401 Unauthorized

#!/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::constant('BASEURL');

sub xml_escape {
    local $_ = shift;
    s/&/&amp;/g;
    s/</&lt;/g;
    s/>/&gt;/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 $post_time = strftime("%a, %d %b %Y %H:%M:%S %Z", localtime($i->{timestamp}));
        print <<ITEM;
    <item>
      <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);
    }
}