aux/cgi/rss.cgi

   1 #!/usr/bin/perl
   2 use CGI::Fast qw/:cgi/;
   3 use Blerg::Database;
   4 use URI::Escape;
   5 use POSIX qw/strftime/;
   6 use MIME::Base64;
   7 use strict;
   8
   9 my $baseurl = Blerg::Database::BASEURL;
  10
  11 sub xml_escape {
  12     local $_ = shift;
  13     s/&/&amp;/g;
  14     s/</&lt;/g;
  15     s/>/&gt;/g;
  16     return $_;
  17 }
  18
  19 sub decode_basic_auth {
  20     my ($q) = @_;
  21
  22     my ($method, $base64) = split(/\s+/, $q->http('Authorization'));
  23     if (!defined $method) {
  24         return;
  25     } elsif ($method ne 'Basic') {
  26         return;
  27     }
  28
  29     my ($username, $password) = split(':', decode_base64($base64), 2);
  30     if (!defined $username) {
  31         return;
  32     }
  33
  34     return ($username, $password);
  35 }
  36
  37 sub print_401 {
  38     print header(-type => 'text/html',
  39                  -status => '401 Unauthorized',
  40                  -WWW_Authenticate => 'Basic realm="blerg"');
  41     print <<DOC;
  42 <!DOCTYPE html>
  43 <h1>401 Unauthorized</h1>
  44 Please log in.
  45 DOC
  46 }
  47
  48 sub print_404 {
  49     print header(-type => 'text/html',
  50                  -status => '404 Not Found');
  51     print <<DOC;
  52 <!DOCTYPE html>
  53 <h1>404 Not Found</h1>
  54 Not Found
  55 DOC
  56 }
  57
  58 sub fetch_records {
  59     my @out;
  60     local $_;
  61
  62     foreach (@_) {
  63         my $b = Blerg::Database->open_existing($_->{author});
  64         my $data = $b->fetch($_->{record});
  65         if (!defined $data) {
  66             $b->close;
  67             next;
  68         }
  69         my $timestamp = $b->timestamp($_->{record});
  70         $b->close;
  71         push @out, {
  72             author => $_->{author},
  73             record => $_->{record},
  74             data => $data,
  75             timestamp => $timestamp,
  76         };
  77     }
  78
  79     return @out;
  80 }
  81
  82 sub print_rss {
  83     my ($type, $name, @items) = @_;
  84
  85     my ($title, $link);
  86     if ($type eq 'user') {
  87         $title = "${name}'s blërg";
  88         $link = "${baseurl}#$name";
  89     } elsif ($type eq 'feed') {
  90         $title = "${name}'s stalking feed";
  91         $link = "${baseurl}#/feed";
  92     } elsif ($type eq 'tag' || $type eq 'ref') {
  93         $title = $name;
  94         my $basename = $name;
  95         $basename =~ s/^.//;
  96         $link = "${baseurl}#/$type/$basename";
  97     }
  98
  99     print <<HEADER;
 100 <?xml version="1.0" encoding="utf-8" ?>
 101 <rss version="2.0">
 102   <channel>
 103     <title>$title</title>
 104     <link>$link</link>
 105     <description>Textual vomit</description>
 106 HEADER
 107
 108     for my $i (@items) {
 109         my $author = defined $i->{author} ? $i->{author} : $name;
 110         my $data = xml_escape(qq{<a href="${baseurl}#$author"><strong>\@$author</strong></a><br> $i->{data}});
 111         my $title = xml_escape(substr($i->{data}, 0, 27)) . "...";
 112         my $post_time = strftime("%a, %d %b %Y %H:%M:%S %Z", localtime($i->{timestamp}));
 113         print <<ITEM;
 114     <item>
 115       <title>$title</title>
 116       <pubDate>$post_time</pubDate>
 117       <guid>${baseurl}get/$author/$i->{record}</guid>
 118       <link>${baseurl}#$author/$i->{record}</link>
 119       <description>$data</description>
 120     </item>
 121 ITEM
 122     }
 123
 124     print <<'FOOTER'
 125   </channel>
 126 </rss>
 127 FOOTER
 128 }
 129
 130 REQUEST:
 131 while (my $q = new CGI::Fast) {
 132     $q->charset('utf8');
 133     my @path = split('/', $ENV{PATH_INFO});
 134     shift @path;
 135
 136     if ($path[0] eq 'feed') {
 137         my ($username, $password) = decode_basic_auth($q);
 138         if (!defined $username) {
 139             print_401;
 140             next REQUEST;
 141         }
 142         if (!Blerg::Database::auth_check_password($username, $password)) {
 143             print_401;
 144             next REQUEST;
 145         }
 146
 147         my $b = Blerg::Database->open_existing($username);
 148         my @list = fetch_records($b->subscription_list());
 149         $b->close;
 150
 151         print header(-type => 'application/rss+xml');
 152         print_rss(feed => $username, @list);
 153     } elsif (@path == 1) {
 154         # Assume this is a username; redirect to /user/<username>
 155         my $username = $path[0];
 156         my $b = Blerg::Database->open_existing($username);
 157         if (!defined $b) {
 158             print_404;
 159             next REQUEST;
 160         }
 161         print header(-type => 'application/rss+xml',
 162                      -charset => 'utf8',
 163                      -status => '301 Moved Permanently',
 164                      -location => "${baseurl}rss/user/$username");
 165         # And present the content in case their client is broken
 166         my $i = {
 167             record => '?failed_redirect',
 168             timestamp => time,
 169             data => qq{Your RSS aggregator is dumb and isn't following 301 redirects.  Please manually redirect it here: ${baseurl}rss/user/$username}
 170         };
 171         print_rss(user => $username, $i);
 172     } elsif ($path[0] eq 'user') {
 173         my $username = $path[1];
 174         my $b = Blerg::Database->open_existing($username);
 175         if (!defined $b) {
 176             print_404;
 177             next REQUEST;
 178         }
 179         print header(-type => 'application/rss+xml');
 180         my $n = $b->record_count - 1;
 181         my @list = reverse map {
 182             {
 183                 record    => $_,
 184                 data      => $b->fetch($_),
 185                 timestamp => $b->timestamp($_),
 186             }
 187         } ($n > 50 ? $n - 50 : 0)..$n;
 188         $b->close;
 189         print_rss(user => $username, @list);
 190     } elsif ($path[0] eq 'tag' || $path[0] eq 'ref') {
 191         my $tag = $path[1];
 192         my $atag;
 193         if ($path[0] eq 'tag') {
 194             $atag = '#' . $tag;
 195         } else {
 196             $atag = '@' . $tag;
 197         }
 198
 199         my @list = fetch_records(Blerg::Database::tag_list($atag, 0, -1));
 200
 201         print header(-type => 'application/rss+xml');
 202         print_rss($path[0] => $atag, @list);
 203     }
 204 }