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 #
   7 #     This program is free software; you can redistribute it and/or modify
   8 #     it under the terms of the GNU General Public License as published by
   9 #     the Free Software Foundation; either version 2 of the License, or
  10 #     (at your option) any later version.
  11 #
  12 #     This program is distributed in the hope that it will be useful,
  13 #     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 #     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 #     GNU General Public License for more details.
  16 #
  17 #     You should have received a copy of the GNU General Public License
  18 #     along with this program; if not, write to the Free Software
  19 #     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111, USA.
  20
  21 use strict;
  22 use File::Copy;
  23
  24 umask 077;
  25
  26 require "timelocal.pl";
  27
  28 sub usage ();
  29 sub newfile ($;$$);
  30 sub mutt_Q ($ );
  31 sub mycopy ($$);
  32
  33 #  directory setup routines
  34 sub mkdir_recursive ($ );
  35 sub init_paths ();
  36
  37 # key/certificate management methods
  38 sub list_certs ();
  39 sub query_label ();
  40 sub add_entry ($$$$$ );
  41 sub add_certificate ($$$$;$ );
  42 sub add_key ($$$$);
  43 sub add_root_cert ($ );
  44 sub parse_pem (@ );
  45 sub handle_pem (@ );
  46 sub modify_entry ($$$;$ );
  47 sub remove_pair ($ );
  48 sub change_label ($ );
  49 sub verify_cert($$);
  50 sub do_verify($$$ );
  51
  52 # Get the directories mutt uses for certificate/key storage.
  53
  54 my $mutt = $ENV{MUTT_CMDLINE} || 'mutt';
  55 my $opensslbin = "/usr/bin/openssl";
  56 my @tempfiles = ();
  57 my @cert_tmp_file = ();
  58
  59 my $tmpdir;
  60 my $private_keys_path = mutt_Q 'smime_keys';
  61 my $certificates_path = mutt_Q 'smime_certificates';
  62 my $root_certs_path   = mutt_Q 'smime_ca_location';
  63 my $root_certs_switch;
  64 if ( -d $root_certs_path) {
  65         $root_certs_switch = -CApath;
  66 } else {
  67         $root_certs_switch = -CAfile;
  68 }
  69
  70
  71 #
  72 # OPS
  73 #
  74
  75 if(@ARGV == 1 and $ARGV[0] eq "init") {
  76     init_paths;
  77 }
  78 elsif(@ARGV == 1 and $ARGV[0] eq "list") {
  79     list_certs;
  80 }
  81 elsif(@ARGV == 2 and $ARGV[0] eq "label") {
  82     change_label($ARGV[1]);
  83 }
  84 elsif(@ARGV == 2 and $ARGV[0] eq "add_cert") {
  85     my $format = -B $ARGV[1] ? 'DER' : 'PEM';
  86     my $cmd = "$opensslbin x509 -noout -hash -in $ARGV[1] -inform $format";
  87     my $cert_hash = `$cmd`;
  88     $? and die "'$cmd' returned $?";
  89     chomp($cert_hash);
  90     my $label = query_label;
  91     &add_certificate($ARGV[1], \$cert_hash, 1, $label, '?');
  92 }
  93 elsif(@ARGV == 2 and $ARGV[0] eq "add_pem") {
  94     -e $ARGV[1] and -s $ARGV[1] or die("$ARGV[1] is nonexistent or empty.");
  95     open(PEM_FILE, "<$ARGV[1]") or die("Can't open $ARGV[1]: $!");
  96     my @pem = <PEM_FILE>;
  97     close(PEM_FILE);
  98     handle_pem(@pem);
  99 }
 100 elsif( @ARGV == 2 and $ARGV[0] eq "add_p12") {
 101     -e $ARGV[1] and -s $ARGV[1] or die("$ARGV[1] is nonexistent or empty.");
 102
 103     print "\nNOTE: This will ask you for two passphrases:\n";
 104     print "       1. The passphrase you used for exporting\n";
 105     print "       2. The passphrase you wish to secure your private key with.\n\n";
 106
 107     my $pem_file = "$ARGV[1].pem";
 108
 109     my $cmd = "$opensslbin pkcs12 -in $ARGV[1] -out $pem_file";
 110     system $cmd and die "'$cmd' returned $?";
 111
 112     -e $pem_file and -s $pem_file or die("Conversion of $ARGV[1] failed.");
 113     open(PEM_FILE, $pem_file) or die("Can't open $pem_file: $!");
 114     my @pem = <PEM_FILE>;
 115     close(PEM_FILE);
 116     unlink $pem_file;
 117     handle_pem(@pem);
 118 }
 119 elsif(@ARGV == 4 and $ARGV[0] eq "add_chain") {
 120     my $mailbox;
 121     my $format = -B $ARGV[2] ? 'DER' : 'PEM';
 122     my $cmd = "$opensslbin x509 -noout -hash -in $ARGV[2] -inform $format";
 123     my $cert_hash = `$cmd`;
 124
 125     $? and die "'$cmd' returned $?";
 126
 127     $format = -B $ARGV[3] ? 'DER' : 'PEM';
 128
 129     $cmd = "$opensslbin x509 -noout -hash -in $ARGV[3] -inform $format";
 130     my $issuer_hash = `$cmd`;
 131     $? and die "'$cmd' returned $?";
 132
 133     chomp($cert_hash);
 134     chomp($issuer_hash);
 135
 136     my $label = query_label;
 137
 138     add_certificate($ARGV[3], \$issuer_hash, 0, $label);
 139     my @mailbox = &add_certificate($ARGV[2], \$cert_hash, 1, $label, $issuer_hash);
 140
 141     foreach $mailbox (@mailbox) {
 142       chomp($mailbox);
 143       add_key($ARGV[1], $cert_hash, $mailbox, $label);
 144     }
 145 }
 146 elsif((@ARGV == 2 or @ARGV == 3) and $ARGV[0] eq "verify") {
 147     verify_cert($ARGV[1], $ARGV[2]);
 148 }
 149 elsif(@ARGV == 2 and $ARGV[0] eq "remove") {
 150     remove_pair($ARGV[1]);
 151 }
 152 elsif(@ARGV == 2 and $ARGV[0] eq "add_root") {
 153     add_root_cert($ARGV[1]);
 154 }
 155 else {
 156     usage;
 157     exit(1);
 158 }
 159
 160 exit(0);
 161
 162
 163
 164
 165
 166 ##############  sub-routines  ########################
 167
 168 sub usage () {
 169     print <<EOF;
 170
 171 Usage: smime_keys <operation>  [file(s) | keyID [file(s)]]
 172
 173         with operation being one of:
 174
 175         init      : no files needed, inits directory structure.
 176
 177         list      : lists the certificates stored in database.
 178         label     : keyID required. changes/removes/adds label.
 179         remove    : keyID required.
 180         verify    : 1=keyID and optionally 2=CRL
 181                     Verifies the certificate chain, and optionally wether
 182                     this certificate is included in supplied CRL (PEM format).
 183                     Note: to verify all certificates at the same time,
 184                     replace keyID with "all"
 185
 186         add_cert  : certificate required.
 187         add_chain : three files reqd: 1=Key, 2=certificate
 188                     plus 3=intermediate certificate(s).
 189         add_p12   : one file reqd. Adds keypair to database.
 190                     file is PKCS12 (e.g. export from netscape).
 191         add_pem   : one file reqd. Adds keypair to database.
 192                     (file was converted from e.g. PKCS12).
 193
 194         add_root  : one file reqd. Adds PEM root certificate to the location
 195                     specified within muttrc (smime_verify_* command)
 196
 197 EOF
 198 }
 199
 200 sub mutt_Q ($) {
 201     my $var = shift or die;
 202
 203     my $cmd = "$mutt -v >/dev/null 2>/dev/null";
 204     system ($cmd) == 0
 205         or die<<EOF;
 206 Couldn't launch mutt. I attempted to do so by running the command "$mutt".
 207 If that's not the right command, you can override it by setting the
 208 environment variable \$MUTT_CMDLINE
 209 EOF
 210
 211     $cmd = "$mutt -Q $var 2>/dev/null";
 212     my $answer = `$cmd`;
 213
 214     $? and die<<EOF;
 215 Couldn't look up the value of the mutt variable "$var".
 216 You must set this in your mutt config file. See contrib/smime.rc for an example.
 217 EOF
 218 #'
 219
 220     $answer =~ /\"(.*?)\"/ and return $1;
 221
 222     $answer =~ /^Mutt (.*?) / and die<<EOF;
 223 This script requires mutt 1.5.0 or later. You are using mutt $1.
 224 EOF
 225
 226     die "Value of $var is weird\n";
 227 }
 228
 229 sub mycopy ($$) {
 230     my $source = shift or die;
 231     my $dest = shift or die;
 232
 233     copy $source, $dest or die "Problem copying $source to $dest: $!\n";
 234 }
 235
 236 #
 237 #  directory setup routines
 238 #
 239
 240
 241 sub mkdir_recursive ($) {
 242     my $path = shift or die;
 243     my $tmp_path;
 244
 245     for my $dir (split /\//, $path) {
 246         $tmp_path .= "$dir/";
 247
 248         -d $tmp_path
 249             or mkdir $tmp_path, 0700
 250                 or die "Can't mkdir $tmp_path: $!";
 251     }
 252 }
 253
 254 sub init_paths () {
 255     mkdir_recursive($certificates_path);
 256     mkdir_recursive($private_keys_path);
 257
 258     my $file;
 259
 260     $file = $certificates_path . "/.index";
 261     -f $file or open(TMP_FILE, ">$file") and close(TMP_FILE)
 262         or die "Can't touch $file: $!";
 263
 264     $file = $private_keys_path . "/.index";
 265     -f $file or open(TMP_FILE, ">$file") and close(TMP_FILE)
 266         or die "Can't touch $file: $!";
 267 }
 268
 269
 270
 271 #
 272 # certificate management methods
 273 #
 274
 275 sub list_certs () {
 276   my %keyflags = ( 'i', '(Invalid)',  'r', '(Revoked)', 'e', '(Expired)',
 277                    'u', '(Unverified)', 'v', '(Valid)', 't', '(Trusted)');
 278
 279   open(INDEX, "<$certificates_path/.index") or
 280     die "Couldn't open $certificates_path/.index: $!";
 281
 282   print "\n";
 283   while(<INDEX>) {
 284     my $tmp;
 285     my @tmp;
 286     my $tab = "            ";
 287     my @fields = split;
 288
 289     if($fields[2] eq '-') {
 290       print "$fields[1]: Issued for: $fields[0] $keyflags{$fields[4]}\n";
 291     } else {
 292       print "$fields[1]: Issued for: $fields[0] \"$fields[2]\" $keyflags{$fields[4]}\n";
 293     }
 294
 295     my $certfile = "$certificates_path/$fields[1]";
 296     my $cert;
 297     {
 298         open F, $certfile or
 299             die "Couldn't open $certfile: $!";
 300         local $/;
 301         $cert = <F>;
 302         close F;
 303     }
 304
 305     my $subject_in;
 306     my $issuer_in;
 307     my $date1_in;
 308     my $date2_in;
 309
 310     my $format = -B $certfile ? 'DER' : 'PEM';
 311     my $cmd = "$opensslbin x509 -subject -issuer -dates -noout -in $certfile -inform $format";
 312     ($subject_in, $issuer_in, $date1_in, $date2_in) = `$cmd`;
 313     $? and print "ERROR: '$cmd' returned $?\n\n" and next;
 314
 315
 316     my @subject = split(/\//, $subject_in);
 317     while(@subject) {
 318       $tmp = shift @subject;
 319       ($tmp =~ /^CN\=/) and last;
 320       undef $tmp;
 321     }
 322     defined $tmp and @tmp = split (/\=/, $tmp) and
 323       print $tab."Subject: $tmp[1]\n";
 324
 325     my @issuer = split(/\//, $issuer_in);
 326     while(@issuer) {
 327       $tmp = shift @issuer;
 328       ($tmp =~ /^CN\=/) and last;
 329       undef $tmp;
 330     }
 331     defined $tmp and @tmp = split (/\=/, $tmp) and
 332       print $tab."Issued by: $tmp[1]";
 333
 334     if ( defined $date1_in and defined $date2_in ) {
 335       @tmp = split (/\=/, $date1_in);
 336       $tmp = $tmp[1];
 337       @tmp = split (/\=/, $date2_in);
 338       print $tab."Certificate is not valid before $tmp".
 339         $tab."                      or after  ".$tmp[1];
 340     }
 341
 342     -e "$private_keys_path/$fields[1]" and
 343       print "$tab - Matching private key installed -\n";
 344
 345     $format = -B "$certificates_path/$fields[1]" ? 'DER' : 'PEM';
 346     $cmd = "$opensslbin x509 -purpose -noout -in $certfile -inform $format";
 347     my $purpose_in = `$cmd`;
 348     $? and die "'$cmd' returned $?";
 349
 350     my @purpose = split (/\n/, $purpose_in);
 351     print "$tab$purpose[0] (displays S/MIME options only)\n";
 352     while(@purpose) {
 353       $tmp = shift @purpose;
 354       ($tmp =~ /^S\/MIME/ and $tmp =~ /Yes/) or next;
 355       my @tmptmp = split (/:/, $tmp);
 356       print "$tab  $tmptmp[0]\n";
 357     }
 358
 359     print "\n";
 360   }
 361
 362   close(INDEX);
 363 }
 364
 365
 366
 367 sub query_label () {
 368     my @words;
 369     my $input;
 370
 371     print "\nYou may assign a label to this key, so you don't have to remember\n";
 372     print "the key ID. This has to be _one_ word (no whitespaces).\n\n";
 373
 374     print "Enter label: ";
 375     chomp($input = <STDIN>);
 376
 377     my ($label, $junk) = split(/\s/, $input, 2);
 378
 379     defined $junk
 380         and print "\nUsing '$label' as label; ignoring '$junk'\n";
 381
 382     defined $label || ($label =  "-");
 383
 384     return $label;
 385 }
 386
 387
 388
 389 sub add_entry ($$$$$) {
 390     my $mailbox = shift or die;
 391     my $hashvalue = shift or die;
 392     my $use_cert = shift;
 393     my $label = shift or die;
 394     my $issuer_hash = shift;
 395
 396     my @fields;
 397
 398     if ($use_cert) {
 399         open(INDEX, "+<$certificates_path/.index") or
 400             die "Couldn't open $certificates_path/.index: $!";
 401     }
 402     else {
 403         open(INDEX, "+<$private_keys_path/.index") or
 404             die "Couldn't open $private_keys_path/.index: $!";
 405     }
 406
 407     while(<INDEX>) {
 408         @fields = split;
 409         return if ($fields[0] eq $mailbox && $fields[1] eq $hashvalue);
 410     }
 411
 412     if ($use_cert) {
 413         print INDEX "$mailbox $hashvalue $label $issuer_hash u\n";
 414     }
 415     else {
 416         print INDEX "$mailbox $hashvalue $label \n";
 417     }
 418
 419     close(INDEX);
 420 }
 421
 422
 423 sub add_certificate ($$$$;$) {
 424     my $filename = shift or die;
 425     my $hashvalue = shift or die;
 426     my $add_to_index = shift;
 427     my $label = shift or die;
 428     my $issuer_hash = shift;
 429
 430     my $iter = 0;
 431     my @mailbox;
 432     my $mailbox;
 433
 434     while(-e "$certificates_path/$$hashvalue.$iter") {
 435         my ($t1, $t2);
 436         my $format = -B $filename ? 'DER' : 'PEM';
 437         my $cmd = "$opensslbin x509 -in $filename -inform $format -fingerprint -noout";
 438         $t1 = `$cmd`;
 439         $? and die "'$cmd' returned $?";
 440
 441         $format = -B "$certificates_path/$$hashvalue.$iter" ? 'DER' : 'PEM';
 442         $cmd = "$opensslbin x509 -in $certificates_path/$$hashvalue.$iter -inform $format -fingerprint -noout";
 443         $t2 = `$cmd`;
 444         $? and die "'$cmd' returned $?";
 445
 446         $t1 eq $t2 and last;
 447
 448         $iter++;
 449     }
 450     $$hashvalue .= ".$iter";
 451
 452     if (-e "$certificates_path/$$hashvalue") {
 453             print "\nCertificate: $certificates_path/$$hashvalue already installed.\n";
 454     }
 455     else {
 456         mycopy $filename, "$certificates_path/$$hashvalue";
 457
 458         if ($add_to_index) {
 459             my $format = -B $filename ? 'DER' : 'PEM';
 460             my $cmd = "$opensslbin x509 -in $filename -inform $format -email -noout";
 461             @mailbox = `$cmd`;
 462             $? and die "'$cmd' returned $?";
 463
 464             foreach $mailbox (@mailbox) {
 465               chomp($mailbox);
 466               add_entry($mailbox, $$hashvalue, 1, $label, $issuer_hash);
 467
 468               print "\ncertificate $$hashvalue ($label) for $mailbox added.\n";
 469             }
 470             verify_cert($$hashvalue, undef);
 471         }
 472         else {
 473             print "added certificate: $certificates_path/$$hashvalue.\n";
 474         }
 475     }
 476
 477     return @mailbox;
 478 }
 479
 480
 481 sub add_key ($$$$) {
 482     my $file = shift or die;
 483     my $hashvalue = shift or die;
 484     my $mailbox = shift or die;
 485     my $label = shift or die;
 486
 487     unless (-e "$private_keys_path/$hashvalue") {
 488         mycopy $file, "$private_keys_path/$hashvalue";
 489     }
 490
 491     add_entry($mailbox, $hashvalue, 0, $label, "");
 492     print "added private key: " .
 493       "$private_keys_path/$hashvalue for $mailbox\n";
 494 }
 495
 496
 497
 498
 499
 500
 501 sub parse_pem (@) {
 502     my $state = 0;
 503     my $cert_iter = 0;
 504     my @bag_attribs;
 505     my $numBags = 0;
 506
 507     $cert_tmp_file[$cert_iter] = newfile("cert_tmp.$cert_iter","temp");
 508     my $cert_tmp_iter = $cert_tmp_file[$cert_iter];
 509     open(CERT_FILE, ">$cert_tmp_iter")
 510         or die "Couldn't open $cert_tmp_iter: $!";
 511
 512     while($_ = shift(@_)) {
 513         if(/^Bag Attributes/) {
 514             $numBags++;
 515             $state == 0 or  die("PEM-parse error at: $.");
 516             $state = 1;
 517             $bag_attribs[$cert_iter*4+1] = "";
 518             $bag_attribs[$cert_iter*4+2] = "";
 519             $bag_attribs[$cert_iter*4+3] = "";
 520         }
 521
 522         ($state == 1) and /localKeyID:\s*(.*)/
 523             and ($bag_attribs[$cert_iter*4+1] = $1);
 524
 525         ($state == 1) and /subject=\s*(.*)/
 526             and ($bag_attribs[$cert_iter*4+2] = $1);
 527
 528         ($state == 1) and /issuer=\s*(.*)/
 529             and ($bag_attribs[$cert_iter*4+3] = $1);
 530
 531         if(/^-----/) {
 532             if(/BEGIN/) {
 533                 print CERT_FILE;
 534                 $state = 2;
 535
 536                 if(/PRIVATE/) {
 537                     $bag_attribs[$cert_iter*4] = "K";
 538                     next;
 539                 }
 540                 if(/CERTIFICATE/) {
 541                     $bag_attribs[$cert_iter*4] = "C";
 542                     next;
 543                 }
 544                 die("What's this: $_");
 545             }
 546             if(/END/) {
 547                 $state = 0;
 548                 print CERT_FILE;
 549                 close(CERT_FILE);
 550                 $cert_iter++;
 551                 $cert_tmp_file[$cert_iter] = newfile("cert_tmp.$cert_iter","temp");
 552                 $cert_tmp_iter = $cert_tmp_file[$cert_iter];
 553                 open(CERT_FILE, ">$cert_tmp_iter")
 554                     or die "Couldn't open $cert_tmp_iter: $!";
 555                 next;
 556             }
 557         }
 558         print CERT_FILE;
 559     }
 560     close(CERT_FILE);
 561
 562     # I'll add support for unbagged cetificates, in case this is needed.
 563     $numBags == $cert_iter or
 564         die("Not all contents were bagged. can't continue.");
 565
 566     return @bag_attribs;
 567 }
 568
 569
 570 # This requires the Bag Attributes to be set
 571 sub handle_pem (@) {
 572
 573     my @pem_contents;
 574     my $iter=0;
 575     my $root_cert;
 576     my $key;
 577     my $certificate;
 578     my $intermediate;
 579     my @mailbox;
 580     my $mailbox;
 581
 582     @pem_contents = &parse_pem(@_);
 583
 584     # private key and certificate use the same 'localKeyID'
 585     while($iter <= $#pem_contents / 4) {
 586         if($pem_contents[$iter * 4] eq "K") {
 587             $key = $iter;
 588             last;
 589         }
 590         $iter++;
 591     }
 592     ($iter > $#pem_contents / 2) and die("Couldn't find private key!");
 593
 594     $pem_contents[($key * 4)+1] or die("Attribute 'localKeyID' wasn't set.");
 595
 596     $iter = 0;
 597     while($iter <= $#pem_contents / 4) {
 598         $iter == $key and ($iter++) and next;
 599         if($pem_contents[($iter * 4)+1] eq $pem_contents[($key * 4)+1]) {
 600             $certificate = $iter;
 601             last;
 602         }
 603         $iter++;
 604     }
 605     ($iter > $#pem_contents / 4) and die("Couldn't find matching certificate!");
 606
 607     my $tmp_key = newfile("tmp_key","temp");
 608     mycopy $cert_tmp_file[$key], $tmp_key;
 609     my $tmp_certificate = newfile("tmp_certificate","temp");
 610     mycopy $cert_tmp_file[$certificate], $tmp_certificate;
 611
 612     # root certificate is self signed
 613     $iter = 0;
 614
 615     while($iter <= $#pem_contents / 4) {
 616         if ($iter == $key or $iter == $certificate) {
 617             $iter++;
 618             next;
 619         }
 620
 621         if($pem_contents[($iter * 4)+2] eq $pem_contents[($iter * 4)+3]) {
 622             $root_cert = $iter;
 623             last;
 624         }
 625         $iter++;
 626     }
 627     if ($iter > $#pem_contents / 4) {
 628       print "Couldn't identify root certificate!\n";
 629       $root_cert = -1;
 630     }
 631
 632     # what's left are intermediate certificates.
 633     $iter = 0;
 634
 635     # needs to be set, so we can check it later
 636     $intermediate = $root_cert;
 637     my $tmp_issuer_cert = newfile("tmp_issuer_cert","temp");
 638     while($iter <= $#pem_contents / 4) {
 639         if ($iter == $key or $iter == $certificate or $iter == $root_cert) {
 640             $iter++;
 641             next;
 642         }
 643
 644         open (IC, ">> $tmp_issuer_cert") or die "can't open $tmp_issuer_cert: $?";
 645         my $cert_tmp_iter = $cert_tmp_file[$iter];
 646         open (CERT, "< $cert_tmp_iter") or die "can't open $cert_tmp_iter: $?";
 647         print IC while (<CERT>);
 648         close IC;
 649         close CERT;
 650
 651         # although there may be many, just need to know if there was any
 652         $intermediate = $iter;
 653
 654         $iter++;
 655     }
 656
 657     # no intermediate certificates ? use root-cert instead (if that was found...)
 658     if($intermediate == $root_cert) {
 659         if ($root_cert == -1) {
 660           die("No root and no intermediate certificates. Can't continue.");
 661         }
 662         mycopy $cert_tmp_file[$root_cert], $tmp_issuer_cert;
 663     }
 664
 665     my $label = query_label;
 666
 667     my $format = -B $tmp_certificate ? 'DER' : 'PEM';
 668     my $cmd = "$opensslbin x509 -noout -hash -in $tmp_certificate -inform $format";
 669     my $cert_hash = `$cmd`;
 670     $? and die "'$cmd' returned $?";
 671
 672     $format = -B $tmp_issuer_cert ? 'DER' : 'PEM';
 673     $cmd = "$opensslbin x509 -noout -hash -in $tmp_issuer_cert -inform $format";
 674     my $issuer_hash = `$cmd`;
 675     $? and die "'$cmd' returned $?";
 676
 677     chomp($cert_hash); chomp($issuer_hash);
 678
 679     # Note: $cert_hash will be changed to reflect the correct filename
 680     #       within add_cert() ONLY, so these _have_ to get called first..
 681     add_certificate($tmp_issuer_cert, \$issuer_hash, 0, $label);
 682     @mailbox = &add_certificate("$tmp_certificate", \$cert_hash, 1, $label, $issuer_hash);
 683     foreach $mailbox (@mailbox) {
 684       chomp($mailbox);
 685       add_key($tmp_key, $cert_hash, $mailbox, $label);
 686     }
 687 }
 688
 689
 690
 691
 692
 693
 694 sub modify_entry ($$$;$ ) {
 695     my $op = shift or die;
 696     my $hashvalue = shift or die;
 697     my $use_cert = shift;
 698     my $crl;
 699     my $label;
 700     my $path;
 701     my @fields;
 702
 703     $op eq 'L' and ($label = shift or die);
 704     $op eq 'V' and ($crl = shift);
 705
 706
 707     if ($use_cert) {
 708         $path = $certificates_path;
 709     }
 710     else {
 711         $path = $private_keys_path;
 712     }
 713
 714     open(INDEX, "<$path/.index") or
 715       die "Couldn't open $path/.index: $!";
 716     my $newindex = newfile("$path/.index.tmp");
 717     open(NEW_INDEX, ">$newindex") or
 718       die "Couldn't create $newindex: $!";
 719
 720     while(<INDEX>) {
 721         @fields = split;
 722         if($fields[1] eq $hashvalue or $hashvalue eq 'all') {
 723           $op eq 'R' and next;
 724           print NEW_INDEX "$fields[0] $fields[1]";
 725           if($op eq 'L') {
 726             if($use_cert) {
 727               print NEW_INDEX " $label $fields[3] $fields[4]";
 728             }
 729             else {
 730               print NEW_INDEX " $label";
 731             }
 732           }
 733           if ($op eq 'V') {
 734             print "\n==> about to verify certificate of $fields[0]\n";
 735             my $flag = &do_verify($fields[1], $fields[3], $crl);
 736             print NEW_INDEX " $fields[2] $fields[3] $flag";
 737           }
 738           print NEW_INDEX "\n";
 739           next;
 740         }
 741         print NEW_INDEX;
 742     }
 743     close(INDEX);
 744     close(NEW_INDEX);
 745
 746     rename $newindex, "$path/.index"
 747         or die "Couldn't rename $newindex to $path/.index: $!\n";
 748
 749     print "\n";
 750 }
 751
 752
 753
 754
 755 sub remove_pair ($ ) {
 756   my $keyid = shift or die;
 757
 758   if (-e "$certificates_path/$keyid") {
 759     unlink "$certificates_path/$keyid";
 760     modify_entry('R', $keyid, 1);
 761     print "Removed certificate $keyid.\n";
 762   }
 763   else {
 764     die "No such certificate: $keyid";
 765   }
 766
 767   if (-e "$private_keys_path/$keyid") {
 768     unlink "$private_keys_path/$keyid";
 769     modify_entry('R', $keyid, 0);
 770     print "Removed private key $keyid.\n";
 771   }
 772 }
 773
 774
 775
 776 sub change_label ($ ) {
 777   my $keyid = shift or die;
 778
 779   my $label = query_label;
 780
 781   if (-e "$certificates_path/$keyid") {
 782     modify_entry('L', $keyid, 1, $label);
 783     print "Changed label for certificate $keyid.\n";
 784   }
 785   else {
 786     die "No such certificate: $keyid";
 787   }
 788
 789   if (-e "$private_keys_path/$keyid") {
 790     modify_entry('L', $keyid, 0, $label);
 791     print "Changed label for private key $keyid.\n";
 792   }
 793
 794 }
 795
 796
 797
 798
 799 sub verify_cert ($$) {
 800   my $keyid = shift or die;
 801   my $crl = shift;
 802
 803   -e "$certificates_path/$keyid" or $keyid eq 'all'
 804     or die "No such certificate: $keyid";
 805   modify_entry('V', $keyid, 1, $crl);
 806 }
 807
 808
 809
 810
 811 sub do_verify($$$) {
 812
 813   my $cert = shift or die;
 814   my $issuerid = shift or die;
 815   my $crl = shift;
 816
 817   my $result = 'i';
 818   my $trust_q;
 819   my $issuer_path;
 820   my $cert_path = "$certificates_path/$cert";
 821
 822   if($issuerid eq '?') {
 823     $issuer_path = "$certificates_path/$cert";
 824   } else {
 825     $issuer_path = "$certificates_path/$issuerid";
 826   }
 827
 828   my $cmd = "$opensslbin verify $root_certs_switch $root_certs_path -purpose smimesign -purpose smimeencrypt -untrusted $issuer_path $cert_path";
 829   my $output = `$cmd`;
 830   $? and die "'$cmd' returned $?";
 831   chop $output;
 832   print "\n$output\n";
 833
 834   ($output =~ /OK/) and ($result = 'v');
 835
 836   $result eq 'i' and return $result;
 837
 838   my $format = -B $cert_path ? 'DER' : 'PEM';
 839   $cmd = "$opensslbin x509 -dates -serial -noout -in $cert_path -inform $format";
 840   (my $date1_in, my $date2_in, my $serial_in) = `$cmd`;
 841   $? and die "'$cmd' returned $?";
 842
 843   if ( defined $date1_in and defined $date2_in ) {
 844     my @tmp = split (/\=/, $date1_in);
 845     my $tmp = $tmp[1];
 846     @tmp = split (/\=/, $date2_in);
 847     my %months = ('Jan', '00', 'Feb', '01', 'Mar', '02', 'Apr', '03',
 848                   'May', '04', 'Jun', '05', 'Jul', '06', 'Aug', '07',
 849                   'Sep', '08', 'Oct', '09', 'Nov', '10', 'Dec', '11');
 850
 851     my @fields =
 852       $tmp =~ /(\w+)\s*(\d+)\s*(\d+):(\d+):(\d+)\s*(\d+)\s*GMT/;
 853
 854     $#fields != 5 and print "Expiration Date: Parse Error :  $tmp\n\n" or
 855       timegm($fields[4], $fields[3], $fields[2], $fields[1],
 856              $months{$fields[0]}, $fields[5]) > time and $result = 'e';
 857     $result eq 'e' and print "Certificate is not yet valid.\n" and return $result;
 858
 859     @fields =
 860       $tmp[1] =~ /(\w+)\s*(\d+)\s*(\d+):(\d+):(\d+)\s*(\d+)\s*GMT/;
 861
 862     $#fields != 5 and print "Expiration Date: Parse Error :  $tmp[1]\n\n" or
 863       timegm($fields[4], $fields[3], $fields[2], $fields[1],
 864              $months{$fields[0]}, $fields[5]) < time and $result = 'e';
 865     $result eq 'e' and print "Certificate has expired.\n" and return $result;
 866
 867   }
 868
 869   if ( defined $crl ) {
 870     my @serial = split (/\=/, $serial_in);
 871     my $cmd = "$opensslbin crl -text -noout -in $crl | grep -A1 $serial[1]";
 872     (my $l1, my $l2) = `$cmd`;
 873     $? and die "'$cmd' returned $?";
 874
 875     if ( defined $l2 ) {
 876       my @revoke_date = split (/:\s/, $l2);
 877       print "FAILURE: Certificate $cert has been revoked on $revoke_date[1]\n";
 878       $result = 'r';
 879     }
 880   }
 881   print "\n";
 882
 883   if ($result eq 'v') {
 884     return 't';
 885   }
 886
 887   return $result;
 888 }
 889
 890
 891
 892 sub add_root_cert ($) {
 893   my $root_cert = shift or die;
 894
 895   my $format = -B $root_cert ? 'DER' : 'PEM';
 896
 897   my $cmd = "$opensslbin x509 -noout -hash -in $root_cert -inform $format";
 898   my $root_hash = `$cmd`;
 899   $? and die "'$cmd' returned $?";
 900
 901   if (-d $root_certs_path) {
 902     -e "$root_certs_path/$root_hash" or
 903         mycopy $root_cert, "$root_certs_path/$root_hash";
 904   }
 905   else {
 906     open(ROOT_CERTS, ">>$root_certs_path") or
 907       die ("Couldn't open $root_certs_path for writing");
 908
 909     $cmd = "$opensslbin x509 -in $root_cert -inform $format -fingerprint -noout";
 910     $? and die "'$cmd' returned $?";
 911     chomp(my $md5fp = `$cmd`);
 912
 913     $cmd = "$opensslbin x509 -in $root_cert -inform $format -text -noout";
 914     $? and die "'$cmd' returned $?";
 915     my @cert_text = `$cmd`;
 916
 917     print "Enter a label, name or description for this certificate: ";
 918     my $input = <STDIN>;
 919
 920     my $line = "=======================================\n";
 921     print ROOT_CERTS "\n$input$line$md5fp\nPEM-Data:\n";
 922
 923     $cmd = "$opensslbin x509 -in $root_cert -inform $format";
 924     my $cert = `$cmd`;
 925     $? and die "'$cmd' returned $?";
 926     print ROOT_CERTS $cert;
 927     print ROOT_CERTS @cert_text;
 928     close (ROOT_CERTS);
 929   }
 930
 931 }
 932
 933 sub newfile ($;$$) {
 934         # returns a file name which does not exist for tmp file creation
 935         my $filename = shift;
 936         my $option = shift;
 937         $option = "notemp" if (not defined($option));
 938         if (! $tmpdir and $option eq "temp") {
 939                 $tmpdir = mutt_Q 'tmpdir';
 940                 $tmpdir = newfile("$tmpdir/smime");
 941                 mkdir $tmpdir, 0700 || die "Can't create $tmpdir: $!\n";
 942         }
 943         $filename = "$tmpdir/$filename" if ($option eq "temp");
 944         my $newfilename = $filename;
 945         my $count = 0;
 946         while (-e $newfilename) {
 947                 $newfilename = "$filename.$count";
 948                 $count++;
 949         }
 950         unshift(@tempfiles,$newfilename);
 951         return $newfilename;
 952 }
 953
 954
 955 END {
 956         # remove all our temporary files in the end:
 957         for (@tempfiles){
 958                 if (-f) {
 959                         unlink;
 960                 } elsif (-d) {
 961                         rmdir;
 962                 }
 963         }
 964 }