[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on May 15:
; rolling code

(define fob1
  (let ( ; permanent read-only memory
         (id 111) (k 948579992)
         (a 69069) (c 1234567) (m 4294967296))
    (let ( ; non-volatile read/write memory
           (seed (modulo (* id k) m)))
      (define (encrypt x) (bitwise-xor x k))
      (define (next s) (modulo (+ (* a s) c) m))
      (lambda (signal)
        (set! seed (next seed))
        (if signal (receiver id seed signal) 'DENY)))))

(define fob2
  (let ( ; permanent read-only memory
         (id 222) (k 948579992)
         (a 69069) (c 1234567) (m 4294967296))
    (let ( ; non-volatile read/write memory
           (seed (modulo (* id k) m)))
      (define (encrypt x) (bitwise-xor x k))
      (define (next s) (modulo (+ (* a s) c) m))
      (lambda (signal)
        (set! seed (next seed))
        (if signal (receiver id seed signal) 'DENY)))))

(define receiver
  (let ( ; permanent read-only memory
         (k 948579992)
         (a 69069) (c 1234567) (m 4294967296))
    (let ( ; non-volatile read/write memory
           (len 0) (ids (vector))
           (seeds (vector)) (prevs (vector)))
      (define (decrypt x) (bitwise-xor x k))
      (define (next s) (modulo (+ (* a s) c) m))
      (define (ok s z)
        (let loop ((i 256) (s (next s)))
          (cond ((zero? i) #f)
                ((= (vector-ref seeds z) s) s)
                (else (loop (- i 1) (next s))))))
      (define (which id)
        (let loop ((i 0))
          (cond ((= i (vector-length ids)) -1)
                ((= (vector-ref ids i) id) i)
                (else (loop (+ i 1))))))
      (case-lambda
      ((new-ids) ; programming mode
        (set! len (length new-ids))
        (set! ids (list->vector new-ids))
        (set! seeds (make-vector len 0))
        (set! prevs (make-vector len 0)))
      ((id seed signal) ; operating mode
        (let ((z (which id)))
          (cond ((negative? z) 'DENY) ; unrecognized fob
                ((ok seed z) => ; recognized fob and code
                  (lambda (s)
                    (vector-set! seeds z s)
                    (vector-set! prevs z s) signal))
                ((= (next (vector-ref prevs z)) seed)
                  (vector-set! seeds z seed) ; resynchronize
                  (vector-set! prevs z seed) signal)
                (else ; recognized fob, unrecognized code
                  (vector-set! prevs z seed) 'DENY))))))))

(receiver '(111 222))
(display (fob1 'LOCK)) (newline)
(display (fob1 'LOCK)) (newline)
(do ((i 300 (- i 1))) ((zero? i)) (fob1 #f))
(display (fob1 'LOCK)) (newline)
(display (fob1 'LOCK)) (newline)
(display (fob2 'UNLOCK)) (newline)
(display (fob2 'UNLOCK)) (newline)


Output:
1
2
3
4
5
6
DENY
LOCK
DENY
LOCK
DENY
UNLOCK


Create a new paste based on this one


Comments: