/[debian]/nanobloggertrackback/branches/upstream/current/tb.cgi
ViewVC logotype

Contents of /nanobloggertrackback/branches/upstream/current/tb.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 181 - (show annotations)
Tue Mar 21 16:14:16 2006 UTC (15 years, 6 months ago) by gregoa
File size: 16416 byte(s)
Load /tmp/tmp.Qx79BG/nanobloggertrackback-0.2.1 into
debian/nanobloggertrackback/branches/upstream/current.

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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26