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

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

fong

...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;
[download]

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/