jcs.org
mutt stable branch with some hacks
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
22use strict;
23use File::Copy;
24use File::Glob ':glob';
25use File::Temp qw(tempfile tempdir);
26
27umask 077;
28
29use Time::Local;
30
31# helper routines
32sub usage ();
33sub mutt_Q ($);
34sub mycopy ($$);
35sub query_label ();
36sub mkdir_recursive ($);
37sub verify_files_exist (@);
38sub create_tempfile (;$);
39sub new_cert_structure ();
40sub create_cert_chains (@);
41
42# openssl helpers
43sub openssl_exec (@);
44sub openssl_format ($);
45sub openssl_x509_query ($@);
46sub openssl_hash ($);
47sub openssl_fingerprint ($);
48sub openssl_emails ($);
49sub openssl_p12_to_pem ($$);
50sub openssl_verify ($$);
51sub openssl_crl_text($);
52sub openssl_trust_flag ($$;$);
53sub openssl_parse_pem ($$);
54sub openssl_dump_cert ($);
55sub openssl_purpose_flag ($);
56
57# key/certificate management methods
58sub cm_list_certs ();
59sub cm_add_entry ($$$$$$;$);
60sub cm_add_cert ($);
61sub cm_add_indexed_cert ($$$);
62sub cm_add_key ($$$$$$);
63sub cm_modify_entry ($$$;$);
64sub cm_find_entry ($$);
65sub cm_refresh_index ();
66
67# op handlers
68sub handle_init_paths ();
69sub handle_change_label ($);
70sub handle_add_cert ($);
71sub handle_add_pem ($);
72sub handle_add_p12 ($);
73sub handle_add_chain ($$$);
74sub handle_verify_cert($$);
75sub handle_remove_pair ($);
76sub handle_add_root_cert ($);
77
78
79my $mutt = $ENV{MUTT_CMDLINE} || 'mutt';
80my $opensslbin = "/usr/bin/openssl";
81my $tmpdir;
82
83# Get the directories mutt uses for certificate/key storage.
84
85my $private_keys_path = mutt_Q 'smime_keys';
86die "smime_keys is not set in mutt's configuration file"
87 if length $private_keys_path == 0;
88
89my $certificates_path = mutt_Q 'smime_certificates';
90die "smime_certificates is not set in mutt's configuration file"
91 if length $certificates_path == 0;
92
93my $root_certs_path = mutt_Q 'smime_ca_location';
94die "smime_ca_location is not set in mutt's configuration file"
95 if length $root_certs_path == 0;
96
97my $root_certs_switch;
98if ( -d $root_certs_path) {
99 $root_certs_switch = -CApath;
100} else {
101 $root_certs_switch = -CAfile;
102}
103
104
105######
106# OPS
107######
108
109if (@ARGV == 1 and $ARGV[0] eq "init") {
110 handle_init_paths();
111}
112elsif (@ARGV == 1 and $ARGV[0] eq "refresh") {
113 cm_refresh_index();
114}
115elsif (@ARGV == 1 and $ARGV[0] eq "list") {
116 cm_list_certs();
117}
118elsif (@ARGV == 2 and $ARGV[0] eq "label") {
119 handle_change_label($ARGV[1]);
120}
121elsif (@ARGV == 2 and $ARGV[0] eq "add_cert") {
122 verify_files_exist($ARGV[1]);
123 handle_add_cert($ARGV[1]);
124}
125elsif (@ARGV == 2 and $ARGV[0] eq "add_pem") {
126 verify_files_exist($ARGV[1]);
127 handle_add_pem($ARGV[1]);
128}
129elsif ( @ARGV == 2 and $ARGV[0] eq "add_p12") {
130 verify_files_exist($ARGV[1]);
131 handle_add_p12($ARGV[1]);
132}
133elsif (@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}
137elsif ((@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}
141elsif (@ARGV == 2 and $ARGV[0] eq "remove") {
142 handle_remove_pair($ARGV[1]);
143}
144elsif (@ARGV == 2 and $ARGV[0] eq "add_root") {
145 verify_files_exist($ARGV[1]);
146 handle_add_root_cert($ARGV[1]);
147}
148else {
149 usage();
150 exit(1);
151}
152
153exit(0);
154
155
156############## sub-routines ########################
157
158
159###################
160# helper routines
161###################
162
163sub usage () {
164 print <<EOF;
165
166Usage: 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 wether
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
195EOF
196}
197
198sub mutt_Q ($) {
199 my ($var) = @_;
200
201 my $cmd = "$mutt -v >/dev/null 2>/dev/null";
202 system ($cmd) == 0 or die<<EOF;
203Couldn't launch mutt. I attempted to do so by running the command "$mutt".
204If that's not the right command, you can override it by setting the
205environment variable \$MUTT_CMDLINE
206EOF
207
208 $cmd = "$mutt -Q $var 2>/dev/null";
209 my $answer = `$cmd`;
210
211 $? and die<<EOF;
212Couldn't look up the value of the mutt variable "$var".
213You must set this in your mutt config file. See contrib/smime.rc for an example.
214EOF
215
216 $answer =~ /\"(.*?)\"/ and return bsd_glob($1, GLOB_TILDE | GLOB_NOCHECK);
217
218 $answer =~ /^Mutt (.*?) / and die<<EOF;
219This script requires mutt 1.5.0 or later. You are using mutt $1.
220EOF
221
222 die "Value of $var is weird\n";
223}
224
225sub mycopy ($$) {
226 my ($source, $dest) = @_;
227
228 copy $source, $dest or die "Problem copying $source to $dest: $!\n";
229}
230
231sub 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
259sub 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
272sub 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)
283sub 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
297sub 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
309sub 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
354sub 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
372sub openssl_format ($) {
373 my ($filename) = @_;
374
375 return -B $filename ? 'DER' : 'PEM';
376}
377
378sub 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
386sub 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
396sub 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
406sub 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
416sub 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
424sub openssl_verify ($$) {
425 my ($issuer_path, $cert_path) = @_;
426
427 my @args = ("verify", $root_certs_switch, $root_certs_path,
428 "-purpose", "smimesign", "-purpose", "smimeencrypt", "-untrusted",
429 $issuer_path, $cert_path);
430 my $output = join("", openssl_exec(@args));
431
432 chomp($output);
433 return $output;
434}
435
436sub openssl_crl_text($) {
437 my ($crl) = @_;
438
439 my @args = ("crl", "-text", "-noout", "-in", $crl);
440 my @output = openssl_exec(@args);
441 $? and die "openssl crl -text '$crl' returned $?";
442
443 return @output;
444}
445
446sub openssl_trust_flag ($$;$) {
447 my ($cert, $issuerid, $crl) = @_;
448
449 print "==> about to verify certificate of $cert\n";
450
451 my $result = 't';
452 my $issuer_path;
453 my $cert_path = "$certificates_path/$cert";
454
455 if ($issuerid eq '?') {
456 $issuer_path = "$certificates_path/$cert";
457 } else {
458 $issuer_path = "$certificates_path/$issuerid";
459 }
460
461 my $output = openssl_verify($issuer_path, $cert_path);
462 if ($?) {
463 print "openssl verify returned exit code " . ($? >> 8) . " with output:\n";
464 print "$output\n\n";
465 print "Marking certificate as invalid\n";
466 return 'i';
467 }
468 print "\n$output\n";
469
470 if ($output !~ /OK/) {
471 return 'i';
472 }
473
474 my ($not_before, $not_after, $serial_in) = openssl_x509_query($cert_path, "-dates", "-serial");
475 $? and die "openssl -dates -serial '$cert_path' returned $?";
476
477 if ( defined $not_before and defined $not_after ) {
478 my %months = ('Jan', '00', 'Feb', '01', 'Mar', '02', 'Apr', '03',
479 'May', '04', 'Jun', '05', 'Jul', '06', 'Aug', '07',
480 'Sep', '08', 'Oct', '09', 'Nov', '10', 'Dec', '11');
481
482 my @tmp = split (/\=/, $not_before);
483 my $not_before_date = $tmp[1];
484 my @fields =
485 $not_before_date =~ /(\w+)\s*(\d+)\s*(\d+):(\d+):(\d+)\s*(\d+)\s*GMT/;
486 if ($#fields == 5) {
487 if (timegm($fields[4], $fields[3], $fields[2], $fields[1],
488 $months{$fields[0]}, $fields[5]) > time) {
489 print "Certificate is not yet valid.\n";
490 return 'e';
491 }
492 } else {
493 print "Expiration Date: Parse Error : $not_before_date\n\n";
494 }
495
496 @tmp = split (/\=/, $not_after);
497 my $not_after_date = $tmp[1];
498 @fields =
499 $not_after_date =~ /(\w+)\s*(\d+)\s*(\d+):(\d+):(\d+)\s*(\d+)\s*GMT/;
500 if ($#fields == 5) {
501 if (timegm($fields[4], $fields[3], $fields[2], $fields[1],
502 $months{$fields[0]}, $fields[5]) < time) {
503 print "Certificate has expired.\n";
504 return 'e';
505 }
506 } else {
507 print "Expiration Date: Parse Error : $not_after_date\n\n";
508 }
509 }
510
511 if ( defined $crl ) {
512 chomp($serial_in);
513 my @serial = split (/\=/, $serial_in);
514 my $match_line = undef;
515 my @crl_lines = openssl_crl_text($crl);
516 for (my $index = 0; $index <= $#crl_lines; $index++) {
517 if ($crl_lines[$index] =~ /Serial Number:\s*\Q$serial[1]\E\b/) {
518 $match_line = $crl_lines[$index + 1];
519 last;
520 }
521 }
522
523 if ( defined $match_line ) {
524 my @revoke_date = split (/:\s/, $match_line);
525 print "FAILURE: Certificate $cert has been revoked on $revoke_date[1]\n";
526 $result = 'r';
527 }
528 }
529 print "\n";
530
531 return $result;
532}
533
534sub openssl_parse_pem ($$) {
535 my ($filename, $attrs_required) = @_;
536
537 my $state = 0;
538 my $cert_data;
539 my @certs;
540 my $cert_count = 0;
541 my $bag_count = 0;
542 my $cert_tmp_fh;
543 my $cert_tmp_filename;
544
545 $cert_data = new_cert_structure();
546 ($cert_tmp_fh, $cert_data->{datafile}) = create_tempfile();
547
548 open(PEM_FILE, "<$filename") or die("Can't open $filename: $!");
549 while (<PEM_FILE>) {
550 if (/^Bag Attributes/) {
551 $bag_count++;
552 $state == 0 or die("PEM-parse error at: $.");
553 $state = 1;
554 }
555
556 # Allow attributes without the "Bag Attributes" header
557 if ($state != 2) {
558 if (/localKeyID:\s*(.*)/) {
559 $cert_data->{localKeyID} = $1;
560 }
561
562 if (/subject=\s*(.*)/) {
563 $cert_data->{subject} = $1;
564 }
565
566 if (/issuer=\s*(.*)/) {
567 $cert_data->{issuer} = $1;
568 }
569 }
570
571
572 if (/^-----/) {
573 if (/BEGIN/) {
574 print $cert_tmp_fh $_;
575 $state = 2;
576
577 if (/PRIVATE/) {
578 $cert_data->{type} = "K";
579 next;
580 }
581 if (/CERTIFICATE/) {
582 $cert_data->{type} = "C";
583 next;
584 }
585 die("What's this: $_");
586 }
587 if (/END/) {
588 $state = 0;
589 print $cert_tmp_fh $_;
590 close($cert_tmp_fh);
591
592 $cert_count++;
593 push (@certs, $cert_data);
594
595 $cert_data = new_cert_structure();
596 ($cert_tmp_fh, $cert_data->{datafile}) = create_tempfile();
597 next;
598 }
599 }
600 print $cert_tmp_fh $_;
601 }
602 close($cert_tmp_fh);
603 close(PEM_FILE);
604
605 if ($attrs_required && ($bag_count != $cert_count)) {
606 die("Not all contents were bagged. can't continue.");
607 }
608
609 return @certs;
610}
611
612sub openssl_dump_cert ($) {
613 my ($filename) = @_;
614
615 my $format = openssl_format($filename);
616 my @args = ("x509", "-in", $filename, "-inform", $format);
617 my $output = join("", openssl_exec(@args));
618 $? and die "openssl x509 certicate dump returned $?";
619
620 return $output;
621}
622
623sub openssl_purpose_flag ($) {
624 my ($filename) = @_;
625
626 my $purpose = "";
627
628 my @output = openssl_x509_query($filename, "-purpose");
629 $? and die "openssl -purpose '$filename' returned $?";
630
631 foreach my $line (@output) {
632 if ($line =~ /^S\/MIME signing\s*:\s*Yes/) {
633 $purpose .= "s";
634 }
635 elsif ($line =~ /^S\/MIME encryption\s*:\s*Yes/) {
636 $purpose .= "e";
637 }
638 }
639
640 if (! $purpose) {
641 $purpose = "-";
642 }
643
644 return $purpose;
645}
646
647
648#################################
649# certificate management methods
650#################################
651
652sub cm_list_certs () {
653 my %keyflags = ( 'i', '(Invalid)', 'r', '(Revoked)', 'e', '(Expired)',
654 'u', '(Unverified)', 'v', '(Valid)', 't', '(Trusted)');
655
656 open(INDEX, "<$certificates_path/.index") or
657 die "Couldn't open $certificates_path/.index: $!";
658
659 print "\n";
660 while (<INDEX>) {
661 my $tmp;
662 my @tmp;
663 my $tab = " ";
664 my @fields = split;
665
666 if ($fields[2] eq '-') {
667 print "$fields[1]: Issued for: $fields[0] $keyflags{$fields[4]}\n";
668 } else {
669 print "$fields[1]: Issued for: $fields[0] \"$fields[2]\" $keyflags{$fields[4]}\n";
670 }
671
672 my $certfile = "$certificates_path/$fields[1]";
673 my $cert;
674 {
675 open F, $certfile or
676 die "Couldn't open $certfile: $!";
677 local $/;
678 $cert = <F>;
679 close F;
680 }
681
682 my ($subject_in, $issuer_in, $date1_in, $date2_in) =
683 openssl_x509_query($certfile, "-subject", "-issuer", "-dates");
684 $? and print "ERROR: openssl -subject -issuer -dates '$certfile' returned $?\n\n" and next;
685
686
687 my @subject = split(/\//, $subject_in);
688 while (@subject) {
689 $tmp = shift @subject;
690 ($tmp =~ /^CN\=/) and last;
691 undef $tmp;
692 }
693 defined $tmp and @tmp = split (/\=/, $tmp) and
694 print $tab."Subject: $tmp[1]\n";
695
696 my @issuer = split(/\//, $issuer_in);
697 while (@issuer) {
698 $tmp = shift @issuer;
699 ($tmp =~ /^CN\=/) and last;
700 undef $tmp;
701 }
702 defined $tmp and @tmp = split (/\=/, $tmp) and
703 print $tab."Issued by: $tmp[1]";
704
705 if ( defined $date1_in and defined $date2_in ) {
706 @tmp = split (/\=/, $date1_in);
707 $tmp = $tmp[1];
708 @tmp = split (/\=/, $date2_in);
709 print $tab."Certificate is not valid before $tmp".
710 $tab." or after ".$tmp[1];
711 }
712
713 -e "$private_keys_path/$fields[1]" and
714 print "$tab - Matching private key installed -\n";
715
716 my @purpose = openssl_x509_query($certfile, "-purpose");
717 $? and die "openssl -purpose '$certfile' returned $?";
718 chomp(@purpose);
719
720 print "$tab$purpose[0] (displays S/MIME options only)\n";
721 while (@purpose) {
722 $tmp = shift @purpose;
723 ($tmp =~ /^S\/MIME/ and $tmp =~ /Yes/) or next;
724 my @tmptmp = split (/:/, $tmp);
725 print "$tab $tmptmp[0]\n";
726 }
727
728 print "\n";
729 }
730
731 close(INDEX);
732}
733
734sub cm_add_entry ($$$$$$;$) {
735 my ($mailbox, $hashvalue, $use_cert, $label, $trust, $purpose, $issuer_hash) = @_;
736
737 if (! defined($issuer_hash) ) {
738 $issuer_hash = "?";
739 }
740
741 if ($use_cert) {
742 open(INDEX, "+<$certificates_path/.index") or
743 die "Couldn't open $certificates_path/.index: $!";
744 }
745 else {
746 open(INDEX, "+<$private_keys_path/.index") or
747 die "Couldn't open $private_keys_path/.index: $!";
748 }
749
750 while (<INDEX>) {
751 my @fields = split;
752 if (($fields[0] eq $mailbox) && ($fields[1] eq $hashvalue)) {
753 close(INDEX);
754 return;
755 }
756 }
757
758 print INDEX "$mailbox $hashvalue $label $issuer_hash $trust $purpose\n";
759
760 close(INDEX);
761}
762
763# Returns the hashvalue.index of the stored cert
764sub cm_add_cert ($) {
765 my ($filename) = @_;
766
767 my $iter = 0;
768 my $hashvalue = openssl_hash($filename);
769 my $fp1 = openssl_fingerprint($filename);
770
771 while (-e "$certificates_path/$hashvalue.$iter") {
772 my $fp2 = openssl_fingerprint("$certificates_path/$hashvalue.$iter");
773
774 last if $fp1 eq $fp2;
775 $iter++;
776 }
777 $hashvalue .= ".$iter";
778
779 if (-e "$certificates_path/$hashvalue") {
780 print "\nCertificate: $certificates_path/$hashvalue already installed.\n";
781 }
782 else {
783 mycopy $filename, "$certificates_path/$hashvalue";
784 }
785
786 return $hashvalue;
787}
788
789# Returns a reference containing the hashvalue, mailboxes, trust flag, and purpose
790# flag of the stored cert.
791sub cm_add_indexed_cert ($$$) {
792 my ($filename, $label, $issuer_hash) = @_;
793
794 my $cert_data = {};
795
796 $cert_data->{hashvalue} = cm_add_cert($filename);
797 $cert_data->{mailboxes} = [ openssl_emails($filename) ];
798 $cert_data->{trust} = openssl_trust_flag($cert_data->{hashvalue}, $issuer_hash);
799 $cert_data->{purpose} = openssl_purpose_flag($filename);
800
801 foreach my $mailbox (@{$cert_data->{mailboxes}}) {
802 cm_add_entry($mailbox, $cert_data->{hashvalue}, 1, $label,
803 $cert_data->{trust}, $cert_data->{purpose}, $issuer_hash);
804 print "\ncertificate ", $cert_data->{hashvalue}, " ($label) for $mailbox added.\n";
805 }
806
807 return $cert_data;
808}
809
810sub cm_add_key ($$$$$$) {
811 my ($file, $hashvalue, $mailbox, $label, $trust, $purpose) = @_;
812
813 unless (-e "$private_keys_path/$hashvalue") {
814 mycopy $file, "$private_keys_path/$hashvalue";
815 }
816
817 cm_add_entry($mailbox, $hashvalue, 0, $label, $trust, $purpose);
818 print "added private key: " .
819 "$private_keys_path/$hashvalue for $mailbox\n";
820}
821
822sub cm_modify_entry ($$$;$) {
823 my ($op, $hashvalue, $use_cert, $opt_param) = @_;
824
825 my $label;
826 my $trust;
827 my $purpose;
828 my $path;
829 my @fields;
830
831 $op eq 'L' and ($label = $opt_param);
832 $op eq 'T' and ($trust = $opt_param);
833 $op eq 'P' and ($purpose = $opt_param);
834
835 if ($use_cert) {
836 $path = $certificates_path;
837 }
838 else {
839 $path = $private_keys_path;
840 }
841
842 open(INDEX, "<$path/.index") or
843 die "Couldn't open $path/.index: $!";
844 my ($newindex_fh, $newindex) = create_tempfile();
845
846 while (<INDEX>) {
847 chomp;
848
849 # fields: mailbox hash label issuer_hash trust purpose
850 @fields = split;
851
852 if ($fields[1] eq $hashvalue or $hashvalue eq 'all') {
853 $op eq 'R' and next;
854
855 if ($op eq 'L') {
856 $fields[2] = $label;
857 }
858
859 if ($op eq 'T') {
860 $fields[3] = "?" if ($#fields < 3);
861 $fields[4] = $trust;
862 }
863
864 if ($op eq 'P') {
865 $fields[3] = "?" if ($#fields < 3);
866 $fields[4] = "u" if ($#fields < 4);
867 $fields[5] = $purpose;
868 }
869
870 print $newindex_fh join(" ", @fields), "\n";
871 }
872 else {
873 print $newindex_fh $_, "\n";
874 }
875 }
876 close(INDEX);
877 close($newindex_fh);
878
879 move $newindex, "$path/.index"
880 or die "Couldn't move $newindex to $path/.index: $!\n";
881}
882
883# This returns the first matching entry.
884sub cm_find_entry ($$) {
885 my ($hashvalue, $use_cert) = @_;
886
887 my ($path, $index_fh);
888
889 if ($use_cert) {
890 $path = $certificates_path;
891 }
892 else {
893 $path = $private_keys_path;
894 }
895
896 open($index_fh, "<$path/.index") or
897 die "Couldn't open $path/.index: $!";
898
899 while (<$index_fh>) {
900 chomp;
901 my @fields = split;
902 if ($fields[1] eq $hashvalue) {
903 close($index_fh);
904 return @fields;
905 }
906 }
907
908 close($index_fh);
909 return;
910}
911
912# Refreshes trust flags, and adds purpose if missing
913# (e.g. from an older index format)
914sub cm_refresh_index () {
915 my $index_fh;
916
917 my ($last_hash, $last_trust, $last_purpose) = ("", "", "");
918
919 open($index_fh, "<$certificates_path/.index") or
920 die "Couldn't open $certificates_path/.index: $!";
921 my ($newindex_fh, $newindex) = create_tempfile();
922
923 while (<$index_fh>) {
924 chomp;
925
926 # fields: mailbox hash label issuer_hash trust purpose
927 my @fields = split;
928
929 if ($fields[1] eq $last_hash) {
930 $fields[4] = $last_trust;
931 $fields[5] = $last_purpose;
932 }
933 else {
934 # Don't overwrite a revoked flag, because we don't have the CRL
935 if ($fields[4] ne "r") {
936 $fields[4] = openssl_trust_flag($fields[1], $fields[3]);
937 }
938
939 if ($#fields < 5) {
940 $fields[5] = openssl_purpose_flag("$certificates_path/$fields[1]");
941 }
942
943 # To update an old private keys index format, always push the trust
944 # and purpose out.
945 if (-e "$private_keys_path/$fields[1]") {
946 cm_modify_entry ("T", $fields[1], 0, $fields[4]);
947 cm_modify_entry ("P", $fields[1], 0, $fields[5]);
948 }
949
950 $last_hash = $fields[1];
951 $last_trust = $fields[4];
952 $last_purpose = $fields[5];
953 }
954
955 print $newindex_fh join(" ", @fields), "\n";
956 }
957 close($index_fh);
958 close($newindex_fh);
959
960 move $newindex, "$certificates_path/.index"
961 or die "Couldn't move $newindex to $certificates_path/.index: $!\n";
962}
963
964
965##############
966# Op handlers
967##############
968
969sub handle_init_paths () {
970 mkdir_recursive($certificates_path);
971 mkdir_recursive($private_keys_path);
972
973 my $file;
974
975 $file = $certificates_path . "/.index";
976 -f $file or open(TMP_FILE, ">$file") and close(TMP_FILE)
977 or die "Can't touch $file: $!";
978
979 $file = $private_keys_path . "/.index";
980 -f $file or open(TMP_FILE, ">$file") and close(TMP_FILE)
981 or die "Can't touch $file: $!";
982}
983
984sub handle_change_label ($) {
985 my ($keyid) = @_;
986
987 my $label = query_label();
988
989 if (-e "$certificates_path/$keyid") {
990 cm_modify_entry('L', $keyid, 1, $label);
991 print "Changed label for certificate $keyid.\n";
992 }
993 else {
994 die "No such certificate: $keyid";
995 }
996
997 if (-e "$private_keys_path/$keyid") {
998 cm_modify_entry('L', $keyid, 0, $label);
999 print "Changed label for private key $keyid.\n";
1000 }
1001}
1002
1003sub handle_add_cert($) {
1004 my ($filename) = @_;
1005
1006 my $label = query_label();
1007 my @cert_contents = openssl_parse_pem($filename, 0);
1008 @cert_contents = grep { $_->{type} eq "C" } @cert_contents;
1009
1010 my @cert_chains = create_cert_chains(@cert_contents);
1011 print "Found " . scalar(@cert_chains) . " certificate chains\n";
1012
1013 foreach my $chain (@cert_chains) {
1014 my $leaf = shift(@$chain);
1015 my $issuer_chain_hash = "?";
1016
1017 print "Processing chain:\n";
1018 if ($leaf->{subject}) {
1019 print "subject=" . $leaf->{subject} . "\n";
1020 }
1021
1022 if (scalar(@$chain) > 0) {
1023 my ($issuer_chain_fh, $issuer_chain_file) = create_tempfile();
1024
1025 foreach my $issuer (@$chain) {
1026 my $issuer_datafile = $issuer->{datafile};
1027 open(my $issuer_fh, "< $issuer_datafile") or
1028 die "can't open $issuer_datafile: $?";
1029 print $issuer_chain_fh $_ while (<$issuer_fh>);
1030 close($issuer_fh);
1031 }
1032
1033 close($issuer_chain_fh);
1034 $issuer_chain_hash = cm_add_cert($issuer_chain_file);
1035 }
1036
1037 cm_add_indexed_cert($leaf->{datafile}, $label, $issuer_chain_hash);
1038 }
1039}
1040
1041sub handle_add_pem ($) {
1042 my ($filename) = @_;
1043
1044 my @pem_contents;
1045 my $iter;
1046 my $key;
1047 my $certificate;
1048 my $root_cert;
1049 my $issuer_cert_file;
1050
1051 @pem_contents = openssl_parse_pem($filename, 1);
1052
1053 # look for key
1054 $iter = 0;
1055 while ($iter <= $#pem_contents) {
1056 if ($pem_contents[$iter]->{type} eq "K") {
1057 $key = $pem_contents[$iter];
1058 splice(@pem_contents, $iter, 1);
1059 last;
1060 }
1061 $iter++;
1062 }
1063 defined($key) or die("Couldn't find private key!");
1064 $key->{localKeyID} or die("Attribute 'localKeyID' wasn't set.");
1065
1066 # private key and certificate use the same 'localKeyID'
1067 $iter = 0;
1068 while ($iter <= $#pem_contents) {
1069 if (($pem_contents[$iter]->{type} eq "C") &&
1070 ($pem_contents[$iter]->{localKeyID} eq $key->{localKeyID})) {
1071 $certificate = $pem_contents[$iter];
1072 splice(@pem_contents, $iter, 1);
1073 last;
1074 }
1075 $iter++;
1076 }
1077 defined($certificate) or die("Couldn't find matching certificate!");
1078
1079 if ($#pem_contents < 0) {
1080 die("No root and no intermediate certificates. Can't continue.");
1081 }
1082
1083 # Look for a self signed root certificate
1084 $iter = 0;
1085 while ($iter <= $#pem_contents) {
1086 if ($pem_contents[$iter]->{subject} eq $pem_contents[$iter]->{issuer}) {
1087 $root_cert = $pem_contents[$iter];
1088 splice(@pem_contents, $iter, 1);
1089 last;
1090 }
1091 $iter++;
1092 }
1093 if (defined($root_cert)) {
1094 $issuer_cert_file = $root_cert->{datafile};
1095 } else {
1096 print "Couldn't identify root certificate!\n";
1097 }
1098
1099 # what's left are intermediate certificates.
1100 if ($#pem_contents >= 0) {
1101 my ($tmp_issuer_cert_fh, $tmp_issuer_cert) = create_tempfile();
1102 $issuer_cert_file = $tmp_issuer_cert;
1103
1104 $iter = 0;
1105 while ($iter <= $#pem_contents) {
1106 my $cert_datafile = $pem_contents[$iter]->{datafile};
1107 open (CERT, "< $cert_datafile") or die "can't open $cert_datafile: $?";
1108 print $tmp_issuer_cert_fh $_ while (<CERT>);
1109 close CERT;
1110
1111 $iter++;
1112 }
1113 close $tmp_issuer_cert_fh;
1114 }
1115
1116 handle_add_chain($key->{datafile}, $certificate->{datafile}, $issuer_cert_file);
1117}
1118
1119sub handle_add_p12 ($) {
1120 my ($filename) = @_;
1121
1122 print "\nNOTE: This will ask you for two passphrases:\n";
1123 print " 1. The passphrase you used for exporting\n";
1124 print " 2. The passphrase you wish to secure your private key with.\n\n";
1125
1126 my ($pem_fh, $pem_file) = create_tempfile();
1127 close($pem_fh);
1128
1129 openssl_p12_to_pem($filename, $pem_file);
1130 -e $pem_file and -s $pem_file or die("Conversion of $filename failed.");
1131
1132 handle_add_pem($pem_file);
1133}
1134
1135sub handle_add_chain ($$$) {
1136 my ($key_file, $cert_file, $issuer_file) = @_;
1137
1138 my $label = query_label();
1139
1140 my $issuer_hash = cm_add_cert($issuer_file);
1141 my $cert_data = cm_add_indexed_cert($cert_file, $label, $issuer_hash);
1142
1143 foreach my $mailbox (@{$cert_data->{mailboxes}}) {
1144 cm_add_key($key_file, $cert_data->{hashvalue}, $mailbox, $label,
1145 $cert_data->{trust}, $cert_data->{purpose});
1146 }
1147}
1148
1149sub handle_verify_cert ($$) {
1150 my ($keyid, $crl) = @_;
1151
1152 -e "$certificates_path/$keyid" or $keyid eq 'all'
1153 or die "No such certificate: $keyid";
1154
1155 my @fields = cm_find_entry($keyid, 1);
1156 if (scalar(@fields)) {
1157 my $issuer_hash = $fields[3];
1158 my $trust = openssl_trust_flag($keyid, $issuer_hash, $crl);
1159
1160 cm_modify_entry('T', $keyid, 0, $trust);
1161 cm_modify_entry('T', $keyid, 1, $trust);
1162 }
1163}
1164
1165sub handle_remove_pair ($) {
1166 my ($keyid) = @_;
1167
1168 if (-e "$certificates_path/$keyid") {
1169 unlink "$certificates_path/$keyid";
1170 cm_modify_entry('R', $keyid, 1);
1171 print "Removed certificate $keyid.\n";
1172 }
1173 else {
1174 die "No such certificate: $keyid";
1175 }
1176
1177 if (-e "$private_keys_path/$keyid") {
1178 unlink "$private_keys_path/$keyid";
1179 cm_modify_entry('R', $keyid, 0);
1180 print "Removed private key $keyid.\n";
1181 }
1182}
1183
1184sub handle_add_root_cert ($) {
1185 my ($root_cert) = @_;
1186
1187 my $root_hash = openssl_hash($root_cert);
1188
1189 if (-d $root_certs_path) {
1190 -e "$root_certs_path/$root_hash" or
1191 mycopy $root_cert, "$root_certs_path/$root_hash";
1192 }
1193 else {
1194 open(ROOT_CERTS, ">>$root_certs_path") or
1195 die ("Couldn't open $root_certs_path for writing");
1196
1197 my $md5fp = openssl_fingerprint($root_cert);
1198
1199 my @cert_text = openssl_x509_query($root_cert, "-text");
1200 $? and die "openssl -text '$root_cert' returned $?";
1201
1202 print "Enter a label, name or description for this certificate: ";
1203 my $input = <STDIN>;
1204
1205 my $line = "=======================================\n";
1206 print ROOT_CERTS "\n$input$line$md5fp\nPEM-Data:\n";
1207
1208 my $cert = openssl_dump_cert($root_cert);
1209 print ROOT_CERTS $cert;
1210 print ROOT_CERTS @cert_text;
1211 close (ROOT_CERTS);
1212 }
1213}