granicus.if.org Git - mutt/blob - smime_keys.pl

   1 #! /usr/bin/perl -w
   2
   3 # Copyright (C) 2001-2002 Oliver Ehli <elmy@acm.org>
   4 # Copyright (C) 2001 Mike Schiraldi <raldi@research.netsol.com>
   5 # Copyright (C) 2003 Bjoern Jacke <bjoern@j3e.de>
   6 # Copyright (C) 2015 Kevin J. McCarthy <kevin@8t8.us>
   7 #
   8 #     This program is free software; you can redistribute it and/or modify
   9 #     it under the terms of the GNU General Public License as published by
  10 #     the Free Software Foundation; either version 2 of the License, or
  11 #     (at your option) any later version.
  12 #
  13 #     This program is distributed in the hope that it will be useful,
  14 #     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 #     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 #     GNU General Public License for more details.
  17 #
  18 #     You should have received a copy of the GNU General Public License
  19 #     along with this program; if not, write to the Free Software
  20 #     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  21
  22 use strict;
  23 use File::Copy;
  24 use File::Glob ':glob';
  25 use File::Temp qw(tempfile tempdir);
  26
  27 umask 077;
  28
  29 use Time::Local;
  30
  31 # helper routines
  32 sub usage ();
  33 sub mutt_Q ($);
  34 sub mycopy ($$);
  35 sub query_label ();
  36 sub mkdir_recursive ($);
  37 sub verify_files_exist (@);
  38 sub create_tempfile (;$);
  39 sub new_cert_structure ();
  40 sub create_cert_chains (@);
  41
  42 # openssl helpers
  43 sub openssl_exec (@);
  44 sub openssl_format ($);
  45 sub openssl_x509_query ($@);
  46 sub openssl_hash ($);
  47 sub openssl_fingerprint ($);
  48 sub openssl_emails ($);
  49 sub openssl_p12_to_pem ($$);
  50 sub openssl_verify ($$);
  51 sub openssl_crl_text($);
  52 sub openssl_trust_flag ($$;$);
  53 sub openssl_parse_pem ($$);
  54 sub openssl_dump_cert ($);
  55 sub openssl_purpose_flag ($$);
  56
  57 # key/certificate management methods
  58 sub cm_list_certs ();
  59 sub cm_add_entry ($$$$$$;$);
  60 sub cm_add_cert ($);
  61 sub cm_add_indexed_cert ($$$);
  62 sub cm_add_key ($$$$$$);
  63 sub cm_modify_entry ($$$;$);
  64 sub cm_find_entry ($$);
  65 sub cm_refresh_index ();
  66
  67 # op handlers
  68 sub handle_init_paths ();
  69 sub handle_change_label ($);
  70 sub handle_add_cert ($);
  71 sub handle_add_pem ($);
  72 sub handle_add_p12 ($);
  73 sub handle_add_chain ($$$);
  74 sub handle_verify_cert($$);
  75 sub handle_remove_pair ($);
  76 sub handle_add_root_cert ($);
  77
  78
  79 my $mutt = $ENV{MUTT_CMDLINE} || 'mutt';
  80 my $opensslbin = "/usr/bin/openssl";
  81 my $tmpdir;
  82
  83 # Get the directories mutt uses for certificate/key storage.
  84
  85 my $private_keys_path = mutt_Q 'smime_keys';
  86 die "smime_keys is not set in mutt's configuration file"
  87    if length $private_keys_path == 0;
  88
  89 my $certificates_path = mutt_Q 'smime_certificates';
  90 die "smime_certificates is not set in mutt's configuration file"
  91    if length $certificates_path == 0;
  92
  93 my $root_certs_path   = mutt_Q 'smime_ca_location';
  94 die "smime_ca_location is not set in mutt's configuration file"
  95    if length $root_certs_path == 0;
  96
  97 my $root_certs_switch;
  98 if ( -d $root_certs_path) {
  99   $root_certs_switch = -CApath;
 100 } else {
 101   $root_certs_switch = -CAfile;
 102 }
 103
 104
 105 ######
 106 # OPS
 107 ######
 108
 109 if (@ARGV == 1 and $ARGV[0] eq "init") {
 110   handle_init_paths();
 111 }
 112 elsif (@ARGV == 1 and $ARGV[0] eq "refresh") {
 113   cm_refresh_index();
 114 }
 115 elsif (@ARGV == 1 and $ARGV[0] eq "list") {
 116   cm_list_certs();
 117 }
 118 elsif (@ARGV == 2 and $ARGV[0] eq "label") {
 119   handle_change_label($ARGV[1]);
 120 }
 121 elsif (@ARGV == 2 and $ARGV[0] eq "add_cert") {
 122   verify_files_exist($ARGV[1]);
 123   handle_add_cert($ARGV[1]);
 124 }
 125 elsif (@ARGV == 2 and $ARGV[0] eq "add_pem") {
 126   verify_files_exist($ARGV[1]);
 127   handle_add_pem($ARGV[1]);
 128 }
 129 elsif ( @ARGV == 2 and $ARGV[0] eq "add_p12") {
 130   verify_files_exist($ARGV[1]);
 131   handle_add_p12($ARGV[1]);
 132 }
 133 elsif (@ARGV == 4 and $ARGV[0] eq "add_chain") {
 134   verify_files_exist($ARGV[1], $ARGV[2], $ARGV[3]);
 135   handle_add_chain($ARGV[1], $ARGV[2], $ARGV[3]);
 136 }
 137 elsif ((@ARGV == 2 or @ARGV == 3) and $ARGV[0] eq "verify") {
 138   verify_files_exist($ARGV[2]) if (@ARGV == 3);
 139   handle_verify_cert($ARGV[1], $ARGV[2]);
 140 }
 141 elsif (@ARGV == 2 and $ARGV[0] eq "remove") {
 142   handle_remove_pair($ARGV[1]);
 143 }
 144 elsif (@ARGV == 2 and $ARGV[0] eq "add_root") {
 145   verify_files_exist($ARGV[1]);
 146   handle_add_root_cert($ARGV[1]);
 147 }
 148 else {
 149   usage();
 150   exit(1);
 151 }
 152
 153 exit(0);
 154
 155
 156 ##############  sub-routines  ########################
 157
 158
 159 ###################
 160 #  helper routines
 161 ###################
 162
 163 sub usage () {
 164     print <<EOF;
 165
 166 Usage: smime_keys <operation>  [file(s) | keyID [file(s)]]
 167
 168         with operation being one of:
 169
 170         init      : no files needed, inits directory structure.
 171         refresh   : refreshes certificate and key index files.
 172                     Updates trust flag (expiration).
 173                     Adds purpose flag if missing.
 174
 175         list      : lists the certificates stored in database.
 176         label     : keyID required. changes/removes/adds label.
 177         remove    : keyID required.
 178         verify    : 1=keyID and optionally 2=CRL
 179                     Verifies the certificate chain, and optionally whether
 180                     this certificate is included in supplied CRL (PEM format).
 181                     Note: to verify all certificates at the same time,
 182                     replace keyID with "all"
 183
 184         add_cert  : certificate required.
 185         add_chain : three files reqd: 1=Key, 2=certificate
 186                     plus 3=intermediate certificate(s).
 187         add_p12   : one file reqd. Adds keypair to database.
 188                     file is PKCS12 (e.g. export from netscape).
 189         add_pem   : one file reqd. Adds keypair to database.
 190                     (file was converted from e.g. PKCS12).
 191
 192         add_root  : one file reqd. Adds PEM root certificate to the location
 193                     specified within muttrc (smime_verify_* command)
 194
 195 EOF
 196 }
 197
 198 sub mutt_Q ($) {
 199   my ($var) = @_;
 200
 201   my $cmd = "$mutt -v >/dev/null 2>/dev/null";
 202   system ($cmd) == 0 or die<<EOF;
 203 Couldn't launch mutt. I attempted to do so by running the command "$mutt".
 204 If that's not the right command, you can override it by setting the
 205 environment variable \$MUTT_CMDLINE
 206 EOF
 207
 208   $cmd = "$mutt -Q $var 2>/dev/null";
 209   my $answer = `$cmd`;
 210
 211   $? and die<<EOF;
 212 Couldn't look up the value of the mutt variable "$var".
 213 You must set this in your mutt config file. See contrib/smime.rc for an example.
 214 EOF
 215
 216   $answer =~ /\"(.*?)\"/ and return bsd_glob($1, GLOB_TILDE | GLOB_NOCHECK);
 217
 218   $answer =~ /^Mutt (.*?) / and die<<EOF;
 219 This script requires mutt 1.5.0 or later. You are using mutt $1.
 220 EOF
 221
 222   die "Value of $var is weird\n";
 223 }
 224
 225 sub mycopy ($$) {
 226   my ($source, $dest) = @_;
 227
 228   copy $source, $dest or die "Problem copying $source to $dest: $!\n";
 229 }
 230
 231 sub query_label () {
 232   my $input;
 233   my $label;
 234   my $junk;
 235
 236   print "\nYou may assign a label to this key, so you don't have to remember\n";
 237   print "the key ID. This has to be _one_ word (no whitespaces).\n\n";
 238
 239   print "Enter label: ";
 240   $input = <STDIN>;
 241
 242   if (defined($input) && ($input !~ /^\s*$/)) {
 243     chomp($input);
 244     $input =~ s/^\s+//;
 245     ($label, $junk) = split(/\s/, $input, 2);
 246
 247     if (defined($junk)) {
 248       print "\nUsing '$label' as label; ignoring '$junk'\n";
 249     }
 250   }
 251
 252   if ((! defined($label)) || ($label =~ /^\s*$/)) {
 253     $label =  "-";
 254   }
 255
 256   return $label;
 257 }
 258
 259 sub mkdir_recursive ($) {
 260   my ($path) = @_;
 261   my $tmp_path;
 262
 263   for my $dir (split /\//, $path) {
 264     $tmp_path .= "$dir/";
 265
 266     -d $tmp_path
 267       or mkdir $tmp_path, 0700
 268         or die "Can't mkdir $tmp_path: $!";
 269   }
 270 }
 271
 272 sub verify_files_exist (@) {
 273   my (@files) = @_;
 274
 275   foreach my $file (@files) {
 276     if ((! -e $file) || (! -s $file)) {
 277       die("$file is nonexistent or empty.");
 278     }
 279   }
 280 }
 281
 282 # Returns a list ($fh, $filename)
 283 sub create_tempfile (;$) {
 284   my ($directory) = @_;
 285
 286   if (! defined($directory)) {
 287     if (! defined($tmpdir)) {
 288       $tmpdir = tempdir(CLEANUP => 1);
 289     }
 290     $directory = $tmpdir;
 291   }
 292
 293   return tempfile(DIR => $directory);
 294 }
 295
 296 # Creates a cert data structure used by openssl_parse_pem
 297 sub new_cert_structure () {
 298   my $cert_data = {};
 299
 300   $cert_data->{datafile} = "";
 301   $cert_data->{type} = "";
 302   $cert_data->{localKeyID} = "";
 303   $cert_data->{subject} = "";
 304   $cert_data->{issuer} = "";
 305
 306   return $cert_data;
 307 }
 308
 309 sub create_cert_chains (@) {
 310   my (@certs) = @_;
 311
 312   my (%subject_hash, @leaves, @chains);
 313
 314   foreach my $cert (@certs) {
 315     $cert->{children} = 0;
 316     if ($cert->{subject}) {
 317       $subject_hash{$cert->{subject}} = $cert;
 318     }
 319   }
 320
 321   foreach my $cert (@certs) {
 322     my $parent = $subject_hash{$cert->{issuer}};
 323     if (defined($parent)) {
 324       $parent->{children} += 1;
 325     }
 326   }
 327
 328   @leaves = grep { $_->{children} == 0 } @certs;
 329   foreach my $leaf (@leaves) {
 330     my $chain = [];
 331     my $cert = $leaf;
 332
 333     while (defined($cert)) {
 334       push @$chain, $cert;
 335
 336       $cert = $subject_hash{$cert->{issuer}};
 337       if (defined($cert) &&
 338           (scalar(grep {$_ == $cert} @$chain) != 0)) {
 339         $cert = undef;
 340       }
 341     }
 342
 343     push @chains, $chain;
 344   }
 345
 346   return @chains;
 347 }
 348
 349
 350 ##################
 351 # openssl helpers
 352 ##################
 353
 354 sub openssl_exec (@) {
 355   my (@args) = @_;
 356
 357   my $fh;
 358
 359   open($fh, "-|", $opensslbin, @args)
 360     or die "Failed to run '$opensslbin @args': $!";
 361   my @output = <$fh>;
 362   if (! close($fh)) {
 363     # NOTE: Callers should check the value of $? for the exit status.
 364     if ($!) {
 365       die "Syserr closing '$opensslbin @args' pipe: $!";
 366     }
 367   }
 368
 369   return @output;
 370 }
 371
 372 sub openssl_format ($) {
 373   my ($filename) = @_;
 374
 375   return -B $filename ? 'DER' : 'PEM';
 376 }
 377
 378 sub openssl_x509_query ($@) {
 379   my ($filename, @query) = @_;
 380
 381   my $format = openssl_format($filename);
 382   my @args = ("x509", "-in", $filename, "-inform", $format, "-noout", @query);
 383   return openssl_exec(@args);
 384 }
 385
 386 sub openssl_hash ($) {
 387   my ($filename) = @_;
 388
 389   my $cert_hash = join("", openssl_x509_query($filename, "-hash"));
 390   $? and die "openssl -hash '$filename' returned $?";
 391
 392   chomp($cert_hash);
 393   return $cert_hash;
 394 }
 395
 396 sub openssl_fingerprint ($) {
 397   my ($filename) = @_;
 398
 399   my $fingerprint = join("", openssl_x509_query($filename, "-fingerprint"));
 400   $? and die "openssl -fingerprint '$filename' returned $?";
 401
 402   chomp($fingerprint);
 403   return $fingerprint;
 404 }
 405
 406 sub openssl_emails ($) {
 407   my ($filename) = @_;
 408
 409   my @mailboxes = openssl_x509_query($filename, "-email");
 410   $? and die "openssl -email '$filename' returned $?";
 411
 412   chomp(@mailboxes);
 413   return @mailboxes;
 414 }
 415
 416 sub openssl_p12_to_pem ($$) {
 417   my ($p12_file, $pem_file) = @_;
 418
 419   my @args = ("pkcs12", "-in", $p12_file, "-out", $pem_file);
 420   openssl_exec(@args);
 421   $? and die "openssl pkcs12 conversion returned $?";
 422 }
 423
 424 sub openssl_verify ($$) {
 425   my ($issuer_path, $cert_path) = @_;
 426
 427   my @args = ("verify", $root_certs_switch, $root_certs_path,
 428               "-untrusted", $issuer_path, $cert_path);
 429   my $output = join("", openssl_exec(@args));
 430
 431   chomp($output);
 432   return $output;
 433 }
 434
 435 sub openssl_crl_text($) {
 436   my ($crl) = @_;
 437
 438   my @args = ("crl", "-text", "-noout", "-in", $crl);
 439   my @output = openssl_exec(@args);
 440   $? and die "openssl crl -text '$crl' returned $?";
 441
 442   return @output;
 443 }
 444
 445 sub openssl_trust_flag ($$;$) {
 446   my ($cert, $issuerid, $crl) = @_;
 447
 448   print "==> about to verify certificate of $cert\n";
 449
 450   my $result = 't';
 451   my $issuer_path;
 452   my $cert_path = "$certificates_path/$cert";
 453
 454   if ($issuerid eq '?') {
 455     $issuer_path = "$certificates_path/$cert";
 456   } else {
 457     $issuer_path = "$certificates_path/$issuerid";
 458   }
 459
 460   my $output = openssl_verify($issuer_path, $cert_path);
 461   if ($?) {
 462     print "openssl verify returned exit code " . ($? >> 8) . " with output:\n";
 463     print "$output\n\n";
 464     print "Marking certificate as invalid\n";
 465     return 'i';
 466   }
 467   print "\n$output\n";
 468
 469   if ($output !~ /OK/) {
 470     return 'i';
 471   }
 472
 473   my ($not_before, $not_after, $serial_in) = openssl_x509_query($cert_path, "-dates", "-serial");
 474   $? and die "openssl -dates -serial '$cert_path' returned $?";
 475
 476   if ( defined $not_before and defined $not_after ) {
 477     my %months = ('Jan', '00', 'Feb', '01', 'Mar', '02', 'Apr', '03',
 478                   'May', '04', 'Jun', '05', 'Jul', '06', 'Aug', '07',
 479                   'Sep', '08', 'Oct', '09', 'Nov', '10', 'Dec', '11');
 480
 481     my @tmp = split (/\=/, $not_before);
 482     my $not_before_date = $tmp[1];
 483     my @fields =
 484       $not_before_date =~ /(\w+)\s*(\d+)\s*(\d+):(\d+):(\d+)\s*(\d+)\s*GMT/;
 485     if ($#fields == 5) {
 486       if (timegm($fields[4], $fields[3], $fields[2], $fields[1],
 487                  $months{$fields[0]}, $fields[5]) > time) {
 488         print "Certificate is not yet valid.\n";
 489         return 'e';
 490       }
 491     } else {
 492       print "Expiration Date: Parse Error :  $not_before_date\n\n";
 493     }
 494
 495     @tmp = split (/\=/, $not_after);
 496     my $not_after_date = $tmp[1];
 497     @fields =
 498       $not_after_date =~ /(\w+)\s*(\d+)\s*(\d+):(\d+):(\d+)\s*(\d+)\s*GMT/;
 499     if ($#fields == 5) {
 500       if (timegm($fields[4], $fields[3], $fields[2], $fields[1],
 501                  $months{$fields[0]}, $fields[5]) < time) {
 502         print "Certificate has expired.\n";
 503         return 'e';
 504       }
 505     } else {
 506       print "Expiration Date: Parse Error :  $not_after_date\n\n";
 507     }
 508   }
 509
 510   if ( defined $crl ) {
 511     chomp($serial_in);
 512     my @serial = split (/\=/, $serial_in);
 513     my $match_line = undef;
 514     my @crl_lines = openssl_crl_text($crl);
 515     for (my $index = 0; $index <= $#crl_lines; $index++) {
 516       if ($crl_lines[$index] =~ /Serial Number:\s*\Q$serial[1]\E\b/) {
 517         $match_line = $crl_lines[$index + 1];
 518         last;
 519       }
 520     }
 521
 522     if ( defined $match_line ) {
 523       my @revoke_date = split (/:\s/, $match_line);
 524       print "FAILURE: Certificate $cert has been revoked on $revoke_date[1]\n";
 525       $result = 'r';
 526     }
 527   }
 528   print "\n";
 529
 530   return $result;
 531 }
 532
 533 sub openssl_parse_pem ($$) {
 534   my ($filename, $attrs_required) = @_;
 535
 536   my $state = 0;
 537   my $cert_data;
 538   my @certs;
 539   my $cert_count = 0;
 540   my $bag_count = 0;
 541   my $cert_tmp_fh;
 542   my $cert_tmp_filename;
 543
 544   $cert_data = new_cert_structure();
 545   ($cert_tmp_fh, $cert_data->{datafile}) = create_tempfile();
 546
 547   open(PEM_FILE, "<$filename") or die("Can't open $filename: $!");
 548   while (<PEM_FILE>) {
 549     if (/^Bag Attributes/) {
 550       $bag_count++;
 551       $state == 0 or  die("PEM-parse error at: $.");
 552       $state = 1;
 553     }
 554
 555     # Allow attributes without the "Bag Attributes" header
 556     if ($state != 2) {
 557       if (/localKeyID:\s*(.*)/) {
 558         $cert_data->{localKeyID} = $1;
 559       }
 560
 561       if (/subject=\s*(.*)/) {
 562         $cert_data->{subject} = $1;
 563       }
 564
 565       if (/issuer=\s*(.*)/) {
 566         $cert_data->{issuer} = $1;
 567       }
 568     }
 569
 570
 571     if (/^-----/) {
 572       if (/BEGIN/) {
 573         print $cert_tmp_fh $_;
 574         $state = 2;
 575
 576         if (/PRIVATE/) {
 577             $cert_data->{type} = "K";
 578             next;
 579         }
 580         if (/CERTIFICATE/) {
 581             $cert_data->{type} = "C";
 582             next;
 583         }
 584         die("What's this: $_");
 585       }
 586       if (/END/) {
 587         $state = 0;
 588         print $cert_tmp_fh $_;
 589         close($cert_tmp_fh);
 590
 591         $cert_count++;
 592         push (@certs, $cert_data);
 593
 594         $cert_data = new_cert_structure();
 595         ($cert_tmp_fh, $cert_data->{datafile}) = create_tempfile();
 596         next;
 597       }
 598     }
 599     print $cert_tmp_fh $_;
 600   }
 601   close($cert_tmp_fh);
 602   close(PEM_FILE);
 603
 604   if ($attrs_required && ($bag_count != $cert_count)) {
 605     die("Not all contents were bagged. can't continue.");
 606   }
 607
 608   return @certs;
 609 }
 610
 611 sub openssl_dump_cert ($) {
 612   my ($filename) = @_;
 613
 614   my $format = openssl_format($filename);
 615   my @args = ("x509", "-in", $filename, "-inform", $format);
 616   my $output = join("", openssl_exec(@args));
 617   $? and die "openssl x509 certificate dump returned $?";
 618
 619   return $output;
 620 }
 621
 622 sub openssl_purpose_flag ($$) {
 623   my ($filename, $certhash) = @_;
 624
 625   print "==> checking purpose flags for $certhash\n";
 626
 627   my $purpose = "";
 628
 629   my @output = openssl_x509_query($filename, "-purpose");
 630   $? and die "openssl -purpose '$filename' returned $?";
 631
 632   foreach my $line (@output) {
 633     if ($line =~ /^S\/MIME signing\s*:\s*Yes/) {
 634       print "\t$line";
 635       $purpose .= "s";
 636     }
 637     elsif ($line =~ /^S\/MIME encryption\s*:\s*Yes/) {
 638       print "\t$line";
 639       $purpose .= "e";
 640     }
 641   }
 642
 643   if (! $purpose) {
 644     print "\tWARNING: neither encryption nor signing flags are enabled.\n";
 645     print "\t         $certhash will not be usable by Mutt.\n";
 646     $purpose = "-";
 647   }
 648
 649   return $purpose;
 650 }
 651
 652
 653 #################################
 654 # certificate management methods
 655 #################################
 656
 657 sub cm_list_certs () {
 658   my %keyflags = ( 'i', '(Invalid)',  'r', '(Revoked)', 'e', '(Expired)',
 659                    'u', '(Unverified)', 'v', '(Valid)', 't', '(Trusted)');
 660
 661   open(INDEX, "<$certificates_path/.index") or
 662     die "Couldn't open $certificates_path/.index: $!";
 663
 664   print "\n";
 665   while (<INDEX>) {
 666     my $tmp;
 667     my @tmp;
 668     my $tab = "            ";
 669     my @fields = split;
 670
 671     if ($fields[2] eq '-') {
 672       print "$fields[1]: Issued for: $fields[0] $keyflags{$fields[4]}\n";
 673     } else {
 674       print "$fields[1]: Issued for: $fields[0] \"$fields[2]\" $keyflags{$fields[4]}\n";
 675     }
 676
 677     my $certfile = "$certificates_path/$fields[1]";
 678     my $cert;
 679     {
 680         open F, $certfile or
 681             die "Couldn't open $certfile: $!";
 682         local $/;
 683         $cert = <F>;
 684         close F;
 685     }
 686
 687     my ($subject_in, $issuer_in, $date1_in, $date2_in) =
 688       openssl_x509_query($certfile, "-subject", "-issuer", "-dates");
 689     $? and print "ERROR: openssl -subject -issuer -dates '$certfile' returned $?\n\n" and next;
 690
 691
 692     my @subject = split(/\//, $subject_in);
 693     while (@subject) {
 694       $tmp = shift @subject;
 695       ($tmp =~ /^CN\=/) and last;
 696       undef $tmp;
 697     }
 698     defined $tmp and @tmp = split (/\=/, $tmp) and
 699       print $tab."Subject: $tmp[1]\n";
 700
 701     my @issuer = split(/\//, $issuer_in);
 702     while (@issuer) {
 703       $tmp = shift @issuer;
 704       ($tmp =~ /^CN\=/) and last;
 705       undef $tmp;
 706     }
 707     defined $tmp and @tmp = split (/\=/, $tmp) and
 708       print $tab."Issued by: $tmp[1]";
 709
 710     if ( defined $date1_in and defined $date2_in ) {
 711       @tmp = split (/\=/, $date1_in);
 712       $tmp = $tmp[1];
 713       @tmp = split (/\=/, $date2_in);
 714       print $tab."Certificate is not valid before $tmp".
 715         $tab."                      or after  ".$tmp[1];
 716     }
 717
 718     -e "$private_keys_path/$fields[1]" and
 719       print "$tab - Matching private key installed -\n";
 720
 721     my @purpose = openssl_x509_query($certfile, "-purpose");
 722     $? and die "openssl -purpose '$certfile' returned $?";
 723     chomp(@purpose);
 724
 725     print "$tab$purpose[0] (displays S/MIME options only)\n";
 726     while (@purpose) {
 727       $tmp = shift @purpose;
 728       ($tmp =~ /^S\/MIME/ and $tmp =~ /Yes/) or next;
 729       my @tmptmp = split (/:/, $tmp);
 730       print "$tab  $tmptmp[0]\n";
 731     }
 732
 733     print "\n";
 734   }
 735
 736   close(INDEX);
 737 }
 738
 739 sub cm_add_entry ($$$$$$;$) {
 740   my ($mailbox, $hashvalue, $use_cert, $label, $trust, $purpose, $issuer_hash) = @_;
 741
 742   if (! defined($issuer_hash) ) {
 743     $issuer_hash = "?";
 744   }
 745
 746   if ($use_cert) {
 747     open(INDEX, "+<$certificates_path/.index") or
 748         die "Couldn't open $certificates_path/.index: $!";
 749   }
 750   else {
 751     open(INDEX, "+<$private_keys_path/.index") or
 752         die "Couldn't open $private_keys_path/.index: $!";
 753   }
 754
 755   while (<INDEX>) {
 756     my @fields = split;
 757     if (($fields[0] eq $mailbox) && ($fields[1] eq $hashvalue)) {
 758       close(INDEX);
 759       return;
 760     }
 761   }
 762
 763   print INDEX "$mailbox $hashvalue $label $issuer_hash $trust $purpose\n";
 764
 765   close(INDEX);
 766 }
 767
 768 # Returns the hashvalue.index of the stored cert
 769 sub cm_add_cert ($) {
 770   my ($filename) = @_;
 771
 772   my $iter = 0;
 773   my $hashvalue = openssl_hash($filename);
 774   my $fp1 = openssl_fingerprint($filename);
 775
 776   while (-e "$certificates_path/$hashvalue.$iter") {
 777     my $fp2 = openssl_fingerprint("$certificates_path/$hashvalue.$iter");
 778
 779     last if $fp1 eq $fp2;
 780     $iter++;
 781   }
 782   $hashvalue .= ".$iter";
 783
 784   if (-e "$certificates_path/$hashvalue") {
 785     print "\nCertificate: $certificates_path/$hashvalue already installed.\n";
 786   }
 787   else {
 788     mycopy $filename, "$certificates_path/$hashvalue";
 789   }
 790
 791   return $hashvalue;
 792 }
 793
 794 # Returns a reference containing the hashvalue, mailboxes, trust flag, and purpose
 795 # flag of the stored cert.
 796 sub cm_add_indexed_cert ($$$) {
 797   my ($filename, $label, $issuer_hash) = @_;
 798
 799   my $cert_data = {};
 800
 801   $cert_data->{hashvalue} = cm_add_cert($filename);
 802   $cert_data->{mailboxes} = [ openssl_emails($filename) ];
 803   $cert_data->{trust} = openssl_trust_flag($cert_data->{hashvalue}, $issuer_hash);
 804   $cert_data->{purpose} = openssl_purpose_flag($filename, $cert_data->{hashvalue});
 805
 806   foreach my $mailbox (@{$cert_data->{mailboxes}}) {
 807     cm_add_entry($mailbox, $cert_data->{hashvalue}, 1, $label,
 808                  $cert_data->{trust}, $cert_data->{purpose}, $issuer_hash);
 809     print "\ncertificate ", $cert_data->{hashvalue}, " ($label) for $mailbox added.\n";
 810   }
 811
 812   return $cert_data;
 813 }
 814
 815 sub cm_add_key ($$$$$$) {
 816     my ($file, $hashvalue, $mailbox, $label, $trust, $purpose) = @_;
 817
 818     unless (-e "$private_keys_path/$hashvalue") {
 819         mycopy $file, "$private_keys_path/$hashvalue";
 820     }
 821
 822     cm_add_entry($mailbox, $hashvalue, 0, $label, $trust, $purpose);
 823     print "added private key: " .
 824       "$private_keys_path/$hashvalue for $mailbox\n";
 825 }
 826
 827 sub cm_modify_entry ($$$;$) {
 828   my ($op, $hashvalue, $use_cert, $opt_param) = @_;
 829
 830   my $label;
 831   my $trust;
 832   my $purpose;
 833   my $path;
 834   my @fields;
 835
 836   $op eq 'L' and ($label = $opt_param);
 837   $op eq 'T' and ($trust = $opt_param);
 838   $op eq 'P' and ($purpose = $opt_param);
 839
 840   if ($use_cert) {
 841     $path = $certificates_path;
 842   }
 843   else {
 844     $path = $private_keys_path;
 845   }
 846
 847   open(INDEX, "<$path/.index") or
 848     die "Couldn't open $path/.index: $!";
 849   my ($newindex_fh, $newindex) = create_tempfile();
 850
 851   while (<INDEX>) {
 852     chomp;
 853
 854     # fields: mailbox hash label issuer_hash trust purpose
 855     @fields = split;
 856
 857     if ($fields[1] eq $hashvalue or $hashvalue eq 'all') {
 858       $op eq 'R' and next;
 859
 860       if ($op eq 'L') {
 861         $fields[2] = $label;
 862       }
 863
 864       if ($op eq 'T') {
 865         $fields[3] = "?" if ($#fields < 3);
 866         $fields[4] = $trust;
 867       }
 868
 869       if ($op eq 'P') {
 870         $fields[3] = "?" if ($#fields < 3);
 871         $fields[4] = "u" if ($#fields < 4);
 872         $fields[5] = $purpose;
 873       }
 874
 875       print $newindex_fh join(" ", @fields), "\n";
 876     }
 877     else {
 878       print $newindex_fh $_, "\n";
 879     }
 880   }
 881   close(INDEX);
 882   close($newindex_fh);
 883
 884   move $newindex, "$path/.index"
 885       or die "Couldn't move $newindex to $path/.index: $!\n";
 886 }
 887
 888 # This returns the first matching entry.
 889 sub cm_find_entry ($$) {
 890   my ($hashvalue, $use_cert) = @_;
 891
 892   my ($path, $index_fh);
 893
 894   if ($use_cert) {
 895     $path = $certificates_path;
 896   }
 897   else {
 898     $path = $private_keys_path;
 899   }
 900
 901   open($index_fh, "<$path/.index") or
 902     die "Couldn't open $path/.index: $!";
 903
 904   while (<$index_fh>) {
 905     chomp;
 906     my @fields = split;
 907     if ($fields[1] eq $hashvalue) {
 908       close($index_fh);
 909       return @fields;
 910     }
 911   }
 912
 913   close($index_fh);
 914   return;
 915 }
 916
 917 # Refreshes trust flags, and adds purpose if missing
 918 # (e.g. from an older index format)
 919 sub cm_refresh_index () {
 920   my $index_fh;
 921
 922   my ($last_hash, $last_trust, $last_purpose) = ("", "", "");
 923
 924   open($index_fh, "<$certificates_path/.index") or
 925     die "Couldn't open $certificates_path/.index: $!";
 926   my ($newindex_fh, $newindex) = create_tempfile();
 927
 928   while (<$index_fh>) {
 929     chomp;
 930
 931     # fields: mailbox hash label issuer_hash trust purpose
 932     my @fields = split;
 933
 934     if ($fields[1] eq $last_hash) {
 935       $fields[4] = $last_trust;
 936       $fields[5] = $last_purpose;
 937     }
 938     else {
 939       # Don't overwrite a revoked flag, because we don't have the CRL
 940       if ($fields[4] ne "r") {
 941         $fields[4] = openssl_trust_flag($fields[1], $fields[3]);
 942       }
 943
 944       if ($#fields < 5) {
 945         $fields[5] = openssl_purpose_flag("$certificates_path/$fields[1]", $fields[1]);
 946       }
 947
 948       # To update an old private keys index format, always push the trust
 949       # and purpose out.
 950       if (-e "$private_keys_path/$fields[1]") {
 951         cm_modify_entry ("T", $fields[1], 0, $fields[4]);
 952         cm_modify_entry ("P", $fields[1], 0, $fields[5]);
 953       }
 954
 955       $last_hash = $fields[1];
 956       $last_trust = $fields[4];
 957       $last_purpose = $fields[5];
 958     }
 959
 960     print $newindex_fh join(" ", @fields), "\n";
 961   }
 962   close($index_fh);
 963   close($newindex_fh);
 964
 965   move $newindex, "$certificates_path/.index"
 966       or die "Couldn't move $newindex to $certificates_path/.index: $!\n";
 967 }
 968
 969
 970 ##############
 971 # Op handlers
 972 ##############
 973
 974 sub handle_init_paths () {
 975   mkdir_recursive($certificates_path);
 976   mkdir_recursive($private_keys_path);
 977
 978   my $file;
 979
 980   $file = $certificates_path . "/.index";
 981   -f $file or open(TMP_FILE, ">$file") and close(TMP_FILE)
 982       or die "Can't touch $file: $!";
 983
 984   $file = $private_keys_path . "/.index";
 985   -f $file or open(TMP_FILE, ">$file") and close(TMP_FILE)
 986       or die "Can't touch $file: $!";
 987 }
 988
 989 sub handle_change_label ($) {
 990   my ($keyid) = @_;
 991
 992   my $label = query_label();
 993
 994   if (-e "$certificates_path/$keyid") {
 995     cm_modify_entry('L', $keyid, 1, $label);
 996     print "Changed label for certificate $keyid.\n";
 997   }
 998   else {
 999     die "No such certificate: $keyid";
1000   }
1001
1002   if (-e "$private_keys_path/$keyid") {
1003     cm_modify_entry('L', $keyid, 0, $label);
1004     print "Changed label for private key $keyid.\n";
1005   }
1006 }
1007
1008 sub handle_add_cert($) {
1009   my ($filename) = @_;
1010
1011   my $label = query_label();
1012   my @cert_contents = openssl_parse_pem($filename, 0);
1013   @cert_contents = grep { $_->{type} eq "C" } @cert_contents;
1014
1015   my @cert_chains = create_cert_chains(@cert_contents);
1016   print "Found " . scalar(@cert_chains) . " certificate chains\n";
1017
1018   foreach my $chain (@cert_chains) {
1019     my $leaf = shift(@$chain);
1020     my $issuer_chain_hash = "?";
1021
1022     print "Processing chain:\n";
1023     if ($leaf->{subject}) {
1024       print "subject=" . $leaf->{subject} . "\n";
1025     }
1026
1027     if (scalar(@$chain) > 0) {
1028       my ($issuer_chain_fh, $issuer_chain_file) = create_tempfile();
1029
1030       foreach my $issuer (@$chain) {
1031         my $issuer_datafile = $issuer->{datafile};
1032         open(my $issuer_fh, "< $issuer_datafile") or
1033             die "can't open $issuer_datafile: $?";
1034         print $issuer_chain_fh $_ while (<$issuer_fh>);
1035         close($issuer_fh);
1036       }
1037
1038       close($issuer_chain_fh);
1039       $issuer_chain_hash = cm_add_cert($issuer_chain_file);
1040     }
1041
1042     cm_add_indexed_cert($leaf->{datafile}, $label, $issuer_chain_hash);
1043   }
1044 }
1045
1046 sub handle_add_pem ($) {
1047   my ($filename) = @_;
1048
1049   my @pem_contents;
1050   my $iter;
1051   my $key;
1052   my $certificate;
1053   my $root_cert;
1054   my $issuer_cert_file;
1055
1056   @pem_contents = openssl_parse_pem($filename, 1);
1057
1058   # look for key
1059   $iter = 0;
1060   while ($iter <= $#pem_contents) {
1061     if ($pem_contents[$iter]->{type} eq "K") {
1062       $key = $pem_contents[$iter];
1063       splice(@pem_contents, $iter, 1);
1064       last;
1065     }
1066     $iter++;
1067   }
1068   defined($key) or die("Couldn't find private key!");
1069   $key->{localKeyID} or die("Attribute 'localKeyID' wasn't set.");
1070
1071   # private key and certificate use the same 'localKeyID'
1072   $iter = 0;
1073   while ($iter <= $#pem_contents) {
1074     if (($pem_contents[$iter]->{type} eq "C") &&
1075         ($pem_contents[$iter]->{localKeyID} eq $key->{localKeyID})) {
1076       $certificate = $pem_contents[$iter];
1077       splice(@pem_contents, $iter, 1);
1078       last;
1079     }
1080     $iter++;
1081   }
1082   defined($certificate) or die("Couldn't find matching certificate!");
1083
1084   if ($#pem_contents < 0) {
1085     die("No root and no intermediate certificates. Can't continue.");
1086   }
1087
1088   # Look for a self signed root certificate
1089   $iter = 0;
1090   while ($iter <= $#pem_contents) {
1091     if ($pem_contents[$iter]->{subject} eq $pem_contents[$iter]->{issuer}) {
1092       $root_cert = $pem_contents[$iter];
1093       splice(@pem_contents, $iter, 1);
1094       last;
1095     }
1096     $iter++;
1097   }
1098   if (defined($root_cert)) {
1099     $issuer_cert_file = $root_cert->{datafile};
1100   } else {
1101     print "Couldn't identify root certificate!\n";
1102   }
1103
1104   # what's left are intermediate certificates.
1105   if ($#pem_contents >= 0) {
1106     my ($tmp_issuer_cert_fh, $tmp_issuer_cert) = create_tempfile();
1107     $issuer_cert_file = $tmp_issuer_cert;
1108
1109     $iter = 0;
1110     while ($iter <= $#pem_contents) {
1111       my $cert_datafile = $pem_contents[$iter]->{datafile};
1112       open (CERT, "< $cert_datafile") or die "can't open $cert_datafile: $?";
1113       print $tmp_issuer_cert_fh $_ while (<CERT>);
1114       close CERT;
1115
1116       $iter++;
1117     }
1118     close $tmp_issuer_cert_fh;
1119   }
1120
1121   handle_add_chain($key->{datafile}, $certificate->{datafile}, $issuer_cert_file);
1122 }
1123
1124 sub handle_add_p12 ($) {
1125   my ($filename) = @_;
1126
1127   print "\nNOTE: This will ask you for two passphrases:\n";
1128   print "       1. The passphrase you used for exporting\n";
1129   print "       2. The passphrase you wish to secure your private key with.\n\n";
1130
1131   my ($pem_fh, $pem_file) = create_tempfile();
1132   close($pem_fh);
1133
1134   openssl_p12_to_pem($filename, $pem_file);
1135   -e $pem_file and -s $pem_file or die("Conversion of $filename failed.");
1136
1137   handle_add_pem($pem_file);
1138 }
1139
1140 sub handle_add_chain ($$$) {
1141   my ($key_file, $cert_file, $issuer_file) = @_;
1142
1143   my $label = query_label();
1144
1145   my $issuer_hash = cm_add_cert($issuer_file);
1146   my $cert_data = cm_add_indexed_cert($cert_file, $label, $issuer_hash);
1147
1148   foreach my $mailbox (@{$cert_data->{mailboxes}}) {
1149     cm_add_key($key_file, $cert_data->{hashvalue}, $mailbox, $label,
1150                $cert_data->{trust}, $cert_data->{purpose});
1151   }
1152 }
1153
1154 sub handle_verify_cert ($$) {
1155   my ($keyid, $crl) = @_;
1156
1157   -e "$certificates_path/$keyid" or $keyid eq 'all'
1158     or die "No such certificate: $keyid";
1159
1160   my @fields = cm_find_entry($keyid, 1);
1161   if (scalar(@fields)) {
1162     my $issuer_hash = $fields[3];
1163     my $trust = openssl_trust_flag($keyid, $issuer_hash, $crl);
1164
1165     cm_modify_entry('T', $keyid, 0, $trust);
1166     cm_modify_entry('T', $keyid, 1, $trust);
1167   }
1168 }
1169
1170 sub handle_remove_pair ($) {
1171   my ($keyid) = @_;
1172
1173   if (-e "$certificates_path/$keyid") {
1174     unlink "$certificates_path/$keyid";
1175     cm_modify_entry('R', $keyid, 1);
1176     print "Removed certificate $keyid.\n";
1177   }
1178   else {
1179     die "No such certificate: $keyid";
1180   }
1181
1182   if (-e "$private_keys_path/$keyid") {
1183     unlink "$private_keys_path/$keyid";
1184     cm_modify_entry('R', $keyid, 0);
1185     print "Removed private key $keyid.\n";
1186   }
1187 }
1188
1189 sub handle_add_root_cert ($) {
1190   my ($root_cert) = @_;
1191
1192   my $root_hash = openssl_hash($root_cert);
1193
1194   if (-d $root_certs_path) {
1195     -e "$root_certs_path/$root_hash" or
1196         mycopy $root_cert, "$root_certs_path/$root_hash";
1197   }
1198   else {
1199     open(ROOT_CERTS, ">>$root_certs_path") or
1200       die ("Couldn't open $root_certs_path for writing");
1201
1202     my $md5fp = openssl_fingerprint($root_cert);
1203
1204     my @cert_text = openssl_x509_query($root_cert, "-text");
1205     $? and die "openssl -text '$root_cert' returned $?";
1206
1207     print "Enter a label, name or description for this certificate: ";
1208     my $input = <STDIN>;
1209
1210     my $line = "=======================================\n";
1211     print ROOT_CERTS "\n$input$line$md5fp\nPEM-Data:\n";
1212
1213     my $cert = openssl_dump_cert($root_cert);
1214     print ROOT_CERTS $cert;
1215     print ROOT_CERTS @cert_text;
1216     close (ROOT_CERTS);
1217   }
1218 }