news2json

#! /usr/bin/perl

# Change this to according the INN perl lib location
use lib '/usr/share/perl5'; use INN::Config;

=head1 NAME

 news2json - News (RFC5536 / RFC1036) to JNTP (JSON) GateWay for INN
 Copyright (c) 2001 by Marco d'Itri <md@linux.it> for controlchan's parts code
 Copyright (c) 2014, Gérald Niel

=head1 SYNOPSIS

 INN gives us
 	@token@ <message-id> feeds
 for each article that needs to be sended.  We invoke sm on the
 localhost to get the actual article, convert it to json string and
 send it to JNTP server over HTTP.

 In the INN's newsfeeds file, you need to have a channel feed:

 	news2json!:!*:Ac,Af,Tc,Wnm*:<pathbin>/news2json

 and a site for each of the various jntp site you're feeding,
 such as

 	nemo.gegeweb.org/from-jntp:!*,local.*:Ap,Tm:news2json!

 According to JNTP RFC (see <http://www.nemoweb.net/?page_id=75>),
 if your hostname doesn't match with your public ip/hostname
 configured for your server by the JNTP server you're feeding you
 need to fix your 'fromname' in the optional <pathetc>/news2json.cf.
 This file map jntp fqdn feed with hostname in one line per feed needed
 to be fixed.
 For example if your hostname (fromhost in <pathetc>/innfeed.conf) is
 name.domain.local but you need to be jntp.public.tld for the feed
 nemo.gegeweb.org such as above :

 	# Feed (fqdn in newsfeeds)		Fromname
 	nemo.gegeweb.org				jntp.public.tld

 Signing Jid with ssl/RSA 1024 key:
 this program attempt to find ssl/RSA keys pair in <pathetc>/ssl.
 Create the folder if not exists:
 $ sudo -u news mkdir <pathetc>/ssl
 $ sudo chmod 700 <pathetc>/ssl
 Generate keys pair
 $ sudo -u news openssl genrsa -out <pathetc>/ssl/jntp.key 1024
 $ sudo -u news openssl rsa -in <pathetc>/ssl/jntp.key -pubout > <pathetc>/ssl/jntp.cert

=head1 DESCRIPTION

 News (NNTP) to JSON (JNTP) channel backend.

=head1 AUTHOR

 Gérald Niel, gerald.niel@gmail.com

 All rights reserved.

 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl 5.10.0. For more details, see the full
 text of the licenses in the directory LICENSES.

 Some parts of this program are from Inn's controlchan and are
 Copyright 2001 by Marco d'Itri <md@linux.it>
=cut

use strict;
use warnings;
use utf8;

use JSON;
use MIME::Parser;
use LWP::UserAgent;
use MIME::WordDecoder;
use Mail::Address;
use Encode;
use Encode::Detect::Detector;
use DateTime;
use DateTime::Format::HTTP;
use Digest::SHA;
use Crypt::OpenSSL::RSA;
use MIME::Base64;

# Declare the subroutines
sub trim($);

# globals


my $curmsgid;
my %domain;
my %article;
my $parser;
my $ent;
my $head;

# Global config (constant in upper case)
my $GW_NAME     = "News2Json";
my $GW_VERSION  = "0.2.12";
my $USER_AGENT	= "$GW_NAME/$GW_VERSION";
my $FROM_DOMAIN = $INN::Config::fromhost;
my $PROTOCOL	= 'JNTP-Transitional';
my $PROTOCOL_V	= '0.65';
my $ORIGIN	= 'NNTP';
my $DATATYPE	= 'Article';

my $conf_file = $INN::Config::newsetc.'/news2json.cf';
# SSL Keys
my $pubkey = read_file($INN::Config::newsetc.'/ssl/jntp.cert');
my $privkey = read_file($INN::Config::newsetc.'/ssl/jntp.key');

# Set logging
my $debug = 0;
my $use_syslog = 1; # this is really verbose at this time!
					# probably better to log jntp dialog in a deticated logfile (TODO)
eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1; };

if ($use_syslog) {
    if ($Sys::Syslog::VERSION < 0.15) {
        eval "sub Sys::Syslog::_PATH_LOG { '/dev/log' }" if $^O eq 'dec_osf';
        Sys::Syslog::setlogsock('unix') if $^O =~ /linux|dec_osf|freebsd|darwin/;
    }
    openlog("$GW_NAME-$GW_VERSION", 'pid', $INN::Config::syslog_facility);
}

logmsg('starting', 'info');

## Read conf File
if (-e($conf_file) && -r($conf_file)) {
	open (CFFILE, '<', $conf_file) or die $!;

	while (<CFFILE>) {
		next if /^#|^\s+$/;
		chop;
		my ($s, $d) = split /\s+/;
		$domain{$s} = $d if ( defined ($d) );
	}
}

POST: while (<STDIN>) {
	chop;
	my ($token, $msgid, $feed) = split(/\s+/, $_, 3);
	($curmsgid = $msgid || '') =~ s/<(.*?)\>/$1/;
	next if (!defined($token) || !$curmsgid || !defined($feed));


	# Test if feed(s) want the article, do nothing if not
	my %send_ok;
	my @feeds = split(/\s+/, $feed);
	foreach (@feeds) {
		$domain{$_} ||= $FROM_DOMAIN;

		# LWP crée un agent et une requête
		my $ua  = LWP::UserAgent->new( agent => $USER_AGENT);
		my $json_string = jntp_request ("ihave", 'Jid', $curmsgid, $domain{$_});
		logmsg ( $_ .' > '.$json_string, 'info');
		my $h = HTTP::Headers->new(Content_Type => 'application/json');
		my $req = HTTP::Request->new( POST => "http://$_/jntp/",$h, $json_string );
		my $res = $ua->request($req);
		next if not $res->is_success;
		$res = $res->content;
		logmsg ( $_. ' < ' . $res, 'info');

		my $json_resp = JSON->new->decode($res);
		
		if(length($$json_resp[1]{'Jid'}[0])>3){
			if (ref($json_resp) eq 'ARRAY' && scalar(grep $_, @$json_resp) > 0
				&& $$json_resp[0] eq "iwant" && scalar(grep $_, $$json_resp[1]{'Jid'}[0]) > 0
				&& $$json_resp[1]{'Jid'}[0] eq $curmsgid) {
				$send_ok{$_} = 1;
			} else { 
					logmsg ("send_ko : $msgid $_" , 'info');
					next; 
				}
		} else { 
				logmsg ("bad_response : $msgid $_" , 'info');
				next; 
		}
	}

	if ( scalar(keys %send_ok) ) {

		## --------
		## Part code of controlchan
		##
		## Copyright 2001 by Marco d'Itri <md@linux.it>
		##
		## Redistribution and use in source and binary forms, with or without
		## modification, are permitted provided that the following conditions
		## are met:
		##
		##   1. Redistributions of source code must retain the above copyright
		##      notice, this list of conditions and the following disclaimer.
		##
		##   2. Redistributions in binary form must reproduce the above copyright
		##      notice, this list of conditions and the following disclaimer in the
		##      documentation and/or other materials provided with the distribution.

		my $artfh = open_article($token);
		next if not defined $artfh;

		my $article_string = '';
		while (<$artfh>) {
			$article_string .= $_;
		}
		close $artfh  // next POST;

		## --------
		%article = n2j($article_string);

		next if ( !scalar(keys %article) );
	}
	else { next; }

	foreach (@feeds) {
		if ($send_ok{$_}) {
			$article{'Data'}{'OriginServer'} = $domain{$_};
			$article{'Route'}[0] = $domain{$_};
			my $rsa_priv = Crypt::OpenSSL::RSA->new_private_key($privkey);
			my $signature = $rsa_priv->sign($article{'Jid'});
			$signature = encode_base64($signature);
			chomp ($signature);
			$article{'ServerSign'} = $signature;
			my $ua  = LWP::UserAgent->new( agent => $USER_AGENT);
			my $json_string = jntp_request ("diffuse", 'Packet', \%article, $domain{$_});
			logmsg($_.' > diffuse : <'.$curmsgid.'>', 'info');
			my $h = HTTP::Headers->new(Content_Type => 'application/json');
			my $req = HTTP::Request->new( POST => "http://$_/jntp/",$h, $json_string );
			my $res = $ua->request($req);
			next if not $res->is_success;
			$res = $res->content;
			logmsg($_.' < '.$res, 'info');
		}
		else { next; }
	}
}

logmsg('closed', 'info');
closelog() if $use_syslog;
exit 0;

# NetNews -> Hash (before convert to JSON String)
sub n2j {
	my ($art) = @_;

    $parser = new MIME::Parser;
    $parser->output_dir("$INN::Config::pathtmp");
    $ent  = $parser->parse_data($art);

	$head = $ent->head;

	# Article is empty or does not exist.
	if (not $head->stringify) {
		$parser->filer->purge;
		return undef;
	}

	# Newsgroups empty
	if (not $head->get('newsgroups') or $head->get('newsgroups') eq '') {
		$parser->filer->purge;
		return undef;
	}

	# Subject empty
	if (not $head->get('subject') or $head->get('subject') eq '') {
		$parser->filer->purge;
		return undef;
	}

	# From empty
	if (not $head->get('from') or $head->get('from') eq '') {
		$parser->filer->purge;
		return undef;
	}

	my $headers = $head->header;
	my ( $injectiondate, $mime_type, $mime_encoding, $charset, @ref, @header );

	# Hashs for JSON Object
	# need to isolate data for sha Jid (for next version of JNTP Protocol)
	my %data = (
		DataType => $DATATYPE,
    	FromName => '',
    	FromMail => '',
    	Subject => '',
        Newsgroups => [],
        FollowupTo => [],
        References => [],
        Protocol => $PROTOCOL,
        ProtocolVersion => $PROTOCOL_V,
        Origin => $ORIGIN,
        OriginServer => $FROM_DOMAIN,
        Server => $USER_AGENT,
        ServerPublicKey => $pubkey,
        ThreadID => '',
        Body => ''
	);

    my %article = (
        Route => [$FROM_DOMAIN],
        Jid => $curmsgid,
        Data => \%data,
        ID => '',
        Media => []
    );
	foreach (@$headers) {

		my @header = split(':',$_, 2);
		my $key = lc($header[0]);
		my $value = $ent->head->get($key);
		# Test if already sent from jntp, die if true.
        if (($key eq "path" && index($value, "!from-jntp") !=-1) || $key eq "jntp-protocol") {
			$parser->filer->purge;
            logmsg ("<$curmsgid> already sent from jntp!", 'notice');
			return undef;
        }
        if ($value && $key ne "xref" && $key ne "message-id") {

        	# First try to convert to utf8 non mime-encoded header
			my $c_head = detect($value);
			$value = decode($c_head, $value) if (defined($c_head));
        	# Decode encoded headers
        	my $wd = supported MIME::WordDecoder 'UTF-8';
        	$value = $wd->decode($value) if (!defined($c_head));
        	# Réassemble sur une ligne et supprime le newline
        	$value = join " ", split m/[ \n\t]+/, $value;
        	chomp($value);

        	# Control
        	if ($key eq "control") {
        		my @args = split(' ', $value);
        		if ($args[0] eq "checkgroups") {
        			$data{'Control'}[0] = $value;
        		}
        		elsif ($args[0] eq "cancel") {
        			$args[1] =~ s/<(.*?)\>/$1/;
        			$data{'Control'} = \@args;
        		}
        		else {
        			$data{'Control'} = \@args;
        		}
        		next;
        	}
        	elsif ($key eq "supersedes") {
        		($data{$header[0]} = $value) =~ s/<(.*?)\>/$1/;
        		next;
        	}
        	elsif ($key eq "references") {
        		(undef, @ref) = split m/[<>, \n\t]+/, $value;
        		$data{$header[0]} = \@ref if (scalar(grep $_, @ref) > 0);
        		next;
        	}
        	elsif ( grep { $key eq $_ } (qw(newsgroups followup-to)) ) {
        		my @ng = split ",", $value;
        		s{^\s+|\s+$}{}g foreach @ng;
        		$header[0] =~ s/-//g;
        		$data{$header[0]} = \@ng;
        		next;
        	}
        	elsif ($key eq "from") {
        		my $fromname;
        		my ($addr) = Mail::Address->parse($value);
        		($fromname = $addr->phrase) =~ s/\"(.*?)\"/$1/;
        		$fromname = $fromname.' '.$addr->comment if ($fromname && $addr->comment);
        		($fromname ||= $addr->comment) =~  s/\((.*?)\)/$1/ if (!$fromname);
			# Trouble with spaces
                        $fromname =~ s/(\ [\^:\.\@]\ ?)/trim($&)/e;
			$fromname =~ s/(\ ?[\^:\.\@]\ )/trim($&)/e;
        		$data{'FromName'} = ($fromname ? $fromname : '');
        		$data{'FromMail'} = $addr->address;
        		next;
        	}
        	elsif ( grep { $key eq $_ } (qw(injection-date nntp-posting-date)) ) {
        		# $injectiondate = httpdate($value);
			# Hack by Julien Arlandis
			$injectiondate = httpdate(DateTime->now());
        		$data{$ORIGIN.'Headers'}{$header[0]} = $value;
        		next;
        	}
        	elsif ($key eq "x-trace") {
        		$data{$ORIGIN.'Headers'}{$header[0]} = $value;
        		my @matches = $value =~ /\((.*?)\)/x;
        		$injectiondate ||= httpdate($matches[0]) if (@matches);
        		next;
        	}
        	elsif ($key eq "date") {
        		$injectiondate ||= httpdate($value);
        		$data{$ORIGIN.'Headers'}{$header[0]} = $value;
        		next;
        	}
        	elsif ( grep { $key eq $_ } (qw(user-agent reply-to organization subject)) ) {
        		$header[0] =~ s/-//g;
        		$data{$header[0]} = $value;
        		next;
        	}
        	elsif ( grep { $key eq $_ } (qw(x-complaints-to complaints-to)) ) {
        		$data{'ComplaintsTo'} = $value;
        		next;
        	}
        	elsif ($key eq "nntp-posting-host") {
        		$data{'PostingHost'} = $value;
        		$data{$ORIGIN.'Headers'}{$header[0]} = $value;
        		next;
        	}
			elsif ($key eq "injection-info") {
				$data{$ORIGIN.'Headers'}{$header[0]} = $value;
				my @injinf = split ('; ', $value);
				# $data{'PostingHost'} = $injinf[0];
				shift(@injinf);
				foreach (@injinf) {
					my @injinfs = split('=',$_, 2);
					$injinfs[1] =~ s/\"(.*?)\"/$1/;
					$data{'ComplaintsTo'} = $injinfs[1] if ($injinfs[0] eq 'mail-complaints-to');
					$data{'PostingHost'} = $injinfs[1] if ($injinfs[0] eq 'posting-host');
				}
				next;
			}
        	else {
        		$data{$ORIGIN.'Headers'}{$header[0]} = $value;
        	}
        }
	}

	$injectiondate ||= httpdate(DateTime->now());
	$data{'InjectionDate'} = $injectiondate;

	$data{'ThreadID'} = $article{'Jid'} if (scalar(grep $_, @ref) == 0 && defined($article{'Jid'}));

	# Body
	$mime_type = $ent->mime_type;
	$mime_encoding = $ent->head->mime_encoding;
	if (!defined($mime_type)) {
		$mime_type = "text/plain";
		$head->replace('Content-type', 'text/plain');
	}
	$data{$ORIGIN.'Headers'}{'MimeType'} = $mime_type;
	if (!$ent->is_multipart) {
		$charset = $head->mime_attr('content-type.charset');
		if ( !defined($mime_encoding) || grep { $mime_encoding eq $_ }
			(qw(quoted-printable base64 7bit)) ) {
			$ent->head->replace('Content-transfer-encoding', "8bit");
		}
		my $body = $ent->body;
		$body = join('', @$body);

		# DataType::Article (signature)
		my $closetag = "[/signature]";
		$body =~ s/\n-- \n(?![\s\S]*\n-- \n)([\s\S]+)/\n[signature]$1$closetag/;

		if (!defined($charset)) {
			$charset = detect($body);
			$charset ||= 'us-ascii';
			$data{$ORIGIN.'Headers'}{'CharsetDetect'} = $charset;
		}
		$body = decode($charset, $body)  if (defined($charset));
		$data{'Body'} = $body;
		$data{'Encoding'} = $ent->head->mime_encoding
			if ($ent->head->mime_encoding && $ent->head->mime_encoding ne "8bit");
	}
	# Multipart keep only text/plain if multipart/alternative
	elsif ( defined($mime_type) && $mime_type eq 'multipart/alternative') {
		for (my $i=0; $i<$ent->parts; $i++) {
			my $subent = $ent->parts($i);
			$mime_type = $subent->mime_type;
			if (!defined($mime_type)) {
				$mime_type = "text/plain";
				$subent->head->replace('Content-type', 'text/plain');
			}
			$mime_encoding = $subent->head->mime_encoding;
			$charset = $subent->head->mime_attr('content-type.charset');
			if ( !defined($mime_encoding) || grep { $mime_encoding eq $_ }
				(qw(quoted-printable base64 7bit)) ) {
				$subent->head->replace('Content-transfer-encoding', "8bit");
			}
			if ($mime_type eq "text/plain") {
				$data{$ORIGIN.'Headers'}{'MimeType'} = $subent->mime_type;
				my $body = $subent->body;
				$body = join('', @$body);
				my $closetag = "[/signature]";
				$body =~ s/\n-- \n(?![\s\S]*\n-- \n)([\s\S]+)/\n[signature]$1$closetag/;
				$data{'Encoding'} = $subent->head->mime_encoding
					if ($subent->head->mime_encoding
					&& $subent->head->mime_encoding ne "8bit");
				if (!defined($charset)) {
					my $charset = detect($body);
					$charset ||= 'us-ascii';
					$data{$ORIGIN.'Headers'}{'CharsetDetect'} = $charset;
				}
				$body = decode($charset, $body) if (defined($charset));
				$data{'Body'} = $body;
			}
			else {
				## Nothing
				next;
			}
		}
	}
	else {
		## Nothing
		$parser->filer->purge;
		return undef;
	}
	$article{'Data'} = \%data;

	# purge tmp file
	$parser->filer->purge;
	return %article;
}

# JNTP request in json string
sub jntp_request {
	my ($command, $key, $data, $domain) = @_;

	my @request = ($command);
	my %argv = (
		From	=>	$domain,
		$key	=>	($key eq 'Jid' ? [$data] : $data)
	);
	push (@request, \%argv);
	return JSON->new->utf8->canonical(1)->encode(\@request);
}

# InjectionDate
sub httpdate {
    my ($date) = @_;
    my $dt = DateTime::Format::HTTP->parse_datetime($date);
    $dt = $dt->clone()->set_time_zone('UTC');
    return undef if ($dt > DateTime->now());
    $dt = $dt->strftime("%FT%TZ");

    return $dt;
}

# Read file by lines and return string.
sub read_file {
	my ($path) = @_;

	open (my $file, '<', $path) or die $!;
	my @lines = <$file>;
	$file = join ('', @lines);
	chomp($file);
	return $file;
}

## -------
##  Part code of controlchan
##
##  Copyright 2001 by Marco d'Itri <md@linux.it>
##
##  Redistribution and use in source and binary forms, with or without
##  modification, are permitted provided that the following conditions
##  are met:
##
##   1. Redistributions of source code must retain the above copyright
##      notice, this list of conditions and the following disclaimer.
##
##   2. Redistributions in binary form must reproduce the above copyright
##      notice, this list of conditions and the following disclaimer in the
##      documentation and/or other materials provided with the distribution.

# Open an article
sub open_article {
    my $token = shift;

    if ($token =~ /^\@.+\@$/) {
        my $pid = open(ART, '-|');
        logdie('Cannot fork: ' . $!) if $pid < 0;
        if ($pid == 0) {
            exec("$INN::Config::newsbin/sm", '-q', $token) or
                logdie("Cannot exec sm: $!");
        }
        return *ART;
    }
    return undef;
}

# Logging
sub logmsg {
    my ($msg, $lvl) = @_;

    return if $lvl and $lvl eq 'debug' and not $debug;
    if ($use_syslog) {
        syslog($lvl || 'notice', '%s', $msg);
    } else {
        print STDERR (scalar localtime) . ": $msg\n";
    }
}

sub logdie {
    my ($msg, $lvl) = @_;

    $msg .= " ($curmsgid)" if $curmsgid;
    logmsg($msg, $lvl || 'err');
    closelog() if $use_syslog;
    exit 1;
}


# Perl trim functon to remove whitespace from the start and end of the string
sub trim($)
{
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}

## -------

__END__