"Fossies" - the Fresh Open Source Software Archive

Member "tin-2.4.5/tools/tinews.pl" (24 Dec 2020, 47778 Bytes) of package /linux/misc/tin-2.4.5.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.4.4_vs_2.4.5.

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