TIN: tools/tinews.pl

"Fossies" - the Fresh Open Source Software Archive

Member "tin-2.4.5/tools/tinews.pl" (24 Dec 2020, 47778 Bytes) of package /linux/misc/tin-2.4.5.tar.xz:

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

2.4.4_vs_2.4.5.

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