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

# -*-cperl-*-
#
# Crypt::Unsnoopable - Completely unsnoopable messaging
# Copyright (c) 2017 Ashish Gulhati
#
# $Id: lib/Crypt/Unsnoopable.pm v1.008 Sun Dec 10 01:36:27 PST 2017 $

package Crypt::Unsnoopable;

use warnings;
use strict;
use Bytes::Random::Secure;
use Persistence::Object::Simple;
use Compress::Zlib;
use Math::Prime::Util qw(fromdigits todigitstring);

use vars qw( $VERSION $AUTOLOAD @ISA @EXPORT_OK );

@ISA = qw(Exporter);
@EXPORT_OK = qw(dec heX);

our ( $VERSION ) = '$Revision: 1.008 $' =~ /\s+([\d\.]+)/;

sub new {
  my ($class, %arg) = @_;
  my $self = bless { debug     => $arg{Debug} || 1,
		     db        => $arg{DB} || '/tmp/.unsnoopable',
		   }, $class;
  $self->{otps} = { map { my $o = new Persistence::Object::Simple ('__Fn' => $_); (pack('H*', $o->{name}) => $o) }
		    glob("$self->{db}/*.otp") };
  return $self;
}

sub otpgen {
  my ($self, $size, $name) = @_;
  my $r = Bytes::Random::Secure->new( Bits => 256 );
  my $pad = $r->bytes($size+4);
  local $SIG{'__WARN__'} = sub { };
  my $pad_id = dec(unpack('H*', substr($pad, 0, 4, '')));
  my $pad_obj = new Persistence::Object::Simple ('__Fn' => $self->db . "/$pad_id.otp");
  $pad_obj->{id} = $pad_id;
  $pad_obj->{pad} = unpack('H*', $pad);
  $pad_obj->{name} = unpack('H*', $name);
  $pad_obj->commit;
  $self->{otps}->{$name} = $pad_obj;
  return $pad_obj;
}

sub add {
  my ($self, $pad, $name) = @_;
  local $SIG{'__WARN__'} = sub { };
  my $hexpad = heX($pad); my $pad_id = dec(substr($hexpad, 0, 8, ''));
  my $padfn = $self->db . "/$pad_id.otp";
  return if -e $padfn;
  my $pad_obj = new Persistence::Object::Simple ('__Fn' => $padfn);
  $pad_obj->{id} = $pad_id;
  $pad_obj->{pad} = $hexpad;
  $pad_obj->{name} = unpack('H*', $name);
  $pad_obj->commit;
  $self->{otps}->{$name} = $pad_obj;
}

sub encrypt {
  my ($self, $pad_name, $msg) = @_;
  return unless exists $self->{otps}->{$pad_name};
  my $pad = $self->{otps}->{$pad_name};
  my $compressed = compress($msg);
  return unless (length($compressed)+4)*2 <= length($pad->{pad});
  my $key = pack('H*',substr($pad->{pad}, 0, (length($compressed)+4)*2, ''));
  $self->otps->{$pad_name}->commit;
  my $encrypted = "\x00\x00\x00\x00$compressed" ^ "$key";
  local $SIG{'__WARN__'} = sub { };
  dec(heX($pad->{id}) . unpack('H*',$encrypted));
}

sub decrypt {
  my ($self, $ciphertext) = @_;
  local $SIG{'__WARN__'} = sub { };
  my $hex = heX($ciphertext);
  my $pad_id = dec(substr($hex, 0, 8, ''));
  my $pad_start = substr($hex, 0, 8);
  my $pads = $self->otps;
  return unless my ($pad_name) = grep { $pads->{$_}->{id} eq $pad_id } keys %$pads;
  my $pad = $pads->{$pad_name}; my $padlen = length($pad->{pad});
  return unless substr($pad->{pad}, 0, 8) eq $pad_start;
  return unless length($hex) <= $padlen;
  my $encrypted = pack('H*',$hex);
  my $key = pack('H*',substr($pad->{pad}, 0, length($hex), ''));
  $pad->commit;
  my $compressed = "$encrypted" ^ "$key";
  my $decrypted = uncompress(substr($compressed,4));
  return ($decrypted, $pad, $padlen/2);
}

sub AUTOLOAD {
  my $self = shift; (my $auto = $AUTOLOAD) =~ s/.*:://;
  return if $auto eq 'DESTROY';
  if ($auto =~ /^(db|debug|otps)$/x) {
    $self->{$auto} = shift if (defined $_[0]);
    return $self->{$auto};
  }
  else {
    die "Could not AUTOLOAD method $auto.";
  }
}

sub _diag {
  my $self = shift;
  print STDERR @_ if $self->debug;
}

sub dec {
  fromdigits(shift, 16);
}

sub heX {
  todigitstring(shift, 16)
}

1; # End of Crypt::Unsnoopable

__END__