smime_keys.pl

mutt-1.5.12 源代码。linux 下邮件接受的工具。

sub add_key ($$$$) {
    my $file = shift or die;
    my $hashvalue = shift or die;
    my $mailbox = shift or die;
    my $label = shift or die;

    unless (-e "$private_keys_path/$hashvalue") {
        mycopy $file, "$private_keys_path/$hashvalue";
    }    

    add_entry($mailbox, $hashvalue, 0, $label, "");
    print "added private key: " .
      "$private_keys_path/$hashvalue for $mailbox\n";
} 






sub parse_pem (@) {
    my $state = 0;
    my $cert_iter = 0;
    my @bag_attribs;
    my $numBags = 0;

    $cert_tmp_file[$cert_iter] = newfile("cert_tmp.$cert_iter","temp");
    my $cert_tmp_iter = $cert_tmp_file[$cert_iter];
    open(CERT_FILE, ">$cert_tmp_iter") 
        or die "Couldn't open $cert_tmp_iter: $!";

    while($_ = shift(@_)) {
        if(/^Bag Attributes/) {
            $numBags++;
            $state == 0 or  die("PEM-parse error at: $.");
	    $state = 1;
            $bag_attribs[$cert_iter*4+1] = "";
            $bag_attribs[$cert_iter*4+2] = "";
            $bag_attribs[$cert_iter*4+3] = "";
        }

        ($state == 1) and /localKeyID:\s*(.*)/ 
            and ($bag_attribs[$cert_iter*4+1] = $1);

        ($state == 1) and /subject=\s*(.*)/    
            and ($bag_attribs[$cert_iter*4+2] = $1);

        ($state == 1) and /issuer=\s*(.*)/     
            and ($bag_attribs[$cert_iter*4+3] = $1);
        
        if(/^-----/) {
            if(/BEGIN/) {
                print CERT_FILE;
                $state = 2;

                if(/PRIVATE/) {
                    $bag_attribs[$cert_iter*4] = "K";
                    next;
                }
                if(/CERTIFICATE/) {
                    $bag_attribs[$cert_iter*4] = "C";
                    next;
                }
                die("What's this: $_");
            }
            if(/END/) {
                $state = 0;
                print CERT_FILE;
                close(CERT_FILE);
                $cert_iter++;
	        $cert_tmp_file[$cert_iter] = newfile("cert_tmp.$cert_iter","temp");
	        $cert_tmp_iter = $cert_tmp_file[$cert_iter];
                open(CERT_FILE, ">$cert_tmp_iter")
                    or die "Couldn't open $cert_tmp_iter: $!";
                next;
            }
        }
        print CERT_FILE;
    }
    close(CERT_FILE);

    # I'll add support for unbagged cetificates, in case this is needed.
    $numBags == $cert_iter or 
        die("Not all contents were bagged. can't continue.");

    return @bag_attribs;
}


# This requires the Bag Attributes to be set
sub handle_pem (@) {

    my @pem_contents;
    my $iter=0;
    my $root_cert;
    my $key;
    my $certificate;
    my $intermediate;
    my @mailbox;
    my $mailbox;

    @pem_contents = &parse_pem(@_);

    # private key and certificate use the same 'localKeyID'
    while($iter <= $#pem_contents / 4) {
        if($pem_contents[$iter * 4] eq "K") {
            $key = $iter;
            last;
        }
        $iter++;
    }
    ($iter > $#pem_contents / 2) and die("Couldn't find private key!");

    $pem_contents[($key * 4)+1] or die("Attribute 'localKeyID' wasn't set.");

    $iter = 0;
    while($iter <= $#pem_contents / 4) {
        $iter == $key and ($iter++) and next;
        if($pem_contents[($iter * 4)+1] eq $pem_contents[($key * 4)+1]) {
            $certificate = $iter;
            last;
        }
        $iter++;
    }
    ($iter > $#pem_contents / 4) and die("Couldn't find matching certificate!");

    my $tmp_key = newfile("tmp_key","temp");
    mycopy $cert_tmp_file[$key], $tmp_key;
    my $tmp_certificate = newfile("tmp_certificate","temp");
    mycopy $cert_tmp_file[$certificate], $tmp_certificate;

    # root certificate is self signed
    $iter = 0;

    while($iter <= $#pem_contents / 4) {
        if ($iter == $key or $iter == $certificate) {
            $iter++; 
            next;
        }

        if($pem_contents[($iter * 4)+2] eq $pem_contents[($iter * 4)+3]) {
            $root_cert = $iter;
            last;
        }
        $iter++;
    }
    if ($iter > $#pem_contents / 4) {
      print "Couldn't identify root certificate!\n";
      $root_cert = -1;      
    }

    # what's left are intermediate certificates.
    $iter = 0;

    # needs to be set, so we can check it later
    $intermediate = $root_cert;
    my $tmp_issuer_cert = newfile("tmp_issuer_cert","temp");
    while($iter <= $#pem_contents / 4) {
        if ($iter == $key or $iter == $certificate or $iter == $root_cert) {
            $iter++; 
            next;
        }

	open (IC, ">> $tmp_issuer_cert") or die "can't open $tmp_issuer_cert: $?";
	my $cert_tmp_iter = $cert_tmp_file[$iter];
	open (CERT, "< $cert_tmp_iter") or die "can't open $cert_tmp_iter: $?";
	print IC while (<CERT>);
	close IC;
	close CERT;

	# although there may be many, just need to know if there was any
	$intermediate = $iter;

        $iter++;
    }

    # no intermediate certificates ? use root-cert instead (if that was found...)
    if($intermediate == $root_cert) {
        if ($root_cert == -1) {
	  die("No root and no intermediate certificates. Can't continue.");
	}
        mycopy $cert_tmp_file[$root_cert], $tmp_issuer_cert;
    }

    my $label = query_label;

    my $format = -B $tmp_certificate ? 'DER' : 'PEM'; 
    my $cmd = "$opensslbin x509 -noout -hash -in $tmp_certificate -inform $format";
    my $cert_hash = `$cmd`;
    $? and die "'$cmd' returned $?";

    $format = -B $tmp_issuer_cert ? 'DER' : 'PEM'; 
    $cmd = "$opensslbin x509 -noout -hash -in $tmp_issuer_cert -inform $format";
    my $issuer_hash = `$cmd`;
    $? and die "'$cmd' returned $?";

    chomp($cert_hash); chomp($issuer_hash);

    # Note: $cert_hash will be changed to reflect the correct filename
    #       within add_cert() ONLY, so these _have_ to get called first..
    add_certificate($tmp_issuer_cert, \$issuer_hash, 0, $label);
    @mailbox = &add_certificate("$tmp_certificate", \$cert_hash, 1, $label, $issuer_hash); 
    foreach $mailbox (@mailbox) {
      chomp($mailbox);
      add_key($tmp_key, $cert_hash, $mailbox, $label);
    }
}






sub modify_entry ($$$;$ ) {
    my $op = shift or die;
    my $hashvalue = shift or die;
    my $use_cert = shift;
    my $crl;
    my $label;
    my $path;
    my @fields;

    $op eq 'L' and ($label = shift or die);
    $op eq 'V' and ($crl = shift);


    if ($use_cert) {
        $path = $certificates_path;
    }
    else {
        $path = $private_keys_path;
    }

    open(INDEX, "<$path/.index") or  
      die "Couldn't open $path/.index: $!";
    my $newindex = newfile("$path/.index.tmp");
    open(NEW_INDEX, ">$newindex") or 
      die "Couldn't create $newindex: $!";

    while(<INDEX>) {
        @fields = split;
        if($fields[1] eq $hashvalue or $hashvalue eq 'all') {
	  $op eq 'R' and next;
	  print NEW_INDEX "$fields[0] $fields[1]";
	  if($op eq 'L') {
	    if($use_cert) {
	      print NEW_INDEX " $label $fields[3] $fields[4]";
	    }
	    else {
	      print NEW_INDEX " $label";
	    }
	  }
	  if ($op eq 'V') {
	    print "\n==> about to verify certificate of $fields[0]\n";
	    my $flag = &do_verify($fields[1], $fields[3], $crl);
	    print NEW_INDEX " $fields[2] $fields[3] $flag";
	  }
	  print NEW_INDEX "\n";
	  next;
	}
	print NEW_INDEX;
    }
    close(INDEX);
    close(NEW_INDEX);

    rename $newindex, "$path/.index" 
        or die "Couldn't rename $newindex to $path/.index: $!\n";

    print "\n";
}




sub remove_pair ($ ) {
  my $keyid = shift or die;

  if (-e "$certificates_path/$keyid") {
    unlink "$certificates_path/$keyid";
    modify_entry('R', $keyid, 1);
    print "Removed certificate $keyid.\n";
  }
  else {
    die "No such certificate: $keyid";
  }

  if (-e "$private_keys_path/$keyid") {
    unlink "$private_keys_path/$keyid";
    modify_entry('R', $keyid, 0);
    print "Removed private key $keyid.\n";
  }
}



sub change_label ($ ) {
  my $keyid = shift or die;
  
  my $label = query_label;

  if (-e "$certificates_path/$keyid") {
    modify_entry('L', $keyid, 1, $label);
    print "Changed label for certificate $keyid.\n";
  }
  else {
    die "No such certificate: $keyid";
  }

  if (-e "$private_keys_path/$keyid") {
    modify_entry('L', $keyid, 0, $label);
    print "Changed label for private key $keyid.\n";
  }

}




sub verify_cert ($$) {
  my $keyid = shift or die;
  my $crl = shift;

  -e "$certificates_path/$keyid" or $keyid eq 'all'
    or die "No such certificate: $keyid";
  modify_entry('V', $keyid, 1, $crl);
}




sub do_verify($$$) {

  my $cert = shift or die;
  my $issuerid = shift or die;
  my $crl = shift;

  my $result = 'i';
  my $trust_q;
  my $issuer_path;
  my $cert_path = "$certificates_path/$cert";

  if($issuerid eq '?') {
    $issuer_path = "$certificates_path/$cert";
  } else {
    $issuer_path = "$certificates_path/$issuerid";
  }

  my $cmd = "$opensslbin verify $root_certs_switch $root_certs_path -purpose smimesign -purpose smimeencrypt -untrusted $issuer_path $cert_path";
  my $output = `$cmd`;
  $? and die "'$cmd' returned $?";
  chop $output;
  print "\n$output\n";

  ($output =~ /OK/) and ($result = 'v');

  $result eq 'i' and return $result;

  my $format = -B $cert_path ? 'DER' : 'PEM'; 
  $cmd = "$opensslbin x509 -dates -serial -noout -in $cert_path -inform $format";
  (my $date1_in, my $date2_in, my $serial_in) = `$cmd`;
  $? and die "'$cmd' returned $?";

  if ( defined $date1_in and defined $date2_in ) {
    my @tmp = split (/\=/, $date1_in);
    my $tmp = $tmp[1];
    @tmp = split (/\=/, $date2_in);
    my %months = ('Jan', '00', 'Feb', '01', 'Mar', '02', 'Apr', '03',
		  'May', '04', 'Jun', '05', 'Jul', '06', 'Aug', '07',
		  'Sep', '08', 'Oct', '09', 'Nov', '10', 'Dec', '11');

    my @fields =
      $tmp =~ /(\w+)\s*(\d+)\s*(\d+):(\d+):(\d+)\s*(\d+)\s*GMT/;

    $#fields != 5 and print "Expiration Date: Parse Error :  $tmp\n\n" or
      timegm($fields[4], $fields[3], $fields[2], $fields[1],
	     $months{$fields[0]}, $fields[5]) > time and $result = 'e';
    $result eq 'e' and print "Certificate is not yet valid.\n" and return $result;

    @fields =
      $tmp[1] =~ /(\w+)\s*(\d+)\s*(\d+):(\d+):(\d+)\s*(\d+)\s*GMT/;

    $#fields != 5 and print "Expiration Date: Parse Error :  $tmp[1]\n\n" or
      timegm($fields[4], $fields[3], $fields[2], $fields[1],
	     $months{$fields[0]}, $fields[5]) < time and $result = 'e';
    $result eq 'e' and print "Certificate has expired.\n" and return $result;

  }
    
  if ( defined $crl ) {
    my @serial = split (/\=/, $serial_in);
    my $cmd = "$opensslbin crl -text -noout -in $crl | grep -A1 $serial[1]";
    (my $l1, my $l2) = `$cmd`;
    $? and die "'$cmd' returned $?";
    
    if ( defined $l2 ) {
      my @revoke_date = split (/:\s/, $l2);
      print "FAILURE: Certificate $cert has been revoked on $revoke_date[1]\n";
      $result = 'r';
    }
  }    
  print "\n";

  if ($result eq 'v') {
    return 't';
  }

  return $result;
}



sub add_root_cert ($) {
  my $root_cert = shift or die;

  my $format = -B $root_cert ? 'DER' : 'PEM'; 

  my $cmd = "$opensslbin x509 -noout -hash -in $root_cert -inform $format";
  my $root_hash = `$cmd`;
  $? and die "'$cmd' returned $?";

  if (-d $root_certs_path) {
    -e "$root_certs_path/$root_hash" or
        mycopy $root_cert, "$root_certs_path/$root_hash";
  }
  else {
    open(ROOT_CERTS, ">>$root_certs_path") or 
      die ("Couldn't open $root_certs_path for writing");

    $cmd = "$opensslbin x509 -in $root_cert -inform $format -fingerprint -noout";
    $? and die "'$cmd' returned $?";
    chomp(my $md5fp = `$cmd`);

    $cmd = "$opensslbin x509 -in $root_cert -inform $format -text -noout";
    $? and die "'$cmd' returned $?";
    my @cert_text = `$cmd`;

    print "Enter a label, name or description for this certificate: ";
    my $input = <STDIN>;

    my $line = "=======================================\n";
    print ROOT_CERTS "\n$input$line$md5fp\nPEM-Data:\n";

    $cmd = "$opensslbin x509 -in $root_cert -inform $format";
    my $cert = `$cmd`;
    $? and die "'$cmd' returned $?";
    print ROOT_CERTS $cert;
    print ROOT_CERTS @cert_text;
    close (ROOT_CERTS);
  }
  
}

sub newfile ($;$$) {
	# returns a file name which does not exist for tmp file creation
	my $filename = shift;
	my $option = shift;
	$option = "notemp" if (not defined($option));
	if (! $tmpdir and $option eq "temp") {
		$tmpdir = mutt_Q 'tmpdir';
		$tmpdir = newfile("$tmpdir/smime");
		mkdir $tmpdir, 0700 || die "Can't create $tmpdir: $!\n";
	}
	$filename = "$tmpdir/$filename" if ($option eq "temp");
	my $newfilename = $filename;
	my $count = 0;
	while (-e $newfilename) {
		$newfilename = "$filename.$count";
		$count++;
	}
	unshift(@tempfiles,$newfilename);
	return $newfilename;
}


END {
	# remove all our temporary files in the end:
	for (@tempfiles){
		if (-f) {
			unlink;
		} elsif (-d) { 
			rmdir;
		}
	}
}