File: tamper.t

package info (click to toggle)
libcrypt-util-perl 0.11-6
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 252 kB
  • sloc: perl: 2,438; makefile: 2
file content (85 lines) | stat: -rw-r--r-- 2,316 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Exception;

use Crypt::Util;

my $c;

BEGIN {
	$c = Crypt::Util->new;

	eval { $c->fallback_digest; $c->fallback_cipher; $c->fallback_mac; $c->fallback_authenticated_mode };
	plan skip_all => "$1" if $@ =~ /(Couldn't load any \w+)/;
	plan skip_all => "Couldn't load fallback" if $@;

	plan 'no_plan';
}

$c->default_key("foo");

foreach my $encrypted ( 1, 0 ) { # encrypted not yet supported

	foreach my $data (
		"zemoose gauhy tj lkj GAJE E djjjj laaaa di da dooo",
		{ foo => "bar", gorch => [ qw/very deep/, 1 .. 10 ] },
		"\0 bar evil binary string \0 \0\0 foo la \xff foo \0 bar",
	) {

		my $tamper;

		lives_ok { $tamper = $c->tamper_proof( data => $data, encrypt => $encrypted ) } "tamper proofing lived (" . ($encrypted ? "aead" : "mac signed") .")";

		ok( defined($tamper), "got some output" );

		unless ( ref $data ) {
			if ( $encrypted ) {
				unlike( $tamper, qr/\Q$data/, "tamper proof does not contain the original" )
			} else {
				like( $tamper, qr/\Q$data/, "tamper proof contains the original" )
			}
		}

		my $thawed;

		lives_ok { $thawed = $c->thaw_tamper_proof( string => $tamper ) } "tamper proof thaw lived";

		ok( defined($thawed), "got some output" );

		is_deeply( $thawed, $data, "tamper resistence round trips (" . ($encrypted ? "aead" : "mac signed") .")" );

		my $corrupt_tamper = $tamper;
		substr( $corrupt_tamper, -10, 5 ) ^= "moose";

		throws_ok {
			$c->thaw_tamper_proof( string => $corrupt_tamper );
		} qr/verification.*failed/i, "corrupt tamper proof string failed";


		my $twaddled_tamper;
		if ( $encrypted ) {
			my ( $type, $inner ) = $c->_unpack_tamper_proof($tamper);
			$twaddled_tamper = $c->decrypt_string( string => $inner );
			substr( $twaddled_tamper, -10, 5 ) ^= "moose";
			$twaddled_tamper = $c->_pack_tamper_proof($type, $c->encrypt_string( string => $twaddled_tamper ));
		} else {
			$twaddled_tamper = $tamper;
			substr( $twaddled_tamper, -10, 5 ) ^= "moose";
		}

		throws_ok {
			$c->thaw_tamper_proof( string => $twaddled_tamper );
		} qr/verification.*failed/i, "altered tamper proof string failed";

		local $Crypt::Util::PACK_FORMAT_VERSION = 2;

		throws_ok {
			$c->thaw_tamper_proof( string => $tamper );
		} qr/Incompatible packed string/, "version check";
	}

}