File Coverage

blib/lib/Crypt/PBE/PBES1.pm
Criterion Covered Total %
statement 46 46 100.0
branch 5 6 83.3
condition 4 10 40.0
subroutine 10 10 100.0
pod 3 3 100.0
total 68 75 90.6


line stmt bran cond sub pod time code
1             package Crypt::PBE::PBES1;
2              
3 3     3   762 use strict;
  3         6  
  3         84  
4 3     3   14 use warnings;
  3         5  
  3         68  
5              
6 3     3   14 use Carp;
  3         4  
  3         147  
7 3     3   1912 use Crypt::CBC;
  3         15473  
  3         99  
8              
9 3     3   1427 use Crypt::PBE::PBKDF1;
  3         8  
  3         176  
10              
11 3     3   20 use Exporter qw(import);
  3         4  
  3         148  
12              
13             our $VERSION = '0.101';
14              
15 3     3   18 use constant ENCRYPTION => { 'des' => 'Crypt::DES', };
  3         7  
  3         1767  
16              
17             sub new {
18              
19 2     2 1 621 my ( $class, %params ) = @_;
20              
21             my $self = {
22             password => $params{password} || croak('Specify password'),
23             count => $params{count} || 1_000,
24             hash => $params{hash} || croak('Specify hash digest algorithm'),
25 2   33     21 encryption => $params{encryption} || 'des', # TODO add support for RC2
      50        
      33        
      50        
26             dk_len => 0,
27             };
28              
29 2         4 my $dk_len = 20;
30 2 50       8 $dk_len = 16 if ( $self->{hash} =~ '/md(2|5)/' );
31              
32 2         4 $self->{dk_len} = $dk_len;
33              
34 2         7 return bless $self, $class;
35              
36             }
37              
38             sub encrypt {
39              
40 2     2 1 367 my ( $self, $data ) = @_;
41              
42 2         19 my $salt = Crypt::CBC->random_bytes(8);
43             my $DK = pbkdf1(
44             hash => $self->{hash},
45             password => $self->{password},
46             salt => $salt,
47             count => $self->{count},
48             dk_len => $self->{dl_len}
49 2         1503 );
50              
51 2         8 my $key = substr( $DK, 0, 8 );
52 2         4 my $iv = substr( $DK, 8, 8 );
53              
54 2         14 my $crypt = Crypt::CBC->new(
55             -key => $key,
56             -iv => $iv,
57             -literal_key => 1,
58             -header => 'none',
59             -cipher => 'Crypt::DES',
60             );
61              
62 2         3665 my @result = ( $salt, $crypt->encrypt($data) );
63              
64 2 100       356 return wantarray ? @result : join( '', @result );
65              
66             }
67              
68             sub decrypt {
69              
70 2     2 1 10 my ( $self, $salt, $encrypted ) = @_;
71              
72 2 100       10 if ( !$encrypted ) {
73 1         2 my $data = $salt;
74 1         2 $salt = substr( $data, 0, 8 );
75 1         2 $encrypted = substr( $data, 8 );
76             }
77              
78             my $DK = pbkdf1(
79             hash => $self->{hash},
80             password => $self->{password},
81             salt => $salt,
82             count => $self->{count},
83             dk_len => $self->{dl_len}
84 2         12 );
85              
86 2         9 my $key = substr( $DK, 0, 8 );
87 2         5 my $iv = substr( $DK, 8, 8 );
88              
89 2         11 my $ciper = Crypt::CBC->new(
90             -key => $key,
91             -iv => $iv,
92             -literal_key => 1,
93             -header => 'none',
94             -cipher => 'Crypt::DES',
95             );
96              
97 2         260 my $decrypted = $ciper->decrypt($encrypted);
98              
99 2         317 return $decrypted;
100              
101             }
102              
103             1;
104              
105             =head1 NAME
106              
107             Crypt::PBE::PBES1 - Perl extension for PKCS #5 Password-Based Encryption Schema 1 (PBES1)
108              
109             =head1 SYNOPSIS
110              
111             use Crypt::PBE::PBES1;
112              
113             my $pbes1 = Crypt::PBE::PBES1->new(
114             'hash' => 'md5',
115             'encryption' => 'des',
116             'password' => 'mypassword'
117             );
118              
119             my $encrypted = $pbes1->encrypt('secret');
120             say $pbes1->decrypt($encrypted); # secret
121              
122              
123             =head1 DESCRIPTION
124              
125             PBES1 combines the PBKDF1 function with an underlying block cipher, which shall
126             be either DES or RC2 in cipher block chaining (CBC) mode.
127              
128             PBES1 is recommended only for compatibility with existing applications, since it
129             supports only two underlying encryption schemes, each of which has a key size
130             (56 or 64 bits) that may not be large enough for some applications.
131              
132              
133             =head1 CONSTRUCTOR
134              
135             =head2 Crypt::PBE::PBES1->new ( %params )
136              
137             Params:
138              
139             =over 4
140              
141             =item * C : The password to use for the derivation
142              
143             =item * C : Hash algorithm ("md2", "md5 or "sha1")
144              
145             =item * C : Encryption method ("des")
146              
147             =item * C : The number of internal iteractions to perform for the derivation key (default "1_000")
148              
149             =back
150              
151              
152             =head1 METHODS
153              
154             =head2 $pbes1->encrypt( $message )
155              
156             Perform the encryption and return the encrypted message in binary format.
157              
158             You can encode the encrypted message in Base64 using L:
159              
160             $b64_encrypted = encode_base64 $pbes1->encrypt('secret');
161              
162              
163             =head2 $pbes1->decrypt( $data )
164              
165             Perform the decryption and return the original message.
166              
167             $decrypted = $pbes1->decrypt($encrypted);
168              
169             You can decode the Base64 encrypted message using L:
170              
171             $decrypted = $pbes1->decrypt(decode_base64 $b64_encrypted);
172              
173              
174             =head1 SUPPORT
175              
176             =head2 Bugs / Feature Requests
177              
178             Please report any bugs or feature requests through the issue tracker
179             at L.
180             You will be notified automatically of any progress on your issue.
181              
182             =head2 Source Code
183              
184             This is open source software. The code repository is available for
185             public review and contribution under the terms of the license.
186              
187             L
188              
189             git clone https://github.com/giterlizzi/perl-Crypt-PBE.git
190              
191              
192             =head1 AUTHOR
193              
194             =over 4
195              
196             =item * Giuseppe Di Terlizzi
197              
198             =back
199              
200              
201             =head1 SEE ALSO
202              
203             =over 4
204              
205             =item L
206              
207             =item L
208              
209             =item [RFC2898] PKCS #5: Password-Based Cryptography Specification Version 2.0 (L)
210              
211             =item [RFC8018] PKCS #5: Password-Based Cryptography Specification Version 2.1 (L)
212              
213             =back
214              
215              
216             =head1 LICENSE AND COPYRIGHT
217              
218             This software is copyright (c) 2020 by Giuseppe Di Terlizzi.
219              
220             This is free software; you can redistribute it and/or modify it under
221             the same terms as the Perl 5 programming language system itself.
222              
223             =cut