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