diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,24 @@ +2018-06-25 John D. Ramsdell + + * cpsa.cabal (Version): Tagged as 3.6.0 + +2018-06-18 John D. Ramsdell + + * src/CPSA/Lib/Strand.hs (gparam): Added support for binding the + strand variable in gparam as opposed to relying on it being bound + by a role length predicate. + +2018-06-11 John D. Ramsdell + + * src/CPSA/Lib/*.hs: Implemented geometric formulas as rewrite + rules. The rules are applied after each cohort step. + +2018-06-05 John D. Ramsdell + + * src/CPSA/Lib/*.hs: Converted the goal language to be + strand-oriented. The goal language in incompatible with the + previous, node-oriented language. + 2018-05-22 John D. Ramsdell * src/CPSA/Lib/Cohort.hs (unrealizedInNode, nextNodeA): Lifted to diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,5 +1,12 @@ CPSA NEWS + June, 2018: + +* Release 3.6.0 adds rules and facts. Rules are associated with + protocols, and facts are associated with skeletons. A rule is a + geometric formula that is used as a rewrite rule, and a fact is a + named relation between values. + April, 2018: * The release of CPSA version 3.5.0 contains one user visiable change. diff --git a/cpsa.cabal b/cpsa.cabal --- a/cpsa.cabal +++ b/cpsa.cabal @@ -1,5 +1,5 @@ Name: cpsa -Version: 3.5.1 +Version: 3.6.0 Maintainer: mliskov@mitre.org Cabal-Version: >= 1.6 License: BSD3 @@ -110,17 +110,6 @@ Type: git Location: git://github.com/mitre/cpsa.git -Executable cpsamatch - Main-Is: CPSA/Match/Main.hs - Build-Depends: base >= 3 && < 5, containers - GHC-Options: - -Wall -fno-warn-name-shadowing -fwarn-unused-imports - Hs-Source-Dirs: src - Other-Modules: - Paths_cpsa CPSA.Lib.Utilities CPSA.Lib.Pretty CPSA.Lib.SExpr - CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.Match.Match - CPSA.Basic.Algebra CPSA.DiffieHellman.Algebra - Executable cpsa Main-Is: CPSA/Lib/Main.hs Build-Depends: base >= 3 && < 5, containers, parallel @@ -131,7 +120,7 @@ Paths_cpsa CPSA.Lib.Utilities CPSA.Lib.Pretty CPSA.Lib.SExpr CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.Lib.AlgebraLibrary CPSA.Lib.State - CPSA.Lib.Protocol CPSA.Lib.Goal CPSA.Lib.Strand + CPSA.Lib.Protocol CPSA.Lib.Strand CPSA.Lib.Characteristic CPSA.Lib.Loader CPSA.Lib.Displayer CPSA.Lib.Cohort CPSA.Lib.Expand CPSA.Lib.Reduction CPSA.Basic.Algebra CPSA.DiffieHellman.Algebra CPSA.Lib.Declaration @@ -172,9 +161,9 @@ CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.Annotations.Formulas CPSA.Annotations.Annotations CPSA.Basic.Algebra CPSA.DiffieHellman.Algebra - -Executable cpsapp - Main-Is: CPSA/Pretty/Main.hs + +Executable cpsadiff + Main-Is: CPSA/Diff/Main.hs Build-Depends: base >= 3 && < 5, containers GHC-Options: -Wall -fno-warn-name-shadowing -fwarn-unused-imports @@ -184,19 +173,19 @@ CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.Basic.Algebra -Executable cpsajson - Main-Is: CPSA/JSON/Main.hs +Executable cpsasas + Main-Is: CPSA/SAS/Main.hs Build-Depends: base >= 3 && < 5, containers GHC-Options: -Wall -fno-warn-name-shadowing -fwarn-unused-imports Hs-Source-Dirs: src Other-Modules: Paths_cpsa CPSA.Lib.Utilities CPSA.Lib.Pretty CPSA.Lib.SExpr - CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra - CPSA.Basic.Algebra - -Executable cpsadiff - Main-Is: CPSA/Diff/Main.hs + CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.SAS.SAS + CPSA.Basic.Algebra CPSA.DiffieHellman.Algebra + +Executable cpsapp + Main-Is: CPSA/Pretty/Main.hs Build-Depends: base >= 3 && < 5, containers GHC-Options: -Wall -fno-warn-name-shadowing -fwarn-unused-imports @@ -206,16 +195,16 @@ CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.Basic.Algebra -Executable cpsasas - Main-Is: CPSA/SAS/Main.hs +Executable cpsajson + Main-Is: CPSA/JSON/Main.hs Build-Depends: base >= 3 && < 5, containers GHC-Options: -Wall -fno-warn-name-shadowing -fwarn-unused-imports Hs-Source-Dirs: src Other-Modules: Paths_cpsa CPSA.Lib.Utilities CPSA.Lib.Pretty CPSA.Lib.SExpr - CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.SAS.SAS - CPSA.Basic.Algebra CPSA.DiffieHellman.Algebra + CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra + CPSA.Basic.Algebra Executable cpsadebase Main-Is: CPSA/Debase/Main.hs @@ -228,3 +217,13 @@ CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.Basic.Algebra +Executable cpsamatch + Main-Is: CPSA/Match/Main.hs + Build-Depends: base >= 3 && < 5, containers + GHC-Options: + -Wall -fno-warn-name-shadowing -fwarn-unused-imports + Hs-Source-Dirs: src + Other-Modules: + Paths_cpsa CPSA.Lib.Utilities CPSA.Lib.Pretty CPSA.Lib.SExpr + CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.Match.Match + CPSA.Basic.Algebra CPSA.DiffieHellman.Algebra diff --git a/doc/Make.hs b/doc/Make.hs --- a/doc/Make.hs +++ b/doc/Make.hs @@ -191,8 +191,8 @@ cpsaparametersRule :: Rule cpsaparametersRule = Rule { prog = "cpsaparameters", - inputExt = sourceBasicExt, - outputExt = paramsRoot ++ cpsaExt } + inputExt = sourceBasicExt, + outputExt = paramsRoot ++ cpsaExt } -- Clean generated files diff --git a/doc/cpsamanual.pdf b/doc/cpsamanual.pdf Binary files a/doc/cpsamanual.pdf and b/doc/cpsamanual.pdf differ diff --git a/doc/examples/blanchet.xhtml b/doc/examples/blanchet.xhtml --- a/doc/examples/blanchet.xhtml +++ b/doc/examples/blanchet.xhtml @@ -1,5 +1,5 @@ - + Blanchet's Simple Example Protocol @@ -12,7 +12,7 @@ 
(herald "Blanchet's Simple Example Protocol"
   (comment "There is a flaw in this protocol by design"))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from blanchet.scm")

Trees: 0 4 6 11 14 18 23 25.

diff --git a/doc/examples/bltk_or.xhtml b/doc/examples/bltk_or.xhtml --- a/doc/examples/bltk_or.xhtml +++ b/doc/examples/bltk_or.xhtml @@ -1,5 +1,5 @@ - + Otway-Rees Protocol @@ -13,7 +13,7 @@ 
(herald "Otway-Rees Protocol"
   (comment "Standard version using variables of sort mesg")
   (algebra diffie-hellman))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from bltk_or.scm")

Tree 0.

diff --git a/doc/examples/dh_mim.xhtml b/doc/examples/dh_mim.xhtml # file too large to diff: doc/examples/dh_mim.xhtml diff --git a/doc/examples/envelope.xhtml b/doc/examples/envelope.xhtml --- a/doc/examples/envelope.xhtml +++ b/doc/examples/envelope.xhtml @@ -1,5 +1,5 @@ - + Envelope Protocol @@ -11,7 +11,7 @@ 
(herald "Envelope Protocol" (bound 20))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from envelope.scm")
 (comment "Strand count bounded at 20")
diff --git a/doc/examples/eq_test.xhtml b/doc/examples/eq_test.xhtml --- a/doc/examples/eq_test.xhtml +++ b/doc/examples/eq_test.xhtml @@ -1,5 +1,5 @@ - + Equality constraint test protocol @@ -13,7 +13,7 @@ 
(herald "Equality constraint test protocol"
   (comment "First skeleton should have a shape,"
     "second, and hird should be dead."))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from eq_test.scm")

Trees: 0 2 4.

diff --git a/doc/examples/ffgg.xhtml b/doc/examples/ffgg.xhtml --- a/doc/examples/ffgg.xhtml +++ b/doc/examples/ffgg.xhtml @@ -1,5 +1,5 @@ - + The ffgg Protocol @@ -12,7 +12,7 @@ 
(herald "The ffgg Protocol"
   (comment "From A Necessarily Parallel Attack by Jon K. Millen"))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from ffgg.scm")

Tree 0.

diff --git a/doc/examples/fnof_test.xhtml b/doc/examples/fnof_test.xhtml --- a/doc/examples/fnof_test.xhtml +++ b/doc/examples/fnof_test.xhtml @@ -1,5 +1,5 @@ - + Function constraint test protocol @@ -12,7 +12,7 @@ 
(herald "Function constraint test protocol"
   (comment "Skeletons 2, 4, and 7 should have no shapes."))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from fnof_test.scm")

Trees: 0 2 3 5 6 8 10.

diff --git a/doc/examples/fnof_yahalom.xhtml b/doc/examples/fnof_yahalom.xhtml --- a/doc/examples/fnof_yahalom.xhtml +++ b/doc/examples/fnof_yahalom.xhtml @@ -1,5 +1,5 @@ - + Yahalom Protocol with Forwarding Removed, using fnof to emulate ltk function @@ -13,7 +13,7 @@ 
(herald
   "Yahalom Protocol with Forwarding Removed, using fnof to emulate ltk function"
   (bound 12))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from fnof_yahalom.scm")

Trees: 0 4 10 15.

diff --git a/doc/examples/goals.scm b/doc/examples/goals.scm --- a/doc/examples/goals.scm +++ b/doc/examples/goals.scm @@ -20,35 +20,35 @@ (comment "Needham-Schroeder with no role origination assumptions")) (defgoal ns - (forall ((b name) (n1 text) (z0 node)) + (forall ((b name) (n1 text) (z0 strd)) (implies - (and (p "init" 2 z0) + (and (p "init" z0 3) (p "init" "n1" z0 n1) (p "init" "b" z0 b) (non (privk b)) (uniq n1)) - (exists ((z1 node)) - (and (p "resp" 1 z1) (p "resp" "b" z1 b))))) + (exists ((z1 strd)) + (and (p "resp" z1 2) (p "resp" "b" z1 b))))) (comment "Initiator point of view") (comment "Authentication goal: agreement on name b")) (defgoal ns - (forall ((b name) (n1 text) (z0 node)) + (forall ((b name) (n1 text) (z0 strd)) (implies - (and (p "init" 2 z0) + (and (p "init" z0 3) (p "init" "n1" z0 n1) (p "init" "b" z0 b) (non (privk b)) (uniq n1)) - (exists ((z1 node)) - (and (p "resp" 1 z1) (p "resp" "b" z1 b) - (prec z1 z0))))) + (exists ((z1 strd)) + (and (p "resp" z1 2) (p "resp" "b" z1 b) + (prec z1 1 z0 2))))) (comment "Prec example")) (defgoal ns - (forall ((a b name) (n2 text) (z0 node)) + (forall ((a b name) (n2 text) (z0 strd)) (implies - (and (p "resp" 2 z0) (p "resp" "n2" z0 n2) + (and (p "resp" z0 3) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a) (p "resp" "b" z0 b) (non (privk a)) (uniq n2)) - (exists ((z1 node)) - (and (p "init" 1 z1) (p "init" "b" z1 b))))) + (exists ((z1 strd)) + (and (p "init" z1 2) (p "init" "b" z1 b))))) (comment "Responder point of view") (comment "Failed authentication goal: agreement on name b")) @@ -68,22 +68,22 @@ (comment "Needham-Schroeder-Lowe with no role origination assumptions")) (defgoal nsl - (forall ((a b name) (n2 text) (z0 node)) + (forall ((a b name) (n2 text) (z0 strd)) (implies - (and (p "resp" 2 z0) (p "resp" "n2" z0 n2) + (and (p "resp" z0 3) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a) (p "resp" "b" z0 b) (non (privk a)) (uniq n2)) - (exists ((z1 node)) - (and (p "init" 1 z1) (p "init" "b" z1 b))))) + (exists ((z1 strd)) + (and (p "init" z1 2) (p "init" "b" z1 b))))) (comment "Responder point of view") (comment "Authentication goal: agreement on name b")) (defgoal ns - (forall ((a b name) (n1 text) (z0 z1 node)) + (forall ((a b name) (n1 text) (z0 z1 strd)) (implies - (and (p "init" 2 z0) (p "init" "n1" z0 n1) + (and (p "init" z0 3) (p "init" "n1" z0 n1) (p "init" "a" z0 a) (p "init" "b" z0 b) - (p "" 0 z1) (p "" "x" z1 n1) + (p "" z1 1) (p "" "x" z1 n1) (non (privk a)) (non (privk b)) (uniq n1)) (false))) (comment "Initiator point of view") @@ -104,14 +104,14 @@ (defgoal unilateral (forall ((a name) (n text) - (z0 node)) + (z0 strd)) (implies - (and (p "init" 1 z0) + (and (p "init" z0 2) (p "init" "n" z0 n) (p "init" "a" z0 a) (non (privk a)) (uniq n)) - (exists ((z1 node)) - (and (p "resp" 1 z1) + (exists ((z1 strd)) + (and (p "resp" z1 2) (p "resp" "a" z1 a))))) (comment "Unilateral authentication goal")) @@ -120,12 +120,12 @@ ;;; Note that the goal requires translation of some of the role ;;; specific predicates. (defgoal ns - (forall ((a name) (n text) (z0 node)) + (forall ((a name) (n text) (z0 strd)) (implies - (and (p "init" 1 z0) (p "init" "n1" z0 n) + (and (p "init" z0 2) (p "init" "n1" z0 n) (p "init" "b" z0 a) (non (privk a)) (uniq n)) - (exists ((z1 node)) - (and (p "resp" 1 z1) (p "resp" "b" z1 a))))) + (exists ((z1 strd)) + (and (p "resp" z1 2) (p "resp" "b" z1 a))))) (comment "Initiator authentication goal") (comment "Same as unilateral goal under the predicate mapping:") (comment (p "init" "n") "->" (p "init" "n1") "and") @@ -135,12 +135,12 @@ ;;; Does responder satisfy the unilateral authentication goal? (defgoal ns - (forall ((a name) (n text) (z0 node)) + (forall ((a name) (n text) (z0 strd)) (implies - (and (p "resp" 2 z0) (p "resp" "n2" z0 n) + (and (p "resp" z0 3) (p "resp" "n2" z0 n) (p "resp" "a" z0 a) (non (privk a)) (uniq n)) - (exists ((z1 node)) - (and (p "init" 2 z1) (p "init" "a" z1 a))))) + (exists ((z1 strd)) + (and (p "init" z1 3) (p "init" "a" z1 a))))) (comment "Responder authentication goal") (comment "Same as unilateral goal under the predicate mapping:") (comment (p "init" 1) "->" (p "resp" 2) "and") @@ -150,51 +150,47 @@ (comment (p "resp" "a") "->" (p "init" "a"))) (defgoal ns - (forall ((a b name) (n text) (z0 node)) + (forall ((a b name) (n text) (z0 strd)) (implies (and - (p "init" 1 z0) (p "init" "n1" z0 n) + (p "init" z0 2) (p "init" "n1" z0 n) (p "init" "a" z0 a) (p "init" "b" z0 b) (non (privk a)) (non (privk b)) (uniq n)) - (exists ((z1 node)) - (and (p "resp" 1 z1) (p "resp" "b" z1 b))))) - (forall ((a b name) (n text) (z0 node)) + (exists ((z1 strd)) + (and (p "resp" z1 2) (p "resp" "b" z1 b))))) + (forall ((a b name) (n text) (z0 strd)) (implies (and - (p "init" 1 z0) (p "init" "n1" z0 n) + (p "init" z0 2) (p "init" "n1" z0 n) (p "init" "a" z0 a) (p "init" "b" z0 b) (non (privk a)) (non (privk b)) (uniq n)) - (exists ((z1 node)) - (and (p "resp" 1 z1) (p "resp" "a" z1 a))))) + (exists ((z1 strd)) + (and (p "resp" z1 2) (p "resp" "a" z1 a))))) (comment "Two initiator authentication goals")) ;;; The shape analysis sentence as input (kind of useless) (defgoal ns - (forall ((n1 n2 text) (b a name) (z z-0 node)) + (forall ((n1 n2 text) (b a name) (z strd)) (implies - (and (p "init" 0 z) (p "init" 2 z-0) - (p "init" "n1" z-0 n1) (p "init" "n2" z-0 n2) - (p "init" "a" z-0 a) (p "init" "b" z-0 b) - (str-prec z z-0) (non (privk b)) (uniq-at n1 z)) - (exists ((n2-0 text) (z-1 z-2 z-3 node)) - (and (p "init" 1 z-1) (p "resp" 0 z-2) - (p "resp" 1 z-3) (p "resp" "n2" z-3 n2-0) - (p "resp" "n1" z-3 n1) (p "resp" "b" z-3 b) - (p "resp" "a" z-3 a) (prec z z-2) (prec z-3 z-1) - (str-prec z z-1) (str-prec z-1 z-0) - (str-prec z-2 z-3))))) + (and (p "init" z 3) (p "init" "n1" z n1) (p "init" "n2" z n2) + (p "init" "a" z a) (p "init" "b" z b) (non (privk b)) + (uniq-at n1 z 0)) + (exists ((n2-0 text) (z-0 strd)) + (and (p "resp" z-0 2) (p "resp" "n2" z-0 n2-0) + (p "resp" "n1" z-0 n1) (p "resp" "b" z-0 b) + (p "resp" "a" z-0 a) (prec z 0 z-0 0) (prec z-0 1 z 1))))) (comment "Shape analysis sentence")) ;;; Section 2 --- Additional Examples (defgoal ns - (forall ((a b name) (n2 text) (z0 z1 node)) + (forall ((a b name) (n2 text) (z0 z1 strd)) (implies (and - (p "resp" 2 z0) (p "resp" "n2" z0 n2) + (p "resp" z0 3) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a) (p "resp" "b" z0 b) - (p "" 0 z1) (p "" "x" z1 n2) + (p "" z1 1) (p "" "x" z1 n2) (non (privk a)) (non (privk b)) (uniq n2)) (false))) (comment "Responder point of view") @@ -208,17 +204,14 @@ (non-orig (privk b) (privk a)) (uniq-orig n1 n1-0) (goals - (forall ((n1 n1-0 n2 n2-0 text) (a b name) (z z-0 z-1 z-2 node)) + (forall ((n1 n1-0 n2 n2-0 text) (a b name) (z z-0 strd)) (implies - (and - (p "init" 0 z) (p "init" 2 z-0) (p "init" 0 z-1) - (p "init" 2 z-2) (p "init" "n1" z-0 n1) (p "init" "n2" z-0 n2) - (p "init" "a" z-0 a) (p "init" "b" z-0 b) - (p "init" "n1" z-2 n1-0) (p "init" "n2" z-2 n2-0) - (p "init" "a" z-2 a) (p "init" "b" z-2 b) (str-prec z z-0) - (str-prec z-1 z-2) (non (privk a)) (non (privk b)) - (uniq-at n1 z) (uniq-at n1-0 z-1)) - (= z-1 z)))) + (and (p "init" z 3) (p "init" z-0 3) (p "init" "n1" z n1) + (p "init" "n2" z n2) (p "init" "a" z a) (p "init" "b" z b) + (p "init" "n1" z-0 n1-0) (p "init" "n2" z-0 n2-0) + (p "init" "a" z-0 a) (p "init" "b" z-0 b) (non (privk a)) + (non (privk b)) (uniq-at n1 z 0) (uniq-at n1-0 z-0 0)) + (= z z-0)))) (comment "Double initiator point of view")) (defprotocol nsl-typeless basic @@ -238,154 +231,10 @@ ;;; The responder point of view (defgoal nsl-typeless - (forall ((n2 text) (a b name) (z z-0 node)) + (forall ((n2 text) (a b name) (z z-0 strd)) (implies - (and (p "resp" 1 z) (p "" 0 z-0) + (and (p "resp" z 2) (p "" z-0 1) (p "resp" "n2" z n2) (p "resp" "b" z b) (p "resp" "a" z a) (p "" "x" z-0 n2) (non (privk a)) (non (privk b)) (uniq n2)) (false))) (comment "Shows typeflaw in typeless NSL")) - -(defskeleton ns - (vars (a name) (n2 text)) - (defstrand resp 3 (a a) (n2 n2)) - (non-orig (privk a)) - (uniq-orig n2) - (goals - (forall ((n1 n2 text) (a b name) (z z-0 node)) - (implies - (and (p "init" 0 z) (p "init" 2 z-0) - (p "init" "n1" z-0 n1) (p "init" "n2" z-0 n2) - (p "init" "a" z-0 a) (p "init" "b" z-0 b) - (str-prec z z-0) (non (privk a)) (non (privk b)) - (uniq-at n1 z)) - (exists ((z-1 z-2 z-3 node)) - (and (p "init" 1 z-1) (p "resp" 0 z-2) - (p "resp" 1 z-3) (p "resp" "n2" z-3 n2) - (p "resp" "n1" z-3 n1) (p "resp" "b" z-3 b) - (p "resp" "a" z-3 a) (prec z z-2) (prec z-3 z-1) - (str-prec z z-1) (str-prec z-1 z-0) - (str-prec z-2 z-3)))))) - (comment "Responder point of view with SAS")) - -(defskeleton ns - (vars (a name) (n2 text)) - (defstrand resp 3 (a a) (n2 n2)) - (non-orig (privk a)) - (uniq-orig n2) - (goals - (forall ((n1 n2 text) (a b name) (z z-0 node)) - (implies - (and (p "init" 0 z) (p "init" 2 z-0) - (p "init" "n1" z-0 n1) (p "init" "n2" z-0 n2) - (p "init" "a" z-0 a) (p "init" "b" z-0 b) - (str-prec z z-0) (non (privk a)) (non (privk b)) - (uniq-at n1 z)) - (false)))) - (comment "Responder point of view with false as the conclusion")) - -(defskeleton ns - (vars (a b name) (n1 text)) - (defstrand init 3 (a a) (b b) (n1 n1)) - (non-orig (privk b) (privk a)) - (uniq-orig n1) - (goals - (forall ((n1 n2 text) (a b name) (z z-0 node)) - (implies - (and (p "init" 0 z) (p "init" 2 z-0) - (p "init" "n1" z-0 n1) (p "init" "n2" z-0 n2) - (p "init" "a" z-0 a) (p "init" "b" z-0 b) - (str-prec z z-0) (non (privk a)) (non (privk b)) - (uniq-at n1 z)) - (false)))) - (comment "Initiator point of view with false as the conclusion")) - -(defgoal ns - (forall ((a b name) (n text) (z0 node)) - (implies - (and - (p "resp" 2 z0) (p "resp" "n2" z0 n) - (p "resp" "a" z0 a) (p "resp" "b" z0 b) - (non (privk a)) (non (privk b)) (uniq n)) - (exists ((z1 node)) - (and (p "init" 2 z1) (p "init" "a" z1 a))))) - (forall ((a b name) (n text) (z0 node)) - (implies - (and - (p "resp" 2 z0) (p "resp" "n2" z0 n) - (p "resp" "a" z0 a) (p "resp" "b" z0 b) - (non (privk a)) (non (privk b)) (uniq n)) - (exists ((z1 node)) - (and (p "init" 2 z1) (p "init" "b" z1 b))))) - (comment "Two responder authentication goals")) - -;;; Needham-Schroeder Protocol with origination assumptions on roles - -(defprotocol ns-role-origs basic - (defrole init - (vars (a b name) (n1 n2 text)) - (trace - (send (enc n1 a (pubk b))) - (recv (enc n1 n2 (pubk a))) - (send (enc n2 (pubk b)))) - (non-orig (privk b)) - (uniq-orig n1)) - (defrole resp - (vars (b a name) (n2 n1 text)) - (trace - (recv (enc n1 a (pubk b))) - (send (enc n1 n2 (pubk a))) - (recv (enc n2 (pubk b)))) - (non-orig (privk a)) - (uniq-orig n2)) - (comment "Needham-Schroeder with role assumptions that are too strong")) - -;;; The initiator point of view -(defskeleton ns-role-origs - (vars) - (defstrand init 3)) - -;;; The responder point of view -(defskeleton ns-role-origs - (vars) - (defstrand resp 3)) - -;;; Needham-Schroeder Protocol with a doubled nonce. Look at the -;;; first message in each role. - -(defprotocol ns2 basic - (defrole init - (vars (a b name) (n1 n2 n3 text)) - (trace - (send (enc n1 n3 a (pubk b))) - (recv (enc n1 n2 (pubk a))) - (send (enc n2 (pubk b))))) - (defrole resp - (vars (b a name) (n2 n1 text)) - (trace - (recv (enc n1 n1 a (pubk b))) - (send (enc n1 n2 (pubk a))) - (recv (enc n2 (pubk b)))) - (note doubled nonce in the first message)) - (note that this protocol is derived from Needham-Schroeder)) - -(defskeleton ns2 - (vars (a b name) (n1 text)) - (defstrand init 3 (a a) (b b) (n1 n1)) - (non-orig (privk b) (privk a)) - (uniq-orig n1) - (note the disappearance of this note)) - -;;; Note that the association list style key-value pairs that follow -;;; the list of strands can be supplied in any order, and values with -;;; the same key are appended together. Check the output to see how -;;; CPSA interprets this input. -(defskeleton ns - (vars (n1 n2 text) (a b name)) - (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b)) - (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a)) - (non-orig (privk b)) - (precedes ((0 0) (1 0))) - (non-orig (privk a)) - (uniq-orig n1) - (precedes ((1 1) (0 1)))) diff --git a/doc/examples/goals.xhtml b/doc/examples/goals.xhtml --- a/doc/examples/goals.xhtml +++ b/doc/examples/goals.xhtml @@ -1,4982 +1,3438 @@ - - - - goals - - - - - -
(herald goals)
-(comment "CPSA 3.5.0")
-(comment "All input read from goals.scm")
- -

Trees: 0 2 4 6 8 17 19 21 23 26 28 33 41 45 47 49 52 54 57 62 65.

- -

Tree 0.

- -
- - 1 - - 0 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 0, Child: 1.

- -
- - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 0 -
- -
(defskeleton ns
-  (vars (n1 n2 text) (b a name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (non-orig (privk b))
-  (uniq-orig n1)
-  (goals
-    (forall ((b name) (n1 text) (z0 node))
-      (implies
-        (and (p "init" 2 z0) (p "init" "n1" z0 n1) (p "init" "b" z0 b)
-          (non (privk b)) (uniq n1))
-        (exists ((z1 node))
-          (and (p "resp" 1 z1) (p "resp" "b" z1 b))))))
-  (comment "Initiator point of view"
-    "Authentication goal: agreement on name b")
-  (label 0)
-  (unrealized (0 1))
-  (origs (n1 (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 1, Parent: 0.

- -
- - - - - - - - - (enc n1 n2-0 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - ((n2 n2-0) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 1 (realized)
- -
(defskeleton ns
-  (vars (n1 n2 n2-0 text) (b a name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (added-strand resp 2) n1 (0 1)
-    (enc n1 a (pubk b)))
-  (label 1)
-  (parent 0)
-  (unrealized)
-  (shape)
-  (satisfies yes)
-  (maps ((0) ((b b) (n1 n1) (a a) (n2 n2))))
-  (origs (n1 (0 0))))
- -

Tree 2.

- -
- - 3 - - 2 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 2, Child: 3.

- -
- - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 2 -
- -
(defskeleton ns
-  (vars (n1 n2 text) (b a name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (non-orig (privk b))
-  (uniq-orig n1)
-  (goals
-    (forall ((b name) (n1 text) (z0 node))
-      (implies
-        (and (p "init" 2 z0) (p "init" "n1" z0 n1) (p "init" "b" z0 b)
-          (non (privk b)) (uniq n1))
-        (exists ((z1 node))
-          (and (p "resp" 1 z1) (p "resp" "b" z1 b) (prec z1 z0))))))
-  (comment "Prec example")
-  (label 2)
-  (unrealized (0 1))
-  (origs (n1 (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 3, Parent: 2.

- -
- - - - - - - - - (enc n1 n2-0 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - ((n2 n2-0) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 3 (realized)
- -
(defskeleton ns
-  (vars (n1 n2 n2-0 text) (b a name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (added-strand resp 2) n1 (0 1)
-    (enc n1 a (pubk b)))
-  (label 3)
-  (parent 2)
-  (unrealized)
-  (shape)
-  (satisfies (no (b b) (n1 n1) (z0 (0 2))))
-  (maps ((0) ((b b) (n1 n1) (a a) (n2 n2))))
-  (origs (n1 (0 0))))
- -

Tree 4.

- -
- - 5 - - 4 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 4, Child: 5.

- -
- - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns 4 -
- -
(defskeleton ns
-  (vars (n2 n1 text) (a b name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (goals
-    (forall ((a b name) (n2 text) (z0 node))
-      (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
-          (p "resp" "b" z0 b) (non (privk a)) (uniq n2))
-        (exists ((z1 node))
-          (and (p "init" 1 z1) (p "init" "b" z1 b))))))
-  (comment "Responder point of view"
-    "Failed authentication goal: agreement on name b")
-  (label 4)
-  (unrealized (0 2))
-  (origs (n2 (0 1)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 5, Parent: 4.

- -
- - - - - - - - - (enc n2 (pubk b-0)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b-0)) - - (enc n2 (pubk b)) - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n2) (a a) (b b-0)) - init - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns 5 (realized)
- -
(defskeleton ns
-  (vars (n2 n1 text) (a b b-0 name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
-  (precedes ((0 1) (1 1)) ((1 2) (0 2)))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (operation nonce-test (added-strand init 3) n2 (0 2)
-    (enc n1 n2 (pubk a)))
-  (label 5)
-  (parent 4)
-  (unrealized)
-  (shape)
-  (satisfies (no (a a) (b b) (n2 n2) (z0 (0 2))))
-  (maps ((0) ((a a) (b b) (n2 n2) (n1 n1))))
-  (origs (n2 (0 1))))
- -

Tree 6.

- -
- - 7 - - 6 -
- -
(defprotocol nsl basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 b (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 b (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment
-    "Needham-Schroeder-Lowe with no role origination assumptions"))
- -

Item 6, Child: 7.

- -
- - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 b (pubk a)) - - (enc n1 a (pubk b)) - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - nsl 6 -
- -
(defskeleton nsl
-  (vars (n2 n1 text) (a b name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (goals
-    (forall ((a b name) (n2 text) (z0 node))
-      (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
-          (p "resp" "b" z0 b) (non (privk a)) (uniq n2))
-        (exists ((z1 node))
-          (and (p "init" 1 z1) (p "init" "b" z1 b))))))
-  (comment "Responder point of view"
-    "Authentication goal: agreement on name b")
-  (label 6)
-  (unrealized (0 2))
-  (origs (n2 (0 1)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 7, Parent: 6.

- -
- - - - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 b (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - - (enc n1 n2 b (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - nsl 7 (realized)
- -
(defskeleton nsl
-  (vars (n2 n1 text) (a b name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (precedes ((0 1) (1 1)) ((1 2) (0 2)))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (operation nonce-test (added-strand init 3) n2 (0 2)
-    (enc n1 n2 b (pubk a)))
-  (label 7)
-  (parent 6)
-  (unrealized)
-  (shape)
-  (satisfies yes)
-  (maps ((0) ((a a) (b b) (n2 n2) (n1 n1))))
-  (origs (n2 (0 1))))
- -

Tree 8.

- -
- - 15 - - 13 - - 16 - - 15 - - 16 - - 14 - - 12 - - 11 - - 10 - - 9 - - 8 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 8, Child: 9.

- -
- - - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - n1 - n1 - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 8 -
- -
(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (deflistener n1)
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (goals
-    (forall ((a b name) (n1 text) (z0 z1 node))
-      (implies
-        (and (p "init" 2 z0) (p "init" "n1" z0 n1) (p "init" "a" z0 a)
-          (p "init" "b" z0 b) (p "" 0 z1) (p "" "x" z1 n1)
-          (non (privk a)) (non (privk b)) (uniq n1)) (false))))
-  (comment "Initiator point of view"
-    "Secrecy goal: nonce n1 not revealed")
-  (label 8)
-  (unrealized (0 0) (1 1))
-  (preskeleton)
-  (comment "Not a skeleton"))
- -

Item 9, Parent: 8, Child: 10.

- -
- - - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - n1 - n1 - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 9 -
- -
(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (deflistener n1)
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (precedes ((1 0) (0 0)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (goals
-    (forall ((a b name) (n1 text) (z0 z1 node))
-      (implies
-        (and (p "init" 2 z0) (p "init" "n1" z0 n1) (p "init" "a" z0 a)
-          (p "init" "b" z0 b) (p "" 0 z1) (p "" "x" z1 n1)
-          (non (privk a)) (non (privk b)) (uniq n1)) (false))))
-  (comment "Initiator point of view"
-    "Secrecy goal: nonce n1 not revealed")
-  (label 9)
-  (parent 8)
-  (unrealized (0 0) (1 1))
-  (origs (n1 (1 0)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 10, Parent: 9, Child: 11.

- -
- - - - - - - - - - (enc n1 n2-0 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - - (enc n1 a (pubk b)) - - n1 - n1 - - ((n2 n2-0) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 10 -
- -
(defskeleton ns
-  (vars (n1 n2 n2-0 text) (a b name))
-  (deflistener n1)
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((1 0) (0 0)) ((1 0) (2 0)) ((2 1) (1 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (added-strand resp 2) n1 (1 1)
-    (enc n1 a (pubk b)))
-  (label 10)
-  (parent 9)
-  (unrealized (0 0) (1 1))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 11, Parent: 10, Children: 12 13.

- -
- - - - - - - - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - - (enc n1 a (pubk b)) - - n1 - n1 - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 11 -
- -
(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (deflistener n1)
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
-  (precedes ((1 0) (0 0)) ((1 0) (2 0)) ((2 1) (1 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (contracted (n2-0 n2)) n1 (1 1)
-    (enc n1 n2 (pubk a)) (enc n1 a (pubk b)))
-  (label 11)
-  (parent 10)
-  (unrealized (0 0))
-  (comment "2 in cohort - 2 not yet seen"))
- -

Item 12, Parent: 11, Children: 14 15.

- -
- - - - - - - - - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - n1 - n1 - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 12 -
- -
(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (deflistener n1)
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
-  (precedes ((1 0) (2 0)) ((2 1) (0 0)) ((2 1) (1 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (displaced 3 2 resp 2) n1 (0 0)
-    (enc n1 a (pubk b)))
-  (label 12)
-  (parent 11)
-  (unrealized (0 0))
-  (comment "2 in cohort - 2 not yet seen"))
- -

Item 13, Parent: 11, Seen Child: 15.

- -
- - - - - - - - - - - (enc n1 n2-0 (pubk a)) - - (enc n1 a (pubk b)) - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - - (enc n1 a (pubk b)) - - n1 - n1 - - ((n2 n2-0) (n1 n1) (b b) (a a)) - resp - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 13 -
- -
(defskeleton ns
-  (vars (n1 n2 n2-0 text) (a b name))
-  (deflistener n1)
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((1 0) (2 0)) ((1 0) (3 0)) ((2 1) (1 1)) ((3 1) (0 0)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (added-strand resp 2) n1 (0 0)
-    (enc n1 a (pubk b)))
-  (label 13)
-  (parent 11)
-  (seen 15)
-  (unrealized (0 0))
-  (comment "1 in cohort - 0 not yet seen"))
- -

Item 14, Parent: 12, Child: 16.

- -
- - - - - - - - - - (enc n2 n2 (pubk a)) - - (enc n2 a (pubk b)) - - - (enc n2 (pubk b)) - - (enc n2 n2 (pubk a)) - - - (enc n2 a (pubk b)) - - n2 - n2 - - ((n2 n2) (n1 n2) (b b) (a a)) - resp - - ((n1 n2) (n2 n2) (a a) (b b)) - init - - ns 14 -
- -
(defskeleton ns
-  (vars (n2 text) (a b name))
-  (deflistener n2)
-  (defstrand init 3 (n1 n2) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n2) (b b) (a a))
-  (precedes ((1 0) (2 0)) ((1 2) (0 0)) ((2 1) (1 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2)
-  (operation nonce-test (displaced 3 1 init 3) n2 (0 0)
-    (enc n2 n2 (pubk a)) (enc n2 a (pubk b)))
-  (label 14)
-  (parent 12)
-  (unrealized (0 0))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 15, Parent: 12, Seen Child: 16.

- -
- - - - - - - - - - - (enc n1 n2-0 (pubk a)) - - (enc n1 a (pubk b)) - - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - - (enc n1 a (pubk b)) - - n1 - n1 - - ((n2 n2-0) (n1 n1) (b b) (a a)) - resp - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 15 -
- -
(defskeleton ns
-  (vars (n1 n2 n2-0 text) (a b name))
-  (deflistener n1)
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((1 0) (2 0)) ((1 0) (3 0)) ((2 1) (0 0)) ((2 1) (1 1))
-    ((3 1) (0 0)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (added-strand resp 2) n1 (0 0)
-    (enc n1 n2 (pubk a)) (enc n1 a (pubk b)))
-  (label 15)
-  (parent 12)
-  (seen 16)
-  (unrealized (0 0))
-  (comment "1 in cohort - 0 not yet seen"))
- -

Item 16, Parent: 14.

- -
- - - - - - - - - - - (enc n2 n2-0 (pubk a)) - - (enc n2 a (pubk b)) - - - (enc n2 n2 (pubk a)) - - (enc n2 a (pubk b)) - - - (enc n2 (pubk b)) - - (enc n2 n2 (pubk a)) - - - - (enc n2 a (pubk b)) - - n2 - n2 - - ((n2 n2-0) (n1 n2) (b b) (a a)) - resp - - ((n2 n2) (n1 n2) (b b) (a a)) - resp - - ((n1 n2) (n2 n2) (a a) (b b)) - init - - ns 16 -
- -
(defskeleton ns
-  (vars (n2 n2-0 text) (a b name))
-  (deflistener n2)
-  (defstrand init 3 (n1 n2) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n2) (b b) (a a))
-  (defstrand resp 2 (n2 n2-0) (n1 n2) (b b) (a a))
-  (precedes ((1 0) (2 0)) ((1 0) (3 0)) ((1 2) (0 0)) ((2 1) (1 1))
-    ((3 1) (0 0)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2)
-  (operation nonce-test (added-strand resp 2) n2 (0 0) (enc n2 (pubk b))
-    (enc n2 n2 (pubk a)) (enc n2 a (pubk b)))
-  (label 16)
-  (parent 14)
-  (unrealized (0 0))
-  (comment "empty cohort"))
- -

Tree 17.

- -
- - 18 - - 17 -
- -
(defprotocol unilateral basic
-  (defrole init
-    (vars (a name) (n text))
-    (trace (send (enc n (pubk a))) (recv n)))
-  (defrole resp
-    (vars (a name) (n text))
-    (trace (recv (enc n (pubk a))) (send n)))
-  (comment "Unilateral authentication"))
- -

Item 17, Child: 18.

- -
- - - - - - - n - - (enc n (pubk a)) - - ((n n) (a a)) - init - - unilateral 17
- -
(defskeleton unilateral
-  (vars (n text) (a name))
-  (defstrand init 2 (n n) (a a))
-  (non-orig (privk a))
-  (uniq-orig n)
-  (goals
-    (forall ((a name) (n text) (z0 node))
-      (implies
-        (and (p "init" 1 z0) (p "init" "n" z0 n) (p "init" "a" z0 a)
-          (non (privk a)) (uniq n))
-        (exists ((z1 node))
-          (and (p "resp" 1 z1) (p "resp" "a" z1 a))))))
-  (comment "Unilateral authentication goal")
-  (label 17)
-  (unrealized (0 1))
-  (origs (n (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 18, Parent: 17.

- -
- - - - - - - - - n - (enc n (pubk a)) - - n - - - (enc n (pubk a)) - - ((n n) (a a)) - resp - - ((n n) (a a)) - init - - unilateral 18 (realized) -
- -
(defskeleton unilateral
-  (vars (n text) (a name))
-  (defstrand init 2 (n n) (a a))
-  (defstrand resp 2 (n n) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a))
-  (uniq-orig n)
-  (operation nonce-test (added-strand resp 2) n (0 1) (enc n (pubk a)))
-  (label 18)
-  (parent 17)
-  (unrealized)
-  (shape)
-  (satisfies yes)
-  (maps ((0) ((a a) (n n))))
-  (origs (n (0 0))))
- -

Tree 19.

- -
- - 20 - - 19 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 19, Child: 20.

- -
- - - - - - - (enc n n2 (pubk a-0)) - - (enc n a-0 (pubk a)) - - ((n1 n) (n2 n2) (a a-0) (b a)) - init - - ns 19 -
- -
(defskeleton ns
-  (vars (n n2 text) (a a-0 name))
-  (defstrand init 2 (n1 n) (n2 n2) (a a-0) (b a))
-  (non-orig (privk a))
-  (uniq-orig n)
-  (goals
-    (forall ((a name) (n text) (z0 node))
-      (implies
-        (and (p "init" 1 z0) (p "init" "n1" z0 n) (p "init" "b" z0 a)
-          (non (privk a)) (uniq n))
-        (exists ((z1 node))
-          (and (p "resp" 1 z1) (p "resp" "b" z1 a))))))
-  (comment "Initiator authentication goal"
-    "Same as unilateral goal under the predicate mapping:"
-    (p "init" "n") "->" (p "init" "n1") "and" (p "init" "a") "->"
-    (p "init" "b") "and" (p "resp" "a") "->" (p "resp" "b"))
-  (label 19)
-  (unrealized (0 1))
-  (origs (n (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 20, Parent: 19.

- -
- - - - - - - - - (enc n n2-0 (pubk a-0)) - - (enc n a-0 (pubk a)) - - (enc n n2 (pubk a-0)) - - - (enc n a-0 (pubk a)) - - ((n2 n2-0) (n1 n) (b a) (a a-0)) - resp - - ((n1 n) (n2 n2) (a a-0) (b a)) - init - - ns 20 (realized)
- -
(defskeleton ns
-  (vars (n n2 n2-0 text) (a a-0 name))
-  (defstrand init 2 (n1 n) (n2 n2) (a a-0) (b a))
-  (defstrand resp 2 (n2 n2-0) (n1 n) (b a) (a a-0))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a))
-  (uniq-orig n)
-  (operation nonce-test (added-strand resp 2) n (0 1)
-    (enc n a-0 (pubk a)))
-  (label 20)
-  (parent 19)
-  (unrealized)
-  (shape)
-  (satisfies yes)
-  (maps ((0) ((a a) (n n) (a-0 a-0) (n2 n2))))
-  (origs (n (0 0))))
- -

Tree 21.

- -
- - 22 - - 21 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 21, Child: 22.

- -
- - - - - - - (enc n (pubk b)) - - (enc n1 n (pubk a)) - - (enc n1 a (pubk b)) - - ((n2 n) (n1 n1) (b b) (a a)) - resp - - ns 21 -
- -
(defskeleton ns
-  (vars (n n1 text) (a b name))
-  (defstrand resp 3 (n2 n) (n1 n1) (b b) (a a))
-  (non-orig (privk a))
-  (uniq-orig n)
-  (goals
-    (forall ((a name) (n text) (z0 node))
-      (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n) (p "resp" "a" z0 a)
-          (non (privk a)) (uniq n))
-        (exists ((z1 node))
-          (and (p "init" 2 z1) (p "init" "a" z1 a))))))
-  (comment "Responder authentication goal"
-    "Same as unilateral goal under the predicate mapping:" (p "init" 1)
-    "->" (p "resp" 2) "and" (p "init" "n") "->" (p "resp" "n2") "and"
-    (p "init" "a") "->" (p "resp" "a") "and" (p "resp" 1) "->"
-    (p "init" 2) "and" (p "resp" "a") "->" (p "init" "a"))
-  (label 21)
-  (unrealized (0 2))
-  (origs (n (0 1)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 22, Parent: 21.

- -
- - - - - - - - - (enc n (pubk b-0)) - - (enc n1 n (pubk a)) - - (enc n1 a (pubk b-0)) - - (enc n (pubk b)) - - - (enc n1 n (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n) (a a) (b b-0)) - init - - ((n2 n) (n1 n1) (b b) (a a)) - resp - - ns 22 (realized)
- -
(defskeleton ns
-  (vars (n n1 text) (a b b-0 name))
-  (defstrand resp 3 (n2 n) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n) (a a) (b b-0))
-  (precedes ((0 1) (1 1)) ((1 2) (0 2)))
-  (non-orig (privk a))
-  (uniq-orig n)
-  (operation nonce-test (added-strand init 3) n (0 2)
-    (enc n1 n (pubk a)))
-  (label 22)
-  (parent 21)
-  (unrealized)
-  (shape)
-  (satisfies yes)
-  (maps ((0) ((a a) (n n) (b b) (n1 n1))))
-  (origs (n (0 1))))
- -

Tree 23.

- -
- - 25 - - 24 - - 23 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 23, Child: 24.

- -
- - - - - - - (enc n n2 (pubk a)) - - (enc n a (pubk b)) - - ((n1 n) (n2 n2) (a a) (b b)) - init - - ns 23 -
- -
(defskeleton ns
-  (vars (n n2 text) (a b name))
-  (defstrand init 2 (n1 n) (n2 n2) (a a) (b b))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n)
-  (goals
-    (forall ((a b name) (n text) (z0 node))
-      (implies
-        (and (p "init" 1 z0) (p "init" "n1" z0 n) (p "init" "a" z0 a)
-          (p "init" "b" z0 b) (non (privk a)) (non (privk b)) (uniq n))
-        (exists ((z1 node)) (and (p "resp" 1 z1) (p "resp" "b" z1 b)))))
-    (forall ((a b name) (n text) (z0 node))
-      (implies
-        (and (p "init" 1 z0) (p "init" "n1" z0 n) (p "init" "a" z0 a)
-          (p "init" "b" z0 b) (non (privk a)) (non (privk b)) (uniq n))
-        (exists ((z1 node))
-          (and (p "resp" 1 z1) (p "resp" "a" z1 a))))))
-  (comment "Two initiator authentication goals")
-  (label 23)
-  (unrealized (0 1))
-  (origs (n (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 24, Parent: 23, Child: 25.

- -
- - - - - - - - - (enc n n2-0 (pubk a)) - - (enc n a (pubk b)) - - (enc n n2 (pubk a)) - - - (enc n a (pubk b)) - - ((n2 n2-0) (n1 n) (b b) (a a)) - resp - - ((n1 n) (n2 n2) (a a) (b b)) - init - - ns 24 -
- -
(defskeleton ns
-  (vars (n n2 n2-0 text) (a b name))
-  (defstrand init 2 (n1 n) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n)
-  (operation nonce-test (added-strand resp 2) n (0 1)
-    (enc n a (pubk b)))
-  (label 24)
-  (parent 23)
-  (unrealized (0 1))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 25, Parent: 24.

- -
- - - - - - - - - (enc n n2 (pubk a)) - - (enc n a (pubk b)) - - (enc n n2 (pubk a)) - - - (enc n a (pubk b)) - - ((n2 n2) (n1 n) (b b) (a a)) - resp - - ((n1 n) (n2 n2) (a a) (b b)) - init - - ns 25 (realized)
- -
(defskeleton ns
-  (vars (n n2 text) (a b name))
-  (defstrand init 2 (n1 n) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n)
-  (operation nonce-test (contracted (n2-0 n2)) n (0 1)
-    (enc n n2 (pubk a)) (enc n a (pubk b)))
-  (label 25)
-  (parent 24)
-  (unrealized)
-  (shape)
-  (satisfies yes yes)
-  (maps ((0) ((a a) (b b) (n n) (n2 n2))))
-  (origs (n (0 0))))
- -

Tree 26.

- -
- - 27 - - 26 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 26, Child: 27.

- -
- - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 26 -
- -
(defskeleton ns
-  (vars (n1 n2 text) (b a name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (non-orig (privk b))
-  (uniq-orig n1)
-  (goals
-    (forall ((n1 n2 text) (b a name) (z z-0 node))
-      (implies
-        (and (p "init" 0 z) (p "init" 2 z-0) (p "init" "n1" z-0 n1)
-          (p "init" "n2" z-0 n2) (p "init" "a" z-0 a)
-          (p "init" "b" z-0 b) (str-prec z z-0) (non (privk b))
-          (uniq-at n1 z))
-        (exists ((n2-0 text) (z-1 z-2 z-3 node))
-          (and (p "init" 1 z-1) (p "resp" 0 z-2) (p "resp" 1 z-3)
-            (p "resp" "n2" z-3 n2-0) (p "resp" "n1" z-3 n1)
-            (p "resp" "b" z-3 b) (p "resp" "a" z-3 a) (prec z z-2)
-            (prec z-3 z-1) (str-prec z z-1) (str-prec z-1 z-0)
-            (str-prec z-2 z-3))))))
-  (comment "Shape analysis sentence")
-  (label 26)
-  (unrealized (0 1))
-  (origs (n1 (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 27, Parent: 26.

- -
- - - - - - - - - (enc n1 n2-0 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - ((n2 n2-0) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 27 (realized)
- -
(defskeleton ns
-  (vars (n1 n2 n2-0 text) (b a name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (added-strand resp 2) n1 (0 1)
-    (enc n1 a (pubk b)))
-  (label 27)
-  (parent 26)
-  (unrealized)
-  (shape)
-  (satisfies yes)
-  (maps ((0) ((n1 n1) (n2 n2) (b b) (a a))))
-  (origs (n1 (0 0))))
- -

Tree 28.

- -
- - 32 - - 31 - - 30 - - 29 - - 28 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 28, Child: 29.

- -
- - - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - n2 - n2 - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns 28 -
- -
(defskeleton ns
-  (vars (n2 n1 text) (a b name))
-  (deflistener n2)
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2)
-  (goals
-    (forall ((a b name) (n2 text) (z0 z1 node))
-      (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
-          (p "resp" "b" z0 b) (p "" 0 z1) (p "" "x" z1 n2)
-          (non (privk a)) (non (privk b)) (uniq n2)) (false))))
-  (comment "Responder point of view"
-    "Failed secrecy goal: nonce n2 not revealed")
-  (label 28)
-  (unrealized (0 0) (1 2))
-  (preskeleton)
-  (comment "Not a skeleton"))
- -

Item 29, Parent: 28, Child: 30.

- -
- - - - - - - - (enc n2 (pubk b)) - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - n2 - n2 - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns 29 -
- -
(defskeleton ns
-  (vars (n2 n1 text) (a b name))
-  (deflistener n2)
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (precedes ((1 1) (0 0)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2)
-  (goals
-    (forall ((a b name) (n2 text) (z0 z1 node))
-      (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
-          (p "resp" "b" z0 b) (p "" 0 z1) (p "" "x" z1 n2)
-          (non (privk a)) (non (privk b)) (uniq n2)) (false))))
-  (comment "Responder point of view"
-    "Failed secrecy goal: nonce n2 not revealed")
-  (label 29)
-  (parent 28)
-  (unrealized (0 0) (1 2))
-  (origs (n2 (1 1)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 30, Parent: 29, Children: 31 32.

- -
- - - - - - - - - - (enc n2 (pubk b-0)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b-0)) - - (enc n2 (pubk b)) - - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - n2 - n2 - - ((n1 n1) (n2 n2) (a a) (b b-0)) - init - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns 30 -
- -
(defskeleton ns
-  (vars (n2 n1 text) (a b b-0 name))
-  (deflistener n2)
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
-  (precedes ((1 1) (0 0)) ((1 1) (2 1)) ((2 2) (1 2)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2)
-  (operation nonce-test (added-strand init 3) n2 (1 2)
-    (enc n1 n2 (pubk a)))
-  (label 30)
-  (parent 29)
-  (unrealized (0 0))
-  (comment "2 in cohort - 2 not yet seen"))
- -

Item 31, Parent: 30.

- -
- - - - - - - - - - - (enc n2 (pubk b-0)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b-0)) - - (enc n2 (pubk b)) - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - n2 - n2 - - ((n1 n1) (n2 n2) (a a) (b b-0)) - init - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns 31 (realized)
- -
(defskeleton ns
-  (vars (n2 n1 text) (a b b-0 name))
-  (deflistener n2)
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
-  (precedes ((1 1) (2 1)) ((2 2) (0 0)) ((2 2) (1 2)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2)
-  (operation nonce-test (displaced 3 2 init 3) n2 (0 0)
-    (enc n1 n2 (pubk a)))
-  (label 31)
-  (parent 30)
-  (unrealized)
-  (shape)
-  (satisfies (no (a a) (b b) (n2 n2) (z0 (1 2)) (z1 (0 0))))
-  (maps ((0 1) ((a a) (b b) (n2 n2) (n1 n1))))
-  (origs (n2 (1 1))))
- -

Item 32, Parent: 30.

- -
- - - - - - - - - - - (enc n2 (pubk b-1)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b-1)) - - - (enc n2 (pubk b-0)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b-0)) - - (enc n2 (pubk b)) - - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - n2 - n2 - - ((n1 n1) (n2 n2) (a a) (b b-1)) - init - - ((n1 n1) (n2 n2) (a a) (b b-0)) - init - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns 32 (realized)
- -
(defskeleton ns
-  (vars (n2 n1 text) (a b b-0 b-1 name))
-  (deflistener n2)
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-1))
-  (precedes ((1 1) (2 1)) ((1 1) (3 1)) ((2 2) (1 2)) ((3 2) (0 0)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2)
-  (operation nonce-test (added-strand init 3) n2 (0 0)
-    (enc n1 n2 (pubk a)))
-  (label 32)
-  (parent 30)
-  (unrealized)
-  (shape)
-  (satisfies (no (a a) (b b) (n2 n2) (z0 (1 2)) (z1 (0 0))))
-  (maps ((0 1) ((a a) (b b) (n2 n2) (n1 n1))))
-  (origs (n2 (1 1))))
- -

Tree 33.

- -
- - 40 - - 39 - - 37 - - 35 - - 38 - - 36 - - 34 - - 33 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 33, Children: 34 35.

- -
- - - - - - - - (enc n2-0 (pubk b)) - - (enc n1-0 n2-0 (pubk a)) - - (enc n1-0 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1-0) (n2 n2-0) (a a) (b b)) - init - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 33 -
- -
(defskeleton ns
-  (vars (n1 n1-0 n2 n2-0 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand init 3 (n1 n1-0) (n2 n2-0) (a a) (b b))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1 n1-0)
-  (subgoals
-    (forall ((n1 n1-0 n2 n2-0 text) (a b name) (z z-0 z-1 z-2 node))
-      (implies
-        (and (p "init" 0 z) (p "init" 2 z-0) (p "init" 0 z-1)
-          (p "init" 2 z-2) (p "init" "n1" z-0 n1) (p "init" "n2" z-0 n2)
-          (p "init" "a" z-0 a) (p "init" "b" z-0 b)
-          (p "init" "n1" z-2 n1-0) (p "init" "n2" z-2 n2-0)
-          (p "init" "a" z-2 a) (p "init" "b" z-2 b) (str-prec z z-0)
-          (str-prec z-1 z-2) (non (privk a)) (non (privk b))
-          (uniq-at n1 z) (uniq-at n1-0 z-1)) (= z-1 z))))
-  (comment "Double initiator point of view")
-  (label 33)
-  (unrealized (0 1) (1 1))
-  (origs (n1 (0 0)) (n1-0 (1 0)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 34, Parent: 33, Child: 36.

- -
- - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 34 -
- -
(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (operation collapsed 1 0)
-  (label 34)
-  (parent 33)
-  (unrealized (0 1))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 35, Parent: 33, Child: 37.

- -
- - - - - - - - - - (enc n1-0 n2-1 (pubk a)) - - (enc n1-0 a (pubk b)) - - (enc n2-0 (pubk b)) - - (enc n1-0 n2-0 (pubk a)) - - - (enc n1-0 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n2 n2-1) (n1 n1-0) (b b) (a a)) - resp - - ((n1 n1-0) (n2 n2-0) (a a) (b b)) - init - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 35 -
- -
(defskeleton ns
-  (vars (n1 n1-0 n2 n2-0 n2-1 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand init 3 (n1 n1-0) (n2 n2-0) (a a) (b b))
-  (defstrand resp 2 (n2 n2-1) (n1 n1-0) (b b) (a a))
-  (precedes ((1 0) (2 0)) ((2 1) (1 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1 n1-0)
-  (operation nonce-test (added-strand resp 2) n1-0 (1 1)
-    (enc n1-0 a (pubk b)))
-  (label 35)
-  (parent 33)
-  (unrealized (0 1) (1 1))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 36, Parent: 34, Child: 38.

- -
- - - - - - - - - (enc n1 n2-0 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - ((n2 n2-0) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 36 -
- -
(defskeleton ns
-  (vars (n1 n2 n2-0 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (added-strand resp 2) n1 (0 1)
-    (enc n1 a (pubk b)))
-  (label 36)
-  (parent 34)
-  (unrealized (0 1))
-  (origs (n1 (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 37, Parent: 35, Child: 39.

- -
- - - - - - - - - - (enc n1-0 n2-0 (pubk a)) - - (enc n1-0 a (pubk b)) - - (enc n2-0 (pubk b)) - - (enc n1-0 n2-0 (pubk a)) - - - (enc n1-0 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n2 n2-0) (n1 n1-0) (b b) (a a)) - resp - - ((n1 n1-0) (n2 n2-0) (a a) (b b)) - init - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 37 -
- -
(defskeleton ns
-  (vars (n1 n1-0 n2 n2-0 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand init 3 (n1 n1-0) (n2 n2-0) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1-0) (b b) (a a))
-  (precedes ((1 0) (2 0)) ((2 1) (1 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1 n1-0)
-  (operation nonce-test (contracted (n2-1 n2-0)) n1-0 (1 1)
-    (enc n1-0 n2-0 (pubk a)) (enc n1-0 a (pubk b)))
-  (label 37)
-  (parent 35)
-  (unrealized (0 1))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 38, Parent: 36.

- -
- - - - - - - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 38 (realized)
- -
(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (contracted (n2-0 n2)) n1 (0 1)
-    (enc n1 n2 (pubk a)) (enc n1 a (pubk b)))
-  (label 38)
-  (parent 36)
-  (unrealized)
-  (shape)
-  (satisfies yes)
-  (maps ((0 0) ((a a) (b b) (n1 n1) (n1-0 n1) (n2 n2) (n2-0 n2))))
-  (origs (n1 (0 0))))
- -

Item 39, Parent: 37, Child: 40.

- -
- - - - - - - - - - - (enc n1 n2-1 (pubk a)) - - (enc n1 a (pubk b)) - - - (enc n1-0 n2-0 (pubk a)) - - (enc n1-0 a (pubk b)) - - (enc n2-0 (pubk b)) - - (enc n1-0 n2-0 (pubk a)) - - - (enc n1-0 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - ((n2 n2-1) (n1 n1) (b b) (a a)) - resp - - ((n2 n2-0) (n1 n1-0) (b b) (a a)) - resp - - ((n1 n1-0) (n2 n2-0) (a a) (b b)) - init - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 39 -
- -
(defskeleton ns
-  (vars (n1 n1-0 n2 n2-0 n2-1 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand init 3 (n1 n1-0) (n2 n2-0) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1-0) (b b) (a a))
-  (defstrand resp 2 (n2 n2-1) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (3 0)) ((1 0) (2 0)) ((2 1) (1 1)) ((3 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1 n1-0)
-  (operation nonce-test (added-strand resp 2) n1 (0 1)
-    (enc n1 a (pubk b)))
-  (label 39)
-  (parent 37)
-  (unrealized (0 1))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 40, Parent: 39.

- -
- - - - - - - - - - - (enc n1 n2-0 (pubk a)) - - (enc n1 a (pubk b)) - - - (enc n1-0 n2 (pubk a)) - - (enc n1-0 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1-0 n2 (pubk a)) - - - (enc n1-0 a (pubk b)) - - (enc n2-0 (pubk b)) - - (enc n1 n2-0 (pubk a)) - - - (enc n1 a (pubk b)) - - ((n2 n2-0) (n1 n1) (b b) (a a)) - resp - - ((n2 n2) (n1 n1-0) (b b) (a a)) - resp - - ((n1 n1-0) (n2 n2) (a a) (b b)) - init - - ((n1 n1) (n2 n2-0) (a a) (b b)) - init - - ns 40 (realized)
- -
(defskeleton ns
-  (vars (n1 n1-0 n2 n2-0 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2-0) (a a) (b b))
-  (defstrand init 3 (n1 n1-0) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1-0) (b b) (a a))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (3 0)) ((1 0) (2 0)) ((2 1) (1 1)) ((3 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1 n1-0)
-  (operation nonce-test (contracted (n2-1 n2-0)) n1 (0 1)
-    (enc n1 n2-0 (pubk a)) (enc n1 a (pubk b)))
-  (label 40)
-  (parent 39)
-  (unrealized)
-  (shape)
-  (satisfies
-    (no (n1 n1) (n1-0 n1-0) (n2 n2-0) (n2-0 n2) (a a) (b b) (z (0 0))
-      (z-0 (0 2)) (z-1 (1 0)) (z-2 (1 2))))
-  (maps ((0 1) ((a a) (b b) (n1 n1) (n1-0 n1-0) (n2 n2-0) (n2-0 n2))))
-  (origs (n1 (0 0)) (n1-0 (1 0))))
- -

Tree 41.

- -
- - 44 - - 43 - - 42 - - 41 -
- -
(defprotocol nsl-typeless basic
-  (defrole init
-    (vars (a b name) (n1 text) (n2 mesg))
-    (trace (send (enc a n1 (pubk b))) (recv (enc n1 n2 b (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 text) (n1 mesg))
-    (trace (recv (enc a n1 (pubk b))) (send (enc n1 n2 b (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder-Lowe with untyped nonces"))
- -

Item 41, Child: 42.

- -
- - - - - - - - (enc n1 n2 b (pubk a)) - - (enc a n1 (pubk b)) - - n2 - n2 - - ((n1 n1) (n2 n2) (b b) (a a)) - resp - - nsl-typeless 41
- -
(defskeleton nsl-typeless
-  (vars (n1 mesg) (n2 text) (a b name))
-  (deflistener n2)
-  (defstrand resp 2 (n1 n1) (n2 n2) (b b) (a a))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2)
-  (goals
-    (forall ((n2 text) (a b name) (z z-0 node))
-      (implies
-        (and (p "resp" 1 z) (p "" 0 z-0) (p "resp" "n2" z n2)
-          (p "resp" "b" z b) (p "resp" "a" z a) (p "" "x" z-0 n2)
-          (non (privk a)) (non (privk b)) (uniq n2)) (false))))
-  (comment "Shows typeflaw in typeless NSL")
-  (label 41)
-  (unrealized (0 0))
-  (preskeleton)
-  (comment "Not a skeleton"))
- -

Item 42, Parent: 41, Children: 43 44.

- -
- - - - - - - - - (enc n1 n2 b (pubk a)) - - (enc a n1 (pubk b)) - - n2 - n2 - - ((n1 n1) (n2 n2) (b b) (a a)) - resp - - nsl-typeless 42
- -
(defskeleton nsl-typeless
-  (vars (n1 mesg) (n2 text) (a b name))
-  (deflistener n2)
-  (defstrand resp 2 (n1 n1) (n2 n2) (b b) (a a))
-  (precedes ((1 1) (0 0)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2)
-  (goals
-    (forall ((n2 text) (a b name) (z z-0 node))
-      (implies
-        (and (p "resp" 1 z) (p "" 0 z-0) (p "resp" "n2" z n2)
-          (p "resp" "b" z b) (p "resp" "a" z a) (p "" "x" z-0 n2)
-          (non (privk a)) (non (privk b)) (uniq n2)) (false))))
-  (comment "Shows typeflaw in typeless NSL")
-  (label 42)
-  (parent 41)
-  (unrealized (0 0))
-  (origs (n2 (1 1)))
-  (comment "2 in cohort - 2 not yet seen"))
- -

Item 43, Parent: 42.

- -
- - - - - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 b (pubk a)) - - (enc a n1 (pubk b)) - - - (enc n1 n2 b (pubk a)) - - (enc a n1 (pubk b)) - - n2 - n2 - - ((n2 n2) (n1 n1) (a a) (b b)) - init - - ((n1 n1) (n2 n2) (b b) (a a)) - resp - - nsl-typeless 43
- -
(defskeleton nsl-typeless
-  (vars (n2 n1 text) (a b name))
-  (deflistener n2)
-  (defstrand resp 2 (n1 n1) (n2 n2) (b b) (a a))
-  (defstrand init 3 (n2 n2) (n1 n1) (a a) (b b))
-  (precedes ((1 1) (2 1)) ((2 2) (0 0)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2)
-  (operation nonce-test (added-strand init 3) n2 (0 0)
-    (enc n1 n2 b (pubk a)))
-  (label 43)
-  (parent 42)
-  (unrealized (0 0))
-  (comment "empty cohort"))
- -

Item 44, Parent: 42.

- -
- - - - - - - - - - (enc (cat n2 b) n2-0 a (pubk a-0)) - - (enc a-0 n2 b (pubk a)) - - - (enc a-0 n2 b (pubk a)) - - (enc a a-0 (pubk b)) - - n2 - n2 - - ((n1 (cat n2 b)) (n2 n2-0) (b a) (a a-0)) - resp - - ((n1 a-0) (n2 n2) (b b) (a a)) - resp - - nsl-typeless 44 (realized) -
- -
(defskeleton nsl-typeless
-  (vars (n2 n2-0 text) (a b a-0 name))
-  (deflistener n2)
-  (defstrand resp 2 (n1 a-0) (n2 n2) (b b) (a a))
-  (defstrand resp 2 (n1 (cat n2 b)) (n2 n2-0) (b a) (a a-0))
-  (precedes ((1 1) (2 0)) ((2 1) (0 0)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2)
-  (operation nonce-test (added-strand resp 2) n2 (0 0)
-    (enc a-0 n2 b (pubk a)))
-  (label 44)
-  (parent 42)
-  (unrealized)
-  (shape)
-  (satisfies (no (n2 n2) (a a) (b b) (z (1 1)) (z-0 (0 0))))
-  (maps ((0 1) ((n2 n2) (a a) (b b) (n1 a-0))))
-  (origs (n2 (1 1))))
- -

Tree 45.

- -
- - 46 - - 45 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 45, Child: 46.

- -
- - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns 45 -
- -
(defskeleton ns
-  (vars (n2 n1 text) (a b name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (subgoals
-    (forall ((n1 n2 text) (a b name) (z z-0 node))
-      (implies
-        (and (p "init" 0 z) (p "init" 2 z-0) (p "init" "n1" z-0 n1)
-          (p "init" "n2" z-0 n2) (p "init" "a" z-0 a)
-          (p "init" "b" z-0 b) (str-prec z z-0) (non (privk a))
-          (non (privk b)) (uniq-at n1 z))
-        (exists ((z-1 z-2 z-3 node))
-          (and (p "init" 1 z-1) (p "resp" 0 z-2) (p "resp" 1 z-3)
-            (p "resp" "n2" z-3 n2) (p "resp" "n1" z-3 n1)
-            (p "resp" "b" z-3 b) (p "resp" "a" z-3 a) (prec z z-2)
-            (prec z-3 z-1) (str-prec z z-1) (str-prec z-1 z-0)
-            (str-prec z-2 z-3))))))
-  (comment "Responder point of view with SAS")
-  (label 45)
-  (unrealized (0 2))
-  (origs (n2 (0 1)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 46, Parent: 45.

- -
- - - - - - - - - (enc n2 (pubk b-0)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b-0)) - - (enc n2 (pubk b)) - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n2) (a a) (b b-0)) - init - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns 46 (realized)
- -
(defskeleton ns
-  (vars (n2 n1 text) (a b b-0 name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
-  (precedes ((0 1) (1 1)) ((1 2) (0 2)))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (operation nonce-test (added-strand init 3) n2 (0 2)
-    (enc n1 n2 (pubk a)))
-  (label 46)
-  (parent 45)
-  (unrealized)
-  (shape)
-  (satisfies yes)
-  (maps ((0) ((a a) (n2 n2) (b b) (n1 n1))))
-  (origs (n2 (0 1))))
- -

Tree 47.

- -
- - 48 - - 47 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 47, Child: 48.

- -
- - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns 47 -
- -
(defskeleton ns
-  (vars (n2 n1 text) (a b name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (subgoals
-    (forall ((n1 n2 text) (a b name) (z z-0 node))
-      (implies
-        (and (p "init" 0 z) (p "init" 2 z-0) (p "init" "n1" z-0 n1)
-          (p "init" "n2" z-0 n2) (p "init" "a" z-0 a)
-          (p "init" "b" z-0 b) (str-prec z z-0) (non (privk a))
-          (non (privk b)) (uniq-at n1 z)) (false))))
-  (comment "Responder point of view with false as the conclusion")
-  (label 47)
-  (unrealized (0 2))
-  (origs (n2 (0 1)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 48, Parent: 47.

- -
- - - - - - - - - (enc n2 (pubk b-0)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b-0)) - - (enc n2 (pubk b)) - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n2) (a a) (b b-0)) - init - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns 48 (realized)
- -
(defskeleton ns
-  (vars (n2 n1 text) (a b b-0 name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
-  (precedes ((0 1) (1 1)) ((1 2) (0 2)))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (operation nonce-test (added-strand init 3) n2 (0 2)
-    (enc n1 n2 (pubk a)))
-  (label 48)
-  (parent 47)
-  (unrealized)
-  (shape)
-  (satisfies yes)
-  (maps ((0) ((a a) (n2 n2) (b b) (n1 n1))))
-  (origs (n2 (0 1))))
- -

Tree 49.

- -
- - 51 - - 50 - - 49 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 49, Child: 50.

- -
- - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 49 -
- -
(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (subgoals
-    (forall ((n1 n2 text) (a b name) (z z-0 node))
-      (implies
-        (and (p "init" 0 z) (p "init" 2 z-0) (p "init" "n1" z-0 n1)
-          (p "init" "n2" z-0 n2) (p "init" "a" z-0 a)
-          (p "init" "b" z-0 b) (str-prec z z-0) (non (privk a))
-          (non (privk b)) (uniq-at n1 z)) (false))))
-  (comment "Initiator point of view with false as the conclusion")
-  (label 49)
-  (unrealized (0 1))
-  (origs (n1 (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 50, Parent: 49, Child: 51.

- -
- - - - - - - - - (enc n1 n2-0 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - ((n2 n2-0) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 50 -
- -
(defskeleton ns
-  (vars (n1 n2 n2-0 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (added-strand resp 2) n1 (0 1)
-    (enc n1 a (pubk b)))
-  (label 50)
-  (parent 49)
-  (unrealized (0 1))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 51, Parent: 50.

- -
- - - - - - - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 51 (realized)
- -
(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (contracted (n2-0 n2)) n1 (0 1)
-    (enc n1 n2 (pubk a)) (enc n1 a (pubk b)))
-  (label 51)
-  (parent 50)
-  (unrealized)
-  (shape)
-  (satisfies (no (n1 n1) (n2 n2) (a a) (b b) (z (0 0)) (z-0 (0 2))))
-  (maps ((0) ((a a) (b b) (n1 n1) (n2 n2))))
-  (origs (n1 (0 0))))
- -

Tree 52.

- -
- - 53 - - 52 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 52, Child: 53.

- -
- - - - - - - (enc n (pubk b)) - - (enc n1 n (pubk a)) - - (enc n1 a (pubk b)) - - ((n2 n) (n1 n1) (b b) (a a)) - resp - - ns 52 -
- -
(defskeleton ns
-  (vars (n n1 text) (a b name))
-  (defstrand resp 3 (n2 n) (n1 n1) (b b) (a a))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n)
-  (goals
-    (forall ((a b name) (n text) (z0 node))
-      (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n) (p "resp" "a" z0 a)
-          (p "resp" "b" z0 b) (non (privk a)) (non (privk b)) (uniq n))
-        (exists ((z1 node)) (and (p "init" 2 z1) (p "init" "a" z1 a)))))
-    (forall ((a b name) (n text) (z0 node))
-      (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n) (p "resp" "a" z0 a)
-          (p "resp" "b" z0 b) (non (privk a)) (non (privk b)) (uniq n))
-        (exists ((z1 node))
-          (and (p "init" 2 z1) (p "init" "b" z1 b))))))
-  (comment "Two responder authentication goals")
-  (label 52)
-  (unrealized (0 2))
-  (origs (n (0 1)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 53, Parent: 52.

- -
- - - - - - - - - (enc n (pubk b-0)) - - (enc n1 n (pubk a)) - - (enc n1 a (pubk b-0)) - - (enc n (pubk b)) - - - (enc n1 n (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n) (a a) (b b-0)) - init - - ((n2 n) (n1 n1) (b b) (a a)) - resp - - ns 53 (realized)
- -
(defskeleton ns
-  (vars (n n1 text) (a b b-0 name))
-  (defstrand resp 3 (n2 n) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n) (a a) (b b-0))
-  (precedes ((0 1) (1 1)) ((1 2) (0 2)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n)
-  (operation nonce-test (added-strand init 3) n (0 2)
-    (enc n1 n (pubk a)))
-  (label 53)
-  (parent 52)
-  (unrealized)
-  (shape)
-  (satisfies yes (no (a a) (b b) (n n) (z0 (0 2))))
-  (maps ((0) ((a a) (b b) (n n) (n1 n1))))
-  (origs (n (0 1))))
- -

Tree 54.

- -
- - 56 - - 55 - - 54 -
- -
(defprotocol ns-role-origs basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b))))
-    (non-orig (privk b))
-    (uniq-orig n1))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b))))
-    (non-orig (privk a))
-    (uniq-orig n2))
-  (comment
-    "Needham-Schroeder with role assumptions that are too strong"))
- -

Item 54, Child: 55.

- -
- - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns-role-origs 54
- -
(defskeleton ns-role-origs
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (non-orig (privk b))
-  (uniq-orig n1)
-  (label 54)
-  (unrealized (0 1))
-  (origs (n1 (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 55, Parent: 54, Child: 56.

- -
- - - - - - - - - (enc n1 n2-0 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - ((n2 n2-0) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns-role-origs 55
- -
(defskeleton ns-role-origs
-  (vars (n1 n2 n2-0 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1 n2-0)
-  (operation nonce-test (added-strand resp 2) n1 (0 1)
-    (enc n1 a (pubk b)))
-  (label 55)
-  (parent 54)
-  (unrealized (0 1))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 56, Parent: 55.

- -
- - - - - - - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns-role-origs 56 (realized) -
- -
(defskeleton ns-role-origs
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1 n2)
-  (operation nonce-test (contracted (n2-0 n2)) n1 (0 1)
-    (enc n1 n2 (pubk a)) (enc n1 a (pubk b)))
-  (label 56)
-  (parent 55)
-  (unrealized)
-  (shape)
-  (maps ((0) ((a a) (b b) (n1 n1) (n2 n2))))
-  (origs (n2 (1 1)) (n1 (0 0))))
- -

Tree 57.

- -
- - 59 - - 61 - - 60 - - 59 - - 58 - - 57 -
- -
(defprotocol ns-role-origs basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b))))
-    (non-orig (privk b))
-    (uniq-orig n1))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b))))
-    (non-orig (privk a))
-    (uniq-orig n2))
-  (comment
-    "Needham-Schroeder with role assumptions that are too strong"))
- -

Item 57, Child: 58.

- -
- - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns-role-origs 57
- -
(defskeleton ns-role-origs
-  (vars (n2 n1 text) (b a name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (label 57)
-  (unrealized (0 2))
-  (origs (n2 (0 1)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 58, Parent: 57, Children: 59 60.

- -
- - - - - - - - - (enc n2 (pubk b-0)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b-0)) - - (enc n2 (pubk b)) - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n2) (a a) (b b-0)) - init - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns-role-origs 58
- -
(defskeleton ns-role-origs
-  (vars (n2 n1 text) (b a b-0 name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
-  (precedes ((0 1) (1 1)) ((1 0) (0 0)) ((1 2) (0 2)))
-  (non-orig (privk a) (privk b-0))
-  (uniq-orig n2 n1)
-  (operation nonce-test (added-strand init 3) n2 (0 2)
-    (enc n1 n2 (pubk a)))
-  (label 58)
-  (parent 57)
-  (unrealized (0 0) (0 2))
-  (comment "2 in cohort - 2 not yet seen"))
- -

Item 59, Parent: 58.

- -
- - - - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns-role-origs 59 (realized) -
- -
(defskeleton ns-role-origs
-  (vars (n2 n1 text) (a b name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (precedes ((0 1) (1 1)) ((1 0) (0 0)) ((1 2) (0 2)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2 n1)
-  (operation nonce-test (contracted (b-0 b)) n1 (0 0)
-    (enc n1 a (pubk b)))
-  (label 59)
-  (parent 58)
-  (unrealized)
-  (shape)
-  (maps ((0) ((b b) (a a) (n2 n2) (n1 n1))))
-  (origs (n1 (1 0)) (n2 (0 1))))
- -

Item 60, Parent: 58, Child: 61.

- -
- - - - - - - - - - (enc n1 n2-0 (pubk a)) - - (enc n1 a (pubk b-0)) - - - (enc n2 (pubk b-0)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b-0)) - - (enc n2 (pubk b)) - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n2 n2-0) (n1 n1) (b b-0) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b-0)) - init - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns-role-origs 60
- -
(defskeleton ns-role-origs
-  (vars (n2 n1 n2-0 text) (b a b-0 name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b-0) (a a))
-  (precedes ((0 1) (1 1)) ((1 0) (2 0)) ((1 2) (0 2)) ((2 1) (0 0)))
-  (non-orig (privk a) (privk b-0))
-  (uniq-orig n2 n1 n2-0)
-  (operation nonce-test (added-strand resp 2) n1 (0 0)
-    (enc n1 a (pubk b-0)))
-  (label 60)
-  (parent 58)
-  (unrealized (0 0) (0 2))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 61, Parent: 60, Seen Child: 59.

- -
- - - - - - - - - - (enc n1 n2-0 (pubk a)) - - (enc n1 a (pubk b)) - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - ((n2 n2-0) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ns-role-origs 61 (realized) -
- -
(defskeleton ns-role-origs
-  (vars (n2 n1 n2-0 text) (a b name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((0 1) (1 1)) ((1 0) (2 0)) ((1 2) (0 2)) ((2 1) (0 0)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2 n1 n2-0)
-  (operation nonce-test (contracted (b-0 b)) n1 (0 0)
-    (enc n1 n2-0 (pubk a)) (enc n1 a (pubk b)))
-  (label 61)
-  (parent 60)
-  (seen 59)
-  (unrealized)
-  (comment "1 in cohort - 0 not yet seen"))
- -

Tree 62.

- -
- - 64 - - 63 - - 62 -
- -
(defprotocol ns2 basic
-  (defrole init
-    (vars (a b name) (n1 n2 n3 text))
-    (trace (send (enc n1 n3 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b))))
-    (note doubled nonce in the first message))
-  (note that this protocol is derived from Needham-Schroeder))
- -

Item 62, Child: 63.

- -
- - - - - - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - (enc n1 n3 a (pubk b)) - - ((n1 n1) (n2 n2) (n3 n3) (a a) (b b)) - init - - ns2 62 -
- -
(defskeleton ns2
-  (vars (n1 n2 n3 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (n3 n3) (a a) (b b))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (label 62)
-  (unrealized (0 1))
-  (origs (n1 (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 63, Parent: 62, Child: 64.

- -
- - - - - - - - - (enc n3 n2-0 (pubk a)) - - (enc n3 n3 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n3 n2 (pubk a)) - - - (enc n3 n3 a (pubk b)) - - ((n2 n2-0) (n1 n3) (b b) (a a)) - resp - - ((n1 n3) (n2 n2) (n3 n3) (a a) (b b)) - init - - ns2 63 -
- -
(defskeleton ns2
-  (vars (n2 n3 n2-0 text) (a b name))
-  (defstrand init 3 (n1 n3) (n2 n2) (n3 n3) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n3) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n3)
-  (operation nonce-test (added-strand resp 2) n3 (0 1)
-    (enc n3 n3 a (pubk b)))
-  (label 63)
-  (parent 62)
-  (unrealized (0 1))
-  (comment "1 in cohort - 1 not yet seen"))
- -

Item 64, Parent: 63.

- -
- - - - - - - - - (enc n3 n2 (pubk a)) - - (enc n3 n3 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n3 n2 (pubk a)) - - - (enc n3 n3 a (pubk b)) - - ((n2 n2) (n1 n3) (b b) (a a)) - resp - - ((n1 n3) (n2 n2) (n3 n3) (a a) (b b)) - init - - ns2 64 (realized)
- -
(defskeleton ns2
-  (vars (n3 n2 text) (a b name))
-  (defstrand init 3 (n1 n3) (n2 n2) (n3 n3) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n3) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n3)
-  (operation nonce-test (contracted (n2-0 n2)) n3 (0 1)
-    (enc n3 n2 (pubk a)) (enc n3 n3 a (pubk b)))
-  (label 64)
-  (parent 63)
-  (unrealized)
-  (shape)
-  (maps ((0) ((a a) (b b) (n1 n3) (n2 n2) (n3 n3))))
-  (origs (n3 (0 0))))
- -

Tree 65.

- -
- - 65 -
- -
(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
- -

Item 65.

- -
- - - - - - - - - (enc n1 n2 (pubk a)) - - (enc n1 a (pubk b)) - - (enc n2 (pubk b)) - - (enc n1 n2 (pubk a)) - - - (enc n1 a (pubk b)) - - ((n2 n2) (n1 n1) (b b) (a a)) - resp - - ((n1 n1) (n2 n2) (a a) (b b)) - init - - ns 65 (realized)
- -
(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (label 65)
-  (unrealized)
-  (shape)
-  (maps ((0 1) ((n1 n1) (n2 n2) (a a) (b b))))
-  (origs (n1 (0 0))))
+ + + + goals + + + + + +
(herald goals)
+(comment "CPSA 3.6.0")
+(comment "All input read from goals.scm")
+ +

Trees: 0 2 4 6 8 17 19 21 23 26 28 33 41.

+ +

Tree 0.

+ +
+ + 1 + + 0 +
+ +
(defprotocol ns basic
+  (defrole init
+    (vars (a b name) (n1 n2 text))
+    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
+      (send (enc n2 (pubk b)))))
+  (defrole resp
+    (vars (b a name) (n2 n1 text))
+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
+      (recv (enc n2 (pubk b)))))
+  (comment "Needham-Schroeder with no role origination assumptions"))
+ +

Item 0, Child: 1.

+ +
+ + + + + + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 0 +
+ +
(defskeleton ns
+  (vars (n1 n2 text) (b a name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (non-orig (privk b))
+  (uniq-orig n1)
+  (goals
+    (forall ((b name) (n1 text) (z0 strd))
+      (implies
+        (and (p "init" z0 3) (p "init" "n1" z0 n1) (p "init" "b" z0 b)
+          (non (privk b)) (uniq n1))
+        (exists ((z1 strd))
+          (and (p "resp" z1 2) (p "resp" "b" z1 b))))))
+  (comment "Initiator point of view"
+    "Authentication goal: agreement on name b")
+  (label 0)
+  (unrealized (0 1))
+  (origs (n1 (0 0)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 1, Parent: 0.

+ +
+ + + + + + + + + (enc n1 n2-0 (pubk a)) + + (enc n1 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + + (enc n1 a (pubk b)) + + ((n2 n2-0) (n1 n1) (b b) (a a)) + resp + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 1 (realized)
+ +
(defskeleton ns
+  (vars (n1 n2 n2-0 text) (b a name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
+  (non-orig (privk b))
+  (uniq-orig n1)
+  (operation nonce-test (added-strand resp 2) n1 (0 1)
+    (enc n1 a (pubk b)))
+  (label 1)
+  (parent 0)
+  (unrealized)
+  (shape)
+  (satisfies yes)
+  (maps ((0) ((b b) (n1 n1) (a a) (n2 n2))))
+  (origs (n1 (0 0))))
+ +

Tree 2.

+ +
+ + 3 + + 2 +
+ +
(defprotocol ns basic
+  (defrole init
+    (vars (a b name) (n1 n2 text))
+    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
+      (send (enc n2 (pubk b)))))
+  (defrole resp
+    (vars (b a name) (n2 n1 text))
+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
+      (recv (enc n2 (pubk b)))))
+  (comment "Needham-Schroeder with no role origination assumptions"))
+ +

Item 2, Child: 3.

+ +
+ + + + + + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 2 +
+ +
(defskeleton ns
+  (vars (n1 n2 text) (b a name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (non-orig (privk b))
+  (uniq-orig n1)
+  (goals
+    (forall ((b name) (n1 text) (z0 strd))
+      (implies
+        (and (p "init" z0 3) (p "init" "n1" z0 n1) (p "init" "b" z0 b)
+          (non (privk b)) (uniq n1))
+        (exists ((z1 strd))
+          (and (p "resp" z1 2) (p "resp" "b" z1 b) (prec z1 1 z0 2))))))
+  (comment "Prec example")
+  (label 2)
+  (unrealized (0 1))
+  (origs (n1 (0 0)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 3, Parent: 2.

+ +
+ + + + + + + + + (enc n1 n2-0 (pubk a)) + + (enc n1 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + + (enc n1 a (pubk b)) + + ((n2 n2-0) (n1 n1) (b b) (a a)) + resp + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 3 (realized)
+ +
(defskeleton ns
+  (vars (n1 n2 n2-0 text) (b a name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
+  (non-orig (privk b))
+  (uniq-orig n1)
+  (operation nonce-test (added-strand resp 2) n1 (0 1)
+    (enc n1 a (pubk b)))
+  (label 3)
+  (parent 2)
+  (unrealized)
+  (shape)
+  (satisfies (no (b b) (n1 n1) (z0 0)))
+  (maps ((0) ((b b) (n1 n1) (a a) (n2 n2))))
+  (origs (n1 (0 0))))
+ +

Tree 4.

+ +
+ + 5 + + 4 +
+ +
(defprotocol ns basic
+  (defrole init
+    (vars (a b name) (n1 n2 text))
+    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
+      (send (enc n2 (pubk b)))))
+  (defrole resp
+    (vars (b a name) (n2 n1 text))
+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
+      (recv (enc n2 (pubk b)))))
+  (comment "Needham-Schroeder with no role origination assumptions"))
+ +

Item 4, Child: 5.

+ +
+ + + + + + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + ns 4 +
+ +
(defskeleton ns
+  (vars (n2 n1 text) (a b name))
+  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
+  (non-orig (privk a))
+  (uniq-orig n2)
+  (goals
+    (forall ((a b name) (n2 text) (z0 strd))
+      (implies
+        (and (p "resp" z0 3) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
+          (p "resp" "b" z0 b) (non (privk a)) (uniq n2))
+        (exists ((z1 strd))
+          (and (p "init" z1 2) (p "init" "b" z1 b))))))
+  (comment "Responder point of view"
+    "Failed authentication goal: agreement on name b")
+  (label 4)
+  (unrealized (0 2))
+  (origs (n2 (0 1)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 5, Parent: 4.

+ +
+ + + + + + + + + (enc n2 (pubk b-0)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b-0)) + + (enc n2 (pubk b)) + + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + ((n1 n1) (n2 n2) (a a) (b b-0)) + init + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + ns 5 (realized)
+ +
(defskeleton ns
+  (vars (n2 n1 text) (a b b-0 name))
+  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
+  (precedes ((0 1) (1 1)) ((1 2) (0 2)))
+  (non-orig (privk a))
+  (uniq-orig n2)
+  (operation nonce-test (added-strand init 3) n2 (0 2)
+    (enc n1 n2 (pubk a)))
+  (label 5)
+  (parent 4)
+  (unrealized)
+  (shape)
+  (satisfies (no (a a) (b b) (n2 n2) (z0 0)))
+  (maps ((0) ((a a) (b b) (n2 n2) (n1 n1))))
+  (origs (n2 (0 1))))
+ +

Tree 6.

+ +
+ + 7 + + 6 +
+ +
(defprotocol nsl basic
+  (defrole init
+    (vars (a b name) (n1 n2 text))
+    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 b (pubk a)))
+      (send (enc n2 (pubk b)))))
+  (defrole resp
+    (vars (b a name) (n2 n1 text))
+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 b (pubk a)))
+      (recv (enc n2 (pubk b)))))
+  (comment
+    "Needham-Schroeder-Lowe with no role origination assumptions"))
+ +

Item 6, Child: 7.

+ +
+ + + + + + + (enc n2 (pubk b)) + + (enc n1 n2 b (pubk a)) + + (enc n1 a (pubk b)) + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + nsl 6 +
+ +
(defskeleton nsl
+  (vars (n2 n1 text) (a b name))
+  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
+  (non-orig (privk a))
+  (uniq-orig n2)
+  (goals
+    (forall ((a b name) (n2 text) (z0 strd))
+      (implies
+        (and (p "resp" z0 3) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
+          (p "resp" "b" z0 b) (non (privk a)) (uniq n2))
+        (exists ((z1 strd))
+          (and (p "init" z1 2) (p "init" "b" z1 b))))))
+  (comment "Responder point of view"
+    "Authentication goal: agreement on name b")
+  (label 6)
+  (unrealized (0 2))
+  (origs (n2 (0 1)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 7, Parent: 6.

+ +
+ + + + + + + + + (enc n2 (pubk b)) + + (enc n1 n2 b (pubk a)) + + (enc n1 a (pubk b)) + + (enc n2 (pubk b)) + + + (enc n1 n2 b (pubk a)) + + (enc n1 a (pubk b)) + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + nsl 7 (realized)
+ +
(defskeleton nsl
+  (vars (n2 n1 text) (a b name))
+  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (precedes ((0 1) (1 1)) ((1 2) (0 2)))
+  (non-orig (privk a))
+  (uniq-orig n2)
+  (operation nonce-test (added-strand init 3) n2 (0 2)
+    (enc n1 n2 b (pubk a)))
+  (label 7)
+  (parent 6)
+  (unrealized)
+  (shape)
+  (satisfies yes)
+  (maps ((0) ((a a) (b b) (n2 n2) (n1 n1))))
+  (origs (n2 (0 1))))
+ +

Tree 8.

+ +
+ + 15 + + 13 + + 16 + + 15 + + 16 + + 14 + + 12 + + 11 + + 10 + + 9 + + 8 +
+ +
(defprotocol ns basic
+  (defrole init
+    (vars (a b name) (n1 n2 text))
+    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
+      (send (enc n2 (pubk b)))))
+  (defrole resp
+    (vars (b a name) (n2 n1 text))
+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
+      (recv (enc n2 (pubk b)))))
+  (comment "Needham-Schroeder with no role origination assumptions"))
+ +

Item 8, Child: 9.

+ +
+ + + + + + + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + n1 + n1 + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 8 +
+ +
(defskeleton ns
+  (vars (n1 n2 text) (a b name))
+  (deflistener n1)
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1)
+  (goals
+    (forall ((a b name) (n1 text) (z0 z1 strd))
+      (implies
+        (and (p "init" z0 3) (p "init" "n1" z0 n1) (p "init" "a" z0 a)
+          (p "init" "b" z0 b) (p "" z1 1) (p "" "x" z1 n1)
+          (non (privk a)) (non (privk b)) (uniq n1)) (false))))
+  (comment "Initiator point of view"
+    "Secrecy goal: nonce n1 not revealed")
+  (label 8)
+  (unrealized (0 0) (1 1))
+  (preskeleton)
+  (comment "Not a skeleton"))
+ +

Item 9, Parent: 8, Child: 10.

+ +
+ + + + + + + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + + (enc n1 a (pubk b)) + + n1 + n1 + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 9 +
+ +
(defskeleton ns
+  (vars (n1 n2 text) (a b name))
+  (deflistener n1)
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (precedes ((1 0) (0 0)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1)
+  (goals
+    (forall ((a b name) (n1 text) (z0 z1 strd))
+      (implies
+        (and (p "init" z0 3) (p "init" "n1" z0 n1) (p "init" "a" z0 a)
+          (p "init" "b" z0 b) (p "" z1 1) (p "" "x" z1 n1)
+          (non (privk a)) (non (privk b)) (uniq n1)) (false))))
+  (comment "Initiator point of view"
+    "Secrecy goal: nonce n1 not revealed")
+  (label 9)
+  (parent 8)
+  (unrealized (0 0) (1 1))
+  (origs (n1 (1 0)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 10, Parent: 9, Child: 11.

+ +
+ + + + + + + + + + (enc n1 n2-0 (pubk a)) + + (enc n1 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + + + (enc n1 a (pubk b)) + + n1 + n1 + + ((n2 n2-0) (n1 n1) (b b) (a a)) + resp + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 10 +
+ +
(defskeleton ns
+  (vars (n1 n2 n2-0 text) (a b name))
+  (deflistener n1)
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
+  (precedes ((1 0) (0 0)) ((1 0) (2 0)) ((2 1) (1 1)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1)
+  (operation nonce-test (added-strand resp 2) n1 (1 1)
+    (enc n1 a (pubk b)))
+  (label 10)
+  (parent 9)
+  (unrealized (0 0) (1 1))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 11, Parent: 10, Children: 12 13.

+ +
+ + + + + + + + + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + + + (enc n1 a (pubk b)) + + n1 + n1 + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 11 +
+ +
(defskeleton ns
+  (vars (n1 n2 text) (a b name))
+  (deflistener n1)
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
+  (precedes ((1 0) (0 0)) ((1 0) (2 0)) ((2 1) (1 1)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1)
+  (operation nonce-test (contracted (n2-0 n2)) n1 (1 1)
+    (enc n1 n2 (pubk a)) (enc n1 a (pubk b)))
+  (label 11)
+  (parent 10)
+  (unrealized (0 0))
+  (comment "2 in cohort - 2 not yet seen"))
+ +

Item 12, Parent: 11, Children: 14 15.

+ +
+ + + + + + + + + + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + + (enc n1 a (pubk b)) + + n1 + n1 + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 12 +
+ +
(defskeleton ns
+  (vars (n1 n2 text) (a b name))
+  (deflistener n1)
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
+  (precedes ((1 0) (2 0)) ((2 1) (0 0)) ((2 1) (1 1)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1)
+  (operation nonce-test (displaced 3 2 resp 2) n1 (0 0)
+    (enc n1 a (pubk b)))
+  (label 12)
+  (parent 11)
+  (unrealized (0 0))
+  (comment "2 in cohort - 2 not yet seen"))
+ +

Item 13, Parent: 11, Seen Child: 15.

+ +
+ + + + + + + + + + + (enc n1 n2-0 (pubk a)) + + (enc n1 a (pubk b)) + + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + + + (enc n1 a (pubk b)) + + n1 + n1 + + ((n2 n2-0) (n1 n1) (b b) (a a)) + resp + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 13 +
+ +
(defskeleton ns
+  (vars (n1 n2 n2-0 text) (a b name))
+  (deflistener n1)
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
+  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
+  (precedes ((1 0) (2 0)) ((1 0) (3 0)) ((2 1) (1 1)) ((3 1) (0 0)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1)
+  (operation nonce-test (added-strand resp 2) n1 (0 0)
+    (enc n1 a (pubk b)))
+  (label 13)
+  (parent 11)
+  (seen 15)
+  (unrealized (0 0))
+  (comment "1 in cohort - 0 not yet seen"))
+ +

Item 14, Parent: 12, Child: 16.

+ +
+ + + + + + + + + + (enc n2 n2 (pubk a)) + + (enc n2 a (pubk b)) + + + (enc n2 (pubk b)) + + (enc n2 n2 (pubk a)) + + + (enc n2 a (pubk b)) + + n2 + n2 + + ((n2 n2) (n1 n2) (b b) (a a)) + resp + + ((n1 n2) (n2 n2) (a a) (b b)) + init + + ns 14 +
+ +
(defskeleton ns
+  (vars (n2 text) (a b name))
+  (deflistener n2)
+  (defstrand init 3 (n1 n2) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2) (n1 n2) (b b) (a a))
+  (precedes ((1 0) (2 0)) ((1 2) (0 0)) ((2 1) (1 1)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n2)
+  (operation nonce-test (displaced 3 1 init 3) n2 (0 0)
+    (enc n2 n2 (pubk a)) (enc n2 a (pubk b)))
+  (label 14)
+  (parent 12)
+  (unrealized (0 0))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 15, Parent: 12, Seen Child: 16.

+ +
+ + + + + + + + + + + (enc n1 n2-0 (pubk a)) + + (enc n1 a (pubk b)) + + + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + + + (enc n1 a (pubk b)) + + n1 + n1 + + ((n2 n2-0) (n1 n1) (b b) (a a)) + resp + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 15 +
+ +
(defskeleton ns
+  (vars (n1 n2 n2-0 text) (a b name))
+  (deflistener n1)
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
+  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
+  (precedes ((1 0) (2 0)) ((1 0) (3 0)) ((2 1) (0 0)) ((2 1) (1 1))
+    ((3 1) (0 0)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1)
+  (operation nonce-test (added-strand resp 2) n1 (0 0)
+    (enc n1 n2 (pubk a)) (enc n1 a (pubk b)))
+  (label 15)
+  (parent 12)
+  (seen 16)
+  (unrealized (0 0))
+  (comment "1 in cohort - 0 not yet seen"))
+ +

Item 16, Parent: 14.

+ +
+ + + + + + + + + + + (enc n2 n2-0 (pubk a)) + + (enc n2 a (pubk b)) + + + (enc n2 n2 (pubk a)) + + (enc n2 a (pubk b)) + + + (enc n2 (pubk b)) + + (enc n2 n2 (pubk a)) + + + + (enc n2 a (pubk b)) + + n2 + n2 + + ((n2 n2-0) (n1 n2) (b b) (a a)) + resp + + ((n2 n2) (n1 n2) (b b) (a a)) + resp + + ((n1 n2) (n2 n2) (a a) (b b)) + init + + ns 16 +
+ +
(defskeleton ns
+  (vars (n2 n2-0 text) (a b name))
+  (deflistener n2)
+  (defstrand init 3 (n1 n2) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2) (n1 n2) (b b) (a a))
+  (defstrand resp 2 (n2 n2-0) (n1 n2) (b b) (a a))
+  (precedes ((1 0) (2 0)) ((1 0) (3 0)) ((1 2) (0 0)) ((2 1) (1 1))
+    ((3 1) (0 0)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n2)
+  (operation nonce-test (added-strand resp 2) n2 (0 0) (enc n2 (pubk b))
+    (enc n2 n2 (pubk a)) (enc n2 a (pubk b)))
+  (label 16)
+  (parent 14)
+  (unrealized (0 0))
+  (comment "empty cohort"))
+ +

Tree 17.

+ +
+ + 18 + + 17 +
+ +
(defprotocol unilateral basic
+  (defrole init
+    (vars (a name) (n text))
+    (trace (send (enc n (pubk a))) (recv n)))
+  (defrole resp
+    (vars (a name) (n text))
+    (trace (recv (enc n (pubk a))) (send n)))
+  (comment "Unilateral authentication"))
+ +

Item 17, Child: 18.

+ +
+ + + + + + + n + + (enc n (pubk a)) + + ((n n) (a a)) + init + + unilateral 17
+ +
(defskeleton unilateral
+  (vars (n text) (a name))
+  (defstrand init 2 (n n) (a a))
+  (non-orig (privk a))
+  (uniq-orig n)
+  (goals
+    (forall ((a name) (n text) (z0 strd))
+      (implies
+        (and (p "init" z0 2) (p "init" "n" z0 n) (p "init" "a" z0 a)
+          (non (privk a)) (uniq n))
+        (exists ((z1 strd))
+          (and (p "resp" z1 2) (p "resp" "a" z1 a))))))
+  (comment "Unilateral authentication goal")
+  (label 17)
+  (unrealized (0 1))
+  (origs (n (0 0)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 18, Parent: 17.

+ +
+ + + + + + + + + n + (enc n (pubk a)) + + n + + + (enc n (pubk a)) + + ((n n) (a a)) + resp + + ((n n) (a a)) + init + + unilateral 18 (realized) +
+ +
(defskeleton unilateral
+  (vars (n text) (a name))
+  (defstrand init 2 (n n) (a a))
+  (defstrand resp 2 (n n) (a a))
+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
+  (non-orig (privk a))
+  (uniq-orig n)
+  (operation nonce-test (added-strand resp 2) n (0 1) (enc n (pubk a)))
+  (label 18)
+  (parent 17)
+  (unrealized)
+  (shape)
+  (satisfies yes)
+  (maps ((0) ((a a) (n n))))
+  (origs (n (0 0))))
+ +

Tree 19.

+ +
+ + 20 + + 19 +
+ +
(defprotocol ns basic
+  (defrole init
+    (vars (a b name) (n1 n2 text))
+    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
+      (send (enc n2 (pubk b)))))
+  (defrole resp
+    (vars (b a name) (n2 n1 text))
+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
+      (recv (enc n2 (pubk b)))))
+  (comment "Needham-Schroeder with no role origination assumptions"))
+ +

Item 19, Child: 20.

+ +
+ + + + + + + (enc n n2 (pubk a-0)) + + (enc n a-0 (pubk a)) + + ((n1 n) (n2 n2) (a a-0) (b a)) + init + + ns 19 +
+ +
(defskeleton ns
+  (vars (n n2 text) (a a-0 name))
+  (defstrand init 2 (n1 n) (n2 n2) (a a-0) (b a))
+  (non-orig (privk a))
+  (uniq-orig n)
+  (goals
+    (forall ((a name) (n text) (z0 strd))
+      (implies
+        (and (p "init" z0 2) (p "init" "n1" z0 n) (p "init" "b" z0 a)
+          (non (privk a)) (uniq n))
+        (exists ((z1 strd))
+          (and (p "resp" z1 2) (p "resp" "b" z1 a))))))
+  (comment "Initiator authentication goal"
+    "Same as unilateral goal under the predicate mapping:"
+    (p "init" "n") "->" (p "init" "n1") "and" (p "init" "a") "->"
+    (p "init" "b") "and" (p "resp" "a") "->" (p "resp" "b"))
+  (label 19)
+  (unrealized (0 1))
+  (origs (n (0 0)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 20, Parent: 19.

+ +
+ + + + + + + + + (enc n n2-0 (pubk a-0)) + + (enc n a-0 (pubk a)) + + (enc n n2 (pubk a-0)) + + + (enc n a-0 (pubk a)) + + ((n2 n2-0) (n1 n) (b a) (a a-0)) + resp + + ((n1 n) (n2 n2) (a a-0) (b a)) + init + + ns 20 (realized)
+ +
(defskeleton ns
+  (vars (n n2 n2-0 text) (a a-0 name))
+  (defstrand init 2 (n1 n) (n2 n2) (a a-0) (b a))
+  (defstrand resp 2 (n2 n2-0) (n1 n) (b a) (a a-0))
+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
+  (non-orig (privk a))
+  (uniq-orig n)
+  (operation nonce-test (added-strand resp 2) n (0 1)
+    (enc n a-0 (pubk a)))
+  (label 20)
+  (parent 19)
+  (unrealized)
+  (shape)
+  (satisfies yes)
+  (maps ((0) ((a a) (n n) (a-0 a-0) (n2 n2))))
+  (origs (n (0 0))))
+ +

Tree 21.

+ +
+ + 22 + + 21 +
+ +
(defprotocol ns basic
+  (defrole init
+    (vars (a b name) (n1 n2 text))
+    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
+      (send (enc n2 (pubk b)))))
+  (defrole resp
+    (vars (b a name) (n2 n1 text))
+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
+      (recv (enc n2 (pubk b)))))
+  (comment "Needham-Schroeder with no role origination assumptions"))
+ +

Item 21, Child: 22.

+ +
+ + + + + + + (enc n (pubk b)) + + (enc n1 n (pubk a)) + + (enc n1 a (pubk b)) + + ((n2 n) (n1 n1) (b b) (a a)) + resp + + ns 21 +
+ +
(defskeleton ns
+  (vars (n n1 text) (a b name))
+  (defstrand resp 3 (n2 n) (n1 n1) (b b) (a a))
+  (non-orig (privk a))
+  (uniq-orig n)
+  (goals
+    (forall ((a name) (n text) (z0 strd))
+      (implies
+        (and (p "resp" z0 3) (p "resp" "n2" z0 n) (p "resp" "a" z0 a)
+          (non (privk a)) (uniq n))
+        (exists ((z1 strd))
+          (and (p "init" z1 3) (p "init" "a" z1 a))))))
+  (comment "Responder authentication goal"
+    "Same as unilateral goal under the predicate mapping:" (p "init" 1)
+    "->" (p "resp" 2) "and" (p "init" "n") "->" (p "resp" "n2") "and"
+    (p "init" "a") "->" (p "resp" "a") "and" (p "resp" 1) "->"
+    (p "init" 2) "and" (p "resp" "a") "->" (p "init" "a"))
+  (label 21)
+  (unrealized (0 2))
+  (origs (n (0 1)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 22, Parent: 21.

+ +
+ + + + + + + + + (enc n (pubk b-0)) + + (enc n1 n (pubk a)) + + (enc n1 a (pubk b-0)) + + (enc n (pubk b)) + + + (enc n1 n (pubk a)) + + (enc n1 a (pubk b)) + + ((n1 n1) (n2 n) (a a) (b b-0)) + init + + ((n2 n) (n1 n1) (b b) (a a)) + resp + + ns 22 (realized)
+ +
(defskeleton ns
+  (vars (n n1 text) (a b b-0 name))
+  (defstrand resp 3 (n2 n) (n1 n1) (b b) (a a))
+  (defstrand init 3 (n1 n1) (n2 n) (a a) (b b-0))
+  (precedes ((0 1) (1 1)) ((1 2) (0 2)))
+  (non-orig (privk a))
+  (uniq-orig n)
+  (operation nonce-test (added-strand init 3) n (0 2)
+    (enc n1 n (pubk a)))
+  (label 22)
+  (parent 21)
+  (unrealized)
+  (shape)
+  (satisfies yes)
+  (maps ((0) ((a a) (n n) (b b) (n1 n1))))
+  (origs (n (0 1))))
+ +

Tree 23.

+ +
+ + 25 + + 24 + + 23 +
+ +
(defprotocol ns basic
+  (defrole init
+    (vars (a b name) (n1 n2 text))
+    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
+      (send (enc n2 (pubk b)))))
+  (defrole resp
+    (vars (b a name) (n2 n1 text))
+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
+      (recv (enc n2 (pubk b)))))
+  (comment "Needham-Schroeder with no role origination assumptions"))
+ +

Item 23, Child: 24.

+ +
+ + + + + + + (enc n n2 (pubk a)) + + (enc n a (pubk b)) + + ((n1 n) (n2 n2) (a a) (b b)) + init + + ns 23 +
+ +
(defskeleton ns
+  (vars (n n2 text) (a b name))
+  (defstrand init 2 (n1 n) (n2 n2) (a a) (b b))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n)
+  (goals
+    (forall ((a b name) (n text) (z0 strd))
+      (implies
+        (and (p "init" z0 2) (p "init" "n1" z0 n) (p "init" "a" z0 a)
+          (p "init" "b" z0 b) (non (privk a)) (non (privk b)) (uniq n))
+        (exists ((z1 strd)) (and (p "resp" z1 2) (p "resp" "b" z1 b)))))
+    (forall ((a b name) (n text) (z0 strd))
+      (implies
+        (and (p "init" z0 2) (p "init" "n1" z0 n) (p "init" "a" z0 a)
+          (p "init" "b" z0 b) (non (privk a)) (non (privk b)) (uniq n))
+        (exists ((z1 strd))
+          (and (p "resp" z1 2) (p "resp" "a" z1 a))))))
+  (comment "Two initiator authentication goals")
+  (label 23)
+  (unrealized (0 1))
+  (origs (n (0 0)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 24, Parent: 23, Child: 25.

+ +
+ + + + + + + + + (enc n n2-0 (pubk a)) + + (enc n a (pubk b)) + + (enc n n2 (pubk a)) + + + (enc n a (pubk b)) + + ((n2 n2-0) (n1 n) (b b) (a a)) + resp + + ((n1 n) (n2 n2) (a a) (b b)) + init + + ns 24 +
+ +
(defskeleton ns
+  (vars (n n2 n2-0 text) (a b name))
+  (defstrand init 2 (n1 n) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2-0) (n1 n) (b b) (a a))
+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n)
+  (operation nonce-test (added-strand resp 2) n (0 1)
+    (enc n a (pubk b)))
+  (label 24)
+  (parent 23)
+  (unrealized (0 1))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 25, Parent: 24.

+ +
+ + + + + + + + + (enc n n2 (pubk a)) + + (enc n a (pubk b)) + + (enc n n2 (pubk a)) + + + (enc n a (pubk b)) + + ((n2 n2) (n1 n) (b b) (a a)) + resp + + ((n1 n) (n2 n2) (a a) (b b)) + init + + ns 25 (realized)
+ +
(defskeleton ns
+  (vars (n n2 text) (a b name))
+  (defstrand init 2 (n1 n) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2) (n1 n) (b b) (a a))
+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n)
+  (operation nonce-test (contracted (n2-0 n2)) n (0 1)
+    (enc n n2 (pubk a)) (enc n a (pubk b)))
+  (label 25)
+  (parent 24)
+  (unrealized)
+  (shape)
+  (satisfies yes yes)
+  (maps ((0) ((a a) (b b) (n n) (n2 n2))))
+  (origs (n (0 0))))
+ +

Tree 26.

+ +
+ + 27 + + 26 +
+ +
(defprotocol ns basic
+  (defrole init
+    (vars (a b name) (n1 n2 text))
+    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
+      (send (enc n2 (pubk b)))))
+  (defrole resp
+    (vars (b a name) (n2 n1 text))
+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
+      (recv (enc n2 (pubk b)))))
+  (comment "Needham-Schroeder with no role origination assumptions"))
+ +

Item 26, Child: 27.

+ +
+ + + + + + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 26 +
+ +
(defskeleton ns
+  (vars (n1 n2 text) (b a name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (non-orig (privk b))
+  (uniq-orig n1)
+  (goals
+    (forall ((n1 n2 text) (b a name) (z strd))
+      (implies
+        (and (p "init" z 3) (p "init" "n1" z n1) (p "init" "n2" z n2)
+          (p "init" "a" z a) (p "init" "b" z b) (non (privk b))
+          (uniq-at n1 z 0))
+        (exists ((n2-0 text) (z-0 strd))
+          (and (p "resp" z-0 2) (p "resp" "n2" z-0 n2-0)
+            (p "resp" "n1" z-0 n1) (p "resp" "b" z-0 b)
+            (p "resp" "a" z-0 a) (prec z 0 z-0 0) (prec z-0 1 z 1))))))
+  (comment "Shape analysis sentence")
+  (label 26)
+  (unrealized (0 1))
+  (origs (n1 (0 0)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 27, Parent: 26.

+ +
+ + + + + + + + + (enc n1 n2-0 (pubk a)) + + (enc n1 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + + (enc n1 a (pubk b)) + + ((n2 n2-0) (n1 n1) (b b) (a a)) + resp + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 27 (realized)
+ +
(defskeleton ns
+  (vars (n1 n2 n2-0 text) (b a name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
+  (non-orig (privk b))
+  (uniq-orig n1)
+  (operation nonce-test (added-strand resp 2) n1 (0 1)
+    (enc n1 a (pubk b)))
+  (label 27)
+  (parent 26)
+  (unrealized)
+  (shape)
+  (satisfies yes)
+  (maps ((0) ((n1 n1) (n2 n2) (b b) (a a))))
+  (origs (n1 (0 0))))
+ +

Tree 28.

+ +
+ + 32 + + 31 + + 30 + + 29 + + 28 +
+ +
(defprotocol ns basic
+  (defrole init
+    (vars (a b name) (n1 n2 text))
+    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
+      (send (enc n2 (pubk b)))))
+  (defrole resp
+    (vars (b a name) (n2 n1 text))
+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
+      (recv (enc n2 (pubk b)))))
+  (comment "Needham-Schroeder with no role origination assumptions"))
+ +

Item 28, Child: 29.

+ +
+ + + + + + + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + n2 + n2 + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + ns 28 +
+ +
(defskeleton ns
+  (vars (n2 n1 text) (a b name))
+  (deflistener n2)
+  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n2)
+  (goals
+    (forall ((a b name) (n2 text) (z0 z1 strd))
+      (implies
+        (and (p "resp" z0 3) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
+          (p "resp" "b" z0 b) (p "" z1 1) (p "" "x" z1 n2)
+          (non (privk a)) (non (privk b)) (uniq n2)) (false))))
+  (comment "Responder point of view"
+    "Failed secrecy goal: nonce n2 not revealed")
+  (label 28)
+  (unrealized (0 0) (1 2))
+  (preskeleton)
+  (comment "Not a skeleton"))
+ +

Item 29, Parent: 28, Child: 30.

+ +
+ + + + + + + + (enc n2 (pubk b)) + + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + n2 + n2 + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + ns 29 +
+ +
(defskeleton ns
+  (vars (n2 n1 text) (a b name))
+  (deflistener n2)
+  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
+  (precedes ((1 1) (0 0)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n2)
+  (goals
+    (forall ((a b name) (n2 text) (z0 z1 strd))
+      (implies
+        (and (p "resp" z0 3) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
+          (p "resp" "b" z0 b) (p "" z1 1) (p "" "x" z1 n2)
+          (non (privk a)) (non (privk b)) (uniq n2)) (false))))
+  (comment "Responder point of view"
+    "Failed secrecy goal: nonce n2 not revealed")
+  (label 29)
+  (parent 28)
+  (unrealized (0 0) (1 2))
+  (origs (n2 (1 1)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 30, Parent: 29, Children: 31 32.

+ +
+ + + + + + + + + + (enc n2 (pubk b-0)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b-0)) + + (enc n2 (pubk b)) + + + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + n2 + n2 + + ((n1 n1) (n2 n2) (a a) (b b-0)) + init + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + ns 30 +
+ +
(defskeleton ns
+  (vars (n2 n1 text) (a b b-0 name))
+  (deflistener n2)
+  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
+  (precedes ((1 1) (0 0)) ((1 1) (2 1)) ((2 2) (1 2)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n2)
+  (operation nonce-test (added-strand init 3) n2 (1 2)
+    (enc n1 n2 (pubk a)))
+  (label 30)
+  (parent 29)
+  (unrealized (0 0))
+  (comment "2 in cohort - 2 not yet seen"))
+ +

Item 31, Parent: 30.

+ +
+ + + + + + + + + + + (enc n2 (pubk b-0)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b-0)) + + (enc n2 (pubk b)) + + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + n2 + n2 + + ((n1 n1) (n2 n2) (a a) (b b-0)) + init + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + ns 31 (realized)
+ +
(defskeleton ns
+  (vars (n2 n1 text) (a b b-0 name))
+  (deflistener n2)
+  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
+  (precedes ((1 1) (2 1)) ((2 2) (0 0)) ((2 2) (1 2)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n2)
+  (operation nonce-test (displaced 3 2 init 3) n2 (0 0)
+    (enc n1 n2 (pubk a)))
+  (label 31)
+  (parent 30)
+  (unrealized)
+  (shape)
+  (satisfies (no (a a) (b b) (n2 n2) (z0 1) (z1 0)))
+  (maps ((0 1) ((a a) (b b) (n2 n2) (n1 n1))))
+  (origs (n2 (1 1))))
+ +

Item 32, Parent: 30.

+ +
+ + + + + + + + + + + (enc n2 (pubk b-1)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b-1)) + + + (enc n2 (pubk b-0)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b-0)) + + (enc n2 (pubk b)) + + + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + n2 + n2 + + ((n1 n1) (n2 n2) (a a) (b b-1)) + init + + ((n1 n1) (n2 n2) (a a) (b b-0)) + init + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + ns 32 (realized)
+ +
(defskeleton ns
+  (vars (n2 n1 text) (a b b-0 b-1 name))
+  (deflistener n2)
+  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-1))
+  (precedes ((1 1) (2 1)) ((1 1) (3 1)) ((2 2) (1 2)) ((3 2) (0 0)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n2)
+  (operation nonce-test (added-strand init 3) n2 (0 0)
+    (enc n1 n2 (pubk a)))
+  (label 32)
+  (parent 30)
+  (unrealized)
+  (shape)
+  (satisfies (no (a a) (b b) (n2 n2) (z0 1) (z1 0)))
+  (maps ((0 1) ((a a) (b b) (n2 n2) (n1 n1))))
+  (origs (n2 (1 1))))
+ +

Tree 33.

+ +
+ + 40 + + 39 + + 37 + + 35 + + 38 + + 36 + + 34 + + 33 +
+ +
(defprotocol ns basic
+  (defrole init
+    (vars (a b name) (n1 n2 text))
+    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
+      (send (enc n2 (pubk b)))))
+  (defrole resp
+    (vars (b a name) (n2 n1 text))
+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
+      (recv (enc n2 (pubk b)))))
+  (comment "Needham-Schroeder with no role origination assumptions"))
+ +

Item 33, Children: 34 35.

+ +
+ + + + + + + + (enc n2-0 (pubk b)) + + (enc n1-0 n2-0 (pubk a)) + + (enc n1-0 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + ((n1 n1-0) (n2 n2-0) (a a) (b b)) + init + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 33 +
+ +
(defskeleton ns
+  (vars (n1 n1-0 n2 n2-0 text) (a b name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand init 3 (n1 n1-0) (n2 n2-0) (a a) (b b))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1 n1-0)
+  (subgoals
+    (forall ((n1 n1-0 n2 n2-0 text) (a b name) (z z-0 strd))
+      (implies
+        (and (p "init" z 3) (p "init" z-0 3) (p "init" "n1" z n1)
+          (p "init" "n2" z n2) (p "init" "a" z a) (p "init" "b" z b)
+          (p "init" "n1" z-0 n1-0) (p "init" "n2" z-0 n2-0)
+          (p "init" "a" z-0 a) (p "init" "b" z-0 b) (non (privk a))
+          (non (privk b)) (uniq-at n1 z 0) (uniq-at n1-0 z-0 0))
+        (= z z-0))))
+  (comment "Double initiator point of view")
+  (label 33)
+  (unrealized (0 1) (1 1))
+  (origs (n1 (0 0)) (n1-0 (1 0)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 34, Parent: 33, Child: 36.

+ +
+ + + + + + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 34 +
+ +
(defskeleton ns
+  (vars (n1 n2 text) (a b name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1)
+  (operation collapsed 1 0)
+  (label 34)
+  (parent 33)
+  (unrealized (0 1))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 35, Parent: 33, Child: 37.

+ +
+ + + + + + + + + + (enc n1-0 n2-1 (pubk a)) + + (enc n1-0 a (pubk b)) + + (enc n2-0 (pubk b)) + + (enc n1-0 n2-0 (pubk a)) + + + (enc n1-0 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + ((n2 n2-1) (n1 n1-0) (b b) (a a)) + resp + + ((n1 n1-0) (n2 n2-0) (a a) (b b)) + init + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 35 +
+ +
(defskeleton ns
+  (vars (n1 n1-0 n2 n2-0 n2-1 text) (a b name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand init 3 (n1 n1-0) (n2 n2-0) (a a) (b b))
+  (defstrand resp 2 (n2 n2-1) (n1 n1-0) (b b) (a a))
+  (precedes ((1 0) (2 0)) ((2 1) (1 1)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1 n1-0)
+  (operation nonce-test (added-strand resp 2) n1-0 (1 1)
+    (enc n1-0 a (pubk b)))
+  (label 35)
+  (parent 33)
+  (unrealized (0 1) (1 1))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 36, Parent: 34, Child: 38.

+ +
+ + + + + + + + + (enc n1 n2-0 (pubk a)) + + (enc n1 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + + (enc n1 a (pubk b)) + + ((n2 n2-0) (n1 n1) (b b) (a a)) + resp + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 36 +
+ +
(defskeleton ns
+  (vars (n1 n2 n2-0 text) (a b name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1)
+  (operation nonce-test (added-strand resp 2) n1 (0 1)
+    (enc n1 a (pubk b)))
+  (label 36)
+  (parent 34)
+  (unrealized (0 1))
+  (origs (n1 (0 0)))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 37, Parent: 35, Child: 39.

+ +
+ + + + + + + + + + (enc n1-0 n2-0 (pubk a)) + + (enc n1-0 a (pubk b)) + + (enc n2-0 (pubk b)) + + (enc n1-0 n2-0 (pubk a)) + + + (enc n1-0 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + ((n2 n2-0) (n1 n1-0) (b b) (a a)) + resp + + ((n1 n1-0) (n2 n2-0) (a a) (b b)) + init + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 37 +
+ +
(defskeleton ns
+  (vars (n1 n1-0 n2 n2-0 text) (a b name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand init 3 (n1 n1-0) (n2 n2-0) (a a) (b b))
+  (defstrand resp 2 (n2 n2-0) (n1 n1-0) (b b) (a a))
+  (precedes ((1 0) (2 0)) ((2 1) (1 1)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1 n1-0)
+  (operation nonce-test (contracted (n2-1 n2-0)) n1-0 (1 1)
+    (enc n1-0 n2-0 (pubk a)) (enc n1-0 a (pubk b)))
+  (label 37)
+  (parent 35)
+  (unrealized (0 1))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 38, Parent: 36.

+ +
+ + + + + + + + + (enc n1 n2 (pubk a)) + + (enc n1 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + + (enc n1 a (pubk b)) + + ((n2 n2) (n1 n1) (b b) (a a)) + resp + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 38 (realized)
+ +
(defskeleton ns
+  (vars (n1 n2 text) (a b name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1)
+  (operation nonce-test (contracted (n2-0 n2)) n1 (0 1)
+    (enc n1 n2 (pubk a)) (enc n1 a (pubk b)))
+  (label 38)
+  (parent 36)
+  (unrealized)
+  (shape)
+  (satisfies yes)
+  (maps ((0 0) ((a a) (b b) (n1 n1) (n1-0 n1) (n2 n2) (n2-0 n2))))
+  (origs (n1 (0 0))))
+ +

Item 39, Parent: 37, Child: 40.

+ +
+ + + + + + + + + + + (enc n1 n2-1 (pubk a)) + + (enc n1 a (pubk b)) + + + (enc n1-0 n2-0 (pubk a)) + + (enc n1-0 a (pubk b)) + + (enc n2-0 (pubk b)) + + (enc n1-0 n2-0 (pubk a)) + + + (enc n1-0 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1 n2 (pubk a)) + + + (enc n1 a (pubk b)) + + ((n2 n2-1) (n1 n1) (b b) (a a)) + resp + + ((n2 n2-0) (n1 n1-0) (b b) (a a)) + resp + + ((n1 n1-0) (n2 n2-0) (a a) (b b)) + init + + ((n1 n1) (n2 n2) (a a) (b b)) + init + + ns 39 +
+ +
(defskeleton ns
+  (vars (n1 n1-0 n2 n2-0 n2-1 text) (a b name))
+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
+  (defstrand init 3 (n1 n1-0) (n2 n2-0) (a a) (b b))
+  (defstrand resp 2 (n2 n2-0) (n1 n1-0) (b b) (a a))
+  (defstrand resp 2 (n2 n2-1) (n1 n1) (b b) (a a))
+  (precedes ((0 0) (3 0)) ((1 0) (2 0)) ((2 1) (1 1)) ((3 1) (0 1)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1 n1-0)
+  (operation nonce-test (added-strand resp 2) n1 (0 1)
+    (enc n1 a (pubk b)))
+  (label 39)
+  (parent 37)
+  (unrealized (0 1))
+  (comment "1 in cohort - 1 not yet seen"))
+ +

Item 40, Parent: 39.

+ +
+ + + + + + + + + + + (enc n1 n2-0 (pubk a)) + + (enc n1 a (pubk b)) + + + (enc n1-0 n2 (pubk a)) + + (enc n1-0 a (pubk b)) + + (enc n2 (pubk b)) + + (enc n1-0 n2 (pubk a)) + + + (enc n1-0 a (pubk b)) + + (enc n2-0 (pubk b)) + + (enc n1 n2-0 (pubk a)) + + + (enc n1 a (pubk b)) + + ((n2 n2-0) (n1 n1) (b b) (a a)) + resp + + ((n2 n2) (n1 n1-0) (b b) (a a)) + resp + + ((n1 n1-0) (n2 n2) (a a) (b b)) + init + + ((n1 n1) (n2 n2-0) (a a) (b b)) + init + + ns 40 (realized)
+ +
(defskeleton ns
+  (vars (n1 n1-0 n2 n2-0 text) (a b name))
+  (defstrand init 3 (n1 n1) (n2 n2-0) (a a) (b b))
+  (defstrand init 3 (n1 n1-0) (n2 n2) (a a) (b b))
+  (defstrand resp 2 (n2 n2) (n1 n1-0) (b b) (a a))
+  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
+  (precedes ((0 0) (3 0)) ((1 0) (2 0)) ((2 1) (1 1)) ((3 1) (0 1)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n1 n1-0)
+  (operation nonce-test (contracted (n2-1 n2-0)) n1 (0 1)
+    (enc n1 n2-0 (pubk a)) (enc n1 a (pubk b)))
+  (label 40)
+  (parent 39)
+  (unrealized)
+  (shape)
+  (satisfies
+    (no (n1 n1) (n1-0 n1-0) (n2 n2-0) (n2-0 n2) (a a) (b b) (z 0)
+      (z-0 1)))
+  (maps ((0 1) ((a a) (b b) (n1 n1) (n1-0 n1-0) (n2 n2-0) (n2-0 n2))))
+  (origs (n1 (0 0)) (n1-0 (1 0))))
+ +

Tree 41.

+ +
+ + 44 + + 43 + + 42 + + 41 +
+ +
(defprotocol nsl-typeless basic
+  (defrole init
+    (vars (a b name) (n1 text) (n2 mesg))
+    (trace (send (enc a n1 (pubk b))) (recv (enc n1 n2 b (pubk a)))
+      (send (enc n2 (pubk b)))))
+  (defrole resp
+    (vars (b a name) (n2 text) (n1 mesg))
+    (trace (recv (enc a n1 (pubk b))) (send (enc n1 n2 b (pubk a)))
+      (recv (enc n2 (pubk b)))))
+  (comment "Needham-Schroeder-Lowe with untyped nonces"))
+ +

Item 41, Child: 42.

+ +
+ + + + + + + + (enc n1 n2 b (pubk a)) + + (enc a n1 (pubk b)) + + n2 + n2 + + ((n1 n1) (n2 n2) (b b) (a a)) + resp + + nsl-typeless 41
+ +
(defskeleton nsl-typeless
+  (vars (n1 mesg) (n2 text) (a b name))
+  (deflistener n2)
+  (defstrand resp 2 (n1 n1) (n2 n2) (b b) (a a))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n2)
+  (goals
+    (forall ((n2 text) (a b name) (z z-0 strd))
+      (implies
+        (and (p "resp" z 2) (p "" z-0 1) (p "resp" "n2" z n2)
+          (p "resp" "b" z b) (p "resp" "a" z a) (p "" "x" z-0 n2)
+          (non (privk a)) (non (privk b)) (uniq n2)) (false))))
+  (comment "Shows typeflaw in typeless NSL")
+  (label 41)
+  (unrealized (0 0))
+  (preskeleton)
+  (comment "Not a skeleton"))
+ +

Item 42, Parent: 41, Children: 43 44.

+ +
+ + + + + + + + + (enc n1 n2 b (pubk a)) + + (enc a n1 (pubk b)) + + n2 + n2 + + ((n1 n1) (n2 n2) (b b) (a a)) + resp + + nsl-typeless 42
+ +
(defskeleton nsl-typeless
+  (vars (n1 mesg) (n2 text) (a b name))
+  (deflistener n2)
+  (defstrand resp 2 (n1 n1) (n2 n2) (b b) (a a))
+  (precedes ((1 1) (0 0)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n2)
+  (goals
+    (forall ((n2 text) (a b name) (z z-0 strd))
+      (implies
+        (and (p "resp" z 2) (p "" z-0 1) (p "resp" "n2" z n2)
+          (p "resp" "b" z b) (p "resp" "a" z a) (p "" "x" z-0 n2)
+          (non (privk a)) (non (privk b)) (uniq n2)) (false))))
+  (comment "Shows typeflaw in typeless NSL")
+  (label 42)
+  (parent 41)
+  (unrealized (0 0))
+  (origs (n2 (1 1)))
+  (comment "2 in cohort - 2 not yet seen"))
+ +

Item 43, Parent: 42.

+ +
+ + + + + + + + + + (enc n2 (pubk b)) + + (enc n1 n2 b (pubk a)) + + (enc a n1 (pubk b)) + + + (enc n1 n2 b (pubk a)) + + (enc a n1 (pubk b)) + + n2 + n2 + + ((n2 n2) (n1 n1) (a a) (b b)) + init + + ((n1 n1) (n2 n2) (b b) (a a)) + resp + + nsl-typeless 43
+ +
(defskeleton nsl-typeless
+  (vars (n2 n1 text) (a b name))
+  (deflistener n2)
+  (defstrand resp 2 (n1 n1) (n2 n2) (b b) (a a))
+  (defstrand init 3 (n2 n2) (n1 n1) (a a) (b b))
+  (precedes ((1 1) (2 1)) ((2 2) (0 0)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n2)
+  (operation nonce-test (added-strand init 3) n2 (0 0)
+    (enc n1 n2 b (pubk a)))
+  (label 43)
+  (parent 42)
+  (unrealized (0 0))
+  (comment "empty cohort"))
+ +

Item 44, Parent: 42.

+ +
+ + + + + + + + + + (enc (cat n2 b) n2-0 a (pubk a-0)) + + (enc a-0 n2 b (pubk a)) + + + (enc a-0 n2 b (pubk a)) + + (enc a a-0 (pubk b)) + + n2 + n2 + + ((n1 (cat n2 b)) (n2 n2-0) (b a) (a a-0)) + resp + + ((n1 a-0) (n2 n2) (b b) (a a)) + resp + + nsl-typeless 44 (realized) +
+ +
(defskeleton nsl-typeless
+  (vars (n2 n2-0 text) (a b a-0 name))
+  (deflistener n2)
+  (defstrand resp 2 (n1 a-0) (n2 n2) (b b) (a a))
+  (defstrand resp 2 (n1 (cat n2 b)) (n2 n2-0) (b a) (a a-0))
+  (precedes ((1 1) (2 0)) ((2 1) (0 0)))
+  (non-orig (privk a) (privk b))
+  (uniq-orig n2)
+  (operation nonce-test (added-strand resp 2) n2 (0 0)
+    (enc a-0 n2 b (pubk a)))
+  (label 44)
+  (parent 42)
+  (unrealized)
+  (shape)
+  (satisfies (no (n2 n2) (a a) (b b) (z 1) (z-0 0)))
+  (maps ((0 1) ((n2 n2) (a a) (b b) (n1 a-0))))
+  (origs (n2 (1 1))))
diff --git a/doc/examples/iadh_um.xhtml b/doc/examples/iadh_um.xhtml # file too large to diff: doc/examples/iadh_um.xhtml diff --git a/doc/examples/kerb.xhtml b/doc/examples/kerb.xhtml --- a/doc/examples/kerb.xhtml +++ b/doc/examples/kerb.xhtml @@ -1,5 +1,5 @@ - + kerb-flawed @@ -10,7 +10,7 @@ -
(comment "CPSA 3.5.0")
+
(comment "CPSA 3.6.0")
 (comment "All input read from kerb.scm")

 
 
Trees: 0 5.

diff --git a/doc/examples/lt_test.xhtml b/doc/examples/lt_test.xhtml
--- a/doc/examples/lt_test.xhtml
+++ b/doc/examples/lt_test.xhtml
@@ -1,5 +1,5 @@
 
-
+
 
 
  Less-than constraint test protocol
@@ -13,7 +13,7 @@
 
(herald "Less-than constraint test protocol"
   (comment "First and third skeletons should have a shape,"
     "second and fourth should be dead."))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from lt_test.scm")

 
 
Trees: 0 2 3 5.

diff --git a/doc/examples/neq_test.xhtml b/doc/examples/neq_test.xhtml
--- a/doc/examples/neq_test.xhtml
+++ b/doc/examples/neq_test.xhtml
@@ -1,5 +1,5 @@
 
-
+
 
 
  Inequality constraint test protocol
@@ -13,7 +13,7 @@
 
(herald "Inequality constraint test protocol"
   (comment "First skeleton should have a shape,"
     "second, and hird should be dead."))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from neq_test.scm")

 
 
Trees: 0 2 3.

diff --git a/doc/examples/ns.xhtml b/doc/examples/ns.xhtml
--- a/doc/examples/ns.xhtml
+++ b/doc/examples/ns.xhtml
@@ -1,5 +1,5 @@
 
-
+
 
 
  Needham-Schroeder Public-Key Protocol
@@ -13,7 +13,7 @@
 
(herald "Needham-Schroeder Public-Key Protocol"
   (comment "This protocol contains a man-in-the-middle"
     "attack discovered by Galvin Lowe."))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from ns.scm")

 
 
Trees: 0 3.

diff --git a/doc/examples/or.xhtml b/doc/examples/or.xhtml
--- a/doc/examples/or.xhtml
+++ b/doc/examples/or.xhtml
@@ -1,5 +1,5 @@
 
-
+
 
 
  Otway-Rees Protocol
@@ -12,7 +12,7 @@
 
 
(herald "Otway-Rees Protocol"
   (comment "Standard version using variables of sort mesg"))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from or.scm")

 
 
Tree 0.

diff --git a/doc/examples/pkinit.scm b/doc/examples/pkinit.scm
--- a/doc/examples/pkinit.scm
+++ b/doc/examples/pkinit.scm
@@ -31,11 +31,7 @@
 ;;; which has no extension for which the conclusion is also
 ;;; satisfied. The shapes for the other analyses contain the
 ;;; annotation (satisfies yes) indicating that the goal is satisfied
-;;; in the shape (and hence in any realized skeleton). 
-
-
-
-
+;;; in the shape (and hence in any realized skeleton).
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;                       ;;
@@ -43,9 +39,8 @@
 ;;                       ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-
 ;; This is the flawed version of the Kerberos public key initial
-;; round. 
+;; round.
 (defprotocol pkinit-flawed basic
   (defrole client
     (vars (c t as name) (n2 n1 text) (tc tk tgt data) (k ak skey))
@@ -62,7 +57,6 @@
           (enc ak n1 tk t k))))
     (uniq-orig k ak)))
 
-
 ;; This is the fix the authors proposed to the standards group. It
 ;; adds the value c in a new field inside the server's signature.
 (defprotocol pkinit-fix1 basic
@@ -100,9 +94,8 @@
                        (privk as)) (pubk c)) c tgt (enc ak n1 tk t k))))
     (uniq-orig k ak)))
 
-
 ;;;;;;;;;;;;;;;;;;;;;
-;;                 ;; 
+;;                 ;;
 ;; Goal Statements ;;
 ;;                 ;;
 ;;;;;;;;;;;;;;;;;;;;;
@@ -110,16 +103,16 @@
 ;; This is the goal that the authors discovered was not met by the
 ;; original, flawed version, but which was met by both fixes.
 (defgoal pkinit-flawed
-  (forall ((c as name) (k skey) (z node))
+  (forall ((c as name) (k skey) (z strd))
           (implies
-           (and (p "client" 1 z)
+           (and (p "client" z 2)
                 (p "client" "c" z c)
                 (p "client" "as" z as)
                 (p "client" "k" z k)
                 (non (privk as))
                 (non (privk c)))
-           (exists ((z-0 node))
-                   (and (p "auth" 1 z-0)
+           (exists ((z-0 strd))
+                   (and (p "auth" z-0 2)
                         (p "auth" "as" z-0 as)
                         (p "auth" "k" z-0 k)
                         (p "auth" "c" z-0 c))))))
@@ -128,84 +121,83 @@
 ;; must repeat it once for every protocol against which we would like
 ;; to evaluate the goal.
 (defgoal pkinit-fix1
-  (forall ((c as name) (k skey) (z node))
+  (forall ((c as name) (k skey) (z strd))
           (implies
-           (and (p "client" 1 z)
+           (and (p "client" z 2)
                 (p "client" "c" z c)
                 (p "client" "as" z as)
                 (p "client" "k" z k)
                 (non (privk as))
                 (non (privk c)))
-           (exists ((z-0 node))
-                   (and (p "auth" 1 z-0)
+           (exists ((z-0 strd))
+                   (and (p "auth" z-0 2)
                         (p "auth" "as" z-0 as)
                         (p "auth" "k" z-0 k)
                         (p "auth" "c" z-0 c))))))
 
 ;; Repeated once more.
 (defgoal pkinit-fix2
-  (forall ((c as name) (k skey) (z node))
+  (forall ((c as name) (k skey) (z strd))
           (implies
-           (and (p "client" 1 z)
+           (and (p "client" z 2)
                 (p "client" "c" z c)
                 (p "client" "as" z as)
                 (p "client" "k" z k)
                 (non (privk as))
                 (non (privk c)))
-           (exists ((z-0 node))
-                   (and (p "auth" 1 z-0)
+           (exists ((z-0 strd))
+                   (and (p "auth" z-0 2)
                         (p "auth" "as" z-0 as)
                         (p "auth" "k" z-0 k)
                         (p "auth" "c" z-0 c))))))
 
-
 ;;;;;;;;
 
 (defgoal pkinit-flawed
-  (forall ((c c-0 as name) (k skey) (z z-0 node))
+  (forall ((c c-0 as name) (k skey) (z z-0 strd))
           (implies
-           (and (p "client" 1 z)
+           (and (p "client" z 2)
                 (p "client" "c" z c)
                 (p "client" "as" z as)
                 (p "client" "k" z k)
-                (p "auth" 1 z-0)
+                (p "auth" z-0 2)
                 (p "auth" "k" z-0 k)
                 (p "auth" "c" z-0 c-0)
                 (non (privk as))
                 (non (privk c)))
-           ;(exists ((z-1 node))
+           ;(exists ((z-1 strd))
            ;        (p "client" 1 z-1))
            (= c c-0)
            )))
 
 (defgoal pkinit-fix1
-  (forall ((c c-0 as name) (k skey) (z z-0 node))
+  (forall ((c c-0 as name) (k skey) (z z-0 strd))
           (implies
-           (and (p "client" 1 z)
+           (and (p "client" z 2)
                 (p "client" "c" z c)
                 (p "client" "as" z as)
                 (p "client" "k" z k)
-                (p "auth" 1 z-0)
+                (p "auth" z-0 2)
                 (p "auth" "k" z-0 k)
                 (p "auth" "c" z-0 c-0)
                 (non (privk as))
                 (non (privk c)))
-           (exists ((z-1 node))
-                   (p "client" 1 z-1))
+           (exists ((z-1 strd))
+                   (p "client" z-1 2))
            ;(= c c-0)
            )))
 
 (defgoal pkinit-fix2
-  (forall ((c c-0 as name) (k skey) (z z-0 node))
+  (forall ((c c-0 as name) (k skey) (z z-0 strd))
           (implies
-           (and (p "client" 1 z)
+           (and (p "client" z 2)
                 (p "client" "c" z c)
                 (p "client" "as" z as)
                 (p "client" "k" z k)
-                (p "auth" 1 z-0)
+                (p "auth" z-0 2)
                 (p "auth" "k" z-0 k)
                 (p "auth" "c" z-0 c-0)
                 (non (privk as))
                 (non (privk c)))
-           (exists ((z-1 node))
-                   (p "client" 1 z-1)))))
+           (exists ((z-1 strd))
+                   (p "client" z-1 2)))))
diff --git a/doc/examples/pkinit.xhtml b/doc/examples/pkinit.xhtml
--- a/doc/examples/pkinit.xhtml
+++ b/doc/examples/pkinit.xhtml
@@ -1,5 +1,5 @@
 
-
+
 
 
  Kerberos PKINIT
@@ -11,7 +11,7 @@
 
 
 
(herald "Kerberos PKINIT")
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from pkinit.scm")

 
 
Trees: 0 2 8 13 16 23.

@@ -89,13 +89,13 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2 n1)
   (goals
-    (forall ((c as name) (k skey) (z node))
+    (forall ((c as name) (k skey) (z strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
+        (and (p "client" z 2) (p "client" "c" z c)
           (p "client" "as" z as) (p "client" "k" z k) (non (privk as))
           (non (privk c)))
-        (exists ((z-0 node))
-          (and (p "auth" 1 z-0) (p "auth" "as" z-0 as)
+        (exists ((z-0 strd))
+          (and (p "auth" z-0 2) (p "auth" "as" z-0 as)
             (p "auth" "k" z-0 k) (p "auth" "c" z-0 c))))))
   (label 0)
   (unrealized (0 1))
@@ -168,7 +168,7 @@
   (parent 0)
   (unrealized)
   (shape)
-  (satisfies (no (c c) (as as) (k k) (z (0 1))))
+  (satisfies (no (c c) (as as) (k k) (z 0)))
   (maps
     ((0)
       ((c c) (as as) (k k) (t t) (n2 n2) (n1 n1) (tc tc) (tk tk)
@@ -272,13 +272,13 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2 n1)
   (goals
-    (forall ((c as name) (k skey) (z node))
+    (forall ((c as name) (k skey) (z strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
+        (and (p "client" z 2) (p "client" "c" z c)
           (p "client" "as" z as) (p "client" "k" z k) (non (privk as))
           (non (privk c)))
-        (exists ((z-0 node))
-          (and (p "auth" 1 z-0) (p "auth" "as" z-0 as)
+        (exists ((z-0 strd))
+          (and (p "auth" z-0 2) (p "auth" "as" z-0 as)
             (p "auth" "k" z-0 k) (p "auth" "c" z-0 c))))))
   (label 2)
   (unrealized (0 1))
@@ -735,13 +735,13 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2 n1)
   (goals
-    (forall ((c as name) (k skey) (z node))
+    (forall ((c as name) (k skey) (z strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
+        (and (p "client" z 2) (p "client" "c" z c)
           (p "client" "as" z as) (p "client" "k" z k) (non (privk as))
           (non (privk c)))
-        (exists ((z-0 node))
-          (and (p "auth" 1 z-0) (p "auth" "as" z-0 as)
+        (exists ((z-0 strd))
+          (and (p "auth" z-0 2) (p "auth" "as" z-0 as)
             (p "auth" "k" z-0 k) (p "auth" "c" z-0 c))))))
   (label 8)
   (unrealized (0 1))
@@ -1135,10 +1135,10 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2-0 n1-0 k ak)
   (goals
-    (forall ((c c-0 as name) (k skey) (z z-0 node))
+    (forall ((c c-0 as name) (k skey) (z z-0 strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
-          (p "client" "as" z as) (p "client" "k" z k) (p "auth" 1 z-0)
+        (and (p "client" z 2) (p "client" "c" z c)
+          (p "client" "as" z as) (p "client" "k" z k) (p "auth" z-0 2)
           (p "auth" "k" z-0 k) (p "auth" "c" z-0 c-0) (non (privk as))
           (non (privk c))) (= c c-0))))
   (label 13)
@@ -1204,10 +1204,10 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2-0 n1-0 k ak)
   (goals
-    (forall ((c c-0 as name) (k skey) (z z-0 node))
+    (forall ((c c-0 as name) (k skey) (z z-0 strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
-          (p "client" "as" z as) (p "client" "k" z k) (p "auth" 1 z-0)
+        (and (p "client" z 2) (p "client" "c" z c)
+          (p "client" "as" z as) (p "client" "k" z k) (p "auth" z-0 2)
           (p "auth" "k" z-0 k) (p "auth" "c" z-0 c-0) (non (privk as))
           (non (privk c))) (= c c-0))))
   (label 14)
@@ -1283,7 +1283,7 @@
   (parent 14)
   (unrealized)
   (shape)
-  (satisfies (no (c c) (c-0 c-0) (as as) (k k) (z (1 1)) (z-0 (0 1))))
+  (satisfies (no (c c) (c-0 c-0) (as as) (k k) (z 1) (z-0 0)))
   (maps
     ((0 1)
       ((c c) (c-0 c-0) (as as) (k k) (t t) (as-0 as) (n2 n2) (n1 n1)
@@ -1410,12 +1410,12 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2-0 n1-0 k ak)
   (goals
-    (forall ((c c-0 as name) (k skey) (z z-0 node))
+    (forall ((c c-0 as name) (k skey) (z z-0 strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
-          (p "client" "as" z as) (p "client" "k" z k) (p "auth" 1 z-0)
+        (and (p "client" z 2) (p "client" "c" z c)
+          (p "client" "as" z as) (p "client" "k" z k) (p "auth" z-0 2)
           (p "auth" "k" z-0 k) (p "auth" "c" z-0 c-0) (non (privk as))
-          (non (privk c))) (exists ((z-1 node)) (p "client" 1 z-1)))))
+          (non (privk c))) (exists ((z-1 strd)) (p "client" z-1 2)))))
   (label 16)
   (unrealized (1 1))
   (preskeleton)
@@ -1479,12 +1479,12 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2-0 n1-0 k ak)
   (goals
-    (forall ((c c-0 as name) (k skey) (z z-0 node))
+    (forall ((c c-0 as name) (k skey) (z z-0 strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
-          (p "client" "as" z as) (p "client" "k" z k) (p "auth" 1 z-0)
+        (and (p "client" z 2) (p "client" "c" z c)
+          (p "client" "as" z as) (p "client" "k" z k) (p "auth" z-0 2)
           (p "auth" "k" z-0 k) (p "auth" "c" z-0 c-0) (non (privk as))
-          (non (privk c))) (exists ((z-1 node)) (p "client" 1 z-1)))))
+          (non (privk c))) (exists ((z-1 strd)) (p "client" z-1 2)))))
   (label 17)
   (parent 16)
   (unrealized (1 1))
@@ -1970,12 +1970,12 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2-0 n1-0 k ak)
   (goals
-    (forall ((c c-0 as name) (k skey) (z z-0 node))
+    (forall ((c c-0 as name) (k skey) (z z-0 strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
-          (p "client" "as" z as) (p "client" "k" z k) (p "auth" 1 z-0)
+        (and (p "client" z 2) (p "client" "c" z c)
+          (p "client" "as" z as) (p "client" "k" z k) (p "auth" z-0 2)
           (p "auth" "k" z-0 k) (p "auth" "c" z-0 c-0) (non (privk as))
-          (non (privk c))) (exists ((z-1 node)) (p "client" 1 z-1)))))
+          (non (privk c))) (exists ((z-1 strd)) (p "client" z-1 2)))))
   (label 23)
   (unrealized (1 1))
   (preskeleton)
@@ -2039,12 +2039,12 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2-0 n1-0 k ak)
   (goals
-    (forall ((c c-0 as name) (k skey) (z z-0 node))
+    (forall ((c c-0 as name) (k skey) (z z-0 strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
-          (p "client" "as" z as) (p "client" "k" z k) (p "auth" 1 z-0)
+        (and (p "client" z 2) (p "client" "c" z c)
+          (p "client" "as" z as) (p "client" "k" z k) (p "auth" z-0 2)
           (p "auth" "k" z-0 k) (p "auth" "c" z-0 c-0) (non (privk as))
-          (non (privk c))) (exists ((z-1 node)) (p "client" 1 z-1)))))
+          (non (privk c))) (exists ((z-1 strd)) (p "client" z-1 2)))))
   (label 24)
   (parent 23)
   (unrealized (1 1))
diff --git a/doc/examples/plaindh.xhtml b/doc/examples/plaindh.xhtml
--- a/doc/examples/plaindh.xhtml
+++ b/doc/examples/plaindh.xhtml
@@ -1,5 +1,5 @@
 
-
+
 
 
  Plain diffie-hellman protocol with challenge-response
@@ -12,7 +12,7 @@
 
 
(herald "Plain diffie-hellman protocol with challenge-response"
   (algebra diffie-hellman))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from plaindh.scm")

 
 
Tree 0.

diff --git a/doc/examples/priority_test.xhtml b/doc/examples/priority_test.xhtml
--- a/doc/examples/priority_test.xhtml
+++ b/doc/examples/priority_test.xhtml
@@ -1,5 +1,5 @@
 
-
+
 
 
  Receive priority test protocol
@@ -11,7 +11,7 @@
 
 
 
(herald "Receive priority test protocol")
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from priority_test.scm")

 
 
Trees: 0 3.

diff --git a/doc/examples/station.xhtml b/doc/examples/station.xhtml
--- a/doc/examples/station.xhtml
+++ b/doc/examples/station.xhtml
@@ -1,5 +1,5 @@
 
-
+
 
 
  Station-to-station protocol
@@ -11,7 +11,7 @@
 
 
 
(herald "Station-to-station protocol" (algebra diffie-hellman))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from station.scm")

 
 
Trees: 0 10 20 23.

diff --git a/doc/examples/subsort_test.xhtml b/doc/examples/subsort_test.xhtml
--- a/doc/examples/subsort_test.xhtml
+++ b/doc/examples/subsort_test.xhtml
@@ -1,5 +1,5 @@
 
-
+
 
 
  Subsort constraint test protocol
@@ -13,7 +13,7 @@
 
(herald "Subsort constraint test protocol"
   (comment "First, third, and fourth skeletons should have a shape,"
     "second should be dead."))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from subsort_test.scm")

 
 
Trees: 0 2 3 5.

diff --git a/doc/examples/woolam.xhtml b/doc/examples/woolam.xhtml
--- a/doc/examples/woolam.xhtml
+++ b/doc/examples/woolam.xhtml
@@ -1,5 +1,5 @@
 
-
+
 
 
  Woo-Lam Protocol
@@ -11,7 +11,7 @@
 
 
 
(herald "Woo-Lam Protocol")
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from woolam.scm")

 
 
Tree 0.

diff --git a/doc/examples/yahalom.xhtml b/doc/examples/yahalom.xhtml
--- a/doc/examples/yahalom.xhtml
+++ b/doc/examples/yahalom.xhtml
@@ -1,5 +1,5 @@
 
-
+
 
 
  Yahalom Protocol with Forwarding Removed
@@ -12,7 +12,7 @@
 
 
(herald "Yahalom Protocol with Forwarding Removed"
   (algebra diffie-hellman) (bound 12))
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from yahalom.scm")

 
 
Trees: 0 52.

diff --git a/src/CPSA/Basic/Algebra.hs b/src/CPSA/Basic/Algebra.hs
--- a/src/CPSA/Basic/Algebra.hs
+++ b/src/CPSA/Basic/Algebra.hs
@@ -127,8 +127,8 @@
     = I !Id
     | C !String                 -- Tag constants
     | F !Symbol ![Term]
-    | D !Id                     -- Node variable
-    | P (Int, Int)              -- Node constant
+    | D !Id                     -- Strand variable
+    | Z Int                     -- Strand constant
       deriving (Show, Eq, Ord)
 
 -- In this algebra (F Invk [F Invk [t]]) == t is an axiom
@@ -148,9 +148,9 @@
 isVar _ = False
 
 -- Note that isVar of (D _) is false.
-isNodeVar :: Term -> Bool
-isNodeVar (D _) = True
-isNodeVar _ = False
+isStrdVar :: Term -> Bool
+isStrdVar (D _) = True
+isStrdVar _ = False
 
 subNums :: Term -> Set Term
 subNums _ = S.empty
@@ -290,7 +290,7 @@
 isAtom (F s _) =
     s == Text || s == Data || s == Name || s == Skey || s == Akey || s == Tag
 isAtom (D _) = False
-isAtom (P _) = False
+isAtom (Z _) = False
 
 -- Is the term numeric?
 isNum :: Term -> Bool
@@ -334,8 +334,8 @@
     foldVars f (foldVars f acc t0) t1
 foldVars f acc (F Hash [t]) =             -- Hashing
     foldVars f acc t
-foldVars f acc t@(D _) = f acc t          -- Node variable
-foldVars _ acc (P _) = acc                -- Node constant
+foldVars f acc t@(D _) = f acc t          -- Strand variable
+foldVars _ acc (Z _) = acc                -- Strand constant
 foldVars _ _ t = C.assertError $ "Algebra.foldVars: Bad term " ++ show t
 
 -- Fold f through a term applying it to each term that is carried by the term.
@@ -420,8 +420,8 @@
 inv t@(F _ _) = t
 inv (I _) = error "Algebra.inv: Cannot invert a variable of sort mesg"
 inv (C _) = error "Algebra.inv: Cannot invert a tag constant"
-inv (D _) = error "Algebra.inv: Cannot invert a variable of sort node"
-inv (P _) = error "Algebra.inv: Cannot invert a node constant"
+inv (D _) = error "Algebra.inv: Cannot invert a variable of sort strd"
+inv (Z _) = error "Algebra.inv: Cannot invert a strand constant"
 
 -- Extracts every encryption that is carried by a term along with its
 -- encryption key.  Note that a hash is treated as a kind of
@@ -486,7 +486,7 @@
     isAcquiredVar = isAcquiredVar
     isObtainedVar = isObtainedVar
     isAtom = isAtom
-    isNodeVar = isNodeVar
+    isStrdVar = isStrdVar
     termsWellFormed = termsWellFormed
     occursIn = occursIn
     foldVars = foldVars
@@ -610,7 +610,7 @@
                   Nothing ->
                       let (gen', y) = cloneId gen x in
                       ((x, y) : alist, gen', D y)
-            P p -> (alist, gen, P p)
+            Z p -> (alist, gen, Z p)
       cloneTermList (alist, gen, u) t =
           let (alist', gen', t') = cloneTerm (alist, gen) t in
           (alist', gen', t' : u)
@@ -653,8 +653,17 @@
     F s (map (idSubst subst) u)
 idSubst subst (D x) =
     M.findWithDefault (D x) x subst
-idSubst _ t@(P _) = t
+idSubst _ t@(Z _) = t
 
+-- Is every variable in a term a key in the map?
+idMapped :: IdMap -> Term -> Bool
+idMapped subst (I x) = M.member x subst
+idMapped _ (C _) = True
+idMapped subst (F _ u) =
+    all (idMapped subst) u
+idMapped subst (D x) = M.member x subst
+idMapped _ (Z _) = True
+
 -- Unification and substitution
 
 newtype Subst = Subst IdMap deriving (Eq, Ord, Show)
@@ -720,7 +729,7 @@
 occurs _ (C _) = False
 occurs x (F _ u) = any (occurs x) u
 occurs x (D y) = x == y
-occurs _ (P _) = False
+occurs _ (Z _) = False
 
 unifyChase :: Term -> Term -> Subst -> Maybe Subst
 unifyChase t t' s = unifyTerms (chase s t) (chase s t') s
@@ -750,10 +759,10 @@
 unifyTerms (D x) (D y) (Subst s)
     | x == y = Just (Subst s)
     | otherwise = Just (Subst $ M.insert x (D y) s)
-unifyTerms (D x) (P p) (Subst s) =
-    Just (Subst $ M.insert x (P p) s)
+unifyTerms (D x) (Z p) (Subst s) =
+    Just (Subst $ M.insert x (Z p) s)
 unifyTerms t (D x) s = unifyTerms (D x) t s
-unifyTerms (P p) (P p') s
+unifyTerms (Z p) (Z p') s
     | p == p' = Just s
     | otherwise = Nothing
 unifyTerms _ _ _ = Nothing
@@ -793,7 +802,7 @@
       F s u ->
           F s (map (substChase subst) u)
       t@(D _) -> t
-      t@(P _) -> t
+      t@(Z _) -> t
 
 destroyer :: Term -> Maybe Subst
 destroyer _ = Nothing
@@ -826,6 +835,15 @@
 instantiate :: Env -> Term -> Term
 instantiate (Env r) t = idSubst r t
 
+-- Is every variable in t in the domain of r?
+matched :: Env -> Term -> Bool
+matched (Env r) t = idMapped r t
+
+-- Apply a substitution to the range of an environment
+substUpdate :: Env -> Subst -> Env
+substUpdate (Env r) s =
+  Env $ M.map (substitute s) r
+
 -- Matching
 
 -- The matcher has the property that when pattern P and term T match
@@ -844,7 +862,7 @@
     case M.lookup x r of
       Nothing -> Just $ Env $ M.insert x t r
       Just t' -> if t == t' then Just $ Env r else Nothing
-match (P p) (P p') r = if p == p' then Just r else Nothing
+match (Z p) (Z p') r = if p == p' then Just r else Nothing
 match _ _ _ = Nothing
 
 matchLists :: [Term] -> [Term] -> Env -> Maybe Env
@@ -887,15 +905,22 @@
           | x == y = (D x, t)
       loop (_ : domain) pair = loop domain pair
 
-nodeMatch ::  Term -> (Int, Int) -> Env -> Maybe Env
-nodeMatch t p env = match t (P p) env
+strdMatch ::  Term -> Int -> Env -> Maybe Env
+strdMatch t p env = match t (Z p) env
 
-nodeLookup :: Env -> Term -> Maybe (Int, Int)
-nodeLookup env t =
+strdLookup :: Env -> Term -> Maybe Int
+strdLookup env t =
   case instantiate env t of
-    P p -> Just p
+    Z p -> Just p
     _ -> Nothing
 
+strdUpdate :: Env -> (Int -> Int) -> Env
+strdUpdate (Env e) f =
+  Env $ M.map h e
+  where
+    h (Z z) = Z $ f z
+    h t = t
+
 instance C.Env Term Gen Subst Env where
    emptyEnv = emptyEnv
    instantiate = instantiate
@@ -903,9 +928,12 @@
        maybe [] (\e -> [(g, e)]) $ match t t' e
    substitution = substitution
    reify = reify
-   nodeMatch t t' (g, e) =
-       maybe [] (\e -> [(g, e)]) $ nodeMatch t t' e
-   nodeLookup = nodeLookup
+   substUpdate = substUpdate
+   matched = matched
+   strdMatch t t' (g, e) =
+       maybe [] (\e -> [(g, e)]) $ strdMatch t t' e
+   strdLookup = strdLookup
+   strdUpdate = strdUpdate
 
 -- Term specific loading functions
 
@@ -943,7 +971,7 @@
             "skey" -> return $ F Skey [I x]
             "akey" -> return $ F Akey [I x]
             "tag" -> return $ F Tag [I x]
-            "node" -> return (D x)
+            "strd" -> return (D x)
             _ -> fail (shows pos' "Sort " ++ sort ++ " not recognized")
 loadVar _ (x,_) = fail (shows (annotation x) "Malformed vars declaration")
 
@@ -1116,7 +1144,7 @@
 displayVar ctx (F Skey [I x]) = displaySortId "skey" ctx x
 displayVar ctx (F Akey [I x]) = displaySortId "akey" ctx x
 displayVar ctx (F Tag [I x]) = displaySortId "tag" ctx x
-displayVar ctx (D x) = displaySortId "node" ctx x
+displayVar ctx (D x) = displaySortId "strd" ctx x
 displayVar _ _ =
     C.assertError "Algebra.displayVar: term not a variable with its sort"
 
@@ -1159,7 +1187,7 @@
 displayTerm ctx (F Hash [t]) =
     L () (S () "hash" : displayList ctx t)
 displayTerm ctx (D x) = displayId ctx x
-displayTerm _ (P (z, i)) = L () [N () z, N () i]
+displayTerm _ (Z z) = N () z
 displayTerm _ t = C.assertError ("Algebra.displayTerm: Bad term " ++ show t)
 
 displayList :: Context -> Term -> [SExpr ()]
diff --git a/src/CPSA/DiffieHellman/Algebra.hs b/src/CPSA/DiffieHellman/Algebra.hs
--- a/src/CPSA/DiffieHellman/Algebra.hs
+++ b/src/CPSA/DiffieHellman/Algebra.hs
@@ -306,14 +306,14 @@
 -- Assumes isGroupVar t == True or isBasisVar t == True!
 getGroupVar :: Group -> Id
 getGroupVar x = head $ M.keys x
-                
+
 -- Create group var as a basis element if be is true
 groupVarG :: Bool -> Id -> Group
 groupVarG be x = M.singleton x (be, 1)
 
 groupVar :: Bool -> Id -> Term
 groupVar be x = G $ groupVarG be x
-                
+
 groupVarGroup :: Id -> Group
 groupVarGroup x = groupVarG False x
 
@@ -386,8 +386,8 @@
     | C !String
     | F !Symbol ![Term]
     | G !Group                  -- An exponent, an Abelian group
-    | D !Id                     -- Node variable
-    | P (Int, Int)              -- Node constant
+    | D !Id                     -- Strand variable
+    | Z Int                     -- Strand constant
       deriving Show
 
 subNums :: Term -> Set Term
@@ -443,7 +443,7 @@
 equalTerm (F s u) (F s' u') =
     s == s' && equalTermLists u u'
 equalTerm (D x) (D y) = x == y
-equalTerm (P p) (P p') = p == p'
+equalTerm (Z p) (Z p') = p == p'
 equalTerm _ _ = False
 
 {-
@@ -515,7 +515,7 @@
       EQ -> compareTermLists u u'
       o -> o
 compareTerm (D x) (D y) = compare x y
-compareTerm (P p) (P p') = compare p p'
+compareTerm (Z p) (Z p') = compare p p'
 compareTerm (I _) (C _) = LT
 compareTerm (C _) (I _) = GT
 compareTerm (I _) (F _ _) = LT
@@ -524,28 +524,28 @@
 compareTerm (G _) (I _) = GT
 compareTerm (I _) (D _) = LT
 compareTerm (D _) (I _) = GT
-compareTerm (I _) (P _) = LT
-compareTerm (P _) (I _) = GT
+compareTerm (I _) (Z _) = LT
+compareTerm (Z _) (I _) = GT
 compareTerm (C _) (F _ _) = LT
 compareTerm (F _ _) (C _) = GT
 compareTerm (C _) (G _) = LT
 compareTerm (G _) (C _) = GT
 compareTerm (C _) (D _) = LT
 compareTerm (D _) (C _) = GT
-compareTerm (C _) (P _) = LT
-compareTerm (P _) (C _) = GT
+compareTerm (C _) (Z _) = LT
+compareTerm (Z _) (C _) = GT
 compareTerm (F _ _) (G _) = LT
 compareTerm (G _) (F _ _) = GT
 compareTerm (F _ _) (D _) = LT
 compareTerm (D _) (F _ _) = GT
-compareTerm (F _ _) (P _) = LT
-compareTerm (P _) (F _ _) = GT
+compareTerm (F _ _) (Z _) = LT
+compareTerm (Z _) (F _ _) = GT
 compareTerm (G _) (D _) = LT
 compareTerm (D _) (G _) = GT
-compareTerm (G _) (P _) = LT
-compareTerm (P _) (G _) = GT
-compareTerm (D _) (P _) = LT
-compareTerm (P _) (D _) = GT
+compareTerm (G _) (Z _) = LT
+compareTerm (Z _) (G _) = GT
+compareTerm (D _) (Z _) = LT
+compareTerm (Z _) (D _) = GT
 
 compareTermLists :: [Term] -> [Term] -> Ordering
 compareTermLists [] [] = EQ
@@ -576,9 +576,9 @@
 isVar _ = False
 
 -- Note that isVar of (D _) is false.
-isNodeVar :: Term -> Bool
-isNodeVar (D _) = True
-isNodeVar _ = False
+isStrdVar :: Term -> Bool
+isStrdVar (D _) = True
+isStrdVar _ = False
 
 -- Extract the identifier from a variable
 varId :: Term -> Id
@@ -714,7 +714,7 @@
     s == Text || s == Data || s == Name || s == Skey || s == Akey || s == Tag
 isAtom (G x) = isBasisVar x
 isAtom (D _) = False
-isAtom (P _) = False
+isAtom (Z _) = False
 
 -- Is the term numeric?
 isNum :: Term -> Bool
@@ -783,9 +783,9 @@
     foldVars f (foldVars f acc t0) t1
 foldVars f acc (F Hash [t])     = -- Hashing
     foldVars f acc t
-foldVars f acc t@(D _) = f acc t          -- Node variable
+foldVars f acc t@(D _) = f acc t          -- Strand variable
+foldVars _ acc (Z _) = acc                -- Strand constant
 foldVars _ acc (C _) = acc
-foldVars _ acc (P _) = acc
 foldVars _ _ t = error $ "Algebra.foldVars: Bad term " ++ show t
 
 -- Fold f through a term applying it to each term that is carried by the term.
@@ -1055,7 +1055,7 @@
       loop acc ((F _ subts): ts) = loop acc (subts ++ ts)
       loop acc (_ : ts) = loop acc ts
 consts _ _ = []
-                 
+
 instance C.Term Term where
     derivable = derivable
     isNum = isNum
@@ -1065,7 +1065,7 @@
     subNums = subNums
     indicator = calcIndicator
     isAtom = isAtom
-    isNodeVar = isNodeVar
+    isStrdVar = isStrdVar
     termsWellFormed = termsWellFormed
     occursIn = occursIn
     foldVars = foldVars
@@ -1277,7 +1277,7 @@
                   Nothing ->
                       let (gen', y) = cloneId gen x in
                       ((x, y) : alist, gen', D y)
-            P p -> (alist, gen, P p)
+            Z p -> (alist, gen, Z p)
       cloneTermList (alist, gen, u) t =
           let (alist', gen', t') = cloneTerm (alist, gen) t in
           (alist', gen', t' : u)
@@ -1347,8 +1347,19 @@
     G $ groupSubst subst t
 idSubst subst (D x) =
     M.findWithDefault (D x) x subst
-idSubst _ t@(P _) = t
+idSubst _ t@(Z _) = t
 
+-- Is every variable in a term a key in the map?
+idMapped :: IdMap -> Term -> Bool
+idMapped subst (I x) = M.member x subst
+idMapped _ (C _) = True
+idMapped subst (F _ u) =
+    all (idMapped subst) u
+idMapped subst (G t) =
+    all (\ x -> M.member x subst) (M.keys t)
+idMapped subst (D x) = M.member x subst
+idMapped _ (Z _) = True
+
 expSubst :: IdMap -> Term -> Group -> Term
 expSubst subst t0 t1 =
     case groupSubst subst t1 of
@@ -1477,7 +1488,7 @@
     if M.null t1
        then t0
        else F Exp [t0, G t1]
-                
+
 chaseGroup :: IdMap -> Group -> Group
 chaseGroup s t =
     M.foldrWithKey f M.empty t
@@ -1492,8 +1503,7 @@
       Just (G t) -> chaseGroup s t
       Just w -> error ("Algebra.chaseGroupLookup: Bad substitution: " ++
                      show x ++ " -> " ++ show w)
-               
-                   
+
 -- Does x occur in t?
 occurs :: Id -> Term -> Bool
 occurs x (I y) = x == y
@@ -1501,7 +1511,7 @@
 occurs x (F _ u) = any (occurs x) u
 occurs x (G t) = elem x (M.keys t)
 occurs x (D y) = x == y
-occurs _ (P _) = False
+occurs _ (Z _) = False
 
 type GenSubst = (Gen, Subst)
 
@@ -1539,10 +1549,10 @@
 unifyTerms (D x) (D y) (g, Subst s)
     | x == y = [(g, Subst s)]
     | otherwise = [(g, Subst $ M.insert x (D y) s)]
-unifyTerms (D x) (P p) (g, Subst s) =
-    [(g, Subst $ M.insert x (P p) s)]
+unifyTerms (D x) (Z p) (g, Subst s) =
+    [(g, Subst $ M.insert x (Z p) s)]
 unifyTerms t (D x) s = unifyTerms (D x) t s
-unifyTerms (P p) (P p') s
+unifyTerms (Z p) (Z p') s
     | p == p' = [s]
     | otherwise = []
 unifyTerms _ _ _ = []
@@ -1648,7 +1658,7 @@
           F s (map (substChase subst) u)
       G t -> G $ chaseGroup ss t
       t@(D _) -> t
-      t@(P _) -> t
+      t@(Z _) -> t
 
 destroyer :: Term -> Maybe Subst
 destroyer t@(G m) | isVar t =
@@ -1809,6 +1819,15 @@
 instantiate :: Env -> Term -> Term
 instantiate (Env (_, r)) t = idSubst r t
 
+-- Is every variable in t in the domain of r?
+matched :: Env -> Term -> Bool
+matched (Env (_, r)) t = idMapped r t
+
+-- Apply a substitution to the range of an environment
+substUpdate :: Env -> Subst -> Env
+substUpdate (Env (x, r)) s =
+  Env (x, M.map (substitute s) r)
+
 -- Matching
 
 type GenEnv = (Gen, Env)
@@ -1859,7 +1878,7 @@
   case M.lookup x r of
     Nothing -> [(g, Env (v, M.insert x t r))]
     Just t' -> if t == t' then [(g, Env (v, r))] else []
-match (P p) (P p') r = if p == p' then [r] else []
+match (Z p) (Z p') r = if p == p' then [r] else []
 match _ _ _ = []
 
 -- On input t, outputs (b, e) such that if t is of sort base then
@@ -2366,15 +2385,22 @@
       grp _ _ map = map
 -}
 
-nodeMatch ::  Term -> (Int, Int) -> GenEnv -> [GenEnv]
-nodeMatch t p env = match t (P p) env
+strdMatch ::  Term -> Int -> GenEnv -> [GenEnv]
+strdMatch t p env = match t (Z p) env
 
-nodeLookup :: Env -> Term -> Maybe (Int, Int)
-nodeLookup env t =
-  case instantiate env t of
-    P p -> Just p
-    _ -> Nothing
+strdLookup :: Env -> Term -> Maybe Int
+strdLookup env t =
+    case instantiate env t of
+     Z p -> Just p
+     _ -> Nothing
 
+strdUpdate :: Env -> (Int -> Int) -> Env
+strdUpdate (Env (x, r)) f =
+  Env (x, M.map h r)
+  where
+    h (Z z) = Z $ f z
+    h t = t
+
 instance C.Env Term Gen Subst Env where
    emptyEnv = emptyEnv
    instantiate = instantiate
@@ -2382,8 +2408,11 @@
    match = match
    substitution = substitution
    reify = reify
-   nodeMatch = nodeMatch
-   nodeLookup = nodeLookup
+   substUpdate = substUpdate
+   matched = matched
+   strdMatch = strdMatch
+   strdLookup = strdLookup
+   strdUpdate = strdUpdate
 
 -- Term specific loading functions
 
@@ -2428,7 +2457,7 @@
   -- Legecy names
   | sort == "expr" = return $ groupVar False x
   | sort == "expn" = return $ groupVar True x
-  | sort == "node" = return $ D x
+  | sort == "strd" = return $ D x
   | otherwise = fail (shows pos "Sort " ++ sort ++ " not recognized")
 
 loadLookup :: Pos -> [Term] -> String -> Either String Term
@@ -2660,7 +2689,7 @@
 displayVar ctx t@(G x)
     | isBasisVar x = displaySortId "rndx" ctx (varId t)
     | isGroupVar x = displaySortId "expt" ctx (varId t)
-displayVar ctx (D x) = displaySortId "node" ctx x
+displayVar ctx (D x) = displaySortId "strd" ctx x
 displayVar _ _ =
     C.assertError "Algebra.displayVar: term not a variable with its sort"
 
@@ -2727,7 +2756,7 @@
 displayTerm ctx (F Hash [t]) =
     L () (S () "hash" : displayList ctx t)
 displayTerm ctx (D x) = displayId ctx x
-displayTerm _ (P (z, i)) = L () [N () z, N () i]
+displayTerm _ (Z z) = N () z
 displayTerm _ t = error ("Algebra.displayTerm: Bad term " ++ show t)
 
 displayList :: Context -> Term -> [SExpr ()]
diff --git a/src/CPSA/Lib/Algebra.hs b/src/CPSA/Lib/Algebra.hs
--- a/src/CPSA/Lib/Algebra.hs
+++ b/src/CPSA/Lib/Algebra.hs
@@ -34,8 +34,8 @@
     isAtom :: t -> Bool       -- Is the sort of this term a base sort?
 
     -- Extension for security goals, a predicate that succeeds only
-    -- when applied to node variables.
-    isNodeVar :: t -> Bool
+    -- when applied to strand variables.
+    isStrdVar :: t -> Bool
 
     -- Does a variable occur in a term?
     occursIn :: t -> t -> Bool
@@ -198,12 +198,18 @@
     -- association list.  The first argument is a list of variables
     -- that make up the domain of the environment.
     reify :: [t] -> e -> [(t, t)]
-    -- Extensions for security goals: node match.  To succeed, the
-    -- term must be a variable of sort node.
-    nodeMatch :: t -> (Int, Int) -> (g, e) -> [(g, e)]
-    -- Node lookup.  If t is a node variable and is bound to a pair in
-    -- e, then return the pair, otherwise return nothing.
-    nodeLookup :: e -> t -> Maybe (Int, Int)
+    -- Is every variable in t in the domain of r?
+    matched :: e -> t -> Bool
+    -- Extensions for security goals: strand match.  To succeed, the
+    -- term must be a variable of sort strd.
+    strdMatch :: t -> Int -> (g, e) -> [(g, e)]
+    -- Strand lookup.  If t is a strand variable and is bound to an integer in
+    -- e, then return the integer, otherwise return nothing.
+    strdLookup :: e -> t -> Maybe Int
+    -- Strand update.  Update strands in an environment.
+    strdUpdate :: e -> (Int -> Int) -> e
+    -- Apply a substitution to the range of an environment
+    substUpdate :: e -> s -> e
 
 -- Display contexts--maps from variables to their printed representation.
 
diff --git a/src/CPSA/Lib/Characteristic.hs b/src/CPSA/Lib/Characteristic.hs
--- a/src/CPSA/Lib/Characteristic.hs
+++ b/src/CPSA/Lib/Characteristic.hs
@@ -14,7 +14,6 @@
 import CPSA.Lib.Algebra
 import CPSA.Lib.Declaration
 import CPSA.Lib.Protocol
-import CPSA.Lib.Goal
 import CPSA.Lib.Strand
 
 {--
@@ -60,110 +59,67 @@
   where                         -- is is the instance formulas and
     (is, ks) = L.partition instForm as -- ks is the skeleton formulas
 
--- Instance formulas are role predicates, parameter predicates, and
--- strand prec.
+-- Instance formulas are length predicates and parameter predicates.
 instForm :: (Pos, AForm t) -> Bool
-instForm (_, RolePred _ _ _) = True
-instForm (_, ParamPred _ _ _ _) = True
-instForm (_, StrPrec _ _) = True
+instForm (_, Length _ _ _) = True
+instForm (_, Param _ _ _ _ _) = True
 instForm _ = False
 
 -- Make the instances from the instance predicates
 
 mkInsts :: (Algebra t p g s e c, Monad m) => g -> Conj t ->
-           m ([(t, Node)], g, [Instance t e])
+           m ([(t, Sid)], g, [Instance t e])
 mkInsts g as =
   do
-    nri <- nodeRoleIndex as     -- Compute index and role of each node
-    nss <- binNodes nri as      -- Collect nodes on the same strand
-    (g, insts) <- foldInsts g as nri nss -- Construct instances
-    return (nodeMap nri nss, g, insts) -- Construct node map for later use
-
-type RoleIndex t = (Role t, Int)
+    srl <- strdRoleLength as    -- Compute role-length of each strand
+    (g, insts) <- foldInsts g as srl -- Construct instances
+    let strdMap = zip (map fst srl) [0..] -- Construct strand map
+    return (strdMap, g, insts) -- Construct node map for later use
 
--- Computes a map from nodes to role-index pairs
-nodeRoleIndex :: (Eq t, Monad m) => Conj t -> m [(t, RoleIndex t)]
-nodeRoleIndex as =
+-- Computes a map from strands to roles and lengths
+strdRoleLength :: (Algebra t p g s e c, Monad m) =>
+                  Conj t -> m [(t, (Role t, Int))]
+strdRoleLength as =
   foldM f [] as
   where
-    f nri (pos, RolePred r i n) =
-      case lookup n nri of
-        Nothing -> return ((n, (r, i)) : nri)
-        Just _ -> fail (shows pos
-                        "Node occurs in more than one role predicate")
-    f nri _ = return nri
-
--- Use this lookup when lookup must succeed.
-nriLookup :: Eq t => t -> [(t, RoleIndex t)] -> RoleIndex t
-nriLookup n nri =
-  case lookup n nri of
-    Just ri -> ri
-    Nothing -> error "Characteristic.nriLookup: Bad lookup"
-
---- Use str-prec to collect the nodes on the same strand.  Check to
---- make sure the role associated with nodes is the same.
-binNodes :: (Eq t, Monad m) => [(t, RoleIndex t)] -> Conj t -> m [[t]]
-binNodes nri as =
-  foldM f (map (\(x, _) -> [x]) nri) as
-  where
-    f nss (pos, StrPrec n n')
-      | i >= i' || rname r /= rname r' =
-        fail (shows pos "Bad str-prec")
-      | otherwise = return $ merge n n' nss
-      where
-        (r, i) = nriLookup n nri
-        (r', i') = nriLookup n' nri
-    f nss _ = return nss
-
--- Merge two sets of nodes and delete the old sets
-merge :: Eq t => t -> t -> [[t]] -> [[t]]
-merge n n' nss =
-  (ns ++ ns') : L.delete ns (L.delete ns' nss)
-  where
-    ns = findl n nss
-    ns' = findl n' nss
-
--- Find a set containing node n
-findl :: Eq t => t -> [[t]] -> [t]
-findl n nss =
-  case L.find (elem n) nss of
-    Just ns -> ns
-    Nothing -> error "Characteristic.findl: cannot find a node"
+    f srl (pos, Length r z h) =
+      case lookup z srl of
+        Nothing -> return ((z, (r, h)) : srl)
+        Just (r', h')
+          | rname r' /= rname r ->
+            fail (shows pos
+                  "Strand occurs in more than one role length atom")
+          | h <= h' -> return srl -- Use original binding
+          | otherwise -> return ((z, (r, h)) : srl)
+    f srl _ = return srl
 
 -- Construct instances
-foldInsts :: (Algebra t p g s e c, Monad m) => g -> Conj t ->
-             [(t, RoleIndex t)] -> [[t]] -> m (g, [Instance t e])
-foldInsts g _ _ [] = return (g, [])
-foldInsts g as nri (ns : nss) =
+foldInsts :: (Algebra t p g s e c, Monad m) =>
+             g -> Conj t -> [(t, (Role t, Int))] ->
+             m (g, [Instance t e])
+foldInsts g _ [] = return (g, [])
+foldInsts g as ((z, (r, h)) : srs) =
   do
-    (g, inst) <- mkInst g as nri ns
-    (g, insts) <- foldInsts g as nri nss
+    (g, inst) <- mkInst g as z r h
+    (g, insts) <- foldInsts g as srs
     return (g, inst : insts)
 
 -- Construct an instance by extracting maplets from the parameter
--- predicates with nodes associated with the strand.
-mkInst :: (Algebra t p g s e c, Monad m) => g -> Conj t ->
-          [(t, RoleIndex t)] -> [t] -> m (g, Instance t e)
-mkInst _ _ _ [] = error "Characteristic.mkInst: no nodes"
-mkInst g as nri (n : ns)
-  | h < 1 || h > length (rtrace r) = -- Checked by the the loader
-    error "Character.mkInst: Bad height"
-  | otherwise =
-      do
-        (g, env) <- foldM (mkMaplet r (n : ns)) (g, emptyEnv) as
-        return (mkInstance g r env h)
-  where
-    (r, i) = nriLookup n nri
-    -- The height (1 + max index)
-    h = 1 + foldr f i ns
-    f n i = max i (snd $ nriLookup n nri)
+-- predicates associated with the strand.
+mkInst :: (Algebra t p g s e c, Monad m) =>
+          g -> Conj t -> t -> Role t -> Int -> m (g, Instance t e)
+mkInst g as z r h =
+  do
+    (g, env) <- foldM (mkMaplet r z) (g, emptyEnv) as
+    return (mkInstance g r env h)
 
 -- Add match from a maplet
-mkMaplet :: (Algebra t p g s e c, Monad m) => Role t ->
-            [t] -> (g, e) -> (Pos, AForm t) -> m (g, e)
-mkMaplet role ns env (pos, ParamPred r v n t)
-  | elem n ns =
-    if rname role == rname r then -- Ensure role match the one
+mkMaplet :: (Algebra t p g s e c, Monad m) =>
+            Role t -> t -> (g, e) ->
+            (Pos, AForm t) -> m (g, e)
+mkMaplet role z env (pos, Param r v _ z' t)
+  | z == z' =
+    if rname role == rname r then -- Ensure role matches the one
       case match v t env of       -- used to create instance
         env : _ -> return env
         [] -> fail (shows pos "Domain does not match range")
@@ -172,26 +128,18 @@
             "Role in parameter pred differs from role position pred")
 mkMaplet _ _ env _ = return env
 
--- Generate a map from node variables to node constants.
-nodeMap :: Eq t => [(t, RoleIndex t)] -> [[t]] -> [(t, Node)]
-nodeMap nri nss =
-  [ (n, (z, i)) |
-    (z, ns) <- zip [0..] nss,
-    n <- ns,
-    let (_, i) = nriLookup n nri ]
-
 -- Use this lookup when lookup must succeed, that is when loader makes
 -- the check.
-nMapLookup :: Eq t => t -> [(t, Node)] -> Node
-nMapLookup n nmap =
-  case lookup n nmap of
-    Just n -> n
+nMapLookup :: Eq t => (t, Int) -> [(t, Sid)] -> Node
+nMapLookup (z, i) nmap =
+  case lookup z nmap of
+    Just s -> (s, i)
     Nothing -> error "Characteristic.nMapLookup: Bad lookup"
 
 -- Create a skeleton given a list of instances
 
 mkSkel :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->
-          [Goal t] -> [(t, Node)] -> g -> [Instance t e] ->
+          [Goal t] -> [(t, Sid)] -> g -> [Instance t e] ->
           Conj t -> [SExpr ()] -> m (Preskel t g s e)
 mkSkel pos p goals nmap g insts as comment =
   do
@@ -201,8 +149,9 @@
     let ur = foldr mkUniq [] as
     let gr = foldr mkUgen [] as
     let decls = mkDcls nr ar ur gr
+    let fs = foldr (mkFact nmap) [] as
     let prios = []
-    let k = mkPreskel g p goals insts o [] decls comment prios Nothing []
+    let k = mkPreskel g p goals insts o [] decls fs comment prios Nothing []
     mapM_ (checkUniqAt nmap k) as
     case termsWellFormed $ (termsInDlist decls) ++ kterms k of
       False -> fail (shows pos "Terms in skeleton not well formed")
@@ -214,7 +163,7 @@
   where
     termsInDlist olist = concat $ map dterms (concatMap snd olist)
 
-mkPrec :: Eq t => [(t, (Int, Int))] ->
+mkPrec :: Eq t => [(t, Sid)] ->
           (Pos, AForm t) -> [Pair] -> [Pair]
 mkPrec nmap (_, Prec n n') o =
   (nMapLookup n nmap, nMapLookup n' nmap) : o
@@ -245,7 +194,17 @@
 mkUgen (_, UgenAt t _) ts = t : ts
 mkUgen _ ts = ts
 
-checkUniqAt :: (Algebra t p g s e c, Monad m) => [(t, Node)] ->
+mkFact :: Eq t => [(t, Sid)] -> (Pos, AForm t) -> [Fact t] -> [Fact t]
+mkFact nmap (_, AFact name fs) ts =
+  Fact name (map f fs) : ts
+  where
+    f t =
+      case lookup t nmap of
+        Just s -> FSid s
+        Nothing -> FTerm t
+mkFact _ _ ts = ts
+
+checkUniqAt :: (Algebra t p g s e c, Monad m) => [(t, Sid)] ->
                Preskel t g s e -> (Pos, AForm t) -> m ()
 checkUniqAt nmap k (pos, UniqAt t n) =
   case lookup t $ korig k of
diff --git a/src/CPSA/Lib/Cohort.hs b/src/CPSA/Lib/Cohort.hs
--- a/src/CPSA/Lib/Cohort.hs
+++ b/src/CPSA/Lib/Cohort.hs
@@ -184,9 +184,10 @@
 reduce :: Algebra t p g s e c => Mode -> Preskel t g s e ->
           [Preskel t g s e]
 reduce mode k =
-    firstJust (map (testNode mode k a) ns)
-                  (whenRealized k) -- Skeleton is realized
+    filterSame k $ concatMap simplify ks -- Apply rewrites
     where
+      ks = firstJust (map (testNode mode k a) ns)
+           (whenRealized k) -- Skeleton is realized
       triples = L.sortBy priorityOrder
                 [(s,i,p) | s <- [0..((length $ strands k)-1)],
                            i <- [0..((height $ instidx s)-1)],
@@ -203,6 +204,14 @@
         | s0 /= s1 = compareStrandOrder mode s0 s1
         | otherwise = compareNodeOrder mode (strandidx s0) i0 i1
 
+-- Filter out skeletons in ks that are isomorphic to k.
+filterSame :: Algebra t p g s e c => Preskel t g s e ->
+              [Preskel t g s e] -> [Preskel t g s e]
+filterSame k ks =
+  filter f ks
+  where
+    f k' = not $ isomorphic (gist k) (gist k')
+
 compareStrandOrder :: Mode -> Int -> Int -> Ordering
 compareStrandOrder mode s0 s1 =
   if visitOldStrandsFirst mode then (compare s0 s1)
@@ -704,16 +713,22 @@
   where
     itrace = map (evtMap $ substitute subst) (take ht (rtrace role))
 
--- Maximize a realized skeleton if possible
+-- Maximize a realized skeleton if possible.  Do not consider
+-- generalizations that fail to satisfy the rules of the skeleton's
+-- protocol.
 
 maximize :: Algebra t p g s e c => Preskel t g s e ->
             [Preskel t g s e]
 maximize k =
-    take 1 gens                 -- Return at most the first answer
+    take 1 (filter f gens)      -- Return at most the first answer
     where
       gens = do
         (k', mapping) <- generalize k -- Generalize generates candidates
         specialization k k' mapping   -- Test a candidate
+      f k =
+        case rewrite k of
+          Nothing -> True
+          _ -> False
 
 -- Test to see if realized skeleton k is a specialization of
 -- preskeleton k' using the given strand mapping.  Returns the
diff --git a/src/CPSA/Lib/Declaration.hs b/src/CPSA/Lib/Declaration.hs
--- a/src/CPSA/Lib/Declaration.hs
+++ b/src/CPSA/Lib/Declaration.hs
@@ -402,7 +402,7 @@
   where
     nsdeclsloop s [] = s
     nsdeclsloop s ((tag, ds) : rest) = nsdeclsloop (S.insert (tag, length ds) s) rest
-                                                  
+
 avoidTerms :: Algebra t p g s e c => Declarations t l -> Set t
 avoidTerms decls =
   S.unions [ns, as, uos, ugs]
diff --git a/src/CPSA/Lib/Displayer.hs b/src/CPSA/Lib/Displayer.hs
--- a/src/CPSA/Lib/Displayer.hs
+++ b/src/CPSA/Lib/Displayer.hs
@@ -28,9 +28,89 @@
 displayProt p =
     L () (S () "defprotocol" : S () (pname p) : S () (alg p) : rs)
     where
-      rs = foldl f (pcomment p) (reverse (roles p))
+      rs = foldl f (map displayRule (rules p) ++ pcomment p)
+                   (reverse (roles p))
       f rs r = displayRole r : rs
 
+displayRule :: Algebra t p g s e c => Rule t -> SExpr ()
+displayRule r =
+  L () (S () "defrule" :
+        S () (rlname r) :
+        displayGoal (rlgoal r) :
+        rlcomment r)
+
+displayGoal :: Algebra t p g s e c => Goal t -> SExpr ()
+displayGoal g =
+  L () [S () "forall",
+        L () (displayVars ctx vars),
+        displayImpl ctx g]
+  where
+    ctx = varsContext vars
+    vars = uvars g
+
+displayImpl :: Algebra t p g s e c => c -> Goal t -> SExpr ()
+displayImpl ctx g =
+  L () [S () "implies",
+        displayConj ctx (antec g),
+        displayDisj ctx (zip (evars g) (concl g)) ]
+
+displayDisj :: Algebra t p g s e c => c -> [([t], [AForm t])] -> SExpr ()
+displayDisj _ [] = L () [S () "false"]
+displayDisj ctx [conj] = displayExistential ctx conj
+displayDisj ctx disj =
+  L () (S () "or" : map (displayExistential ctx) disj)
+
+displayExistential :: Algebra t p g s e c => c -> ([t], [AForm t]) -> SExpr ()
+displayExistential ctx ([], conj) =
+  displayConj ctx conj
+displayExistential ctx (evars, conj) =
+  L () [S () "exists",
+        L () (displayVars ctx' evars),
+        displayConj ctx' conj]
+  where
+    ctx' = addToContext ctx evars
+
+displayConj :: Algebra t p g s e c => c -> [AForm t] -> SExpr ()
+displayConj _ [] = error "DisplayConj: empty conjunct"
+displayConj ctx [form] = displayForm ctx form
+displayConj ctx forms = L () (S () "and" : map (displayForm ctx) forms)
+
+displayForm :: Algebra t p g s e c => c -> AForm t -> SExpr ()
+displayForm ctx (Length r s l) =
+  L () [S () "p", Q () (rname r), displayTerm ctx  s, N () l]
+displayForm ctx (Param r p _ s t) =
+  L () [S () "p", Q () (rname r), displayParam r p,
+        displayTerm ctx s, displayTerm ctx t]
+displayForm ctx (Prec (x, i) (y, j)) =
+  L () [S () "prec", displayTerm ctx x, N () i,
+        displayTerm ctx y, N () j]
+displayForm ctx (Non t) =
+  L () [S () "non", displayTerm ctx t]
+displayForm ctx (Pnon t) =
+  L () [S () "pnon", displayTerm ctx t]
+displayForm ctx (Uniq t) =
+  L () [S () "uniq", displayTerm ctx t]
+displayForm ctx (UniqAt t (s, i)) =
+  L () [S () "uniq-at", displayTerm ctx t,
+        displayTerm ctx s, N () i]
+displayForm ctx (UgenAt t (s, i)) =
+  L () [S () "ugen-at", displayTerm ctx t,
+        displayTerm ctx s, N () i]
+displayForm ctx (Ugen t) =
+  L () [S () "ugen", displayTerm ctx t]
+displayForm ctx (AFact name fs) =
+  L () (S () "fact" : S () name : map (displayTerm ctx) fs)
+displayForm ctx (Equals t1 t2) =
+  L () [S () "=", displayTerm ctx t1, displayTerm ctx t2]
+
+displayParam :: Algebra t p g s e c => Role t -> t -> SExpr ()
+displayParam r t =
+  case displayTerm (varsContext (rvars r)) t of
+    S () var -> Q () var
+    _ -> error "displayParam: bad parameter"
+
+-- Display of Roles
+
 displayRole :: Algebra t p g s e c => Role t -> SExpr ()
 displayRole r =
     L () (S () "defrole" :
@@ -135,9 +215,10 @@
      (displayOptional "leadsto" (displayOrdering (leadsto k))
       (displayOptional "priority" (displayPriorities (kpriorities k))
        (displaySkelDeclarations ctx (decls k)
-        (kcomment k ++
-         (displayOperation k ctx
-          (displayOptional "traces" traces rest))))))
+        (displayOptional "facts" (map (displayFact ctx) (kfacts k))
+         (kcomment k ++
+          (displayOperation k ctx
+           (displayOptional "traces" traces rest)))))))
   where
     traces = map (L () . displayTrace ctx . trace) (insts k)
 
@@ -302,6 +383,14 @@
     where
       ns = dlocs dinst
 
+displayFact :: Algebra t p g s e c => c -> Fact t -> SExpr ()
+displayFact ctx (Fact name fs) =
+  L () (S () name : map (displayFterm ctx) fs)
+
+displayFterm :: Algebra t p g s e c => c -> FTerm t -> SExpr ()
+displayFterm _ (FSid s) = N () s
+displayFterm ctx (FTerm t) = displayTerm ctx t
+
 displayInst :: Algebra t p g s e c => c ->
                Instance t e -> SExpr ()
 displayInst ctx s =
@@ -396,7 +485,7 @@
           [S () "weakened", L () [displayNode n0, displayNode n1] ]
       displayMethod ctx (Separated t) =
           [S () "separated", displayOpTerm ctx t]
-      displayMethod ctx (Forgot decls) = 
+      displayMethod ctx (Forgot decls) =
           [S () "forgot", L () (displaySkelDeclarations ctx decls [])]
 
 -- Terms in the operation field may contain variables not in the skeleton
diff --git a/src/CPSA/Lib/Goal.hs b/src/CPSA/Lib/Goal.hs
deleted file mode 100644
--- a/src/CPSA/Lib/Goal.hs
+++ /dev/null
@@ -1,155 +0,0 @@
--- Security Goals
-
--- Copyright (c) 2015 The MITRE Corporation
---
--- This program is free software: you can redistribute it and/or
--- modify it under the terms of the BSD License as published by the
--- University of California.
-
-module CPSA.Lib.Goal where
-
-import CPSA.Lib.Protocol
-
--- Syntax for the atomic formulas
-data AForm t
-  = RolePred (Role t) Int t
-  | ParamPred (Role t) t t t
-  | StrPrec t t
-  | Prec t t
-  | Non t
-  | Pnon t
-  | Uniq t
-  | UniqAt t t
-  | UgenAt t t
-  | Ugen t
-  | Equals t t
-  deriving Show
-
-data Goal t
-  = Goal { uvars :: [t],          -- Universally quantified variables
-           antec :: [AForm t],    -- Antecedent
-           concl :: [[AForm t]] } -- Conclusion
-
--- Ordering used to sort by constructor order.
-aFormOrder :: AForm t -> AForm t -> Ordering
-aFormOrder (RolePred _ _ _) (RolePred _ _ _) = EQ
-aFormOrder (RolePred _ _ _) (ParamPred _ _ _ _) = LT
-aFormOrder (RolePred _ _ _) (StrPrec _ _) = LT
-aFormOrder (RolePred _ _ _) (Prec _ _) = LT
-aFormOrder (RolePred _ _ _) (Non _) = LT
-aFormOrder (RolePred _ _ _) (Pnon _) = LT
-aFormOrder (RolePred _ _ _) (Uniq _) = LT
-aFormOrder (RolePred _ _ _) (UniqAt _ _) = LT
-aFormOrder (RolePred _ _ _) (UgenAt _ _) = LT
-aFormOrder (RolePred _ _ _) (Ugen _) = LT
-aFormOrder (RolePred _ _ _) (Equals _ _) = LT
-aFormOrder (ParamPred _ _ _ _) (RolePred _ _ _) = GT
-aFormOrder (ParamPred _ _ _ _) (ParamPred _ _ _ _) = EQ
-aFormOrder (ParamPred _ _ _ _) (StrPrec _ _) = LT
-aFormOrder (ParamPred _ _ _ _) (Prec _ _) = LT
-aFormOrder (ParamPred _ _ _ _) (Non _) = LT
-aFormOrder (ParamPred _ _ _ _) (Pnon _) = LT
-aFormOrder (ParamPred _ _ _ _) (Uniq _) = LT
-aFormOrder (ParamPred _ _ _ _) (UniqAt _ _) = LT
-aFormOrder (ParamPred _ _ _ _) (UgenAt _ _) = LT
-aFormOrder (ParamPred _ _ _ _) (Ugen _) = LT
-aFormOrder (ParamPred _ _ _ _) (Equals _ _) = LT
-aFormOrder (StrPrec _ _) (RolePred _ _ _) = GT
-aFormOrder (StrPrec _ _) (ParamPred _ _ _ _) = GT
-aFormOrder (StrPrec _ _) (StrPrec _ _) = EQ
-aFormOrder (StrPrec _ _) (Prec _ _) = LT
-aFormOrder (StrPrec _ _) (Non _) = LT
-aFormOrder (StrPrec _ _) (Pnon _) = LT
-aFormOrder (StrPrec _ _) (Uniq _) = LT
-aFormOrder (StrPrec _ _) (UniqAt _ _) = LT
-aFormOrder (StrPrec _ _) (UgenAt _ _) = LT
-aFormOrder (StrPrec _ _) (Ugen _) = LT
-aFormOrder (StrPrec _ _) (Equals _ _) = LT
-aFormOrder (Prec _ _) (RolePred _ _ _) = GT
-aFormOrder (Prec _ _) (ParamPred _ _ _ _) = GT
-aFormOrder (Prec _ _) (StrPrec _ _) = GT
-aFormOrder (Prec _ _) (Prec _ _) = EQ
-aFormOrder (Prec _ _) (Non _) = LT
-aFormOrder (Prec _ _) (Pnon _) = LT
-aFormOrder (Prec _ _) (Uniq _) = LT
-aFormOrder (Prec _ _) (UniqAt _ _) = LT
-aFormOrder (Prec _ _) (UgenAt _ _) = LT
-aFormOrder (Prec _ _) (Ugen _) = LT
-aFormOrder (Prec _ _) (Equals _ _) = LT
-aFormOrder (Non _) (RolePred _ _ _) = GT
-aFormOrder (Non _) (ParamPred _ _ _ _) = GT
-aFormOrder (Non _) (StrPrec _ _) = GT
-aFormOrder (Non _) (Prec _ _) = GT
-aFormOrder (Non _) (Non _) = EQ
-aFormOrder (Non _) (Pnon _) = LT
-aFormOrder (Non _) (Uniq _) = LT
-aFormOrder (Non _) (UniqAt _ _) = LT
-aFormOrder (Non _) (UgenAt _ _) = LT
-aFormOrder (Non _) (Ugen _) = LT
-aFormOrder (Non _) (Equals _ _) = LT
-aFormOrder (Pnon _) (RolePred _ _ _) = GT
-aFormOrder (Pnon _) (ParamPred _ _ _ _) = GT
-aFormOrder (Pnon _) (StrPrec _ _) = GT
-aFormOrder (Pnon _) (Prec _ _) = GT
-aFormOrder (Pnon _) (Non _) = GT
-aFormOrder (Pnon _) (Pnon _) = EQ
-aFormOrder (Pnon _) (Uniq _) = LT
-aFormOrder (Pnon _) (UniqAt _ _) = LT
-aFormOrder (Pnon _) (UgenAt _ _) = LT
-aFormOrder (Pnon _) (Ugen _) = LT
-aFormOrder (Pnon _) (Equals _ _) = LT
-aFormOrder (Uniq _) (RolePred _ _ _) = GT
-aFormOrder (Uniq _) (ParamPred _ _ _ _) = GT
-aFormOrder (Uniq _) (StrPrec _ _) = GT
-aFormOrder (Uniq _) (Prec _ _) = GT
-aFormOrder (Uniq _) (Non _) = GT
-aFormOrder (Uniq _) (Pnon _) = GT
-aFormOrder (Uniq _) (Uniq _) = EQ
-aFormOrder (Uniq _) (UniqAt _ _) = LT
-aFormOrder (Uniq _) (UgenAt _ _) = LT
-aFormOrder (Uniq _) (Ugen _) = LT
-aFormOrder (Uniq _) (Equals _ _) = LT
-aFormOrder (UniqAt _ _) (RolePred _ _ _) = GT
-aFormOrder (UniqAt _ _) (ParamPred _ _ _ _) = GT
-aFormOrder (UniqAt _ _) (StrPrec _ _) = GT
-aFormOrder (UniqAt _ _) (Prec _ _) = GT
-aFormOrder (UniqAt _ _) (Non _) = GT
-aFormOrder (UniqAt _ _) (Pnon _) = GT
-aFormOrder (UniqAt _ _) (Uniq _) = GT
-aFormOrder (UniqAt _ _) (UniqAt _ _) = EQ
-aFormOrder (UniqAt _ _) (UgenAt _ _) = LT
-aFormOrder (UniqAt _ _) (Ugen _) = LT
-aFormOrder (UniqAt _ _) (Equals _ _) = LT
-aFormOrder (UgenAt _ _) (RolePred _ _ _) = GT
-aFormOrder (UgenAt _ _) (ParamPred _ _ _ _) = GT
-aFormOrder (UgenAt _ _) (StrPrec _ _) = GT
-aFormOrder (UgenAt _ _) (Prec _ _) = GT
-aFormOrder (UgenAt _ _) (Non _) = GT
-aFormOrder (UgenAt _ _) (Pnon _) = GT
-aFormOrder (UgenAt _ _) (Uniq _) = GT
-aFormOrder (UgenAt _ _) (UniqAt _ _) = GT
-aFormOrder (UgenAt _ _) (UgenAt _ _) = EQ
-aFormOrder (UgenAt _ _) (Ugen _) = LT
-aFormOrder (UgenAt _ _) (Equals _ _) = LT
-aFormOrder (Ugen _) (RolePred _ _ _) = GT
-aFormOrder (Ugen _) (ParamPred _ _ _ _) = GT
-aFormOrder (Ugen _) (StrPrec _ _) = GT
-aFormOrder (Ugen _) (Prec _ _) = GT
-aFormOrder (Ugen _) (Non _) = GT
-aFormOrder (Ugen _) (Pnon _) = GT
-aFormOrder (Ugen _) (Uniq _) = GT
-aFormOrder (Ugen _) (UniqAt _ _) = GT
-aFormOrder (Ugen _) (UgenAt _ _) = GT
-aFormOrder (Ugen _) (Ugen _) = EQ
-aFormOrder (Ugen _) (Equals _ _) = LT
-aFormOrder (Equals _ _) (RolePred _ _ _) = GT
-aFormOrder (Equals _ _) (ParamPred _ _ _ _) = GT
-aFormOrder (Equals _ _) (StrPrec _ _) = GT
-aFormOrder (Equals _ _) (Prec _ _) = GT
-aFormOrder (Equals _ _) (Non _) = GT
-aFormOrder (Equals _ _) (Pnon _) = GT
-aFormOrder (Equals _ _) (Uniq _) = GT
-aFormOrder (Equals _ _) (UniqAt _ _) = GT
-aFormOrder (Equals _ _) (UgenAt _ _) = GT
-aFormOrder (Equals _ _) (Ugen _) = GT
-aFormOrder (Equals _ _) (Equals _ _) = EQ
diff --git a/src/CPSA/Lib/Loader.hs b/src/CPSA/Lib/Loader.hs
--- a/src/CPSA/Lib/Loader.hs
+++ b/src/CPSA/Lib/Loader.hs
@@ -17,7 +17,6 @@
 import CPSA.Lib.Declaration
 import CPSA.Lib.State
 import CPSA.Lib.Protocol
-import CPSA.Lib.Goal
 import CPSA.Lib.Strand
 import CPSA.Lib.Characteristic
 
@@ -66,10 +65,13 @@
         fail (shows pos $ "Expecting terms in algebra " ++ nom)
     | otherwise =
         do
-          (gen, rs, comment) <- loadRoles origin (x : xs)
-          -- Check for duplicate role names
+          (gen, rs, rest) <- loadRoles origin (x : xs)
           (gen, r) <- mkListenerRole pos gen
-          validate (mkProt name alg gen rs r comment) rs
+          -- Fake protocol is used only for loading rules
+          let fakeProt = mkProt name alg gen rs r [] []
+          (gen, rules, comment) <- loadRules fakeProt gen rest
+          -- Check for duplicate role names
+          validate (mkProt name alg gen rs r rules comment) rs
     where
       validate prot [] = return prot
       validate prot (r : rs) =
@@ -82,16 +84,14 @@
 loadProt _ _ pos _ = fail (shows pos "Malformed protocol")
 
 loadRoles :: (Algebra t p g s e c, Monad m) => g -> [SExpr Pos] ->
-             m (g, [Role t], [SExpr ()])
+             m (g, [Role t], [SExpr Pos])
 loadRoles gen (L pos (S _ "defrole" : x) : xs) =
     do
       (gen, r) <- loadRole gen pos x
       (gen, rs, comment) <- loadRoles gen xs
       return (gen, r : rs, comment)
 loadRoles gen xs =
-    do
-      comment <- alist [] xs    -- Ensure remaining is an alist
-      return (gen, [], comment)
+  return (gen, [], xs)
 
 loadRole :: (Algebra t p g s e c, Monad m) => g -> Pos ->
             [SExpr Pos] -> m (g, Role t)
@@ -346,6 +346,31 @@
       [x] -> return (g, mkRole "" [x] [In x, Out x] [] [] [] False)
       _ -> fail "Loader.mkListenerRole: Expection one variable"
 
+-- Protocol Rules
+
+loadRules :: (Algebra t p g s e c, Monad m) => Prot t g -> g ->
+             [SExpr Pos] -> m (g, [Rule t], [SExpr ()])
+loadRules prot g (L pos (S _ "defrule" : x) : xs) =
+    do
+      (g, r) <- loadRule prot g pos x
+      (g, rs, comment) <- loadRules prot g xs
+      return (g, r : rs, comment)
+loadRules _ g xs =
+    do
+      comment <- alist [] xs    -- Ensure remaining is an alist
+      return (g, [], comment)
+
+loadRule :: (Algebra t p g s e c, Monad m) => Prot t g -> g ->
+            Pos -> [SExpr Pos] -> m (g, Rule t)
+loadRule prot g pos (S _ name : x : xs) =
+  do
+    (g, goal, _) <- loadSentence UnusedVars pos prot g x
+    comment <- alist [] xs      -- Ensure remaining is an alist
+    return (g, Rule { rlname = name,
+                      rlgoal = goal,
+                      rlcomment = comment })
+loadRule _ _ pos _ = fail (shows pos "Malformed rule")
+
 -- Association lists
 
 -- Make an association list into a comment.  The first argument is the
@@ -545,13 +570,14 @@
       predefs <- loadAllPredefSkelDecls heights kvars xs
       priorities <- loadPriorities (assoc "priority" xs) insts'
       (gen, gs) <- loadGoals top p gen goals
-      loadRest top p gs gen insts' order leadsto
-        (predefs ++ others) kcomment priorities pov
+      loadRest top kvars p gs gen insts' order leadsto
+        (predefs ++ others) fs kcomment priorities pov
     where
       insts' = reverse insts
       heights = map (\ inst -> length $ trace inst) insts'
       order = assoc "precedes" xs
       leadsto = assoc "leadsto" xs
+      fs = assoc "facts" xs
       goals = assoc "goals" xs
       pov = assoc "pov" xs
       kcomment =
@@ -629,12 +655,13 @@
       t <- loadTerm kvars False x
       return $ mkListener p gen t
 
-loadRest :: (Algebra t p g s e c, Monad m) => Pos ->
+loadRest :: (Algebra t p g s e c, Monad m) => Pos -> [t] ->
             Prot t g -> [Goal t] -> g -> [Instance t e] ->
             [SExpr Pos] -> [SExpr Pos] -> SkelDeclList t ->
-            [SExpr ()] -> [((Int,Int),Int)] -> [SExpr Pos] ->
-            m (Preskel t g s e)
-loadRest pos p gs gen insts orderings leadsto decls comment priorities pov =
+            [SExpr Pos] -> [SExpr ()] -> [((Int,Int),Int)] ->
+            [SExpr Pos] -> m (Preskel t g s e)
+loadRest pos vars p gs gen insts orderings leadsto decls
+         fs comment priorities pov =
     do
       case null insts of
         True -> fail (shows pos "No strands")
@@ -642,9 +669,10 @@
       let heights = map height insts
       o <- loadOrderings heights orderings True
       l <- loadOrderings heights leadsto False
+      fs <- mapM (loadFact heights vars) fs
       (pov, prob) <- loadPov pos p pov
       checkProb pos (length insts) prob
-      let k = mkPreskel gen p gs insts o l decls comment priorities pov prob
+      let k = mkPreskel gen p gs insts o l decls fs comment priorities pov prob
       case termsWellFormed $ (termsInDlist decls) ++ kterms k of
         True -> return ()
         False -> fail (shows pos "Terms in skeleton not well formed:" ++ show (termsInDlist decls ++ kterms k))
@@ -783,6 +811,25 @@
           | otherwise = height xs (s - 1)
 loadNode _ x = fail (shows (annotation x) "Malformed node")
 
+loadFact :: (Algebra t p g s e c, Monad m) =>
+            [Int] -> [t] -> SExpr Pos -> m (Fact t)
+loadFact heights vars (L _ (S _ name : fs)) =
+  do
+    fs <- mapM (loadFterm heights vars) fs
+    return $ Fact name fs
+loadFact _ _ x =
+  fail (shows (annotation x) "Malformed fact")
+
+loadFterm :: (Algebra t p g s e c, Monad m) =>
+             [Int] -> [t] -> SExpr Pos -> m (FTerm t)
+loadFterm heights _ (N pos s)
+  | 0 <= s && s < length heights = return $ FSid s
+  | otherwise = fail (shows pos ("Bad strand in fact: " ++ show s))
+loadFterm _ vars x =
+  do
+    t <- loadTerm vars False x
+    return $ FTerm t
+
 loadPov :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->
            [SExpr Pos] -> m (Maybe (Preskel t g s e), [Sid])
 loadPov _ _ [] = return (Nothing, [])
@@ -821,7 +868,7 @@
       Nothing -> fail (shows pos $ "Protocol " ++ name ++ " unknown")
       Just p ->
         do
-          (g, goal, antec) <- loadSentence pos p (pgen p) x
+          (g, goal, antec) <- loadSentence RoleSpec pos p (pgen p) x
           let (gs, xs') = findAlist xs
           (g, goals) <- loadGoals pos p g gs
           _ <- alist [] xs'          -- Check syntax of xs
@@ -849,69 +896,86 @@
 loadGoals _ _ g [] = return (g, [])
 loadGoals pos prot g (x : xs) =
   do
-    (g, goal, _) <- loadSentence pos prot g x
+    (g, goal, _) <- loadSentence RoleSpec pos prot g x
     (g, goals) <- loadGoals pos prot g xs
     return (g, goal : goals)
 
+data Mode
+  = RoleSpec
+  | UnusedVars
+
 -- Load a single security goal, a universally quantified formula
 -- Returns the goal and the antecedent with position information.
 
-loadSentence :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->
-                g -> SExpr Pos -> m (g, Goal t, Conj t)
-loadSentence _ prot g (L pos [S _ "forall", L _ vs, x]) =
+loadSentence :: (Algebra t p g s e c, Monad m) => Mode -> Pos ->
+                Prot t g -> g -> SExpr Pos -> m (g, Goal t, Conj t)
+loadSentence md _ prot g (L pos [S _ "forall", L _ vs, x]) =
   do
     (g, vars) <- loadVars g vs
-    loadImplication pos prot g (L.nub vars) x
-loadSentence pos _ _ _ = fail (shows pos "Malformed goal sentence")
+    loadImplication md pos prot g (L.nub vars) x
+loadSentence _ pos _ _ _ = fail (shows pos "Malformed goal sentence")
 
 -- Load the top-level implication of a security goal
 
-loadImplication :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->
+loadImplication :: (Algebra t p g s e c, Monad m) => Mode -> Pos -> Prot t g ->
                    g -> [t] -> SExpr Pos -> m (g, Goal t, Conj t)
-loadImplication _ prot g vars (L pos [S _ "implies", a, c]) =
+loadImplication md _ prot g vars (L pos [S _ "implies", a, c]) =
   do
-    antec <- loadRoleSpecific pos prot vars vars a
-    (g, concl) <- loadConclusion pos prot g vars c
+    antec <- loadCheckedConj md pos prot vars vars a
+    (g, vc) <- loadConclusion md pos prot g vars c
+    let (evars, concl) = unzip vc
     let goal =
           Goal { uvars = vars,
                  antec = map snd antec,
+                 evars = evars,
                  concl = map (map snd) concl }
     return (g, goal, antec)
-loadImplication pos _ _ _ _ = fail (shows pos "Malformed goal implication")
+loadImplication _ pos _ _ _ _ = fail (shows pos "Malformed goal implication")
 
 -- The conclusion must be a disjunction.  Each disjunct may introduce
 -- existentially quantified variables.
 
-loadConclusion :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->
-                  g -> [t] -> SExpr Pos -> m (g, [Conj t])
-loadConclusion _ _ g _ (L _ [S _ "false"]) = return (g, [])
-loadConclusion _ prot g vars (L pos (S _ "or" : xs)) =
-  loadDisjuncts pos prot g vars xs []
-loadConclusion pos prot g vars x =
+loadConclusion :: (Algebra t p g s e c, Monad m) => Mode -> Pos -> Prot t g ->
+                  g -> [t] -> SExpr Pos -> m (g, [([t], Conj t)])
+loadConclusion _ _ _ g _ (L _ [S _ "false"]) = return (g, [])
+loadConclusion md _ prot g vars (L pos (S _ "or" : xs)) =
+  loadDisjuncts md pos prot g vars xs []
+loadConclusion md pos prot g vars x =
   do
-    (g, a) <- loadExistential pos prot g vars x
+    (g, a) <- loadExistential md pos prot g vars x
     return (g, [a])
 
-loadDisjuncts :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->
-                 g -> [t] -> [SExpr Pos] -> [Conj t] -> m (g, [Conj t])
-loadDisjuncts _ _ g _ [] rest = return (g, reverse rest)
-loadDisjuncts pos prot g vars (x : xs) rest =
+loadDisjuncts :: (Algebra t p g s e c, Monad m) => Mode -> Pos ->
+                 Prot t g -> g -> [t] -> [SExpr Pos] ->
+                 [([t], Conj t)] -> m (g, [([t], Conj t)])
+loadDisjuncts _ _ _ g _ [] rest = return (g, reverse rest)
+loadDisjuncts md pos prot g vars (x : xs) rest =
   do
-    (g, a) <- loadExistential pos prot g vars x
-    loadDisjuncts pos prot g vars xs (a : rest)
+    (g, a) <- loadExistential md pos prot g vars x
+    loadDisjuncts md pos prot g vars xs (a : rest)
 
-loadExistential :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->
-                   g -> [t] -> SExpr Pos -> m (g, Conj t)
-loadExistential _ prot g vars (L pos [S _ "exists", L _ vs, x]) =
+loadExistential :: (Algebra t p g s e c, Monad m) => Mode -> Pos -> Prot t g ->
+                   g -> [t] -> SExpr Pos -> m (g, ([t], Conj t))
+loadExistential md _ prot g vars (L pos [S _ "exists", L _ vs, x]) =
   do
     (g, evars) <- loadVars g vs
-    as <- loadRoleSpecific pos prot (evars ++ vars) evars x
-    return (g, as)
-loadExistential pos prot g vars x =
+    as <- loadCheckedConj md pos prot (evars ++ vars) evars x
+    return (g, (evars, as))
+loadExistential md pos prot g vars x =
   do
-    as <- loadRoleSpecific pos prot vars [] x
-    return (g, as)
+    as <- loadCheckedConj md pos prot vars [] x
+    return (g, ([], as))
 
+-- Load a conjunction and check the result as determined by the mode
+-- md.
+
+loadCheckedConj :: (Algebra t p g s e c, Monad m) => Mode -> Pos ->
+                   Prot t g -> [t] -> [t] -> SExpr Pos -> m (Conj t)
+loadCheckedConj RoleSpec pos prot vars unbound x =
+  loadRoleSpecific pos prot vars unbound x
+loadCheckedConj UnusedVars pos prot vars unbound x =
+  loadUsedVars pos prot vars unbound x
+
 --- Load a conjunction of atomic formulas and ensure the formula is
 --- role specific.
 
@@ -926,6 +990,20 @@
       [] -> return as'
       (v : _) -> fail (shows (annotation x) ("Malformed defgoal: " ++ showst v " not used"))
 
+-- Load a conjuction of atomic formulas and ensure that all declared
+-- variables are used.
+
+loadUsedVars :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->
+                [t] -> [t] -> SExpr Pos -> m (Conj t)
+loadUsedVars pos prot vars unbound x =
+  do
+    as <- loadConjunction pos prot vars x
+    -- Compute the free variables in the conjunction
+    let f vars (_, form) = aFreeVars vars form
+    case unbound L.\\ foldl f [] as of
+      [] -> return as
+      (v : _) -> fail (shows (annotation x) (showst v " not used"))
+
 -- Load a conjunction of atomic formulas
 
 loadConjunction :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->
@@ -953,7 +1031,7 @@
   do
     t <- loadTerm kvars False x
     t' <- loadTerm kvars False y
-    case isNodeVar t == isNodeVar t' of
+    case isStrdVar t == isStrdVar t' of
       True -> return (pos, Equals t t')
       False -> fail (shows pos "Sort mismatch in equality")
 loadPrimary _ _ kvars (L pos [S _ "non", x]) =
@@ -968,62 +1046,77 @@
   do
     t <- loadAlgTerm kvars x
     return (pos, Uniq t)
-loadPrimary _ _ kvars (L pos [S _ "uniq-at", x, y]) =
+loadPrimary _ _ kvars (L pos [S _ "uniq-at", x, y, z]) =
   do
     t <- loadAlgTerm kvars x
-    t' <- loadNodeTerm kvars y
+    t' <- loadNodeTerm kvars y z
     return (pos, UniqAt t t')
-loadPrimary _ _ kvars (L pos [S _ "ugen-at", x, y]) =
+loadPrimary _ _ kvars (L pos [S _ "ugen-at", x, y, z]) =
   do
     t <- loadAlgTerm kvars x
-    t' <- loadNodeTerm kvars y
+    t' <- loadNodeTerm kvars y z
     return (pos, UgenAt t t')
 loadPrimary _ _ kvars (L pos [S _ "ugen", x]) =
   do
     t <- loadAlgTerm kvars x
     return (pos, Ugen t)
-loadPrimary _ _ kvars (L pos [S _ "str-prec", x, y]) =
+loadPrimary _ _ kvars (L pos (S _ "fact" : S _ name : fs)) =
   do
-    t <- loadNodeTerm kvars x
-    t' <- loadNodeTerm kvars y
-    return (pos, StrPrec t t')
-loadPrimary _ _ kvars (L pos [S _ "prec", x, y]) =
+    fs <- mapM (loadTerm kvars False) fs
+    return (pos, AFact name fs)
+loadPrimary _ _ kvars (L pos [S _ "prec", w, x, y, z]) =
   do
-    t <- loadNodeTerm kvars x
-    t' <- loadNodeTerm kvars y
+    t <- loadNodeTerm kvars w x
+    t' <- loadNodeTerm kvars y z
     return (pos, Prec t t')
-loadPrimary _ p kvars (L pos [S _ "p", Q _ name, N _ i, x]) =
+loadPrimary _ p kvars (L pos [S _ "p", Q _ name, x, N _ h]) =
   do
     r <- lookupRole pos p name
-    t <- loadNodeTerm kvars x
-    case i < 0 || i >= length (rtrace r) of
+    t <- loadStrdTerm kvars x
+    case h <= 0 || h > length (rtrace r) of
       True -> fail (shows pos "Bad index")
-      False -> return (pos, RolePred r i t)
+      False -> return (pos, Length r t h)
 loadPrimary _ p kvars (L pos [S _ "p", Q _ name, Q var x, y, z]) =
   do
     r <- lookupRole pos p name
     v <- loadAlgTerm (rvars r) (S var x)
-    n <- loadNodeTerm kvars y
+    n <- loadStrdTerm kvars y
     t <- loadAlgTerm kvars z
     case isVar v of
       False -> fail (shows pos "Bad parameter -- not a variable")
-      True -> return (pos, ParamPred r v n t)
+      True ->
+        case firstOccurs v r of
+          Just i -> return (pos, Param r v (i + 1) n t)
+          Nothing ->
+            fail (shows pos ("parameter " ++ x ++ " not in role " ++ name))
 loadPrimary _ _ _ (L pos (S _ "p" : Q _ name : _)) =
   fail (shows pos ("Malformed role specific formula for role " ++ name))
 loadPrimary _ _ _ (L pos (S _ pred : _)) =
   fail (shows pos ("Malformed formula for predicate " ++ pred))
 loadPrimary pos _ _ _ = fail (shows pos "Bad formula")
 
--- Load a term and make sure it has sort node
+-- Load a term and make sure it has sort strd
 
-loadNodeTerm :: (Algebra t p g s e c, Monad m) => [t] -> SExpr Pos -> m t
-loadNodeTerm ts x =
+loadStrdTerm :: (Algebra t p g s e c, Monad m) =>
+                [t] -> SExpr Pos -> m t
+loadStrdTerm ts x =
   do
     t <- loadTerm ts False x
-    case isNodeVar t of
+    case isStrdVar t of
       True -> return t
-      False -> fail (shows (annotation x) "Expecting a node variable")
+      False -> fail (shows (annotation x) "Expecting a strand variable")
 
+-- Load a term and make sure it describes a node
+
+loadNodeTerm :: (Algebra t p g s e c, Monad m) =>
+                [t] -> SExpr Pos -> SExpr Pos -> m (NodeTerm t)
+loadNodeTerm ts x (N _ i) | i >= 0 =
+  do
+    t <- loadStrdTerm ts x
+    return (t, i)
+loadNodeTerm _ _ y =
+  fail (shows (annotation y) "Expecting an integer")
+
 -- Load a term and make sure it does not have sort node
 
 loadAlgTerm :: (Algebra t p g s e c, Monad m) => [t] -> SExpr Pos -> m t
@@ -1032,7 +1125,7 @@
 loadAlgTerm ts x =
   do
     t <- loadTerm ts False x
-    case isNodeVar t of
+    case isStrdVar t of
       True -> fail (shows (annotation x) "Expecting an algebra term")
       False -> return t
 
@@ -1049,16 +1142,13 @@
 
 roleSpecific :: (Algebra t p g s e c, Monad m) =>
                 [t] -> (Pos, AForm t) -> m [t]
-roleSpecific unbound (_, RolePred _ _ n) =
-  return $ L.delete n unbound
-roleSpecific unbound (pos, ParamPred _ _ n t)
-  | L.notElem n unbound = return $ unbound L.\\ termVars t
+roleSpecific unbound (_, Length _ z _) =
+  return $ L.delete z unbound
+roleSpecific unbound (pos, Param _ _ _ z t)
+  | L.notElem z unbound = return $ unbound L.\\ termVars t
   | otherwise = fail (shows pos "Unbound variable in parameter predicate")
-roleSpecific unbound (pos, StrPrec n n')
-  | L.notElem n unbound && L.notElem n' unbound = return unbound
-  | otherwise = fail (shows pos "Unbound variable in str-prec")
-roleSpecific unbound (pos, Prec n n')
-  | L.notElem n unbound && L.notElem n' unbound = return unbound
+roleSpecific unbound (pos, Prec (z, _) (z', _))
+  | L.notElem z unbound && L.notElem z' unbound = return unbound
   | otherwise = fail (shows pos "Unbound variable in prec")
 roleSpecific unbound (pos, Non t)
   | allBound unbound t = return unbound
@@ -1069,21 +1159,24 @@
 roleSpecific unbound (pos, Uniq t)
   | allBound unbound t = return unbound
   | otherwise = fail (shows pos "Unbound variable in uniq")
-roleSpecific unbound (pos, UniqAt t n)
-  | allBound unbound t && L.notElem n unbound = return unbound
+roleSpecific unbound (pos, UniqAt t (z, _))
+  | allBound unbound t && L.notElem z unbound = return unbound
   | otherwise = fail (shows pos "Unbound variable in uniq-at")
-roleSpecific unbound (pos, UgenAt t n)
-  | allBound unbound t && L.notElem n unbound = return unbound
+roleSpecific unbound (pos, UgenAt t (z, _))
+  | allBound unbound t && L.notElem z unbound = return unbound
   | otherwise = fail (shows pos "Unbound variable in ugen-at")
 roleSpecific unbound (pos, Ugen t)
   | allBound unbound t = return unbound
   | otherwise = fail (shows pos "Unbound variable in ugen")
+roleSpecific unbound (pos, AFact _ fs)
+  | all (allBound unbound) fs = return unbound
+  | otherwise = fail (shows pos "Unbound variable in fact")
 roleSpecific unbound (pos, Equals t t')
-  | isNodeVar t && isNodeVar t' =
+  | isStrdVar t && isStrdVar t' =
     case L.notElem t unbound && L.notElem t' unbound of
       True -> return unbound
       False -> fail (shows pos "Unbound variable in equals")
-  | isNodeVar t = fail (shows pos "Type mismatch in equals")
-  | isNodeVar t' = fail (shows pos "Type mismatch in equals")
+  | isStrdVar t = fail (shows pos "Type mismatch in equals")
+  | isStrdVar t' = fail (shows pos "Type mismatch in equals")
   | allBound unbound t && allBound unbound t' = return unbound
   | otherwise = fail (shows pos "Unbound variable in equals")
diff --git a/src/CPSA/Lib/Protocol.hs b/src/CPSA/Lib/Protocol.hs
--- a/src/CPSA/Lib/Protocol.hs
+++ b/src/CPSA/Lib/Protocol.hs
@@ -8,12 +8,14 @@
 
 module CPSA.Lib.Protocol (Event (..), evtTerms, evtMesgTerms, evtMap, evt,
     recvTerm, Trace, stripSync, tterms, originates,
-    originationPos, gainedPos, genGainedPos, 
+    originationPos, gainedPos, genGainedPos, firstOccurs,
     Role, rname, rvars, rtrace, rdecls, rcomment, rsearch, generationPos,
     ridecls, mkRole, roleWellFormed,
     RoleDeclInst, RoleDeclInstList, RoleDeclaration, RoleDeclList,
     RoleDeclarations, rpriority, defaultPriority,
-    Prot, mkProt, pname, alg, pgen, roles, listenerRole,
+    AForm (..), NodeTerm, Goal (..),
+    aFormOrder, aFreeVars, Rule (..),
+    Prot, mkProt, pname, alg, pgen, roles, rules, listenerRole,
     varsAllAtoms, pcomment) where
 
 import qualified Data.List as L
@@ -221,6 +223,20 @@
 defaultPriority :: Int
 defaultPriority = 5
 
+firstOccurs :: Algebra t p g s e c => t -> Role t -> Maybe Int
+firstOccurs v r = firstOccursAt v (rtrace r)
+
+-- | Compute the index of the first event at which the given variable
+-- occurs in a trace.
+firstOccursAt :: Algebra t p g s e c => t -> Trace t -> Maybe Int
+firstOccursAt t c =
+    loop 0 c
+    where
+      loop _ [] = Nothing
+      loop i (e : c)
+          | any (occursIn t) (evtTerms e) = Just i
+          | otherwise = loop (i + 1) c
+
 -- The empty role name is used with listener strands.  All roles in a
 -- protocol must have a name with more than one character.
 
@@ -372,24 +388,194 @@
 notListenerPrefix (In t : Out t' : _) | t == t' = False
 notListenerPrefix _ = True
 
+-- Security Goals
+
+-- Syntax for the atomic formulas
+data AForm t
+  = Length (Role t) t Int
+  | Param (Role t) t Int t t   -- role param first-height strand value
+  | Prec (NodeTerm t) (NodeTerm t)
+  | Non t
+  | Pnon t
+  | Uniq t
+  | UniqAt t (NodeTerm t)
+  | UgenAt t (NodeTerm t)
+  | Ugen t
+  | AFact String [t]
+  | Equals t t
+  deriving Show
+
+type NodeTerm t = (t, Int)
+
+data Goal t
+  = Goal { uvars :: [t],          -- Universally quantified variables
+           antec :: [AForm t],    -- Antecedent
+           evars :: [[t]],        -- Existentially quantified variables
+           concl :: [[AForm t]] } -- Conclusion
+  deriving Show
+
+-- Ordering used to sort by constructor order.
+aFormOrder :: AForm t -> AForm t -> Ordering
+aFormOrder (Length _ _ _) (Length _ _ _) = EQ
+aFormOrder (Length _ _ _) (Param _ _ _ _ _) = LT
+aFormOrder (Length _ _ _) (Prec _ _) = LT
+aFormOrder (Length _ _ _) (Non _) = LT
+aFormOrder (Length _ _ _) (Pnon _) = LT
+aFormOrder (Length _ _ _) (Uniq _) = LT
+aFormOrder (Length _ _ _) (UniqAt _ _) = LT
+aFormOrder (Length _ _ _) (UgenAt _ _) = LT
+aFormOrder (Length _ _ _) (Ugen _) = LT
+aFormOrder (Length _ _ _) (AFact _ _) = LT
+aFormOrder (Length _ _ _) (Equals _ _) = LT
+aFormOrder (Param _ _ _ _ _) (Length _ _ _) = GT
+aFormOrder (Param _ _ _ _ _) (Param _ _ _ _ _) = EQ
+aFormOrder (Param _ _ _ _ _) (Prec _ _) = LT
+aFormOrder (Param _ _ _ _ _) (Non _) = LT
+aFormOrder (Param _ _ _ _ _) (Pnon _) = LT
+aFormOrder (Param _ _ _ _ _) (Uniq _) = LT
+aFormOrder (Param _ _ _ _ _) (UniqAt _ _) = LT
+aFormOrder (Param _ _ _ _ _) (UgenAt _ _) = LT
+aFormOrder (Param _ _ _ _ _) (Ugen _) = LT
+aFormOrder (Param _ _ _ _ _) (AFact _ _) = LT
+aFormOrder (Param _ _ _ _ _) (Equals _ _) = LT
+aFormOrder (Prec _ _) (Length _ _ _) = GT
+aFormOrder (Prec _ _) (Param _ _ _ _ _) = GT
+aFormOrder (Prec _ _) (Prec _ _) = EQ
+aFormOrder (Prec _ _) (Non _) = LT
+aFormOrder (Prec _ _) (Pnon _) = LT
+aFormOrder (Prec _ _) (Uniq _) = LT
+aFormOrder (Prec _ _) (UniqAt _ _) = LT
+aFormOrder (Prec _ _) (UgenAt _ _) = LT
+aFormOrder (Prec _ _) (Ugen _) = LT
+aFormOrder (Prec _ _) (AFact _ _) = LT
+aFormOrder (Prec _ _) (Equals _ _) = LT
+aFormOrder (Non _) (Length _ _ _) = GT
+aFormOrder (Non _) (Param _ _ _ _ _) = GT
+aFormOrder (Non _) (Prec _ _) = GT
+aFormOrder (Non _) (Non _) = EQ
+aFormOrder (Non _) (Pnon _) = LT
+aFormOrder (Non _) (Uniq _) = LT
+aFormOrder (Non _) (UniqAt _ _) = LT
+aFormOrder (Non _) (UgenAt _ _) = LT
+aFormOrder (Non _) (Ugen _) = LT
+aFormOrder (Non _) (AFact _ _) = LT
+aFormOrder (Non _) (Equals _ _) = LT
+aFormOrder (Pnon _) (Length _ _ _) = GT
+aFormOrder (Pnon _) (Param _ _ _ _ _) = GT
+aFormOrder (Pnon _) (Prec _ _) = GT
+aFormOrder (Pnon _) (Non _) = GT
+aFormOrder (Pnon _) (Pnon _) = EQ
+aFormOrder (Pnon _) (Uniq _) = LT
+aFormOrder (Pnon _) (UniqAt _ _) = LT
+aFormOrder (Pnon _) (UgenAt _ _) = LT
+aFormOrder (Pnon _) (Ugen _) = LT
+aFormOrder (Pnon _) (AFact _ _) = LT
+aFormOrder (Pnon _) (Equals _ _) = LT
+aFormOrder (Uniq _) (Length _ _ _) = GT
+aFormOrder (Uniq _) (Param _ _ _ _ _) = GT
+aFormOrder (Uniq _) (Prec _ _) = GT
+aFormOrder (Uniq _) (Non _) = GT
+aFormOrder (Uniq _) (Pnon _) = GT
+aFormOrder (Uniq _) (Uniq _) = EQ
+aFormOrder (Uniq _) (UniqAt _ _) = LT
+aFormOrder (Uniq _) (UgenAt _ _) = LT
+aFormOrder (Uniq _) (Ugen _) = LT
+aFormOrder (Uniq _) (AFact _ _) = LT
+aFormOrder (Uniq _) (Equals _ _) = LT
+aFormOrder (UniqAt _ _) (Length _ _ _) = GT
+aFormOrder (UniqAt _ _) (Param _ _ _ _ _) = GT
+aFormOrder (UniqAt _ _) (Prec _ _) = GT
+aFormOrder (UniqAt _ _) (Non _) = GT
+aFormOrder (UniqAt _ _) (Pnon _) = GT
+aFormOrder (UniqAt _ _) (Uniq _) = GT
+aFormOrder (UniqAt _ _) (UniqAt _ _) = EQ
+aFormOrder (UniqAt _ _) (UgenAt _ _) = LT
+aFormOrder (UniqAt _ _) (Ugen _) = LT
+aFormOrder (UniqAt _ _) (AFact _ _) = LT
+aFormOrder (UniqAt _ _) (Equals _ _) = LT
+aFormOrder (UgenAt _ _) (Length _ _ _) = GT
+aFormOrder (UgenAt _ _) (Param _ _ _ _ _) = GT
+aFormOrder (UgenAt _ _) (Prec _ _) = GT
+aFormOrder (UgenAt _ _) (Non _) = GT
+aFormOrder (UgenAt _ _) (Pnon _) = GT
+aFormOrder (UgenAt _ _) (Uniq _) = GT
+aFormOrder (UgenAt _ _) (UniqAt _ _) = GT
+aFormOrder (UgenAt _ _) (UgenAt _ _) = EQ
+aFormOrder (UgenAt _ _) (Ugen _) = LT
+aFormOrder (UgenAt _ _) (AFact _ _) = LT
+aFormOrder (UgenAt _ _) (Equals _ _) = LT
+aFormOrder (Ugen _) (Length _ _ _) = GT
+aFormOrder (Ugen _) (Param _ _ _ _ _) = GT
+aFormOrder (Ugen _) (Prec _ _) = GT
+aFormOrder (Ugen _) (Non _) = GT
+aFormOrder (Ugen _) (Pnon _) = GT
+aFormOrder (Ugen _) (Uniq _) = GT
+aFormOrder (Ugen _) (UniqAt _ _) = GT
+aFormOrder (Ugen _) (UgenAt _ _) = GT
+aFormOrder (Ugen _) (Ugen _) = EQ
+aFormOrder (Ugen _) (AFact _ _) = LT
+aFormOrder (Ugen _) (Equals _ _) = LT
+aFormOrder (AFact _ _) (Length _ _ _) = GT
+aFormOrder (AFact _ _) (Param _ _ _ _ _) = GT
+aFormOrder (AFact _ _) (Prec _ _) = GT
+aFormOrder (AFact _ _) (Non _) = GT
+aFormOrder (AFact _ _) (Pnon _) = GT
+aFormOrder (AFact _ _) (Uniq _) = GT
+aFormOrder (AFact _ _) (UniqAt _ _) = GT
+aFormOrder (AFact _ _) (UgenAt _ _) = GT
+aFormOrder (AFact _ _) (Ugen _) = GT
+aFormOrder (AFact _ _) (AFact _ _) = EQ
+aFormOrder (AFact _ _) (Equals _ _) = LT
+aFormOrder (Equals _ _) (Length _ _ _) = GT
+aFormOrder (Equals _ _) (Param _ _ _ _ _) = GT
+aFormOrder (Equals _ _) (Prec _ _) = GT
+aFormOrder (Equals _ _) (Non _) = GT
+aFormOrder (Equals _ _) (Pnon _) = GT
+aFormOrder (Equals _ _) (Uniq _) = GT
+aFormOrder (Equals _ _) (UniqAt _ _) = GT
+aFormOrder (Equals _ _) (UgenAt _ _) = GT
+aFormOrder (Equals _ _) (Ugen _) = GT
+aFormOrder (Equals _ _) (AFact _ _) = GT
+aFormOrder (Equals _ _) (Equals _ _) = EQ
+
+aFreeVars :: Algebra t p g s e c => [t] -> AForm t -> [t]
+aFreeVars vars (Length _ z _) = addVars vars z
+aFreeVars vars (Param _ _ _ z t) = addVars (addVars vars z) t
+aFreeVars vars (Prec (x, _) (y, _)) = addVars (addVars vars x) y
+aFreeVars vars (Non t) = addVars vars t
+aFreeVars vars (Pnon t) = addVars vars t
+aFreeVars vars (Uniq t) = addVars vars t
+aFreeVars vars (UniqAt t (z, _)) = addVars (addVars vars t) z
+aFreeVars vars (UgenAt t (z, _)) = addVars (addVars vars t) z
+aFreeVars vars (Ugen t) = addVars vars t
+aFreeVars vars (AFact _ ft) = foldl addVars vars ft
+aFreeVars vars (Equals x y) = addVars (addVars vars x) y
+
+data Rule t
+  = Rule { rlname :: String,    -- Name of rule
+           rlgoal :: Goal t,    -- Sentence
+           rlcomment :: [SExpr ()] }
+    deriving Show
+
 -- Protocols
 
 data Prot t g
     = Prot { pname :: !String,  -- Name of the protocol
              alg :: !String,    -- Name of the algebra
-             pgen :: !g,        -- Initial variable generator
+             pgen :: !g,      -- Initial variable generator
              roles :: ![Role t], -- Non-listener roles of a protocol
              listenerRole :: Role t,
+             rules :: ![Rule t],  -- Protocol rules
              varsAllAtoms :: !Bool,   -- Are all role variables atoms?
              pcomment :: [SExpr ()] }  -- Comments from the input
     deriving Show
 
 -- Callers should ensure every role has a distinct name.
 mkProt :: Algebra t p g s e c => String -> String ->
-          g -> [Role t] -> Role t -> [SExpr ()] -> Prot t g
-mkProt name alg gen roles lrole comment =
+          g -> [Role t] -> Role t -> [Rule t] -> [SExpr ()] -> Prot t g
+mkProt name alg gen roles lrole rules comment =
     Prot { pname = name, alg = alg, pgen = gen, roles = roles,
-           listenerRole = lrole, pcomment = comment,
+           listenerRole = lrole, rules = rules, pcomment = comment,
            varsAllAtoms = all roleVarsAllAtoms roles }
     where
       roleVarsAllAtoms role = all isAtom (rvars role)
diff --git a/src/CPSA/Lib/Reduction.hs b/src/CPSA/Lib/Reduction.hs
--- a/src/CPSA/Lib/Reduction.hs
+++ b/src/CPSA/Lib/Reduction.hs
@@ -18,13 +18,13 @@
 import CPSA.Lib.SExpr
 import CPSA.Lib.Entry
 import CPSA.Lib.Algebra
-import CPSA.Lib.Goal
+import CPSA.Lib.Protocol
 import CPSA.Lib.Strand
 import CPSA.Lib.Cohort
 import CPSA.Lib.Displayer
 
-{--
--- Debugging support (Comment line above)
+--
+{-- Debugging support (Comment line above)
 import CPSA.Lib.Debug
 {--
 import System.IO.Unsafe
@@ -126,7 +126,7 @@
 solve _ h [] _ =                -- Done
     hClose h
 solve p h (k : ks) n | (not $ optDoAnalyze p) =
-    do 
+    do
       wrt p h (displayProt (protocol k))
       -- Just display the preskel
       wrt p h (displayPreskel k [])
@@ -141,27 +141,12 @@
               wrt p h (commentPreskel lk [] (unrealized k) Ordinary
                        "Input cannot be made into a skeleton--nothing to do")
               solve p h ks (n + 1)
-{--    -- Shouldn't need this case anymore
-        [k'] ->
-            if isomorphic (gist k) (gist k') then -- Input was a skeleton
-                let lk' = LPreskel k' n 0 Nothing in
-                begin p h ks (n + optLimit p) (n + 1)
-                         (hist (gist k', n)) [lk']
-            else                -- Input was not a skeleton
-                do
-                  let lk = LPreskel k n (-1) Nothing
-                  wrt p h (commentPreskel lk [] (unrealized k) Ordinary
-                           "Not a skeleton")
-                  let lk' = withParent k' (n + 1) lk
-                  begin p h ks (n + optLimit p) (n + 2)
-                           (hist (gist k', n + 1))  [lk']
---}
         ks' ->
             -- If input was a skeleton, just proceed
-            case [k''|k'' <- ks', isomorphic (gist k) (gist k'')] of
+            case [k'' | k'' <- ks', isomorphic (gist k) (gist k'')] of
               (k' : _) -> begin p h ks (n + optLimit p) (n+1)
                             (hist (gist k', n)) [LPreskel k' n 0 Nothing]
-              [] -> 
+              [] ->
                 do
                   let lk = LPreskel k n (-1) Nothing
                   let ks'' = L.nubBy (\k1 k2 -> isomorphic (gist k1) (gist k2)) ks'
@@ -171,14 +156,27 @@
                   let lks' = map (\(n', k')-> withParent k' n' lk) lk_nums
                   begin p h ks (n + optLimit p) (n+length(ks'')+1)
                            (hist (gist (head ks'), n+1)) lks'
---        _ -> error "Main.solve: can't handle more than one first skeleton"
 
--- Begin by collapsing the point-of-view skeleton as much as possible.
+-- Begin by applying rules as much as possible.
 begin :: Algebra t p g s e c => Options -> Handle ->
          [Preskel t g s e] -> Int -> Int -> Seen t g s e ->
          [LPreskel t g s e] -> IO ()
 begin p h ks m n seen todo =
-    search p h ks m n seen todo []
+  loop n seen todo []
+  where
+    loop n seen [] todo =
+      search p h ks m n seen (reverse todo) []
+    loop n seen (lk : lks) todo =
+      let k = content lk in
+        case rewrite k of
+          Nothing -> loop n seen lks (lk : todo)
+          Just kids ->
+            do
+              wrt p h (commentPreskel lk [] (unrealized k) Ordinary
+                       "Not closed under rules")
+              let (n', seen', todo', _) =
+                    foldl (next lk) (n, seen, todo, []) kids
+              loop n' seen' todo' lks
 
 -- Apply collapse until all possibilities are exhausted.
 search :: Algebra t p g s e c => Options -> Handle ->
@@ -188,7 +186,7 @@
     mode p h ks m n seen (reverse done)
 search p h ks m n seen (lk:todo) done =
     do
-      let kids = collapse (content lk)
+      let kids = concatMap simplify (collapse $ content lk)
       let (n', seen', todo', _) =
               foldl (next lk) (n, seen, todo, []) kids
       search p h ks m n' seen' todo' (lk:done)
diff --git a/src/CPSA/Lib/Strand.hs b/src/CPSA/Lib/Strand.hs
--- a/src/CPSA/Lib/Strand.hs
+++ b/src/CPSA/Lib/Strand.hs
@@ -1,4 +1,4 @@
--- Instance and preskeleton data structures and support functions.
+-- on data structures and support functions.
 
 -- Copyright (c) 2009 The MITRE Corporation
 --
@@ -8,7 +8,8 @@
 
 module CPSA.Lib.Strand (Instance, mkInstance, bldInstance, mkListener,
     role, env, trace, height, listenerTerm, Sid, Node, mkPreskel,
-    firstSkeleton, Pair, Preskel, gen, protocol, kgoals, insts, orderings, leadsto,
+    firstSkeleton, Pair, Preskel, gen, protocol, kgoals, insts,
+    orderings, leadsto, kfacts,
     pov, korig, kcomment, nstrands, kvars, kpriority, kpriorities,
     strandids, kterms, avoid, preskelWellFormed, verbosePreskelWellFormed,
     Strand, inst, nodes, Vertex, preds, event, kabsent,
@@ -17,7 +18,8 @@
     Cause (..), Direction (..), Method (..), Operation (..),
     operation, SkelDeclInst, SkelDeclInstList, SkelDeclaration,
     SkelDeclList, SkelDeclarations, priority,
-    prob, homomorphism, toSkeleton, generalize, collapse, decls, sat) where
+    prob, homomorphism, toSkeleton, generalize, collapse, decls, sat,
+    FTerm (..), Fact (..), simplify, rewrite) where
 
 import Control.Monad
 -- import System.IO.Error (ioeGetErrorString)
@@ -32,7 +34,6 @@
 import CPSA.Lib.Declaration
 import CPSA.Lib.State
 import CPSA.Lib.Protocol
-import CPSA.Lib.Goal
 
 -- Debugging support (Uncomment below)
 --import CPSA.Lib.Debug
@@ -359,6 +360,7 @@
       cInfo :: ConstInfo t,
       decls :: SkelDeclarations t,
       extraDecls :: SkelDeclarations t,
+      kfacts :: ![Fact t],
       kcomment :: [SExpr ()],   -- Comments from the input
       pov :: Maybe (Preskel t g s e), -- Point of view, the
                                           -- original problem statement.
@@ -424,14 +426,14 @@
 -- must be consumed by firstSkeleton.
 mkPreskel :: Algebra t p g s e c => g -> Prot t g -> [Goal t] ->
              [Instance t e] -> [Pair] -> [Pair] -> SkelDeclList t ->
-             [SExpr ()] -> [(Node,Int)] -> Maybe (Preskel t g s e) ->
-             [Sid] -> Preskel t g s e
-mkPreskel gen protocol gs insts orderings leadsto dlist comment priorities
+             [Fact t] -> [SExpr ()] -> [(Node,Int)] ->
+             Maybe (Preskel t g s e) -> [Sid] -> Preskel t g s e
+mkPreskel gen protocol gs insts orderings leadsto dlist facts comment priorities
    maybePov maybeProb =
     k { kcomment = comment }
     where
       k = newPreskel gen shared insts orderings leadsto' decls'
-          New prob kpriority maybePov
+          facts New prob kpriority maybePov
       shared = Shared { prot = protocol, goals = gs }
       decls' = foldl addInstOrigs decls (zip (nats (length insts)) insts)
       decls = mkDecls dlist'
@@ -510,13 +512,15 @@
 -- within this module.
 newPreskel :: Algebra t p g s e c => g -> Shared t g ->
              [Instance t e] -> [Pair] -> [Pair] -> SkelDeclarations t ->
-             Operation t s -> [Sid] -> [(Node,Int)] ->
+             [Fact t] -> Operation t s -> [Sid] -> [(Node,Int)] ->
              Maybe (Preskel t g s e) -> Preskel t g s e
-newPreskel gen shared insts orderings leadsto decls oper prob kpriority pov =
+newPreskel gen shared insts orderings leadsto decls
+           facts oper prob kpriority pov =
     let orderings' = L.nub orderings
         g = graph trace height insts orderings'
         strands = gstrands g
         decls' = declsNub decls
+        facts' = L.nub facts
         edges = gedges g
         tc = filter pairWellOrdered (graphClose $ graphEdges strands)
         k = Preskel { gen = gen,
@@ -528,6 +532,7 @@
                       edges = edges,
                       decls = decls',
                       extraDecls = mkDecls [],
+                      kfacts = facts',
                       cInfo = declsOrig strands decls',
                       kcomment = [],
                       tc = map graphPair tc,
@@ -656,8 +661,8 @@
 tracePattern [] = 1
 tracePattern (In _:r) = traceBase*(tracePattern r)
 tracePattern (Out _:r) = traceBase*(tracePattern r) + 1
-tracePattern (Sync _:r) = traceBase*(tracePattern r) + 2                         
-                          
+tracePattern (Sync _:r) = traceBase*(tracePattern r) + 2
+
 -- Isomorphism Check
 
 -- Are two skeletons equivalent?  Two skeletons are equivalent if they
@@ -685,11 +690,13 @@
       gleadsto :: [Pair],
       gpatterns :: [Int],
       gdecls :: SkelDeclarations t,
+      gfacts :: [Fact t],
       nvars :: !Int,           -- Number of variables
       ntraces :: !Int,         -- Number of traces
       norderings :: !Int,      -- Number of orderings
       nleadsto :: !Int,        -- Number of leadsto pairs
-      nsndecls :: [Int] }      -- Counts of decls
+      nsndecls :: [Int],       -- Counts of decls
+      nfacts :: !Int }         -- Number of facts
     deriving Show
 
 gist :: Algebra t p g s e c => Preskel t g s e -> Gist t g
@@ -699,21 +706,23 @@
            gorderings = gorderings,
            gleadsto = gleadsto,
            gdecls = gdecls,
+           gfacts = gfacts,
            gpatterns = patterns,
            nvars = length (kvars k),
            ntraces = length gtraces,
            norderings = length gorderings,
            nleadsto = length gleadsto,
-           nsndecls = nsds gdecls }
+           nsndecls = nsds gdecls,
+           nfacts = length gfacts }
     where
       gtraces = map (\i -> (height i, trace i)) (insts k)
       gorderings = orderings k
       gleadsto = leadsto k
       gdecls = decls k
+      gfacts = kfacts k
       patterns = L.sort (map (tracePattern . trace) (insts k))
       nsds decls = [length (dknon decls), length (dkpnon decls), length (dkunique decls)]
 
-
 -- Test to see if two preskeletons are isomorphic
 
 -- First, ensure the two preskeletons have:
@@ -721,6 +730,7 @@
 -- 2. The same number of strands
 -- 3. The same number of node orderings
 -- 4. The same number of terms in knon and kunique
+-- 5. The same number of facts
 
 -- Next compute the plausible permutations and substitutions.
 
@@ -741,6 +751,7 @@
     gpatterns g == gpatterns g' &&
     nleadsto g == nleadsto g' &&
     nsndecls g == nsndecls g' &&
+    nfacts g == nfacts g' &&
     any (tryPerm g g') (permutations g g')
 
 probIsomorphic :: Algebra t p g s e c => Preskel t g s e -> Preskel t g s e -> Bool
@@ -751,7 +762,7 @@
       g' = gist k'
       pr = prob k
       pr' = prob k'
-        
+
 -- Extend a permutation while extending a substitution
 -- Extend by matching later strands first
 permutations :: Algebra t p g s e c => Gist t g ->
@@ -823,6 +834,7 @@
 tryPerm g g' (fenv, renv, perm) =
     checkOrigs g g' fenv perm &&
     checkOrigs g' g renv (invperm perm) &&
+    checkFacts g g' fenv perm &&
     containsMapped (permutePair perm) (gorderings g') (gorderings g) &&
     containsMapped (permutePair perm) (gleadsto g') (gleadsto g)
 
@@ -831,6 +843,7 @@
 tryPermProb g g' prob prob' (fenv, renv, perm) =
     checkOrigs g g' fenv perm &&
     checkOrigs g' g renv perm &&
+    checkFacts g g' fenv perm &&
     containsMapped (permutePair perm) (gorderings g') (gorderings g) &&
     containsMapped (permutePair perm) (gleadsto g') (gleadsto g) &&
     all (\n -> perm !! (prob !! n) == prob' !! n) [0..((length prob)-1)]
@@ -850,6 +863,13 @@
 permuteNode :: [Sid] -> Node -> Node
 permuteNode perm (strand, pos) = (perm !! strand, pos)
 
+checkFacts :: Algebra t p g s e c => Gist t g ->
+              Gist t g -> (g, e) -> [Sid] -> Bool
+checkFacts g g' (_, e) perm =
+  all f (gfacts g)
+  where
+    f fact = elem (instUpdateFact e (perm !!) fact) (gfacts g')
+
 -- Preskeleton Reduction System (PRS)
 
 -- The PRS reduces a preskeleton to a list of skeletons.  Along the way,
@@ -874,9 +894,11 @@
   do
       (gen', insts') <- foldMapM (substInst subst) gen (insts k)
       let decls' = declsMapTerms (substitute subst) (decls k)
+      let facts' = map (substFact subst) (kfacts k)
       let operation' = substOper subst (operation k)
       let k' = newPreskel gen' (shared k) insts'
-               (orderings k) (leadsto k) decls' operation' (prob k) (kpriority k) (pov k)
+               (orderings k) (leadsto k) decls' facts' operation'
+               (prob k) (kpriority k) (pov k)
       k' <- wellFormedPreskel k'
       return (k0, k', n, phi, compose subst hsubst)
 
@@ -936,6 +958,7 @@
               orderings'
               (permuteOrderings perm (leadsto k))
               (declsMapStrands perm (decls k))
+              (map (updateFact $ updateStrand s s') (kfacts k))
               (operation k)
               (updateProb perm (prob k))
               (updatePriority perm (kpriority k))
@@ -1020,6 +1043,7 @@
               leadsto'
               (declsMapStrands perm
                       (declsFilterValid (iterms insts') (strandNotInSkel s)  (decls k)))
+              (map (updateFact $ updateStrand s s') (kfacts k))
               (operation k)
               (updateProb perm (prob k))
               (updatePriority perm (kpriority k))
@@ -1244,6 +1268,7 @@
                   o
                   (leadsto k)
                   (decls k)
+                  (kfacts k)
                   (operation k)
                   (prob k)
                   (kpriority k)
@@ -1338,7 +1363,8 @@
       let leadsto' = if isState then pair : leadsto k else leadsto k
       let decls' = inheritRdecls s inst (decls k)
       let k' = newPreskel (gen k) (shared k) insts'
-           orderings' leadsto' decls' (operation k) (prob k) (kpriority k) (pov k)
+               orderings' leadsto' decls' (kfacts k) (operation k)
+               (prob k) (kpriority k) (pov k)
       k' <- wellFormedPreskel k'
       return (k0, k', n, phi, hsubst)
 
@@ -1414,7 +1440,7 @@
       ans prs
     where
       k' = newPreskel gen' (shared k) insts' orderings' (leadsto k) (decls k)
-           (AddedListener t cause) (prob k) (kpriority k) (pov k)
+           (kfacts k) (AddedListener t cause) (prob k) (kpriority k) (pov k)
       (gen', inst) = mkListener (protocol k) (gen k) t
       insts' = insts k ++ [inst]
       pair = ((length (insts k), 1), n)
@@ -1430,7 +1456,7 @@
       ans prs
     where
       k' = newPreskel gen'' (shared k) insts' orderings' (leadsto k) decls'
-           (AddedListener t' cause) (prob k) (kpriority k) (pov k)
+           (kfacts k) (AddedListener t' cause) (prob k) (kpriority k) (pov k)
       (gen', t') = basePrecursor (gen k) t
       (gen'', inst) = mkListener (protocol k) gen' t'
       insts' = insts k ++ [inst]
@@ -1453,8 +1479,8 @@
       ans prs
     where                       -- New cause should be added!
       k' = newPreskel (gen k) (shared k) (insts k) (orderings k)
-        (leadsto k) decls' (AddedAbsence x t cause) (prob k)
-        (kpriority k) (pov k)
+           (leadsto k) decls' (kfacts k) (AddedAbsence x t cause)
+           (prob k) (kpriority k) (pov k)
       decls' = addDeclInst "absent" [x, t] [] (decls k)
 
 -- Numeric contraction
@@ -1564,8 +1590,9 @@
           let i = inst (strand n)
           (gen', i') <- bldInstance (role i) (take p (trace i)) (gen k)
           let k' = deleteNodeRest k gen' (s, p) (replaceNth i' s (insts k))
-                   (shortenOrderings (s, p) (tc k)) (shortenOrderings (s, p) (leadsto k))
-                   (prob k)
+                   (shortenOrderings (s, p) (tc k))
+                   (shortenOrderings (s, p) (leadsto k))
+                   (prob k) (kfacts k)
           return (k', mapping)
     where
       p = pos n
@@ -1607,6 +1634,7 @@
     (deleteOrderings s (tc k))
     (deleteOrderings s (leadsto k)) -- is this the right thing?
     decls'
+    facts'
     (Generalized (Deleted n))
     (updatePerm s s (prob k)) -- s shouldn't appear in prob, but we need to update
                               -- in case any strands in prob are > s.
@@ -1619,6 +1647,9 @@
     decls0 = declsFilterValid (iterms (insts k)) (strandNotInSkel s) (decls k)
     decls' = declsFilterValid terms (const True)
              (declsMapStrands mapping decls0)
+    facts' = cleansFacts terms (map
+                                (updateFact (updateStrand s s))
+                                (deleteFacts s $ kfacts k))
     terms = iterms insts'
 
 nodeInSkel :: Preskel t g s e -> Node -> Bool
@@ -1628,15 +1659,25 @@
 
 deleteNodeRest :: Algebra t p g s e c => Preskel t g s e ->
                   g -> Node -> [Instance t e] -> [Pair] -> [Pair] ->
-                  [Sid] -> Preskel t g s e
-deleteNodeRest k gen n insts' orderings leadsto prob =
-    newPreskel gen (shared k) insts' orderings leadsto decls'
+                  [Sid] -> [Fact t] -> Preskel t g s e
+deleteNodeRest k gen n insts' orderings leadsto prob facts =
+    newPreskel gen (shared k) insts' orderings leadsto decls' facts'
                    (Generalized (Deleted n)) prob (kpriority k) (pov k)
     where
       -- Drop nons that aren't mentioned anywhere
       decls' = declsFilterValid terms (nodeInSkel k) (decls k)
+      facts' = cleansFacts terms facts
       terms = iterms insts'
 
+deleteFacts :: Sid -> [Fact t] -> [Fact t]
+deleteFacts s facts =
+  filter f facts
+  where
+    f (Fact _ ft) =
+      all g ft
+    g (FSid s') = s /= s'
+    g (FTerm _) = True
+
 -- Node ordering weakening
 
 -- To weaken, create a candidate for each element in the current
@@ -1665,7 +1706,7 @@
     addIdentity k'
     where
       k' = newPreskel (gen k) (shared k) (insts k)
-           orderings (leadsto k) (decls k)
+           orderings (leadsto k) (decls k) (kfacts k)
            (Generalized (Weakened p)) (prob k) (kpriority k) (pov k)
 
 -- Origination assumption forgetting
@@ -1821,6 +1862,7 @@
                 | otherwise = (prob k !! s, t, p)
 
 -- Change the given locations and create the resulting preskeleton
+-- JDR: Something about facts is needed here.
 changeLocations :: Algebra t p g s e c => Preskel t g s e ->
                    Preskel t g s e -> g -> t ->
                    ([Location t p g s e c], [PovLocation t p g s e c]) ->
@@ -1831,8 +1873,9 @@
       ks = f (splitDecls k pk gen' insts' t povlocs pove)
       locs = rlocs ++ concatMap (\(_,x,_)->x) povlocs
       f (gen'', newdecl) =
-        newPreskel gen'' (shared k) insts' (orderings k) (leadsto k)
-        newdecl (Generalized (Separated t)) (prob k) (kpriority k) (pov k)
+        newPreskel gen'' (shared k) insts' (orderings k) (leadsto k) newdecl
+        (kfacts k)              -- This is wrong.  Facts need to be cleansed!
+        (Generalized (Separated t)) (prob k) (kpriority k) (pov k)
       (gen', insts') = changeStrands locs t gen (strands k)
 
 -- For variable separation
@@ -1982,7 +2025,7 @@
 -}
 
 -- Exported
--- JDR: duplicate code with mkPreskel
+-- JDR: something about facts is needed here I think
 forgetSomeTerm :: Algebra t p g s e c => Preskel t g s e ->
                   [Candidate t p g s e c]
 forgetSomeTerm k =
@@ -2149,7 +2192,7 @@
 
 enforceAbsence :: Algebra t p g s e c => PRS t p g s e c -> [PRS t p g s e c]
 enforceAbsence prs@(_, k, _, _, _) =
-  [prs'| s <- absenceSubst (gen k) (kabsent k), prs' <- ksubst prs s]
+  [prs' | s <- absenceSubst (gen k) (kabsent k), prs' <- ksubst prs s]
 
 skeletonize2 :: Algebra t p g s e c => Bool -> Int -> PRS t p g s e c ->
                [PRS t p g s e c]
@@ -2210,22 +2253,23 @@
 rectifyIndicatorConstraints :: Algebra t p g s e c => PRS t p g s e c -> [PRS t p g s e c]
 rectifyIndicatorConstraints prs
   | indicatorConstraintsCheck (skel prs) = [prs]
-  | otherwise = [prs'|ge <- gefix,
-                      prs' <- recurse1 (ind0Problems (skel prs)) prs ge]
+  | otherwise = [prs' | ge <- gefix,
+                        prs' <- recurse1 (ind0Problems (skel prs)) prs ge]
   where
     -- Rectify ind-zero constraints until none are left, then rectify
     -- ind-zero-in constraints.
     recurse1 [] prs ge = recurse2 (ind0_inProblems (skel prs)) prs ge
     recurse1 (t:ts) prs ge =
-      [prs'|(g,e) <- zeroIndicator t ge (filter (/= t) $ resExps (skel prs)),
-            sprs <- ksubst prs (g, substitution e),
-            prs' <- recurse1 (map (substitute (substitution e)) ts) sprs (g,e)]
+      [prs' | (g,e) <- zeroIndicator t ge (filter (/= t) $ resExps (skel prs)),
+              sprs <- ksubst prs (g, substitution e),
+              prs' <- recurse1 (map (substitute (substitution e)) ts) sprs (g,e)]
 
     -- Rectify ind-zero-in constraints until none are left
     recurse2 [] prs _ = [prs]
-    recurse2 (tv:tvs) prs ge = [prs'|(g,e) <- zeroIndicatorIn (tv !! 1) (tv !! 0) ge,
-            sprs <- ksubst prs (g,substitution e),
-            prs' <- recurse2 (map (\tv -> map (substitute (substitution e)) tv) tvs) sprs (g,e)]
+    recurse2 (tv:tvs) prs ge =
+      [prs' | (g,e) <- zeroIndicatorIn (tv !! 1) (tv !! 0) ge,
+              sprs <- ksubst prs (g,substitution e),
+              prs' <- recurse2 (map (\tv -> map (substitute (substitution e)) tv) tvs) sprs (g,e)]
 
     -- Include restricted variables
     gefix = matchMany (resExps (skel prs)) (resExps (skel prs)) (gen (skel prs), emptyEnv)
@@ -2324,6 +2368,7 @@
                   o
                   (leadsto k)
                   (decls k)
+                  (kfacts k)
                   (operation k)
                   (prob k)
                   (kpriority k)
@@ -2443,22 +2488,126 @@
 type SkelDeclList t = DeclList t (Int, Int)
 type SkelDeclarations t = Declarations t (Int, Int)
 
+-- Facts
+
+data FTerm t
+  = FSid Sid
+  | FTerm t
+  deriving (Eq, Show)
+
+data Fact t
+  = Fact String [FTerm t]
+  deriving (Eq, Show)
+
+substFTerm :: Algebra t p g s e c => s -> FTerm t -> FTerm t
+substFTerm s (FTerm t) = FTerm $ substitute s t
+substFTerm _ t = t
+
+substFact :: Algebra t p g s e c => s -> Fact t -> Fact t
+substFact s (Fact name fs) = Fact name $ map (substFTerm s) fs
+
+{-
+instFTerm :: Algebra t p g s e c => e -> FTerm t -> FTerm t
+instFTerm s (FTerm t) = FTerm $ instantiate s t
+instFTerm _ t = t
+
+instFact :: Algebra t p g s e c => e -> Fact t -> Fact t
+instFact s (Fact name fs) = Fact name $ map (instFTerm s) fs
+-}
+
+updateFTerm :: (Sid -> Sid) -> FTerm t -> FTerm t
+updateFTerm f (FSid s) = FSid $ f s
+updateFTerm _ t = t
+
+updateFact :: (Sid -> Sid) -> Fact t -> Fact t
+updateFact f (Fact name fs) = Fact name $ map (updateFTerm f) fs
+
+instUpdateFTerm :: Algebra t p g s e c => e ->
+                   (Sid -> Sid) -> FTerm t -> FTerm t
+instUpdateFTerm _ f (FSid s) = FSid $ f s
+instUpdateFTerm e _ (FTerm t) = FTerm $ instantiate e t
+
+instUpdateFact :: Algebra t p g s e c => e ->
+                  (Sid -> Sid) -> Fact t -> Fact t
+instUpdateFact e f (Fact name fs) = Fact name $ map (instUpdateFTerm e f) fs
+
+-- Is all of the fact's variables in a list of variables?
+
+factVarsElem :: Algebra t p g s e c => [t] -> Fact t -> Bool
+factVarsElem vs (Fact _ ts) =
+  all f ts
+  where
+    f (FSid _) = True
+    f (FTerm t) = all (\v -> elem v vs) (varsInTerms [t])
+
+cleansFacts :: Algebra t p g s e c => [t] -> [Fact t] -> [Fact t]
+cleansFacts vs facts =
+  L.filter (factVarsElem vs) facts
+
+{-
+instvars :: Algebra t p g s e c => [Instance t e] -> [t]
+instvars insts =
+    S.elems $ foldl addIvars S.empty insts
+-}
+
+{-- For debugging
+factVars :: Fact -> [Term] -> [Term]
+factVars (Fact _ ts) vs =
+  foldr f vs ts
+  where
+    f (FSid _) vs = vs
+    f (FTerm t) vs = addVars vs t
+
+chkFVars :: Preskel -> Preskel
+chkFVars k =
+  foldl f k (foldr factVars [] (kfacts k))
+  where
+    f k v
+      | elem v (kvars k) = k
+      | otherwise = error ("Bad var in fact " ++ show v)
+--}
+
+{-
+chkFacts :: Preskel -> Bool
+chkFacts k =
+  all checkFact (kfacts k)
+  where
+    checkFact (Fact _ ft) =
+      all checkFTerm ft
+    checkFTerm (FSid s) =
+      s < nstrands k
+    checkFTerm (FNode (s, _)) =
+      s < nstrands k
+    checkFTerm (FTerm _) = True
+
+-- Use this to find bad fact updates.
+chkFacts :: Preskel -> Bool
+chkFacts k =
+  all checkFact (kfacts k)
+  where
+    checkFact (Fact _ ft) =
+      all checkFTerm ft
+    checkFTerm (FSid s) | s >= nstrands k = error "Bad strand in fact"
+    checkFTerm (FNode (s, _)) | s >= nstrands k = error "Bad node in fact"
+    checkFTerm _ = True
+
+-}
 -- Security goals: satisfaction of atomic formulas
 
 type Sem t g s e = Preskel t g s e -> (g, e) -> [(g, e)]
 
 satisfy :: Algebra t p g s e c => AForm t -> Sem t g s e
 satisfy (Equals t t') = geq t t'
+satisfy (AFact name fs) = gafact name fs
 satisfy (Non t) = gnon t
 satisfy (Pnon t) = gpnon t
 satisfy (Uniq t) = guniq t
 satisfy (UniqAt t n) = guniqAt t n
 satisfy (UgenAt t n) = gugenAt t n
 satisfy (Ugen t) = gugen t
-satisfy (StrPrec n n') = gstrPrec n n'
 satisfy (Prec n n') = gprec n n'
-satisfy (RolePred r i n) = grole r i n
-satisfy (ParamPred r v n t) = gparam r v n t
+satisfy (Length r n i) = glength r n i
+satisfy (Param r v f n t) = gparam r v f n t
 
 -- Equality assumes there has been a static role specific check to
 -- eliminate error cases.
@@ -2470,6 +2619,29 @@
     ti = instantiate e t
     ti' = instantiate e t'
 
+-- Facts
+gafact :: Algebra t p g s e c => String -> [t] -> Sem t g s e
+gafact name fs k e =
+  do
+    Fact name' ts <- kfacts k
+    case name == name' of
+      True -> fmatchList fs ts e
+      False -> []
+
+fmatchList :: Algebra t p g s e c => [t] -> [FTerm t] -> (g, e) -> [(g, e)]
+fmatchList [] [] e = [e]
+fmatchList (f : fs) (t : ts) e =
+  do
+    e <- fmatch f t e
+    fmatchList fs ts e
+fmatchList _ _ _ = []
+
+fmatch :: Algebra t p g s e c => t -> FTerm t -> (g, e) -> [(g, e)]
+fmatch z (FSid s) e =
+  strdMatch z s e
+fmatch t (FTerm t') e =
+  match t t' e
+
 -- Non-origination
 gnon :: Algebra t p g s e c => t -> Sem t g s e
 gnon t k e =
@@ -2492,23 +2664,28 @@
     match t t' e
 
 -- Unique origination at a node
-guniqAt :: Algebra t p g s e c => t -> t -> Sem t g s e
-guniqAt t n k e =
+guniqAt :: Algebra t p g s e c => t -> NodeTerm t -> Sem t g s e
+guniqAt t (z, i) k e =
   do
-    (t', l) <- dkuniqFull $ decls k
-    e <- match t t' e
-    nodeMatch n l e
+    (t', (s, j)) <- dkuniqFull $ decls k
+    case i == j of
+      True ->
+        do
+          e <- match t t' e
+          strdMatch z s e
+      _ -> []
 
 -- Unique generation at a node
-gugenAt :: Algebra t p g s e c => t -> t -> Sem t g s e
-gugenAt t n k e =
+gugenAt :: Algebra t p g s e c => t -> NodeTerm t -> Sem t g s e
+gugenAt t (z, i) k e =
   do
     (t', l) <- dkugenFull $ decls k
     case l of
-      Nothing -> []
-      Just n' -> do
-        e <- match t t' e
-        nodeMatch n n' e
+      Just (s, j) | i == j ->
+        do
+          e <- match t t' e
+          strdMatch z s e
+      _ -> []
 
 -- Unique generation
 gugen :: Algebra t p g s e c => t -> Sem t g s e
@@ -2526,54 +2703,53 @@
   | s == s' && i < i' = True
   | otherwise = False
 
--- Within strand node precedes
-gstrPrec :: Algebra t p g s e c => t -> t -> Sem t g s e
-gstrPrec n n' k (g, e) =
-  case (nodeLookup e n, nodeLookup e n') of
-    (Just p, Just p')
-      | inSkel k p && inSkel k p' && strandPrec p p' -> [(g, e)]
-    (Just _, Just _) -> []
-    (_, Just _) ->
-      error ("Strand.gstrPrec: node " ++ show n ++ " unbound")
-    _ ->
-      error ("Strand.gstrPrec: node " ++ show n' ++ " unbound")
+nodeLookup :: Algebra t p g s e c => e -> NodeTerm t -> Maybe Node
+nodeLookup e (z, i) =
+  do
+    s <- strdLookup e z
+    return (s, i)
 
+nodeMatch :: Algebra t p g s e c => NodeTerm t -> Node -> (g, e) -> [(g, e)]
+nodeMatch (z, i) (s, j) e
+  | i == j = strdMatch z s e
+  | otherwise = []
+
 -- Node precedes
 -- This should look at the transitive closure of the ordering graph.
-gprec :: Algebra t p g s e c => t -> t -> Sem t g s e
+gprec :: Algebra t p g s e c => NodeTerm t -> NodeTerm t -> Sem t g s e
 gprec n n' k (g, e) =
   case (nodeLookup e n, nodeLookup e n') of
     (Just p, Just p')
       | inSkel k p && inSkel k p' &&
         (strandPrec p p' || elem (p, p') (tc k)) -> [(g, e)]
-    (Just _, Just _) -> []
-    (_, Just _) ->
-      error ("Strand.gstrPrec: node " ++ show n ++ " unbound")
     _ ->
-      error ("Strand.gstrPrec: node " ++ show n' ++ " unbound")
+      do
+        (p, p') <- tc k
+        (g, e) <- nodeMatch n p (g, e)
+        nodeMatch n' p' (g, e)
 
--- Role predicate
--- r and i determine the predicate, which has arity one.
-grole :: Algebra t p g s e c => Role t -> Int -> t -> Sem t g s e
-grole r i n k (g, e) =
-  case nodeLookup e n of
+-- Length predicate
+-- r and h determine the predicate, which has arity one.
+glength :: Algebra t p g s e c => Role t -> t -> Int -> Sem t g s e
+glength r z h k (g, e) =
+  case strdLookup e z of
     Nothing ->
       do
-        (z, inst) <- zip [0..] $ insts k
+        (s, inst) <- zip [0..] $ insts k
         case () of
-          _ | i >= height inst -> []
-            | rname (role inst) == rname r -> nodeMatch n (z, i) (g, e)
+          _ | h > height inst -> []
+            | rname (role inst) == rname r -> strdMatch z s (g, e)
             | otherwise ->      -- See if z could have been an instance of r
-              case bldInstance r (take (i + 1) $ trace inst) g of
+              case bldInstance r (take h $ trace inst) g of
                 [] -> []
-                _ -> nodeMatch n (z, i) (g, e)
-    Just (z, j) | z < nstrands k && i == j ->
-      let inst = insts k !! z in
+                _ -> strdMatch z s (g, e)
+    Just s | s < nstrands k ->
+      let inst = insts k !! s in
       case () of
-        _ | i >= height inst -> []
+        _ | h > height inst -> []
           | rname (role inst) == rname r -> [(g, e)]
           | otherwise ->
-            case bldInstance r (take (i + 1) $ trace inst) g of
+            case bldInstance r (take h $ trace inst) g of
               [] -> []
               _ -> [(g, e)]
     _ -> []
@@ -2582,20 +2758,33 @@
 
 -- r and t determine the predicate, which has arity two.  t must be
 -- a variable declared in role r.
-gparam :: Algebra t p g s e c => Role t -> t -> t -> t -> Sem t g s e
-gparam r t n t' k (g, e) =
-  case nodeLookup e n of
-    Just (z, i) | z < nstrands k  ->
-      let inst = insts k !! z in
+gparam :: Algebra t p g s e c => Role t -> t -> Int -> t -> t -> Sem t g s e
+gparam r t h z t' k (g, e) =
+  case strdLookup e z of
+    Nothing ->
+      do
+        (s, inst) <- zip [0..] $ insts k
+        case () of
+          _ | h > height inst -> []
+            | rname (role inst) == rname r ->
+              do
+                ge <- strdMatch z s (g, e)
+                match t' (instantiate (env inst) t) ge
+            | otherwise ->      -- See if z could have been an instance of r
+                do
+                  (g, inst) <- bldInstance r (take h $ trace inst) g
+                  ge <- strdMatch z s (g, e)
+                  match t' (instantiate (env inst) t) ge
+    Just s | s < nstrands k  ->
+      let inst = insts k !! s in
       case () of
-        _ | i >= height inst -> []
+        _ | h > height inst -> []
           | rname (role inst) == rname r ->
             match t' (instantiate (env inst) t) (g, e)
           | otherwise ->
               do
-                (g, inst) <- bldInstance r (take (i + 1) $ trace inst) g
+                (g, inst) <- bldInstance r (take h $ trace inst) g
                 match t' (instantiate (env inst) t) (g, e)
-    Nothing -> error ("Strand.gparam: node " ++ show n ++ " unbound")
     _ -> []
 
 -- Conjunction
@@ -2624,3 +2813,400 @@
 sat :: Algebra t p g s e c => Preskel t g s e -> [(Goal t, [e])]
 sat k =
   map (goalSat k) (kgoals k)
+
+-- Rules
+
+-- Try simplifying k if possible
+simplify :: Algebra t p g s e c => Preskel t g s e -> [Preskel t g s e]
+simplify k =
+  case rewrite k of
+    Nothing -> [k]
+    Just ks -> ks
+
+{-
+-- Try all rules associated with the protocol of k.  Return nothing if
+-- no rule applies, otherwise return the replacements.
+rewrite :: Algebra t p g s e c => Preskel t g s e -> Maybe [Preskel t g s e]
+rewrite _ = Nothing
+-}
+
+-- Try all rules associated with the protocol of k.  Return nothing if
+-- no rule applies, otherwise return the replacements.
+rewrite :: Algebra t p g s e c => Preskel t g s e -> Maybe [Preskel t g s e]
+rewrite k =
+  loop prules
+  where
+    prules = rules $ protocol k
+    loop [] = Nothing           -- No rules apply
+    loop (r : rs) =
+      let vas = tryRule k r in
+        if null vas then
+          loop rs               -- Rule does not apply
+        else
+          Just $ doRewrites prules k r vas
+
+-- Returns the environments that show satifaction of the antecedent
+-- but fail to be extendable to show satifaction of one of the
+-- conclusions.
+tryRule :: Algebra t p g s e c => Preskel t g s e -> Rule t -> [(g, e)]
+tryRule k r =
+  [(g, e) | (g, e) <- conjoin (antec $ rlgoal r) k (gen k, emptyEnv),
+            conclusion (g, e) ]
+  where
+    conclusion e = all (disjunct e) $ concl $ rlgoal r
+    disjunct e a = null $ conjoin a k e
+
+-- Repeatedly applies rules until no rule applies.
+doRewrites :: Algebra t p g s e c => [Rule t] -> Preskel t g s e ->
+              Rule t -> [(g, e)] -> [Preskel t g s e]
+doRewrites rules k r vas =
+  concatMap f (doRewrite k r vas)
+  where
+    f k = loop rules
+      where
+        loop [] = [k]           -- No rules apply
+        loop (r : rs) =
+          let vas = tryRule k r in
+            if null vas then
+              loop rs           -- Rule does not apply
+            else
+              doRewrites rules k r vas
+
+-- Apply rewrite rule at all assignments
+doRewrite :: Algebra t p g s e c => Preskel t g s e ->
+             Rule t -> [(g, e)] -> [Preskel t g s e]
+doRewrite k r vas =
+  concatMap (doRewriteOne k r) vas
+
+-- Apply rewrite rule at one assignment
+doRewriteOne :: Algebra t p g s e c => Preskel t g s e ->
+                Rule t -> (g, e) -> [Preskel t g s e]
+doRewriteOne k r e =
+  do
+    cl <- concl $ rlgoal r
+    (k, _) <- doConj (rlname r) cl k e
+    k <- wellFormedPreskel k
+    k <- toSkeleton True k
+    return $ f k                -- Add comment about rule application
+  where f k = k { kcomment =
+                  L () [S () "rule", S () (rlname r)] :
+                  kcomment k }
+
+type Rewrite t g s e =
+  Preskel t g s e -> (g, e) -> [(Preskel t g s e, (g, e))]
+
+doConj :: Algebra t p g s e c => String -> [AForm t] -> Rewrite t g s e
+doConj _ [] k e = [(k, e)]
+doConj rule (f : fs) k e =
+  do
+    (k, e) <- rwt rule f k e
+    doConj rule fs k e
+
+rwt :: Algebra t p g s e c => String -> AForm t -> Rewrite t g s e
+rwt _ (Length r z h) = rlength r z h
+rwt rule (Param r v i z t) = rparam rule r v i z t
+rwt rule (Prec n n') = rprec rule n n'
+rwt rule (Non t) = rlnon rule t
+rwt rule (Pnon t) = rlpnon rule t
+rwt rule (Uniq t) = rluniq rule t
+rwt rule (UniqAt t n) = runiqAt rule t n
+rwt rule (UgenAt t n) = rugenAt rule t n
+rwt rule (Ugen t) = rlugen rule t
+rwt rule (AFact name fs) = rafact rule name fs
+rwt rule (Equals t t') = req rule t t'
+
+rlength :: Algebra t p g s e c => Role t -> t -> Int -> Rewrite t g s e
+rlength r z h k (g, e)
+  | length (rtrace r) < h = []
+  | otherwise =
+    case strdLookup e z of
+      Just s ->                 -- Try to displace
+        rDisplace e k' ns s
+        where
+          k' = addStrand g k r h
+          ns = nstrands k
+      Nothing ->                -- Try to augment
+        do                      -- and displace everywhere
+          let ns = nstrands k
+          (g, e) <- strdMatch z ns (g, e)
+          let k' = addStrand g k r h
+          let f s' = rDisplace e k' ns s'
+          (k', (gen k', e)) : concatMap f (nats ns)
+
+-- Just add a strand cloned from a role.
+-- The length must be greater than one.
+addStrand :: Algebra t p g s e c => g -> Preskel t g s e ->
+             Role t -> Int -> Preskel t g s e
+addStrand g k r h =
+  newPreskel g' (shared k) insts'
+  (orderings k) (leadsto k) decls' (kfacts k) (operation k)
+  (prob k) (kpriority k) (pov k)
+  where
+    (g', inst) = mkInstance g r emptyEnv h -- Create instance
+    insts' = (insts k) ++ [inst]
+    decls' = inheritRdecls s inst (decls k)
+    s = length (insts k)
+
+rDisplace :: Algebra t p g s e c => e -> Preskel t g s e ->
+             Sid -> Sid -> [(Preskel t g s e, (g, e))]
+rDisplace e k s s' | s == s' = [(k, (gen k, e))]
+rDisplace e k s s' =
+  do
+    (s, s', subst) <- unifyStrands k s s'
+    k <- rSubst k subst
+    k <- rCompress k s s'
+    return (k, (gen k, strdUpdate
+                       (substUpdate e (snd subst))
+                       (updateStrand s s')))
+
+rSubst :: Algebra t p g s e c => Preskel t g s e ->
+          (g, s) -> [Preskel t g s e]
+rSubst k (gen, subst) =
+    do
+      (gen', insts') <- foldMapM (substInst subst) gen (insts k)
+      let decls' = declsMapTerms (substitute subst) (decls k)
+      let facts' = map (substFact subst) (kfacts k)
+      let operation' = substOper subst (operation k)
+      return $
+        newPreskel gen' (shared k) insts'
+        (orderings k) (leadsto k) decls' facts' operation'
+        (prob k) (kpriority k) (pov k)
+
+rCompress :: Algebra t p g s e c => Preskel t g s e ->
+             Sid -> Sid -> [Preskel t g s e]
+rCompress k s s' =
+    do
+      let perm = updatePerm s s' (strandids k)
+      orderings' <- normalizeOrderings True
+                    (permuteOrderings perm (orderings k))
+      return $
+        newPreskel
+        (gen k)
+        (shared k)
+        (deleteNth s (insts k))
+        orderings'
+        (permuteOrderings perm (leadsto k))
+        (declsMapStrands perm (decls k))
+        (map (updateFact $ updateStrand s s') (kfacts k))
+        (operation k)
+        (updateProb perm (prob k))
+        (updatePriority perm (kpriority k))
+        (pov k)
+
+rparam :: Algebra t p g s e c => String -> Role t ->
+          t -> Int -> t -> t -> Rewrite t g s e
+rparam name r v h z t k (g, e) =
+  case strdLookup e z of
+    Just s
+      | height inst < h -> []
+      | rname (role inst) == rname r ->
+        rParam k (g, e) t t'
+      | otherwise ->
+        do
+          (k, (g, e)) <- rDisplace e k' ns s
+          rParam k (g, e) t t'
+      where
+        inst = strandInst k s
+        t' = instantiate (env inst) v
+        k' = addStrand g k r h
+        ns = nstrands k
+    Nothing ->
+      error ("In rule " ++ name ++ ", parameter predicate for " ++
+             rname r ++ " did not get a strand")
+
+rParam :: Algebra t p g s e c => Preskel t g s e ->
+          (g, e) -> t -> t -> [(Preskel t g s e, (g, e))]
+rParam k (g, e) t t' =
+  case matched e t of
+    False ->
+      do
+        (g, e) <- match t t' (g, e)
+        return (k, (g, e))
+    True ->
+      rUnify k (g, e) (instantiate e t) t'
+
+rUnify :: Algebra t p g s e c => Preskel t g s e ->
+          (g, e) -> t -> t -> [(Preskel t g s e, (g , e))]
+rUnify k (g, e) t t' =
+  do
+    subst <- unify t t' (g, emptySubst)
+    k <- rSubst k subst
+    return (k, (gen k, substUpdate e (snd subst)))
+
+rprec :: Algebra t p g s e c => String -> NodeTerm t ->
+         NodeTerm t -> Rewrite t g s e
+rprec name (z, i) (z', i') k (g, e) =
+  case (strdLookup e z, strdLookup e z') of
+    (Just s, Just s')
+      | elem ((s, i), (s', i')) tc -> [(k, (g, e))]
+      | badIndex k s i || badIndex k s' i' -> []
+      | otherwise ->
+        do                      -- Add one ordering
+          orderings' <- normalizeOrderings True
+                        (((s, i), (s', i')) : orderings k)
+          let k' = newPreskel g (shared k) (insts k) orderings'
+                   (leadsto k) (decls k) (kfacts k) (operation k)
+                   (prob k) (kpriority k) (pov k)
+          return (k', (gen k, e))
+    _ ->
+      error ("In rule " ++ name ++ ", precidence did not get a strand")
+  where
+    tc = map graphPair $ graphClose $ graphEdges $ strands k
+
+badIndex :: Algebra t p g s e c => Preskel t g s e -> Sid -> Int -> Bool
+badIndex k s i =
+  i >= height (strandInst k s)
+
+withNewDecl :: Algebra t p g s e c => Preskel t g s e ->
+               SkelDeclarations t -> Preskel t g s e
+withNewDecl k d =
+  newPreskel (gen k) (shared k) (insts k) (orderings k)
+  (leadsto k) d (kfacts k) (operation k)
+  (prob k) (kpriority k) (pov k)
+
+rlnon :: Algebra t p g s e c => String -> t -> Rewrite t g s e
+rlnon name t k (g, e) =
+  case matched e t of
+    True
+      | elem t' (knon k) -> [(k, (g, e))]
+      | not $ isAtom t' -> []
+      | otherwise ->
+        [(k', (g, e))]
+        where
+          k' = withNewDecl k (addDeclInst "non-orig" [t'] [] (decls k))
+    False ->
+      error ("In rule " ++ name ++ ", non did not get a term")
+  where
+    t' = instantiate e t
+
+rlpnon :: Algebra t p g s e c => String -> t -> Rewrite t g s e
+rlpnon name t k (g, e) =
+  case matched e t of
+    True
+      | elem t' (kpnon k) -> [(k, (g, e))]
+      | not $ isAtom t' -> []
+      | otherwise ->
+        [(k', (g, e))]
+        where
+          k' = withNewDecl k (addDeclInst "pen-non-orig" [t'] [] (decls k))
+    False ->
+      error ("In rule " ++ name ++ ", pnon did not get a term")
+  where
+    t' = instantiate e t
+
+rluniq :: Algebra t p g s e c => String -> t -> Rewrite t g s e
+rluniq name t k (g, e) =
+  case matched e t of
+    True
+      | elem t' (dkunique $ decls k) -> [(k, (g, e))]
+      | not $ isAtom t' -> []
+      | otherwise ->
+        case originationNodes (strands k) t' of
+          (_, []) -> []
+          (_, n : _) ->
+            [(k', (g, e))]
+            where
+              k' = withNewDecl k (addDeclInst "uniq-orig" [t'] [n] (decls k))
+    False ->
+      error ("In rule " ++ name ++ ", uniq did not get a term")
+  where
+    t' = instantiate e t
+
+runiqAt :: Algebra t p g s e c => String -> t ->
+           NodeTerm t -> Rewrite t g s e
+runiqAt name t (z, i) k (g, e) =
+  case (matched e t, strdLookup e z) of
+    (True, Just s)
+      | elem (t', (s, i)) (dkuniqFull $ decls k) -> [(k, (g, e))]
+      | not $ isAtom t' -> []
+      | otherwise ->
+        [(k', (g, e))]
+        where
+          k' = withNewDecl k (addDeclInst "uniq-orig" [t'] [(s, i)] (decls k))
+    (False, _) ->
+      error ("In rule " ++ name ++ ", uniq-at did not get a term")
+    (_, Nothing) ->
+      error ("In rule " ++ name ++ ", uniq-at did not get a strand")
+  where
+    t' = instantiate e t
+
+rugenAt :: Algebra t p g s e c => String -> t ->
+           NodeTerm t -> Rewrite t g s e
+rugenAt name t (z, i) k (g, e) =
+  case (matched e t, strdLookup e z) of
+    (True, Just s)
+      | elem (t', (s, i)) (dkuniqFull $ decls k) -> [(k, (g, e))]
+      | not $ isAtom t' -> []
+      | otherwise ->
+        [(k', (g, e))]
+        where
+          k' = withNewDecl k (addDeclInst "uniq-gen" [t'] [(s, i)] (decls k))
+    (False, _) ->
+      error ("In rule " ++ name ++ ", ugen-at did not get a term")
+    (_, Nothing) ->
+      error ("In rule " ++ name ++ ", ugen-at did not get a strand")
+  where
+    t' = instantiate e t
+
+rlugen :: Algebra t p g s e c => String -> t -> Rewrite t g s e
+rlugen name t k (g, e) =
+  case matched e t of
+    True
+      | elem t' (dkuniqgen $ decls k) -> [(k, (g, e))]
+      | not $ isAtom t' -> []
+      | otherwise ->
+        case originationNodes (strands k) t' of
+          (_, []) -> []
+          (_, n : _) ->
+            [(k', (g, e))]
+            where
+              k' = withNewDecl k (addDeclInst "uniq-gen" [t'] [n] (decls k))
+    False ->
+      error ("In rule " ++ name ++ ", ugen did not get a term")
+  where
+    t' = instantiate e t
+
+rafact :: Algebra t p g s e c => String -> String -> [t] -> Rewrite t g s e
+rafact rule name fts k (g, e)
+  | elem fact (kfacts k) = [(k, (g, e))]
+  | otherwise = [(k', (gen k', e))]
+  where
+    fts' = map (rFactLookup rule e) fts
+    fact = Fact name fts'
+    k' = newPreskel
+         g (shared k) (insts k) (orderings k) (leadsto k)
+         (decls k) (fact : kfacts k)
+         (operation k) (prob k) (kpriority k) (pov k)
+
+rFactLookup :: Algebra t p g s e c => String -> e -> t -> FTerm t
+rFactLookup name e t
+  | isStrdVar t =
+    case strdLookup e t of
+      Just s -> FSid s
+      Nothing ->
+        error ("In rule " ++ name ++ ": fact did not get a strand")
+  | matched e t = FTerm $ instantiate e t
+  | otherwise =
+      error ("In rule " ++ name ++ ": fact did not get a term")
+
+req :: Algebra t p g s e c => String -> t -> t -> Rewrite t g s e
+req name x y k (g, e)
+  | isStrdVar x =
+    case (strdLookup e x, strdLookup e y) of
+      (Just s, Just t)
+        | s == t -> [(k, (g, e))]
+        | otherwise ->
+          rDisplace e (k {gen = g})  s t
+      _ ->
+        error ("In rule " ++ name ++ ", = did not get a strand")
+  | otherwise =
+    case (matched e x, matched e y) of
+      (True, True)
+        | u == v -> [(k, (g, e))]
+        | otherwise ->
+          rUnify k (g, e) u v
+      _ ->
+        error ("In rule " ++ name ++ ", = did not get a term")
+    where
+      u = instantiate e x
+      v = instantiate e y
diff --git a/src/CPSA/SAS/SAS.hs b/src/CPSA/SAS/SAS.hs
--- a/src/CPSA/SAS/SAS.hs
+++ b/src/CPSA/SAS/SAS.hs
@@ -192,33 +192,36 @@
         [t] -> return (gen', t)
         _ -> fail (shows pos "Bad variable generation")
 
--- Node to variable maps
+-- Strand to variable maps
 
--- A variable map maps nodes to variables
+-- A variable map maps strands to variables
 
-type VM t = M.Map Node t
+type VM t = M.Map Strand t
 
 -- A generator and a variable map
 type GVM g t = (g, VM t)
 
 -- Add a variable for a node if the mapping does not already exist.
 addVar :: (Algebra t p g s e c, Monad m) =>
-          Pos -> GVM g t -> Node -> m (GVM g t)
-addVar pos (gen, vm) n =
-  case M.lookup n vm of
+          Pos -> GVM g t -> Strand -> m (GVM g t)
+addVar pos (gen, vm) z =
+  case M.lookup z vm of
     Just _ -> return (gen, vm)
     Nothing ->
       do
         (gen, t) <- makeVar pos gen root -- Make the variable
-        return (gen, M.insert n t vm)
+        return (gen, M.insert z t vm)
 
--- Node lookup assumes a node will always be found.
-nlookup :: Node -> VM t -> t
-nlookup n vm =
-  case M.lookup n vm of
+-- Strand lookup assumes a strand will always be found.
+slookup :: Strand -> VM t -> t
+slookup z vm =
+  case M.lookup z vm of
     Just t -> t
-    Nothing -> error ("SAS.nlookup: cannot find " ++ show n)
+    Nothing -> error ("SAS.slookup: cannot find " ++ show z)
 
+nlookup :: Node -> VM t -> (t, Int)
+nlookup (z, i) vm = (slookup z vm, i)
+
 -- Find a protocol
 
 findProt :: Monad m => Pos -> [Prot t g c] -> [SExpr Pos] -> m (Prot t g c)
@@ -239,22 +242,28 @@
 
 type Strands = [Int]            -- [Strand height]
 
-type Node = (Int, Int)          -- (Strand, Position)
+type Strand = Int
 
+type Node = (Strand, Int)       -- (Strand, Position)
+
 type Pair = (Node, Node)        -- Precedes relation
 
+type Fact t = (String, [t])
+
 data Preskel t g c = Preskel
     { protocol :: Prot t g c,
       kgen :: g,                -- Final generator
       kvars :: [t],             -- Algebra variables
-      knodes :: [t],            -- Node variables
+      kstrands :: [t],          -- Strand variables
       insts :: [Instance t c],
-      strands :: [t],           -- A node for each instance
-      orderings :: [(t, t)],
-      succs :: [(t, t)],
+      strands :: [t],           -- A variable for each instance
+      orderings :: [((t, Int), (t, Int))],
       nons :: [t],
+      pnons :: [t],
       uniqs :: [t],
-      origs :: [(t, t)],
+      origs :: [(t, (t, Int))],
+      -- ugen, ugenAt missing!
+      facts :: [Fact t],
       isSkeleton :: Bool,
       isFringe :: !Bool,         -- Always looked at, so make it strict
       homomorphisms :: [SExpr Pos], -- Loaded later
@@ -269,23 +278,25 @@
       let heights = map height insts
       orderings <- loadOrderings heights (assoc precedesKey xs)
       nons <- loadBaseTerms kvars (assoc nonOrigKey xs)
+      pnons <- loadBaseTerms kvars (assoc pnonOrigKey xs)
       uniqs <- loadBaseTerms kvars (assoc uniqOrigKey xs)
       origs <- loadOrigs kvars heights (assoc origsKey xs)
-      let strands = map (\(s, h) -> (s, h - 1)) (zip [0..] heights)
-      (gen, varmap) <- makeVarmap pos gen strands orderings origs
+      (gen, varmap) <- makeVarmap pos gen [0..(length insts)-1]
+      facts <- mapM (loadFact kvars varmap) (assoc factsKey xs)
       let f (n0, n1) = (nlookup n0 varmap, nlookup n1 varmap)
       let g (t, n) = (t, nlookup n varmap)
       return (Preskel { protocol = prot,
                         kgen = gen,
                         kvars = kvars,
-                        knodes = M.elems varmap,
+                        kstrands = M.elems varmap,
                         insts = insts,
-                        strands = map (flip nlookup varmap) strands,
+                        strands = M.elems varmap,
                         orderings = map f orderings,
-                        succs = loadSuccs varmap,
                         nons = nons,
+                        pnons = pnons,
                         uniqs = uniqs,
                         origs = map g origs,
+                        facts = facts,
                         isSkeleton = not $ hasKey preskeletonKey xs,
                         isFringe = hasKey shapeKey xs || hasKey fringeKey xs,
                         homomorphisms = assoc mapsKey xs,
@@ -401,21 +412,6 @@
         True -> return t
         False -> fail (shows (annotation x) "Expecting an atom")
 
--- Creates the atomic formulas used to describe the strand node orderings
--- Must compute the transitive reduction of the within strand orderings
-loadSuccs :: Algebra t p g s e c => VM t -> [(t, t)]
-loadSuccs varmap =
-    concatMap f idx
-    where
-      ns = M.keys varmap               -- The set of nodes
-      ss = L.sort $ L.nub $ map fst ns -- The ordered set of strands
-      idx = [(s, is) | s <- ss,        -- The per strand indices
-                       let is = L.sort [i | (s', i) <- ns, s' == s]]
-      f (_, []) = error "SAS.loadSuccs: Bad index entry"
-      f (_, [_]) = []
-      f (s, i:i':is) =
-        (nlookup (s, i) varmap, nlookup (s, i') varmap):f(s, i':is)
-
 loadOrigs :: (Algebra t p g s e c, Monad m) => [t] -> Strands ->
              [SExpr Pos] -> m [(t, Node)]
 loadOrigs _ _ [] = return []
@@ -435,6 +431,30 @@
 loadOrig _ _ x =
     fail (shows (annotation x) "Malformed origination")
 
+-- Make a variable for each strand
+makeVarmap :: (Algebra t p g s e c, Monad m) =>
+              Pos -> g -> [Strand] -> m (GVM g t)
+makeVarmap pos g strands =
+  foldM (addVar pos) (g, M.empty) strands
+
+loadFact :: (Algebra t p g s e c, Monad m) => [t] ->
+            VM t -> SExpr Pos -> m (Fact t)
+loadFact vars varmap (L _ (S _ name : ft)) =
+  do
+    ft <- mapM (loadFactTerm vars varmap) ft
+    return (name, ft)
+loadFact _ _ x =
+  fail (shows (annotation x) "Malformed fact")
+
+loadFactTerm :: (Algebra t p g s e c, Monad m) =>
+                [t] -> VM t -> SExpr Pos -> m t
+loadFactTerm _ varmap (N pos z) =
+  case M.lookup z varmap of
+    Just t -> return t
+    Nothing -> fail $ shows pos ("Bad strand in fact: " ++ show z)
+loadFactTerm vars _ x =
+  loadTerm vars False x
+
 -- Homomorphisms
 
 -- The maps entry in a preskeleton contains a list of homomorphisms.
@@ -453,7 +473,7 @@
 loadMap pov k (L _ [L _ strandMap, L _ algebraMap]) =
     do
       perm <- mapM loadPerm strandMap -- Load the strand map
-      let nh = map (loadNodeEq k perm) (M.assocs $ varmap pov)
+      let nh = map (loadStrandEq k perm) (M.assocs $ varmap pov)
       -- Load the algebra part of the homomorphism
       ah <- mapM (loadMaplet (kvars k) (kvars pov)) algebraMap
       return (nh, ah)
@@ -463,27 +483,11 @@
 loadPerm (N _ n) | n >= 0 = return n
 loadPerm x = fail (shows (annotation x) "Expecting a natural number")
 
--- Applies a strand permutation to a node.
+-- Applies a strand permutation to a strand.
 -- Hope the strand map is valid, or !! will blow up.
-loadNodeEq :: Preskel t g c -> [Int] -> (Node, t) -> (t, t)
-loadNodeEq k perm ((s, i), v) =
-  (v, nlookup (perm !! s, i) (varmap k))
-
--- Collect all the relevant nodes and make a variable for each one.
-makeVarmap :: (Algebra t p g s e c, Monad m) => Pos ->
-              g -> [Node] -> [Pair] -> [(t, Node)] -> m (GVM g t)
-makeVarmap pos g strands orderings origs =
-  do
-    gvm <- foldM fht (g, M.empty) strands
-    gvm <- foldM fodr gvm orderings
-    foldM forg  gvm origs
-  where
-    fht gvm n = addVar pos gvm n
-    fodr gvm (n0, n1) =
-      do
-        gvm <- addVar pos gvm n0
-        addVar pos gvm n1
-    forg gvm (_, n) = addVar pos gvm n
+loadStrandEq :: Preskel t g c -> [Int] -> (Strand, t) -> (t, t)
+loadStrandEq k perm (z, v) =
+  (v, slookup (perm !! z) (varmap k))
 
 -- Association lists
 
@@ -523,6 +527,10 @@
 nonOrigKey :: String
 nonOrigKey = "non-orig"
 
+-- The key used in preskeletons for penetrator non-originating atoms
+pnonOrigKey :: String
+pnonOrigKey = "pen-non-orig"
+
 -- The key used in preskeletons for uniquely originating atoms
 uniqOrigKey :: String
 uniqOrigKey = "uniq-orig"
@@ -531,6 +539,10 @@
 origsKey :: String
 origsKey = "origs"
 
+-- The key used to extract facts
+factsKey :: String
+factsKey = "facts"
+
 type Analysis t g c = (Preskel t g c, [(Homo t, Preskel t g c)])
 
 loadAnalysis :: (Algebra t p g s e c, Monad m) => Preskel t g c ->
@@ -560,7 +572,7 @@
 reduceShape pov (homo, k) =
   (mapHomo env homo, mapSkel env pov k)
   where
-    env = snd $head $ homoEnv (kgen k) homo
+    env = snd $ head $ homoEnv (kgen k) homo
 
 -- Compute a substition for equalities that equate two variables
 -- of the same sort.
@@ -602,19 +614,23 @@
            Preskel t g c -> Preskel t g c
 mapSkel env pov k =
   k { kvars = vs L.\\ kvars pov, -- Delete redundant POV variables
-      knodes = ns L.\\ knodes pov,
+      kstrands = zs L.\\ kstrands pov,
       insts = map (mapInst env) (insts k),
-      strands = map (instantiate env) (strands k),
+      strands = zs,
       orderings = mapPair (instantiate env) (orderings k),
-      succs = mapPair (instantiate env) (succs k),
       nons = map (instantiate env) (nons k),
+      pnons = map (instantiate env) (pnons k),
       uniqs = map (instantiate env) (uniqs k),
-      origs = mapPair (instantiate env) (origs k),
+      origs = mapOrig (instantiate env) (origs k),
+      facts = mapFact (instantiate env) (facts k),
       varmap = M.map (instantiate env) (varmap k) }
   where
     vs = map (instantiate env) (kvars k)
-    ns = map (instantiate env) (knodes k)
-    mapPair f l = map (\(a,b) -> (f a, f b)) l
+    zs = map (instantiate env) (kstrands k)
+    mapNode f (z, i) = (f z, i)
+    mapPair f l = map (\(a, b) -> (mapNode f a, mapNode f b)) l
+    mapOrig f l = map (\(a, b) -> (f a, mapNode f b)) l
+    mapFact f l = map (\(name, ft) -> (name, map f ft)) l
 
 -- Formula printing
 
@@ -642,17 +658,19 @@
 skel :: Algebra t p g s e c => c -> Preskel t g c ->
         (c, [SExpr ()], [SExpr ()])
 skel ctx k =
-  let vars = kvars k ++ knodes k in
+  let vars = kvars k ++ kstrands k in
   let kctx = addToContext ctx vars in
-  let nodes = displayVars kctx (knodes k) in
+  let strds = displayVars kctx (kstrands k) in
   (kctx,
-   displayVars kctx (kvars k) ++ listMap node nodes,
-   map (nodeForm kctx k) (M.assocs (varmap k)) ++
-   concatMap (strandForm kctx) (zip (strands k) $ insts k) ++
+   displayVars kctx (kvars k) ++ listMap strd strds,
+   map (lengthForm kctx k) (M.assocs (varmap k)) ++
+   concatMap (paramForm kctx) (zip (strands k) $ insts k) ++
    map (precForm kctx) (orderings k) ++
-   map (sprecForm kctx) (succs k) ++
    map (unary "non" kctx) (nons k) ++
-   map (uniqForm kctx) (origs k))
+   map (unary "pnon" kctx) (pnons k) ++
+   -- Not possible map (unary "uniq" kctx) (noOrigUniqs k) ++
+   map (uniqAtForm kctx) (origs k) ++
+   map (factForm kctx) (facts k))
 
 -- map through lists in an S-Expression.
 listMap :: ([SExpr ()] -> [SExpr ()]) -> [SExpr ()] -> [SExpr ()]
@@ -660,49 +678,49 @@
 listMap f (L () xs : ys) = L () (f xs) : listMap f ys
 listMap f (y : ys) = y : listMap f ys
 
--- Replace "mesg" as the sort in the list with "node"
-node :: [SExpr ()] -> [SExpr ()]
-node [] = error "SAS.node: empty list as argument"
-node [_] = [S () "node"]
-node (v : vs) = v : node vs
+-- Replace "mesg" as the sort in the list with "strd"
+strd :: [SExpr ()] -> [SExpr ()]
+strd [] = error "SAS.strd: empty list as argument"
+strd [_] = [S () "strd"]
+strd (v : vs) = v : strd vs
 
 -- Creates the atomic formulas used to describe an instance of a role
-nodeForm :: Algebra t p g s e c => c -> Preskel t g c ->
-            (Node, t) -> SExpr ()
-nodeForm c k ((s, i), n) =
+lengthForm :: Algebra t p g s e c => c -> Preskel t g c ->
+              (Strand, t) -> SExpr ()
+lengthForm c k (z, n) =
     L () [S () "p",
           Q () $ rname $ role inst,  -- Name of the role
-          N () $ i,
-          displayTerm c n]
+          displayTerm c n,
+          N () $ height inst]
     where
-      inst = insts k !! s
+      inst = insts k !! z
 
 quote :: SExpr () -> SExpr ()
 quote (S () str) = Q () str
 quote x = x
 
 -- Creates the atomic formulas used to describe an instance of a role
-strandForm :: Algebra t p g s e c => c -> (t, Instance t c) -> [SExpr ()]
-strandForm c (s, inst) =
+paramForm :: Algebra t p g s e c => c -> (t, Instance t c) -> [SExpr ()]
+paramForm c (z, inst) =
     map f (env inst)
     where
       f (x, t) =
           L () [S () "p",
                 Q () $ rname $ role inst,  -- Name of the role
                 quote $ displayTerm (ctx $ role inst) x,
-                displayTerm c s,
+                displayTerm c z,
                 displayTerm c t]
 
 -- Creates the atomic formula used to describe a node ordering relation
-precForm :: Algebra t p g s e c => c -> (t, t) -> SExpr ()
-precForm = binary "prec"
+precForm :: Algebra t p g s e c => c -> ((t, Int), (t, Int)) -> SExpr ()
+precForm = quaternary "prec"
 
--- Creates the atomic formula used to describe a strand node ordering
-sprecForm :: Algebra t p g s e c => c -> (t, t) -> SExpr ()
-sprecForm = binary "str-prec"
+uniqAtForm :: Algebra t p g s e c => c -> (t, (t, Int)) -> SExpr ()
+uniqAtForm = ternary "uniq-at"
 
-uniqForm :: Algebra t p g s e c => c -> (t, t) -> SExpr ()
-uniqForm = binary "uniq-at"
+factForm :: Algebra t p g s e c => c -> (String, [t]) -> SExpr ()
+factForm c (name, ft) =
+  L () (S () "fact" : S () name : map (displayTerm c) ft)
 
 -- Creates a formula associated with a shape.  It is a disjunction of
 -- existentially quantified formulas that describe the homomorphism
@@ -712,7 +730,7 @@
 shape c pov ((nh, ah), shape) =
   let (ctx, vars, conj) = skel c shape in
   let n = map (displayEq ctx) nh in
-  let a = map (displayEq ctx) ah in
+  let a = map (displayEq ctx) ah in -- List diff on S-Exprs
   quantify "exists" vars (conjoin (n ++ a ++ (conj L.\\ pov)))
 
 displayEq :: Algebra t p g s e c => c -> (t, t) -> SExpr ()
@@ -727,6 +745,16 @@
 binary :: Algebra t p g s e c => String -> c -> (t, t) -> SExpr ()
 binary pred ctx (t0, t1) =
     L () [S () pred, displayTerm ctx t0, displayTerm ctx t1]
+
+ternary :: Algebra t p g s e c => String -> c ->
+           (t, (t, Int)) -> SExpr ()
+ternary pred ctx (t0, (t1, i1)) =
+    L () [S () pred, displayTerm ctx t0, displayTerm ctx t1, N () i1]
+
+quaternary :: Algebra t p g s e c => String -> c ->
+              ((t, Int), (t, Int)) -> SExpr ()
+quaternary pred ctx ((t0, i0), (t1, i1)) =
+    L () [S () pred, displayTerm ctx t0, N () i0, displayTerm ctx t1, N () i1]
 
 quantify :: String -> [SExpr ()] -> SExpr () -> SExpr ()
 quantify _ [] form = form
diff --git a/tst/aik.tst b/tst/aik.tst
--- a/tst/aik.tst
+++ b/tst/aik.tst
@@ -1,6 +1,6 @@
 (herald "Anonymous identity protocol from TCG")
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from aik.scm")
 
 (defprotocol aikprot basic
diff --git a/tst/axiom2.tst b/tst/axiom2.tst
--- a/tst/axiom2.tst
+++ b/tst/axiom2.tst
@@ -1,6 +1,6 @@
 (herald "Axiom 2 Protocol" (bound 20))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from axiom2.scm")
 (comment "Strand count bounded at 20")
 
diff --git a/tst/blanchet.tst b/tst/blanchet.tst
--- a/tst/blanchet.tst
+++ b/tst/blanchet.tst
@@ -1,7 +1,7 @@
 (herald "Blanchet's Simple Example Protocol"
   (comment "There is a flaw in this protocol by design"))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from blanchet.scm")
 
 (defprotocol blanchet basic
diff --git a/tst/bltk_test.tst b/tst/bltk_test.tst
--- a/tst/bltk_test.tst
+++ b/tst/bltk_test.tst
@@ -1,6 +1,6 @@
 (herald "bltk Test File" (algebra diffie-hellman) (bound 12))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from bltk_test.scm")
 
 (defprotocol test diffie-hellman
diff --git a/tst/dh-ca.tst b/tst/dh-ca.tst
--- a/tst/dh-ca.tst
+++ b/tst/dh-ca.tst
@@ -1,6 +1,6 @@
 (herald dhca (algebra diffie-hellman))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from dh-ca.scm")
 
 (defprotocol dhca diffie-hellman
diff --git a/tst/dh_mim.tst b/tst/dh_mim.tst
--- a/tst/dh_mim.tst
+++ b/tst/dh_mim.tst
@@ -1,7 +1,7 @@
 (herald "Diffie-Hellman protocol, man-in-the-middle attack"
   (algebra diffie-hellman))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from dh_mim.scm")
 
 (defprotocol dh_mim diffie-hellman
diff --git a/tst/dh_mim2.tst b/tst/dh_mim2.tst
--- a/tst/dh_mim2.tst
+++ b/tst/dh_mim2.tst
@@ -1,7 +1,7 @@
 (herald "Diffie-Hellman protocol, man-in-the-middle attack"
   (algebra diffie-hellman))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from dh_mim2.scm")
 
 (defprotocol dh_mim diffie-hellman
diff --git a/tst/dh_sig.tst b/tst/dh_sig.tst
--- a/tst/dh_sig.tst
+++ b/tst/dh_sig.tst
@@ -1,6 +1,6 @@
 (herald "Signed DH exchange" (algebra diffie-hellman))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from dh_sig.scm")
 
 (defprotocol dh_sig diffie-hellman
diff --git a/tst/dh_test.tst b/tst/dh_test.tst
--- a/tst/dh_test.tst
+++ b/tst/dh_test.tst
@@ -1,7 +1,7 @@
 (herald "Diffie-Hellman protocol, man-in-the-middle attack"
   (algebra diffie-hellman) (bound 20))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from dh_test.scm")
 (comment "Strand count bounded at 20")
 
diff --git a/tst/dhnsl_basic.tst b/tst/dhnsl_basic.tst
--- a/tst/dhnsl_basic.tst
+++ b/tst/dhnsl_basic.tst
@@ -1,7 +1,7 @@
 (herald "Diffie-Hellman enhanced Needham-Schroeder-Lowe Protocol"
   (algebra diffie-hellman))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from dhnsl_basic.scm")
 
 (defprotocol dhnsl diffie-hellman
diff --git a/tst/dhnsl_use.tst b/tst/dhnsl_use.tst
--- a/tst/dhnsl_use.tst
+++ b/tst/dhnsl_use.tst
@@ -1,7 +1,7 @@
 (herald "Diffie-Hellman enhanced Needham-Schroeder-Lowe Protocol"
   (algebra diffie-hellman))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from dhnsl_use.scm")
 
 (defprotocol dhnsl diffie-hellman
diff --git a/tst/enrich.tst b/tst/enrich.tst
--- a/tst/enrich.tst
+++ b/tst/enrich.tst
@@ -1,6 +1,6 @@
 (herald enrich)
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from enrich.scm")
 
 (defprotocol enrich basic
diff --git a/tst/envelope.tst b/tst/envelope.tst
--- a/tst/envelope.tst
+++ b/tst/envelope.tst
@@ -1,6 +1,6 @@
 (herald "Envelope Protocol" (bound 20))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from envelope.scm")
 (comment "Strand count bounded at 20")
 
diff --git a/tst/ffgg.tst b/tst/ffgg.tst
--- a/tst/ffgg.tst
+++ b/tst/ffgg.tst
@@ -1,7 +1,7 @@
 (herald "The ffgg Protocol"
   (comment "From A Necessarily Parallel Attack by Jon K. Millen"))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from ffgg.scm")
 
 (defprotocol ffgg basic
diff --git a/tst/fnof_or.tst b/tst/fnof_or.tst
--- a/tst/fnof_or.tst
+++ b/tst/fnof_or.tst
@@ -2,7 +2,7 @@
   (comment
     "Version using variables of sort mesg, with ltk function emulated."))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from fnof_or.scm")
 
 (defprotocol or basic
diff --git a/tst/fnof_test.tst b/tst/fnof_test.tst
--- a/tst/fnof_test.tst
+++ b/tst/fnof_test.tst
@@ -1,7 +1,7 @@
 (herald "Function constraint test protocol"
   (comment "Skeletons 2, 4, and 7 should have no shapes."))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from fnof_test.scm")
 
 (defprotocol fnoftest basic
diff --git a/tst/fnof_woolam.tst b/tst/fnof_woolam.tst
--- a/tst/fnof_woolam.tst
+++ b/tst/fnof_woolam.tst
@@ -1,6 +1,6 @@
 (herald "Woo-Lam Protocol, using fnof to emulate ltk function")
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from fnof_woolam.scm")
 
 (defprotocol woolam basic
diff --git a/tst/fnof_yahalom.tst b/tst/fnof_yahalom.tst
--- a/tst/fnof_yahalom.tst
+++ b/tst/fnof_yahalom.tst
@@ -2,7 +2,7 @@
   "Yahalom Protocol with Forwarding Removed, using fnof to emulate ltk function"
   (bound 12))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from fnof_yahalom.scm")
 
 (defprotocol yahalom basic
diff --git a/tst/goals.scm b/tst/goals.scm
--- a/tst/goals.scm
+++ b/tst/goals.scm
@@ -20,35 +20,35 @@
   (comment "Needham-Schroeder with no role origination assumptions"))
 
 (defgoal ns
-  (forall ((b name) (n1 text) (z0 node))
+  (forall ((b name) (n1 text) (z0 strd))
     (implies
-     (and (p "init" 2 z0)
+     (and (p "init" z0 3)
       (p "init" "n1" z0 n1) (p "init" "b" z0 b)
       (non (privk b)) (uniq n1))
-     (exists ((z1 node))
-	     (and (p "resp" 1 z1) (p "resp" "b" z1 b)))))
+     (exists ((z1 strd))
+	     (and (p "resp" z1 2) (p "resp" "b" z1 b)))))
   (comment "Initiator point of view")
   (comment "Authentication goal: agreement on name b"))
 
 (defgoal ns
-  (forall ((b name) (n1 text) (z0 node))
+  (forall ((b name) (n1 text) (z0 strd))
     (implies
-     (and (p "init" 2 z0)
+     (and (p "init" z0 3)
       (p "init" "n1" z0 n1) (p "init" "b" z0 b)
       (non (privk b)) (uniq n1))
-     (exists ((z1 node))
-	     (and (p "resp" 1 z1) (p "resp" "b" z1 b)
-	      (prec z1 z0)))))
+     (exists ((z1 strd))
+	     (and (p "resp" z1 2) (p "resp" "b" z1 b)
+	      (prec z1 1 z0 2)))))
   (comment "Prec example"))
 
 (defgoal ns
-  (forall ((a b name) (n2 text) (z0 node))
+  (forall ((a b name) (n2 text) (z0 strd))
     (implies
-     (and (p "resp" 2 z0) (p "resp" "n2" z0 n2)
+     (and (p "resp" z0 3) (p "resp" "n2" z0 n2)
       (p "resp" "a" z0 a) (p "resp" "b" z0 b)
       (non (privk a)) (uniq n2))
-     (exists ((z1 node))
-      (and (p "init" 1 z1) (p "init" "b" z1 b)))))
+     (exists ((z1 strd))
+      (and (p "init" z1 2) (p "init" "b" z1 b)))))
   (comment "Responder point of view")
   (comment "Failed authentication goal: agreement on name b"))
 
@@ -68,22 +68,22 @@
   (comment "Needham-Schroeder-Lowe with no role origination assumptions"))
 
 (defgoal nsl
-  (forall ((a b name) (n2 text) (z0 node))
+  (forall ((a b name) (n2 text) (z0 strd))
     (implies
-     (and (p "resp" 2 z0) (p "resp" "n2" z0 n2)
+     (and (p "resp" z0 3) (p "resp" "n2" z0 n2)
       (p "resp" "a" z0 a) (p "resp" "b" z0 b)
       (non (privk a)) (uniq n2))
-     (exists ((z1 node))
-      (and (p "init" 1 z1) (p "init" "b" z1 b)))))
+     (exists ((z1 strd))
+      (and (p "init" z1 2) (p "init" "b" z1 b)))))
   (comment "Responder point of view")
   (comment "Authentication goal: agreement on name b"))
 
 (defgoal ns
-  (forall ((a b name) (n1 text) (z0 z1 node))
+  (forall ((a b name) (n1 text) (z0 z1 strd))
     (implies
-     (and (p "init" 2 z0) (p "init" "n1" z0 n1)
+     (and (p "init" z0 3) (p "init" "n1" z0 n1)
       (p "init" "a" z0 a) (p "init" "b" z0 b)
-      (p "" 0 z1) (p "" "x" z1 n1)
+      (p "" z1 1) (p "" "x" z1 n1)
       (non (privk a)) (non (privk b)) (uniq n1))
      (false)))
   (comment "Initiator point of view")
@@ -104,14 +104,14 @@
 
 (defgoal unilateral
   (forall ((a name) (n text)
-           (z0 node))
+           (z0 strd))
    (implies
-    (and (p "init" 1 z0)
+    (and (p "init" z0 2)
      (p "init" "n" z0 n)
      (p "init" "a" z0 a)
      (non (privk a)) (uniq n))
-    (exists ((z1 node))
-     (and (p "resp" 1 z1)
+    (exists ((z1 strd))
+     (and (p "resp" z1 2)
       (p "resp" "a" z1 a)))))
   (comment "Unilateral authentication goal"))
 
@@ -120,12 +120,12 @@
 ;;; Note that the goal requires translation of some of the role
 ;;; specific predicates.
 (defgoal ns
-  (forall ((a name) (n text) (z0 node))
+  (forall ((a name) (n text) (z0 strd))
    (implies
-    (and (p "init" 1 z0) (p "init" "n1" z0 n)
+    (and (p "init" z0 2) (p "init" "n1" z0 n)
      (p "init" "b" z0 a) (non (privk a)) (uniq n))
-    (exists ((z1 node))
-     (and (p "resp" 1 z1) (p "resp" "b" z1 a)))))
+    (exists ((z1 strd))
+     (and (p "resp" z1 2) (p "resp" "b" z1 a)))))
   (comment "Initiator authentication goal")
   (comment "Same as unilateral goal under the predicate mapping:")
   (comment (p "init" "n") "->" (p "init" "n1") "and")
@@ -135,12 +135,12 @@
 ;;; Does responder satisfy the unilateral authentication goal?
 
 (defgoal ns
-  (forall ((a name) (n text) (z0 node))
+  (forall ((a name) (n text) (z0 strd))
    (implies
-    (and (p "resp" 2 z0) (p "resp" "n2" z0 n)
+    (and (p "resp" z0 3) (p "resp" "n2" z0 n)
      (p "resp" "a" z0 a) (non (privk a)) (uniq n))
-    (exists ((z1 node))
-     (and (p "init" 2 z1) (p "init" "a" z1 a)))))
+    (exists ((z1 strd))
+     (and (p "init" z1 3) (p "init" "a" z1 a)))))
   (comment "Responder authentication goal")
   (comment "Same as unilateral goal under the predicate mapping:")
   (comment (p "init" 1) "->" (p "resp" 2) "and")
@@ -150,51 +150,47 @@
   (comment (p "resp" "a") "->" (p "init" "a")))
 
 (defgoal ns
-  (forall ((a b name) (n text) (z0 node))
+  (forall ((a b name) (n text) (z0 strd))
     (implies
      (and
-      (p "init" 1 z0) (p "init" "n1" z0 n)
+      (p "init" z0 2) (p "init" "n1" z0 n)
       (p "init" "a" z0 a) (p "init" "b" z0 b)
       (non (privk a)) (non (privk b)) (uniq n))
-     (exists ((z1 node))
-      (and (p "resp" 1 z1) (p "resp" "b" z1 b)))))
-  (forall ((a b name) (n text) (z0 node))
+     (exists ((z1 strd))
+      (and (p "resp" z1 2) (p "resp" "b" z1 b)))))
+  (forall ((a b name) (n text) (z0 strd))
    (implies
      (and
-      (p "init" 1 z0) (p "init" "n1" z0 n)
+      (p "init" z0 2) (p "init" "n1" z0 n)
       (p "init" "a" z0 a) (p "init" "b" z0 b)
       (non (privk a)) (non (privk b)) (uniq n))
-     (exists ((z1 node))
-      (and (p "resp" 1 z1) (p "resp" "a" z1 a)))))
+     (exists ((z1 strd))
+      (and (p "resp" z1 2) (p "resp" "a" z1 a)))))
   (comment "Two initiator authentication goals"))
 
 ;;; The shape analysis sentence as input (kind of useless)
 
 (defgoal ns
-  (forall ((n1 n2 text) (b a name) (z z-0 node))
+  (forall ((n1 n2 text) (b a name) (z strd))
     (implies
-      (and (p "init" 0 z) (p "init" 2 z-0)
-        (p "init" "n1" z-0 n1) (p "init" "n2" z-0 n2)
-        (p "init" "a" z-0 a) (p "init" "b" z-0 b)
-        (str-prec z z-0) (non (privk b)) (uniq-at n1 z))
-      (exists ((n2-0 text) (z-1 z-2 z-3 node))
-        (and (p "init" 1 z-1) (p "resp" 0 z-2)
-          (p "resp" 1 z-3) (p "resp" "n2" z-3 n2-0)
-          (p "resp" "n1" z-3 n1) (p "resp" "b" z-3 b)
-          (p "resp" "a" z-3 a) (prec z z-2) (prec z-3 z-1)
-          (str-prec z z-1) (str-prec z-1 z-0)
-          (str-prec z-2 z-3)))))
+      (and (p "init" z 3) (p "init" "n1" z n1) (p "init" "n2" z n2)
+        (p "init" "a" z a) (p "init" "b" z b) (non (privk b))
+        (uniq-at n1 z 0))
+      (exists ((n2-0 text) (z-0 strd))
+        (and (p "resp" z-0 2) (p "resp" "n2" z-0 n2-0)
+          (p "resp" "n1" z-0 n1) (p "resp" "b" z-0 b)
+          (p "resp" "a" z-0 a) (prec z 0 z-0 0) (prec z-0 1 z 1)))))
   (comment "Shape analysis sentence"))
 
 ;;; Section 2 --- Additional Examples
 
 (defgoal ns
-  (forall ((a b name) (n2 text) (z0 z1 node))
+  (forall ((a b name) (n2 text) (z0 z1 strd))
     (implies
      (and
-      (p "resp" 2 z0) (p "resp" "n2" z0 n2)
+      (p "resp" z0 3) (p "resp" "n2" z0 n2)
       (p "resp" "a" z0 a) (p "resp" "b" z0 b)
-      (p "" 0 z1) (p "" "x" z1 n2)
+      (p "" z1 1) (p "" "x" z1 n2)
       (non (privk a)) (non (privk b)) (uniq n2))
      (false)))
   (comment "Responder point of view")
@@ -208,17 +204,14 @@
   (non-orig (privk b) (privk a))
   (uniq-orig n1 n1-0)
   (goals
-   (forall ((n1 n1-0 n2 n2-0 text) (a b name) (z z-0 z-1 z-2 node))
+  (forall ((n1 n1-0 n2 n2-0 text) (a b name) (z z-0 strd))
     (implies
-     (and
-      (p "init" 0 z) (p "init" 2 z-0) (p "init" 0 z-1)
-      (p "init" 2 z-2) (p "init" "n1" z-0 n1) (p "init" "n2" z-0 n2)
-      (p "init" "a" z-0 a) (p "init" "b" z-0 b)
-      (p "init" "n1" z-2 n1-0) (p "init" "n2" z-2 n2-0)
-      (p "init" "a" z-2 a) (p "init" "b" z-2 b) (str-prec z z-0)
-      (str-prec z-1 z-2) (non (privk a)) (non (privk b))
-      (uniq-at n1 z) (uniq-at n1-0 z-1))
-     (= z-1 z))))
+      (and (p "init" z 3) (p "init" z-0 3) (p "init" "n1" z n1)
+        (p "init" "n2" z n2) (p "init" "a" z a) (p "init" "b" z b)
+        (p "init" "n1" z-0 n1-0) (p "init" "n2" z-0 n2-0)
+        (p "init" "a" z-0 a) (p "init" "b" z-0 b) (non (privk a))
+        (non (privk b)) (uniq-at n1 z 0) (uniq-at n1-0 z-0 0))
+      (= z z-0))))
   (comment "Double initiator point of view"))
 
 (defprotocol nsl-typeless basic
@@ -238,154 +231,10 @@
 
 ;;; The responder point of view
 (defgoal nsl-typeless
-  (forall ((n2 text) (a b name) (z z-0 node))
+  (forall ((n2 text) (a b name) (z z-0 strd))
     (implies
-      (and (p "resp" 1 z) (p "" 0 z-0)
+      (and (p "resp" z 2) (p "" z-0 1)
         (p "resp" "n2" z n2) (p "resp" "b" z b) (p "resp" "a" z a)
         (p "" "x" z-0 n2) (non (privk a)) (non (privk b)) (uniq n2))
       (false)))
   (comment "Shows typeflaw in typeless NSL"))
-
-(defskeleton ns
-  (vars (a name) (n2 text))
-  (defstrand resp 3 (a a) (n2 n2))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (goals
-   (forall ((n1 n2 text) (a b name) (z z-0 node))
-    (implies
-      (and (p "init" 0 z) (p "init" 2 z-0)
-        (p "init" "n1" z-0 n1) (p "init" "n2" z-0 n2)
-        (p "init" "a" z-0 a) (p "init" "b" z-0 b)
-        (str-prec z z-0) (non (privk a)) (non (privk b))
-        (uniq-at n1 z))
-      (exists ((z-1 z-2 z-3 node))
-        (and (p "init" 1 z-1) (p "resp" 0 z-2)
-          (p "resp" 1 z-3) (p "resp" "n2" z-3 n2)
-          (p "resp" "n1" z-3 n1) (p "resp" "b" z-3 b)
-          (p "resp" "a" z-3 a) (prec z z-2) (prec z-3 z-1)
-          (str-prec z z-1) (str-prec z-1 z-0)
-          (str-prec z-2 z-3))))))
-  (comment "Responder point of view with SAS"))
-
-(defskeleton ns
-  (vars (a name) (n2 text))
-  (defstrand resp 3 (a a) (n2 n2))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (goals
-   (forall ((n1 n2 text) (a b name) (z z-0 node))
-    (implies
-      (and (p "init" 0 z) (p "init" 2 z-0)
-        (p "init" "n1" z-0 n1) (p "init" "n2" z-0 n2)
-        (p "init" "a" z-0 a) (p "init" "b" z-0 b)
-        (str-prec z z-0) (non (privk a)) (non (privk b))
-        (uniq-at n1 z))
-      (false))))
-  (comment "Responder point of view with false as the conclusion"))
-
-(defskeleton ns
-  (vars (a b name) (n1 text))
-  (defstrand init 3 (a a) (b b) (n1 n1))
-  (non-orig (privk b) (privk a))
-  (uniq-orig n1)
-  (goals
-   (forall ((n1 n2 text) (a b name) (z z-0 node))
-    (implies
-      (and (p "init" 0 z) (p "init" 2 z-0)
-        (p "init" "n1" z-0 n1) (p "init" "n2" z-0 n2)
-        (p "init" "a" z-0 a) (p "init" "b" z-0 b)
-        (str-prec z z-0) (non (privk a)) (non (privk b))
-        (uniq-at n1 z))
-      (false))))
-  (comment "Initiator point of view with false as the conclusion"))
-
-(defgoal ns
-  (forall ((a b name) (n text) (z0 node))
-   (implies
-    (and
-     (p "resp" 2 z0) (p "resp" "n2" z0 n)
-     (p "resp" "a" z0 a) (p "resp" "b" z0 b)
-     (non (privk a)) (non (privk b)) (uniq n))
-    (exists ((z1 node))
-     (and (p "init" 2 z1) (p "init" "a" z1 a)))))
-  (forall ((a b name) (n text) (z0 node))
-   (implies
-    (and
-     (p "resp" 2 z0) (p "resp" "n2" z0 n)
-     (p "resp" "a" z0 a) (p "resp" "b" z0 b)
-     (non (privk a)) (non (privk b)) (uniq n))
-    (exists ((z1 node))
-     (and (p "init" 2 z1) (p "init" "b" z1 b)))))
-  (comment "Two responder authentication goals"))
-
-;;; Needham-Schroeder Protocol with origination assumptions on roles
-
-(defprotocol ns-role-origs basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace
-     (send (enc n1 a (pubk b)))
-     (recv (enc n1 n2 (pubk a)))
-     (send (enc n2 (pubk b))))
-    (non-orig (privk b))
-    (uniq-orig n1))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace
-     (recv (enc n1 a (pubk b)))
-     (send (enc n1 n2 (pubk a)))
-     (recv (enc n2 (pubk b))))
-    (non-orig (privk a))
-    (uniq-orig n2))
-  (comment "Needham-Schroeder with role assumptions that are too strong"))
-
-;;; The initiator point of view
-(defskeleton ns-role-origs
-  (vars)
-  (defstrand init 3))
-
-;;; The responder point of view
-(defskeleton ns-role-origs
-  (vars)
-  (defstrand resp 3))
-
-;;; Needham-Schroeder Protocol with a doubled nonce.  Look at the
-;;; first message in each role.
-
-(defprotocol ns2 basic
-  (defrole init
-    (vars (a b name) (n1 n2 n3 text))
-    (trace
-     (send (enc n1 n3 a (pubk b)))
-     (recv (enc n1 n2 (pubk a)))
-     (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace
-     (recv (enc n1 n1 a (pubk b)))
-     (send (enc n1 n2 (pubk a)))
-     (recv (enc n2 (pubk b))))
-    (note doubled nonce in the first message))
-  (note that this protocol is derived from Needham-Schroeder))
-
-(defskeleton ns2
-  (vars (a b name) (n1 text))
-  (defstrand init 3 (a a) (b b) (n1 n1))
-  (non-orig (privk b) (privk a))
-  (uniq-orig n1)
-  (note the disappearance of this note))
-
-;;; Note that the association list style key-value pairs that follow
-;;; the list of strands can be supplied in any order, and values with
-;;; the same key are appended together.  Check the output to see how
-;;; CPSA interprets this input.
-(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
-  (non-orig (privk b))
-  (precedes ((0 0) (1 0)))
-  (non-orig (privk a))
-  (uniq-orig n1)
-  (precedes ((1 1) (0 1))))
diff --git a/tst/goals.tst b/tst/goals.tst
--- a/tst/goals.tst
+++ b/tst/goals.tst
@@ -1,6 +1,6 @@
 (herald goals)
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from goals.scm")
 
 (defprotocol ns basic
@@ -20,12 +20,12 @@
   (non-orig (privk b))
   (uniq-orig n1)
   (goals
-    (forall ((b name) (n1 text) (z0 node))
+    (forall ((b name) (n1 text) (z0 strd))
       (implies
-        (and (p "init" 2 z0) (p "init" "n1" z0 n1) (p "init" "b" z0 b)
+        (and (p "init" z0 3) (p "init" "n1" z0 n1) (p "init" "b" z0 b)
           (non (privk b)) (uniq n1))
-        (exists ((z1 node))
-          (and (p "resp" 1 z1) (p "resp" "b" z1 b))))))
+        (exists ((z1 strd))
+          (and (p "resp" z1 2) (p "resp" "b" z1 b))))))
   (comment "Initiator point of view"
     "Authentication goal: agreement on name b")
   (traces
@@ -76,12 +76,12 @@
   (non-orig (privk b))
   (uniq-orig n1)
   (goals
-    (forall ((b name) (n1 text) (z0 node))
+    (forall ((b name) (n1 text) (z0 strd))
       (implies
-        (and (p "init" 2 z0) (p "init" "n1" z0 n1) (p "init" "b" z0 b)
+        (and (p "init" z0 3) (p "init" "n1" z0 n1) (p "init" "b" z0 b)
           (non (privk b)) (uniq n1))
-        (exists ((z1 node))
-          (and (p "resp" 1 z1) (p "resp" "b" z1 b) (prec z1 z0))))))
+        (exists ((z1 strd))
+          (and (p "resp" z1 2) (p "resp" "b" z1 b) (prec z1 1 z0 2))))))
   (comment "Prec example")
   (traces
     ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
@@ -108,7 +108,7 @@
   (parent 2)
   (unrealized)
   (shape)
-  (satisfies (no (b b) (n1 n1) (z0 (0 2))))
+  (satisfies (no (b b) (n1 n1) (z0 0)))
   (maps ((0) ((b b) (n1 n1) (a a) (n2 n2))))
   (origs (n1 (0 0))))
 
@@ -131,12 +131,12 @@
   (non-orig (privk a))
   (uniq-orig n2)
   (goals
-    (forall ((a b name) (n2 text) (z0 node))
+    (forall ((a b name) (n2 text) (z0 strd))
       (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
+        (and (p "resp" z0 3) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
           (p "resp" "b" z0 b) (non (privk a)) (uniq n2))
-        (exists ((z1 node))
-          (and (p "init" 1 z1) (p "init" "b" z1 b))))))
+        (exists ((z1 strd))
+          (and (p "init" z1 2) (p "init" "b" z1 b))))))
   (comment "Responder point of view"
     "Failed authentication goal: agreement on name b")
   (traces
@@ -165,7 +165,7 @@
   (parent 4)
   (unrealized)
   (shape)
-  (satisfies (no (a a) (b b) (n2 n2) (z0 (0 2))))
+  (satisfies (no (a a) (b b) (n2 n2) (z0 0)))
   (maps ((0) ((a a) (b b) (n2 n2) (n1 n1))))
   (origs (n2 (0 1))))
 
@@ -189,12 +189,12 @@
   (non-orig (privk a))
   (uniq-orig n2)
   (goals
-    (forall ((a b name) (n2 text) (z0 node))
+    (forall ((a b name) (n2 text) (z0 strd))
       (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
+        (and (p "resp" z0 3) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
           (p "resp" "b" z0 b) (non (privk a)) (uniq n2))
-        (exists ((z1 node))
-          (and (p "init" 1 z1) (p "init" "b" z1 b))))))
+        (exists ((z1 strd))
+          (and (p "init" z1 2) (p "init" "b" z1 b))))))
   (comment "Responder point of view"
     "Authentication goal: agreement on name b")
   (traces
@@ -247,10 +247,10 @@
   (non-orig (privk a) (privk b))
   (uniq-orig n1)
   (goals
-    (forall ((a b name) (n1 text) (z0 z1 node))
+    (forall ((a b name) (n1 text) (z0 z1 strd))
       (implies
-        (and (p "init" 2 z0) (p "init" "n1" z0 n1) (p "init" "a" z0 a)
-          (p "init" "b" z0 b) (p "" 0 z1) (p "" "x" z1 n1)
+        (and (p "init" z0 3) (p "init" "n1" z0 n1) (p "init" "a" z0 a)
+          (p "init" "b" z0 b) (p "" z1 1) (p "" "x" z1 n1)
           (non (privk a)) (non (privk b)) (uniq n1)) (false))))
   (comment "Initiator point of view"
     "Secrecy goal: nonce n1 not revealed")
@@ -270,10 +270,10 @@
   (non-orig (privk a) (privk b))
   (uniq-orig n1)
   (goals
-    (forall ((a b name) (n1 text) (z0 z1 node))
+    (forall ((a b name) (n1 text) (z0 z1 strd))
       (implies
-        (and (p "init" 2 z0) (p "init" "n1" z0 n1) (p "init" "a" z0 a)
-          (p "init" "b" z0 b) (p "" 0 z1) (p "" "x" z1 n1)
+        (and (p "init" z0 3) (p "init" "n1" z0 n1) (p "init" "a" z0 a)
+          (p "init" "b" z0 b) (p "" z1 1) (p "" "x" z1 n1)
           (non (privk a)) (non (privk b)) (uniq n1)) (false))))
   (comment "Initiator point of view"
     "Secrecy goal: nonce n1 not revealed")
@@ -446,12 +446,12 @@
   (non-orig (privk a))
   (uniq-orig n)
   (goals
-    (forall ((a name) (n text) (z0 node))
+    (forall ((a name) (n text) (z0 strd))
       (implies
-        (and (p "init" 1 z0) (p "init" "n" z0 n) (p "init" "a" z0 a)
+        (and (p "init" z0 2) (p "init" "n" z0 n) (p "init" "a" z0 a)
           (non (privk a)) (uniq n))
-        (exists ((z1 node))
-          (and (p "resp" 1 z1) (p "resp" "a" z1 a))))))
+        (exists ((z1 strd))
+          (and (p "resp" z1 2) (p "resp" "a" z1 a))))))
   (comment "Unilateral authentication goal")
   (traces ((send (enc n (pubk a))) (recv n)))
   (label 17)
@@ -496,12 +496,12 @@
   (non-orig (privk a))
   (uniq-orig n)
   (goals
-    (forall ((a name) (n text) (z0 node))
+    (forall ((a name) (n text) (z0 strd))
       (implies
-        (and (p "init" 1 z0) (p "init" "n1" z0 n) (p "init" "b" z0 a)
+        (and (p "init" z0 2) (p "init" "n1" z0 n) (p "init" "b" z0 a)
           (non (privk a)) (uniq n))
-        (exists ((z1 node))
-          (and (p "resp" 1 z1) (p "resp" "b" z1 a))))))
+        (exists ((z1 strd))
+          (and (p "resp" z1 2) (p "resp" "b" z1 a))))))
   (comment "Initiator authentication goal"
     "Same as unilateral goal under the predicate mapping:"
     (p "init" "n") "->" (p "init" "n1") "and" (p "init" "a") "->"
@@ -550,12 +550,12 @@
   (non-orig (privk a))
   (uniq-orig n)
   (goals
-    (forall ((a name) (n text) (z0 node))
+    (forall ((a name) (n text) (z0 strd))
       (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n) (p "resp" "a" z0 a)
+        (and (p "resp" z0 3) (p "resp" "n2" z0 n) (p "resp" "a" z0 a)
           (non (privk a)) (uniq n))
-        (exists ((z1 node))
-          (and (p "init" 2 z1) (p "init" "a" z1 a))))))
+        (exists ((z1 strd))
+          (and (p "init" z1 3) (p "init" "a" z1 a))))))
   (comment "Responder authentication goal"
     "Same as unilateral goal under the predicate mapping:" (p "init" 1)
     "->" (p "resp" 2) "and" (p "init" "n") "->" (p "resp" "n2") "and"
@@ -610,17 +610,17 @@
   (non-orig (privk a) (privk b))
   (uniq-orig n)
   (goals
-    (forall ((a b name) (n text) (z0 node))
+    (forall ((a b name) (n text) (z0 strd))
       (implies
-        (and (p "init" 1 z0) (p "init" "n1" z0 n) (p "init" "a" z0 a)
+        (and (p "init" z0 2) (p "init" "n1" z0 n) (p "init" "a" z0 a)
           (p "init" "b" z0 b) (non (privk a)) (non (privk b)) (uniq n))
-        (exists ((z1 node)) (and (p "resp" 1 z1) (p "resp" "b" z1 b)))))
-    (forall ((a b name) (n text) (z0 node))
+        (exists ((z1 strd)) (and (p "resp" z1 2) (p "resp" "b" z1 b)))))
+    (forall ((a b name) (n text) (z0 strd))
       (implies
-        (and (p "init" 1 z0) (p "init" "n1" z0 n) (p "init" "a" z0 a)
+        (and (p "init" z0 2) (p "init" "n1" z0 n) (p "init" "a" z0 a)
           (p "init" "b" z0 b) (non (privk a)) (non (privk b)) (uniq n))
-        (exists ((z1 node))
-          (and (p "resp" 1 z1) (p "resp" "a" z1 a))))))
+        (exists ((z1 strd))
+          (and (p "resp" z1 2) (p "resp" "a" z1 a))))))
   (comment "Two initiator authentication goals")
   (traces ((send (enc n a (pubk b))) (recv (enc n n2 (pubk a)))))
   (label 23)
@@ -682,18 +682,15 @@
   (non-orig (privk b))
   (uniq-orig n1)
   (goals
-    (forall ((n1 n2 text) (b a name) (z z-0 node))
+    (forall ((n1 n2 text) (b a name) (z strd))
       (implies
-        (and (p "init" 0 z) (p "init" 2 z-0) (p "init" "n1" z-0 n1)
-          (p "init" "n2" z-0 n2) (p "init" "a" z-0 a)
-          (p "init" "b" z-0 b) (str-prec z z-0) (non (privk b))
-          (uniq-at n1 z))
-        (exists ((n2-0 text) (z-1 z-2 z-3 node))
-          (and (p "init" 1 z-1) (p "resp" 0 z-2) (p "resp" 1 z-3)
-            (p "resp" "n2" z-3 n2-0) (p "resp" "n1" z-3 n1)
-            (p "resp" "b" z-3 b) (p "resp" "a" z-3 a) (prec z z-2)
-            (prec z-3 z-1) (str-prec z z-1) (str-prec z-1 z-0)
-            (str-prec z-2 z-3))))))
+        (and (p "init" z 3) (p "init" "n1" z n1) (p "init" "n2" z n2)
+          (p "init" "a" z a) (p "init" "b" z b) (non (privk b))
+          (uniq-at n1 z 0))
+        (exists ((n2-0 text) (z-0 strd))
+          (and (p "resp" z-0 2) (p "resp" "n2" z-0 n2-0)
+            (p "resp" "n1" z-0 n1) (p "resp" "b" z-0 b)
+            (p "resp" "a" z-0 a) (prec z 0 z-0 0) (prec z-0 1 z 1))))))
   (comment "Shape analysis sentence")
   (traces
     ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
@@ -744,10 +741,10 @@
   (non-orig (privk a) (privk b))
   (uniq-orig n2)
   (goals
-    (forall ((a b name) (n2 text) (z0 z1 node))
+    (forall ((a b name) (n2 text) (z0 z1 strd))
       (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
-          (p "resp" "b" z0 b) (p "" 0 z1) (p "" "x" z1 n2)
+        (and (p "resp" z0 3) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
+          (p "resp" "b" z0 b) (p "" z1 1) (p "" "x" z1 n2)
           (non (privk a)) (non (privk b)) (uniq n2)) (false))))
   (comment "Responder point of view"
     "Failed secrecy goal: nonce n2 not revealed")
@@ -767,10 +764,10 @@
   (non-orig (privk a) (privk b))
   (uniq-orig n2)
   (goals
-    (forall ((a b name) (n2 text) (z0 z1 node))
+    (forall ((a b name) (n2 text) (z0 z1 strd))
       (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
-          (p "resp" "b" z0 b) (p "" 0 z1) (p "" "x" z1 n2)
+        (and (p "resp" z0 3) (p "resp" "n2" z0 n2) (p "resp" "a" z0 a)
+          (p "resp" "b" z0 b) (p "" z1 1) (p "" "x" z1 n2)
           (non (privk a)) (non (privk b)) (uniq n2)) (false))))
   (comment "Responder point of view"
     "Failed secrecy goal: nonce n2 not revealed")
@@ -822,7 +819,7 @@
   (parent 30)
   (unrealized)
   (shape)
-  (satisfies (no (a a) (b b) (n2 n2) (z0 (1 2)) (z1 (0 0))))
+  (satisfies (no (a a) (b b) (n2 n2) (z0 1) (z1 0)))
   (maps ((0 1) ((a a) (b b) (n2 n2) (n1 n1))))
   (origs (n2 (1 1))))
 
@@ -848,7 +845,7 @@
   (parent 30)
   (unrealized)
   (shape)
-  (satisfies (no (a a) (b b) (n2 n2) (z0 (1 2)) (z1 (0 0))))
+  (satisfies (no (a a) (b b) (n2 n2) (z0 1) (z1 0)))
   (maps ((0 1) ((a a) (b b) (n2 n2) (n1 n1))))
   (origs (n2 (1 1))))
 
@@ -872,15 +869,14 @@
   (non-orig (privk a) (privk b))
   (uniq-orig n1 n1-0)
   (subgoals
-    (forall ((n1 n1-0 n2 n2-0 text) (a b name) (z z-0 z-1 z-2 node))
+    (forall ((n1 n1-0 n2 n2-0 text) (a b name) (z z-0 strd))
       (implies
-        (and (p "init" 0 z) (p "init" 2 z-0) (p "init" 0 z-1)
-          (p "init" 2 z-2) (p "init" "n1" z-0 n1) (p "init" "n2" z-0 n2)
-          (p "init" "a" z-0 a) (p "init" "b" z-0 b)
-          (p "init" "n1" z-2 n1-0) (p "init" "n2" z-2 n2-0)
-          (p "init" "a" z-2 a) (p "init" "b" z-2 b) (str-prec z z-0)
-          (str-prec z-1 z-2) (non (privk a)) (non (privk b))
-          (uniq-at n1 z) (uniq-at n1-0 z-1)) (= z-1 z))))
+        (and (p "init" z 3) (p "init" z-0 3) (p "init" "n1" z n1)
+          (p "init" "n2" z n2) (p "init" "a" z a) (p "init" "b" z b)
+          (p "init" "n1" z-0 n1-0) (p "init" "n2" z-0 n2-0)
+          (p "init" "a" z-0 a) (p "init" "b" z-0 b) (non (privk a))
+          (non (privk b)) (uniq-at n1 z 0) (uniq-at n1-0 z-0 0))
+        (= z z-0))))
   (comment "Double initiator point of view")
   (traces
     ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
@@ -1034,8 +1030,8 @@
   (unrealized)
   (shape)
   (satisfies
-    (no (n1 n1) (n1-0 n1-0) (n2 n2-0) (n2-0 n2) (a a) (b b) (z (0 0))
-      (z-0 (0 2)) (z-1 (1 0)) (z-2 (1 2))))
+    (no (n1 n1) (n1-0 n1-0) (n2 n2-0) (n2-0 n2) (a a) (b b) (z 0)
+      (z-0 1)))
   (maps ((0 1) ((a a) (b b) (n1 n1) (n1-0 n1-0) (n2 n2-0) (n2-0 n2))))
   (origs (n1 (0 0)) (n1-0 (1 0))))
 
@@ -1059,9 +1055,9 @@
   (non-orig (privk a) (privk b))
   (uniq-orig n2)
   (goals
-    (forall ((n2 text) (a b name) (z z-0 node))
+    (forall ((n2 text) (a b name) (z z-0 strd))
       (implies
-        (and (p "resp" 1 z) (p "" 0 z-0) (p "resp" "n2" z n2)
+        (and (p "resp" z 2) (p "" z-0 1) (p "resp" "n2" z n2)
           (p "resp" "b" z b) (p "resp" "a" z a) (p "" "x" z-0 n2)
           (non (privk a)) (non (privk b)) (uniq n2)) (false))))
   (comment "Shows typeflaw in typeless NSL")
@@ -1080,9 +1076,9 @@
   (non-orig (privk a) (privk b))
   (uniq-orig n2)
   (goals
-    (forall ((n2 text) (a b name) (z z-0 node))
+    (forall ((n2 text) (a b name) (z z-0 strd))
       (implies
-        (and (p "resp" 1 z) (p "" 0 z-0) (p "resp" "n2" z n2)
+        (and (p "resp" z 2) (p "" z-0 1) (p "resp" "n2" z n2)
           (p "resp" "b" z b) (p "resp" "a" z a) (p "" "x" z-0 n2)
           (non (privk a)) (non (privk b)) (uniq n2)) (false))))
   (comment "Shows typeflaw in typeless NSL")
@@ -1131,538 +1127,8 @@
   (parent 42)
   (unrealized)
   (shape)
-  (satisfies (no (n2 n2) (a a) (b b) (z (1 1)) (z-0 (0 0))))
+  (satisfies (no (n2 n2) (a a) (b b) (z 1) (z-0 0)))
   (maps ((0 1) ((n2 n2) (a a) (b b) (n1 a-0))))
   (origs (n2 (1 1))))
-
-(comment "Nothing left to do")
-
-(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
-
-(defskeleton ns
-  (vars (n2 n1 text) (a b name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (subgoals
-    (forall ((n1 n2 text) (a b name) (z z-0 node))
-      (implies
-        (and (p "init" 0 z) (p "init" 2 z-0) (p "init" "n1" z-0 n1)
-          (p "init" "n2" z-0 n2) (p "init" "a" z-0 a)
-          (p "init" "b" z-0 b) (str-prec z z-0) (non (privk a))
-          (non (privk b)) (uniq-at n1 z))
-        (exists ((z-1 z-2 z-3 node))
-          (and (p "init" 1 z-1) (p "resp" 0 z-2) (p "resp" 1 z-3)
-            (p "resp" "n2" z-3 n2) (p "resp" "n1" z-3 n1)
-            (p "resp" "b" z-3 b) (p "resp" "a" z-3 a) (prec z z-2)
-            (prec z-3 z-1) (str-prec z z-1) (str-prec z-1 z-0)
-            (str-prec z-2 z-3))))))
-  (comment "Responder point of view with SAS")
-  (traces
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (label 45)
-  (unrealized (0 2))
-  (origs (n2 (0 1)))
-  (comment "1 in cohort - 1 not yet seen"))
-
-(defskeleton ns
-  (vars (n2 n1 text) (a b b-0 name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
-  (precedes ((0 1) (1 1)) ((1 2) (0 2)))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (operation nonce-test (added-strand init 3) n2 (0 2)
-    (enc n1 n2 (pubk a)))
-  (traces
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b))))
-    ((send (enc n1 a (pubk b-0))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b-0)))))
-  (label 46)
-  (parent 45)
-  (unrealized)
-  (shape)
-  (satisfies yes)
-  (maps ((0) ((a a) (n2 n2) (b b) (n1 n1))))
-  (origs (n2 (0 1))))
-
-(comment "Nothing left to do")
-
-(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
-
-(defskeleton ns
-  (vars (n2 n1 text) (a b name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (subgoals
-    (forall ((n1 n2 text) (a b name) (z z-0 node))
-      (implies
-        (and (p "init" 0 z) (p "init" 2 z-0) (p "init" "n1" z-0 n1)
-          (p "init" "n2" z-0 n2) (p "init" "a" z-0 a)
-          (p "init" "b" z-0 b) (str-prec z z-0) (non (privk a))
-          (non (privk b)) (uniq-at n1 z)) (false))))
-  (comment "Responder point of view with false as the conclusion")
-  (traces
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (label 47)
-  (unrealized (0 2))
-  (origs (n2 (0 1)))
-  (comment "1 in cohort - 1 not yet seen"))
-
-(defskeleton ns
-  (vars (n2 n1 text) (a b b-0 name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
-  (precedes ((0 1) (1 1)) ((1 2) (0 2)))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (operation nonce-test (added-strand init 3) n2 (0 2)
-    (enc n1 n2 (pubk a)))
-  (traces
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b))))
-    ((send (enc n1 a (pubk b-0))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b-0)))))
-  (label 48)
-  (parent 47)
-  (unrealized)
-  (shape)
-  (satisfies yes)
-  (maps ((0) ((a a) (n2 n2) (b b) (n1 n1))))
-  (origs (n2 (0 1))))
-
-(comment "Nothing left to do")
-
-(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
-
-(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (subgoals
-    (forall ((n1 n2 text) (a b name) (z z-0 node))
-      (implies
-        (and (p "init" 0 z) (p "init" 2 z-0) (p "init" "n1" z-0 n1)
-          (p "init" "n2" z-0 n2) (p "init" "a" z-0 a)
-          (p "init" "b" z-0 b) (str-prec z z-0) (non (privk a))
-          (non (privk b)) (uniq-at n1 z)) (false))))
-  (comment "Initiator point of view with false as the conclusion")
-  (traces
-    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (label 49)
-  (unrealized (0 1))
-  (origs (n1 (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
-
-(defskeleton ns
-  (vars (n1 n2 n2-0 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (added-strand resp 2) n1 (0 1)
-    (enc n1 a (pubk b)))
-  (traces
-    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b))))
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2-0 (pubk a)))))
-  (label 50)
-  (parent 49)
-  (unrealized (0 1))
-  (comment "1 in cohort - 1 not yet seen"))
-
-(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (operation nonce-test (contracted (n2-0 n2)) n1 (0 1)
-    (enc n1 n2 (pubk a)) (enc n1 a (pubk b)))
-  (traces
-    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b))))
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))))
-  (label 51)
-  (parent 50)
-  (unrealized)
-  (shape)
-  (satisfies (no (n1 n1) (n2 n2) (a a) (b b) (z (0 0)) (z-0 (0 2))))
-  (maps ((0) ((a a) (b b) (n1 n1) (n2 n2))))
-  (origs (n1 (0 0))))
-
-(comment "Nothing left to do")
-
-(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
-
-(defskeleton ns
-  (vars (n n1 text) (a b name))
-  (defstrand resp 3 (n2 n) (n1 n1) (b b) (a a))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n)
-  (goals
-    (forall ((a b name) (n text) (z0 node))
-      (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n) (p "resp" "a" z0 a)
-          (p "resp" "b" z0 b) (non (privk a)) (non (privk b)) (uniq n))
-        (exists ((z1 node)) (and (p "init" 2 z1) (p "init" "a" z1 a)))))
-    (forall ((a b name) (n text) (z0 node))
-      (implies
-        (and (p "resp" 2 z0) (p "resp" "n2" z0 n) (p "resp" "a" z0 a)
-          (p "resp" "b" z0 b) (non (privk a)) (non (privk b)) (uniq n))
-        (exists ((z1 node))
-          (and (p "init" 2 z1) (p "init" "b" z1 b))))))
-  (comment "Two responder authentication goals")
-  (traces
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n (pubk a)))
-      (recv (enc n (pubk b)))))
-  (label 52)
-  (unrealized (0 2))
-  (origs (n (0 1)))
-  (comment "1 in cohort - 1 not yet seen"))
-
-(defskeleton ns
-  (vars (n n1 text) (a b b-0 name))
-  (defstrand resp 3 (n2 n) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n) (a a) (b b-0))
-  (precedes ((0 1) (1 1)) ((1 2) (0 2)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n)
-  (operation nonce-test (added-strand init 3) n (0 2)
-    (enc n1 n (pubk a)))
-  (traces
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n (pubk a)))
-      (recv (enc n (pubk b))))
-    ((send (enc n1 a (pubk b-0))) (recv (enc n1 n (pubk a)))
-      (send (enc n (pubk b-0)))))
-  (label 53)
-  (parent 52)
-  (unrealized)
-  (shape)
-  (satisfies yes (no (a a) (b b) (n n) (z0 (0 2))))
-  (maps ((0) ((a a) (b b) (n n) (n1 n1))))
-  (origs (n (0 1))))
-
-(comment "Nothing left to do")
-
-(defprotocol ns-role-origs basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b))))
-    (non-orig (privk b))
-    (uniq-orig n1))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b))))
-    (non-orig (privk a))
-    (uniq-orig n2))
-  (comment
-    "Needham-Schroeder with role assumptions that are too strong"))
-
-(defskeleton ns-role-origs
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (non-orig (privk b))
-  (uniq-orig n1)
-  (traces
-    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (label 54)
-  (unrealized (0 1))
-  (origs (n1 (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
-
-(defskeleton ns-role-origs
-  (vars (n1 n2 n2-0 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1 n2-0)
-  (operation nonce-test (added-strand resp 2) n1 (0 1)
-    (enc n1 a (pubk b)))
-  (traces
-    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b))))
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2-0 (pubk a)))))
-  (label 55)
-  (parent 54)
-  (unrealized (0 1))
-  (comment "1 in cohort - 1 not yet seen"))
-
-(defskeleton ns-role-origs
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1 n2)
-  (operation nonce-test (contracted (n2-0 n2)) n1 (0 1)
-    (enc n1 n2 (pubk a)) (enc n1 a (pubk b)))
-  (traces
-    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b))))
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))))
-  (label 56)
-  (parent 55)
-  (unrealized)
-  (shape)
-  (maps ((0) ((a a) (b b) (n1 n1) (n2 n2))))
-  (origs (n2 (1 1)) (n1 (0 0))))
-
-(comment "Nothing left to do")
-
-(defprotocol ns-role-origs basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b))))
-    (non-orig (privk b))
-    (uniq-orig n1))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b))))
-    (non-orig (privk a))
-    (uniq-orig n2))
-  (comment
-    "Needham-Schroeder with role assumptions that are too strong"))
-
-(defskeleton ns-role-origs
-  (vars (n2 n1 text) (b a name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (non-orig (privk a))
-  (uniq-orig n2)
-  (traces
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (label 57)
-  (unrealized (0 2))
-  (origs (n2 (0 1)))
-  (comment "1 in cohort - 1 not yet seen"))
-
-(defskeleton ns-role-origs
-  (vars (n2 n1 text) (b a b-0 name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
-  (precedes ((0 1) (1 1)) ((1 0) (0 0)) ((1 2) (0 2)))
-  (non-orig (privk a) (privk b-0))
-  (uniq-orig n2 n1)
-  (operation nonce-test (added-strand init 3) n2 (0 2)
-    (enc n1 n2 (pubk a)))
-  (traces
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b))))
-    ((send (enc n1 a (pubk b-0))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b-0)))))
-  (label 58)
-  (parent 57)
-  (unrealized (0 0) (0 2))
-  (comment "2 in cohort - 2 not yet seen"))
-
-(defskeleton ns-role-origs
-  (vars (n2 n1 text) (a b name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (precedes ((0 1) (1 1)) ((1 0) (0 0)) ((1 2) (0 2)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2 n1)
-  (operation nonce-test (contracted (b-0 b)) n1 (0 0)
-    (enc n1 a (pubk b)))
-  (traces
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b))))
-    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (label 59)
-  (parent 58)
-  (unrealized)
-  (shape)
-  (maps ((0) ((b b) (a a) (n2 n2) (n1 n1))))
-  (origs (n1 (1 0)) (n2 (0 1))))
-
-(defskeleton ns-role-origs
-  (vars (n2 n1 n2-0 text) (b a b-0 name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b-0))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b-0) (a a))
-  (precedes ((0 1) (1 1)) ((1 0) (2 0)) ((1 2) (0 2)) ((2 1) (0 0)))
-  (non-orig (privk a) (privk b-0))
-  (uniq-orig n2 n1 n2-0)
-  (operation nonce-test (added-strand resp 2) n1 (0 0)
-    (enc n1 a (pubk b-0)))
-  (traces
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b))))
-    ((send (enc n1 a (pubk b-0))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b-0))))
-    ((recv (enc n1 a (pubk b-0))) (send (enc n1 n2-0 (pubk a)))))
-  (label 60)
-  (parent 58)
-  (unrealized (0 0) (0 2))
-  (comment "1 in cohort - 1 not yet seen"))
-
-(defskeleton ns-role-origs
-  (vars (n2 n1 n2-0 text) (a b name))
-  (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a))
-  (precedes ((0 1) (1 1)) ((1 0) (2 0)) ((1 2) (0 2)) ((2 1) (0 0)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n2 n1 n2-0)
-  (operation nonce-test (contracted (b-0 b)) n1 (0 0)
-    (enc n1 n2-0 (pubk a)) (enc n1 a (pubk b)))
-  (traces
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b))))
-    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b))))
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2-0 (pubk a)))))
-  (label 61)
-  (parent 60)
-  (seen 59)
-  (unrealized)
-  (comment "1 in cohort - 0 not yet seen"))
-
-(comment "Nothing left to do")
-
-(defprotocol ns2 basic
-  (defrole init
-    (vars (a b name) (n1 n2 n3 text))
-    (trace (send (enc n1 n3 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b))))
-    (note doubled nonce in the first message))
-  (note that this protocol is derived from Needham-Schroeder))
-
-(defskeleton ns2
-  (vars (n1 n2 n3 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (n3 n3) (a a) (b b))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (traces
-    ((send (enc n1 n3 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (label 62)
-  (unrealized (0 1))
-  (origs (n1 (0 0)))
-  (comment "1 in cohort - 1 not yet seen"))
-
-(defskeleton ns2
-  (vars (n2 n3 n2-0 text) (a b name))
-  (defstrand init 3 (n1 n3) (n2 n2) (n3 n3) (a a) (b b))
-  (defstrand resp 2 (n2 n2-0) (n1 n3) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n3)
-  (operation nonce-test (added-strand resp 2) n3 (0 1)
-    (enc n3 n3 a (pubk b)))
-  (traces
-    ((send (enc n3 n3 a (pubk b))) (recv (enc n3 n2 (pubk a)))
-      (send (enc n2 (pubk b))))
-    ((recv (enc n3 n3 a (pubk b))) (send (enc n3 n2-0 (pubk a)))))
-  (label 63)
-  (parent 62)
-  (unrealized (0 1))
-  (comment "1 in cohort - 1 not yet seen"))
-
-(defskeleton ns2
-  (vars (n3 n2 text) (a b name))
-  (defstrand init 3 (n1 n3) (n2 n2) (n3 n3) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n3) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n3)
-  (operation nonce-test (contracted (n2-0 n2)) n3 (0 1)
-    (enc n3 n2 (pubk a)) (enc n3 n3 a (pubk b)))
-  (traces
-    ((send (enc n3 n3 a (pubk b))) (recv (enc n3 n2 (pubk a)))
-      (send (enc n2 (pubk b))))
-    ((recv (enc n3 n3 a (pubk b))) (send (enc n3 n2 (pubk a)))))
-  (label 64)
-  (parent 63)
-  (unrealized)
-  (shape)
-  (maps ((0) ((a a) (b b) (n1 n3) (n2 n2) (n3 n3))))
-  (origs (n3 (0 0))))
-
-(comment "Nothing left to do")
-
-(defprotocol ns basic
-  (defrole init
-    (vars (a b name) (n1 n2 text))
-    (trace (send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b)))))
-  (defrole resp
-    (vars (b a name) (n2 n1 text))
-    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))
-      (recv (enc n2 (pubk b)))))
-  (comment "Needham-Schroeder with no role origination assumptions"))
-
-(defskeleton ns
-  (vars (n1 n2 text) (a b name))
-  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))
-  (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a))
-  (precedes ((0 0) (1 0)) ((1 1) (0 1)))
-  (non-orig (privk a) (privk b))
-  (uniq-orig n1)
-  (traces
-    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))
-      (send (enc n2 (pubk b))))
-    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))))
-  (label 65)
-  (unrealized)
-  (shape)
-  (maps ((0 1) ((n1 n1) (n2 n2) (a a) (b b))))
-  (origs (n1 (0 0))))
 
 (comment "Nothing left to do")
diff --git a/tst/iadh_um.tst b/tst/iadh_um.tst
# file too large to diff: tst/iadh_um.tst
diff --git a/tst/injection.tst b/tst/injection.tst
--- a/tst/injection.tst
+++ b/tst/injection.tst
@@ -2,7 +2,7 @@
   (comment "This protocol contains a man-in-the-middle"
     "attack discovered by Galvin Lowe."))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from injection.scm")
 
 (defprotocol ns diffie-hellman
diff --git a/tst/kerb.tst b/tst/kerb.tst
--- a/tst/kerb.tst
+++ b/tst/kerb.tst
@@ -1,4 +1,4 @@
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from kerb.scm")
 
 (defprotocol kerb-flawed basic
diff --git a/tst/kerberos++.tst b/tst/kerberos++.tst
--- a/tst/kerberos++.tst
+++ b/tst/kerberos++.tst
@@ -1,4 +1,4 @@
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from kerberos++.scm")
 
 (defprotocol kerberos basic
diff --git a/tst/lt_test.tst b/tst/lt_test.tst
--- a/tst/lt_test.tst
+++ b/tst/lt_test.tst
@@ -2,7 +2,7 @@
   (comment "First and third skeletons should have a shape,"
     "second and fourth should be dead."))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from lt_test.scm")
 
 (defprotocol lttest basic
diff --git a/tst/neq_test.tst b/tst/neq_test.tst
--- a/tst/neq_test.tst
+++ b/tst/neq_test.tst
@@ -2,7 +2,7 @@
   (comment "First skeleton should have a shape,"
     "second, and hird should be dead."))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from neq_test.scm")
 
 (defprotocol neqtest basic
diff --git a/tst/ns.tst b/tst/ns.tst
--- a/tst/ns.tst
+++ b/tst/ns.tst
@@ -2,7 +2,7 @@
   (comment "This protocol contains a man-in-the-middle"
     "attack discovered by Galvin Lowe."))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from ns.scm")
 
 (defprotocol ns basic
diff --git a/tst/or.tst b/tst/or.tst
--- a/tst/or.tst
+++ b/tst/or.tst
@@ -1,7 +1,7 @@
 (herald "Otway-Rees Protocol"
   (comment "Standard version using variables of sort mesg"))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from or.scm")
 
 (defprotocol or basic
diff --git a/tst/owang.tst b/tst/owang.tst
--- a/tst/owang.tst
+++ b/tst/owang.tst
@@ -1,4 +1,4 @@
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from owang.scm")
 
 (defprotocol wang basic
diff --git a/tst/owat.tst b/tst/owat.tst
--- a/tst/owat.tst
+++ b/tst/owat.tst
@@ -1,7 +1,7 @@
 (herald "One-way Authentication Test with bltk keys"
   (algebra diffie-hellman) (bound 12))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from owat.scm")
 
 (defprotocol owa diffie-hellman
diff --git a/tst/pkinit.scm b/tst/pkinit.scm
--- a/tst/pkinit.scm
+++ b/tst/pkinit.scm
@@ -103,16 +103,16 @@
 ;; This is the goal that the authors discovered was not met by the
 ;; original, flawed version, but which was met by both fixes.
 (defgoal pkinit-flawed
-  (forall ((c as name) (k skey) (z node))
+  (forall ((c as name) (k skey) (z strd))
           (implies
-           (and (p "client" 1 z)
+           (and (p "client" z 2)
                 (p "client" "c" z c)
                 (p "client" "as" z as)
                 (p "client" "k" z k)
                 (non (privk as))
                 (non (privk c)))
-           (exists ((z-0 node))
-                   (and (p "auth" 1 z-0)
+           (exists ((z-0 strd))
+                   (and (p "auth" z-0 2)
                         (p "auth" "as" z-0 as)
                         (p "auth" "k" z-0 k)
                         (p "auth" "c" z-0 c))))))
@@ -121,32 +121,32 @@
 ;; must repeat it once for every protocol against which we would like
 ;; to evaluate the goal.
 (defgoal pkinit-fix1
-  (forall ((c as name) (k skey) (z node))
+  (forall ((c as name) (k skey) (z strd))
           (implies
-           (and (p "client" 1 z)
+           (and (p "client" z 2)
                 (p "client" "c" z c)
                 (p "client" "as" z as)
                 (p "client" "k" z k)
                 (non (privk as))
                 (non (privk c)))
-           (exists ((z-0 node))
-                   (and (p "auth" 1 z-0)
+           (exists ((z-0 strd))
+                   (and (p "auth" z-0 2)
                         (p "auth" "as" z-0 as)
                         (p "auth" "k" z-0 k)
                         (p "auth" "c" z-0 c))))))
 
 ;; Repeated once more.
 (defgoal pkinit-fix2
-  (forall ((c as name) (k skey) (z node))
+  (forall ((c as name) (k skey) (z strd))
           (implies
-           (and (p "client" 1 z)
+           (and (p "client" z 2)
                 (p "client" "c" z c)
                 (p "client" "as" z as)
                 (p "client" "k" z k)
                 (non (privk as))
                 (non (privk c)))
-           (exists ((z-0 node))
-                   (and (p "auth" 1 z-0)
+           (exists ((z-0 strd))
+                   (and (p "auth" z-0 2)
                         (p "auth" "as" z-0 as)
                         (p "auth" "k" z-0 k)
                         (p "auth" "c" z-0 c))))))
@@ -154,50 +154,50 @@
 ;;;;;;;;
 
 (defgoal pkinit-flawed
-  (forall ((c c-0 as name) (k skey) (z z-0 node))
+  (forall ((c c-0 as name) (k skey) (z z-0 strd))
           (implies
-           (and (p "client" 1 z)
+           (and (p "client" z 2)
                 (p "client" "c" z c)
                 (p "client" "as" z as)
                 (p "client" "k" z k)
-                (p "auth" 1 z-0)
+                (p "auth" z-0 2)
                 (p "auth" "k" z-0 k)
                 (p "auth" "c" z-0 c-0)
                 (non (privk as))
                 (non (privk c)))
-           ;(exists ((z-1 node))
+           ;(exists ((z-1 strd))
            ;        (p "client" 1 z-1))
            (= c c-0)
            )))
 
 (defgoal pkinit-fix1
-  (forall ((c c-0 as name) (k skey) (z z-0 node))
+  (forall ((c c-0 as name) (k skey) (z z-0 strd))
           (implies
-           (and (p "client" 1 z)
+           (and (p "client" z 2)
                 (p "client" "c" z c)
                 (p "client" "as" z as)
                 (p "client" "k" z k)
-                (p "auth" 1 z-0)
+                (p "auth" z-0 2)
                 (p "auth" "k" z-0 k)
                 (p "auth" "c" z-0 c-0)
                 (non (privk as))
                 (non (privk c)))
-           (exists ((z-1 node))
-                   (p "client" 1 z-1))
+           (exists ((z-1 strd))
+                   (p "client" z-1 2))
            ;(= c c-0)
            )))
 
 (defgoal pkinit-fix2
-  (forall ((c c-0 as name) (k skey) (z z-0 node))
+  (forall ((c c-0 as name) (k skey) (z z-0 strd))
           (implies
-           (and (p "client" 1 z)
+           (and (p "client" z 2)
                 (p "client" "c" z c)
                 (p "client" "as" z as)
                 (p "client" "k" z k)
-                (p "auth" 1 z-0)
+                (p "auth" z-0 2)
                 (p "auth" "k" z-0 k)
                 (p "auth" "c" z-0 c-0)
                 (non (privk as))
                 (non (privk c)))
-           (exists ((z-1 node))
-                   (p "client" 1 z-1)))))
+           (exists ((z-1 strd))
+                   (p "client" z-1 2)))))
diff --git a/tst/pkinit.tst b/tst/pkinit.tst
--- a/tst/pkinit.tst
+++ b/tst/pkinit.tst
@@ -1,6 +1,6 @@
 (herald "Kerberos PKINIT")
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from pkinit.scm")
 
 (defprotocol pkinit-flawed basic
@@ -26,13 +26,13 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2 n1)
   (goals
-    (forall ((c as name) (k skey) (z node))
+    (forall ((c as name) (k skey) (z strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
+        (and (p "client" z 2) (p "client" "c" z c)
           (p "client" "as" z as) (p "client" "k" z k) (non (privk as))
           (non (privk c)))
-        (exists ((z-0 node))
-          (and (p "auth" 1 z-0) (p "auth" "as" z-0 as)
+        (exists ((z-0 strd))
+          (and (p "auth" z-0 2) (p "auth" "as" z-0 as)
             (p "auth" "k" z-0 k) (p "auth" "c" z-0 c))))))
   (traces
     ((send (cat (enc tc n2 (privk c)) c t n1))
@@ -69,7 +69,7 @@
   (parent 0)
   (unrealized)
   (shape)
-  (satisfies (no (c c) (as as) (k k) (z (0 1))))
+  (satisfies (no (c c) (as as) (k k) (z 0)))
   (maps
     ((0)
       ((c c) (as as) (k k) (t t) (n2 n2) (n1 n1) (tc tc) (tk tk)
@@ -101,13 +101,13 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2 n1)
   (goals
-    (forall ((c as name) (k skey) (z node))
+    (forall ((c as name) (k skey) (z strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
+        (and (p "client" z 2) (p "client" "c" z c)
           (p "client" "as" z as) (p "client" "k" z k) (non (privk as))
           (non (privk c)))
-        (exists ((z-0 node))
-          (and (p "auth" 1 z-0) (p "auth" "as" z-0 as)
+        (exists ((z-0 strd))
+          (and (p "auth" z-0 2) (p "auth" "as" z-0 as)
             (p "auth" "k" z-0 k) (p "auth" "c" z-0 c))))))
   (traces
     ((send (cat (enc tc n2 (privk c)) c t n1))
@@ -283,13 +283,13 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2 n1)
   (goals
-    (forall ((c as name) (k skey) (z node))
+    (forall ((c as name) (k skey) (z strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
+        (and (p "client" z 2) (p "client" "c" z c)
           (p "client" "as" z as) (p "client" "k" z k) (non (privk as))
           (non (privk c)))
-        (exists ((z-0 node))
-          (and (p "auth" 1 z-0) (p "auth" "as" z-0 as)
+        (exists ((z-0 strd))
+          (and (p "auth" z-0 2) (p "auth" "as" z-0 as)
             (p "auth" "k" z-0 k) (p "auth" "c" z-0 c))))))
   (traces
     ((send (cat (enc tc n2 (privk c)) c t n1))
@@ -452,10 +452,10 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2-0 n1-0 k ak)
   (goals
-    (forall ((c c-0 as name) (k skey) (z z-0 node))
+    (forall ((c c-0 as name) (k skey) (z z-0 strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
-          (p "client" "as" z as) (p "client" "k" z k) (p "auth" 1 z-0)
+        (and (p "client" z 2) (p "client" "c" z c)
+          (p "client" "as" z as) (p "client" "k" z k) (p "auth" z-0 2)
           (p "auth" "k" z-0 k) (p "auth" "c" z-0 c-0) (non (privk as))
           (non (privk c))) (= c c-0))))
   (traces
@@ -483,10 +483,10 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2-0 n1-0 k ak)
   (goals
-    (forall ((c c-0 as name) (k skey) (z z-0 node))
+    (forall ((c c-0 as name) (k skey) (z z-0 strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
-          (p "client" "as" z as) (p "client" "k" z k) (p "auth" 1 z-0)
+        (and (p "client" z 2) (p "client" "c" z c)
+          (p "client" "as" z as) (p "client" "k" z k) (p "auth" z-0 2)
           (p "auth" "k" z-0 k) (p "auth" "c" z-0 c-0) (non (privk as))
           (non (privk c))) (= c c-0))))
   (traces
@@ -529,7 +529,7 @@
   (parent 14)
   (unrealized)
   (shape)
-  (satisfies (no (c c) (c-0 c-0) (as as) (k k) (z (1 1)) (z-0 (0 1))))
+  (satisfies (no (c c) (c-0 c-0) (as as) (k k) (z 1) (z-0 0)))
   (maps
     ((0 1)
       ((c c) (c-0 c-0) (as as) (k k) (t t) (as-0 as) (n2 n2) (n1 n1)
@@ -565,12 +565,12 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2-0 n1-0 k ak)
   (goals
-    (forall ((c c-0 as name) (k skey) (z z-0 node))
+    (forall ((c c-0 as name) (k skey) (z z-0 strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
-          (p "client" "as" z as) (p "client" "k" z k) (p "auth" 1 z-0)
+        (and (p "client" z 2) (p "client" "c" z c)
+          (p "client" "as" z as) (p "client" "k" z k) (p "auth" z-0 2)
           (p "auth" "k" z-0 k) (p "auth" "c" z-0 c-0) (non (privk as))
-          (non (privk c))) (exists ((z-1 node)) (p "client" 1 z-1)))))
+          (non (privk c))) (exists ((z-1 strd)) (p "client" z-1 2)))))
   (traces
     ((recv (cat (enc tc n2 (privk c-0)) c-0 t n1))
       (send
@@ -596,12 +596,12 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2-0 n1-0 k ak)
   (goals
-    (forall ((c c-0 as name) (k skey) (z z-0 node))
+    (forall ((c c-0 as name) (k skey) (z z-0 strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
-          (p "client" "as" z as) (p "client" "k" z k) (p "auth" 1 z-0)
+        (and (p "client" z 2) (p "client" "c" z c)
+          (p "client" "as" z as) (p "client" "k" z k) (p "auth" z-0 2)
           (p "auth" "k" z-0 k) (p "auth" "c" z-0 c-0) (non (privk as))
-          (non (privk c))) (exists ((z-1 node)) (p "client" 1 z-1)))))
+          (non (privk c))) (exists ((z-1 strd)) (p "client" z-1 2)))))
   (traces
     ((recv (cat (enc tc n2 (privk c-0)) c-0 t n1))
       (send
@@ -787,12 +787,12 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2-0 n1-0 k ak)
   (goals
-    (forall ((c c-0 as name) (k skey) (z z-0 node))
+    (forall ((c c-0 as name) (k skey) (z z-0 strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
-          (p "client" "as" z as) (p "client" "k" z k) (p "auth" 1 z-0)
+        (and (p "client" z 2) (p "client" "c" z c)
+          (p "client" "as" z as) (p "client" "k" z k) (p "auth" z-0 2)
           (p "auth" "k" z-0 k) (p "auth" "c" z-0 c-0) (non (privk as))
-          (non (privk c))) (exists ((z-1 node)) (p "client" 1 z-1)))))
+          (non (privk c))) (exists ((z-1 strd)) (p "client" z-1 2)))))
   (traces
     ((recv (cat (enc tc n2 (privk c-0)) c-0 t n1))
       (send
@@ -823,12 +823,12 @@
   (non-orig (privk c) (privk as))
   (uniq-orig n2-0 n1-0 k ak)
   (goals
-    (forall ((c c-0 as name) (k skey) (z z-0 node))
+    (forall ((c c-0 as name) (k skey) (z z-0 strd))
       (implies
-        (and (p "client" 1 z) (p "client" "c" z c)
-          (p "client" "as" z as) (p "client" "k" z k) (p "auth" 1 z-0)
+        (and (p "client" z 2) (p "client" "c" z c)
+          (p "client" "as" z as) (p "client" "k" z k) (p "auth" z-0 2)
           (p "auth" "k" z-0 k) (p "auth" "c" z-0 c-0) (non (privk as))
-          (non (privk c))) (exists ((z-1 node)) (p "client" 1 z-1)))))
+          (non (privk c))) (exists ((z-1 strd)) (p "client" z-1 2)))))
   (traces
     ((recv (cat (enc tc n2 (privk c-0)) c-0 t n1))
       (send
diff --git a/tst/plaindh.tst b/tst/plaindh.tst
--- a/tst/plaindh.tst
+++ b/tst/plaindh.tst
@@ -1,7 +1,7 @@
 (herald "Plain diffie-hellman protocol with challenge-response"
   (algebra diffie-hellman))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from plaindh.scm")
 
 (defprotocol plaindh diffie-hellman
diff --git a/tst/priority_test.tst b/tst/priority_test.tst
--- a/tst/priority_test.tst
+++ b/tst/priority_test.tst
@@ -1,6 +1,6 @@
 (herald "Receive priority test protocol")
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from priority_test.scm")
 
 (defprotocol priority_test basic
diff --git a/tst/reflect.tst b/tst/reflect.tst
--- a/tst/reflect.tst
+++ b/tst/reflect.tst
@@ -1,6 +1,6 @@
 (herald reflect)
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from reflect.scm")
 
 (defprotocol reflect basic
diff --git a/tst/staticdh.tst b/tst/staticdh.tst
--- a/tst/staticdh.tst
+++ b/tst/staticdh.tst
@@ -1,6 +1,6 @@
 (herald "Static DH key exchange" (algebra diffie-hellman))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from staticdh.scm")
 
 (defprotocol staticdh1 diffie-hellman
diff --git a/tst/station.tst b/tst/station.tst
--- a/tst/station.tst
+++ b/tst/station.tst
@@ -1,6 +1,6 @@
 (herald "Station-to-station protocol" (algebra diffie-hellman))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from station.scm")
 
 (defprotocol station-to-station diffie-hellman
diff --git a/tst/station2.tst b/tst/station2.tst
--- a/tst/station2.tst
+++ b/tst/station2.tst
@@ -1,6 +1,6 @@
 (herald "Station-to-station protocol" (algebra diffie-hellman))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from station2.scm")
 
 (defprotocol station-to-station diffie-hellman
diff --git a/tst/subsort_test.tst b/tst/subsort_test.tst
--- a/tst/subsort_test.tst
+++ b/tst/subsort_test.tst
@@ -2,7 +2,7 @@
   (comment "First, third, and fourth skeletons should have a shape,"
     "second should be dead."))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from subsort_test.scm")
 
 (defprotocol subsorttest basic
diff --git a/tst/test_small.tst b/tst/test_small.tst
--- a/tst/test_small.tst
+++ b/tst/test_small.tst
@@ -1,6 +1,6 @@
 (herald "small test" (algebra diffie-hellman))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from test_small.scm")
 
 (defprotocol test diffie-hellman
diff --git a/tst/unilateral.tst b/tst/unilateral.tst
--- a/tst/unilateral.tst
+++ b/tst/unilateral.tst
@@ -1,6 +1,6 @@
 (herald unilateral)
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from unilateral.scm")
 
 (defprotocol unilateral basic
diff --git a/tst/uniq-gen-test.tst b/tst/uniq-gen-test.tst
--- a/tst/uniq-gen-test.tst
+++ b/tst/uniq-gen-test.tst
@@ -1,7 +1,7 @@
 (herald "Unique generation test protocols."
   (comment "Skeletons 2, 4, and 7 should have no shapes."))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from uniq-gen-test.scm")
 
 (defprotocol uniqgentest basic
diff --git a/tst/woolam.tst b/tst/woolam.tst
--- a/tst/woolam.tst
+++ b/tst/woolam.tst
@@ -1,6 +1,6 @@
 (herald "Woo-Lam Protocol")
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from woolam.scm")
 
 (defprotocol woolam basic
diff --git a/tst/wrap_decrypt.tst b/tst/wrap_decrypt.tst
--- a/tst/wrap_decrypt.tst
+++ b/tst/wrap_decrypt.tst
@@ -1,6 +1,6 @@
 (herald wrap-decrypt (bound 10))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from wrap_decrypt.lsp")
 (comment "Strand count bounded at 10")
 
diff --git a/tst/yahalom.tst b/tst/yahalom.tst
--- a/tst/yahalom.tst
+++ b/tst/yahalom.tst
@@ -1,7 +1,7 @@
 (herald "Yahalom Protocol with Forwarding Removed"
   (algebra diffie-hellman) (bound 12))
 
-(comment "CPSA 3.5.0")
+(comment "CPSA 3.6.0")
 (comment "All input read from yahalom.scm")
 
 (defprotocol yahalom diffie-hellman