File Coverage

blib/lib/Filter/Crypto/CryptFile.pm
Criterion Covered Total %
statement 99 134 73.8
branch 47 110 42.7
condition 20 27 74.0
subroutine 16 16 100.0
pod 1 1 100.0
total 183 288 63.5


line stmt bran cond sub pod time code
1             #===============================================================================
2             #
3             # CryptFile/lib/Filter/Crypto/CryptFile.pm
4             #
5             # DESCRIPTION
6             # Module providing the means to convert files to/from an encrypted state in
7             # which they can be run via Filter::Crypto::Decrypt.
8             #
9             # COPYRIGHT
10             # Copyright (C) 2004-2009, 2012-2014 Steve Hay. All rights reserved.
11             #
12             # LICENCE
13             # This module is free software; you can redistribute it and/or modify it under
14             # the same terms as Perl itself, i.e. under the terms of either the GNU
15             # General Public License or the Artistic License, as specified in the LICENCE
16             # file.
17             #
18             #===============================================================================
19              
20             package Filter::Crypto::CryptFile;
21              
22 7     7   432537 use 5.008001;
  7         84  
23              
24 7     7   36 use strict;
  7         14  
  7         155  
25 7     7   29 use warnings;
  7         13  
  7         298  
26              
27 7     7   44 use Carp qw(carp croak);
  7         14  
  7         443  
28 7     7   51 use Exporter qw();
  7         14  
  7         202  
29 7     7   45 use Fcntl qw(:DEFAULT :flock);
  7         14  
  7         3085  
30 7     7   54 use Scalar::Util qw(reftype);
  7         13  
  7         371  
31 7     7   47 use XSLoader qw();
  7         15  
  7         1082  
32              
33             ## no critic (Subroutines::ProhibitSubroutinePrototypes)
34              
35             sub crypt_file($;$$);
36             sub _isa_cryptmode($);
37             sub _isa_filehandle($);
38             sub _isa_filename($);
39              
40             #===============================================================================
41             # MODULE INITIALIZATION
42             #===============================================================================
43              
44             our(@ISA, @EXPORT, @EXPORT_OK, $VERSION);
45              
46             BEGIN {
47 7     7   142 @ISA = qw(Exporter);
48              
49 7         68 @EXPORT = qw(
50             CRYPT_MODE_AUTO
51             CRYPT_MODE_ENCRYPT
52             CRYPT_MODE_DECRYPT
53             CRYPT_MODE_ENCRYPTED
54             CRYPT_MODE_DECRYPTED
55             crypt_file
56             );
57              
58 7         15 @EXPORT_OK = qw(
59             $ErrStr
60             );
61              
62 7         20 $VERSION = '2.10';
63              
64 7         20527 XSLoader::load(__PACKAGE__, $VERSION);
65             }
66              
67             # Last error message.
68             our $ErrStr = '';
69              
70             #===============================================================================
71             # PUBLIC API
72             #===============================================================================
73              
74             # Autoload the CRYPT_MODE_* flags from the constant() XS function.
75              
76             sub AUTOLOAD {
77 16     16   4239 our $AUTOLOAD;
78              
79             # Get the name of the constant to generate a subroutine for.
80 16         148 (my $constant = $AUTOLOAD) =~ s/^.*:://o;
81              
82             # Avoid deep recursion on AUTOLOAD() if constant() is not defined.
83 16 50       102 croak('Unexpected error in AUTOLOAD(): constant() is not defined')
84             if $constant eq 'constant';
85              
86 16         155 my($error, $value) = constant($constant);
87              
88             # Handle any error from looking up the constant.
89 16 50       49 croak($error) if $error;
90              
91             # Generate an in-line subroutine returning the required value.
92             {
93 7     7   63 no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict)
  7         14  
  7         9672  
  16         26  
94 16     179   201 *$AUTOLOAD = sub { return $value };
  179         15935  
95             }
96              
97             # Switch to the subroutine that we have just generated.
98 16         91 goto &$AUTOLOAD;
99             }
100              
101             sub crypt_file($;$$) {
102 97     97 1 155197 $ErrStr = '';
103 97         731 my $num_bytes = 0;
104              
105 97 100 66     1253 if ( @_ == 1 or
      100        
      100        
106             (@_ == 2 and (not defined $_[1] or $_[1] eq '' or
107             _isa_cryptmode($_[1]) )))
108             {
109 81         513 my($fh, $file, $opened, $flocked);
110 81 100       771 if (_isa_filehandle($_[0])) {
    50          
111 4         12 $fh = $_[0];
112 4         7 $opened = 0;
113             }
114             elsif (_isa_filename($_[0])) {
115 77         279 $file = $_[0];
116 77 100       6079 unless (sysopen $fh, $file, O_RDWR | O_BINARY) {
117 1         24 $ErrStr = "Can't open file '$file' for updating: $!";
118 1         6 return;
119             }
120 76         553 $opened = 1;
121             }
122             else {
123 0         0 croak("'$_[0]' is not a filehandle or a file name");
124             }
125              
126 80 50       1310 if (-f $fh) {
127 80 50       1222 unless (flock $fh, LOCK_EX | LOCK_NB) {
128 0         0 $ErrStr = "Can't acquire exclusive lock on update " .
129             "filehandle: $!";
130 0         0 local($!, $^E);
131 0 0       0 close $fh if $opened;
132 0         0 return;
133             }
134 80         348 $flocked = 1;
135             }
136              
137 80 100 66     743 my $crypt_mode = (@_ == 2 and defined $_[1] and $_[1] ne '')
138             ? $_[1] : CRYPT_MODE_AUTO();
139              
140 80 50       437054 unless (_crypt_fh($fh, $crypt_mode, $num_bytes)) {
141 0         0 local($!, $^E);
142 0 0       0 $opened ? close $fh : $flocked ? flock $fh, LOCK_UN : 1;
    0          
143 0         0 return;
144             }
145              
146 80 100       845 if ($opened) {
    50          
147 76 50       7509 close $fh or
148             carp("Can't close file '$file' after updating: $!");
149             }
150             elsif ($flocked) {
151 4 50       136 flock $fh, LOCK_UN or
152             carp("Can't release lock on filehandle after updating: $!");
153             }
154             }
155             else {
156 16         72 my($in_fh, $in_file, $in_opened, $in_flocked);
157 16 100       175 if (_isa_filehandle($_[0])) {
    50          
158 8         38 $in_fh = $_[0];
159 8         105 $in_opened = 0;
160             }
161             elsif (_isa_filename($_[0])) {
162 8         51 $in_file = $_[0];
163 8 50       626 unless (sysopen $in_fh, $in_file, O_RDONLY | O_BINARY) {
164 0         0 $ErrStr = "Can't open input file '$in_file' for reading: $!";
165 0         0 return;
166             }
167 8         54 $in_opened = 1;
168             }
169             else {
170 0         0 croak("'$_[0]' is not a filehandle or a file name");
171             }
172              
173 16 50       372 if (-f $in_fh) {
174 16 50       269 unless (flock $in_fh, LOCK_SH | LOCK_NB) {
175 0         0 $ErrStr = "Can't acquire shared lock on input filehandle: $!";
176 0         0 local($!, $^E);
177 0 0       0 close $in_fh if $in_opened;
178 0         0 return;
179             }
180 16         66 $in_flocked = 1;
181             }
182              
183 16         48 my($out_fh, $out_file, $out_opened, $out_flocked);
184 16 100       58 if (_isa_filehandle($_[1])) {
    50          
185 8         48 $out_fh = $_[1];
186 8         17 $out_opened = 0;
187             }
188             elsif (_isa_filename($_[1])) {
189 8         40 $out_file = $_[1];
190 8 50       893 unless (sysopen $out_fh, $out_file,
191             O_WRONLY | O_CREAT | O_TRUNC | O_BINARY)
192             {
193 0         0 $ErrStr = "Can't open output file '$out_file' for writing: $!";
194 0         0 local($!, $^E);
195 0 0       0 $in_opened ? close $in_fh
    0          
196             : $in_flocked ? flock $in_fh, LOCK_UN : 1;
197 0         0 return;
198             }
199 8         53 $out_opened = 1;
200             }
201             else {
202 0         0 local($!, $^E);
203 0 0       0 $in_opened ? close $in_fh : $in_flocked ? flock $in_fh, LOCK_UN : 1;
    0          
204 0         0 croak("'$_[1]' is not a valid crypt mode or a filehandle or a " .
205             "file name");
206             }
207              
208 16 50       202 if (-f $out_fh) {
209 16 50       194 unless (flock $out_fh, LOCK_EX | LOCK_NB) {
210 0         0 $ErrStr = "Can't acquire exclusive lock on output " .
211             "filehandle: $!";
212 0         0 local($!, $^E);
213 0 0       0 $in_opened ? close $in_fh
    0          
214             : $in_flocked ? flock $in_fh, LOCK_UN : 1;
215 0 0       0 close $out_fh if $out_opened;
216 0         0 return;
217             }
218 16         59 $out_flocked = 1;
219             }
220              
221 16         37 my $crypt_mode;
222 16 100 66     297 if (@_ == 3 and defined $_[2] and $_[2] ne '') {
      66        
223 12 50       103 if (_isa_cryptmode($_[2])) {
224 12         34 $crypt_mode = $_[2];
225             }
226             else {
227 0         0 local($!, $^E);
228 0 0       0 $in_opened ? close $in_fh
    0          
229             : $in_flocked ? flock $in_fh, LOCK_UN : 1;
230 0 0       0 $out_opened ? close $out_fh
    0          
231             : $out_flocked ? flock $out_fh, LOCK_UN : 1;
232 0         0 croak("'$_[2]' is not a valid crypt mode");
233             }
234             }
235             else {
236 4         16 $crypt_mode = CRYPT_MODE_AUTO();
237             }
238              
239 16 50       87059 unless (_crypt_fhs($in_fh, $out_fh, $crypt_mode, $num_bytes)) {
240 0         0 local($!, $^E);
241 0 0       0 $in_opened ? close $in_fh
    0          
242             : $in_flocked ? flock $in_fh, LOCK_UN : 1;
243 0 0       0 $out_opened ? close $out_fh
    0          
244             : $out_flocked ? flock $out_fh, LOCK_UN : 1;
245 0         0 return;
246             }
247              
248 16 100       209 if ($in_opened) {
    50          
249 8 50       154 close $in_fh or
250             carp("Can't close input file '$in_file' after reading: $!");
251             }
252             elsif ($in_flocked) {
253 8 50       107 flock $in_fh, LOCK_UN or
254             carp("Can't release lock on input filehandle after " .
255             "reading: $!");
256             }
257              
258 16 100       107 if ($out_opened) {
    50          
259 8 50       423 close $out_fh or
260             carp("Can't close output file '$out_file' after writing: $!");
261             }
262             elsif ($out_flocked) {
263 8 50       413 flock $out_fh, LOCK_UN or
264             carp("Can't release lock on output filehandle after " .
265             "writing: $!");
266             }
267             }
268              
269 96 100       1707 return $num_bytes ? $num_bytes : '0E0';
270             }
271              
272             #===============================================================================
273             # PRIVATE API
274             #===============================================================================
275              
276             sub _isa_cryptmode($) {
277 24     24   116 my $mode = shift;
278              
279 24   100     90 return(($mode eq CRYPT_MODE_AUTO() or
280             $mode eq CRYPT_MODE_ENCRYPT() or
281             $mode eq CRYPT_MODE_DECRYPT() or
282             $mode eq CRYPT_MODE_ENCRYPTED() or
283             $mode eq CRYPT_MODE_DECRYPTED() ));
284             }
285              
286             sub _isa_filehandle($) {
287 113     113   704 my $fh = shift;
288              
289 113   66     3346 return((( ref $fh and reftype($fh) eq 'GLOB') or
290             (not ref $fh and reftype(\$fh) eq 'GLOB') ) and
291             defined fileno $fh);
292             }
293              
294             sub _isa_filename($) {
295 93     93   310 my $name = shift;
296              
297 93   33     1343 return(not ref $name and reftype(\$name) eq 'SCALAR');
298             }
299              
300             1;
301              
302             __END__