home *** CD-ROM | disk | FTP | other *** search
/ ftp.eterna.com.au / 2014.06.ftp.eterna.com.au.tar / ftp.eterna.com.au / lisp / rc16.el < prev    next >
Lisp/Scheme  |  1998-04-13  |  2KB  |  85 lines
  1. ;; this is GPL'd code.
  2.  
  3. ;; most numbers in here are meant to be 16bits
  4. (defconst xFFFF (- 65536 1))
  5.  
  6. ;; rc16-context functions
  7. (defun rc16-create-context ()
  8.   (vector 0 0 (make-vector 65536 0)))
  9.  
  10. (defsubst rc16-context-x (context)
  11.   (aref context 0))
  12.  
  13. (defsubst rc16-context-y (context)
  14.   (aref context 1))
  15.  
  16. (defsubst rc16-context-state (context)
  17.   (aref context 2))
  18.  
  19. ;; sigh.  why doesn't elisp have (setf (aref ...))?
  20. (defsubst rc16-context-set-x (context val)
  21.   (aset context 0 val))
  22.  
  23. (defsubst rc16-context-set-y (context val)
  24.   (aset context 1 val))
  25.  
  26. ;; set a key, init the context
  27. (defun rc16-set-key (context key)
  28.   (let ((state (rc16-context-state context)))
  29.     ;; init context
  30.     (rc16-context-set-x context 0)
  31.     (rc16-context-set-y context 0)
  32.     (let ((counter 0))
  33.       (while (< counter 65536)
  34.     (aset state counter counter)
  35.     (setq counter (1+ counter))))
  36.   
  37.     ;; mix in key
  38.     (let ((keyidx 0)
  39.       (keylen (length key))
  40.       (stateidx 0)
  41.       (counter 0)
  42.       temp1 temp2)
  43.       (while (< counter 65536)
  44.     (setq temp1 (aref state counter))
  45.     (setq stateidx (logand (+ stateidx temp1 (aref key keyidx)) xFFFF))
  46.     (setq temp2 (aref state stateidx))
  47.     (aset state stateidx temp1)
  48.     (aset state counter temp2)
  49.     (setq keyidx (1+ keyidx))
  50.     (if (= keyidx keylen) (setq keyidx 0))
  51.     (setq counter (1+ counter))))))
  52.  
  53. (defun rc16-short (context)
  54.   (let* ((state (rc16-context-state context))
  55.      (x (logand (1+ (rc16-context-x context)) xFFFF))
  56.      (sx (aref state x))
  57.      (y (logand (+ sx (rc16-context-y context)) xFFFF))
  58.      (sy (aref state y)))
  59.     (rc16-context-set-x context x)
  60.     (rc16-context-set-y context y)
  61.     (aset state y sx)
  62.     (aset state x sy)
  63.     (aref state (logand (+ sx sy) xFFFF))))
  64.  
  65. (defun rc16-encrypt (context data)
  66.   (let* ((cipher (make-string (length data) 0))
  67.      (rc16-val (rc16-short context))
  68.      (hi-byte (ash rc16-val -8))
  69.      (lo-byte (logand rc16-val 255))
  70.      (bytes-left 2)
  71.      (count 0)
  72.      (length (length data)))
  73.     (while (< count length)
  74.       (aset cipher count (logxor (aref data count) hi-byte))
  75.       (setq bytes-left (1- bytes-left))
  76.       (if (= bytes-left 0)
  77.       (progn
  78.         (setq bytes-left 2)
  79.         (setq rc16-val (rc16-short context))
  80.         (setq hi-byte (ash rc16-val -8))
  81.         (setq lo-byte (logand rc16-val 255)))
  82.     (setq hi-byte lo-byte))
  83.       (setq count (1+ count)))
  84.     cipher))
  85.