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