#! /usr/bin/perl -ws
do '@LIBDIR@/innshellvars.pl';
#
# written April 1996, tale@isc.org (David C Lawrence)
# Version 1.14, 6 May 2001
#
# NOTICE TO INN MAINTAINERS:  The version that is shipped with INN
# is the same as the version that I make available to the rest of the
# world (including non-INN sites), so please make all changes through me.
#
# This program is intended to be compatible with Perl 4 and Perl 5.
#
# Changes from 1.13.1 -> 1.14
# -- Native support for GnuPG without the pgpgpg wrapper, using GnuPG's
#    program interface by Marco d'Itri.
# -- Always use Sys::Syslog without any setlogsock call for Perl 5.6.0 or
#    later, since Sys::Syslog in those versions of Perl uses the C library
#    interface and is now portable.
# -- Default to expecting the key ring in $inn'newsetc/pgp if it exists.
# -- Fix a portability problem for Perl 4 introduced in 1.12.
#
# Changes from 1.13 -> 1.13.1
# -- Nothing functional, just moved the innshellvars.pl line to the head of
#    the script, to accomodate the build process of INN.
#
# Changes from 1.12 -> 1.13
# -- Use INN's syslog_facility if available.
#
# Changes from 1.11 -> 1.12
# -- support for GnuPG
# -- Use /usr/ucb/logger, if present, instead of /usr/bin/logger (the latter
#    of which, on Solaris at least, is some sort of brain damaged POSIX.2
#    command which doesn't use syslog).
# -- made syslog work for dec_osf (version 4, at least)
# -- fixed up priority of '.' operator vs bitwise operators
#
# Changes from 1.10 -> 1.11
# -- code to log error messages to syslog.
#    See $syslog and $syslog_method configurable variables.
# -- configurably allow date stamp on stderr error messages.
# -- added locking for multiple concurrent pgp instances.
# -- more clear error message if pgp exits abnormally.
# -- identify PGP 5 "BAD signature" string.
# -- minor diddling for INN (path to innshellvars.pl changed)
#
# Changes from 1.9 -> 1.10
# -- minor diddling for INN 2.0: use $inn'pathtmp if it exists, and
#    work with the new subst method to find innshellvars.pl
# -- do not truncate the tmp file when opening, in case it is really linked
#    to another file
#
# Changes from 1.8 -> 1.9
# -- match 'Bad signature' pgp output to return exit status 3 by removing
#    '^' in regexp matched on multiline string.
#
# Changes from 1.7 -> 1.8
# -- ignore final dot-CRLF if article is in NNTP format
#
# Changes from 1.6 -> 1.7
# -- parse PGP 5.0 'good signature' lines.
# -- allow -test swtich; prints pgp input and output
# -- look for pgp in INN's innshellvars.pl
# -- changed regexp delimiters for stripping $0 to be compatible with old perl
#
# Changes from 1.5 -> 1.6
# -- handle articles encoded in NNTP format ('.' starting line is doubled,
#    \r\n at line end) by stripping NNTP encoding.
# -- exit 255 with pointer to $HOME or $PGPPATH if pgp can't find key ring.
#    (probably doesn't match the necessary error message with ViaCrypt PGP)
# -- failures also report message-id so the article can be looked up to retry.
#
# Changes from 1.4 -> 1.5
# -- force English lanugage for 'Good signature from user' by passing
#    +language=en on pgp command line, rather than setting the
#    environment variable LANGUAGE to 'en'.
#
# Changes from 1.3 -> 1.4
# -- now handles wrapped headers that have been unfolded.
#    (though I do believe news software oughtn't be unfolding them.)
# -- checks to ensure that the temporary file is really a file, and
#    not a link or some other weirdness

# Path to the GnuPG gpgv binary, if you have GnuPG.  If you do, this will
# be used in preference to PGP.  For most current control messages, you
# need a version of GnuPG that can handle RSA signatures.  If you have INN
# and the script is able to successfully include your innshellvars.pl
# file, the value of $inn::gpgv will override this.
# $gpgv = '/usr/local/bin/gpgv';

# Path to pgp binary; for PGP 5.0, set the path to the pgpv binary.
# If you have INN and the script is able to successfully include your
# innshellvars.pl file, the value of $inn::pgp will override this.
$pgp = '/usr/local/bin/pgp';

# If you keep your keyring somewhere that is not the default used by pgp,
# uncomment the next line and set appropriately.  If you have INN and the
# script is able to successfully include your innshellvars.pl file, this
# will be set to $inn::newsetc/pgp if that directory exists unless you set
# it explicitly.  GnuPG will use a file named pubring.gpg in this
# directory.
# $keyring = '/path/to/your/pgp/config';

# If you have INN and the script is able to successfully include your
# innshellvars.pl file, the value of $inn::pathtmp and $inn::locks will
# override these.
$tmpdir = "/tmp";
$lockdir = $tmpdir;

# How should syslog be accessed?
#
# As it turns out, syslogging is very hard to do portably in versions of
# Perl prior to 5.6.0.  Sys::Syslog should work without difficulty in
# 5.6.0 or later and will be used automatically for those versions of Perl
# (unless $syslog_method is '').  For earlier versions of Perl, 'inet' is
# all that's available up to version 5.004_03.  If your syslog does not
# accept UDP log packets, such as when syslogd runs with the -l flag,
# 'inet' will not work.  A value of 'unix' will try to contact syslogd
# directly over a Unix domain socket built entirely in perl code (no
# subprocesses).  If that is not working for you, and you have the
# 'logger' program on your system, set this variable to its full path name
# to have a subprocess contact syslogd.  If the method is just "logger",
# the script will search some known directories for that program.  If it
# can't be found & used, everything falls back on stderr logging.
#
# You can test the script's syslogging by running "pgpverify < /some/text/file"
# on a file that is not a valid news article.  The "non-header at line #"
# error should be syslogged.
#
# $syslog_method = 'unix';    # Unix doman socket, perl5.004_03 or higher
# $syslog_method = 'inet';    # UDP to port 514 of localhost
# $syslog_method = '';        # Don't ever try to do syslogging.
$syslog_method = 'logger';    # search for the logger program

# The next two variables are the values to be used for syslog's facility and
# level to use, as would be found in syslog.conf.  For various reasons, it is
# impossible to economically have the script figure out how to do syslogging
# correctly on the machine.  If you have INN and the script is able to
# successfully include you innshellvars.pl file, then the value of
# $inn::syslog_facility will override this value of $syslog_facility;
# $syslog_level is unaffected.
$syslog_facility = 'news';
$syslog_level = 'err';

# Prepend the error message with a timestamp?
# This is only relevant if not syslogging, when errors go to stderr.
#
# $log_date = 0;  # zero means don't do it.
# $log_date = 1;  # non-zero means do it.
$log_date = -t STDOUT; # do it if STDOUT is to a terminal

### Exit value:
### 0  good signature
### 1  no signature
### 2  unknown signature
### 3  bad signature
### 255 problem not directly related to pgp analysis of signature

# not syslogged, such an error is almost certainly from someone running
# the script manually.
die "Usage: $0 < message\n" if @ARGV != 0;

$0 =~ s%^.*/%%;                 # trim /path/to/prog to prog

$pgp = $inn'pgp if $inn'pgp && $inn'pgp ne "no-pgp-found-during-configure";
$gpgv = $inn'gpgv if $inn'gpgv;
$tmp = ($inn'pathtmp ? $inn'pathtmp : $tmpdir) . "/pgp$$";
$lockdir = $inn'locks if $inn'locks;
$syslog_facility = $inn'syslog_facility if $inn'syslog_facility;
if (! $keyring && $inn'newsetc) {
  $keyring = $inn'newsetc . '/pgp' if -d $inn'newsetc . '/pgp';
}

if ($gpgv) {
  if (! -x $gpgv) {
    &fail("$0: $gpgv: " . (-e _ ? "cannot execute" : "no such file") . "\n");
  }
} elsif (! -x $pgp) {
  &fail("$0: $pgp: " . (-e _ ? "cannot execute" : "no such file") . "\n");
}

# this is, by design, case-sensitive with regards to the headers it checks.
# it's also insistent about the colon-space rule.
while (<>) {
  # if a header line ends with \r\n, this article is in the encoding
  # it would be in during an NNTP session.  some article storage
  # managers keep them this way for efficiency.
  $nntp_format = /\r\n$/ if $. == 1;
  s/\r?\n$//;

  last if /^$/;
  if (/^(\S+):[ \t](.+)/) {
    ($label, $value) = ($1, $2);
    $dup{$label} = 1 if $header{$label};
    $header{$label} = $value;
  } elsif (/^\s/) {
    &fail("$0: non-header at line $.: $_\n") unless $label;
    $header{$label} .= "\n$_";
  } else {
    &fail("$0: non-header at line $.: $_\n");
  }
}

$pgpheader = "X-PGP-Sig";
exit 1 unless $_ = $header{$pgpheader}; # no signature

# the regexp below might be too strict about the structure of pgp sig lines

# the $sep value means the separator between the radix64 signature lines
# can have any amount of spaces or tabs, but must have at least one space
# or tab, if there is a newline then the space or tab has to follow the
# newline.  any number of newlines can appear as long as each is followed
# by at least one space or tab.   *phew*
$sep = "[ \t]*(\n?[ \t]+)+";

# match all of the characters in a radix64 string
$r64 = '[a-zA-Z0-9+/]';

&fail("$0: $pgpheader not in expected format\n")
  unless /^(\S+)$sep(\S+)(($sep$r64{64})+$sep$r64+=?=?$sep=$r64{4})$/;

($version, $signed_headers, $signature) = ($1, $3, $4);
$signature =~ s/$sep/\n/g;

$message  = "-----BEGIN PGP SIGNED MESSAGE-----\n\n";
$message .= "X-Signed-Headers: $signed_headers\n";
foreach $label (split(",", $signed_headers)) {
  &fail("$0: duplicate signed $label header, can't verify\n")
    if $dup{$label};
  $message .= "$label: ";
  $message .= "$header{$label}" if $header{$label};
  $message .= "\n";
}
$message .= "\n";               # end of headers

while (<>) {                    # read body lines
  if ($nntp_format) {
    # check for end of article; some news servers (eg, Highwind's "Breeze")
    # include the dot-CRLF of the NNTP protocol in the article data passed
    # to this script
    last if $_ eq ".\r\n";

    # remove NNTP encoding
    s/^\.\./\./;
    s/\r\n$/\n/;
  }

  s/^-/- -/;                    # pgp quote ("ASCII armor") dashes
  $message .= $_;               # append to output string
}

$message .= "\n-----BEGIN PGP SIGNATURE-----\n";
$message .= "Version: $version\n";
$message .= $signature;
$message .= "\n-----END PGP SIGNATURE-----\n";

open(TMP,">> $tmp") || &fail("$0: open > $tmp: $!\n");

-f TMP ||
  &fail("$0: $tmp not a plain file, possible security violation attempt\n");
(stat(_))[3] == 1 ||
  &fail("$0: $tmp has hard links, possible security violation attempt\n");

seek(TMP, 0, 0);                # make sure pointer is at beginning of file
truncate(TMP, 0);               # make sure file is zero length

print TMP $message;
close(TMP) || &errmsg("$0: close > $tmp: $!\n");
&fail("$0: write error for message to check\n")
  if -s $tmp != length($message);

print $message if $test;

if ($gpgv) {
  ($ok, $signer) = &gpg_check($tmp, $keyring);
} else {
  ($ok, $signer) = &pgp_check($tmp, $keyring);
}

print "$signer\n" if $signer;
exit $ok;

# Check the signature using PGP (including 2.6.2, 5.0, and the pgpgpg
# wrapper for GnuPG).
sub pgp_check {
  ($file, $ring) = @_;

  $ENV{'PGPPATH'} = $ring if $ring;

  # The call to pgp needs to be locked because it tries to both read and
  # write a file named randseed.bin but doesn't do its own locking as it
  # should, and the consequences of a multiprocess conflict is failure to
  # verify.
  $lock = "$lockdir/LOCK.$0";

  until (&shlock($lock) > 0) {
    sleep(2);
  }

  open(PGP,"$pgp -f +language=en < $file 2>&1 >/dev/null |") ||
    &fail("$0: failed to execute pgp: $!\n");

  undef $/;
  $_ = <PGP>;

  unlink($lock) || &errmsg("$0: unlink $lock: $!\n");
  unlink($file) || &errmsg("$0: unlink $file: $!\n");

  unless (close(PGP)) {
    if ($? >> 8) {
      &errmsg("$0: pgp exited status " . ($? >> 8) . "\n");
    } else {
      &errmsg("$0: pgp died on signal " . ($? & 255) . "\n");
    }
  }

  print if $test;

  # MIT PGP 2.6.2:
  #   Good signature from user "Robert Braver <rbraver@ohww.norman.ok.us>".
  # ViaCrypt PGP 4.0:
  #   Good signature from user:  Robert Braver <rbraver@ohww.norman.ok.us>
  # GnuPG (via pgpgpg)
  #   Good signature from "news.announce.newgroups"
  # PGP 5.0i:
  #   Good signature made 1997-07-09 21:57 GMT by key:
  #     1024 bits, Key ID B88DA9C1, Created 1996-04-10
  #      "news.announce.newgroups"

  $ok = 2;                        # unknown signature result is default
  if (/B[Aa][Dd] signature /) {
    $ok = 3;
  } elsif (/Good signature from user(:  (.*)| "(.*)"\.)/ ||
           /Good signature from "(.*)"/ ||
           /Good signature made .* by key:\n.+\n +"(.*)"/) {
    $ok = 0;
    $signer = $+;
  } elsif (/Keyring file '(.*)' does not exist/) {
    &fail("$0: couldn't access $1.  Bad \$HOME or \$PGPPATH?\n");
  }

  return ($ok, $signer);
}

# Check the signature using GnuPG.
sub gpg_check {
  ($file, $ring) = @_;

  $opts = '--quiet --status-fd=1 --logger-fd=1';
  if ($ring) {
    $opts .= " --keyring=$ring/pubring.gpg";
  } else {
    $opts .= " --keyring=pubring.gpg";
  }

  open(PGP, "$gpgv $opts $file 2> /dev/null |") ||
    &fail("$0: failed to execute $pgp: $!\n");

  undef $/;
  $_ = <PGP>;

  unlink($file) || &errmsg("$0: unlink $file: $!\n");

  unless (close(PGP)) {
    if ($? >> 8) {
      &errmsg("$0: gpgv exited status " . ($? >> 8) . "\n");
    } else {
      &errmsg("$0: gpgv died on signal " . ($? & 255) . "\n");
    }
  }

  $ok = 255;        # default exit status
  if (/\[GNUPG:\]\s+GOODSIG\s+\S+\s+(\S+)/) {
    $ok = 0;
    $signer = $1;
  } elsif (/\[GNUPG:\]\s+NODATA/ || /\[GNUPG:\]\s+UNEXPECTED/) {
    $ok = 1;
  } elsif (/\[GNUPG:\]\s+NO_PUBKEY/) {
    $ok = 2;
  } elsif (/\[GNUPG:\]\s+BADSIG\s+/) {
    $ok = 3;
  }

  return ($ok, $signer);
}

# Log an error message, attempting syslog first based on $syslog_method
# and falling back on stderr.
sub errmsg {
  $_[0] =~ s/\n$//;

  $date = '';
  if ($log_date) {
    eval "require 'ctime.pl'";
    ($date = &ctime(time)) =~ s/\d{4}\n//
      unless $@;
  }

  if ($syslog_method && $] >= 5.006) {
    eval "use Sys::Syslog";
    $syslog_method = 'internal';
  }

  if ($syslog_method eq "logger") {
    @loggers = ('/usr/ucb/logger', '/usr/bin/logger', '/usr/local/bin/logger');
    foreach $try (@loggers) {
      if (-x $try) {
        $syslog_method = $try;
        last;
      }
    }
    $syslog_method = '' if $syslog_method eq 'logger';
  }

  if ($syslog_method ne '' && $syslog_method !~ m%/logger$%) {
    if ($] >= 5) {
      eval "use Sys::Syslog";
    } else {
      eval "require 'syslog.pl'";
    }
  }

  if ($@ || $syslog_method eq '') {
    warn $date, "$0: trying to use perl's syslog: $@\n" if $@;
    warn $date, $_[0], "\n";
    warn $date, "... while processing $header{'Message-ID'}\n"
      if $header{'Message-ID'};

  } else {
    $_[0] .= " processing $header{'Message-ID'}"
      if $header{'Message-ID'};

    if ($syslog_method =~ m%/logger$%) {
      unless (system($syslog_method, "-i", "-p",
                     "$syslog_facility.$syslog_level", $_[0]) == 0) {
        if ($? >> 8) {
          warn $date, "$0: $syslog_method exited status ",  $? >>  8, "\n";
        } else {
          warn $date, "$0: $syslog_method died on signal ", $? & 255, "\n";
        }
        $syslog_method = '';
        &errmsg($_[0]);
      }

    } else {
      # setlogsock arrived in perl 5.004_03 to enable Sys::Syslog
      # to use a Unix domain socket to talk to syslogd, which is
      # the only way to do it when syslog runs with the -l switch.
      if ($syslog_method eq "unix") {
        if ($^O eq "dec_osf" && $] >= 5) {
          eval 'sub Sys::Syslog::_PATH_LOG { "/dev/log" }';
        }
        if ($] <= 5.00403 || ! eval "setlogsock('unix')") {
          warn $date, "$0: cannot use syslog_method 'unix' on this system\n";
          $syslog_method = '';
          &errmsg($_[0]);
          return;
        }
      }

      # unfortunately, there is no way to definitively know in this program if
      # the message was logged.  I wish there were a way to send a message
      # to stderr if and only if the syslog attempt failed.
      &openlog($0, 'pid', $syslog_facility);
      &syslog($syslog_level, $_[0]);
      &closelog();
    }
  }
}

sub fail {
  unlink($tmp);
  &errmsg($_[0]);
  exit 255;
}

# get a lock in essentially the same fashion as INN's shlock.
# return 1 on success, 0 for normal failure, -1 for abnormal failure.
# "normal failure" is that a lock is apparently in use by someone else.
sub shlock {
  local($file) = @_;
  local($ltmp, $pid);

  unless (defined(&ENOENT)) {
    eval "require POSIX qw(:errno_h)";
    if ($@) {
      # values taken from BSD/OS 3.1
      sub ENOENT {  2 }
      sub ESRCH  {  3 }
      sub EEXIST { 17 }
    }
  }

  $ltmp = ($file =~ m#(.*/)#)[0] . "shlock$$";

  # this should really attempt to use another temp name
  -e $ltmp && (unlink($ltmp) || return -1);

  open(LTMP, ">$ltmp") || return -1;
  print LTMP "$$\n" || (unlink($ltmp), return -1);
  close(LTMP) || (unlink($ltmp), return -1);

  if (!link($ltmp, $file)) {
    if ($! == &EEXIST) {
      if (open(LOCK, "<$file")) {
        $pid = <LOCK>;
        if ($pid =~ /^\d+$/ && (kill(0, $pid) == 1 || $! != &ESRCH)) {
          unlink($ltmp);
          return 0;
        }

        # ok, the pid in the lockfile is not a number or no longer exists.
        close(LOCK);            # silent failure is ok here

        # unlink failed
        if (unlink($file) != 1 && $! != &ENOENT) {
          unlink($ltmp);
          return 0;
        }

      # check if open failed for reason other than file no longer present
      } elsif ($! != &ENOENT) {
        unlink($ltmp);
        return -1;
      }

      # either this process unlinked the lockfile because it was bogus,
      # or between this process's link() and open() the other process
      # holding the lock unlinked it.  This process can now try to aquire.
      if (! link($ltmp, $file)) {
        unlink($ltmp);
        return $! == &EEXIST ? 0 : -1; # maybe another proc grabbed the lock
      }

    } else {                    # first attempt to link failed
      unlink($ltmp);
      return 0;
    }
  }
  unlink($ltmp);
  return 1;
}

# Our lawyer told me to include the following.  The upshot of it is
# that you can use the software for free as much as you like.

# Copyright (c) 1996 UUNET Technologies, Inc.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#      This product includes software developed by UUNET Technologies, Inc.
# 4. The name of UUNET Technologies ("UUNET") may not be used to endorse or
#    promote products derived from this software without specific prior
#    written permission.
#
# THIS SOFTWARE IS PROVIDED BY UUNET ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL UUNET BE LIABLE FOR ANY DIRECT,
# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
# OF THE POSSIBILITY OF SUCH DAMAGE.

# Local variables:
# cperl-indent-level: 2
# fill-column: 74
# End: