diff options
author | Eric Wong <e@80x24.org> | 2014-04-30 22:58:23 +0000 |
---|---|---|
committer | Eric Wong <e@80x24.org> | 2014-05-01 01:49:23 +0000 |
commit | a6134a0ca3ac69f2dfe353019c35eb36db3d831e (patch) | |
tree | 1fc1dbf53c2bf6441dde8a7979a0ee901157956e /lib | |
parent | dae2c7b509308c052406a0d811e84e30db1bedd2 (diff) | |
download | public-inbox-a6134a0ca3ac69f2dfe353019c35eb36db3d831e.tar.gz |
This should allow us to more-easily test with Plack.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/PublicInbox/WWW.pm | 208 |
1 files changed, 208 insertions, 0 deletions
diff --git a/lib/PublicInbox/WWW.pm b/lib/PublicInbox/WWW.pm new file mode 100644 index 00000000..6d9550b4 --- /dev/null +++ b/lib/PublicInbox/WWW.pm @@ -0,0 +1,208 @@ +# Copyright (C) 2014, Eric Wong <normalperson@yhbt.net> and all contributors +# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt) +# +# We focus on the lowest common denominators here: +# - targeted at text-only console browsers (lynx, w3m, etc..) +# - Only basic HTML, CSS only for line-wrapping <pre> text content for GUIs +# - No JavaScript, graphics or icons allowed. +# - Must not rely on static content +# - UTF-8 is only for user-content, 7-bit US-ASCII for us +package PublicInbox::WWW; +use 5.008; +use strict; +use warnings; +use PublicInbox::Config; +use URI::Escape qw(uri_escape_utf8 uri_unescape); +our $LISTNAME_RE = qr!\A/([\w\.\-]+)!; +our $pi_config; +BEGIN { + $pi_config = PublicInbox::Config->new; +} + +sub run { + my ($cgi, $method) = @_; + my %ctx; + if ($method !~ /\AGET|HEAD\z/) { + return r(405, 'Method Not Allowed'); + } + my $path_info = $cgi->path_info; + + # top-level indices and feeds + if ($path_info eq '/') { + r404(); + } elsif ($path_info =~ m!$LISTNAME_RE\z!o) { + invalid_list(\%ctx, $1) || redirect_list_index(\%ctx, $cgi); + } elsif ($path_info =~ m!$LISTNAME_RE(?:/|/index\.html)?\z!o) { + invalid_list(\%ctx, $1) || get_index(\%ctx, $cgi, 0); + } elsif ($path_info =~ m!$LISTNAME_RE/atom\.xml\z!o) { + invalid_list(\%ctx, $1) || get_atom(\%ctx, $cgi, 0); + + # single-message pages + } elsif ($path_info =~ m!$LISTNAME_RE/m/(\S+)\.txt\z!o) { + invalid_list_mid(\%ctx, $1, $2) || get_mid_txt(\%ctx, $cgi); + } elsif ($path_info =~ m!$LISTNAME_RE/m/(\S+)\.html\z!o) { + invalid_list_mid(\%ctx, $1, $2) || get_mid_html(\%ctx, $cgi); + + # full-message page + } elsif ($path_info =~ m!$LISTNAME_RE/f/(\S+)\.html\z!o) { + invalid_list_mid(\%ctx, $1, $2) || get_full_html(\%ctx, $cgi); + + # convenience redirects, order matters + } elsif ($path_info =~ m!$LISTNAME_RE/(?:m|f)/(\S+)\z!o) { + invalid_list_mid(\%ctx, $1, $2) || redirect_mid(\%ctx, $cgi); + + } else { + r404(); + } +} + +# for CoW-friendliness, MOOOOO! +sub preload { + require PublicInbox::Feed; + require PublicInbox::View; + require Mail::Thread; + require Email::MIME; + require Digest::SHA; + require POSIX; + require XML::Atom::SimpleFeed; +} + +# private functions below + +sub r404 { r(404, 'Not Found') } + +# simple response for errors +sub r { [ $_[0], ['Content-Type' => 'text/plain'], [ join(' ', @_, "\n") ] ] } + +# returns undef if valid, array ref response if invalid +sub invalid_list { + my ($ctx, $listname) = @_; + my $git_dir = $pi_config->get($listname, "mainrepo"); + if (defined $git_dir) { + $ctx->{git_dir} = $git_dir; + $ctx->{listname} = $listname; + return; + } + r404(); +} + +# returns undef if valid, array ref response if invalid +sub invalid_list_mid { + my ($ctx, $listname, $mid) = @_; + my $ret = invalid_list($ctx, $listname, $mid); + $ctx->{mid} = uri_unescape($mid) unless $ret; + $ret; +} + +# /$LISTNAME/atom.xml -> Atom feed, includes replies +sub get_atom { + my ($ctx, $cgi, $top) = @_; + require PublicInbox::Feed; + [ 200, [ 'Content-Type' => 'application/xml' ], + [ PublicInbox::Feed->generate({ + git_dir => $ctx->{git_dir}, + listname => $ctx->{listname}, + pi_config => $pi_config, + cgi => $cgi, + top => $top, + }) ] + ]; +} + +# /$LISTNAME/?r=$GIT_COMMIT -> HTML only +sub get_index { + my ($ctx, $cgi, $top) = @_; + require PublicInbox::Feed; + [ 200, [ 'Content-Type' => 'text/html; charset=UTF-8' ], + [ PublicInbox::Feed->generate_html_index({ + git_dir => $ctx->{git_dir}, + listname => $ctx->{listname}, + pi_config => $pi_config, + cgi => $cgi, + top => $top, + }) ] + ]; +} + +# just returns a string ref for the blob in the current ctx +sub mid2blob { + my ($ctx) = @_; + require Digest::SHA; + my $hex = Digest::SHA::sha1_hex($ctx->{mid}); + $hex =~ /\A([a-f0-9]{2})([a-f0-9]{38})\z/i or + die "BUG: not a SHA-1 hex: $hex"; + + my @cmd = ('git', "--git-dir=$ctx->{git_dir}", + qw(cat-file blob), "HEAD:$1/$2"); + my $cmd = join(' ', @cmd); + my $pid = open my $fh, '-|'; + defined $pid or die "fork failed: $!\n"; + if ($pid == 0) { + open STDERR, '>', '/dev/null'; # ignore errors + exec @cmd or die "exec failed: $!\n"; + } else { + my $blob = eval { local $/; <$fh> }; + close $fh; + $? == 0 ? \$blob : undef; + } +} + +# /$LISTNAME/m/$MESSAGE_ID.txt -> raw original +sub get_mid_txt { + my ($ctx, $cgi) = @_; + my $x = mid2blob($ctx); + $x ? [ 200, [ 'Content-Type' => 'text/plain' ], [ $$x ] ] : r404(); +} + +# /$LISTNAME/m/$MESSAGE_ID.html -> HTML content (short quotes) +sub get_mid_html { + my ($ctx, $cgi) = @_; + my $x = mid2blob($ctx); + return r404() unless $x; + + require PublicInbox::View; + my $mid_href = PublicInbox::Hval::ascii_html( + uri_escape_utf8($ctx->{mid})); + my $pfx = "../f/$mid_href.html"; + require Email::MIME; + [ 200, [ 'Content-Type' => 'text/html; charset=UTF-8' ], + [ PublicInbox::View->as_html(Email::MIME->new($$x), $pfx) ] ]; +} + +# /$LISTNAME/f/$MESSAGE_ID.html -> HTML content (fullquotes) +sub get_full_html { + my ($ctx, $cgi) = @_; + my $x = mid2blob($ctx); + return r404() unless $x; + require PublicInbox::View; + require Email::MIME; + [ 200, [ 'Content-Type' => 'text/html' ], + [ PublicInbox::View->as_html(Email::MIME->new($$x))] ]; +} + +sub self_url { + my ($cgi) = @_; + ref($cgi) eq 'CGI' ? $cgi->self_url : $cgi->uri->as_string; +} + +sub redirect_list_index { + my ($ctx, $cgi) = @_; + do_redirect(self_url($cgi) . "/"); +} + +sub redirect_mid { + my ($ctx, $cgi) = @_; + my $url = self_url($cgi); + $url =~ s!/f/!/m/!; + do_redirect($url . '.html'); +} + +sub do_redirect { + my ($url) = @_; + [ 301, + [ Location => $url, 'Content-Type' => 'text/plain' ], + [ "Redirecting to $url\n" ] + ] +} + +1; |