ANEW --SOLITAIRE-- \ Neil Bawd 2003-02-22
\ *******************************************************************
\ * *
\ * Neil Bawd 99-07-14 *
\ * *
\ * SOLITAIRE *
\ * *
\ * `SOLITAIRE` is a Forth implementation of the Solitaire *
\ * cryptosystem, as designed by Bruce Schneier and described at *
\ * , as well as *
\ * in Neil Stephenson's novel _Cryptonomicon_, *
\ * ISBN 0-380-97346-4. *
\ * *
\ *******************************************************************
\ "Cheap, fast, good: choose two."
\ Alleged `RC4`, now known as `ARCFOUR`, is cheap and fast and good.
\ It _does_ need a computer.
\ `SOLITAIRE` is cheap and good, but it's not fast. It's very cheap;
\ it doesn't need a computer, just a deck of cards. It's more secure
\ than all other known paper- and-pencil ciphers other than a
\ one-time pad. And for fast, it's as fast as an actual cipher used
\ by a Soviet spy. This was described by David Kahn in _Kahn on
\ Codes_.
\ Using the Soviet cipher or `SOLITAIRE` will take an evening to
\ encrypt or decrypt a message with paper and pencil. However one
\ side or the other will almost always have a computer. I have the
\ Forth code on my Palm.
\ A deck of cards is easier to conceal than a computer or codebook.
\ But soon the secret police will seize and torture anyone with a
\ deck of cards. A card deck is a munition and criminal to export.
\ The algorithm takes the normal cards of a deck as the numbers
\ 1-52, with two Jokers as 53-54. The letters of the alphabet are
\ 1-26. Adding a card number to a letter number modulo 26 enciphers
\ a letter; subtracting a card number modulo 26 deciphers a letter.
\ The card numbering arranges the suits in Bridge order - Clubs,
\ Diamonds, Hearts, Spades. The suits are arranged A23456789JQK. So
\ Clubs are 1-13, Diamonds 14-26, Hearts 27-39, Spades 40-52. The
\ Queen of Hearts is 12+26 = 38; the Ace of Spades is 40.
\ The two Jokers should be distinguishable. Usually one is larger
\ than the other.
\ If not, draw an A on one and B on the other.
\ The key for a message is the initial arrangement of the deck.
\ There are 54! ways to do this.
\ A daily Bridge column in a selected newspaper could be used, with
\ the first two cards played positioning the Jokers. Or an
\ agreed-upon arrangement could be used, modified by a keyphrase, to
\ stack the deck.
\ After stacking the deck, to encipher or decipher each letter of a
\ message:
\ 1. Find the A-Joker and move it down 1. When the A-Joker is the
\ bottom card, move it around the top card.
\ 2. Find the B-Joker and move it down 2. When the B-Joker is one of
\ the two bottom cards, move it around the top card.
\ 3. Exchange the cards above the first occurring Joker with the
\ cards below the second occurring Joker.
\ 4. Count down and cut using the value in the bottom card. The
\ bottom card stays put.
\ 5. Count down using the value in the top card. Both jokers count
\ as `#CARDS`-1.
\ Take the value of the next card, and add to encrypt or subtract to
\ decrypt modulo 26 with the letter of the message.
\ Do all this twice because it's prone to human error.
\ *******************************************************************
\ * *
\ * NOTE: the Solitaire encryption algorithm is strong *
\ * cryptography. That means the security it affords is based *
\ * on the secrecy of the key rather than the secrecy of the *
\ * algorithm itself. That also means that this program and *
\ * programs derived from it may be treated as a munition for *
\ * the purpose of export regulation in the United States and *
\ * other countries. You are encouraged to seek competent *
\ * legal counsel before distributing copies of this program. *
\ * *
\ *******************************************************************
\ [The source code for cipher generation has been removed.]
\ *******************************************************************
\ * End-User Words *
\ *******************************************************************
\ ZAP ( -- )
\ Put the deck in an unkeyed arrangement. Here
\ it does the simplest arrangement: 1-54.
\ STACK ( -- )
\ Use a keyphrase to stack the deck from its
\ unkeyed arrangement.
\ ALICE ( str len -- )
\ Turn plaintext into ciphertext.
\ BOB ( str len -- )
\ Turn ciphertext into plaintext.
\ There is environmental dependency on `1 CHARS` is 1.
\ *******************************************************************
\ * Implementation *
\ *******************************************************************
\ #CARDS ( -- n )
\ The size of the deck: 54.
\ DECK
\ Work space for the deck: 54 characters as numbers.
\ A-Joker
\ A joker. The "little" one.
\ B-Joker
\ The other joker. The "big" one.
\ Clubs: 1-13. Diamonds: 14-26. Hearts: 27-39. Spades: 40-52.
54 CONSTANT #CARDS
CREATE DECK #CARDS ALLOT
#CARDS 1- CONSTANT A-Joker
#CARDS CONSTANT B-Joker
\ CEXCHANGE ( addr addr -- )
\ Exchange the characters at two addresses. Used in `SREVERSE`.
\ SREVERSE ( str len -- )
\ Reverse the order of a string of characters. Used in `SROTATE`.
\ SROTATE ( str len k -- )
\ Rotate a string of characters. `SROTATE` splits a string into
\ two parts, reverses each part, and then reverses the whole
\ string.
\
\ `str len 1 SROTATE` moves the first char to the end.
\
\ `str len DUP 1- SROTATE` moves the last char to the
\ beginning.
: CEXCHANGE ( addr addr -- )
over C@ >R dup C@ ROT C! R> SWAP C! ;
: SREVERSE ( str len -- )
1- over + ( str addr)
BEGIN 2dup U< WHILE
2dup CEXCHANGE
1 /STRING \ Because 1 CHARS is 1.
REPEAT 2DROP ;
: SROTATE ( str len k -- )
>R 2dup 2dup R> /STRING ( s n s n s+k n-k)
dup >R 2SWAP R> - ( s n s+k n-k s k)
SREVERSE SREVERSE SREVERSE ;
\ Find-the-A-Joker ( -- i )
\ Find the position of the A-Joker in the deck.
\ Used in `Move-the-A-Joker-Down-1` and
\ `Exchange-Above-and-Below-Jokers`.
\ Find-the-B-Joker ( -- i )
\ Find the position of the B-Joker in the deck.
\ Used in `Move-the-B-Joker-Down-2` and
\ `Exchange-Above-and-Below-Jokers`.
: Find-the-a-Joker ( -- i )
#CARDS 0 DO
I DECK + C@ A-Joker = IF
I UNLOOP
EXIT THEN
LOOP TRUE ABORT" The A-Joker is missing. " ;
: Find-the-B-Joker ( -- i )
#CARDS 0 DO
I DECK + C@ B-Joker = IF
I UNLOOP
EXIT THEN
LOOP TRUE ABORT" The B-Joker is missing. " ;
\ Move-the-A-Joker-Down-1 ( -- )
\ Move the A-Joker down 1. When the A-Joker is the bottom
\ card, move it around the top card. Used in `CIPHER` and
\ `STACK`.
\ Move-the-B-Joker-Down-2 ( -- )
\ Move the B-Joker down 2. When the B-Joker is one of the
\ two bottom cards, move it around the top card. Used in
\ `CIPHER` and `STACK`.
\ Exchange-Above-and-Below-Jokers ( -- )
\ Do a triple cut. The cards above the first occurring joker
\ are exchanged with the cards below the second occurring
\ joker. Used in `CIPHER` and `STACK`.
\ Count-and-Cut-with-Bottom-Card ( -- )
\ Count down and cut using the value in the bottom card. The
\ bottom card stays put. Used in `CIPHER` and `STACK`.
\ Count-with-Top-Card ( -- n )
\ Find the output card by counting down using the value in
\ the top card. Both Jokers count as `#CARDS`-1. Used in
\ `CIPHER`.
: Move-the-a-Joker-Down-1 ( -- )
Find-the-a-Joker ( i)
dup #CARDS 1- < IF
DECK + 2 1 SROTATE
ELSE \ A-Joker is at the bottom of the deck.
DROP DECK #CARDS 1 /STRING dup 1- SROTATE
THEN ( ) ;
: Move-the-B-Joker-Down-2 ( -- )
Find-the-B-Joker ( i)
dup #CARDS 2 - < IF
DECK + 3 1 SROTATE
ELSE
#CARDS 1- = IF \ B-Joker is at bottom.
DECK #CARDS 2 /STRING dup 1- SROTATE
ELSE \ B-Joker is next to bottom.
DECK #CARDS 1 /STRING 1- dup 1- SROTATE
THEN THEN ;
: Exchange-Above-and-Below-Jokers ( -- )
Find-the-a-Joker Find-the-B-Joker ( A B)
2dup MAX >R MIN >R ( )( R: max min)
DECK #CARDS R@ /STRING 2R@ - 1+ SROTATE
DECK #CARDS R> SROTATE R> DROP ;
: Count-and-Cut-with-Bottom-Card
DECK #CARDS 1- 2dup + C@ over MIN SROTATE ;
: Count-with-Top-Card ( -- n )
DECK C@ #CARDS 1- MIN DECK + C@ ;
\ *******************************************************************
\ * CIPHER *
\ *******************************************************************
\ CIPHER
\ Finds the next output card in the deck. ( -- n )
\ The jokers are skipped.
\ Used in: `ENCIPHER` `DECIPHER`
\ `CIPHER` will do the following:
\ * Move the A Joker Down 1
\ * Move the B Joker Down 2
\ * Exchange Above and Below Jokers
\ * Count and Cut with Bottom Card
\ * Count with Top Card
\ * If the next card is a Joker, i.e. > `#CARDS`-2, then
\ skip it and repeat from the beginning
: CIPHER
\ ### ##### # # ### ### #### ##### ####
\ # # # # # # # # # # # # # #
\ # # ## # # # # # # # # #
\ # #### # # # ### # # #### #### # #
\ # # # ## # # # # # # # #
\ # # # # # # # # # # # # # #
\ ### ##### # # ### ### # # ##### ####
;
\ Stack-Cut ( n -- )
\ Cut the deck according to the next character in
\ the keyphrase. The bottom card stays put.
\ Used in `STACK`.
\ Is-Alpha ( char -- flag )
\ Test a character for alphabetic.
\ Alpha>Num ( char -- n )
\ Convert a letter to a number 1--26.
\ Num>Alpha ( n -- char )
\ Convert a number 1--78 to a letter.
: Stack-Cut ( n -- ) DECK #CARDS 1- ROT SROTATE ;
: Is-Alpha ( char -- flag ) 32 OR [char] a - 26 U< ;
: Alpha>Num ( char -- n ) 32 OR [char] a 1- - ;
: Num>Alpha ( n -- char ) 1- 26 MOD [char] A + ;
\ COL ( -- addr )
\ Counter for columns that have been written.
\ Used in `.CIPHER` and `ZAP`.
\ .CIPHER ( char -- )
\ Display a character with a space after every
\ five characters. Used in `ENCIPHER` and `DECIPHER`.
\ ENCIPHER ( char -- )
\ Turn a plaintext character into ciphertext.
\ Used in `ALICE`.
\ DECIPHER ( char -- )
\ Turn a ciphertext character into plaintext.
\ Used in `BOB`.
\ Now legal.
: CIPHER ( -- n )
BEGIN
Move-the-A-Joker-Down-1
Move-the-B-Joker-Down-2
Exchange-Above-and-Below-Jokers
Count-and-Cut-with-Bottom-Card
Count-with-Top-Card ( n)
dup #CARDS 2 - >
WHILE DROP REPEAT ;
VARIABLE COL
: .CIPHER ( char -- )
EMIT 1 COL +! ( )
COL @ 1+ 6 MOD 0= IF
SPACE 1 COL +!
COL @ 60 = IF CR 0 COL ! THEN
THEN ;
: ENCIPHER ( char -- )
Alpha>Num CIPHER + 1- 26 MOD 1+ Num>Alpha
.CIPHER ;
: DECIPHER ( char -- )
Alpha>Num CIPHER - 51 + 26 MOD 1+ Num>Alpha 32 OR
.CIPHER ;
\ *******************************************************************
\ * ZAP STACK ALICE BOB *
\ *******************************************************************
: ZAP ( -- )
#CARDS 0 DO I 1+ I DECK + C! LOOP
0 COL ! ;
: STACK ( str len -- )
ZAP
BEGIN dup WHILE
Move-the-a-Joker-Down-1
Move-the-B-Joker-Down-2
Exchange-Above-and-Below-Jokers
Count-and-Cut-with-Bottom-Card
over C@ Alpha>Num Stack-Cut
1 /STRING
REPEAT 2DROP ;
: ALICE ( str len -- )
BEGIN dup WHILE
over C@ Is-Alpha IF
over C@ ENCIPHER
THEN
1 /STRING
REPEAT 2DROP
BEGIN COL @ 6 MOD WHILE
[char] X ENCIPHER
REPEAT ;
: BOB ( str len -- )
BEGIN dup WHILE
over C@ Is-Alpha IF
over C@ DECIPHER
THEN
1 /STRING
REPEAT 2DROP ;
MARKER TESTING
: PLAINTEXT: BL WORD COUNT PAD 2dup C! 1+ SWAP MOVE ;
: KEY: BL WORD COUNT over C@ [char] ' = IF
1 /STRING 1- STACK
ELSE 2DROP postpone \
ZAP
THEN ;
: OUTPUT: postpone \ ;
: CIPHERTEXT: postpone \ CR PAD COUNT ALICE ;
Plaintext: AAAAAAAAAAAAAAA
Key:
Output: 4 49 10 53 24 8 51 44 6 4 33 20 39 19 34 42
Ciphertext: EXKYI ZSGEH UNTIQ
Plaintext: AAAAAAAAAAAAAAA
Key: 'f'
Output: 49 24 8 46 16 1 12 33 10 10 9 27 4 32 24
Ciphertext: XYIUQ BMHKK JBEGY
Plaintext: AAAAAAAAAAAAAAA
Key: 'fo'
Output: 19 46 9 24 12 1 4 43 11 32 23 39 29 34 22
Ciphertext: TUJYM BERLG XNDIW
Plaintext: AAAAAAAAAAAAAAA
Key: 'foo'
Output: 8 19 7 25 20 53 9 8 22 32 43 5 26 17 53 38 48
Ciphertext: ITHZU JIWGR FARMW
Plaintext: AAAAAAAAAAAAAAA
Key: 'a'
Output: 49 14 3 26 11 32 18 2 46 37 34 42 13 18 28
Ciphertext: XODAL GSCUL IQNSC
Plaintext: AAAAAAAAAAAAAAA
Key: 'aa'
Output: 14 7 32 22 38 23 23 2 26 8 12 2 34 16 15
Ciphertext: OHGWM XXCAI MCIQP
Plaintext: AAAAAAAAAAAAAAA
Key: 'aaa'
Output: 3 28 18 42 24 33 1 16 51 53 39 6 29 43 46 45
Ciphertext: DCSQY HBQZN GDRUT
Plaintext: AAAAAAAAAAAAAAA
Key: 'b'
Output: 49 16 4 30 12 40 8 19 37 25 47 29 18 16 18
Ciphertext: XQEEM OITLZ VDSQS
Plaintext: AAAAAAAAAAAAAAA
Key: 'bc'
Output: 16 13 32 17 10 42 34 7 2 37 6 48 44 28 53 4
Ciphertext: QNGRK QIHCL GWSCE
Plaintext: AAAAAAAAAAAAAAA
Key: 'bcd'
Output: 5 38 20 27 50 1 38 26 49 33 39 42 49 2 35
Ciphertext: FMUBY BMAXH NQXCJ
Plaintext: AAAAAAAAAAAAAAAAAAAAAAAAA
Key: 'cryptonomicon'
Ciphertext: SUGSR SXSWQ RMXOH IPBFP XARYQ
Plaintext: SOLITAIRE
Key: 'cryptonomicon'
Ciphertext: KIRAK SFJAN
( END ) TESTING
\ *******************************************************************
\ * *
\ * Eight Kings *
\ * *
\ * The following is a version of ZAP that arranges the deck in *
\ * Eight Kings sequence. *
\ * *
\ * Eight-Kings ( -- addr ) *
\ * The pattern for the Eight Kings card sequence: *
\ * *
\ * Eight kings threaten to save 95 queens for one sick knave. *
\ * *
\ * ZAP ( -- ) *
\ * Initialize the deck to the Eight Kings card sequence. *
\ * *
\ *******************************************************************
CREATE Eight-Kings
8 C, 13 C, 3 C, 10 C, 2 C, 7 C,
9 C, 5 C, 12 C, 4 C, 1 C, 6 C, 10 C,
: ZAP ( -- )
DECK 52 0 DO
I 13 MOD Eight-Kings + C@
I 4 MOD 13 * +
OVER C! 1+
LOOP
53 OVER C! 1+ 54 SWAP C! ;
\\ // \\ // \\ // \\ // \\ // \\ // \\ // \\