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