1*5650a0e1Sdjm# test/cms-examples.pl 2*5650a0e1Sdjm# Written by Dr Stephen N Henson (steve@openssl.org) for the OpenSSL 3*5650a0e1Sdjm# project. 4*5650a0e1Sdjm# 5*5650a0e1Sdjm# ==================================================================== 6*5650a0e1Sdjm# Copyright (c) 2008 The OpenSSL Project. All rights reserved. 7*5650a0e1Sdjm# 8*5650a0e1Sdjm# Redistribution and use in source and binary forms, with or without 9*5650a0e1Sdjm# modification, are permitted provided that the following conditions 10*5650a0e1Sdjm# are met: 11*5650a0e1Sdjm# 12*5650a0e1Sdjm# 1. Redistributions of source code must retain the above copyright 13*5650a0e1Sdjm# notice, this list of conditions and the following disclaimer. 14*5650a0e1Sdjm# 15*5650a0e1Sdjm# 2. Redistributions in binary form must reproduce the above copyright 16*5650a0e1Sdjm# notice, this list of conditions and the following disclaimer in 17*5650a0e1Sdjm# the documentation and/or other materials provided with the 18*5650a0e1Sdjm# distribution. 19*5650a0e1Sdjm# 20*5650a0e1Sdjm# 3. All advertising materials mentioning features or use of this 21*5650a0e1Sdjm# software must display the following acknowledgment: 22*5650a0e1Sdjm# "This product includes software developed by the OpenSSL Project 23*5650a0e1Sdjm# for use in the OpenSSL Toolkit. (http://www.OpenSSL.org/)" 24*5650a0e1Sdjm# 25*5650a0e1Sdjm# 4. The names "OpenSSL Toolkit" and "OpenSSL Project" must not be used to 26*5650a0e1Sdjm# endorse or promote products derived from this software without 27*5650a0e1Sdjm# prior written permission. For written permission, please contact 28*5650a0e1Sdjm# licensing@OpenSSL.org. 29*5650a0e1Sdjm# 30*5650a0e1Sdjm# 5. Products derived from this software may not be called "OpenSSL" 31*5650a0e1Sdjm# nor may "OpenSSL" appear in their names without prior written 32*5650a0e1Sdjm# permission of the OpenSSL Project. 33*5650a0e1Sdjm# 34*5650a0e1Sdjm# 6. Redistributions of any form whatsoever must retain the following 35*5650a0e1Sdjm# acknowledgment: 36*5650a0e1Sdjm# "This product includes software developed by the OpenSSL Project 37*5650a0e1Sdjm# for use in the OpenSSL Toolkit (http://www.OpenSSL.org/)" 38*5650a0e1Sdjm# 39*5650a0e1Sdjm# THIS SOFTWARE IS PROVIDED BY THE OpenSSL PROJECT ``AS IS'' AND ANY 40*5650a0e1Sdjm# EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 41*5650a0e1Sdjm# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 42*5650a0e1Sdjm# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE OpenSSL PROJECT OR 43*5650a0e1Sdjm# ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 44*5650a0e1Sdjm# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 45*5650a0e1Sdjm# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 46*5650a0e1Sdjm# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 47*5650a0e1Sdjm# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 48*5650a0e1Sdjm# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 49*5650a0e1Sdjm# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED 50*5650a0e1Sdjm# OF THE POSSIBILITY OF SUCH DAMAGE. 51*5650a0e1Sdjm# ==================================================================== 52*5650a0e1Sdjm 53*5650a0e1Sdjm# Perl script to run tests against S/MIME examples in RFC4134 54*5650a0e1Sdjm# Assumes RFC is in current directory and called "rfc4134.txt" 55*5650a0e1Sdjm 56*5650a0e1Sdjmuse MIME::Base64; 57*5650a0e1Sdjm 58*5650a0e1Sdjmmy $badttest = 0; 59*5650a0e1Sdjmmy $verbose = 1; 60*5650a0e1Sdjm 61*5650a0e1Sdjmmy $cmscmd; 62*5650a0e1Sdjmmy $exdir = "./"; 63*5650a0e1Sdjmmy $exfile = "./rfc4134.txt"; 64*5650a0e1Sdjm 65*5650a0e1Sdjmif (-f "../apps/openssl") 66*5650a0e1Sdjm { 67*5650a0e1Sdjm $cmscmd = "../util/shlib_wrap.sh ../apps/openssl cms"; 68*5650a0e1Sdjm } 69*5650a0e1Sdjmelsif (-f "..\\out32dll\\openssl.exe") 70*5650a0e1Sdjm { 71*5650a0e1Sdjm $cmscmd = "..\\out32dll\\openssl.exe cms"; 72*5650a0e1Sdjm } 73*5650a0e1Sdjmelsif (-f "..\\out32\\openssl.exe") 74*5650a0e1Sdjm { 75*5650a0e1Sdjm $cmscmd = "..\\out32\\openssl.exe cms"; 76*5650a0e1Sdjm } 77*5650a0e1Sdjm 78*5650a0e1Sdjmmy @test_list = ( 79*5650a0e1Sdjm [ "3.1.bin" => "dataout" ], 80*5650a0e1Sdjm [ "3.2.bin" => "encode, dataout" ], 81*5650a0e1Sdjm [ "4.1.bin" => "encode, verifyder, cont, dss" ], 82*5650a0e1Sdjm [ "4.2.bin" => "encode, verifyder, cont, rsa" ], 83*5650a0e1Sdjm [ "4.3.bin" => "encode, verifyder, cont_extern, dss" ], 84*5650a0e1Sdjm [ "4.4.bin" => "encode, verifyder, cont, dss" ], 85*5650a0e1Sdjm [ "4.5.bin" => "verifyder, cont, rsa" ], 86*5650a0e1Sdjm [ "4.6.bin" => "encode, verifyder, cont, dss" ], 87*5650a0e1Sdjm [ "4.7.bin" => "encode, verifyder, cont, dss" ], 88*5650a0e1Sdjm [ "4.8.eml" => "verifymime, dss" ], 89*5650a0e1Sdjm [ "4.9.eml" => "verifymime, dss" ], 90*5650a0e1Sdjm [ "4.10.bin" => "encode, verifyder, cont, dss" ], 91*5650a0e1Sdjm [ "4.11.bin" => "encode, certsout" ], 92*5650a0e1Sdjm [ "5.1.bin" => "encode, envelopeder, cont" ], 93*5650a0e1Sdjm [ "5.2.bin" => "encode, envelopeder, cont" ], 94*5650a0e1Sdjm [ "5.3.eml" => "envelopemime, cont" ], 95*5650a0e1Sdjm [ "6.0.bin" => "encode, digest, cont" ], 96*5650a0e1Sdjm [ "7.1.bin" => "encode, encrypted, cont" ], 97*5650a0e1Sdjm [ "7.2.bin" => "encode, encrypted, cont" ] 98*5650a0e1Sdjm); 99*5650a0e1Sdjm 100*5650a0e1Sdjm# Extract examples from RFC4134 text. 101*5650a0e1Sdjm# Base64 decode all examples, certificates and 102*5650a0e1Sdjm# private keys are converted to PEM format. 103*5650a0e1Sdjm 104*5650a0e1Sdjmmy ( $filename, $data ); 105*5650a0e1Sdjm 106*5650a0e1Sdjmmy @cleanup = ( "cms.out", "cms.err", "tmp.der", "tmp.txt" ); 107*5650a0e1Sdjm 108*5650a0e1Sdjm$data = ""; 109*5650a0e1Sdjm 110*5650a0e1Sdjmopen( IN, $exfile ) || die "Can't Open RFC examples file $exfile"; 111*5650a0e1Sdjm 112*5650a0e1Sdjmwhile (<IN>) { 113*5650a0e1Sdjm next unless (/^\|/); 114*5650a0e1Sdjm s/^\|//; 115*5650a0e1Sdjm next if (/^\*/); 116*5650a0e1Sdjm if (/^>(.*)$/) { 117*5650a0e1Sdjm $filename = $1; 118*5650a0e1Sdjm next; 119*5650a0e1Sdjm } 120*5650a0e1Sdjm if (/^</) { 121*5650a0e1Sdjm $filename = "$exdir/$filename"; 122*5650a0e1Sdjm if ( $filename =~ /\.bin$/ || $filename =~ /\.eml$/ ) { 123*5650a0e1Sdjm $data = decode_base64($data); 124*5650a0e1Sdjm open OUT, ">$filename"; 125*5650a0e1Sdjm binmode OUT; 126*5650a0e1Sdjm print OUT $data; 127*5650a0e1Sdjm close OUT; 128*5650a0e1Sdjm push @cleanup, $filename; 129*5650a0e1Sdjm } 130*5650a0e1Sdjm elsif ( $filename =~ /\.cer$/ ) { 131*5650a0e1Sdjm write_pem( $filename, "CERTIFICATE", $data ); 132*5650a0e1Sdjm } 133*5650a0e1Sdjm elsif ( $filename =~ /\.pri$/ ) { 134*5650a0e1Sdjm write_pem( $filename, "PRIVATE KEY", $data ); 135*5650a0e1Sdjm } 136*5650a0e1Sdjm $data = ""; 137*5650a0e1Sdjm $filename = ""; 138*5650a0e1Sdjm } 139*5650a0e1Sdjm else { 140*5650a0e1Sdjm $data .= $_; 141*5650a0e1Sdjm } 142*5650a0e1Sdjm 143*5650a0e1Sdjm} 144*5650a0e1Sdjm 145*5650a0e1Sdjmmy $secretkey = 146*5650a0e1Sdjm "73:7c:79:1f:25:ea:d0:e0:46:29:25:43:52:f7:dc:62:91:e5:cb:26:91:7a:da:32"; 147*5650a0e1Sdjm 148*5650a0e1Sdjmforeach (@test_list) { 149*5650a0e1Sdjm my ( $file, $tlist ) = @$_; 150*5650a0e1Sdjm print "Example file $file:\n"; 151*5650a0e1Sdjm if ( $tlist =~ /encode/ ) { 152*5650a0e1Sdjm run_reencode_test( $exdir, $file ); 153*5650a0e1Sdjm } 154*5650a0e1Sdjm if ( $tlist =~ /certsout/ ) { 155*5650a0e1Sdjm run_certsout_test( $exdir, $file ); 156*5650a0e1Sdjm } 157*5650a0e1Sdjm if ( $tlist =~ /dataout/ ) { 158*5650a0e1Sdjm run_dataout_test( $exdir, $file ); 159*5650a0e1Sdjm } 160*5650a0e1Sdjm if ( $tlist =~ /verify/ ) { 161*5650a0e1Sdjm run_verify_test( $exdir, $tlist, $file ); 162*5650a0e1Sdjm } 163*5650a0e1Sdjm if ( $tlist =~ /digest/ ) { 164*5650a0e1Sdjm run_digest_test( $exdir, $tlist, $file ); 165*5650a0e1Sdjm } 166*5650a0e1Sdjm if ( $tlist =~ /encrypted/ ) { 167*5650a0e1Sdjm run_encrypted_test( $exdir, $tlist, $file, $secretkey ); 168*5650a0e1Sdjm } 169*5650a0e1Sdjm if ( $tlist =~ /envelope/ ) { 170*5650a0e1Sdjm run_envelope_test( $exdir, $tlist, $file ); 171*5650a0e1Sdjm } 172*5650a0e1Sdjm 173*5650a0e1Sdjm} 174*5650a0e1Sdjm 175*5650a0e1Sdjmforeach (@cleanup) { 176*5650a0e1Sdjm unlink $_; 177*5650a0e1Sdjm} 178*5650a0e1Sdjm 179*5650a0e1Sdjmif ($badtest) { 180*5650a0e1Sdjm print "\n$badtest TESTS FAILED!!\n"; 181*5650a0e1Sdjm} 182*5650a0e1Sdjmelse { 183*5650a0e1Sdjm print "\n***All tests successful***\n"; 184*5650a0e1Sdjm} 185*5650a0e1Sdjm 186*5650a0e1Sdjmsub write_pem { 187*5650a0e1Sdjm my ( $filename, $str, $data ) = @_; 188*5650a0e1Sdjm 189*5650a0e1Sdjm $filename =~ s/\.[^.]*$/.pem/; 190*5650a0e1Sdjm 191*5650a0e1Sdjm push @cleanup, $filename; 192*5650a0e1Sdjm 193*5650a0e1Sdjm open OUT, ">$filename"; 194*5650a0e1Sdjm 195*5650a0e1Sdjm print OUT "-----BEGIN $str-----\n"; 196*5650a0e1Sdjm print OUT $data; 197*5650a0e1Sdjm print OUT "-----END $str-----\n"; 198*5650a0e1Sdjm 199*5650a0e1Sdjm close OUT; 200*5650a0e1Sdjm} 201*5650a0e1Sdjm 202*5650a0e1Sdjmsub run_reencode_test { 203*5650a0e1Sdjm my ( $cmsdir, $tfile ) = @_; 204*5650a0e1Sdjm unlink "tmp.der"; 205*5650a0e1Sdjm 206*5650a0e1Sdjm system( "$cmscmd -cmsout -inform DER -outform DER" 207*5650a0e1Sdjm . " -in $cmsdir/$tfile -out tmp.der" ); 208*5650a0e1Sdjm 209*5650a0e1Sdjm if ($?) { 210*5650a0e1Sdjm print "\tReencode command FAILED!!\n"; 211*5650a0e1Sdjm $badtest++; 212*5650a0e1Sdjm } 213*5650a0e1Sdjm elsif ( !cmp_files( "$cmsdir/$tfile", "tmp.der" ) ) { 214*5650a0e1Sdjm print "\tReencode FAILED!!\n"; 215*5650a0e1Sdjm $badtest++; 216*5650a0e1Sdjm } 217*5650a0e1Sdjm else { 218*5650a0e1Sdjm print "\tReencode passed\n" if $verbose; 219*5650a0e1Sdjm } 220*5650a0e1Sdjm} 221*5650a0e1Sdjm 222*5650a0e1Sdjmsub run_certsout_test { 223*5650a0e1Sdjm my ( $cmsdir, $tfile ) = @_; 224*5650a0e1Sdjm unlink "tmp.der"; 225*5650a0e1Sdjm unlink "tmp.pem"; 226*5650a0e1Sdjm 227*5650a0e1Sdjm system( "$cmscmd -cmsout -inform DER -certsout tmp.pem" 228*5650a0e1Sdjm . " -in $cmsdir/$tfile -out tmp.der" ); 229*5650a0e1Sdjm 230*5650a0e1Sdjm if ($?) { 231*5650a0e1Sdjm print "\tCertificate output command FAILED!!\n"; 232*5650a0e1Sdjm $badtest++; 233*5650a0e1Sdjm } 234*5650a0e1Sdjm else { 235*5650a0e1Sdjm print "\tCertificate output passed\n" if $verbose; 236*5650a0e1Sdjm } 237*5650a0e1Sdjm} 238*5650a0e1Sdjm 239*5650a0e1Sdjmsub run_dataout_test { 240*5650a0e1Sdjm my ( $cmsdir, $tfile ) = @_; 241*5650a0e1Sdjm unlink "tmp.txt"; 242*5650a0e1Sdjm 243*5650a0e1Sdjm system( 244*5650a0e1Sdjm "$cmscmd -data_out -inform DER" . " -in $cmsdir/$tfile -out tmp.txt" ); 245*5650a0e1Sdjm 246*5650a0e1Sdjm if ($?) { 247*5650a0e1Sdjm print "\tDataout command FAILED!!\n"; 248*5650a0e1Sdjm $badtest++; 249*5650a0e1Sdjm } 250*5650a0e1Sdjm elsif ( !cmp_files( "$cmsdir/ExContent.bin", "tmp.txt" ) ) { 251*5650a0e1Sdjm print "\tDataout compare FAILED!!\n"; 252*5650a0e1Sdjm $badtest++; 253*5650a0e1Sdjm } 254*5650a0e1Sdjm else { 255*5650a0e1Sdjm print "\tDataout passed\n" if $verbose; 256*5650a0e1Sdjm } 257*5650a0e1Sdjm} 258*5650a0e1Sdjm 259*5650a0e1Sdjmsub run_verify_test { 260*5650a0e1Sdjm my ( $cmsdir, $tlist, $tfile ) = @_; 261*5650a0e1Sdjm unlink "tmp.txt"; 262*5650a0e1Sdjm 263*5650a0e1Sdjm $form = "DER" if $tlist =~ /verifyder/; 264*5650a0e1Sdjm $form = "SMIME" if $tlist =~ /verifymime/; 265*5650a0e1Sdjm $cafile = "$cmsdir/CarlDSSSelf.pem" if $tlist =~ /dss/; 266*5650a0e1Sdjm $cafile = "$cmsdir/CarlRSASelf.pem" if $tlist =~ /rsa/; 267*5650a0e1Sdjm 268*5650a0e1Sdjm $cmd = 269*5650a0e1Sdjm "$cmscmd -verify -inform $form" 270*5650a0e1Sdjm . " -CAfile $cafile" 271*5650a0e1Sdjm . " -in $cmsdir/$tfile -out tmp.txt"; 272*5650a0e1Sdjm 273*5650a0e1Sdjm $cmd .= " -content $cmsdir/ExContent.bin" if $tlist =~ /cont_extern/; 274*5650a0e1Sdjm 275*5650a0e1Sdjm system("$cmd 2>cms.err 1>cms.out"); 276*5650a0e1Sdjm 277*5650a0e1Sdjm if ($?) { 278*5650a0e1Sdjm print "\tVerify command FAILED!!\n"; 279*5650a0e1Sdjm $badtest++; 280*5650a0e1Sdjm } 281*5650a0e1Sdjm elsif ( $tlist =~ /cont/ 282*5650a0e1Sdjm && !cmp_files( "$cmsdir/ExContent.bin", "tmp.txt" ) ) 283*5650a0e1Sdjm { 284*5650a0e1Sdjm print "\tVerify content compare FAILED!!\n"; 285*5650a0e1Sdjm $badtest++; 286*5650a0e1Sdjm } 287*5650a0e1Sdjm else { 288*5650a0e1Sdjm print "\tVerify passed\n" if $verbose; 289*5650a0e1Sdjm } 290*5650a0e1Sdjm} 291*5650a0e1Sdjm 292*5650a0e1Sdjmsub run_envelope_test { 293*5650a0e1Sdjm my ( $cmsdir, $tlist, $tfile ) = @_; 294*5650a0e1Sdjm unlink "tmp.txt"; 295*5650a0e1Sdjm 296*5650a0e1Sdjm $form = "DER" if $tlist =~ /envelopeder/; 297*5650a0e1Sdjm $form = "SMIME" if $tlist =~ /envelopemime/; 298*5650a0e1Sdjm 299*5650a0e1Sdjm $cmd = 300*5650a0e1Sdjm "$cmscmd -decrypt -inform $form" 301*5650a0e1Sdjm . " -recip $cmsdir/BobRSASignByCarl.pem" 302*5650a0e1Sdjm . " -inkey $cmsdir/BobPrivRSAEncrypt.pem" 303*5650a0e1Sdjm . " -in $cmsdir/$tfile -out tmp.txt"; 304*5650a0e1Sdjm 305*5650a0e1Sdjm system("$cmd 2>cms.err 1>cms.out"); 306*5650a0e1Sdjm 307*5650a0e1Sdjm if ($?) { 308*5650a0e1Sdjm print "\tDecrypt command FAILED!!\n"; 309*5650a0e1Sdjm $badtest++; 310*5650a0e1Sdjm } 311*5650a0e1Sdjm elsif ( $tlist =~ /cont/ 312*5650a0e1Sdjm && !cmp_files( "$cmsdir/ExContent.bin", "tmp.txt" ) ) 313*5650a0e1Sdjm { 314*5650a0e1Sdjm print "\tDecrypt content compare FAILED!!\n"; 315*5650a0e1Sdjm $badtest++; 316*5650a0e1Sdjm } 317*5650a0e1Sdjm else { 318*5650a0e1Sdjm print "\tDecrypt passed\n" if $verbose; 319*5650a0e1Sdjm } 320*5650a0e1Sdjm} 321*5650a0e1Sdjm 322*5650a0e1Sdjmsub run_digest_test { 323*5650a0e1Sdjm my ( $cmsdir, $tlist, $tfile ) = @_; 324*5650a0e1Sdjm unlink "tmp.txt"; 325*5650a0e1Sdjm 326*5650a0e1Sdjm my $cmd = 327*5650a0e1Sdjm "$cmscmd -digest_verify -inform DER" . " -in $cmsdir/$tfile -out tmp.txt"; 328*5650a0e1Sdjm 329*5650a0e1Sdjm system("$cmd 2>cms.err 1>cms.out"); 330*5650a0e1Sdjm 331*5650a0e1Sdjm if ($?) { 332*5650a0e1Sdjm print "\tDigest verify command FAILED!!\n"; 333*5650a0e1Sdjm $badtest++; 334*5650a0e1Sdjm } 335*5650a0e1Sdjm elsif ( $tlist =~ /cont/ 336*5650a0e1Sdjm && !cmp_files( "$cmsdir/ExContent.bin", "tmp.txt" ) ) 337*5650a0e1Sdjm { 338*5650a0e1Sdjm print "\tDigest verify content compare FAILED!!\n"; 339*5650a0e1Sdjm $badtest++; 340*5650a0e1Sdjm } 341*5650a0e1Sdjm else { 342*5650a0e1Sdjm print "\tDigest verify passed\n" if $verbose; 343*5650a0e1Sdjm } 344*5650a0e1Sdjm} 345*5650a0e1Sdjm 346*5650a0e1Sdjmsub run_encrypted_test { 347*5650a0e1Sdjm my ( $cmsdir, $tlist, $tfile, $key ) = @_; 348*5650a0e1Sdjm unlink "tmp.txt"; 349*5650a0e1Sdjm 350*5650a0e1Sdjm system( "$cmscmd -EncryptedData_decrypt -inform DER" 351*5650a0e1Sdjm . " -secretkey $key" 352*5650a0e1Sdjm . " -in $cmsdir/$tfile -out tmp.txt" ); 353*5650a0e1Sdjm 354*5650a0e1Sdjm if ($?) { 355*5650a0e1Sdjm print "\tEncrypted Data command FAILED!!\n"; 356*5650a0e1Sdjm $badtest++; 357*5650a0e1Sdjm } 358*5650a0e1Sdjm elsif ( $tlist =~ /cont/ 359*5650a0e1Sdjm && !cmp_files( "$cmsdir/ExContent.bin", "tmp.txt" ) ) 360*5650a0e1Sdjm { 361*5650a0e1Sdjm print "\tEncrypted Data content compare FAILED!!\n"; 362*5650a0e1Sdjm $badtest++; 363*5650a0e1Sdjm } 364*5650a0e1Sdjm else { 365*5650a0e1Sdjm print "\tEncryptedData verify passed\n" if $verbose; 366*5650a0e1Sdjm } 367*5650a0e1Sdjm} 368*5650a0e1Sdjm 369*5650a0e1Sdjmsub cmp_files { 370*5650a0e1Sdjm my ( $f1, $f2 ) = @_; 371*5650a0e1Sdjm my ( $fp1, $fp2 ); 372*5650a0e1Sdjm 373*5650a0e1Sdjm my ( $rd1, $rd2 ); 374*5650a0e1Sdjm 375*5650a0e1Sdjm if ( !open( $fp1, "<$f1" ) ) { 376*5650a0e1Sdjm print STDERR "Can't Open file $f1\n"; 377*5650a0e1Sdjm return 0; 378*5650a0e1Sdjm } 379*5650a0e1Sdjm 380*5650a0e1Sdjm if ( !open( $fp2, "<$f2" ) ) { 381*5650a0e1Sdjm print STDERR "Can't Open file $f2\n"; 382*5650a0e1Sdjm return 0; 383*5650a0e1Sdjm } 384*5650a0e1Sdjm 385*5650a0e1Sdjm binmode $fp1; 386*5650a0e1Sdjm binmode $fp2; 387*5650a0e1Sdjm 388*5650a0e1Sdjm my $ret = 0; 389*5650a0e1Sdjm 390*5650a0e1Sdjm for ( ; ; ) { 391*5650a0e1Sdjm $n1 = sysread $fp1, $rd1, 4096; 392*5650a0e1Sdjm $n2 = sysread $fp2, $rd2, 4096; 393*5650a0e1Sdjm last if ( $n1 != $n2 ); 394*5650a0e1Sdjm last if ( $rd1 ne $rd2 ); 395*5650a0e1Sdjm 396*5650a0e1Sdjm if ( $n1 == 0 ) { 397*5650a0e1Sdjm $ret = 1; 398*5650a0e1Sdjm last; 399*5650a0e1Sdjm } 400*5650a0e1Sdjm 401*5650a0e1Sdjm } 402*5650a0e1Sdjm 403*5650a0e1Sdjm close $fp1; 404*5650a0e1Sdjm close $fp2; 405*5650a0e1Sdjm 406*5650a0e1Sdjm return $ret; 407*5650a0e1Sdjm 408*5650a0e1Sdjm} 409*5650a0e1Sdjm 410