The Tor Browser / file revision

 #!/usr/local/bin/perl

 # This Source Code Form is subject to the terms of the Mozilla Public

 # License, v. 2.0. If a copy of the MPL was not distributed with this

 # file, You can obtain one at http://mozilla.org/MPL/2.0/.

 #

 # smime.pl - frontend for S/MIME message generation and parsing

 #

 use Getopt::Std;

 @boundarychars = ( "0" .. "9", "A" .. "F" );

 # path to cmsutil

 $cmsutilpath = "cmsutil";

 #

 # Thanks to Gisle Aas <gisle@aas.no> for the base64 functions

 # originally taken from MIME-Base64-2.11 at www.cpan.org

 #

 sub encode_base64($)

 {

     my $res = "";

     pos($_[0]) = 0;                          # ensure start at the beginning

     while ($_[0] =~ /(.{1,45})/gs) {

 	$res .= substr(pack('u', $1), 1);    # get rid of length byte after packing

 	chop($res);

     }

     $res =~ tr|` -_|AA-Za-z0-9+/|;

     # fix padding at the end

     my $padding = (3 - length($_[0]) % 3) % 3;

     $res =~ s/.{$padding}$/'=' x $padding/e if $padding;

     # break encoded string into lines of no more than 76 characters each

     $res =~ s/(.{1,76})/$1\n/g;

     $res;

 }

 sub decode_base64($)

 {

     local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]

     my $str = shift;

     my $res = "";

     $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars

     if (length($str) % 4) {

 	require Carp;

 	Carp::carp("Length of base64 data not a multiple of 4")

     }

     $str =~ s/=+$//;                        # remove padding

     $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format

     while ($str =~ /(.{1,60})/gs) {

 	my $len = chr(32 + length($1)*3/4); # compute length byte

 	$res .= unpack("u", $len . $1 );    # uudecode

     }

     $res;

 }

 #

 # parse headers into a hash

 #

 # %headers = parseheaders($headertext);

 #

 sub parseheaders($)

 {

     my ($headerdata) = @_;

     my $hdr;

     my %hdrhash;

     my $hdrname;

     my $hdrvalue;

     my @hdrvalues;

     my $subhdrname;

     my $subhdrvalue;

     # the expression in split() correctly handles continuation lines

     foreach $hdr (split(/\n(?=\S)/, $headerdata)) {

 	$hdr =~ s/\r*\n\s+/ /g;	# collapse continuation lines

 	($hdrname, $hdrvalue) = $hdr =~ m/^(\S+):\s+(.*)$/;

 	# ignore non-headers (or should we die horribly?)

 	next unless (defined($hdrname));

 	$hdrname =~ tr/A-Z/a-z/;			# lowercase the header name

 	@hdrvalues = split(/\s*;\s*/, $hdrvalue);	# split header values (XXXX quoting)

 	# there is guaranteed to be at least one value

 	$hdrvalue = shift @hdrvalues;

 	if ($hdrvalue =~ /^\s*\"(.*)\"\s*$/) {		# strip quotes if there

 	    $hdrvalue = $1;

 	}

 	$hdrhash{$hdrname}{MAIN} = $hdrvalue;

 	# print "XXX $hdrname = $hdrvalue\n";

 	# deal with additional name-value pairs

 	foreach $hdrvalue (@hdrvalues) {

 	    ($subhdrname, $subhdrvalue) = $hdrvalue =~ m/^(\S+)\s*=\s*(.*)$/;

 	    # ignore non-name-value pairs (or should we die?)

 	    next unless (defined($subhdrname));

 	    $subhdrname =~ tr/A-Z/a-z/;

 	    if ($subhdrvalue =~ /^\s*\"(.*)\"\s*$/) {	# strip quotes if there

 		$subhdrvalue = $1;

 	    }

 	    $hdrhash{$hdrname}{$subhdrname} = $subhdrvalue;

 	}

     }

     return %hdrhash;

 }

 #

 # encryptentity($entity, $options) - encrypt an S/MIME entity,

 #                                    creating a new application/pkcs7-smime entity

 #

 # entity  - string containing entire S/MIME entity to encrypt

 # options - options for cmsutil

 #

 # this will generate and return a new application/pkcs7-smime entity containing

 # the enveloped input entity.

 #

 sub encryptentity($$)

 {

     my ($entity, $cmsutiloptions) = @_;

     my $out = "";

     my $boundary;

     $tmpencfile = "/tmp/encryptentity.$$";

     #

     # generate a random boundary string

     #

     $boundary = "------------ms" . join("", @boundarychars[map{rand @boundarychars }( 1 .. 24 )]);

     #

     # tell cmsutil to generate a enveloped CMS message using our data

     #

     open(CMS, "|$cmsutilpath -E $cmsutiloptions -o $tmpencfile") or die "ERROR: cannot pipe to cmsutil";

     print CMS $entity;

     unless (close(CMS)) {

 	print STDERR "ERROR: encryption failed.\n";

 	unlink($tmpsigfile);

 	exit 1;

     }

     $out  = "Content-Type: application/pkcs7-mime; smime-type=enveloped-data; name=smime.p7m\n";

     $out .= "Content-Transfer-Encoding: base64\n";

     $out .= "Content-Disposition: attachment; filename=smime.p7m\n";

     $out .= "\n";			# end of entity header

     open (ENC, $tmpencfile) or die "ERROR: cannot find newly generated encrypted content";

     local($/) = undef;			# slurp whole file

     $out .= encode_base64(<ENC>), "\n";	# entity body is base64-encoded CMS message

     close(ENC);

     unlink($tmpencfile);

     $out;

 }

 #

 # signentity($entity, $options) - sign an S/MIME entity

 #

 # entity  - string containing entire S/MIME entity to sign

 # options - options for cmsutil

 #

 # this will generate and return a new multipart/signed entity consisting

 # of the canonicalized original content, plus a signature block.

 #

 sub signentity($$)

 {

     my ($entity, $cmsutiloptions) = @_;

     my $out = "";

     my $boundary;

     $tmpsigfile = "/tmp/signentity.$$";

     #

     # generate a random boundary string

     #

     $boundary = "------------ms" . join("", @boundarychars[map{rand @boundarychars }( 1 .. 24 )]);

     #

     # tell cmsutil to generate a signed CMS message using the canonicalized data

     # The signedData has detached content (-T) and includes a signing time attribute (-G)

     #

     # if we do not provide a password on the command line, here's where we would be asked for it

     #

     open(CMS, "|$cmsutilpath -S -T -G $cmsutiloptions -o $tmpsigfile") or die "ERROR: cannot pipe to cmsutil";

     print CMS $entity;

     unless (close(CMS)) {

 	print STDERR "ERROR: signature generation failed.\n";

 	unlink($tmpsigfile);

 	exit 1;

     }

     open (SIG, $tmpsigfile) or die "ERROR: cannot find newly generated signature";

     #

     # construct a new multipart/signed MIME entity consisting of the original content and

     # the signature

     #

     # (we assume that cmsutil generates a SHA1 digest)

     $out .= "Content-Type: multipart/signed; protocol=\"application/pkcs7-signature\"; micalg=sha1; boundary=\"${boundary}\"\n";

     $out .= "\n";		# end of entity header

     $out .= "This is a cryptographically signed message in MIME format.\n"; # explanatory comment

     $out .= "\n--${boundary}\n";

     $out .= $entity;

     $out .= "\n--${boundary}\n";

     $out .= "Content-Type: application/pkcs7-signature; name=smime.p7s\n";

     $out .= "Content-Transfer-Encoding: base64\n";

     $out .= "Content-Disposition: attachment; filename=smime.p7s\n";

     $out .= "Content-Description: S/MIME Cryptographic Signature\n";

     $out .= "\n";		# end of signature subentity header

     local($/) = undef;		# slurp whole file

     $out .= encode_base64(<SIG>);	# append base64-encoded signature

     $out .= "\n--${boundary}--\n";

     close(SIG);

     unlink($tmpsigfile);

     $out;

 }

 sub usage {

     print STDERR "usage: smime [options]\n";

     print STDERR " options:\n";

     print STDERR " -S nick             generate signed message, use certificate named \"nick\"\n";

     print STDERR "  -p passwd          use \"passwd\" as security module password\n";

     print STDERR " -E rec1[,rec2...]   generate encrypted message for recipients\n";

     print STDERR " -D                  decode a S/MIME message\n";

     print STDERR "  -p passwd          use \"passwd\" as security module password\n";

     print STDERR "                     (required for decrypting only)\n";

     print STDERR " -C pathname         set pathname of \"cmsutil\"\n";

     print STDERR " -d directory        set directory containing certificate db\n";

     print STDERR "                     (default: ~/.netscape)\n";

     print STDERR "\nWith -S or -E, smime will take a regular RFC822 message or MIME entity\n";

     print STDERR "on stdin and generate a signed or encrypted S/MIME message with the same\n";

     print STDERR "headers and content from it. The output can be used as input to a MTA.\n";

     print STDERR "-D causes smime to strip off all S/MIME layers if possible and output\n";

     print STDERR "the \"inner\" message.\n";

 }

 #

 # start of main procedures

 #

 #

 # process command line options

 #

 unless (getopts('S:E:p:d:C:D')) {

     usage();

     exit 1;

 }

 unless (defined($opt_S) or defined($opt_E) or defined($opt_D)) {

     print STDERR "ERROR: -S and/or -E, or -D must be specified.\n";

     usage();

     exit 1;

 }

 $signopts = "";

 $encryptopts = "";

 $decodeopts = "";

 # pass -d option along

 if (defined($opt_d)) {

     $signopts .= "-d \"$opt_d\" ";

     $encryptopts .= "-d \"$opt_d\" ";

     $decodeopts .= "-d \"$opt_d\" ";

 }

 if (defined($opt_S)) {

     $signopts .= "-N \"$opt_S\" ";

 }

 if (defined($opt_p)) {

     $signopts .= "-p \"$opt_p\" ";

     $decodeopts .= "-p \"$opt_p\" ";

 }

 if (defined($opt_E)) {

     @recipients = split(",", $opt_E);

     $encryptopts .= "-r ";

     $encryptopts .= join (" -r ", @recipients);

 }

 if (defined($opt_C)) {

     $cmsutilpath = $opt_C;

 }

 #

 # split headers into mime entity headers and RFC822 headers

 # The RFC822 headers are preserved and stay on the outer layer of the message

 #

 $rfc822headers = "";

 $mimeheaders = "";

 $mimebody = "";

 $skippedheaders = "";

 while (<STDIN>) {

     last if (/^$/);

     if (/^content-\S+: /i) {

 	$lastref = \$mimeheaders;

     } elsif (/^mime-version: /i) {

 	$lastref = \$skippedheaders;			# skip it

     } elsif (/^\s/) {

 	;

     } else {

 	$lastref = \$rfc822headers;

     }

     $$lastref .= $_;

 }

 #

 # if there are no MIME entity headers, generate some default ones

 #

 if ($mimeheaders eq "") {

     $mimeheaders .= "Content-Type: text/plain; charset=us-ascii\n";

     $mimeheaders .= "Content-Transfer-Encoding: 7bit\n";

 }

 #

 # slurp in the entity body

 #

 $saveRS = $/;

 $/ = undef;

 $mimebody = <STDIN>;

 $/ = $saveRS;

 chomp($mimebody);

 if (defined $opt_D) {

     #

     # decode

     #

     # possible options would be:

     # - strip off only one layer

     # - strip off outer signature (if present)

     # - just print information about the structure of the message

     # - strip n layers, then dump DER of CMS message

     $layercounter = 1;

     while (1) {

 	%hdrhash = parseheaders($mimeheaders);

 	unless (exists($hdrhash{"content-type"}{MAIN})) {

 	    print STDERR "ERROR: no content type header found in MIME entity\n";

 	    last;	# no content-type - we're done

 	}

 	$contenttype = $hdrhash{"content-type"}{MAIN};

 	if ($contenttype eq "application/pkcs7-mime") {

 	    #

 	    # opaque-signed or enveloped message

 	    #

 	    unless (exists($hdrhash{"content-type"}{"smime-type"})) {

 		print STDERR "ERROR: no smime-type attribute in application/pkcs7-smime entity.\n";

 		last;

 	    }

 	    $smimetype = $hdrhash{"content-type"}{"smime-type"};

 	    if ($smimetype eq "signed-data" or $smimetype eq "enveloped-data") {

 		# it's verification or decryption time!

 		# can handle only base64 encoding for now

 		# all other encodings are treated as binary (8bit)

 		if ($hdrhash{"content-transfer-encoding"}{MAIN} eq "base64") {

 		    $mimebody = decode_base64($mimebody);

 		}

 		# if we need to dump the DER, we would do it right here

 		# now write the DER

 		$tmpderfile = "/tmp/der.$$";

 		open(TMP, ">$tmpderfile") or die "ERROR: cannot write signature data to temporary file";

 		print TMP $mimebody;

 		unless (close(TMP)) {

 		    print STDERR "ERROR: writing signature data to temporary file.\n";

 		    unlink($tmpderfile);

 		    exit 1;

 		}

 		$mimeheaders = "";

 		open(TMP, "$cmsutilpath -D $decodeopts -h $layercounter -i $tmpderfile |") or die "ERROR: cannot open pipe to cmsutil";

 		$layercounter++;

 		while (<TMP>) {

 		    last if (/^\r?$/);			# empty lines mark end of header

 		    if (/^SMIME: /) {			# add all SMIME info to the rfc822 hdrs

 			$lastref = \$rfc822headers;

 		    } elsif (/^\s/) {

 			;				# continuation lines go to the last dest

 		    } else {

 			$lastref = \$mimeheaders;	# all other headers are mime headers

 		    }

 		    $$lastref .= $_;

 		}

 		# slurp in rest of the data to $mimebody

 		$saveRS = $/; $/ = undef; $mimebody = <TMP>; $/ = $saveRS;

 		close(TMP);

 		unlink($tmpderfile);

 	    } else {

 		print STDERR "ERROR: unknown smime-type \"$smimetype\" in application/pkcs7-smime entity.\n";

 		last;

 	    }

 	} elsif ($contenttype eq "multipart/signed") {

 	    #

 	    # clear signed message

 	    #

 	    unless (exists($hdrhash{"content-type"}{"protocol"})) {

 		print STDERR "ERROR: content type has no protocol attribute in multipart/signed entity.\n";

 		last;

 	    }

 	    if ($hdrhash{"content-type"}{"protocol"} ne "application/pkcs7-signature") {

 		# we cannot handle this guy

 		print STDERR "ERROR: unknown protocol \"", $hdrhash{"content-type"}{"protocol"},

 			"\" in multipart/signed entity.\n";

 		last;

 	    }

 	    unless (exists($hdrhash{"content-type"}{"boundary"})) {

 		print STDERR "ERROR: no boundary attribute in multipart/signed entity.\n";

 		last;

 	    }

 	    $boundary = $hdrhash{"content-type"}{"boundary"};

 	    # split $mimebody along \n--$boundary\n - gets you four parts

 	    # first (0), any comments the sending agent might have put in

 	    # second (1), the message itself

 	    # third (2), the signature as a mime entity

 	    # fourth (3), trailing data (there shouldn't be any)

 	    @multiparts = split(/\r?\n--$boundary(?:--)?\r?\n/, $mimebody);

 	    #

 	    # parse the signature headers

 	    ($submimeheaders, $submimebody) = split(/^$/m, $multiparts[2]);

 	    %sighdrhash = parseheaders($submimeheaders);

 	    unless (exists($sighdrhash{"content-type"}{MAIN})) {

 		print STDERR "ERROR: signature entity has no content type.\n";

 		last;

 	    }

 	    if ($sighdrhash{"content-type"}{MAIN} ne "application/pkcs7-signature") {

 		# we cannot handle this guy

 		print STDERR "ERROR: unknown content type \"", $sighdrhash{"content-type"}{MAIN},

 			"\" in signature entity.\n";

 		last;

 	    }

 	    if ($sighdrhash{"content-transfer-encoding"}{MAIN} eq "base64") {

 		$submimebody = decode_base64($submimebody);

 	    }

 	    # we would dump the DER at this point

 	    $tmpsigfile = "/tmp/sig.$$";

 	    open(TMP, ">$tmpsigfile") or die "ERROR: cannot write signature data to temporary file";

 	    print TMP $submimebody;

 	    unless (close(TMP)) {

 		print STDERR "ERROR: writing signature data to temporary file.\n";

 		unlink($tmpsigfile);

 		exit 1;

 	    }

 	    $tmpmsgfile = "/tmp/msg.$$";

 	    open(TMP, ">$tmpmsgfile") or die "ERROR: cannot write message data to temporary file";

 	    print TMP $multiparts[1];

 	    unless (close(TMP)) {

 		print STDERR "ERROR: writing message data to temporary file.\n";

 		unlink($tmpsigfile);

 		unlink($tmpmsgfile);

 		exit 1;

 	    }

 	    $mimeheaders = "";

 	    open(TMP, "$cmsutilpath -D $decodeopts -h $layercounter -c $tmpmsgfile -i $tmpsigfile |") or die "ERROR: cannot open pipe to cmsutil";

 	    $layercounter++;

 	    while (<TMP>) {

 		last if (/^\r?$/);

 		if (/^SMIME: /) {

 		    $lastref = \$rfc822headers;

 		} elsif (/^\s/) {

 		    ;

 		} else {

 		    $lastref = \$mimeheaders;

 		}

 		$$lastref .= $_;

 	    }

 	    $saveRS = $/; $/ = undef; $mimebody = <TMP>; $/ = $saveRS;

 	    close(TMP);

 	    unlink($tmpsigfile);

 	    unlink($tmpmsgfile);

 	} else {

 	    # not a content type we know - we're done

 	    last;

 	}

     }

     # so now we have the S/MIME parsing information in rfc822headers

     # and the first mime entity we could not handle in mimeheaders and mimebody.

     # dump 'em out and we're done.

     print $rfc822headers;

     print $mimeheaders . "\n" . $mimebody;

 } else {

     #

     # encode (which is much easier than decode)

     #

     $mimeentity = $mimeheaders . "\n" . $mimebody;

     #

     # canonicalize inner entity (rudimentary yet)

     # convert single LFs to CRLF

     # if no Content-Transfer-Encoding header present:

     #  if 8 bit chars present, use Content-Transfer-Encoding: quoted-printable

     #  otherwise, use Content-Transfer-Encoding: 7bit

     #

     $mimeentity =~ s/\r*\n/\r\n/mg;

     #

     # now do the wrapping

     # we sign first, then encrypt because that's what Communicator needs

     #

     if (defined($opt_S)) {

 	$mimeentity = signentity($mimeentity, $signopts);

     }

     if (defined($opt_E)) {

 	$mimeentity = encryptentity($mimeentity, $encryptopts);	

     }

     #

     # XXX sign again to do triple wrapping (RFC2634)

     #

     #

     # now write out the RFC822 headers

     # followed by the final $mimeentity

     #

     print $rfc822headers;

     print "MIME-Version: 1.0 (NSS SMIME - http://www.mozilla.org/projects/security)\n";	# set up the flag

     print $mimeentity;

 }

 exit 0;