Load /tmp/tmp.4vw2vi/nanobloggertrackback-0.2.2 into
[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     # 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