File Coverage

script/news
Criterion Covered Total %
statement 76 78 97.4
branch 13 22 59.0
condition 11 17 64.7
subroutine 12 12 100.0
pod n/a
total 112 129 86.8


line stmt bran cond sub pod time code
1             #! /usr/bin/env perl
2             # Copyright (C) 2023 Alex Schroeder <alex@gnu.org>
3              
4             # This program is free software: you can redistribute it and/or modify it under
5             # the terms of the GNU Affero General Public License as published by the Free
6             # Software Foundation, either version 3 of the License, or (at your option) any
7             # later version.
8             #
9             # This program is distributed in the hope that it will be useful, but WITHOUT
10             # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
11             # FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
12             # details.
13             #
14             # You should have received a copy of the GNU Affero General Public License along
15             # with this program. If not, see <https://www.gnu.org/licenses/>.
16              
17             =encoding utf8
18              
19             =head1 NAME
20              
21             news - a web front-end to a local news server
22              
23             =head1 SYNOPSIS
24              
25             B<news>
26              
27             =head1 DESCRIPTION
28              
29             C<news> connects to the local news server via NNTP on port 119 and offers a
30             web interface for it.
31              
32             There are a number of views available:
33              
34             =over
35              
36             =item * the list of newsgroups available ("server view");
37              
38             =item * the list of articles available in a particular newsgroup ("group view");
39              
40             =item * a list of articles with a particular tag in a newsgroup ("tag view");
41              
42             =item * an article ("article view");
43              
44             =item * a reply;
45              
46             =item * a new post.
47              
48             =back
49              
50             When showing From fields, the value is stripped of things that look like email
51             addresses in angled brackets such as <alex@gnu.org> or in double quotes such as
52             "alex@gnu.org"; if an email address is followed by a real name in parenthesis
53             such as alex@gnu.org (Alex Schroeder), the address and the parenthesis are
54             stripped. If no full name is provided, "Anonymous" is used.
55              
56             In the article view, email addresses in angled brackets such as <alex@gnu.org>
57             or in double quotes such as "alex@gnu.org" are also stripped. Other things that
58             might look like email addresses are not stripped.
59              
60             =head2 Threading
61              
62             Technically, articles only have references back in time. In order to show links
63             to replies, the article view relies on a cache of the group view. If the group
64             view isn't in the cache, replies cannot be shown.
65              
66             =head2 Caching
67              
68             All the NNTP requests are cached for 5min. The cache relies on L<Mojo::Cache>.
69             That cache only holds 100 items by default, so on a busy server, NNTP requests
70             might get cached for less time. The cache isn't written to disk, so if you're a
71             developer, you can restart the server to empty the cache instead of waiting for
72             5min.
73              
74             =head2 Tags
75              
76             When an article's subject contains a string in square brackets C<[like this]>,
77             then this is treated as a tag. Click on the tag to see the tag view containing
78             articles with the same tag, irrespective of threading.
79              
80             =head2 Authentication
81              
82             When posting or replying, the username and password provided by the user are
83             passed along to the news server. If that allows the user to post, it works.
84              
85             =head2 Environment variables
86              
87             The news server is determined by L<Net::NNTP>: If no host is passed then two
88             environment variables are checked C<NNTPSERVER> then C<NEWSHOST>, then
89             L<Net::Config> is checked, and if a host is not found then C<news> is used.
90              
91             C<NEWS_INTRO_ID> can be set to a message id for a "start here" message. By
92             default, no such link is shown. This must be a message-id and cannot be a
93             message number (that would require a group, too).
94              
95             C<NEWS_MODE> can be set to "NOAUTH" in order to hide username and password on
96             the post form in case your newsserver isn't public and requires no
97             authorisation; if set to "NOPOST" then posting links are hidden.
98              
99             C<NEWS_GROUPS> can be set to a comma-separated list of patterns in the WILDMAT
100             format. The details are in RFC 3977. Usually it means: names separated by
101             commas, prefixed by C<!> if negated and C<*> used as a wildcard. Support for
102             this varies. The C<sn> server only accepts a single pattern, no negation. You
103             might have to experiment.
104              
105             =head2 Systemd
106              
107             To install as a service, use a C<news.service> file like the following:
108              
109             [Unit]
110             Description=News (a web front-end)
111             After=network-online.target
112             Wants=network-online.target
113             [Install]
114             WantedBy=multi-user.target
115             [Service]
116             Type=simple
117             DynamicUser=true
118             Restart=always
119             MemoryHigh=80M
120             MemoryMax=100M
121             Environment="NNTPSERVER=localhost"
122             Environment="NEWS_INTRO_ID=<u4d0i0$n72d$1@sibirocobombus.campaignwiki>"
123             ExecStart=/home/alex/perl5/perlbrew/perls/perl-5.32.0/bin/perl /home/alex/perl5/perlbrew/perls/perl-5.32.0/bin/news daemon
124              
125             =head2 Cookies
126              
127             The web app stores name, username and password in an encrypted cookie which
128             expires one week after posting an article.
129              
130             =head2 Caching
131              
132             The web app caches all the data it gets from the news server in a cache, using
133             L<Mojo::Cache>. By default, this cache is small (100 items). Each cached item is
134             cached with a timestamp and cache hits are only used if they aren't older than
135             5min.
136              
137             =head2 Superseding
138              
139             The web app allows superseding. It's up to the newsserver to allow or deny this.
140             There's currently no way for the user to supply their own cancel secret.
141              
142             =head1 EXAMPLES
143              
144             A remote news server.
145              
146             NNTPSERVER=cosmic.voyage news daemon
147              
148             The remote news server but only the C<campaignwiki.*> groups, with the pattern
149             in quotes to prevent shell expansion:
150              
151             NNTPSERVER=campaignwiki.org "NEWS_GROUPS=campaignwiki.*" news daemon
152              
153             The remote news server with all the groups except any C<*.test> groups, with the
154             pattern in quotes to prevent shell expansion. The C<sn> server can't parse this
155             pattern, unfortunately.
156              
157             NNTPSERVER=campaignwiki.org "NEWS_GROUPS=*,!*.test" news daemon
158              
159             The local news server requires no authorisation.
160              
161             NNTPSERVER=localhost NEWS_MODE=NOAUTH news daemon
162              
163             The news server requires authorisation and we want to point visitors to a first
164             post. We assume that NNTPSERVER or NEWSHOST is already set.
165              
166             NEWS_INTRO_ID='<u4d0i0$n72d$1@sibirocobombus.campaignwiki>' news daemon
167              
168             As a developer, run it under C<morbo> so that we can make changes to the script.
169             Provide the path to the script. This time with regular authorisation.
170              
171             PERL5LIB=lib NNTPSERVER=localhost morbo script/news
172              
173             =head1 SEE ALSO
174              
175             The Tildeverse also runs news. L<https://news.tildeverse.org/>
176              
177             L<RFC 3977|https://www.rfc-editor.org/rfc/rfc3977>: Network News Transfer
178             Protocol (NNTP).
179              
180             L<RFC 3987|https://www.rfc-editor.org/rfc/rfc3987>: Internationalized Resource
181             Identifiers (IRIs)
182              
183             L<RFC 4643|https://www.rfc-editor.org/rfc/rfc4643>: Network News Transfer
184             Protocol (NNTP) Extension for Authentication.
185              
186             L<RFC 5536|https://www.rfc-editor.org/rfc/rfc5536>: Netnews Article Format.
187              
188             L<RFC 5537|https://www.rfc-editor.org/rfc/rfc5537>: Netnews Architecture and
189             Protocols.
190              
191             L<RFC 8315|https://www.rfc-editor.org/rfc/rfc8315>: Cancel-Locks in Netnews
192             Articles
193              
194             =head1 LICENSE
195              
196             GNU Affero General Public License
197              
198             =cut
199              
200             # corelist
201 5     5   10795877 use Net::NNTP;
  5         174661  
  5         682  
202 5     5   407 use Encode qw(encode decode);
  5         99  
  5         820  
203             # not core
204 5     5   3535 use Mojolicious::Lite; # Mojolicious
  5         668439  
  5         57  
205 5     5   246400 use Mojo::Cache;
  5         61  
  5         46  
206 5     5   3632 use DateTime::Format::Mail;
  5         3504759  
  5         354  
207 5     5   76 use List::Util qw(first);
  5         13  
  5         571  
208 5     5   40 use utf8;
  5         15  
  5         48  
209             # our own
210 5     5   3836 use App::news qw(wrap html_unwrap ranges);
  5         18  
  5         39613  
211              
212             my $cache = Mojo::Cache->new;
213              
214             get '/' => sub {
215             shift->redirect_to('index');
216             };
217              
218             under 'news';
219              
220             get '/' => sub {
221             my $c = shift;
222             my $list = cached("active " . ($ENV{NEWS_GROUPS} || "*"), sub {
223             my $nntp = Net::NNTP->new() or return 'error';
224             my $value = $nntp->active($ENV{NEWS_GROUPS} || "*");
225             $nntp->quit;
226             return $value });
227             return $c->render(template => 'noserver') if $list eq 'error';
228             $c->render(template => 'index', list => $list,
229             id => $ENV{NEWS_INTRO_ID},
230             address => $c->tx->req->url->to_abs->host);
231             } => 'index';
232              
233             sub cached {
234 11     11   42 my ($key, $sub) = @_;
235 11         62 my $cached = $cache->get($key);
236 11         74 my $value;
237 11 100       50 if (defined $cached) {
238 1         4 my ($ts, $data) = @$cached;
239 1         4 my $age = time - $ts;
240 1         7 app->log->debug("Cache age of $key: ${age}s");
241 1 50       33 $value = $data if $age <= 5 * 60; # cached for five minutes
242             }
243 11 100       49 if (not defined $value) {
244 10         76 app->log->debug("Getting a fresh copy of $key");
245 10         277 $value = $sub->();
246 10         195 $cache->set($key => [time, $value]);
247             }
248 11         336 return $value;
249             }
250              
251             my $per_page = 50;
252             my $per_search = 500;
253              
254             get '/group/#group' => sub {
255             my $c = shift;
256             my $group = $c->param('group');
257             my $edit = $c->param('edit');
258             my $page = $c->param('page') || "";
259             my $nntp; # only created on demand
260             my $description = cached("$group description", sub {
261             $nntp ||= Net::NNTP->new() or return 'error';
262             my $newsgroups = $nntp->newsgroups($group);
263             return $newsgroups && $newsgroups->{$group} || "" });
264             return $c->render(template => 'noserver') if 'error' eq $description;
265             my $data = cached("$group list $page", sub {
266             $nntp ||= Net::NNTP->new() or return 'error';
267             my ($nums, $first, $last) = $nntp->group($group) or return [];
268             my $last_page = int($last / $per_page) + 1;
269             $page ||= $last_page;
270             my $to = $page * $per_page;
271             $to = $last if $to > $last;
272             my $from = ($page - 1) * $per_page;
273             $from = $first if $from < $first;
274             my $fmt = $nntp->overview_fmt;
275             app->log->debug("Getting $group $from-$to");
276             my $messages = $nntp->xover("$from-$to");
277             my $articles = [];
278             my $parser = DateTime::Format::Mail->new->loose;
279             for my $num (sort { $b <=> $a } keys %$messages) {
280             my ($subject, $from, $date, $id, $references) = @{$messages->{$num}};
281             $subject = decode("MIME-Header", $subject) || "?";
282             my ($tag) = $subject =~ /\[(.*?)\]/;
283             $from = no_email(decode("MIME-Header", $from));
284             my $dt = $parser->parse_datetime($date);
285             my $url = $c->url_for('article', group => $group, id => $num);
286             $url = $url->query(edit => $edit) if $edit;
287             push(@$articles, {
288             id => $id,
289             num => $num,
290             tag => $tag,
291             url => $url,
292             from => $from,
293             subject => $subject,
294             date => [$dt->ymd, sprintf("%02d:%02d", $dt->hour, $dt->minute)],
295             references => [split(/\s+/, decode("MIME-Header", $references))],
296             replies => [] })
297             };
298             # link replies based on references but only the articles on the same pages (!)
299             for my $article (@$articles) {
300             for my $reference (@{$article->{references}}) {
301             my $original = first { $reference eq $_->{id} } @$articles;
302             next unless $original;
303             push(@{$original->{replies}}, $article->{id});
304             app->log->debug("$article->{id} is a reply to $original->{id}");
305             }
306             }
307             return {
308             articles => $articles,
309             pagination => {page => $page, last_page => $last_page}}});
310             return $c->render(template => 'noserver') if 'error' eq $data;
311             $nntp->quit if $nntp;
312             $c->render(template => 'group', group => $group, edit => $edit, description => $description,
313             list => $data->{articles}, pagination => $data->{pagination});
314             } => 'group';
315              
316             sub no_email {
317 11     11   1141 my $from = shift;
318 11         87 $from =~ s/\s*<.*>//;
319 11         31 $from =~ s/\s*"\S+@\S+"//;
320 11         24 $from =~ s/\S+@\S+\s+\((.*?)\)/$1/;
321 11   50     51 return $from || "Anonymous";
322             }
323              
324             get '/tag/#group/#tag' => sub {
325             my $c = shift;
326             my $group = $c->param('group');
327             my $edit = $c->param('edit');
328             my $tag = $c->param('tag');
329             # We start counting in the back… This is different from the /group list.
330             # There, we take the first and last message numbers and compute page numbers
331             # based on that. Starting at the front makes this stable. The same articles
332             # stay on the same pages. Given first and last article numbers and a search
333             # pattern, we can't do this. Therefore, we start at the present and scan into
334             # the past until we have the page we want.
335             my $page = $c->param('page') // 0;
336             my $include = $c->param('include') // 0;
337             my $nntp; # only created on demand
338             my $data = cached("$group tag $tag", sub {
339             $nntp ||= Net::NNTP->new() or return 'error';
340             my ($nums, $first, $last) = $nntp->group($group) or return [];
341             app->log->debug("$group has $first-$last");
342             my $seen = 0; # set when we have seen $include
343             my $to = $last;
344             my $from = $to - $per_search;
345             $from = $first if $from < $first;
346             my $pattern = "*\\[$tag\\]*";
347             $pattern =~ s/ /?/g;
348             my $result = $nntp->xpat("Subject", $pattern, [$from, $to]);
349             my @nums = sort keys %$result;
350             app->log->debug("Searching pattern $pattern $from-$to found " . scalar(@nums) . " articles");
351             $seen = grep { $_ == $include } @nums if $include;
352             # keep checking more, if necessary
353             while (($page and @nums / $per_page < $page
354             or $include and not $seen)
355             and $from > $first) {
356             $to -= $per_search;
357             $from -= $per_search;
358             $from = $first if $from < $first;
359             $result = $nntp->xpat("Subject", $pattern, [$from, $to]);
360             app->log->debug("Searching pattern $pattern $from-$to found " . scalar(@nums) . " articles");
361             $seen = grep { $_ == $include } keys %$result if $include;
362             unshift(@nums, sort keys %$result);
363             }
364             # add pagination
365             if ($page) {
366             @nums = @nums[(-$page-1) * $per_page + 1, -$page * $per_page];
367             } elsif ($include) {
368             my @page;
369             while (@nums > $per_page and not grep { $_ == $include } @page) {
370             @page = splice(@nums, -$per_page);
371             $page++;
372             }
373             @nums = @page if @page;
374             }
375             my $ranges = ranges(@nums);
376             my $fmt = $nntp->overview_fmt;
377             my $re = quotemeta($tag);
378             my $articles = [];
379             my $parser = DateTime::Format::Mail->new->loose;
380             for my $range (@$ranges) {
381             app->log->debug("Getting $group " . (ref $range ? join("-", @$range) : $range));
382             my $messages = $nntp->xover($range);
383             app->log->debug("Received " . scalar(keys %$messages) . " messages");
384             for my $num (sort keys %$messages) {
385             my ($subject, $from, $date, $id, $references) = @{$messages->{$num}};
386             $subject = decode("MIME-Header", $subject) || "?";
387             $subject =~ s/\[$re\]\s*//;
388             $from = no_email(decode("MIME-Header", $from));
389             my $dt = $parser->parse_datetime($date);
390             my $url = $c->url_for('article', group => $group, id => $num);
391             $url = $url->query(edit => $edit) if $edit;
392             push(@$articles, {
393             id => $id,
394             num => $num,
395             url => $url,
396             from => $from,
397             subject => $subject,
398             date => [$dt->ymd, sprintf("%02d:%02d", $dt->hour, $dt->minute)],
399             references => [split(/\s+/, decode("MIME-Header", $references))],
400             replies => [] });
401             }
402             }
403             # link replies based on references but only the articles on the same page (!)
404             for my $article (@$articles) {
405             for my $reference (@{$article->{references}}) {
406             my $original = first { $reference eq $_->{id} } @$articles;
407             next unless $original;
408             push(@{$original->{replies}}, $article->{id});
409             app->log->debug("$article->{id} is a reply to $original->{id}");
410             }
411             }
412             # reverse the list of articles, latest ones come first
413             return [reverse @$articles]});
414             return $c->render(template => 'noserver') if 'error' eq $data;
415             $nntp->quit if $nntp;
416             # If the cached data did not include our article, delete the cache and retry.
417             # This could be optimized to extend the existing data…
418             if ($include and (@$data == 0 or $include < $data->[$#$data]->{num})) {
419             my $seen = grep { $_->{num} == $include } @$data;
420             if (not $seen) {
421             app->log->debug("$include was not seen in the cached data");
422             $cache->set("$group tag $tag" => undef);
423             return $c->redirect_to('tag');
424             }
425             }
426             $c->render(template => 'tag', group => $group, tag => $tag, edit => $edit, list => $data);
427             } => 'tag';
428              
429             # This only works for message-ids, not for message numbers (since they require a
430             # group).
431             get '/article/#id' => sub {
432             my $c = shift;
433             show_article($c, $c->param('id'));
434             } => 'article_id';
435              
436             get '/article/#group/#id' => sub {
437             my $c = shift;
438             show_article($c, $c->param('id'), $c->param('group'));
439             } => 'article';
440              
441             sub show_article {
442             # When following a link from the group, $id_or_num is a num and $group is
443             # important. When following a reference from an article, $id_or_num is a
444             # message-id and $group is only used for the reply form.
445 2     2   157 my ($c, $id_or_num, $group) = @_;
446             my $article = cached("$group article $id_or_num", sub {
447 2 50   2   45 my $nntp = Net::NNTP->new() or return 'noserver';
448 2 50       11119 $nntp->group($group) if $group;
449 2         1833 my $article = $nntp->article($id_or_num);
450 2 50       3108 return 'unknown' unless $article;
451             # app->log->trace(join("", @$article));
452             # $article is header lines, an empty line, and body lines
453 2         30 my $headers = Mojo::Headers->new;
454 2         22 while ($_ = shift(@$article)) {
455 14         81 $headers->parse("$_\r\n");
456 14 100       1135 last unless /\S/;
457             }
458 2         13 my $id = $headers->header("message-id");
459 2   50     57 my $subject = decode("MIME-Header", $headers->header("subject")) || "?";
460 2         9755 my $from = no_email(decode("MIME-Header", $headers->header("from")));
461 2         11 my $date = $headers->header("date");
462 2         50 my $dt = DateTime::Format::Mail->new->loose->parse_datetime($date);
463 2         2874 $date = [$dt->ymd, sprintf("%02d:%02d", $dt->hour, $dt->minute)];
464 2   50     81 my $newsgroups = [split(/\s*,\s*/, decode("MIME-Header", $headers->header("newsgroups")) || "")];
465 2   33     257 $group ||= "@$newsgroups";
466 2   50     11 my $references = [split(/\s+/, decode("MIME-Header", $headers->header("references")) || "")];
467 2         83 my $body = join("", @$article);
468 2         7 $body =~ s/\s*<\S*?@\S*?>//g; # remove email addresses
469 2         7 $body =~ s/\s*"\S*?@\S*?"//g; # remove email addresses
470 2 50       8 if ($headers->header('content-type')) {
471 0         0 my ($charset) = $headers->header('content-type') =~ /charset=['"]?([^;'"]*)/;
472 0 0       0 $body = decode($charset, $body) if $charset;
473             }
474 2         47 my $value = {
475             id => $id,
476             group => $group,
477             from => $from,
478             subject => $subject,
479             date => $date,
480             newsgroups => $newsgroups,
481             references => $references,
482             html_body => html_unwrap($body),
483             body => $body,
484             };
485             # perhaps we have cached replies from looking at the group (space and no page number at the end)
486 2   100     21 my $cached_group = cached("$group list ", sub {}) || {};
487 2   100     14 my $cached_article = (first { $_->{id} eq $id } @{$cached_group->{articles}}) || {};
488 2   100     17 $value->{replies} = $cached_article->{replies} || [];
489 2         29 app->log->debug("$id replies: @{$value->{replies}}");
  2         29  
490 2         25 $nntp->quit;
491             # If $id_or_num was a number, add a second key to the cache in case we need
492             # the same article but following a reference.
493 2 50       2516 $cache->set("$group article $id" => [time, $value]) if $id_or_num ne $id;
494 2         29 return $value });
  2         110  
495 2 50       52 return $c->render(template => $article) unless ref $article;
496 2         21 $c->render(template => 'article', article => $article, edit => $c->param('edit'));
497             }
498              
499             get '/post/#group' => sub {
500             my $c = shift;
501             # copy from the cookie
502             $c->param($_ => $c->session->{$_}) for qw(name username password);
503             $c->render(template => 'post',
504             id => '',
505             subject => '',
506             supersedes => '',
507             references => '');
508             } => 'new';
509              
510             post '/reply' => sub {
511             my $c = shift;
512             # copy from the cookie
513             $c->param($_ => $c->session->{$_}) for qw(name username password);
514             $c->render(template => 'post',
515             id => $c->param('id'),
516             group => $c->param('group'),
517             subject => $c->param('subject'),
518             supersedes => '',
519             references => $c->param('references'));
520             } => 'reply';
521              
522             post '/supersede' => sub {
523             my $c = shift;
524             # copy from the cookie
525             $c->param($_ => $c->session->{$_}) for qw(name username password);
526             $c->render(template => 'post',
527             id => '',
528             body => $c->param('body'),
529             group => $c->param('group'),
530             subject => $c->param('subject'),
531             supersedes => $c->param('supersedes'),
532             references => $c->param('references'));
533             } => 'supersede';
534              
535             post '/post' => sub {
536             my $c = shift;
537             $c->session(expiration => time + 7 * 24 * 60 * 60); # one week
538             my $username = $c->param('username');
539             return $c->error("No username") unless $username or $ENV{NEWS_MODE} and $ENV{NEWS_MODE} eq "NOAUTH";
540             $c->session(username => $username);
541              
542             my $password = $c->param('password');
543             return $c->error("No password") unless $password or $ENV{NEWS_MODE} and $ENV{NEWS_MODE}eq "NOAUTH";
544             $c->session(password => $password);
545              
546             my $name = $c->param('name');
547             return $c->error("No from address specified") unless $name;
548             $name =~ s/[^[:graph:] ]//g;
549             return $c->error("From address does not have the format 'Your Name <mail\@example.org>'") unless $name =~ /<\S+@\S+\.\S+>/;
550             $c->session(name => $name);
551              
552             my $group = $c->param('group');
553             return $c->error("No group") unless $group;
554             $group =~ s/[^[:graph:]]//g;
555             return $c->error("No group") unless $group;
556              
557             my $references = $c->param('references');
558             my $supersedes = $c->param('supersedes');
559              
560             my $subject = $c->param('subject');
561             return $c->error("No subject") unless $subject;
562             # $subject = encode("MIME-Header", $subject);
563              
564             my $body = $c->param('body');
565             return $c->error("No body") unless $body;
566              
567             $body = wrap($body) if $c->param('wrap');
568              
569             my $nntp = Net::NNTP->new() or return $c->render(template => 'noserver');
570             $nntp->authinfo($username, $password) if $username and $password;
571             my $article = [];
572             push(@$article, "From: $name\r\n");
573             push(@$article, "Subject: $subject\r\n");
574             push(@$article, "Newsgroups: $group\r\n");
575             push(@$article, "References: $references\r\n") if $references;
576             push(@$article, "Supersedes: $supersedes\r\n") if $supersedes;
577             push(@$article, "MIME-Version: 1.0\r\n");
578             push(@$article, "Content-Type: text/plain; charset=UTF-8\r\n");
579             push(@$article, "Content-Transfer-Encoding: 8bit\r\n");
580             push(@$article, "\r\n");
581             push(@$article, map { "$_\r\n" } split(/\r?\n/, encode('UTF-8', $body)));
582             app->log->debug(join("", @$article));
583             my $ok = $nntp->post($article);
584             $cache->set("$group list " => undef) if $ok; # includes space and no page number
585             $nntp->quit;
586             $c->render('posted', group => $group, ok => $ok);
587             } => 'post';
588              
589             get '/latest' => sub {
590             my $c = shift;
591             my $list = cached("news " . ($ENV{NEWS_GROUPS} || "*"), sub {
592             my $nntp = Net::NNTP->new() or return 'error';
593             my $since = time() - 7 * 24 * 60 * 60; # one week
594             my $ids = $nntp->newnews($since, $ENV{NEWS_GROUPS} || "*");
595             $ids = [@$ids[$#$ids - $per_page .. $#$ids]] if @$ids > $per_page;
596             my $articles = [];
597             my $parser = DateTime::Format::Mail->new->loose;
598             for my $id (@$ids) {
599             my $head = $nntp->head($id);
600             next unless $head;
601             my $headers = Mojo::Headers->new;
602             for my $line (@$head) {
603             $headers->parse("$line\r\n");
604             }
605             $headers->parse("\r\n"); # make sure it finishes correctly
606             my $subject = decode("MIME-Header", $headers->header("subject")) || "?";
607             my ($tag) = $subject =~ /\[(.*?)\]/;
608             my $from = no_email(decode("MIME-Header", $headers->header("from")));
609             my $date = $headers->header("date");
610             app->log->debug("$from/$subject/$date") unless $date;
611             my $dt = $parser->parse_datetime($date);
612             $date = [$dt->ymd, sprintf("%02d:%02d", $dt->hour, $dt->minute)];
613             my $newsgroups = [split(/\s*,\s*/, decode("MIME-Header", $headers->header("newsgroups")) || "")];
614             my $group = "@$newsgroups";
615             my $url = $c->url_for('article', group => $group, id => $id); # $num is not available
616             push(@$articles, {
617             id => $id,
618             tag => $tag,
619             url => $url,
620             group => $group,
621             from => $from,
622             subject => $subject,
623             date => $date,
624             newsgroups => $newsgroups, });
625             };
626             $nntp->quit;
627             return $articles });
628             return $c->render(template => 'noserver') if $list eq 'error';
629             $c->render(template => 'latest', list => $list);
630             } => 'latest';
631              
632             app->start;
633              
634             __DATA__
635              
636             @@ index.html.ep
637             % layout "default";
638             % title 'News';
639             <h1>News</h1>
640             <p>
641             This is a forum. The groups and posts it shows are from a <a
642             href="https://en.wikipedia.org/wiki/News_server">news server</a>. If you have a
643             web browser that knows how to handle news URLs, like <tt>lynx</tt>, you can
644             visit the news server <a href="news://<%= $address %>/">directly</a>.
645              
646             <p>
647             % if ($id) {
648             <%= link_to url_for('article_id', id => $id) => begin %>Start here<% end %>.
649             % }
650             <%= link_to url_for('latest') => begin %>Latest posts<% end %>.
651              
652             <table>
653             <tr><th class="status">Post</th><th>Group</th></tr>
654             % my @seen;
655             % for my $group (sort keys %$list) {
656             % my ($last, $first, $flag) = @{$list->{$group}};
657             % my $status = "";
658             % my $edit = 0;
659             % if ($flag eq "y") { $status = "OK"; $edit = 1 }
660             % elsif ($flag eq "m") { $status = "Moderated"; $edit = 1 }
661             % elsif ($flag eq "n") { $status = "Remote" }
662             % elsif ($flag eq "j") { $status = "Junked" }
663             % elsif ($flag eq "x") { $status = "Archived" }
664             % else { $status = "Renamed" }
665             % push(@seen, $flag) unless grep { $_ eq $flag } @seen;
666             % if ($edit) {
667             <tr><td class="status"><%= $status %></td><td><%= link_to url_for('group', group => $group)->fragment($last) => begin %><%= $group %><% end %><br></td></tr>
668             % } else {
669             <tr><td class="status"><%= $status %></td><td><%= link_to url_for('group', group => $group)->query(edit => 'no')->fragment($last) => begin %><%= $group %><% end %><br></td></tr>
670             % }
671             % }
672             </table>
673             <p>
674             % for my $flag (@seen) {
675             % if ($flag eq "y") {
676             OK: Posting is possible and probably requires an account.
677             % } elsif ($flag eq "m") {
678             Moderated: Posts aren't published unless approved by a moderator.
679             % } elsif ($flag eq "n") {
680             Remote: Posts from a peer are shown but you cannot post.
681             % } elsif ($flag eq "j") {
682             Junked: All posts are immediately moved to the junk group.
683             % } elsif ($flag eq "x") {
684             Archived: No new posts.
685             % } else {
686             Renamed: Posts will get moved to a different group.
687             % }
688             % }
689              
690             @@ group.html.ep
691             % layout "default";
692             % title "$group";
693             <h1><%= $group %></h1>
694             % if ($description) {
695             <p><%= $description %>
696             % }
697             <p>
698             <%= link_to url_for('index') => begin %>List all groups<% end %>
699             % if ($pagination->{page} > 1) {
700             <%= link_to url_for('group', group => $group)->query(page => 1) => begin %>First<% end %>
701             % }
702             % if ($pagination->{page} > 2) {
703             <%= link_to url_for('group', group => $group)->query(page => $pagination->{page} - 1) => begin %>Older<% end %>
704             % }
705             % if ($pagination->{page} < $pagination->{last_page} - 1) {
706             <%= link_to url_for('group', group => $group)->query(page => $pagination->{page} + 1) => begin %>Newer<% end %>
707             % }
708             % if ($pagination->{page} < $pagination->{last_page}) {
709             <%= link_to url_for('group', group => $group) => begin %>Last<% end %>
710             % }
711             % unless ($ENV{NEWS_MODE} and $ENV{NEWS_MODE} eq "NOPOST" or $edit and $edit eq "no") {
712             <%= link_to url_for('new', group => $group) => begin %>Add post<% end %> (requires account)
713             % }
714             % if (@$list) {
715             <table>
716             <tr><th class="date">Date</th><th class="from">From</th><th class="subject">Subject</th></tr>
717             % my $date = "";
718             % for my $article (@$list) {
719             % if ($article->{date}->[0] ne $date) {
720             % $date = $article->{date}->[0];
721             <tr><td class="day"><%= $date %></td><td></td><td></td></tr>
722             % }
723             % if ($article->{tag}) {
724             % my $re = quotemeta($article->{tag});
725             % my @part = split(/$re/, $article->{subject}, 2);
726             <tr><td class="time"><a href="<%= $article->{url} %>"><%= $article->{date}->[1] %></a></td><td class="from"><%= $article->{from} %></td><td class="subject"><%= $part[0] %><%= link_to url_for('tag', group => $group, tag => $article->{tag})->query(include => $article->{num}) =>begin %><%= $article->{tag} %><% end %><%= $part[1] %></td></tr>
727             % } else {
728             <tr><td class="time"><a href="<%= $article->{url} %>"><%= $article->{date}->[1] %></a></td><td class="from"><%= $article->{from} %></td><td class="subject"><%= $article->{subject} %></td></tr>
729             % }
730             % }
731             </table>
732             % } else {
733             <p>This group is empty.
734             % }
735              
736             @@ tag.html.ep
737             % layout "default";
738             % title "$group: $tag";
739             <h1><%= $group %>: <%= $tag %></h1>
740             <p>
741             <%= link_to url_for('index') => begin %>List all groups<% end %>
742             <%= link_to url_for('group', group => $group) => begin %>List all posts<% end %>
743             % unless ($ENV{NEWS_MODE} and $ENV{NEWS_MODE} eq "NOPOST" or $edit and $edit eq "no") {
744             <%= link_to url_for('new', group => $group) => begin %>Add post<% end %> (requires account)
745             % }
746             % if (@$list) {
747             <table>
748             <tr><th class="date">Date</th><th class="from">From</th><th class="subject">Subject</th></tr>
749             % my $date = "";
750             % for my $article (@$list) {
751             % if ($article->{date}->[0] ne $date) {
752             % $date = $article->{date}->[0];
753             <tr><td class="day"><%= $date %></td><td></td><td></td></tr>
754             % }
755             <tr><td class="time"><a href="<%= $article->{url} %>"><%= $article->{date}->[1] %></a></td><td class="from"><%= $article->{from} %></td><td class="subject"><%= $article->{subject} %></td></tr>
756             % }
757             </table>
758             % } else {
759             <p>This group is empty.
760             % }
761              
762             @@ article.html.ep
763             % layout "default";
764             % title "$article->{subject}";
765             <h1><%= $article->{subject} %></h1>
766             <p class="headers"><span class="value from"><%= $article->{from} %></span>,
767             <span class="date"><%= "@{$article->{date}}" %></span>,
768             % for my $newsgroup (@{$article->{newsgroups}}) {
769             <%= link_to url_for('group', group => $newsgroup) => (class => "value newsgroups") => begin %><%= $newsgroup %><% end %>
770             % }
771             % if (@{$article->{references}}) {
772             % for my $id (@{$article->{references}}) {
773             <%= link_to url_for('article', id => $id) => (class => "value references") => begin %>ref<% end %>
774             % }
775             % }
776             % if (@{$article->{references}} and @{$article->{replies}}) {
777             (this post)
778             % }
779             % if (@{$article->{replies}}) {
780             % for my $id (reverse @{$article->{replies}}) {
781             <%= link_to url_for('article', id => $id) => (class => "value replies") => begin %>reply<% end %>
782             % }
783             % }
784             <pre class="body"><%== $article->{html_body} %></pre>
785             % unless ($ENV{NEWS_MODE} and $ENV{NEWS_MODE} eq "NOPOST" or $edit and $edit eq "no") {
786             % my $subject = $article->{subject};
787             % $subject = "Re: $subject" unless $subject =~ /^Re:/i;
788             % my $body = "$article->{from}, @{$article->{date}}:\n$article->{body}";
789             % $body =~ s/\s+$//mg;
790             % $body =~ s/\n(>*) */\n>$1 /g;
791             % $body .= "\n";
792             % my @references = (@{$article->{references}}, $article->{id});
793             %= form_for reply => (class => "button") => begin
794             %= hidden_field id => $article->{id}
795             %= hidden_field group => "@{$article->{newsgroups}}"
796             %= hidden_field references => "@references"
797             %= hidden_field subject => $subject
798             %= hidden_field body => $body
799             %= submit_button 'Reply'
800             %= end
801             %= form_for supersede => (class => "button") => begin
802             %= hidden_field supersedes => $article->{id}
803             %= hidden_field group => "@{$article->{newsgroups}}"
804             %= hidden_field references => "@references"
805             %= hidden_field subject => $article->{subject}
806             %= hidden_field body => $article->{body}
807             %= submit_button 'Supersede'
808             %= end
809             (Both require an account.)
810             % }
811              
812             @@ unknown.html.ep
813             % layout "default";
814             % title "Unknown Article";
815             <h1>Unknown article</h1>
816             <p>Either the message id is wrong or the article has expired on this news
817             server.
818              
819             @@ noserver.html.ep
820             % layout "default";
821             % title "No News Server";
822             <h1>No News Server</h1>
823             <p>The administrator needs to specify the news server to use.
824             <p>One way to do this is to set the environment variable <code>NNTPSERVER</code>.
825              
826             @@ post.html.ep
827             % layout 'default';
828             % title 'Post';
829             % if ($supersedes) {
830             <h1><%= $subject %></h1>
831             <p>(This article supersedes a <%= link_to url_for('article', group => $group, id => $supersedes) => begin %>another<% end %>.)
832             % } elsif ($subject) {
833             <h1><%= $subject %></h1>
834             <p>(This is a <%= link_to url_for('article', group => $group, id => $id) => begin %>reply<% end %>.)
835             % } else {
836             <h1>New article for <%= $group %></h1>
837             % }
838             %= form_for post => begin
839             %= hidden_field group => $group
840             %= hidden_field references => $references
841             %= hidden_field supersedes => $supersedes
842             % unless ($ENV{NEWS_MODE} and $ENV{NEWS_MODE} eq "NOAUTH") {
843             %= label_for username => 'Username'
844             %= text_field 'username', required => undef
845             <br>
846             %= label_for password => 'Password'
847             %= password_field 'password', required => undef
848             <br>
849             % }
850             %= label_for name => 'From'
851             %= text_field 'name', required => undef, pattern => '.*<\S+@\S+\.\S+>', title => 'Must end with an email address in angled brackets, e.g. <you@example.org>', placeholder => 'Your Name <you@example.org>'
852             <br>
853             %= label_for subject => 'Subject'
854             %= text_field 'subject', required => undef
855             <p>
856             %= label_for body => 'Article'
857             %= text_area 'body', required => undef
858             <p>
859             %= check_box wrap => 1, checked => 1, id => 'wrap'
860             %= label_for wrap => 'Wrap'
861             %= submit_button 'Post', id => 'post'
862             % end
863              
864             @@ posted.html.ep
865             % layout 'default';
866             % title 'Posted';
867             % if ($ok) {
868             <h1>Posted!</h1>
869             <p>The article was posted to <%= link_to url_for('group', group => $group) => begin %><%= $group %><% end %>.
870             % } else {
871             <h1>Error</h1>
872             <p>Oops. Looks like posting to <%= link_to url_for('group', group => $group) => begin %><%= $group %><% end %> failed!
873             % }
874              
875             @@ latest.html.ep
876             % layout "default";
877             % title "New news";
878             <h1>New news</h1>
879             <p><%= link_to url_for('index') => begin %>List all groups<% end %>
880             % if (@$list) {
881             <table>
882             <tr><th class="date">Date</th><th class="from">From</th><th class="subject">Subject</th></tr>
883             % my $date = "";
884             % for my $article (@$list) {
885             % if ($article->{date}->[0] ne $date) {
886             % $date = $article->{date}->[0];
887             <tr><td class="day"><%= $date %></td><td></td><td></td></tr>
888             % }
889             % if ($article->{tag}) {
890             % my $re = quotemeta($article->{tag});
891             % my @part = split(/$re/, $article->{subject}, 2);
892             <tr><td class="time"><a href="<%= $article->{url} %>"><%= $article->{date}->[1] %></a></td><td class="from"><%= $article->{from} %></td><td class="subject"><%= $part[0] %><%= link_to url_for('tag', group => $article->{group}, tag => $article->{tag}) =>begin %><%= $article->{tag} %><% end %><%= $part[1] %></td></tr>
893             % } else {
894             <tr><td class="time"><a href="<%= $article->{url} %>"><%= $article->{date}->[1] %></a></td><td class="from"><%= $article->{from} %></td><td class="subject"><%= $article->{subject} %></td></tr>
895             % }
896             % }
897             </table>
898             % } else {
899             <p>No news is good news.
900             <p>Uhh… 🤔
901             % }
902              
903             @@ layouts/default.html.ep
904             <!DOCTYPE html>
905             <html>
906             <head>
907             <title><%= title %></title>
908             %= stylesheet begin
909             body {
910             color: #111;
911             background-color: #fffff8;
912             padding: 1ch;
913             max-width: 80ch;
914             font-size: 12pt;
915             font-family: Lucida Console,Lucida Sans Typewriter,monaco,DejaVu Mono,Bitstream Vera Sans Mono,monospace;
916             hyphens: auto;
917             }
918             @media (prefers-color-scheme: dark) {
919             body {
920             color: #7f7;
921             background-color: #010;
922             }
923             a:link { color: #99f; }
924             a:visited { color: #86f; }
925             a:hover { color: #eef; }
926             }
927             .day { padding-top: 1ch; }
928             .time, .status { text-align: center; }
929             td { min-width: 10ch; padding: 0 0.5ch; }
930             label { display: inline-block; min-width: 10ch; }
931             label[for=wrap] { display: inline; }
932             input[type=password], input[type=text] { width: 30ch; }
933             textarea { width: 100%; height: 20ch; }
934             .button { display: inline-block; }
935             pre { white-space: pre-wrap; }
936             blockquote { border-left: 0.5ch solid gray; padding-left: 0.5ch; margin: 0; margin-top: 0.5ch; }
937             % end
938             <meta name="viewport" content="width=device-width">
939             </head>
940             <body lang="en">
941             <%= content %>
942             <hr>
943             <p>
944             <a href="https://campaignwiki.org/news">News</a>&#x2003;
945             <a href="https://alexschroeder.ch/cgit/news/about/">Source</a>&#x2003;
946             <a href="https://alexschroeder.ch/wiki/Contact">Alex Schroeder</a>
947             </body>
948             </html>