lib/PublicInbox/WWW.pm

   1 # Copyright (C) 2014, Eric Wong <normalperson@yhbt.net> and all contributors
   2 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
   3 #
   4 # We focus on the lowest common denominators here:
   5 # - targeted at text-only console browsers (lynx, w3m, etc..)
   6 # - Only basic HTML, CSS only for line-wrapping <pre> text content for GUIs
   7 # - No JavaScript, graphics or icons allowed.
   8 # - Must not rely on static content
   9 # - UTF-8 is only for user-content, 7-bit US-ASCII for us
  10 package PublicInbox::WWW;
  11 use 5.008;
  12 use strict;
  13 use warnings;
  14 use PublicInbox::Config;
  15 use URI::Escape qw(uri_escape_utf8 uri_unescape);
  16 use constant SSOMA_URL => 'http://ssoma.public-inbox.org/';
  17 use constant PI_URL => 'http://public-inbox.org/';
  18 our $LISTNAME_RE = qr!\A/([\w\.\-]+)!;
  19 our $pi_config;
  20 BEGIN {
  21         $pi_config = PublicInbox::Config->new;
  22 }
  23
  24 sub run {
  25         my ($cgi, $method) = @_;
  26         my %ctx;
  27         if ($method !~ /\AGET|HEAD\z/) {
  28                 return r(405, 'Method Not Allowed');
  29         }
  30         my $path_info = $cgi->path_info;
  31
  32         # top-level indices and feeds
  33         if ($path_info eq '/') {
  34                 r404();
  35         } elsif ($path_info =~ m!$LISTNAME_RE\z!o) {
  36                 invalid_list(\%ctx, $1) || redirect_list_index(\%ctx, $cgi);
  37         } elsif ($path_info =~ m!$LISTNAME_RE(?:/|/index\.html)?\z!o) {
  38                 invalid_list(\%ctx, $1) || get_index(\%ctx, $cgi);
  39         } elsif ($path_info =~ m!$LISTNAME_RE/atom\.xml\z!o) {
  40                 invalid_list(\%ctx, $1) || get_atom(\%ctx, $cgi);
  41
  42         # single-message pages
  43         } elsif ($path_info =~ m!$LISTNAME_RE/m/(\S+)\.txt\z!o) {
  44                 invalid_list_mid(\%ctx, $1, $2) || get_mid_txt(\%ctx, $cgi);
  45         } elsif ($path_info =~ m!$LISTNAME_RE/m/(\S+)\.html\z!o) {
  46                 invalid_list_mid(\%ctx, $1, $2) || get_mid_html(\%ctx, $cgi);
  47
  48         # full-message page
  49         } elsif ($path_info =~ m!$LISTNAME_RE/f/(\S+)\.html\z!o) {
  50                 invalid_list_mid(\%ctx, $1, $2) || get_full_html(\%ctx, $cgi);
  51
  52         # thread display
  53         } elsif ($path_info =~ m!$LISTNAME_RE/t/(\S+)\.html\z!o) {
  54                 invalid_list_mid(\%ctx, $1, $2) || get_thread(\%ctx, $cgi);
  55
  56         # subject_path display
  57         } elsif ($path_info =~ m!$LISTNAME_RE/s/(\S+)\.html\z!o) {
  58                 my $sp = $2;
  59                 invalid_list(\%ctx, $1) || get_subject_path(\%ctx, $cgi, $sp);
  60
  61         } elsif ($path_info =~ m!$LISTNAME_RE/f/\S+\.txt\z!o) {
  62                 invalid_list_mid(\%ctx, $1, $2) ||
  63                         redirect_mid_txt(\%ctx, $cgi);
  64
  65         # convenience redirects, order matters
  66         } elsif ($path_info =~ m!$LISTNAME_RE/(m|f|t|s)/(\S+)\z!o) {
  67                 my $pfx = $2;
  68                 invalid_list_mid(\%ctx, $1, $3) ||
  69                         redirect_mid(\%ctx, $cgi, $2);
  70
  71         } else {
  72                 r404();
  73         }
  74 }
  75
  76 # for CoW-friendliness, MOOOOO!
  77 sub preload {
  78         require PublicInbox::Feed;
  79         require PublicInbox::View;
  80         require PublicInbox::Thread;
  81         require Email::MIME;
  82         require Digest::SHA;
  83         require POSIX;
  84         require XML::Atom::SimpleFeed;
  85 }
  86
  87 # private functions below
  88
  89 sub r404 { r(404, 'Not Found') }
  90
  91 # simple response for errors
  92 sub r { [ $_[0], ['Content-Type' => 'text/plain'], [ join(' ', @_, "\n") ] ] }
  93
  94 # returns undef if valid, array ref response if invalid
  95 sub invalid_list {
  96         my ($ctx, $listname) = @_;
  97         my $git_dir = $pi_config->get($listname, "mainrepo");
  98         if (defined $git_dir) {
  99                 $ctx->{git_dir} = $git_dir;
 100                 $ctx->{listname} = $listname;
 101                 return;
 102         }
 103         r404();
 104 }
 105
 106 # returns undef if valid, array ref response if invalid
 107 sub invalid_list_mid {
 108         my ($ctx, $listname, $mid) = @_;
 109         my $ret = invalid_list($ctx, $listname, $mid);
 110         $ctx->{mid} = uri_unescape($mid) unless $ret;
 111         $ret;
 112 }
 113
 114 # /$LISTNAME/atom.xml                       -> Atom feed, includes replies
 115 sub get_atom {
 116         my ($ctx, $cgi) = @_;
 117         require PublicInbox::Feed;
 118         $ctx->{pi_config} = $pi_config;
 119         $ctx->{cgi} = $cgi;
 120         [ 200, [ 'Content-Type' => 'application/xml' ],
 121           [ PublicInbox::Feed->generate($ctx) ] ]
 122 }
 123
 124 # /$LISTNAME/?r=$GIT_COMMIT                 -> HTML only
 125 sub get_index {
 126         my ($ctx, $cgi) = @_;
 127         require PublicInbox::Feed;
 128         my $srch = searcher($ctx);
 129         $ctx->{pi_config} = $pi_config;
 130         $ctx->{cgi} = $cgi;
 131         footer($ctx);
 132         [ 200, [ 'Content-Type' => 'text/html; charset=UTF-8' ],
 133           [ PublicInbox::Feed->generate_html_index($ctx) ] ]
 134 }
 135
 136 # just returns a string ref for the blob in the current ctx
 137 sub mid2blob {
 138         my ($ctx) = @_;
 139         require PublicInbox::MID;
 140         my $path = PublicInbox::MID::mid2path($ctx->{mid});
 141         my @cmd = ('git', "--git-dir=$ctx->{git_dir}",
 142                         qw(cat-file blob), "HEAD:$path");
 143         my $cmd = join(' ', @cmd);
 144         my $pid = open my $fh, '-|';
 145         defined $pid or die "fork failed: $!\n";
 146         if ($pid == 0) {
 147                 open STDERR, '>', '/dev/null'; # ignore errors
 148                 exec @cmd or die "exec failed: $!\n";
 149         } else {
 150                 my $blob = eval { local $/; <$fh> };
 151                 close $fh;
 152                 $? == 0 ? \$blob : undef;
 153         }
 154 }
 155
 156 # /$LISTNAME/m/$MESSAGE_ID.txt                    -> raw original
 157 sub get_mid_txt {
 158         my ($ctx, $cgi) = @_;
 159         my $x = mid2blob($ctx);
 160         $x ? [ 200, [ 'Content-Type' => 'text/plain' ], [ $$x ] ] : r404();
 161 }
 162
 163 # /$LISTNAME/m/$MESSAGE_ID.html                   -> HTML content (short quotes)
 164 sub get_mid_html {
 165         my ($ctx, $cgi) = @_;
 166         my $x = mid2blob($ctx);
 167         return r404() unless $x;
 168
 169         require PublicInbox::View;
 170         my $pfx = msg_pfx($ctx);
 171         my $foot = footer($ctx);
 172         require Email::MIME;
 173         my $mime = Email::MIME->new($x);
 174         my $srch = searcher($ctx);
 175         [ 200, [ 'Content-Type' => 'text/html; charset=UTF-8' ],
 176           [ PublicInbox::View->msg_html($mime, $pfx, $foot, $srch) ] ];
 177 }
 178
 179 # /$LISTNAME/f/$MESSAGE_ID.html                   -> HTML content (fullquotes)
 180 sub get_full_html {
 181         my ($ctx, $cgi) = @_;
 182         my $x = mid2blob($ctx);
 183         return r404() unless $x;
 184         require PublicInbox::View;
 185         my $foot = footer($ctx);
 186         require Email::MIME;
 187         my $mime = Email::MIME->new($x);
 188         my $srch = searcher($ctx);
 189         [ 200, [ 'Content-Type' => 'text/html; charset=UTF-8' ],
 190           [ PublicInbox::View->msg_html($mime, undef, $foot, $srch)] ];
 191 }
 192
 193 # /$LISTNAME/t/$MESSAGE_ID.html
 194 sub get_thread {
 195         my ($ctx, $cgi) = @_;
 196         my $srch = searcher($ctx) or return need_search($ctx);
 197         require PublicInbox::View;
 198         my $foot = footer($ctx);
 199         my $body = PublicInbox::View->thread_html($ctx, $foot, $srch) or
 200                 return r404();
 201         [ 200, [ 'Content-Type' => 'text/html; charset=UTF-8' ],
 202           [ $body ] ];
 203 }
 204
 205 # /$LISTNAME/s/$SUBJECT_PATH.html
 206 sub get_subject_path {
 207         my ($ctx, $cgi, $sp) = @_;
 208         $ctx->{subject_path} = $sp;
 209         my $srch = searcher($ctx) or return need_search($ctx);
 210         require PublicInbox::View;
 211         my $foot = footer($ctx);
 212         my $body = PublicInbox::View->subject_path_html($ctx, $foot, $srch) or
 213                 return r404();
 214         [ 200, [ 'Content-Type' => 'text/html; charset=UTF-8' ],
 215           [ $body ] ];
 216 }
 217
 218 sub self_url {
 219         my ($cgi) = @_;
 220         ref($cgi) eq 'CGI' ? $cgi->self_url : $cgi->uri->as_string;
 221 }
 222
 223 sub redirect_list_index {
 224         my ($ctx, $cgi) = @_;
 225         do_redirect(self_url($cgi) . "/");
 226 }
 227
 228 sub redirect_mid {
 229         my ($ctx, $cgi, $pfx) = @_;
 230         my $url = self_url($cgi);
 231         my $anchor = '';
 232         if (lc($pfx) eq 't') {
 233                 $anchor = '#u'; # <u id='#u'> is used to highlight in View.pm
 234         }
 235         do_redirect($url . ".html$anchor");
 236 }
 237
 238 # only hit when somebody tries to guess URLs manually:
 239 sub redirect_mid_txt {
 240         my ($ctx, $cgi, $pfx) = @_;
 241         my $listname = $ctx->{listname};
 242         my $url = self_url($cgi);
 243         $url =~ s!/$listname/f/(\S+\.txt)\z!/$listname/m/$1!;
 244         do_redirect($url);
 245 }
 246
 247 sub do_redirect {
 248         my ($url) = @_;
 249         [ 301,
 250           [ Location => $url, 'Content-Type' => 'text/plain' ],
 251           [ "Redirecting to $url\n" ]
 252         ]
 253 }
 254
 255 sub ctx_get {
 256         my ($ctx, $key) = @_;
 257         my $val = $ctx->{$key};
 258         (defined $val && length $val) or die "BUG: bad ctx, $key unusable\n";
 259         $val;
 260 }
 261
 262 sub try_cat {
 263         my ($path) = @_;
 264         my $rv;
 265         if (open(my $fh, '<', $path)) {
 266                 local $/;
 267                 $rv = <$fh>;
 268                 close $fh;
 269         }
 270         $rv;
 271 }
 272
 273 sub footer {
 274         my ($ctx) = @_;
 275         return '' unless $ctx;
 276         my $git_dir = ctx_get($ctx, 'git_dir');
 277
 278         # favor user-supplied footer
 279         my $footer = try_cat("$git_dir/public-inbox/footer.html");
 280         if (defined $footer) {
 281                 chomp $footer;
 282                 $ctx->{footer} = $footer;
 283                 return $footer;
 284         }
 285
 286         # auto-generate a footer
 287         my $listname = ctx_get($ctx, 'listname');
 288         my $desc = try_cat("$git_dir/description");
 289         $desc = '$GIT_DIR/description missing' unless defined $desc;
 290         chomp $desc;
 291
 292         my $urls = try_cat("$git_dir/cloneurl");
 293         my @urls = split(/\r?\n/, $urls || '');
 294         my $nurls = scalar @urls;
 295         if ($nurls == 0) {
 296                 $urls = '($GIT_DIR/cloneurl missing)';
 297         } elsif ($nurls == 1) {
 298                 $urls = "git URL for <a\nhref=\"" . SSOMA_URL .
 299                         '">ssoma</a>: ' . $urls[0];
 300         } else {
 301                 $urls = "git URLs for <a\nhref=\"" . SSOMA_URL .
 302                         "\">ssoma</a>:\n" . join("\n", map { "\t$_" } @urls);
 303         }
 304
 305         my $addr = $pi_config->get($listname, 'address');
 306         if (ref($addr) eq 'ARRAY') {
 307                 $addr = $addr->[0]; # first address is primary
 308         }
 309
 310         $addr = "<a\nhref=\"mailto:$addr\">$addr</a>";
 311         $desc =  $desc;
 312
 313         $ctx->{footer} = join("\n",
 314                 '- ' . $desc,
 315                 "A <a\nhref=\"" . PI_URL .  '">public-inbox</a>, ' .
 316                         'anybody may post in plain-text (not HTML):',
 317                 $addr,
 318                 $urls
 319         );
 320 }
 321
 322 # search support is optional, returns undef if Xapian is not installed
 323 # or not configured for the given GIT_DIR
 324 sub searcher {
 325         my ($ctx) = @_;
 326         eval {
 327                 require PublicInbox::Search;
 328                 $ctx->{srch} = PublicInbox::Search->new($ctx->{git_dir});
 329         };
 330 }
 331
 332 sub need_search {
 333         my ($ctx) = @_;
 334         my $msg = <<EOF;
 335 <html><head><title>Search not available for this
 336 public-inbox</title><body><pre>Search is not available for this public-inbox
 337 <a href="../">Return to index</a></pre></body></html>
 338 EOF
 339         [ 501, [ 'Content-Type' => 'text/html; charset=UTF-8' ], [ $msg ] ];
 340 }
 341
 342 sub msg_pfx {
 343         my ($ctx) = @_;
 344         my $href = PublicInbox::Hval::ascii_html(uri_escape_utf8($ctx->{mid}));
 345         "../f/$href.html";
 346 }
 347
 348 1;