! Copyright (C) 2009 Hugo Aguilar.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions sequences namespaces
combinators locals prettyprint io io.encodings.binary io.files
strings continuations system typed byte-arrays tools.time ;
IN: LC53

! ******
! ****** The following are for encryption.
! ******

CONSTANT: rnd-unity     4294967291      ! 2^32 - 5
CONSTANT: rnd-mult      3961633963      ! 2^32 - 333333333

: <prng> ( seed -- new-seed ) rnd-mult * rnd-unity mod ; inline
: <rnd-byte> ( seed -- new-seed r ) <prng> dup -24 shift ; inline

: crypt ( seed seq -- 'seq )
    ! this both encrypts and decrypts
    [ [ <rnd-byte> ] dip bitxor ] map nip ; inline

! ******
! ****** The following are for encrypting files.
! ******

CONSTANT: test-file "test.txt"
CONSTANT: test-seed 123456789

: load-file ( -- sample ) test-file binary file-contents ;
: show-file ( sample -- ) >string print ;

! ******
! ****** The following are for cracking the LC53 encryption.
! ****** We are assuming that the plaintext was a 7-bit-ascii text file.
! ****** This implies that the high bit of every byte is 0, which is what we are looking for.
! ******

: |word ( -- mask ) 31 2^ ; inline ! high bit of a word
: |byte ( -- mask )  7 2^ ; inline ! high bit of a byte

: how-far ( seed sample -- count|f )                           ! how far we went, or f if all the way
    [ [ <rnd-byte> ] dip bitxor |byte bitand 0 = not ] find  drop nip ; inline

SYMBOL: escape-continuation

: escape ( mask -- ) escape-continuation get continue-with ;

:: <find-seed> ( sample upper-count seed mask -- )
    mask 0 = [ ] [                                      ! if mask = 0, then no solution was found
        seed mask bitor             :> tryout           ! our tryout seed
        tryout sample how-far       :> count            ! the quality of our tryout seed
        count [                                         ! a count implies we didn't go all the way
            mask -1 shift           :> next-mask        ! the next lower bit mask
            upper-count count < [
                sample    count           seed mask bitor     next-mask   <find-seed>
                sample    upper-count     seed                next-mask   <find-seed>
            ] [
                sample    upper-count     seed                next-mask   <find-seed>
                sample    count           seed mask bitor     next-mask   <find-seed>
            ] if
        ] [                                             ! we found it! (our tryout went all the way)
            tryout escape
        ] if
    ] if ; inline recursive

TYPED:: find-seed ( sample: byte-array -- seed|f )
    [ escape-continuation set sample 0 0 |word <find-seed> f ] callcc1 ;

:: test ( -- )
    load-file :> sample
    sample show-file
    test-seed sample crypt :> sample
    nl "Sample file is encrypted and seed is zeroed; commencing cracking..." print flush
    [ sample find-seed ] time
    dup [
        [ nl "The seed is: " print  . ]
        [ nl "The file is: " print sample crypt show-file ] bi
    ] [
        drop
        nl "We did a complete search and were unable to find a valid seed." print
        nl "The file may have contained non-text characters (with the high-bit set)." print
    ] if ;

test