# pgp.pl - functions for handling pgp keys
#
# Copyright (c) 1993, 1994, 1995, 1996, 1997, 1998, 1999 by RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
# $Id: pgp.pl,v 2.5 1999/10/06 16:41:16 marek Exp $
#
#	$RCSfile: pgp.pl,v $
#	$Revision: 2.5 $
#	$Author: marek $
#	$Date: 1999/10/06 16:41:16 $

require "adderror.pl";
require "defines.pl";
require "misc.pl";

# genPGPkc(*object, $type)
#
# Add generated fields to the key certificate object. To do this
# we have to add the key to a temporary keyring. This depends heavily
# on the features and the bugs # of PGP 5.0i.

sub genPGPkc {
  local(*object, $type) = @_;
  my($rtcode) = $O_OK;

  my($state) = 0; # used in state machines in this subroutine

  return $O_OK unless $have_pgp;

  print "starting genPGPkc(" . $object{'kc'} . ")\n" if $opt_V;

  # do some simple syntax checks for the key (we do it here
  # instead of sub checksyntax because here we got the complete
  # key in one piece, instead of line by line):

  $state = 0;  # 0 = waiting for header, 1 = header, 2 = key, 3 = end

  foreach (split(/\n/, $object{"ce"})) {
    if ($state == 0 && /^-----BEGIN PGP PUBLIC KEY BLOCK-----$/) {
      $state = 1;
      next;
    }
    if ($state == 1 && /^\s*$/) {
      $state = 2;
      next;
    }
    next if $state == 1 && /^[^:]+:.*$/;

    if ($state == 2 && /^-----END PGP PUBLIC KEY BLOCK-----$/) {
      $state = 3;
      next;
    }
    next if $state == 2 && /^[A-Za-z0-9\+\/=]+$/; # allowed radix 64 chars

    # we get this far only if the format is not correct
    adderror(*object, 'the format of the PGP key in the "certif" attribute is '
	. 'invalid');
    return $O_ERROR;
  }

  if ($state != 3) { # state must be 3 if we reached the end of the key
    adderror(*object, 'the format of the PGP key in the "certif" attribute is '
	. 'invalid');
    return $O_ERROR;
  }

  # Put they key to a temporary file to be fed to PGP:

  my($temp_key)     = $TMPDIR . "/pgp_key.$$";
  my($temp_pgp_dir) = $TMPDIR . "/pgp_dir.$$";

  unless (open(KEY, ">$temp_key")) {
    syslog("ERRLOG", "genPGPkc: open(.., >$temp_key): $!");
    adderror(*object, "Cannot create a temporary file for PGP/1: $!");
    return $O_ERROR;
  }
  print KEY $object{"ce"};
  close(KEY);

# The PGP 5.0i is broken, it doesn't honor the command line switches
# which are used to specify the location of the keyring. In order
# to work around this, we need to set the PGPPATH environment
# variable to the location (= directory) of a temporary keyring, instead
# of just specifying the temporary keyring path on the command line
# (as documented in the manual):

  unless (mkdir($temp_pgp_dir, 0777)) {
    syslog("ERRLOG", "genPGPkc: mkdir($temp_pgp_dir): $!");
    adderror(*object, "Cannot create a temporary directory for PGP: $!");
    unlink($temp_key);
    return $O_ERROR;
  }

  my($orig_pgp_dir); 

  $orig_pgp_dir = $ENV{"PGPPATH"} if defined($ENV{"PGPPATH"});
  $ENV{"PGPPATH"} = $temp_pgp_dir;

# Add the key to the temporary keyring and check the output:

  unless(open(PGPADD, "$PGPK -a --batchmode=1 $temp_key 2>&1 |")) {
    syslog("ERRLOG", "genPGPkc: open(PGPADD, $PGPK -a --batchmode=1 "
	. "$temp_key 2>&1 |): $!");
    adderror(*object, "Cannot start PGP process/1: $!");
    unlink($temp_key);
    rm_tmpdir($temp_pgp_dir);
    return $O_ERROR;
  }

  # Get all useful information from the PGP process:
  my($pgp_keyid, @pgp_uids, $pgp_ok);

  while (<PGPADD>) {
    # Look for error messages from PGP. This is extremely ugly but PGP 5 seems
    # to be an unfinished program so it always returns 0 on exit
    if (m/^Unable to import keyfile/) {
      eatit(*PGPADD);
      adderror(*object, "Error in certificate");
      unlink($temp_key);
      rm_tmpdir($temp_pgp_dir);
      return $O_ERROR;
    }

    # If the above is successful the key will be in the local key ring  
    # Look for the keyid. Will not find secret keys. Careful with the contents
    # of the database keyring!
    if (/^pub.*0x([0-9a-fA-F]{8}).*Sign.*/) {
      if (defined($pgp_keyid)) {
	eatit(*PGPADD);
        adderror(*object, "Too many public keys in the certification object");
        unlink($temp_key);
	rm_tmpdir($temp_pgp_dir);
        return $O_ERROR;
      }
      $pgp_keyid = uc($1);
    }

    # Look for the uids:
    if (/^uid\s+(.*)$/) { push @pgp_uids, $1 }

    # Look for PGP ok message:
    $pgp_ok = 1 if /^Keys added successfully/;
  }
  close(PGPADD);

  unlink($temp_key); # get rid of the temporary key file

  unless (defined($pgp_ok)) {
    adderror(*object, "Didn't get successful reply from PGP/1");
    rm_tmpdir($temp_pgp_dir);
    return $O_ERROR;
  }

  unless (defined($pgp_keyid)) {
    adderror(*object, "Didn't find any PGP public keys in the object");
    rm_tmpdir($temp_pgp_dir);
    return $O_ERROR;
  }

  # Check if the PGP key ID from the real key matches the key ID given in 
  # the object:
  if (uc($object{"kc"}) ne "PGPKEY-$pgp_keyid") {
    adderror(*object, "Keyid for this certificate ($pgp_keyid) is not the "
	. "same as the PGPKEY field (" . $object{"kc"} . ")");
    rm_tmpdir($temp_pgp_dir);
    return $O_ERROR;
  }

  # Set the owner attributes from the key. This ignores whatever the value 
  # of this attribute happens to be in the message.
  $object{"ow"} = join("\n", @pgp_uids);

  # Get the fingerprint using the pgpk -ll command.
  # This ignores whatever the value of this attribute happens to be
  # in the message.
  unless (open(FINGERPR, "$PGPK -ll --batchmode=1 2>&1 |")) {
    syslog("ERRLOG", "genPGPkc: open(FINGERPR, $PGPK -ll --batchmode=1 "
	. "2>&1 |): $!");
    adderror(*object, "Cannot start PGP process/2: $!");
    rm_tmpdir($temp_pgp_dir);
    return $O_ERROR;
  }

  my($pgp_fp_found);

  while (<FINGERPR>) {
    if (/^pub/) {
      my($line) = scalar(<FINGERPR>);
      if ($line =~ /^f(?:16|20)\s+Fingerprint(?:16|20) = ([A-F\d ]+)$/) {
        if (defined($pgp_fp_found)) {
	  eatit(*FINGERPR);
	  adderror(*object, "Too many fingerprints in the key");
	  rm_tmpdir($temp_pgp_dir);
	  return $O_ERROR;
	}
	$object{"fp"} = $1;
	$pgp_fp_found = 1;
      }
    }
  }
  close(FINGERPR);

  unless (defined($pgp_fp_found)) {
    adderror(*object, "Didn't find PGP key fingerprint");
    rm_tmpdir($temp_pgp_dir);
    return $O_ERROR;
  }

  # Add the signing method (PGP). This ignores whatever the value of this
  # attribute happens to be in the message.
  $object{"mh"} = "PGP";

# Now all checks have been made and the information needed should be 
# extracted from the temporary keyfile. 

  # forget the temporary directory setting
  if (defined($orig_pgp_dir)) {
    $ENV{"PGPPATH"} = $orig_pgp_dir;
  } else {
    delete $ENV{"PGPPATH"};
  }

  # Clean up the mess we've left and exit:
  rm_tmpdir($temp_pgp_dir);

  print "ending genPGPkc\n" if $opt_V;

  return $rtcode;
}

# addPGPkey(*object, $type)
#
# Add PGP key from a certificate object to the main keyring

sub addPGPkey {
  local(*object, $type) = @_;

  return $O_OK unless $have_pgp;

  my($temp_key) = $TMPDIR . "/pgp_key.$$";

  print "starting addPGPkey(" . $object{'kc'} . ")\n" if $opt_V;

  # Put they key to a temporary file to be fed to PGP:
  unless (open(KEY, ">$temp_key")) {
    syslog("ERRLOG", "addPGPkey: open(.., >$temp_key): $!");
    adderror(*object, "Cannot create a temporary file for PGP/2: $!");
    return $O_ERROR;
  }
  print KEY $object{"ce"};
  close(KEY);

  lockPGPring();

  unless (open(PGPK, "$PGPK -a --batchmode=1 $temp_key 2>&1 |")) {
    syslog("ERRLOG", "addPGPkey: open(PGPK, $PGPK -a --batchmode=1 "
	. "$temp_key 2>&1 |): $!");
    adderror(*object, "Cannot start PGP process/3: $!");
    rm_tmpdir($temp_pgp_dir);
    return $O_ERROR;
  }

  my($pgp_ok);

  while (<PGPK>) {
    $pgp_ok = 1 if /^Keys added successfully/;
  }
  close(PGPK);

  unless (defined($pgp_ok)) {
    adderror(*object, "Didn't get successful reply from PGP/3");
    unlockPGPring();
    unlink($temp_key);
    return $O_ERROR;
  }

  unlockPGPring();
  unlink($temp_key);
  print "ending addPGPkey " . $object{'kc'} . "\n" if $opt_V;
  return $O_OK;
}

# delPGPkey($keyid)
#
# Delete PGP key from the keyring

sub delPGPkey {
  my($keyid) = shift;

  print "starting delPGPkey($keyid)\n" if $opt_V;

  $keyid =~ s/^PGPKEY-//;
  return $O_ERROR unless $keyid =~ /^[0-9a-fA-F]+$/; # just a safeguard

  return $O_OK unless $have_pgp;

  lockPGPring();

  unless (open(PGPK, "$PGPK -r --batchmode=1 0x$keyid 2>&1 |")) {
    syslog("ERRLOG", "delPGPkey: open(PGPK, $PGPK -r --batchmode=1 "
	. "0x$keyid 2>&1 |): $!");
    return $O_ERROR;
  }

  my($removeok);

  while (<PGPK>) {
    $removeok = 1 if /^Removed\.$/;
  }
  close(PGPK);

  unlockPGPring();

  print "ending delPGPkey " . $keyid . "\n" if $opt_V;

  return defined($removeok) ? $O_OK : $O_ERROR;
}

# checkPGPmsg($infile, $outfile)
#
# Check PGP message contents
#
# returns ($status, $id), where:
#   $status == -1    if checking failed ($id is the reason)
#   $status == undef if no signature or encrypted message found
#   $status == 0     if the signature is invalid (might be crypted)
#   $status == 1     if the file is signed by unknown key (might be crypted)
#   $status == 2     if the signature is valid (might be crypted)
#   $status == 3     if message is encrypted & cannot decrypt (not signed)
#   $status == 4     if message is encrypted & can decrypt (not signed)
#
# if $status != undef, $id will contain the PGP key ID

sub checkPGPmsg {
  my($in, $out) = @_;
  my($status, $id);

  return (undef, undef) unless $have_pgp;

  print "starting checkPGPsig($in, $out)\n" if $opt_V;

  return (undef, undef) unless -r $in;
  unlink($out) if -e $out;

  lockPGPring();

  unless (open(PGPV, "$PGPV --batchmode=1 $in -o $out 2>&1 |")) {
    syslog("ERRLOG", "checkPGPmsg: open(PGPV, $PGPV --batchmode=1 $in -o $out "
	. "2>&1 |): $!");
    return (-1, "Cannot start PGP process/4: $!");
  }

  # 0 = waiting for good/bad, 1 = waiting for ID, 2 = eating garbage (yum yum)
  $state = 0; 

  while (<PGPV>) {
    next if $state == 2;
    if ($state == 0) {
      if (/^Good signature made.+by key:$/) {
	$state = 1;
	$status = 2;
      }
      if (/^This signature applies to another message$/) {
	$state = 2;
	$status = -1;
	$id = "This signature applies to another message";
      }
      if (/^BAD signature made.+by key:$/) {
	$state = 1;
	$status = 0;
      }
      if (/^Signature by unknown keyid: 0x([0-9a-fA-F]{8})/) {
	$state = 2;
	$status = 1;
	$id = $1;
      }
      if (/^Message is encrypted\.$/) {
	$state = 0;
	$status = 4; # will be changed to 0, 1 or 2 if there is a signature
      }
      if (/^Cannot decrypt message\./) {
        $state = 2;
        $status = 3;
      }
      next;
    }
    if ($state == 1) {
      $state = 2;
      $id = $1 if /^\s*\d+ bits, Key ID ([0-9a-fA-F]{8}),/;
    }
  }
  close(PGPV);

  unlockPGPring();

  print "ending checkPGPsig\n" if $opt_V;

  $status = undef if defined($status) && $status == 2 && !defined($id);

  return ($status, $id);
}

# lockPGPring()
# unlockPGPring()
#
# Lock & unlock PGP keyring (must be implemented here as PGP doesn't
# do any locking itself -- sigh)

sub lockPGPring {
  my($lockfile) = $LOCKDIR . "/PGP.lock";

  unless (open(LOCK, ">$lockfile")) {
    syslog("ERRLOG", "lockPGPring: open(>$lockfile): $!");
    return 0;
  }

  return lock(LOCK);
}

sub unlockPGPring {
  my($lockfile) = $LOCKDIR . "/PGP.lock";

  my($r) = unlock(LOCK);
  close(LOCK);
  return $r;
}

# rm_tmpdir($tmpdir)
#
# Delete temporary directory and all files in it

sub rm_tmpdir {
  my($tmpdir) = shift;

  opendir(TMPDIR, $tmpdir)
      or return undef;

  foreach (readdir(TMPDIR)) {
    next if $_ eq '.' || $_ eq '..';
    unlink("$tmpdir/$_");
  }
  closedir(TMPDIR);
  return rmdir($tmpdir);
}

# eatit(*FH)
#
# Eat the rest of given input to prevent PGP process from dumping core,
# and close the file handle after that

sub eatit {
  my($yummy) = shift;

  while (<$yummy>) {
    # munch munch; nothing here
  }
  close($yummy);
}

1;
# eof
