Reorganize auxilliary CGIs
$(ENV_DIR)/www/css \
$(ENV_DIR)/www/doc/perl \
$(ENV_DIR)/www/images
- install --mode 755 blerg.cgi rss.cgi $(ENV_DIR)/lib/cgi-bin/
+ install --mode 755 blerg.cgi aux/cgi/*.cgi $(ENV_DIR)/lib/cgi-bin/
install --mode 755 blergtool blerglatest $(ENV_DIR)/bin/
install --mode 644 www/favicon.gif www/favicon.ico www/index.html \
www/welcome.html \
+#!/usr/bin/perl
+use CGI::Fast qw/:cgi/;
+use Blerg::Database;
+use URI::Escape;
+use POSIX qw/strftime/;
+use MIME::Base64;
+use strict;
+
+my $baseurl = Blerg::Database::BASEURL;
+
+sub xml_escape {
+ local $_ = shift;
+ s/&/&/g;
+ s/</</g;
+ s/>/>/g;
+ return $_;
+}
+
+sub decode_basic_auth {
+ my ($q) = @_;
+
+ my ($method, $base64) = split(/\s+/, $q->http('Authorization'));
+ if (!defined $method) {
+ return;
+ } elsif ($method ne 'Basic') {
+ return;
+ }
+
+ my ($username, $password) = split(':', decode_base64($base64), 2);
+ if (!defined $username) {
+ return;
+ }
+
+ return ($username, $password);
+}
+
+sub print_401 {
+ print header(-type => 'text/html',
+ -status => '401 Unauthorized',
+ -WWW_Authenticate => 'Basic realm="blerg"');
+ print <<DOC;
+<!DOCTYPE html>
+<h1>401 Unauthorized</h1>
+Please log in.
+DOC
+}
+
+sub print_404 {
+ print header(-type => 'text/html',
+ -status => '404 Not Found');
+ print <<DOC;
+<!DOCTYPE html>
+<h1>404 Not Found</h1>
+Not Found
+DOC
+}
+
+sub fetch_records {
+ my @out;
+ local $_;
+
+ foreach (@_) {
+ my $b = Blerg::Database->open_existing($_->{author});
+ my $data = $b->fetch($_->{record});
+ if (!defined $data) {
+ $b->close;
+ next;
+ }
+ my $timestamp = $b->timestamp($_->{record});
+ $b->close;
+ push @out, {
+ author => $_->{author},
+ record => $_->{record},
+ data => $data,
+ timestamp => $timestamp,
+ };
+ }
+
+ return @out;
+}
+
+sub print_rss {
+ my ($type, $name, @items) = @_;
+
+ my ($title, $link);
+ if ($type eq 'user') {
+ $title = "${name}'s blërg";
+ $link = "${baseurl}#$name";
+ } elsif ($type eq 'feed') {
+ $title = "${name}'s stalking feed";
+ $link = "${baseurl}#/feed";
+ } elsif ($type eq 'tag' || $type eq 'ref') {
+ $title = $name;
+ my $basename = $name;
+ $basename =~ s/^.//;
+ $link = "${baseurl}#/$type/$basename";
+ }
+
+ print <<HEADER;
+<?xml version="1.0" encoding="utf-8" ?>
+<rss version="2.0">
+ <channel>
+ <title>$title</title>
+ <link>$link</link>
+ <description>Textual vomit</description>
+HEADER
+
+ for my $i (@items) {
+ my $author = defined $i->{author} ? $i->{author} : $name;
+ my $data = xml_escape(qq{<a href="${baseurl}#$author"><strong>\@$author</strong></a><br> $i->{data}});
+ my $title = xml_escape(substr($i->{data}, 0, 27)) . "...";
+ my $post_time = strftime("%a, %d %b %Y %H:%M:%S %Z", localtime($i->{timestamp}));
+ print <<ITEM;
+ <item>
+ <title>$title</title>
+ <pubDate>$post_time</pubDate>
+ <guid>${baseurl}get/$author/$i->{record}</guid>
+ <link>${baseurl}#$author/$i->{record}</link>
+ <description>$data</description>
+ </item>
+ITEM
+ }
+
+ print <<'FOOTER'
+ </channel>
+</rss>
+FOOTER
+}
+
+REQUEST:
+while (my $q = new CGI::Fast) {
+ $q->charset('utf8');
+ my @path = split('/', $ENV{PATH_INFO});
+ shift @path;
+
+ if ($path[0] eq 'feed') {
+ my ($username, $password) = decode_basic_auth($q);
+ if (!defined $username) {
+ print_401;
+ next REQUEST;
+ }
+ if (!Blerg::Database::auth_check_password($username, $password)) {
+ print_401;
+ next REQUEST;
+ }
+
+ my $b = Blerg::Database->open_existing($username);
+ my @list = fetch_records($b->subscription_list());
+ $b->close;
+
+ print header(-type => 'application/rss+xml');
+ print_rss(feed => $username, @list);
+ } elsif (@path == 1) {
+ # Assume this is a username; redirect to /user/<username>
+ my $username = $path[0];
+ my $b = Blerg::Database->open_existing($username);
+ if (!defined $b) {
+ print_404;
+ next REQUEST;
+ }
+ print header(-type => 'application/rss+xml',
+ -charset => 'utf8',
+ -status => '301 Moved Permanently',
+ -location => "${baseurl}rss/user/$username");
+ # And present the content in case their client is broken
+ my $i = {
+ record => '?failed_redirect',
+ timestamp => time,
+ data => qq{Your RSS aggregator is dumb and isn't following 301 redirects. Please manually redirect it here: ${baseurl}rss/user/$username}
+ };
+ print_rss(user => $username, $i);
+ } elsif ($path[0] eq 'user') {
+ my $username = $path[1];
+ my $b = Blerg::Database->open_existing($username);
+ if (!defined $b) {
+ print_404;
+ next REQUEST;
+ }
+ print header(-type => 'application/rss+xml');
+ my $n = $b->record_count - 1;
+ my @list = reverse map {
+ {
+ record => $_,
+ data => $b->fetch($_),
+ timestamp => $b->timestamp($_),
+ }
+ } ($n > 50 ? $n - 50 : 0)..$n;
+ $b->close;
+ print_rss(user => $username, @list);
+ } elsif ($path[0] eq 'tag' || $path[0] eq 'ref') {
+ my $tag = $path[1];
+ my $atag;
+ if ($path[0] eq 'tag') {
+ $atag = '#' . $tag;
+ } else {
+ $atag = '@' . $tag;
+ }
+
+ my @list = fetch_records(Blerg::Database::tag_list($atag, 0, -1));
+
+ print header(-type => 'application/rss+xml');
+ print_rss($path[0] => $atag, @list);
+ }
+}
-#!/usr/bin/perl
-use CGI::Fast qw/:cgi/;
-use Blerg::Database;
-use URI::Escape;
-use POSIX qw/strftime/;
-use MIME::Base64;
-use strict;
-
-my $baseurl = Blerg::Database::BASEURL;
-
-sub xml_escape {
- local $_ = shift;
- s/&/&/g;
- s/</</g;
- s/>/>/g;
- return $_;
-}
-
-sub decode_basic_auth {
- my ($q) = @_;
-
- my ($method, $base64) = split(/\s+/, $q->http('Authorization'));
- if (!defined $method) {
- return;
- } elsif ($method ne 'Basic') {
- return;
- }
-
- my ($username, $password) = split(':', decode_base64($base64), 2);
- if (!defined $username) {
- return;
- }
-
- return ($username, $password);
-}
-
-sub print_401 {
- print header(-type => 'text/html',
- -status => '401 Unauthorized',
- -WWW_Authenticate => 'Basic realm="blerg"');
- print <<DOC;
-<!DOCTYPE html>
-<h1>401 Unauthorized</h1>
-Please log in.
-DOC
-}
-
-sub print_404 {
- print header(-type => 'text/html',
- -status => '404 Not Found');
- print <<DOC;
-<!DOCTYPE html>
-<h1>404 Not Found</h1>
-Not Found
-DOC
-}
-
-sub fetch_records {
- my @out;
- local $_;
-
- foreach (@_) {
- my $b = Blerg::Database->open_existing($_->{author});
- my $data = $b->fetch($_->{record});
- if (!defined $data) {
- $b->close;
- next;
- }
- my $timestamp = $b->timestamp($_->{record});
- $b->close;
- push @out, {
- author => $_->{author},
- record => $_->{record},
- data => $data,
- timestamp => $timestamp,
- };
- }
-
- return @out;
-}
-
-sub print_rss {
- my ($type, $name, @items) = @_;
-
- my ($title, $link);
- if ($type eq 'user') {
- $title = "${name}'s blërg";
- $link = "${baseurl}#$name";
- } elsif ($type eq 'feed') {
- $title = "${name}'s stalking feed";
- $link = "${baseurl}#/feed";
- } elsif ($type eq 'tag' || $type eq 'ref') {
- $title = $name;
- my $basename = $name;
- $basename =~ s/^.//;
- $link = "${baseurl}#/$type/$basename";
- }
-
- print <<HEADER;
-<?xml version="1.0" encoding="utf-8" ?>
-<rss version="2.0">
- <channel>
- <title>$title</title>
- <link>$link</link>
- <description>Textual vomit</description>
-HEADER
-
- for my $i (@items) {
- my $author = defined $i->{author} ? $i->{author} : $name;
- my $data = xml_escape(qq{<a href="${baseurl}#$author"><strong>\@$author</strong></a><br> $i->{data}});
- my $title = xml_escape(substr($i->{data}, 0, 27)) . "...";
- my $post_time = strftime("%a, %d %b %Y %H:%M:%S %Z", localtime($i->{timestamp}));
- print <<ITEM;
- <item>
- <title>$title</title>
- <pubDate>$post_time</pubDate>
- <guid>${baseurl}get/$author/$i->{record}</guid>
- <link>${baseurl}#$author/$i->{record}</link>
- <description>$data</description>
- </item>
-ITEM
- }
-
- print <<'FOOTER'
- </channel>
-</rss>
-FOOTER
-}
-
-REQUEST:
-while (my $q = new CGI::Fast) {
- $q->charset('utf8');
- my @path = split('/', $ENV{PATH_INFO});
- shift @path;
-
- if ($path[0] eq 'feed') {
- my ($username, $password) = decode_basic_auth($q);
- if (!defined $username) {
- print_401;
- next REQUEST;
- }
- if (!Blerg::Database::auth_check_password($username, $password)) {
- print_401;
- next REQUEST;
- }
-
- my $b = Blerg::Database->open_existing($username);
- my @list = fetch_records($b->subscription_list());
- $b->close;
-
- print header(-type => 'application/rss+xml');
- print_rss(feed => $username, @list);
- } elsif (@path == 1) {
- # Assume this is a username; redirect to /user/<username>
- my $username = $path[0];
- my $b = Blerg::Database->open_existing($username);
- if (!defined $b) {
- print_404;
- next REQUEST;
- }
- print header(-type => 'application/rss+xml',
- -charset => 'utf8',
- -status => '301 Moved Permanently',
- -location => "${baseurl}rss/user/$username");
- # And present the content in case their client is broken
- my $i = {
- record => '?failed_redirect',
- timestamp => time,
- data => qq{Your RSS aggregator is dumb and isn't following 301 redirects. Please manually redirect it here: ${baseurl}rss/user/$username}
- };
- print_rss(user => $username, $i);
- } elsif ($path[0] eq 'user') {
- my $username = $path[1];
- my $b = Blerg::Database->open_existing($username);
- if (!defined $b) {
- print_404;
- next REQUEST;
- }
- print header(-type => 'application/rss+xml');
- my $n = $b->record_count - 1;
- my @list = reverse map {
- {
- record => $_,
- data => $b->fetch($_),
- timestamp => $b->timestamp($_),
- }
- } ($n > 50 ? $n - 50 : 0)..$n;
- $b->close;
- print_rss(user => $username, @list);
- } elsif ($path[0] eq 'tag' || $path[0] eq 'ref') {
- my $tag = $path[1];
- my $atag;
- if ($path[0] eq 'tag') {
- $atag = '#' . $tag;
- } else {
- $atag = '@' . $tag;
- }
-
- my @list = fetch_records(Blerg::Database::tag_list($atag, 0, -1));
-
- print header(-type => 'application/rss+xml');
- print_rss($path[0] => $atag, @list);
- }
-}
<h3><a name="building">Building</a></h3>
<p>At this point, it should be gravy. Type 'make' and in a few seconds,
-you should have <code>blerg.httpd</code>, <code>blerg.cgi</code>,
-<code>rss.cgi</code>, and <code>blergtool</code>. Each of those can be
-made individually as well, if you, for example, don't want to install
-the prerequisites for <code>blerg.httpd</code> or
-<code>blerg.cgi</code>.
+you should have <code>blerg.cgi</code>, <code>blergtool</code>, and
+<code>blerglatest</code>.
<p><strong>NOTE</strong>: blerg.httpd is deprecated and will not be
updated with new features.
<h4>The extra RSS CGI</h4>
-<p>There is an optional RSS cgi (<code>rss.cgi</code>) that will serve
+<p>There is an optional RSS cgi (<code>aux/cgi/rss.cgi</code>) that will serve
RSS feeds for users. Install this like <code>blerg.cgi</code> above.
As of 1.9.0, this is a perl FastCGI script, so you will have to make
sure the perl libraries are available to it. A good way of doing that