Welcome to Funny Games

Play top FREE games daily
Register Now

Crypto

Discussion in 'Programming Room' started by gwarhammer, Jun 27, 2009.

  1. gwarhammer

    gwarhammer Cpt on the Ship of Fools

    139
    12
    18
    Well, since there appears to be no crypto thread yet, here one is for all you fellow crypto freaks. To kick it off, here;s a Fibonacci-based rotation cipher I wrote in Scheme:


    (define (rotn val char)

    (if (= val 0)

    char

    (cond

    ((eq? char 'a) (rotn (- val 1) 'b))

    ((eq? char 'b) (rotn (- val 1) 'c))

    ((eq? char 'c) (rotn (- val 1) 'd))

    ((eq? char 'd) (rotn (- val 1) 'e))

    ((eq? char 'e) (rotn (- val 1) 'f))

    ((eq? char 'f) (rotn (- val 1) 'g))

    ((eq? char 'g) (rotn (- val 1) 'h))

    ((eq? char 'h) (rotn (- val 1) 'i))

    ((eq? char 'i) (rotn (- val 1) 'j))

    ((eq? char 'j) (rotn (- val 1) 'k))

    ((eq? char 'k) (rotn (- val 1) 'l))

    ((eq? char 'l) (rotn (- val 1) 'm))

    ((eq? char 'm) (rotn (- val 1) 'n))

    ((eq? char 'n) (rotn (- val 1) 'o))

    ((eq? char 'o) (rotn (- val 1) 'p))

    ((eq? char 'p) (rotn (- val 1) 'q))

    ((eq? char 'q) (rotn (- val 1) 'r))

    ((eq? char 'r) (rotn (- val 1) 's))

    ((eq? char 's) (rotn (- val 1) 't))

    ((eq? char 't) (rotn (- val 1) 'u))

    ((eq? char 'u) (rotn (- val 1) 'v))

    ((eq? char 'v) (rotn (- val 1) 'w))

    ((eq? char 'w) (rotn (- val 1) 'x))

    ((eq? char 'x) (rotn (- val 1) 'y))

    ((eq? char 'y) (rotn (- val 1) 'z))

    ((eq? char 'z) (rotn (- val 1) #\space))

    ((eq? char #\space) (rotn (- val 1) '0))

    ((eq? char '0) (rotn (- val 1) '1))

    ((eq? char '1) (rotn (- val 1) '2))

    ((eq? char '2) (rotn (- val 1) '3))

    ((eq? char '3) (rotn (- val 1) '4))

    ((eq? char '4) (rotn (- val 1) '5))

    ((eq? char '5) (rotn (- val 1) '6))

    ((eq? char '6) (rotn (- val 1) '7))

    ((eq? char '7) (rotn (- val 1) '8))

    ((eq? char '8) (rotn (- val 1) '9))

    ((eq? char '9) (rotn (- val 1) 'a))

    (else char)

    )

    )

    )



    (define (rrotn val char)

    (if (= val 0)

    char

    (cond

    ((eq? char 'a) (rrotn (- val 1) '9))

    ((eq? char 'b) (rrotn (- val 1) 'a))

    ((eq? char 'c) (rrotn (- val 1) 'b))

    ((eq? char 'd) (rrotn (- val 1) 'c))

    ((eq? char 'e) (rrotn (- val 1) 'd))

    ((eq? char 'f) (rrotn (- val 1) 'e))

    ((eq? char 'g) (rrotn (- val 1) 'f))

    ((eq? char 'h) (rrotn (- val 1) 'g))

    ((eq? char 'i) (rrotn (- val 1) 'h))

    ((eq? char 'j) (rrotn (- val 1) 'i))

    ((eq? char 'k) (rrotn (- val 1) 'j))

    ((eq? char 'l) (rrotn (- val 1) 'k))

    ((eq? char 'm) (rrotn (- val 1) 'l))

    ((eq? char 'n) (rrotn (- val 1) 'm))

    ((eq? char 'o) (rrotn (- val 1) 'n))

    ((eq? char 'p) (rrotn (- val 1) 'o))

    ((eq? char 'q) (rrotn (- val 1) 'p))

    ((eq? char 'r) (rrotn (- val 1) 'q))

    ((eq? char 's) (rrotn (- val 1) 'r))

    ((eq? char 't) (rrotn (- val 1) 's))

    ((eq? char 'u) (rrotn (- val 1) 't))

    ((eq? char 'v) (rrotn (- val 1) 'u))

    ((eq? char 'w) (rrotn (- val 1) 'v))

    ((eq? char 'x) (rrotn (- val 1) 'w))

    ((eq? char 'y) (rrotn (- val 1) 'x))

    ((eq? char 'z) (rrotn (- val 1) 'y))

    ((eq? char #\space) (rrotn (- val 1) 'z))

    ((eq? char '0) (rrotn (- val 1) #\space))

    ((eq? char '1) (rrotn (- val 1) '0))

    ((eq? char '2) (rrotn (- val 1) '1))

    ((eq? char '3) (rrotn (- val 1) '2))

    ((eq? char '4) (rrotn (- val 1) '3))

    ((eq? char '5) (rrotn (- val 1) '4))

    ((eq? char '6) (rrotn (- val 1) '5))

    ((eq? char '7) (rrotn (- val 1) '6))

    ((eq? char '8) (rrotn (- val 1) '7))

    ((eq? char '9) (rrotn (- val 1) '8))

    (else char)

    )

    )

    )



    (define (encrypt-letter letter prev1 prev2)

    (cons (rotn (remainder (+ prev1 prev2) 37) letter) (cons prev2 (list (+ prev1 prev2))))

    )



    (define (encrypt-full text current val1 val2)

    (if (null? text)

    current

    (if (null? current)

    (encrypt-full (cdr text) (car (encrypt-letter (car text) val1 val2)) val2 (+ val1 val2))

    (encrypt-full (cdr text) (code-append current (list (car (encrypt-letter (car text) val1 val2)))) val2 (+ val1 val2))

    )

    )

    )



    (define (encrypt text)

    (append (list '0 '1) (encrypt-full text '() 0 1))

    )



    (define (decrypt code rot)

    (if (null? code)

    '()

    (cons (rotn rot (car code)) (decrypt (cdr code) rot))

    )

    )



    (define (code-append list1 list2)

    (if (list? list1)

    (if (list? list2)

    (append list1 list2)

    (append list1 (list list2))

    )

    (if (list? list2)

    (cons list1 list2)

    (cons list1 (list list2))

    )

    )

    )



    (define (fr-decrypt-full code val1 val2)

    (if (null? code)

    '()

    (cons (rrotn (remainder (+ val1 val2) 37) (car code)) (fr-decrypt-full (cdr code) val2 (+ val1 val2)))

    )

    )



    (define (fr-decrypt code)

    (fr-decrypt-full (cddr code) (car code) (cadr code))

    )



    (define (list-make input-list)

    (if (null? input-list)

    '()

    (cons (const-convert (car input-list)) (list-make (cdr input-list)))

    )

    )



    (define (const-convert char)

    (cond

    ((or (eq? char #\a) (eq? char #\A)) 'a)

    ((or (eq? char #\b) (eq? char #\B)) 'b)

    ((or (eq? char #\c) (eq? char #\C)) 'c)

    ((or (eq? char #\d) (eq? char #\D)) 'd)

    ((or (eq? char #\e) (eq? char #\E)) 'e)

    ((or (eq? char #\f) (eq? char #\F)) 'f)

    ((or (eq? char #\g) (eq? char #\G)) 'g)

    ((or (eq? char #\h) (eq? char #\H)) 'h)

    ((or (eq? char #\i) (eq? char #\I)) 'i)

    ((or (eq? char #\j) (eq? char #\J)) 'j)

    ((or (eq? char #\k) (eq? char #\K)) 'k)

    ((or (eq? char #\l) (eq? char #\L)) 'l)

    ((or (eq? char #\m) (eq? char #\M)) 'm)

    ((or (eq? char #\n) (eq? char #\N)) 'n)

    ((or (eq? char #\o) (eq? char #\O)) 'o)

    ((or (eq? char #\p) (eq? char #\P)) 'p)

    ((or (eq? char #\q) (eq? char #\Q)) 'q)

    ((or (eq? char #\r) (eq? char #\R)) 'r)

    ((or (eq? char #\s) (eq? char #\S)) 's)

    ((or (eq? char #\t) (eq? char #\T)) 't)

    ((or (eq? char #\u) (eq? char #\U)) 'u)

    ((or (eq? char #\v) (eq? char #\V)) 'v)

    ((or (eq? char #\w) (eq? char #\W)) 'w)

    ((or (eq? char #\x) (eq? char #\X)) 'x)

    ((or (eq? char #\y) (eq? char #\Y)) 'y)

    ((or (eq? char #\z) (eq? char #\Z)) 'z)

    ((eq? char #\0) '0)

    ((eq? char #\1) '1)

    ((eq? char #\2) '2)

    ((eq? char #\3) '3)

    ((eq? char #\4) '4)

    ((eq? char #\5) '5)

    ((eq? char #\6) '6)

    ((eq? char #\7) '7)

    ((eq? char #\8) '8)

    ((eq? char #\9) '9)

    ((eq? char #\space) #\space)

    )

    )

    (define (init)

    (display "\"enc\" to encode, \"dec\" to decode, anything else to quit.")

    (newline)

    (main)

    )



    (define (main)

    (define a (read))

    (if (< (length (list-make (string->list a))) 3)

    (display "Quitting.")

    (if (equal? (cons (car (list-make (string->list a))) (code-append (cadr (list-make (string->list a))) (caddr (list-make (string->list a))))) '(e n c))

    (enc-main)

    (if (equal? (cons (car (list-make (string->list a))) (code-append (cadr (list-make (string->list a))) (caddr (list-make (string->list a))))) '(d e c))

    (dec-main)

    (display "Quitting.")

    )

    )

    )

    )



    (define (enc-main)

    (display "Enter a string inside quotes to encode.")

    (newline)

    (display (encrypt (list-make (string->list (read)))))

    (newline)

    (newline)

    (init)

    )



    (define (dec-main)

    (display "Enter an FR-Encrypted string inside quotes to decipher")

    (newline)

    (display (fr-decrypt (list-make (string->list (read)))))

    (newline)

    (newline)

    (init)

    )

    (init)

    Basically, the stanard version (run using (init)) takes a string as input and returns a list of characters, starting with 0 and 1, as the seeds of the sequence, after encoding.

    EDIT: For those interested, I have a compiled version for windows command line, courtesy of a free interpreter, the PLT "Dr. Scheme".
     
    Last edited by a moderator: Jun 27, 2009
  2. cybseth

    cybseth n00b

    1
    0
    1
    For those of us who might share an interest in crypto, but who don't have knowledge of/experience with scheme/lisp - do you think you could provide some details on your algorithm in psuedo code for us?
     
  3. gwarhammer

    gwarhammer Cpt on the Ship of Fools

    139
    12
    18
    Well, I tried to make it fairly self-explanatory, but here goes:

    The large functions full of letters:

    shift(input-character, number-of-places)
    while(number-of-places > 0)
    shift character;
    decrement number-of-places;


    That generates the letters once the right letter has been found.
    The main loop works like this:

    encode(next-character, fib-number1, fib-number2)
    shift(next-character, (fib-number1+fib-nuber2)) -- Actually uses modulo to prevent unnecessary loops through the entire character set at higher values

    This just continually gets the next character in the string.

    A lot of the code is scheme-specific, just to deal with the way Scheme handles things, so those two functions are basically all you need. It will work with any ordering, just fill out the tables of characters to rotate forwards and backwards and the code will do the rest.
     

Share This Page