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

Contents of /nanobloggertrackback/trunk/tb.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 285 - (show annotations)
Thu May 25 22:08:36 2006 UTC (14 years, 11 months ago) by gregoa
File size: 17001 byte(s)
* New upstream release.
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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26