;; Common Lisp RC4 implementation as an exercise
;; Released in the Public Domain.

;; TODO:
;; - Attempt to specialize methods afterwards for other objects than strings
;; - Attempt to cleanup code further
;; - Write with-key-init or such macro
;; - Write stream-type functions for it


(declaim (optimize (speed 3) (safety 1))
	 (inline -key-init)
	 (inline key-random)
	 (inline key-random-add))


(defpackage :mm-rc4
  (:use :cl)
  (:nicknames :rc4)
  (:export
   #:key-init
   #:key-random-add
   #:key-random
   #:key-destroy))


(in-package :rc4)


(defclass rc4-type ()
  ((x
    :type fixnum
    :accessor key-x
    :initform 0)
   (y
    :type fixnum
    :accessor key-y
    :initform 0)
   (state
    :type (simple-array fixnum (256))
    :accessor key-state
    :initform (make-array 256 :element-type 'fixnum :initial-element 0))))


(defgeneric -key-init (key))

(defmethod -key-init ((k rc4-type))
  (setf (key-x k) 0)
  (setf (key-y k) 0)
  (loop
     for i from 0 to 255
     do (setf (aref (the (simple-array fixnum (256)) (key-state k)) i) i)))


(defgeneric key-init (key data discard))

(defmethod key-init ((k rc4-type) (s string) (discard fixnum))
  (-key-init k)
  (key-random-add k s discard))


(defgeneric key-random-add (key data discard))

(defmethod key-random-add ((k rc4-type) (s string) (discard fixnum))
  (let ((y 0) (si 0) (slen (length s)))
    (with-accessors ((sa key-state)) k
      (declare (type fixnum y si slen)
	       (type (simple-array fixnum (256)) sa)
	       (type (simple-array character (*)) s))
      (loop
	 for x from 0 to 255
	 do (progn
	      (setf
	       y (logand (+ y (aref sa x) (char-code (char s si))) #Xff)
	       si (mod (1+ si) slen))
	      (psetf (aref sa x) (aref sa y)
		     (aref sa y) (aref sa x))))))
  (loop
     repeat discard
     do (key-random k)))


(defgeneric key-random (key))

(defmethod key-random ((k rc4-type))
  (with-accessors ((sa key-state) (kx key-x) (ky key-y)) k
    (declare (type fixnum kx ky)
	     (type (simple-array fixnum (256)) sa))
    (setf
     kx (logand (1+ kx) #Xff)
     ky (logand (+ ky (aref sa kx)) #Xff))
    (psetf (aref sa kx) (aref sa ky)
	   (aref sa ky) (aref sa kx))
    (aref sa (logand (+ (aref sa kx) (aref sa ky)) #Xff))))


(defgeneric key-encode (k s))

;; XXX This would fail with length == 0!
;; Also, now only supports destructive mode.
(defmethod key-encode ((k rc4-type) (s string))
  (let ((slen (1- (length s))))
    (declare (type fixnum slen)
	     (type (simple-array character (*)) s))
    (loop
       for i from 0 to slen
       do (setf (char s i)
		(code-char
		 (logxor (char-code (char s i))
			 (the fixnum (key-random k)))))))
  s)


(defgeneric key-destroy (k))

(defmethod key-destroy ((k rc4-type))
  (setf (key-x k) 0)
  (setf (key-y k) 0)
  (loop
     for i from (the fixnum 0) to 255
     do (setf (aref (the (simple-array fixnum (256)) (key-state k)) i) 0)))



(defvar *k*)
(setf *k* (make-instance 'rc4-type))
(key-init *k* "This is a test" 3072)
;;(key-destroy *k*)