/[debian]/nanobloggertrackback/trunk/tb.cgi
ViewVC logotype

Contents of /nanobloggertrackback/trunk/tb.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 209 - (show annotations)
Sat Apr 29 15:03:37 2006 UTC (15 years, 4 months ago) by gregoa
File size: 16538 byte(s)
* New upstream release.
* Add new upstream ChangeLog.
* Added ${perl:Depends} to Depends and dh_perl to debian/rules.
1 #!/usr/bin/perl -w
2 # Copyright 2002 Benjamin Trott.
3 # This code is released under the Artistic License.
4 #
5 # Original: http://www.movabletype.org/downloads/tb-standalone.tar.gz
6 # Docs: http://www.sixapart.com/movabletype/docs/tb-standalone
7 #
8 # Changed by gregor herrmann <gregor+debian@comodo.priv.at>, 2005, 2006
9
10 use strict;
11 use warnings;
12
13 my $DataDir = "BLOGDIR/tb/data";
14 my $RSSDir = "BLOGDIR/tb/rss";
15 my $GenerateRSS = 1;
16 my $Header = "BLOGDIR/tb/header.txt";
17 my $Footer = "BLOGDIR/tb/footer.txt";
18 my $Password = "PASSWORD";
19 my $MailNotify = 'EMAIL';
20 my $NBDataDir = "BLOGDIR/data";
21
22 use vars qw( $VERSION );
23 $VERSION = '1.02';
24
25 use CGI qw( :standard );
26 use File::Spec::Functions;
27
28 my $mode = param('__mode');
29 unless ($mode) {
30 my $tb_id = munge_tb_id(get_tb_id());
31 respond_exit("No TrackBack ID (tb_id)") unless $tb_id;
32 respond_exit("No valid TrackBack ID:" . $tb_id) unless is_valid_tb_id($tb_id);
33 my $i = { map { $_ => scalar param($_) } qw(title excerpt url blog_name) };
34 $i->{title} ||= $i->{url};
35 $i->{timestamp} = time;
36 respond_exit("No URL (url)") unless $i->{url};
37 # require excerpt, even if not in TB specification, against spam
38 respond_exit("No excerpt") unless $i->{excerpt};
39 my $data = load_data($tb_id);
40 unshift @$data, $i;
41 store_data($tb_id, $data);
42 if ($GenerateRSS && open(FH, ">" . catfile($RSSDir, $tb_id . '.xml'))) {
43 print FH generate_rss($tb_id, $data, 15);
44 close FH;
45 }
46 my $me = url();
47 # open(SENDMAIL, "|/usr/lib/sendmail -oi -t -odq") or die "Can't fork for sendmail: $!\n";
48 open(SENDMAIL, "| /usr/sbin/exim4 -ti") or respond_exit( "Can't fork for sendmail: $!\n");
49 print SENDMAIL <<"EOF";
50 From: trackback $MailNotify
51 To: $MailNotify
52 Subject: new trackback ping
53
54 You received a new trackback ping:
55 $me?__mode=list&tb_id=$tb_id
56 EOF
57 close(SENDMAIL) or warn "sendmail didn't close nicely";
58 respond_exit();
59 } elsif ($mode eq 'list') {
60 my $tb_id = munge_tb_id(get_tb_id());
61 die("No TrackBack ID (tb_id)") unless $tb_id;
62 my $me = url();
63 print header(), from_file($Header), <<URL;
64 <div class="url">TrackBack URL for this entry:
65 <div class="ping-url">$me/$tb_id</div>
66 </div>
67 URL
68 my $data = load_data($tb_id);
69 my $tmpl = <<TMPL;
70 <a target="new" href="%s">%s</a><br />
71 <div class="head">&#187; %s</div>
72 <div class="excerpt">"%s"</div>
73 <div class="footer">Tracked: %s %s</div>
74 TMPL
75 my $i = 0;
76 require POSIX;
77 my $logged_in = is_logged_in();
78 for my $item (@$data) {
79 my $ts = POSIX::strftime("%F %T %Z", localtime $item->{timestamp});
80 printf $tmpl,
81 $item->{url}, $item->{title},
82 $item->{blog_name} || "[No blog name]",
83 $item->{excerpt} || "[No excerpt]",
84 $ts,
85 $logged_in ? qq(<a class="delete" href="$me?__mode=delete&tb_id=$tb_id&index=$i">[DELETE]</a>) : '';
86 $i++;
87 }
88 unless ($logged_in) {
89 print <<HTML;
90 <div align="right">[Is this your site? <a href="$me?__mode=login">Log in</a> to delete pings.]</div>
91 HTML
92 } else {
93 print <<HTML;
94 <div align="right">[<a href="$me?__mode=logout">Log out</a>]</div>
95 HTML
96 }
97 print from_file($Footer);
98
99 } elsif ($mode eq 'show') {
100 my $tb_id = munge_tb_id(get_tb_id());
101 die("No TrackBack ID (tb_id)") unless $tb_id;
102 my $data = load_data($tb_id);
103 print header();
104 if(@{$data} > 0) {
105 print <<URL;
106 <div class="tb-title">Trackbacks for this entry:</div>
107 URL
108 }
109 my $tmpl = <<TMPL;
110 <div class="tb-header">&#187; %s:
111 <a href="%s">%s</a>
112 </div>
113 <div class="tb-excerpt">"%s"</div>
114 <div class="tb-footer">Tracked: %s</div>
115 TMPL
116 my $i = 0;
117 require POSIX;
118 for my $item (@$data) {
119 my $ts = POSIX::strftime("%F %T %Z", localtime $item->{timestamp});
120 printf $tmpl,
121 $item->{blog_name} || "[No blog name]",
122 $item->{url},
123 $item->{title},
124 $item->{excerpt} || "[No excerpt]",
125 $ts;
126 $i++;
127 }
128
129 } elsif ($mode eq 'delete') {
130 die "You are not authorized" unless is_logged_in();
131 my $tb_id = munge_tb_id(get_tb_id());
132 die("No TrackBack ID (tb_id)") unless $tb_id;
133 my $data = load_data($tb_id);
134 my $index = param('index') || 0;
135 splice @$data, $index, 1;
136 store_data($tb_id, $data);
137 print redirect(url() . "?__mode=list&tb_id=$tb_id");
138 } elsif ($mode eq 'rss') {
139 my $tb_id = munge_tb_id(get_tb_id());
140 respond_exit("No TrackBack ID (tb_id)") unless $tb_id;
141 my $data = load_data($tb_id);
142 respond_exit(undef, generate_rss($tb_id, $data));
143 } elsif ($mode eq 'send_ping') {
144 require LWP::UserAgent;
145 my $ua = LWP::UserAgent->new;
146 $ua->agent("TrackBack/$VERSION");
147 my @qs = map $_ . '=' . encode_url(param($_) || ''),
148 qw( title url excerpt blog_name );
149 my $ping = param('ping_url') or ping_form_exit("No ping URL");
150 my $req;
151 if ($ping =~ /\?/) {
152 $req = HTTP::Request->new(GET => $ping . '&' . join('&', @qs));
153 } else {
154 $req = HTTP::Request->new(POST => $ping);
155 $req->content_type('application/x-www-form-urlencoded');
156 $req->content(join('&', @qs));
157 }
158 my $res = $ua->request($req);
159 ping_form_exit("HTTP error: " . $res->status_line) unless $res->is_success;
160 my($e, $msg) = $res->content =~ m!<error>(\d+).*<message>(.+?)</message>!s;
161 $e ? ping_form_exit("Error: $msg") : ping_form_exit("Ping successfuly sent");
162 } elsif ($mode eq 'send_form') {
163 ping_form_exit();
164 } elsif ($mode eq 'login') {
165 print header(), login_form();
166 } elsif ($mode eq 'do_login') {
167 my $key = param('key');
168 unless ($key eq $Password) {
169 print header(), login_form("Invalid login");
170 exit;
171 }
172 require CGI::Cookie;
173 my @alpha = ('a'..'z', 'A'..'Z', 0..9);
174 my $salt = join '', map $alpha[rand @alpha], 1..2;
175 my $cookie = CGI::Cookie->new(-name => 'key',
176 -value => crypt($key, $salt));
177 print header(-cookie => $cookie), from_file($Header),
178 "Logged in", from_file($Footer);
179 } elsif ($mode eq 'logout') {
180 require CGI::Cookie;
181 my $cookie = CGI::Cookie->new(-name => 'key', -value => '',
182 -expire => '-1y');
183 print header(-cookie => $cookie), login_form("Logged out");
184 }
185
186 sub get_tb_id {
187 my $tb_id = param('tb_id');
188 unless ($tb_id) {
189 if (my $pi = path_info()) {
190 ($tb_id = $pi) =~ s!^/!!;
191 }
192 }
193 $tb_id;
194 }
195
196 sub munge_tb_id {
197 my($id) = @_;
198 return '' unless $id;
199 $id =~ tr/a-zA-Z0-9/_/cs;
200 $id;
201 }
202
203 sub is_valid_tb_id {
204 my($id) = @_;
205 return '' unless $id;
206 my @nb_files=<$NBDataDir/*>;
207 map { $_ =~ s/^$NBDataDir\/// } @nb_files;
208 map { $_ = munge_tb_id($_) } @nb_files;
209 print @nb_files;
210 $id =~ s/^e//;
211 return (grep(/$id/, @nb_files) ? '1' : '');
212 }
213
214 sub is_logged_in {
215 require CGI::Cookie;
216 my %cookies = CGI::Cookie->fetch;
217 return unless $cookies{key};
218 my $key = $cookies{key}->value || return;
219 $key eq crypt $Password, substr $key, 0, 2;
220 }
221
222 sub load_data {
223 my($tb_id) = @_;
224 my $tb_file = catfile($DataDir, $tb_id . '.stor');
225 require Storable;
226 scalar eval { Storable::retrieve($tb_file) } || [];
227 }
228
229 sub store_data {
230 my($tb_id, $data) = @_;
231 my $tb_file = catfile($DataDir, $tb_id . '.stor');
232 require Storable;
233 Storable::store($data, $tb_file);
234 }
235
236 sub generate_rss {
237 my($tb_id, $data, $limit) = @_;
238 my $rss = qq(<rss version="0.91"><channel><title>TB: $tb_id</title>\n);
239 my $max = $limit ? $limit - 1 : $#$data;
240 for my $i (@{$data}[0..$max]) {
241 $rss .= sprintf "<item>%s%s%s</item>\n", xml('title', $i->{title}),
242 xml('link', $i->{url}), xml('description', $i->{excerpt}) if $i;
243 }
244 $rss . qq(</channel></rss>);
245 }
246
247 sub respond_exit {
248 print "Content-Type: text/xml\n\n";
249 print qq(<?xml version="1.0" encoding="iso-8859-1"?>\n<response>\n);
250 if ($_[0]) {
251 printf qq(<error>1</error>\n%s\n), xml('message', $_[0]);
252 } else {
253 print qq(<error>0</error>\n) . ($_[1] ? $_[1] : '');
254 }
255 print "</response>\n";
256 exit;
257 }
258
259 sub ping_form_exit {
260 print header(), from_file($Header);
261 print "@_" if @_;
262 print <<HTML;
263 <h2>Send a TrackBack ping</h2>
264 <form method="post"><input type="hidden" name="__mode" value="send_ping" />
265 <table border="0" cellspacing="3" cellpadding="0">
266 <tr><td>TrackBack Ping URL:</td><td><input name="ping_url" size="60" /></td></tr>
267 <tr><td>&nbsp;</td></tr>
268 <tr><td>Title:</td><td><input name="title" size="35" /></td></tr>
269 <tr><td>Blog name:</td><td><input name="blog_name" size="35" /></td></tr>
270 <tr><td>Excerpt:</td><td><input name="excerpt" size="60" /></td></tr>
271 <tr><td>Permalink URL:</td><td><input name="url" size="60" /></td></tr>
272 </table>
273 <input type="submit" value="Send">
274 </form>
275 HTML
276 print from_file($Footer);
277 exit;
278 }
279
280 sub login_form {
281 my $str = from_file($Header);
282 $str .= "<p>@_</p>" if @_;
283 $str .= <<HTML . from_file($Footer);
284 <form method="post">
285 <input type="hidden" name="__mode" value="do_login" />
286 Password: <input name="key" type="password" />
287 <input type="submit" value="Log in" />
288 </form>
289 HTML
290 $str;
291 }
292 my(%Map, $RE);
293 BEGIN {
294 %Map = ('&' => '&amp;', '"' => '&quot;', '<' => '&lt;', '>' => '&gt;');
295 $RE = join '|', keys %Map;
296 }
297 sub xml {
298 (my $s = defined $_[1] ? $_[1] : '') =~ s!($RE)!$Map{$1}!g;
299 "<$_[0]>$s</$_[0]>\n";
300 }
301
302 sub encode_url {
303 (my $str = $_[0]) =~ s!([^a-zA-Z0-9_.-])!uc sprintf "%%%02x", ord($1)!eg;
304 $str;
305 }
306
307 sub from_file {
308 my($file) = @_;
309 local *FH;
310 open FH, $file;
311 my $c;
312 { local $/; $c = <FH> }
313 close FH;
314 $c;
315 }
316
317 __END__
318
319 =head1 NAME
320
321 tb-standalone - Standalone TrackBack
322
323 =head1 DESCRIPTION
324
325 The standalone TrackBack tool serves two purposes: 1) it allows non-Movable
326 Type users to use TrackBack with the tool of their choice, provided they meet
327 the installation requirements; 2) it serves as a reference point to aid
328 developers in implementing TrackBack in their own systems. This tool is a
329 single CGI script that accepts TrackBack pings through HTTP requests, stores
330 the pings locally in the filesystem, and can return a list of pings either
331 in RSS or in a browser-viewable format. It can also be used to send pings
332 to other sites.
333
334 It is released under the Artistic License. The terms of the Artistic License
335 are described at I<http://www.perl.com/language/misc/Artistic.html>.
336
337 =head1 REQUIREMENTS
338
339 You'll need a webserver capable of running CGI scripts (this means, for
340 example, that this won't work with BlogSpot-hosted blogs). You'll also need
341 perl, and the following Perl modules:
342
343 =over 4
344
345 =item * File::Spec
346
347 =item * Storable
348
349 =item * CGI
350
351 =item * CGI::Cookie
352
353 =item * LWP
354
355 =back
356
357 The first four are core modules as of perl 5.6.0, I believe, and LWP is
358 installed on most hosts. Furthermore LWP is only required if you wish to
359 B<send> TrackBack pings.
360
361 =head1 INSTALLATION
362
363 Installation of the standalone TrackBack tool is very simple. It's just one
364 CGI script, F<tb.cgi>, along with two text files that define the header and
365 footer HTML for the public list of TrackBack pings.
366
367 =over 4
368
369 =item 1. Configure tb.cgi
370
371 You'll need to edit the script to change the I<$DataDir>, I<$RSSDir>,
372 and I<$Password> settings.
373
374 B<BE SURE TO CHANGE THE I<$Password> BEFORE INSTALLING THE TOOL.>
375
376 I<$DataDir> is the path to the directory where the TrackBack data
377 files will be stored; I<$RSSDir> is the path to the directory where the static
378 RSS files will be generated; I<$Password> is your secret password that will
379 allow you to delete TrackBack pings, when logged in.
380
381 After setting I<$DataDir> and I<$RSSDir>, you'll need to create both of these
382 directories and make them writeable by the user running the CGI scripts. In
383 most cases, this means that you must set the permissions on these directories
384 to 777.
385
386 =item 2. Upload Files
387
388 After editing the settings, upload F<tb.cgi>, F<header.txt>, and F<footer.txt>
389 in ASCII mode to your webserver into a directory where you can run CGI
390 scripts. Set the permissions on F<tb.cgi> to 755.
391
392 =back
393
394 =head1 USAGE
395
396 =head2 Sending Pings
397
398 To send pings from the tool, go to the following URL:
399
400 http://yourserver.com/cgi-bin/tb.cgi?__mode=send_form
401
402 where I<http://yourserver.com/cgi-bin/tb.cgi> is the URL where you
403 installed F<tb.cgi>. Fill out the fields in the form, then press I<Send>.
404
405 =head2 Receiving Pings
406
407 To use the tool in your existing pages, you'll need to do two things:
408
409 =over 4
410
411 =item 1. Link to TrackBack listing
412
413 First, you'll need to add a link to each of your weblog entries with a
414 link to the list of TrackBack pings for that entry. You can do this by
415 adding the following HTML to your template:
416
417 <a href="http://yourserver.com/cgi-bin/tb.cgi?__mode=list&tb_id=[TrackBack ID]" onclick="window.open(this.href, 'trackback', 'width=480,height=480,scrollbars=yes,status=yes'); return false">TrackBack</a>
418
419 You'll need to change C<http://yourserver.com/cgi-bin/tb.cgi> to the proper
420 URL for I<tb.cgi> on your server. And, depending on the weblogging tool that
421 you use, you'll need to change C<[TrackBack ID]> to a unique post ID. See
422 the L<conversion table below|Conversion Table> to determine the proper tag to
423 use for the tool that you use, to generate a unique post ID.
424
425 =item 2. Add RDF
426
427 TrackBack uses RDF embedded within your web page to auto-discover
428 TrackBack-enabled entries on your pages. It also uses this information when
429 building a threaded list of a cross-weblog "discussion". For these purposes,
430 it is useful to embed the RDF into your page.
431
432 Add the following to your weblog template so that it is displayed for each
433 of the entries on your page:
434
435 <!--
436 <rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
437 xmlns:dc="http://purl.org/dc/elements/1.1/"
438 xmlns:trackback="http://madskills.com/public/xml/rss/module/trackback/">
439 <rdf:Description
440 rdf:about="[Entry Permalink]"
441 dc:title="[Entry Title]"
442 dc:identifier="[Entry Permalink]" />
443 trackback:ping="http://yourserver.com/cgi-bin/tb.cgi/[TrackBack ID]"
444 </rdf:RDF>
445 -->
446
447 As above, the tags that you should use for C<[TrackBack ID]>,
448 C<[Entry Title]>, and C<[Entry Permalink]> all depend on the weblogging tool
449 that you are using. See the L<conversion table below|Conversion Table>.
450
451 =back
452
453 =head2 Conversion Table
454
455 =over 4
456
457 =item * Blogger
458
459 TrackBack ID = C<E<lt>$BlogItemNumber$E<gt>>
460
461 Entry Title = C<E<lt>PostSubjectE<gt>E<lt>$BlogItemSubject$E<gt>E<lt>/PostSubjectE<gt>>
462
463 Entry Permalink = C<E<lt>$BlogItemArchiveFileName$E<gt>#E<lt>$BlogItemNumber$E<gt>>
464
465 =item * GreyMatter
466
467 TrackBack ID = C<{{entrynumber}}>
468
469 Entry Title = C<{{entrysubject}}>
470
471 Entry Permalink = C<{{pagelink}}>
472
473 =item * b2
474
475 TrackBack ID = C<E<lt>?php the_ID() ?E<gt>>
476
477 Entry Title = C<E<lt>?php the_title() ?E<gt>>
478
479 Entry Permalink = C<E<lt>?php permalink_link() ?E<gt>>
480
481 =item * pMachine
482
483 TrackBack ID = C<%%id%%>
484
485 Entry Title = C<%%title%%>
486
487 Entry Permalink = C<%%comment_permalink%%>
488
489 =item * Bloxsom
490
491 TrackBack ID = C<$fn>
492
493 Entry Title = C<$title>
494
495 Entry Permalink = C<$url/$yr/$mo/$da#$fn>
496
497 Thanks to Rael for this list of conversions.
498
499 =back
500
501 =head1 POSSIBLE USES
502
503 =over 4
504
505 =item 1. Content repository
506
507 Like Movable Type's TrackBack implementation, this standalone script can
508 be used to power a distributed content repository. The value of the I<tb_id>
509 parameter does not necessarily have to be an integer, because all it is used
510 for is a filename (B<note> that this is not true of most other TrackBack
511 implementations). For example, if you run a site about cats, and want to have
512 a way for users to ping your site with entries they write about their own
513 cats, you could set up a TrackBack URL like
514 F<http://www.foo.com/bar/tb.cgi?tb_id=cats>, then give that URL out on your
515 site. End users could then associate this URL with a I<Cats> category in
516 their own blog, and ping you whenever they wrote about cats.
517
518 =item 2. Building block
519
520 You can use this simple implementation as a building block, or a guide, for
521 implementing TrackBack in your own system. It illustrates the core
522 functionality of the TrackBack framework, onto which you could add bells
523 and whistles (IP banning, password-protected TrackBacks, etc).
524
525 =item 3. Centralized tool
526
527 This TrackBack tool requires that the end user have the ability to run CGI
528 scripts on their server. For many users (eg BlogSpot users), this is not
529 an option. For such users, a centralized system (based on this tool, perhaps)
530 would be ideal.
531
532 =back
533
534 =cut

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26