Scheme RC4 implementation

README.md

arcfour.ss

For some reason, in January of 2009 I felt the need to implement RC4 in Scheme.

Usage

Known to work with Racket.

Specify the key and plaintext on the command-line as arguments, and it will output the ciphertext. For example,

$ racket arcfour.ss Key Plaintext
BBF316E8D940AF0AD3

arcfour.ss

#!r6rs
(import (rnrs base)
        (rnrs arithmetic bitwise) ; bitwise-and, etc
        (rnrs bytevectors) ; make-bytevector, etc
        (rnrs control) ; unless
        (rnrs io simple) ; display
        (rnrs programs) ; command-line
        (rnrs unicode)) ; string-upcase

; Calculate next value to XOR with the plaintext.
; (output-next i j) -> (vector value new_i new_j)
(define (output-next i j)
  (set! i (bitwise-and (+ i 1) 255))
  (let ((Si (bytevector-u8-ref S i)))
    (set! j (bitwise-and (+ j Si) 255))
    (bytevector-u8-set! S i (bytevector-u8-ref S j))
    (bytevector-u8-set! S j Si))
  (vector (bytevector-u8-ref S (bitwise-and 255 (+ (bytevector-u8-ref S i)
                                                   (bytevector-u8-ref S j))))
          i j))

(define argv (command-line))
(unless (= (length argv) 3)
  (display (string-append "usage: " (car argv) " <key> <plaintext>"))
  (newline)
  (exit 1))
(define key (cadr argv))
(define plaintext (caddr argv))

(define S (make-bytevector 256))

; Init S to S[i]=i
(let loop ((i 0))
  (bytevector-u8-set! S i i)
  (unless (>= (+ i 1) (bytevector-length S))
    (loop (+ 1 i))))

; Init S based on key
(let loop ((i 0)
           (j 0))
  (let ((Si (bytevector-u8-ref S i)))
    (set! j (bitwise-and 255 (+ j Si (char->integer (string-ref key (mod i (string-length key)))))))
    (bytevector-u8-set! S i (bytevector-u8-ref S j))
    (bytevector-u8-set! S j Si)
    (unless (>= (+ i 1) (bytevector-length S))
      (loop (+ i 1) j))))

; Encrypt
(let loop ((x 0) (i 0) (j 0))
  (let* ((next-vector (output-next i j))
         (next-number (bitwise-xor (char->integer (string-ref plaintext x)) (vector-ref next-vector 0)))
         (next-string (string-upcase (number->string next-number 16))))
    (display (if (>= next-number 16) next-string
                 (string-append "0" next-string)))
    (unless (>= (+ x 1) (string-length plaintext))
      (loop (+ x 1)
            (vector-ref next-vector 1)
            (vector-ref next-vector 2)))))

(newline)
(exit 0)