2 # written April 1996, tale@isc.org (David C Lawrence)
3 # Currently maintained by Russ Allbery <rra@stanford.edu>
4 # Version 1.8, 2003-07-06
6 # Changes from 1.6 -> 1.8
7 # -- Added support for GnuPG.
8 # -- Replace signing code with code from PGP::Sign that generates detached
9 # signatures instead. Otherwise, GnuPG signatures with DSA keys could
10 # not be verified. Should still work the same as before with RSA keys.
11 # -- Thanks to new signing code, no longer uses a temporary file.
12 # -- Only lock when using PGP; GnuPG shouldn't need it.
14 # Changes from 1.5 -> 1.6
15 # -- eliminated subprocess use (except pgp, of course).
16 # -- interlock against competing signing processes.
17 # -- allow optional headers; see $use_or_add.
18 # -- added simple comments about why particular headers are signed.
19 # -- made error messages a tad more helpful for situations when it is hard
20 # to know what message was trying to be signed (such as via an "at"
22 # -- set $action, $group, $moderated to "" to prevent unusued variable
23 # warnings in the event a Control header can't be parsed.
24 # -- moved assignment of $pgpend out of loop.
26 # Changes from 1.4 -> 1.5
27 # -- need to require Text::Tabs to get 'expand' for tabs in checkgroups.
29 # Changes from 1.3 -> 1.4
30 # -- added checkgroups checking.
31 # -- added group name in several error messages (for help w/batch
33 # -- disabled moderator address checking.
34 # -- adjusted newsgroups line (ie, tabbing fixed) now correctly
35 # substituted into control message.
37 # Changes from 1.2.3 -> 1.3
38 # -- skip minor pgp signature headers like "charset:" after "version:"
39 # header and until the empty line that starts the base64 signature block.
45 # $pgp can be set to the path to GnuPG to use GnuPG instead. The program
46 # name needs to end in gpg so that signcontrol knows GnuPG is being used.
48 # STORING YOUR PASS PHRASE IN A FILE IS A POTENTIAL SECURITY HOLE.
49 # make sure you know what you're doing if you do it.
50 # if you don't use pgppassfile, you can only use this script interactively.
51 # if you DO use pgppassfile, it is possible that someone could steal
52 # your passphrase either by gaining access to the file or by seeing
53 # the environment of a running pgpverify program.
55 # $pgplock is used because pgp does not guard itself against concurrent
56 # read/write access to its randseed.bin file. A writable file is needed;
57 # The default value is to use the .pgp/config.txt file in the home
58 # directory of the user running the program. Note that this will only
59 # work to lock against other instances of signcontrol, not all pgp uses.
60 # $pgplock is not used if $pgp ends in 'gpg' since GnuPG doesn't need
62 $pgpsigner = 'INSERT_YOUR_PGP_USERID';
63 $pgppassfile = ''; # file with pass phrase for $pgpsigner
64 $pgp = "/usr/local/bin/pgp";
65 $pgpheader = "X-PGP-Sig";
66 $pgplock = (getpwuid($<))[7] . '/.pgp/config.txt';
68 # this program is strict about always wanting to be consistent about what
69 # headers appear in the control messages. the defaults for the
70 # @... arrays are reasonable, but you should edit the force values.
72 # these headers are acceptable in input, but they will be overwritten with
73 # these values. no sanity checking is done on what you put here. also,
74 # Subject: is forced to be the Control header prepending by "cmsg". also,
75 # Newsgroups: is forced to be just the group being added/removed.
76 # (but is taken as-is for checkgroups)
77 $force{'Path'} = 'bounce-back';
78 $force{'From'} = 'YOUR_ADDRESS_AND_NAME';
79 $force{'Approved'} = 'ADDRESS_FOR_Approved_HEADER';
80 $force{'X-Info'}='ftp://ftp.isc.org/pub/pgpcontrol/README.html'
82 . 'ftp://ftp.isc.org/pub/pgpcontrol/README';
84 # these headers are acceptable in input, or if not present then will be
85 # created with the given value. None are enabled by default, because they
86 # should not be necessary. Setting one to a null string will pass through
87 # any instance of it found in the input, but not generate one if it is
88 # missing. If you set any $default{} variables, you must also put it in
89 # @orderheaders below.
91 # Note that Distribution nearly never works correctly, so use it only if
92 # you are really sure the propagation of the article will be limited as
93 # you intend. This normally means that you control all servers the
94 # distribution will go to with an iron fist.
96 # $use_or_add{'Reply-To'} = 'YOUR_REPLY_ADDRESS';
97 # $use_or_add{'Oranization'} = 'YOUR_ORGANIZATION';
98 # $use_or_add{'Distribution'} = 'MESSAGE_DISTRIBUTION';
100 # host for message-id; this could be determined automatically based on
101 # where it is run, but consistency is the goal here
102 $id_host = 'FULL_HOST_NAME';
104 # headers to sign. Sender is included because non-PGP authentication uses
105 # it. The following should always be signed:
106 # Subject -- some older news systems use it to identify the control action.
107 # Control -- most news systems use this to determine what to do.
108 # Message-ID -- guards against replay attacks.
109 # Date -- guards against replay attacks.
110 # From -- used by news systems as part of authenticating the message.
111 # Sender -- used by news systems as part of authenticating the message.
112 @signheaders = ('Subject', 'Control', 'Message-ID', 'Date', 'From', 'Sender');
114 # headers to remove from real headers of final message.
115 # If it is a signed header, it is signed with an empty value.
116 # set to () if you do not want any headers removed.
117 @ignoreheaders = ('Sender');
119 # headers that will appear in final message, and their order of
120 # appearance. all _must_ be set, either in input or via the $force{} and
121 # $use_or_add{} variables above.
122 # (exceptions: Date, Lines, Message-ID are computed by this program)
123 # if header is in use_or_add with a null value, it will not appear in output.
124 # several are required by the news article format standard; if you remove
125 # these, your article will not propagate:
126 # Path, From, Newsgroups, Subject, Message-ID, Date
127 # if you take out these, your control message is not very useful:
129 # any headers in @ignoreheaders also in @orderheaders are silently dropped.
130 # any non-null header in the input but not in @orderheaders or @ignoreheaders
132 # null headers are silently dropped.
134 ('Path', 'From', 'Newsgroups', 'Subject', 'Control', 'Approved',
135 'Message-ID', 'Date', 'Lines', 'X-Info', $pgpheader);
137 # this program tries to help you out by not letting you sign erroneous
138 # names, especially ones that are so erroneous they run afoul of naming
141 # set to match only hierarchies you will use it on
142 # include no '|' for a single hierarchy (eg, "$hierarchies = 'uk';").
144 $hierarchies = 'HIERARCHIES';
146 # the draft news article format standard says:
147 # "subsequent components SHOULD begin with a letter"
148 # where "SHOULD" means:
149 # means that the item is a strong recommendation: there may be
150 # valid reasons to ignore it in unusual circumstances, but
151 # this should be done only after careful study of the full
152 # implications and a firm conclusion that it is necessary,
153 # because there are serious disadvantages to doing so.
154 # as opposed to "MUST" which means:
155 # means that the item is an absolute requirement of the specification
156 # MUST is preferred, but might not be acceptable if you have legacy
157 # newsgroups that have name components that begin with a letter, like
158 # news.announce.newgroups does with comp.sys.3b1 and 17 other groups.
160 $start_component_with_letter = 'MUST';
164 use Fcntl qw(F_SETFD);
166 use IPC::Open3 qw(open3);
167 use POSIX qw(setlocale strftime LC_TIME);
168 use Text::Tabs; # to get 'expand' for tabs in checkgroups
172 die "Usage: $0 < message\n" if @ARGV > 0;
174 umask(0022); # flock needs a writable file, if we create it
175 if ($pgp !~ /gpg$/) {
176 open(LOCK, ">>$pgplock") || die "$0: open $lock: $!, exiting\n";
177 flock(LOCK, 2); # block until locked
189 die "$0: ERROR PROCESSING ${action}group $group:\n", $die;
190 } elsif ($action eq 'check') {
191 die "$0: ERROR PROCESSING checkgroups:\n", $die;
192 } elsif ($header{'Subject'}) {
193 die "$0: ERROR PROCESSING Subject: $header{'Subject'}\n", $die;
201 if ($pgp !~ /gpg$/) {
202 close(LOCK) || warn "$0: close $lock: $!\n";
210 my ($hierarchy, $plain_component, $no_component);
211 my ($must_start_letter, $should_start_letter);
214 # newsgroup name checks based on RFC 1036bis (not including encodings) rules:
215 # "component MUST contain at least one letter"
216 # "[component] MUST not contain uppercase letters"
217 # "[component] MUST begin with a letter or digit"
218 # "[component] MUST not be longer than 14 characters"
219 # "sequences 'all' and 'ctl' MUST not be used as components"
220 # "first component MUST begin with a letter"
221 # and enforcing "subsequent components SHOULD begin with a letter" as MUST
222 # and enforcing at least a 2nd level group (can't use to newgroup "general")
224 # DO NOT COPY THIS PATTERN BLINDLY TO OTHER APPLICATIONS!
225 # It has special construction based on the pattern it is finally used in.
227 $plain_component = '[a-z][-+_a-z\d]{0,13}';
228 $no_component = '(.*\.)?(all|ctl)(\.|$)';
229 $must_start_letter = '(\.' . $plain_component . ')+';
230 $should_start_letter = '(\.(?=\d*[a-z])[a-z\d]+[-+_a-z\d]{0,13})+';
232 $grouppat = "(?!$no_component)($hierarchies)";
233 if ($start_component_with_letter eq 'SHOULD') {
234 $grouppat .= $should_start_letter;
235 } elsif ($start_component_with_letter eq 'MUST') {
236 $grouppat .= $must_start_letter;
238 die "$0: unknown value configured for \$start_component_with_letter\n";
241 foreach $hierarchy (split(/\|/, $hierarchies)) {
242 die "$0: hierarchy name $hierarchy not standards-compliant\n"
243 if $hierarchy !~ /^$plain_component$/o;
246 $eval = "\$_ = 'test'; /$grouppat/;";
248 die "$0: bad regexp for matching group names:\n $@" if $@;
255 my($head, $label, $value);
259 $head = <STDIN>; # get the whole news header
260 $die .= "$0: continuation lines in headers not allowed\n"
261 if $head =~ s/\n[ \t]+/ /g; # rejoin continued lines
263 for (split(/\n/, $head)) {
264 if (/^(\S+): (.*)/) {
268 $die .= "$0: duplicate header $label\n" if $header{$label};
270 $header{$label} = $value;
271 $header{$label} =~ s/^\s+//;
272 $header{$label} =~ s/\s+$//;
274 ; # the empty line separator(s)
276 $die .= "$0: non-header line:\n $_\n";
280 $header{'Message-ID'} = '<' . time . ".$$\@$id_host>";
282 setlocale(LC_TIME, "C");
283 $header{'Date'} = strftime("%a, %d %h %Y %T -0000", gmtime);
285 for (@ignoreheaders) {
286 $die .= "ignored header $_ also has forced value set\n" if $force{$_};
290 for (@orderheaders) {
291 $header{$_} = $force{$_} if defined($force{$_});
292 next if /^(Lines|\Q$pgpheader\E)$/; # these are set later
293 unless ($header{$_}) {
294 if (defined($use_or_add{$_})) {
295 $header{$_} = $use_or_add{$_} if $use_or_add{$_} ne '';
297 $die .= "$0: missing $_ header\n";
302 $action = $group = $moderated = "";
303 if ($header{'Control'}) {
304 if ($header{'Control'} =~ /^(new)group (\S+)( moderated)?$/o ||
305 $header{'Control'} =~ /^(rm)group (\S+)()$/o ||
306 $header{'Control'} =~ /^(check)groups()()$/o) {
307 ($action, $group, $moderated) = ($1, $2, $3);
308 $die .= "$0: group name $group is not standards-compliant\n"
309 if $group !~ /^$grouppat$/ && $action eq 'new';
310 $die .= "$0: no group to rmgroup on Control: line\n"
311 if ! $group && $action eq 'rm';
312 $header{'Subject'} = "cmsg $header{'Control'}";
313 $header{'Newsgroups'} = $group unless $action eq 'check';
315 $die .= "$0: bad Control format: $header{'Control'}\n";
318 $die .= "$0: can't verify message content; missing Control header\n";
327 local($status, $ngline, $fixline, $used, $desc, $mods);
330 $body = $_ = <STDIN>;
331 $header{'Lines'} = $body =~ tr/\n/\n/ if $body;
333 # the following tests are based on the structure of a
334 # news.announce.newgroups newgroup message; even if you comment out the
335 # "first line" test, please leave the newsgroups line and moderators
337 if ($action eq 'new') {
338 $status = $moderated ? 'a\smoderated' : 'an\sunmoderated';
339 $die .= "$0: nonstandard first line in body for $group\n"
340 if ! /^\Q$group\E\sis\s$status\snewsgroup\b/;
342 my $intro = "For your newsgroups file:\n";
344 (/^$intro\Q$group\E[ \t]+(.+)\n(\n|\Z(?!\n))/mi)[0];
349 $fixline .= "\t" x ((length) > 23 ? 1 : (4 - ((length) + 1) / 8));
350 $used = (length) < 24 ? 24 : (length) + (8 - (length) % 8);
352 $desc =~ s/ \(Moderated\)//i;
355 $die .= "$0: $group description too long\n" if $used + length($desc) > 80;
357 $fixline .= ' (Moderated)' if $moderated;
358 $body =~ s/^$intro(.+)/$intro$fixline/mi;
360 $die .= "$0: $group newsgroup line not formatted correctly\n";
362 # moderator checks are disabled; some sites were trying to
363 # automatically maintain aliases based on this, which is bad policy.
364 if (0 && $moderated) {
365 $die .= "$0: $group submission address not formatted correctly\n"
366 if $body !~ /\nGroup submission address: ?\S+@\S+\.\S+\n/m;
367 $mods = "( |\n[ \t]+)\\([^)]+\\)\n\n";
368 $die .= "$0: $group contact address not formatted correctly\n"
369 if $body !~ /\nModerator contact address: ?\S+@\S+\.\S+$mods/m;
372 # rmgroups have freeform bodies
374 # checkgroups have structured bodies
375 if ($action eq 'check') {
376 for (split(/\n/, $body)) {
377 my ($group, $description) = /^(\S+)\t+(.+)/;
378 $die .= "$0: no group:\n $_\n" unless $group;
379 $die .= "$0: no description:\n $_\n" unless $description;
380 $die .= "$0: bad group name \"$group\"\n" if $group !~ /^$grouppat$/;
381 $die .= "$0: tab in description\n" if $description =~ /\t/;
383 $die .= "$0: $group line too long\n" if length(expand($_)) > 80;
388 # Create a detached signature for the given data. The first argument
389 # should be a key id, the second argument the PGP passphrase (which may be
390 # null, in which case PGP will prompt for it), and the third argument
391 # should be the complete message to sign.
393 # In a scalar context, the signature is returned as an ASCII-armored block
394 # with embedded newlines. In array context, a list consisting of the
395 # signature and the PGP version number is returned. Returns undef in the
396 # event of an error, and the error text is then stored in @ERROR.
398 # This function is taken almost verbatim from PGP::Sign except the PGP
399 # style is determined from the name of the program used.
401 my ($keyid, $passphrase, $message) = @_;
403 # Ignore SIGPIPE, since we're going to be talking to PGP.
404 local $SIG{PIPE} = 'IGNORE';
406 # Determine the PGP style.
407 my $pgpstyle = 'PGP2';
408 if ($pgp =~ /pgps$/) { $pgpstyle = 'PGP5' }
409 elsif ($pgp =~ /gpg$/) { $pgpstyle = 'GPG' }
411 # Figure out what command line we'll be using. PGP v6 and PGP v2 use
412 # compatible syntaxes for what we're trying to do. PGP v5 would have,
413 # except that the -s option isn't valid when you call pgps. *sigh*
415 if ($pgpstyle eq 'PGP5') {
416 @command = ($pgp, qw/-baft -u/, $keyid);
417 } elsif ($pgpstyle eq 'GPG') {
418 @command = ($pgp, qw/--detach-sign --armor --textmode -u/, $keyid,
419 qw/--force-v3-sigs --pgp2/);
421 @command = ($pgp, qw/-sbaft -u/, $keyid);
424 # We need to send the password to PGP, but we don't want to use either
425 # the command line or an environment variable, since both may expose us
426 # to snoopers on the system. So we create a pipe, stick the password in
427 # it, and then pass the file descriptor to PGP. PGP wants to know about
428 # this in an environment variable; GPG uses a command-line flag.
429 # 5.005_03 started setting close-on-exec on file handles > $^F, so we
430 # need to clear that here (but ignore errors on platforms where fcntl or
431 # F_SETFD doesn't exist, if any).
433 # Make sure that the file handles are created outside of the if
434 # statement, since otherwise they leave scope at the end of the if
435 # statement and are automatically closed by Perl.
436 my $passfh = new FileHandle;
437 my $writefh = new FileHandle;
438 local $ENV{PGPPASSFD};
440 pipe ($passfh, $writefh);
441 eval { fcntl ($passfh, F_SETFD, 0) };
442 print $writefh $passphrase;
444 if ($pgpstyle eq 'GPG') {
445 push (@command, '--batch', '--passphrase-fd', $passfh->fileno);
447 push (@command, '+batchmode');
448 $ENV{PGPPASSFD} = $passfh->fileno;
452 # Fork off a pgp process that we're going to be feeding data to, and tell
453 # it to just generate a signature using the given key id and pass phrase.
454 my $pgp = new FileHandle;
455 my $signature = new FileHandle;
456 my $errors = new FileHandle;
457 my $pid = eval { open3 ($pgp, $signature, $errors, @command) };
459 @ERROR = ($@, "Execution of $command[0] failed.\n");
463 # Write the message to the PGP process. Strip all trailing whitespace
464 # for compatibility with older pgpverify and attached signature
466 $message =~ s/[ \t]+\n/\n/g;
469 # All done. Close the pipe to PGP, clean up, and see if we succeeded.
470 # If not, save the error output and return undef.
473 my @errors = <$errors>;
474 my @signature = <$signature>;
477 close $passfh if $passphrase;
480 @ERROR = (@errors, "$command[0] returned exit status $?\n");
484 # Now, clean up the returned signature and return it, along with the
485 # version number if desired. PGP v2 calls this a PGP MESSAGE, whereas
486 # PGP v5 and v6 and GPG both (more correctly) call it a PGP SIGNATURE,
488 while ((shift @signature) !~ /-----BEGIN PGP \S+-----\n/) {
489 unless (@signature) {
490 @ERROR = ("No signature from PGP (command not found?)\n");
495 while ($signature[0] ne "\n" && @signature) {
496 $version = $1 if ((shift @signature) =~ /^Version:\s+(.*?)\s*$/);
500 $signature = join ('', @signature);
503 return wantarray ? ($signature, $version) : $signature;
510 my($head, $header, $signheaders, $pgpflags, $pgpbegin, $pgpend);
512 # Form the message to be signed.
513 $signheaders = join(",", @signheaders);
514 $head = "X-Signed-Headers: $signheaders\n";
515 foreach $header (@signheaders) {
516 $head .= "$header: $header{$header}\n";
518 my $message = "$head\n$body";
520 # Get the passphrase if available.
522 if ($pgppassfile && -f $pgppassfile) {
523 $pgppassfile =~ s%^(\s)%./$1%;
524 if (open (PGPPASS, "< $pgppassfile\0")) {
525 $passphrase = <PGPPASS>;
531 # Sign the message, getting the signature and PGP version number.
532 my ($signature, $version) = pgp_sign ($pgpsigner, $passphrase, $message);
533 unless ($signature) {
534 die "@ERROR\n$0: could not generate signature\n";
537 # GnuPG has version numbers containing spaces, which breaks our header
538 # format. Find just some portion that contains a digit.
539 ($version) = ($version =~ /(\S*\d\S*)/);
541 # Put the signature into the headers.
542 $signature =~ s/^/\t/mg;
543 $header{$pgpheader} = "$version $signheaders\n$signature";
545 for (@ignoreheaders) {
546 delete $header{$_} if defined $header{$_};
550 foreach $header (@orderheaders) {
551 $head .= "$header: $header{$header}\n" if $header{$header};
552 delete $header{$header};
555 foreach $header (keys %header) {
556 die "$0: unexpected header $header left in header array\n";
564 # Our lawyer told me to include the following. The upshot of it is that
565 # you can use the software for free as much as you like.
567 # Copyright (c) 1996 UUNET Technologies, Inc.
568 # All rights reserved.
570 # Redistribution and use in source and binary forms, with or without
571 # modification, are permitted provided that the following conditions
573 # 1. Redistributions of source code must retain the above copyright
574 # notice, this list of conditions and the following disclaimer.
575 # 2. Redistributions in binary form must reproduce the above copyright
576 # notice, this list of conditions and the following disclaimer in the
577 # documentation and/or other materials provided with the distribution.
578 # 3. All advertising materials mentioning features or use of this software
579 # must display the following acknowledgement:
580 # This product includes software developed by UUNET Technologies, Inc.
581 # 4. The name of UUNET Technologies ("UUNET") may not be used to endorse or
582 # promote products derived from this software without specific prior
583 # written permission.
585 # THIS SOFTWARE IS PROVIDED BY UUNET ``AS IS'' AND ANY EXPRESS OR
586 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
587 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
588 # ARE DISCLAIMED. IN NO EVENT SHALL UUNET BE LIABLE FOR ANY DIRECT,
589 # INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
590 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
591 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
592 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
593 # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
594 # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
595 # OF THE POSSIBILITY OF SUCH DAMAGE.
598 # cperl-indent-level: 2