File Coverage

blib/lib/CTK/Crypt.pm
Criterion Covered Total %
statement 24 101 23.7
branch 0 40 0.0
condition 0 22 0.0
subroutine 8 13 61.5
pod 5 5 100.0
total 37 181 20.4


line stmt bran cond sub pod time code
1             package CTK::Crypt;
2 1     1   1063 use strict;
  1         2  
  1         32  
3 1     1   6 use utf8;
  1         2  
  1         8  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             CTK::Crypt - Cryptography frontend module
10              
11             =head1 VERSION
12              
13             Version 1.73
14              
15             =head1 SYNOPSIS
16              
17             use CTK::Util qw/gpg_init gpg_encrypt gpg_decrypt/;
18              
19             my $gpg_instance = gpg_init(
20             -gpgbin => "/usr/bin/gpg",
21             -gpghome => "/gpg/homedir",
22             -gpgconf => "/gpg/homedir/gpg.conf",
23             -gpgopts => ["verbose", "yes"],
24             -publickey => "/path/to/public.key",
25             -privatekey => "/path/to/private.key",
26             -password => "passphrase", # Key password
27             -recipient => "anonymous@example.com", # Email, user id, keyid, or keygrip
28             ) or die("Can't create crypter");
29              
30             gpg_encrypt(
31             -infile => "MyDocument.txt",
32             -outfile=> "MyDocument.txt.asc",
33             -armor => "yes",
34             ) or die( $CTK::Crypt::ERROR );
35              
36             gpg_decrypt(
37             -infile => "MyDocument.txt.asc",
38             -outfile=> "MyDocument.txt",
39             ) or die( $CTK::Crypt::ERROR );
40              
41             tcd_encrypt( "file.txt", "file.tcd" )
42             or die( $CTK::Crypt::ERROR );
43              
44             tcd_decrypt( "file.tcd", "file.txt" )
45             or die( $CTK::Crypt::ERROR );
46              
47             =head1 DESCRIPTION
48              
49             Cryptography frontend module
50              
51             =over 8
52              
53             =item B
54              
55             my $gpg_instance = gpg_init(
56             -gpgbin => "/usr/bin/gpg",
57             -gpghome => "/gpg/homedir",
58             -gpgconf => "/gpg/homedir/gpg.conf",
59             -gpgopts => ["verbose", "yes"],
60             -publickey => "/path/to/public.key",
61             -privatekey => "/path/to/private.key",
62             -password => "passphrase", # Key password
63             -recipient => "anonymous@example.com", # Email, user id, keyid, or keygrip
64             ) or die("Can't create crypter");
65              
66             Initialize GPG instance
67              
68             See L
69              
70             =item B
71              
72             $gpg_instance->decrypt(
73             -infile => "MyDocument.txt.asc",
74             -outfile=> "MyDocument.txt",
75             ) or die( $CTK::Crypt::ERROR );
76              
77             GPG (PGP) Decrypting the files
78              
79             See L
80              
81             =item B
82              
83             $gpg_instance->encrypt(
84             -infile => "MyDocument.txt",
85             -outfile=> "MyDocument.txt.asc",
86             -armor => "yes",
87             ) or die( $CTK::Crypt::ERROR );
88              
89             GPG (PGP) Encrypting the files
90              
91             See L
92              
93             =item B
94              
95             tcd_decrypt( "file.tcd", "file.txt" )
96             or die( $CTK::Crypt::ERROR );
97              
98             TCD04 Decrypting files
99              
100             =item B
101              
102             tcd_encrypt( "file.txt", "file.tcd" )
103             or die( $CTK::Crypt::ERROR );
104              
105             TCD04 Encrypting files
106              
107             =back
108              
109             =head1 TAGS
110              
111             =over 8
112              
113             =item B<:all>
114              
115             Will be exported all functions
116              
117             =item B<:tcd04>
118              
119             Will be exported following functions:
120              
121             tcd_encrypt, tcd_decrypt
122              
123             =item B<:gpg>
124              
125             Will be exported following functions:
126              
127             gpg_init, gpg_encrypt, gpg_decrypt
128              
129             =back
130              
131             =head1 HISTORY
132              
133             See C file
134              
135             =head1 DEPENDENCIES
136              
137             L, L
138              
139             =head1 TO DO
140              
141             See C file
142              
143             =head1 BUGS
144              
145             * none noted
146              
147             =head1 SEE ALSO
148              
149             L, L
150              
151             =head1 AUTHOR
152              
153             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
154              
155             =head1 COPYRIGHT
156              
157             Copyright (C) 1998-2022 D&D Corporation. All Rights Reserved
158              
159             =head1 LICENSE
160              
161             This program is free software; you can redistribute it and/or
162             modify it under the same terms as Perl itself.
163              
164             See C file and L
165              
166             =cut
167              
168 1     1   44 use vars qw/$VERSION @EXPORT_OK %EXPORT_TAGS $ERROR/;
  1         3  
  1         86  
169             $VERSION = '1.73';
170              
171 1     1   6 use base qw/Exporter/;
  1         2  
  1         149  
172              
173 1     1   6 use IO::File;
  1         2  
  1         181  
174 1     1   401 use CTK::Crypt::GPG;
  1         5  
  1         40  
175 1     1   605 use CTK::Crypt::TCD04;
  1         4  
  1         33  
176              
177 1     1   6 use constant BUFFER_SIZE => 32 * 1024; # 32kB
  1         28  
  1         776  
178              
179             @EXPORT_OK = (qw/
180             gpg_init gpg_encrypt gpg_decrypt
181             tcd_encrypt tcd_decrypt
182             /);
183              
184             %EXPORT_TAGS = (
185             tcd04 => [qw/tcd_encrypt tcd_decrypt/],
186             gpg => [qw/gpg_init gpg_encrypt gpg_decrypt/],
187             all => [@EXPORT_OK],
188             );
189              
190             my $GPG_INSTANCE;
191              
192             sub gpg_init {
193 0     0 1   return $GPG_INSTANCE = CTK::Crypt::GPG->new(@_);
194             }
195             sub gpg_encrypt {
196 0     0 1   $ERROR = "";
197 0           my $st = $GPG_INSTANCE->encrypt(@_);
198 0 0         $ERROR = $GPG_INSTANCE->error unless $st;
199 0           return $st;
200             }
201             sub gpg_decrypt {
202 0     0 1   $ERROR = "";
203 0           my $st = $GPG_INSTANCE->decrypt(@_);
204 0 0         $ERROR = $GPG_INSTANCE->error unless $st;
205 0           return $st;
206             }
207             sub tcd_encrypt {
208 0     0 1   my $filein = shift;
209 0           my $fileout = shift;
210 0 0 0       unless (defined($filein) && length($filein) && -e $filein) {
      0        
211 0   0       $ERROR = sprintf("File not found \"%s\"", $filein // "");
212 0           return 0;
213             }
214 0 0 0       unless (defined($fileout) && length($fileout)) {
215 0           $ERROR = "Incorrect target file";
216 0           return 0;
217             }
218 0           $ERROR = "";
219              
220 0 0         my $infh = IO::File->new($filein, "r") or do {
221 0           $ERROR = sprintf("Can't open file \"%s\": %s", $filein, $!);
222 0           return 0;
223             };
224 0 0         $infh->binmode() or do {
225 0           $ERROR = sprintf("Can't switch to binmode file \"%s\": %s", $filein, $!);
226 0           return 0;
227             };
228 0 0         my $outfh = IO::File->new($fileout, "w") or do {
229 0           $ERROR = sprintf("Can't open file \"%s\": %s", $fileout, $!);
230 0           return 0;
231             };
232 0 0         $outfh->binmode() or do {
233 0           $ERROR = sprintf("Can't switch to binmode file \"%s\": %s", $fileout, $!);
234 0           return 0;
235             };
236              
237 0           my $tcd = CTK::Crypt::TCD04->new;
238 0           my $buf;
239 0           while ( $infh->read ( $buf, BUFFER_SIZE/2 ) ) {
240 0 0         $outfh->write($tcd->encrypt($buf), BUFFER_SIZE) or do {
241 0           $ERROR = sprintf("Can't write file \"%s\": %s", $fileout, $!);
242 0           return 0;
243             };
244             }
245              
246 0 0         $outfh->close or do {
247 0           $ERROR = sprintf("Can't close file \"%s\": %s", $fileout, $!);
248 0           return 0;
249             };
250 0 0         $infh->close or do {
251 0           $ERROR = sprintf("Can't close file \"%s\": %s", $filein, $!);
252 0           return 0;
253             };
254 0           return 1;
255             }
256             sub tcd_decrypt {
257 0     0 1   my $filein = shift;
258 0           my $fileout = shift;
259 0 0 0       unless (defined($filein) && length($filein) && -e $filein) {
      0        
260 0   0       $ERROR = sprintf("File not found \"%s\"", $filein // "");
261 0           return 0;
262             }
263 0 0 0       unless (defined($fileout) && length($fileout)) {
264 0           $ERROR = "Incorrect target file";
265 0           return 0;
266             }
267 0           $ERROR = "";
268              
269 0 0         my $infh = IO::File->new($filein, "r") or do {
270 0           $ERROR = sprintf("Can't open file \"%s\": %s", $filein, $!);
271 0           return 0;
272             };
273 0 0         $infh->binmode() or do {
274 0           $ERROR = sprintf("Can't switch to binmode file \"%s\": %s", $filein, $!);
275 0           return 0;
276             };
277 0 0         my $outfh = IO::File->new($fileout, "w") or do {
278 0           $ERROR = sprintf("Can't open file \"%s\": %s", $fileout, $!);
279 0           return 0;
280             };
281 0 0         $outfh->binmode() or do {
282 0           $ERROR = sprintf("Can't switch to binmode file \"%s\": %s", $fileout, $!);
283 0           return 0;
284             };
285              
286 0           my $tcd = CTK::Crypt::TCD04->new;
287 0           my $buf;
288 0           while ( $infh->read ( $buf, BUFFER_SIZE ) ) {
289 0 0         $outfh->write($tcd->decrypt($buf), BUFFER_SIZE/2) or do {
290 0           $ERROR = sprintf("Can't write file \"%s\": %s", $fileout, $!);
291 0           return 0;
292             };
293             }
294              
295 0 0         $outfh->close or do {
296 0           $ERROR = sprintf("Can't close file \"%s\": %s", $fileout, $!);
297 0           return 0;
298             };
299 0 0         $infh->close or do {
300 0           $ERROR = sprintf("Can't close file \"%s\": %s", $filein, $!);
301 0           return 0;
302             };
303 0           return 1;
304             }
305              
306             1;
307              
308             __END__