packages feed

cpsa-3.3.0: doc/examples/fnof_yahalom.scm

(herald "Yahalom Protocol with Forwarding Removed, using fnof to emulate ltk function"
   (bound 12))

(defprotocol yahalom basic
  (defrole init
    (vars (a b c name) (n-a n-b text) (ltkac ltkbc k skey))
    ; Including init (c ltkac) to force c, ltkac to be present in the
    ; trace.
    (trace (init (cat c ltkac))
           (send (cat a n-a))
	   (recv (enc b k n-a n-b ltkac))
	   (send (enc n-b k)))
    (fn-of ("ltk" (ltkac (cat a c)) (ltkbc (cat b c))))
    (fn-of ("ltk-inv" ((cat a c) ltkac) ((cat b c) ltkbc)))
  )
  (defrole resp
    (vars (b a c name) (n-a n-b text) (ltkac ltkbc k skey))
    ; Including init (c ltkac) to force c, ltkac to be present in the
    ; trace.
    (trace (init (cat c ltkac))
           (recv (cat a n-a))
	   (send (cat b (enc a n-a n-b ltkbc)))
	   (recv (enc a k ltkbc))
	   (recv (enc n-b k)))
    (fn-of ("ltk" (ltkac (cat a c)) (ltkbc (cat b c))))
    (fn-of ("ltk-inv" ((cat a c) ltkac) ((cat b c) ltkbc)))
  )
  (defrole serv
    (vars (c a b name) (n-a n-b text) (ltkac ltkbc k skey))
    ; Including init c to force c to be present in the trace.
    (trace (init c)
           (recv (cat b (enc a n-a n-b ltkbc)))
	   (send (enc b k n-a n-b ltkac))
	   (send (enc a k ltkbc)))
    (uniq-orig k)
    (fn-of ("ltk" (ltkac (cat a c)) (ltkbc (cat b c))))
    (fn-of ("ltk-inv" ((cat a c) ltkac) ((cat b c) ltkbc)))
  )
)

(defskeleton yahalom
  (vars (a b c name) (n-b text) (ltkac ltkbc skey))
  (defstrand resp 4 (a a) (b b) (c c) (n-b n-b) (ltkac ltkac) (ltkbc ltkbc))
  (non-orig ltkbc ltkac)
  (uniq-orig n-b)
)

;;; Ensure encryption key remains secret.
(defskeleton yahalom
  (vars (a b c name) (n-b text) (ltkac ltkbc k skey))
  (defstrand resp 4 (a a) (b b) (c c) (n-b n-b) (k k) (ltkac ltkac) (ltkbc ltkbc))
  (deflistener k)
  (non-orig ltkbc ltkac)
  (uniq-orig n-b)
)

;;;  In this version, fn-of is only used for the "forward" direction
;;; of the ltk function.  In other words, if y = ltk(a,b) and z =
;;; ltk(a,b) then y = z.  But if y = ltk(a,b) and z = ltk(c,d) it is
;;; not necessarily the case that if y = z then a = b and c = d.
(defprotocol yahalom2 basic
  (defrole init
    (vars (a b c name) (n-a n-b text) (ltkac ltkbc k skey))
    ; Including init (c ltkac) to force c, ltkac to be present in the
    ; trace.
    (trace (init (cat c ltkac))
           (send (cat a n-a))
	   (recv (enc b k n-a n-b ltkac))
	   (send (enc n-b k)))
    (fn-of ("ltk" (ltkac (cat a c)) (ltkbc (cat b c))))
  )
  (defrole resp
    (vars (b a c name) (n-a n-b text) (ltkac ltkbc k skey))
    ; Including init (c ltkac) to force c, ltkac to be present in the
    ; trace.
    (trace (init (cat c ltkac))
           (recv (cat a n-a))
	   (send (cat b (enc a n-a n-b ltkbc)))
	   (recv (enc a k ltkbc))
	   (recv (enc n-b k)))
    (fn-of ("ltk" (ltkac (cat a c)) (ltkbc (cat b c))))
  )
  (defrole serv
    (vars (c a b name) (n-a n-b text) (ltkac ltkbc k skey))
    ; Including init c to force c to be present in the trace.
    (trace (init c)
           (recv (cat b (enc a n-a n-b ltkbc)))
	   (send (enc b k n-a n-b ltkac))
	   (send (enc a k ltkbc)))
    (uniq-orig k)
    (fn-of ("ltk" (ltkac (cat a c)) (ltkbc (cat b c))))
  )
)

(defprotocol yahalom2 basic
  (defrole init
    (vars (a b c name) (n-a n-b text) (ltkac ltkbc k skey))
    (trace (send (cat a n-a (hash ltkbc)))
	   (recv (enc b k n-a n-b ltkac))
	   (send (enc n-b k)))
    (fn-of ("ltk" (ltkac (cat a c)) (ltkbc (cat b c))))
  )
  (defrole resp
    (vars (b a c name) (n-a n-b text) (ltkac ltkbc k skey))
    (trace (recv (cat a n-a))
	   (send (cat b (enc a n-a n-b ltkbc) (hash c ltkac)))
	   (recv (enc a k ltkbc))
	   (recv (enc n-b k)))
    (fn-of ("ltk" (ltkac (cat a c)) (ltkbc (cat b c))))
  )
  (defrole serv
    (vars (c a b name) (n-a n-b text) (ltkac ltkbc k skey))
    (trace (recv (cat b (enc a n-a n-b ltkbc)))
	   (send (cat (hash c) (enc b k n-a n-b ltkac)))
	   (send (enc a k ltkbc)))
    (uniq-orig k)
    (fn-of ("ltk" (ltkac (cat a c)) (ltkbc (cat b c))))
  )
)

(defskeleton yahalom2
  (vars (a b c name) (n-b text) (ltkac ltkbc skey))
  (defstrand resp 4 (a a) (b b) (c c) (n-b n-b) (ltkac ltkac) (ltkbc ltkbc))
  (non-orig ltkbc ltkac)
  (uniq-orig n-b)
)

;;; Ensure encryption key remains secret.
(defskeleton yahalom2
  (vars (a b c name) (n-b text) (ltkac ltkbc k skey))
  (defstrand resp 4 (a a) (b b) (c c) (n-b n-b) (k k) (ltkac ltkac) (ltkbc ltkbc))
  (deflistener k)
  (non-orig ltkbc ltkac)
  (uniq-orig n-b)
)