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