#!/usr/bin/perl -Tw $|++; use strict; use CGI qw(:standard escapeHTML); use HTTP::Daemon; use Net::NNTP; use URI::Find; use Mail::Internet; ## config my $PORT = 42084; # at what port my $TIMEOUT = 600; # number of quiet seconds before abort my $NNTP = "news.my-isp.comm"; # news-server ## end config my ($HOST) = $ENV{SERVER_NAME} =~ /(.*)/s; # untaint my $d = do { local($^W) = 0; new HTTP::Daemon (LocalAddr => $HOST, LocalPort => $PORT, Reuse => 1) }; my $url = $d ? $d->url : "http://$HOST:$PORT"; my $SELF_URL = self_url; # for restarting when server breaks my $ICONS = self_url(-base => 1)."/icons"; print redirect($url); exit 0 unless defined $d; # do we need to become the server? defined(my $pid = fork) or die "Cannot fork: $!"; exit 0 if $pid; # I am the parent close(STDOUT); my $nntp = Net::NNTP->new($NNTP); $nntp->reader if $nntp; ## the main loop { alarm($TIMEOUT); # (re-)set the deadman timer my $c = $d->accept or redo; # $c is a connection select $c; # default for print my $r = $c->get_request; # $r is a request unless ($r) { warn "cannot get request", $c->reason; redo; } (my $code = $r->url->epath) =~ s{^/}{}; $c->send_basic_header; $CGI::Q = new CGI $r->content; print header, start_html("read news"); unless ($nntp) { print "Sorry, the NNTP server is unavailable!", br, a({-href => $SELF_URL}, "[Start over]"); close $c; redo; } my ($group, $article, $direction, $number, $min, $max); unless (($group, $article, $direction) = $code =~ /\A([a-z0-9.]+)\/(?:(\d+)(-\w+)?)?\z/ and ($number, $min, $max) = $nntp->group($group)) { print h2("Select a group"); my $active = $nntp->active("rec.humor.*"); print ul(map li(a({-href => "/$_/"}, escapeHTML("[$_]"))), sort keys %$active); close $c; redo; } ## we have a valid group: print h2("Group ", escapeHTML($group)); $article = $max unless defined $article; # if entering group $article = $min if $article < $min; $article = $max if $article > $max; ($article) = $nntp->message =~ /^(\d+)/ if $nntp->nntpstat($article); # prepare for next/prev if ($direction) { if ($direction eq "-prev") { ($article) = $nntp->message =~ /^(\d+)/ if $nntp->last; } elsif ($direction eq "-next") { ($article) = $nntp->message =~ /^(\d+)/ if $nntp->next; } # might add other cases here or error checking } ## navigation box: print table({-border => 0, -cellspacing => 0, -cellpadding => 2}, Tr(td(" "), td(a({-href => "/"}, img({-src => "$ICONS/up.gif"}))), td(" ")), Tr(td($article > $min ? a({-href => "/$group/$article-prev"}, img({-src => "$ICONS/left.gif"})) : img({-src => "$ICONS/left.gif"})), td(" "), td($article < $max ? a({-href => "/$group/$article-next"}, img({-src => "$ICONS/right.gif"})) : img({-src => "$ICONS/right.gif"})))); ## article: print h2("Article ", escapeHTML($article)); next unless my $headbody = $nntp->article; my $mail = Mail::Internet->new($headbody); ## $mail->remove_sig; $mail->tidy_body; print pre(fix(join("", map("$_: ".($mail->head->get($_)), qw(Subject Date From)), "\n", @{$mail->body}),1)); close $c; redo; } sub fix { # HTML escape, plus find URIs if $_[1] local $_ = shift; return escapeHTML($_) unless shift; # use \001 as "shift out", "shift in", presume data doesn't have \001 find_uris($_, sub {my ($uri, $text) = @_; qq{\1\1$text\1\1} }); s/\G(.*?)(?:\001(.*?)\001)?/escapeHTML($1).(defined $2 ? $2 : "")/sgie; $_; }