File Coverage

blib/lib/Crypt/SSSS.pm

Criterion	Covered	Total	%
statement	73	75	97.3
branch	12	18	66.6
condition	11	16	68.7
subroutine	7	7	100.0
pod	2	3	66.6
total	105	119	88.2

package Crypt::SSSS;

use strict;
use warnings;

our $VERSION = 0.1;

require Exporter;

our @ISA    = qw(Exporter);
our @EXPORT = qw(ssss_distribute ssss_reconstruct);

use POSIX qw(ceil pow);
use Crypt::SSSS::Message;

require Carp;

sub ssss_distribute(%) {
    my (%data) = @_;

    my $message = $data{message} or Carp::croak 'Missed "message" argument';

    my $k = $data{k} or Carp::croak 'Missed "k" argument';
    my $n = $data{n} || $k;

    my $p = $data{p} || 257;

    my $shares = {};

    for my $x (1 .. $n) {
        $shares->{$x} = Crypt::SSSS::Message->new(p => $p);
    }

    my $chunks;
    if (my $ref = ref $message) {
        Carp::croak qw/"message" has unsupported type "$ref"/
          unless $ref eq 'Crypt::SSSS::Message';

        $chunks = $message->get_data;
    }
    else {
        $chunks = [unpack (($data{pack_size} || 'C') . '*', $message)];
    }
    while (@$chunks) {
        my @a = splice @$chunks, 0, $k;

        for my $x (1 .. $n) {

            my $res = 0;
            for my $pow (0 .. $k - 1) {
                $res += ($a[$pow] || 0) * pow($x, $pow);

            }

            # print "$x → ", $res % $p, "\n";
            $shares->{$x}->push_data($res % $p);
        }
    }

    $shares;
}

sub ssss_reconstruct(%) {
    my (%data) = @_;

    my $shares = $data{shares};
    my $p = $data{p} || '257';

    my @xs = keys %$shares;
    my $k = @xs;

    my %mdata;
    foreach my $x (@xs) {
        $mdata{$x} =
          Crypt::SSSS::Message->build_from_binary($p, $shares->{$x})
          ->get_data;
    }

    my $size = $data{size} || @{(values %mdata)[0]};

    my $message = '';

    my $pack_size = $data{pack_size} || 'C';

    for (my $l = 0; $l < $size; $l++) {
        my @fx = ();
        for my $i (@xs) {

            # Plynom
            my @pl = (1);

            # Divider
            my $d = 1;
            for my $j (@xs) {
                if ($j != $i) {

                    # Multiply polinoms
                    my @opl = @pl;
                    unshift @pl, 0;
                    for (my $i = 0; $i < @opl; $i++) {
                        $pl[$i] += -$j * $opl[$i];
                    }
                    $d *= $i - $j;
                }
            }
            $d += $p if $d < 0;

            my ($m) = extended_gcb($d, $p);
            $m += $p if $m < 0;

            while (@fx < @pl) {
                push @fx, 0;
            }

            # Add our polynom (multiplied by constant)
            for (my $j = 0; $j < @pl; $j++) {
                $fx[$j] += $m * $mdata{$i}->[$l] * $pl[$j];
            }
        }

        for (@fx) {
            $_ %= $p;
            $_ += $p if $_ < 0;
        }

        for (my $i = 0; $i < $k; $i++) {
            $message .= pack $pack_size, $fx[$i];
        }
    }

    $message;
}

sub extended_gcb {
    my ($a, $b) = @_;

    return (1, 0) if $b == 0;

    my $q = int($a / $b);
    my $r = $a % $b;
    my ($s, $t) = extended_gcb($b, $r);

    return ($t, $s - $q * $t);
}

1;
__END__