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

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26