File Coverage

blib/lib/Crypt/Unsnoopable.pm
Criterion Covered Total %
statement 21 90 23.3
branch 0 20 0.0
condition 0 4 0.0
subroutine 7 20 35.0
pod 5 7 71.4
total 33 141 23.4


line stmt bran cond sub pod time code
1             # -*-cperl-*-
2             #
3             # Crypt::Unsnoopable - Completely unsnoopable messaging
4             # Copyright (c) 2017 Ashish Gulhati
5             #
6             # $Id: lib/Crypt/Unsnoopable.pm v1.007 Sat Nov 4 20:41:32 PDT 2017 $
7              
8             package Crypt::Unsnoopable;
9              
10 1     1   70697 use warnings;
  1         2  
  1         33  
11 1     1   5 use strict;
  1         2  
  1         19  
12 1     1   338 use Bytes::Random::Secure;
  1         8733  
  1         53  
13 1     1   357 use Persistence::Object::Simple;
  1         9351  
  1         51  
14 1     1   475 use Compress::Zlib;
  1         75310  
  1         299  
15 1     1   1064 use Math::Prime::Util qw(fromdigits todigitstring);
  1         9854  
  1         8  
16              
17 1     1   254 use vars qw( $VERSION $AUTOLOAD @ISA @EXPORT_OK );
  1         4  
  1         1203  
18              
19             @ISA = qw(Exporter);
20             @EXPORT_OK = qw(dec heX);
21              
22             our ( $VERSION ) = '$Revision: 1.007 $' =~ /\s+([\d\.]+)/;
23              
24             sub new {
25 0     0 1   my ($class, %arg) = @_;
26             my $self = bless { debug => $arg{Debug} || 1,
27 0   0       db => $arg{DB} || '/tmp/.unsnoopable',
      0        
28             }, $class;
29 0           $self->{otps} = { map { my $o = new Persistence::Object::Simple ('__Fn' => $_); (pack('H*', $o->{name}) => $o) }
  0            
  0            
30             glob("$self->{db}/*.otp") };
31 0           return $self;
32             }
33              
34             sub otpgen {
35 0     0 1   my ($self, $size, $name) = @_;
36 0           my $r = Bytes::Random::Secure->new( Bits => 256 );
37 0           my $pad = $r->bytes($size+4);
38 0     0     local $SIG{'__WARN__'} = sub { };
39 0           my $pad_id = dec(unpack('H*', substr($pad, 0, 4, '')));
40 0           my $pad_obj = new Persistence::Object::Simple ('__Fn' => $self->db . "/$pad_id.otp");
41 0           $pad_obj->{id} = $pad_id;
42 0           $pad_obj->{pad} = unpack('H*', $pad);
43 0           $pad_obj->{name} = unpack('H*', $name);
44 0           $pad_obj->commit;
45 0           $self->{otps}->{$name} = $pad_obj;
46 0           return $pad_obj;
47             }
48              
49             sub add {
50 0     0 1   my ($self, $pad, $name) = @_;
51 0     0     local $SIG{'__WARN__'} = sub { };
52 0           my $hexpad = heX($pad); my $pad_id = dec(substr($hexpad, 0, 8, ''));
  0            
53 0           my $padfn = $self->db . "/$pad_id.otp";
54 0 0         return if -e $padfn;
55 0           my $pad_obj = new Persistence::Object::Simple ('__Fn' => $padfn);
56 0           $pad_obj->{id} = $pad_id;
57 0           $pad_obj->{pad} = $hexpad;
58 0           $pad_obj->{name} = unpack('H*', $name);
59 0           $pad_obj->commit;
60 0           $self->{otps}->{$name} = $pad_obj;
61             }
62              
63             sub encrypt {
64 0     0 1   my ($self, $pad_name, $msg) = @_;
65 0 0         return unless exists $self->{otps}->{$pad_name};
66 0           my $pad = $self->{otps}->{$pad_name};
67 0           my $compressed = compress($msg);
68 0 0         return unless (length($compressed)+4)*2 <= length($pad->{pad});
69 0           my $key = pack('H*',substr($pad->{pad}, 0, (length($compressed)+4)*2, ''));
70 0           $self->otps->{$pad_name}->commit;
71 0           my $encrypted = "\x00\x00\x00\x00$compressed" ^ "$key";
72 0     0     local $SIG{'__WARN__'} = sub { };
73 0           dec(heX($pad->{id}) . unpack('H*',$encrypted));
74             }
75              
76             sub decrypt {
77 0     0 1   my ($self, $ciphertext) = @_;
78 0     0     local $SIG{'__WARN__'} = sub { };
79 0           my $hex = heX($ciphertext);
80 0           my $pad_id = dec(substr($hex, 0, 8, ''));
81 0           my $pad_start = substr($hex, 0, 8);
82 0           my $pads = $self->otps;
83 0 0         return unless my ($pad_name) = grep { $pads->{$_}->{id} eq $pad_id } keys %$pads;
  0            
84 0           my $pad = $pads->{$pad_name}; my $padlen = length($pad->{pad});
  0            
85 0 0         return unless substr($pad->{pad}, 0, 8) eq $pad_start;
86 0 0         return unless length($hex) <= $padlen;
87 0           my $encrypted = pack('H*',$hex);
88 0           my $key = pack('H*',substr($pad->{pad}, 0, length($hex), ''));
89 0           $pad->commit;
90 0           my $compressed = "$encrypted" ^ "$key";
91 0           my $decrypted = uncompress(substr($compressed,4));
92 0           return ($decrypted, $pad, $padlen/2);
93             }
94              
95             sub AUTOLOAD {
96 0     0     my $self = shift; (my $auto = $AUTOLOAD) =~ s/.*:://;
  0            
97 0 0         return if $auto eq 'DESTROY';
98 0 0         if ($auto =~ /^(db|debug|otps)$/x) {
99 0 0         $self->{$auto} = shift if (defined $_[0]);
100 0           return $self->{$auto};
101             }
102             else {
103 0           die "Could not AUTOLOAD method $auto.";
104             }
105             }
106              
107             sub _diag {
108 0     0     my $self = shift;
109 0 0         print STDERR @_ if $self->debug;
110             }
111              
112             sub dec {
113 0     0 0   fromdigits(shift, 16);
114             }
115              
116             sub heX {
117 0     0 0   todigitstring(shift, 16)
118             }
119              
120             1; # End of Crypt::Unsnoopable
121              
122             __END__