File Coverage

blib/lib/Net/IPMessenger/Encrypt.pm
Criterion Covered Total %
statement 17 71 23.9
branch 1 16 6.2
condition n/a
subroutine 5 10 50.0
pod 6 6 100.0
total 29 103 28.1


line stmt bran cond sub pod time code
1             package Net::IPMessenger::Encrypt;
2              
3 2     2   11 use warnings;
  2         4  
  2         73  
4 2     2   11 use strict;
  2         4  
  2         73  
5 2     2   1055 use Net::IPMessenger::EncryptOption;
  2         5  
  2         58  
6 2     2   12 use base qw( Class::Accessor::Fast );
  2         4  
  2         2130  
7              
8             __PACKAGE__->mk_accessors(
9             qw( exponent modulus private_key
10             support_encryption attach )
11             );
12              
13             my $RSA_KEY_SIZE = 1024;
14             my $IV = "\0\0\0\0\0\0\0\0";
15              
16             sub new {
17 3     3 1 6 my $class = shift;
18 3         6 my %args = @_;
19             # needs those modules for encryption support
20 3         6 eval {
21 3         2078 require Crypt::Blowfish;
22 0         0 require Crypt::CBC;
23 0         0 require Crypt::OpenSSL::Bignum;
24 0         0 require Crypt::OpenSSL::RSA;
25             };
26              
27 3 50       26 return if $@;
28 0           my $self = {};
29 0           bless $self, $class;
30              
31 0           $self->support_encryption( $self->option->set_rsa_1024->set_blowfish_128 );
32 0           return $self;
33             }
34              
35             sub option {
36 0     0 1   my $self = shift;
37 0           return Net::IPMessenger::EncryptOption->new(shift);
38             }
39              
40             sub generate_keys {
41 0     0 1   my $self = shift;
42              
43 0 0         if ( $self->private_key ) {
44 0           return ( $self->exponent, $self->modulus );
45             }
46              
47 0           my $rsa_key_size;
48 0           my $option = $self->support_encryption;
49 0 0         if ( $option->get_rsa_2048 ) {
    0          
    0          
50 0           $rsa_key_size = 2048;
51             }
52             elsif ( $option->get_rsa_1024 ) {
53 0           $rsa_key_size = 1024;
54             }
55             elsif ( $option->get_rsa_512 ) {
56 0           $rsa_key_size = 512;
57             }
58              
59 0           my $rsa = Crypt::OpenSSL::RSA->generate_key($rsa_key_size);
60 0           my( $modulus, $exponent ) = $rsa->get_key_parameters;
61              
62 0           $self->private_key( $rsa->get_private_key_string );
63             return (
64 0           $self->exponent( $exponent->to_hex ),
65             $self->modulus( $modulus->to_hex )
66             );
67             }
68              
69             sub public_key_string {
70 0     0 1   my $self = shift;
71              
72 0           my( $exponent, $modulus ) = $self->generate_keys;
73 0           my $option = sprintf "%x:%d-%s",
74             $self->support_encryption, $exponent, $modulus;
75             }
76              
77             sub encrypt_message {
78 0     0 1   my( $self, $message, $pubkey ) = @_;
79              
80 0           my $option = $self->option( hex $pubkey->{option} );
81 0           my $blowfish_key_size;
82 0 0         if ( $option->get_blowfish_128 ) {
    0          
83 0           $blowfish_key_size = 128 / 8;
84             }
85             elsif ( $option->get_blowfish_256 ) {
86 0           $blowfish_key_size = 256 / 8;
87             }
88              
89 0           my $shared_key = Crypt::CBC->random_bytes($blowfish_key_size);
90 0           my $blowfish = Crypt::CBC->new(
91             -literal_key => 1,
92             -key => $shared_key,
93             -keysize => length $shared_key,
94             -cipher => 'Blowfish',
95             -padding => 'standard',
96             -iv => $IV,
97             -header => 'none',
98             );
99              
100 0           my $exponent = Crypt::OpenSSL::Bignum->new_from_hex( $pubkey->{exponent} );
101 0           my $modulus = Crypt::OpenSSL::Bignum->new_from_hex( $pubkey->{modulus} );
102 0           my $rsa_pub =
103             Crypt::OpenSSL::RSA->new_key_from_parameters( $modulus, $exponent );
104 0           $rsa_pub->use_pkcs1_padding;
105              
106             # encrypt key and message
107 0           my $cipher_key = $rsa_pub->encrypt($shared_key);
108 0           my $cipher_text = $blowfish->encrypt($message);
109              
110 0           return sprintf "%s:%s:%s", $pubkey->{option}, unpack( "H*", $cipher_key ),
111             unpack( "H*", $cipher_text );
112             }
113              
114             sub decrypt_message {
115 0     0 1   my( $self, $message ) = @_;
116 0 0         return $message unless defined $self->private_key;
117              
118 0           my( $enc_opt, $cipher_key, $cipher_text ) = split /\:/, $message, 3;
119 0           my $rsa = Crypt::OpenSSL::RSA->new_private_key( $self->private_key );
120 0           $rsa->use_pkcs1_padding;
121 0           my $shared_key = $rsa->decrypt( pack( "H*", $cipher_key ) );
122 0           my $blowfish = Crypt::CBC->new(
123             -literal_key => 1,
124             -key => $shared_key,
125             -keysize => length $shared_key,
126             -cipher => 'Blowfish',
127             -padding => 'standard',
128             -iv => $IV,
129             -header => 'none',
130             );
131             # XXX attach info not encrypted
132 0           my( $fileid, $attach ) = split /:/, $cipher_text, 2;
133 0           $fileid = substr $fileid, -1;
134 0           $attach = $fileid . ':' . $attach;
135              
136 0           my $decrypted = $blowfish->decrypt( pack( "H*", $cipher_text ) );
137             # delete null string
138 0           my($text) = split /\0/, $decrypted;
139 0           $self->attach($attach);
140 0           return $text;
141             }
142              
143             1;
144             __END__