"Fossies" - the Fresh Open Source Software Archive

Member "tin-2.6.2/tools/tinews.pl" (3 Nov 2022, 49078 Bytes) of package /linux/misc/tin-2.6.2.tar.xz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "tinews.pl" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.6.1_vs_2.6.2.

A hint: This file contains one or more very long lines, so maybe it is better readable using the pure text view mode that shows the contents as wrapped lines within the browser window.


    1 #! /usr/bin/perl -w
    2 #
    3 # reads an article on STDIN, mails any copies if required,
    4 # signs the article and posts it.
    5 #
    6 #
    7 # Copyright (c) 2002-2023 Urs Janssen <urs@tin.org>,
    8 #                         Marc Brockschmidt <marc@marcbrockschmidt.de>
    9 #
   10 # Redistribution and use in source and binary forms, with or without
   11 # modification, are permitted provided that the following conditions
   12 # are met:
   13 #
   14 # 1. Redistributions of source code must retain the above copyright notice,
   15 #    this list of conditions and the following disclaimer.
   16 #
   17 # 2. Redistributions in binary form must reproduce the above copyright
   18 #    notice, this list of conditions and the following disclaimer in the
   19 #    documentation and/or other materials provided with the distribution.
   20 #
   21 # 3. Neither the name of the copyright holder nor the names of its
   22 #    contributors may be used to endorse or promote products derived from
   23 #    this software without specific prior written permission.
   24 #
   25 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   26 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   27 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   28 # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
   29 # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   30 # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   31 # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   32 # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   33 # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   34 # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35 # POSSIBILITY OF SUCH DAMAGE.
   36 #
   37 #
   38 # TODO: - extend debug mode to not delete tmp-files and be more verbose
   39 #       - add pid to pgptmpf to allow multiple simultaneous instances
   40 #       - check for /etc/nntpserver (and /etc/news/server)
   41 #       - add $PGPOPTS, $PGPPATH and $GNUPGHOME support
   42 #       - cleanup and remove duplicated code
   43 #       - quote inpupt properly before passing to shell
   44 #       - $ENV{'NEWSHOST'} / $ENV{'NNTPSERVER'} and $ENV{'NNTPPORT'}
   45 #         do have higher precedence than settings in the script and
   46 #         config-file, but config-settig SSL may override $ENV{'NNTPPORT'}
   47 #       - if (!defined $ENV{'GPG_TTY'}) {if (open(my $T,'-|','tty')) {
   48 #           chomp(my $tty=<$T>); close($T);
   49 #           $ENV{'GPG_TTY'}=$tty if($tty =~ m/^\//)}}
   50 #         for gpg?
   51 #       - option to break long header lines?
   52 #       - option to trim References
   53 #       ...
   54 #
   55 # cmd-line options used in other inews:
   56 # inews-xt (Olaf Titz):
   57 #    -C accepted for historic reasons and errors out
   58 # inews (inn)
   59 #    -P don't add Sender
   60 
   61 use strict;
   62 use warnings;
   63 
   64 # version Number
   65 my $version = "1.1.61";
   66 
   67 my %config;
   68 
   69 # configuration, may be overwritten via ~/.tinewsrc
   70 $config{'nntp-server'}  = 'news';   # your NNTP servers name, may be set via $NNTPSERVER
   71 $config{'nntp-port'}    = 119;  # NNTP-port, may be set via $NNTPPORT
   72 $config{'nntp-user'}    = '';   # username for nntp-auth, may be set via ~/.newsauth or ~/.nntpauth
   73 $config{'nntp-pass'}    = '';   # password for nntp-auth, may be set via ~/.newsauth or ~/.nntpauth
   74 
   75 $config{'ssl'}          = 0;    # set to 1 to use NNTPS if possible
   76 
   77 $config{'pgp-signer'}   = '';   # sign as who?
   78 $config{'pgp-pass'}     = '';   # pgp2 only
   79 $config{'path-to-pgp-pass'}= '';    # pgp2, pgp5, pgp6 and gpg
   80 $config{'pgp-pass-fd'}  = 9;    # file descriptor used for input redirection of path-to-pgp-pass; GPG1, GPG2, PGP5 and PGP6 only
   81 
   82 $config{'pgp'}          = '/usr/bin/pgp';   # path to pgp
   83 $config{'pgp-version'}  = '2';  # Use 2 for 2.X, 5 for PGP5, 6 for PGP6, GPG or GPG1 for GPG1 and GPG2 for GPG2
   84 $config{'digest-algo'}  = 'MD5';# Digest Algorithm for GPG. Must be supported by your installation
   85 
   86 $config{'interactive'}  = 'yes';# allow interactive usage
   87 
   88 $config{'verbose'}      = 0;    # set to 1 to get warning messages
   89 $config{'debug'}        = 0;    # set to 1 to get some debug output
   90 
   91 $config{'sig-path'}     = glob('~/.signature'); # path to signature
   92 $config{'add-signature'}= 'yes';# Add $config{'sig-path'} to posting if there is no sig
   93 $config{'sig-max-lines'}= 4;    # max number of signatures lines
   94 
   95 $config{'max-header-length'} = 998; # RFC 5536
   96 
   97 $config{'sendmail'}     = '/usr/sbin/sendmail -i -t'; # set to '' to disable mail-actions
   98 
   99 $config{'pgptmpf'}      = 'pgptmp'; # temporary file for PGP.
  100 
  101 $config{'pgpheader'}    = 'X-PGP-Sig';
  102 $config{'pgpbegin'}     = '-----BEGIN PGP SIGNATURE-----';  # Begin of PGP-Signature
  103 $config{'pgpend'}       = '-----END PGP SIGNATURE-----';    # End of PGP-Signature
  104 
  105 $config{'canlock-algorithm'}    = 'sha1';   # Digest algorithm used for cancel-lock and cancel-key; sha1, sha256 and sha512 are supported
  106 # $config{'canlock-secret'} = '~/.cancelsecret';        # Path to canlock secret file
  107 
  108 # $config{'ignore-headers'} = '';       # headers to be ignored during signing
  109 
  110 $config{'pgp-sign-headers'} = ['From', 'Newsgroups', 'Subject', 'Control',
  111     'Supersedes', 'Followup-To', 'Date', 'Injection-Date', 'Sender', 'Approved',
  112     'Message-ID', 'Reply-To', 'Cancel-Key', 'Also-Control',
  113     'Distribution'];
  114 $config{'pgp-order-headers'} = ['from', 'newsgroups', 'subject', 'control',
  115     'supersedes', 'followup-To', 'date', 'injection-date', 'organization',
  116     'lines', 'sender', 'approved', 'distribution', 'message-id',
  117     'references', 'reply-to', 'mime-version', 'content-type',
  118     'content-transfer-encoding', 'summary', 'keywords', 'cancel-lock',
  119     'cancel-key', 'also-control', 'x-pgp', 'user-agent'];
  120 
  121 ################################################################################
  122 
  123 use Getopt::Long qw(GetOptions);
  124 use Net::NNTP;
  125 use Time::Local;
  126 use Term::ReadLine;
  127 
  128 (my $pname = $0) =~ s#^.*/##;
  129 
  130 # read config file (first match counts) from
  131 #   $XDG_CONFIG_HOME/tinewsrc
  132 #   ~/.config/tinewsrc
  133 #   ~/.tinewsrc
  134 # if present
  135 my $TINEWSRC = undef;
  136 my (@try, %seen);
  137 
  138 if ($ENV{'XDG_CONFIG_HOME'}) {
  139     push(@try, (glob("$ENV{'XDG_CONFIG_HOME'}/tinewsrc"))[0]);
  140 }
  141 push(@try, (glob('~/.config/tinewsrc'))[0], (glob('~/.tinewsrc'))[0]);
  142 
  143 foreach (grep { ! $seen{$_}++ } @try) { # uniq @try
  144     last if (open($TINEWSRC, '<', $_));
  145     $TINEWSRC = undef;
  146 }
  147 if (defined($TINEWSRC)) {
  148     my $changes = 0;
  149     while (defined($_ = <$TINEWSRC>)) {
  150         if (m/^([^#\s=]+)\s*=\s*(\S[^#]+)/io) {
  151             # rename pre 1.1.56 tinewsrc-var names
  152             my $key = $1;
  153             my $val = $2;
  154             $key =~ s#^followupto#follow-to# && $changes++;
  155             $key =~ s#^replyto#reply-to# && $changes++;
  156             $key =~ s#^NNTP(?!\-).#NNTP-# && $changes++;
  157             $key =~ s#^PathtoPGPPass#path-to-pgp-pass# && $changes++;
  158             $key =~ s#^PGPorderheaders#pgp-order-headers# && $changes++;
  159             $key =~ s#^PGPPassFD#pgp-pass-fd# && $changes++;
  160             $key =~ s#^PGPSignHeaders#pgp-sign-headers# && $changes++;
  161             $key =~ s#^PGP(?!\-).#PGP-# && $changes++;
  162             $key =~ s#_#-# && $changes++;
  163             chomp($config{lc($key)} = $val);
  164         }
  165     }
  166     close($TINEWSRC);
  167     print "Old style tinewsrc option names found, you should adjust them.\n" if ($changes && ($config{'verbose'} || $config{'debug'}));
  168 }
  169 
  170 # as of tinews 1.1.51 we use 3 args open() to pipe to sendmail
  171 # thus we remove any leading '|' to avoid syntax errors;
  172 # for redirections use cat etc.pp., eg. 'cat > /tmp/foo'
  173 $config{'sendmail'} =~ s/^\s*\|\s*//io;
  174 
  175 # digest-algo is case sensitive and should be all uppercase
  176 $config{'digest-algo'} = uc($config{'digest-algo'});
  177 
  178 # these env-vars have higher priority (order is important)
  179 $config{'nntp-server'} = $ENV{'NEWSHOST'} if ($ENV{'NEWSHOST'});
  180 $config{'nntp-server'} = $ENV{'NNTPSERVER'} if ($ENV{'NNTPSERVER'});
  181 $config{'nntp-port'} = $ENV{'NNTPPORT'} if ($ENV{'NNTPPORT'});
  182 
  183 # Get options:
  184 $Getopt::Long::ignorecase=0;
  185 $Getopt::Long::bundling=1;
  186 GetOptions('A|V|W|h|headers' => [], # do nothing
  187     'debug|D|N' => \$config{'debug'},
  188     'port|p=i'  => \$config{'nntp-port'},
  189     'no-sign|X' => \$config{'no-sign'},
  190     'no-control|R'  => \$config{'no-control'},
  191     'no-signature|S'    => \$config{'no-signature'},
  192     'no-canlock|L'  => \$config{'no-canlock'},
  193     'no-injection-date|I'   => \$config{'no-injection-date'},
  194     'no-organization|O' => \$config{'no-organization'},
  195     'force-auth|Y'  => \$config{'force-auth'},
  196     'approved|a=s'  => \$config{'approved'},
  197     'control|c=s'   => \$config{'control'},
  198     'canlock-algorithm=s'   => \$config{'canlock-algorithm'},
  199     'distribution|d=s'  => \$config{'distribution'},
  200     'discard-empty|E'   => \$config{'discard-empty'},
  201     'expires|e=s'   => \$config{'expires'},
  202     'from|f=s'  => \$config{'from'},
  203     'ignore-headers|i=s'    => \$config{'ignore-headers'},
  204     'followup-to|w=s'   => \$config{'followup-to'},
  205     'message-id|m=s'    => \$config{'message-id'},
  206     'newsgroups|n=s'    => \$config{'newsgroups'},
  207     'reply-to|r=s'  => \$config{'reply-to'},
  208     'savedir|s=s'   => \$config{'savedir'},
  209     'ssl|nntps' => \$config{'ssl'},
  210     'subject|t=s'   => \$config{'subject'},
  211     'references|F=s'    => \$config{'references'},
  212     'organization|o=s'  => \$config{'organization'},
  213     'path|x=s'  => \$config{'path'},
  214     'help|H'    => \$config{'help'},
  215     'transform' => \$config{'transform'},
  216     'verbose|v' => \$config{'verbose'},
  217     'version'   => \$config{'version'}
  218 );
  219 
  220 foreach (@ARGV) {
  221     print STDERR "Unknown argument $_.";
  222     usage();
  223 }
  224 
  225 if ($config{'version'}) {
  226     version();
  227     exit 0;
  228 }
  229 
  230 usage() if ($config{'help'});
  231 
  232 # check if SSL support is available
  233 if ($config{'ssl'}) {
  234     eval "Net::NNTP->can_ssl";
  235     if ($@) {
  236         warn "Your Net::NNTP doesn't support SSL.\n" if ($config{'debug'} || $config{'verbose'});
  237         $config{'ssl'} = 0;
  238     }
  239 }
  240 # and now adjust default port depending on SSL requested and
  241 # available or not
  242 if ($config{'ssl'}) {
  243     $config{'nntp-port'} = 563 if ($config{'nntp-port'} == 119);
  244 } else {
  245     $config{'nntp-port'} = 119 if ($config{'nntp-port'} == 563);
  246 }
  247 
  248 my $sha_mod = undef;
  249 # Cancel-Locks require some more modules
  250 if ($config{'canlock-secret'} && !$config{'no-canlock'}) {
  251     $config{'canlock-algorithm'} = lc($config{'canlock-algorithm'});
  252     # we support sha1, sha256 and sha512, fallback to sha1 if something else is given
  253     if (!($config{'canlock-algorithm'} =~ /^sha(1|256|512)$/)) {
  254         warn "Digest algorithm " . $config{'canlock-algorithm'} . " not supported. Falling back to sha1.\n" if ($config{'debug'} || $config{'verbose'});
  255         $config{'canlock-algorithm'} = 'sha1';
  256     }
  257     if ($config{'canlock-algorithm'} eq 'sha1') {
  258         foreach ('Digest::SHA qw(sha1)', 'Digest::SHA1()') {
  259             eval "use $_";
  260             if (!$@) {
  261                 ($sha_mod = $_) =~ s#( qw\(sha1\)|\(\))##;
  262                 last;
  263             }
  264         }
  265         foreach ('MIME::Base64()', 'Digest::HMAC_SHA1()') {
  266             eval "use $_";
  267             if ($@ || !defined($sha_mod)) {
  268                 $config{'no-canlock'} = 1;
  269                 warn "Cancel-Locks disabled: Can't locate ".$_."\n" if ($config{'debug'} || $config{'verbose'});
  270                 last;
  271             }
  272         }
  273     } elsif ($config{'canlock-algorithm'} eq 'sha256') {
  274         foreach ('MIME::Base64()', 'Digest::SHA qw(sha256 hmac_sha256)') {
  275             eval "use $_";
  276             if ($@) {
  277                 $config{'no-canlock'} = 1;
  278                 warn "Cancel-Locks disabled: Can't locate ".$_."\n" if ($config{'debug'} || $config{'verbose'});
  279                 last;
  280             }
  281         }
  282     } else {
  283         foreach ('MIME::Base64()', 'Digest::SHA qw(sha512 hmac_sha512)') {
  284             eval "use $_";
  285             if ($@) {
  286                 $config{'no-canlock'} = 1;
  287                 warn "Cancel-Locks disabled: Can't locate ".$_."\n" if ($config{'debug'} || $config{'verbose'});
  288                 last;
  289             }
  290         }
  291     }
  292 }
  293 
  294 my $term = Term::ReadLine->new('tinews');
  295 my $attribs = $term->Attribs;
  296 my $in_header = 1;
  297 my (%Header, @Body, $PGPCommand);
  298 
  299 if (! $config{'no-sign'}) {
  300     $config{'pgp-signer'} = $ENV{'SIGNER'} if ($ENV{'SIGNER'});
  301     $config{'path-to-pgp-pass'} = $ENV{'PGPPASSFILE'} if ($ENV{'PGPPASSFILE'});
  302     if ($config{'path-to-pgp-pass'}) {
  303         open(my $pgppass, '<', (glob($config{'path-to-pgp-pass'}))[0]) or
  304             $config{'interactive'} && die("$0: Can't open ".$config{'path-to-pgp-pass'}.": $!");
  305         chomp($config{'pgp-pass'} = <$pgppass>);
  306         close($pgppass);
  307     }
  308     if ($config{'pgp-version'} eq '2' && $ENV{'PGPPASS'}) {
  309         $config{'pgp-pass'} = $ENV{'PGPPASS'};
  310     }
  311 }
  312 
  313 # Remove unwanted headers from pgp-sign-headers
  314 if (${config{'ignore-headers'}}) {
  315     my @hdr_to_ignore = split(/,/, ${config{'ignore-headers'}});
  316     foreach my $hdr (@hdr_to_ignore) {
  317         @{$config{'pgp-sign-headers'}} = map {lc($_) eq lc($hdr) ? () : $_} @{$config{'pgp-sign-headers'}};
  318     }
  319 }
  320 # Read the message and split the header
  321 readarticle(\%Header, \@Body);
  322 
  323 # empty @Body
  324 if (scalar @Body == 0) {
  325     warn("Empty article\n") if ($config{'verbose'});
  326     exit 0 if ($config{'discard-empty'});
  327 }
  328 
  329 # Add signature if there is none
  330 if (!$config{'no-signature'}) {
  331     if ($config{'add-signature'} && !grep {/^-- /} @Body) {
  332         if (-r glob($config{'sig-path'})) {
  333             my $l = 0;
  334             push @Body, "-- \n";
  335             open(my $SIGNATURE, '<', glob($config{'sig-path'})) or die("Can't open " . $config{'sig-path'} . ": $!");
  336             while (<$SIGNATURE>) {
  337                 die $config{'sig-path'} . " longer than " . $config{'sig-max-lines'}. " lines!" if (++$l > $config{'sig-max-lines'});
  338                 push @Body, $_;
  339             }
  340             close($SIGNATURE);
  341         } else {
  342             warn "Tried to add " . $config{'sig-path'} . ", but it is unreadable.\n" if ($config{'debug'} || $config{'verbose'});
  343         }
  344     }
  345 }
  346 
  347 # import headers set in the environment
  348 if (!defined($Header{'reply-to'})) {
  349     if ($ENV{'REPLYTO'}) {
  350         chomp($Header{'reply-to'} = "Reply-To: " . $ENV{'REPLYTO'});
  351         $Header{'reply-to'} .= "\n";
  352     }
  353 }
  354 foreach ('DISTRIBUTION', 'ORGANIZATION') {
  355     if (!defined($Header{lc($_)}) && $ENV{$_}) {
  356         chomp($Header{lc($_)} = ucfirst($_).": " . $ENV{$_});
  357         $Header{lc($_)} .= "\n";
  358     }
  359 }
  360 
  361 # overwrite headers if specified via cmd-line
  362 foreach ('Approved', 'Control', 'Distribution', 'Expires',
  363     'From', 'Followup-To', 'Message-ID', 'Newsgroups',' Reply-To',
  364     'Subject', 'References', 'Organization') {
  365     next if (!defined($config{lc($_)}));
  366     chomp($Header{lc($_)} = $_ . ": " . $config{lc($_)});
  367     $Header{lc($_)} .= "\n";
  368 }
  369 
  370 # -x doesn't overwrite but prefixes
  371 if (defined($config{'path'})) {
  372     if (defined($Header{'path'})) {
  373         (my $pbody = $Header{'path'}) =~ s#^Path: ##i;
  374         chomp($Header{'path'} = "Path: " . $config{'path'} . "!" . $pbody);
  375     } else {
  376         chomp($Header{'path'} = "Path: " . $config{'path'});
  377     }
  378     $Header{'path'} .= "\n";
  379 }
  380 
  381 # verify/add/remove headers
  382 foreach ('From', 'Subject') {
  383     die("$0: No $_:-header defined.") if (!defined($Header{lc($_)}));
  384 }
  385 
  386 $Header{'date'} = "Date: ".getdate()."\n" if (!defined($Header{'date'}) || $Header{'date'} !~ m/^[^\s:]+: .+/o);
  387 $Header{'injection-date'} = "Injection-Date: ".getdate()."\n" if (!$config{'no-injection-date'});
  388 
  389 if (defined($Header{'user-agent'})) {
  390     chomp $Header{'user-agent'};
  391     $Header{'user-agent'} = $Header{'user-agent'}." ".$pname."/".$version."\n";
  392 }
  393 
  394 delete $Header{'x-pgp-key'} if (!$config{'no-sign'} && defined($Header{'x-pgp-key'}));
  395 
  396 delete $Header{'organization'} if ($config{'no-organization'} && defined($Header{'organization'}));
  397 
  398 # No control. No control. You have no control.
  399 if ($config{'no-control'} and $Header{control}) {
  400     print STDERR "No control messages allowed.\n";
  401     exit 1;
  402 }
  403 
  404 # various checks
  405 if ($config{'debug'} || $config{'verbose'}) {
  406     foreach (keys %Header) {
  407         warn "Raw 8-bit data in the following header:\n$Header{$_}\n" if ($Header{$_} =~ m/[\x80-\xff]/o);
  408     }
  409     if (!defined($Header{'mime-version'}) || !defined($Header{'content-type'}) || !defined($Header{'content-transfer-encoding'})) {
  410         warn "8bit body without MIME-headers\n" if (grep {/[\x80-\xff]/} @Body);
  411     }
  412 }
  413 
  414 # try ~/.newsauth if no $config{'nntp-pass'} was set
  415 if (!$config{'nntp-pass'}) {
  416     my ($l, $server, $pass, $user);
  417     if (-r (glob("~/.newsauth"))[0]) {
  418         open (my $NEWSAUTH, '<', (glob("~/.newsauth"))[0]) or die("Can't open ~/.newsauth: $!");
  419         while ($l = <$NEWSAUTH>) {
  420             chomp $l;
  421             next if ($l =~ m/^[#\s]/);
  422             ($server, $pass, $user) = split(/\s+\b/, $l);
  423             last if ($server =~ m/\Q$config{'nntp-server'}\E/);
  424         }
  425         close($NEWSAUTH);
  426         if ($pass && $server =~ m/\Q$config{'nntp-server'}\E/) {
  427             $config{'nntp-pass'} = $pass;
  428             $config{'nntp-user'} = $user || getlogin || getpwuid($<) || $ENV{USER};
  429         } else {
  430             $pass = $user = "";
  431         }
  432     }
  433     # try ~/.nntpauth if we still got no password
  434     if (!$pass) {
  435         if (-r (glob("~/.nntpauth"))[0]) {
  436             open (my $NNTPAUTH, '<', (glob("~/.nntpauth"))[0]) or die("Can't open ~/.nntpauth: $!");
  437             while ($l = <$NNTPAUTH>) {
  438                 chomp $l;
  439                 next if ($l =~ m/^[#\s]/);
  440                 ($server, $user, $pass) = split(/\s+\b/, $l);
  441                 last if ($server =~ m/\Q$config{'nntp-server'}\E/);
  442             }
  443             close($NNTPAUTH);
  444             if ($pass && $server =~ m/\Q$config{'nntp-server'}\E/) {
  445                 $config{'nntp-pass'} = $pass;
  446                 $config{'nntp-user'} = $user || getlogin || getpwuid($<) || $ENV{USER};
  447             }
  448         }
  449     }
  450 }
  451 
  452 # instead of abort posting just to prefetch a Messsage-ID we should (try
  453 # to) keep the session open instead
  454 if (!($config{'no-sign'} && $config{'no-canlock'})) {
  455     if (! $config{'savedir'} && defined($Header{'newsgroups'}) && !defined($Header{'message-id'})) {
  456         my $Server = AuthonNNTP();
  457         my $ServerMsg = $Server->message();
  458         $Header{'message-id'} = "Message-ID: $1\n" if ($ServerMsg =~ m/(<\S+\@\S+>)/o);
  459         #$Server->datasend('.');    # dataend() already sends "."
  460         $Server->dataend();
  461         $Server->quit();
  462     }
  463 
  464     if (!defined($Header{'message-id'})) {
  465         my $hname;
  466         eval "use Sys::Hostname";
  467         if ($@) {
  468             chomp($hname = `hostname`);
  469         } else {
  470             $hname = hostname();
  471         }
  472         my ($hostname,) = gethostbyname($hname);
  473         if (defined($hostname) && $hostname =~ m/\./io) {
  474             $Header{'message-id'} = "Message-ID: " . sprintf("<N%xI%xT%x@%s>\n", $>, timelocal(localtime), $$, $hostname);
  475         }
  476     }
  477 }
  478 
  479 # add Cancel-Lock (and Cancel-Key) header(s) if requested
  480 if ($config{'canlock-secret'} && !$config{'no-canlock'} && defined($Header{'message-id'})) {
  481     open(my $CANLock, '<', (glob($config{'canlock-secret'}))[0]) or die("$0: Can't open " . $config{'canlock-secret'} . ": $!");
  482     chomp(my $key = <$CANLock>);
  483     close($CANLock);
  484     (my $data = $Header{'message-id'}) =~ s#^Message-ID: ##i;
  485     chomp $data;
  486     my $cancel_key = buildcancelkey($data, $key);
  487     my $cancel_lock = buildcancellock($cancel_key, $sha_mod);
  488     if (defined($Header{'cancel-lock'})) {
  489         chomp $Header{'cancel-lock'};
  490         $Header{'cancel-lock'} .= " " . $config{'canlock-algorithm'} . ":" . $cancel_lock . "\n";
  491     } else {
  492         $Header{'cancel-lock'} = "Cancel-Lock: " . $config{'canlock-algorithm'} . ":" . $cancel_lock . "\n";
  493     }
  494 
  495     if ((defined($Header{'supersedes'}) && $Header{'supersedes'} =~ m/^Supersedes:\s+<\S+>\s*$/i) || (defined($Header{'control'}) && $Header{'control'} =~ m/^Control:\s+cancel\s+<\S+>\s*$/i) ||(defined($Header{'also-control'}) && $Header{'also-control'} =~ m/^Also-Control:\s+cancel\s+<\S+>\s*$/i)) {
  496         if (defined($Header{'also-control'}) && $Header{'also-control'} =~ m/^Also-Control:\s+cancel\s+/i) {
  497             ($data = $Header{'also-control'}) =~ s#^Also-Control:\s+cancel\s+##i;
  498             chomp $data;
  499             $cancel_key = buildcancelkey($data, $key);
  500         } else {
  501             if (defined($Header{'control'}) && $Header{'control'} =~ m/^Control: cancel /i) {
  502                 ($data = $Header{'control'})=~ s#^Control:\s+cancel\s+##i;
  503                 chomp $data;
  504                 $cancel_key = buildcancelkey($data, $key);
  505             } else {
  506                 if (defined($Header{'supersedes'})) {
  507                     ($data = $Header{'supersedes'}) =~ s#^Supersedes: ##i;
  508                     chomp $data;
  509                     $cancel_key = buildcancelkey($data, $key);
  510                 }
  511             }
  512         }
  513         if (defined($Header{'cancel-key'})) {
  514             chomp $Header{'cancel-key'};
  515             $Header{'cancel-key'} .= " " . $config{'canlock-algorithm'} . ":" . $cancel_key . "\n";
  516         } else {
  517             $Header{'cancel-key'} = "Cancel-Key: " . $config{'canlock-algorithm'} . ":" . $cancel_key . "\n";
  518         }
  519     }
  520 }
  521 
  522 # set Posted-And-Mailed if we send a mailcopy to someone else
  523 if ($config{'sendmail'} && defined($Header{'newsgroups'}) && (defined($Header{'to'}) || defined($Header{'cc'}) || defined($Header{'bcc'}))) {
  524     foreach ('to', 'bcc', 'cc') {
  525         if (defined($Header{$_}) && $Header{$_} ne $Header{'from'}) {
  526             $Header{'posted-and-mailed'} = "Posted-And-Mailed: yes\n";
  527             last;
  528         }
  529     }
  530 }
  531 
  532 if (! $config{'no-sign'}) {
  533     if (!$config{'pgp-signer'}) {
  534         chomp($config{'pgp-signer'} = $Header{'from'});
  535         $config{'pgp-signer'} =~ s/^[^\s:]+: (.*)/$1/;
  536     }
  537     $PGPCommand = getpgpcommand($config{'pgp-version'});
  538 }
  539 
  540 # exit with error if neither $Newsgroups nor any of $To, $Cc or $Bcc are set
  541 my $required = 0;
  542 foreach ('Newsgroups', 'To,', 'Cc', 'Bcc') {
  543     $required++ if (defined($Header{lc($_)}));
  544     last if $required;
  545 }
  546 die("$0: neither Newsgroups: nor any of To:, Cc:, or Bcc: present.\n") if (!$required);
  547 
  548 # (re)move mail-headers
  549 my ($To, $Cc, $Bcc, $Newsgroups) = '';
  550 $To = $Header{'to'} if (defined($Header{'to'}));
  551 $Cc = $Header{'cc'} if (defined($Header{'cc'}));
  552 $Bcc = $Header{'bcc'} if (defined($Header{'bcc'}));
  553 delete $Header{$_} foreach ('to', 'cc', 'bcc');
  554 $Newsgroups = $Header{'newsgroups'} if (defined($Header{'newsgroups'}));
  555 
  556 my $MessageR = [];
  557 
  558 if ($config{'no-sign'}) {
  559     # don't sign article
  560     push @$MessageR, $Header{$_} for (keys %Header);
  561     push @$MessageR, "\n", @Body;
  562 } else {
  563     # sign article
  564     $MessageR = signarticle(\%Header, \@Body);
  565 }
  566 
  567 # post or save article
  568 if (! $config{'savedir'}) {
  569     postarticle($MessageR) if ($Newsgroups);
  570 } else {
  571     savearticle($MessageR) if ($Newsgroups);
  572 }
  573 
  574 # mail article
  575 if (($To || $Cc || $Bcc) && $config{'sendmail'}) {
  576     open(my $MAIL, '|-', $config{'sendmail'}) || die("$!");
  577     unshift @$MessageR, "$To" if ($To);
  578     unshift @$MessageR, "$Cc" if ($Cc);
  579     unshift @$MessageR, "$Bcc" if ($Bcc);
  580     print($MAIL @$MessageR);
  581 
  582     close($MAIL);
  583 }
  584 
  585 # Game over. Insert new coin.
  586 exit;
  587 
  588 
  589 #-------- sub readarticle
  590 #
  591 sub readarticle {
  592     my ($HeaderR, $BodyR) = @_;
  593     my $currentheader;
  594     my $l = 0;
  595     while (defined($_ = <>)) {
  596         s#\r\n$#\n# if ($config{'transform'});
  597         if ($in_header) {
  598             use bytes;
  599             if (m/^$/o) { #end of header
  600                 $in_header = 0;
  601             } elsif (m/^([^\s:]+): (.*)$/s) {
  602                 $currentheader = lc($1);
  603                 $$HeaderR{$currentheader} = "$1: $2";
  604                 $l = length($_);
  605                 print $1 . ":-header exceeds line length limit " . $l . " > " . $config{'max-header-length'} . " octets.\n" if (($config{'verbose'} || $config{'debug'}) && length($_) > $config{'max-header-length'});
  606             } elsif (m/^[ \t]/o) {
  607                 $$HeaderR{$currentheader} .= $_;
  608                 $l = length($_);
  609                 print "Part of continued " . ucfirst($currentheader) . ":-header exceeds line length limit " . $l . " > " . $config{'max-header-length'} . " octets.\n" if (($config{'verbose'} || $config{'debug'}) && $l > $config{'max-header-length'});
  610 #           } elsif (m/^([^\s:]+):$/) { # skip over empty headers
  611 #               next;
  612             } else {
  613                 chomp($_);
  614                 # TODO: quote esc. sequences?
  615                 die("'$_' is not a correct header-line");
  616             }
  617         } else {
  618             push @$BodyR, $_;
  619         }
  620     }
  621     return;
  622 }
  623 
  624 #-------- sub getdate
  625 # getdate generates a date and returns it.
  626 #
  627 sub getdate {
  628     my @time = localtime;
  629     my $ss = ($time[0]<10) ? "0".$time[0] : $time[0];
  630     my $mm = ($time[1]<10) ? "0".$time[1] : $time[1];
  631     my $hh = ($time[2]<10) ? "0".$time[2] : $time[2];
  632     my $day = $time[3];
  633     my $month = ($time[4]+1 < 10) ? "0".($time[4]+1) : $time[4]+1;
  634     my $monthN = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$time[4]];
  635     my $wday = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$time[6]];
  636     my $year = $time[5] + 1900;
  637     my $offset = timelocal(localtime) - timelocal(gmtime);
  638     my $sign ="+";
  639     if ($offset < 0) {
  640         $sign ="-";
  641         $offset *= -1;
  642     }
  643     my $offseth = int($offset/3600);
  644     my $offsetm = int(($offset - $offseth*3600)/60);
  645     my $tz = sprintf ("%s%0.2d%0.2d", $sign, $offseth, $offsetm);
  646     return "$wday, $day $monthN $year $hh:$mm:$ss $tz";
  647 }
  648 
  649 
  650 #-------- sub AuthonNNTP
  651 # AuthonNNTP opens the connection to a Server and returns a Net::NNTP-Object.
  652 #
  653 # User, Password and Server are defined before as elements
  654 # of the global hash %config. If no values for user or password
  655 # are defined, the sub will try to ask the user (only if
  656 # $config{'interactive'} is != 0).
  657 sub AuthonNNTP {
  658     my $Server = Net::NNTP->new(
  659         Host    => $config{'nntp-server'},
  660         Reader  => 1,
  661         Debug   => $config{'debug'},
  662         Port    => $config{'nntp-port'},
  663         SSL     => $config{'ssl'},
  664         SSL_verify_mode => 0
  665     ) or die("$0: Can't connect to ".$config{'nntp-server'}.":".$config{'nntp-port'}."!\n");
  666     if ($config{'ssl'} && $config{'debug'}) {
  667         printf("SSL_fingerprint: %s %s\n", split(/\$/, $Server->get_fingerprint));
  668     }
  669     my $ServerMsg = $Server->message();
  670     my $ServerCod = $Server->code();
  671 
  672     # no read and/or write access - give up
  673     if ($ServerCod < 200 || $ServerCod > 201) {
  674         $Server->quit();
  675         die($0.": ".$ServerCod." ".$ServerMsg."\n");
  676     }
  677 
  678     # read access - try auth
  679     if ($ServerCod == 201 || $config{'force-auth'}) {
  680         if ($config{'nntp-pass'} eq "") {
  681             if ($config{'interactive'}) {
  682                 $config{'nntp-user'} = $term->readline("Your Username at ".$config{'nntp-server'}.": ");
  683                 $attribs->{redisplay_function} = $attribs->{shadow_redisplay};
  684                 $config{'nntp-pass'} = $term->readline("Password for ".$config{'nntp-user'}." at ".$config{'nntp-server'}.": ");
  685             } else {
  686                 $Server->quit();
  687                 die($0.": ".$ServerCod." ".$ServerMsg."\n");
  688             }
  689         }
  690         $Server->authinfo($config{'nntp-user'}, $config{'nntp-pass'});
  691         $ServerCod = $Server->code();
  692         $ServerMsg = $Server->message();
  693         if ($ServerCod != 281) { # auth failed
  694             $Server->quit();
  695             die $0.": ".$ServerCod." ".$ServerMsg."\n";
  696         }
  697     }
  698 
  699     $Server->post();
  700     $ServerCod = $Server->code();
  701     if ($ServerCod == 480) {
  702         if ($config{'nntp-pass'} eq "") {
  703             if ($config{'interactive'}) {
  704                 $config{'nntp-user'} = $term->readline("Your Username at ".$config{'nntp-server'}.": ");
  705                 $attribs->{redisplay_function} = $attribs->{shadow_redisplay};
  706                 $config{'nntp-pass'} = $term->readline("Password for ".$config{'nntp-user'}." at ".$config{'nntp-server'}.": ");
  707             } else {
  708                 $ServerMsg = $Server->message();
  709                 $Server->quit();
  710                 die($0.": ".$ServerCod." ".$ServerMsg."\n");
  711             }
  712         }
  713         $Server->authinfo($config{'nntp-user'}, $config{'nntp-pass'});
  714         $Server->post();
  715     }
  716     return $Server;
  717 }
  718 
  719 
  720 #-------- sub getpgpcommand
  721 # getpgpcommand generates the command to sign the message and returns it.
  722 #
  723 # Receives:
  724 #   - $pgpversion: A scalar holding the pgp-version
  725 sub getpgpcommand {
  726     my ($pgpversion) = @_;
  727     my $found = 0;
  728 
  729     if ($config{'pgp'} !~ /^\//) {
  730         foreach(split(/:/, $ENV{'PATH'})) {
  731             if (-x $_."/".$config{'pgp'}) {
  732                 $found++;
  733                 last;
  734             }
  735         }
  736     }
  737     if (!-x $config{'pgp'} && ! $found) {
  738         warn "PGP signing disabled: Can't locate executable ".$config{'pgp'}."\n" if ($config{'debug'} || $config{'verbose'});
  739         $config{'no-sign'} = 1;
  740     }
  741 
  742     if ($pgpversion eq '2') {
  743         if ($config{'pgp-pass'}) {
  744             $PGPCommand = "PGPPASS=\"".$config{'pgp-pass'}."\" ".$config{'pgp'}." -z -u \"".$config{'pgp-signer'}."\" +verbose=0 language='en' -saft <".$config{'pgptmpf'}.".txt >".$config{'pgptmpf'}.".txt.asc";
  745         } elsif ($config{'interactive'}) {
  746             $PGPCommand = $config{'pgp'}." -z -u \"".$config{'pgp-signer'}."\" +verbose=0 language='en' -saft <".$config{'pgptmpf'}.".txt >".$config{'pgptmpf'}.".txt.asc";
  747         } else {
  748             die("$0: Passphrase is unknown!\n");
  749         }
  750     } elsif ($pgpversion eq '5') {
  751         if ($config{'path-to-pgp-pass'}) {
  752             $PGPCommand = "PGPPASSFD=".$config{'pgp-pass-fd'}." ".$config{'pgp'}."s -u \"".$config{'pgp-signer'}."\" -t --armor -o ".$config{'pgptmpf'}.".txt.asc -z -f < ".$config{'pgptmpf'}.".txt ".$config{'pgp-pass-fd'}."<".$config{'path-to-pgp-pass'};
  753         } elsif ($config{'interactive'}) {
  754             $PGPCommand = $config{'pgp'}."s -u \"".$config{'pgp-signer'}."\" -t --armor -o ".$config{'pgptmpf'}.".txt.asc -z -f < ".$config{'pgptmpf'}.".txt";
  755         } else {
  756             die("$0: Passphrase is unknown!\n");
  757         }
  758     } elsif ($pgpversion eq '6') { # this is untested
  759         if ($config{'path-to-pgp-pass'}) {
  760             $PGPCommand = "PGPPASSFD=".$config{'pgp-pass-fd'}." ".$config{'pgp'}." -u \"".$config{'pgp-signer'}."\" -saft -o ".$config{'pgptmpf'}.".txt.asc < ".$config{'pgptmpf'}.".txt ".$config{'pgp-pass-fd'}."<".$config{'path-to-pgp-pass'};
  761         } elsif ($config{'interactive'}) {
  762             $PGPCommand = $config{'pgp'}." -u \"".$config{'pgp-signer'}."\" -saft -o ".$config{'pgptmpf'}.".txt.asc < ".$config{'pgptmpf'}.".txt";
  763         } else {
  764             die("$0: Passphrase is unknown!\n");
  765         }
  766     } elsif ($pgpversion =~ m/GPG1?$/io) {
  767         if ($config{'path-to-pgp-pass'}) {
  768             $PGPCommand = $config{'pgp'}." --emit-version --digest-algo $config{'digest-algo'} -a -u \"".$config{'pgp-signer'}."\" -o ".$config{'pgptmpf'}.".txt.asc --no-tty --batch --passphrase-fd ".$config{'pgp-pass-fd'}." ".$config{'pgp-pass-fd'}."<".$config{'path-to-pgp-pass'}." --clearsign ".$config{'pgptmpf'}.".txt";
  769         } elsif ($config{'interactive'}) {
  770             $PGPCommand = $config{'pgp'}." --emit-version --digest-algo $config{'digest-algo'} -a -u \"".$config{'pgp-signer'}."\" -o ".$config{'pgptmpf'}.".txt.asc --no-secmem-warning --no-batch --clearsign ".$config{'pgptmpf'}.".txt";
  771         } else {
  772             die("$0: Passphrase is unknown!\n");
  773         }
  774     } elsif ($pgpversion =~ m/GPG2$/io) {
  775         if ($config{'path-to-pgp-pass'}) {
  776             $PGPCommand = $config{'pgp'}." --pinentry-mode loopback --emit-version --digest-algo $config{'digest-algo'} -a -u \"".$config{'pgp-signer'}."\" -o ".$config{'pgptmpf'}.".txt.asc --no-tty --batch --passphrase-fd ".$config{'pgp-pass-fd'}." ".$config{'pgp-pass-fd'}."<".$config{'path-to-pgp-pass'}." --clearsign ".$config{'pgptmpf'}.".txt";
  777         } elsif ($config{'interactive'}) {
  778             $PGPCommand = $config{'pgp'}." --emit-version --digest-algo $config{'digest-algo'} -a -u \"".$config{'pgp-signer'}."\" -o ".$config{'pgptmpf'}.".txt.asc --no-secmem-warning --no-batch --clearsign ".$config{'pgptmpf'}.".txt";
  779         } else {
  780             die("$0: Passphrase is unknown!\n");
  781         }
  782     } else {
  783         die("$0: Unknown PGP-Version $pgpversion!");
  784     }
  785     return $PGPCommand;
  786 }
  787 
  788 
  789 #-------- sub postarticle
  790 # postarticle posts your article to your Newsserver.
  791 #
  792 # Receives:
  793 #   - $ArticleR: A reference to an array containing the article
  794 sub postarticle {
  795     my ($ArticleR) = @_;
  796 
  797     my $Server = AuthonNNTP();
  798     my $ServerCod = $Server->code();
  799     my $ServerMsg = $Server->message();
  800     if ($ServerCod == 340) {
  801         $Server->datasend(@$ArticleR);
  802         ## buggy Net::Cmd < 2.31
  803         $Server->set_status(200, "");
  804         $Server->dataend();
  805         $ServerCod = $Server->code();
  806         $ServerMsg = $Server->message();
  807         if (! $Server->ok()) {
  808             $Server->quit();
  809             die("\n$0: Posting failed! Response from news server:\n", $ServerCod, ' ', $ServerMsg);
  810         }
  811         $Server->quit();
  812     } else {
  813         die("\n$0: Posting failed! Response from news server:\n", $ServerCod, ' ', $ServerMsg);
  814     }
  815     return;
  816 }
  817 
  818 
  819 #-------- sub savearticle
  820 # savearticle saves your article to the directory $config{'savedir'}
  821 #
  822 # Receives:
  823 #   - $ArticleR: A reference to an array containing the article
  824 sub savearticle {
  825     my ($ArticleR) = @_;
  826     my $timestamp = timelocal(localtime);
  827     (my $ng = $Newsgroups) =~ s#^Newsgroups:\s*([^,\s]+).*#$1#i;
  828     my $gn = join "", map { substr($_,0,1) } (split(/\./, $ng));
  829     my $filename = $config{'savedir'}."/".$timestamp."-".$gn."-".$$;
  830     open(my $SH, '>', $filename) or die("$0: can't open $filename: $!\n");
  831     print $SH @$ArticleR;
  832     close($SH) or warn "$0: Couldn't close: $!\n";
  833     return;
  834 }
  835 
  836 
  837 #-------- sub signarticle
  838 # signarticle signs an article and returns a reference to an array
  839 # containing the whole signed Message.
  840 #
  841 # Receives:
  842 #   - $HeaderR: A reference to a hash containing the articles headers.
  843 #   - $BodyR: A reference to an array containing the body.
  844 #
  845 # Returns:
  846 #   - $MessageRef: A reference to an array containing the whole message.
  847 sub signarticle {
  848     my ($HeaderR, $BodyR) = @_;
  849     my (@pgphead, @pgpbody, $pgphead, $pgpbody, $signheaders, @signheaders);
  850 
  851     foreach (@{$config{'pgp-sign-headers'}}) {
  852         if (defined($$HeaderR{lc($_)}) && $$HeaderR{lc($_)} =~ m/^[^\s:]+: .+/o) {
  853             push @signheaders, $_;
  854         }
  855     }
  856 
  857     $pgpbody = join("", @$BodyR);
  858 
  859     # Delete and create the temporary pgp-Files
  860     unlink $config{'pgptmpf'}.".txt";
  861     unlink $config{'pgptmpf'}.".txt.asc";
  862     $signheaders = join(",", @signheaders);
  863 
  864     $pgphead = "X-Signed-Headers: $signheaders\n";
  865     foreach my $header (@signheaders) {
  866         if ($$HeaderR{lc($header)} =~ m/^[^\s:]+: (.+?)\n?$/so) {
  867             $pgphead .= $header.": ".$1."\n";
  868         }
  869     }
  870 
  871     unless (substr($pgpbody,-1,1)=~ /\n/ ) {$pgpbody.="\n"};
  872     open(my $FH, '>', $config{'pgptmpf'} . ".txt") or die("$0: can't open ".$config{'pgptmpf'}.": $!\n");
  873     print $FH $pgphead, "\n", $pgpbody;
  874     print $FH "\n" if ($config{'pgp-version'} =~ m/GPG/io); # workaround a pgp/gpg incompatibility - should IMHO be fixed in pgpverify
  875     close($FH) or warn "$0: Couldn't close TMP: $!\n";
  876 
  877     # Start PGP, then read the signature;
  878     `$PGPCommand`;
  879 
  880     open($FH, '<', $config{'pgptmpf'} . ".txt.asc") or die("$0: can't open ".$config{'pgptmpf'}.".txt.asc: $!\n");
  881     local $/ = "\n".$config{'pgpbegin'}."\n";
  882     $_ = <$FH>;
  883     unless (m/\Q$config{'pgpbegin'}\E$/o) {
  884         unlink $config{'pgptmpf'} . ".txt";
  885         unlink $config{'pgptmpf'} . ".txt.asc";
  886         close($FH);
  887         die("$0: ".$config{'pgpbegin'}." not found in ".$config{'pgptmpf'}.".txt.asc\n");
  888     }
  889     unlink($config{'pgptmpf'} . ".txt") or warn "$0: Couldn't unlink ".$config{'pgptmpf'}.".txt: $!\n";
  890 
  891     local $/ = "\n";
  892     $_ = <$FH>;
  893     unless (m/^Version: (\S+)(?:\s(\S+))?/o) {
  894         unlink $config{'pgptmpf'} . ".txt.asc";
  895         close($FH);
  896         die("$0: didn't find PGP Version line where expected.\n");
  897     }
  898     if (defined($2)) {
  899         $$HeaderR{$config{'pgpheader'}} = $1."-".$2." ".$signheaders;
  900     } else {
  901         $$HeaderR{$config{'pgpheader'}} = $1." ".$signheaders;
  902     }
  903     do {            # skip other pgp headers like
  904         $_ = <$FH>; # "charset:"||"comment:" until empty line
  905     } while ! /^$/;
  906 
  907     while (<$FH>) {
  908         chomp;
  909         last if /^\Q$config{'pgpend'}\E$/;
  910         $$HeaderR{$config{'pgpheader'}} .= "\n\t$_";
  911     }
  912     $$HeaderR{$config{'pgpheader'}} .= "\n" unless ($$HeaderR{$config{'pgpheader'}} =~ /\n$/s);
  913 
  914     $_ = <$FH>;
  915     unless (eof($FH)) {
  916         unlink $config{'pgptmpf'} . ".txt.asc";
  917         close($FH);
  918         die("$0: unexpected data following ".$config{'pgpend'}."\n");
  919     }
  920     close($FH);
  921     unlink $config{'pgptmpf'} . ".txt.asc";
  922 
  923     my $tmppgpheader = $config{'pgpheader'} . ": " . $$HeaderR{$config{'pgpheader'}};
  924     delete $$HeaderR{$config{'pgpheader'}};
  925 
  926     @pgphead = ();
  927     foreach my $header (@{$config{'pgp-order-headers'}}) {
  928         if ($$HeaderR{$header} && $$HeaderR{$header} ne "\n") {
  929             push(@pgphead, "$$HeaderR{$header}");
  930             delete $$HeaderR{$header};
  931         }
  932     }
  933 
  934     foreach my $header (keys %$HeaderR) {
  935         if ($$HeaderR{$header} && $$HeaderR{$header} ne "\n") {
  936             push(@pgphead, "$$HeaderR{$header}");
  937             delete $$HeaderR{$header};
  938         }
  939     }
  940 
  941     push @pgphead, ("X-PGP-Hash: " . $config{'digest-algo'} . "\n") if (defined($config{'digest-algo'}));
  942     push @pgphead, ("X-PGP-Key: " . $config{'pgp-signer'} . "\n"), $tmppgpheader;
  943     undef $tmppgpheader;
  944 
  945     @pgpbody = split(/$/m, $pgpbody);
  946     my @pgpmessage = (@pgphead, "\n", @pgpbody);
  947     return \@pgpmessage;
  948 }
  949 
  950 #-------- sub buildcancelkey
  951 # buildcancelkey builds the cancel-key based on the configured HASH algorithm.
  952 #
  953 # Receives:
  954 #   - $data: The input data.
  955 #   - $key: The secret key to be used.
  956 #
  957 # Returns:
  958 #   - $cancel_key: The calculated cancel-key.
  959 sub buildcancelkey {
  960     my ($data, $key) = @_;
  961     my $cancel_key;
  962     if ($config{'canlock-algorithm'} eq 'sha1') {
  963         $cancel_key = MIME::Base64::encode(Digest::HMAC_SHA1::hmac_sha1($data, $key), '');
  964     } elsif ($config{'canlock-algorithm'} eq 'sha256') {
  965         $cancel_key = MIME::Base64::encode(Digest::SHA::hmac_sha256($data, $key), '');
  966     } else {
  967         $cancel_key = MIME::Base64::encode(Digest::SHA::hmac_sha512($data, $key), '');
  968     }
  969     return $cancel_key;
  970 }
  971 
  972 #-------- sub buildcancellock
  973 # buildcancellock builds the cancel-lock based on the configured HASH algorithm
  974 # and the given cancel-key.
  975 #
  976 # Receives:
  977 #   - $sha_mod: A hint which module to be used for sha1.
  978 #   - $cancel_key: The cancel-key for which the lock has to be calculated.
  979 #
  980 # Returns:
  981 #   - $cancel_lock: The calculated cancel-lock.
  982 sub buildcancellock {
  983     my ($cancel_key, $sha_mod) = @_;
  984     my $cancel_lock;
  985     if ($config{'canlock-algorithm'} eq 'sha1') {
  986         if ($sha_mod =~ m/SHA1/) {
  987             $cancel_lock = MIME::Base64::encode(Digest::SHA1::sha1($cancel_key, ''), '');
  988         } else {
  989             $cancel_lock = MIME::Base64::encode(Digest::SHA::sha1($cancel_key, ''), '');
  990         }
  991     } elsif ($config{'canlock-algorithm'} eq 'sha256') {
  992         $cancel_lock = MIME::Base64::encode(Digest::SHA::sha256($cancel_key, ''), '');
  993     } else {
  994         $cancel_lock = MIME::Base64::encode(Digest::SHA::sha512($cancel_key, ''), '');
  995     }
  996     return $cancel_lock;
  997 }
  998 
  999 sub version {
 1000     print $pname." ".$version."\n";
 1001     return;
 1002 }
 1003 
 1004 sub usage {
 1005     version();
 1006     print "Usage: ".$pname." [OPTS] < article\n";
 1007     print "  -a string  set Approved:-header to string\n";
 1008     print "  -c string  set Control:-header to string\n";
 1009     print "  -d string  set Distribution:-header to string\n";
 1010     print "  -e string  set Expires:-header to string\n";
 1011     print "  -f string  set From:-header to string\n";
 1012     print "  -i string  list of headers to be ignored for signing\n";
 1013     print "  -m string  set Message-ID:-header to string\n";
 1014     print "  -n string  set Newsgroups:-header to string\n";
 1015     print "  -o string  set Organization:-header to string\n";
 1016     print "  -p port    use port as NNTP port [default=".$config{'nntp-port'}."]\n";
 1017     print "  -r string  set Reply-To:-header to string\n";
 1018     print "  -s string  save signed article to directory string instead of posting\n";
 1019     print "  -t string  set Subject:-header to string\n";
 1020     print "  -v         show warnings about missing/disabled features\n";
 1021     print "  -w string  set Followup-To:-header to string\n";
 1022     print "  -x string  prepend Path:-header with string\n";
 1023     print "  -D         enable debugging\n";
 1024     print "  -E         silently discard empty article\n";
 1025     print "  -F string  set References:-header to string\n";
 1026     print "  -H         show help\n";
 1027     print "  -I         do not add Injection-Date: header\n";
 1028     print "  -L         do not add Cancel-Lock: / Cancel-Key: headers\n";
 1029     print "  -O         do not add Organization:-header\n";
 1030     print "  -R         disallow control messages\n";
 1031     print "  -S         do not append " . $config{'sig-path'} . "\n";
 1032     print "  -X         do not sign article\n";
 1033     print "  -Y         force authentication on connect\n";
 1034     print " --canlock-algorithm string\n";
 1035     print "             digest algorithm for Cancel-Lock (sha1, sha256 or sha512)\n";
 1036     print " --ssl       use NNTPS (via port 563) if available\n";
 1037     print " --transform convert <CR><LF> to <LF>\n";
 1038     print " --version   show version\n";
 1039     printf ("\nAvailable tinewsrc-vars: %s\n", join(", ",sort keys %config)) if ($config{'verbose'} || $config{'debug'});
 1040     exit 0;
 1041 }
 1042 
 1043 __END__
 1044 
 1045 =head1 NAME
 1046 
 1047 tinews.pl - Post and sign an article via NNTP
 1048 
 1049 =head1 SYNOPSIS
 1050 
 1051 B<tinews.pl> [B<OPTIONS>] E<lt> I<input>
 1052 
 1053 =head1 DESCRIPTION
 1054 
 1055 B<tinews.pl> reads an article on STDIN, signs it via L<pgp(1)> or
 1056 L<gpg(1)> and posts it to a news server.
 1057 
 1058 The article shall not contain any raw 8-bit data or it needs to
 1059 already have the relevant MIME-headers as B<tinews.pl> will not
 1060 add any MIME-headers nor encode its input.
 1061 
 1062 If the article contains To:, Cc: or Bcc: headers and mail-actions are
 1063 configured it will automatically add a "Posted-And-Mailed: yes" header
 1064 to the article and send out the mail-copies.
 1065 
 1066 If a Cancel-Lock secret file is defined it will automatically add a
 1067 Cancel-Lock: (and Cancel-Key: if required) header.
 1068 
 1069 The input should have unix line endings (<LF>, '\n'). Use --B<transform>
 1070 to convert from <CR><LF> to just <LF>.
 1071 
 1072 =head1 OPTIONS
 1073 X<tinews, command-line options>
 1074 
 1075 =over 4
 1076 
 1077 =item -B<a> C<Approved> | --B<approved> C<Approved>
 1078 X<-a> X<--approved>
 1079 
 1080 Set the article header field Approved: to the given value.
 1081 
 1082 =item -B<c> C<Control> | --B<control> C<Control>
 1083 X<-c> X<--control>
 1084 
 1085 Set the article header field Control: to the given value.
 1086 
 1087 =item -B<d> C<Distribution> | --B<distribution> C<Distribution>
 1088 X<-d> X<--distribution>
 1089 
 1090 Set the article header field Distribution: to the given value.
 1091 
 1092 =item -B<e> C<Expires> | --B<expires> C<Expires>
 1093 X<-e> X<--expires>
 1094 
 1095 Set the article header field Expires: to the given value.
 1096 
 1097 =item -B<f> C<From> | --B<from> C<From>
 1098 X<-f> X<--from>
 1099 
 1100 Set the article header field From: to the given value.
 1101 
 1102 =item -B<i> F<header> | --B<ignore-headers> F<header>
 1103 X<-i> X<--ignore-headers>
 1104 
 1105 Comma separated list of headers that will be ignored during signing.
 1106 Usually the following headers will be signed if present:
 1107 
 1108 From, Newsgroups, Subject, Control, Supersedes, Followup-To,
 1109 Date, Injection-Date, Sender, Approved, Message-ID, Reply-To,
 1110 Cancel-Key, Also-Control and Distribution.
 1111 
 1112 Some of them may be altered on the Server (i.e. Cancel-Key) which would
 1113 invalid the signature, this option can be used the exclude such headers
 1114 if required.
 1115 
 1116 =item -B<m> C<Message-ID> | --B<message-id> C<Message-ID>
 1117 X<-m> X<--message-id>
 1118 
 1119 Set the article header field Message-ID: to the given value.
 1120 
 1121 =item -B<n> C<Newsgroups> | --B<newsgroups> C<Newsgroups>
 1122 X<-n> X<--newsgroups>
 1123 
 1124 Set the article header field Newsgroups: to the given value.
 1125 
 1126 =item -B<o> C<Organization> | --B<organization> C<Organization>
 1127 X<-o> X<--organization>
 1128 
 1129 Set the article header field Organization: to the given value.
 1130 
 1131 =item -B<p> C<port> | --B<port> C<port>
 1132 X<-p> X<--port>
 1133 
 1134 use C<port> as NNTP-port
 1135 
 1136 =item -B<r> C<Reply-To> | --B<reply-to> C<Reply-To>
 1137 X<-r> X<--reply-to>
 1138 
 1139 Set the article header field Reply-To: to the given value.
 1140 
 1141 =item -B<s> F<directory> | --B<savedir> F<directory>
 1142 X<-s> X<--savedir>
 1143 
 1144 Save signed article to directory F<directory> instead of posting.
 1145 
 1146 =item -B<t> C<Subject> | --B<subject> C<Subject>
 1147 X<-t> X<--subject>
 1148 
 1149 Set the article header field Subject: to the given value.
 1150 
 1151 =item -B<v> | --B<verbose>
 1152 X<-v> X<--verbose>
 1153 
 1154 Warn about disabled options due to lacking perl-modules or executables and
 1155 unreadable files and enable warnings about raw 8-bit data.
 1156 
 1157 =item -B<w> C<Followup-To> | --B<followup-to> C<Followup-To>
 1158 X<-w> X<--followup-to>
 1159 
 1160 Set the article header field Followup-To: to the given value.
 1161 
 1162 =item -B<x> C<Path> | --B<path> C<Path>
 1163 X<-x> X<--path>
 1164 
 1165 Prepend the article header field Path: with the given value.
 1166 
 1167 =item -B<D> | -B<N> | --B<debug>
 1168 X<-D> X<-N> X<--debug>
 1169 
 1170 Set L<Net::NNTP(3pm)> to debug mode, enable warnings about raw 8-bit data,
 1171 warn about disabled options due to lacking perl-modules or executables and
 1172 unreadable files.
 1173 
 1174 =item -B<E> | --B<discard-empty>
 1175 X<-E> X<--discard-empty>
 1176 
 1177 Silently discard an empty article.
 1178 
 1179 =item -B<F> | --B<references>
 1180 X<-F> X<--references>
 1181 
 1182 Set the article header field References: to the given value.
 1183 
 1184 =item -B<H> | --B<help>
 1185 X<-H> X<--help>
 1186 
 1187 Show help-page.
 1188 
 1189 =item -B<I> | --B<no-injection-date>
 1190 X<-I> X<--no-injection-date>
 1191 
 1192 Do not add Injection-Date: header.
 1193 
 1194 =item -B<L> | --B<no-canlock>
 1195 X<-L> X<--no-canlock>
 1196 
 1197 Do not add Cancel-Lock: / Cancel-Key: headers.
 1198 
 1199 =item -B<O> | --B<no-organization>
 1200 X<-O> X<--no-organization>
 1201 
 1202 Do not add Organization: header.
 1203 
 1204 =item -B<R> | --B<no-control>
 1205 X<-R> X<--no-control>
 1206 
 1207 Restricted mode, disallow control-messages.
 1208 
 1209 =item -B<S> | --B<no-signature>
 1210 X<-s> X<--no-signature>
 1211 
 1212 Do not append F<$HOME/.signature>.
 1213 
 1214 =item -B<X> | --B<no-sign>
 1215 X<-X> X<--no-sign>
 1216 
 1217 Do not sign the article.
 1218 
 1219 =item -B<Y> | --B<force-auth>
 1220 X<-Y> X<--force-auth>
 1221 
 1222 Force authentication on connect even if not required by the server.
 1223 
 1224 =item --B<canlock-algorithm> C<Algorithm>
 1225 X<--canlock-algorithm>
 1226 
 1227 Digest algorithm used for Cancel-Lock: / Cancel-Key: headers.
 1228 Supported algorithms are sha1, sha256 and sha512. Default is sha1.
 1229 
 1230 =item --B<ssl> | --B<nntps>
 1231 X<--ssl> X<--nntps>
 1232 
 1233 Use NNTPS (via port 563) if available. This requires a recent version
 1234 of L<Net::NNTP(3pm)> and L<IO::Socket::SSL(3pm)>. Be aware that no SSL
 1235 verification will be done.
 1236 
 1237 =item --B<transform>
 1238 X<--transform>
 1239 
 1240 Convert network line endings (<CR><LF>) to unix line endings (<LF>).
 1241 
 1242 =item --B<version>
 1243 X<--version>
 1244 
 1245 Show version.
 1246 
 1247 =item -B<A> -B<V> -B<W>
 1248 X<-A> X<-V> X<-W>
 1249 
 1250 These options are accepted for compatibility reasons but ignored.
 1251 
 1252 =item -B<h> | --B<headers>
 1253 X<-h> X<--headers>
 1254 
 1255 These options are accepted for compatibility reasons but ignored.
 1256 
 1257 =back
 1258 
 1259 =head1 EXIT STATUS
 1260 
 1261 The following exit values are returned:
 1262 
 1263 =over 4
 1264 
 1265 =item S< 0>
 1266 
 1267 Successful completion.
 1268 
 1269 =item S<!=0>
 1270 
 1271 An error occurred.
 1272 
 1273 =back
 1274 
 1275 =head1 ENVIRONMENT
 1276 X<tinews, environment variables>
 1277 
 1278 =over 4
 1279 
 1280 =item B<$NEWSHOST>
 1281 X<$NEWSHOST> X<NEWSHOST>
 1282 
 1283 Set to override the NNTP server configured in the source or config-file.
 1284 It has lower priority than B<$NNTPSERVER> and should be avoided.
 1285 
 1286 =item B<$NNTPSERVER>
 1287 X<$NNTPSERVER> X<NNTPSERVER>
 1288 
 1289 Set to override the NNTP server configured in the source or config-file.
 1290 This has higher priority than B<$NEWSHOST>.
 1291 
 1292 =item B<$NNTPPORT>
 1293 X<$NNTPPORT> X<NNTPPORT>
 1294 
 1295 The NNTP TCP-port to post news to. This variable only needs to be set if the
 1296 TCP-port is not 119 (the default). The '-B<p>' command-line option overrides
 1297 B<$NNTPPORT>.
 1298 
 1299 =item B<$PGPPASS>
 1300 X<$PGPPASS> X<PGPPASS>
 1301 
 1302 Set to override the passphrase configured in the source (used for
 1303 L<pgp(1)>-2.6.3).
 1304 
 1305 =item B<$PGPPASSFILE>
 1306 X<$PGPPASSFILE> X<PGPPASSFILE>
 1307 
 1308 Passphrase file used for L<pgp(1)> or L<gpg(1)>.
 1309 
 1310 =item B<$SIGNER>
 1311 X<$SIGNER> X<SIGNER>
 1312 
 1313 Set to override the user-id for signing configured in the source. If you
 1314 neither set B<$SIGNER> nor configure it in the source the contents of the
 1315 From:-field will be used.
 1316 
 1317 =item B<$REPLYTO>
 1318 X<$REPLYTO> X<REPLYTO>
 1319 
 1320 Set the article header field Reply-To: to the return address specified by
 1321 the variable if there isn't already a Reply-To: header in the article.
 1322 The '-B<r>' command-line option overrides B<$REPLYTO>.
 1323 
 1324 =item B<$ORGANIZATION>
 1325 X<$ORGANIZATION> X<ORGANIZATION>
 1326 
 1327 Set the article header field Organization: to the contents of the variable
 1328 if there isn't already an Organization: header in the article. The '-B<o>'
 1329 command-line option overrides B<$ORGANIZATION>, The '-B<O>' command-line
 1330 option disables it.
 1331 
 1332 =item B<$DISTRIBUTION>
 1333 X<$DISTRIBUTION> X<DISTRIBUTION>
 1334 
 1335 Set the article header field Distribution: to the contents of the variable
 1336 if there isn't already a Distribution: header in the article. The '-B<d>'
 1337 command-line option overrides B<$DISTRIBUTION>.
 1338 
 1339 =back
 1340 
 1341 =head1 FILES
 1342 
 1343 =over 4
 1344 
 1345 =item F<pgptmp.txt>
 1346 
 1347 Temporary file used to store the reformatted article.
 1348 
 1349 =item F<pgptmp.txt.asc>
 1350 
 1351 Temporary file used to store the reformatted and signed article.
 1352 
 1353 =item F<$PGPPASSFILE>
 1354 
 1355 The passphrase file to be used for L<pgp(1)> or L<gpg(1)>.
 1356 
 1357 =item F<$HOME/.signature>
 1358 
 1359 Signature file which will be automatically included.
 1360 
 1361 =item F<$HOME/.cancelsecret>
 1362 
 1363 The passphrase file to be used for Cancel-Locks. This feature is turned
 1364 off by default.
 1365 
 1366 =item F<$HOME/.newsauth>
 1367 
 1368 "nntpserver password [user]" pairs or triples for NNTP servers that require
 1369 authorization. First match counts. Any line that starts with "#" is a
 1370 comment. Blank lines are ignored. This file should be readable only for the
 1371 user as it contains the user's unencrypted password for reading news. If no
 1372 matching entry is found F<$HOME/.nntpauth> is checked.
 1373 
 1374 =item F<$HOME/.nntpauth>
 1375 
 1376 "nntpserver user password" triples for NNTP servers that require
 1377 authorization. First match counts. Lines starting with "#" are skipped and
 1378 blank lines are ignored. This file should be readable only for the user as
 1379 it contains the user's unencrypted password for reading news.
 1380 F<$HOME/.newsauth> is checked first.
 1381 
 1382 =item F<$XDG_CONFIG_HOME/tinewsrc> F<$HOME/.config/tinewsrc> F<$HOME/.tinewsrc>
 1383 
 1384 "option=value" configuration pairs, last match counts and only
 1385 "value" is case sensitive. Lines that start with "#" are ignored. If the
 1386 file contains unencrypted passwords (e.g. nntp-pass or pgp-pass), it
 1387 should be readable for the user only. Use -B<vH> to get a full list of
 1388 all available configuration options.
 1389 
 1390 =back
 1391 
 1392 =head1 SECURITY
 1393 
 1394 If you've configured or entered a password, even if the variable that
 1395 contained that password has been erased, it may be possible for someone to
 1396 find that password, in plaintext, in a core dump. In short, if serious
 1397 security is an issue, don't use this script.
 1398 
 1399 Be aware that even if NNTPS is used still no SSL verification will be done.
 1400 
 1401 =head1 NOTES
 1402 
 1403 B<tinews.pl> is designed to be used with L<pgp(1)>-2.6.3,
 1404 L<pgp(1)>-5, L<pgp(1)>-6, L<gpg(1)> and L<gpg2(1)>.
 1405 
 1406 B<tinews.pl> requires the following standard modules to be installed:
 1407 L<Getopt::Long(3pm)>, L<Net::NNTP(3pm)>, L<Time::Local(3pm)> and
 1408 L<Term::Readline(3pm)>.
 1409 
 1410 NNTPS (NNTP with implicit TLS; RFC 4642 and RFC 8143) may be unavailable
 1411 if L<Net::NNTP(3pm)> is too old or L<IO::Socket::SSL(3pm)> is missing on
 1412 the system. B<tinews.pl> will fallback to unencrypted NNTP in that case.
 1413 
 1414 If the Cancel-Lock feature (RFC 8315) is enabled the following additional
 1415 modules must be installed: L<MIME::Base64(3pm)>, L<Digest::SHA(3pm)> or
 1416 L<Digest::SHA1(3pm)> and L<Digest::HMAC_SHA1(3pm)>. sha256 and sha512 as
 1417 algorithms for B<canlock-algorithm> are only available with L<Digest::SHA(3pm)>.
 1418 
 1419 L<gpg2(1)> users may need to set B<$GPG_TTY>, i.e.
 1420 
 1421  GPG_TTY=$(tty)
 1422  export GPG_TTY
 1423 
 1424 before using B<tinews.pl>. See L<https://www.gnupg.org/> for details.
 1425 
 1426 B<tinews.pl> does not do any MIME encoding, its input should be already
 1427 properly encoded and have all relevant headers set.
 1428 
 1429 =head1 AUTHOR
 1430 
 1431 Urs Janssen E<lt>urs@tin.orgE<gt>,
 1432 Marc Brockschmidt E<lt>marc@marcbrockschmidt.deE<gt>
 1433 
 1434 =head1 SEE ALSO
 1435 
 1436 L<pgp(1)>, L<gpg(1)>, L<gpg2(1)>, L<pgps(1)>, L<Digest::HMAC_SHA1(3pm)>,
 1437 L<Digest::SHA(3pm)>, L<Digest::SHA1(3pm)>, L<Getopt::Long(3pm)>,
 1438 L<IO::Socket::SSL(3pm)>, L<MIME::Base64(3pm)>, L<Net::NNTP(3pm)>,
 1439 L<Time::Local(3pm)>, L<Term::Readline(3pm)>
 1440 
 1441 =cut