michael@0: #!/usr/local/bin/perl michael@0: michael@0: # This Source Code Form is subject to the terms of the Mozilla Public michael@0: # License, v. 2.0. If a copy of the MPL was not distributed with this michael@0: # file, You can obtain one at http://mozilla.org/MPL/2.0/. michael@0: michael@0: # michael@0: # smime.pl - frontend for S/MIME message generation and parsing michael@0: # michael@0: michael@0: use Getopt::Std; michael@0: michael@0: @boundarychars = ( "0" .. "9", "A" .. "F" ); michael@0: michael@0: # path to cmsutil michael@0: $cmsutilpath = "cmsutil"; michael@0: michael@0: # michael@0: # Thanks to Gisle Aas for the base64 functions michael@0: # originally taken from MIME-Base64-2.11 at www.cpan.org michael@0: # michael@0: sub encode_base64($) michael@0: { michael@0: my $res = ""; michael@0: pos($_[0]) = 0; # ensure start at the beginning michael@0: while ($_[0] =~ /(.{1,45})/gs) { michael@0: $res .= substr(pack('u', $1), 1); # get rid of length byte after packing michael@0: chop($res); michael@0: } michael@0: $res =~ tr|` -_|AA-Za-z0-9+/|; michael@0: # fix padding at the end michael@0: my $padding = (3 - length($_[0]) % 3) % 3; michael@0: $res =~ s/.{$padding}$/'=' x $padding/e if $padding; michael@0: # break encoded string into lines of no more than 76 characters each michael@0: $res =~ s/(.{1,76})/$1\n/g; michael@0: $res; michael@0: } michael@0: michael@0: sub decode_base64($) michael@0: { michael@0: local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123] michael@0: michael@0: my $str = shift; michael@0: my $res = ""; michael@0: michael@0: $str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars michael@0: if (length($str) % 4) { michael@0: require Carp; michael@0: Carp::carp("Length of base64 data not a multiple of 4") michael@0: } michael@0: $str =~ s/=+$//; # remove padding michael@0: $str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format michael@0: while ($str =~ /(.{1,60})/gs) { michael@0: my $len = chr(32 + length($1)*3/4); # compute length byte michael@0: $res .= unpack("u", $len . $1 ); # uudecode michael@0: } michael@0: $res; michael@0: } michael@0: michael@0: # michael@0: # parse headers into a hash michael@0: # michael@0: # %headers = parseheaders($headertext); michael@0: # michael@0: sub parseheaders($) michael@0: { michael@0: my ($headerdata) = @_; michael@0: my $hdr; michael@0: my %hdrhash; michael@0: my $hdrname; michael@0: my $hdrvalue; michael@0: my @hdrvalues; michael@0: my $subhdrname; michael@0: my $subhdrvalue; michael@0: michael@0: # the expression in split() correctly handles continuation lines michael@0: foreach $hdr (split(/\n(?=\S)/, $headerdata)) { michael@0: $hdr =~ s/\r*\n\s+/ /g; # collapse continuation lines michael@0: ($hdrname, $hdrvalue) = $hdr =~ m/^(\S+):\s+(.*)$/; michael@0: michael@0: # ignore non-headers (or should we die horribly?) michael@0: next unless (defined($hdrname)); michael@0: $hdrname =~ tr/A-Z/a-z/; # lowercase the header name michael@0: @hdrvalues = split(/\s*;\s*/, $hdrvalue); # split header values (XXXX quoting) michael@0: michael@0: # there is guaranteed to be at least one value michael@0: $hdrvalue = shift @hdrvalues; michael@0: if ($hdrvalue =~ /^\s*\"(.*)\"\s*$/) { # strip quotes if there michael@0: $hdrvalue = $1; michael@0: } michael@0: michael@0: $hdrhash{$hdrname}{MAIN} = $hdrvalue; michael@0: # print "XXX $hdrname = $hdrvalue\n"; michael@0: michael@0: # deal with additional name-value pairs michael@0: foreach $hdrvalue (@hdrvalues) { michael@0: ($subhdrname, $subhdrvalue) = $hdrvalue =~ m/^(\S+)\s*=\s*(.*)$/; michael@0: # ignore non-name-value pairs (or should we die?) michael@0: next unless (defined($subhdrname)); michael@0: $subhdrname =~ tr/A-Z/a-z/; michael@0: if ($subhdrvalue =~ /^\s*\"(.*)\"\s*$/) { # strip quotes if there michael@0: $subhdrvalue = $1; michael@0: } michael@0: $hdrhash{$hdrname}{$subhdrname} = $subhdrvalue; michael@0: } michael@0: michael@0: } michael@0: return %hdrhash; michael@0: } michael@0: michael@0: # michael@0: # encryptentity($entity, $options) - encrypt an S/MIME entity, michael@0: # creating a new application/pkcs7-smime entity michael@0: # michael@0: # entity - string containing entire S/MIME entity to encrypt michael@0: # options - options for cmsutil michael@0: # michael@0: # this will generate and return a new application/pkcs7-smime entity containing michael@0: # the enveloped input entity. michael@0: # michael@0: sub encryptentity($$) michael@0: { michael@0: my ($entity, $cmsutiloptions) = @_; michael@0: my $out = ""; michael@0: my $boundary; michael@0: michael@0: $tmpencfile = "/tmp/encryptentity.$$"; michael@0: michael@0: # michael@0: # generate a random boundary string michael@0: # michael@0: $boundary = "------------ms" . join("", @boundarychars[map{rand @boundarychars }( 1 .. 24 )]); michael@0: michael@0: # michael@0: # tell cmsutil to generate a enveloped CMS message using our data michael@0: # michael@0: open(CMS, "|$cmsutilpath -E $cmsutiloptions -o $tmpencfile") or die "ERROR: cannot pipe to cmsutil"; michael@0: print CMS $entity; michael@0: unless (close(CMS)) { michael@0: print STDERR "ERROR: encryption failed.\n"; michael@0: unlink($tmpsigfile); michael@0: exit 1; michael@0: } michael@0: michael@0: $out = "Content-Type: application/pkcs7-mime; smime-type=enveloped-data; name=smime.p7m\n"; michael@0: $out .= "Content-Transfer-Encoding: base64\n"; michael@0: $out .= "Content-Disposition: attachment; filename=smime.p7m\n"; michael@0: $out .= "\n"; # end of entity header michael@0: michael@0: open (ENC, $tmpencfile) or die "ERROR: cannot find newly generated encrypted content"; michael@0: local($/) = undef; # slurp whole file michael@0: $out .= encode_base64(), "\n"; # entity body is base64-encoded CMS message michael@0: close(ENC); michael@0: michael@0: unlink($tmpencfile); michael@0: michael@0: $out; michael@0: } michael@0: michael@0: # michael@0: # signentity($entity, $options) - sign an S/MIME entity michael@0: # michael@0: # entity - string containing entire S/MIME entity to sign michael@0: # options - options for cmsutil michael@0: # michael@0: # this will generate and return a new multipart/signed entity consisting michael@0: # of the canonicalized original content, plus a signature block. michael@0: # michael@0: sub signentity($$) michael@0: { michael@0: my ($entity, $cmsutiloptions) = @_; michael@0: my $out = ""; michael@0: my $boundary; michael@0: michael@0: $tmpsigfile = "/tmp/signentity.$$"; michael@0: michael@0: # michael@0: # generate a random boundary string michael@0: # michael@0: $boundary = "------------ms" . join("", @boundarychars[map{rand @boundarychars }( 1 .. 24 )]); michael@0: michael@0: # michael@0: # tell cmsutil to generate a signed CMS message using the canonicalized data michael@0: # The signedData has detached content (-T) and includes a signing time attribute (-G) michael@0: # michael@0: # if we do not provide a password on the command line, here's where we would be asked for it michael@0: # michael@0: open(CMS, "|$cmsutilpath -S -T -G $cmsutiloptions -o $tmpsigfile") or die "ERROR: cannot pipe to cmsutil"; michael@0: print CMS $entity; michael@0: unless (close(CMS)) { michael@0: print STDERR "ERROR: signature generation failed.\n"; michael@0: unlink($tmpsigfile); michael@0: exit 1; michael@0: } michael@0: michael@0: open (SIG, $tmpsigfile) or die "ERROR: cannot find newly generated signature"; michael@0: michael@0: # michael@0: # construct a new multipart/signed MIME entity consisting of the original content and michael@0: # the signature michael@0: # michael@0: # (we assume that cmsutil generates a SHA1 digest) michael@0: $out .= "Content-Type: multipart/signed; protocol=\"application/pkcs7-signature\"; micalg=sha1; boundary=\"${boundary}\"\n"; michael@0: $out .= "\n"; # end of entity header michael@0: $out .= "This is a cryptographically signed message in MIME format.\n"; # explanatory comment michael@0: $out .= "\n--${boundary}\n"; michael@0: $out .= $entity; michael@0: $out .= "\n--${boundary}\n"; michael@0: $out .= "Content-Type: application/pkcs7-signature; name=smime.p7s\n"; michael@0: $out .= "Content-Transfer-Encoding: base64\n"; michael@0: $out .= "Content-Disposition: attachment; filename=smime.p7s\n"; michael@0: $out .= "Content-Description: S/MIME Cryptographic Signature\n"; michael@0: $out .= "\n"; # end of signature subentity header michael@0: michael@0: local($/) = undef; # slurp whole file michael@0: $out .= encode_base64(); # append base64-encoded signature michael@0: $out .= "\n--${boundary}--\n"; michael@0: michael@0: close(SIG); michael@0: unlink($tmpsigfile); michael@0: michael@0: $out; michael@0: } michael@0: michael@0: sub usage { michael@0: print STDERR "usage: smime [options]\n"; michael@0: print STDERR " options:\n"; michael@0: print STDERR " -S nick generate signed message, use certificate named \"nick\"\n"; michael@0: print STDERR " -p passwd use \"passwd\" as security module password\n"; michael@0: print STDERR " -E rec1[,rec2...] generate encrypted message for recipients\n"; michael@0: print STDERR " -D decode a S/MIME message\n"; michael@0: print STDERR " -p passwd use \"passwd\" as security module password\n"; michael@0: print STDERR " (required for decrypting only)\n"; michael@0: print STDERR " -C pathname set pathname of \"cmsutil\"\n"; michael@0: print STDERR " -d directory set directory containing certificate db\n"; michael@0: print STDERR " (default: ~/.netscape)\n"; michael@0: print STDERR "\nWith -S or -E, smime will take a regular RFC822 message or MIME entity\n"; michael@0: print STDERR "on stdin and generate a signed or encrypted S/MIME message with the same\n"; michael@0: print STDERR "headers and content from it. The output can be used as input to a MTA.\n"; michael@0: print STDERR "-D causes smime to strip off all S/MIME layers if possible and output\n"; michael@0: print STDERR "the \"inner\" message.\n"; michael@0: } michael@0: michael@0: # michael@0: # start of main procedures michael@0: # michael@0: michael@0: # michael@0: # process command line options michael@0: # michael@0: unless (getopts('S:E:p:d:C:D')) { michael@0: usage(); michael@0: exit 1; michael@0: } michael@0: michael@0: unless (defined($opt_S) or defined($opt_E) or defined($opt_D)) { michael@0: print STDERR "ERROR: -S and/or -E, or -D must be specified.\n"; michael@0: usage(); michael@0: exit 1; michael@0: } michael@0: michael@0: $signopts = ""; michael@0: $encryptopts = ""; michael@0: $decodeopts = ""; michael@0: michael@0: # pass -d option along michael@0: if (defined($opt_d)) { michael@0: $signopts .= "-d \"$opt_d\" "; michael@0: $encryptopts .= "-d \"$opt_d\" "; michael@0: $decodeopts .= "-d \"$opt_d\" "; michael@0: } michael@0: michael@0: if (defined($opt_S)) { michael@0: $signopts .= "-N \"$opt_S\" "; michael@0: } michael@0: michael@0: if (defined($opt_p)) { michael@0: $signopts .= "-p \"$opt_p\" "; michael@0: $decodeopts .= "-p \"$opt_p\" "; michael@0: } michael@0: michael@0: if (defined($opt_E)) { michael@0: @recipients = split(",", $opt_E); michael@0: $encryptopts .= "-r "; michael@0: $encryptopts .= join (" -r ", @recipients); michael@0: } michael@0: michael@0: if (defined($opt_C)) { michael@0: $cmsutilpath = $opt_C; michael@0: } michael@0: michael@0: # michael@0: # split headers into mime entity headers and RFC822 headers michael@0: # The RFC822 headers are preserved and stay on the outer layer of the message michael@0: # michael@0: $rfc822headers = ""; michael@0: $mimeheaders = ""; michael@0: $mimebody = ""; michael@0: $skippedheaders = ""; michael@0: while () { michael@0: last if (/^$/); michael@0: if (/^content-\S+: /i) { michael@0: $lastref = \$mimeheaders; michael@0: } elsif (/^mime-version: /i) { michael@0: $lastref = \$skippedheaders; # skip it michael@0: } elsif (/^\s/) { michael@0: ; michael@0: } else { michael@0: $lastref = \$rfc822headers; michael@0: } michael@0: $$lastref .= $_; michael@0: } michael@0: michael@0: # michael@0: # if there are no MIME entity headers, generate some default ones michael@0: # michael@0: if ($mimeheaders eq "") { michael@0: $mimeheaders .= "Content-Type: text/plain; charset=us-ascii\n"; michael@0: $mimeheaders .= "Content-Transfer-Encoding: 7bit\n"; michael@0: } michael@0: michael@0: # michael@0: # slurp in the entity body michael@0: # michael@0: $saveRS = $/; michael@0: $/ = undef; michael@0: $mimebody = ; michael@0: $/ = $saveRS; michael@0: chomp($mimebody); michael@0: michael@0: if (defined $opt_D) { michael@0: # michael@0: # decode michael@0: # michael@0: # possible options would be: michael@0: # - strip off only one layer michael@0: # - strip off outer signature (if present) michael@0: # - just print information about the structure of the message michael@0: # - strip n layers, then dump DER of CMS message michael@0: michael@0: $layercounter = 1; michael@0: michael@0: while (1) { michael@0: %hdrhash = parseheaders($mimeheaders); michael@0: unless (exists($hdrhash{"content-type"}{MAIN})) { michael@0: print STDERR "ERROR: no content type header found in MIME entity\n"; michael@0: last; # no content-type - we're done michael@0: } michael@0: michael@0: $contenttype = $hdrhash{"content-type"}{MAIN}; michael@0: if ($contenttype eq "application/pkcs7-mime") { michael@0: # michael@0: # opaque-signed or enveloped message michael@0: # michael@0: unless (exists($hdrhash{"content-type"}{"smime-type"})) { michael@0: print STDERR "ERROR: no smime-type attribute in application/pkcs7-smime entity.\n"; michael@0: last; michael@0: } michael@0: $smimetype = $hdrhash{"content-type"}{"smime-type"}; michael@0: if ($smimetype eq "signed-data" or $smimetype eq "enveloped-data") { michael@0: # it's verification or decryption time! michael@0: michael@0: # can handle only base64 encoding for now michael@0: # all other encodings are treated as binary (8bit) michael@0: if ($hdrhash{"content-transfer-encoding"}{MAIN} eq "base64") { michael@0: $mimebody = decode_base64($mimebody); michael@0: } michael@0: michael@0: # if we need to dump the DER, we would do it right here michael@0: michael@0: # now write the DER michael@0: $tmpderfile = "/tmp/der.$$"; michael@0: open(TMP, ">$tmpderfile") or die "ERROR: cannot write signature data to temporary file"; michael@0: print TMP $mimebody; michael@0: unless (close(TMP)) { michael@0: print STDERR "ERROR: writing signature data to temporary file.\n"; michael@0: unlink($tmpderfile); michael@0: exit 1; michael@0: } michael@0: michael@0: $mimeheaders = ""; michael@0: open(TMP, "$cmsutilpath -D $decodeopts -h $layercounter -i $tmpderfile |") or die "ERROR: cannot open pipe to cmsutil"; michael@0: $layercounter++; michael@0: while () { michael@0: last if (/^\r?$/); # empty lines mark end of header michael@0: if (/^SMIME: /) { # add all SMIME info to the rfc822 hdrs michael@0: $lastref = \$rfc822headers; michael@0: } elsif (/^\s/) { michael@0: ; # continuation lines go to the last dest michael@0: } else { michael@0: $lastref = \$mimeheaders; # all other headers are mime headers michael@0: } michael@0: $$lastref .= $_; michael@0: } michael@0: # slurp in rest of the data to $mimebody michael@0: $saveRS = $/; $/ = undef; $mimebody = ; $/ = $saveRS; michael@0: close(TMP); michael@0: michael@0: unlink($tmpderfile); michael@0: michael@0: } else { michael@0: print STDERR "ERROR: unknown smime-type \"$smimetype\" in application/pkcs7-smime entity.\n"; michael@0: last; michael@0: } michael@0: } elsif ($contenttype eq "multipart/signed") { michael@0: # michael@0: # clear signed message michael@0: # michael@0: unless (exists($hdrhash{"content-type"}{"protocol"})) { michael@0: print STDERR "ERROR: content type has no protocol attribute in multipart/signed entity.\n"; michael@0: last; michael@0: } michael@0: if ($hdrhash{"content-type"}{"protocol"} ne "application/pkcs7-signature") { michael@0: # we cannot handle this guy michael@0: print STDERR "ERROR: unknown protocol \"", $hdrhash{"content-type"}{"protocol"}, michael@0: "\" in multipart/signed entity.\n"; michael@0: last; michael@0: } michael@0: unless (exists($hdrhash{"content-type"}{"boundary"})) { michael@0: print STDERR "ERROR: no boundary attribute in multipart/signed entity.\n"; michael@0: last; michael@0: } michael@0: $boundary = $hdrhash{"content-type"}{"boundary"}; michael@0: michael@0: # split $mimebody along \n--$boundary\n - gets you four parts michael@0: # first (0), any comments the sending agent might have put in michael@0: # second (1), the message itself michael@0: # third (2), the signature as a mime entity michael@0: # fourth (3), trailing data (there shouldn't be any) michael@0: michael@0: @multiparts = split(/\r?\n--$boundary(?:--)?\r?\n/, $mimebody); michael@0: michael@0: # michael@0: # parse the signature headers michael@0: ($submimeheaders, $submimebody) = split(/^$/m, $multiparts[2]); michael@0: %sighdrhash = parseheaders($submimeheaders); michael@0: unless (exists($sighdrhash{"content-type"}{MAIN})) { michael@0: print STDERR "ERROR: signature entity has no content type.\n"; michael@0: last; michael@0: } michael@0: if ($sighdrhash{"content-type"}{MAIN} ne "application/pkcs7-signature") { michael@0: # we cannot handle this guy michael@0: print STDERR "ERROR: unknown content type \"", $sighdrhash{"content-type"}{MAIN}, michael@0: "\" in signature entity.\n"; michael@0: last; michael@0: } michael@0: if ($sighdrhash{"content-transfer-encoding"}{MAIN} eq "base64") { michael@0: $submimebody = decode_base64($submimebody); michael@0: } michael@0: michael@0: # we would dump the DER at this point michael@0: michael@0: $tmpsigfile = "/tmp/sig.$$"; michael@0: open(TMP, ">$tmpsigfile") or die "ERROR: cannot write signature data to temporary file"; michael@0: print TMP $submimebody; michael@0: unless (close(TMP)) { michael@0: print STDERR "ERROR: writing signature data to temporary file.\n"; michael@0: unlink($tmpsigfile); michael@0: exit 1; michael@0: } michael@0: michael@0: $tmpmsgfile = "/tmp/msg.$$"; michael@0: open(TMP, ">$tmpmsgfile") or die "ERROR: cannot write message data to temporary file"; michael@0: print TMP $multiparts[1]; michael@0: unless (close(TMP)) { michael@0: print STDERR "ERROR: writing message data to temporary file.\n"; michael@0: unlink($tmpsigfile); michael@0: unlink($tmpmsgfile); michael@0: exit 1; michael@0: } michael@0: michael@0: $mimeheaders = ""; michael@0: open(TMP, "$cmsutilpath -D $decodeopts -h $layercounter -c $tmpmsgfile -i $tmpsigfile |") or die "ERROR: cannot open pipe to cmsutil"; michael@0: $layercounter++; michael@0: while () { michael@0: last if (/^\r?$/); michael@0: if (/^SMIME: /) { michael@0: $lastref = \$rfc822headers; michael@0: } elsif (/^\s/) { michael@0: ; michael@0: } else { michael@0: $lastref = \$mimeheaders; michael@0: } michael@0: $$lastref .= $_; michael@0: } michael@0: $saveRS = $/; $/ = undef; $mimebody = ; $/ = $saveRS; michael@0: close(TMP); michael@0: unlink($tmpsigfile); michael@0: unlink($tmpmsgfile); michael@0: michael@0: } else { michael@0: michael@0: # not a content type we know - we're done michael@0: last; michael@0: michael@0: } michael@0: } michael@0: michael@0: # so now we have the S/MIME parsing information in rfc822headers michael@0: # and the first mime entity we could not handle in mimeheaders and mimebody. michael@0: # dump 'em out and we're done. michael@0: print $rfc822headers; michael@0: print $mimeheaders . "\n" . $mimebody; michael@0: michael@0: } else { michael@0: michael@0: # michael@0: # encode (which is much easier than decode) michael@0: # michael@0: michael@0: $mimeentity = $mimeheaders . "\n" . $mimebody; michael@0: michael@0: # michael@0: # canonicalize inner entity (rudimentary yet) michael@0: # convert single LFs to CRLF michael@0: # if no Content-Transfer-Encoding header present: michael@0: # if 8 bit chars present, use Content-Transfer-Encoding: quoted-printable michael@0: # otherwise, use Content-Transfer-Encoding: 7bit michael@0: # michael@0: $mimeentity =~ s/\r*\n/\r\n/mg; michael@0: michael@0: # michael@0: # now do the wrapping michael@0: # we sign first, then encrypt because that's what Communicator needs michael@0: # michael@0: if (defined($opt_S)) { michael@0: $mimeentity = signentity($mimeentity, $signopts); michael@0: } michael@0: michael@0: if (defined($opt_E)) { michael@0: $mimeentity = encryptentity($mimeentity, $encryptopts); michael@0: } michael@0: michael@0: # michael@0: # XXX sign again to do triple wrapping (RFC2634) michael@0: # michael@0: michael@0: # michael@0: # now write out the RFC822 headers michael@0: # followed by the final $mimeentity michael@0: # michael@0: print $rfc822headers; michael@0: print "MIME-Version: 1.0 (NSS SMIME - http://www.mozilla.org/projects/security)\n"; # set up the flag michael@0: print $mimeentity; michael@0: } michael@0: michael@0: exit 0;