"Fossies" - the Fresh Open Source Software Archive

Member "tin-2.6.1/tools/tinews.pl" (22 Dec 2021, 48223 Bytes) of package /linux/misc/tin-2.6.1.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.0_vs_2.6.1.

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