Add 2-way path for SSSE3 version of ChaCha20
[libgcrypt.git] / tests / cavs_driver.pl
1 #!/usr/bin/env perl
2 #
3 # $Id: cavs_driver.pl 1497 2009-01-22 14:01:29Z smueller $
4 #
5 # CAVS test driver (based on the OpenSSL driver)
6 # Written by: Stephan Müller <sm@atsec.com>
7 # Copyright (c) atsec information security corporation
8 #
9 # Permission is hereby granted, free of charge, to any person obtaining a copy
10 # of this software and associated documentation files (the "Software"), to deal
11 # in the Software without restriction, including without limitation the rights
12 # to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
13 # copies of the Software, and to permit persons to whom the Software is
14 # furnished to do so, subject to the following conditions:
15 #
16 # The above copyright notice and this permission notice shall be included in
17 # all copies or substantial portions of the Software.
18 #
19 #                            NO WARRANTY
20 #
21 #    BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
22 #    FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
23 #    OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
24 #    PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
25 #    OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
26 #    MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
27 #    TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
28 #    PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
29 #    REPAIR OR CORRECTION.
30 #
31 #    IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
32 #    WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
33 #    REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
34 #    INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
35 #    OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
36 #    TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
37 #    YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
38 #    PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
39 #    POSSIBILITY OF SUCH DAMAGES.
40 #
41 #
42 # test execution instruction:
43 # 1. get the request files from the lab
44 # 2. call each request file from 1. with this program:
45 #       $0 <FILE>.rep
46 # 3. send the resulting file <FILE>.rsp to the lab
47 #
48 #
49 # Test should be easily adoptable to other implementations
50 # See the first functions for this task
51 #
52 # Following tests are covered (others may also be covered
53 # but have not been tested)
54 #
55 # AES
56 #       [CBC|CFB128|ECB|OFB]GFSbox[128|192|256]
57 #       [CBC|CFB128|ECB|OFB]MCT[128|192|256]
58 #       [CBC|CFB128|ECB|OFB]VarKey[128|192|256]
59 #       [CBC|CFB128|ECB|OFB]KeySbox[128|192|256]
60 #       [CBC|CFB128|ECB|OFB]MMT[128|192|256]
61 #       [CBC|CFB128|ECB|OFB]VarTxt[128|192|256]
62 #
63 # RSA
64 #       SigGen[15|RSA]
65 #       SigVer15
66 #       (SigVerRSA is not applicable for OpenSSL as X9.31 padding
67 #               is not done through openssl dgst)
68 #       KeyGen RSA X9.31
69 #
70 # SHA
71 #       SHA[1|224|256|384|512]ShortMsg
72 #       SHA[1|224|256|384|512]LongMsg
73 #       SHA[1|224|256|384|512]Monte
74 #
75 # HMAC (SHA - caveat: we only support hash output equal to the block size of
76 #       of the hash - we do not support truncation of the hash; to support
77 #       that, we first need to decipher the HMAC.req file - see hmac_kat() )
78 #       HMAC
79 #
80 # TDES
81 #       T[CBC|CFB??|ECB|OFB]Monte[1|2|3]
82 #       T[CBC|CFB??|ECB|OFB]permop
83 #       T[CBC|CFB??|ECB|OFB]MMT[1|2|3]
84 #       T[CBC|CFB??|ECB|OFB]subtab
85 #       T[CBC|CFB??|ECB|OFB]varkey
86 #       T[CBC|CFB??|ECB|OFB]invperm
87 #       T[CBC|CFB??|ECB|OFB]vartext
88 #
89 # ANSI X9.31 RNG
90 #       ANSI931_AES128MCT
91 #       ANSI931_AES128VST
92 #
93 # DSA
94 #       PQGGen
95 #       SigGen
96 #       SigVer
97 #
98 # RC4 (atsec developed tests)
99 #       RC4KeyBD
100 #       RC4MCT
101 #       RC4PltBD
102 #       RC4REGT
103 #
104
105 use strict;
106 use warnings;
107 use IPC::Open2;
108 use Getopt::Std;
109 use MIME::Base64;
110
111 # Contains the command line options
112 my %opt;
113
114 #################################################################
115 ##### Central interface functions to the external ciphers #######
116 #################################################################
117 # Only these interface routines should be changed in case of
118 # porting to a new cipher library
119 #
120 # For porting to a new library, create implementation of these functions
121 # and then add pointers to the respective implementation of each
122 # function to the given variables.
123
124 # common encryption/decryption routine
125 # $1 key in hex form (please note for 3DES: even when ede3 for three
126 #    independent ciphers is given with the cipher specification, we hand in
127 #    either one key for k1 = k2 = k3, two keys which are concatinated for
128 #    k1 = k3, k2 independent, or three keys which are concatinated for
129 #    k1, k2, k3 independent)
130 # $2 iv in hex form
131 # $3 cipher - the cipher string is defined as specified in the openssl
132 #    enc(1ssl) specification for the option "-ciphername"
133 #    (e.g. aes-128-cbc or des-ede3-cbc)
134 # $4 encrypt=1/decrypt=0
135 # $5 de/encrypted data in hex form
136 # return en/decrypted data in hex form
137 my $encdec;
138
139 #
140 # Derive an RSA key from the given X9.31 parameters.
141 # $1: modulus size
142 # $2: E   in hex form
143 # $3: Xp1 in hex form
144 # $4: Xp2 in hex form
145 # $5: Xp  in hex form
146 # $6: Xq1 in hex form
147 # $7: Xq2 in hex form
148 # $8: Xq  in hex form
149 # return: string with the calculated values in hex format, where each value
150 #        is separated from the previous with a \n in the following order:
151 #         P\n
152 #         Q\n
153 #         N\n
154 #         D\n
155 my $rsa_derive;
156
157 # Sign a message with RSA
158 # $1: data to be signed in hex form
159 # $2: Hash algo
160 # $3: Key file in PEM format with the private key
161 # return: digest in hex format
162 my $rsa_sign;
163
164 # Verify a message with RSA
165 # $1: data to be verified in hex form
166 # $2: hash algo
167 # $3: file holding the public RSA key in PEM format
168 # $4: file holding the signature in binary form
169 # return: 1 == verified / 0 == not verified
170 my $rsa_verify;
171
172 # generate a new private RSA key with the following properties:
173 #       exponent is 65537
174 #       PEM format
175 # $1 key size in bit
176 # $2 keyfile name
177 # return: nothing, but file created
178 my $gen_rsakey;
179
180 # Creating a hash
181 # $1: Plaintext in hex form
182 # $2: hash type in the form documented in openssl's dgst(1ssl) - e.g.
183 #     sha1, sha224, sha256, sha384, sha512
184 # return: hash in hex form
185 my $hash;
186
187 # supplying the call to the external cipher implementation
188 # that is being used to keep STDIN and STDOUT open
189 # to maintain the state of the block chaining
190 # $1: cipher
191 # $2: 1=encryption, 0=decryption
192 # $3: buffersize needed for openssl
193 # $4: encryption key in binary form
194 # $5: IV in binary form
195 # return: command line to execute the application
196 my $state_cipher;
197 # the only difference of the DES version is that it implements the inner loop
198 # of the TDES tests
199 my $state_cipher_des;
200
201 # supplying the call to the external cipher implementation
202 # that is being used to keep STDIN and STDOUT open
203 # to maintain the state of the RNG with its seed
204 #
205 # input holds seed values
206 # $1: cipher key in hex format
207 # $2: DT value in hex format
208 # $3: V value in hex format
209 #
210 # return: command line to execute the application
211 #
212 # the application is expected to deliver random values on STDOUT - the script
213 # reads 128 bits repeatedly where the state of the RNG must be retained
214 # between the reads. The output of the RNG on STDOUT is assumed to be binary.
215 my $state_rng;
216
217 # Generate an HMAC based on SHAx
218 # $1: Key to be used for the HMAC in hex format
219 # $2: length of the hash to be calculated in bits
220 # $3: Message for which the HMAC shall be calculated in hex format
221 # $4: hash type (1 - SHA1, 224 - SHA224, and so on)
222 # return: calculated HMAC in hex format
223 my $hmac;
224
225 #
226 # Generate the P, Q, G, Seed, counter, h (value used to generate g) values
227 # for DSA
228 # $1: modulus size
229 # return: string with the calculated values in hex format, where each value
230 #         is separated from the previous with a \n in the following order:
231 #         P\n
232 #         Q\n
233 #         G\n
234 #         Seed\n
235 #         counter\n
236 #         h
237 my $dsa_pqggen;
238
239 #
240 # Generate an DSA public key from the provided parameters:
241 # $1: Name of file to create
242 # $2: P in hex form
243 # $3: Q in hex form
244 # $4: G in hex form
245 # $5: Y in hex form
246 my $dsa_genpubkey;
247
248 # Verify a message with DSA
249 # $1: data to be verified in hex form
250 # $2: file holding the public DSA key in PEM format
251 # $3: R value of the signature
252 # $4: S value of the signature
253 # return: 1 == verified / 0 == not verified
254 my $dsa_verify;
255
256 # generate a new DSA key with the following properties:
257 #       PEM format
258 # $1 keyfile name
259 # return: file created, hash with keys of P, Q, G in hex format
260 my $gen_dsakey;
261
262 # Sign a message with DSA
263 # $1: data to be signed in hex form
264 # $2: Key file in PEM format with the private key
265 # return: hash of digest information in hex format with Y, R, S as keys
266 my $dsa_sign;
267
268 ################################################################
269 ##### OpenSSL interface functions
270 ################################################################
271 sub openssl_encdec($$$$$) {
272         my $key=shift;
273         my $iv=shift;
274         my $cipher=shift;
275         my $enc = (shift) ? "-e" : "-d";
276         my $data=shift;
277
278         # We only invoke the driver with the IV parameter, if we have
279         # an IV, otherwise, we skip it
280         $iv = "-iv $iv" if ($iv);
281
282         $data=hex2bin($data);
283         my $program="openssl enc -$cipher -nopad -nosalt -K $key $enc $iv";
284         $program = "rc4 -k $key" if $opt{'R'}; #for ARCFOUR, no IV must be given
285         $data=pipe_through_program($data,$program);
286         return bin2hex($data);
287 }
288
289 sub openssl_rsa_sign($$$) {
290         my $data = shift;
291         my $cipher = shift;
292         my $keyfile = shift;
293
294         $data=hex2bin($data);
295         die "ARCFOUR not available for RSA" if $opt{'R'};
296         $data=pipe_through_program($data,
297                 "openssl dgst -$cipher -binary -sign $keyfile");
298         return bin2hex($data);
299 }
300
301 sub openssl_rsa_verify($$$$) {
302         my $data = shift;
303         my $cipher = shift;
304         my $keyfile = shift;
305         my $sigfile = shift;
306
307         $data = hex2bin($data);
308         die "ARCFOUR not available for RSA" if $opt{'R'};
309         $data = pipe_through_program($data,
310                 "openssl dgst -$cipher -binary -verify $keyfile -signature $sigfile");
311
312         # Parse through the OpenSSL output information
313         return ($data =~ /OK/);
314 }
315
316 sub openssl_gen_rsakey($$) {
317         my $keylen = shift;
318         my $file = shift;
319
320         die "ARCFOUR not available for RSA" if $opt{'R'};
321         # generating of a key with exponent 0x10001
322         my @args = ("openssl", "genrsa", "-F4", "-out", "$file", "$keylen");
323         system(@args) == 0
324                 or die "system @args failed: $?";
325         die "system @args failed: file $file not created" if (! -f $file);
326 }
327
328 sub openssl_hash($$) {
329         my $pt = shift;
330         my $cipher = shift;
331
332         die "ARCFOUR not available for hashes" if $opt{'R'};
333         my $hash = hex2bin($pt);
334         #bin2hex not needed as the '-hex' already converts it
335         return pipe_through_program($hash, "openssl dgst -$cipher -hex");
336 }
337
338 sub openssl_state_cipher($$$$$) {
339         my $cipher = shift;
340         my $encdec = shift;
341         my $bufsize = shift;
342         my $key = shift;
343         my $iv = shift;
344
345         my $enc = $encdec ? "-e": "-d";
346
347         # We only invoke the driver with the IV parameter, if we have
348         # an IV, otherwise, we skip it
349         $iv = "-iv ".bin2hex($iv) if ($iv);
350
351         my $out = "openssl enc -'$cipher' $enc -nopad -nosalt -bufsize $bufsize -K ".bin2hex($key)." $iv";
352         #for ARCFOUR, no IV must be given
353         $out = "rc4 -k " . bin2hex($key) if $opt{'R'};
354         return $out;
355 }
356
357 ###### End of OpenSSL interface implementation ############
358
359 ###########################################################
360 ###### libgcrypt implementation
361 ###########################################################
362 sub libgcrypt_encdec($$$$$) {
363         my $key=shift;
364         my $iv=shift;
365         my $cipher=shift;
366         my $enc = (shift) ? "encrypt" : "decrypt";
367         my $data=shift;
368
369         # We only invoke the driver with the IV parameter, if we have
370         # an IV, otherwise, we skip it
371         $iv = "--iv $iv" if ($iv);
372
373         my $program="fipsdrv --key $key $iv --algo $cipher $enc";
374
375         return pipe_through_program($data,$program);
376
377 }
378
379 sub libgcrypt_rsa_derive($$$$$$$$) {
380         my $n   = shift;
381         my $e   = shift;
382         my $xp1 = shift;
383         my $xp2 = shift;
384         my $xp  = shift;
385         my $xq1 = shift;
386         my $xq2 = shift;
387         my $xq  = shift;
388         my $sexp;
389         my @tmp;
390
391         $n = sprintf ("%u", $n);
392         $e = sprintf ("%u", hex($e));
393         $sexp = "(genkey(rsa(nbits " . sprintf ("%u:%s", length($n), $n) . ")"
394                 . "(rsa-use-e " . sprintf ("%u:%s", length($e), $e) . ")"
395                 . "(derive-parms"
396                 . "(Xp1 #$xp1#)"
397                 . "(Xp2 #$xp2#)"
398                 . "(Xp  #$xp#)"
399                 . "(Xq1 #$xq1#)"
400                 . "(Xq2 #$xq2#)"
401                 . "(Xq  #$xq#))))\n";
402
403         return pipe_through_program($sexp, "fipsdrv rsa-derive");
404 }
405
406
407 sub libgcrypt_rsa_sign($$$) {
408         my $data = shift;
409         my $hashalgo = shift;
410         my $keyfile = shift;
411
412         die "ARCFOUR not available for RSA" if $opt{'R'};
413
414         return pipe_through_program($data,
415                 "fipsdrv --pkcs1 --algo $hashalgo --key $keyfile rsa-sign");
416 }
417
418 sub libgcrypt_rsa_verify($$$$) {
419         my $data = shift;
420         my $hashalgo = shift;
421         my $keyfile = shift;
422         my $sigfile = shift;
423
424         die "ARCFOUR not available for RSA" if $opt{'R'};
425         $data = pipe_through_program($data,
426                 "fipsdrv --pkcs1 --algo $hashalgo --key $keyfile --signature $sigfile rsa-verify");
427
428         # Parse through the output information
429         return ($data =~ /GOOD signature/);
430 }
431
432 sub libgcrypt_gen_rsakey($$) {
433         my $keylen = shift;
434         my $file = shift;
435
436         die "ARCFOUR not available for RSA" if $opt{'R'};
437         my @args = ("fipsdrv --keysize $keylen rsa-gen > $file");
438         system(@args) == 0
439                 or die "system @args failed: $?";
440         die "system @args failed: file $file not created" if (! -f $file);
441 }
442
443 sub libgcrypt_hash($$) {
444         my $pt = shift;
445         my $hashalgo = shift;
446
447         my $program = "fipsdrv --algo $hashalgo digest";
448         die "ARCFOUR not available for hashes" if $opt{'R'};
449
450         return pipe_through_program($pt, $program);
451 }
452
453 sub libgcrypt_state_cipher($$$$$) {
454         my $cipher = shift;
455         my $enc = (shift) ? "encrypt": "decrypt";
456         my $bufsize = shift;
457         my $key = shift;
458         my $iv = shift;
459
460         # We only invoke the driver with the IV parameter, if we have
461         # an IV, otherwise, we skip it
462         $iv = "--iv ".bin2hex($iv) if ($iv);
463
464         my $program="fipsdrv --binary --key ".bin2hex($key)." $iv --algo '$cipher' --chunk '$bufsize' $enc";
465
466         return $program;
467 }
468
469 sub libgcrypt_state_cipher_des($$$$$) {
470         my $cipher = shift;
471         my $enc = (shift) ? "encrypt": "decrypt";
472         my $bufsize = shift;
473         my $key = shift;
474         my $iv = shift;
475
476         # We only invoke the driver with the IV parameter, if we have
477         # an IV, otherwise, we skip it
478         $iv = "--iv ".bin2hex($iv) if ($iv);
479
480         my $program="fipsdrv --algo '$cipher' --mct-server $enc";
481
482         return $program;
483 }
484
485 sub libgcrypt_state_rng($$$) {
486         my $key = shift;
487         my $dt = shift;
488         my $v = shift;
489
490         return "fipsdrv --binary --loop --key $key --iv $v --dt $dt random";
491 }
492
493 sub libgcrypt_hmac($$$$) {
494         my $key = shift;
495         my $maclen = shift;
496         my $msg = shift;
497         my $hashtype = shift;
498
499         my $program = "fipsdrv --key $key --algo $hashtype hmac-sha";
500         return pipe_through_program($msg, $program);
501 }
502
503 sub libgcrypt_dsa_pqggen($) {
504         my $mod = shift;
505
506         my $program = "fipsdrv --keysize $mod dsa-pqg-gen";
507         return pipe_through_program("", $program);
508 }
509
510 sub libgcrypt_gen_dsakey($) {
511         my $file = shift;
512
513         my $program = "fipsdrv --keysize 1024 --key $file dsa-gen";
514         my $tmp;
515         my %ret;
516
517         die "ARCFOUR not available for DSA" if $opt{'R'};
518
519         $tmp = pipe_through_program("", $program);
520         die "dsa key gen failed: file $file not created" if (! -f $file);
521
522         @ret{'P', 'Q', 'G', 'Seed', 'c', 'H'} = split(/\n/, $tmp);
523         return %ret;
524 }
525
526 sub libgcrypt_dsa_genpubkey($$$$$) {
527         my $filename = shift;
528         my $p = shift;
529         my $q = shift;
530         my $g = shift;
531         my $y = shift;
532
533         my $sexp;
534
535         $sexp = "(public-key(dsa(p #$p#)(q #$q#)(g #$g#)(y #$y#)))";
536
537         open(FH, ">", $filename) or die;
538         print FH $sexp;
539         close FH;
540 }
541
542 sub libgcrypt_dsa_sign($$) {
543         my $data = shift;
544         my $keyfile = shift;
545         my $tmp;
546         my %ret;
547
548         die "ARCFOUR not available for DSA" if $opt{'R'};
549
550         $tmp = pipe_through_program($data, "fipsdrv --key $keyfile dsa-sign");
551         @ret{'Y', 'R', 'S'} = split(/\n/, $tmp);
552         return %ret;
553 }
554
555 sub libgcrypt_dsa_verify($$$$) {
556         my $data = shift;
557         my $keyfile = shift;
558         my $r = shift;
559         my $s = shift;
560
561         my $ret;
562
563         die "ARCFOUR not available for DSA" if $opt{'R'};
564
565         my $sigfile = "$keyfile.sig";
566         open(FH, ">$sigfile") or die "Cannot create file $sigfile: $?";
567         print FH "(sig-val(dsa(r #$r#)(s #$s#)))";
568         close FH;
569
570         $ret = pipe_through_program($data,
571                 "fipsdrv --key $keyfile --signature $sigfile dsa-verify");
572         unlink ($sigfile);
573         # Parse through the output information
574         return ($ret =~ /GOOD signature/);
575 }
576
577 ######### End of libgcrypt implementation ################
578
579 ################################################################
580 ###### Vendor1 interface functions
581 ################################################################
582
583 sub vendor1_encdec($$$$$) {
584         my $key=shift;
585         my $iv=shift;
586         my $cipher=shift;
587         my $enc = (shift) ? "encrypt" : "decrypt";
588         my $data=shift;
589
590         $data=hex2bin($data);
591         my $program = "./aes $enc $key";
592         $data=pipe_through_program($data,$program);
593         return bin2hex($data);
594 }
595
596 sub vendor1_state_cipher($$$$$) {
597         my $cipher = shift;
598         my $encdec = shift;
599         my $bufsize = shift;
600         my $key = shift;
601         my $iv = shift;
602
603         $key = bin2hex($key);
604         my $enc = $encdec ? "encrypt": "decrypt";
605         my $out = "./aes $enc $key $bufsize";
606         return $out;
607 }
608
609 ##### No other interface functions below this point ######
610 ##########################################################
611
612 ##########################################################
613 # General helper routines
614
615 # Executing a program by feeding STDIN and retrieving
616 # STDOUT
617 # $1: data string to be piped to the app on STDIN
618 # rest: program and args
619 # returns: STDOUT of program as string
620 sub pipe_through_program($@) {
621         my $in = shift;
622         my @args = @_;
623
624         my ($CO, $CI);
625         my $pid = open2($CO, $CI, @args);
626
627         my $out = "";
628         my $len = length($in);
629         my $first = 1;
630         while (1) {
631                 my $rin = "";
632                 my $win = "";
633                 # Output of prog is FD that we read
634                 vec($rin,fileno($CO),1) = 1;
635                 # Input of prog is FD that we write
636                 # check for $first is needed because we can have NULL input
637                 # that is to be written to the app
638                 if ( $len > 0 || $first) {
639                         (vec($win,fileno($CI),1) = 1);
640                         $first=0;
641                 }
642                 # Let us wait for 100ms
643                 my $nfound = select(my $rout=$rin, my $wout=$win, undef, 0.1);
644                 if ( $wout ) {
645                         my $written = syswrite($CI, $in, $len);
646                         die "broken pipe" if !defined $written;
647                         $len -= $written;
648                         substr($in, 0, $written) = "";
649                         if ($len <= 0) {
650                                 close $CI or die "broken pipe: $!";
651                         }
652                 }
653                 if ( $rout ) {
654                         my $tmp_out = "";
655                         my $bytes_read = sysread($CO, $tmp_out, 4096);
656                         $out .= $tmp_out;
657                         last if ($bytes_read == 0);
658                 }
659         }
660         close $CO or die "broken pipe: $!";
661         waitpid $pid, 0;
662
663         return $out;
664 }
665
666 #
667 # convert ASCII hex to binary input
668 # $1 ASCII hex
669 # return binary representation
670 sub hex2bin($) {
671         my $in = shift;
672         my $len = length($in);
673         $len = 0 if ($in eq "00");
674         return pack("H$len", "$in");
675 }
676
677 #
678 # convert binary input to ASCII hex
679 # $1 binary value
680 # return ASCII hex representation
681 sub bin2hex($) {
682         my $in = shift;
683         my $len = length($in)*2;
684         return unpack("H$len", "$in");
685 }
686
687 # $1: binary byte (character)
688 # returns: binary byte with odd parity using low bit as parity bit
689 sub odd_par($) {
690         my $in = ord(shift);
691         my $odd_count=0;
692         for(my $i=1; $i<8; $i++) {
693                 $odd_count++ if ($in & (1<<$i));
694         }
695
696         my $out = $in;
697         if ($odd_count & 1) { # check if parity is already odd
698                 $out &= ~1; # clear the low bit
699         } else {
700                 $out |= 1; # set the low bit
701         }
702
703         return chr($out);
704 }
705
706 # DES keys uses only the 7 high bits of a byte, the 8th low bit
707 # is the parity bit
708 # as the new key is calculated from oldkey XOR cipher in the MCT test,
709 # the parity is not really checked and needs to be set to match
710 # expectation (OpenSSL does not really care, but the FIPS
711 # test result is expected that the key has the appropriate parity)
712 # $1: arbitrary binary string
713 # returns: string with odd parity set in low bit of each byte
714 sub fix_key_parity($) {
715         my $in = shift;
716         my $out = "";
717         for (my $i = 0; $i < length($in); $i++) {
718                 $out .= odd_par(substr($in, $i, 1));
719         }
720
721         return $out;
722 }
723
724 ####################################################
725 # DER/PEM utility functions
726 # Cf. http://www.columbia.edu/~ariel/ssleay/layman.html
727
728 # Convert unsigned integer to base256 bigint bytes
729 # $1 integer
730 # returns base256 octet string
731 sub int_base256_unsigned($) {
732         my $n = shift;
733
734         my $out = chr($n & 255);
735         while ($n>>=8) {
736                 $out = chr($n & 255) . $out;
737         }
738
739         return $out;
740 }
741
742 # Convert signed integer to base256 bigint bytes
743 # $1 integer
744 # returns base256 octet string
745 sub int_base256_signed($) {
746         my $n = shift;
747         my $negative = ($n < 0);
748
749         if ($negative) {
750                 $n = -$n-1;
751         }
752
753         my $out = int_base256_unsigned($n);
754
755         if (ord(substr($out, 0, 1)) & 128) {
756                 # it's supposed to be positive but has sign bit set,
757                 # add a leading zero
758                 $out = chr(0) . $out;
759         }
760
761         if ($negative) {
762                 my $neg = chr(255) x length($out);
763                 $out ^= $neg;
764         }
765
766         return $out;
767 }
768
769 # Length header for specified DER object length
770 # $1 length as integer
771 # return octet encoding for length
772 sub der_len($) {
773         my $len = shift;
774
775         if ($len <= 127) {
776                 return chr($len);
777         } else {
778                 my $blen = int_base256_unsigned($len);
779
780                 return chr(128 | length($blen)) . $blen;
781         }
782 }
783
784 # Prepend length header to object
785 # $1 object as octet sequence
786 # return length header for object followed by object as octets
787 sub der_len_obj($) {
788         my $x = shift;
789
790         return der_len(length($x)) . $x;
791 }
792
793 # DER sequence
794 # $* objects
795 # returns DER sequence consisting of the objects passed as arguments
796 sub der_seq {
797         my $seq = join("", @_);
798         return chr(0x30) . der_len_obj($seq);
799 }
800
801 # DER bitstring
802 # $1 input octets (must be full octets, fractional octets not supported)
803 # returns input encapsulated as bitstring
804 sub der_bitstring($) {
805         my $x = shift;
806
807         $x = chr(0) . $x;
808
809         return chr(0x03) . der_len_obj($x);
810 }
811
812 # base-128-encoded integer, used for object numbers.
813 # $1 integer
814 # returns octet sequence
815 sub der_base128($) {
816         my $n = shift;
817
818         my $out = chr($n & 127);
819
820         while ($n>>=7) {
821                 $out = chr(128 | ($n & 127)) . $out;
822         }
823
824         return $out;
825 }
826
827 # Generating the PEM certificate string
828 # (base-64-encoded DER string)
829 # $1 DER string
830 # returns octet sequence
831 sub pem_cert($) {
832         my $n = shift;
833
834         my $out = "-----BEGIN PUBLIC KEY-----\n";
835         $out .= encode_base64($n);
836         $out .= "-----END PUBLIC KEY-----\n";
837
838         return $out;
839 }
840
841 # DER object identifier
842 # $* sequence of id numbers
843 # returns octets
844 sub der_objectid {
845         my $v1 = shift;
846         my $v2 = shift;
847
848         my $out = chr(40*$v1 + $v2) . join("", map { der_base128($_) } @_);
849
850         return chr(0x06) . der_len_obj($out);
851 }
852
853 # DER signed integer
854 # $1 number as octet string (base 256 representation, high byte first)
855 # returns number in DER integer encoding
856 sub der_bigint($) {
857         my $x = shift;
858
859         return chr(0x02) . der_len_obj($x);
860 }
861
862 # DER positive integer with leading zeroes stripped
863 # $1 number as octet string (base 256 representation, high byte first)
864 # returns number in DER integer encoding
865 sub der_pos_bigint($) {
866         my $x = shift;
867
868         # strip leading zero digits
869         $x =~ s/^[\0]+//;
870
871         # need to prepend a zero if high bit set, since it would otherwise be
872         # interpreted as a negative number. Also needed for number 0.
873         if (!length($x) || ord(substr($x, 0, 1)) >= 128) {
874                 $x = chr(0) . $x;
875         }
876
877         return der_bigint($x);
878 }
879
880 # $1 number as signed integer
881 # returns number as signed DER integer encoding
882 sub der_int($) {
883         my $n = shift;
884
885         return der_bigint(int_base256_signed($n));
886 }
887
888 # the NULL object constant
889 sub der_null() {
890         return chr(0x05) . chr(0x00);
891 }
892
893 # Unit test helper
894 # $1 calculated result
895 # $2 expected result
896 # no return value, dies if results differ, showing caller's line number
897 sub der_test($$) {
898         my $actual = bin2hex(shift);
899         my $expected = shift;
900
901         my @caller = caller;
902         $actual eq $expected or die "Error:line $caller[2]:assertion failed: "
903                 ."$actual != $expected\n";
904 }
905
906 # Unit testing for the DER encoding functions
907 # Examples from http://www.columbia.edu/~ariel/ssleay/layman.html
908 # No input, no output. Dies if unit tests fail.
909 sub der_unit_test {
910         ## uncomment these if you want to test the test framework
911         #print STDERR "Unit test running\n";
912         #der_test chr(0), "42";
913
914         der_test der_null, "0500";
915
916         # length bytes
917         der_test der_len(1), "01";
918         der_test der_len(127), "7f";
919         der_test der_len(128), "8180";
920         der_test der_len(256), "820100";
921         der_test der_len(65536), "83010000";
922
923         # bigint
924         der_test der_bigint(chr(0)), "020100";
925         der_test der_bigint(chr(128)), "020180"; # -128
926         der_test der_pos_bigint(chr(128)), "02020080"; # +128
927         der_test der_pos_bigint(chr(0).chr(0).chr(1)), "020101";
928         der_test der_pos_bigint(chr(0)), "020100";
929
930         # integers (tests base256 conversion)
931         der_test der_int(     0), "020100";
932         der_test der_int(   127), "02017f";
933         der_test der_int(   128), "02020080";
934         der_test der_int(   256), "02020100";
935         der_test der_int(    -1), "0201ff";
936         der_test der_int(  -128), "020180";
937         der_test der_int(  -129), "0202ff7f";
938         der_test der_int(-65536), "0203ff0000";
939         der_test der_int(-65537), "0203feffff";
940
941         # object encoding, "RSA Security"
942         der_test der_base128(840), "8648";
943         der_test der_objectid(1, 2, 840, 113549), "06062a864886f70d";
944
945         # Combinations
946         der_test der_bitstring("ABCD"), "03050041424344";
947         der_test der_bitstring(der_null), "0303000500";
948         der_test der_seq(der_int(0), der_null), "30050201000500";
949
950         # The big picture
951         der_test der_seq(der_seq(der_objectid(1, 2, 840, 113549), der_null),
952                          der_bitstring(der_seq(der_pos_bigint(chr(5)),
953                                                der_pos_bigint(chr(3))))),
954                  "3017300a06062a864886f70d05000309003006020105020103";
955 }
956
957 ####################################################
958 # OpenSSL missing functionality workarounds
959
960 ## Format of an RSA public key:
961 #    0:d=0  hl=3 l= 159 cons: SEQUENCE
962 #    3:d=1  hl=2 l=  13 cons:  SEQUENCE
963 #    5:d=2  hl=2 l=   9 prim:   OBJECT            :rsaEncryption
964 #   16:d=2  hl=2 l=   0 prim:   NULL
965 #   18:d=1  hl=3 l= 141 prim:  BIT STRING
966 #                              [ sequence: INTEGER (n), INTEGER (e) ]
967
968 # generate RSA pub key in PEM format
969 # $1: filename where PEM key is to be stored
970 # $2: n of the RSA key in hex
971 # $3: e of the RSA key in hex
972 # return: nothing, but file created
973 sub gen_pubrsakey($$$) {
974         my $filename=shift;
975         my $n = shift;
976         my $e = shift;
977
978         # make sure the DER encoder works ;-)
979         der_unit_test();
980
981         # generate DER encoding of the public key
982
983         my $rsaEncryption = der_objectid(1, 2, 840, 113549, 1, 1, 1);
984
985         my $der = der_seq(der_seq($rsaEncryption, der_null),
986                           der_bitstring(der_seq(der_pos_bigint(hex2bin($n)),
987                                                 der_pos_bigint(hex2bin($e)))));
988
989         open(FH, ">", $filename) or die;
990         print FH pem_cert($der);
991         close FH;
992
993 }
994
995 # generate RSA pub key in PEM format
996 #
997 # This implementation uses "openssl asn1parse -genconf" which was added
998 # in openssl 0.9.8. It is not available in older openssl versions.
999 #
1000 # $1: filename where PEM key is to be stored
1001 # $2: n of the RSA key in hex
1002 # $3: e of the RSA key in hex
1003 # return: nothing, but file created
1004 sub gen_pubrsakey_using_openssl($$$) {
1005         my $filename=shift;
1006         my $n = shift;
1007         my $e = shift;
1008
1009         my $asn1 = "asn1=SEQUENCE:pubkeyinfo
1010
1011 [pubkeyinfo]
1012 algorithm=SEQUENCE:rsa_alg
1013 pubkey=BITWRAP,SEQUENCE:rsapubkey
1014
1015 [rsa_alg]
1016 algorithm=OID:rsaEncryption
1017 parameter=NULL
1018
1019 [rsapubkey]
1020 n=INTEGER:0x$n
1021
1022 e=INTEGER:0x$e";
1023
1024         open(FH, ">$filename.cnf") or die "Cannot create file $filename.cnf: $?";
1025         print FH $asn1;
1026         close FH;
1027         my @args = ("openssl", "asn1parse", "-genconf", "$filename.cnf", "-noout", "-out", "$filename.der");
1028         system(@args) == 0 or die "system @args failed: $?";
1029         @args = ("openssl", "rsa", "-inform", "DER", "-in", "$filename.der",
1030                  "-outform", "PEM", "-pubin", "-pubout", "-out", "$filename");
1031         system(@args) == 0 or die "system @args failed: $?";
1032         die "RSA PEM formatted key file $filename was not created"
1033                 if (! -f $filename);
1034
1035         unlink("$filename.cnf");
1036         unlink("$filename.der");
1037 }
1038
1039 ############################################
1040 # Test cases
1041
1042 # This is the Known Answer Test
1043 # $1: the string that we have to put in front of the key
1044 #     when printing the key
1045 # $2: crypto key1 in hex form
1046 # $3: crypto key2 in hex form (TDES, undef otherwise)
1047 # $4: crypto key3 in hex form (TDES, undef otherwise)
1048 # $5: IV in hex form
1049 # $6: Plaintext (enc=1) or Ciphertext (enc=0) in hex form
1050 # $7: cipher
1051 # $8: encrypt=1/decrypt=0
1052 # return: string formatted as expected by CAVS
1053 sub kat($$$$$$$$) {
1054         my $keytype = shift;
1055         my $key1 = shift;
1056         my $key2 = shift;
1057         my $key3 = shift;
1058         my $iv = shift;
1059         my $pt = shift;
1060         my $cipher = shift;
1061         my $enc = shift;
1062
1063         my $out = "";
1064
1065         $out .= "$keytype = $key1\n";
1066
1067         # this is the concardination of the keys for 3DES
1068         if (defined($key2)) {
1069                 $out .= "KEY2 = $key2\n";
1070                 $key1 = $key1 . $key2;
1071         }
1072         if (defined($key3)) {
1073                 $out .= "KEY3 = $key3\n";
1074                 $key1= $key1 . $key3;
1075         }
1076
1077         $out .= "IV = $iv\n" if (defined($iv) && $iv ne "");
1078         if ($enc) {
1079                 $out .= "PLAINTEXT = $pt\n";
1080                 $out .= "CIPHERTEXT = " . &$encdec($key1, $iv, $cipher, 1, $pt) . "\n";
1081         } else {
1082                 $out .= "CIPHERTEXT = $pt\n";
1083                 $out .= "PLAINTEXT = " . &$encdec($key1, $iv, $cipher, 0, $pt) . "\n";
1084         }
1085
1086         return $out;
1087 }
1088
1089 # This is the Known Answer Test for Hashes
1090 # $1: Plaintext in hex form
1091 # $2: hash
1092 # $3: hash length (undef if not applicable)
1093 # return: string formatted as expected by CAVS
1094 sub hash_kat($$$) {
1095         my $pt = shift;
1096         my $cipher = shift;
1097         my $len = shift;
1098
1099         my $out = "";
1100         $out .= "Len = $len\n" if (defined($len));
1101         $out .= "Msg = $pt\n";
1102
1103         $pt = "" if(!$len);
1104         $out .= "MD = " . &$hash($pt, $cipher) . "\n";
1105         return $out;
1106 }
1107
1108 # Known Answer Test for HMAC hash
1109 # $1: key length in bytes
1110 # $2: MAC length in bytes
1111 # $3: key for HMAC in hex form
1112 # $4: message to be hashed
1113 # return: string formatted as expected by CAVS
1114 sub hmac_kat($$$$) {
1115         my $klen = shift;
1116         my $tlen = shift;
1117         my $key  = shift;
1118         my $msg  = shift;
1119
1120         # XXX this is a hack - we need to decipher the HMAC REQ files in a more
1121         # sane way
1122         #
1123         # This is a conversion table from the expected hash output size
1124         # to the assumed hash type - we only define here the block size of
1125         # the underlying hashes and do not allow any truncation
1126         my %hashtype = (
1127                 20 => 1,
1128                 28 => 224,
1129                 32 => 256,
1130                 48 => 384,
1131                 64 => 512
1132         );
1133
1134         die "Hash output size $tlen is not supported!"
1135                 if(!defined($hashtype{$tlen}));
1136
1137         my $out = "";
1138         $out .= "Klen = $klen\n";
1139         $out .= "Tlen = $tlen\n";
1140         $out .= "Key = $key\n";
1141         $out .= "Msg = $msg\n";
1142         $out .= "Mac = " . &$hmac($key, $tlen, $msg, $hashtype{$tlen}) . "\n";
1143
1144         return $out;
1145 }
1146
1147
1148 # Cipher Monte Carlo Testing
1149 # $1: the string that we have to put in front of the key
1150 #     when printing the key
1151 # $2: crypto key1 in hex form
1152 # $3: crypto key2 in hex form (TDES, undef otherwise)
1153 # $4: crypto key3 in hex form (TDES, undef otherwise)
1154 # $5: IV in hex form
1155 # $6: Plaintext (enc=1) or Ciphertext (enc=0) in hex form
1156 # $7: cipher
1157 # $8: encrypt=1/decrypt=0
1158 # return: string formatted as expected by CAVS
1159 sub crypto_mct($$$$$$$$) {
1160         my $keytype = shift;
1161         my $key1 = hex2bin(shift);
1162         my $key2 = shift;
1163         my $key3 = shift;
1164         my $iv = hex2bin(shift);
1165         my $source_data = hex2bin(shift);
1166         my $cipher = shift;
1167         my $enc = shift;
1168
1169         my $out = "";
1170
1171         $key2 = hex2bin($key2) if (defined($key2));
1172         $key3 = hex2bin($key3) if (defined($key3));
1173         my $bufsize = length($source_data);
1174
1175         # for AES: outer loop 0-99, inner 0-999 based on FIPS compliance tests
1176         # for RC4: outer loop 0-99, inner 0-999 based on atsec compliance tests
1177         # for DES: outer loop 0-399, inner 0-9999 based on FIPS compliance tests
1178         my $ciph = substr($cipher,0,3);
1179         my $oloop=100;
1180         my $iloop=1000;
1181         if ($ciph =~ /des/) {$oloop=400;$iloop=10000;}
1182
1183         for (my $i=0; $i<$oloop; ++$i) {
1184                 $out .= "COUNT = $i\n";
1185                 if (defined($key2)) {
1186                         $out .= "$keytype = ". bin2hex($key1). "\n";
1187                         $out .= "KEY2 = ". bin2hex($key2). "\n";
1188                         $key1 = $key1 . $key2;
1189                 } else {
1190                         $out .= "$keytype = ". bin2hex($key1). "\n";
1191                 }
1192                 if(defined($key3)) {
1193                         $out .= "KEY3 = ". bin2hex($key3). "\n";
1194                         $key1 = $key1 . $key3;
1195                 }
1196                 my $keylen = length($key1);
1197
1198                 $out .= "IV = ". bin2hex($iv) . "\n"
1199                         if (defined($iv) && $iv ne "");
1200
1201                 if ($enc) {
1202                         $out .= "PLAINTEXT = ". bin2hex($source_data). "\n";
1203                 } else {
1204                         $out .= "CIPHERTEXT = ". bin2hex($source_data). "\n";
1205                 }
1206                 my ($CO, $CI);
1207                 my $cipher_imp = &$state_cipher($cipher, $enc, $bufsize, $key1, $iv);
1208                 $cipher_imp = &$state_cipher_des($cipher, $enc, $bufsize, $key1, $iv) if($cipher =~ /des/);
1209                 my $pid = open2($CO, $CI, $cipher_imp);
1210
1211                 my $calc_data = $iv; # CT[j]
1212                 my $old_calc_data; # CT[j-1]
1213                 my $old_old_calc_data; # CT[j-2]
1214                 my $next_source;
1215
1216                 # TDES inner loop implements logic within driver
1217                 if ($cipher =~ /des/) {
1218                         # Need to provide a dummy IV in case of ECB mode.
1219                         my $iv_arg = (defined($iv) && $iv ne "")
1220                                         ? bin2hex($iv)
1221                                         : "00"x(length($source_data));
1222                         print $CI "1\n"
1223                                   .$iloop."\n"
1224                                   .bin2hex($key1)."\n"
1225                                   .$iv_arg."\n"
1226                                   .bin2hex($source_data)."\n\n" or die;
1227                         chomp(my $line = <$CO>);
1228                         $calc_data = hex2bin($line);
1229                         chomp($line = <$CO>);
1230                         $old_calc_data = hex2bin($line);
1231                         chomp($line = <$CO>);
1232                         $old_old_calc_data = hex2bin($line);
1233                         chomp($line = <$CO>);
1234                         $iv = hex2bin($line) if (defined($iv) && $iv ne "");
1235                         chomp($line = <$CO>);
1236                         $next_source = hex2bin($line);
1237                         # Skip over empty line.
1238                         $line = <$CO>;
1239                 } else {
1240                         for (my $j = 0; $j < $iloop; ++$j) {
1241                                 $old_old_calc_data = $old_calc_data;
1242                                 $old_calc_data = $calc_data;
1243
1244                                 #print STDERR "source_data=", bin2hex($source_data), "\n";
1245                                 syswrite $CI, $source_data or die $!;
1246                                 my $len = sysread $CO, $calc_data, $bufsize;
1247
1248                                 #print STDERR "len=$len, bufsize=$bufsize\n";
1249                                 die if $len ne $bufsize;
1250                                 #print STDERR "calc_data=", bin2hex($calc_data), "\n";
1251
1252                                 if ( (!$enc && $ciph =~ /des/) ||
1253                                      $ciph =~ /rc4/ ||
1254                                      $cipher =~ /ecb/ ) {
1255                                         #TDES in decryption mode, RC4 and ECB mode
1256                                         #have a special rule
1257                                         $source_data = $calc_data;
1258                                 } else {
1259                                         $source_data = $old_calc_data;
1260                                 }
1261                         }
1262                 }
1263                 close $CO;
1264                 close $CI;
1265                 waitpid $pid, 0;
1266
1267                 if ($enc) {
1268                         $out .= "CIPHERTEXT = ". bin2hex($calc_data). "\n\n";
1269                 } else {
1270                         $out .= "PLAINTEXT = ". bin2hex($calc_data). "\n\n";
1271                 }
1272
1273                 if ( $ciph =~ /aes/ ) {
1274                         $key1 ^= substr($old_calc_data . $calc_data, -$keylen);
1275                         #print STDERR bin2hex($key1)."\n";
1276                 } elsif ( $ciph =~ /des/ ) {
1277                         die "Wrong keylen $keylen" if ($keylen != 24);
1278
1279                         # $nkey needed as $key holds the concatenation of the
1280                         # old key atm
1281                         my $nkey = fix_key_parity(substr($key1,0,8) ^ $calc_data);
1282                         #print STDERR "KEY1 = ". bin2hex($nkey)."\n";
1283                         if (substr($key1,0,8) ne substr($key1,8,8)) {
1284                                 #print STDERR "KEY2 recalc: KEY1==KEY3, KEY2 indep. or all KEYs are indep.\n";
1285                                 $key2 = fix_key_parity((substr($key1,8,8) ^ $old_calc_data));
1286                         } else {
1287                                 #print STDERR "KEY2 recalc: KEY1==KEY2==KEY3\n";
1288                                 $key2 = fix_key_parity((substr($key1,8,8) ^ $calc_data));
1289                         }
1290                         #print STDERR "KEY2 = ". bin2hex($key2)."\n";
1291                         if ( substr($key1,0,8) eq substr($key1,16)) {
1292                                 #print STDERR "KEY3 recalc: KEY1==KEY2==KEY3 or KEY1==KEY3, KEY2 indep.\n";
1293                                 $key3 = fix_key_parity((substr($key1,16) ^ $calc_data));
1294                         } else {
1295                                 #print STDERR "KEY3 recalc: all KEYs are independent\n";
1296                                 $key3 = fix_key_parity((substr($key1,16) ^ $old_old_calc_data));
1297                         }
1298                         #print STDERR "KEY3 = ". bin2hex($key3)."\n";
1299
1300                         # reset the first key - concardination happens at
1301                         # beginning of loop
1302                         $key1=$nkey;
1303                 } elsif ($ciph =~ /rc4/ ) {
1304                         $key1 ^= substr($calc_data, 0, 16);
1305                         #print STDERR bin2hex($key1)."\n";
1306                 } else {
1307                         die "Test limitation: cipher '$cipher' not supported in Monte Carlo testing";
1308                 }
1309
1310                 if ($cipher =~ /des-ede3-ofb/) {
1311                         $source_data = $source_data ^ $next_source;
1312                 } elsif (!$enc && $cipher =~ /des-ede3-cfb/) {
1313                         #TDES decryption CFB has a special rule
1314                         $source_data = $next_source;
1315                 } elsif ( $ciph =~ /rc4/ || $cipher eq "des-ede3" || $cipher =~ /ecb/) {
1316                         #No resetting of IV as the IV is all zero set initially (i.e. no IV)
1317                         $source_data = $calc_data;
1318                 } elsif (! $enc && $ciph =~ /des/ ) {
1319                         #TDES in decryption mode has a special rule
1320                         $iv = $old_calc_data;
1321                         $source_data = $calc_data;
1322                 } else {
1323                         $iv = $calc_data;
1324                         $source_data = $old_calc_data;
1325                 }
1326         }
1327
1328         return $out;
1329 }
1330
1331 # Hash Monte Carlo Testing
1332 # $1: Plaintext in hex form
1333 # $2: hash
1334 # return: string formatted as expected by CAVS
1335 sub hash_mct($$) {
1336         my $pt = shift;
1337         my $cipher = shift;
1338
1339         my $out = "";
1340
1341         $out .= "Seed = $pt\n\n";
1342
1343         for (my $j=0; $j<100; ++$j) {
1344                 $out .= "COUNT = $j\n";
1345                 my $md0=$pt;
1346                 my $md1=$pt;
1347                 my $md2=$pt;
1348                 for (my $i=0; $i<1000; ++$i) {
1349                         #print STDERR "outer loop $j; inner loop $i\n";
1350                         my $mi= $md0 . $md1 . $md2;
1351                         $md0=$md1;
1352                         $md1=$md2;
1353                         $md2 = &$hash($mi, $cipher);
1354                         $md2 =~ s/\n//;
1355                 }
1356                 $out .= "MD = $md2\n\n";
1357                 $pt=$md2;
1358         }
1359
1360         return $out;
1361 }
1362
1363 # RSA SigGen test
1364 # $1: Message to be signed in hex form
1365 # $2: Hash algorithm
1366 # $3: file name with RSA key in PEM form
1367 # return: string formatted as expected by CAVS
1368 sub rsa_siggen($$$) {
1369         my $data = shift;
1370         my $cipher = shift;
1371         my $keyfile = shift;
1372
1373         my $out = "";
1374
1375         $out .= "SHAAlg = $cipher\n";
1376         $out .= "Msg = $data\n";
1377         $out .= "S = " . &$rsa_sign($data, lc($cipher), $keyfile) . "\n";
1378
1379         return $out;
1380 }
1381
1382 # RSA SigVer test
1383 # $1: Message to be verified in hex form
1384 # $2: Hash algorithm
1385 # $3: Signature of message in hex form
1386 # $4: n of the RSA key in hex in hex form
1387 # $5: e of the RSA key in hex in hex form
1388 # return: string formatted as expected by CAVS
1389 sub rsa_sigver($$$$$) {
1390         my $data = shift;
1391         my $cipher = shift;
1392         my $signature = shift;
1393         my $n = shift;
1394         my $e = shift;
1395
1396         my $out = "";
1397
1398         $out .= "SHAAlg = $cipher\n";
1399         $out .= "e = $e\n";
1400         $out .= "Msg = $data\n";
1401         $out .= "S = $signature\n";
1402
1403         # XXX maybe a secure temp file name is better here
1404         # but since it is not run on a security sensitive
1405         # system, I hope that this is fine
1406         my $keyfile = "rsa_sigver.tmp.$$";
1407         gen_pubrsakey($keyfile, $n, $e);
1408
1409         my $sigfile = "$keyfile.sig";
1410         open(FH, ">$sigfile") or die "Cannot create file $sigfile: $?";
1411         print FH hex2bin($signature);
1412         close FH;
1413
1414         $out .= "Result = " . (&$rsa_verify($data, lc($cipher), $keyfile, $sigfile) ? "P\n" : "F\n");
1415
1416         unlink($keyfile);
1417         unlink($sigfile);
1418
1419         return $out;
1420 }
1421
1422 # RSA X9.31 key generation test
1423 # $1 modulus size
1424 # $2 e
1425 # $3 xp1
1426 # $4 xp2
1427 # $5 Xp
1428 # $6 xq1
1429 # $7 xq2
1430 # $8 Xq
1431 # return: string formatted as expected by CAVS
1432 sub rsa_keygen($$$$$$$$) {
1433         my $modulus = shift;
1434         my $e = shift;
1435         my $xp1 = shift;
1436         my $xp2 = shift;
1437         my $Xp = shift;
1438         my $xq1 = shift;
1439         my $xq2 = shift;
1440         my $Xq = shift;
1441
1442         my $out = "";
1443
1444         my $ret = &$rsa_derive($modulus, $e, $xp1, $xp2, $Xp, $xq1, $xq2, $Xq);
1445
1446         my ($P, $Q, $N, $D) = split(/\n/, $ret);
1447
1448         $out .= "e = $e\n";
1449         $out .= "xp1 = $xp1\n";
1450         $out .= "xp2 = $xp2\n";
1451         $out .= "Xp = $Xp\n";
1452         $out .= "p = $P\n";
1453         $out .= "xq1 = $xq1\n";
1454         $out .= "xq2 = $xq2\n";
1455         $out .= "Xq = $Xq\n";
1456         $out .= "q = $Q\n";
1457         $out .= "n = $N\n";
1458         $out .= "d = $D\n\n";
1459
1460         return $out;
1461
1462 }
1463
1464 # X9.31 RNG test
1465 # $1 key for the AES cipher
1466 # $2 DT value
1467 # $3 V value
1468 # $4 type ("VST", "MCT")
1469 # return: string formatted as expected by CAVS
1470 sub rngx931($$$$) {
1471         my $key=shift;
1472         my $dt=shift;
1473         my $v=shift;
1474         my $type=shift;
1475
1476         my $out = "Key = $key\n";
1477         $out   .= "DT = $dt\n";
1478         $out   .= "V = $v\n";
1479
1480         my $count = 1;
1481         $count = 10000 if ($type eq "MCT");
1482
1483         my $rnd_val = "";
1484
1485         # we read 16 bytes from RNG
1486         my $bufsize = 16;
1487
1488         my ($CO, $CI);
1489         my $rng_imp = &$state_rng($key, $dt, $v);
1490         my $pid = open2($CO, $CI, $rng_imp);
1491         for (my $i = 0; $i < $count; ++$i) {
1492                 my $len = sysread $CO, $rnd_val, $bufsize;
1493                 #print STDERR "len=$len, bufsize=$bufsize\n";
1494                 die "len=$len != bufsize=$bufsize" if $len ne $bufsize;
1495                 #print STDERR "calc_data=", bin2hex($rnd_val), "\n";
1496         }
1497         close $CO;
1498         close $CI;
1499         waitpid $pid, 0;
1500
1501         $out .= "R = " . bin2hex($rnd_val) . "\n\n";
1502
1503         return $out;
1504 }
1505
1506 # DSA PQGGen test
1507 # $1 modulus size
1508 # $2 number of rounds to perform the test
1509 # return: string formatted as expected by CAVS
1510 sub dsa_pqggen_driver($$) {
1511         my $mod = shift;
1512         my $rounds = shift;
1513
1514         my $out = "";
1515         for(my $i=0; $i<$rounds; $i++) {
1516                 my $ret = &$dsa_pqggen($mod);
1517                 my ($P, $Q, $G, $Seed, $c, $H) = split(/\n/, $ret);
1518                 die "Return value does not contain all expected values of P, Q, G, Seed, c, H for dsa_pqggen"
1519                         if (!defined($P) || !defined($Q) || !defined($G) ||
1520                             !defined($Seed) || !defined($c) || !defined($H));
1521
1522                 # now change the counter to decimal as CAVS wants decimal
1523                 # counter value although all other is HEX
1524                 $c = hex($c);
1525
1526                 $out .= "P = $P\n";
1527                 $out .= "Q = $Q\n";
1528                 $out .= "G = $G\n";
1529                 $out .= "Seed = $Seed\n";
1530                 $out .= "c = $c\n";
1531                 $out .= "H = $H\n\n";
1532         }
1533
1534         return $out;
1535 }
1536
1537
1538 # DSA SigGen test
1539 # $1: Message to be signed in hex form
1540 # $2: file name with DSA key in PEM form
1541 # return: string formatted as expected by CAVS
1542 sub dsa_siggen($$) {
1543         my $data = shift;
1544         my $keyfile = shift;
1545
1546         my $out = "";
1547
1548         my %ret = &$dsa_sign($data, $keyfile);
1549
1550         $out .= "Msg = $data\n";
1551         $out .= "Y = " . $ret{'Y'} . "\n";
1552         $out .= "R = " . $ret{'R'} . "\n";
1553         $out .= "S = " . $ret{'S'} . "\n";
1554
1555         return $out;
1556 }
1557
1558
1559 # DSA signature verification
1560 # $1 modulus
1561 # $2 P
1562 # $3 Q
1563 # $4 G
1564 # $5 Y - public key
1565 # $6 r
1566 # $7 s
1567 # $8 message to be verified
1568 # return: string formatted as expected by CAVS
1569 sub dsa_sigver($$$$$$$$) {
1570         my $modulus = shift;
1571         my $p = shift;
1572         my $q = shift;
1573         my $g = shift;
1574         my $y = shift;
1575         my $r = shift;
1576         my $s = shift;
1577         my $msg = shift;
1578
1579         my $out = "";
1580
1581         #PQG are already printed - do not print them here
1582
1583         $out .= "Msg = $msg\n";
1584         $out .= "Y = $y\n";
1585         $out .= "R = $r\n";
1586         $out .= "S = $s\n";
1587
1588         # XXX maybe a secure temp file name is better here
1589         # but since it is not run on a security sensitive
1590         # system, I hope that this is fine
1591         my $keyfile = "dsa_sigver.tmp.$$";
1592         &$dsa_genpubkey($keyfile, $p, $q, $g, $y);
1593
1594         $out .= "Result = " . (&$dsa_verify($msg, $keyfile, $r, $s) ? "P\n" : "F\n");
1595
1596         unlink($keyfile);
1597
1598         return $out;
1599 }
1600
1601 ##############################################################
1602 # Parser of input file and generator of result file
1603 #
1604
1605 sub usage() {
1606
1607         print STDERR "Usage:
1608 $0 [-R] [-D] [-I name] <CAVS-test vector file>
1609
1610 -R      execution of ARCFOUR instead of OpenSSL
1611 -I NAME Use interface style NAME:
1612                 openssl     OpenSSL (default)
1613                 libgcrypt   Libgcrypt
1614 -D      SigGen and SigVer are executed with DSA
1615         Please note that the DSA CAVS vectors do not allow distinguishing
1616         them from the RSA vectors. As the RSA test is the default, you have
1617         to supply this option to apply the DSA logic";
1618 }
1619
1620 # Parser of CAVS test vector file
1621 # $1: Test vector file
1622 # $2: Output file for test results
1623 # return: nothing
1624 sub parse($$) {
1625         my $infile = shift;
1626         my $outfile = shift;
1627
1628         my $out = "";
1629
1630         # this is my cipher/hash type
1631         my $cipher = "";
1632
1633         # Test type
1634         # 1 - cipher known answer test
1635         # 2 - cipher Monte Carlo test
1636         # 3 - hash known answer test
1637         # 4 - hash Monte Carlo test
1638         # 5 - RSA signature generation
1639         # 6 - RSA signature verification
1640         my $tt = 0;
1641
1642         # Variables for tests
1643         my $keytype = ""; # we can have "KEY", "KEYs", "KEY1"
1644         my $key1 = "";
1645         my $key2 = undef; #undef needed for allowing
1646         my $key3 = undef; #the use of them as input variables
1647         my $pt = "";
1648         my $enc = 1;
1649         my $iv = "";
1650         my $len = undef; #see key2|3
1651         my $n = "";
1652         my $e = "";
1653         my $signature = "";
1654         my $rsa_keyfile = "";
1655         my $dsa_keyfile = "";
1656         my $dt = "";
1657         my $v = "";
1658         my $klen = "";
1659         my $tlen = "";
1660         my $modulus = "";
1661         my $capital_n = 0;
1662         my $capital_p = "";
1663         my $capital_q = "";
1664         my $capital_g = "";
1665         my $capital_y = "";
1666         my $capital_r = "";
1667         my $xp1 = "";
1668         my $xp2 = "";
1669         my $Xp = "";
1670         my $xq1 = "";
1671         my $xq2 = "";
1672         my $Xq = "";
1673
1674         my $mode = "";
1675
1676         open(IN, "<$infile");
1677         while(<IN>) {
1678
1679                 my $line = $_;
1680                 chomp($line);
1681                 $line =~ s/\r//;
1682
1683                 my $keylen = "";
1684
1685                 # Mode and type check
1686                 # consider the following parsed line
1687                 # '# AESVS MCT test data for CBC'
1688                 # '# TDES Multi block Message Test for CBC'
1689                 # '# INVERSE PERMUTATION - KAT for CBC'
1690                 # '# SUBSTITUTION TABLE - KAT for CBC'
1691                 # '# TDES Monte Carlo (Modes) Test for CBC'
1692                 # '#  "SHA-1 Monte" information for "IBMRHEL5"'
1693                 # '# "SigVer PKCS#1 Ver 1.5" information for "IBMRHEL5"'
1694                 # '# "SigGen PKCS#1 Ver 1.5" information for "IBMRHEL5"'
1695                 # '#RC4VS MCT test data'
1696
1697                 # avoid false positives from user specified 'for "PRODUCT"' strings
1698                 my $tmpline = $line;
1699                 $tmpline =~ s/ for ".*"//;
1700
1701                 ##### Extract cipher
1702                 # XXX there may be more - to be added
1703                 if ($tmpline =~ /^#.*(CBC|ECB|OFB|CFB|SHA-|SigGen|SigVer|RC4VS|ANSI X9\.31|Hash sizes tested|PQGGen|KeyGen RSA)/) {
1704                         if ($tmpline    =~ /CBC/)   { $mode="cbc"; }
1705                         elsif ($tmpline =~ /ECB/)   { $mode="ecb"; }
1706                         elsif ($tmpline =~ /OFB/)   { $mode="ofb"; }
1707                         elsif ($tmpline =~ /CFB/)   { $mode="cfb"; }
1708                         #we do not need mode as the cipher is already clear
1709                         elsif ($tmpline =~ /SHA-1/) { $cipher="sha1"; }
1710                         elsif ($tmpline =~ /SHA-224/) { $cipher="sha224"; }
1711                         elsif ($tmpline =~ /SHA-256/) { $cipher="sha256"; }
1712                         elsif ($tmpline =~ /SHA-384/) { $cipher="sha384"; }
1713                         elsif ($tmpline =~ /SHA-512/) { $cipher="sha512"; }
1714                         #we do not need mode as the cipher is already clear
1715                         elsif ($tmpline =~ /RC4VS/) { $cipher="rc4"; }
1716                         elsif ($tmpline =~ /SigGen|SigVer/) {
1717                                 die "Error: X9.31 is not supported"
1718                                         if ($tmpline =~ /X9/);
1719                                 $cipher="sha1"; #place holder - might be overwritten later
1720                         }
1721
1722                         if ($tmpline =~ /^#.*AESVS/) {
1723                                 # AES cipher (part of it)
1724                                 $cipher="aes";
1725                         }
1726                         if ($tmpline =~ /^#.*(TDES|KAT)/) {
1727                                 # TDES cipher (full definition)
1728                                 # the FIPS-140 test generator tool does not produce
1729                                 # machine readable output!
1730                                 if ($mode eq "cbc") { $cipher="des-ede3-cbc"; }
1731                                 if ($mode eq "ecb") { $cipher="des-ede3"; }
1732                                 if ($mode eq "ofb") { $cipher="des-ede3-ofb"; }
1733                                 if ($mode eq "cfb") { $cipher="des-ede3-cfb"; }
1734                         }
1735
1736                         # check for RNG
1737                         if ($tmpline =~ /ANSI X9\.31/) {
1738                                 # change the tmpline to add the type of the
1739                                 # test which is ONLY visible from the file
1740                                 # name :-(
1741                                 if ($infile =~ /MCT\.req/) {
1742                                         $tmpline .= " MCT";
1743                                 } elsif ($infile =~ /VST\.req/) {
1744                                         $tmpline .= " VST";
1745                                 } else {
1746                                         die "Unexpected cipher type with $infile";
1747                                 }
1748                         }
1749
1750                         if ($tt == 0) {
1751                         ##### Identify the test type
1752                                 if ($tmpline =~ /KeyGen RSA \(X9\.31\)/) {
1753                                         $tt = 13;
1754                                         die "Interface function rsa_derive for RSA key generation not defined for tested library"
1755                                                 if (!defined($rsa_derive));
1756                                 } elsif ($tmpline =~ /SigVer/ && $opt{'D'} ) {
1757                                         $tt = 12;
1758                                         die "Interface function dsa_verify or dsa_genpubkey for DSA verification not defined for tested library"
1759                                                 if (!defined($dsa_verify) || !defined($dsa_genpubkey));
1760                                 } elsif ($tmpline =~ /SigGen/ && $opt{'D'}) {
1761                                         $tt = 11;
1762                                         die "Interface function dsa_sign or gen_dsakey for DSA sign not defined for tested library"
1763                                                 if (!defined($dsa_sign) || !defined($gen_rsakey));
1764                                 } elsif ($tmpline =~ /PQGGen/) {
1765                                         $tt = 10;
1766                                         die "Interface function for DSA PQGGen testing not defined for tested library"
1767                                                 if (!defined($dsa_pqggen));
1768                                 } elsif ($tmpline =~ /Hash sizes tested/) {
1769                                         $tt = 9;
1770                                         die "Interface function hmac for HMAC testing not defined for tested library"
1771                                                 if (!defined($hmac));
1772                                 } elsif ($tmpline =~ /ANSI X9\.31/ && $tmpline =~ /MCT/) {
1773                                         $tt = 8;
1774                                         die "Interface function state_rng for RNG MCT not defined for tested library"
1775                                                 if (!defined($state_rng));
1776                                 } elsif ($tmpline =~ /ANSI X9\.31/ && $tmpline =~ /VST/) {
1777                                         $tt = 7;
1778                                         die "Interface function state_rng for RNG KAT not defined for tested library"
1779                                                 if (!defined($state_rng));
1780                                 } elsif ($tmpline =~ /SigVer/ ) {
1781                                         $tt = 6;
1782                                         die "Interface function rsa_verify or gen_rsakey for RSA verification not defined for tested library"
1783                                                 if (!defined($rsa_verify) || !defined($gen_rsakey));
1784                                 } elsif ($tmpline =~ /SigGen/ ) {
1785                                         $tt = 5;
1786                                         die "Interface function rsa_sign or gen_rsakey for RSA sign not defined for tested library"
1787                                                 if (!defined($rsa_sign) || !defined($gen_rsakey));
1788                                 } elsif ($tmpline =~ /Monte|MCT|Carlo/ && $cipher =~ /^sha/) {
1789                                         $tt = 4;
1790                                         die "Interface function hash for Hashing not defined for tested library"
1791                                                 if (!defined($hash));
1792                                 } elsif ($tmpline =~ /Monte|MCT|Carlo/) {
1793                                         $tt = 2;
1794                                         die "Interface function state_cipher for Stateful Cipher operation defined for tested library"
1795                                                 if (!defined($state_cipher) || !defined($state_cipher_des));
1796                                 } elsif ($cipher =~ /^sha/) {
1797                                         $tt = 3;
1798                                         die "Interface function hash for Hashing not defined for tested library"
1799                                                 if (!defined($hash));
1800                                 } else {
1801                                         $tt = 1;
1802                                         die "Interface function encdec for Encryption/Decryption not defined for tested library"
1803                                                 if (!defined($encdec));
1804                                 }
1805                         }
1806                 }
1807
1808                 # This is needed as ARCFOUR does not operate with an IV
1809                 $iv = "00000000000000000000000000000000" if ($cipher eq "rc4"
1810                                                              && $iv eq "" );
1811
1812                 # we are now looking for the string
1813                 # '# Key Length : 256'
1814                 # found in AES
1815                 if ($tmpline =~ /^# Key Length.*?(128|192|256)/) {
1816                         if ($cipher eq "aes") {
1817                                 $cipher="$cipher-$1-$mode";
1818                         } else {
1819                                 die "Error: Key length $1 given for cipher $cipher which is unexpected";
1820                         }
1821                 }
1822
1823                 # Get the test data
1824                 if ($line =~ /^(KEY|KEY1|Key)\s*=\s*(.*)/) { # found in ciphers and RNG
1825                         die "KEY seen twice - input file crap" if ($key1 ne "");
1826                         $keytype=$1;
1827                         $key1=$2;
1828                         $key1 =~ s/\s//g; #replace potential white spaces
1829                 }
1830                 elsif ($line =~ /^(KEYs)\s*=\s*(.*)/) { # found in ciphers and RNG
1831                         die "KEY seen twice - input file crap" if ($key1 ne "");
1832                         $keytype=$1;
1833                         $key1=$2;
1834                         $key1 =~ s/\s//g; #replace potential white spaces
1835                         $key2 = $key1;
1836                         $key3 = $key1;
1837                 }
1838                 elsif ($line =~ /^KEY2\s*=\s*(.*)/) { # found in TDES
1839                         die "First key not set, but got already second key - input file crap" if ($key1 eq "");
1840                         die "KEY2 seen twice - input file crap" if (defined($key2));
1841                         $key2=$1;
1842                         $key2 =~ s/\s//g; #replace potential white spaces
1843                 }
1844                 elsif ($line =~ /^KEY3\s*=\s*(.*)/) { # found in TDES
1845                         die "Second key not set, but got already third key - input file crap" if ($key2 eq "");
1846                         die "KEY3 seen twice - input file crap" if (defined($key3));
1847                         $key3=$1;
1848                         $key3 =~ s/\s//g; #replace potential white spaces
1849                 }
1850                 elsif ($line =~ /^IV\s*=\s*(.*)/) { # found in ciphers
1851                         die "IV seen twice - input file crap" if ($iv ne "");
1852                         $iv=$1;
1853                         $iv =~ s/\s//g; #replace potential white spaces
1854                 }
1855                 elsif ($line =~ /^PLAINTEXT\s*=\s*(.*)/) { # found in ciphers
1856                         if ( $1 !~ /\?/ ) { #only use it if there is valid hex data
1857                                 die "PLAINTEXT/CIPHERTEXT seen twice - input file crap" if ($pt ne "");
1858                                 $pt=$1;
1859                                 $pt =~ s/\s//g; #replace potential white spaces
1860                                 $enc=1;
1861                         }
1862                 }
1863                 elsif ($line =~ /^CIPHERTEXT\s*=\s*(.*)/) { # found in ciphers
1864                         if ( $1 !~ /\?/ ) { #only use it if there is valid hex data
1865                                 die "PLAINTEXT/CIPHERTEXT seen twice - input file crap" if ($pt ne "");
1866                                 $pt=$1;
1867                                 $pt =~ s/\s//g; #replace potential white spaces
1868                                 $enc=0;
1869                         }
1870                 }
1871                 elsif ($line =~ /^Len\s*=\s*(.*)/) { # found in hashs
1872                         $len=$1;
1873                 }
1874                 elsif ($line =~ /^(Msg|Seed)\s*=\s*(.*)/) { # found in hashs
1875                         die "Msg/Seed seen twice - input file crap" if ($pt ne "");
1876                         $pt=$2;
1877                 }
1878                 elsif ($line =~ /^\[mod\s*=\s*(.*)\]$/) { # found in RSA requests
1879                         $modulus = $1;
1880                         $out .= $line . "\n\n"; # print it
1881                         # generate the private key with given bit length now
1882                         # as we have the required key length in bit
1883                         if ($tt == 11) {
1884                                 $dsa_keyfile = "dsa_siggen.tmp.$$";
1885                                 my %pqg = &$gen_dsakey($dsa_keyfile);
1886                                 $out .= "P = " . $pqg{'P'} . "\n";
1887                                 $out .= "Q = " . $pqg{'Q'} . "\n";
1888                                 $out .= "G = " . $pqg{'G'} . "\n";
1889                         } elsif ( $tt == 5 ) {
1890                                 # XXX maybe a secure temp file name is better here
1891                                 # but since it is not run on a security sensitive
1892                                 # system, I hope that this is fine
1893                                 $rsa_keyfile = "rsa_siggen.tmp.$$";
1894                                 &$gen_rsakey($modulus, $rsa_keyfile);
1895                                 my $modulus = pipe_through_program("", "openssl rsa -pubout -modulus -in $rsa_keyfile");
1896                                 $modulus =~ s/Modulus=(.*?)\s(.|\s)*/$1/;
1897                                 $out .= "n = $modulus\n";
1898                                 $out .= "\ne = 10001\n"
1899                         }
1900                 }
1901                 elsif ($line =~ /^SHAAlg\s*=\s*(.*)/) { #found in RSA requests
1902                         $cipher=$1;
1903                 }
1904                 elsif($line =~ /^n\s*=\s*(.*)/) { # found in RSA requests
1905                         $out .= $line . "\n";
1906                         $n=$1;
1907                 }
1908                 elsif ($line =~ /^e\s*=\s*(.*)/) { # found in RSA requests
1909                         $e=$1;
1910                 }
1911                 elsif ($line =~ /^S\s*=\s*(.*)/) { # found in RSA requests
1912                         die "S seen twice - input file crap" if ($signature ne "");
1913                         $signature=$1;
1914                 }
1915                 elsif ($line =~ /^DT\s*=\s*(.*)/) { # X9.31 RNG requests
1916                         die "DT seen twice - check input file"
1917                                 if ($dt ne "");
1918                         $dt=$1;
1919                 }
1920                 elsif ($line =~ /^V\s*=\s*(.*)/) { # X9.31 RNG requests
1921                         die "V seen twice - check input file"
1922                                 if ($v ne "");
1923                         $v=$1;
1924                 }
1925                 elsif ($line =~ /^Klen\s*=\s*(.*)/) { # HMAC requests
1926                         die "Klen seen twice - check input file"
1927                                 if ($klen ne "");
1928                         $klen=$1;
1929                 }
1930                 elsif ($line =~ /^Tlen\s*=\s*(.*)/) { # HMAC RNG requests
1931                         die "Tlen seen twice - check input file"
1932                                 if ($tlen ne "");
1933                         $tlen=$1;
1934                 }
1935                 elsif ($line =~ /^N\s*=\s*(.*)/) { #DSA PQGGen
1936                         die "N seen twice - check input file"
1937                                 if ($capital_n);
1938                         $capital_n = $1;
1939                 }
1940                 elsif ($line =~ /^P\s*=\s*(.*)/) { #DSA SigVer
1941                         die "P seen twice - check input file"
1942                                 if ($capital_p);
1943                         $capital_p = $1;
1944                         $out .= $line . "\n"; # print it
1945                 }
1946                 elsif ($line =~ /^Q\s*=\s*(.*)/) { #DSA SigVer
1947                         die "Q seen twice - check input file"
1948                                 if ($capital_q);
1949                         $capital_q = $1;
1950                         $out .= $line . "\n"; # print it
1951                 }
1952                 elsif ($line =~ /^G\s*=\s*(.*)/) { #DSA SigVer
1953                         die "G seen twice - check input file"
1954                                 if ($capital_g);
1955                         $capital_g = $1;
1956                         $out .= $line . "\n"; # print it
1957                 }
1958                 elsif ($line =~ /^Y\s*=\s*(.*)/) { #DSA SigVer
1959                         die "Y seen twice - check input file"
1960                                 if ($capital_y);
1961                         $capital_y = $1;
1962                 }
1963                 elsif ($line =~ /^R\s*=\s*(.*)/) { #DSA SigVer
1964                         die "R seen twice - check input file"
1965                                 if ($capital_r);
1966                         $capital_r = $1;
1967                 }
1968                 elsif ($line =~ /^xp1\s*=\s*(.*)/) { #RSA key gen
1969                         die "xp1 seen twice - check input file"
1970                                 if ($xp1);
1971                         $xp1 = $1;
1972                 }
1973                 elsif ($line =~ /^xp2\s*=\s*(.*)/) { #RSA key gen
1974                         die "xp2 seen twice - check input file"
1975                                 if ($xp2);
1976                         $xp2 = $1;
1977                 }
1978                 elsif ($line =~ /^Xp\s*=\s*(.*)/) { #RSA key gen
1979                         die "Xp seen twice - check input file"
1980                                 if ($Xp);
1981                         $Xp = $1;
1982                 }
1983                 elsif ($line =~ /^xq1\s*=\s*(.*)/) { #RSA key gen
1984                         die "xq1 seen twice - check input file"
1985                                 if ($xq1);
1986                         $xq1 = $1;
1987                 }
1988                 elsif ($line =~ /^xq2\s*=\s*(.*)/) { #RSA key gen
1989                         die "xq2 seen twice - check input file"
1990                                 if ($xq2);
1991                         $xq2 = $1;
1992                 }
1993                 elsif ($line =~ /^Xq\s*=\s*(.*)/) { #RSA key gen
1994                         die "Xq seen twice - check input file"
1995                                 if ($Xq);
1996                         $Xq = $1;
1997                 }
1998                 else {
1999                         $out .= $line . "\n";
2000                 }
2001
2002                 # call tests if all input data is there
2003                 if ($tt == 1) {
2004                         if ($key1 ne "" && $pt ne "" && $cipher ne "") {
2005                                 $out .= kat($keytype, $key1, $key2, $key3, $iv, $pt, $cipher, $enc);
2006                                 $keytype = "";
2007                                 $key1 = "";
2008                                 $key2 = undef;
2009                                 $key3 = undef;
2010                                 $iv = "";
2011                                 $pt = "";
2012                         }
2013                 }
2014                 elsif ($tt == 2) {
2015                         if ($key1 ne "" && $pt ne "" && $cipher ne "") {
2016                                 $out .= crypto_mct($keytype, $key1, $key2, $key3, $iv, $pt, $cipher, $enc);
2017                                 $keytype = "";
2018                                 $key1 = "";
2019                                 $key2 = undef;
2020                                 $key3 = undef;
2021                                 $iv = "";
2022                                 $pt = "";
2023                         }
2024                 }
2025                 elsif ($tt == 3) {
2026                         if ($pt ne "" && $cipher ne "") {
2027                                 $out .= hash_kat($pt, $cipher, $len);
2028                                 $pt = "";
2029                                 $len = undef;
2030                         }
2031                 }
2032                 elsif ($tt == 4) {
2033                         if ($pt ne "" && $cipher ne "") {
2034                                 $out .= hash_mct($pt, $cipher);
2035                                 $pt = "";
2036                         }
2037                 }
2038                 elsif ($tt == 5) {
2039                         if ($pt ne "" && $cipher ne "" && $rsa_keyfile ne "") {
2040                                 $out .= rsa_siggen($pt, $cipher, $rsa_keyfile);
2041                                 $pt = "";
2042                         }
2043                 }
2044                 elsif ($tt == 6) {
2045                         if ($pt ne "" && $cipher ne "" && $signature ne "" && $n ne "" && $e ne "") {
2046                                 $out .= rsa_sigver($pt, $cipher, $signature, $n, $e);
2047                                 $pt = "";
2048                                 $signature = "";
2049                         }
2050                 }
2051                 elsif ($tt == 7 ) {
2052                         if ($key1 ne "" && $dt ne "" && $v ne "") {
2053                                 $out .= rngx931($key1, $dt, $v, "VST");
2054                                 $key1 = "";
2055                                 $dt = "";
2056                                 $v = "";
2057                         }
2058                 }
2059                 elsif ($tt == 8 ) {
2060                         if ($key1 ne "" && $dt ne "" && $v ne "") {
2061                                 $out .= rngx931($key1, $dt, $v, "MCT");
2062                                 $key1 = "";
2063                                 $dt = "";
2064                                 $v = "";
2065                         }
2066                 }
2067                 elsif ($tt == 9) {
2068                         if ($klen ne "" && $tlen ne "" && $key1 ne "" && $pt ne "") {
2069                                 $out .= hmac_kat($klen, $tlen, $key1, $pt);
2070                                 $key1 = "";
2071                                 $tlen = "";
2072                                 $klen = "";
2073                                 $pt = "";
2074                         }
2075                 }
2076                 elsif ($tt == 10) {
2077                         if ($modulus ne "" && $capital_n > 0) {
2078                                 $out .= dsa_pqggen_driver($modulus, $capital_n);
2079                                 #$mod is not resetted
2080                                 $capital_n = 0;
2081                         }
2082                 }
2083                 elsif ($tt == 11) {
2084                         if ($pt ne "" && $dsa_keyfile ne "") {
2085                                 $out .= dsa_siggen($pt, $dsa_keyfile);
2086                                 $pt = "";
2087                         }
2088                 }
2089                 elsif ($tt == 12) {
2090                         if ($modulus ne "" &&
2091                             $capital_p ne "" &&
2092                             $capital_q ne "" &&
2093                             $capital_g ne "" &&
2094                             $capital_y ne "" &&
2095                             $capital_r ne "" &&
2096                             $signature ne "" &&
2097                             $pt ne "") {
2098                                 $out .= dsa_sigver($modulus,
2099                                                    $capital_p,
2100                                                    $capital_q,
2101                                                    $capital_g,
2102                                                    $capital_y,
2103                                                    $capital_r,
2104                                                    $signature,
2105                                                    $pt);
2106
2107                                 # We do not clear the domain values PQG and
2108                                 # the modulus value as they
2109                                 # are specified only once in a file
2110                                 # and we do not need to print them as they
2111                                 # are already printed above
2112                                 $capital_y = "";
2113                                 $capital_r = "";
2114                                 $signature = "";
2115                                 $pt = "";
2116                         }
2117                 }
2118                 elsif ($tt == 13) {
2119                         if($modulus ne "" &&
2120                            $e ne "" &&
2121                            $xp1 ne "" &&
2122                            $xp2 ne "" &&
2123                            $Xp ne "" &&
2124                            $xq1 ne "" &&
2125                            $xq2 ne "" &&
2126                            $Xq ne "") {
2127                                 $out .= rsa_keygen($modulus,
2128                                                    $e,
2129                                                    $xp1,
2130                                                    $xp2,
2131                                                    $Xp,
2132                                                    $xq1,
2133                                                    $xq2,
2134                                                    $Xq);
2135                                 $e = "";
2136                                 $xp1 = "";
2137                                 $xp2 = "";
2138                                 $Xp = "";
2139                                 $xq1 = "";
2140                                 $xq2 = "";
2141                                 $Xq = "";
2142                         }
2143                 }
2144                 elsif ($tt > 0) {
2145                         die "Test case $tt not defined";
2146                 }
2147         }
2148
2149         close IN;
2150         $out =~ s/\n/\r\n/g; # make it a dos file
2151         open(OUT, ">$outfile") or die "Cannot create output file $outfile: $?";
2152         print OUT $out;
2153         close OUT;
2154
2155 }
2156
2157 # Signalhandler
2158 sub cleanup() {
2159         unlink("rsa_siggen.tmp.$$");
2160         unlink("rsa_sigver.tmp.$$");
2161         unlink("rsa_sigver.tmp.$$.sig");
2162         unlink("rsa_sigver.tmp.$$.der");
2163         unlink("rsa_sigver.tmp.$$.cnf");
2164         unlink("dsa_siggen.tmp.$$");
2165         unlink("dsa_sigver.tmp.$$");
2166         unlink("dsa_sigver.tmp.$$.sig");
2167         exit;
2168 }
2169
2170 ############################################################
2171 #
2172 # let us pretend to be C :-)
2173 sub main() {
2174
2175         usage() unless @ARGV;
2176
2177         getopts("DRI:", \%opt) or die "bad option";
2178
2179         ##### Set library
2180
2181         if ( ! defined $opt{'I'} || $opt{'I'} eq 'openssl' ) {
2182                 print STDERR "Using OpenSSL interface functions\n";
2183                 $encdec =       \&openssl_encdec;
2184                 $rsa_sign =     \&openssl_rsa_sign;
2185                 $rsa_verify =   \&openssl_rsa_verify;
2186                 $gen_rsakey =   \&openssl_gen_rsakey;
2187                 $hash =         \&openssl_hash;
2188                 $state_cipher = \&openssl_state_cipher;
2189         } elsif ( $opt{'I'} eq 'libgcrypt' ) {
2190                 print STDERR "Using libgcrypt interface functions\n";
2191                 $encdec =       \&libgcrypt_encdec;
2192                 $rsa_sign =     \&libgcrypt_rsa_sign;
2193                 $rsa_verify =   \&libgcrypt_rsa_verify;
2194                 $gen_rsakey =   \&libgcrypt_gen_rsakey;
2195                 $rsa_derive =   \&libgcrypt_rsa_derive;
2196                 $hash =         \&libgcrypt_hash;
2197                 $state_cipher = \&libgcrypt_state_cipher;
2198                 $state_cipher_des =     \&libgcrypt_state_cipher_des;
2199                 $state_rng =    \&libgcrypt_state_rng;
2200                 $hmac =         \&libgcrypt_hmac;
2201                 $dsa_pqggen =   \&libgcrypt_dsa_pqggen;
2202                 $gen_dsakey =   \&libgcrypt_gen_dsakey;
2203                 $dsa_sign =     \&libgcrypt_dsa_sign;
2204                 $dsa_verify =   \&libgcrypt_dsa_verify;
2205                 $dsa_genpubkey = \&libgcrypt_dsa_genpubkey;
2206         } else {
2207                 die "Invalid interface option given";
2208         }
2209
2210         my $infile=$ARGV[0];
2211         die "Error: Test vector file $infile not found" if (! -f $infile);
2212
2213         my $outfile = $infile;
2214         # let us add .rsp regardless whether we could strip .req
2215         $outfile =~ s/\.req$//;
2216         if ($opt{'R'}) {
2217                 $outfile .= ".rc4";
2218         } else {
2219                 $outfile .= ".rsp";
2220         }
2221         if (-f $outfile) {
2222                 die "Output file $outfile could not be removed: $?"
2223                         unless unlink($outfile);
2224         }
2225         print STDERR "Performing tests from source file $infile with results stored in destination file $outfile\n";
2226
2227         #Signal handler
2228         $SIG{HUP} = \&cleanup;
2229         $SIG{INT} = \&cleanup;
2230         $SIG{QUIT} = \&cleanup;
2231         $SIG{TERM} = \&cleanup;
2232
2233         # Do the job
2234         parse($infile, $outfile);
2235
2236         cleanup();
2237
2238 }
2239
2240 ###########################################
2241 # Call it
2242 main();
2243 1;