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