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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 164 - (hide 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 gregoa 164 #!/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