tor-browser

The Tor Browser
git clone https://git.dasho.dev/tor-browser.git
Log | Files | Refs | README | LICENSE

smime (16448B)


      1 #!/usr/local/bin/perl
      2 
      3 # This Source Code Form is subject to the terms of the Mozilla Public
      4 # License, v. 2.0. If a copy of the MPL was not distributed with this
      5 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
      6 
      7 #
      8 # smime.pl - frontend for S/MIME message generation and parsing
      9 #
     10 
     11 use Getopt::Std;
     12 
     13 @boundarychars = ( "0" .. "9", "A" .. "F" );
     14 
     15 # path to cmsutil
     16 $cmsutilpath = "cmsutil";
     17 
     18 #
     19 # Thanks to Gisle Aas <gisle@aas.no> for the base64 functions
     20 # originally taken from MIME-Base64-2.11 at www.cpan.org
     21 #
     22 sub encode_base64($)
     23 {
     24     my $res = "";
     25     pos($_[0]) = 0;                          # ensure start at the beginning
     26     while ($_[0] =~ /(.{1,45})/gs) {
     27 	$res .= substr(pack('u', $1), 1);    # get rid of length byte after packing
     28 	chop($res);
     29     }
     30     $res =~ tr|` -_|AA-Za-z0-9+/|;
     31     # fix padding at the end
     32     my $padding = (3 - length($_[0]) % 3) % 3;
     33     $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
     34     # break encoded string into lines of no more than 76 characters each
     35     $res =~ s/(.{1,76})/$1\n/g;
     36     $res;
     37 }
     38 
     39 sub decode_base64($)
     40 {
     41     local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
     42 
     43     my $str = shift;
     44     my $res = "";
     45 
     46     $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
     47     if (length($str) % 4) {
     48 	require Carp;
     49 	Carp::carp("Length of base64 data not a multiple of 4")
     50     }
     51     $str =~ s/=+$//;                        # remove padding
     52     $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
     53     while ($str =~ /(.{1,60})/gs) {
     54 	my $len = chr(32 + length($1)*3/4); # compute length byte
     55 	$res .= unpack("u", $len . $1 );    # uudecode
     56     }
     57     $res;
     58 }
     59 
     60 #
     61 # parse headers into a hash
     62 #
     63 # %headers = parseheaders($headertext);
     64 #
     65 sub parseheaders($)
     66 {
     67     my ($headerdata) = @_;
     68     my $hdr;
     69     my %hdrhash;
     70     my $hdrname;
     71     my $hdrvalue;
     72     my @hdrvalues;
     73     my $subhdrname;
     74     my $subhdrvalue;
     75 
     76     # the expression in split() correctly handles continuation lines
     77     foreach $hdr (split(/\n(?=\S)/, $headerdata)) {
     78 	$hdr =~ s/\r*\n\s+/ /g;	# collapse continuation lines
     79 	($hdrname, $hdrvalue) = $hdr =~ m/^(\S+):\s+(.*)$/;
     80 
     81 	# ignore non-headers (or should we die horribly?)
     82 	next unless (defined($hdrname));
     83 	$hdrname =~ tr/A-Z/a-z/;			# lowercase the header name
     84 	@hdrvalues = split(/\s*;\s*/, $hdrvalue);	# split header values (XXXX quoting)
     85 
     86 	# there is guaranteed to be at least one value
     87 	$hdrvalue = shift @hdrvalues;
     88 	if ($hdrvalue =~ /^\s*\"(.*)\"\s*$/) {		# strip quotes if there
     89 	    $hdrvalue = $1;
     90 	}
     91 
     92 	$hdrhash{$hdrname}{MAIN} = $hdrvalue;
     93 	# print "XXX $hdrname = $hdrvalue\n";
     94 
     95 	# deal with additional name-value pairs
     96 	foreach $hdrvalue (@hdrvalues) {
     97 	    ($subhdrname, $subhdrvalue) = $hdrvalue =~ m/^(\S+)\s*=\s*(.*)$/;
     98 	    # ignore non-name-value pairs (or should we die?)
     99 	    next unless (defined($subhdrname));
    100 	    $subhdrname =~ tr/A-Z/a-z/;
    101 	    if ($subhdrvalue =~ /^\s*\"(.*)\"\s*$/) {	# strip quotes if there
    102 		$subhdrvalue = $1;
    103 	    }
    104 	    $hdrhash{$hdrname}{$subhdrname} = $subhdrvalue;
    105 	}
    106 
    107     }
    108     return %hdrhash;
    109 }
    110 
    111 #
    112 # encryptentity($entity, $options) - encrypt an S/MIME entity,
    113 #                                    creating a new application/pkcs7-smime entity
    114 #
    115 # entity  - string containing entire S/MIME entity to encrypt
    116 # options - options for cmsutil
    117 #
    118 # this will generate and return a new application/pkcs7-smime entity containing
    119 # the enveloped input entity.
    120 #
    121 sub encryptentity($$)
    122 {
    123     my ($entity, $cmsutiloptions) = @_;
    124     my $out = "";
    125     my $boundary;
    126 
    127     $tmpencfile = "/tmp/encryptentity.$$";
    128 
    129     #
    130     # generate a random boundary string
    131     #
    132     $boundary = "------------ms" . join("", @boundarychars[map{rand @boundarychars }( 1 .. 24 )]);
    133 
    134     #
    135     # tell cmsutil to generate a enveloped CMS message using our data
    136     #
    137     open(CMS, "|$cmsutilpath -E $cmsutiloptions -o $tmpencfile") or die "ERROR: cannot pipe to cmsutil";
    138     print CMS $entity;
    139     unless (close(CMS)) {
    140 	print STDERR "ERROR: encryption failed.\n";
    141 	unlink($tmpsigfile);
    142 	exit 1;
    143     }
    144 
    145     $out  = "Content-Type: application/pkcs7-mime; smime-type=enveloped-data; name=smime.p7m\n";
    146     $out .= "Content-Transfer-Encoding: base64\n";
    147     $out .= "Content-Disposition: attachment; filename=smime.p7m\n";
    148     $out .= "\n";			# end of entity header
    149 
    150     open (ENC, $tmpencfile) or die "ERROR: cannot find newly generated encrypted content";
    151     local($/) = undef;			# slurp whole file
    152     $out .= encode_base64(<ENC>), "\n";	# entity body is base64-encoded CMS message
    153     close(ENC);
    154 
    155     unlink($tmpencfile);
    156 
    157     $out;
    158 }
    159 
    160 #
    161 # signentity($entity, $options) - sign an S/MIME entity
    162 #
    163 # entity  - string containing entire S/MIME entity to sign
    164 # options - options for cmsutil
    165 #
    166 # this will generate and return a new multipart/signed entity consisting
    167 # of the canonicalized original content, plus a signature block.
    168 #
    169 sub signentity($$)
    170 {
    171     my ($entity, $cmsutiloptions) = @_;
    172     my $out = "";
    173     my $boundary;
    174 
    175     $tmpsigfile = "/tmp/signentity.$$";
    176 
    177     #
    178     # generate a random boundary string
    179     #
    180     $boundary = "------------ms" . join("", @boundarychars[map{rand @boundarychars }( 1 .. 24 )]);
    181 
    182     #
    183     # tell cmsutil to generate a signed CMS message using the canonicalized data
    184     # The signedData has detached content (-T) and includes a signing time attribute (-G)
    185     #
    186     # if we do not provide a password on the command line, here's where we would be asked for it
    187     #
    188     open(CMS, "|$cmsutilpath -S -T -G $cmsutiloptions -o $tmpsigfile") or die "ERROR: cannot pipe to cmsutil";
    189     print CMS $entity;
    190     unless (close(CMS)) {
    191 	print STDERR "ERROR: signature generation failed.\n";
    192 	unlink($tmpsigfile);
    193 	exit 1;
    194     }
    195 
    196     open (SIG, $tmpsigfile) or die "ERROR: cannot find newly generated signature";
    197 
    198     #
    199     # construct a new multipart/signed MIME entity consisting of the original content and
    200     # the signature
    201     #
    202     # (we assume that cmsutil generates a SHA256 digest)
    203     $out .= "Content-Type: multipart/signed; protocol=\"application/pkcs7-signature\"; micalg=sha256; boundary=\"${boundary}\"\n";
    204     $out .= "\n";		# end of entity header
    205     $out .= "This is a cryptographically signed message in MIME format.\n"; # explanatory comment
    206     $out .= "\n--${boundary}\n";
    207     $out .= $entity;
    208     $out .= "\n--${boundary}\n";
    209     $out .= "Content-Type: application/pkcs7-signature; name=smime.p7s\n";
    210     $out .= "Content-Transfer-Encoding: base64\n";
    211     $out .= "Content-Disposition: attachment; filename=smime.p7s\n";
    212     $out .= "Content-Description: S/MIME Cryptographic Signature\n";
    213     $out .= "\n";		# end of signature subentity header
    214 
    215     local($/) = undef;		# slurp whole file
    216     $out .= encode_base64(<SIG>);	# append base64-encoded signature
    217     $out .= "\n--${boundary}--\n";
    218 
    219     close(SIG);
    220     unlink($tmpsigfile);
    221 
    222     $out;
    223 }
    224 
    225 sub usage {
    226     print STDERR "usage: smime [options]\n";
    227     print STDERR " options:\n";
    228     print STDERR " -S nick             generate signed message, use certificate named \"nick\"\n";
    229     print STDERR "  -p passwd          use \"passwd\" as security module password\n";
    230     print STDERR " -E rec1[,rec2...]   generate encrypted message for recipients\n";
    231     print STDERR " -D                  decode a S/MIME message\n";
    232     print STDERR "  -p passwd          use \"passwd\" as security module password\n";
    233     print STDERR "                     (required for decrypting only)\n";
    234     print STDERR " -C pathname         set pathname of \"cmsutil\"\n";
    235     print STDERR " -d directory        set directory containing certificate db\n";
    236     print STDERR "                     (default: ~/.netscape)\n";
    237     print STDERR "\nWith -S or -E, smime will take a regular RFC822 message or MIME entity\n";
    238     print STDERR "on stdin and generate a signed or encrypted S/MIME message with the same\n";
    239     print STDERR "headers and content from it. The output can be used as input to a MTA.\n";
    240     print STDERR "-D causes smime to strip off all S/MIME layers if possible and output\n";
    241     print STDERR "the \"inner\" message.\n";
    242 }
    243 
    244 #
    245 # start of main procedures
    246 #
    247 
    248 #
    249 # process command line options
    250 #
    251 unless (getopts('S:E:p:d:C:D')) {
    252     usage();
    253     exit 1;
    254 }
    255 
    256 unless (defined($opt_S) or defined($opt_E) or defined($opt_D)) {
    257     print STDERR "ERROR: -S and/or -E, or -D must be specified.\n";
    258     usage();
    259     exit 1;
    260 }
    261 
    262 $signopts = "";
    263 $encryptopts = "";
    264 $decodeopts = "";
    265 
    266 # pass -d option along
    267 if (defined($opt_d)) {
    268     $signopts .= "-d \"$opt_d\" ";
    269     $encryptopts .= "-d \"$opt_d\" ";
    270     $decodeopts .= "-d \"$opt_d\" ";
    271 }
    272 
    273 if (defined($opt_S)) {
    274     $signopts .= "-N \"$opt_S\" ";
    275 }
    276 
    277 if (defined($opt_p)) {
    278     $signopts .= "-p \"$opt_p\" ";
    279     $decodeopts .= "-p \"$opt_p\" ";
    280 }
    281 
    282 if (defined($opt_E)) {
    283     @recipients = split(",", $opt_E);
    284     $encryptopts .= "-r ";
    285     $encryptopts .= join (" -r ", @recipients);
    286 }
    287 
    288 if (defined($opt_C)) {
    289     $cmsutilpath = $opt_C;
    290 }
    291 
    292 #
    293 # split headers into mime entity headers and RFC822 headers
    294 # The RFC822 headers are preserved and stay on the outer layer of the message
    295 #
    296 $rfc822headers = "";
    297 $mimeheaders = "";
    298 $mimebody = "";
    299 $skippedheaders = "";
    300 while (<STDIN>) {
    301     last if (/^$/);
    302     if (/^content-\S+: /i) {
    303 	$lastref = \$mimeheaders;
    304     } elsif (/^mime-version: /i) {
    305 	$lastref = \$skippedheaders;			# skip it
    306     } elsif (/^\s/) {
    307 	;
    308     } else {
    309 	$lastref = \$rfc822headers;
    310     }
    311     $$lastref .= $_;
    312 }
    313 
    314 #
    315 # if there are no MIME entity headers, generate some default ones
    316 #
    317 if ($mimeheaders eq "") {
    318     $mimeheaders .= "Content-Type: text/plain; charset=us-ascii\n";
    319     $mimeheaders .= "Content-Transfer-Encoding: 7bit\n";
    320 }
    321 
    322 #
    323 # slurp in the entity body
    324 #
    325 $saveRS = $/;
    326 $/ = undef;
    327 $mimebody = <STDIN>;
    328 $/ = $saveRS;
    329 chomp($mimebody);
    330 
    331 if (defined $opt_D) {
    332     #
    333     # decode
    334     #
    335     # possible options would be:
    336     # - strip off only one layer
    337     # - strip off outer signature (if present)
    338     # - just print information about the structure of the message
    339     # - strip n layers, then dump DER of CMS message
    340 
    341     $layercounter = 1;
    342 
    343     while (1) {
    344 	%hdrhash = parseheaders($mimeheaders);
    345 	unless (exists($hdrhash{"content-type"}{MAIN})) {
    346 	    print STDERR "ERROR: no content type header found in MIME entity\n";
    347 	    last;	# no content-type - we're done
    348 	}
    349 
    350 	$contenttype = $hdrhash{"content-type"}{MAIN};
    351 	if ($contenttype eq "application/pkcs7-mime") {
    352 	    #
    353 	    # opaque-signed or enveloped message
    354 	    #
    355 	    unless (exists($hdrhash{"content-type"}{"smime-type"})) {
    356 		print STDERR "ERROR: no smime-type attribute in application/pkcs7-smime entity.\n";
    357 		last;
    358 	    }
    359 	    $smimetype = $hdrhash{"content-type"}{"smime-type"};
    360 	    if ($smimetype eq "signed-data" or $smimetype eq "enveloped-data") {
    361 		# it's verification or decryption time!
    362 
    363 		# can handle only base64 encoding for now
    364 		# all other encodings are treated as binary (8bit)
    365 		if ($hdrhash{"content-transfer-encoding"}{MAIN} eq "base64") {
    366 		    $mimebody = decode_base64($mimebody);
    367 		}
    368 
    369 		# if we need to dump the DER, we would do it right here
    370 
    371 		# now write the DER
    372 		$tmpderfile = "/tmp/der.$$";
    373 		open(TMP, ">$tmpderfile") or die "ERROR: cannot write signature data to temporary file";
    374 		print TMP $mimebody;
    375 		unless (close(TMP)) {
    376 		    print STDERR "ERROR: writing signature data to temporary file.\n";
    377 		    unlink($tmpderfile);
    378 		    exit 1;
    379 		}
    380 
    381 		$mimeheaders = "";
    382 		open(TMP, "$cmsutilpath -D $decodeopts -h $layercounter -i $tmpderfile |") or die "ERROR: cannot open pipe to cmsutil";
    383 		$layercounter++;
    384 		while (<TMP>) {
    385 		    last if (/^\r?$/);			# empty lines mark end of header
    386 		    if (/^SMIME: /) {			# add all SMIME info to the rfc822 hdrs
    387 			$lastref = \$rfc822headers;
    388 		    } elsif (/^\s/) {
    389 			;				# continuation lines go to the last dest
    390 		    } else {
    391 			$lastref = \$mimeheaders;	# all other headers are mime headers
    392 		    }
    393 		    $$lastref .= $_;
    394 		}
    395 		# slurp in rest of the data to $mimebody
    396 		$saveRS = $/; $/ = undef; $mimebody = <TMP>; $/ = $saveRS;
    397 		close(TMP);
    398 
    399 		unlink($tmpderfile);
    400 
    401 	    } else {
    402 		print STDERR "ERROR: unknown smime-type \"$smimetype\" in application/pkcs7-smime entity.\n";
    403 		last;
    404 	    }
    405 	} elsif ($contenttype eq "multipart/signed") {
    406 	    #
    407 	    # clear signed message
    408 	    #
    409 	    unless (exists($hdrhash{"content-type"}{"protocol"})) {
    410 		print STDERR "ERROR: content type has no protocol attribute in multipart/signed entity.\n";
    411 		last;
    412 	    }
    413 	    if ($hdrhash{"content-type"}{"protocol"} ne "application/pkcs7-signature") {
    414 		# we cannot handle this guy
    415 		print STDERR "ERROR: unknown protocol \"", $hdrhash{"content-type"}{"protocol"},
    416 			"\" in multipart/signed entity.\n";
    417 		last;
    418 	    }
    419 	    unless (exists($hdrhash{"content-type"}{"boundary"})) {
    420 		print STDERR "ERROR: no boundary attribute in multipart/signed entity.\n";
    421 		last;
    422 	    }
    423 	    $boundary = $hdrhash{"content-type"}{"boundary"};
    424 
    425 	    # split $mimebody along \n--$boundary\n - gets you four parts
    426 	    # first (0), any comments the sending agent might have put in
    427 	    # second (1), the message itself
    428 	    # third (2), the signature as a mime entity
    429 	    # fourth (3), trailing data (there shouldn't be any)
    430 
    431 	    @multiparts = split(/\r?\n--$boundary(?:--)?\r?\n/, $mimebody);
    432 
    433 	    #
    434 	    # parse the signature headers
    435 	    ($submimeheaders, $submimebody) = split(/^$/m, $multiparts[2]);
    436 	    %sighdrhash = parseheaders($submimeheaders);
    437 	    unless (exists($sighdrhash{"content-type"}{MAIN})) {
    438 		print STDERR "ERROR: signature entity has no content type.\n";
    439 		last;
    440 	    }
    441 	    if ($sighdrhash{"content-type"}{MAIN} ne "application/pkcs7-signature") {
    442 		# we cannot handle this guy
    443 		print STDERR "ERROR: unknown content type \"", $sighdrhash{"content-type"}{MAIN},
    444 			"\" in signature entity.\n";
    445 		last;
    446 	    }
    447 	    if ($sighdrhash{"content-transfer-encoding"}{MAIN} eq "base64") {
    448 		$submimebody = decode_base64($submimebody);
    449 	    }
    450 
    451 	    # we would dump the DER at this point
    452 
    453 	    $tmpsigfile = "/tmp/sig.$$";
    454 	    open(TMP, ">$tmpsigfile") or die "ERROR: cannot write signature data to temporary file";
    455 	    print TMP $submimebody;
    456 	    unless (close(TMP)) {
    457 		print STDERR "ERROR: writing signature data to temporary file.\n";
    458 		unlink($tmpsigfile);
    459 		exit 1;
    460 	    }
    461 
    462 	    $tmpmsgfile = "/tmp/msg.$$";
    463 	    open(TMP, ">$tmpmsgfile") or die "ERROR: cannot write message data to temporary file";
    464 	    print TMP $multiparts[1];
    465 	    unless (close(TMP)) {
    466 		print STDERR "ERROR: writing message data to temporary file.\n";
    467 		unlink($tmpsigfile);
    468 		unlink($tmpmsgfile);
    469 		exit 1;
    470 	    }
    471 
    472 	    $mimeheaders = "";
    473 	    open(TMP, "$cmsutilpath -D $decodeopts -h $layercounter -c $tmpmsgfile -i $tmpsigfile |") or die "ERROR: cannot open pipe to cmsutil";
    474 	    $layercounter++;
    475 	    while (<TMP>) {
    476 		last if (/^\r?$/);
    477 		if (/^SMIME: /) {
    478 		    $lastref = \$rfc822headers;
    479 		} elsif (/^\s/) {
    480 		    ;
    481 		} else {
    482 		    $lastref = \$mimeheaders;
    483 		}
    484 		$$lastref .= $_;
    485 	    }
    486 	    $saveRS = $/; $/ = undef; $mimebody = <TMP>; $/ = $saveRS;
    487 	    close(TMP);
    488 	    unlink($tmpsigfile);
    489 	    unlink($tmpmsgfile);
    490 
    491 	} else {
    492 
    493 	    # not a content type we know - we're done
    494 	    last;
    495 
    496 	}
    497     }
    498 
    499     # so now we have the S/MIME parsing information in rfc822headers
    500     # and the first mime entity we could not handle in mimeheaders and mimebody.
    501     # dump 'em out and we're done.
    502     print $rfc822headers;
    503     print $mimeheaders . "\n" . $mimebody;
    504 
    505 } else {
    506 
    507     #
    508     # encode (which is much easier than decode)
    509     #
    510 
    511     $mimeentity = $mimeheaders . "\n" . $mimebody;
    512 
    513     #
    514     # canonicalize inner entity (rudimentary yet)
    515     # convert single LFs to CRLF
    516     # if no Content-Transfer-Encoding header present:
    517     #  if 8 bit chars present, use Content-Transfer-Encoding: quoted-printable
    518     #  otherwise, use Content-Transfer-Encoding: 7bit
    519     #
    520     $mimeentity =~ s/\r*\n/\r\n/mg;
    521 
    522     #
    523     # now do the wrapping
    524     # we sign first, then encrypt because that's what Communicator needs
    525     #
    526     if (defined($opt_S)) {
    527 	$mimeentity = signentity($mimeentity, $signopts);
    528     }
    529 
    530     if (defined($opt_E)) {
    531 	$mimeentity = encryptentity($mimeentity, $encryptopts);	
    532     }
    533 
    534     #
    535     # XXX sign again to do triple wrapping (RFC2634)
    536     #
    537 
    538     #
    539     # now write out the RFC822 headers
    540     # followed by the final $mimeentity
    541     #
    542     print $rfc822headers;
    543     print "MIME-Version: 1.0 (NSS SMIME - http://www.mozilla.org/projects/security)\n";	# set up the flag
    544     print $mimeentity;
    545 }
    546 
    547 exit 0;