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;