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