File Coverage

blib/lib/Crypt/Solitaire.pm

Criterion	Covered	Total	%
statement	37	53	69.8
branch	11	16	68.7
condition			n/a
subroutine	5	8	62.5
pod	1	6	16.6
total	54	83	65.0

#------------------------------------------------------------------------------#
# Crypt::Solitaire
#
# Solitaire cryptosystem, as used in Neal Stephenson's novel _Cryptonomicon_
# Designed by Bruce Schneier (President, Counterpane Systems)
# Original Perl Code by Ian Goldberg , 19980817
# Minor changes and module-ification by Kurt Kincaid
#
#       Last Modified:  28-Nov-2001 04:20:10 PM
#       Copyright(c) 2001, Kurt Kincaid. All Rights Reserved.
#
# This is free software and may be modified and/or redistributed under the
# same terms as perl itself.
#------------------------------------------------------------------------------#

package Crypt::Solitaire;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $multFactor $k $D $c $v $Deck $text $passphrase $mode $class );

require Exporter;

@ISA       = qw(Exporter AutoLoader);
@EXPORT_OK = qw(Pontifex);

$VERSION = "2.0";

sub new {
    ( $class, $passphrase ) = @_;
    $passphrase =~ y/a-z/A-Z/;
    $passphrase =~ s/[A-Z]/$k=ord($&)-64,&e/eg;
    my $self = bless {}, $class;
    return $self;
}

sub encrypt {
    my $self = shift;
    ( $text, $passphrase ) = @_;
    return Pontifex( $text, $passphrase, "e" );
}

sub decrypt {
    my $self = shift;
    ( $text, $passphrase ) = @_;
    return Pontifex( $text, $passphrase, "d" );
}

sub Pontifex {
    if ( ref $_[ 0 ] ) {
        my $self = shift;
    }
    ( $text, $passphrase, $mode ) = @_;
    if ( $mode =~ /^e/i ) {
        $multFactor = 1;
    } elsif ( $mode =~ /^d/i ) {
        $multFactor = -1;
    } else {
        return undef;
    }

    $Deck = pack( 'C*', 33 .. 86 );

    $k = 0;

    $text =~ y/a-z/A-Z/;
    $text =~ y/A-Z//dc;
    if ( $multFactor == 1 ) {
        $text .= "X" while length( $text ) % 5;
    }
    $text =~ s/./chr((ord($&)-13+$multFactor*&e)%26+65)/eg;

    if ( $multFactor == -1 ) {
        $text =~ s/X*$//;
    }
    $text =~ s/.{5}/$& /g;
    return $text;
}

sub v {
    $v = ord( substr( $D, $_[ 0 ] ) ) - 32;
    $v > 53 ? 53 : $v;
}

sub e {
    $D =~ s/(.*)U$/U$1/;
    $D =~ s/U(.)/$1U/;

    $D =~ s/(.*)V$/V$1/;
    $D =~ s/V(.)/$1V/;
    $D =~ s/(.*)V$/V$1/;
    $D =~ s/V(.)/$1V/;

    $D =~ s/(.*)([UV].*[UV])(.*)/$3$2$1/;

    $c = &v( 53 );
    $D =~ s/(.{$c})(.*)(.)/$2$1$3/;

    if ( $k ) {
        $D =~ s/(.{$k})(.*)(.)/$2$1$3/;
        return;
    }

    $c = &v( &v( 0 ) );

    $c > 52 ? &e : $c;
}

1;
__END__