phadthai

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

;; TODO:
;; - Ideally provide a generic function or method for key scheduling.
;;   key-init method as well as key-random-add should use it.
;; - Attempt to specialize methods afterwards for other objects than strings.
;; - Attempt to cleanup code and optimize further.
;; - Write with-key-init or such macro.
;; - Write stream-type functions for it


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

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


(in-package :rc4)

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


(defgeneric key-init (key data discard))

(defmethod key-init ((k rc4-type) (s string) (discard fixnum))
  (let ((tmp) (id1 0) (id2 0) (slen (length s)))
    (declare (tmp fixnum) (id1 fixnum) (id2 fixnum) (slen fixnum))
    (setf (x k) 0)
    (setf (y k) 0)
    (loop
       for i from 0 to 255
       do (setf (elt (state k) i) i))
    (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 ((tmp) (id1 0) (id2 0) (slen (length s)))
    (loop
       for i from 0 to 255
       do (progn (setf tmp (elt (state k) i))
		 (setf id2
		       (ldb (byte 8 0) (+ (char-code (elt s id1)) tmp id2)))
		 (if (= (incf id1) slen) (setf id1 0) ())
		 (setf (elt (state k) i) (elt (state k) id2))
		 (setf (elt (state k) id2) tmp)))
    (loop
       repeat discard
       do (key-random k))))


(defgeneric key-random (key))

(defmethod key-random ((k rc4-type))
  (let ((tmp))
    (declare (tmp fixnum))
    (setf (x k) (ldb (byte 8 0) (1+ (x k))))
    (setf tmp (elt (state k) (x k)))
    (setf (y k) (ldb (byte 8 0) (+ tmp (y k))))
    (setf (elt (state k) (x k)) (elt (state k) (y k)))
    (setf (elt (state k) (y k)) tmp))
  (elt (state k) (ldb (byte 8 0) (+ (x k) (y k)))))


(defgeneric key-encode (k s))

(defmethod key-encode ((k rc4-type) (s string))
  (let ((slen (1- (length s))))
    (declare (slen fixnum))
    (loop
       for i from 0 to slen
       do (setf (elt s i)
		(code-char
		 (logxor (char-code (elt s i))
			 (key-random k))))))
  s)


(defgeneric key-destroy (k))

(defmethod key-destroy ((k rc4-type))
  (setf (x k) 0)
  (setf (y k) 0)
  (loop
     for i from 0 to 255
     do (setf (elt (state k) i) 0)))



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