/[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 283 - (hide annotations)
Thu May 25 22:04:00 2006 UTC (15 years, 3 months ago) by gregoa
File size: 17001 byte(s)
Load /tmp/tmp.NEZQhj5432/nanobloggertrackback-0.2.3 into
debian/nanobloggertrackback/branches/upstream/current.

1 gregoa 164 #!/usr/bin/perl -w
2     # Copyright 2002 Benjamin Trott.
3     # This code is released under the Artistic License.
4     #
5 gregoa 283 # Changes:
6     # Copyright gregor herrmann <gregor+debian@comodo.priv.at> 2005, 2006
7     # GPL 2 or later
8 gregoa 164
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 gregoa 283 my $BLOGURL = "BLOGURL";
21 gregoa 164
22     use vars qw( $VERSION );
23 gregoa 283 $VERSION = '1.02-gh01';
24 gregoa 164
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 gregoa 207 # require excerpt, even if not in TB specification, against spam
38     respond_exit("No excerpt") unless $i->{excerpt};
39 gregoa 283 # 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 gregoa 164 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 gregoa 283
62 gregoa 164 } 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 gregoa 283 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 gregoa 164 __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