xref: /openbsd-src/lib/libssl/test/cms-examples.pl (revision 5650a0e1b1300b167aa354ad1f7b944b49271323)
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