1#! /usr/local/bin/perl
2
3# The script itself would of course run with -w.  However, at least
4# GOST_PP throws so many warnings, that the test results would suffer
5# from writing to stderr.
6
7use strict;
8
9use Cwd qw (getcwd abs_path);
10
11BEGIN {
12	unshift @INC, abs_path (getcwd . '/../lib');
13}
14
15use IO::File;
16
17use Benchmark qw (countit);
18
19# How many seconds to run for each module?
20use constant SECONDS => 2;
21
22sub by_name;
23sub by_ekeys;
24sub by_dkeys;
25sub by_bytes_encrypt;
26sub by_bytes_decrypt;
27sub by_blocks_encrypt;
28sub by_blocks_decrypt;
29sub by_blocksize;
30sub by_keysize;
31sub gen_html;
32
33my $now = localtime;
34chomp $now;
35
36# Which algorithms should be tested?
37my @tests = (
38		 { name => 'Twofish_PP', keysize => 16, blocksize => 16 },
39         { name => 'Twofish_PP', keysize => 24, blocksize => 16 },
40         { name => 'Twofish_PP', keysize => 32, blocksize => 16 },
41         { name => 'Twofish',	keysize => 16, blocksize => 16 },
42		 { name => 'Twofish',	keysize => 24, blocksize => 16 },
43		 { name => 'Twofish',	keysize => 32, blocksize => 16 },
44		 { name => 'Twofish2', keysize => 16, blocksize => 16	},
45		 { name => 'Twofish2', keysize => 24,	blocksize => 16	},
46		 { name => 'Twofish2', keysize => 32,	blocksize => 16	},
47		 { name => 'Rijndael', keysize => 16,	blocksize => 16	},
48		 { name => 'Rijndael', keysize => 24,	blocksize => 16	},
49		 { name => 'Rijndael', keysize => 32,	blocksize => 16	},
50	# { name => 'Rijndael_PP',	keysize => 16, blocksize => 16 },
51	# { name => 'Rijndael_PP',	keysize => 24, blocksize => 16 },
52		 { name => 'Rijndael_PP', keysize => 32, blocksize => 16 },
53		 { name => 'Blowfish', keysize => 8, blocksize => 8	},
54		 { name => 'Blowfish', keysize => 16, blocksize => 8	},
55		 { name => 'Blowfish', keysize => 24, blocksize => 8	},
56		 { name => 'Blowfish', keysize => 32, blocksize => 8	},
57		 { name => 'Blowfish', keysize => 40, blocksize => 8	},
58		 { name => 'Blowfish', keysize => 48, blocksize => 8	},
59		 { name => 'Blowfish', keysize => 56, blocksize => 8	},
60		 { name => 'Blowfish_PP', keysize => 8, blocksize => 8	},
61		 { name => 'Blowfish_PP', keysize => 16, blocksize => 8	},
62		 { name => 'Blowfish_PP', keysize => 24, blocksize => 8	},
63		 { name => 'Blowfish_PP', keysize => 32, blocksize => 8	},
64		 { name => 'Blowfish_PP', keysize => 40, blocksize => 8	},
65		 { name => 'Blowfish_PP', keysize => 48, blocksize => 8	},
66		 { name => 'Blowfish_PP', keysize => 56, blocksize => 8	},
67		 { name => 'DES', keysize => 8, blocksize => 8 },
68		 { name => 'DES_PP', keysize => 8, blocksize => 8 },
69		 { name => 'IDEA', keysize => 16, blocksize => 8 },
70		 { name => 'Noekeon', keysize => 16, blocksize => 16 },
71		 { name => 'NULL', keysize => 16, blocksize => 16, language => 'Perl' },
72		 { name => 'Misty1', keysize => 16, blocksize => 8 },
73		 { name => 'Loki97', keysize => 16, blocksize => 16 },
74		 { name => 'GOST', keysize => 32, blocksize => 8 },
75	     { name => 'GOST_PP', keysize => 32, blocksize => 8 },
76		 { name => 'DES_EEE3', keysize => 24, blocksize => 8 },
77		 { name => 'DES_EDE3', keysize => 24, blocksize => 8 },
78		 { name => 'Khazad', keysize => 16, blocksize => 8 },
79		 { name => 'Camellia', keysize => 16, blocksize => 16 },
80		 { name => 'CAST5', keysize => 5, blocksize => 8 },
81		 { name => 'CAST5', keysize => 8, blocksize => 8 },
82		 { name => 'CAST5', keysize => 16, blocksize => 8 },
83		 { name => 'CAST5_PP', keysize => 5, blocksize => 8 },
84		 { name => 'CAST5_PP', keysize => 8, blocksize => 8 },
85		 { name => 'CAST5_PP', keysize => 16, blocksize => 8 },
86		 { name => 'Anubis', keysize => 16, blocksize => 16 },
87	# Other keysizes not supported by Perl version.
88	# { name => 'Anubis', keysize => 20, blocksize => 16 },
89	# { name => 'Anubis', keysize => 24, blocksize => 16 },
90	# { name => 'Anubis', keysize => 28, blocksize => 16 },
91	# { name => 'Anubis', keysize => 32, blocksize => 16 },
92	# { name => 'Anubis', keysize => 36, blocksize => 16 },
93	# { name => 'Anubis', keysize => 40, blocksize => 16 },
94	# FIXME: Maybe test with lesser rounds, but the performance
95	# should actually change in a linear way anyhow...
96         { name => 'Square', keysize => 16, blocksize => 16 },
97         { name => 'Skipjack', keysize => 10, blocksize => 8 },
98		 { name => 'Shark', keysize => 16, blocksize => 8 },
99		 { name => 'Serpent', keysize => 16, blocksize => 16	},
100		 { name => 'Serpent', keysize => 24, blocksize => 16	},
101		 { name => 'Serpent', keysize => 32, blocksize => 16	},
102		 { name => 'Rainbow', keysize => 16, blocksize => 16	},
103		 { name => 'TEA', keysize => 16, blocksize => 8 },
104			 );
105
106#$#tests = 5;
107
108foreach my $test (@tests) {
109	eval "require Crypt::$test->{name}";
110    if ($@) {
111		print STDERR "Crypt::$test->{name} is not available - skipped\n";
112		next;
113	}
114
115    $test->{key} = 'k' x $test->{keysize};
116	$test->{namespace} = "Crypt::$test->{name}";
117
118	# Some modules (IDEA) are not in the Crypt:: namespace.
119	eval "$test->{namespace}->new ('$test->{key}')";
120	if ($@) {
121		$test->{namespace} = $test->{name};
122		eval "$test->{namespace}->new ('$test->{key}')";
123		if ($@) {
124			# No way.
125			print STDERR "$test->{name} cannot be loaded - skipped\n";
126			next;
127		}
128	}
129
130	$test->{block} = 'b' x $test->{blocksize};
131    $test->{version} = eval "\$$test->{namespace}::VERSION";
132    $test->{version} = '?' unless defined $test->{version};
133
134    unless ($test->{language}) {
135		$test->{language} = $test->{name} =~ /_PP$/ ? 'Perl' : 'C'
136	}
137}
138
139foreach my $test (@tests) {
140	next unless $test->{block};
141
142	my $module = "$test->{namespace}";
143	my ($t, $cipher, $bytes);
144
145    print <<EOF;
146
147*** $test->{name} (ks$test->{keysize}/bs$test->{blocksize}) ***
148Encrypting blocks of $test->{blocksize} bytes.
149EOF
150
151	$cipher = $module->new ($test->{key});
152	$t = countit SECONDS, sub { $cipher->encrypt ($test->{block}) };
153	$test->{count_encrypt} = $test->{real_count_encrypt} = $t->iters;
154	$test->{time_encrypt} = $t->cpu_a;
155
156	$test->{bytes_encrypt} = $test->{blocksize} * $test->{count_encrypt};
157	print "  $test->{bytes_encrypt} bytes ($test->{count_encrypt} "
158		. "$test->{blocksize}-byte blocks) in $test->{time_encrypt} seconds.\n";
159	$test->{count_encrypt} = sprintf '%.2f', $t->iters / $t->cpu_a;
160	$test->{bytes_encrypt} = sprintf '%.2f', $test->{bytes_encrypt} / $t->cpu_a;
161
162	print "Decrypting blocks of $test->{blocksize} bytes.\n";
163	$cipher = $module->new ($test->{key});
164	$t = countit SECONDS, sub { $cipher->decrypt ($test->{block}) };
165	$test->{count_decrypt} = $test->{real_count_decrypt} = $t->iters;
166	$test->{time_decrypt} = $t->cpu_a;
167	$test->{bytes_decrypt} = $test->{blocksize} * $test->{count_decrypt};
168	print "  $test->{bytes_decrypt} bytes ($test->{count_decrypt} "
169		. "$test->{blocksize}-byte blocks) in $test->{time_decrypt} seconds.\n";
170	$test->{count_decrypt} = sprintf '%.2f', $t->iters / $t->cpu_a;
171	$test->{bytes_decrypt} = sprintf '%.2f', $test->{bytes_decrypt} / $t->cpu_a;
172
173	print "Generating $test->{keysize}-bit encryption keys.\n";
174	$t = countit SECONDS, sub {
175		$module->new ($test->{key})->encrypt ($test->{block})
176	};
177	$test->{count_ekeys} = $t->iters;
178	$test->{time_ekeys} = $t->cpu_a;
179	print "  $test->{count_ekeys} in $test->{time_ekeys} seconds.\n";
180    $test->{count_ekeys} = sprintf '%.2f', ($t->iters / $t->cpu_a);
181
182    print "Generating $test->{keysize}-bit decryption keys.\n";
183	$t = countit SECONDS, sub {
184		$module->new ($test->{key})->decrypt ($test->{block})
185	};
186	$test->{count_dkeys} = $t->iters;
187	$test->{time_dkeys} = $t->cpu_a;
188	print "  $test->{count_dkeys} in $test->{time_dkeys} seconds.\n";
189    $test->{count_dkeys} = sprintf '%.2f', ($t->iters / $t->cpu_a);
190}
191
192sub by_name
193{
194	my $result = $a->{name} cmp $b->{name};
195	return $result if $result;
196	$result = $b->{keysize} <=> $a->{keysize};
197	return $result if $result;
198	return $b->{blocksize} <=> $a->{blocksize};
199}
200
201sub by_ekeys
202{
203	my $result = $b->{count_ekeys} <=> $a->{count_ekeys};
204	return $result if $result;
205	return by_name;
206}
207
208sub by_dkeys
209{
210	my $result = $b->{count_dkeys} <=> $a->{count_dkeys};
211	return $result if $result;
212	return by_name;
213}
214
215sub by_bytes_encrypt
216{
217	my $result = $b->{bytes_encrypt} <=> $a->{bytes_encrypt};
218	return $result if $result;
219	return by_name;
220}
221
222sub by_bytes_decrypt
223{
224	my $result = $b->{bytes_decrypt} <=> $a->{bytes_decrypt};
225	return $result if $result;
226	return by_name;
227}
228
229sub by_blocks_encrypt
230{
231	my $result = $b->{count_encrypt} <=> $a->{count_encrypt};
232	return $result if $result;
233	return by_name;
234}
235
236sub by_blocks_decrypt
237{
238	my $result = $b->{count_decrypt} <=> $a->{count_decrypt};
239	return $result if $result;
240	return by_name;
241}
242
243sub by_blocksize
244{
245	my $result = $b->{blocksize} <=> $a->{blocksize};
246	return $result if $result;
247	return by_name;
248}
249
250sub by_keysize
251{
252	my $result = $b->{keysize} <=> $a->{keysize};
253	return $result if $result;
254	return by_name;
255}
256
257gen_html \&by_name, "by name", "";
258gen_html \&by_ekeys, "by encryption keys", "_by_ekeys";
259gen_html \&by_dkeys, "by decryption keys", "_by_dkeys";
260gen_html \&by_bytes_encrypt, "by encrypted bytes", "_by_ebytes";
261gen_html \&by_bytes_decrypt, "by decrypted bytes", "_by_dbytes";
262gen_html \&by_blocks_encrypt, "by encrypted blocks", "_by_eblocks";
263gen_html \&by_blocks_decrypt, "by decrypted blocks", "_by_dblocks";
264gen_html \&by_blocksize, "by blocksize", "_by_blksize";
265gen_html \&by_keysize, "by blocksize", "_by_keysize";
266print "Summary in benchmark.html\n";
267
268sub gen_html
269{
270	my ($sort, $sort_title, $suffix) = @_;
271
272	my $html = <<EOF;
273<?xml version="1.0" encoding="us-ascii"?>
274<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
275    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
276<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US">
277  <head>
278    <meta http-equiv="Content-Type" content="text/html; charset=us-ascii"/>
279    <meta name="generator" content="$0"/>
280    <title>Benchmark Results ($now) $sort_title</title>
281	<style type="text/css">
282body {
283        font-family: Monospace;
284}
285td {
286	text-align: right;
287    padding-left: 1em;
288    padding-right: 3pt;
289}
290th {
291	text-align: left;
292    padding-left: 1em;
293    padding-right: 3pt;
294    background-color: #d0c4b6;
295}
296.name {
297	text-align: left;
298	background-color: #fffff2;
299}
300th.name {
301	text-align: left;
302    font-weight: bold;
303	background-color: #d0c4b6;
304}
305.other {
306	background-color: #fffff2;
307}
308.twofish {
309        background-color: #eee2d4;
310}
311.twofish_name {
312        text-align: left;
313        background-color: #eee2d4;
314}
315    </style>
316  </head>
317  <body>
318    <a name="top"><!-- --></a>
319    <h1>Benchmark Results ($now)</h1>
320    <h2>Sorted $sort_title, time per test: @{[SECONDS]} s</h2>
321    <table border="1" summary="Benchmark">
322      <tbody>
323        <tr>
324          <th rowspan="2" colspan="2" class="name">
325	        <a href="benchmark.html">Module</a>
326          </th>
327          <th rowspan="2" class="name">
328            Language<super>[<a href="#lang">1</a>]</super>
329          </th>
330          <th rowspan="2">
331	        <a href="benchmark_by_blksize.html">Blocksize</a>
332          </th>
333          <th rowspan="2">
334	        <a href="benchmark_by_keysize.html">Keysize</a>
335          </th>
336          <th colspan="2">Keys/s<super>[<a href="#keys">2</a>]</super></th>
337          <th colspan="2">Encrypt</th>
338          <th colspan="2">Decrypt</th>
339        </tr>
340        <tr>
341          <th>
342            <a href="benchmark_by_ekeys.html">encrypt</a>
343          </th>
344          <th>
345            <a href="benchmark_by_dkeys.html">decrypt</a>
346          </th>
347          <th>
348            <a href="benchmark_by_ebytes.html">bytes/s</a>
349          </th>
350          <th>
351            <a href="benchmark_by_eblocks.html">blocks/s</a>
352          </th>
353          <th>
354            <a href="benchmark_by_dbytes.html">bytes/s</a>
355          </th>
356          <th>
357            <a href="benchmark_by_dblocks.html">blocks/s</a>
358          </th>
359        </tr>
360EOF
361
362	my $count = 0;
363    foreach my $test (sort $sort @tests) {
364		next unless $test->{block};
365		++$count;
366
367		my $name_class = 'Twofish_PP' eq $test->{name} ?
368			'twofish_name' : 'name';
369		my $class = 'Twofish_PP' eq $test->{name} ?
370			'twofish' : 'other';
371		$html .= <<EOF;
372        <tr>
373            <td class="$class">$count</td>
374			<td class="$name_class">$test->{name} v$test->{version}</td>
375            <td class="$class">$test->{language}</td>
376			<td class="$class">$test->{blocksize}</td>
377			<td class="$class">$test->{keysize}</td>
378			<td class="$class">$test->{count_ekeys}</td>
379			<td class="$class">$test->{count_dkeys}</td>
380			<td class="$class">$test->{bytes_encrypt}</td>
381			<td class="$class">$test->{count_encrypt}</td>
382			<td class="$class">$test->{bytes_decrypt}</td>
383			<td class="$class">$test->{count_decrypt}</td>
384        </tr>
385EOF
386    }
387
388    $html .= <<EOF;
389      </tbody>
390    </table>
391    <hr />
392<p>
393Remarks:<br />
394<dl>
395<dt><a name="lang">[1]</a></dt>
396<dd>Some modules, like Crypt::DES_EEE3 or Crypt::DES_EDE3 are actually
397pure Perl modules but are implemented as a wrapper around XS modules.
398These are still listed here as implemented in C.
399<a href="#top">back</a></dd>
400
401<dt><a name="keys">[2]</a></dt>
402<dd>One test cycle for key generation actually consists of a constructor
403call followed by one encryption resp. decryption operation, since a module
404may decide to postpone the key scheduling until the direction is fixed.
405The number is therefore an indicator for the encryption/decryption
406performance for small chunks of data.
407<a href="#top">back</a></dd>
408</p>
409  </body>
410</html>
411EOF
412
413	local *HANDLE;
414    open HANDLE, ">benchmark$suffix.html" or
415	die "cannot open 'benchmark$suffix.html' for writing: $!";
416    print HANDLE $html or
417	    die "cannot write to 'benchmark$suffix.html': $!";
418    close HANDLE or
419	    die "cannot close 'benchmark$suffix.html': $!";
420    print "wrote 'benchmark$suffix.html'\n";
421}
422
423=cut
424Local Variables:
425mode: perl
426perl-indent-level: 4
427perl-continued-statement-offset: 4
428perl-continued-brace-offset: 0
429perl-brace-offset: -4
430perl-brace-imaginary-offset: 0
431perl-label-offset: -4
432cperl-indent-level: 4
433cperl-continued-statement-offset: 2
434tab-width: 4
435End:
436=cut
437