Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Solitaire Crypto.

by one4k4 (Hermit)
on Mar 20, 2001 at 01:39 UTC ( #65552=sourcecode: print w/ replies, xml ) Need Help??

Category: Cryptography
Author/Contact Info Paul Crowley <paul@hedonism.demon.co.uk>
Description: I found this rather old (year or two) article on /., and thought this might be a worthy submission into the cryptography category. Its rather fun, and quite the interesting idea. See here for a more detailed description.
#!/usr/bin/perl
# 
# Perl implementation of Bruce Schneier's card cipher, "Solitaire".
# Paul Crowley <paul@hedonism.demon.co.uk>, 1999
#
# This program is adapted from Ian Goldberg's Perl implementation; I
# place my modifications in the public domain if I can though I'm not
# sure of the copyright status of the original
#
# It only really exists to verify the correctness of the C version.
# 
# http://www.hedonism.demon.co.uk/paul/solitaire/

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

sub cycle_deck {
    $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/;
}


sub key_char {
    my $kc = shift;
    my $k = ord($kc) - 64;

    cycle_deck();
    $D =~ s/(.{$k})(.*)(.)/$2$1$3/;
    print $D, " after $kc\n" if $verbose;
}

sub encrypt_char {
    my $c = shift;
    my $prnd;
    do {
    cycle_deck();
    $prnd = V(V(0));
    } while( $prnd == 53 );
    my $ec = chr((ord($c)-13 + $prnd)%26+65);
    print $D, " $c -> $ec\n" if $verbose;
    return $ec;
}

$verbose = 0;

while( $ARGV[0] =~ /^-/ ) {
    $arg = shift;
    if ($arg eq '-v') {
    $verbose = 1;
    } else {
    die "Unrecognised flag $arg, stopped";
    }
}
$p = shift;
$o = shift;

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

$p =~ y/a-z/A-Z/;
$p =~ s/[A-Z]/key_char($&)/eg;

if ($o =~ /^\d+$/) {
    $o = 'A' x $o;
    $old_len = length($o);
    $o =~ s/./encrypt_char($&)/eg;
    $o =~ tr/A-Z//s;
    $cc = $old_len - length($o);
    $n = $old_len -1;
    #$np = $n / 26;
    #$sd = sqrt($np * (25 / 26));

    print "Coincidences: $cc / $n\n";
    #print( ($cc - $np)/$sd, " SDs from mean\n");
} else {
    $o =~ tr/a-z/A-Z/;
    $o =~ tr/A-Z//cd;
    $o .= 'X' while length($o)%5;
    $o =~ s/./encrypt_char($&)/eg;
    $o =~ s/.{5}/$& /g;
    print $o, "\n";
}

Comment on Solitaire Crypto.
Download Code
Re: Solitaire Crypto.
by knobunc (Pilgrim) on Mar 20, 2001 at 19:42 UTC
    You might want to look over at Bruce Schneier's web site[1] for more information about the algorithm such as how to do it by hand with a deck of cards. Also on that site is his implementaion of the algorithm in Perl[2] that they released (interestingly, they have the following - 'Note: only the Perl implementation has been tested by Counterpane.').

    If you have not read Neal Stephenson's Cryptonomicon that this was developed for, I strongly recommend it as a good read.

    [1] http://www.counterpane.com/solitaire.html
    [2] http://www.counterpane.com/sol.pl

(fongsaiyuk)Re: Solitaire Crypto.
by fongsaiyuk (Pilgrim) on Mar 20, 2001 at 19:44 UTC
    I believe this algorithm was featured in Neal Stephenson's book, "Cryptonomicon", which IMHO should be required reading.

    He actually managed a real ending that didn't feel like it was slapped together!

    fong

Re: Solitaire Crypto.
by mugwumpjism (Hermit) on Jun 19, 2001 at 14:35 UTC

    ...and here's the same thing, but done in OO. Sorry, no POD :)

    #!/usr/bin/perl package Crypt::Pontifex; use strict; BEGIN { use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d +."."%02d" x $#r, @r }; # must be all one line, for MakeMaker @ISA = qw(Exporter); @EXPORT = qw(); %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], @EXPORT_OK = qw(); } # Crypt::Pontifex::new(); # Create a new Pontifex deck sub new { my $self = { # Set up the deck in sorted order. chr(33) == '!' represents # A of clubs, chr(34) == '"' represents 2 of clubs, and so on # in order until chr(84) == 'T' represents K of spades. # chr(85) == 'U' is joker A and chr(86) == 'V' is joker B. 'deck' => (pack('C*',33..86)), # No stored key 'key' => "" }; # bless yourself, my child. bless $self; $self; } # Crypt::Pontifex::key($key) sub key ($$) { my ($self, $key) = (@_); $self->{key} = $key; $self->rekey(); } # Crypt::Pontifex::rekey() sub rekey($) { my ($self) = (@_); $self->{deck} = (pack('C*',33..86)); for (my $i; $i < length($self->{key}); $i++) { $self->stir(substr $self->{key}, $i, 1); } 1; } # Crypt::Pontifex::lettersum($x, $y [, $subtract] ) sub lettersum($$;$) { my ($a, $b, $x) = (@_); $a = uc($a); $b = uc ($b); ($a =~ m/^[A-Z]$/) && ($b =~ m/^[A-Z]$/) or die "Bad arguments passed to lettersum: \"$a\", \"$b\""; return letter ( 52 + (ord($a)-64) + ( (ord($b)-64) * ($x?-1:1) ) ) +; } # Crypt::Pontifex::stir([$key]) # Runs the solitaire algorithm, and returns the output value from 1 to + 52. sub stir($;$) { my ($self, $key) = (@_); ## If the U (joker A) is at the bottom of the deck, move it to the + top $self->{deck} =~ s/(.*)U$/U$1/; ## Swap the U (joker A) with the card below it $self->{deck} =~ s/U(.)/$1U/; ## Do the same as above, but with the V (joker B), and do it twice +. $self->{deck} =~ s/(.*)V$/V$1/; $self->{deck} =~ s/V(.)/$1V/; $self->{deck} =~ s/(.*)V$/V$1/; $self->{deck} =~ s/V(.)/$1V/; ## Do the triple cut: swap the pieces before the first joker, and ## after the second joker. $self->{deck} =~ s/(.*)([UV].*[UV])(.*)/$3$2$1/; ## Do the count cut: find the value of the bottom card in the deck my $c=$self->card(53); ## Switch that many cards from the top of the deck with all but ## the last card. $self->{deck} =~ s/(.{$c})(.*)(.)/$2$1$3/; ## If we're doing key setup, do another count cut here, with the ## count value being the letter value of the key character (A=1, B +=2, ## etc.; this value will already have been stored in $k). After t +he ## second count cut, return, so that we don't happen to do the loo +p ## at the bottom. if ($key) { $key = ord(uc($key)) - 64; ($key > 26) && ($key = 0); $self->{deck} =~ s/(.{$key})(.*)(.)/$2$1$3/; return; } ## Find the value of the nth card in the deck, where n is the valu +e ## of the top card (be careful about off-by-one errors here) $c=$self->card($self->card(0)); ## If this wasn't a joker, return its value. If it was a joker, ## just start again at the top of this subroutine. $c>52?$self->stir():$c; } sub card($$) { my ($self,$ord) = (@_); ## The value of most cards is just the ASCII value minus 32. ## substr($D,$_[0]) is a string beginning with the nth card in the + deck my $card=ord(substr($self->{deck},$ord,1))-32; ## Special case: both jokers (53 and 54, normally) have value 53, ## so return 53 if the value is greater than 53, and the value oth +erwise. $card>53?53:$card; } sub letter($) { my ($ord) = (@_); (($ord %= 26)?chr($ord + 64): "Z"); } # Crypt::Pontifex::decrypt($string) sub decrypt($$) { my ($self, $string) = (@_); $self->encrypt($string, 1); } # Crypt::Pontifex::encrypt($string [,$decrypt]) sub encrypt($$;$) { my ($self, $string, $decrypt) = (@_); my $return; for (my $i = 0; $i < length($string); $i++) { $return .= lettersum((substr $string, $i, 1), letter $self->stir(), $decrypt); } $return; } 1;
      Interesting. A while back I wrote Crypt::Solitaire which is another implementation. I'm interested to run our versions side-by-side.

      Btw, Paul Crowley did some nice work in pointing out a random number bias in Solitaire. He attempted to write a new card cipher (Mirdek) that wasn't encumbered by the limitations in Solitaire, but by his own admission, his version suffers from weaknesses as well. Here's the URL of his stuff if you're interested: http://www.cluefactory.org.uk/paul/crypto/mirdek/

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://65552]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (2)
As of 2014-07-31 00:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (242 votes), past polls