[ create a new paste ] login | about

Link: http://codepad.org/B0cDjRS5    [ raw code | fork ]

cky - Scheme, pasted on Jun 21:
;;; Requires SRFIs 26, 41, 43, 60.

(define (make-sbox rounds key iv)
  (define vector-times
    (compose vector-concatenate vector->list make-vector))
  (define key-iv
    (vector-append (list->vector (map char->integer (string->list key))) iv))
  (define s (vector-unfold values 256))
  (define s2 (vector-times (ceiling (/ 256 (vector-length key-iv))) key-iv))
  (define (shuffle-iter i j e e2)
    (let ((k (modulo (+ j e e2) 256)))
      (vector-swap! s i k)
      k))
  (do ((i rounds (- i 1))
       (j 0 (vector-fold shuffle-iter j s s2)))
      ((zero? i) s)))

(define-stream (make-cipher-stream sbox)
  (let* ((s (vector-copy sbox))
         (sbox-ref (cut vector-ref s <>))
         (u8+ (compose (cut modulo <> 256) +)))
    (stream-let next ((i 1)
                      (j (sbox-ref 1)))
      (vector-swap! s i j)
      (stream-cons (sbox-ref (u8+ (sbox-ref i) (sbox-ref j)))
                   (let ((i+1 (u8+ i 1)))
                     (next i+1 (u8+ j (sbox-ref i+1))))))))

(define-stream (make-stdin-stream)
  (let ((b (read-byte)))
    (if (eof-object? b) stream-null
        (stream-cons b (make-stdin-stream)))))

(define (process rounds key)
  (define (read-iv port)
    (define (readv _)
      (read-byte port))
    (vector-unfold readv 10))
  (define (writev _ x)
    (write-byte x))
  (let* ((iv (if (< rounds 0) (read-iv (current-input-port))
                 (call-with-input-file "/dev/urandom" read-iv)))
         (cs (make-cipher-stream (make-sbox (abs rounds) key iv)))
         (is (make-stdin-stream)))
    (if (> rounds 0) (vector-for-each writev iv))
    (stream-for-each (compose write-byte bitwise-xor) cs is)))

;;; Entry point for SRFI 22-capable Scheme implementations.
(define (main args)
  (define (main _ rounds key)
    (process (string->number rounds) key))
  (apply main args))


Create a new paste based on this one


Comments: