Commit 227045f5145b7dfee004c44d212dbbd6aef82989 - libcryptx-perl

new module Crypt::Misc Karel Miko 8 years ago

12 changed file(s) with 319 addition(s) and 172 deletion(s). Raw diff Collapse all Expand all

-1

Changes less more

13	13	- maybe: add enc_b64/dec_b64 + enc_b64u/dec_b64u + enc_b32/dec_b32
14	14	- maybe: x509_rsa_pubkey + x509_rsa_pubkey_alg
15	15
16		0.028_03 2016/03/29
	16	0.028_04 2016/04/04
17	17	- NEW module: Math::BigInt::LTM
	18	- NEW module: Crypt::Misc
	19	- TODO: pod for Crypt::Misc
	20	- TODO: fix - Please specify prototyping behavior for CryptX.xs (see perlxs manual)
18	21
19	22	0.028 2016/03/23
20	23	- IMPORTANT: switch from Module::Build to ExtUtils::MakeMaker

+219

-0

lib/Crypt/Misc.pm less more

	0	package Crypt::Misc;
	1
	2	use strict;
	3	use warnings;
	4
	5	require Exporter; our @ISA = qw(Exporter); ### use Exporter 5.57 'import';
	6	use Carp 'croak';
	7	our %EXPORT_TAGS = ( all => [qw(encode_b64 decode_b64 encode_b64u decode_b64u pem_to_der der_to_pem read_rawfile write_rawfile slow_eq)] );
	8	our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
	9	our @EXPORT = qw();
	10
	11	use Carp 'carp';
	12	use CryptX;
	13	use Crypt::Digest 'digest_data';
	14	use Crypt::Mode::CBC;
	15	use Crypt::Mode::CFB;
	16	use Crypt::Mode::ECB;
	17	use Crypt::Mode::OFB;
	18	use Crypt::Cipher;
	19	use Crypt::PRNG 'random_bytes';
	20
	21	sub encode_b64 {
	22	CryptX::_encode_base64(@_);
	23	}
	24
	25	sub decode_b64 {
	26	CryptX::_decode_base64(@_);
	27	}
	28
	29	sub encode_b64u {
	30	CryptX::_encode_base64url(@_);
	31	}
	32
	33	sub decode_b64u {
	34	CryptX::_decode_base64url(@_);
	35	}
	36
	37	sub pem_to_der {
	38	my ($data, $password) = @_;
	39
	40	my ($begin, $obj1, $content, $end, $obj2) = $data =~ m/(----[- ]BEGIN ([^\r\n\-]+KEY)[ -]----)(.*?)(----[- ]END ([^\r\n\-]+)[ -]----)/s;
	41	return undef unless $content;
	42
	43	$content =~ s/^\s+//sg;
	44	$content =~ s/\s+$//sg;
	45	$content =~ s/\r\n/\n/sg; # CR-LF >> LF
	46	$content =~ s/\r/\n/sg; # CR >> LF
	47	$content =~ s/\\\n//sg; # \ + LF
	48
	49	my ($headers, undef, $b64) = $content =~ /^(([^:]+:.?\n))(.*)$/s;
	50	return undef unless $b64;
	51
	52	my $binary = decode_b64($b64);
	53	return undef unless $binary;
	54
	55	my ($ptype, $cipher_name, $iv_hex);
	56	for my $h (split /\n/, ($headers\|\|'')) {
	57	my ($k, $v) = split /:\s*/, $h, 2;
	58	$ptype = $v if $k eq 'Proc-Type';
	59	($cipher_name, $iv_hex) = $v =~ /^\s(.?)\s,\s([0-9a-fA-F]+)\s*$/ if $k eq 'DEK-Info';
	60	}
	61	if ($cipher_name && $iv_hex && $ptype && $ptype eq '4,ENCRYPTED') {
	62	croak "FATAL: encrypted PEM but no password provided" unless defined $password;
	63	my $iv = pack("H*", $iv_hex);
	64	my ($mode, $klen) = _name2mode($cipher_name);
	65	my $key = _password2key($password, $klen, $iv, 'MD5');
	66	return $mode->decrypt($binary, $key, $iv);
	67	}
	68	return $binary;
	69	}
	70
	71	sub der_to_pem {
	72	my ($data, $header_name, $password, $cipher_name) = @_;
	73	my $content = $data;
	74	my @headers;
	75
	76	if ($password) {
	77	$cipher_name \|\|= 'AES-256-CBC';
	78	my ($mode, $klen, $ilen) = _name2mode($cipher_name);
	79	my $iv = random_bytes($ilen);
	80	my $key = _password2key($password, $klen, $iv, 'MD5');
	81	$content = $mode->encrypt($data, $key, $iv);
	82	push @headers, 'Proc-Type: 4,ENCRYPTED', "DEK-Info: ".uc($cipher_name).",".unpack("H*", $iv);
	83	}
	84
	85	my $pem = "-----BEGIN $header_name-----\n";
	86	if (@headers) {
	87	$pem .= "$_\n" for @headers;
	88	$pem .= "\n";
	89	}
	90	my @l = encode_b64($content) =~ /.{1,64}/g;
	91	$pem .= join("\n", @l) . "\n";
	92	$pem .= "-----END $header_name-----\n";
	93	return $pem;
	94	}
	95
	96	sub read_rawfile {
	97	my $f = shift;
	98	croak "FATAL: read_rawfile() non-existing file '$f'" unless -f $f;
	99	open my $fh, "<", $f or croak "FATAL: read_rawfile() cannot open file '$f': $!";
	100	binmode $fh;
	101	return do { local $/; <$fh> };
	102	}
	103
	104	sub write_rawfile {
	105	# write_rawfile($filename, $data);
	106	croak "FATAL: write_rawfile() no data" unless defined $_[1];
	107	open my $fh, ">", $_[0] or croak "FATAL: write_rawfile() cannot open file '$_[0]': $!";
	108	binmode $fh;
	109	print $fh $_[1] or croak "FATAL: write_rawfile() cannot write to '$_[0]': $!";
	110	close $fh or croak "FATAL: write_rawfile() cannot close '$_[0]': $!";
	111	return;
	112	}
	113
	114	sub slow_eq {
	115	my ($a, $b) = @_;
	116	return unless defined $a && defined $b;
	117	my $diff = length $a ^ length $b;
	118	for(my $i = 0; $i < length $a && $i < length $b; $i++) {
	119	$diff \|= ord(substr $a, $i) ^ ord(substr $b, $i);
	120	}
	121	return $diff == 0;
	122	}
	123
	124	### private functions
	125
	126	sub _name2mode {
	127	my $cipher_name = uc(shift);
	128	my %trans = ( 'DES-EDE3' => 'DES_EDE' );
	129
	130	my ($cipher, undef, $klen, $mode) = $cipher_name =~ /^(AES\|CAMELLIA\|DES\|DES-EDE3\|SEED)(-(\d+))?-(CBC\|CFB\|ECB\|OFB)$/i;
	131	croak "FATAL: unsupported cipher '$cipher_name'" unless $cipher && $mode;
	132	$cipher = $trans{$cipher} \|\| $cipher;
	133	$klen = $klen ? int($klen/8) : Crypt::Cipher::min_keysize($cipher);
	134	my $ilen = Crypt::Cipher::blocksize($cipher);
	135	croak "FATAL: unsupported cipher '$cipher_name'" unless $klen && $ilen;
	136
	137	return (Crypt::Mode::CBC->new($cipher), $klen, $ilen) if $mode eq 'CBC';
	138	return (Crypt::Mode::CFB->new($cipher), $klen, $ilen) if $mode eq 'CFB';
	139	return (Crypt::Mode::ECB->new($cipher), $klen, $ilen) if $mode eq 'ECB';
	140	return (Crypt::Mode::OFB->new($cipher), $klen, $ilen) if $mode eq 'OFB';
	141	}
	142
	143	sub _password2key {
	144	my ($password, $klen, $iv, $hash) = @_;
	145	my $salt = substr($iv, 0, 8);
	146	my $key = '';
	147	while (length($key) < $klen) {
	148	$key .= digest_data($hash, $key . $password . $salt);
	149	}
	150	return substr($key, 0, $klen);
	151	}
	152
	153	1;
	154
	155	=pod
	156
	157	=head1 NAME
	158
	159	Crypt::Misc - miscellaneous functions related to (or used by) CryptX
	160
	161	=head1 SYNOPSIS
	162
	163	use Crypt::Misc ':all';
	164
	165
	166	=head1 DESCRIPTION
	167
	168	xxx
	169
	170	=head1 METHODS
	171
	172	=head2 encode_b64
	173
	174	xxx
	175
	176	=head2 decode_b64
	177
	178	xxx
	179
	180	=head2 read_rawfile
	181
	182	xxx
	183
	184	=head2 write_rawfile
	185
	186	xxx
	187
	188	=head2 slow_eq
	189
	190	xxx
	191
	192	=head2 encode_b64u
	193
	194	xxx
	195
	196	=head2 decode_b64u
	197
	198	xxx
	199
	200	=head2 pem_to_der
	201
	202	xxx
	203
	204	=head2 der_to_pem
	205
	206	xxx
	207
	208	=head1 SEE ALSO
	209
	210	=over
	211
	212	=item * L<CryptX\|CryptX>
	213
	214	=back
	215
	216	=cut
	217
	218	__END__

-3

lib/Crypt/PK/DH.pm less more

7	7	our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
8	8	our @EXPORT = qw();
9	9
	10	use Carp;
10	11	use CryptX;
11		use Crypt::PK;
12	12	use Crypt::Digest 'digest_data';
13		use Carp;
	13	use Crypt::Misc qw(read_rawfile encode_b64u decode_b64u encode_b64 decode_b64);
14	14
15	15	sub new {
16	16	my ($class, $f) = @_;

27	27	$data = $$key;
28	28	}
29	29	elsif (-f $key) {
30		$data = Crypt::PK::_slurp_file($key);
	30	$data = read_rawfile($key);
31	31	}
32	32	else {
33	33	croak "FATAL: non-existing file '$key'";

+11

-10

lib/Crypt/PK/DSA.pm less more

7	7	our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
8	8	our @EXPORT = qw();
9	9
10		use CryptX qw( _encode_base64 _decode_base64 );
	10	use Carp;
	11	use CryptX qw(_encode_json _decode_json);
	12	use Crypt::Digest 'digest_data';
	13	use Crypt::Misc qw(read_rawfile encode_b64u decode_b64u encode_b64 decode_b64 pem_to_der der_to_pem);
11	14	use Crypt::PK;
12		use Crypt::Digest 'digest_data';
13		use Carp;
14	15
15	16	sub new {
16	17	my ($class, $f, $p) = @_;

23	24	my ($self, $type, $password, $cipher) = @_;
24	25	my $key = $self->export_key_der($type\|\|'');
25	26	return unless $key;
26		return Crypt::PK::_asn1_to_pem($key, "DSA PRIVATE KEY", $password, $cipher) if $type eq 'private';
27		return Crypt::PK::_asn1_to_pem($key, "DSA PUBLIC KEY") if $type eq 'public';
28		return Crypt::PK::_asn1_to_pem($key, "PUBLIC KEY") if $type eq 'public_x509';
	27	return der_to_pem($key, "DSA PRIVATE KEY", $password, $cipher) if $type eq 'private';
	28	return der_to_pem($key, "DSA PUBLIC KEY") if $type eq 'public';
	29	return der_to_pem($key, "PUBLIC KEY") if $type eq 'public_x509';
29	30	}
30	31
31	32	sub import_key {

45	46	$data = $$key;
46	47	}
47	48	elsif (-f $key) {
48		$data = Crypt::PK::_slurp_file($key);
	49	$data = read_rawfile($key);
49	50	}
50	51	else {
51	52	croak "FATAL: non-existing file '$key'";

53	54	croak "FATAL: invalid key data" unless $data;
54	55
55	56	if ($data =~ /-----BEGIN (DSA PRIVATE\|DSA PUBLIC\|PRIVATE\|PUBLIC) KEY-----(.*?)-----END/sg) {
56		$data = Crypt::PK::_pem_to_binary($data, $password);
	57	$data = pem_to_der($data, $password);
57	58	return $self->_import($data);
58	59	}
59	60	elsif ($data =~ /---- BEGIN SSH2 PUBLIC KEY ----(.*?)---- END SSH2 PUBLIC KEY ----/sg) {
60		$data = Crypt::PK::_pem_to_binary($data);
	61	$data = pem_to_der($data);
61	62	my ($typ, $p, $q, $g, $y) = Crypt::PK::_ssh_parse($data);
62	63	return $self->_import_hex(unpack('H',$p), unpack('H',$q), unpack('H',$g), undef, unpack('H',$y)) if $typ && $p && $q && $g && $y && $typ eq 'ssh-dss';
63	64	}
64	65	elsif ($data =~ /ssh-dss\s+(\S+)/) {
65		$data = _decode_base64("$1");
	66	$data = decode_b64("$1");
66	67	my ($typ, $p, $q, $g, $y) = Crypt::PK::_ssh_parse($data);
67	68	return $self->_import_hex(unpack('H',$p), unpack('H',$q), unpack('H',$g), undef, unpack('H',$y)) if $typ && $p && $q && $g && $y && $typ eq 'ssh-dss';
68	69	}

+18

-17

lib/Crypt/PK/ECC.pm less more

7	7	our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
8	8	our @EXPORT = qw();
9	9
10		use CryptX qw( _encode_base64url _decode_base64url _encode_base64 _decode_base64 _decode_json _encode_json );
	10	use Carp;
	11	use CryptX qw(_encode_json _decode_json);
	12	use Crypt::Digest 'digest_data';
	13	use Crypt::Misc qw(read_rawfile encode_b64u decode_b64u encode_b64 decode_b64 pem_to_der der_to_pem);
11	14	use Crypt::PK;
12		use Crypt::Digest 'digest_data';
13		use Carp;
14	15
15	16	our %curve = (
16	17	### http://www.ecc-brainpool.org/download/Domain-parameters.pdf (v1.0 19.10.2005)

432	433	my ($self, $type, $password, $cipher) = @_;
433	434	my $key = $self->export_key_der($type\|\|'');
434	435	return unless $key;
435		return Crypt::PK::_asn1_to_pem($key, "EC PRIVATE KEY", $password, $cipher) if $type eq 'private';
436		return Crypt::PK::_asn1_to_pem($key, "PUBLIC KEY") if $type eq 'public' \|\| $type eq 'public_compressed';
	436	return der_to_pem($key, "EC PRIVATE KEY", $password, $cipher) if $type eq 'private';
	437	return der_to_pem($key, "PUBLIC KEY") if $type eq 'public' \|\| $type eq 'public_compressed';
437	438	}
438	439
439	440	sub export_key_jwk {

454	455	# but they are used in https://tools.ietf.org/html/rfc7517#appendix-A.2
455	456	my $hash = {
456	457	kty => "EC", crv=>$curve,
457		x => _encode_base64url(pack("H*", $kh->{pub_x})),
458		y => _encode_base64url(pack("H*", $kh->{pub_y})),
459		d => _encode_base64url(pack("H*", $kh->{k})),
	458	x => encode_b64u(pack("H*", $kh->{pub_x})),
	459	y => encode_b64u(pack("H*", $kh->{pub_y})),
	460	d => encode_b64u(pack("H*", $kh->{k})),
460	461	};
461	462	return $wanthash ? $hash : _encode_json($hash);
462	463	}

467	468	}
468	469	my $hash = {
469	470	kty => "EC", crv=>$curve,
470		x => _encode_base64url(pack("H*", $kh->{pub_x})),
471		y => _encode_base64url(pack("H*", $kh->{pub_y})),
	471	x => encode_b64u(pack("H*", $kh->{pub_x})),
	472	y => encode_b64u(pack("H*", $kh->{pub_y})),
472	473	};
473	474	return $wanthash ? $hash : _encode_json($hash);
474	475	}

490	491	# hash with items corresponding to JSON Web Key (JWK)
491	492	$key = {%$key}; # make a copy as we will modify it
492	493	for (qw/x y d/) {
493		$key->{$_} = eval { unpack("H*", _decode_base64url($key->{$_})) } if exists $key->{$_};
	494	$key->{$_} = eval { unpack("H*", decode_b64u($key->{$_})) } if exists $key->{$_};
494	495	}
495	496	if (my $curve = $jwkcrv{$key->{crv}}) {
496	497	return $self->_import_hex($key->{x}, $key->{y}, $key->{d}, $curve);

504	505	$data = $$key;
505	506	}
506	507	elsif (-f $key) {
507		$data = Crypt::PK::_slurp_file($key);
	508	$data = read_rawfile($key);
508	509	}
509	510	else {
510	511	croak "FATAL: non-existing file '$key'";

512	513	croak "FATAL: invalid key data" unless $data;
513	514
514	515	if ($data =~ /-----BEGIN (EC PRIVATE\|EC PUBLIC\|PUBLIC) KEY-----(.*?)-----END/sg) {
515		$data = Crypt::PK::_pem_to_binary($data, $password);
	516	$data = pem_to_der($data, $password);
516	517	return $self->_import($data);
517	518	}
518	519	elsif ($data =~ /-----BEGIN PRIVATE KEY-----(.*?)-----END/sg) {
519		$data = Crypt::PK::_pem_to_binary($data, $password);
	520	$data = pem_to_der($data, $password);
520	521	return $self->_import_pkcs8($data);
521	522	}
522	523	elsif ($data =~ /-----BEGIN ENCRYPTED PRIVATE KEY-----(.*?)-----END/sg) {

529	530	my $h = _decode_json($json);
530	531	if ($h && $h->{kty} eq "EC") {
531	532	for (qw/x y d/) {
532		$h->{$_} = eval { unpack("H*", _decode_base64url($h->{$_})) } if exists $h->{$_};
	533	$h->{$_} = eval { unpack("H*", decode_b64u($h->{$_})) } if exists $h->{$_};
533	534	}
534	535	if (my $curve = $jwkcrv{$h->{crv}}) {
535	536	return $self->_import_hex($h->{x}, $h->{y}, $h->{d}, $curve);

537	538	}
538	539	}
539	540	elsif ($data =~ /---- BEGIN SSH2 PUBLIC KEY ----(.*?)---- END SSH2 PUBLIC KEY ----/sg) {
540		$data = Crypt::PK::_pem_to_binary($data);
	541	$data = pem_to_der($data);
541	542	my ($typ, $skip, $pubkey) = Crypt::PK::_ssh_parse($data);
542	543	return $self->import_key_raw($pubkey, "$2") if $pubkey && $typ =~ /^ecdsa-(.+?)-(.*)$/;
543	544	}
544	545	elsif ($data =~ /(ecdsa-\S+)\s+(\S+)/) {
545		$data = _decode_base64("$2");
	546	$data = decode_b64("$2");
546	547	my ($typ, $skip, $pubkey) = Crypt::PK::_ssh_parse($data);
547	548	return $self->import_key_raw($pubkey, "$2") if $pubkey && $typ =~ /^ecdsa-(.+?)-(.*)$/;
548	549	}

+24

-23

lib/Crypt/PK/RSA.pm less more

7	7	our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
8	8	our @EXPORT = qw();
9	9
10		use CryptX qw( _encode_base64url _decode_base64url _encode_base64 _decode_base64 _encode_json _decode_json);
	10	use Carp;
	11	use CryptX qw(_encode_json _decode_json);
	12	use Crypt::Digest 'digest_data';
	13	use Crypt::Misc qw(read_rawfile encode_b64u decode_b64u encode_b64 decode_b64 pem_to_der der_to_pem);
11	14	use Crypt::PK;
12		use Crypt::Digest 'digest_data';
13		use Carp;
14	15
15	16	sub new {
16	17	my ($class, $f, $p) = @_;

27	28	# PKCS#1 RSAPrivateKey** (PEM header: BEGIN RSA PRIVATE KEY)
28	29	# PKCS#8 PrivateKeyInfo* (PEM header: BEGIN PRIVATE KEY)
29	30	# PKCS#8 EncryptedPrivateKeyInfo** (PEM header: BEGIN ENCRYPTED PRIVATE KEY)
30		return Crypt::PK::_asn1_to_pem($key, "RSA PRIVATE KEY", $password, $cipher) if $type eq 'private';
	31	return der_to_pem($key, "RSA PRIVATE KEY", $password, $cipher) if $type eq 'private';
31	32
32	33	# PKCS#1 RSAPublicKey* (PEM header: BEGIN RSA PUBLIC KEY)
33		return Crypt::PK::_asn1_to_pem($key, "RSA PUBLIC KEY") if $type eq 'public';
	34	return der_to_pem($key, "RSA PUBLIC KEY") if $type eq 'public';
34	35	# X.509 SubjectPublicKeyInfo** (PEM header: BEGIN PUBLIC KEY)
35		return Crypt::PK::_asn1_to_pem($key, "PUBLIC KEY") if $type eq 'public_x509';
	36	return der_to_pem($key, "PUBLIC KEY") if $type eq 'public_x509';
36	37	}
37	38
38	39	sub export_key_jwk {

45	46	}
46	47	my $hash = {
47	48	kty => "RSA",
48		n => _encode_base64url(pack("H*", $kh->{N})),
49		e => _encode_base64url(pack("H*", $kh->{e})),
50		d => _encode_base64url(pack("H*", $kh->{d})),
51		p => _encode_base64url(pack("H*", $kh->{p})),
52		q => _encode_base64url(pack("H*", $kh->{q})),
53		dp => _encode_base64url(pack("H*", $kh->{dP})),
54		dq => _encode_base64url(pack("H*", $kh->{dQ})),
55		qi => _encode_base64url(pack("H*", $kh->{qP})),
	49	n => encode_b64u(pack("H*", $kh->{N})),
	50	e => encode_b64u(pack("H*", $kh->{e})),
	51	d => encode_b64u(pack("H*", $kh->{d})),
	52	p => encode_b64u(pack("H*", $kh->{p})),
	53	q => encode_b64u(pack("H*", $kh->{q})),
	54	dp => encode_b64u(pack("H*", $kh->{dP})),
	55	dq => encode_b64u(pack("H*", $kh->{dQ})),
	56	qi => encode_b64u(pack("H*", $kh->{qP})),
56	57	};
57	58	return $wanthash ? $hash : _encode_json($hash);
58	59	}

63	64	}
64	65	my $hash = {
65	66	kty => "RSA",
66		n => _encode_base64url(pack("H*", $kh->{N})),
67		e => _encode_base64url(pack("H*", $kh->{e})),
	67	n => encode_b64u(pack("H*", $kh->{N})),
	68	e => encode_b64u(pack("H*", $kh->{e})),
68	69	};
69	70	return $wanthash ? $hash : _encode_json($hash);
70	71	}

83	84	if ($key->{n} && $key->{e} && $key->{kty} && $key->{kty} eq "RSA") {
84	85	# hash with items corresponding to JSON Web Key (JWK)
85	86	for (qw/n e d p q dp dq qi/) {
86		$key->{$_} = eval { unpack("H*", _decode_base64url($key->{$_})) } if exists $key->{$_};
	87	$key->{$_} = eval { unpack("H*", decode_b64u($key->{$_})) } if exists $key->{$_};
87	88	}
88	89	return $self->_import_hex($key->{n}, $key->{e}, $key->{d}, $key->{p}, $key->{q}, $key->{dp}, $key->{dq}, $key->{qi});
89	90	}

95	96	$data = $$key;
96	97	}
97	98	elsif (-f $key) {
98		$data = Crypt::PK::_slurp_file($key);
	99	$data = read_rawfile($key);
99	100	}
100	101	else {
101	102	croak "FATAL: non-existing file '$key'";

106	107	# PKCS#1 RSAPublicKey (PEM header: BEGIN RSA PUBLIC KEY)
107	108	# PKCS#1 RSAPrivateKey (PEM header: BEGIN RSA PRIVATE KEY)
108	109	# X.509 SubjectPublicKeyInfo (PEM header: BEGIN PUBLIC KEY)
109		$data = Crypt::PK::_pem_to_binary($data, $password);
	110	$data = pem_to_der($data, $password);
110	111	return $self->_import($data) if $data;
111	112	}
112	113	elsif ($data =~ /-----BEGIN PRIVATE KEY-----(.*?)-----END/sg) {
113	114	# PKCS#8 PrivateKeyInfo (PEM header: BEGIN PRIVATE KEY)
114		$data = Crypt::PK::_pem_to_binary($data, $password);
	115	$data = pem_to_der($data, $password);
115	116	return $self->_import_pkcs8($data) if $data;
116	117	}
117	118	elsif ($data =~ /-----BEGIN ENCRYPTED PRIVATE KEY-----(.*?)-----END/sg) {

124	125	my $h = _decode_json($json);
125	126	if ($h && $h->{kty} eq "RSA") {
126	127	for (qw/n e d p q dp dq qi/) {
127		$h->{$_} = eval { unpack("H*", _decode_base64url($h->{$_})) } if exists $h->{$_};
	128	$h->{$_} = eval { unpack("H*", decode_b64u($h->{$_})) } if exists $h->{$_};
128	129	}
129	130	return $self->_import_hex($h->{n}, $h->{e}, $h->{d}, $h->{p}, $h->{q}, $h->{dp}, $h->{dq}, $h->{qi}) if $h->{n} && $h->{e};
130	131	}
131	132	}
132	133	elsif ($data =~ /---- BEGIN SSH2 PUBLIC KEY ----(.*?)---- END SSH2 PUBLIC KEY ----/sg) {
133		$data = Crypt::PK::_pem_to_binary($data);
	134	$data = pem_to_der($data);
134	135	my ($typ, $N, $e) = Crypt::PK::_ssh_parse($data);
135	136	return $self->_import_hex(unpack("H", $e), unpack("H", $N)) if $typ && $e && $N && $typ eq 'ssh-rsa';
136	137	}
137	138	elsif ($data =~ /ssh-rsa\s+(\S+)/) {
138		$data = _decode_base64("$1");
	139	$data = decode_b64("$1");
139	140	my ($typ, $N, $e) = Crypt::PK::_ssh_parse($data);
140	141	return $self->_import_hex(unpack("H", $e), unpack("H", $N)) if $typ && $e && $N && $typ eq 'ssh-rsa';
141	142	}

-104

lib/Crypt/PK.pm less more

3	3	use warnings;
4	4
5	5	use Carp;
6		use CryptX qw( _encode_base64 _decode_base64 );
7		use Crypt::Digest qw(digest_data);
8		use Crypt::Mode::CBC;
9		use Crypt::Mode::CFB;
10		use Crypt::Mode::ECB;
11		use Crypt::Mode::OFB;
12		use Crypt::Cipher;
13		use Crypt::PRNG 'random_bytes';
14
15		sub _slurp_file {
16		my $f = shift;
17		croak "FATAL: non-existing file '$f'" unless -f $f;
18		local $/ = undef;
19		open my $fh, "<", $f or croak "FATAL: couldn't open file: $!";
20		binmode $fh;
21		my $string = readline($fh);
22		close $fh;
23		return $string;
24		}
25
26		sub _name2mode {
27		my $cipher_name = uc(shift);
28		my %trans = ( 'DES-EDE3' => 'DES_EDE' );
29
30		my ($cipher, undef, $klen, $mode) = $cipher_name =~ /^(AES\|CAMELLIA\|DES\|DES-EDE3\|SEED)(-(\d+))?-(CBC\|CFB\|ECB\|OFB)$/i;
31		croak "FATAL: unsupported cipher '$cipher_name'" unless $cipher && $mode;
32		$cipher = $trans{$cipher} \|\| $cipher;
33		$klen = $klen ? int($klen/8) : Crypt::Cipher::min_keysize($cipher);
34		my $ilen = Crypt::Cipher::blocksize($cipher);
35		croak "FATAL: unsupported cipher '$cipher_name'" unless $klen && $ilen;
36
37		return (Crypt::Mode::CBC->new($cipher), $klen, $ilen) if $mode eq 'CBC';
38		return (Crypt::Mode::CFB->new($cipher), $klen, $ilen) if $mode eq 'CFB';
39		return (Crypt::Mode::ECB->new($cipher), $klen, $ilen) if $mode eq 'ECB';
40		return (Crypt::Mode::OFB->new($cipher), $klen, $ilen) if $mode eq 'OFB';
41		}
42
43		sub _password2key {
44		my ($password, $klen, $iv, $hash) = @_;
45		my $salt = substr($iv, 0, 8);
46		my $key = '';
47		while (length($key) < $klen) {
48		$key .= digest_data($hash, $key . $password . $salt);
49		}
50		return substr($key, 0, $klen);
51		}
52
53		sub _pem_to_binary {
54		my ($data, $password) = @_;
55
56		my ($begin, $obj1, $content, $end, $obj2) = $data =~ m/(----[- ]BEGIN ([^\r\n\-]+KEY)[ -]----)(.*?)(----[- ]END ([^\r\n\-]+)[ -]----)/s;
57		return undef unless $content;
58		$content =~ s/^\s+//sg;
59		$content =~ s/\s+$//sg;
60		$content =~ s/\r\n/\n/sg; # CR-LF >> LF
61		$content =~ s/\r/\n/sg; # CR >> LF
62		$content =~ s/\\\n//sg; # \ + LF
63
64		my ($headers, undef, $b64) = $content =~ /^(([^:]+:.?\n))(.*)$/s;
65		return undef unless $b64;
66		my $binary = _decode_base64($b64);
67		return undef unless $binary;
68
69		my ($ptype, $cipher_name, $iv_hex);
70		for my $h (split /\n/, ($headers\|\|'')) {
71		my ($k, $v) = split /:\s*/, $h, 2;
72		$ptype = $v if $k eq 'Proc-Type';
73		($cipher_name, $iv_hex) = $v =~ /^\s(.?)\s,\s([0-9a-fA-F]+)\s*$/ if $k eq 'DEK-Info';
74		}
75
76		if ($cipher_name && $iv_hex && $ptype && $ptype eq '4,ENCRYPTED') {
77		croak "FATAL: encrypted PEM but no password provided" unless defined $password;
78		my $iv = pack("H*", $iv_hex);
79		my ($mode, $klen) = _name2mode($cipher_name);
80		my $key = _password2key($password, $klen, $iv, 'MD5');
81		return $mode->decrypt($binary, $key, $iv);
82		}
83
84		return $binary;
85		}
86
87		sub _asn1_to_pem {
88		my ($data, $header_name, $password, $cipher_name) = @_;
89		my $content = $data;
90		my @headers;
91
92		if ($password) {
93		$cipher_name \|\|= 'AES-256-CBC';
94		my ($mode, $klen, $ilen) = _name2mode($cipher_name);
95		my $iv = random_bytes($ilen);
96		my $key = _password2key($password, $klen, $iv, 'MD5');
97		$content = $mode->encrypt($data, $key, $iv);
98		push @headers, 'Proc-Type: 4,ENCRYPTED', "DEK-Info: ".uc($cipher_name).",".unpack("H*", $iv);
99		}
100
101		my $rv = "-----BEGIN $header_name-----\n";
102		if (@headers) {
103		$rv .= "$_\n" for @headers;
104		$rv .= "\n";
105		}
106		my @l = _encode_base64($content) =~ /.{1,64}/g;
107		$rv .= join("\n", @l) . "\n";
108		$rv .= "-----END $header_name-----\n";
109		}
110	6
111	7	sub _ssh_parse {
112	8	my $raw = shift;

-4

lib/Crypt/PRNG.pm less more

7	7	our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
8	8	our @EXPORT = qw();
9	9
10		use CryptX qw(_encode_base64 _encode_base64url);
	10	#BEWARE: cannot use Crypt::Misc qw(encode_b64 encode_b64u);
	11	use CryptX;
11	12
12	13	sub _trans_prng_name {
13	14	my $name = shift;

31	32
32	33	sub bytes_hex { return unpack("H*", shift->bytes(shift)) }
33	34
34		sub bytes_b64 { return _encode_base64(shift->bytes(shift)) }
35
36		sub bytes_b64u { return _encode_base64url(shift->bytes(shift)) }
	35	sub bytes_b64 { return CryptX::_encode_base64(shift->bytes(shift)) }
	36
	37	sub bytes_b64u { return CryptX::_encode_base64url(shift->bytes(shift)) }
37	38
38	39	sub string {
39	40	my ($self, $len) = @_;

-2

lib/CryptX.pm less more

2	2	use strict;
3	3	use warnings ;
4	4
5		our $VERSION = '0.028_03';
	5	our $VERSION = '0.028_04';
6	6
7	7	use base qw(Exporter);
8		our @EXPORT_OK = qw( _encode_base64url _decode_base64url _encode_base64 _decode_base64 _decode_json _encode_json);
	8	our @EXPORT_OK = qw( _decode_json _encode_json);
9	9
10	10	require XSLoader;
11	11	XSLoader::load('CryptX', $VERSION);

-1

t/003_all_pm_pod.t less more

4	4
5	5	plan skip_all => "File::Find not installed" unless eval { require File::Find };
6	6	plan skip_all => "Test::Pod not installed" unless eval { require Test::Pod };
7		plan tests => 73;
	7	plan tests => 74;
8	8
9	9	my @files;
10	10	File::Find::find({ wanted=>sub { push @files, $_ if /\.pm$/ }, no_chdir=>1 }, 'lib');

+25

-0

t/crypt-misc.t less more

	0	use strict;
	1	use warnings;
	2	use Test::More tests => 15;
	3
	4	use Crypt::Misc qw(encode_b64 decode_b64 encode_b64u decode_b64u pem_to_der der_to_pem read_rawfile write_rawfile slow_eq);
	5
	6	is(encode_b64(pack("H*","702fad4215a04a657f011d3ea5711879c696788c91d2")), "cC+tQhWgSmV/AR0+pXEYecaWeIyR0g==", "encode_b64");
	7	is(unpack("H*", decode_b64("cC+tQhWgSmV/AR0+pXEYecaWeIyR0g==")), "702fad4215a04a657f011d3ea5711879c696788c91d2", "decode_b64");
	8	is(unpack("H*", decode_b64("cC+tQhWgSmV/AR0+pXEYecaWeIyR0g")), "702fad4215a04a657f011d3ea5711879c696788c91d2", "decode_b64/relaxed1");
	9	is(unpack("H*", decode_b64("cC+tQh\nWgSmV/A\nR0+pXEYec\naWeIyR0g")), "702fad4215a04a657f011d3ea5711879c696788c91d2", "decode_b64/relaxed2");
	10	is(unpack("H*", decode_b64("cC+tQh\r\nWgSmV/A\r\nR0+pXEYec\r\naWeIyR0g")), "702fad4215a04a657f011d3ea5711879c696788c91d2", "decode_b64/relaxed3");
	11	is(unpack("H*", decode_b64("cC+tQh WgSmV/A R0+pXEYec aWeIyR0g")), "702fad4215a04a657f011d3ea5711879c696788c91d2", "decode_b64/relaxed4");
	12	is(unpack("H*", decode_b64("cC+tQh\tWgSmV/A\tR0+pXEYec\taWeIyR0g")), "702fad4215a04a657f011d3ea5711879c696788c91d2", "decode_b64/relaxed5");
	13
	14	is(encode_b64u(pack("H*","702fad4215a04a657f011d3ea5711879c696788c91d2")), "cC-tQhWgSmV_AR0-pXEYecaWeIyR0g", "encode_b64u");
	15	is(unpack("H*", decode_b64u("cC-tQhWgSmV_AR0-pXEYecaWeIyR0g")), "702fad4215a04a657f011d3ea5711879c696788c91d2", "decode_b64u");
	16	is(unpack("H*", decode_b64u("cC-tQhWgSmV_AR0-pXEYecaWeIyR0g==")), "702fad4215a04a657f011d3ea5711879c696788c91d2", "decode_b64u/padded");
	17	is(unpack("H*", decode_b64u("cC-tQh\nWgSmV_A\nR0-pXEYec\naWeIyR0g")), "702fad4215a04a657f011d3ea5711879c696788c91d2", "decode_b64u/relaxed1");
	18	is(unpack("H*", decode_b64u("cC-tQh\r\nWgSmV_A\r\nR0-pXEYec\r\naWeIyR0g")), "702fad4215a04a657f011d3ea5711879c696788c91d2", "decode_b64u/relaxed2");
	19	is(unpack("H*", decode_b64u("cC-tQh WgSmV_A R0-pXEYec aWeIyR0g")), "702fad4215a04a657f011d3ea5711879c696788c91d2", "decode_b64u/relaxed3");
	20	is(unpack("H*", decode_b64u("cC-tQh\tWgSmV_A\tR0-pXEYec\taWeIyR0g")), "702fad4215a04a657f011d3ea5711879c696788c91d2", "decode_b64u/relaxed4");
	21
	22	write_rawfile("tmp.$$.file", "a\nb\r\nc\rd\te");
	23	ok(slow_eq(read_rawfile("tmp.$$.file"), "a\nb\r\nc\rd\te"), "slow_eq + read_rawfile + write_rawfile");
	24	unlink "tmp.$$.file";

-7

t/pk_rsa_test_vectors_openssl.t less more

2	2
3	3	use Test::More tests => 246;
4	4	use Crypt::PK::RSA;
5		use CryptX qw(_decode_base64);
	5	use Crypt::Misc qw(decode_b64);
6	6
7	7	my $data = [ #test vectors generated by: OpenSSL 1.0.1e 11 Feb 2013
8	8	{ID=>'key-512-1',SIZE=>512,PRI=>'632B6C7F984EA022C2B3D507A3A0886678F8794B151E16EA696883B0305B2A984EB6CBE3CC56025852CCE742A51655A8CADE5BE73EBE75CEEF70CAA72F82A801',PUB=>'C5920D48C0DB954D7834FA7C74DB7C91714C97EF2DA4B35DA302D75A0E08AD3B7C05296533C71DF5045F66DDD2E1F9A0D487CDAFE4137214F7764D2BE25D0D29',SIGSHA1=>'v/ZzE0JT8xakMsHhh2qVcEm1r/odXZAfSr+JK/B2trzq3UrzUwYfWgM7NtO2L6kU0wyNCVTy+gMpGECfaAEiqA==',SIGSHA256=>'pjOjBMaGXx7XZ+uNgfszCD1yy9WeLwgdM/1eP987j+s6hGaIjHKOm2PAxXZ6cEqYi1QQsMybe3F9UhL2b5ws9A==',SIGSHA512=>'',ENC=>'mQw7zaZdwthCgpBdV/BxdzMp9yUMOSFHogB7DvwCYztRlqlc8bXnJUsa6yasLARaN2rbb3dyIN+apNW+wZkvrg==',PRIDER=>'MIIBOgIBAAJBAMWSDUjA25VNeDT6fHTbfJFxTJfvLaSzXaMC11oOCK07fAUpZTPHHfUEX2bd0uH5oNSHza/kE3IU93ZNK+JdDSkCAwEAAQJAYytsf5hOoCLCs9UHo6CIZnj4eUsVHhbqaWiDsDBbKphOtsvjzFYCWFLM50KlFlWoyt5b5z6+dc7vcMqnL4KoAQIhAPLj363QXovzYxztngqfImgsXOSBwgTpmnKylb6oSbfVAiEA0Dv50hhAHRneuo0M4nat47wIvc5MmJVS4ecf1N4bngUCIEbwgRLd6c9MPaVkTSVjBwSP+G2Q7F7M75wSRqQRuL4lAiEAqDzcsQ6gtiJRnh0ZnNpP0Z/43AkSP3DdfuByClTMsVUCIH3TYvzcDPJO1K9KTLNXGOSAhkh3QE3wJBLZCI7jm3LY',PUBDER=>'MFwwDQYJKoZIhvcNAQEBBQADSwAwSAJBAMWSDUjA25VNeDT6fHTbfJFxTJfvLaSzXaMC11oOCK07fAUpZTPHHfUEX2bd0uH5oNSHza/kE3IU93ZNK+JdDSkCAwEAAQ=='},

45	45
46	46	sub test_rsa {
47	47	my $h = shift;
48		my $rsa_pri = Crypt::PK::RSA->new->import_key(\_decode_base64($h->{PRIDER}));
49		my $rsa_pub = Crypt::PK::RSA->new->import_key(\_decode_base64($h->{PUBDER}));
	48	my $rsa_pri = Crypt::PK::RSA->new->import_key(\decode_b64($h->{PRIDER}));
	49	my $rsa_pub = Crypt::PK::RSA->new->import_key(\decode_b64($h->{PUBDER}));
50	50	my $rsa_pri_h = $rsa_pri->key2hash;
51	51	my $rsa_pub_h = $rsa_pub->key2hash;
52	52	is($rsa_pri_h->{d}, $h->{PRI}, "$h->{ID}/PRI");
53	53	is($rsa_pri_h->{N}, $h->{PUB}, "$h->{ID}/PUB");
54	54	is($rsa_pub_h->{N}, $h->{PUB}, "$h->{ID}/PUB");
55		is( $rsa_pri->decrypt(_decode_base64($h->{ENC}), 'v1.5'), 'test-data', "$h->{ID}/ENC") \|\| return 0;
56		ok( $rsa_pub->verify_message(_decode_base64($h->{SIGSHA1}), 'test-data', 'SHA1', 'v1.5'), "$h->{ID}/SIGSHA1") \|\| return 0;
57		ok( $rsa_pub->verify_message(_decode_base64($h->{SIGSHA256}), 'test-data', 'SHA256', 'v1.5'), "$h->{ID}/SIGSHA256") \|\| return 0;
	55	is( $rsa_pri->decrypt(decode_b64($h->{ENC}), 'v1.5'), 'test-data', "$h->{ID}/ENC") \|\| return 0;
	56	ok( $rsa_pub->verify_message(decode_b64($h->{SIGSHA1}), 'test-data', 'SHA1', 'v1.5'), "$h->{ID}/SIGSHA1") \|\| return 0;
	57	ok( $rsa_pub->verify_message(decode_b64($h->{SIGSHA256}), 'test-data', 'SHA256', 'v1.5'), "$h->{ID}/SIGSHA256") \|\| return 0;
58	58	return 1 if !$h->{SIGSHA512}; #SHA512 might be too big for short RSA keys
59		ok( $rsa_pub->verify_message(_decode_base64($h->{SIGSHA512}), 'test-data', 'SHA512', 'v1.5'), "$h->{ID}/SIGSHA512") \|\| return 0;
	59	ok( $rsa_pub->verify_message(decode_b64($h->{SIGSHA512}), 'test-data', 'SHA512', 'v1.5'), "$h->{ID}/SIGSHA512") \|\| return 0;
60	60	return 1;
61	61	}
62	62