File Coverage

blib/lib/Crypt/CVS.pm

Criterion	Covered	Total	%
statement	24	24	100.0
branch	2	2	100.0
condition			n/a
subroutine	7	7	100.0
pod	0	2	0.0
total	33	35	94.2

package Crypt::CVS;
BEGIN {
  $Crypt::CVS::AUTHORITY = 'cpan:AVAR';
}
BEGIN {
  $Crypt::CVS::VERSION = '0.03';
}

use strict;
use warnings;
use base 'Exporter';

our @EXPORT    = ();
our @EXPORT_OK = qw(scramble descramble);
our %EXPORT_TAGS;
$EXPORT_TAGS{'all'} = \@EXPORT_OK;

# This table is from src/scramble.c in the CVS source
our @SHIFTS = (
    0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15,
    16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
    114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
    111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
    41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
    125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
    36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
    58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
    225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
    199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
    174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
    207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
    192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
    227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
    182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
    243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
);

sub scramble
{
    my ($str) = @_;
    my @str = unpack "C*", $str;
    my $ret = join '', map { chr $SHIFTS[$_] } @str;
    return "A$ret";
}

sub descramble
{
    my ($str) = @_;

    # This should never happen, the same password format (A) has been
    # used by CVS since the beginning of time
    {
        my $fmt = substr($str, 0, 1);
        die "invalid password format `$fmt'" unless $fmt eq 'A';
    }

    my @str = unpack "C*", substr($str, 1);
    my $ret = join '', map { chr $SHIFTS[$_] } @str;
    return $ret;
}

1;

__END__