packages feed

cpsa 2.4.0 → 2.5.0

raw patch · 108 files changed

+5324/−958 lines, 108 filesbinary-added

Files

ChangeLog view
@@ -1,3 +1,99 @@+2015-05-21  John D. Ramsdell  <ramsdell@mitre.org>++	* cpsa.cabal (Version): Tagged as version 2.5.0++2015-04-27  John D. Ramsdell  <ramsdell@mitre.org>++	* src/CPSA/Lib/Loader.hs (ReturnFail): Added ReturnFail Monad so+	that fail is correctly handled.  Added Functor and Applicative+	instance to support GHC 7.10 base library.++2015-04-20  John D. Ramsdell  <ramsdell@mitre.org>++	* cpsa.cabal (Source-Repository): Added github source repository.++2015-04-10  John D. Ramsdell  <ramsdell@mitre.org>++	* src/CPSA/Lib/Strand.hs (mkListener): The role used for listener+	strands is now the one stored in the protocol.  It has a single+	variable x of sort mesg as its set of variables.  This change+	enables satisfaction checking on skeleton that include listeners.++2015-04-02  John D. Ramsdell  <ramsdell@mitre.org>++	* src/CPSA/Lib/Strand.hs (hull): Removed the hulling by+	deorigination mode and returned to the hulling by compression+	algorithm.  Hulling is only used on the initial preskeleton.++	* src/CPSA/SAS/SAS.hs (form): Changed the output form from defsas+	to defgoal.++2015-03-30  John D. Ramsdell  <ramsdell@mitre.org>++	* src/CPSA/Lib/Loader.hs (loadPrimary): Improved the error+	messages for ill-formed atomic formulas.++	* src/CPSA/SAS/SAS.hs (loadPOV, loadOtherPreskel): Flushed the+	check that an atom assumed to uniquely originate must originate in+	a skeleton.  In this case, cpsasas generates a uniq assertion+	rather than a uniq-at assertion.++2015-03-27  John D. Ramsdell  <ramsdell@mitre.org>++	* src/CPSA/Lib/Loader.hs (findGoal): Allow more than one sentence+	in a defgoal.++	* src/CPSA/SAS/SAS.hs (Preskel): Added pnon predicate symbol.++	* src/CPSA/Lib/Strand.hs (toSkeleton): Added hulling to the+	process of converting an input preskeleton into a skeleton.++2015-03-26  John D. Ramsdell  <ramsdell@mitre.org>++	* src/CPSA/Lib/{Characteristic,Strand,Loader}.hs: Added new+	toplevel form: defgoal.  The characteristic skeleton of the+	antecedent in the goal is extracted and used as the initial+	skeleton.++2015-03-24  John D. Ramsdell  <ramsdell@mitre.org>++	* src/CPSA/Lib/{Reduction,Strand,Loader}.hs: Made it so that when+	a shape does not satisfy a goal, an environment showing why is+	printed.  For each goal, the output is yes when the goal is+	satisfied or (no (VAR VAL)...).++2015-03-20  John D. Ramsdell  <ramsdell@mitre.org>++	* src/CPSA/Lib/{Goal,Strand,Loader}.hs: Added goal loading and+	satisfaction checking.  When a shape satisfies all goals in a+	point-of-view skeleton, the shape is annotated with+	(satifies-all-goals).++2015-03-19  John D. Ramsdell  <ramsdell@mitre.org>++	* src/CPSA/Basic/Algebra.hs (Term): Added node variables and+	constants for security goals.++	* src/CPSA/SAS/SAS.hs (form): Changed the format of a shape+	analysis sentences.  Instead of a bare formula, the formula is+	wrapped in a defsas form, as in (defsas PROT SAS).  Removed the+	protocol from role position predicates and parameter predicates.+	Replaced function symbols uniq and sprec with uniq-at and str-prec+	respectively.++2015-03-17  John D. Ramsdell  <ramsdell@mitre.org>++	* src/CPSA/SAS/SAS.hs (displayEq): Use = for function symbol+	instead of equal.++2014-11-24  John D. Ramsdell  <ramsdell@mitre.org>++	* src/prover9.pl: Added missing mesg predicates in output.++2014-11-17  John D.  Ramsdell  <ramsdell@mitre.org>++	* cpsa.cabal (Version): Tagged as version 2.4.0+ 2014-11-15  John D.  Ramsdell  <ramsdell@mitre.org>  	* src/CPSA/SAS/SAS.hs (nodeForm): Fixed bug where some role@@ -26,7 +122,6 @@ 2014-09-05  John D. Ramsdell  <ramsdell@mitre.org>  	* cpsa.cabal (Version): Tagged as version 2.3.5-  2014-09-02  John D. Ramsdell  <ramsdell@mitre.org>
NEWS view
@@ -1,5 +1,22 @@ CPSA NEWS -- history of user-visible changes. +* Changes in version 2.5.0++** Added support for security goals+   In CPSA, a security goal is expressed as a sentence in first-order+   logic.  It asserts that if some properties hold for a skeleton,+   then some other properties must hold for all shapes computed by+   CPSA starting with the skeleton.  Security goals can be used to+   formally state authentication and secrecy goals of a protocol.+   +   Security goals have been integrated into the main CPSA program.+   The new defgoal form can be used to pose an analysis problem by a+   sentence instead of a skeleton.  CPSA extracts a point-of-view+   skeleton from the antecedent of the formula and then analyzes it.+   When it prints a shape, it checks to see if the shape satisfies the+   conclusion of the security goal.  See cpsagoals.pdf for more+   information.+ * Changes in version 2.4.0  ** Added program cpsasas
cpsa.cabal view
@@ -1,5 +1,5 @@ Name:			cpsa-Version:		2.4.0+Version:		2.5.0 Maintainer:		ramsdell@mitre.org Cabal-Version:		>= 1.6 License:		BSD3@@ -46,24 +46,25 @@ Build-Type:		Simple Data-Files:   index.html readme.html cpsauser.html cpsa.mk Make.hs cpsaprimer.pdf-  cpsaoverview.pdf cpsaintroslides.pdf cpsaspec.pdf cpsadesign.pdf-  ffgg.scm ns.scm blanchet.scm or.scm woolam.scm yahalom.scm+  cpsagoals.pdf cpsaoverview.pdf cpsaintroslides.pdf cpsaspec.pdf+  cpsadesign.pdf ffgg.scm ns.scm blanchet.scm or.scm woolam.scm+  yahalom.scm goals.scm Data-Dir:	    	doc Extra-Source-Files:   Makefile ChangeLog README NEWS ghci cpsatst setup.bat   doc/README doc/Makefile doc/macros.tex doc/cpsaprimer.tex-  doc/bcasyntax.tex doc/cpsaintroslides.tex doc/mitreslides.sty-  doc/cpsaspec.tex doc/cpsadesign.tex doc/cpsaoverview.tex-  doc/cpsadiagrams.mp doc/strands.mp doc/cmstrands.mp-  doc/carriers.mp doc/termtree.mp doc/blanchet.mp doc/mitrelogo.mp-  doc/cpsa.bib doc/SDAG.lhs+  doc/cpsagoals.tex doc/bcasyntax.tex doc/cpsaintroslides.tex+  doc/mitreslides.sty doc/cpsaspec.tex doc/cpsadesign.tex+  doc/cpsaoverview.tex doc/cpsadiagrams.mp doc/strands.mp+  doc/cmstrands.mp doc/carriers.mp doc/termtree.mp doc/blanchet.mp+  doc/mitrelogo.mp doc/cpsa.bib doc/SDAG.lhs   src/index.html src/cpsacgi src/cpsacgi.py src/cpsajson.py src/split.py   src/cpsa2svg src/cpsa.el src/httpd_allow_execmem.te src/cpsaperm.scm   src/cpsaops.scm src/preskel src/cpsa.pl src/unsorted.pl src/pp.pl   src/sexpr.pl src/perm.pl src/prover9.pl src/zoom.js src/js2hs-  src/ghcmemlimit build.xml src/cpsaextras/Main.scala-  src/cpsaextras/Pretty.scala src/cpsaextras/Printer.scala-  src/cpsaextras/SExpr.scala+  src/ghcmemlimit build.xml src/scala/Main.scala+  src/scala/Pretty.scala src/scala/Printer.scala+  src/scala/SExpr.scala   tst/README tst/Makefile tst/Make.hs tst/checktst tst/cpsagraphall   tst/cpsashapesall    tst/blanchet.scm tst/blanchet.tst tst/completeness-test.scm@@ -78,22 +79,23 @@   tst/epmo_acctnum.lisp tst/epmo-hash.scm tst/epmo-hash.tst   tst/epmo-key-hash.scm tst/epmo-key-hash.tst tst/epmo.scm   tst/epmo.tst tst/ffgg.scm tst/ffgg.tst tst/fragile_pruning.scm-  tst/fragile_pruning.tst tst/hashtest-key-hash.scm-  tst/hashtest-key-hash.tst tst/hashtest.scm tst/hashtest.tst-  tst/incompleteness_example.scm tst/incompleteness_example.tst-  tst/isoreject.scm tst/isoreject.tst tst/kelly1.scm tst/kelly1.tst-  tst/kelly64.lisp tst/kerb5.lisp tst/kerberos.scm tst/kerberos.tst-  tst/mass2.lsp tst/mass2.tst tst/mass.lsp tst/mass.tst-  tst/missing_contraction.scm tst/missing_contraction.tst-  tst/neuman-stubblebine-alt.lisp tst/neuman-stubblebine-reauth.lisp-  tst/neuman-stubblebine-reauth.lsp tst/neuman-stubblebine-reauth.tst-  tst/neuman-stubblebine.scm tst/neuman-stubblebine.tst-  tst/no_contraction.scm tst/no_contraction.tst tst/nonaug-prune.scm-  tst/nonaug-prune.tst tst/non_transforming.scm-  tst/non_transforming.tst tst/nsl3.scm tst/nsl3.tst tst/nsl4cm1.lsp-  tst/nsl4cm1.tst tst/nsl4.lisp tst/nsl4resp2.lisp tst/nsl5i.lisp-  tst/nsl5.lisp tst/ns-l.scm tst/nslsk.scm tst/nslsk.tst tst/ns-l.tst-  tst/ns.scm tst/ns.tst tst/or.scm tst/or.tst tst/pca.scm tst/pca.tst+  tst/fragile_pruning.tst tst/goals.scm tst/goals.tst+  tst/hashtest-key-hash.scm tst/hashtest-key-hash.tst tst/hashtest.scm+  tst/hashtest.tst tst/incompleteness_example.scm+  tst/incompleteness_example.tst tst/isoreject.scm tst/isoreject.tst+  tst/kelly1.scm tst/kelly1.tst tst/kelly64.lisp tst/kerb5.lisp+  tst/kerberos.scm tst/kerberos.tst tst/mass2.lsp tst/mass2.tst+  tst/mass.lsp tst/mass.tst tst/missing_contraction.scm+  tst/missing_contraction.tst tst/neuman-stubblebine-alt.lisp+  tst/neuman-stubblebine-reauth.lisp tst/neuman-stubblebine-reauth.lsp+  tst/neuman-stubblebine-reauth.tst tst/neuman-stubblebine.scm+  tst/neuman-stubblebine.tst tst/no_contraction.scm+  tst/no_contraction.tst tst/nonaug-prune.scm tst/nonaug-prune.tst+  tst/non_transforming.scm tst/non_transforming.tst tst/nsl3.scm+  tst/nsl3.tst tst/nsl4cm1.lsp tst/nsl4cm1.tst tst/nsl4.lisp+  tst/nsl4resp2.lisp tst/nsl5i.lisp tst/nsl5.lisp tst/ns-l.scm+  tst/nslsk.scm tst/nslsk.tst tst/ns-l.tst tst/ns.scm tst/ns.tst+  tst/or.scm tst/or.tst tst/pca.scm tst/pca.tst   tst/pen-non-orig-test.scm tst/pen-non-orig-test.tst tst/pkinit.scm   tst/pkinit.tst tst/preprocess.scm tst/preprocess.tst tst/print.scm   tst/print.tst tst/pruning1.scm tst/pruning1.tst tst/sigenc.scm@@ -110,8 +112,13 @@   tst/wonthull2.scm tst/wonthull2.tst tst/wonthull3.scm   tst/wonthull3.tst tst/wonthull.scm tst/wonthull.tst tst/woolam.scm   tst/woolam.tst tst/yahalom-6.3.6.scm tst/yahalom-6.3.6.tst-  tst/yahalom.scm tst/yahalom.tst+  tst/yahalom.scm tst/yahalom.tst tst/unilateral.scm+  tst/unilateral.tst +Source-Repository head+  Type:     git+  Location: git://github.com/ramsdell/cpsa.git+ -- Algebra implementations must import CPSA.Lib.CPSA. -- Tools may additionally import CPSA.Lib.Entry. -- No other modules in CPSA.Lib should be imported by applications.@@ -125,9 +132,10 @@   Other-Modules:     Paths_cpsa CPSA.Lib.Vector CPSA.Lib.Utilities CPSA.Lib.Pretty     CPSA.Lib.SExpr CPSA.Lib.Printer CPSA.Lib.Notation CPSA.Lib.Entry-    CPSA.Lib.Algebra CPSA.Lib.Protocol CPSA.Lib.Strand CPSA.Lib.Loader-    CPSA.Lib.Displayer CPSA.Lib.Cohort CPSA.Lib.Expand CPSA.Lib.CPSA-    CPSA.Lib.Reduction CPSA.Basic.Algebra CPSA.DiffieHellman.Algebra+    CPSA.Lib.Algebra CPSA.Lib.Protocol CPSA.Lib.Goal CPSA.Lib.Strand+    CPSA.Lib.Characteristic CPSA.Lib.Loader CPSA.Lib.Displayer+    CPSA.Lib.Cohort CPSA.Lib.Expand CPSA.Lib.CPSA CPSA.Lib.Reduction+    CPSA.Basic.Algebra CPSA.DiffieHellman.Algebra  Executable cpsagraph   Main-Is:		CPSA/Graph/Main.hs
doc/Makefile view
@@ -10,6 +10,7 @@ SHELL = /bin/sh  PRIMER = cpsaprimer+GOALS = cpsagoals OVERVIEW = cpsaoverview SLIDES = cpsaintroslides DESIGN = cpsadesign@@ -31,8 +32,8 @@ %.ind:	%.idx 	makeindex $* -all:	$(PRIMER).pdf $(OVERVIEW).pdf $(SLIDES).pdf \-		$(DESIGN).pdf $(SPEC).pdf+all:	$(PRIMER).pdf $(GOALS).pdf $(OVERVIEW).pdf \+		$(SLIDES).pdf $(DESIGN).pdf $(SPEC).pdf  $(PRIMER).pdf:	$(MP_SRCS:.mp=-0.mps) $(TEX_SRCS) \ 		 $(PRIMER).tex $(PRIMER).bbl@@ -40,6 +41,11 @@ 	if test -f $(PRIMER).idx; then $(MAKE) $(PRIMER).ind; fi 	pdflatex $(PRIMER).tex +$(GOALS).pdf: $(MP_SRCS:.mp=-0.mps) $(TEX_SRCS) \+		$(GOALS).tex $(GOALS).bbl+	if test ! -f $(GOALS).aux; then pdflatex $(GOALS).tex; fi+	pdflatex $(GOALS).tex+ $(OVERVIEW).pdf: $(OVERVIEW).tex $(OVERVIEW).bbl 	if test ! -f $(OVERVIEW).aux; then pdflatex $(OVERVIEW).tex; fi 	pdflatex $(OVERVIEW).tex@@ -59,8 +65,8 @@ 	if test -f $(SPEC).idx; then $(MAKE) $(SPEC).ind; fi 	pdflatex $(SPEC).tex -CLEAN_FILES := $(PRIMER).pdf $(OVERVIEW).pdf $(SLIDES).pdf \-		$(DESIGN).pdf $(SPEC).pdf \+CLEAN_FILES := $(PRIMER).pdf $(GOALS).pdf $(OVERVIEW).pdf \+		$(SLIDES).pdf $(DESIGN).pdf $(SPEC).pdf \ 	$(wildcard *.log *.aux *.toc *.mps *.mpx *.lot *.lof) \ 	$(wildcard *.bbl *.blg *.ind *.idx *.ilg *.out)
doc/README view
@@ -8,12 +8,13 @@  * cpsaoverview.pdf: Another attempt at a gentle introduction to CPSA +* cpsagoals.pdf: CPSA and Formal Security Goals, an introduction+  to reasoning about security goals using first-order logic.+ * cpsaspec.pdf: The CPSA Specification, a formal specification of the   algorithm  * cpsadesign.pdf: CPSA Design, a description of implementation choices--* cpsadha.pdf: Diffie-Hellman Algebra (an experiment with known flaws).  To build the documentation, you need Metapost and XY-pic.  On Linux, Metapost is supplied via the package texlive-metapost, and XY-pic is
doc/bcasyntax.tex view
@@ -1,14 +1,18 @@ The complete syntax for the analyzer using the Basic Crypto Algebra is-shown in Table~\ref{tab:syntax}.  The start grammar symbol is-\textsc{file}, and the terminal grammar symbols are: \textsc{(, ),-  symbol, string, integer,} and the constants set in typewriter font.+shown in Tables~\ref{tab:syntax} and~\ref{tab:goal}.  The start+grammar symbol is \textsc{file}, and the terminal grammar symbols+are: \textsc{(, ), symbol, string, integer,} and the constants set in+typewriter font.  The language used for stating security goals is in+Table~\ref{tab:goal}.  The goal language adds the sort+symbol \texttt{node}.  The \textsc{alist}, \textsc{prot-alist}, \textsc{role-alist},-and \textsc{skel-alist} productions are Lisp style association lists,-that is, lists of key-value pairs, where every key is a symbol.-Key-value pairs with unrecognized keys are ignored, and are available-for use by other tools.  On output, unrecognized key-value pairs are-preserved when printing protocols, but elided when printing skeletons.+\textsc{skel-alist}, and \textsc{goal-alist} productions are+Lisp style association lists, that is, lists of key-value pairs, where+every key is a symbol.  Key-value pairs with unrecognized keys are+ignored, and are available for use by other tools.  On output,+unrecognized key-value pairs are preserved when printing protocols,+but elided when printing skeletons.  \begin{table} \newcommand{\sym}[1]{\textup{\texttt{#1}}}@@ -19,7 +23,7 @@ (\sym{herald}~title~alist) \\title&$\leftarrow$&$\mbox{symbol}\mid\mbox{string}$ \\form&$\leftarrow$&-$\mbox{comment}\mid\mbox{protocol}\mid\mbox{skeleton}$+$\mbox{comment}\mid\mbox{protocol}\mid\mbox{skeleton}\mid\mbox{goal}$ \\ comment&$\leftarrow$& (\sym{comment}~\ldots) \\ protocol&$\leftarrow$&@@ -71,6 +75,34 @@ \end{tabular} \end{center} \caption{{\cpsa} Syntax}\label{tab:syntax}+\end{table}++\begin{table}+\newcommand{\sym}[1]{\textup{\texttt{#1}}}+\begin{center}\scshape+\begin{tabular}{rcl}+goal&$\leftarrow$&+(\sym{defgoal} id sentence+ goal-alist)+\\ sentence&$\leftarrow$&(\sym{forall} (decl$\ast$) implication)+\\ implication&$\leftarrow$&+(\sym{implies} \mbox{antecedent} \mbox{conclusion})+\\ conclusion&$\leftarrow$&(\sym{false})+   $\mid$ existential $\mid$ (\sym{or} existential$\ast)$+\\ existential&$\leftarrow$&(\sym{exists}+(decl$\ast$) antecedent) $\mid$ antecedent+\\ antecedent&$\leftarrow$& atomic $\mid$ (\sym{and} atomic$\ast$)+\\ atomic&$\leftarrow$&(\sym{p} roleid pos nvar)+\\ &$\mid$&(\sym{p} roleid param nvar term)+\\ &$\mid$&(\sym{str-prec} nvar nvar) $\mid$ (\sym{prec} nvar nvar)+\\ &$\mid$&(\sym{non} term) $\mid$ (\sym{pnon} term) $\mid$ (\sym{uniq} term)+\\ &$\mid$&(\sym{uniq-at} term nvar) $\mid$ (= term term)+\\ roleid&$\leftarrow$& string+\\ pos&$\leftarrow$& integer+\\ nvar&$\leftarrow$& id+\\ param&$\leftarrow$& string+\end{tabular}+\end{center}+\caption{{\cpsa} Syntax Continued}\label{tab:goal} \end{table}  The contents of a file can be interpreted as a sequence of
doc/cpsa.bib view
@@ -223,6 +223,20 @@   OPTannote = 	 {} } +@Manual{cpsagoals09,+  title = 	 {{CPSA} and Formal Security Goals},+  OPTkey = 	 {},+  author = 	 {John D.~Ramsdell},+  organization = {The MITRE Corporation},+  OPTaddress = 	 {},+  OPTedition = 	 {},+  OPTmonth = 	 {},+  year = 	 2015,+  note = 	 {In \url{http://hackage.haskell.org/package/cpsa} source+    distribution, \texttt{doc} directory},+  OPTannote = 	 {}+}+ @Manual{cpsaoverview09,   title = 	 {{CPSA} Overview},   OPTkey = 	 {},@@ -399,10 +413,42 @@   author = 	 {John D. Ramsdell and Joshua D. Guttman and                   Jonathan K. Millen and Brian O'Hanlon},   title = 	 {An Analysis of the {CAVES} Attestation Protocol using {CPSA}},-  note = 	 {\url{http://arxiv.org/abs/1207.0418v1}},+  note = 	 {\url{http://arxiv.org/abs/1207.0418}},   institution =  {The {MITRE} Corporation},   month = 	 dec,   year = 	 2009,   type = 	 {{MITRE} Technical Report},   number = 	 {{MTR090213}}+}++@InProceedings{GuttmanLiskovRowe14,+  author = 	 {Joshua D. Guttman and Moses D. Liskov and Paul D. Rowe},+  title = 	 {Security Goals and Evolving Standards},+  booktitle =    {Security Standardization Research},+  year = 	 2014,+  editor = 	 {Liqun Chen and Chris Mitchell},+  volume = 	 8839,+  series = 	 {LNCS},+  pages = 	 {93--110},+  month = 	 dec,+  publisher =    {Springer},+}++@Article{Guttman14,+  author = 	 {Joshua D. Guttman},+  title = 	 {Establishing and Preserving Protocol Security Goals},+  journal = 	 {Journal of Computer Security},+  year = 	 2014,+  volume = 	 22,+  number = 	 2,+  pages = 	 {201--267}}++@Unpublished{prover9,+  author = 	 {Bill W. McCune},+  title = 	 {Prover9},+  note = 	 {\url{http://www.cs.unm.edu/~mccune/mace4/}},+  OPTkey = 	 {},+  OPTmonth = 	 {},+  OPTyear = 	 {},+  OPTannote = 	 {} }
doc/cpsadesign.pdf view

binary file changed (273796 → 275306 bytes)

doc/cpsadesign.tex view
@@ -927,8 +927,12 @@ Provides a common entry point for programs based on the CPSA library. \item[CPSA.Lib.Protocol:] Protocol data structures.+\item[CPSA.Lib.Goal:]+Security goal data structures. \item[CPSA.Lib.Strand:] Instance and preskeleton data structures and support functions.+\item[CPSA.Lib.Characteristic:]+Produces the characteristic skeleton of the antecedent of a goal. \item[CPSA.Lib.Cohort:] Computes the cohort associated with a skeleton or its generalization. \item[CPSA.Lib.Reduction:]@@ -936,7 +940,7 @@ \item[CPSA.Lib.Expand:] Expands macros using definitions in the input. \item[CPSA.Lib.Loader:]-Loads protocols and preskeletons from S-expressions.+Loads protocols, preskeletons, and goals from S-expressions. \item[CPSA.Lib.Displayer:] Displays protocols and preskeletons as S-expressions. \end{description}
doc/cpsadiagrams.mp view
@@ -73,11 +73,11 @@   strand.b(3, .5w, delta, btex $\mathstrut\mathit{resp}$ etex, node);    % Messages and arrows-  label.top(btex $\enc{N_1, A}{K_B}$ etex, .5[a1.e, b1.w]);+  label.top(btex $\enc{N_1, A}{K_B}$ etex, .5[a1.c, b1.c]);   drawmsg(a1.e -- b1.w);-  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, .5[a2.e, b2.w]);+  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, .5[a2.c, b2.c]);   drawmsg(b2.w -- a2.e);-  label.top(btex $\enc{N_2}{K_B}$ etex, .5[a3.e, b3.w]);+  label.top(btex $\enc{N_2}{K_B}$ etex, .5[a3.c, b3.c]);   drawmsg(a3.e -- b3.w); endfig; @@ -125,15 +125,15 @@   drawsucc(b1.s -- b2.n);   drawsucc(b2.s -- b3.n); -  label.top(btex $\enc{N_1, A}{K_P}$ etex, .5[a1.e, p1.w]);+  label.top(btex $\enc{N_1, A}{K_P}$ etex, .5[a1.c, p1.c]);   drawmsg(a1.e -- p1.w);-  label.top(btex $\enc{N_1, A}{K_B}$ etex, .5[p2.e, b1.w]);+  label.top(btex $\enc{N_1, A}{K_B}$ etex, .5[p2.c, b1.c]);   drawmsg(p2.e -- b1.w);-  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, .75[b2.w, a2.e]);+  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, .75[b2.c, a2.c]);   drawmsg(b2.w -- a2.e);-  label.top(btex $\enc{N_2}{K_P}$ etex, .5[a3.e, p3.w]);+  label.top(btex $\enc{N_2}{K_P}$ etex, .5[a3.c, p3.c]);   drawmsg(a3.e -- p3.w);-  label.top(btex $\enc{N_2}{K_B}$ etex, .5[p4.e, b3.w]);+  label.top(btex $\enc{N_2}{K_B}$ etex, .5[p4.c, b3.c]);   drawmsg(p4.e -- b3.w); endfig; @@ -156,17 +156,17 @@   endfor;    % Messages and arrows-  label.top(btex $\enc{N_1, A}{K_C}$ etex, alpha[a1.e, o1.w]);+  label.top(btex $\enc{N_1, A}{K_C}$ etex, alpha[a1.c, o1.c]);   drawmsg(a1.e -- beta[a1.e,o1.w]); % Shortened arrow-  label.top(btex $\enc{N_1, A}{K_B}$ etex, alpha[b1.w, o1.e]);+  label.top(btex $\enc{N_1, A}{K_B}$ etex, alpha[b1.c, o1.c]);   drawmsg(beta[b1.w,o1.e] -- b1.w); % Shortened arrow-  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, alpha[a2.e, o2.w]);+  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, alpha[a2.c, o2.c]);   drawmsg(o2.w -- a2.e);-  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, alpha[b2.w, o2.e]);+  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, alpha[b2.c, o2.c]);   drawmsg(b2.w -- o2.e);-  label.top(btex $\enc{N_2}{K_C}$ etex, alpha[a3.e, o3.w]);+  label.top(btex $\enc{N_2}{K_C}$ etex, alpha[a3.c, o3.c]);   drawmsg(a3.e -- o3.w);-  label.top(btex $\enc{N_2}{K_B}$ etex, alpha[b3.w, o3.e]);+  label.top(btex $\enc{N_2}{K_B}$ etex, alpha[b3.c, o3.c]);   drawmsg(o3.e -- b3.w); endfig; @@ -186,17 +186,17 @@   endfor;    % Messages and arrows-  label.top(btex $\enc{N_1, A}{K_B}$ etex, alpha[a1.e, o1.w]);+  label.top(btex $\enc{N_1, A}{K_B}$ etex, alpha[a1.c, o1.c]);   drawmsg(a1.e -- o1.w);-  label.top(btex $\enc{N_1, A}{K_B}$ etex, alpha[b1.w, o1.e]);+  label.top(btex $\enc{N_1, A}{K_B}$ etex, alpha[b1.c, o1.c]);   drawmsg(o1.e -- b1.w);-  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, alpha[a2.e, o2.w]);+  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, alpha[a2.c, o2.c]);   drawmsg(o2.w -- a2.e);-  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, alpha[b2.w, o2.e]);+  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, alpha[b2.c, o2.c]);   drawmsg(b2.w -- o2.e);   label.top(btex $\enc{N_2}{K_B}$ etex,-    alpha[a3.e, (xpart o2.w, ypart a3.c)]);-  drawmsg(a3.e -- (beta * xpart o2.w, ypart a3.c));+    alpha[a3.c, (xpart o2.c, ypart a3.c)]);+  drawmsg(a3.c -- (beta * xpart o2.c, ypart a3.c)); endfig;  % Incompleteness example@@ -233,10 +233,72 @@   strand.b(2, .5w, delta, btex $\mathstrut\mathit{resp}$ etex, node);    % Messages and arrows-  label.top(btex $\enc{N}{K}$ etex, .5[a1.e, b1.w]);+  label.top(btex $\enc{N}{K}$ etex, .5[a1.c, b1.c]);   drawmsg(a1.e -- b1.w);-  label.top(btex $N$ etex, .5[a2.e, b2.w]);+  label.top(btex $N$ etex, .5[a2.c, b2.c]);   drawmsg(b2.w -- a2.e);+endfig;++beginfig(9);+  % Strand for principal A+  strand.a(3, origin, delta, btex $\mathstrut\mathit{init}$ etex, node);++  % Strand for principal B+  strand.b(2, w + a2.c, delta, btex $\mathstrut\mathit{resp}$ etex, node);++  % Centered ordering symbols+  boxit.o1(btex $\prec$ etex); o1.c = .5[a1.c, b1.c];+  boxit.o2(btex $\succ$ etex); o2.c = .5[a2.c, b2.c];++  for i = 1 upto 2:+    draw pic o[i];+  endfor;++  % Messages and arrows+  label.top(btex $\enc{N_1, A}{K_B}$ etex, alpha[a1.c, o1.c]);+  drawmsg(a1.e -- o1.w);+  label.top(btex $\enc{N_1, A}{K_B}$ etex, alpha[b1.c, o1.c]);+  drawmsg(o1.e -- b1.w);+  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, alpha[a2.c, o2.c]);+  drawmsg(o2.w -- a2.e);+  label.top(btex $\enc{N_1, N_2'}{K_A}$ etex, alpha[b2.c, o2.c]);+  drawmsg(b2.w -- o2.e);+  label.top(btex $\enc{N_2}{K_B}$ etex,+    alpha[a3.c, (xpart o2.c, ypart a3.c)]);+  drawmsg(a3.e -- (beta * xpart o2.w, ypart a3.c));+endfig;++beginfig(10);+  % Strand for principal A+  strand.a(3, origin, delta, btex $\mathstrut\mathit{resp}$ etex, node);++  % Strand for principal B+  strand.b(3, w, delta, btex $\mathstrut\mathit{init}$ etex, node);++  % Centered ordering symbols+  boxit.o2(btex $\prec$ etex); o2.c = .5[a2.c, b2.c];+  boxit.o3(btex $\succ$ etex); o3.c = .5[a3.c, b3.c];++  for i = 2 upto 3:+    draw pic o[i];+  endfor;++  % Messages and arrows+  label.top(btex $\enc{N_1, A}{K_B}$ etex,+      alpha[a1.c, (xpart o2.c, ypart a1.c)]);+  drawmsg(a1.e -- (beta * xpart o2.w, ypart a1.c));+  label.top(btex $\enc{N_1, A}{K_{B'}}$ etex,+      alpha[b1.c, (xpart o2.c, ypart b1.c)]);+  drawmsg((1-beta)[(xpart o2.e, ypart b1.c), b1.w] -- b1.w);+  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, alpha[a2.c, o2.c]);+  drawmsg(a2.e -- o2.w);+  label.top(btex $\enc{N_1, N_2}{K_A}$ etex, alpha[b2.c, o2.c]);+  drawmsg(o2.e -- b2.w);+  label.top(btex $\enc{N_2}{K_B}$ etex, alpha[a3.c, o3.c]);+  drawmsg(o3.w -- a3.e);+  label.top(btex $\enc{N_2}{K_{B'}}$ etex, alpha[b3.c, o3.c]);+  drawmsg(b3.w -- o3.e);+ endfig;  verbatimtex
+ doc/cpsagoals.pdf view

binary file changed (absent → 194012 bytes)

+ doc/cpsagoals.tex view
@@ -0,0 +1,718 @@+\documentclass[12pt]{article}+\usepackage{amssymb}+\usepackage{amsmath}+\usepackage{url}+\usepackage{graphicx}+\usepackage{alltt}+\input{macros}++\newcommand{\sym}[1]{\textup{\texttt{#1}}}++\title{CPSA and Formal Security Goals}+\author{John D.~Ramsdell\\+  The MITRE Corporation\\ CPSA Version \version}++\begin{document}+\maketitle+\cpsacopying++\tableofcontents++\newpage++\listoffigures++\listoftables++\newpage++\section{Introduction}++\begin{sloppypar}+Analyzing a cryptographic protocol means finding out what security+properties---essentially, authentication and secrecy properties---are+true in all its possible executions.+\end{sloppypar}++Given a protocol definition and some assumptions about executions,+{\cpsa} attempts to produce descriptions of all possible executions of+the protocol compatible with the assumptions.  Naturally, there are+infinitely many possible executions of a useful protocol, since+different participants can run it with varying parameters, and the+participants can run it repeatedly.++However, for many naturally occurring protocols, there are only+finitely many of these runs that are essentially different.  Indeed,+there are frequently very few, often just one or two, even in cases+where the protocol is flawed.  We call these essentially different+executions the \emph{shapes} of the protocol.  Authentication and+secrecy properties are easy to ``read off'' from the shapes, as are+attacks and anomalies, according to the introduction in the {\cpsa}+Primer~\cite{cpsaprimer09}.++But how easy is it to read off authentication and secrecy properties?+What precisely is it that an expert sees?  This paper describes+{\cpsa}'s support for reasoning about security goals using first-order+logic.  With security goals expressed in first-order logic, intuition+is replaced by determining if a formula is true in all executions of+the protocol.++% \emph{Something about the benefits of first-order logic goes here.}++This treatment of security goals relies heavily on a branch of+first-order logic called model theory.  It deals with the relationship+between descriptions in first-order languages and the structures that+satisfy these descriptions.  In our case, the structures are skeletons+that denote a collection of executions of a protocol.  This paper+attempts to describe the language of security goals and its+structures without requiring the reader to have studied model theory.++The model theoretical foundation of this approach to security goals+appears in~\cite{Guttman14}.  A practical use of security goals in+protocol standardization is described in~\cite{GuttmanLiskovRowe14}.+The precise semantics of the goal language is+in~\cite[Appendix~C]{cpsaspec09}.  The syntax of security goals+appears in~\cite[Table~2]{cpsaprimer09}.++The distribution in which this paper is included contains the sample+input {\cpsa} file \texttt{goals.scm}.  It contains the examples in+this paper.  You are encouraged to run the examples and examine the+output while reading this paper.++%% Use a margin width of 62 for S-expressions++\begin{figure}+\begin{center}+\includegraphics{cpsadiagrams-0.mps}\hfil+\includegraphics{cpsadiagrams-1.mps}\\+\end{center}+\begin{center}+\begin{minipage}{3in}+\begin{verbatim}+(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))))))+\end{verbatim}+\end{minipage}+\end{center}+\caption{Needham-Schroeder Initiator and Responder Roles}+\label{fig:ns roles}+\end{figure}++\begin{figure}+\begin{verbatim}+(defgoal ns                ; Goal+  (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))))))++(defskeleton ns            ; Point of view skeleton+  (vars (a b name) (n1 n2 text))+  (defstrand init 3 (a a) (b b) (n1 n1) (n2 n2))+  (non-orig (privk b))+  (uniq-orig n1))+\end{verbatim}+\begin{center}+\includegraphics{cpsadiagrams-9.mps}+\end{center}+\begin{verbatim}+(defskeleton ns            ; Shape+  (vars (n1 n2 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 b))+  (uniq-orig n1)+  (satisfied yes))+\end{verbatim}+\caption{Needham-Schroeder Initiator Point of View}+\label{fig:ns init}+\end{figure}++The {\cpsa} Primer~\cite{cpsaprimer09} is a prerequisite for reading+this paper.  In particular, the Needham-Schroeder Protocol in+Section~10 is reanalyzed using security goals here.  The roles are+displayed in Figure~\ref{fig:ns roles}.++The protocol is analyzed from the point of view of a complete run of+one instance of the initiator role.  The input security goal, followed+by the point of view skeleton it generates and the shape produced by+{\cpsa}, are shown in Figure~\ref{fig:ns init}.  The syntax and+semantics of the goal will be explained later.  Roughly speaking, it+asserts that if a realized skeleton contains a full length initiator+strand, its private key is uncompromised, and it uniquely generates+\texttt{n1}, then the skeleton will contain a responder strand that+agrees with the initiator on the name \texttt{b}.  The shape produced+by {\cpsa} contains the annotation \texttt{(satisfies yes)}.  This+indicates that its structure satisfies the description given by the+security goal.  It will be explained later why the properties of+{\cpsa} allows us to conclude that this goal is true in all executions+of the protocol, and therefore conclude that the Needham-Schroeder+protocol achieves this authentication goal.++\section{Syntax}\label{sec:syntax}++To be precise, a security goal is an order-sorted first-order logic+sentence in a restricted form.  The sentence in Figure~\ref{fig:ns+  init} has the form shared by all security goals.  It is a universally+quantified implication.  The antecedent is a conjunction of atomic+formulas.  For this sentence, the conclusion is an existentially+quantified conjunction of atomic formulas, but in general, the+conclusion is a disjunction of existentially quantified conjunctions+of atomic formulas.  \sym{(false)} is a synonym for \sym{(or)}.++\begin{center}\scshape+  \begin{tabular}{rcl}+  goal&$\leftarrow$&(\sym{defgoal} prot sent$+$ comments)+  \\ sent&$\leftarrow$&(\sym{forall} (decl$\ast$) (\sym{implies} antec concl))+  \\ concl&$\leftarrow$&(\sym{false})+  $\mid$ existl $\mid$ (\sym{or} existl$\ast)$+  \\ existl&$\leftarrow$&(\sym{exists}+  (decl$\ast$) antec) $\mid$ antec+  \\ antec&$\leftarrow$&atomic $\mid$ (\sym{and} atomic$\ast$)+  \end{tabular}+\end{center}++Variables are declared as they are for roles and skeletons with one+exception, there is a new sort symbol \sym{node}.  Notice that in the+sentence, variables \sym{z0} and \sym{z1} have sort \sym{node}.  Every+universally quantified variable must occur in the antecedent of the+implication.++The predicates used to construct an atomic formula (\textsc{atomic})+are listed in Table~\ref{tab:predicates}.  The first line gives the+syntax of a role position predicate.  It contains three tokens,+\texttt{p}, a string that names a role, and an integer that specifies+a position within the trace of the role.  That is, for role~$r$ with a+trace of length~$n$, there are~$n$ role position predicates,+\mbox{\texttt{p} $r$ $i$}, for $0\leq i < n$.  The second line gives+the syntax of a role parameter predicate.  It contains three tokens,+\texttt{p}, a string that names a role, and a string that names a role+variable.  For role~$r$, there is role parameter predicate for each+variable declared by~$r$.++The empty string names the listener role of a protocol.  The role+has the variable \texttt{x} of sort \texttt{mesg} as its only role+variable.  There are two positions in the listener role.++When a variable of sort \sym{node} occurs in a formula, its position+must be specified using a role position formula.  When an algebra+variable occurs in formula, its association with the parameter of some+role must be specified using a role parameter formula.++\begin{table}+\begin{center}+  \begin{tabular}{lcl}+    Symbol & Sort & Description\\+    \hline+    \scshape\sym{p} role pos & \dom{node} & \mbox{Role position} \\+    \scshape\sym{p} role param & $\dom{node}\times\dom{mesg}$+    & \mbox{Role parameter} \\+    \sym{str-prec}& $\dom{node}\times\dom{node}$+    & \mbox{Precedes on strand} \\+    \sym{prec}& $\dom{node}\times\dom{node}$+    & \mbox{Precedes} \\+    \sym{non}& \dom{atom}+    & \mbox{Non-origination} \\+    \sym{pnon}& \dom{atom}+    & \mbox{Penetrator non-origination} \\+    \sym{uniq}& \dom{atom}+    & \mbox{Unique origination} \\+    \sym{uniq-at}& $\dom{atom}\times\dom{node}$+    & \mbox{Unique origination at node} \\+    $=$ & $\dom{all}\times\dom{all}$ & Equality+  \end{tabular}+\end{center}+\caption{Predicates}\label{tab:predicates}+\end{table}++\section{Semantics}\label{sec:semantics}++In a \texttt{defgoal} sentence, the antecedent specifies the point of+view skeleton.  We focus on the antecedent.  In the example,++\begin{quote}+\begin{verbatim}+(defstrand init 3 (a a) (b b) (n1 n1) (n2 n2))+\end{verbatim}+\end{quote}+is extracted from+\begin{quote}+\begin{verbatim}+(and (p "init" 2 z0)+  (p "init" "n1" z0 n1) (p "init" "b" z0 b)).+\end{verbatim}+\end{quote}+Notice that {\cpsa} adds a binding for \texttt{a} and \texttt{n2} just+as it does had+\begin{quote}+\begin{verbatim}+(defstrand init 3 (b b) (n1 n1))+\end{verbatim}+\end{quote}+been given as input.++Our aim now is to specify how to decide if a security goal is true in+all possible executions of a protocol.  A skeleton defines a set of+executions that contain the skeleton's structure.  We say a skeleton+\emph{satisfies} a formula if the formula is true in all executions+that contain the skeleton's structure.  To decide if a skeleton+satisfies a formula, we decide if it satisfies each of its atomic+formulas, and combine the results using the rules of first-order+logic.++Atomic formula \texttt{(p "init" 2 z0)} is called a role position+formula.  A skeleton~$k$ satisfies the formula if \texttt{z0} maps to+a node $n=(s,2)$ in~$k$ such that+\begin{enumerate}+\item the trace of strand~$s$ in~$k$ has a length greater than 2, and+\item the trace when truncated to length 3 is an instance of the init+  role.+\end{enumerate}+Consider the shape in Figure~\ref{fig:ns init}.  It satisfies+\texttt{(p "init" 2 z0)} when \texttt{z0} maps to $(0,2)$.++Atomic formula \texttt{(p "init" "n1" z0 n1)} is called a role+parameter formula.  A skeleton~$k$ satisfies the formula if+\texttt{z0} maps to a node $n=(s,i)$ in~$k$ and \texttt{n1} maps to a+message algebra term~$t$ in~$k$ such that+\begin{enumerate}+\item the trace of strand~$s$ in~$k$ has a length greater than~$i$,+\item the trace truncated to length $i+1$ is an instance of the+  init role, and+\item the truncated trace is compatible with mapping the init role's+  \texttt{"n1"} role variable to~$t$.+\end{enumerate}+The shape in Figure~\ref{fig:ns init} satisfies \texttt{(p "init" "n1"+  z0 n1)} when \texttt{z0} maps to $(0,2)$ and \texttt{n1} maps to the+message algebra term \texttt{n1}.++Collectively, a skeleton satisfies the formula+\begin{quote}+\begin{verbatim}+(and (p "init" 2 z0)+     (p "init" "a" z0 a) (p "init" "b" z0 b)+     (p "init" "n1" z0 n1) (p "init" "n2" z0 n2))+\end{verbatim}+\end{quote}+if the skeleton contains the structure specified by+\begin{quote}+\begin{verbatim}+(defstrand init 3 (a a) (b b) (n1 n1) (n2 n2)).+\end{verbatim}+\end{quote}++The antecedent in Figure~\ref{fig:ns init} contains two origination+assertions.  The formula \texttt{(non (privk b))} is extracted as+\texttt{(privk b)}.  A skeleton~$k$ satisfies the formula if+\texttt{b} maps to a message algebra term~$t$ in~$k$ such that~$k$+assumes that~$t$ is non-originating.  The unique origination formula for+\texttt{n1} is similarly extracted.++Putting it all together, the mapping+\[\{\mathtt{n1}\mapsto\mathtt{n1},+\mathtt{n2}\mapsto\mathtt{n2}, \mathtt{a}\mapsto\mathtt{a},+\mathtt{b}\mapsto\mathtt{b},\mbox{\tt z0}\mapsto(0,2)\}\] shows that+the shape in Figure~\ref{fig:ns init} satisfies the antecedent of the+security goal.++The \texttt{prec} predicate is used to assert a node precedes another+node.  The conclusion in Figure~\ref{fig:ns init} with \texttt{(prec+  z1 z0)} added is satisfied by the shape using the mapping $\mbox{\tt+  z0}\mapsto(0,2)$ and $\mbox{\tt z1}\mapsto(1,1)$.++The \texttt{str-prec} predicate is used to assert a node precedes another+node and that both are on the same strand.++The \texttt{uniq-at} predicate is used to assert not only that an atom+uniquely originates, but also the node at which it originates.  It is+typically used in conjunction with a \texttt{str-prec} formula.  In+the Figure~\ref{fig:ns init} goal, the \texttt{(uniq n1)} formula+could have been replaced by+\begin{quote}+\begin{verbatim}+(p "init" 0 z2) (str-prec z2 z0) (uniq-at n1 z2),+\end{verbatim}+\end{quote}+where \texttt{z2} has sort \texttt{node}.  The extracted point of view+skeleton is the same.  Of course, an error is raised if the role+position formula is replaced by \texttt{(p "init" 1 z2)}.++Recall that our aim in analyzing a protocol is to find out what+security goals are true in all of its possible executions.  We are+interested in runs of {\cpsa} that show that when every shape+satisfies a goal, it is true in every execution.++When {\cpsa} performs a shape analysis, every shape it generates+refines the input skeleton.  Skeleton refinement is defined+in~\cite[Section~6]{cpsaprimer09}, but roughly speaking, skeleton~$A$+refines skeleton~$B$ if~$A$ contains the structure of skeleton~$B$.++The skeleton~$k_0$ extracted from the antecedent of a security goal+has the property that every skeleton than refines~$k_0$ satisfies the+antecedent.  A skeleton with this property is called the+\emph{characteristic skeleton} of the antecedent.++Given a goal~\(\Phi\), consider a shape analysis starting from the+characteristic skeleton~$k_0$ of its antecedent.  Assume {\cpsa} finds+shapes $k_1,\ldots,k_n$ and that {\cpsa} determines that each~$k_i$+satisfies~$\Phi$.  Consider the executions that contain the structure+in~$k_0$.  {\cpsa} tells us that each execution is in the executions+that contain the structure of some~$k_i$.  Furthermore, because~$k_0$+is a characteristic skeleton, each~$k_i$ satisfies the antecedent+of~$\Phi$.  Therefore,~$\Phi$ is true in all executions of the+protocol and maximally informative.++\section{Examples}\label{sec:examples}++This section contains examples of both authentication and secrecy+goals.  The first example shows the feedback the user receives when a+shape does not satisfy a security goal.  The second example shows how+to use a listener to state a secrecy goal.++\subsection{Needham-Schroeder Responder}\label{sec:ns resp}++\begin{figure}+\begin{verbatim}+(defgoal ns                ; Goal+  (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)))))++(defskeleton ns            ; Point of view skeleton+  (vars (a b name) (n1 n2 text))+  (defstrand init 3 (a a) (b b) (n1 n1) (n2 n2))+  (non-orig (privk a))+  (uniq-orig n2))+\end{verbatim}+\begin{center}+\includegraphics{cpsadiagrams-10.mps}+\end{center}+\begin{verbatim}+(defskeleton ns            ; Shape+  (vars (n1 n2 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)+  (satisfies (no (a a) (b b) (n2 n2) (z0 (0 2))))+\end{verbatim}+\caption{Needham-Schroeder Responder Point of View}+\label{fig:ns resp}+\end{figure}++Figure~\ref{fig:ns resp} contains an analysis of Needham-Schroeder+from the point of view of a complete run of the responder under the+assumption that the responder's private key is uncompromised and the+nonce it generates uniquely originates.++The conclusion of the goal asserts that in an execution compatible+with the point of view, there must be an initiator strand that agrees+with the responder strand on the name \texttt{b}.  The shape produced+by {\cpsa} is a counterexample to this assertion.  Because of this,+{\cpsa} annotates the shape with+\begin{quote}+\begin{verbatim}+(satisfies (no (a a) (b b) (n2 n2) (z0 (0 2))).+\end{verbatim}+\end{quote}+The annotation includes a variable mapping for the shape that+satisfies the antecedent of the goal but does not satisfy its+conclusion.  The mapping \texttt{(b b)} is the reason the shape does+not satisfy the goal.++Galvin Lowe identified this authentication failure in+Needham-Schroeder and provided a fix.  In the Needham-Schroeder-Lowe+Protocol, the name \texttt{b} is included within the encryption in second+message of both roles.  With this modification, the shape found by+{\cpsa} satisfies the security goal in Figure~\ref{fig:ns resp}, so+Needham-Schroeder-Lowe achieves this authentication goal.++\subsection{A Needham-Schroeder Secrecy Goal}\label{sec:secrecy goal}++\begin{figure}+\begin{quote}+\begin{verbatim}+(defgoal ns+  (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)    ; Listener+      (non (privk a)) (non (privk b)) (uniq n1))+     (false))))+\end{verbatim}+\end{quote}+\caption{Needham-Schroeder Secrecy Goal}\label{fig:ns secrecy}+\end{figure}++Figure~\ref{fig:ns secrecy} contains an analysis of Needham-Schroeder+from the point of view of a complete run of the initiator under the+assumption that the responder's and its peer's private key are+uncompromised and the nonce~\texttt{n1} it generates uniquely+originates.  Futhermore, the point of view asserts that the nonce is+leaked using a listener.+\begin{quote}+\begin{verbatim}+(p "" 0 z1) (p "" "x" z1 n1)    ; Listener+\end{verbatim}+\end{quote}++{\cpsa} finds no shapes, so Needham-Schroeder achieves this secrecy+goal and does not leak~\texttt{n1}.++\subsection{Unilateral Authentication}\label{sec:unilateral}++This example focuses on unilateral authentication.  To best visualize+this example, process the sample file \texttt{goal.scm} with {\cpsa}+and display its output in a browser.++The protocol and its goal is shown in Figure~\ref{fig:unilateral}.+The goal asserts that if a realized skeleton contains a full length+initiator strand that uniquely generates \texttt{n1}, and+peer~\texttt{a}'s private key is uncompromised, then the skeleton will+contain a responder strand that agrees with the initiator on the+name~\texttt{a}.  When given as input, {\cpsa} verifies that the goal+is true in all executions of the protocol.++\begin{figure}+\begin{minipage}{2.7in}+\begin{verbatim}+(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))))+\end{verbatim}+\end{minipage}\hfil+\begin{minipage}{3.0in}+\begin{verbatim}+(defgoal unilateral+  (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))))))+\end{verbatim}+\end{minipage}+\caption{Unilateral Protocol and Authentication Goal}\label{fig:unilateral}+\end{figure}++\begin{figure}+\begin{quote}+\begin{verbatim}+(defgoal ns+  (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))))))+\end{verbatim}+\end{quote}+\caption{Translated Unilateral Goal for the+  Initiator}\label{fig:unilateral ns init}+\end{figure}++\begin{figure}+\begin{quote}+\begin{verbatim}+(defgoal ns+  (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)))))+\end{verbatim}+\end{quote}+\caption{Translated Unilateral Goal for the+  Responder}\label{fig:unilateral ns resp}+\end{figure}++In Section~\ref{sec:ns resp}, a goal written for the Needham-Schroeder+Protocol was reused to analyze the Needham-Schroeder-Lowe Protocol.+We now use the unilateral authentication goal to analyze+Needham-Schroeder.++Consider the goal in Figure~\ref{fig:unilateral ns init}.  This goal+is the result of translating the Unilateral role position and+parameter predicates as follows.+\begin{center}+\begin{tabular}{l@{$\quad\rightarrow\quad$}l}+  \texttt{p "init" "n"}&\texttt{p "init" "n1"}\\+  \texttt{p "init" "a"}&\texttt{p "init" "b"}\\+  \texttt{p "resp" "a"}&\texttt{p "resp" "b"}+\end{tabular}+\end{center}+When given Figure~\ref{fig:unilateral ns init} as input, {\cpsa}+verifies that the goal is true in all executions of the protocol.++There is another way to translate the Unilateral goal.+\begin{center}+\begin{tabular}{l@{$\quad\rightarrow\quad$}l}+  \texttt{p "init" 1}&\texttt{p "resp" "2"}\\+  \texttt{p "init" "n"}&\texttt{p "resp" "n2"}\\+  \texttt{p "init" "a"}&\texttt{p "resp" "a"}\\+  \texttt{p "resp" "1"}&\texttt{p "init" "2"}\\+  \texttt{p "resp" "a"}&\texttt{p "init" "a"}+\end{tabular}+\end{center}+When given Figure~\ref{fig:unilateral ns resp} as input, {\cpsa}+verifies that the goal is true in all executions of the protocol.++{\cpsa} has demonstrated two ways in which Needham-Schroeder achieves+the goals of the Unilateral Protocol.++\section{The Whole Story}\label{sec:whole story}++The examples in the previous section demonstrate the typical way+security goals are analyzed with {\cpsa}.  However, there are more+features that may be useful.++A \texttt{defgoal} form may contain more than one sentence.  See+Figure~\ref{fig:ns init goals} for an example.  When presented with+more than one sentence, {\cpsa} extracts the point of view skeleton+from the first sentence.++It is wise to ensure that the antecedent in every sentence is+identical.  When {\cpsa} performs satisfaction-checking on+sentence~$\Phi$, it only determines if each shape it finds is+satisfied.  If the point of view skeleton in not the characteristic+skeleton of the antecedent of~$\Phi$, the fact that all skeletons+satisfy~$\Phi$ cannot be used to conclude that~$\Phi$ is true in all+executions of the protocol.++\begin{figure}+\begin{quote}+\begin{verbatim}+(defgoal ns+  (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))))))+\end{verbatim}+\end{quote}+\caption{Two Initiator Authentication Goals}\label{fig:ns init goals}+\end{figure}++{\cpsa} performs satisfaction-checking when an input skeleton in annotated+with one or more security goals.  The annotation uses the+\texttt{goals} key.++\begin{quote}+  \begin{alltt}+(defskeleton+   \ldots+   (goals \textsc{sent\ensuremath{+}}))+  \end{alltt}+\end{quote}++The program \texttt{cpsasas}, discussed in the next section, can be+used to generate an formula with an antecedent such that the input+skeleton is the characteristic skeleton of the antecedent.++\subsection{Shape Analysis Sentences}\label{sec:sas}++A shape analysis sentence expresses all that can be learned from a run+of {\cpsa} as a security goal.  If a security goal can be derived from+a shape analysis sentence, then the protocol achieves the security+goal, that is, the goal is true in all executions of the protocol.++The program \texttt{cpsasas} extracts shape analysis sentences from+the output of {\cpsa}.  Consider the first example in this paper+(Figure~\ref{fig:ns init}), which is in the sample file+\texttt{goals.scm}.  To generate a maximally informative security goal+from the initiator point of view with \texttt{ghci} and+\texttt{Make.hs}, type+\begin{quote}+\begin{verbatim}+$ ghci Make.hs+*Make> sas "goals"+\end{verbatim}+\end{quote}+When using GNU make, type ``\texttt{make goals\_sas.text}''.  The+resulting shape analysis sentence is displayed in Figure~\ref{fig:ns+  sas}.++\begin{figure}+\begin{verbatim}+(defgoal ns+  (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))))))+\end{verbatim}+\caption{Initiator Shape Analysis Sentence}\label{fig:ns sas}+\end{figure}++A shape analysis sentences asserts that either a realized skeleton+does not satisfy its antecedent or it satisfies one or more of the+disjuncts in its conclusion.  {\cpsa} has been designed so that this+assertion is true.  Therefore, every shape analysis sentence is true+in all executions.++A security goal is true in all executions if it can be derived from a+shape analysis sentence~\cite{Ramsdell12}.  {\cpsa} comes with a+Prolog program that translates shape analysis sentences into Prover9+syntax~\cite{prover9}.  Prover9 can then be used to perform the+required theorem-proving.++In practice, theorem-proving using shape analysis sentences is rarely+employed.  It's clumsy and it requires too much expertise.  The main+use of \texttt{cpsasas} is for generating a formula that is edited to+become a desired security goal.++\bibliography{cpsa}+\bibliographystyle{plain}++\end{document}
doc/cpsaintroslides.pdf view

binary file changed (93145 → 93099 bytes)

doc/cpsaoverview.pdf view

binary file changed (129002 → 128944 bytes)

doc/cpsaprimer.pdf view

binary file changed (273720 → 276659 bytes)

doc/cpsaprimer.tex view
@@ -1098,6 +1098,22 @@ (comment "Nothing left to do") \end{verbatim} +\section{First-Order Logic and Security Goals}\label{sec:security goals}++Another way to specify a problem statement is with a security goal. A+security goal a sentence in first-order logic.  It asserts that if+some properties hold for a skeleton, then some other properties must+hold for all shapes computed by CPSA starting with the skeleton.+Security goals can be used to formally state authentication and+secrecy goals of a protocol.++The \texttt{defgoal} form is used to pose an analysis problem with a+sentence instead of a skeleton.  CPSA extracts a point of view+skeleton from the antecedent of the formula and then analyzes it.+When it prints a shape, it checks to see if the shape satisfies the+conclusion of the security goal.  See~\cite{cpsagoals09} for details.+The grammar of security goals is in Table~\ref{tab:goal}.+ \section{Macros}\label{sec:macros}  After reading the input, {\cpsa} expands macros before in analyzing
doc/cpsaspec.pdf view

binary file changed (387594 → 387770 bytes)

doc/cpsaspec.tex view
@@ -2114,10 +2114,10 @@ each role~$\role_Y(C,N,U)\in P$ and variable~$x:S$ that occurs in~$C$, there is a protocol specific binary parameter predicate $P[r,x]:\dom{node}\times{}S$.  The protocol independent unary-predicates are $\mathsf{non}: B$ for each base sort~$B$.  The-remaining protocol independent predicates are binary, and are-$\mathsf{uniq}: B\times\dom{node}$,-$\mathsf{sprec}:\dom{node}\times\dom{node}$,+predicates are $\mathsf{non}: B$ and $\mathsf{uniq}: B$ for each base+sort~$B$.  The remaining protocol independent predicates are binary,+and are $\mathsf{\uniqat}: B\times\dom{node}$,+$\mathsf{\strprec}:\dom{node}\times\dom{node}$, $\mathsf{prec}:\dom{node}\times\dom{node}$, and equality.  Soon we define~$\form(k)=(Y,\Phi)$, where~$\Phi$ is $k$'s skeleton@@ -2158,12 +2158,14 @@   $P[r,x](v(s,h-1),t)$,   where $r^c=C$ when $r=\role(C,N,U)$. \item For each $(s,i),(s,i')\in N$ such that $i<i'$, assert-  $\cn{sprec}(v(s,i),v(s,i'))$.+  $\cn{\strprec}(v(s,i),v(s,i'))$. \item For each $(s,i)\prec^-(s',i')$ such that $s\neq s'$, assert   $\cn{prec}(v(s,i),v(s',i'))$. \item For each $t\in N$, assert $\cn{non}(t)$. \item For each $t\in U$ and node~$n$ such that-  $n\in\orig_k(t)$, assert $\cn{uniq}(t,v(n))$.+  $n\in\orig_k(t)$, assert $\cn{\uniqat}(t,v(n))$.+\item For each $t\in U$ without a point of origination in~$k$, assert+  $\cn{uniq}(t)$. \end{itemize}  Given a set of homomorphisms $\delta_i\colon k_0\mapsto k_i$, its shape@@ -2212,8 +2214,8 @@ \qquad\quad\wedge\init_0(n_3)\wedge\init_a(n_3,a_1)\wedge \init_b(n_3,b_2)\wedge \init_s(n_3,s_1)\\-\qquad\quad\wedge\cn{uniq}(s_1,n_2)\wedge-\cn{prec}(n_3,n_2)\wedge\cn{sprec}(n_2,n_1)\\+\qquad\quad\wedge\cn{\uniqat}(s_1,n_2)\wedge+\cn{prec}(n_3,n_2)\wedge\cn{\strprec}(n_2,n_1)\\ \qquad\quad\wedge\cn{non}(a_1^{-1})\wedge \cn{non}(b_1^{-1}))) \end{array}$$@@ -2255,10 +2257,11 @@ \begin{itemize} \item $k,\alpha\models\cn{prec}(y,z)$ iff   $\alpha(y)\prec\alpha(z)$.-\item $k,\alpha\models\cn{sprec}(y,z)$ iff $\alpha(y)\prec\alpha(z)$,+\item $k,\alpha\models\cn{\strprec}(y,z)$ iff $\alpha(y)\prec\alpha(z)$,   $\alpha(y)=(s,i)$, and $\alpha(z)=(s,i')$. \item $k,\alpha\models\cn{non}(t)$ iff $\bar\alpha(t)\in\nu$.-\item $k,\alpha\models\cn{uniq}(t,y)$ iff $\bar\alpha(t)\in\upsilon$ and+\item $k,\alpha\models\cn{uniq}(t)$ iff $\bar\alpha(t)\in\upsilon$.+\item $k,\alpha\models\cn{\uniqat}(t,y)$ iff $\bar\alpha(t)\in\upsilon$ and   $\alpha(y)\in\orig_k(\bar\alpha(t))$. \item $k,\alpha\models y=z$ iff $\bar\alpha(y)=\bar\alpha(z)$. \end{itemize}@@ -2273,7 +2276,7 @@ \[\cn{prec}(x,y) \land\cn{prec}(y,z)\supset \cn{prec}(x,z).\]-Furthermore, $\cn{sprec}(x,y)\supset\cn{prec}(x,y)$.+Furthermore, $\cn{\strprec}(x,y)\supset\cn{prec}(x,y)$.  \bibliography{cpsa} \bibliographystyle{plain}
doc/cpsauser.html view
@@ -3,7 +3,7 @@ <head>   <meta http-equiv="content-type"   content="application/xhtml+xml; charset=UTF-8" />-  <title>CPSA 2.4 User Guide</title>+  <title>CPSA 2.5 User Guide</title>   <meta name="generator" content="Amaya 9.54, see http://www.w3.org/Amaya/" />   <style type="text/css">     h1 { text-align: center }@@ -12,7 +12,7 @@ </head>  <body>-<h1>CPSA 2.4 User Guide</h1>+<h1>CPSA 2.5 User Guide</h1>  <p>The Cryptographic Protocol Shapes Analyzer (CPSA) attempts to enumerate all essentially different executions possible for a cryptographic protocol. We call@@ -59,11 +59,13 @@ <a href="#cpsajson"><code>cpsajson</code></a> program translates JSON encoded CPSA into CPSA S-Expressions.</p> -<p>The input syntax is essentially the same as the output syntax. A Lisp aware-editor will pretty print input, and the output is pretty printed. We use Emacs'-Scheme mode to prepare input. This document describes the syntax, but provides-little assistance for its interpretation. See the CPSA Tutorial document for-this information.</p>+<p>The input syntax is essentially the same as the output syntax. A+  Lisp aware editor will pretty print input, and the output is pretty+  printed. We use Emacs' Scheme mode to prepare input. This document+  describes the syntax, but provides little assistance for its+  interpretation. See the <a href="cpsaprimer.pdf">CPSA Primer</a> and+  <a href="cpsagoals.pdf">CPSA and Formal Security Goals</a> for more+  information.</p>  <p>The typical pattern of usage is to enter the set of problems to be analyzed into a file, in this example, <code>prob.scm</code>, analyze the problems, and if@@ -131,9 +133,13 @@ protocol definitions and problem statements. A <a href="#usage">herald form</a> allows options normally specified on the command line to be specified within an input file.  A problem-statement describes the initial behavior as a skeleton. The grammar-for a protocol follows.</p>+statement describes the initial behavior as a skeleton or a security+goal.</p> +<h3>Protocols</h3>++<p>The grammar for a protocol follows.</p>+ <blockquote>   <pre>PROTOCOL   ::= (defprotocol ID ALG ROLE+ PROT-ALIST) ID         ::= SYMBOL@@ -190,6 +196,8 @@ other than <code>mesg</code>, or it if formed from one of the following operations: <code>pubk</code>, <code>privk</code>, <code>invk</code>, and <code>ltk</code>.</p> +<h3>Skeletons</h3>+ <blockquote>   <pre>SKELETON   ::= (defskeleton ID VARS STRAND+ SKEL-ALIST) STRAND     ::= (defstrand ID INT MAPLET*) | (deflistener TERM)@@ -280,6 +288,49 @@ <code>(exp (exp h x) y) = (exp h (mul x y)</code>.</p>  -->++<h3>First-order Logic and Security Goals</h3>++<p>Another way to specify a problem statement is with a security+  goal. A security goal a sentence in first-order logic.  It asserts+  that if some properties hold for a skeleton, then some other+  properties must hold for all shapes computed by CPSA starting with+  the skeleton.  Security goals can be used to formally state+  authentication and secrecy goals of a protocol.</p>++<p>The <code>defgoal</code> form is used to pose an analysis problem+  with a sentence instead of a skeleton.  CPSA extracts a point of view+  skeleton from the antecedent of the formula and then analyzes it.+  When it prints a shape, it checks to see if the shape satisfies the+  conclusion of the security goal.  See+  <a href="cpsagoals.pdf">CPSA and Formal Security Goals</a> for+  details.</p>++<p>To be precise, a security goal is an order-sorted first-order logic+  sentence in a restricted form.  The set of sort symbols available+  for use in a <code>DECL</code> is the ones provided by the message+  algebra augmented with the symbol <code>node</code>.  The form of a+  sentence is restricted by the syntax that follows.</p>++<blockquote>+  <pre>GOAL        ::= (defgoal ID SENTENCE+ GOAL-ALIST)+SENTENCE    ::= (forall (DECL*) (implies ANTECEDENT CONCLUSION))+CONCLUSION  ::= (false) | EXISTENTIAL | (or EXISTENTIAL*)+EXISTENTIAL ::= (exists (DECL*) ANTECEDENT) | ANTECEDENT+ANTECEDENT  ::= ATOMIC | (and ATOMIC*)+ATOMIC      ::= (p ROLEID POS NVAR) | (p ROLEID PARAM NVAR TERM)+             |  (str-prec NVAR NVAR) | (prec NVAR NVAR)+             |  (non TERM) | (pnon TERM) | (uniq TERM)+             |  (uniq-at TERM NVAR) | (= TERM TERM)+ROLEID      ::= STRING+POS         ::= INT+NVAR        ::= ID+PARAM       ::= STRING</pre>+</blockquote>++<p>The empty string names the listener role of a protocol.  The+  role has the variable <code>x</code> of sort <code>mesg</code>+  as its only role variable. There are two positions in the listener role.</p>  <h3>Macros and Includes</h3>
+ doc/goals.scm view
@@ -0,0 +1,391 @@+(herald goals)++;;; Section 1 --- Examples from CPSA and Formal Security Goals++;;; Needham-Schroeder from Section 10 of the CPSA Primer++(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"))++(defgoal ns+  (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")+  (comment "Authentication goal: agreement on name b"))++(defgoal ns+  (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"))++(defgoal ns+  (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")+  (comment "Failed authentication goal: agreement on name b"))++(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"))++(defgoal nsl+  (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")+  (comment "Authentication goal: agreement on name b"))++(defgoal ns+  (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")+  (comment "Secrecy goal: nonce n1 not revealed"))++(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"))++(defgoal unilateral+  (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"))++;;; Does initiator satisfy the unilateral authentication goal?++;;; Note that the goal requires translation of some of the role+;;; specific predicates.+(defgoal ns+  (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")+  (comment "Same as unilateral goal under the predicate mapping:")+  (comment (p "init" "n") "->" (p "init" "n1") "and")+  (comment (p "init" "a") "->" (p "init" "b") "and")+  (comment (p "resp" "a") "->" (p "resp" "b")))++;;; Does responder satisfy the unilateral authentication goal?++(defgoal ns+  (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")+  (comment "Same as unilateral goal under the predicate mapping:")+  (comment (p "init" 1) "->" (p "resp" 2) "and")+  (comment (p "init" "n") "->" (p "resp" "n2") "and")+  (comment (p "init" "a") "->" (p "resp" "a") "and")+  (comment (p "resp" 1) "->" (p "init" 2) "and")+  (comment (p "resp" "a") "->" (p "init" "a")))++(defgoal ns+  (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"))++;;; The shape analysis sentence as input (kind of useless)++(defgoal ns+  (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"))++;;; Section 2 --- Additional Examples++(defgoal ns+  (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")+  (comment "Failed secrecy goal: nonce n2 not revealed"))++;;; Double initiator point of view+(defskeleton ns+  (vars (a b name) (n1 n1-0 text))+  (defstrand init 3 (a a) (b b) (n1 n1))+  (defstrand init 3 (a a) (b b) (n1 n1-0))+  (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))+    (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"))++(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"))++;;; The responder point of view+(defgoal nsl-typeless+  (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"))++(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))))
doc/index.html view
@@ -10,17 +10,19 @@  <p>[<a href="cpsauser.html">CPSA User Guide</a>] [<a href="cpsaprimer.pdf">CPSA Primer</a>]+[<a href="cpsagoals.pdf">CPSA and Formal Security Goals</a>] [<a href="cpsaoverview.pdf">CPSA Overview</a>] [<a href="cpsaintroslides.pdf">CPSA Introductory Slides</a>] [<a href="http://www.mitre.org/publications/technical-papers/completeness-of-cpsa">CPSA Correctness Proof</a>]</p>  <h1>CPSA</h1> -<p>The Cryptographic Protocol Shapes Analyzer (CPSA) attempts to enumerate all-essentially different executions possible for a cryptographic protocol. We call-them the <i>shapes</i> of the protocol. Naturally occurring protocols have only-finitely many, indeed very few shapes. Authentication and secrecy properties-are easy to determine from them, as are attacks and anomalies.</p>+<p>The Cryptographic Protocol Shapes Analyzer (CPSA) attempts to+  enumerate all essentially different executions possible for a+  cryptographic protocol. We call them the <i>shapes</i> of the+  protocol. Naturally occurring protocols have only finitely many,+  indeed very few shapes. Authentication and secrecy properties are+  easy to determine from them, as are attacks and anomalies.</p>  <p>CPSA comes with a user guide, a primer, an overview, and some slides.   The user guide provides usage information for each program in the@@ -47,11 +49,11 @@   better way to analyze protocols when GNU Make is available.</p>  <p>After running the analysis, you will note files with the extension-<code>.xhtml</code>. These are XHTML/SVG compound documents that can be viewed by-standards compliant browsers such as Firefox, Chrome, Safari, and-later versions of Internet Explorer.  See the section-on <a href="cpsauser.html#cpsagraph">visualization</a> in the user-guide for help interpreting these documents.</p>+  <code>.xhtml</code>. These are XHTML/SVG compound documents that can+  be viewed by standards compliant browsers such as Firefox, Chrome,+  Safari, and later versions of Internet Explorer.  See the section+  on <a href="cpsauser.html#cpsagraph">visualization</a> in the user+  guide for help interpreting these documents.</p>  <p>New users should study CPSA's analysis of the following protocols   in order, Blanchet (<code>blanchet.xhtml</code>), Needham-Schroeder@@ -60,8 +62,13 @@   (<code>ffgg.xhtml</code>), and finally Otway-Rees   (<code>or.xhtml</code>). When studying the full output,   simultaneously display the extracted shapes. The shapes file has an-  extension of <code>_shapes.xhtml</code>.</p>+  extension of <code>_shapes.xhtml</code>. +<p>An analysis of Needham-Schroeder+  using <a href="cpsagoals.pdf">security goals</a> is+  in <code>goals.xhtml</code>.  This example can safely be ignored by+  new users.</p>+ <p>To make effective use of CPSA, new users should scan the   <a href="cpsauser.html">user guide</a> to get a flavor of its   contents, and then read the <a href="cpsaprimer.pdf">primer</a>.@@ -70,9 +77,9 @@  <h2>Tips</h2> -<p>Choose a small, simple protocol for your first analysis task. When analyzing-complex protocols, analyze small parts of the protocol first, and then enrich-the description of the problem. </p>+<p>Choose a small, simple protocol for your first analysis task. When+  analyzing complex protocols, analyze small parts of the protocol+  first, and then enrich the description of the problem. </p>  <p>The source distribution contains additional programs and a test   suite with many examples.  The README in the top-level directory of@@ -92,10 +99,11 @@   Specification</a>.</p>  <p>An origination assumption-  (<code>non-orig</code>, <code>pen-non-orig</code>, and <code>unig-orig</code>),-  can be specified in a role or in a skeleton.  Be sure to read the-  advice in the <a href="cpsaprimer.pdf">primer</a> on the proper-  placement of origination assumptions.</p>+  (<code>non-orig</code>, <code>pen-non-orig</code>,+  and <code>unig-orig</code>), can be specified in a role or in a+  skeleton.  Be sure to read the advice in+  the <a href="cpsaprimer.pdf">primer</a> on the proper placement of+  origination assumptions.</p>  <p>Variables of sort message unify with any message.  See Otway-Rees   (<code>or.xhtml</code>) for an example of the use of variables of this@@ -110,15 +118,18 @@   multiple occurrences of a message with one named definition of it.   Macros are described in the <a href="cpsaprimer.pdf">primer</a>.</p> -<p>When the <code>cpsagraph</code> program is given the <code>--zoom</code>-  option, it produces diagrams that scale.  This is useful when-  viewing large diagrams.</p>+<p>When the <code>cpsagraph</code> program is given+  the <code>--zoom</code> option, it produces diagrams that scale.+  This is useful when viewing large diagrams.</p> -<p>The <code>cpsasas</code> program translates a CPSA result into a-  sentence in first-order logic that can be used with automated-  theorem provers.  The formula is called a shape analysis sentence.-  See <a href="http://arxiv.org/abs/1204.0480">Deducing Security Goals-  From Shape Analysis Sentences</a> for more details.</p>+<p>In CPSA, a security goal is expressed as a sentence in first-order+  logic.  It asserts that if some properties hold for a skeleton, then+  some other properties must hold for all shapes computed by CPSA+  starting with the skeleton.  Security goals can be used to state+  authentication and secrecy goals of a protocol.  See+  <a href="cpsagoals.pdf">CPSA and Formal Security Goals</a>.  An+  analysis of Needham-Schroeder using first-order logic is+  in <code>goals.xhtml</code>.</p>  <p>When the <code>cpsapp</code> program is given   the <code>--json</code> option, it translates S-expressions into
doc/macros.tex view
@@ -1,5 +1,5 @@ \newcommand{\cpsa}{\textsc{cpsa}}-\newcommand{\version}{2.4.0}+\newcommand{\version}{2.5.0} \newcommand{\cpsacopying}{\begingroup   \renewcommand{\thefootnote}{}\footnotetext{{\copyright} 2010 The     MITRE Corporation.  Permission to copy without fee all or part of@@ -58,3 +58,5 @@ \newcommand{\longtwoheadrightarrow}{\relax \smash{\relbar\joinrel\twoheadrightarrow}\vphantom\rightarrow} \newcommand{\setreduction}[1]{\stackrel{#1}{\longtwoheadrightarrow}}+\newcommand{\uniqat}{\mbox{\sf uniq-at}}+\newcommand{\strprec}{\mbox{\sf str-prec}}
src/CPSA/Basic/Algebra.hs view
@@ -4,6 +4,10 @@ -- order-sorted algebra.  It exports a name, and the origin used to -- generate variables. +-- To support security goals, the message algebra has been augmented+-- with support for variables of sort node and pairs of integers.  The+-- constructor D is used as N is taken for numbers in S-Expressions.+ -- Copyright (c) 2009 The MITRE Corporation -- -- This program is free software: you can redistribute it and/or@@ -122,6 +126,8 @@     = I !Id     | C !String                 -- Tag constants     | F !Symbol ![Term]+    | D !Id                     -- Node variable+    | P (Int, Int)              -- Node constant       deriving (Show, Eq, Ord)  -- In this algebra (F Invk [F Invk [t]]) == t is an axiom@@ -132,7 +138,7 @@ -- sort information is called a variable.  The sort of a variable is -- one of mesg, text, data, name, skey, and akey. --- Terms that represent variables.+-- Terms that represent algebra variables. isVar :: Term -> Bool isVar (I _) = True           -- Sort: mesg isVar (F s [I _]) =@@ -140,6 +146,11 @@     s == Text || s == Data || s == Name || s == Skey || s == Akey isVar _ = False +-- Note that isVar of (D _) is false.+isNodeVar :: Term -> Bool+isNodeVar (D _) = True+isNodeVar _ = False+ -- Extract the identifier from a variable varId :: Term -> Id varId (I x) = x@@ -148,6 +159,7 @@ varId (F Name [I x]) = x varId (F Skey [I x]) = x varId (F Akey [I x]) = x+varId (D x) = x varId _ = error "Algebra.varId: term not a variable with its sort"  isAcquiredVar :: Term -> Bool@@ -246,6 +258,8 @@ isAtom (C _) = False isAtom (F s _) =     s == Text || s == Data || s == Name || s == Skey || s == Akey+isAtom (D _) = False+isAtom (P _) = False  -- Does a term occur in another term? occursIn :: Term -> Term -> Bool@@ -277,6 +291,7 @@     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 _ _ t = error $ "Algebra.foldVars: Bad term " ++ show t  -- Fold f through a term applying it to each term that is carried by the term.@@ -437,6 +452,7 @@     isVar = isVar     isAcquiredVar = isAcquiredVar     isAtom = isAtom+    isNodeVar = isNodeVar     termsWellFormed = termsWellFormed     occursIn = occursIn     foldVars = foldVars@@ -534,6 +550,13 @@                 let (alist', gen', u') =                         foldl cloneTermList (alist, gen, []) u in                 (alist', gen', F sym $ reverse u')+            D x ->              -- identifiers to identifier.+                case lookup x alist of+                  Just y -> (alist, gen, D y)+                  Nothing ->+                      let (gen', y) = cloneId gen x in+                      ((x, y) : alist, gen', D y)+            P p -> (alist, gen, P p)       cloneTermList (alist, gen, u) t =           let (alist', gen', t') = cloneTerm (alist, gen) t in           (alist', gen', t' : u)@@ -561,6 +584,9 @@       t -> F Invk [t] idSubst subst (F s u) =     F s (map (idSubst subst) u)+idSubst subst (D x) =+    M.findWithDefault (D x) x subst+idSubst _ t@(P _) = t  -- Unification and substitution @@ -606,6 +632,10 @@     case M.lookup x s of       Nothing -> I x       Just t -> chase (Subst s) t+chase (Subst s) (D x) =+    case M.lookup x s of+      Nothing -> D x+      Just t -> chase (Subst s) t chase s (F Invk [t]) = chaseInvk s t chase _ t = t @@ -622,6 +652,8 @@ occurs x (I y) = x == y occurs _ (C _) = False occurs x (F _ u) = any (occurs x) u+occurs x (D y) = x == y+occurs _ (P _) = False  unifyChase :: Term -> Term -> Subst -> Maybe Subst unifyChase t t' s = unifyTerms (chase s t) (chase s t') s@@ -648,6 +680,15 @@ unifyTerms (F sym u) (F sym' u') s     | sym == sym' = unifyTermLists u u' s     | otherwise = Nothing+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 t (D x) s = unifyTerms (D x) t s+unifyTerms (P p) (P p') s+    | p == p' = Just s+    | otherwise = Nothing unifyTerms _ _ _ = Nothing  unifyTermLists :: [Term] -> [Term] -> Subst -> Maybe Subst@@ -684,6 +725,8 @@             t -> F Invk [t]       F s u ->           F s (map (substChase subst) u)+      t@(D _) -> t+      t@(P _) -> t  instance C.Subst Term Gen Subst where    emptySubst = emptySubst@@ -720,6 +763,11 @@     | s == s' = matchLists u u' r match (F Invk [t]) t' r =     match t (F Invk [t']) r+match (D x) t (Env r) =+    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 _ _ _ = Nothing  matchLists :: [Term] -> [Term] -> Env -> Maybe Env@@ -744,6 +792,8 @@ allId f (I x) = f x allId _ (C _) = True allId f (F _ u) = all (allId f) u+allId f (D x) = f x+allId _ (P _) = True  -- Cast an environment into a substitution by filtering out trivial -- bindings.@@ -773,6 +823,8 @@           | x == y = (F Skey [I x], F Skey [t])       loop (F Akey [I x] : _) (y, t)           | x == y = (F Akey [I x], F Akey [t])+      loop (D x : _) (y, t)+          | x == y = (D x, t)       loop (_ : domain) pair = loop domain pair  -- Ensure the range of an environment contains only variables and that@@ -786,6 +838,15 @@           S.notMember x s && loop (S.insert x s) e       loop _ _ = False +nodeMatch ::  Term -> (Int, Int) -> Env -> Maybe Env+nodeMatch t p env = match t (P p) env++nodeLookup :: Env -> Term -> Maybe (Int, Int)+nodeLookup env t =+  case instantiate env t of+    P p -> Just p+    _ -> Nothing+ instance C.Env Term Gen Subst Env where    emptyEnv = emptyEnv    instantiate = instantiate@@ -799,6 +860,9 @@    substitution = substitution    reify = reify    matchRenaming (_, e) = matchRenaming e+   nodeMatch t t' (g, e) =+       maybe [] (\e -> [(g, e)]) $ nodeMatch t t' e+   nodeLookup = nodeLookup  -- Term specific loading functions @@ -824,17 +888,18 @@       Left _ ->           do             let (gen', x) = freshId gen name-            p <- mkVar (I x)+            p <- mkVar x             return (gen', p : vars)     where-      mkVar t =+      mkVar x =           case sort of-            "mesg" -> return t-            "text" -> return $ F Text [t]-            "data" -> return $ F Data [t]-            "name" -> return $ F Name [t]-            "skey" -> return $ F Skey [t]-            "akey" -> return $ F Akey [t]+            "mesg" -> return (I x)+            "text" -> return $ F Text [I x]+            "data" -> return $ F Data [I x]+            "name" -> return $ F Name [I x]+            "skey" -> return $ F Skey [I x]+            "akey" -> return $ F Akey [I x]+            "node" -> return (D x)             _ -> fail (shows pos' "Sort " ++ sort ++ " not recognized") loadVar _ (x,_) = fail (shows (annotation x) "Bad variable syntax") @@ -976,6 +1041,7 @@ displayVar ctx (F Name [I x]) = displaySortId "name" ctx x displayVar ctx (F Skey [I x]) = displaySortId "skey" ctx x displayVar ctx (F Akey [I x]) = displaySortId "akey" ctx x+displayVar ctx (D x) = displaySortId "node" ctx x displayVar _ _ =     error "Algebra.displayVar: term not a variable with its sort" @@ -1015,6 +1081,8 @@     L () (S () "enc" : displayEnc ctx t0 t1) 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 _ t = error ("Algebra.displayTerm: Bad term " ++ show t)  displayList :: Context -> Term -> [SExpr ()]
src/CPSA/DiffieHellman/Algebra.hs view
@@ -813,6 +813,7 @@   isVar = isVar   isAcquiredVar = isAcquiredVar   isAtom = isAtom+  isNodeVar _ = error "Algebra.isNodeVar: no support for nodes"   termsWellFormed = termsWellFormed   occursIn = occursIn   foldVars = foldVars@@ -1715,6 +1716,8 @@   substitution = substitution   reify = reify   matchRenaming = matchRenaming+  nodeMatch _ _ _ = error "Algebra.nodeMatch: no support for nodes"+  nodeLookup _ _ = error "Algebra.nodeMatch: no support for nodes"  -- Term specific loading functions
src/CPSA/Lib/Algebra.hs view
@@ -26,10 +26,16 @@ -- Terms  class (Ord t, Show t) => Term t where-    isVar :: t -> Bool          -- Is term a variable in the algebra?++  -- These predicates succeed only on terms in the message algebra.+    isVar :: t -> Bool          -- Is term a variable in the message algebra?     isAcquiredVar :: t -> Bool  -- Is term an acquired variable?     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+     -- Does a term occur in another term?     occursIn :: t -> t -> Bool @@ -133,7 +139,7 @@      -- Given a generator, load a list of variables or return an error     -- message.  Each element of the list is an identifier and a sort.-    -- The varibles are returned in the reverse order.+    -- The variables are returned in the reverse order.     loadVars :: Monad m => g -> [SExpr Pos] -> m (g, [t])  -- Substitutions@@ -169,6 +175,12 @@     -- Is match a one-to-one variable-to-variable map?  This function     -- is used while testing if two skeletons are isomorphic.     matchRenaming :: (g, e) -> Bool+    -- 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)  -- Display contexts--maps from variables to their printed representation.
+ src/CPSA/Lib/Characteristic.hs view
@@ -0,0 +1,248 @@+-- Makes the characteristic skeleton of a security goal++-- 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.Characteristic (Conj, characteristic) where++import Control.Monad+import qualified Data.List as L+import CPSA.Lib.Utilities+import CPSA.Lib.SExpr+import CPSA.Lib.Algebra+import CPSA.Lib.Protocol+import CPSA.Lib.Goal+import CPSA.Lib.Strand++{--+import System.IO.Unsafe+z :: Show a => a -> b -> b+z x y = unsafePerformIO (print x >> return y)+--}++type Conj t = [(Pos, AForm t)]++-- Entry point.  Takes a position, a protocol, a variable generator, a+-- goal, and a skeleton comment and makes a skeleton or fails.  This+-- function extracts the anecedent and univesally quantified variable.+characteristic :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->+                  [Goal t] -> g -> Conj t -> [SExpr ()] -> m (Preskel t g s e)+characteristic pos prot goals g antec comment =+  equalsForm pos prot goals g antec comment++-- Checks for equals in an antecedent and fails if it finds one.  One+-- could use unification to solve the equality, and then apply the+-- result to the remaining parts of the formula.+equalsForm :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->+              [Goal t] -> g -> Conj t -> [SExpr ()] -> m (Preskel t g s e)+equalsForm pos _ _ _ as _ | any isEquals as =+  fail (shows pos "Equals not allowed in antecedent")+equalsForm pos prot goals g as comment =+  splitForm pos prot goals g as comment++isEquals :: (Pos, AForm t) -> Bool+isEquals (_, Equals _ _) = True+isEquals _ = False++-- Split the formula into instance formulas and skeleton formulas.+-- The instance formulas are used to generate the skeleton's+-- instances, and the skeleton formulas generate the rest.  Make the+-- instances, and then make the rest.+splitForm :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->+             [Goal t] -> g -> Conj t -> [SExpr ()] -> m (Preskel t g s e)+splitForm pos prot goals g as comment =+  do+    (nmap, g, insts) <- mkInsts g is+    mkSkel pos prot goals nmap g insts ks comment+  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.+instForm :: (Pos, AForm t) -> Bool+instForm (_, RolePred _ _ _) = True+instForm (_, ParamPred _ _ _ _) = True+instForm (_, StrPrec _ _) = 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])+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)++-- Computes a map from nodes to role-index pairs+nodeRoleIndex :: (Eq t, Monad m) => Conj t -> m [(t, RoleIndex t)]+nodeRoleIndex 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"++-- 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) =+  do+    (g, inst) <- mkInst g as nri ns+    (g, insts) <- foldInsts g as nri nss+    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)++-- 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+      case match v t env of       -- used to create instance+        env : _ -> return env+        [] -> fail (shows pos "Domain does not match range")+    else+      fail (shows pos+            "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+    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] ->+          Conj t -> [SExpr ()] -> m (Preskel t g s e)+mkSkel pos p goals nmap g insts as comment =+  do+    let o = foldr (mkPrec nmap) [] as+    let nr = foldr mkNon [] as+    let ar = foldr mkPnon [] as+    let ur = foldr mkUniq [] as+    let (nr', ar', ur') = foldl addInstOrigs (nr, ar, ur) insts+    let prios = []+    let k = mkPreskel g p goals insts o nr' ar' ur' prios comment+    mapM_ (checkUniqAt nmap k) as+    case termsWellFormed $ nr' ++ ar' ++ ur' ++ kterms k of+      False -> fail (shows pos "Terms in skeleton not well formed")+      True -> return ()+    case verbosePreskelWellFormed k of+      Right () -> return k+      Left msg -> fail $ shows pos+                  $ showString "Skeleton not well formed: " msg++addInstOrigs :: Algebra t p g s e c => ([t], [t], [t]) ->+                Instance t e -> ([t], [t], [t])+addInstOrigs (nr, ar, ur) i =+    (foldl (flip adjoin) nr $ inheritRnon i,+     foldl (flip adjoin) ar $ inheritRpnon i,+     foldl (flip adjoin) ur $ inheritRunique i)++mkPrec :: Eq t => [(t, (Int, Int))] ->+          (Pos, AForm t) -> [Pair] -> [Pair]+mkPrec nmap (_, Prec n n') o =+  (nMapLookup n nmap, nMapLookup n' nmap) : o+mkPrec _ _ o = o++mkNon :: (Pos, AForm t) -> [t] -> [t]+mkNon (_, Non t) ts = t : ts+mkNon _ ts = ts++mkPnon :: (Pos, AForm t) -> [t] -> [t]+mkPnon (_, Pnon t) ts = t : ts+mkPnon _ ts = ts++mkUniq :: (Pos, AForm t) -> [t] -> [t]+mkUniq (_, Uniq t) ts = t : ts+mkUniq (_, UniqAt t _) ts = t : ts+mkUniq _ ts = ts++checkUniqAt :: (Algebra t p g s e c, Monad m) => [(t, Node)] ->+               Preskel t g s e -> (Pos, AForm t) -> m ()+checkUniqAt nmap k (pos, UniqAt t n) =+  case lookup t $ korig k of+    Nothing -> fail (shows pos "Atom not unique at node")+    Just ns+      | elem (nMapLookup n nmap) ns -> return ()+      | otherwise -> fail (shows pos "Atom not unique at node")+checkUniqAt _ _ _ = return ()
+ src/CPSA/Lib/Goal.hs view
@@ -0,0 +1,113 @@+-- 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+  | 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 _ _ _) (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 _ _ _ _) (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 _ _) (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 _ _) (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 _) (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 _) (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 _) (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 _ _) (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 _ _) (Equals _ _) = EQ
src/CPSA/Lib/Loader.hs view
@@ -9,13 +9,16 @@ module CPSA.Lib.Loader (loadSExprs) where  import Control.Monad+import Control.Applicative import qualified Data.List as L import Data.Maybe (isJust) import CPSA.Lib.Utilities import CPSA.Lib.SExpr import CPSA.Lib.Algebra import CPSA.Lib.Protocol+import CPSA.Lib.Goal import CPSA.Lib.Strand+import CPSA.Lib.Characteristic  {-- import System.IO.Unsafe@@ -45,6 +48,10 @@     do       k <- findPreskel pos ps xs       return (ps, k : ks)+loadSExpr _ _ (ps, ks) (L pos (S _ "defgoal" : xs)) =+    do+      k <- findGoal pos ps xs+      return (ps, k : ks) loadSExpr nom origin (ps, ks) (L pos (S pos' "defpreskeleton" : xs)) =     loadSExpr nom origin (ps, ks) (L pos (S pos' "defskeleton" : xs)) loadSExpr _ _ (ps, ks) (L _ (S _ "comment" : _)) = return (ps, ks)@@ -62,7 +69,8 @@         do           (gen, rs, comment) <- loadRoles origin (x : xs)           -- Check for duplicate role names-          validate (mkProt name alg gen rs comment) rs+          (gen, r) <- mkListenerRole pos gen+          validate (mkProt name alg gen rs r comment) rs     where       validate prot [] = return prot       validate prot (r : rs) =@@ -119,10 +127,20 @@         Fail msg -> fail (shows pos $ showString "Role not well formed: " msg) loadRole _ pos _ = fail (shows pos "Malformed role") +-- Like Either String but with fail method defined data ReturnFail a     = Return a     | Fail String +instance Functor (ReturnFail) where+    fmap _ (Fail x) = Fail x+    fmap f (Return y) = Return (f y)++instance Applicative (ReturnFail) where+    pure          = Return+    Fail e <*> _ = Fail e+    Return f <*> r = fmap f r+ instance Monad ReturnFail where     return = Return     Fail l >>= _ = Fail l@@ -192,6 +210,14 @@ showst t =     shows $ displayTerm (addToContext emptyContext [t]) t +-- This is the only place a role is generated with an empty name.+-- This is what marks a strand as a listener.+mkListenerRole :: (Algebra t p g s e c, Monad m) => Pos -> g -> m (g, Role t)+mkListenerRole pos g =+  do+    (g, [x]) <- loadVars g [L pos [S pos "x", S pos "mesg"]]+    return (g, mkRole "" [x] [In x, Out x] [] [] [] [] [] False)+ -- Ensure a trace is not a prefix of a listener notListenerPrefix :: Algebra t p g s e c => Trace t -> Bool notListenerPrefix (In t : Out t' : _) | t == t' = False@@ -328,27 +354,31 @@     case x of       [term] ->           do-            (gen, i) <- loadListener kvars gen term+            (gen, i) <- loadListener p kvars gen term             loadInsts top p kvars gen (i : insts) xs       _ ->           fail (shows pos "Malformed deflistener") loadInsts top p kvars gen insts xs =     do       _ <- alist [] xs          -- Check syntax of xs-      loadRest top kvars p gen (reverse insts) order nr ar ur pl kcomment+      (gen, gs) <- loadGoals top p gen goals+      loadRest top kvars p gen gs (reverse insts) order nr ar ur pl kcomment     where       order = assoc "precedes" xs       nr = assoc "non-orig" xs       ar = assoc "pen-non-orig" xs       ur = assoc "uniq-orig" xs       pl = assoc "priority" xs-      comment = assoc "comment" xs+      goals = assoc "goals" xs       kcomment =-          if null comment then-              []-          else-              [L () (S () "comment" : map strip comment)]+        loadComment "goals" goals +++        loadComment "comment" (assoc "comment" xs) +loadComment :: String -> [SExpr Pos] -> [SExpr ()]+loadComment _ [] = []+loadComment key comment =+  [L () (S () key : map strip comment)]+ loadInst :: (Algebra t p g s e c, Monad m) => Pos ->             Prot t g -> [t] -> g -> String -> Int ->             [SExpr Pos] -> m (g, Instance t e)@@ -365,6 +395,8 @@  lookupRole :: (Algebra t p g s e c, Monad m) => Pos ->               Prot t g -> String -> m (Role t)+lookupRole _ p role  | role == "" =+    return $ listenerRole p lookupRole pos p role =     case L.find (\r -> role == rname r) (roles p) of       Nothing ->@@ -382,18 +414,18 @@         [] -> fail (shows pos "Domain does not match range") loadMaplet _ _ _ x = fail (shows (annotation x) "Malformed maplet") -loadListener :: (Algebra t p g s e c, Monad m) => [t] -> g ->-                SExpr Pos -> m (g, Instance t e)-loadListener kvars gen x =+loadListener :: (Algebra t p g s e c, Monad m) => Prot t g ->+                [t] -> g -> SExpr Pos -> m (g, Instance t e)+loadListener p kvars gen x =     do-      t <- loadTerm kvars x-      return (mkListener gen t)+     t <- loadTerm kvars x+     return $ mkListener p gen t  loadRest :: (Algebra t p g s e c, Monad m) => Pos -> [t] ->-            Prot t g -> g -> [Instance t e] ->+            Prot t g -> g -> [Goal t] -> [Instance t e] ->             [SExpr Pos] -> [SExpr Pos] -> [SExpr Pos] -> [SExpr Pos] ->             [SExpr Pos] -> [SExpr ()] -> m (Preskel t g s e)-loadRest pos vars p gen insts orderings nr ar ur pl comment =+loadRest pos vars p gen gs insts orderings nr ar ur pl comment =     do       case null insts of         True -> fail (shows pos "No strands")@@ -405,7 +437,7 @@       ur <- loadBaseTerms vars ur       let (nr', ar', ur') = foldl addInstOrigs (nr, ar, ur) insts       prios <- mapM (loadPriorities heights) pl-      let k = mkPreskel gen p insts o nr' ar' ur' prios comment+      let k = mkPreskel gen p gs insts o nr' ar' ur' prios comment       case termsWellFormed $ nr' ++ ar' ++ ur' ++ kterms k of         False -> fail (shows pos "Terms in skeleton not well formed")         True -> return ()@@ -465,3 +497,268 @@     (foldl (flip adjoin) nr $ inheritRnon i,      foldl (flip adjoin) ar $ inheritRpnon i,      foldl (flip adjoin) ur $ inheritRunique i)++-- Security goals++-- Load a defgoal form+findGoal :: (Algebra t p g s e c, Monad m) => Pos ->+            [Prot t g] -> [SExpr Pos] -> m (Preskel t g s e)+findGoal pos ps (S _ name : x : xs) =+    case L.find (\p -> name == pname p) ps of+      Nothing -> fail (shows pos $ "Protocol " ++ name ++ " unknown")+      Just p ->+        do+          (g, goal, antec) <- loadSentence pos p (pgen p) x+          let (gs, xs') = findAlist xs+          (g, goals) <- loadGoals pos p g gs+          _ <- alist [] xs'          -- Check syntax of xs+          let kcomment =+                loadComment "goals" (x : gs) +++                loadComment "comment" (assoc "comment" xs')+          -- Make and return the characteristic skeleton of a security goal+          characteristic pos p (goal : goals) g antec kcomment+findGoal pos _ _ = fail (shows pos "Malformed goal")++-- Separate argument into goals and any remaining elements of an+-- association list.+findAlist :: [SExpr Pos] -> ([SExpr Pos], [SExpr Pos])+findAlist [] = ([], [])+findAlist (x@(L _ (S _ "forall" : _)) : xs) =+  (x : gs, xs')+  where+    (gs, xs') = findAlist xs+findAlist xs = ([], xs)++--- Load a sequence of security goals++loadGoals :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->+             g -> [SExpr Pos] -> m (g, [Goal t])+loadGoals _ _ g [] = return (g, [])+loadGoals pos prot g (x : xs) =+  do+    (g, goal, _) <- loadSentence pos prot g x+    (g, goals) <- loadGoals pos prot g xs+    return (g, goal : goals)++-- 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]) =+  do+    (g, vars) <- loadVars g vs+    loadImplication pos prot g (L.nub $ reverse vars) x+loadSentence pos _ _ _ = fail (shows pos "Bad 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 ->+                   g -> [t] -> SExpr Pos -> m (g, Goal t, Conj t)+loadImplication _ prot g vars (L pos [S _ "implies", a, c]) =+  do+    (g, antec) <- loadRoleSpecific pos prot g vars vars a+    (g, concl) <- loadConclusion pos prot g vars c+    let goal =+          Goal { uvars = vars,+                 antec = map snd antec,+                 concl = map (map snd) concl }+    return (g, goal, antec)+loadImplication pos _ _ _ _ = fail (shows pos "Bad 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 =+  do+    (g, a) <- loadExistential 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 =+  do+    (g, a) <- loadExistential pos prot g vars x+    loadDisjuncts 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]) =+  do+    (g, evars) <- loadVars g vs+    loadRoleSpecific pos prot g (reverse evars ++ vars) evars x+loadExistential pos prot g vars x =+  loadRoleSpecific pos prot g vars [] x++--- Load a conjunction of atomic formulas and ensure the formula is+--- role specific.++loadRoleSpecific :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->+                    g -> [t] -> [t] -> SExpr Pos -> m (g, Conj t)+loadRoleSpecific pos prot g vars unbound x =+  do+    (g, as) <- loadConjunction pos prot vars g x+    let as' = L.sortBy (\(_, x) (_, y) -> aFormOrder x y) as+    unbound <- foldM roleSpecific unbound as'+    case unbound of+      [] -> return (g, 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 ->+                   [t] -> g -> SExpr Pos -> m (g, Conj t)+loadConjunction _ p kvars g (L pos (S _ "and" : xs)) =+  loadConjuncts pos p kvars g xs []+loadConjunction top p kvars g x =+  do+    (g, pos, a) <- loadPrimary top p kvars g x+    return (g, [(pos, a)])++loadConjuncts :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->+                 [t] -> g -> [SExpr Pos] -> Conj t -> m (g, Conj t)+loadConjuncts _ _ _ g [] rest = return (g, reverse rest)+loadConjuncts top p kvars g (x : xs) rest =+  do+    (g, pos, a) <- loadPrimary top p kvars g x+    loadConjuncts top p kvars g xs ((pos, a) : rest)++-- Load the atomic formulas++loadPrimary :: (Algebra t p g s e c, Monad m) => Pos -> Prot t g ->+               [t] -> g -> SExpr Pos -> m (g, Pos, AForm t)+loadPrimary _ _ kvars g (L pos [S _ "=", x, y]) =+  do+    (g, t) <- loadSgTerm kvars g x+    (g, t') <- loadSgTerm kvars g y+    return (g, pos, Equals t t')+loadPrimary _ _ kvars g (L pos [S _ "non", x]) =+  do+    t <- loadAlgTerm kvars x+    return (g, pos, Non t)+loadPrimary _ _ kvars g (L pos [S _ "pnon", x]) =+  do+    t <- loadAlgTerm kvars x+    return (g, pos, Pnon t)+loadPrimary _ _ kvars g (L pos [S _ "uniq", x]) =+  do+    t <- loadAlgTerm kvars x+    return (g, pos, Uniq t)+loadPrimary _ _ kvars g (L pos [S _ "uniq-at", x, y]) =+  do+    t <- loadAlgTerm kvars x+    (g, t') <- loadNodeTerm kvars g y+    return (g, pos, UniqAt t t')+loadPrimary _ _ kvars g (L pos [S _ "str-prec", x, y]) =+  do+    (g, t) <- loadNodeTerm kvars g x+    (g, t') <- loadNodeTerm kvars g y+    return (g, pos, StrPrec t t')+loadPrimary _ _ kvars g (L pos [S _ "prec", x, y]) =+  do+    (g, t) <- loadNodeTerm kvars g x+    (g, t') <- loadNodeTerm kvars g y+    return (g, pos, Prec t t')+loadPrimary _ p kvars g (L pos [S _ "p", Q _ name, N _ i, x]) =+  do+    r <- lookupRole pos p name+    (g, t) <- loadNodeTerm kvars g x+    case i < 0 || i >= length (rtrace r) of+      True -> fail (shows pos "Bad index")+      False -> return (g, pos, RolePred r i t)+loadPrimary _ p kvars g (L pos [S _ "p", Q _ name, Q var x, y, z]) =+  do+    r <- lookupRole pos p name+    v <- loadAlgTerm (rvars r) (S var x)+    (g, n) <- loadNodeTerm kvars g y+    t <- loadAlgTerm kvars z+    case isVar v of+      False -> fail (shows pos "Bad parameter -- not a variable")+      True -> return (g, pos, ParamPred r v n t)+loadPrimary _ _ _ _ (L pos (S _ "p" : Q _ name : _)) =+  fail (shows pos ("Bad role specific formula for role " ++ name))+loadPrimary _ _ _ _ (L pos (S _ pred : _)) =+  fail (shows pos ("Bad formula for predicate " ++ pred))+loadPrimary pos _ _ _ _ = fail (shows pos "Bad formula")++-- Load a term and make sure it has sort node++loadNodeTerm :: (Algebra t p g s e c, Monad m) => [t] -> g ->+                SExpr Pos -> m (g, t)+loadNodeTerm ts g x =+  do+    (g, t) <- loadSgTerm ts g x+    case isNodeVar t of+      True -> return (g, t)+      False -> fail (shows (annotation x) "Expecting a node variable")++-- 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+loadAlgTerm _ x@(L _ [N _ _, N _ _]) =+  fail (shows (annotation x) "Expecting an algebra term")+loadAlgTerm ts x =+  do+    t <- loadTerm ts x+    case isNodeVar t of+      True -> fail (shows (annotation x) "Expecting an algebra term")+      False -> return t++loadSgTerm :: (Algebra t p g s e c, Monad m) => [t] -> g ->+              SExpr Pos -> m (g, t)+loadSgTerm ts g x =+  do+    t <- loadTerm ts x+    return (g, t)++-- Role specific check++termVars :: Algebra t p g s e c => t -> [t]+termVars t = addVars [] t++allBound :: Algebra t p g s e c => [t] -> t -> Bool+allBound unbound t =+  L.all (flip L.notElem unbound) (termVars t)++-- Returns variables in unbound that are not role specific++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+  | 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+  | otherwise = fail (shows pos "Unbound variable in prec")+roleSpecific unbound (pos, Non t)+  | allBound unbound t = return unbound+  | otherwise = fail (shows pos "Unbound variable in non")+roleSpecific unbound (pos, Pnon t)+  | allBound unbound t = return unbound+  | otherwise = fail (shows pos "Unbound variable in pnon")+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+  | otherwise = fail (shows pos "Unbound variable in uniq-at")+roleSpecific unbound (pos, Equals t t')+  | isNodeVar t && isNodeVar 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")+  | allBound unbound t && allBound unbound t' = return unbound+  | otherwise = fail (shows pos "Unbound variable in equals")
src/CPSA/Lib/Protocol.hs view
@@ -12,7 +12,7 @@     Role, rname, rvars, rtrace, rnon, rpnon, runique, rcomment,     rsearch, rnorig, rpnorig, ruorig, rpriority, mkRole, varSubset,     varsInTerms, addVars,-    Prot, mkProt, pname, alg, pgen, roles,+    Prot, mkProt, pname, alg, pgen, roles, listenerRole,     varsAllAtoms, pcomment, flow) where  import qualified Data.List as L@@ -251,17 +251,18 @@     = Prot { pname :: !String,  -- Name of the protocol              alg :: !String,    -- Name of the algebra              pgen :: !g,        -- Initial variable generator-             roles :: ![Role t],+             roles :: ![Role t], -- Non-listener roles of a protocol+             listenerRole :: Role t,              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] -> [SExpr ()] -> Prot t g-mkProt name alg gen roles comment =-    Prot { pname = name, alg = alg, pgen = gen,-           roles = roles, pcomment = comment,+          g -> [Role t] -> Role t -> [SExpr ()] -> Prot t g+mkProt name alg gen roles lrole comment =+    Prot { pname = name, alg = alg, pgen = gen, roles = roles,+           listenerRole = lrole, pcomment = comment,            varsAllAtoms = all roleVarsAllAtoms roles }     where       roleVarsAllAtoms role = all isAtom (rvars role)
src/CPSA/Lib/Reduction.hs view
@@ -18,6 +18,7 @@ import CPSA.Lib.SExpr import CPSA.Lib.Entry import CPSA.Lib.Algebra+import CPSA.Lib.Goal import CPSA.Lib.Strand import CPSA.Lib.Cohort import CPSA.Lib.Displayer@@ -340,6 +341,8 @@                      (map (N ()) (L.sort (L.nub seen))) $     addKeyValues "unrealized" (map displayNode $ L.sort unrealized) $     condAddKeyValues "shape" shape [] $+    condAddKeyValues "satisfies" (shape && (not $ null $ kgoals k))+    (satisfies k) $     -- Structure preserving maps     -- Added for cpsasas program     condAddKeyValues "maps" shape (maps k) $@@ -375,6 +378,16 @@     rest maybeAddVKeyValues key f (Just x) rest =     addKeyValues key (f x) rest++-- Variable assignments and security goals++satisfies :: Algebra t p g s e c => Preskel t g s e -> [SExpr ()]+satisfies k =+  map f (sat k) where+    f (_, []) = S () "yes"+    f (g, e : _) =+      L () (S () "no" : displayEnv (ctx $ uvars g) (ctx $ kvars k) e)+    ctx ts = addToContext emptyContext ts  -- Prints structure preserving maps (homomorphisms) maps :: Algebra t p g s e c => Preskel t g s e -> [SExpr ()]
src/CPSA/Lib/Strand.hs view
@@ -8,14 +8,14 @@  module CPSA.Lib.Strand (Instance, mkInstance, bldInstance, mkListener,     role, env, trace, height, listenerTerm, Sid, Node, mkPreskel,-    firstSkeleton, Pair, Preskel, gen, protocol, insts, orderings,+    firstSkeleton, Pair, Preskel, gen, protocol, kgoals, insts, orderings,     pov, knon, kpnon, kunique, korig, kpriority, kcomment, nstrands, kvars,     strandids, kterms, uniqOrig, preskelWellFormed, verbosePreskelWellFormed,     Strand, inst, sid, nodes, Vertex, strand, pos, preds, event,     graphNode, strands, vertex, Gist, gist, isomorphic, contract, augment,     inheritRnon, inheritRpnon, inheritRunique, addListener, Cause     (..), Direction (..), Method (..), Operation (..), operation,-    prob, homomorphism, toSkeleton, generalize, collapse) where+    prob, homomorphism, toSkeleton, generalize, collapse, sat) where  import Control.Monad import qualified Data.List as L@@ -26,6 +26,7 @@ import CPSA.Lib.SExpr import CPSA.Lib.Algebra import CPSA.Lib.Protocol+import CPSA.Lib.Goal  {-- import System.IO.Unsafe@@ -87,12 +88,6 @@ useSingleStrandThinning :: Bool useSingleStrandThinning = False -- True --- Enable de-origination.--- Don't use de-origination without thinning although you may want to--- use thinning without de-origination.-useDeOrigination :: Bool-useDeOrigination = False -- True- -- Sanity check: ensure no role variable occurs in a skeleton. useCheckVars :: Bool useCheckVars = False@@ -195,24 +190,12 @@                trace = trace,                height = length trace } --- This is the only place a role is generated with an empty name.--- This is what marks a strand as a listener.-mkListener :: Algebra t p g s e c => g -> t ->+mkListener :: Algebra t p g s e c => Prot t g -> g -> t ->               (g, Instance t e)-mkListener gen term =-    (gen'', Instance { role = mkRole "" vars [In rterm, Out rterm]-                              [] [] [] [] [] False,-                       env = env,-                       trace = [In term, Out term],-                       height = 2 })-    where-      (gen', rterm) = clone gen term -- Make role term-      vars = addVars [] rterm        -- Collect vars in role term-      (gen'', env) =-          case match rterm term (gen', emptyEnv) of-            (gen'', env) : _ -> (gen'', env)-            [] -> error msg-      msg = "Strand.mkListener: cannot generate an environment."+mkListener p gen term =+    case bldInstance (listenerRole p) [In term, Out term] gen of+      [x] -> x+      _ -> error "Strand.mkListener: Cannot build an instance of a listener"  -- Add to set s the variables that are in the range of instance i addIvars :: Algebra t p g s e c => Set t -> Instance t e -> Set t@@ -355,11 +338,26 @@           | otherwise = inner (p : orderings) True pairs rest       sameStrands (n0, n1) = strand n0 == strand n1 +-- Shared part of preskeletons++data Shared t g = Shared+    { prot  :: Prot t g,+      goals :: [Goal t] }++instance (Show t, Show g) => Show (Shared t g) where+    showsPrec _ s = shows (prot s)++protocol :: Preskel t g s e -> Prot t g+protocol k = prot $ shared k++kgoals :: Preskel t g s e -> [Goal t]+kgoals k = goals $ shared k+ -- Preskeletons  data Preskel t g s e = Preskel     { gen :: !g,-      protocol :: Prot t g,+      shared :: Shared t g,       insts :: ![Instance t e],       strands :: ![Strand t e],       orderings :: ![Pair],@@ -428,14 +426,15 @@ -- Create a preskeleton.  The point of view field is not filled in. -- This version is exported for use by the loader.  This preskeleton -- must be consumed by firstSkeleton.-mkPreskel :: Algebra t p g s e c => g -> Prot t g ->+mkPreskel :: Algebra t p g s e c => g -> Prot t g -> [Goal t] ->              [Instance t e] -> [Pair] -> [t] -> [t] -> [t] ->              [(Node, Int)] -> [SExpr ()] -> Preskel t g s e-mkPreskel gen protocol insts orderings non pnon unique prio comment =+mkPreskel gen protocol gs insts orderings non pnon unique prio comment =     k { kcomment = comment }     where-      k = newPreskel gen protocol insts orderings non pnon+      k = newPreskel gen shared insts orderings non pnon           unique prio New prob Nothing+      shared = Shared { prot = protocol, goals = gs }       prob = strandids k        -- Fixed point on k is okay.  -- Strand functions@@ -461,11 +460,11 @@ -- preds field of each instance in this function.  The maybe uniquely -- originating term data is also filled in.  This version is used -- within this module.-newPreskel :: Algebra t p g s e c => g -> Prot t g ->+newPreskel :: Algebra t p g s e c => g -> Shared t g ->              [Instance t e] -> [Pair] -> [t] -> [t] -> [t] ->              [(Node, Int)] -> Operation t s -> [Sid] ->              Maybe (Preskel t g s e) -> Preskel t g s e-newPreskel gen protocol insts orderings non pnon unique prio oper prob pov =+newPreskel gen shared insts orderings non pnon unique prio oper prob pov =     let orderings' = L.nub orderings         unique' = L.nub unique         g = graph trace height insts orderings'@@ -474,7 +473,7 @@         orig = map (originationNodes strands) unique'         tc = filter pairWellOrdered (graphClose $ graphEdges strands)         k = Preskel { gen = gen,-                      protocol = protocol,+                      shared = shared,                       insts = insts,                       strands = strands,                       orderings = orderings',@@ -860,7 +859,7 @@       let pnon' = map (substitute subst) (kpnon k)       let unique' = map (substitute subst) (kunique k)       let operation' = substOper subst (operation k)-      let k' = newPreskel gen' (protocol k) insts'+      let k' = newPreskel gen' (shared k) insts'                (orderings k) non' pnon' unique' (kpriority k)                operation' (prob k) (pov k)       k' <- wellFormedPreskel k'@@ -911,7 +910,7 @@       let k' =               newPreskel               (gen k)-              (protocol k)+              (shared k)               (deleteNth s (insts k))               orderings'               (knon k)@@ -971,7 +970,7 @@       let k' =               newPreskel               (gen k)-              (protocol k)+              (shared k)               (deleteNth s (insts k))               orderings'               (knon k)@@ -1000,8 +999,6 @@ skeletonize :: Algebra t p g s e c => Bool -> PRS t p g s e c ->                [PRS t p g s e c] skeletonize thin prs-    | useDeOrigination = hull thin prs-    -- Cull preskels with a unique origination assumption that is not unique     | hasMultipleOrig prs = []  -- Usual case     | otherwise = enrich thin prs @@ -1018,30 +1015,14 @@       -- No uniques originate on more than one strand       loop [] = enrich thin prs       -- Found a pair that needs hulling-      loop ((u, (s, i) : (s', i') : _) : _) =-              hullByDeOrigination thin prs u (s, i) (s', i')+      loop ((_, (s, _) : (s', _) : _) : _) =+        do+          (s'', s''', subst) <- unifyStrands (skel prs) s s'+          prs <- ksubst prs subst+          prs' <- compress False prs s'' s'''+          hull thin prs'       loop(_ : orig) = loop orig --- De-Origination--hullByDeOrigination :: Algebra t p g s e c => Bool -> PRS t p g s e c ->-                       t -> Node -> Node -> [PRS t p g s e c]-hullByDeOrigination  thin prs u (s, i) (s', i') =-    do-      subst <- deOrig (skel prs) u (s, i) ++ deOrig (skel prs) u (s', i')-      prs <- ksubst prs subst-      hull thin prs--deOrig :: Algebra t p g s e c => Preskel t g s e -> t -> Node -> [(g, s)]-deOrig k u (s, i) =-    [ (g, s) |-      let tr = trace $ strandInst k s,-      e <- take i tr,-      t <- M.maybeToList $ inbnd e,-      subterm <- S.toList $ foldCarriedTerms (flip S.insert) S.empty t,-      (g, s) <- unify u subterm (gen k, emptySubst),-      not $ originates (substitute s u) (map (evtMap $ substitute s) tr) ]- -- Order Enrichment  -- Adds orderings so that a skeleton respects origination.@@ -1057,7 +1038,7 @@           let k' =                   newPreskel                   (gen k)-                  (protocol k)+                  (shared k)                   (insts k)                   o                   (knon k)@@ -1313,7 +1294,7 @@           let k' =                   newPreskel                   (gen k)-                  (protocol k)+                  (shared k)                   (insts k)                   o                   (knon k)@@ -1358,7 +1339,7 @@               [Preskel t g s e] toSkeleton thin k =     do-      prs <- skeletonize thin (k, k, (0, 0), strandids k, emptySubst)+      prs <- hull thin (k, k, (0, 0), strandids k, emptySubst)       (k', _, _, _) <- homomorphismFilter prs       return k' @@ -1419,7 +1400,7 @@       let non' = inheritRnon inst ++ (knon k)       let pnon' = inheritRpnon inst ++ (kpnon k)       let unique' = inheritRunique inst ++ (kunique k)-      let k' = newPreskel (gen k) (protocol k) insts'+      let k' = newPreskel (gen k) (shared k) insts'            orderings' non' pnon' unique' (kpriority k)            (operation k) (prob k) (pov k)       k' <- wellFormedPreskel k'@@ -1511,10 +1492,10 @@              (k, k', n, strandids k, emptySubst)       homomorphismFilter prs     where-      k' = newPreskel gen' (protocol k) insts' orderings' (knon k)+      k' = newPreskel gen' (shared k) insts' orderings' (knon k)            (kpnon k) (kunique k) (kpriority k)            (AddedListener t cause) (prob k) (pov k)-      (gen', inst) = mkListener (gen k) t+      (gen', inst) = mkListener (protocol k) (gen k) t       insts' = insts k ++ [inst]       pair = ((length (insts k), 1), n)       orderings' = pair : orderings k@@ -1660,7 +1641,7 @@                   g -> Node -> [Instance t e] -> [Pair] ->                   [Sid] -> Preskel t g s e deleteNodeRest k gen n insts' orderings prob =-    newPreskel gen (protocol k) insts' orderings non' pnon' unique'+    newPreskel gen (shared k) insts' orderings non' pnon' unique'                    prio' (Generalized (Deleted n)) prob (pov k)     where       -- Drop nons that aren't mentioned anywhere@@ -1703,7 +1684,7 @@ weaken k p orderings =     addIdentity k'     where-      k' = newPreskel (gen k) (protocol k) (insts k)+      k' = newPreskel (gen k) (shared k) (insts k)            orderings (knon k) (kpnon k) (kunique k) (kpriority k)            (Generalized (Weakened p)) (prob k) (pov k) @@ -1862,9 +1843,9 @@ changeLocations k env gen t locs =     [addIdentity k0, addIdentity k1]     where-      k0 = newPreskel gen' (protocol k) insts' (orderings k) non pnon unique0+      k0 = newPreskel gen' (shared k) insts' (orderings k) non pnon unique0            (kpriority k) (Generalized (Separated t)) (prob k) (pov k)-      k1 = newPreskel gen' (protocol k) insts' (orderings k) non pnon unique1+      k1 = newPreskel gen' (shared k) insts' (orderings k) non pnon unique1            (kpriority k) (Generalized (Separated t)) (prob k) (pov k)       (gen', insts') = changeStrands locs t gen (strands k)       non = knon k ++ map (instantiate env) (knon k)@@ -1932,3 +1913,176 @@       prs <- compress True prs s s'       prs <- skeletonize useThinningDuringCollapsing prs       return $ skel prs++-- Security goals: satisfaction of atomic formulas++type Sem t g s e = Preskel t g s e -> (g, e) -> [(g, e)]++-- Extends an environment (a variable assignment) according to the+-- given atomic formula.+satisfy :: Algebra t p g s e c => AForm t -> Sem t g s e+satisfy (Equals t t') = geq t t'+satisfy (Non t) = ggnon t+satisfy (Pnon t) = ggpnon t+satisfy (Uniq t) = gguniq t+satisfy (UniqAt t n) = guniqAt t n+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++-- Equality This isn't right.  Suppose t is a compound term which has+-- some unbound variable.  Need static role specific check to+-- eliminate this case.+geq :: Algebra t p g s e c => t -> t -> Sem t g s e+geq t t' _ (g, e)+  | t == ti = error ("Strand.geq: " ++ show t ++ " unbound")+  | t' == ti' = error ("Strand.geq: " ++ show t' ++ " unbound")+  | ti == ti' = [(g, e)]+  | otherwise = []+  where+    ti = instantiate e t+    ti' = instantiate e t'++-- Non-origination+ggnon :: Algebra t p g s e c => t -> Sem t g s e+ggnon t k e =+  do+    t' <- knon k+    match t t' e++-- Penetrator non-origination+ggpnon :: Algebra t p g s e c => t -> Sem t g s e+ggpnon t k e =+  do+    t' <- kpnon k+    match t t' e++-- Unique origination+gguniq :: Algebra t p g s e c => t -> Sem t g s e+gguniq t k e =+  do+    t' <- kunique k+    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 =+  do+    (t', ls) <- korig k+    case ls of+      [l] ->+        do+          e <- match t t' e+          nodeMatch n l e+      _ -> []++inSkel :: Algebra t p g s e c => Preskel t g s e -> (Int, Int) -> Bool+inSkel k (s, i) =+  s >= 0 && s < nstrands k && i >= 0 && i < height (insts k !! s)++strandPrec :: Node -> Node -> Bool+strandPrec (s, i) (s', i')+  | 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")++-- 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 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) -> [(g, e)]+    (Just _, Just _) -> []+    (_, Just _) ->+      error ("Strand.gstrPrec: node " ++ show n ++ " unbound")+    _ ->+      error ("Strand.gstrPrec: node " ++ show n' ++ " unbound")+  where+    tc = map graphPair $ graphClose $ graphEdges $ strands k++-- 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+    Nothing ->+      do+        (z, inst) <- zip [0..] $ insts k+        case () of+          _ | i >= height inst -> []+            | rname (role inst) == rname r -> nodeMatch n (z, i) (g, e)+            | otherwise ->      -- See if z could have been an instance of r+              case bldInstance r (take (i + 1) $ trace inst) g of+                [] -> []+                _ -> nodeMatch n (z, i) (g, e)+    Just (z, j) | z < nstrands k && i == j ->+      let inst = insts k !! z in+      case () of+        _ | i >= height inst -> []+          | rname (role inst) == rname r -> [(g, e)]+          | otherwise ->+            case bldInstance r (take (i + 1) $ trace inst) g of+              [] -> []+              _ -> [(g, e)]+    _ -> []++-- Parameter predicate++-- 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+      case () of+        _ | i >= 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+                match t' (instantiate (env inst) t) (g, e)+    Nothing -> error ("Strand.gparam: node " ++ show n ++ " unbound")+    _ -> []++-- Conjunction++conjoin :: Algebra t p g s e c => [AForm t] -> Sem t g s e+conjoin [] _ e = [e]+conjoin (a: as) k e =+  do+    e <- satisfy a k e+    conjoin as k e++-- Satisfaction++-- Returns the environments that show satifaction of the antecedent+-- but fail to be extendable to show satifaction of one of the+-- conclusions.+goalSat :: Algebra t p g s e c => Preskel t g s e -> Goal t -> (Goal t, [e])+goalSat k g =+  (g, [ e |+        (gen, e) <- conjoin (antec g) k (gen k, emptyEnv),+        conclusion (gen, e) ])+  where+    conclusion e = all (disjunct e) $ concl g+    disjunct e a = null $ conjoin a k e++sat :: Algebra t p g s e c => Preskel t g s e -> [(Goal t, [e])]+sat k =+  map (goalSat k) (kgoals k)
src/CPSA/SAS/SAS.hs view
@@ -48,9 +48,7 @@       k <- loadPreskel pos p (pgen p) xs       case (isSkeleton k, isShape k) of         (True, False) ->-          do                    -- Found POV-            origCheck pos k     -- Ensure uniqs originate-            return ((ps, [k]), Nothing)+          return ((ps, [k]), Nothing) -- Found POV         _ -> return ((ps, []), Nothing) -- Not POV loadPOV _ _ ps _ = return ((ps, []), Nothing) @@ -67,26 +65,10 @@       let g = kgen (last ks)      -- Make sure vars in skeleton are       k <- loadPreskel pos p g xs -- distinct from the ones in the POV       case isShape k of-        True ->-          do                    -- Found shape-            origCheck pos k     -- Ensure uniqs originate-            return ((ps, k : ks), Nothing)+        True -> return ((ps, k : ks), Nothing) -- Found shape         False -> return ((ps, ks), Nothing) -- Found intermediate skeleton loadOtherPreskel _ _ ps ks _ = return ((ps, ks), Nothing) --- Ensure every uniq originates-origCheck :: (Algebra t p g s e c, Monad m) =>-             Pos -> Preskel t g c -> m ()-origCheck pos k =-  mapM_ f (uniqs k)-  where-    f t | any (\(t', _) -> t == t') (origs k) = return ()-        | otherwise =-      fail (shows pos "Uniq " ++ u ++ " has no origination point")-      where-        u = pp 0 0 (displayTerm ctx t)-        ctx = addToContext emptyContext (kvars k)- -- Load a protocol  -- The Prot record contains information extraced from protocols for@@ -248,6 +230,7 @@       orderings :: [(t, t)],       succs :: [(t, t)],       nons :: [t],+      pnons :: [t],       uniqs :: [t],       origs :: [(t, t)],       isSkeleton :: Bool,@@ -264,6 +247,7 @@       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)@@ -279,6 +263,7 @@                         orderings = map f orderings,                         succs = loadSuccs varmap,                         nons = nons,+                        pnons = pnons,                         uniqs = uniqs,                         origs = map g origs,                         isSkeleton = not $ hasKey preskeletonKey xs,@@ -516,6 +501,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"@@ -601,6 +590,7 @@       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),       varmap = M.map (instantiate env) (varmap k) }@@ -625,7 +615,8 @@ form (pov, shapes) =   let (c, vars, conj) = skel emptyContext pov in   let disj = map (shape c conj) shapes in-  quantify "forall" vars (imply (conjoin conj) (disjoin disj))+  L () [S () "defgoal", S () (pname $ protocol pov), -- Name of protocol+        quantify "forall" vars (imply (conjoin conj) (disjoin disj))]  -- Convert one skeleton into a declaration and a conjunction.  The -- declaration is used as the bound variables in a quantifier.  The@@ -640,11 +631,13 @@   (kctx,    displayVars kctx (kvars k) ++ listMap node nodes,    map (nodeForm kctx k) (M.assocs (varmap k)) ++-   map (strandForm kctx k) (zip (strands k) $ insts k) +++   map (strandForm 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) +++   map (unary "uniq" kctx) (noOrigUniqs k) +++   map (uniqAtForm kctx) (origs k))  -- map through lists in an S-Expression. listMap :: ([SExpr ()] -> [SExpr ()]) -> [SExpr ()] -> [SExpr ()]@@ -663,7 +656,6 @@             (Node, t) -> SExpr () nodeForm c k ((s, i), n) =     L () [S () "p",-          Q () $ pname $ protocol k, -- Name of the protocol           Q () $ rname $ role inst,  -- Name of the role           N () $ i,           displayTerm c n]@@ -675,14 +667,12 @@ quote x = x  -- Creates the atomic formulas used to describe an instance of a role-strandForm :: Algebra t p g s e c => c -> Preskel t g c ->-              (t, Instance t c) -> SExpr ()-strandForm c k (s, inst) =+strandForm :: Algebra t p g s e c => c -> (t, Instance t c) -> SExpr ()+strandForm c (s, inst) =     conjoin (map f (env inst))     where       f (x, t) =           L () [S () "p",-                Q () $ pname $ protocol k, -- Name of the protocol                 Q () $ rname $ role inst,  -- Name of the role                 quote $ displayTerm (ctx $ role inst) x,                 displayTerm c s,@@ -694,11 +684,18 @@  -- 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 "sprec"+sprecForm = binary "str-prec" -uniqForm :: Algebra t p g s e c => c -> (t, t) -> SExpr ()-uniqForm = binary "uniq"+uniqAtForm :: Algebra t p g s e c => c -> (t, t) -> SExpr ()+uniqAtForm = binary "uniq-at" +-- Returns the uniqs that do not originate in k.+noOrigUniqs :: Algebra t p g s e c => Preskel t g c -> [t]+noOrigUniqs k =+  [ t | t <- uniqs k, all (f t) (origs k) ]+  where+    f t (t', _) = t /= t'+ -- Creates a formula associated with a shape.  It is a disjunction of -- existentially quantified formulas that describe the homomorphism -- and the shape as a skeleton.@@ -711,7 +708,7 @@   quantify "exists" vars (conjoin (n ++ a ++ (conj L.\\ pov)))  displayEq :: Algebra t p g s e c => c -> (t, t) -> SExpr ()-displayEq = binary "equal"+displayEq = binary "="  -- Formula primitives
− src/cpsaextras/Main.scala 
@@ -1,47 +0,0 @@-package cpsaextras--import java.io._-import java.util.ResourceBundle;--object Main {--  /**-   * @param args the command line arguments-   */-  def main(args: Array[String]): Unit = {-    if (args.length != 1) {-      println("Usage: cpsaextras INPUT")-      println(getVersion())-    }-    else {-      val in = new BufferedReader(new FileReader(args(0)))-      val sr = new SExprReader(args(0), in)-      val out = new PrintWriter(System.out)-      while (true) {-	val x = sr.read()-	if (x == null) {-	  out.close()-	  return-	}-	Printer.pp(out, 80, 2, x)-	out.println()-	out.println()-      }-    }-  }--  private var resources: ResourceBundle = null--  private val VERSION_RESOURCES = "cpsaextras/version"--  /**-   * Get program name and a version number from a resource.-   */-  def getVersion() = {-    if (resources == null)-      resources = ResourceBundle.getBundle(VERSION_RESOURCES)-    val program = resources.getString("program")-    val version = resources.getString("version")-    program + " " + version-  }-}
− src/cpsaextras/Pretty.scala 
@@ -1,159 +0,0 @@-/*- * A simple pretty printer- *- * The alogithm is by Lawrence C. Paulson, who simplified an algorithm- * by Derek C. Oppen.- *- * Derek C. Oppen, Prettyprinting, ACM Transactions on Programming- * Languages and Systems, Vol 2, No. 4, October 1980, Pages 465-483.- *- * Copyright (c) 2010 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.- */--/* A pretty printer based on ML programs with the following copyright--(**** ML Programs from Chapter 8 of--  ML for the Working Programmer, 2nd edition-  by Lawrence C. Paulson, Computer Laboratory, University of Cambridge.-  (Cambridge University Press, 1996)--Copyright (C) 1996 by Cambridge University Press.-Permission to copy without fee is granted provided that this copyright-notice and the DISCLAIMER OF WARRANTY are included in any copy.--DISCLAIMER OF WARRANTY.  These programs are provided `as is' without-warranty of any kind.  We make no warranties, express or implied, that the-programs are free of error, or are consistent with any particular standard-of merchantability, or that they will meet your requirements for any-particular application.  They should not be relied upon for solving a-problem whose incorrect solution could result in injury to a person or loss-of property.  If you do use the programs or functions in such a manner, it-is at your own risk.  The author and publisher disclaim all liability for-direct, incidental or consequential damages resulting from your use of-these programs or functions.-****)--*/--package cpsaextras--import java.io.PrintWriter--/** Abstract data type for pretty printing. */-sealed abstract class Pretty-private case class Str(s: String) extends Pretty-private case class Brk(n: Int) extends Pretty-private case class Blo(l: List[Pretty], indent: Int, n: Int) extends Pretty-private case class Grp(l: List[Pretty], indent: Int, n: Int) extends Pretty--object Pretty {-  // Exported constructors--  /** Create a string.-   * @param s string to be printed-   */-  def str(s: String): Pretty = {-    Str(s)-  }--  /** Create a break point.-   * @param n number of spaces-   */-  def brk(n: Int): Pretty = {-    Brk(n)-  }--  /** Create an indentation block.  When pretty printing, any of the-   * break points in the list can be used.-   * @param indent number of spaces to indent-   * @param es a list that includes break points-   */-  def blo(indent: Int, es: List[Pretty]): Pretty = {-    Blo(es, indent, len(es, 0))-  }--  /** Create an indentation group.  When pretty printing,-   * either all or none of the break points are used.-   * @param indent number of spaces to indent-   * @param es a list that includes break points-   */-  def grp(indent: Int, es: List[Pretty]): Pretty = {-    Grp(es, indent, len(es, 0))-  }--  private def len(es: List[Pretty], n: Int): Int = {-    es match {-      case Nil => n-      case e :: es => len(es, size(e) + n)-    }-  }--  private def size(e: Pretty): Int = {-    e match {-      case Str(s) => s.length-      case Brk(n) => n-      case Blo(_, _, n) => n-      case Grp(_, _, n) => n-    }-  }--  /** Print an object of type Pretty. */-  def pr(w: PrintWriter, margin: Int, e: Pretty): Unit = {-    printing(w, margin, List(e), margin, 0, false, margin)-  }--  private def printing(w: PrintWriter, margin: Int, es: List[Pretty],-		       blockspace:Int, after: Int, force: Boolean,-		       space: Int): Int = {-    es match {-      case Nil => space-      case e :: es =>-	val space1 = e match {-	  case Str(s) =>		// Place a string-	    w.print(s)-	    space - s.length-	  case Brk(n) =>		// Place breakable space-	    if (!force && n + breakdist(es, after) <= space)-	      blanks(w, n, space)	// Don't break-	    else {-	      w.println()		// Break-	      blanks(w, margin - blockspace, margin)-	    }-	  case Blo(bes, indent, _) =>	// Place a block-	    printing(w, margin, bes, space - indent,-		     breakdist(es, after), false, space)-	  case Grp(bes, indent, n) =>	// Place a group-	    val dist = breakdist(es, after)-	    printing(w, margin, bes, space - indent,-		     dist, n + dist > space, space)-	}-	printing(w, margin, es, blockspace, after, force, space1)-    }-  }--  // Find the distance to the nearest breakable space-  private def breakdist(es: List[Pretty], after: Int): Int = {-    es match {-      case Nil => after-      case Str(s) :: es => s.length + breakdist(es, after)-      case Brk(_) :: es => 0-      case Blo(_, _, n) :: es => n + breakdist(es, after)-      case Grp(_, _, n) :: es => n + breakdist(es, after)-    }-  }--  // Place spaces-  private def blanks(w: PrintWriter, n: Int, space: Int): Int = {-    if (n <= 0)-      space-    else {-      w.print(' ')-      blanks(w, n - 1, space - 1)-    }-  }-}
− src/cpsaextras/Printer.scala 
@@ -1,122 +0,0 @@-/*- * A CPSA specific pretty printer- *- * Copyright (c) 2009 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.- */--package cpsaextras--import java.io.PrintWriter--object Printer {--  /** CPSA specific pretty printer.-   * The pretty printer that indents a constant amount for each list.  The-   * top-level lists are laid out specially.  Whenever some breaks-   * occur, all breaks are forced.  Also, breaks are only placed before-   * strings and lists.  CPSA protocols are handled specially.  Each-   * defrole is handled as are top-level lists.-   *-   * @param w the output writer-   * @param margin the width to be filled-   * @param indent the number of spaces in an indent-   * @param x the S-expression to be pretty printed-   */-  def pp[A](w: PrintWriter, margin: Int, indent: Int, x: SExpr[A]): Unit = {-    Pretty.pr(w, margin, pretty(indent, x))-  }--  private def pretty[A](indent: Int, x: SExpr[A]): Pretty = {-    x match {-      case L(_, (x@S(_, "defprotocol")) :: xs) =>-	roles(indent, xs, List(block(indent, x), Pretty.str("(")))-      case x@L(_, S(_, "defmacro") :: _) =>-	block(indent, x)-      case x@L(_, S(_, "herald") :: _) =>-	block(indent, x)-      case _ =>-	group(indent, x)-    }-  }--  // Role specific pretty printer-  private def roles[A](indent: Int, xs: List[SExpr[A]],-		       acc: List[Pretty]): Pretty = {-    xs match {-      case Nil =>-	Pretty.grp(indent, (Pretty.str(")") :: acc).reverse)-      case (x@S(_, _)) :: xs =>-	roles(indent, xs, block(indent, x) :: Pretty.str(" ") :: acc)-      case (x@Q(_, _)) :: xs =>-	roles(indent, xs, block(indent, x) :: Pretty.brk(1) :: acc)-      case (x@N(_, _)) :: xs =>-	roles(indent, xs, block(indent, x) :: Pretty.str(" ") :: acc)-      case (x@L(_, S(_, "defrole") :: _)) :: xs =>-	roles(indent, xs, group(indent, x) :: Pretty.brk(1) :: acc)-      case (x@L(_, _)) :: xs =>-	roles(indent, xs, block(indent, x) :: Pretty.brk(1) :: acc)-    }-  }--  // A pretty printer for top-level S-expressions-  private def group[A](indent: Int, x: SExpr[A]): Pretty = {-    x match {-      case L(a, l) => grouplist(indent, l)-      case _ => block(indent, x)-    }-  }--  private def grouplist[A](indent: Int, xs: List[SExpr[A]]): Pretty = {-    xs match {-      case Nil => Pretty.str("()")-      case x :: xs =>-	grouprest(indent, xs, List(block(indent, x), Pretty.str("(")))-    }-  }--  private def grouprest[A](indent: Int, xs: List[SExpr[A]],-			acc: List[Pretty]): Pretty = {-    xs match {-      case Nil =>-	Pretty.grp(indent, (Pretty.str(")") :: acc).reverse)-      case (x@S(_, _)) :: xs =>-	grouprest(indent, xs, block(indent, x) :: Pretty.str(" ") :: acc)-      case (x@Q(_, _)) :: xs =>-	grouprest(indent, xs, block(indent, x) :: Pretty.brk(1) :: acc)-      case (x@N(_, _)) :: xs =>-	grouprest(indent, xs, block(indent, x) :: Pretty.str(" ") :: acc)-      case (x@L(_, _)) :: xs =>-	grouprest(indent, xs, block(indent, x) :: Pretty.brk(1) :: acc)-    }-  }--  // A pretty printer for interior lists using block style breaking.-  private def block[A](indent: Int, x: SExpr[A]): Pretty = {-    x match {-      case L(a, l) => blocklist(indent, l)-      case _ => Pretty.str(x.toString())-    }-  }--  private def blocklist[A](indent: Int, xs: List[SExpr[A]]): Pretty = {-    xs match {-      case Nil => Pretty.str("()")-      case x :: xs =>-	blockrest(indent, xs, List(block(indent, x), Pretty.str("(")))-    }-  }--  private def blockrest[A](indent: Int, xs: List[SExpr[A]],-			acc: List[Pretty]): Pretty = {-    xs match {-      case Nil =>-	Pretty.blo(indent, (Pretty.str(")") :: acc).reverse)-      case x :: xs =>-	blockrest(indent, xs, block(indent, x) :: Pretty.brk(1) :: acc)-    }-  }-}
− src/cpsaextras/SExpr.scala 
@@ -1,282 +0,0 @@-/*- * S-expressions- *-'* Copyright (c) 2010 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.- */--package cpsaextras--import java.io._--/**- * Annotated S-expressions.  Each S-expression can be annotated with- * something of type A.- */-sealed abstract class SExpr[A] {-  /** The annotation. */-  val a: A-}-/** Case of a symbol. */-case class S[A](a: A, s: String) extends SExpr[A] {-  override def toString(): String = {-    s.toString()-  }-}-/** Case of a string. */-case class Q[A](a: A, q: String) extends SExpr[A] {-  override def toString(): String = {-    "\"" + q.toString() + "\""-  }-}-/** Case of a number. */-case class N[A](a: A, n: Int) extends SExpr[A] {-  override def toString(): String = {-    n.toString()-  }-}-/** Case of a list of S-expressions. */-case class L[A](a: A, l: List[SExpr[A]]) extends SExpr[A] {-  override def toString(): String = {-    l.toString()-  }-}--/** The file position annotation. */-final case class Pos(file: String, line: Int, column: Int) {-  override def toString (): String = {-    file + ":" + line + ":" + column + ": "-  }-}--/** An S-expression reader.- *- * @param file name of the input file- * @param in stream associated with the input file- */-class SExprReader(file: String, in: Reader) {-  private var line = 1			// Stream line number-  private var column = 1		// Stream column--  // A scanner token-  private sealed abstract class Token-  // A token for a non-list S-expression-  private case class Atom(a: SExpr[Pos]) extends Token-  // A token for the left parenthesis-  private case class LParen(p: Pos) extends Token-  // A token for the right parenthesis-  private case class RParen(p: Pos) extends Token-  // A token for end-of-file-  private case object Eof extends Token--  /**-   * Reads an S-expression annotated with file positions.-   * @return an S-expression or null on end-of-file-   */-  def read(): SExpr[Pos] = {-    scan() match {-      case Atom(a) => a-      case LParen(p) => list(p, Nil)-      case RParen(p) =>-	in.close()-	throw new IOException(p + "Close of unopened list")-      case Eof =>-	in.close()-	null-    }-  }--  // Parse a non top-level list-  private def list(pos: Pos, acc: List[SExpr[Pos]]): SExpr[Pos] = {-    scan() match {-      case Atom(a) => list(pos, a :: acc)-      case LParen(p) => list(pos, list(p, Nil) :: acc)-      case RParen(_) => L(pos, acc.reverse)-      case Eof =>-	in.close()-	throw new IOException(pos + "Unexpected end of input in list")-    }-  }--  // Scanner--  // Consume white space and then dispatch on the first character-  private def scan(): Token = {-    val ch = get()-    if (Character.isWhitespace(ch))-      scan()-    else ch match {-      case -1 => Eof-      case '(' => LParen(Pos(file, line, column))-      case ')' => RParen(Pos(file, line, column))-      case ';' => comment()-      case _ => atom(ch)-    }-  }--  // Consume a comment and then resume scanning-  private def comment(): Token = {-    get() match {-      case -1 => Eof-      case '\n' => scan()-      case _ => comment()-    }-  }--  // Scan an atom-  private def atom(ch: Int): Token = {-    val p = Pos(file, line, column)	// Position of atom-    ch match {-      case '"' => string(p, new StringBuilder())-      case '+' => numOrSym(p, singleton(ch))-      case '-' => numOrSym(p, singleton(ch))-      case _ =>-	if (Character.isDigit(ch))-	  number(p, singleton(ch))-	else if (isSym(ch))-	  symbol(p, singleton(ch))-	else {-	  in.close()-	  throw new IOException(p + "Bad char in atom")-	}-    }-  }--  // Create a string buffer with one character-  private def singleton(ch: Int): StringBuilder = {-    val sb = new StringBuilder()-    sb.append(ch.toChar)-    sb-  }--  // Scan a string atom-  private def string(p: Pos, sb: StringBuilder): Token = {-    val ch = get()-    if (ch == -1) {-      in.close()-      throw new IOException(p + "End of input in string")-    }-    else if (ch == '"')-      Atom(Q(p, sb.toString().intern()))-    else if (isStr(ch)) {-      sb.append(ch.toChar)-      string(p, sb)-    }-    else {-      in.close()-      throw new IOException(p + "Bad char for string")-    }-  }--  // Scan a number atom-  private def number(p: Pos, sb: StringBuilder): Token = {-    val ch = peek()-    if (ch == -1)-      Atom(N(p, Integer.parseInt(sb.toString())))-    else if (Character.isDigit(ch)) {-      get()-      sb.append(ch.toChar)-      number(p, sb)-    }-    else if (isSym(ch)) {-      in.close()-      throw new IOException(p + "Bad char after number")-    }-    else-      Atom(N(p, Integer.parseInt(sb.toString())))-  }--  // See if an atom is an number or a symbol-  private def numOrSym(p: Pos, sb: StringBuilder): Token = {-    val ch = peek()-    if (ch == -1)-      symbol(p, sb)-    else if (Character.isDigit(ch))-      number(p, sb)-    else-      symbol(p, sb)-  }--  // Scan a symbol-  private def symbol(p: Pos, sb: StringBuilder): Token = {-    val ch = peek()-    if (ch == -1)-      Atom(S(p, sb.toString().intern()))-    else if (isSym(ch)) {-      get()-      sb.append(ch.toChar)-      symbol(p, sb)-    }-    else-      Atom(S(p, sb.toString().intern()))-  }--  // Is character a constituent of a symbol?-  private def isSym(ch: Int) = {-    ch match {-      case '+' => true-      case '-' => true-      case '*' => true-      case '/' => true-      case '<' => true-      case '=' => true-      case '>' => true-      case '!' => true-      case '?' => true-      case ':' => true-      case '$' => true-      case '%' => true-      case '_' => true-      case '&' => true-      case '~' => true-      case '^' => true-      case _ => Character.isLetterOrDigit(ch)-    }-  }--  // Is character a constituent of a string?-  private def isStr(ch: Int) = {-    ch match {-      case '"' => false-      case '\\' => false-      case _ => !Character.isISOControl(ch)-    }-  }--  // Character reader with look ahead--  private var peeked = false		// Is look ahead active?-  private var seen = 0			// peeked character--  // Get next character and set the current file position.-  private def get(): Int = {-    val next =-      if (peeked) {-	peeked = false-	seen-      }-      else-	in.read()-    if (next == '\n') {-      line += 1-      column = 1-    }-    else-      column += 1-    next-  }--  // Read ahead if need be-  private def peek(): Int = {-    if (peeked)-      seen-    else {-      peeked = true-      seen = in.read()-      seen-    }-  }-}
src/prover9.pl view
@@ -7,6 +7,15 @@  %% Known to work in SWI-Prolog, but not with GNU Prolog. +%% To handle the subsort relations of the message algebra, add the+%% following axioms.++%%    all T (akey(T) -> mesg(T)).+%%    all T (skey(T) -> mesg(T)).+%%    all T (name(T) -> mesg(T)).+%%    all T (text(T) -> mesg(T)).+%%    all T (name(T) -> mesg(T)).+ %% Copyright (c) 2011 The MITRE Corporation %% %% This program is free software: you can redistribute it and/or@@ -28,7 +37,7 @@  %% Ignore all forms except the ones that start with forall. top_forms_pp(_, []).-top_forms_pp(Out, [[forall|Rest]|Forms]) :-+top_forms_pp(Out, [[defsas, _, [forall|Rest]]|Forms]) :- 	!, 	form_to_pretty([forall|Rest], Pretty), 	pp:pr(Out, 72, Pretty),@@ -144,9 +153,6 @@ 	decl(Decl, Sort, SVars, End).  quantifier_preds([], [], []).-quantifier_preds([(Var,mesg)|SVars], [Var|Vars], Preds) :--        !,-        quantifier_preds(SVars, Vars, Preds). quantifier_preds([(Var,Sort)|SVars], [Var|Vars], [[Sort, Var]|Preds]) :-         quantifier_preds(SVars, Vars, Preds).
+ src/scala/Main.scala view
@@ -0,0 +1,47 @@+package cpsaextras++import java.io._+import java.util.ResourceBundle;++object Main {++  /**+   * @param args the command line arguments+   */+  def main(args: Array[String]): Unit = {+    if (args.length != 1) {+      println("Usage: cpsaextras INPUT")+      println(getVersion())+    }+    else {+      val in = new BufferedReader(new FileReader(args(0)))+      val sr = new SExprReader(args(0), in)+      val out = new PrintWriter(System.out)+      while (true) {+	val x = sr.read()+	if (x == null) {+	  out.close()+	  return+	}+	Printer.pp(out, 80, 2, x)+	out.println()+	out.println()+      }+    }+  }++  private var resources: ResourceBundle = null++  private val VERSION_RESOURCES = "cpsaextras/version"++  /**+   * Get program name and a version number from a resource.+   */+  def getVersion() = {+    if (resources == null)+      resources = ResourceBundle.getBundle(VERSION_RESOURCES)+    val program = resources.getString("program")+    val version = resources.getString("version")+    program + " " + version+  }+}
+ src/scala/Pretty.scala view
@@ -0,0 +1,159 @@+/*+ * A simple pretty printer+ *+ * The alogithm is by Lawrence C. Paulson, who simplified an algorithm+ * by Derek C. Oppen.+ *+ * Derek C. Oppen, Prettyprinting, ACM Transactions on Programming+ * Languages and Systems, Vol 2, No. 4, October 1980, Pages 465-483.+ *+ * Copyright (c) 2010 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.+ */++/* A pretty printer based on ML programs with the following copyright++(**** ML Programs from Chapter 8 of++  ML for the Working Programmer, 2nd edition+  by Lawrence C. Paulson, Computer Laboratory, University of Cambridge.+  (Cambridge University Press, 1996)++Copyright (C) 1996 by Cambridge University Press.+Permission to copy without fee is granted provided that this copyright+notice and the DISCLAIMER OF WARRANTY are included in any copy.++DISCLAIMER OF WARRANTY.  These programs are provided `as is' without+warranty of any kind.  We make no warranties, express or implied, that the+programs are free of error, or are consistent with any particular standard+of merchantability, or that they will meet your requirements for any+particular application.  They should not be relied upon for solving a+problem whose incorrect solution could result in injury to a person or loss+of property.  If you do use the programs or functions in such a manner, it+is at your own risk.  The author and publisher disclaim all liability for+direct, incidental or consequential damages resulting from your use of+these programs or functions.+****)++*/++package cpsaextras++import java.io.PrintWriter++/** Abstract data type for pretty printing. */+sealed abstract class Pretty+private case class Str(s: String) extends Pretty+private case class Brk(n: Int) extends Pretty+private case class Blo(l: List[Pretty], indent: Int, n: Int) extends Pretty+private case class Grp(l: List[Pretty], indent: Int, n: Int) extends Pretty++object Pretty {+  // Exported constructors++  /** Create a string.+   * @param s string to be printed+   */+  def str(s: String): Pretty = {+    Str(s)+  }++  /** Create a break point.+   * @param n number of spaces+   */+  def brk(n: Int): Pretty = {+    Brk(n)+  }++  /** Create an indentation block.  When pretty printing, any of the+   * break points in the list can be used.+   * @param indent number of spaces to indent+   * @param es a list that includes break points+   */+  def blo(indent: Int, es: List[Pretty]): Pretty = {+    Blo(es, indent, len(es, 0))+  }++  /** Create an indentation group.  When pretty printing,+   * either all or none of the break points are used.+   * @param indent number of spaces to indent+   * @param es a list that includes break points+   */+  def grp(indent: Int, es: List[Pretty]): Pretty = {+    Grp(es, indent, len(es, 0))+  }++  private def len(es: List[Pretty], n: Int): Int = {+    es match {+      case Nil => n+      case e :: es => len(es, size(e) + n)+    }+  }++  private def size(e: Pretty): Int = {+    e match {+      case Str(s) => s.length+      case Brk(n) => n+      case Blo(_, _, n) => n+      case Grp(_, _, n) => n+    }+  }++  /** Print an object of type Pretty. */+  def pr(w: PrintWriter, margin: Int, e: Pretty): Unit = {+    printing(w, margin, List(e), margin, 0, false, margin)+  }++  private def printing(w: PrintWriter, margin: Int, es: List[Pretty],+		       blockspace:Int, after: Int, force: Boolean,+		       space: Int): Int = {+    es match {+      case Nil => space+      case e :: es =>+	val space1 = e match {+	  case Str(s) =>		// Place a string+	    w.print(s)+	    space - s.length+	  case Brk(n) =>		// Place breakable space+	    if (!force && n + breakdist(es, after) <= space)+	      blanks(w, n, space)	// Don't break+	    else {+	      w.println()		// Break+	      blanks(w, margin - blockspace, margin)+	    }+	  case Blo(bes, indent, _) =>	// Place a block+	    printing(w, margin, bes, space - indent,+		     breakdist(es, after), false, space)+	  case Grp(bes, indent, n) =>	// Place a group+	    val dist = breakdist(es, after)+	    printing(w, margin, bes, space - indent,+		     dist, n + dist > space, space)+	}+	printing(w, margin, es, blockspace, after, force, space1)+    }+  }++  // Find the distance to the nearest breakable space+  private def breakdist(es: List[Pretty], after: Int): Int = {+    es match {+      case Nil => after+      case Str(s) :: es => s.length + breakdist(es, after)+      case Brk(_) :: es => 0+      case Blo(_, _, n) :: es => n + breakdist(es, after)+      case Grp(_, _, n) :: es => n + breakdist(es, after)+    }+  }++  // Place spaces+  private def blanks(w: PrintWriter, n: Int, space: Int): Int = {+    if (n <= 0)+      space+    else {+      w.print(' ')+      blanks(w, n - 1, space - 1)+    }+  }+}
+ src/scala/Printer.scala view
@@ -0,0 +1,122 @@+/*+ * A CPSA specific pretty printer+ *+ * Copyright (c) 2009 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.+ */++package cpsaextras++import java.io.PrintWriter++object Printer {++  /** CPSA specific pretty printer.+   * The pretty printer that indents a constant amount for each list.  The+   * top-level lists are laid out specially.  Whenever some breaks+   * occur, all breaks are forced.  Also, breaks are only placed before+   * strings and lists.  CPSA protocols are handled specially.  Each+   * defrole is handled as are top-level lists.+   *+   * @param w the output writer+   * @param margin the width to be filled+   * @param indent the number of spaces in an indent+   * @param x the S-expression to be pretty printed+   */+  def pp[A](w: PrintWriter, margin: Int, indent: Int, x: SExpr[A]): Unit = {+    Pretty.pr(w, margin, pretty(indent, x))+  }++  private def pretty[A](indent: Int, x: SExpr[A]): Pretty = {+    x match {+      case L(_, (x@S(_, "defprotocol")) :: xs) =>+	roles(indent, xs, List(block(indent, x), Pretty.str("(")))+      case x@L(_, S(_, "defmacro") :: _) =>+	block(indent, x)+      case x@L(_, S(_, "herald") :: _) =>+	block(indent, x)+      case _ =>+	group(indent, x)+    }+  }++  // Role specific pretty printer+  private def roles[A](indent: Int, xs: List[SExpr[A]],+		       acc: List[Pretty]): Pretty = {+    xs match {+      case Nil =>+	Pretty.grp(indent, (Pretty.str(")") :: acc).reverse)+      case (x@S(_, _)) :: xs =>+	roles(indent, xs, block(indent, x) :: Pretty.str(" ") :: acc)+      case (x@Q(_, _)) :: xs =>+	roles(indent, xs, block(indent, x) :: Pretty.brk(1) :: acc)+      case (x@N(_, _)) :: xs =>+	roles(indent, xs, block(indent, x) :: Pretty.str(" ") :: acc)+      case (x@L(_, S(_, "defrole") :: _)) :: xs =>+	roles(indent, xs, group(indent, x) :: Pretty.brk(1) :: acc)+      case (x@L(_, _)) :: xs =>+	roles(indent, xs, block(indent, x) :: Pretty.brk(1) :: acc)+    }+  }++  // A pretty printer for top-level S-expressions+  private def group[A](indent: Int, x: SExpr[A]): Pretty = {+    x match {+      case L(a, l) => grouplist(indent, l)+      case _ => block(indent, x)+    }+  }++  private def grouplist[A](indent: Int, xs: List[SExpr[A]]): Pretty = {+    xs match {+      case Nil => Pretty.str("()")+      case x :: xs =>+	grouprest(indent, xs, List(block(indent, x), Pretty.str("(")))+    }+  }++  private def grouprest[A](indent: Int, xs: List[SExpr[A]],+			acc: List[Pretty]): Pretty = {+    xs match {+      case Nil =>+	Pretty.grp(indent, (Pretty.str(")") :: acc).reverse)+      case (x@S(_, _)) :: xs =>+	grouprest(indent, xs, block(indent, x) :: Pretty.str(" ") :: acc)+      case (x@Q(_, _)) :: xs =>+	grouprest(indent, xs, block(indent, x) :: Pretty.brk(1) :: acc)+      case (x@N(_, _)) :: xs =>+	grouprest(indent, xs, block(indent, x) :: Pretty.str(" ") :: acc)+      case (x@L(_, _)) :: xs =>+	grouprest(indent, xs, block(indent, x) :: Pretty.brk(1) :: acc)+    }+  }++  // A pretty printer for interior lists using block style breaking.+  private def block[A](indent: Int, x: SExpr[A]): Pretty = {+    x match {+      case L(a, l) => blocklist(indent, l)+      case _ => Pretty.str(x.toString())+    }+  }++  private def blocklist[A](indent: Int, xs: List[SExpr[A]]): Pretty = {+    xs match {+      case Nil => Pretty.str("()")+      case x :: xs =>+	blockrest(indent, xs, List(block(indent, x), Pretty.str("(")))+    }+  }++  private def blockrest[A](indent: Int, xs: List[SExpr[A]],+			acc: List[Pretty]): Pretty = {+    xs match {+      case Nil =>+	Pretty.blo(indent, (Pretty.str(")") :: acc).reverse)+      case x :: xs =>+	blockrest(indent, xs, block(indent, x) :: Pretty.brk(1) :: acc)+    }+  }+}
+ src/scala/SExpr.scala view
@@ -0,0 +1,282 @@+/*+ * S-expressions+ *+'* Copyright (c) 2010 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.+ */++package cpsaextras++import java.io._++/**+ * Annotated S-expressions.  Each S-expression can be annotated with+ * something of type A.+ */+sealed abstract class SExpr[A] {+  /** The annotation. */+  val a: A+}+/** Case of a symbol. */+case class S[A](a: A, s: String) extends SExpr[A] {+  override def toString(): String = {+    s.toString()+  }+}+/** Case of a string. */+case class Q[A](a: A, q: String) extends SExpr[A] {+  override def toString(): String = {+    "\"" + q.toString() + "\""+  }+}+/** Case of a number. */+case class N[A](a: A, n: Int) extends SExpr[A] {+  override def toString(): String = {+    n.toString()+  }+}+/** Case of a list of S-expressions. */+case class L[A](a: A, l: List[SExpr[A]]) extends SExpr[A] {+  override def toString(): String = {+    l.toString()+  }+}++/** The file position annotation. */+final case class Pos(file: String, line: Int, column: Int) {+  override def toString (): String = {+    file + ":" + line + ":" + column + ": "+  }+}++/** An S-expression reader.+ *+ * @param file name of the input file+ * @param in stream associated with the input file+ */+class SExprReader(file: String, in: Reader) {+  private var line = 1			// Stream line number+  private var column = 1		// Stream column++  // A scanner token+  private sealed abstract class Token+  // A token for a non-list S-expression+  private case class Atom(a: SExpr[Pos]) extends Token+  // A token for the left parenthesis+  private case class LParen(p: Pos) extends Token+  // A token for the right parenthesis+  private case class RParen(p: Pos) extends Token+  // A token for end-of-file+  private case object Eof extends Token++  /**+   * Reads an S-expression annotated with file positions.+   * @return an S-expression or null on end-of-file+   */+  def read(): SExpr[Pos] = {+    scan() match {+      case Atom(a) => a+      case LParen(p) => list(p, Nil)+      case RParen(p) =>+	in.close()+	throw new IOException(p + "Close of unopened list")+      case Eof =>+	in.close()+	null+    }+  }++  // Parse a non top-level list+  private def list(pos: Pos, acc: List[SExpr[Pos]]): SExpr[Pos] = {+    scan() match {+      case Atom(a) => list(pos, a :: acc)+      case LParen(p) => list(pos, list(p, Nil) :: acc)+      case RParen(_) => L(pos, acc.reverse)+      case Eof =>+	in.close()+	throw new IOException(pos + "Unexpected end of input in list")+    }+  }++  // Scanner++  // Consume white space and then dispatch on the first character+  private def scan(): Token = {+    val ch = get()+    if (Character.isWhitespace(ch))+      scan()+    else ch match {+      case -1 => Eof+      case '(' => LParen(Pos(file, line, column))+      case ')' => RParen(Pos(file, line, column))+      case ';' => comment()+      case _ => atom(ch)+    }+  }++  // Consume a comment and then resume scanning+  private def comment(): Token = {+    get() match {+      case -1 => Eof+      case '\n' => scan()+      case _ => comment()+    }+  }++  // Scan an atom+  private def atom(ch: Int): Token = {+    val p = Pos(file, line, column)	// Position of atom+    ch match {+      case '"' => string(p, new StringBuilder())+      case '+' => numOrSym(p, singleton(ch))+      case '-' => numOrSym(p, singleton(ch))+      case _ =>+	if (Character.isDigit(ch))+	  number(p, singleton(ch))+	else if (isSym(ch))+	  symbol(p, singleton(ch))+	else {+	  in.close()+	  throw new IOException(p + "Bad char in atom")+	}+    }+  }++  // Create a string buffer with one character+  private def singleton(ch: Int): StringBuilder = {+    val sb = new StringBuilder()+    sb.append(ch.toChar)+    sb+  }++  // Scan a string atom+  private def string(p: Pos, sb: StringBuilder): Token = {+    val ch = get()+    if (ch == -1) {+      in.close()+      throw new IOException(p + "End of input in string")+    }+    else if (ch == '"')+      Atom(Q(p, sb.toString().intern()))+    else if (isStr(ch)) {+      sb.append(ch.toChar)+      string(p, sb)+    }+    else {+      in.close()+      throw new IOException(p + "Bad char for string")+    }+  }++  // Scan a number atom+  private def number(p: Pos, sb: StringBuilder): Token = {+    val ch = peek()+    if (ch == -1)+      Atom(N(p, Integer.parseInt(sb.toString())))+    else if (Character.isDigit(ch)) {+      get()+      sb.append(ch.toChar)+      number(p, sb)+    }+    else if (isSym(ch)) {+      in.close()+      throw new IOException(p + "Bad char after number")+    }+    else+      Atom(N(p, Integer.parseInt(sb.toString())))+  }++  // See if an atom is an number or a symbol+  private def numOrSym(p: Pos, sb: StringBuilder): Token = {+    val ch = peek()+    if (ch == -1)+      symbol(p, sb)+    else if (Character.isDigit(ch))+      number(p, sb)+    else+      symbol(p, sb)+  }++  // Scan a symbol+  private def symbol(p: Pos, sb: StringBuilder): Token = {+    val ch = peek()+    if (ch == -1)+      Atom(S(p, sb.toString().intern()))+    else if (isSym(ch)) {+      get()+      sb.append(ch.toChar)+      symbol(p, sb)+    }+    else+      Atom(S(p, sb.toString().intern()))+  }++  // Is character a constituent of a symbol?+  private def isSym(ch: Int) = {+    ch match {+      case '+' => true+      case '-' => true+      case '*' => true+      case '/' => true+      case '<' => true+      case '=' => true+      case '>' => true+      case '!' => true+      case '?' => true+      case ':' => true+      case '$' => true+      case '%' => true+      case '_' => true+      case '&' => true+      case '~' => true+      case '^' => true+      case _ => Character.isLetterOrDigit(ch)+    }+  }++  // Is character a constituent of a string?+  private def isStr(ch: Int) = {+    ch match {+      case '"' => false+      case '\\' => false+      case _ => !Character.isISOControl(ch)+    }+  }++  // Character reader with look ahead++  private var peeked = false		// Is look ahead active?+  private var seen = 0			// peeked character++  // Get next character and set the current file position.+  private def get(): Int = {+    val next =+      if (peeked) {+	peeked = false+	seen+      }+      else+	in.read()+    if (next == '\n') {+      line += 1+      column = 1+    }+    else+      column += 1+    next+  }++  // Read ahead if need be+  private def peek(): Int = {+    if (peeked)+      seen+    else {+      peeked = true+      seen = in.read()+      seen+    }+  }+}
tst/DH_hack.tst view
@@ -1,6 +1,6 @@ (herald "DH Hack" (bound 15)) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from DH_hack.scm") (comment "Strand count bounded at 15")
tst/blanchet.tst view
@@ -1,7 +1,7 @@ (herald "Blanchet's Simple Example Protocol"   (comment "There is a flaw in this protocol by design")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from blanchet.scm")  (defprotocol blanchet basic
tst/completeness-test.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from completeness-test.scm")  (defprotocol completeness-test basic
tst/crushing.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from crushing.scm")  (defprotocol crushing basic
tst/dass_simple.tst view
@@ -1,6 +1,6 @@ (herald "Distributed Authentication Security Service Protocol Variants") -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from dass_simple.scm")  (defprotocol dass-simple basic
tst/denning-sacco.tst view
@@ -1,6 +1,6 @@ (herald "Denning-Sacco Protocol") -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from denning-sacco.scm")  (defprotocol denning-sacco basic
tst/deorig_contract.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from deorig_contract.scm")  (defprotocol deorig-contract basic
tst/deorig_mesg.tst view
@@ -1,6 +1,6 @@ (herald deorig-mesg) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from deorig_mesg.scm")  (defprotocol deorig-mesg basic
tst/deorig_simple.tst view
@@ -1,6 +1,6 @@ (herald deorig-simple) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from deorig_simple.scm")  (defprotocol deorig-simple basic
tst/dy.tst view
@@ -1,6 +1,6 @@ (herald "Example 1.3 from 1983 Dolev-Yao Paper") -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from dy.lsp")  (defprotocol dy basic
tst/encsig.tst view
@@ -1,7 +1,7 @@ (herald "Encrypted Signed Message Example"   (comment "Shows examples of key usage of asymmetric keys")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from encsig.scm")  (defprotocol mult-keys-enc-sig basic
tst/epmo-hash.tst view
@@ -1,7 +1,7 @@ (herald "Electronic Purchase with Money Order Protocol with Key Hashing"   (comment "Annotated with trust management formulas")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from epmo-hash.scm")  (defprotocol epmo basic
tst/epmo-key-hash.tst view
@@ -1,7 +1,7 @@ (herald "Electronic Purchase with Money Order Protocol with Key Hashing"   (comment "Annotated with trust management formulas")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from epmo-key-hash.scm")  (defprotocol epmo basic
tst/epmo.tst view
@@ -1,7 +1,7 @@ (herald "Electronic Purchase with Money Order Protocol"   (comment "Annotated with trust management formulas")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from epmo.scm")  (defprotocol epmo basic
tst/epmo_acctnum-key-hash.tst view
@@ -2,7 +2,7 @@   "Electronic Purchase with Money Order Protocol Variant with Key Hashing"   (comment "This version includes account numbers in exchanges")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from epmo_acctnum-key-hash.scm")  (defprotocol epmo_acctnum basic
tst/ffgg.tst view
@@ -1,7 +1,7 @@ (herald "The ffgg Protocol"   (comment "From A Necessarily Parallel Attack by Jon K. Millen")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from ffgg.scm")  (defprotocol ffgg basic
tst/fragile_pruning.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from fragile_pruning.scm")  (defprotocol fragile_pruning basic
+ tst/goals.scm view
@@ -0,0 +1,355 @@+(herald goals)++;;; Some authentication goals++;;; Unilateral authentication++(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))))++(defgoal unilateral+  (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 "Authentication goal"))++(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 (a b name) (n1 n2 text))+    (trace+     (recv (enc n1 a (pubk b)))+     (send (enc n1 n2 (pubk a)))+     (recv (enc n2 (pubk b)))))+  (comment "Needham-Schroeder"))++;;; Does initiator satisfy the unilateral authentication goal?++;;; Note that the goal requires translation of some of the role+;;; specific predicates.+(defgoal ns+  (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")+  (comment "Same as unilateral goal under the predicate mapping:")+  (comment (p "init" "n") "->" (p "init" "n1") "and")+  (comment (p "init" "a") "->" (p "init" "b") "and")+  (comment (p "resp" "a") "->" (p "resp" "b")))+  +;;; Does responder satisfy the unilateral authentication goal?++(defgoal ns+  (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")+  (comment "Same as unilateral goal under the predicate mapping:")+  (comment (p "init" 1) "->" (p "resp" 2) "and")+  (comment (p "init" "n") "->" (p "resp" "n2") "and")+  (comment (p "init" "a") "->" (p "resp" "a") "and")+  (comment (p "resp" 1) "->" (p "init" 2) "and")+  (comment (p "resp" "a") "->" (p "init" "a")))++(defgoal ns+  (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 "Double initiator authentication goal"))+  +(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 "Double responder authentication goal"))++;;; Old stuff++;;; The initiator point-of-view+(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 ((a b name) (n1 text) (no nu node))+	   (implies+	    (and (p "init" 2 no)+		 (p "init" "a" no a)+		 (p "init" "b" no b)+		 (p "init" "n1" no n1)+		 (p "init" 0 nu)+		 (str-prec nu no)+		 (non (privk a))+		 (non (privk b))+		 (uniq-at n1 nu))+	    (exists ((na nb node))+		    (and (p "init" 2 na)+			 (p "resp" 1 nb)+			 (p "init" "b" na b)+			 (p "resp" "b" nb b))))))+  (comment "Initiator point-of-view"))++(defgoal ns+  (forall ((a b name) (n1 text) (no nu node))+	  (implies+	   (and (p "init" 2 no)+		(p "init" "a" no a)+		(p "init" "b" no b)+		(p "init" "n1" no n1)+		(p "init" 0 nu)+		(str-prec nu no)+		(non (privk a))+		(non (privk b))+		(uniq-at n1 nu))+	   (exists ((na nb node))+		   (and (p "init" 2 na)+			(p "resp" 1 nb)+			(p "init" "b" na b)+			(p "resp" "b" nb b)))))+  (comment "Initiator point-of-view"))++;;; The responder point-of-view+(defskeleton ns+  (vars (a name) (n2 text))+  (defstrand resp 3 (a a) (n2 n2))+  (non-orig (privk a))+  (uniq-orig n2)+  (goals+  (forall ((n2 n1 text) (a b name) (z z-0 node))+    (implies+      (and (p "resp" 1 z) (p "resp" 2 z-0) (p "resp" "n2" z-0 n2)+        (p "resp" "n1" z-0 n1) (p "resp" "b" z-0 b) (p "resp" "a" z-0 a)+        (str-prec z z-0) (non (privk a)) (uniq-at n2 z))+      (exists ((b-0 name) (z-1 z-2 node))+        (and (p "init" 1 z-1) (p "init" 2 z-2) (p "init" "n1" z-2 n1)+          (p "init" "n2" z-2 n2) (p "init" "a" z-2 a)+          (p "init" "b" z-2 b-0) (prec z z-1) (prec z-2 z-0)+          (str-prec z-1 z-2))))))+  (comment "Responder point-of-view"))++;;; The responder point-of-view+(defskeleton ns+  (vars (a name) (n2 text))+  (defstrand resp 3 (a a) (n2 n2))+  (non-orig (privk a))+  (uniq-orig n2)+  (goals+   (forall ((n2 n1 text) (a b name) (z z-0 node))+    (implies+      (and (p "resp" 1 z) (p "resp" 2 z-0) (p "resp" "n2" z-0 n2)+        (p "resp" "n1" z-0 n1) (p "resp" "b" z-0 b) (p "resp" "a" z-0 a)+        (str-prec z z-0) (non (privk a)) (uniq-at n2 z))+      (exists ((b-0 name) (z-1 z-2 node))+        (and (p "init" 1 z-1) (p "init" 2 z-2) (p "init" "n1" z-2 n1)+          (p "init" "n2" z-2 n2) (p "init" "a" z-2 a)+          (p "init" "b" z-2 b-0) (prec z z-1) (prec z-2 z-0)+          (str-prec z-1 z-2))))))+  (comment "Responder point-of-view"))++;;; Double initiator point-of-view+(defskeleton ns+  (vars (a b name) (n1 n1-0 text))+  (defstrand init 3 (a a) (b b) (n1 n1))+  (defstrand init 3 (a a) (b b) (n1 n1-0))+  (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))+	   (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"))++;;; Needham-Schroeder Protocol with origination assumptions on roles+;;; This++(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))))++(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"))++;;; The responder point-of-view+(defskeleton nsl-typeless+  (vars (a b name) (n2 text))+  (defstrand resp 2 (a a) (n2 n2) (b b))+  (deflistener n2)+  (non-orig (privk a) (privk b))+  (uniq-orig n2)+  (comment "Shows typeflaw in typeless NSL"))
+ tst/goals.tst view
@@ -0,0 +1,1117 @@+(herald goals)++(comment "CPSA 2.5.0")+(comment "All input read from goals.scm")++(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))))++(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 "Authentication goal")+  (traces ((send (enc n (pubk a))) (recv n)))+  (label 0)+  (unrealized (0 1))+  (origs (n (0 0)))+  (comment "1 in cohort - 1 not yet seen"))++(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)))+  (traces ((send (enc n (pubk a))) (recv n))+    ((recv (enc n (pubk a))) (send n)))+  (label 1)+  (parent 0)+  (unrealized)+  (shape)+  (satisfies yes)+  (maps ((0) ((a a) (n n))))+  (origs (n (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 (a b name) (n1 n2 text))+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))+      (recv (enc n2 (pubk b)))))+  (comment "Needham-Schroeder"))++(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"))+  (traces ((send (enc n a-0 (pubk a))) (recv (enc n n2 (pubk a-0)))))+  (label 2)+  (unrealized (0 1))+  (origs (n (0 0)))+  (comment "1 in cohort - 1 not yet seen"))++(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 (n1 n) (n2 n2-0) (a a-0) (b 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 a-0 (pubk a)))+  (traces ((send (enc n a-0 (pubk a))) (recv (enc n n2 (pubk a-0))))+    ((recv (enc n a-0 (pubk a))) (send (enc n n2-0 (pubk a-0)))))+  (label 3)+  (parent 2)+  (unrealized)+  (shape)+  (satisfies yes)+  (maps ((0) ((a a) (n n) (a-0 a-0) (n2 n2))))+  (origs (n (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 (a b name) (n1 n2 text))+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))+      (recv (enc n2 (pubk b)))))+  (comment "Needham-Schroeder"))++(defskeleton ns+  (vars (n n1 text) (a b name))+  (defstrand resp 3 (n1 n1) (n2 n) (a a) (b b))+  (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"))+  (traces+    ((recv (enc n1 a (pubk b))) (send (enc n1 n (pubk a)))+      (recv (enc n (pubk b)))))+  (label 4)+  (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 (n1 n1) (n2 n) (a a) (b b))+  (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)))+  (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 5)+  (parent 4)+  (unrealized)+  (shape)+  (satisfies yes)+  (maps ((0) ((a a) (n n) (b b) (n1 n1))))+  (origs (n (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 (a b name) (n1 n2 text))+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))+      (recv (enc n2 (pubk b)))))+  (comment "Needham-Schroeder"))++(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 "Double initiator authentication goal")+  (traces ((send (enc n a (pubk b))) (recv (enc n n2 (pubk a)))))+  (label 6)+  (unrealized (0 1))+  (origs (n (0 0)))+  (comment "1 in cohort - 1 not yet seen"))++(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 (n1 n) (n2 n2-0) (a a) (b b))+  (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)))+  (traces ((send (enc n a (pubk b))) (recv (enc n n2 (pubk a))))+    ((recv (enc n a (pubk b))) (send (enc n n2-0 (pubk a)))))+  (label 7)+  (parent 6)+  (unrealized (0 1))+  (comment "1 in cohort - 1 not yet seen"))++(defskeleton ns+  (vars (n n2 text) (a b name))+  (defstrand init 2 (n1 n) (n2 n2) (a a) (b b))+  (defstrand resp 2 (n1 n) (n2 n2) (a a) (b b))+  (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)))+  (traces ((send (enc n a (pubk b))) (recv (enc n n2 (pubk a))))+    ((recv (enc n a (pubk b))) (send (enc n n2 (pubk a)))))+  (label 8)+  (parent 7)+  (unrealized)+  (shape)+  (satisfies yes yes)+  (maps ((0) ((a a) (b b) (n n) (n2 n2))))+  (origs (n (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 (a b name) (n1 n2 text))+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))+      (recv (enc n2 (pubk b)))))+  (comment "Needham-Schroeder"))++(defskeleton ns+  (vars (n n1 text) (a b name))+  (defstrand resp 3 (n1 n1) (n2 n) (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 "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 "Double responder authentication goal")+  (traces+    ((recv (enc n1 a (pubk b))) (send (enc n1 n (pubk a)))+      (recv (enc n (pubk b)))))+  (label 9)+  (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 (n1 n1) (n2 n) (a a) (b b))+  (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 10)+  (parent 9)+  (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 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 (a b name) (n1 n2 text))+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))+      (recv (enc n2 (pubk b)))))+  (comment "Needham-Schroeder"))++(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)+  (goals+    (forall ((a b name) (n1 text) (no nu node))+      (implies+        (and (p "init" 2 no) (p "init" "a" no a) (p "init" "b" no b)+          (p "init" "n1" no n1) (p "init" 0 nu) (str-prec nu no)+          (non (privk a)) (non (privk b)) (uniq-at n1 nu))+        (exists ((na nb node))+          (and (p "init" 2 na) (p "resp" 1 nb) (p "init" "b" na b)+            (p "resp" "b" nb b))))))+  (comment "Initiator point-of-view")+  (traces+    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))+      (send (enc n2 (pubk b)))))+  (label 11)+  (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 (n1 n1) (n2 n2-0) (a a) (b b))+  (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 12)+  (parent 11)+  (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 (n1 n1) (n2 n2) (a a) (b b))+  (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 13)+  (parent 12)+  (unrealized)+  (shape)+  (satisfies yes)+  (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 (a b name) (n1 n2 text))+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))+      (recv (enc n2 (pubk b)))))+  (comment "Needham-Schroeder"))++(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)+  (goals+    (forall ((a b name) (n1 text) (no nu node))+      (implies+        (and (p "init" 2 no) (p "init" "a" no a) (p "init" "b" no b)+          (p "init" "n1" no n1) (p "init" 0 nu) (str-prec nu no)+          (non (privk a)) (non (privk b)) (uniq-at n1 nu))+        (exists ((na nb node))+          (and (p "init" 2 na) (p "resp" 1 nb) (p "init" "b" na b)+            (p "resp" "b" nb b))))))+  (comment "Initiator point-of-view")+  (traces+    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))+      (send (enc n2 (pubk b)))))+  (label 14)+  (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 (n1 n1) (n2 n2-0) (a a) (b b))+  (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 15)+  (parent 14)+  (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 (n1 n1) (n2 n2) (a a) (b b))+  (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 16)+  (parent 15)+  (unrealized)+  (shape)+  (satisfies yes)+  (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 (a b name) (n1 n2 text))+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))+      (recv (enc n2 (pubk b)))))+  (comment "Needham-Schroeder"))++(defskeleton ns+  (vars (n2 n1 text) (a b name))+  (defstrand resp 3 (n1 n1) (n2 n2) (a a) (b b))+  (non-orig (privk a))+  (uniq-orig n2)+  (goals+    (forall ((n2 n1 text) (a b name) (z z-0 node))+      (implies+        (and (p "resp" 1 z) (p "resp" 2 z-0) (p "resp" "n2" z-0 n2)+          (p "resp" "n1" z-0 n1) (p "resp" "b" z-0 b)+          (p "resp" "a" z-0 a) (str-prec z z-0) (non (privk a))+          (uniq-at n2 z))+        (exists ((b-0 name) (z-1 z-2 node))+          (and (p "init" 1 z-1) (p "init" 2 z-2) (p "init" "n1" z-2 n1)+            (p "init" "n2" z-2 n2) (p "init" "a" z-2 a)+            (p "init" "b" z-2 b-0) (prec z z-1) (prec z-2 z-0)+            (str-prec z-1 z-2))))))+  (comment "Responder point-of-view")+  (traces+    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))+      (recv (enc n2 (pubk b)))))+  (label 17)+  (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 (n1 n1) (n2 n2) (a a) (b b))+  (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 18)+  (parent 17)+  (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 (a b name) (n1 n2 text))+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))+      (recv (enc n2 (pubk b)))))+  (comment "Needham-Schroeder"))++(defskeleton ns+  (vars (n2 n1 text) (a b name))+  (defstrand resp 3 (n1 n1) (n2 n2) (a a) (b b))+  (non-orig (privk a))+  (uniq-orig n2)+  (goals+    (forall ((n2 n1 text) (a b name) (z z-0 node))+      (implies+        (and (p "resp" 1 z) (p "resp" 2 z-0) (p "resp" "n2" z-0 n2)+          (p "resp" "n1" z-0 n1) (p "resp" "b" z-0 b)+          (p "resp" "a" z-0 a) (str-prec z z-0) (non (privk a))+          (uniq-at n2 z))+        (exists ((b-0 name) (z-1 z-2 node))+          (and (p "init" 1 z-1) (p "init" 2 z-2) (p "init" "n1" z-2 n1)+            (p "init" "n2" z-2 n2) (p "init" "a" z-2 a)+            (p "init" "b" z-2 b-0) (prec z z-1) (prec z-2 z-0)+            (str-prec z-1 z-2))))))+  (comment "Responder point-of-view")+  (traces+    ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))+      (recv (enc n2 (pubk b)))))+  (label 19)+  (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 (n1 n1) (n2 n2) (a a) (b b))+  (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 20)+  (parent 19)+  (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 (a b name) (n1 n2 text))+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))+      (recv (enc n2 (pubk b)))))+  (comment "Needham-Schroeder"))++(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)+  (goals+    (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")+  (traces+    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))+      (send (enc n2 (pubk b))))+    ((send (enc n1-0 a (pubk b))) (recv (enc n1-0 n2-0 (pubk a)))+      (send (enc n2-0 (pubk b)))))+  (label 21)+  (unrealized (0 1) (1 1))+  (origs (n1 (0 0)) (n1-0 (1 0)))+  (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))+  (non-orig (privk a) (privk b))+  (uniq-orig n1)+  (operation collapsed 1 0)+  (traces+    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))+      (send (enc n2 (pubk b)))))+  (label 22)+  (parent 21)+  (unrealized (0 1))+  (comment "1 in cohort - 1 not yet seen"))++(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 (n1 n1-0) (n2 n2-1) (a a) (b b))+  (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)))+  (traces+    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))+      (send (enc n2 (pubk b))))+    ((send (enc n1-0 a (pubk b))) (recv (enc n1-0 n2-0 (pubk a)))+      (send (enc n2-0 (pubk b))))+    ((recv (enc n1-0 a (pubk b))) (send (enc n1-0 n2-1 (pubk a)))))+  (label 23)+  (parent 21)+  (unrealized (0 1) (1 1))+  (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 (n1 n1) (n2 n2-0) (a a) (b b))+  (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 24)+  (parent 22)+  (unrealized (0 1))+  (origs (n1 (0 0)))+  (comment "1 in cohort - 1 not yet seen"))++(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 (n1 n1-0) (n2 n2-0) (a a) (b b))+  (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)))+  (traces+    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))+      (send (enc n2 (pubk b))))+    ((send (enc n1-0 a (pubk b))) (recv (enc n1-0 n2-0 (pubk a)))+      (send (enc n2-0 (pubk b))))+    ((recv (enc n1-0 a (pubk b))) (send (enc n1-0 n2-0 (pubk a)))))+  (label 25)+  (parent 23)+  (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 (n1 n1) (n2 n2) (a a) (b b))+  (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 26)+  (parent 24)+  (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))))++(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 (n1 n1-0) (n2 n2-0) (a a) (b b))+  (defstrand resp 2 (n1 n1) (n2 n2-1) (a a) (b b))+  (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)))+  (traces+    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))+      (send (enc n2 (pubk b))))+    ((send (enc n1-0 a (pubk b))) (recv (enc n1-0 n2-0 (pubk a)))+      (send (enc n2-0 (pubk b))))+    ((recv (enc n1-0 a (pubk b))) (send (enc n1-0 n2-0 (pubk a))))+    ((recv (enc n1 a (pubk b))) (send (enc n1 n2-1 (pubk a)))))+  (label 27)+  (parent 25)+  (unrealized (0 1))+  (comment "1 in cohort - 1 not yet seen"))++(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 (n1 n1-0) (n2 n2) (a a) (b b))+  (defstrand resp 2 (n1 n1) (n2 n2-0) (a a) (b b))+  (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)))+  (traces+    ((send (enc n1 a (pubk b))) (recv (enc n1 n2-0 (pubk a)))+      (send (enc n2-0 (pubk b))))+    ((send (enc n1-0 a (pubk b))) (recv (enc n1-0 n2 (pubk a)))+      (send (enc n2 (pubk b))))+    ((recv (enc n1-0 a (pubk b))) (send (enc n1-0 n2 (pubk a))))+    ((recv (enc n1 a (pubk b))) (send (enc n1 n2-0 (pubk a)))))+  (label 28)+  (parent 27)+  (unrealized)+  (shape)+  (satisfies+    (no (n1-0 n1) (n1 n1-0) (n2-0 n2-0) (n2 n2) (a a) (b b) (z-2 (0 0))+      (z-1 (0 2)) (z-0 (1 0)) (z (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))))++(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 29)+  (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 30)+  (parent 29)+  (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 31)+  (parent 30)+  (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 32)+  (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 33)+  (parent 32)+  (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 34)+  (parent 33)+  (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 35)+  (parent 33)+  (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 36)+  (parent 35)+  (seen 34)+  (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 37)+  (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 38)+  (parent 37)+  (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 39)+  (parent 38)+  (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 (a b name) (n1 n2 text))+    (trace (recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))+      (recv (enc n2 (pubk b)))))+  (comment "Needham-Schroeder"))++(defskeleton ns+  (vars (n1 n2 text) (a b name))+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))+  (defstrand resp 2 (n1 n1) (n2 n2) (a a) (b b))+  (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 40)+  (unrealized)+  (shape)+  (maps ((0 1) ((n1 n1) (n2 n2) (a a) (b b))))+  (origs (n1 (0 0))))++(comment "Nothing left to do")++(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"))++(defskeleton nsl-typeless+  (vars (n1 mesg) (n2 text) (a b name))+  (defstrand resp 2 (n1 n1) (n2 n2) (b b) (a a))+  (deflistener n2)+  (non-orig (privk a) (privk b))+  (uniq-orig n2)+  (comment "Shows typeflaw in typeless NSL")+  (traces ((recv (enc a n1 (pubk b))) (send (enc n1 n2 b (pubk a))))+    ((recv n2) (send n2)))+  (label 41)+  (unrealized (1 0))+  (preskeleton)+  (comment "Not a skeleton"))++(defskeleton nsl-typeless+  (vars (n1 mesg) (n2 text) (a b name))+  (defstrand resp 2 (n1 n1) (n2 n2) (b b) (a a))+  (deflistener n2)+  (precedes ((0 1) (1 0)))+  (non-orig (privk a) (privk b))+  (uniq-orig n2)+  (traces ((recv (enc a n1 (pubk b))) (send (enc n1 n2 b (pubk a))))+    ((recv n2) (send n2)))+  (label 42)+  (parent 41)+  (unrealized (1 0))+  (origs (n2 (0 1)))+  (comment "2 in cohort - 2 not yet seen"))++(defskeleton nsl-typeless+  (vars (n2 n1 text) (a b name))+  (defstrand resp 2 (n1 n1) (n2 n2) (b b) (a a))+  (deflistener n2)+  (defstrand init 3 (n2 n2) (n1 n1) (a a) (b b))+  (precedes ((0 1) (2 1)) ((2 2) (1 0)))+  (non-orig (privk a) (privk b))+  (uniq-orig n2)+  (operation nonce-test (added-strand init 3) n2 (1 0)+    (enc n1 n2 b (pubk a)))+  (traces ((recv (enc a n1 (pubk b))) (send (enc n1 n2 b (pubk a))))+    ((recv n2) (send n2))+    ((send (enc a n1 (pubk b))) (recv (enc n1 n2 b (pubk a)))+      (send (enc n2 (pubk b)))))+  (label 43)+  (parent 42)+  (unrealized (1 0))+  (comment "empty cohort"))++(defskeleton nsl-typeless+  (vars (n2 n2-0 text) (a b a-0 name))+  (defstrand resp 2 (n1 a-0) (n2 n2) (b b) (a a))+  (deflistener n2)+  (defstrand resp 2 (n1 (cat n2 b)) (n2 n2-0) (b a) (a a-0))+  (precedes ((0 1) (2 0)) ((2 1) (1 0)))+  (non-orig (privk a) (privk b))+  (uniq-orig n2)+  (operation nonce-test (added-strand resp 2) n2 (1 0)+    (enc a-0 n2 b (pubk a)))+  (traces ((recv (enc a a-0 (pubk b))) (send (enc a-0 n2 b (pubk a))))+    ((recv n2) (send n2))+    ((recv (enc a-0 n2 b (pubk a)))+      (send (enc (cat n2 b) n2-0 a (pubk a-0)))))+  (label 44)+  (parent 42)+  (unrealized)+  (shape)+  (maps ((0 1) ((a a) (b b) (n2 n2) (n1 a-0))))+  (origs (n2 (0 1))))++(comment "Nothing left to do")
tst/hashtest-key-hash.tst view
@@ -1,6 +1,6 @@ (herald "Hashtest") -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from hashtest-key-hash.scm")  (defprotocol hashtest basic
tst/hashtest.tst view
@@ -1,6 +1,6 @@ (herald "Hashtest") -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from hashtest.scm")  (defprotocol hashtest basic
tst/incompleteness_example.tst view
@@ -1,7 +1,7 @@ (herald incompleteness-example   (comment "Shows a shape not found by CPSA")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from incompleteness_example.scm")  (defprotocol incompleteness-example basic
tst/isoreject.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from isoreject.scm")  (defprotocol isoreject basic
tst/kelly1.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from kelly1.scm")  (defprotocol kelly1 basic
tst/kerberos.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from kerberos.scm")  (defprotocol kerberos basic
tst/mass.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from mass.lsp")  (defprotocol mass basic
tst/mass2.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from mass2.lsp")  (defprotocol mass2 basic
tst/missing_contraction.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from missing_contraction.scm")  (defprotocol missing-contraction basic
tst/neuman-stubblebine-reauth.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from neuman-stubblebine-reauth.lsp")  (defprotocol neuman-stubblebine-reauth basic
tst/neuman-stubblebine.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from neuman-stubblebine.scm")  (defprotocol neuman-stubblebine basic
tst/no_contraction.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from no_contraction.scm")  (defprotocol no-contraction basic
tst/non_transforming.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from non_transforming.scm")  (defprotocol non_transforming basic
tst/nonaug-prune.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from nonaug-prune.scm")  (defprotocol nonaug-prune basic
tst/ns-l.tst view
@@ -1,7 +1,7 @@ (herald "Needham-Schroeder-Low Public-Key Protocol"   (comment "With deflistener's")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from ns-l.scm")  (defprotocol ns basic
tst/ns.scm view
@@ -32,6 +32,15 @@   (uniq-orig n1 n1-0)   (comment "Double initiator point-of-view")) +;;; Double initiator point-of-view, same nonce+(defskeleton ns+  (vars (a b name) (n1 text))+  (defstrand init 3 (a a) (b b) (n1 n1))+  (defstrand init 3 (a a) (b b) (n1 n1))+  (non-orig (privk b) (privk a))+  (uniq-orig n1)+  (comment "Double initiator point-of-view, same nonce"))+ ;;; The responder point-of-view (defskeleton ns   (vars (a name) (n2 text))
tst/ns.tst view
@@ -1,6 +1,6 @@ (herald "Needham-Schroeder Public-Key Protocol Variants") -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from ns.scm")  (defprotocol ns basic@@ -253,6 +253,88 @@   (comment "Needham-Schroeder with no role origination assumptions"))  (defskeleton ns+  (vars (n1 n2 n2-0 text) (a b name))+  (defstrand init 3 (n1 n1) (n2 n2) (a a) (b b))+  (defstrand init 3 (n1 n1) (n2 n2-0) (a a) (b b))+  (non-orig (privk a) (privk b))+  (uniq-orig n1)+  (comment "Double initiator point-of-view, same nonce")+  (traces+    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))+      (send (enc n2 (pubk b))))+    ((send (enc n1 a (pubk b))) (recv (enc n1 n2-0 (pubk a)))+      (send (enc n2-0 (pubk b)))))+  (label 11)+  (unrealized)+  (preskeleton)+  (comment "Not a skeleton"))++(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)+  (traces+    ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))+      (send (enc n2 (pubk b)))))+  (label 12)+  (parent 11)+  (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 13)+  (parent 12)+  (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 14)+  (parent 13)+  (unrealized)+  (shape)+  (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 (n2 n1 text) (a b name))   (defstrand resp 3 (n2 n2) (n1 n1) (b b) (a a))   (non-orig (privk a))@@ -261,7 +343,7 @@   (traces     ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))       (recv (enc n2 (pubk b)))))-  (label 11)+  (label 15)   (unrealized (0 2))   (origs (n2 (0 1)))   (comment "1 in cohort - 1 not yet seen"))@@ -280,8 +362,8 @@       (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 12)-  (parent 11)+  (label 16)+  (parent 15)   (unrealized)   (shape)   (maps ((0) ((a a) (n2 n2) (b b) (n1 n1))))@@ -313,7 +395,7 @@   (traces     ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))       (send (enc n2 (pubk b)))))-  (label 13)+  (label 17)   (unrealized (0 1))   (origs (n1 (0 0)))   (comment "1 in cohort - 1 not yet seen"))@@ -331,8 +413,8 @@     ((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 14)-  (parent 13)+  (label 18)+  (parent 17)   (unrealized (0 1))   (comment "1 in cohort - 1 not yet seen")) @@ -349,8 +431,8 @@     ((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 15)-  (parent 14)+  (label 19)+  (parent 18)   (unrealized)   (shape)   (maps ((0) ((a a) (b b) (n1 n1) (n2 n2))))@@ -382,7 +464,7 @@   (traces     ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))       (recv (enc n2 (pubk b)))))-  (label 16)+  (label 20)   (unrealized (0 2))   (origs (n2 (0 1)))   (comment "1 in cohort - 1 not yet seen"))@@ -401,8 +483,8 @@       (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 17)-  (parent 16)+  (label 21)+  (parent 20)   (unrealized (0 0) (0 2))   (comment "2 in cohort - 2 not yet seen")) @@ -420,8 +502,8 @@       (recv (enc n2 (pubk b))))     ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a)))       (send (enc n2 (pubk b)))))-  (label 18)-  (parent 17)+  (label 22)+  (parent 21)   (unrealized)   (shape)   (maps ((0) ((b b) (a a) (n2 n2) (n1 n1))))@@ -443,8 +525,8 @@     ((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 19)-  (parent 17)+  (label 23)+  (parent 21)   (unrealized (0 0) (0 2))   (comment "1 in cohort - 1 not yet seen")) @@ -464,9 +546,9 @@     ((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 20)-  (parent 19)-  (seen 18)+  (label 24)+  (parent 23)+  (seen 22)   (unrealized)   (comment "1 in cohort - 0 not yet seen")) @@ -492,7 +574,7 @@   (traces     ((send (enc n1 n3 a (pubk b))) (recv (enc n1 n2 (pubk a)))       (send (enc n2 (pubk b)))))-  (label 21)+  (label 25)   (unrealized (0 1))   (origs (n1 (0 0)))   (comment "1 in cohort - 1 not yet seen"))@@ -510,8 +592,8 @@     ((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 22)-  (parent 21)+  (label 26)+  (parent 25)   (unrealized (0 1))   (comment "1 in cohort - 1 not yet seen")) @@ -528,8 +610,8 @@     ((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 23)-  (parent 22)+  (label 27)+  (parent 26)   (unrealized)   (shape)   (maps ((0) ((a a) (b b) (n1 n3) (n2 n2) (n3 n3))))@@ -559,7 +641,7 @@     ((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 24)+  (label 28)   (unrealized)   (shape)   (maps ((0 1) ((n1 n1) (n2 n2) (a a) (b b))))@@ -587,7 +669,7 @@   (comment "Shows typeflaw in typeless NSL")   (traces ((recv (enc a n1 (pubk b))) (send (enc n1 n2 b (pubk a))))     ((recv n2) (send n2)))-  (label 25)+  (label 29)   (unrealized (1 0))   (preskeleton)   (comment "Not a skeleton"))@@ -601,8 +683,8 @@   (uniq-orig n2)   (traces ((recv (enc a n1 (pubk b))) (send (enc n1 n2 b (pubk a))))     ((recv n2) (send n2)))-  (label 26)-  (parent 25)+  (label 30)+  (parent 29)   (unrealized (1 0))   (origs (n2 (0 1)))   (comment "2 in cohort - 2 not yet seen"))@@ -621,8 +703,8 @@     ((recv n2) (send n2))     ((send (enc a n1 (pubk b))) (recv (enc n1 n2 b (pubk a)))       (send (enc n2 (pubk b)))))-  (label 27)-  (parent 26)+  (label 31)+  (parent 30)   (unrealized (1 0))   (comment "empty cohort")) @@ -640,8 +722,8 @@     ((recv n2) (send n2))     ((recv (enc a-0 n2 b (pubk a)))       (send (enc (cat n2 b) n2-0 a (pubk a-0)))))-  (label 28)-  (parent 26)+  (label 32)+  (parent 30)   (unrealized)   (shape)   (maps ((0 1) ((a a) (b b) (n2 n2) (n1 a-0))))
tst/nsl3.tst view
@@ -1,6 +1,6 @@ (herald "Three Party Needham-Schroeder-Lowe Protocol") -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from nsl3.scm")  (defprotocol nsl3 basic
tst/nsl4cm1.tst view

file too large to diff

tst/nslsk.tst view
@@ -1,6 +1,6 @@ (herald "Needham-Schroeder-Lowe Protocol with symmetric encryption") -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from nslsk.scm")  (defprotocol nslsk basic
tst/or.tst view
@@ -1,7 +1,7 @@ (herald "Otway-Rees Protocol"   (comment "Standard version using variables of sort mesg")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from or.scm")  (defprotocol or basic
tst/pca.tst view
@@ -1,7 +1,7 @@ (herald "Privacy Certificate Authority" (bound 15)   (comment "Generation of an Attestation Identity Certificate")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from pca.scm") (comment "Strand count bounded at 15")
tst/pen-non-orig-test.tst view
@@ -1,6 +1,6 @@ (herald "pen-non-orig test") -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from pen-non-orig-test.scm")  (defprotocol pennonorigtest basic
tst/pkinit.tst view
@@ -1,6 +1,6 @@ (herald "Kerberos PK init") -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from pkinit.scm")  (defprotocol pkinit basic
tst/preprocess.tst view
@@ -1,6 +1,6 @@ (herald "Pre-processing test example: modified NS with two responders") -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from preprocess.scm")  (defprotocol ns basic
tst/print.tst view
@@ -1,7 +1,7 @@ (herald "Print Test"   (comment "See if read forms look like printed ones")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from print.scm")  (defprotocol print-test basic
tst/pruning1.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from pruning1.scm")  (defprotocol prune basic
tst/sigenc.tst view
@@ -1,7 +1,7 @@ (herald "Signed Encrypted Message Example"   (comment "Shows examples of key usage of asymmetric keys")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from sigenc.scm")  (defprotocol mult-keys-sig-enc basic
tst/sorted_epmo_acctnum.tst view
@@ -4,7 +4,7 @@     "This version uses sorts to avoid confusion"     "between a nonce and other data")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from sorted_epmo_acctnum.scm") (comment "Strand count bounded at 12")
tst/targetterms2.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from targetterms2.scm")  (defprotocol targetterms2 basic
tst/targetterms6.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from targetterms6.scm")  (defprotocol targetterms6 basic
tst/targetterms8.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from targetterms8.scm")  (defprotocol targetterms8 basic
tst/timestamping.tst view
@@ -1,6 +1,6 @@ (herald timestamping-service) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from timestamping.scm")  (defprotocol timestamping-service basic
tst/uncarried_keys.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from uncarried_keys.scm")  (defprotocol uncarried-keys basic
+ tst/unilateral.scm view
@@ -0,0 +1,92 @@+(herald unilateral)++(defprotocol unilateral basic+  (defrole init+     (vars (n text) (k akey))+     (trace+      (send (enc n k))+      (recv n))+     (uniq-orig n))+  (defrole resp+     (vars (n text) (k akey))+     (trace+      (recv (enc n k))+      (send n))))++(defskeleton unilateral+   (vars (k akey))+   (defstrand init 2 (k k))+   (non-orig (invk k)))++(defskeleton unilateral+   (vars (n text) (k akey))+   (defstrand resp 2 (n n) (k k))+   (pen-non-orig n)+   (non-orig (invk k)))++;;; The same two problems posed using security goals.  The goals were+;;; taken from the output of cpsasas.++(defgoal unilateral+  (forall ((n text) (k akey) (z z-0 node))+    (implies+      (and (p "init" 0 z) (p "init" 1 z-0) (p "init" "n" z-0 n)+        (p "init" "k" z-0 k) (str-prec z z-0) (non (invk k))+        (uniq-at n z))+      (exists ((z-1 z-2 node))+        (and (p "resp" 0 z-1) (p "resp" 1 z-2) (p "resp" "n" z-2 n)+          (p "resp" "k" z-2 k) (prec z z-1) (prec z-2 z-0)+          (str-prec z-1 z-2))))))++(defgoal unilateral+  (forall ((n text) (k akey) (z node))+    (implies+      (and (p "resp" 1 z) (p "resp" "n" z n) (p "resp" "k" z k)+        (non (invk k)) (pnon n))+      (exists ((k-0 akey) (z-0 z-1 node))+        (and (p "resp" 0 z-0) (p "init" 0 z-1) (p "init" "n" z-1 n)+          (p "init" "k" z-1 k-0) (prec z-1 z-0) (str-prec z-0 z)+          (uniq-at n z-1))))))++;;; Unilateral authentication from ISO/IEC JTC 1/SC 27/WG 2 N1050++(defprotocol iso-unilateral basic+  (defrole resp+    (vars (na nb t1 t2 t3 text) (b name))+    (trace+     (recv (cat nb t1))+     (send (cat na nb b t3 (enc na nb b t2 (privk b)))))+    (uniq-orig na))+  (defrole init+    (vars (na nb t1 t2 t3 text) (b name))+    (trace+     (send (cat nb t1))+     (recv (cat na nb b t3 (enc na nb b t2 (privk b)))))+    (uniq-orig nb))+  (comment "Two pass authentication"))++(defskeleton iso-unilateral+  (vars (b name))+  (defstrand init 2 (b b))+  (non-orig (privk b)))++;;; Same as above, but also checking to see if there was agreement.+(defgoal iso-unilateral+  (forall ((b name) (z node))+    (implies+     (and (p "init" 1 z)+	  (p "init" "b" z b)+	  (non (privk b)))+      (exists ((y node))+	      (and (p "resp" 1 y)+		   (p "resp" "b" y b))))))++;;; Silly example.  Of course the shape produced does not satisfy this+;;; goal!+(defgoal iso-unilateral+  (forall ((b name) (z node))+    (implies+     (and (p "init" 1 z)+	  (p "init" "b" z b)+	  (non (privk b)))+     (false))))
+ tst/unilateral.tst view
@@ -0,0 +1,336 @@+(herald unilateral)++(comment "CPSA 2.5.0")+(comment "All input read from unilateral.scm")++(defprotocol unilateral basic+  (defrole init+    (vars (n text) (k akey))+    (trace (send (enc n k)) (recv n))+    (uniq-orig n))+  (defrole resp+    (vars (n text) (k akey))+    (trace (recv (enc n k)) (send n))))++(defskeleton unilateral+  (vars (n text) (k akey))+  (defstrand init 2 (n n) (k k))+  (non-orig (invk k))+  (uniq-orig n)+  (traces ((send (enc n k)) (recv n)))+  (label 0)+  (unrealized (0 1))+  (origs (n (0 0)))+  (comment "1 in cohort - 1 not yet seen"))++(defskeleton unilateral+  (vars (n text) (k akey))+  (defstrand init 2 (n n) (k k))+  (defstrand resp 2 (n n) (k k))+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))+  (non-orig (invk k))+  (uniq-orig n)+  (operation nonce-test (added-strand resp 2) n (0 1) (enc n k))+  (traces ((send (enc n k)) (recv n)) ((recv (enc n k)) (send n)))+  (label 1)+  (parent 0)+  (unrealized)+  (shape)+  (maps ((0) ((k k) (n n))))+  (origs (n (0 0))))++(comment "Nothing left to do")++(defprotocol unilateral basic+  (defrole init+    (vars (n text) (k akey))+    (trace (send (enc n k)) (recv n))+    (uniq-orig n))+  (defrole resp+    (vars (n text) (k akey))+    (trace (recv (enc n k)) (send n))))++(defskeleton unilateral+  (vars (n text) (k akey))+  (defstrand resp 2 (n n) (k k))+  (non-orig (invk k))+  (pen-non-orig n)+  (traces ((recv (enc n k)) (send n)))+  (label 2)+  (unrealized (0 0))+  (origs)+  (comment "1 in cohort - 1 not yet seen"))++(defskeleton unilateral+  (vars (n text) (k k-0 akey))+  (defstrand resp 2 (n n) (k k))+  (defstrand init 1 (n n) (k k-0))+  (precedes ((1 0) (0 0)))+  (non-orig (invk k))+  (pen-non-orig n)+  (uniq-orig n)+  (operation nonce-test (added-strand init 1) n (0 0))+  (traces ((recv (enc n k)) (send n)) ((send (enc n k-0))))+  (label 3)+  (parent 2)+  (unrealized)+  (shape)+  (maps ((0) ((n n) (k k))))+  (origs (n (1 0))))++(comment "Nothing left to do")++(defprotocol unilateral basic+  (defrole init+    (vars (n text) (k akey))+    (trace (send (enc n k)) (recv n))+    (uniq-orig n))+  (defrole resp+    (vars (n text) (k akey))+    (trace (recv (enc n k)) (send n))))++(defskeleton unilateral+  (vars (n text) (k akey))+  (defstrand init 2 (n n) (k k))+  (non-orig (invk k))+  (uniq-orig n)+  (goals+    (forall ((n text) (k akey) (z z-0 node))+      (implies+        (and (p "init" 0 z) (p "init" 1 z-0) (p "init" "n" z-0 n)+          (p "init" "k" z-0 k) (str-prec z z-0) (non (invk k))+          (uniq-at n z))+        (exists ((z-1 z-2 node))+          (and (p "resp" 0 z-1) (p "resp" 1 z-2) (p "resp" "n" z-2 n)+            (p "resp" "k" z-2 k) (prec z z-1) (prec z-2 z-0)+            (str-prec z-1 z-2))))))+  (traces ((send (enc n k)) (recv n)))+  (label 4)+  (unrealized (0 1))+  (origs (n (0 0)))+  (comment "1 in cohort - 1 not yet seen"))++(defskeleton unilateral+  (vars (n text) (k akey))+  (defstrand init 2 (n n) (k k))+  (defstrand resp 2 (n n) (k k))+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))+  (non-orig (invk k))+  (uniq-orig n)+  (operation nonce-test (added-strand resp 2) n (0 1) (enc n k))+  (traces ((send (enc n k)) (recv n)) ((recv (enc n k)) (send n)))+  (label 5)+  (parent 4)+  (unrealized)+  (shape)+  (satisfies yes)+  (maps ((0) ((n n) (k k))))+  (origs (n (0 0))))++(comment "Nothing left to do")++(defprotocol unilateral basic+  (defrole init+    (vars (n text) (k akey))+    (trace (send (enc n k)) (recv n))+    (uniq-orig n))+  (defrole resp+    (vars (n text) (k akey))+    (trace (recv (enc n k)) (send n))))++(defskeleton unilateral+  (vars (n text) (k akey))+  (defstrand resp 2 (n n) (k k))+  (non-orig (invk k))+  (pen-non-orig n)+  (goals+    (forall ((n text) (k akey) (z node))+      (implies+        (and (p "resp" 1 z) (p "resp" "n" z n) (p "resp" "k" z k)+          (non (invk k)) (pnon n))+        (exists ((k-0 akey) (z-0 z-1 node))+          (and (p "resp" 0 z-0) (p "init" 0 z-1) (p "init" "n" z-1 n)+            (p "init" "k" z-1 k-0) (prec z-1 z-0) (str-prec z-0 z)+            (uniq-at n z-1))))))+  (traces ((recv (enc n k)) (send n)))+  (label 6)+  (unrealized (0 0))+  (origs)+  (comment "1 in cohort - 1 not yet seen"))++(defskeleton unilateral+  (vars (n text) (k k-0 akey))+  (defstrand resp 2 (n n) (k k))+  (defstrand init 1 (n n) (k k-0))+  (precedes ((1 0) (0 0)))+  (non-orig (invk k))+  (pen-non-orig n)+  (uniq-orig n)+  (operation nonce-test (added-strand init 1) n (0 0))+  (traces ((recv (enc n k)) (send n)) ((send (enc n k-0))))+  (label 7)+  (parent 6)+  (unrealized)+  (shape)+  (satisfies yes)+  (maps ((0) ((n n) (k k))))+  (origs (n (1 0))))++(comment "Nothing left to do")++(defprotocol iso-unilateral basic+  (defrole resp+    (vars (na nb t1 t2 t3 text) (b name))+    (trace (recv (cat nb t1))+      (send (cat na nb b t3 (enc na nb b t2 (privk b)))))+    (uniq-orig na))+  (defrole init+    (vars (na nb t1 t2 t3 text) (b name))+    (trace (send (cat nb t1))+      (recv (cat na nb b t3 (enc na nb b t2 (privk b)))))+    (uniq-orig nb))+  (comment "Two pass authentication"))++(defskeleton iso-unilateral+  (vars (na nb t1 t2 t3 text) (b name))+  (defstrand init 2 (na na) (nb nb) (t1 t1) (t2 t2) (t3 t3) (b b))+  (non-orig (privk b))+  (uniq-orig nb)+  (traces+    ((send (cat nb t1))+      (recv (cat na nb b t3 (enc na nb b t2 (privk b))))))+  (label 8)+  (unrealized (0 1))+  (origs (nb (0 0)))+  (comment "1 in cohort - 1 not yet seen"))++(defskeleton iso-unilateral+  (vars (na nb t1 t2 t3 t1-0 t3-0 text) (b name))+  (defstrand init 2 (na na) (nb nb) (t1 t1) (t2 t2) (t3 t3) (b b))+  (defstrand resp 2 (na na) (nb nb) (t1 t1-0) (t2 t2) (t3 t3-0) (b b))+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))+  (non-orig (privk b))+  (uniq-orig na nb)+  (operation encryption-test (added-strand resp 2)+    (enc na nb b t2 (privk b)) (0 1))+  (traces+    ((send (cat nb t1))+      (recv (cat na nb b t3 (enc na nb b t2 (privk b)))))+    ((recv (cat nb t1-0))+      (send (cat na nb b t3-0 (enc na nb b t2 (privk b))))))+  (label 9)+  (parent 8)+  (unrealized)+  (shape)+  (maps ((0) ((b b) (na na) (nb nb) (t1 t1) (t2 t2) (t3 t3))))+  (origs (na (1 1)) (nb (0 0))))++(comment "Nothing left to do")++(defprotocol iso-unilateral basic+  (defrole resp+    (vars (na nb t1 t2 t3 text) (b name))+    (trace (recv (cat nb t1))+      (send (cat na nb b t3 (enc na nb b t2 (privk b)))))+    (uniq-orig na))+  (defrole init+    (vars (na nb t1 t2 t3 text) (b name))+    (trace (send (cat nb t1))+      (recv (cat na nb b t3 (enc na nb b t2 (privk b)))))+    (uniq-orig nb))+  (comment "Two pass authentication"))++(defskeleton iso-unilateral+  (vars (na nb t1 t2 t3 text) (b name))+  (defstrand init 2 (na na) (nb nb) (t1 t1) (t2 t2) (t3 t3) (b b))+  (non-orig (privk b))+  (uniq-orig nb)+  (goals+    (forall ((b name) (z node))+      (implies (and (p "init" 1 z) (p "init" "b" z b) (non (privk b)))+        (exists ((y node)) (and (p "resp" 1 y) (p "resp" "b" y b))))))+  (traces+    ((send (cat nb t1))+      (recv (cat na nb b t3 (enc na nb b t2 (privk b))))))+  (label 10)+  (unrealized (0 1))+  (origs (nb (0 0)))+  (comment "1 in cohort - 1 not yet seen"))++(defskeleton iso-unilateral+  (vars (na nb t1 t2 t3 t1-0 t3-0 text) (b name))+  (defstrand init 2 (na na) (nb nb) (t1 t1) (t2 t2) (t3 t3) (b b))+  (defstrand resp 2 (na na) (nb nb) (t1 t1-0) (t2 t2) (t3 t3-0) (b b))+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))+  (non-orig (privk b))+  (uniq-orig na nb)+  (operation encryption-test (added-strand resp 2)+    (enc na nb b t2 (privk b)) (0 1))+  (traces+    ((send (cat nb t1))+      (recv (cat na nb b t3 (enc na nb b t2 (privk b)))))+    ((recv (cat nb t1-0))+      (send (cat na nb b t3-0 (enc na nb b t2 (privk b))))))+  (label 11)+  (parent 10)+  (unrealized)+  (shape)+  (satisfies yes)+  (maps ((0) ((b b) (na na) (nb nb) (t1 t1) (t2 t2) (t3 t3))))+  (origs (na (1 1)) (nb (0 0))))++(comment "Nothing left to do")++(defprotocol iso-unilateral basic+  (defrole resp+    (vars (na nb t1 t2 t3 text) (b name))+    (trace (recv (cat nb t1))+      (send (cat na nb b t3 (enc na nb b t2 (privk b)))))+    (uniq-orig na))+  (defrole init+    (vars (na nb t1 t2 t3 text) (b name))+    (trace (send (cat nb t1))+      (recv (cat na nb b t3 (enc na nb b t2 (privk b)))))+    (uniq-orig nb))+  (comment "Two pass authentication"))++(defskeleton iso-unilateral+  (vars (na nb t1 t2 t3 text) (b name))+  (defstrand init 2 (na na) (nb nb) (t1 t1) (t2 t2) (t3 t3) (b b))+  (non-orig (privk b))+  (uniq-orig nb)+  (goals+    (forall ((b name) (z node))+      (implies (and (p "init" 1 z) (p "init" "b" z b) (non (privk b)))+        (false))))+  (traces+    ((send (cat nb t1))+      (recv (cat na nb b t3 (enc na nb b t2 (privk b))))))+  (label 12)+  (unrealized (0 1))+  (origs (nb (0 0)))+  (comment "1 in cohort - 1 not yet seen"))++(defskeleton iso-unilateral+  (vars (na nb t1 t2 t3 t1-0 t3-0 text) (b name))+  (defstrand init 2 (na na) (nb nb) (t1 t1) (t2 t2) (t3 t3) (b b))+  (defstrand resp 2 (na na) (nb nb) (t1 t1-0) (t2 t2) (t3 t3-0) (b b))+  (precedes ((0 0) (1 0)) ((1 1) (0 1)))+  (non-orig (privk b))+  (uniq-orig na nb)+  (operation encryption-test (added-strand resp 2)+    (enc na nb b t2 (privk b)) (0 1))+  (traces+    ((send (cat nb t1))+      (recv (cat na nb b t3 (enc na nb b t2 (privk b)))))+    ((recv (cat nb t1-0))+      (send (cat na nb b t3-0 (enc na nb b t2 (privk b))))))+  (label 13)+  (parent 12)+  (unrealized)+  (shape)+  (satisfies (no (b b) (z (0 1))))+  (maps ((0) ((b b) (na na) (nb nb) (t1 t1) (t2 t2) (t3 t3))))+  (origs (na (1 1)) (nb (0 0))))++(comment "Nothing left to do")
tst/uo.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from uo.scm")  (defprotocol uniq-orig basic
tst/wang-hash.tst view
@@ -1,6 +1,6 @@ (herald "Wang's Fair Exchange Protocol" (bound 10)) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from wang-hash.scm") (comment "Strand count bounded at 10")
tst/wang-key-hash.tst view
@@ -1,6 +1,6 @@ (herald "Wang's Fair Exchange Protocol" (bound 10)) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from wang-key-hash.scm") (comment "Strand count bounded at 10")
tst/weird.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from weird.scm")  (defprotocol weird basic
tst/wide-mouth-frog-scyther.tst view
@@ -1,7 +1,7 @@ (herald "Wide-Mouth Frog Protocol from Scyther"   (comment "This protocol has an infinite number of shapes")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from wide-mouth-frog-scyther.lsp")  (defprotocol wide-mouth-frog basic
tst/wide-mouth-frog.tst view
@@ -1,7 +1,7 @@ (herald "Wide-Mouth Frog Protocol"   (comment "This protocol has an infinite number of shapes")) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from wide-mouth-frog.lsp")  (defprotocol wide-mouth-frog basic
tst/wonthull.tst view
@@ -1,6 +1,6 @@ (herald wonthull (bound 9)) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from wonthull.scm") (comment "Strand count bounded at 9")
tst/wonthull2.tst view
@@ -1,6 +1,6 @@ (herald wonthull2 (bound 9)) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from wonthull2.scm") (comment "Strand count bounded at 9")
tst/wonthull3.tst view
@@ -1,4 +1,4 @@-(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from wonthull3.scm")  (defprotocol wonthull3 basic
tst/woolam.tst view
@@ -1,6 +1,6 @@ (herald "Woo-Lam Protocol") -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from woolam.scm")  (defprotocol woolam basic
tst/yahalom-6.3.6.tst view
@@ -5,7 +5,7 @@   (url "http://www.eecs.umich.edu/acal/swerve/docs/49-1.pdf")   (bound 15)) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from yahalom-6.3.6.scm") (comment "Strand count bounded at 15")
tst/yahalom.tst view
@@ -1,6 +1,6 @@ (herald "Yahalom Protocol Without Forwarding" (bound 15)) -(comment "CPSA 2.4.0")+(comment "CPSA 2.5.0") (comment "All input read from yahalom.scm") (comment "Strand count bounded at 15")