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