package Crypt::RSA;
use strict;
use Carp qw( croak );

use vars qw( $INT_CLASS );
BEGIN {
    my @err;
    for my $mod (qw( Math::GMP Math::BigInt )) {
        eval "use $mod;";
        $INT_CLASS = $mod, last unless $@;
        push @err, $@;
    }
    die "Can't load a big integer class:\n@err"
        unless $INT_CLASS;
}

sub new {
    my($class, $key, $n) = @_;
    croak "usage: ", __PACKAGE__, "->new(\$key, \$n)"
        unless $key && $n;

    $key = "0$key" if length($key) % 2;
    ($key = unpack('B*', pack('H*', $key))) =~ s/^0*//;
    my @k = split //, $key;

    my $x = $INT_CLASS->new(0);
    $x = ($x*16) + hex $1 while $n =~ /(.)/g;

    bless { k => \@k, n => $x, n_len => length($n) }, $class;
}

sub encrypt { $_[0]->crypt($_[1], 0) }
sub decrypt { $_[0]->crypt($_[1], 1) }

sub crypt {
    my($rsa, $data, $d) = @_;

    ## Determine sizes of blocks that we read and write, respectively.
    ## $br is the size of the blocks we read; $bw is the size of the
    ## blocks we write. This depends on whether we're encrypting or
    ## decrypting ($d). Both values must be smaller than N,
    ## the RSA modulus.
    my $br = ((2*$d-1 + $rsa->{n_len})&~1)/2;
    my $bw = $br + 1 - 2*$d;

    my($offset, $len, $whole) = (0, length $data);
    while ($offset < $len) {
        my $chunk = substr $data, $offset, $br;
        $whole .= _crypt_chunk($chunk, $rsa->{k}, $rsa->{n}, $br, $bw)
+;
        $offset += $br;
    }
    $whole;
}

sub _crypt_chunk {
    my($chunk, $k, $n, $br, $bw) = @_;
    $chunk = substr $chunk . "\0"x$br, 0, $br;   # Pad with nulls.

    my $cl = $INT_CLASS->new(0);
    $cl = ($cl * 256) + ord $1 while $chunk =~ /(.)/sg;

    my $res = $INT_CLASS->new(1);
    for my $b (@$k) {
        $res = ($res * $res) % $n;
        $res = ($res * $cl) % $n if $b;
    }

    my($text, $t) = ("");
    for (1..$bw) {
        ($res, $t) = ($res/256, $res%256);
        $text = pack("C", $t) . $text;
    }
    $text;
}
[download]