File Coverage

blib/lib/Crypt/Mimetic/TEA.pm
Criterion Covered Total %
statement 10 65 15.3
branch 0 32 0.0
condition 0 12 0.0
subroutine 4 10 40.0
pod n/a
total 14 119 11.7


line stmt bran cond sub pod time code
1             =pod
2            
3             =head1 NAME
4            
5             Crypt::Mimetic::TEA - Tiny Encryption Algorithm
6            
7            
8             =head1 DESCRIPTION
9            
10             This module is a part of I.
11            
12             This modules uses TEA to encrypt blocks of bytes, so I needs @info containing generic-blocks-length and last-block-length (padlen) to know how decrypt a file. I and I always encrypt/decrypt a string as a single block.
13            
14             =cut
15            
16             package Crypt::Mimetic::TEA;
17 1     1   5 use strict;
  1         2  
  1         186  
18 1     1   6 use Error::Mimetic;
  1         2  
  1         6  
19 1     1   54 use vars qw($VERSION);
  1         1  
  1         987  
20             $VERSION = '0.01';
21            
22 1     1   414 eval 'use Crypt::Tea';
  0            
  0            
23             die ("Crypt::Tea required by ". __PACKAGE__) if $@;
24            
25             =pod
26            
27             =head1 PROCEDURAL INTERFACE
28            
29             =item string I ()
30            
31             Return a short description of algorithm
32            
33             =cut
34            
35             sub ShortDescr {
36 0     0     return "TEA - Tiny Encryption Algorithm.";
37             }
38            
39             =pod
40            
41             =item boolean I ()
42            
43             Return true if password is needed by this algorithm, false otherwise.
44             ('TEA' return always true)
45            
46             =cut
47            
48             sub PasswdNeeded {
49 0     0     return 1;
50             }
51            
52             =pod
53            
54             =item ($len,$blocklen,$padlen,[string]) I ($filename,$output,$algorithm,$key,@info)
55            
56             Encrypt a file with TEA algorithm. See I.
57            
58             =cut
59            
60             sub EncryptFile {
61 0     0     my ($filename,$output,$algorithm,$key,@info) = @_;
62 0           my ($buf, $text, $txt) = ("","","");
63 0           my ($len,$blocklen,$padlen) = (0,0,0);
64 0 0         if ($output) {
65 0 0         open(OUT,">>$output") or throw Error::Mimetic "Cannot open $output: $!";
66             }
67 0 0         open(IN,"$filename") or throw Error::Mimetic "Cannot open $filename: $!";
68 0 0 0       $key = Crypt::Mimetic::GetConfirmedPasswd() or throw Error::Mimetic "Password is needed" unless $key;
69 0           while ( read(IN,$buf,32768) ) {
70 0           $blocklen = $padlen;
71 0           $text = encrypt($buf,$key);
72 0           $padlen = length($text);
73 0           $len += $padlen;
74 0 0         if ($output) {
75 0           print OUT $text;
76             } else {
77 0           $txt .= $text;
78             }
79             }
80 0           close(IN);
81 0 0         if ($output) {
82 0           close(OUT);
83 0           return ($len,$blocklen,$padlen);
84             }
85 0           return ($len,$blocklen,$padlen,$txt);
86             }
87            
88             =pod
89            
90             =item string I ($string,$algorithm,$key,@info)
91            
92             Encrypt a string with TEA algorithm. See I.
93            
94             =cut
95            
96             sub EncryptString {
97 0     0     my ($string,$algorithm,$key,@info) = @_;
98 0 0 0       $key = Crypt::Mimetic::GetConfirmedPasswd() or throw Error::Mimetic "Password is needed" unless $key;
99 0           return &encrypt ($string, $key);
100             }
101            
102             =pod
103            
104             =item [string] I ($filename,$output,$offset,$len,$algorithm,$key,@info)
105            
106             Decrypt a file with TEA algorithm. See I.
107            
108             =cut
109            
110             sub DecryptFile {
111 0     0     my ($filename,$output,$offset,$len,$algorithm,$key,@info) = @_;
112 0           my ($blocklen,$padlen) = @info;
113 0           my ($buf, $text, $i, $txt) = ("","",0,"");
114 0           my $blocks = 0;
115 0 0         $blocks = int($len/$blocklen) if $blocklen;
116 0 0         if ($output) {
117 0 0         open(OUT,">$output") or throw Error::Mimetic "Cannot open $output: $!";
118             }
119 0 0         open(IN,"$filename") or throw Error::Mimetic "Cannot open $filename: $!";
120 0 0 0       $key = Crypt::Mimetic::GetPasswd() or throw Error::Mimetic "Password is needed" unless $key;
121 0           seek IN, $offset, 0;
122 0           for ($i = 0; $i < $blocks; $i++ ) {
123 0           read(IN,$buf,$blocklen);
124 0           $text = decrypt($buf,$key);
125 0 0         if ($output) {
126 0           print OUT $text;
127             } else {
128 0           $txt .= $text;
129             }
130             }
131 0           read(IN,$buf,$padlen);
132 0           $text = decrypt($buf,$key);
133 0 0         if ($output) {
134 0           print OUT $text;
135             } else {
136 0           $txt .= $text;
137             }
138 0           close(IN);
139 0 0         if ($output) {
140 0           close(OUT);
141             } else {
142 0           return $txt;
143             }
144             }
145            
146             =pod
147            
148             =item string I ($string,$algorithm,$key,@info)
149            
150             Decrypt a string with TEA algorithm. See I.
151            
152             =cut
153            
154             sub DecryptString {
155 0     0     my ($string,$algorithm,$key,@info) = @_;
156 0 0 0       $key = GetPasswd() or throw Error::Mimetic "Password is needed" unless $key;
157 0           return &decrypt ($string, $key);
158             }
159            
160             1;
161             __END__