App-news
view release on metacpan or search on metacpan
script/news view on Meta::CPAN
NNTPSERVER=cosmic.voyage news daemon
The remote news server but only the C<campaignwiki.*> groups, with the pattern
in quotes to prevent shell expansion:
NNTPSERVER=campaignwiki.org "NEWS_GROUPS=campaignwiki.*" news daemon
The remote news server with all the groups except any C<*.test> groups, with the
pattern in quotes to prevent shell expansion. The C<sn> server can't parse this
pattern, unfortunately.
NNTPSERVER=campaignwiki.org "NEWS_GROUPS=*,!*.test" news daemon
The local news server requires no authorisation.
NNTPSERVER=localhost NEWS_MODE=NOAUTH news daemon
The news server requires authorisation and we want to point visitors to a first
post. We assume that NNTPSERVER or NEWSHOST is already set.
NEWS_INTRO_ID='<u4d0i0$n72d$1@sibirocobombus.campaignwiki>' news daemon
As a developer, run it under C<morbo> so that we can make changes to the script.
Provide the path to the script. This time with regular authorisation.
PERL5LIB=lib NNTPSERVER=localhost morbo script/news
=head1 SEE ALSO
The Tildeverse also runs news. L<https://news.tildeverse.org/>
L<RFC 3977|https://www.rfc-editor.org/rfc/rfc3977>: Network News Transfer
Protocol (NNTP).
L<RFC 3987|https://www.rfc-editor.org/rfc/rfc3987>: Internationalized Resource
Identifiers (IRIs)
L<RFC 4643|https://www.rfc-editor.org/rfc/rfc4643>: Network News Transfer
Protocol (NNTP) Extension for Authentication.
L<RFC 5536|https://www.rfc-editor.org/rfc/rfc5536>: Netnews Article Format.
L<RFC 5537|https://www.rfc-editor.org/rfc/rfc5537>: Netnews Architecture and
Protocols.
L<RFC 8315|https://www.rfc-editor.org/rfc/rfc8315>: Cancel-Locks in Netnews
Articles
=head1 LICENSE
GNU Affero General Public License
=cut
# corelist
use Net::NNTP;
use Encode qw(encode decode);
# not core
use Mojolicious::Lite; # Mojolicious
use Mojo::Cache;
use DateTime::Format::Mail;
use List::Util qw(first);
use utf8;
# our own
use App::news qw(wrap html_unwrap ranges);
my $cache = Mojo::Cache->new;
get '/' => sub {
shift->redirect_to('index');
};
under 'news';
get '/' => sub {
my $c = shift;
my $list = cached("active " . ($ENV{NEWS_GROUPS} || "*"), sub {
my $nntp = Net::NNTP->new() or return 'error';
my $value = $nntp->active($ENV{NEWS_GROUPS} || "*");
$nntp->quit;
return $value });
return $c->render(template => 'noserver') if $list eq 'error';
$c->render(template => 'index', list => $list,
id => $ENV{NEWS_INTRO_ID},
address => $c->tx->req->url->to_abs->host);
} => 'index';
sub cached {
my ($key, $sub) = @_;
my $cached = $cache->get($key);
my $value;
if (defined $cached) {
my ($ts, $data) = @$cached;
my $age = time - $ts;
app->log->debug("Cache age of $key: ${age}s");
$value = $data if $age <= 5 * 60; # cached for five minutes
}
if (not defined $value) {
app->log->debug("Getting a fresh copy of $key");
$value = $sub->();
$cache->set($key => [time, $value]);
}
return $value;
}
my $per_page = 50;
my $per_search = 500;
get '/group/#group' => sub {
my $c = shift;
my $group = $c->param('group');
my $edit = $c->param('edit');
my $page = $c->param('page') || "";
my $nntp; # only created on demand
my $description = cached("$group description", sub {
$nntp ||= Net::NNTP->new() or return 'error';
my $newsgroups = $nntp->newsgroups($group);
return $newsgroups && $newsgroups->{$group} || "" });
return $c->render(template => 'noserver') if 'error' eq $description;
my $data = cached("$group list $page", sub {
$nntp ||= Net::NNTP->new() or return 'error';
my ($nums, $first, $last) = $nntp->group($group) or return [];
my $last_page = int($last / $per_page) + 1;
$page ||= $last_page;
my $to = $page * $per_page;
$to = $last if $to > $last;
my $from = ($page - 1) * $per_page;
$from = $first if $from < $first;
my $fmt = $nntp->overview_fmt;
app->log->debug("Getting $group $from-$to");
my $messages = $nntp->xover("$from-$to");
my $articles = [];
my $parser = DateTime::Format::Mail->new->loose;
for my $num (sort { $b <=> $a } keys %$messages) {
my ($subject, $from, $date, $id, $references) = @{$messages->{$num}};
$subject = decode("MIME-Header", $subject) || "?";
my ($tag) = $subject =~ /\[(.*?)\]/;
$from = no_email(decode("MIME-Header", $from));
my $dt = $parser->parse_datetime($date);
my $url = $c->url_for('article', group => $group, id => $num);
$url = $url->query(edit => $edit) if $edit;
push(@$articles, {
id => $id,
num => $num,
tag => $tag,
url => $url,
from => $from,
subject => $subject,
date => [$dt->ymd, sprintf("%02d:%02d", $dt->hour, $dt->minute)],
references => [split(/\s+/, decode("MIME-Header", $references))],
replies => [] })
};
# link replies based on references but only the articles on the same pages (!)
for my $article (@$articles) {
for my $reference (@{$article->{references}}) {
my $original = first { $reference eq $_->{id} } @$articles;
next unless $original;
push(@{$original->{replies}}, $article->{id});
app->log->debug("$article->{id} is a reply to $original->{id}");
}
}
return {
articles => $articles,
pagination => {page => $page, last_page => $last_page}}});
return $c->render(template => 'noserver') if 'error' eq $data;
$nntp->quit if $nntp;
$c->render(template => 'group', group => $group, edit => $edit, description => $description,
list => $data->{articles}, pagination => $data->{pagination});
} => 'group';
sub no_email {
my $from = shift;
$from =~ s/\s*<.*>//;
$from =~ s/\s*"\S+@\S+"//;
$from =~ s/\S+@\S+\s+\((.*?)\)/$1/;
return $from || "Anonymous";
}
get '/tag/#group/#tag' => sub {
my $c = shift;
my $group = $c->param('group');
my $edit = $c->param('edit');
my $tag = $c->param('tag');
# We start counting in the back… This is different from the /group list.
# There, we take the first and last message numbers and compute page numbers
# based on that. Starting at the front makes this stable. The same articles
# stay on the same pages. Given first and last article numbers and a search
# pattern, we can't do this. Therefore, we start at the present and scan into
# the past until we have the page we want.
my $page = $c->param('page') // 0;
my $include = $c->param('include') // 0;
my $nntp; # only created on demand
my $data = cached("$group tag $tag", sub {
$nntp ||= Net::NNTP->new() or return 'error';
my ($nums, $first, $last) = $nntp->group($group) or return [];
app->log->debug("$group has $first-$last");
my $seen = 0; # set when we have seen $include
my $to = $last;
my $from = $to - $per_search;
$from = $first if $from < $first;
my $pattern = "*\\[$tag\\]*";
$pattern =~ s/ /?/g;
my $result = $nntp->xpat("Subject", $pattern, [$from, $to]);
my @nums = sort keys %$result;
app->log->debug("Searching pattern $pattern $from-$to found " . scalar(@nums) . " articles");
$seen = grep { $_ == $include } @nums if $include;
# keep checking more, if necessary
while (($page and @nums / $per_page < $page
or $include and not $seen)
and $from > $first) {
$to -= $per_search;
$from -= $per_search;
$from = $first if $from < $first;
$result = $nntp->xpat("Subject", $pattern, [$from, $to]);
app->log->debug("Searching pattern $pattern $from-$to found " . scalar(@nums) . " articles");
$seen = grep { $_ == $include } keys %$result if $include;
unshift(@nums, sort keys %$result);
}
# add pagination
if ($page) {
@nums = @nums[(-$page-1) * $per_page + 1, -$page * $per_page];
} elsif ($include) {
my @page;
while (@nums > $per_page and not grep { $_ == $include } @page) {
@page = splice(@nums, -$per_page);
$page++;
}
@nums = @page if @page;
}
my $ranges = ranges(@nums);
my $fmt = $nntp->overview_fmt;
my $re = quotemeta($tag);
my $articles = [];
my $parser = DateTime::Format::Mail->new->loose;
for my $range (@$ranges) {
app->log->debug("Getting $group " . (ref $range ? join("-", @$range) : $range));
my $messages = $nntp->xover($range);
app->log->debug("Received " . scalar(keys %$messages) . " messages");
for my $num (sort keys %$messages) {
my ($subject, $from, $date, $id, $references) = @{$messages->{$num}};
$subject = decode("MIME-Header", $subject) || "?";
$subject =~ s/\[$re\]\s*//;
$from = no_email(decode("MIME-Header", $from));
my $dt = $parser->parse_datetime($date);
my $url = $c->url_for('article', group => $group, id => $num);
$url = $url->query(edit => $edit) if $edit;
push(@$articles, {
id => $id,
num => $num,
url => $url,
from => $from,
subject => $subject,
date => [$dt->ymd, sprintf("%02d:%02d", $dt->hour, $dt->minute)],
references => [split(/\s+/, decode("MIME-Header", $references))],
replies => [] });
}
}
# link replies based on references but only the articles on the same page (!)
for my $article (@$articles) {
for my $reference (@{$article->{references}}) {
my $original = first { $reference eq $_->{id} } @$articles;
next unless $original;
push(@{$original->{replies}}, $article->{id});
app->log->debug("$article->{id} is a reply to $original->{id}");
}
}
# reverse the list of articles, latest ones come first
return [reverse @$articles]});
return $c->render(template => 'noserver') if 'error' eq $data;
$nntp->quit if $nntp;
# If the cached data did not include our article, delete the cache and retry.
# This could be optimized to extend the existing data…
if ($include and (@$data == 0 or $include < $data->[$#$data]->{num})) {
my $seen = grep { $_->{num} == $include } @$data;
if (not $seen) {
app->log->debug("$include was not seen in the cached data");
$cache->set("$group tag $tag" => undef);
return $c->redirect_to('tag');
}
}
$c->render(template => 'tag', group => $group, tag => $tag, edit => $edit, list => $data);
} => 'tag';
# This only works for message-ids, not for message numbers (since they require a
# group).
get '/article/#id' => sub {
my $c = shift;
show_article($c, $c->param('id'));
} => 'article_id';
get '/article/#group/#id' => sub {
my $c = shift;
show_article($c, $c->param('id'), $c->param('group'));
} => 'article';
sub show_article {
# When following a link from the group, $id_or_num is a num and $group is
# important. When following a reference from an article, $id_or_num is a
# message-id and $group is only used for the reply form.
my ($c, $id_or_num, $group) = @_;
my $article = cached("$group article $id_or_num", sub {
my $nntp = Net::NNTP->new() or return 'noserver';
$nntp->group($group) if $group;
my $article = $nntp->article($id_or_num);
return 'unknown' unless $article;
# app->log->trace(join("", @$article));
# $article is header lines, an empty line, and body lines
my $headers = Mojo::Headers->new;
while ($_ = shift(@$article)) {
$headers->parse("$_\r\n");
last unless /\S/;
}
my $id = $headers->header("message-id");
my $subject = decode("MIME-Header", $headers->header("subject")) || "?";
my $from = no_email(decode("MIME-Header", $headers->header("from")));
my $date = $headers->header("date");
my $dt = DateTime::Format::Mail->new->loose->parse_datetime($date);
$date = [$dt->ymd, sprintf("%02d:%02d", $dt->hour, $dt->minute)];
my $newsgroups = [split(/\s*,\s*/, decode("MIME-Header", $headers->header("newsgroups")) || "")];
$group ||= "@$newsgroups";
my $references = [split(/\s+/, decode("MIME-Header", $headers->header("references")) || "")];
my $body = join("", @$article);
$body =~ s/\s*<\S*?@\S*?>//g; # remove email addresses
$body =~ s/\s*"\S*?@\S*?"//g; # remove email addresses
if ($headers->header('content-type')) {
my ($charset) = $headers->header('content-type') =~ /charset=['"]?([^;'"]*)/;
$body = decode($charset, $body) if $charset;
}
my $value = {
id => $id,
group => $group,
from => $from,
subject => $subject,
date => $date,
newsgroups => $newsgroups,
references => $references,
html_body => html_unwrap($body),
body => $body,
};
# perhaps we have cached replies from looking at the group (space and no page number at the end)
my $cached_group = cached("$group list ", sub {}) || {};
my $cached_article = (first { $_->{id} eq $id } @{$cached_group->{articles}}) || {};
$value->{replies} = $cached_article->{replies} || [];
app->log->debug("$id replies: @{$value->{replies}}");
$nntp->quit;
# If $id_or_num was a number, add a second key to the cache in case we need
# the same article but following a reference.
$cache->set("$group article $id" => [time, $value]) if $id_or_num ne $id;
return $value });
return $c->render(template => $article) unless ref $article;
$c->render(template => 'article', article => $article, edit => $c->param('edit'));
}
get '/post/#group' => sub {
my $c = shift;
# copy from the cookie
$c->param($_ => $c->session->{$_}) for qw(name username password);
$c->render(template => 'post',
id => '',
subject => '',
supersedes => '',
references => '');
} => 'new';
post '/reply' => sub {
my $c = shift;
# copy from the cookie
$c->param($_ => $c->session->{$_}) for qw(name username password);
$c->render(template => 'post',
id => $c->param('id'),
group => $c->param('group'),
subject => $c->param('subject'),
supersedes => '',
references => $c->param('references'));
} => 'reply';
post '/supersede' => sub {
script/news view on Meta::CPAN
$c->session(expiration => time + 7 * 24 * 60 * 60); # one week
my $username = $c->param('username');
return $c->error("No username") unless $username or $ENV{NEWS_MODE} and $ENV{NEWS_MODE} eq "NOAUTH";
$c->session(username => $username);
my $password = $c->param('password');
return $c->error("No password") unless $password or $ENV{NEWS_MODE} and $ENV{NEWS_MODE}eq "NOAUTH";
$c->session(password => $password);
my $name = $c->param('name');
return $c->error("No from address specified") unless $name;
$name =~ s/[^[:graph:] ]//g;
return $c->error("From address does not have the format 'Your Name <mail\@example.org>'") unless $name =~ /<\S+@\S+\.\S+>/;
$c->session(name => $name);
my $group = $c->param('group');
return $c->error("No group") unless $group;
$group =~ s/[^[:graph:]]//g;
return $c->error("No group") unless $group;
my $references = $c->param('references');
my $supersedes = $c->param('supersedes');
my $subject = $c->param('subject');
return $c->error("No subject") unless $subject;
# $subject = encode("MIME-Header", $subject);
my $body = $c->param('body');
return $c->error("No body") unless $body;
$body = wrap($body) if $c->param('wrap');
my $nntp = Net::NNTP->new() or return $c->render(template => 'noserver');
$nntp->authinfo($username, $password) if $username and $password;
my $article = [];
push(@$article, "From: $name\r\n");
push(@$article, "Subject: $subject\r\n");
push(@$article, "Newsgroups: $group\r\n");
push(@$article, "References: $references\r\n") if $references;
push(@$article, "Supersedes: $supersedes\r\n") if $supersedes;
push(@$article, "MIME-Version: 1.0\r\n");
push(@$article, "Content-Type: text/plain; charset=UTF-8\r\n");
push(@$article, "Content-Transfer-Encoding: 8bit\r\n");
push(@$article, "\r\n");
push(@$article, map { "$_\r\n" } split(/\r?\n/, encode('UTF-8', $body)));
app->log->debug(join("", @$article));
my $ok = $nntp->post($article);
$cache->set("$group list " => undef) if $ok; # includes space and no page number
$nntp->quit;
$c->render('posted', group => $group, ok => $ok);
} => 'post';
get '/latest' => sub {
my $c = shift;
my $list = cached("news " . ($ENV{NEWS_GROUPS} || "*"), sub {
my $nntp = Net::NNTP->new() or return 'error';
my $since = time() - 7 * 24 * 60 * 60; # one week
my $ids = $nntp->newnews($since, $ENV{NEWS_GROUPS} || "*");
$ids = [@$ids[$#$ids - $per_page .. $#$ids]] if @$ids > $per_page;
my $articles = [];
my $parser = DateTime::Format::Mail->new->loose;
for my $id (@$ids) {
my $head = $nntp->head($id);
next unless $head;
my $headers = Mojo::Headers->new;
for my $line (@$head) {
$headers->parse("$line\r\n");
}
$headers->parse("\r\n"); # make sure it finishes correctly
my $subject = decode("MIME-Header", $headers->header("subject")) || "?";
my ($tag) = $subject =~ /\[(.*?)\]/;
my $from = no_email(decode("MIME-Header", $headers->header("from")));
my $date = $headers->header("date");
app->log->debug("$from/$subject/$date") unless $date;
my $dt = $parser->parse_datetime($date);
$date = [$dt->ymd, sprintf("%02d:%02d", $dt->hour, $dt->minute)];
my $newsgroups = [split(/\s*,\s*/, decode("MIME-Header", $headers->header("newsgroups")) || "")];
my $group = "@$newsgroups";
my $url = $c->url_for('article', group => $group, id => $id); # $num is not available
push(@$articles, {
id => $id,
tag => $tag,
url => $url,
group => $group,
from => $from,
subject => $subject,
date => $date,
newsgroups => $newsgroups, });
};
$nntp->quit;
return $articles });
return $c->render(template => 'noserver') if $list eq 'error';
$c->render(template => 'latest', list => $list);
} => 'latest';
app->start;
__DATA__
@@ index.html.ep
% layout "default";
% title 'News';
<h1>News</h1>
<p>
This is a forum. The groups and posts it shows are from a <a
href="https://en.wikipedia.org/wiki/News_server">news server</a>. If you have a
web browser that knows how to handle news URLs, like <tt>lynx</tt>, you can
visit the news server <a href="news://<%= $address %>/">directly</a>.
<p>
% if ($id) {
<%= link_to url_for('article_id', id => $id) => begin %>Start here<% end %>.
% }
<%= link_to url_for('latest') => begin %>Latest posts<% end %>.
<table>
<tr><th class="status">Post</th><th>Group</th></tr>
% my @seen;
% for my $group (sort keys %$list) {
% my ($last, $first, $flag) = @{$list->{$group}};
% my $status = "";
( run in 0.552 second using v1.01-cache-2.11-cpan-5735350b133 )