#! /usr/bin/env perl
# Copyright (C) 2023  Alex Schroeder <alex@gnu.org>

# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU Affero General Public License as published by the Free
# Software Foundation, either version 3 of the License, or (at your option) any
# later version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
# details.
#
# You should have received a copy of the GNU Affero General Public License along
# with this program. If not, see <https://www.gnu.org/licenses/>.

=encoding utf8

=head1 NAME

news - a read-only web fron-end to a local news server

=head1 SYNOPSIS

B<news> [B<message-id>]

=head1 DESCRIPTION

C<news> connects to the local news server via NNTP on port 119, lists all the
groups and allows read-only access.

An optional B<message-id> can be provided on the command line. A link to this
article serves as the "start here" link on the front page.

For each group, only posts made in the last seven days are shown. The From field
is stripped of anything in angled brackets in an effort to remove email
addresses: \s*<.*>

For each article, an attempt is made to scrip email addresses by removing
anything in angled brackets: \s*<\S*?@.*?>

=head1 SEE ALSO

The Tildeverse also runs news.
L<https://news.tildeverse.org/>

=head1 LICENSE

GNU Affero General Public License

=cut

# corelist
use Net::NNTP;
use Encode qw(decode);
# not core
use Mojolicious::Lite;      # Mojolicious
use DateTime::Format::Mail;

my $host = "localhost"; # host to contact on port 119
my $groups = "."; # regular expression for groups to show by default
my $intro_id = shift; # message id for an article that introduces it all

get '/' => sub {
  shift->redirect_to('index');
};

under 'news';

# Config needs server, and newsgroups.

get '/' => sub {
  my $c = shift;
  my $nntp = Net::NNTP->new($host) or die "No server running on localhost:119";
  my $list = $nntp->list();
  $nntp->quit;
  # just keep the newsgroups we're willing to publish
  delete $list->{$_} for grep !/$groups/, keys %$list;
  $c->render(template => 'index', list => $list,
             address => $c->tx->req->url->to_abs->host,
             id => $intro_id);
} => 'index';

get '/group/#group' => sub {
  my $c = shift;
  my $group = $c->param('group');
  my $nntp = Net::NNTP->new("localhost") or die "No server running on localhost:119";
  my $ids = $nntp->newnews(time() - 7 * 24 * 60 * 60, , $group);
  my $list = [];
  for my $id (reverse @$ids) {
    my $headers = Mojo::Headers->new;
    $headers->parse("$_\r\n") for @{$nntp->head($id)};
    my $data = {
      id => $id,
      from => from_header($headers),
      subject => subject_header($headers),
      date => date_header($headers),
    };
    push(@$list, $data);
  }
  $nntp->quit;
  $c->render(template => 'group', group => $group, list => $list);
} => 'group';

get '/article/#id' => sub {
  my $c = shift;
  my $id = $c->param('id');
  my $nntp = Net::NNTP->new("localhost") or die "No server running on localhost:119";
  my $body = $nntp->body($id);
  return $c->render(template => 'unknown') unless $body;
  my $headers = Mojo::Headers->new;
  $headers->parse("$_\r\n") for @{$nntp->head($id)};
  my $data = {
    id => $id,
    from => from_header($headers),
    subject => subject_header($headers),
    date => date_header($headers),
    newsgroups => newsgroups_header($headers),
    references => references_header($headers),
    body => article_body(join("", @$body), $headers),
  };
  $nntp->quit;
  $c->render(template => 'article', article => $data);
} => 'article';

sub from_header {
  my ($headers) = @_;
  my $value = $headers->header("from");
  return "Anonymous" unless $value = decode("MIME-Header", $value); # decode non-ASCII
  $value =~ s/\s*<.*>//; # remove email addresses
  return $value;
}

sub subject_header {
  my ($headers) = @_;
  return "?" unless my $value = $headers->header("subject");
  $value = decode("MIME-Header", $value); # decode non-ASCII
  return $value;
}

sub date_header {
  my ($headers) = @_;
  my $value = $headers->header("date");
  $value = decode("MIME-Header", $value); # decode non-ASCII
  $value =~ s/\s*\(.*\)//; # remove extra timezone info like "(UTC)"
  my $dt = DateTime::Format::Mail->parse_datetime($value);
  return $dt->ymd . " " . $dt->hms;
}

sub newsgroups_header {
  my ($headers) = @_;
  return [] unless my $value = $headers->header("newsgroups");
  $value = decode("MIME-Header", $value); # decode non-ASCII
  return [split(/\s*,\s*/, $value)];
}

sub references_header {
  my ($headers) = @_;
  return [] unless my $value = $headers->header("references");
  $value = decode("MIME-Header", $value); # decode non-ASCII
  return [split(/\s*,\s*/, $value)];
}

sub article_body {
  my ($body, $headers) = @_;
  $body =~ s/\s*<\S*?@.*?>//; # remove email addresses
  return $body unless $headers->header('content-type');
  my ($charset) = $headers->header('content-type') =~ /charset=(.*)/;
  return $body unless $charset;
  return decode($charset, $body);
}

app->start;

__DATA__

@@ index.html.ep
% layout "default";
% title 'News';
<h1>News</h1>
<p>
This is a read-only 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>.

% if ($id) {
<p>
<%= link_to url_for('article', id => $id) => begin %>Start here<% end %>.
% }

<ul>
% for my $group (sort keys %$list) {
<li><%= link_to url_for('group', group => $group) => begin %><%= $group %><% end %>
% }
</ul>

@@ group.html.ep
% layout "default";
% title "$group";
<h1><%= $group %></h1>
<table>
<tr><th>Date</th><th>From</th><th>Subject</th></tr>
% for my $article (@$list) {
<tr><td><%= link_to url_for('article', id => $article->{id}) => begin %><%= $article->{date} %><% end %></td><td><%= $article->{from} %></td><td><%= $article->{subject} %></td></tr>
% }
</table>

@@ article.html.ep
% layout "default";
% title "$article->{subject}";
<h1><%= $article->{subject} %></h1>
<p class="headers"><span class="value from"><%= $article->{from} %></span>,
<span class="date"><%= $article->{date} %></span>,
% for my $newsgroup (@{$article->{newsgroups}}) {
<%= link_to url_for('group', group => $newsgroup) => (class => "value newsgroups") => begin %><%= $newsgroup %><% end %>
% }
% if (@{$article->{references}}) {
%   for my $id (@{$article->{references}}) {
<%= link_to url_for('article', id => $id) => (class => "value references") => begin %>ref<% end %>
%   }
% }

<pre class="body"><%= $article->{body} %></pre>

@@ unknown.html.ep
% layout "default";
% title "Unknown Article";
<h1>Unknown article</h1>
<p>Either the message id is wrong or the article has expired on this news
server.

@@ layouts/default.html.ep
<!DOCTYPE html>
<html>
<head>
<title><%= title %></title>
%= stylesheet begin
body {
  padding: 1ch;
  max-width: 80ch;
  font-size: 12pt;
  font-family: "DejaVu Mono", mono;
  hyphens: auto;
}
td {
  padding: 0 0.5ch;
}

% end
<meta name="viewport" content="width=device-width">
</head>
<body lang="en">
<%= content %>
<hr>
<p>
<a href="https://campaignwiki.org/news">News</a>&#x2003;
<a href="https://alexschroeder.ch/cgit/news/about/">Source</a>&#x2003;
<a href="https://alexschroeder.ch/wiki/Contact">Alex Schroeder</a>
</body>
</html>
