Make Account Center only usable when logged in
[blerg.git] / 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/&/&/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 }