diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,29 @@ +2010-09-10 John D. Ramsdell + + * cpsa.cabal (Version): Tagged as version 2.1.1. + + * src/CPSA/Graph/Tree.hs (assemble): To handle incomplete outputs, + assemble ignores unavailable seen children instead of signaling an + error. + +2010-08-24 John D. Ramsdell + + * src/CPSA/Lib/Strand.hs (augCollapses): Pruning is now performed + only after augmentation, and only when the augmented strand is + involved. + +2010-08-12 John D. Ramsdell + + * src/CPSA/Graph/LaTeXView.hs (matrix): When drawing a skeleton, + communication edges between nodes with different messages is shown + with a dotted arrow as is already done for SVG diagrams. + +2010-08-09 John D. Ramsdell + + * src/CPSA/Lib/Notation.hs: Added an infix notation for XHTML and + LaTeX output. Enable by specifying the -i flag when invoking + cpsagraph or cpsapp. + 2010-07-29 John D. Ramsdell * cpsa.cabal (Version): Tagged as version 2.1.0. diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,5 +1,22 @@ CPSA NEWS -- history of user-visible changes. +* Changes in version 2.1.1 + +* Graph program handles incomplete output +The graph program no longer requires that every seen child mentioned +in the output is in it. Therefore, the program can handle output from +some interrupted runs. + +* Pruning restriction +We found examples in which pruning prevented us from finding some +shapes. Pruning is now performed only after augmentation, and only +when the augmented strand is involved. + +* Compact output notation +There is a new infix notation for XHTML and LaTeX output that is more +compact, and hopefully more readable for large problems. Enable it by +specifying the -i flag when invoking cpsagraph or cpsapp. + * Changes in version 2.1.0 ** Initial comments displayed diff --git a/cpsa.cabal b/cpsa.cabal --- a/cpsa.cabal +++ b/cpsa.cabal @@ -1,5 +1,5 @@ Name: cpsa -Version: 2.1.0 +Version: 2.1.1 Maintainer: ramsdell@mitre.org Cabal-Version: >= 1.6 License: BSD3 @@ -21,8 +21,8 @@ . We are working towards a version of CPSA with the property that whenever it successfully terminates, every possible execution is - described by its output. However, the current implementation - occasionally fails to find some executions. + described by its output. A proof of this correctness property is + also in development. . The package contains a set of programs used to perform and display the analysis. Program documentation is in the doc directory in the @@ -35,8 +35,8 @@ . The theory and algorithm used by CPSA was developed with the help of Joshua D. Guttman, John D. Ramsdell, Jon C. Herzog, Shaddin - F. Doghmi, F. Javier Thayer, and Paul D. Rowe. John D. Ramsdell - implemented the algorithm in Haskell. + F. Doghmi, F. Javier Thayer, Paul D. Rowe, and Moses Liskov. + John D. Ramsdell implemented the algorithm in Haskell. Category: Cryptography Build-Type: Simple Data-Files: @@ -44,8 +44,8 @@ cpsaoverview.pdf ffgg.scm ns.scm or.scm woolam.scm yahalom.scm Data-Dir: doc Extra-Source-Files: - Makefile ChangeLog README NEWS ghci cpsatst doc/README doc/Makefile - doc/macros.tex doc/cpsaprimer.tex doc/bcasyntax.tex + Makefile ChangeLog README NEWS ghci cpsatst setup.bat doc/README + doc/Makefile doc/macros.tex doc/cpsaprimer.tex doc/bcasyntax.tex doc/cpsatheory.tex 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/cpsa.bib @@ -74,13 +74,16 @@ tst/nsl4resp2.lisp tst/nsl5i.lisp tst/nsl5.lisp tst/nslsk.scm tst/nslsk.tst tst/ns.scm tst/ns.tst tst/or.scm tst/or.tst tst/pca.lsp tst/pca.tst tst/pruning1.scm tst/pruning1.tst - tst/sigenc.scm tst/sigenc.tst tst/sorted_epmo_acctnum.scm + tst/sigenc.scm tst/sigenc.tst tst/sorted_epmo_acctnum.lsp tst/sorted_epmo_acctnum.tst tst/targetterms2.scm tst/targetterms2.tst tst/targetterms6.scm tst/targetterms6.tst tst/tnsl5.lisp tst/uncarried_keys.scm tst/uncarried_keys.tst tst/uo.scm tst/uo.tst tst/updatetst tst/weird.scm tst/weird.tst tst/wmf.lsp tst/wmf.tst tst/woolam.scm tst/woolam.tst - tst/yahalom.scm tst/yahalom.tst + tst/yahalom.scm tst/yahalom.tst tst/crushing.tst tst/crushing.tst + tst/fragile_pruning.scm tst/fragile_pruning.tst tst/nonaug-prune.scm + tst/nonaug-prune.tst tst/wonthull.scm tst/wonthull.tst + tst/yahalom-6.3.6.scm tst/yahalom-6.3.6.tst -- Disable with -f-par option during configuration. @@ -100,8 +103,8 @@ Hs-Source-Dirs: src Other-Modules: Paths_cpsa CPSA.Lib.Vector CPSA.Lib.Utilities CPSA.Lib.Pretty - CPSA.Lib.SExpr CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra - CPSA.Lib.Protocol CPSA.Lib.Strand CPSA.Lib.Loader + 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.Basic.Algebra CPSA.DiffieHellman.Algebra CPSA.DiffieHellman.IntLinEq @@ -118,12 +121,13 @@ Hs-Source-Dirs: src Other-Modules: Paths_cpsa CPSA.Lib.Utilities CPSA.Lib.Pretty CPSA.Lib.SExpr - CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.Lib.Protocol - CPSA.Lib.Strand CPSA.Lib.Loader CPSA.Lib.Displayer CPSA.Lib.Cohort - CPSA.Lib.CPSA CPSA.Graph.XMLOutput CPSA.Graph.Config - CPSA.Graph.SVG CPSA.Graph.Loader CPSA.Graph.Preskeleton - CPSA.Graph.Layout CPSA.Graph.Tree CPSA.Graph.CompactView - CPSA.Graph.ExpandedView CPSA.Graph.LaTeXView + 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.CPSA + CPSA.Graph.XMLOutput CPSA.Graph.Config CPSA.Graph.SVG + CPSA.Graph.Loader CPSA.Graph.Preskeleton CPSA.Graph.Layout + CPSA.Graph.Tree CPSA.Graph.CompactView CPSA.Graph.ExpandedView + CPSA.Graph.LaTeXView Executable cpsashapes Main-Is: CPSA/Shapes/Main.hs @@ -133,9 +137,10 @@ Hs-Source-Dirs: src Other-Modules: Paths_cpsa CPSA.Lib.Utilities CPSA.Lib.Pretty CPSA.Lib.SExpr - CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.Lib.Protocol - CPSA.Lib.Strand CPSA.Lib.Loader CPSA.Lib.Displayer CPSA.Lib.Cohort - CPSA.Lib.CPSA CPSA.Shapes.Shapes + 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.CPSA + CPSA.Shapes.Shapes Executable cpsaannotations Main-Is: CPSA/Annotations/Main.hs @@ -145,11 +150,12 @@ Hs-Source-Dirs: src Other-Modules: Paths_cpsa CPSA.Lib.Utilities CPSA.Lib.Pretty CPSA.Lib.SExpr - CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.Lib.Protocol - CPSA.Lib.Strand CPSA.Lib.Loader CPSA.Lib.Displayer CPSA.Lib.Cohort - CPSA.Lib.CPSA CPSA.Annotations.Formulas - CPSA.Annotations.Annotations CPSA.Basic.Algebra - CPSA.DiffieHellman.Algebra CPSA.DiffieHellman.IntLinEq + 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.CPSA + CPSA.Annotations.Formulas CPSA.Annotations.Annotations + CPSA.Basic.Algebra CPSA.DiffieHellman.Algebra + CPSA.DiffieHellman.IntLinEq Executable cpsaparameters Main-Is: CPSA/Parameters/Main.hs @@ -159,9 +165,10 @@ Hs-Source-Dirs: src Other-Modules: Paths_cpsa CPSA.Lib.Utilities CPSA.Lib.Pretty CPSA.Lib.SExpr - CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.Lib.Protocol - CPSA.Lib.Strand CPSA.Lib.Loader CPSA.Lib.Displayer CPSA.Lib.Cohort - CPSA.Lib.CPSA CPSA.Parameters.Flow + 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.CPSA + CPSA.Parameters.Flow Executable cpsapp Main-Is: CPSA/Pretty/Main.hs @@ -171,6 +178,6 @@ Hs-Source-Dirs: src Other-Modules: Paths_cpsa CPSA.Lib.Utilities CPSA.Lib.Pretty CPSA.Lib.SExpr - CPSA.Lib.Printer CPSA.Lib.Entry CPSA.Lib.Algebra CPSA.Lib.Protocol - CPSA.Lib.Strand CPSA.Lib.Loader CPSA.Lib.Displayer CPSA.Lib.Cohort - CPSA.Lib.CPSA + 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.CPSA diff --git a/doc/bcasyntax.tex b/doc/bcasyntax.tex --- a/doc/bcasyntax.tex +++ b/doc/bcasyntax.tex @@ -73,7 +73,7 @@ encode characters. Every list is proper. An S-expression atom is either a \textsc{symbol}, an \textsc{integer}, or a \textsc{string}. The characters that make up a symbol are the letters, the digits, and -the special characters in ``\verb|-*/<;=>;!?:$%_&~^+|''. A symbol may +the special characters in ``\verb|-*/<=>!?:$%_&~^+|''. A symbol may not begin with a digit or a sign followed by a digit. The characters that make up a string are the \textsc{ascii} printing characters omitting double quote and backslash. Double quotes delimit a string. diff --git a/doc/cpsadesign.pdf b/doc/cpsadesign.pdf Binary files a/doc/cpsadesign.pdf and b/doc/cpsadesign.pdf differ diff --git a/doc/cpsaoverview.pdf b/doc/cpsaoverview.pdf Binary files a/doc/cpsaoverview.pdf and b/doc/cpsaoverview.pdf differ diff --git a/doc/cpsaprimer.pdf b/doc/cpsaprimer.pdf Binary files a/doc/cpsaprimer.pdf and b/doc/cpsaprimer.pdf differ diff --git a/doc/cpsaspec.pdf b/doc/cpsaspec.pdf Binary files a/doc/cpsaspec.pdf and b/doc/cpsaspec.pdf differ diff --git a/doc/cpsatheory.pdf b/doc/cpsatheory.pdf Binary files a/doc/cpsatheory.pdf and b/doc/cpsatheory.pdf differ diff --git a/doc/cpsatheory.tex b/doc/cpsatheory.tex --- a/doc/cpsatheory.tex +++ b/doc/cpsatheory.tex @@ -22,7 +22,7 @@ \newcommand{\inv}[1]{\ensuremath{\cn{inv}(#1)}} \newcommand{\scap}[1]{\ensuremath{\mathop{\relax \smash{\mbox{\sc#1}}}\!\mathop{\vphantom{#1}}\nolimits}} -\newcommand{\concat}{\frown} +\newcommand{\concat}{\append} \newcommand{\gen}{\ensuremath{\cn{g}}} \newcommand{\expr}[2]{\ensuremath{{#1}^{#2}}} \newcommand{\sca}{\textsc{sca}} @@ -42,7 +42,6 @@ \newcommand{\dcmp}{\fn{dcmp}} \newcommand{\carpos}{\fn{carpos}} \newcommand{\esc}{\fn{esc}} -\newcommand{\msg}{\fn{msg}} \newcommand{\aug}{\fn{aug}} \newcommand{\eo}{\fn{eo}} \newcommand{\ie}{\fn{ie}} @@ -55,7 +54,8 @@ \newcommand{\sran}{\fn{Ran}} \newcommand{\svars}{\fn{Vars}} \newcommand{\evt}{\fn{evt}} -\newcommand{\mesg}{\fn{mesg}} +\newcommand{\msg}{\fn{msg}} +\newcommand{\mesg}{\msg} \newcommand{\role}{\mathsf{r}} \newcommand{\skel}{\mathsf{k}} \newcommand{\rl}{\fn{rl}} @@ -109,7 +109,7 @@ This paper makes no attempt to provide a general introduction to order-sorted quotient term algebras. We use a simple message algebra called the Basic Crypto Algebra (\bca), which is the algebra -used by CPSA. +used by {\cpsa}. \begin{figure} Sorts: \scap{name}, \scap{text}, \scap{data}, \scap{skey}, \scap{akey} $<$ \scap{mesg}\\[1ex] @@ -291,7 +291,7 @@ strand space $\Theta$ are $\{(s,i)\mid s\in\sdom(\Theta), 1\leq i\leq |\Theta(s)|\}$, the event at a node is $\evt_\Theta(s,i)=\Theta(s)(i)$, and the message at a node is -$\mesg_\Theta(s,i) = m$ such that $\evt_\Theta(s,i) = \pm m$. Just as +$\msg_\Theta(s,i) = m$ such that $\evt_\Theta(s,i) = \pm m$. Just as a position names a subterm within another term, a strand names a trace within a strand space, and a node names an event in a strand space. The relation~$\Rightarrow$ defined by $\{(s,i)\Rightarrow(s,i+1)\mid @@ -442,20 +442,25 @@ Let $k_0=\skel_X(rl_0,P,\Theta_0,\prec_0,N_0,U_0)$ and $k_1=\skel_Y(rl_1,P,\Theta_1,\prec_1,N_1,U_1)$ be preskeletons. There -is a \emph{preskeleton homomorphism} from~$k_0$ to~$k_1$, -written~$k_0\homomorphism{\phi,\sigma}k_1$, if~$\phi$ and~$\sigma$ are -structure-preserving maps with the following properties: +is a \emph{proto-homomorphism} from~$k_0$ to~$k_1$ if~$\phi$ and~$\sigma$ are +maps with the following properties: \begin{enumerate} \item $\phi$ maps strands of~$k_0$ into those of~$k_1$, and nodes as $\phi((s,p))=(\phi(s),p)$, that is $\phi$ is in $\sdom(\Theta_0)\to\sdom(\Theta_1)$; \item $\sigma\colon\alga_X\to\alga_Y$ is a message algebra homomorphism; \item $n\in\nodes(\Theta_0)$ implies $\sigma(\evt_{\Theta_0}(n))=\evt_{\Theta_1}(\phi(n))$; -\item $n_0\prec_0 n_1$ implies $\phi(n_0)\prec_1\phi(n_1)$; \item $\sigma(N_0)\subseteq N_1$; \item $\sigma(U_0)\subseteq U_1$; -\item $t\in U_0$ implies $\phi(\orig_{k_0}(t))\subseteq\orig_{k_1}(\sigma(t))$. \end{enumerate} + +A proto-homomorphism is \emph{structure-preserving} if +$n_0\prec_0 n_1$ implies $\phi(n_0)\prec_1\phi(n_1)$. We write +$k_0\homomorphism{\phi,\sigma}k_1$ when $(\phi,\sigma)$ is structure-preserving. +A proto-homomorphism is a +\emph{preskeleton homomorphism} if it is structure-preserving and also, +$t\in U_0$ implies $\phi(\orig_{k_0}(t))\subseteq\orig_{k_1}(\sigma(t))$. + A homomorphism is \emph{strandwise injective} if its strand map is injective. Two preskeletons are isomorphic if they are related by strandwise injective homomorphism in both directions. A homomorphism @@ -535,7 +540,7 @@ \caption{Dolev-Yao Example 1.3 Shape}\label{fig:dy shape} \end{figure} -CPSA determines $m$ is not kept secret by producing the shape in +{\cpsa} determines $m$ is not kept secret by producing the shape in Figure~\ref{fig:dy shape}. The added strands in the shape are instances of responder roles. The strands in the shape are: $$\begin{array}{l} @@ -845,8 +850,11 @@ \item $\anc(t,p) \cap E(S,t \termat p) = \emptyset$. \end{enumerate} \end{defn} -A critical message is $t \termat p$ where $p$ is a critical position. +\begin{conj} +$S\vdash t$ iff $\critpos(S,t)=\emptyset$. +\end{conj} +A critical message is $t \termat p$ where $p$ is a critical position. A critical message that is an atom is called a \emph{nonce test}, and one that is an encryption is called an \emph{encryption test}, and both types of tests are called an \emph{authentication test}. @@ -856,14 +864,16 @@ $\evt_k(n)=\inbnd t$ and $\critpos(\pubmsg_k(n),t)\neq\emptyset.$ \end{defn} -{\cpsa} makes progress by solving a test. Suppose~$p$ is a critical +{\cpsa} makes progress by solving a test. + +\begin{defn}[Critical Position Solved]\label{def:critical position solved} +Suppose~$p$ is a critical position at~$n$ in~$k$, i.e.\ $\evt_k(n)=\inbnd t$ and $p\in\critpos(\pubmsg_k(n),t)$, and suppose -$k\homomorphism{\phi,\sigma}k'$. Let $T= -E(\pubmsg_k(n),t \termat p)$, $T'=\sigma(T)$, $n'=\phi(n)$, and -$t' = \mesg_{k'}(n')$. Position~$p$ at~$n$ in~$k$ is -\emph{solved} in~$k'$, written $k\solve{n,p}k'$, if there exists a $(\phi,\sigma)$ -such that: +$k\homomorphism{\phi,\sigma}k'$. Let $T= E(\pubmsg_k(n),t \termat +p)$, $T'=\sigma(T)$, $n'=\phi(n)$, and $t' = \msg_{k'}(n')$. +Position~$p$ at~$n$ in~$k$ is \emph{solved} in~$k'$, written +$k\solve{n,p}k'$, if there exists a $(\phi,\sigma)$ such that: \begin{enumerate} \item\label{enu:contract} $\anc(t',p) \cap T' \neq \emptyset$, or \item\label{enu:augment} for some $t_p\in\transpred_{k'}(n')$, @@ -875,6 +885,7 @@ \item\label{enu:crit} $t' \termat p=\enc{t_0}{t_1}$, and $\pubmsg_{k'}(n')\vdash t_1$. \end{enumerate} +\end{defn} In words, {\cpsa} makes progress by a contraction (Item~\ref{enu:contract}), where messages are identified, an @@ -979,7 +990,9 @@ \end{defn} For $k'=\ops{S}_\sigma(k)$, there is a homomorphism from~$k$ to~$k'$ -only if for all $t\in U_k$, $\orig_k(t)\subseteq\orig_{k'}(\sigma(t))$. +only if for all $t\in U_k$, +$\orig_k(t)\subseteq\orig_{k'}(\sigma(t))$. The structure preserving +maps associated with the homomorphism are~$\idphi$ and~$\sigma$. \begin{defn}[Compression Operator] For distinct strands~$s$ and~$s'$, operator~$\ops{C}_{s,s'}$ @@ -1014,15 +1027,18 @@ The compression operator is only used when $\Theta_X(s)$ is a prefix of $\Theta_X(s')$, and when there is a homomorphism from~$k$ to -$\ops{C}_{s,s'}(k)$. Note that the compression operator is defined -only when relation~$\prec'$ is asymmetric, and -that $\comp{\phi_{s,s'}}{\phi'_s}=\idphi$. +$\ops{C}_{s,s'}(k)$. The structure preserving maps associated with +the homomorphism are~$\phi_{s,s'}$ and~$\idsigma$. Note that the +compression operator is defined only when relation~$\prec'$ is +asymmetric, and that $\comp{\phi_{s,s'}}{\phi'_s}=\idphi$. \begin{defn}[Ordering Enrichment Operator] Operator~$\ops{E}(k)$ enriches~$\kprec{k}$ by adding all elements implied by unique origination. \end{defn} -The ordering enrichment operator is total and idempotent. +The ordering enrichment operator is total and idempotent. The +structure preserving maps associated with the operator's homomorphism +are~$\idphi$ and~$\idsigma$, i.e.\ the homomorphism is an embedding. \begin{defn}[Augmentation Operator] For node~$n$, role~$r$, and trace~$C$, operator~$\ops{A}_{n,r,C}$ is: @@ -1038,6 +1054,10 @@ for~$U'$. \end{defn} +The structure preserving maps associated with the augmentation +operator's homomorphism are~$\idphi$ and~$\idsigma$, i.e.\ the +homomorphism is an embedding. + \subsection{Hulling Step} For preskeleton~$k=\skel(\_,\_,\Theta_k,\_,\_,U_k)$, assume $t\in U_k$ @@ -1047,7 +1067,8 @@ step if there is a most general unifier~$\sigma$ such that $\comp\sigma{\Theta_k(s)} = \comp\sigma{\prefix{\Theta_k(s')}{h}}$ with $h=|\Theta_k(s)|$, and there is a homomorphism from~$k$ to -$\ops{H}_{s's'}(k)$. +$\ops{H}_{s,s'}(k)$. The structure preserving maps associated with +the homomorphism are~$\phi_{s,s'}$ and~$\sigma$. \subsection{Pruning Step} @@ -1072,15 +1093,24 @@ on~$\ops{H}_k$. Let $k'=\ops{H}_k(\ops{A}_{n,r,C}(\ops{S}_\sigma(k)))$. An augmentation step is defined only if there is a homomorphism from~$k$ to~$k'$. -Operator~$\ops{H}_k$ always focuses on the added strand, and does not +There also must be a homomorphism from~$k$ to~$\ops{S}_\sigma(k)$. +There need not be one from~$\ops{H}_k$'s argument to its result. + +The operator~$\ops{H}_k$ is the identity if the added strand +originates no atom assumed to be uniquely originating that originates +on another strand. Otherwise, it performs one hulling step using the +added strand. Unlike an ordinary hulling step,~$\ops{H}_k$ does not require that nodes at which a uniquely originating atom originates on the added strand is preserved. In other words, for $k'=\ops{H}_k(k'')$, $\ops{H}_k$ requires there be a homomorphism -from~$k$ to~$k'$, but not one from~$k''$ to~$k'$. There also must be a -homomorphism from~$k$ to~$\ops{S}_\sigma(k)$. +from~$k$ to~$k'$, but not one from~$k''$ to~$k'$. When~$\ops{H}_k$ is +the identity, the structure preserving maps associated with an +augmentation step's homomorphism are~$\idphi$ and~$\sigma$. +When~$\ops{H}_k$ merges strands~$s$ and~$s'$ using~$\sigma'$, the maps +are~$\phi_{s,s'}$ and~$\comp{\sigma'}{\sigma}$. Suppose skeleton~$k=\skel_X(\_,P,\_,\_,\_,\_)$ has a critical -position~$p$ at node~$n$, and $t_c=\mesg_k(n)\termat p$ is the +position~$p$ at node~$n$, and $t_c=\msg_k(n)\termat p$ is the critical message. {\cpsa} computes the parameters for a set of augmentation steps as follows. First, compute the target messages. Let $T_e=E(\pubmsg_k(n), t_c)$. The target messages are $\fn{targ}(t_c, T_e)$. @@ -1119,7 +1149,9 @@ enrichment operator once to produce a skeleton. Finally, it applies as many pruning steps as is possible to produce a skeleton that is pruned subject to restriction that only pairs of strands are -considered. +considered. The structure preserving maps associated with +function~$\fn{skel}$'s homomorphism are composed from the +structure preserving maps for the operators it uses. \subsection{Test Solving Reductions} @@ -1146,6 +1178,14 @@ $k'=\fn{skel}(\ops{A}_{n, \lsn,\seq{\inbnd t_1,\outbnd t_1}}(k))$. \end{description} +When $k\reduction{n,p}k'$, there is a +homomorphism~$k\homomorphism{\phi,\sigma}k'$, where maps~$\phi$ +and~$\sigma$ are the composition of the maps from the steps used to +perform a test solving reduction. To ensure that position~$p$ at~$n$ +is solved in~$k'$, the implementation computes~$\sigma$, but it does +not compute~$\phi$. Instead it computes $\phi(n)$, which is all that +is needed to use Definition~\ref{def:critical position solved}. + \begin{conj}[Authentication Solving Algorithm Complete] Suppose~$k$ is a skeleton with a critical position~$p$ at node~$n$, and~$p$ at~$n$ in~$k$ is solved in skeleton~$k'$, i.e.\ $k\solve{n,p}k'$. @@ -1172,173 +1212,263 @@ and $k''\homomorphism{\phi,\sigma}k'$. \end{conj} -\appendix -\section{Old Stuff} -\begin{prop} -A reception node is a test node iff it is unrealized, alternatively -$S\vdash t$ iff $\crit(S,t)=\emptyset$. -\end{prop} -\begin{proof} -We show that $S\vdash t$ iff $\eo(S,t)=\emptyset$, where $\eo(S,t)$ is -defined below, and then apply a theorem by Paul Rowe that states that -$\eo(S,t)=\emptyset$ iff $\crit(S,t)=\emptyset$. -\end{proof} +\section{Completeness of CPSA} -\begin{defn}[Essential obstructions]\label{def:eo} -Let~$S$ be a set of public messages. The \emph{essential - obstructions} for~$t$ in the context of~$S$ is $\eo(S,t)$, where -$$\eo(S,t)=\left\{ -\begin{array}{ll} -\emptyset&\mbox{if $t\in M(S)$, else}\\ -\eo(S,t_0)\cup\eo(S,t_1)&\mbox{if $t=(t_0,t_1)$, else}\\ -\eo(S,t_0)&\mbox{if $t=\enc{t_0}{t_1}$ and $S\vdash t_1$, else}\\ -\{t\}&\mbox{otherwise} -\end{array}\right.$$ +{\bf NOTE: This section is still an unstable draft!} + +In this section, we prove that the {\cpsa} cohort of finding regular and listener augmentations and contractions +to solve a test is complete in the sense that if $k$ is a skeleton and $k\homomorphism{\phi,\sigma}k'$ +and $k\solve{n,p}k'$ then there is some $k''$ directly obtainable from $k$ and a factorization +$k \homomorphism{\phi_0,\sigma_0} k'' \homomorphism{\phi_1,\sigma_1} k'$ such that $\phi = \phi_1 \circ \phi_0$ +and $\sigma = \sigma_1 \circ \sigma_0$. + +This would be the ideal theorem statement but we need to make the statement more complicated because of {\cpsa}'s +use of listener augmentations which are not reflected in bundles. So instead, we will have to prove that if +$k$ is a skeleton that denotes a bundle $\Upsilon$, then there is some $k''$ directly obtainable from $k$ that +denotes $\Upsilon$. In order to relate this to the solved predicate, we make use of the theorem from the +previous section, which states that if $k\homomorphism{\phi,\sigma}k'$ and $k'$ is realized, then $k\solve{n,p}k'$ +for any unrealized $n$ in $k$ with critical position $p$. Let $k'$ be the skeleton of bundle $\Upsilon$. +For the non-listener cases we will prove the homomorphism from $k$ to $k'$ factors through $k''$; for the listener +cases, we will simply prove that $\Upsilon$ is still denoted by $k''$. + +Let $k$ be an unrealized skeleton and let $n$ be an unrealized node and $p$ be a critical position at that node. +Let $\Upsilon(\Theta,\to)$ be a bundle denoted by $k$ and let $k'$ be the skeleton of that bundle. +Note that $k\homomorphism{\phi,\sigma}k'$ and $k\solve{n,p}k'$. +The proof proceeds by cases, corresponding to the conditions of the definition of solved. + +[Condition (1) of solved]: If $p'$ is a prefix of $p$ such that $t' \termat p' = t'_e \in T'$, then +$\sigma$ is a unifier of $t \termat p'$ and $t_e$ where $\sigma(t_e) = t'_e$. Specifically, let $k''$ be +nodewise isomorphic to $k$, and let $\sigma_0$ be a most general unifier of $t_e$ and $t \termat p'$ +more general than $\sigma$ so that $\sigma = \sigma_1 \circ \sigma_0$. Then let $\phi_0$ be the nodewise isomorphism +and let $\phi_1 = \phi \circ \phi_0^{-1}$. We have now specified $\sigma_0, \sigma_1, \phi_0, \phi_1$, and note +that $\phi = \phi \circ \phi_0^{-1} \circ \phi_0$ and that $\sigma = \sigma_1 \circ \sigma_0$, which proves the +factorization commutes. + +[Conditions (3) and (4) of solved]: If $\pubmsg_{k'}(n') \vdash {t'_1}^{-1}$ where $\enc{t'_0}{t'_1} \in T'$, a listener +augmentation will serve as our intermediate step. {\cpsa} attempts a listener augmentation for every decryption +key associated with an encryption in its escape set; let $\enc{t_0}{t_1}$ be (one) preimage of $\enc{t'_0}{t'_1}$ +under $\sigma$ in the escape set $T$. {\cpsa} will thus attempt a listener augmentation for $t_1^{-1}$. Let $k''$ be defined to be +$k$ with an additional listener for $t_1^{-1}$. The map $\phi_0$ is nodewise injective with image that avoids the +new listener, and the map $\sigma_0$ is the identity. Let $k'_1$ be $k'$ with an additional listener for ${t'}_1^{-1}$, +ordered immediately before $n'$ (that is, the listener nodes are previous to $n'$ and all nodes of $k'$ strictly +previous to $n'$ are strictly previous to the first node of the listener.) We can define a homomorphism from $k''$ +to $k'_1$, namely, $\phi_1,\sigma_1$ where $\sigma_1 = \sigma$ and where $\phi_1$ is defined to be $\phi \circ \phi_0^{-1}$ +for nodes in the image of $\phi_0$, with the two listener nodes mapping to the two listener nodes of $k'_1$. +$k'_1$ will still be realized; the only new reception is for ${t'}_1^{-1}$ but we assumed that $\pubmsg_{k'}(n') +\vdash {t'}_1^{-1}$ and all public messages sent before $n'$ are available before the listener reception since $n'$ +contains a reception event. + +In $\Upsilon(\Theta,\to)$, we must now insert the listener in a way compatible with $k'_1$, yet also keep +the bundle property intact. This may require one or more penetrator strands be added to produce ${t'}_1^{-1}$ if it +was not already produced. Let $\Theta',\to'$ be the extensions of $\Theta,\to$ to incorporate the listener +strand and any necessary penetrator strands. Then $k'_1$ realizes $\Upsilon(\Theta',\to')$ and so $k''$ realizes +$\Upsilon(\Theta,\to)$ modulo listeners. + +If $t'_c = \enc{t'_0}{t'_1}$ and $\pubmsg_{k'}(n') \vdash t'_1$ then, again, we use a listener augmentation. When +the critical term is an encryption, {\cpsa} will attempt a listener augmentation for its encryption key. In this case, +if $t_c = \enc{t_0}{t_1}$, {\cpsa} will attempt a listener augmentation for $t_1$. The rest of the argument for this case +is effectively identical to the argument for condition (3), but the listener in $k''$ will be for $t_1$ rather than $t_1^{-1}$ +and the listener in $k'_1$ will be for $t'_1$ rather than ${t'}_1^{-1}$. + +[Condition (2) of solved]: The proof of this case proceeds via the proof of two lemmas. The first lemma proves that +a good candidate augmentation exists, and the second lemma proves that this augmentation is successful, produces a distinct +result from $k$, and covers $k'$. + +\begin{defn} +Let $r = (C,N,U)$ be a role, $i$ be whole number, $pp$ be a position, and $tt$ be a term. Then $(r,i,pp,tt)$ is an {\em augmentation +candidate} for $(k,n,p)$ if: +\begin{enumerate} +\item $|C| \leq i$, +\item Position $pp$ in $C(i)$ is a well-defined, carried position. +\item $tt$ is either $t \termat p$ or a proper, carried subterm of an element of $E(\pubmsg_n(k),t \termat p)$ that carries $t \termat p$. +\end{enumerate} \end{defn} -Paul Rowe showed the relation between essential obstructions and -critical messages is -$$\eo(S,t)=\{t_0\in\crit(S,t)\mid -\some{p}t_0=t\termat p\land\anc(t,p)\cap\crit(S,t)=\emptyset\}.$$ +\begin{defn} +Let $k$ be an unrealized skeleton with unrealized node $n$ and critical position $p$. Let $k'$ be a realized, +pruned skeleton, and let $k \homomorphism{\phi,\sigma} k'$. Then $(r,i,pp,tt)$ is a {\em solving augmentation +candidate} for $(k,k',n,p,\phi,\sigma)$ if $(r,i,pp,tt)$ is an augmentation candidate for $(k,n,p)$, and +\begin{enumerate} +\item There is a send of a message $t'$ at a node $n' = (s, i)$ in $k'$ such +that (1) $n' \prec \phi(n)$, (2) strand $\Theta'(s)$ is an instance of role $r$, +(3) $t' \termat pp = \sigma(tt)$, and (4) if $t'' = \msg_k(s,j)$ for $j < i$ then $\mcow(t'_c,T',t'')$. +\item There is some position $q$ such that $t'_c \sqsubseteq_{q} t'$ and such that (1) $\anc(t',q) \cap T' = +\emptyset$ or (2) there exists some $q', q'': q' \append q''$ is a prefix of $q$ and $t' \termat q' \in T'$ +and $t' \termat q' \append q'' \in \fn{targ}(t'_c,T')$ but $t' \termat q' \append q'' \notin \sigma(\fn{targ}(t_c,T))$. +\end{enumerate} +\end{defn} -\begin{prop} -$S\vdash t$ iff $\eo(S,t)=\emptyset$. -\end{prop} +\begin{lem} +\label{lem:candidate} +If $k\solve{n,p}k'$ via $k \homomorphism{\phi,\sigma}$ and only condition (2) of the solved predicate +holds, then there exists a solving augmentation candidate for $(k,k',n,p,\phi,\sigma)$. +\end{lem} + \begin{proof} -The cases in Definition~\ref{def:eo} follow the cases for constructing -messages in Section~\ref{sec:pen deriv mesgs}. The first case -corresponds to showing that $S\vdash t$ with $t\in D^0$. The second -case corresponds to showing that $S\vdash (t_0,t_1)$ by finding an~$n$ -such that $t_0,t_1\in D^n$. The third case is the same, but for an -encryption. +In order to concisely deal with similarities between more complex cases and simpler cases, we define several +related sequences which become defined as needed. Specifically, we define a sequence $T'_i$ of sets of terms, +a sequence $t'_i$ of terms, sequences $p_i$ and $p'_i$ of positions, and a sequence $n_i$ of nodes, such that: + +\begin{itemize} +\item $T'_i \subset T'$. +\item For $i > 0$, $T'_i = \{t'_i\} \cup (E(\pubmsg_{k'}(n_i),\pubmsg_{k'}(n'),t'_c) \cap T'_{i-1})$. +\item For $i > 0$,$p'_i$ is a prefix of $p_i$. +\item For $i > 0$, $t'_c \sqsubseteq_{p_i} t'_i$ but $t'_i \termat p'_i \in \fn{targ}(t'_c, T')$ and $t'_i \termat p'_i \notin \sigma(\fn{targ} +(t_c, T))$ +\item For $i \geq 0$, $n_{i+1} \preceq n_i$, and $n_0 \preceq n'$. +\item $\mncow(t'_c, T'_i, \msg(n_i))$. +\end{itemize} + +We let $T'_0 = T'$ and we let $n_0$ be the node preceding $n'$ transmitting the message $t_p$ such that $\mncow(t'_c,T',t_p)$. +There is no need to define $t'_0, p_0,$ or $p'_0$ because no conditions are placed on them. + +Note that in fact $T'_i = \{t'_i\} \cup (E(\pubmsg_{k'}(n_i),\pubmsg_{k'}(n'),t'_c) \cap T')$, by repeated +substitution of $T'_{i-1}$ coupled with the fact that these escape sets get smaller as $i$ grows. + +Since $T'$ is finite, we know that this sequence cannot be defined farther than $i = |T'|$. Therefore, it suffices to prove +that either we can find a solving augmentation candidate given a sequence of length $i$, or that we can extend the sequence +while maintaining these properties. + +Recall that since for all $\enc{t_0}{t_1} \in T'$ we have that $\pubmsg_{k'}(n') \not\vdash t_1^{-1}$, and +also if $t'_c$ is an encryption, its encryption key is not derivable from $\pubmsg_{k'}(n')$, we know that if +$S$ is a set of messages such that for every $x \in S$ we have that $\mcow(t'_c,T'_i,x)$, then $S \vdash x'$ implies +that $\mcow(t'_c,T',x')$. Thus, for any reception node prior to $n'$ in $k'$, if the reception carries +$t'_c$ not only within $T'_i$ then there is an earlier send node that carries $t'_c$ not only within $T'_i$; if the +earliest such node is a reception, its message would not be derivable. + +Thus, for the message at any node $\preceq n_i$ in $k'$, if that message does not carry $t'_c$ only within $T'_i$, then +either that node is a send, or there is an earlier node whose message does not carry $t'_c$ only within $T'$. In other +words, if such a message exists, we can find an ealiest transmission node $\nu_i$ sending $\tau_i$ such that $\mncow(t'_c, T', +\tau_i)$ and for all $\tau$ sent earlier than $\nu_i$, $\mcow(t'_c, T', \tau)$. Note that since $\mncow(t'_c, T'_i, +\msg(n_i))$, there must exist some node $\nu_i$ such that (1) $\evt_{k'}(\nu_i) = +\tau_i$, (2) $\mncow(t'_c, T'_i, \tau_i)$, and +(3) for all $\nu \prec \nu_i, \mcow(t'_c, T'_i, \msg(\nu))$. In other words, $\nu_i$ is an earliest transmission node whose +message carries $t'_c$ not only within $T'_i$. + +Since $k'$ is realized, we know that $\mcow(t'_c,E(\pubmsg_{k'}(\nu_i),t'_c),\tau_i)$ and therefore, +$\mcow(t'_c,E(\pubmsg_{k'}(n_i),\pubmsg_{k'}(n'),t'_c),\tau_i)$ by Lemma~\ref{lem:escapesetcow}. Since $\mncow(t'_c,T'_i,\tau_i)$, +let $q$ be such that $t'_c \sqsubseteq_q \tau_i$ and $\anc(\tau_i, q) \cap T'_i = \emptyset$. If such a $q$ exists such that +$\anc(\tau_i, q) \cap T' = \emptyset$ then let $q$ have this property. Let $t^\star \in \anc(\tau_i,q) \cap E(\pubmsg_{k'}(n_i), +\pubmsg_{k'}(n'),t'_c)\setminus T'_i$, where $t^\star \in T'$ if such a $t^\star$ exists given our choice of $q$. +If $t^\star \in T'$ then $t^\star = t_i$ (recall, $T'_i \setminus (T' \cap E(\pubmsg_{k'}(n_i),\pubmsg_{k'}(n'),t'_c)) = \{t'_i\}$). +In such a case, assume without loss of generality that we can write $q = q' \concat p_i$ where $\tau_i \termat q' = +t^\star$.\footnote{If not, write $q = q_0 \append q_1$ where $t' \termat q_0 = t^\star$ and +$t'_c \sqsubseteq_{q_1} t^\star$. Consider $q' = q_0 \append p_i$. Then $t'_c \sqsubseteq_{q'} \tau_i$ and $t^\star \in +\anc(\tau_i,q')$.} + +Note that $q$ satisfies condition (3) of a solving augmentation candidate, a condition which depends only on the transforming +message, $\tau_i$. If $t^\star \notin T'$ then it is because $\anc(\tau_i, q) \cap T' = \emptyset$. Otherwise, $t^\star = t_i$, +and $q \concat p'_i$ is the prefix required: $\tau_i \termat q' = t_i \in T'$ and $\tau_i \termat q' \concat p'_i = t_i \termat p'_i$ +is in $\fn{targ}(t'_c,T')$ but not in $\sigma(\fn{targ}(t_c,T))$. + +From here, we must identify our solving augmentation candidate or identify our extension of the sequence. + +Let $r_i = (C_i,N_i,U_i)$ be the role associated with $\nu_i$'s strand in $k'$ via its role map, and let $\nu_i = (s_i, h_i)$. +We know that $\nu_i$ is a sending node, so let $t_r$ be such that $C(h_i) = +t_r$. If $q$ is a well-defined position of +$t_r$ then $(r_i,h_i,q,t_c)$ is a solving augmentation candidate. (Proof omitted.) + +If not, then let $q'$ be the longest prefix of $q$ such that $q'$ is a well-defined position of $t_r$ (and let $q = q' \append +q''$); then $t_r \termat q' = x$ where $x$ is of sort $\scap{mesg}$. Since our protocol satisfies the acquired constraint +there is an earlier message $C(h_{aq}) = -t_{aq}$ in which $x$ is acquired; let $p_{aq}$ be such that $x \sqsubseteq_{p_{aq}} +t_{aq}$. If $t'_{aq} = \msg(n'_{aq})$ where $n'_{aq} = (s_i, h_{aq})$ then we know that $t'_{aq} \termat (p_{aq} \append +q'') = t'_c$ so there must be some ancestor $t'_e$ in $T'_i \cap \anc(t'_{aq},p_{aq}\append q'')$. Specifically, let $t'_e$ +be the ancestor closest to $t'_{aq} \termat (p_{aq} \append q'')$ in $E(\pubmsg_{k'}(n'_{aq}), +\pubmsg_{k'}(n'),t'_c)$. We know there is some ancestor in $E(\pubmsg_{k'}(n'_{aq}),t'_c)$ because $k'$ is realized, and +by Lemma~\ref{lem:escapesetcow} and Lemma~\ref{lem:cowtrans}, there is some ancestor in $E(\pubmsg_{k'}(n'_{aq}), \pubmsg_{k'}(n'), +t'_c)$. Given that there is at least one, we can without loss of generality pick the smallest as $t'_e$. + +Furthermore, $t'_e$ must appear at some position $p'_{aq}$ in $t'_{aq}$ which is a proper prefix of $p_{aq}$, otherwise, $t'_e$ would +be in $\anc(t_p,q)$. Let $p_{aq} = p'_{aq} \append p''_{aq}$. If there is some target term $tt$ such that $\sigma(tt) = t'_e \termat p''_{aq}$ +then $(r_i,h_i,q',tt)$ is a solving augmentation candidate. (Proof omitted.) + +Otherwise, for all $tt \in \fn{targ}(t_c,T)$, $\sigma(tt) \neq t'_e \termat p''_{aq}$. Let $t'_{i+1} = t'_e$, let $p_{i+1} = p''_{aq}$, let +$T'_{i+1} = (T'_i \setminus \{t'_e\}) \cap E(\pubmsg_{k'}(n'_{aq}),\pubmsg_{k'}(n'),t'_c)$, +and let $n_{i+1}$ be some node $\preceq n'_{aq}$ such that $t'_e \in M(\fn{mesg}(n_{i+1}),\pubmsg_{k'}(n'))$; we know such a node +exists because $t'_e \in E(\pubmsg_{k'}(n'_{aq}),\pubmsg_{k'}(n'),t'_c)$. Then $\mncow(t'_c, T'_{i+1}, \fn{mesg}(n_{i+1})$ because +$t'_e \in M(\fn{mesg}(n_{i+1})$ and $t'_e$ has at least one carried position of $t'_c$, namely $p''_{aq}$, that has no ancestor +in $E(\pubmsg_{k'}(n'_{aq}),\pubmsg_{k'}(n'),t'_c)$. \end{proof} -\section{Unification in a Many-Sorted Algebra} +This establishes that a solving augmentation candidate exists. Next we must prove that the existence of such an +augmentation candidate implies a cohort member that we can factor through. -Unification in the Simple Crypto Order-Sorted Algebra can be -implemented using the unsorted unification algorithm from Laurence -Paulson's ``ML for the Working Programmer'' in a many-sorted algebra -isomorphic to the order-sorted algebra, with a modification to handle -an equation. See Figure~\ref{fig:unifier}. +\begin{lem} +\label{lem:candidate works} +If $(r,i,pp,tt)$ is a solving augmentation candidate for $(k,k',n,p,\phi,\sigma)$ then if +$k'' = \aug(k,r,i,pp,tt)$ then there exist homomorphisms $(\phi', \sigma')$ and $(\phi'',\sigma'')$ +such that $k \homomorphism{\phi',\sigma'} k'' \homomorphism{\phi'',\sigma''} k'$ where $\phi = \phi'' +\circ \phi'$ and $\sigma = \sigma'' \circ \sigma'$, and $k''$ is not isomorphic to $k$. +\end{lem} -\begin{figure} -$$ -\begin{array}{l} -\cn{unify}(\ell, t, t') = \cn{unify\_aux}(\ell,\cn{chase}(\ell, t), -\cn{chase}(\ell, t')) -\\ -\\\cn{chase}(\ell, x)= -\\ \qquad\mbox{let }t=\cn{lookup}(x,\ell)\mbox{ in} -\\ \qquad \mbox{if }x = t\mbox{ then }x -\mbox{ else }\cn{chase}(\ell, t) -\\\cn{chase}(\ell, t^{-1})=\cn{chase\_invk}(\ell, t)\hfill(!) -\\\cn{chase}(\ell, t)=t -\\ -\\\cn{chase\_invk}(\ell, x)=\hfill(!) -\\ \qquad\mbox{let }t=\cn{lookup}(x,\ell)\mbox{ in}\hfill(!) -\\ \qquad \mbox{if }x = t\mbox{ then }x^{-1} -\mbox{ else }\cn{chase\_invk}(\ell, t)\hfill(!) -\\\cn{chase\_invk}(\ell, t^{-1})=\cn{chase}(\ell, t)\hfill(!) -\\\cn{chase\_invk}(\ell, t)=t^{-1}\hfill(!) -\\ -\\\cn{lookup}(x,\seq{})=x -\\\cn{lookup}(x,(y,t)\cons\ell)= -\mbox{if }x=y\mbox{ then }t\mbox{ else } -\cn{lookup}(x, \ell) -\\ -\\\cn{unify\_aux}(\ell,x,x) =\ell -\\\cn{unify\_aux}(\ell,x,t) =\mbox{if }\cn{occurs}(x, t)\mbox{ then raise failure else } -(x,t)\cons\ell -\\\cn{unify\_aux}(\ell,t,x) =\cn{unify\_aux}(\ell,x,t) -\\\cn{unify\_aux}(\ell,f(t,\ldots),f(t',\ldots)) = -\cn{unify\_list}(\ell,\seq{t,\ldots},\seq{t',\ldots}) -\\\cn{unify\_aux}(\ell,t,t') =\mbox{raise failure} -\\ -\\\cn{unify\_list}(\ell,\seq{},\seq{}) =\ell -\\\cn{unify\_list}(\ell,t\cons u,t'\cons u') = -\cn{unify\_list}(\cn{unify}(\ell,t,t'), u, u') -\\\cn{unify\_list}(\ell,u,u') =\mbox{raise failure} -\end{array} -$$ -\caption{Unifier}\label{fig:unifier} -\end{figure} +STOP READING HERE -\begin{description} -\item[Signature:] -$$\begin{array}{ll@{{}\colon{}}ll} -\mbox{Sorts:}&\multicolumn{3}{l}{\mbox{$\top$, $S$, and $A$}}\\ -\mbox{Operations:}&s&S\to\top& \mbox{Symmetric key inclusion}\\ -&a&A\to\top& \mbox{Asymmetric key inclusion}\\ -&(\cdot,\cdot)&\top\times\top\to\top& \mbox{Pairing}\\ -&\enc{\cdot}{(\cdot)}&\top\times S\to\top& \mbox{Symmetric encryption}\\ -&\enc{\cdot}{(\cdot)}&\top\times A\to\top& \mbox{Asymmetric encryption}\\ -&(\cdot)^{-1}&S\to S& \mbox{Symmetric key inverse}\\ -&(\cdot)^{-1}&A\to A& \mbox{Asymmetric key inverse} -\end{array}$$ -\item[Equations:] for $x\colon S$, $x^{-1}\approx x$, and for $y\colon - A$, $(y^{-1})^{-1}\approx y$ -\item[Translation:] $\sembrack{\cdot}$ maps an order-sorted term to a - many-sorted term -$$\sembrack{t}=\left\{ -\begin{array}{ll} -t&\mbox{if $t\in X_\top$}\\ -s(t)&\mbox{if $t\in X_S$}\\ -\sembrack{t_0}&\mbox{if $t = t_0^{-1}$ and $t_0 : S$}\\ -a(t)&\mbox{if $t\in X_A$}\\ -a(x^{-1})&\mbox{if $t = x^{-1}$ and $x\in X_A$}\\ -\sembrack{t_0}&\mbox{if $t = (t_0^{-1})^{-1}$ and $t_0 : A$}\\ -(\sembrack{t_0},\sembrack{t_1})&\mbox{if $t=(t_0,t_1)$}\\ -\enc{\sembrack{t_0}}{\sembrack{t_1}}&\mbox{if $t=\enc{t_0}{t_1}$} -\end{array} -\right.$$ -\item[Canonical Terms:] BNF -$$\begin{array}{r@{{}\gets{}}l} -T&X_\top\mid S\mid A\mid(T,T)\mid\enc{T}{S}\mid -\enc{T}{A} -\\ S&s(X_S) -\\ A&a(X_A)\mid a(X_A^{-1}) -\end{array}$$ -\end{description} +\begin{proof} -\section{Simple Diffie-Hellman Algebra} +In such cases, the map from $k$ to $k'$ filters through $k''$ which is the result of an augmentation +followed by pruning. To specify an augmentation operation, we must specify an $n$ which the new instance +precedes, a role $r$, a trace $C$ (an instantiation of $r$ under some substitution up to some height) and +a substitution $\sigma$ to apply in conjunection with the augmentation. This produces a pre-skeleton $k''_0$ +and then $k''$ is the result of first hulling $k''_0$ and then pruning single strands. -\begin{figure} -$$\begin{array}{ll@{{}\colon{}}ll} -\mbox{Sorts:}&\multicolumn{3}{l}{\mbox{$\top$, $S$, $A$, and $E$, - where $S<\top$, $A<\top$, and $E<\top$}}\\ -\mbox{Operations:}&(\cdot,\cdot)&\top\times\top\to\top& \mbox{Pairing}\\ -&\enc{\cdot}{(\cdot)}&\top\times S\to\top& \mbox{Symmetric encryption}\\ -&\enc{\cdot}{(\cdot)}&\top\times A\to\top& \mbox{Asymmetric encryption}\\ -&\cn{inv}&S\to S& \mbox{Symmetric key inverse}\\ -&\cn{inv}&A\to A& \mbox{Asymmetric key inverse}\\ -&\gen&S&\mbox{Generator}\\ -&\expr{(\cdot)}{(\cdot)}&S\times E\to S&\mbox{Exponentiation}\\ -&(\cdot \cdot)& E\times E\to E&\mbox{Multiplication}\\ -&(1/\cdot)&E\to E & \mbox{Reciprocal}\\ -&1&E & \mbox{Identity} -\end{array}$$ -\caption{Simple Diffie-Hellman Algebra Signature}\label{fig:dh signature} -\end{figure} +$n'$ will serve as the $n$ for the augmentation, and $r$ will be the role. -\begin{figure} -\begin{center} -$$\begin{array}{lll} -x(yz) \approx (xy)z& -xy \approx yx& -1x \approx x\\ -x(1/x) \approx 1& -(h^x)^y \approx h^{xy}& -h^1 \approx h\\ -\inv{h}\approx h&\inv{\inv{a}}\approx a -\end{array}$$ -where $a\colon A$, $h\colon S$, and $x,y,z\colon E$ -\end{center} -\caption{Simple Diffie-Hellman Algebra Equations}\label{fig:dh equations} -\end{figure} +In $k'$, there is a node $\nu = (s',i)$ such that $\nu \prec n'$ such that $\evt(\nu) = +\tau$ and $\tau +\termat pp = \sigma(tt)$, and where $s$ is an instance of role $r$, and such that for all $j < i$, +$\mcow(t'_c,T',\mesg_k(s,j))$. -\emph{This section will discuss the algebra whose signature is given - in Figure~\ref{fig:dh signature} and equations are given in - Figure~\ref{fig:dh equations}.} +\noindent {\bf First step: adding a fresh instance} + +Let $k_0$ be the skeleton $\mathbb{A}_{n,r,C}(\mathbb{S}_{\idsigma}(k))$ where $C$ is a variable-disjoint +renaming of the trace in $r$ up to the $i$th event.\footnote{We can see that $k_0$ is a skeleton because +no origination of values already in $k$ changes, and because $C$ is consistent with the origination +restrictions introduced.} There is a homomorphism $k \homomorphism{\phi_0,\sigma_0} k_0$ with $\sigma_0 = +\idsigma$ and $\phi_0$ being nodewise bijective. In other words, $(\phi_0, \sigma_0)$ is an inclusion map. + +Furthermore, $(\phi,\sigma)$ factors through $(\phi_0,\sigma_0)$. Let $\hat{\phi}$ be defined to be +$\phi \circ \phi_0^{-1}$ for those nodes in the image of $\phi_0$. Nodes not in the image of $\phi_0$ are +the nodes in the additional strand introduced by the augmentation. For such nodes $(s,i)$, $\hat{\phi}$ +maps them to $(s',i)$ in $k'$. $\hat{\sigma}$ is defined to be $\sigma$ on all variables appearing in +$\phi_0(k)$. For the variables appearing outside the image of $\phi_0$, note that there is a renaming +$\rho$ that maps the first $i$ events in the trace of $r$ to $C$ used in our augmentation, and there is a +substitution $\sigma_r$, the instantiation map in $k'$, which unifies the first $i$ events in the trace of $r$ +with the first $i$ events in the strand $s'$ in $k'$. (Specifically, let $\sigma_r$ be the full instantiation +map for that strand, restricted to the variables that appear in the first $i$ events in the trace of $r$.) Then +$\hat{\sigma}$ on variables appearing outside the image of $\phi_0$ is $\sigma_r \circ \rho^{-1}$. + +\noindent {\bf Second step: placing the critical message} + +Let $t_r$ be the message sent in the $i$th node of the newly added strand in $k_0$. +Note that $\hat{\sigma}$ unifies $t_r \termat pp$ with $tt$, because $\hat{\sigma}(t_r) = \tau$ and +$\tau \termat pp = \hat{\sigma}(tt) = \sigma(tt)$. Let $\sigma_1$ be a most general unifier of $t_r \termat pp$ +and $tt$ more general than $\hat{\sigma}$, and let $\hat{\sigma}_1$ be such that $\hat{\sigma} = \hat{\sigma}_1 \circ +\sigma_1$. + +Consider $k_1 = \mathbb{S}_{\sigma_1}(k_0)$. Let $\phi_1$ be the identity map. Then $(\phi_1,\sigma_1)$ is a proto-homomorphism +from $k_0$ into $k_1$. + +The second step in the augmentation is relies on parameters $(k,n,r,i,pp,tt)$ where $pp$, the {\em placement position}, is a well-defined +position in $C(i)$, and where $tt$, the {\em target term}, is either $t \termat p$ where $t$ is the message to be received +at node $n$, or a member of $\{tt | tt$ is a subterm of an element of $E(\pubmsg_k(n),t \termat p)\} \setminus E(\pubmsg_k(n),t +\termat p)$.\footnote{Note that the latter will always include $t \termat p$ itself unless the escape set is empty. It {\em is} +possible for the escape set to be empty, in which case, explicitly specifying that $tt = t \termat p$ is necessary.} Here, we +seek to find a preskeleton $\aug_1(k,n,r,i,pp,tt)$ that has a new instance of role $r$ at height $i$, that is as fresh as possible, +subject to the constraint that $t' \termat pp = tt$, where $t'$ is the message sent in the new instance at height $i$. + +We accomplish this, essentially, by considering $\aug_0(k,n,r,i)$ where $t'$ is the message sent in the new instance at height $i$, +and finding $\sigma_1 \in \fn{unify}(t' \termat pp, tt)$ and then applying $\sigma_1$ to $\aug_0(k,n,r,i)$ to produce +$\aug_1(k,n,r,i,pp,tt).$ This step can fail, if there is no unifier, or if $\aug_1(k,n,r,i,pp,tt)$ is not a preskeleton, or if the +map $(\phi_1 \circ \phi_0, \sigma_1 \circ \sigma_0)$ is not a preskeleton homomorphism.\footnote{If, +for instance, the unification requires identifying a variable occurring but not carried in $t' \termat pp$ with a term in $N(k)$, and +that variable appears earlier in the instance in a carried position, $\aug_1$ would be a non-preskeleton.} + +However, if $k\homomorphism{\phi,\sigma}k'$ and $k'$ has a strand $s_r$ for which $|s_r| \geq i$, $rl(s_r) = r$, $(s_r,i) \prec \phi(n)$, +and $t' \termat pp = \sigma(tt)$ where $t'$ is the message sent at $(s_r, i)$, then $(\phi,\sigma)$ always factors through $(\phi_1 \circ +\phi_0, \sigma_1 \circ \sigma_0)$ and this step does not fail. + +\noindent {\bf Third step: ensuring carried-only-within} + +(complete me!) + +\end{proof} \section*{Acknowledgments} diff --git a/doc/cpsauser.html b/doc/cpsauser.html --- a/doc/cpsauser.html +++ b/doc/cpsauser.html @@ -47,7 +47,7 @@ annotations to annotate shapes and generate protocol soundness obligations. The cpsaparameters program detects some specification errors by performing a data flow analysis on protocol roles. The -cpsapp program pretty prints its input using the +cpsapp program pretty prints its input using a CPSA specific algorithm.

The input syntax is essentially the same as the output syntax. A Lisp aware @@ -351,6 +351,7 @@ -c --compact use compact format -l --latex use LaTeX format -m INT --margin=INT set output margin (default 72) + -i --infix output uses infix notation -h --help show help message -v --version show version number @@ -478,6 +479,7 @@ Usage: cpsapp [OPTIONS] [FILE] -o FILE --output=FILE output FILE -m INT --margin=INT set output margin (default 72) + -i --infix output uses infix notation -h --help show help message -v --version show version number diff --git a/doc/macros.tex b/doc/macros.tex --- a/doc/macros.tex +++ b/doc/macros.tex @@ -1,5 +1,5 @@ \newcommand{\cpsa}{\textsc{cpsa}} -\newcommand{\version}{2.0.6} +\newcommand{\version}{2.1.1} \newcommand{\cpsacopying}{\begingroup \renewcommand{\thefootnote}{}\footnotetext{{\copyright} 2010 The MITRE Corporation. Permission to copy without fee all or part of diff --git a/doc/strands.mp b/doc/strands.mp --- a/doc/strands.mp +++ b/doc/strands.mp @@ -76,7 +76,7 @@ % is the length of the first arrow. vardef inbnd@#(expr pos, width, term) = pair d; - d = (width + xpart @#[1].e, ypart @#[pos].e); + d = (xpart @#[1].e + width, ypart @#[pos].e); drawmsg(d .. @#[pos].e); label.rt(term, d); enddef; @@ -85,7 +85,22 @@ % width is the length of the first arrow. vardef outbnd@#(expr pos, width, term) = pair d; - d = (width + xpart @#[1].e, ypart @#[pos].e); + d = (xpart @#[1].e + width, ypart @#[pos].e); drawmsg(@#[pos].e .. d); label.rt(term, d); +enddef; + +% Reverse versions: +vardef rinbnd@#(expr pos, width, term) = + pair d; + d = (xpart @#[1].w - width, ypart @#[pos].w); + drawmsg(d .. @#[pos].w); + label.lft(term, d); +enddef; + +vardef routbnd@#(expr pos, width, term) = + pair d; + d = (xpart @#[1].w - width, ypart @#[pos].w); + drawmsg(@#[pos].w .. d); + label.lft(term, d); enddef; diff --git a/setup.bat b/setup.bat new file mode 100644 --- /dev/null +++ b/setup.bat @@ -0,0 +1,3 @@ +runghc Setup.hs configure +runghc Setup.hs build +runghc Setup.hs install diff --git a/src/CPSA/Annotations/Annotations.hs b/src/CPSA/Annotations/Annotations.hs --- a/src/CPSA/Annotations/Annotations.hs +++ b/src/CPSA/Annotations/Annotations.hs @@ -17,7 +17,7 @@ {-- import System.IO.Unsafe z :: Show a => a -> b -> b -z x y = seq (unsafePerformIO (print x)) y +z x y = unsafePerformIO (print x >> return y) --} -- Constructs the output or reports an error from the input given a diff --git a/src/CPSA/DiffieHellman/Algebra.hs b/src/CPSA/DiffieHellman/Algebra.hs --- a/src/CPSA/DiffieHellman/Algebra.hs +++ b/src/CPSA/DiffieHellman/Algebra.hs @@ -29,7 +29,7 @@ import System.IO.Unsafe z :: Show a => a -> b -> b -z x y = seq (unsafePerformIO (print x)) y +z x y = unsafePerformIO (print x >> return y) zz :: Show a => a -> a zz x = z x x diff --git a/src/CPSA/Graph/Config.hs b/src/CPSA/Graph/Config.hs --- a/src/CPSA/Graph/Config.hs +++ b/src/CPSA/Graph/Config.hs @@ -6,8 +6,10 @@ -- modify it under the terms of the BSD License as published by the -- University of California. -module CPSA.Graph.Config where +module CPSA.Graph.Config (Config(..), Notation(..), printer) where +import CPSA.Lib.CPSA (SExpr, pp, printItem) + data Config = Config { units :: String, -- Unit of length font :: Float, -- Font size @@ -23,5 +25,17 @@ dx :: Float, -- Distance between strands dy :: Float, -- Distance between nodes br :: Float, -- Bullet radius - compact :: Bool } -- Generate compact format + compact :: Bool, -- Generate compact format + notation :: Notation } -- Select notation deriving (Show, Read) + +data Notation + = Prefix -- Use S-expression syntax + | Infix -- Use condensed syntax + deriving (Show, Read, Eq) + +printer :: Config -> Int -> Int -> SExpr a -> String +printer conf margin indent sexpr = + case notation conf of + Prefix -> pp margin indent sexpr + Infix -> printItem margin indent sexpr diff --git a/src/CPSA/Graph/ExpandedView.hs b/src/CPSA/Graph/ExpandedView.hs --- a/src/CPSA/Graph/ExpandedView.hs +++ b/src/CPSA/Graph/ExpandedView.hs @@ -1,5 +1,5 @@ --- Generates an expanded view of CPSA S-expressions as a compound --- document that contains SVG within XHTML. +-- Generates an expanded view of CPSA output as a compound document +-- that contains SVG within XHTML. -- Copyright (c) 2009 The MITRE Corporation -- @@ -20,19 +20,22 @@ import CPSA.Graph.Preskeleton import CPSA.Graph.Tree +type Printer a = Int -> Int -> SExpr a -> String + expandedView :: Handle -> Config -> Int -> [SExpr Pos] -> [Preskel] -> IO () expandedView h conf margin cmts ps = do hPutList h (header ps) - comments h margin cmts + let pp = printer conf + comments h margin pp cmts let f = forest ps case f of [t] -> - tdrawer h conf margin False t + tdrawer h conf margin pp False t _ -> do toc h f - mapM_ (tdrawer h conf margin True) f + mapM_ (tdrawer h conf margin pp True) f hPutList h closer hClose h @@ -49,8 +52,8 @@ title [] = " CPSA" title (k : _) = " CPSA " ++ protocol k ++ "" -comments :: Handle -> Int -> [SExpr Pos] -> IO () -comments h margin cmts = +comments :: Handle -> Int -> Printer Pos -> [SExpr Pos] -> IO () +comments h margin pp cmts = do hPutStrLn h "" let xs = concat $ intersperse "\n" $ map (pp margin indent) cmts @@ -95,8 +98,8 @@ viewbox = "0 0 " ++ showL w ++ " " ++ showL h -- Draws one tree -tdrawer :: Handle -> Config -> Int -> Bool -> Tree -> IO () -tdrawer h conf margin toc t = +tdrawer :: Handle -> Config -> Int -> Printer Pos -> Bool -> Tree -> IO () +tdrawer h conf margin pp toc t = do hPutStrLn h "" let id = label (vertex t) @@ -109,8 +112,8 @@ let (width, height, es) = tree conf t hPutStrLn h $ show $ docRoot conf width height $ rect conf 0 0 width height : es - hPutSExpr h margin (protSrc (vertex t)) - mapM_ (kdrawer h conf margin id) (collectPreskels t) + hPutSExpr h margin pp (protSrc (vertex t)) + mapM_ (kdrawer h conf margin pp id) (collectPreskels t) treeid :: Int -> String treeid label = "t" ++ show label @@ -123,8 +126,8 @@ f s t = foldl f (S.insert t s) (children t) -- Draws one item in the tree--a preskeleton. -kdrawer :: Handle -> Config -> Int -> Int -> Tree -> IO () -kdrawer h conf margin tid t = +kdrawer :: Handle -> Config -> Int -> Printer Pos -> Int -> Tree -> IO () +kdrawer h conf margin pp tid t = do hPutStrLn h "" let k = vertex t @@ -143,7 +146,7 @@ hPutStrLn h "" let (width, height, e) = kdraw conf 0 0 k hPutStrLn h $ show $ docRoot conf width height [defs conf, e] - hPutSExpr h margin (preskelSrc k) + hPutSExpr h margin pp (preskelSrc k) itemid :: Int -> String itemid label = "i" ++ show label @@ -161,8 +164,8 @@ hPutStr h $ ", " ++ plural ++ ":" mapM_ (anchor h itemid) ls -hPutSExpr :: Handle -> Int -> SExpr Pos -> IO () -hPutSExpr h margin sexpr = +hPutSExpr :: Handle -> Int -> Printer Pos -> SExpr Pos -> IO () +hPutSExpr h margin pp sexpr = do hPutStrLn h "" hPutStrLn h $ show $ mc "pre" [] (pp margin indent sexpr) diff --git a/src/CPSA/Graph/LaTeXView.hs b/src/CPSA/Graph/LaTeXView.hs --- a/src/CPSA/Graph/LaTeXView.hs +++ b/src/CPSA/Graph/LaTeXView.hs @@ -1,4 +1,4 @@ --- Generates a text view of CPSA S-expressions as a LaTeX document. +-- Generates a text view of CPSA output as a LaTeX document. -- Copyright (c) 2009 The MITRE Corporation -- @@ -10,38 +10,40 @@ import System.IO import CPSA.Lib.CPSA (nats, SExpr, Pos) -import CPSA.Lib.Entry (writeSExpr) import CPSA.Graph.Loader import CPSA.Graph.Layout +type Printer a = Int -> Int -> SExpr a -> String + -- Main entry point -latexView :: Handle -> Int -> [SExpr Pos] -> [Preskel] -> IO () -latexView h margin cmts ps = +latexView :: Handle -> Int -> Printer Pos -> + [SExpr Pos] -> [Preskel] -> IO () +latexView h margin pp cmts ps = do hPutStrLn h "\\usepackage[matrix,arrow,curve]{xy}" hPutStrLn h "\\begin{document}" hPutStrLn h "\\begin{verbatim}" - mapM_ (writeSExpr h margin) cmts + mapM_ (writeItem h margin pp) cmts hPutStrLn h "\\end{verbatim}" - mapM_ (writeLnPreskel h margin) ps + mapM_ (writeLnPreskel h margin pp) ps hPutStrLn h "\n\\end{document}" hClose h return () -writeLnPreskel :: Handle -> Int -> Preskel -> IO () -writeLnPreskel h m k = +writeLnPreskel :: Handle -> Int -> Printer Pos -> Preskel -> IO () +writeLnPreskel h m pp k = do case parent k of -- Write protocol with first preskeleton Nothing -> do hPutStrLn h "\n\\begin{verbatim}" - writeSExpr h m (protSrc k) + writeItem h m pp (protSrc k) hPutStrLn h "\\end{verbatim}" Just _ -> return () hPutStrLn h (showString "\n\\paragraph{Label " $ shows (label k) "}\n") hPutStrLn h (show (matrix k)) hPutStrLn h "\n\\begin{verbatim}" - writeSExpr h m (preskelSrc k) + writeItem h m pp (preskelSrc k) hPutStrLn h "\\end{verbatim}" -- XY-pic output @@ -55,7 +57,7 @@ | Item { tag :: Maybe String, -- Maybe place text, else use bullet len :: Int, -- Length of the strand succession arrow -- Communication arrows, bend arrows - adj :: [(Int, Int, Bool)] } -- when bool is True + adj :: [(Int, Int, Bool, Bool)] } -- when second bool is True -- Construct the matrix for a preskeleton matrix :: Preskel -> Matrix @@ -72,11 +74,15 @@ Just v -> item c r v -- Grid point has content item c r v = let len = maybe 0 (\v'->rank (vnode v') - r) (next v) - adj = map (shift (c, r) . rankNode . vnode) (succs v) in + adj = map (style c r v) (succs v) in Item { tag = Nothing, len = len, adj = map (curve c r) adj } - curve c r (x, y) = -- Decide if an arrows is curved - (x, y, abs x > 1 && bend) + style c r src dst = + (msg src == msg dst, x, y) where + (x, y) = shift (c, r) $ rankNode $ vnode dst + curve c r (solid, x, y) = -- Decide if an arrows is curved + (x, y, solid, abs x > 1 && bend) + where bend = y /= 0 || any (obstruction c r) (between x) obstruction c r x = -- Is there an obstruction here? maybe False (const True) (lookup (c + x, r) alist) @@ -126,12 +132,15 @@ else id comm [] = id - comm ((x, y, bend) : cs) = + comm ((x, y, solid, bend) : cs) = showString ar . horiz x . vert y . showChar ']' . comm cs where - ar = if not bend then "\\ar[" - else if x > 0 then "\\ar@/_/[" - else "\\ar@/^/[" + curve = case () of + _ | not bend -> "[" + | x > 0 -> "@/_/[" + | otherwise -> "@/^/[" + style = if solid then "" else "@{-->}" + ar = "\\ar" ++ style ++ curve vert :: Int -> ShowS vert n = @@ -146,3 +155,12 @@ LT -> showChar 'l' . horiz (succ n) EQ -> id GT -> showChar 'r' . horiz (pred n) + +-- Writer +writeItem :: Handle -> Int -> Printer a -> SExpr a -> IO () +writeItem h margin pp sexpr = + hPutStrLn h (pp margin indent sexpr) + +-- S-expression pretty print parameters +indent :: Int +indent = 2 diff --git a/src/CPSA/Graph/Loader.hs b/src/CPSA/Graph/Loader.hs --- a/src/CPSA/Graph/Loader.hs +++ b/src/CPSA/Graph/Loader.hs @@ -45,14 +45,14 @@ data Inst = Inst { part :: String, -- Role name (empty if this is a listener) - mapping :: String, -- Environment (empty if this is a listener) - trace :: [String] } -- Transmit or reception directed terms + mapping :: SExpr Pos, -- Environment (empty if this is a listener) + trace :: Trace } -- Transmit or reception directed terms deriving Show -- A vertex v contains the information associated with the node -- (strand v, pos v). data Vertex = Vertex - { msg :: String, + { msg :: SExpr Pos, inst :: Inst, prev :: Maybe Vertex, -- Strand previous next :: Maybe Vertex, -- Strand next @@ -77,7 +77,7 @@ role v = part (inst v) -- Returns the env associated with the node -env :: Vertex -> String +env :: Vertex -> SExpr Pos env v = mapping (inst v) lastVertex :: Vertex -> Vertex @@ -126,7 +126,7 @@ return (reverse cmts, reverse ks) loadComments :: [SExpr Pos] -> [SExpr Pos] -> ([SExpr Pos], [SExpr Pos]) -loadComments cmts (cmt@(L _ (S _ "comment" : _)): xs) = +loadComments cmts (cmt@(L _ (S _ "comment" : _)): xs) = loadComments (cmt:cmts) xs loadComments cmts xs = (cmts, xs) @@ -204,9 +204,9 @@ loadInsts s top p tag insts cs (L pos (S _ "deflistener" : x) : xs) = case x of [term] -> - let e0 = show (L pos [S pos "recv", term]) in - let e1 = show (L pos [S pos "send", term]) in - let i = Inst { part = "", mapping = "", trace = [e0, e1] } in + let e0 = L pos [S pos "recv", term] in + let e1 = L pos [S pos "send", term] in + let i = Inst { part = "", mapping = L pos [], trace = [e0, e1] } in let (_, cs') = case cs of L _ c : cs' -> (c, cs') _ -> ([], []) in @@ -246,7 +246,7 @@ where initial = map head nodes -- The first node in each strand nodes = [ [ Vertex { - msg = msg, + msg = evtMsg evt, inst = inst, prev = getPrev (s, p), next = getNext ht (s, p), @@ -254,9 +254,11 @@ succs = getSuccs (s, p), strand = s, pos = p } | - (p, msg) <- zip [0..] (trace inst) ] | + (p, evt) <- zip [0..] (trace inst) ] | (s, inst) <- zip [0..] insts, let ht = length (trace inst) ] + evtMsg (L _ [S _ _, t]) = t + evtMsg x = x -- Handle bad syntax getNode (s, p) = nodes !! s !! p getPrev (s, p) | p > 0 = Just (getNode (s, p - 1)) @@ -312,7 +314,7 @@ True -> fail (shows pos "Bad height") False -> do - let mapping = show (L pos env) + let mapping = L pos env env <- loadMaplet env let evts = itrace env c (take ht trace) return Inst { part = role, @@ -320,12 +322,12 @@ trace = evts } -- Compute an instance's trace, using the traces output where possible. -itrace :: [(String, SExpr Pos)] -> [SExpr Pos] -> [SExpr Pos] -> [String] +itrace :: [(String, SExpr Pos)] -> [SExpr Pos] -> Trace -> Trace itrace _ _ [] = [] itrace env (c : cs) (_: rs) = - show c : itrace env cs rs + c : itrace env cs rs itrace env [] (r : rs) = - show (subst env r) : itrace env [] rs + subst env r : itrace env [] rs loadMaplet :: Monad m => [SExpr Pos] -> m [(String, SExpr Pos)] loadMaplet (L _ [S _ name, x] : xs) = diff --git a/src/CPSA/Graph/Main.hs b/src/CPSA/Graph/Main.hs --- a/src/CPSA/Graph/Main.hs +++ b/src/CPSA/Graph/Main.hs @@ -25,6 +25,7 @@ data Params = Params { file :: Maybe FilePath, -- Nothing specifies standard output format :: Format, -- Output format + prefix :: Bool, -- Use prefix notation? margin :: Int } -- Output line length deriving Show @@ -48,15 +49,17 @@ do hPutStrLn h "\\documentclass[12pt]{article}" hPutStrLn h ("% " ++ cpsaVersion) - latexView h (margin params) cmts preskels + let pp = printer (config False $ prefix params) + latexView h (margin params) pp cmts preskels _ -> do hPutStrLn h "" hPutStrLn h ("") case format params of - XML -> expandedView h (config False) + XML -> expandedView h (config False $ prefix params) (margin params) cmts preskels - SVG -> compactView h (config True) preskels + SVG -> compactView h (config True $ prefix params) + preskels LaTeX -> error "Bad case in main" readSExprs :: PosHandle -> IO [SExpr Pos] @@ -80,6 +83,7 @@ | Compact -- Select compact format in SVG | Text -- Select text format in LaTeX | Margin String -- Output line length + | InfixFlag -- Select output notation | Output String -- Output file name deriving Show @@ -92,41 +96,45 @@ Option ['l'] ["latex"] (NoArg Text) "use LaTeX format", Option ['m'] ["margin"] (ReqArg Margin "INT") ("set output margin (default " ++ show defaultMargin ++ ")"), + Option ['i'] ["infix"] (NoArg InfixFlag) "output uses infix notation", Option ['h'] ["help"] (NoArg Help) "show help message", Option ['v'] ["version"] (NoArg Info) "show version number" ] -- Interpret option flags interp :: [Flag] -> IO Params interp flags = - loop flags Nothing XML defaultMargin -- By default, no output file - where -- and use expanded format - loop [] file format margin = - return Params { file = file, - format = format, - margin = margin } - loop (Output name : flags) Nothing format margin = - loop flags (Just name) format margin - loop (Expanded : flags) file _ margin = - loop flags file XML margin - loop (Compact : flags) file _ margin = - loop flags file SVG margin - loop (Text : flags) file _ margin = - loop flags file LaTeX margin - loop (Margin value : flags) file format _ = + loop flags (Params { file = Nothing, -- By default, no output file + format = XML, -- and use expanded format + prefix = True, + margin = defaultMargin }) + where + loop [] params = return params + loop (Output name : flags) params + | file params == Nothing = + loop flags $ params { file = Just name } + loop (Expanded : flags) params = + loop flags $ params { format = XML } + loop (Compact : flags) params = + loop flags $ params { format = SVG } + loop (Text : flags) params = + loop flags $ params { format = LaTeX } + loop (InfixFlag : flags) params = + loop flags $ params { prefix = False } + loop (Margin value : flags) params = case readDec value of [(margin, "")] -> - loop flags file format margin + loop flags $ params { margin = margin } _ -> do msg <- usage options ["Bad value for margin\n"] abort msg - loop (Info : _) _ _ _ = + loop (Info : _) _ = success cpsaVersion - loop (Help : _) _ _ _ = + loop (Help : _) _ = do -- Show help then exit with success msg <- usage options [] success msg - loop _ _ _ _ = + loop _ _ = do -- Show help then exit with failure msg <- usage options ["Bad option combination\n"] abort msg @@ -134,8 +142,8 @@ -- Default configuration. The lengths are in points, however the more -- natural choice is a font relative unit of length such as ems, -- however FireFox doesn't support these units yet. -config :: Bool -> Config -config compact = +config :: Bool -> Bool -> Config +config compact prefix = Config { units = "pt", font = font, stroke = 0.08 * font, @@ -150,6 +158,7 @@ mx = 3.33 * font, my = 3.33 * font, br = 0.50 * font, - compact = compact} + compact = compact, + notation = if prefix then Prefix else Infix } where font = 12 diff --git a/src/CPSA/Graph/Preskeleton.hs b/src/CPSA/Graph/Preskeleton.hs --- a/src/CPSA/Graph/Preskeleton.hs +++ b/src/CPSA/Graph/Preskeleton.hs @@ -8,12 +8,31 @@ module CPSA.Graph.Preskeleton (kdraw) where +import CPSA.Lib.CPSA (SExpr, printMsg, printEnv) import CPSA.Graph.XMLOutput import CPSA.Graph.Config import CPSA.Graph.SVG import CPSA.Graph.Loader import CPSA.Graph.Layout +showMsg :: Config -> SExpr a -> String +showMsg conf x = + case notation conf of + Prefix -> show x + Infix -> printMsg margin indent x + +showEnv :: Config -> SExpr a -> String +showEnv conf x = + case notation conf of + Prefix -> show x + Infix -> printEnv margin indent x + +margin :: Int +margin = 1024 + +indent :: Int +indent = 0 + -- Compute a node's position. npos :: Config -> Rank -> Node -> (Float, Float) npos conf rank (s, p) = @@ -41,7 +60,7 @@ sameMsg :: Vertex -> Vertex -> Bool sameMsg src dest = - drop 6 (msg src) == drop 6 (msg dest) + msg src == msg dest -- Add a strand node addNode :: Config -> Preskel -> Rank -> [Element] -> Vertex -> [Element] @@ -49,7 +68,7 @@ let (x, y) = npos conf rank (vnode node) color = elem node (maybe [] id (unrealized k)) bullet = circ conf color x y - es = tooltip (msg node) [bullet] : elements + es = tooltip (showMsg conf $ msg node) [bullet] : elements es' = foldl (addEdge conf rank node x y) es (succs node) in maybe es' (addNode conf k rank es') (next node) @@ -59,7 +78,7 @@ if null r then es else - tooltip e [text conf x y r] : es + tooltip (showEnv conf e) [text conf x y r] : es where r = role node e = env node diff --git a/src/CPSA/Graph/Tree.hs b/src/CPSA/Graph/Tree.hs --- a/src/CPSA/Graph/Tree.hs +++ b/src/CPSA/Graph/Tree.hs @@ -8,7 +8,7 @@ module CPSA.Graph.Tree (Tree (..), Forest, forest, tree) where -import qualified Data.List as L +import qualified Data.Map as M import CPSA.Graph.XMLOutput import CPSA.Graph.Config import CPSA.Graph.SVG @@ -60,14 +60,12 @@ where loops t = -- Add in the other edges let k = vertex t in -- in the forest - makeTree k (map (duplicate k) (seen k)) - (map loops (children t)) - duplicate k tag = - case L.find (\k -> label k == tag) ks of - Just k -> makeTree k [] [] - Nothing -> - error ("Tree: Cannot find " ++ show tag ++ - " seen in skeleton " ++ show (label k)) + makeTree k (duplicates k) (map loops (children t)) + duplicates k = + [ makeTree k' [] [] + | tag <- seen k, + k' <- maybe [] (:[]) (M.lookup tag table) ] + table = M.fromList $ map (\k -> (label k, k)) ks -- Compute the spanning forest of the preskeletons spanning :: [Preskel] -> Forest diff --git a/src/CPSA/Lib/CPSA.hs b/src/CPSA/Lib/CPSA.hs --- a/src/CPSA/Lib/CPSA.hs +++ b/src/CPSA/Lib/CPSA.hs @@ -21,6 +21,7 @@ module CPSA.Lib.SExpr, module CPSA.Lib.Printer, module CPSA.Lib.Pretty, + module CPSA.Lib.Notation, module CPSA.Lib.Algebra, Event (..), flow) where @@ -28,5 +29,6 @@ import CPSA.Lib.SExpr import CPSA.Lib.Pretty import CPSA.Lib.Printer +import CPSA.Lib.Notation import CPSA.Lib.Algebra import CPSA.Lib.Protocol(Event (..), flow) diff --git a/src/CPSA/Lib/Cohort.hs b/src/CPSA/Lib/Cohort.hs --- a/src/CPSA/Lib/Cohort.hs +++ b/src/CPSA/Lib/Cohort.hs @@ -22,7 +22,7 @@ import qualified CPSA.Lib.Utilities as U z :: Show a => a -> b -> b -z x y = seq (unsafePerformIO (print x)) y +z x y = unsafePerformIO (print x >> return y) zz :: Show a => a -> a zz x = z x x @@ -73,6 +73,10 @@ useMguFilter :: Bool useMguFilter = True +-- Use pruning during generalization. +usePruningDuringGeneralization :: Bool +usePruningDuringGeneralization = False + -- Penetrator derivable predicate and checking for unrealized skeletons. derivable :: Algebra t p g s e c => Set t -> Set t -> t -> Bool @@ -163,7 +167,7 @@ maybeSolved ct pos ek escape k n subst = not useSolvedFilter || solved ct pos ek escape k n subst -data Mode = Mode +data Mode = Mode { noGeneralization :: Bool, addDisplacements :: Bool, nonceFirstOrder :: Bool, @@ -182,7 +186,7 @@ where ss = strandVisitOrder mode (strands k) (a, u) = avoid k - whenRealized k = + whenRealized k = if noGeneralization mode then [] else realizedReductions k strandVisitOrder :: Mode -> [a] -> [a] @@ -541,7 +545,7 @@ | not (preskelWellFormed k') = Nothing | otherwise = do - k'' <- toSkeleton False k' + k'' <- toSkeleton usePruningDuringGeneralization k' case realized k'' && gist k /= gist k'' && refines k'' (pov k'') (prob k'') && refines k (Just k') mapping of diff --git a/src/CPSA/Lib/Entry.hs b/src/CPSA/Lib/Entry.hs --- a/src/CPSA/Lib/Entry.hs +++ b/src/CPSA/Lib/Entry.hs @@ -59,8 +59,10 @@ usage options errs = do name <- getProgName + datadir <- getDataDir let header = "Usage: " ++ name ++ " [OPTIONS] [FILE]" - return (concat errs ++ usageInfo header options) + let footer = "\nDocumentation directory: " ++ datadir + return (concat errs ++ usageInfo header options ++ footer) readSExpr :: PosHandle -> IO (Maybe (SExpr Pos)) readSExpr p = diff --git a/src/CPSA/Lib/Loader.hs b/src/CPSA/Lib/Loader.hs --- a/src/CPSA/Lib/Loader.hs +++ b/src/CPSA/Lib/Loader.hs @@ -20,7 +20,7 @@ {-- import System.IO.Unsafe z :: Show a => a -> b -> b -z x y = seq (unsafePerformIO (print x)) y +z x y = unsafePerformIO (print x >> return y) --} -- Load protocols and preskeletons from a list of S-expressions, and diff --git a/src/CPSA/Lib/Main.hs b/src/CPSA/Lib/Main.hs --- a/src/CPSA/Lib/Main.hs +++ b/src/CPSA/Lib/Main.hs @@ -215,7 +215,7 @@ margin = defaultMargin } where loop [] params = return params - loop (Output name : flags) params + loop (Output name : flags) params | file params == Nothing = loop flags $ params { file = Just name } loop (Limit value : flags) params = diff --git a/src/CPSA/Lib/Notation.hs b/src/CPSA/Lib/Notation.hs new file mode 100644 --- /dev/null +++ b/src/CPSA/Lib/Notation.hs @@ -0,0 +1,305 @@ +-- 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. + +module CPSA.Lib.Notation (printItem, printMsg, printEnv) where + +import CPSA.Lib.Pretty +import CPSA.Lib.SExpr + +-- Top-level pretty printer within specified margin. +printItem :: Int -> Int -> SExpr a -> String +printItem margin indent sexpr = + pr margin (item indent sexpr) "" + +-- Message pretty printer within specified margin. +printMsg :: Int -> Int -> SExpr a -> String +printMsg margin indent sexpr = + pr margin (mesg indent sexpr) "" + +-- Environment pretty printer within specified margin. +printEnv :: Int -> Int -> SExpr a -> String +printEnv margin indent sexpr = + pr margin (env indent sexpr) "" + where + env indent (L _ xs) = blo indent $ str "(" : aft "," ")" + ( map (maplet indent) xs) + env indent x = generic indent x + +type Printer a = Int -> SExpr a -> Pretty + +-- Print a top-level form +item :: Printer a +item indent (L _ (S _ "comment" : xs)) = + blo indent $ str "comment " : aft "" ";" (map (generic indent) xs) +item indent (L _ (S _ "defprotocol" : S _ name : S _ alg : body)) = + protocol indent name alg body +item indent (L _ (S _ "defskeleton" : S _ name : + L _ (S _ "vars" : decls) : body)) = + skeleton indent name decls body +item indent x = generic indent x + +-- Print a generic list. Used when there is a syntax error. +generic :: Printer a +generic _ (S _ s) = str s +generic _ (Q _ s) = str (showQuoted s "") +generic _ (N _ n) = str (show n) +generic indent (L _ xs) = + blo indent $ str "[" : aft "," "]" (map (generic indent) xs) + +-- Add a separator and a final symbol to a list of Pretty's. +-- A break point is inserted after each separator. +aft :: String -> String -> [Pretty] -> [Pretty] +aft _ end [] = [str end] +aft _ end [p] = [p, str end] +aft sep end (p:ps) = + p : str sep : brk 1 : aft sep end ps + +-- Print a protocol +protocol :: Int -> String -> String -> [SExpr a] -> Pretty +protocol indent name alg body = + grp indent $ header : brk 1 : aft "" "}" (map (alist indent) body) + where + header = str ("prot " ++ name ++ " " ++ alg ++ " {") + +-- Print a skeleton +skeleton :: Int -> String -> [SExpr a] -> [SExpr a] -> Pretty +skeleton indent name decls body = + grp indent $ header : brk 1 : aft "" "}" (map (alist indent) body) + where + start = str ("skel " ++ name ++ "(") + header = blo (2 * indent) $ start : aft ";" ") {" + (map (decl indent) decls) + +-- A vars list is written with the sort first, followed by the variables. +-- Thus ((a b text) (k skey)) => (text a, b; skey k) +decl :: Int -> SExpr a -> Pretty +decl indent (L _ xs@(_:_:_)) = + blo indent $ sort : str " " : aft "," "" vars + where + (sort, vars) = split [] xs + split vars [S _ sort] = (str sort, reverse vars) + split vars (S _ var: xs) = split (str var : vars) xs + split _ _ = error "split: bad arg" +decl indent x = generic indent x + +-- Association lists + +-- The body of a protocol, role, and skeleton is an association list. +-- Each element of the list is a symbol followed by a list. + +-- One function is used to process association lists even though a +-- role declaration may not occur in a skeleton or a role, and a +-- precedes declaration may not appear in a role or a protocol. + +alist :: Printer a +alist _ (L _ [S _ key]) = + str (key ++ ";") +alist indent (L _ (S _ "defrole" : S _ name : + L _ (S _ "vars" : decls) : + L a (S _ "trace" : trace) : body)) = + role indent name decls (L a trace) body +alist indent (L _ (S _ "defstrand" : S _ name : N _ height : env)) = + strand indent name height (map (maplet indent) env) +alist indent x@(L _ (S _ "operation" : _)) = + operation indent x +alist indent x@(L _ (S _ key : _)) + | key == "annotations" || key == "obligations" = + annotations indent x +alist indent (L _ (S _ key : xs)) + | key == "non-orig" || key == "uniq-orig" || + key == "deflistener" || key == "parameters" = + values indent mesg key xs + | key == "precedes" = + values indent order key xs + | key == "unrealized" = + values indent node key xs + | key == "traces" = + grp indent $ str key : brk 1 : aft "," ";" (map (trace indent) xs) + | otherwise = + values indent generic key xs +alist indent x = generic indent x + +-- Show the values associated with a key using the given printer. +values :: Int -> Printer a -> String -> [SExpr a] -> Pretty +values indent printer key values = + blo indent $ str key : str " " : aft "," ";" (map (printer indent) values) + +-- Print a role +role :: Int -> String -> [SExpr a] -> SExpr a -> [SExpr a] -> Pretty +role indent name decls tr body = + grp indent $ header : brk 1 : aft "" "}" rest + where + start = str ("role " ++ name ++ "(") + header = blo (2 * indent) $ start : aft ";" ") {" + (map (decl indent) decls) + rest = trace indent tr : map (alist indent) body + +-- Print a trace +trace :: Printer a +trace indent (L _ xs) = + blo 1 $ str "[" : aft "," "]" (map (event indent) xs) +trace indent x = generic indent x + +-- Print an event +event :: Printer a +event indent (L _ [S _ "send", x]) = blo 0 [str "+", mesg indent x] +event indent (L _ [S _ "recv", x]) = blo 0 [str "-", mesg indent x] +event indent x = generic indent x + +-- Print a term in the Basic Crypto Algebra in compact form. + +-- (enc a b ... z) => E(z; a, b, ...) +-- (cat a b ... z) => (a, b, ..., z) +-- (pubk a) => K(a) +-- (invk a) => I(a) +-- (privk a) => I(K(a)) +-- (ltk a b) => S(a, b) +mesg :: Printer a +mesg indent (L _ (S _ "enc" : xs@(_:_:_))) = + blo indent $ str "E(" : mesg indent key : str ";" : brk 1 : + aft "," ")" (map (mesg indent) plaintext) + where + (key, plaintext) = rotate xs +mesg indent (L a (S b "privk" : xs)) = + mesg indent (L a [S b "invk", L a (S b "pubk" : xs)]) +mesg indent (L _ (S _ name : xs)) + | name == "cat" = + fun indent "" args + | name == "pubk" = + fun indent "K" args + | name == "invk" = + fun indent "I" args + | name == "ltk" = + fun indent "S" args + | otherwise = + fun indent name args + where + args = map (mesg indent) xs +mesg indent (L _ xs@[N _ _, _]) = + fun indent "" $ map (mesg indent) xs +mesg indent x = generic indent x + +-- Print generic function application +fun :: Int -> String -> [Pretty] -> Pretty +fun indent name args = + blo indent $ str name : str "(" : aft "," ")" args + +-- Get last element of list and list without last element +rotate :: [a] -> (a, [a]) +rotate (x:xs) = + loop [] x xs + where + loop xs x [] = (x, reverse xs) + loop ys y (x:xs) = loop (y:ys) x xs +rotate [] = error "rotate: bad arg" + +-- Print a node ordering +order :: Printer a +order indent (L _ [x, y]) = + blo indent [node indent x, str " < ", node indent y] +order indent x = generic indent x + +-- Print a node +node :: Printer a +node _ (L _ [N _ s, N _ i]) = + str ("(" ++ show s ++ ", " ++ show i ++ ")") +node indent x = generic indent x + +-- Print a maplet +maplet :: Printer a +maplet indent (L _ [x, y]) = + blo indent [mesg indent x, str " -> ", mesg indent y] +maplet indent x = generic indent x + +-- Print a strand +strand :: Int -> String -> Int -> [Pretty] -> Pretty +strand _ role height [] = + str ("strand " ++ role ++ "(" ++ show height ++ ");") +strand indent role height env = + blo indent $ header : brk 1 : aft "," ");" env + where + header = str ("strand " ++ role ++ "(" ++ show height ++ ";") + +-- Print an operation +operation :: Printer a +operation indent (L _ (S _ "operation" : S _ direction : op : + critical : test : escape)) + | direction == "encryption-test" || direction == "nonce-test" = + blo indent $ aft "" ";" body + where + body = [str "operation", str direction, solve indent op, + mesg indent critical, node indent test, set] + set = blo 1 $ str "{" : aft "," "}" (map (mesg indent) escape) +operation indent (L _ (S _ "operation" : S _ "generalization" : desc)) = + blo indent $ aft "" ";" [str "operation", str "generalization", + generalization indent desc] +operation indent (L _ (S _ "operation" : xs)) = + blo indent $ aft "" ";" $ str "operation" : (map (generic indent) xs) +operation indent x = generic indent x + +-- Print authentication test solving operation +solve :: Printer a +solve indent (L _ (S _ "contracted" : xs)) = + blo indent $ str "contracted(" : aft "," ")" (map (maplet indent) xs) +solve indent (L _ (S _ "displaced" : xs)) = + blo indent $ str "displaced(" : aft "," ")" (map (generic indent) xs) +solve indent (L _ (S _ "added-strand" : xs)) = + blo indent $ str "added-strand(" : aft "," ")" (map (generic indent) xs) +solve indent (L _ [S _ "added-listener", t]) = + blo indent $ [str "added-listener(", mesg indent t, str ")"] +solve indent x = generic indent x + +-- Print generalization method +generalization :: Int -> [SExpr a] -> Pretty +generalization indent [S _ "deleted", n] = + blo indent [str "deleted ", node indent n] +generalization indent [S _ "weakened", o] = + blo indent [str "weakened ", order indent o] +generalization indent [S _ "separated", t] = + blo indent [str "separated ", mesg indent t] +generalization indent [S _ "forgot", t] = + blo indent [str "forgot ", mesg indent t] +generalization indent xs = + blo indent $ aft "" "" (map (generic indent) xs) + +-- Annotations + +-- Print an annotation +annotations :: Printer a +annotations indent (L _ (S _ key : + (xs@(L _ (L _ [N _ _, N _ _] : _) : _)))) = + grp indent $ str key : brk 1 : aft "," ";" (map (obligation indent) xs) +annotations indent (L _ (S _ key : term : formulas)) = + blo indent $ str key : brk 1 : mesg indent term : + str "," : brk 1 : aft "," ";" (map (numform indent) formulas) +annotations indent x = generic indent x + +numform :: Printer a +numform indent (L _ [n@(N _ _), f]) = + blo indent [str "(", mesg indent n, str ",", brk 1, + form indent f, str ")"] +numform indent x = generic indent x + +obligation :: Printer a +obligation indent (L _ [n, term, formula]) = + blo indent [str "[", node indent n, str ",", brk 1, mesg indent term, + str ",", brk 1, form indent formula, str "]"] +obligation indent x = generic indent x + +-- Print a formula +form :: Printer a +form indent (L _ [S _ "implies", h, c]) = + blo indent [mesg indent h, brk 1, str "implies", brk 1, mesg indent c] +form indent (L _ (S _ "implies" : xs@(_:_:_:_))) = + grp 0 [lhs, brk 1, str "implies", brk 1, mesg indent concl] + where + lhs = grp indent $ str "and(" : brk 0 : + aft "," ")" (map (mesg indent) hypoth) + (concl, hypoth) = rotate xs +form indent x = + mesg indent x diff --git a/src/CPSA/Lib/SExpr.hs b/src/CPSA/Lib/SExpr.hs --- a/src/CPSA/Lib/SExpr.hs +++ b/src/CPSA/Lib/SExpr.hs @@ -20,7 +20,14 @@ | Q !a !String -- A quoted string | N !a !Int -- An integer | L !a ![SExpr a] -- A proper list - deriving Eq + +-- Equality ignores position annotations +instance Eq (SExpr a) where + S _ s == S _ s' = s == s' + Q _ s == Q _ s' = s == s' + N _ n == N _ n' = n == n' + L _ xs == L _ xs' = xs == xs' + _ == _ = False -- Printing support diff --git a/src/CPSA/Lib/Strand.hs b/src/CPSA/Lib/Strand.hs --- a/src/CPSA/Lib/Strand.hs +++ b/src/CPSA/Lib/Strand.hs @@ -30,7 +30,7 @@ {-- import System.IO.Unsafe z :: Show a => a -> b -> b -z x y = seq (unsafePerformIO (print x)) y +z x y = unsafePerformIO (print x >> return y) zz :: Show a => a -> a zz x = z x x @@ -69,6 +69,12 @@ useCheckVars :: Bool useCheckVars = False +usePruningDuringCollapsing :: Bool +usePruningDuringCollapsing = False + +usePruningWhileSolving :: Bool +usePruningWhileSolving = False + -- Instances and Strand Identifiers -- An Instance is an instance of a role, in the sense that each @@ -1027,30 +1033,32 @@ maybe (pruneStrands prs (s:ss) ss') -- Try next pair prune -- Success (pruneStrand prs s s') - where - -- A strand is redundant if there is an environment that maps - -- the trace of s into a prefix of the trace of s', but changes - -- no other traces in the preskeleton. - pruneStrand prs@(k, _, _) s s' = - do - env <- matchTraces - (trace (strandInst k s)) - (trace (strandInst k s')) - (gen k, emptyEnv) - (gen', env') <- idempotentEnvFor env - (concatMap (tterms . trace) $ deleteNth s $ insts k) - case matchRenaming (gen', env') of - True -> return () - False -> Nothing - case origCheck k env' of - True -> return () - False -> Nothing - case all (precedesCheck k s s') (edges k) of - True -> return () - False -> Nothing - prs <- ksubst prs (gen', substitution env') - compress prs s s' +-- A strand is redundant if there is an environment that maps +-- the trace of s into a prefix of the trace of s', but changes +-- no other traces in the preskeleton. +pruneStrand :: Algebra t p g s e c => PRS t p g s e c -> + Sid -> Sid -> Maybe (PRS t p g s e c) +pruneStrand prs@(k, _, _) s s' = + do + env <- matchTraces + (trace (strandInst k s)) + (trace (strandInst k s')) + (gen k, emptyEnv) + (gen', env') <- idempotentEnvFor env + (concatMap (tterms . trace) $ deleteNth s $ insts k) + case matchRenaming (gen', env') of + True -> return () + False -> Nothing + case origCheck k env' of + True -> return () + False -> Nothing + case all (precedesCheck k s s') (edges k) of + True -> return () + False -> Nothing + prs <- ksubst prs (gen', substitution env') + compress prs s s' + matchTraces :: Algebra t p g s e c => Trace t p g s e c -> Trace t p g s e c -> (g, e) -> Maybe (g, e) matchTraces [] _ env = Just env -- Pattern can be shorter @@ -1121,39 +1129,49 @@ do prs <- ksubst (k { operation = Contracted emptySubst cause }, n, emptySubst) subst - hull True prs + hull usePruningWhileSolving prs -- Regular Augmentation --- Apply a substitution and then augment. Augmentations add an --- instance and one ordered pair. - +-- First argument determines if displacement is used. augment :: Algebra t p g s e c => Bool -> Preskel t p g s e c -> Node -> Cause t p g s e c -> Role t p g s e c -> (g, s) -> Instance t p g s e c -> [PRS t p g s e c] -augment useDisplacement k0 n cause role subst inst = - case substAndAugment useDisplacement k0 n cause role subst inst of +augment True k0 n cause role subst inst = + augmentAndDisplace k0 n cause role subst inst +augment False k0 n cause role subst inst = + augmentOnly k0 n cause role subst inst + +-- Apply a substitution, and then augment and displace. Augmentations +-- add an instance and one ordered pair. Displacements add an ordered +-- pair and may add nodes. + +augmentAndDisplace :: Algebra t p g s e c => Preskel t p g s e c -> + Node -> Cause t p g s e c -> Role t p g s e c -> + (g, s) -> Instance t p g s e c -> [PRS t p g s e c] +augmentAndDisplace k0 n cause role subst inst = + case substAndAugment k0 n cause role subst inst of Nothing -> [] Just prs@(k, n, hsubst) -> - case useDisplacement of - False -> [prs] - True -> - case hull True prs of - Nothing -> augDisplace k0 k n hsubst - Just prs -> prs : augDisplace k0 k n hsubst + case hullForAugmentation k0 prs of + Nothing -> augDisplace k0 k n hsubst + Just prs -> prs : augDisplace k0 k n hsubst -substAndAugment :: Algebra t p g s e c => Bool -> Preskel t p g s e c -> +-- Apply the substitution and apply augmentation operator. +substAndAugment :: Algebra t p g s e c => Preskel t p g s e c -> Node -> Cause t p g s e c -> Role t p g s e c -> (g, s) -> Instance t p g s e c -> Maybe (PRS t p g s e c) -substAndAugment useDisplacement k n cause role subst inst = +substAndAugment k n cause role subst inst = do let operation' = AddedStrand (rname role) (height inst) cause prs <- ksubst (k { operation = operation' }, n, emptySubst) subst - aug useDisplacement prs inst + aug prs inst -aug :: Algebra t p g s e c => Bool -> PRS t p g s e c -> +-- Apply the augmentation operator by adding an instance and one +-- ordered pair. +aug :: Algebra t p g s e c => PRS t p g s e c -> Instance t p g s e c -> Maybe (PRS t p g s e c) -aug useDisplacement (k, n, hsubst) inst = +aug (k, n, hsubst) inst = do let insts' = (insts k) ++ [inst] let pair = ((length (insts k), height inst - 1), n) @@ -1163,12 +1181,7 @@ let k' = newPreskel (gen k) (protocol k) insts' orderings' non' unique' (operation k) (prob k) (pov k) k' <- wellFormedPreskel k' - case useDisplacement of - False -> - do - (k', n, hsubst) <- augCollapses k (k', n, hsubst) (nstrands k) - hull True (k', n, hsubst) - True -> return (k', n, hsubst) + return (k', n, hsubst) -- Inherit non-originating atoms if the traces is long enough inheritRnon :: Algebra t p g s e c => Instance t p g s e c -> [t] @@ -1186,15 +1199,65 @@ where f (_, pos) = pos < height i +-- Add all displacements +augDisplace :: Algebra t p g s e c => Preskel t p g s e c -> + Preskel t p g s e c -> Node -> s -> [PRS t p g s e c] +augDisplace k0 k n hsubst = + let s = nstrands k - 1 in + [k' | s' <- nats s, + k' <- M.maybeToList $ augDisplaceStrands k0 k n hsubst s s'] + +-- Try to displace with strand s' +augDisplaceStrands :: Algebra t p g s e c => Preskel t p g s e c -> + Preskel t p g s e c -> Node -> s -> + Sid -> Sid -> Maybe (PRS t p g s e c) +augDisplaceStrands k0 k n hsubst s s' = + do + (s, s', subst) <- unifyStrands k s s' + let op = addedToDisplaced (operation k) s s' + prs <- augSubst k0 (k { operation = op}, n, hsubst) subst + prs <- compress prs s s' + hull usePruningWhileSolving prs + +addedToDisplaced :: Algebra t p g s e c => Operation t p g s e c -> + Int -> Int -> Operation t p g s e c +addedToDisplaced (AddedStrand role height cause) s s' = + Displaced s s' role height cause +addedToDisplaced _ _ _ = error "Strand.addedToDisplaced: Bad operation" + +-- Apply a substitution and then augment. Augmentations add an +-- instance and one ordered pair. + +augmentOnly :: Algebra t p g s e c =>Preskel t p g s e c -> + Node -> Cause t p g s e c -> Role t p g s e c -> + (g, s) -> Instance t p g s e c -> [PRS t p g s e c] +augmentOnly k0 n cause role subst inst = + case substAndAugment k0 n cause role subst inst of + Nothing -> [] + Just prs -> M.maybeToList $ hullForAugmentation k0 prs + +hullForAugmentation :: Algebra t p g s e c => Preskel t p g s e c -> + PRS t p g s e c -> Maybe (PRS t p g s e c ) +hullForAugmentation k prs = + do + prs' <- augCollapses k prs (nstrands k) + hull usePruningWhileSolving prs' + +-- The augmented strand can be collapsed either by hulling or pruning. augCollapses :: Algebra t p g s e c => Preskel t p g s e c -> PRS t p g s e c -> Sid -> Maybe (PRS t p g s e c ) augCollapses k0 prs@(k, _, _) s = case findCollapses k s of - s':_ -> + s':_ -> -- Try hulling do (_, _, subst) <- unifyStrands k s s' augSubst k0 prs subst - _ -> return prs + _ | usePruningWhileSolving -> + return prs + | otherwise -> -- Try pruning + do + prs' <- hull False prs + return $ pruneAugStrand prs' s -- Find the strands that share an origination point with s findCollapses :: Algebra t p g s e c => Preskel t p g s e c -> Sid -> [Sid] @@ -1205,6 +1268,25 @@ s' <- ss, s' /= s] +pruneAugStrand :: Algebra t p g s e c => PRS t p g s e c -> + Sid -> PRS t p g s e c +pruneAugStrand prs@(k, _, _) s = + if s >= nstrands k then + prs + else + loop $ strandids k + where + loop [] = prs + loop (s' : ss) + | s' == s = loop ss + | otherwise = + case pruneStrand prs s s' of + Just prs -> prs + Nothing -> + case pruneStrand prs s' s of + Just prs -> prs + Nothing -> loop ss + augSubst :: Algebra t p g s e c => Preskel t p g s e c -> PRS t p g s e c -> (g, s) -> Maybe (PRS t p g s e c) augSubst k0 (k, n, hsubst) (gen, subst) = @@ -1221,30 +1303,6 @@ True -> return (k', n, hsubst') False -> Nothing -augDisplace :: Algebra t p g s e c => Preskel t p g s e c -> - Preskel t p g s e c -> Node -> s -> [PRS t p g s e c] -augDisplace k0 k n hsubst = - let s = nstrands k - 1 in - [k' | s' <- nats s, - k' <- M.maybeToList $ augDisplaceStrands k0 k n hsubst s s'] - -augDisplaceStrands :: Algebra t p g s e c => Preskel t p g s e c -> - Preskel t p g s e c -> Node -> s -> - Sid -> Sid -> Maybe (PRS t p g s e c) -augDisplaceStrands k0 k n hsubst s s' = - do - (s, s', subst) <- unifyStrands k s s' - let op = addedToDisplaced (operation k) s s' - prs <- augSubst k0 (k { operation = op}, n, hsubst) subst - prs <- compress prs s s' - hull True prs - -addedToDisplaced :: Algebra t p g s e c => Operation t p g s e c -> - Int -> Int -> Operation t p g s e c -addedToDisplaced (AddedStrand role height cause) s s' = - Displaced s s' role height cause -addedToDisplaced _ _ _ = error "Strand.addedToDisplaced: Bad operation" - -- Listener Augmentation addListener :: Algebra t p g s e c => Preskel t p g s e c -> Node -> @@ -1252,7 +1310,7 @@ addListener k n cause t = do k' <- wellFormedPreskel k' - hull True (k', n, emptySubst) + hull usePruningWhileSolving (k', n, emptySubst) where k' = newPreskel gen' (protocol k) insts' orderings' (knon k) (kunique k) (AddedListener t cause) (prob k) (pov k) @@ -1649,5 +1707,5 @@ prs <- ksubst (k { operation = Collapsed s s' }, (0, 0), emptySubst) subst prs <- compress prs s s' - (k, _, _) <- hull True prs + (k, _, _) <- hull usePruningDuringCollapsing prs return k diff --git a/src/CPSA/Pretty/Main.hs b/src/CPSA/Pretty/Main.hs --- a/src/CPSA/Pretty/Main.hs +++ b/src/CPSA/Pretty/Main.hs @@ -8,18 +8,38 @@ module Main (main) where +import Numeric import System.IO +import System.Console.GetOpt import CPSA.Lib.CPSA import CPSA.Lib.Entry +-- Runtime parameters + +data Params = Params + { file :: Maybe FilePath, -- Nothing specifies standard output + prefix :: Bool, -- Use prefix notation? + margin :: Int } -- Output line length + deriving Show + +indent :: Int +indent = 2 + main :: IO () main = do - (p, (output, margin)) <- start filterOptions filterInterp - h <- outputHandle output - go (writeSEexprLn h margin) p + (p, params) <- start options interp + h <- outputHandle $ file params + let printer = if prefix params then pp else printItem + go (writeCpsaLn (printer (margin params) indent) h) p hClose h +writeCpsaLn :: (SExpr a -> String) -> Handle -> SExpr a -> IO () +writeCpsaLn printer h sexpr = + do + hPutStrLn h $ printer sexpr + hPutStrLn h "" + go :: (SExpr Pos -> IO ()) -> PosHandle -> IO () go f p = loop @@ -35,8 +55,52 @@ f sexpr loop -writeSEexprLn :: Handle -> Int -> SExpr a -> IO () -writeSEexprLn h margin sexpr = - do - writeSExpr h margin sexpr - hPutStrLn h "" +-- Command line option flags +data Flag + = Help -- Help + | Info -- Version information + | Margin String -- Output line length + | Infix -- Select output notation + | Output String -- Output file name + deriving Show + +options :: [OptDescr Flag] +options = + [ Option ['o'] ["output"] (ReqArg Output "FILE") "output FILE", + Option ['m'] ["margin"] (ReqArg Margin "INT") + ("set output margin (default " ++ show defaultMargin ++ ")"), + Option ['i'] ["infix"] (NoArg Infix) "output uses infix notation", + Option ['h'] ["help"] (NoArg Help) "show help message", + Option ['v'] ["version"] (NoArg Info) "show version number" ] + +-- Interpret option flags +interp :: [Flag] -> IO Params +interp flags = + loop flags (Params { file = Nothing, -- By default, no output file + prefix = True, + margin = defaultMargin }) + where + loop [] params = return params + loop (Output name : flags) params + | file params == Nothing = + loop flags $ params { file = Just name } + loop (Infix : flags) params = + loop flags $ params { prefix = False } + loop (Margin value : flags) params = + case readDec value of + [(margin, "")] -> + loop flags $ params { margin = margin } + _ -> + do + msg <- usage options ["Bad value for margin\n"] + abort msg + loop (Info : _) _ = + success cpsaVersion + loop (Help : _) _ = + do -- Show help then exit with success + msg <- usage options [] + success msg + loop _ _ = + do -- Show help then exit with failure + msg <- usage options ["Bad option combination\n"] + abort msg diff --git a/tst/blanchet.scm b/tst/blanchet.scm --- a/tst/blanchet.scm +++ b/tst/blanchet.scm @@ -12,34 +12,40 @@ (defskeleton blanchet (vars (a b name) (s skey) (d text)) - (defstrand resp 2 (a a) (b b) (s s) (d d)) + (defstrand init 2 (a a) (b b) (s s) (d d)) (non-orig (privk a) (privk b)) (uniq-orig s)) (defskeleton blanchet (vars (a b name) (s skey) (d text)) + (defstrand init 2 (a a) (b b) (s s) (d d)) + (deflistener d) + (non-orig (privk a) (privk b)) + (uniq-orig s d)) + +(defskeleton blanchet + (vars (a b name) (s skey) (d text)) (defstrand resp 2 (a a) (b b) (s s) (d d)) - (deflistener s) (non-orig (privk a) (privk b)) (uniq-orig s)) (defskeleton blanchet (vars (a b name) (s skey) (d text)) - (defstrand init 2 (a a) (b b) (s s) (d d)) - (deflistener s) + (defstrand resp 2 (a a) (b b) (s s) (d d)) + (deflistener d) (non-orig (privk a) (privk b)) - (uniq-orig s)) + (uniq-orig s d)) (defskeleton blanchet (vars (a b name) (s skey) (d text)) - (defstrand init 2 (a a) (b b) (s s) (d d)) - (deflistener s) + (defstrand resp 2 (a a) (b b) (s s) (d d)) + (deflistener d) (non-orig (privk a)) - (uniq-orig s)) + (uniq-orig s d)) (defskeleton blanchet (vars (a b name) (s skey) (d text)) (defstrand init 2 (a a) (b b) (s s) (d d)) - (deflistener s) - (non-orig (privk a)) + (deflistener d) + (non-orig (privk b)) (uniq-orig s d)) diff --git a/tst/blanchet.tst b/tst/blanchet.tst --- a/tst/blanchet.tst +++ b/tst/blanchet.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol blanchet basic @@ -11,27 +11,57 @@ (defskeleton blanchet (vars (d text) (a b name) (s skey)) - (defstrand resp 2 (d d) (a a) (b b) (s s)) + (defstrand init 2 (d d) (a a) (b b) (s s)) (non-orig (privk a) (privk b)) (uniq-orig s) - (traces ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s)))) + (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s)))) (label 0) - (unrealized (0 0)) - (comment "1 in cohort - 1 not yet seen")) + (unrealized (0 1)) + (comment "2 in cohort - 2 not yet seen")) (defskeleton blanchet - (vars (d text) (a b b-0 name) (s skey)) - (defstrand resp 2 (d d) (a a) (b b) (s s)) - (defstrand init 1 (a a) (b b-0) (s s)) - (precedes ((1 0) (0 0))) + (vars (d text) (a b a-0 b-0 name) (s skey)) + (defstrand init 2 (d d) (a a) (b b) (s s)) + (defstrand resp 2 (d d) (a a-0) (b b-0) (s s)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) (non-orig (privk a) (privk b)) (uniq-orig s) - (operation encryption-test (added-strand init 1) (enc s (privk a)) - (0 0)) - (traces ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s))) - ((send (enc (enc s (privk a)) (pubk b-0))))) + (operation encryption-test (added-strand resp 2) (enc d s) (0 1)) + (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) + ((recv (enc (enc s (privk a-0)) (pubk b-0))) (send (enc d s)))) (label 1) (parent 0) + (unrealized (1 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton blanchet + (vars (d text) (a b name) (s skey)) + (defstrand init 2 (d d) (a a) (b b) (s s)) + (deflistener s) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (privk a) (privk b)) + (uniq-orig s) + (operation encryption-test (added-listener s) (enc d s) (0 1)) + (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) + ((recv s) (send s))) + (label 2) + (parent 0) + (unrealized (1 0)) + (comment "empty cohort")) + +(defskeleton blanchet + (vars (d text) (a b name) (s skey)) + (defstrand init 2 (d d) (a a) (b b) (s s)) + (defstrand resp 2 (d d) (a a) (b b) (s s)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (privk a) (privk b)) + (uniq-orig s) + (operation nonce-test (contracted (a-0 a) (b-0 b)) s (1 0) + (enc (enc s (privk a)) (pubk b))) + (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) + ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s)))) + (label 3) + (parent 1) (unrealized) (shape)) @@ -47,30 +77,120 @@ (defskeleton blanchet (vars (d text) (a b name) (s skey)) + (defstrand init 2 (d d) (a a) (b b) (s s)) + (deflistener d) + (non-orig (privk a) (privk b)) + (uniq-orig d s) + (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) + ((recv d) (send d))) + (label 4) + (unrealized (0 1)) + (comment "2 in cohort - 2 not yet seen")) + +(defskeleton blanchet + (vars (d text) (a b a-0 b-0 name) (s skey)) + (defstrand init 2 (d d) (a a) (b b) (s s)) + (deflistener d) + (defstrand resp 2 (d d) (a a-0) (b b-0) (s s)) + (precedes ((0 0) (2 0)) ((2 1) (0 1)) ((2 1) (1 0))) + (non-orig (privk a) (privk b)) + (uniq-orig d s) + (operation encryption-test (added-strand resp 2) (enc d s) (0 1)) + (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) + ((recv d) (send d)) + ((recv (enc (enc s (privk a-0)) (pubk b-0))) (send (enc d s)))) + (label 5) + (parent 4) + (unrealized (1 0) (2 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton blanchet + (vars (d text) (a b name) (s skey)) + (defstrand init 2 (d d) (a a) (b b) (s s)) + (deflistener d) + (deflistener s) + (precedes ((0 0) (2 0)) ((2 1) (0 1))) + (non-orig (privk a) (privk b)) + (uniq-orig d s) + (operation encryption-test (added-listener s) (enc d s) (0 1)) + (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) + ((recv d) (send d)) ((recv s) (send s))) + (label 6) + (parent 4) + (unrealized (2 0)) + (comment "empty cohort")) + +(defskeleton blanchet + (vars (d text) (a b name) (s skey)) + (defstrand init 2 (d d) (a a) (b b) (s s)) + (deflistener d) (defstrand resp 2 (d d) (a a) (b b) (s s)) + (precedes ((0 0) (2 0)) ((2 1) (0 1)) ((2 1) (1 0))) + (non-orig (privk a) (privk b)) + (uniq-orig d s) + (operation nonce-test (contracted (a-0 a) (b-0 b)) s (2 0) + (enc (enc s (privk a)) (pubk b))) + (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) + ((recv d) (send d)) + ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s)))) + (label 7) + (parent 5) + (unrealized (1 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton blanchet + (vars (d text) (a b name) (s skey)) + (defstrand init 2 (d d) (a a) (b b) (s s)) + (deflistener d) + (defstrand resp 2 (d d) (a a) (b b) (s s)) (deflistener s) + (precedes ((0 0) (2 0)) ((0 0) (3 0)) ((2 1) (0 1)) ((2 1) (1 0)) + ((3 1) (1 0))) (non-orig (privk a) (privk b)) - (uniq-orig s) - (traces ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s))) + (uniq-orig d s) + (operation nonce-test (added-listener s) d (1 0) (enc d s)) + (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) + ((recv d) (send d)) + ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s))) ((recv s) (send s))) - (label 2) + (label 8) + (parent 7) + (unrealized (3 0)) + (comment "empty cohort")) + +(comment "Nothing left to do") + +(defprotocol blanchet basic + (defrole init + (vars (a b name) (s skey) (d text)) + (trace (send (enc (enc s (privk a)) (pubk b))) (recv (enc d s)))) + (defrole resp + (vars (a b name) (s skey) (d text)) + (trace (recv (enc (enc s (privk a)) (pubk b))) (send (enc d s))))) + +(defskeleton blanchet + (vars (d text) (a b name) (s skey)) + (defstrand resp 2 (d d) (a a) (b b) (s s)) + (non-orig (privk a) (privk b)) + (uniq-orig s) + (traces ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s)))) + (label 9) (unrealized (0 0)) (comment "1 in cohort - 1 not yet seen")) (defskeleton blanchet (vars (d text) (a b b-0 name) (s skey)) (defstrand resp 2 (d d) (a a) (b b) (s s)) - (deflistener s) (defstrand init 1 (a a) (b b-0) (s s)) - (precedes ((2 0) (0 0)) ((2 0) (1 0))) + (precedes ((1 0) (0 0))) (non-orig (privk a) (privk b)) (uniq-orig s) (operation encryption-test (added-strand init 1) (enc s (privk a)) (0 0)) (traces ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s))) - ((recv s) (send s)) ((send (enc (enc s (privk a)) (pubk b-0))))) - (label 3) - (parent 2) + ((send (enc (enc s (privk a)) (pubk b-0))))) + (label 10) + (parent 9) (unrealized) (shape)) @@ -86,29 +206,46 @@ (defskeleton blanchet (vars (d text) (a b name) (s skey)) - (defstrand init 2 (d d) (a a) (b b) (s s)) - (deflistener s) + (defstrand resp 2 (d d) (a a) (b b) (s s)) + (deflistener d) (non-orig (privk a) (privk b)) - (uniq-orig s) - (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) - ((recv s) (send s))) - (label 4) - (unrealized (0 1) (1 0))) + (uniq-orig d s) + (traces ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s))) + ((recv d) (send d))) + (label 11) + (unrealized (0 0) (1 0))) (defskeleton blanchet (vars (d text) (a b name) (s skey)) - (defstrand init 2 (d d) (a a) (b b) (s s)) - (deflistener s) - (precedes ((0 0) (1 0))) + (defstrand resp 2 (d d) (a a) (b b) (s s)) + (deflistener d) + (precedes ((0 1) (1 0))) (non-orig (privk a) (privk b)) - (uniq-orig s) - (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) - ((recv s) (send s))) - (label 5) - (parent 4) - (unrealized (0 1) (1 0)) - (comment "empty cohort")) + (uniq-orig d s) + (traces ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s))) + ((recv d) (send d))) + (label 12) + (parent 11) + (unrealized (0 0)) + (comment "1 in cohort - 1 not yet seen")) +(defskeleton blanchet + (vars (d text) (a b b-0 name) (s skey)) + (defstrand resp 2 (d d) (a a) (b b) (s s)) + (deflistener d) + (defstrand init 1 (a a) (b b-0) (s s)) + (precedes ((0 1) (1 0)) ((2 0) (0 0))) + (non-orig (privk a) (privk b)) + (uniq-orig d s) + (operation encryption-test (added-strand init 1) (enc s (privk a)) + (0 0)) + (traces ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s))) + ((recv d) (send d)) ((send (enc (enc s (privk a)) (pubk b-0))))) + (label 13) + (parent 12) + (unrealized) + (shape)) + (comment "Nothing left to do") (defprotocol blanchet basic @@ -121,26 +258,43 @@ (defskeleton blanchet (vars (d text) (a b name) (s skey)) - (defstrand init 2 (d d) (a a) (b b) (s s)) - (deflistener s) + (defstrand resp 2 (d d) (a a) (b b) (s s)) + (deflistener d) (non-orig (privk a)) - (uniq-orig s) - (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) - ((recv s) (send s))) - (label 6) - (unrealized (1 0))) + (uniq-orig d s) + (traces ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s))) + ((recv d) (send d))) + (label 14) + (unrealized (0 0) (1 0))) (defskeleton blanchet (vars (d text) (a b name) (s skey)) - (defstrand init 2 (d d) (a a) (b b) (s s)) - (deflistener s) - (precedes ((0 0) (1 0))) + (defstrand resp 2 (d d) (a a) (b b) (s s)) + (deflistener d) + (precedes ((0 1) (1 0))) (non-orig (privk a)) - (uniq-orig s) - (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) - ((recv s) (send s))) - (label 7) - (parent 6) + (uniq-orig d s) + (traces ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s))) + ((recv d) (send d))) + (label 15) + (parent 14) + (unrealized (0 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton blanchet + (vars (d text) (a b b-0 name) (s skey)) + (defstrand resp 2 (d d) (a a) (b b) (s s)) + (deflistener d) + (defstrand init 1 (a a) (b b-0) (s s)) + (precedes ((0 1) (1 0)) ((2 0) (0 0))) + (non-orig (privk a)) + (uniq-orig d s) + (operation encryption-test (added-strand init 1) (enc s (privk a)) + (0 0)) + (traces ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s))) + ((recv d) (send d)) ((send (enc (enc s (privk a)) (pubk b-0))))) + (label 16) + (parent 15) (unrealized) (shape)) @@ -157,26 +311,84 @@ (defskeleton blanchet (vars (d text) (a b name) (s skey)) (defstrand init 2 (d d) (a a) (b b) (s s)) + (deflistener d) + (non-orig (privk b)) + (uniq-orig d s) + (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) + ((recv d) (send d))) + (label 17) + (unrealized (0 1)) + (comment "2 in cohort - 2 not yet seen")) + +(defskeleton blanchet + (vars (d text) (a b a-0 b-0 name) (s skey)) + (defstrand init 2 (d d) (a a) (b b) (s s)) + (deflistener d) + (defstrand resp 2 (d d) (a a-0) (b b-0) (s s)) + (precedes ((0 0) (2 0)) ((2 1) (0 1)) ((2 1) (1 0))) + (non-orig (privk b)) + (uniq-orig d s) + (operation encryption-test (added-strand resp 2) (enc d s) (0 1)) + (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) + ((recv d) (send d)) + ((recv (enc (enc s (privk a-0)) (pubk b-0))) (send (enc d s)))) + (label 18) + (parent 17) + (unrealized (1 0) (2 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton blanchet + (vars (d text) (a b name) (s skey)) + (defstrand init 2 (d d) (a a) (b b) (s s)) + (deflistener d) (deflistener s) - (non-orig (privk a)) + (precedes ((0 0) (2 0)) ((2 1) (0 1))) + (non-orig (privk b)) (uniq-orig d s) + (operation encryption-test (added-listener s) (enc d s) (0 1)) (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) - ((recv s) (send s))) - (label 8) - (unrealized (1 0))) + ((recv d) (send d)) ((recv s) (send s))) + (label 19) + (parent 17) + (unrealized (2 0)) + (comment "empty cohort")) (defskeleton blanchet (vars (d text) (a b name) (s skey)) (defstrand init 2 (d d) (a a) (b b) (s s)) + (deflistener d) + (defstrand resp 2 (d d) (a a) (b b) (s s)) + (precedes ((0 0) (2 0)) ((2 1) (0 1)) ((2 1) (1 0))) + (non-orig (privk b)) + (uniq-orig d s) + (operation nonce-test (contracted (a-0 a) (b-0 b)) s (2 0) + (enc (enc s (privk a)) (pubk b))) + (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) + ((recv d) (send d)) + ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s)))) + (label 20) + (parent 18) + (unrealized (1 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton blanchet + (vars (d text) (a b name) (s skey)) + (defstrand init 2 (d d) (a a) (b b) (s s)) + (deflistener d) + (defstrand resp 2 (d d) (a a) (b b) (s s)) (deflistener s) - (precedes ((0 0) (1 0))) - (non-orig (privk a)) + (precedes ((0 0) (2 0)) ((0 0) (3 0)) ((2 1) (0 1)) ((2 1) (1 0)) + ((3 1) (1 0))) + (non-orig (privk b)) (uniq-orig d s) + (operation nonce-test (added-listener s) d (1 0) (enc d s)) (traces ((send (enc (enc s (privk a)) (pubk b))) (recv (enc d s))) + ((recv d) (send d)) + ((recv (enc (enc s (privk a)) (pubk b))) (send (enc d s))) ((recv s) (send s))) - (label 9) - (parent 8) - (unrealized) - (shape)) + (label 21) + (parent 20) + (unrealized (3 0)) + (comment "empty cohort")) (comment "Nothing left to do") diff --git a/tst/completeness-test.tst b/tst/completeness-test.tst --- a/tst/completeness-test.tst +++ b/tst/completeness-test.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol completeness-test basic diff --git a/tst/crushing.tst b/tst/crushing.tst new file mode 100644 --- /dev/null +++ b/tst/crushing.tst @@ -0,0 +1,155 @@ +(comment "CPSA 2.1.1") +(comment "All input read") + +(defprotocol crushing basic + (defrole init + (vars (k akey) (n n1 n2 n3 text)) + (trace (send (enc n k)) (recv (enc n n1 (invk k))) + (recv (enc n n2 (invk k))) (recv (enc n n3 (invk k))) + (send (enc n n1 n2 n3 (invk k))) + (recv (enc n n1 n2 n3 n (invk k)))) + (non-orig (invk k)) + (uniq-orig n)) + (defrole adder + (vars (k akey) (n new text)) + (trace (recv (enc n k)) (send (enc n new (invk k)))) + (uniq-orig new)) + (defrole twister + (vars (k akey) (n n1 n2 n3 text)) + (trace (recv (enc n n1 n2 n3 (invk k))) + (send (enc n n2 n3 n1 n (invk k)))))) + +(defskeleton crushing + (vars (n n1 n2 n3 text) (k akey)) + (defstrand init 6 (n n) (n1 n1) (n2 n2) (n3 n3) (k k)) + (non-orig (invk k)) + (uniq-orig n n1 n2 n3) + (traces + ((send (enc n k)) (recv (enc n n1 (invk k))) + (recv (enc n n2 (invk k))) (recv (enc n n3 (invk k))) + (send (enc n n1 n2 n3 (invk k))) + (recv (enc n n1 n2 n3 n (invk k))))) + (label 0) + (unrealized (0 1) (0 2) (0 3) (0 5)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton crushing + (vars (n n1 n2 n3 text) (k akey)) + (defstrand init 6 (n n) (n1 n1) (n2 n2) (n3 n3) (k k)) + (defstrand adder 2 (n n) (new n1) (k k)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (invk k)) + (uniq-orig n n1 n2 n3) + (operation encryption-test (added-strand adder 2) (enc n n1 (invk k)) + (0 1)) + (traces + ((send (enc n k)) (recv (enc n n1 (invk k))) + (recv (enc n n2 (invk k))) (recv (enc n n3 (invk k))) + (send (enc n n1 n2 n3 (invk k))) + (recv (enc n n1 n2 n3 n (invk k)))) + ((recv (enc n k)) (send (enc n n1 (invk k))))) + (label 1) + (parent 0) + (unrealized (0 2) (0 3) (0 5)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton crushing + (vars (n n1 n2 n3 text) (k akey)) + (defstrand init 6 (n n) (n1 n1) (n2 n2) (n3 n3) (k k)) + (defstrand adder 2 (n n) (new n1) (k k)) + (defstrand adder 2 (n n) (new n2) (k k)) + (precedes ((0 0) (1 0)) ((0 0) (2 0)) ((1 1) (0 1)) ((2 1) (0 2))) + (non-orig (invk k)) + (uniq-orig n n1 n2 n3) + (operation encryption-test (added-strand adder 2) (enc n n2 (invk k)) + (0 2)) + (traces + ((send (enc n k)) (recv (enc n n1 (invk k))) + (recv (enc n n2 (invk k))) (recv (enc n n3 (invk k))) + (send (enc n n1 n2 n3 (invk k))) + (recv (enc n n1 n2 n3 n (invk k)))) + ((recv (enc n k)) (send (enc n n1 (invk k)))) + ((recv (enc n k)) (send (enc n n2 (invk k))))) + (label 2) + (parent 1) + (unrealized (0 3) (0 5)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton crushing + (vars (n n1 n2 n3 text) (k akey)) + (defstrand init 6 (n n) (n1 n1) (n2 n2) (n3 n3) (k k)) + (defstrand adder 2 (n n) (new n1) (k k)) + (defstrand adder 2 (n n) (new n2) (k k)) + (defstrand adder 2 (n n) (new n3) (k k)) + (precedes ((0 0) (1 0)) ((0 0) (2 0)) ((0 0) (3 0)) ((1 1) (0 1)) + ((2 1) (0 2)) ((3 1) (0 3))) + (non-orig (invk k)) + (uniq-orig n n1 n2 n3) + (operation encryption-test (added-strand adder 2) (enc n n3 (invk k)) + (0 3)) + (traces + ((send (enc n k)) (recv (enc n n1 (invk k))) + (recv (enc n n2 (invk k))) (recv (enc n n3 (invk k))) + (send (enc n n1 n2 n3 (invk k))) + (recv (enc n n1 n2 n3 n (invk k)))) + ((recv (enc n k)) (send (enc n n1 (invk k)))) + ((recv (enc n k)) (send (enc n n2 (invk k)))) + ((recv (enc n k)) (send (enc n n3 (invk k))))) + (label 3) + (parent 2) + (unrealized (0 5)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton crushing + (vars (n n1 n2 n3 text) (k akey)) + (defstrand init 6 (n n) (n1 n1) (n2 n2) (n3 n3) (k k)) + (defstrand adder 2 (n n) (new n1) (k k)) + (defstrand adder 2 (n n) (new n2) (k k)) + (defstrand adder 2 (n n) (new n3) (k k)) + (defstrand twister 2 (n n) (n1 n3) (n2 n1) (n3 n2) (k k)) + (precedes ((0 0) (1 0)) ((0 0) (2 0)) ((0 0) (3 0)) ((1 1) (0 1)) + ((1 1) (4 0)) ((2 1) (0 2)) ((2 1) (4 0)) ((3 1) (0 3)) + ((3 1) (4 0)) ((4 1) (0 5))) + (non-orig (invk k)) + (uniq-orig n n1 n2 n3) + (operation encryption-test (added-strand twister 2) + (enc n n1 n2 n3 n (invk k)) (0 5)) + (traces + ((send (enc n k)) (recv (enc n n1 (invk k))) + (recv (enc n n2 (invk k))) (recv (enc n n3 (invk k))) + (send (enc n n1 n2 n3 (invk k))) + (recv (enc n n1 n2 n3 n (invk k)))) + ((recv (enc n k)) (send (enc n n1 (invk k)))) + ((recv (enc n k)) (send (enc n n2 (invk k)))) + ((recv (enc n k)) (send (enc n n3 (invk k)))) + ((recv (enc n n3 n1 n2 (invk k))) + (send (enc n n1 n2 n3 n (invk k))))) + (label 4) + (parent 3) + (unrealized (4 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton crushing + (vars (n n2 text) (k akey)) + (defstrand init 6 (n n) (n1 n2) (n2 n2) (n3 n2) (k k)) + (defstrand adder 2 (n n) (new n2) (k k)) + (defstrand twister 2 (n n) (n1 n2) (n2 n2) (n3 n2) (k k)) + (precedes ((0 0) (1 0)) ((0 4) (2 0)) ((1 1) (0 1)) ((2 1) (0 5))) + (non-orig (invk k)) + (uniq-orig n n2) + (operation encryption-test (added-strand init 5) + (enc n n2 n2 n2 (invk k)) (4 0)) + (traces + ((send (enc n k)) (recv (enc n n2 (invk k))) + (recv (enc n n2 (invk k))) (recv (enc n n2 (invk k))) + (send (enc n n2 n2 n2 (invk k))) + (recv (enc n n2 n2 n2 n (invk k)))) + ((recv (enc n k)) (send (enc n n2 (invk k)))) + ((recv (enc n n2 n2 n2 (invk k))) + (send (enc n n2 n2 n2 n (invk k))))) + (label 5) + (parent 4) + (unrealized) + (shape)) + +(comment "Nothing left to do") diff --git a/tst/dass_simple.tst b/tst/dass_simple.tst --- a/tst/dass_simple.tst +++ b/tst/dass_simple.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol dass basic diff --git a/tst/denning-sacco.tst b/tst/denning-sacco.tst --- a/tst/denning-sacco.tst +++ b/tst/denning-sacco.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol denning-sacco basic diff --git a/tst/dh.tst b/tst/dh.tst --- a/tst/dh.tst +++ b/tst/dh.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol dhke diffie-hellman diff --git a/tst/dh_unifywithconst.tst b/tst/dh_unifywithconst.tst --- a/tst/dh_unifywithconst.tst +++ b/tst/dh_unifywithconst.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol dh_unifywith1 diffie-hellman diff --git a/tst/dy.tst b/tst/dy.tst --- a/tst/dy.tst +++ b/tst/dy.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol dy basic @@ -294,26 +294,29 @@ (comment "1 in cohort - 0 not yet seen")) (defskeleton dy - (vars (m text) (b a a-0 name)) + (vars (m text) (b a a-0 a-1 name)) (defstrand init 2 (m m) (a b) (b b)) - (defstrand resp 2 (m m) (a a) (b b)) + (defstrand resp 2 (m (cat (enc m (pubk b)) b)) (a a) (b b)) + (defstrand resp 2 (m m) (a a-0) (b b)) (defstrand resp 2 (m m) (a b) (b b)) - (defstrand resp 2 (m (cat (enc m (pubk b)) b)) (a a-0) (b b)) - (precedes ((0 0) (2 0)) ((0 0) (3 0)) ((1 1) (0 1)) ((2 1) (1 0)) - ((3 1) (1 0))) + (defstrand resp 2 (m (cat (enc m (pubk b)) b)) (a a-1) (b b)) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((0 0) (4 0)) ((1 1) (0 1)) + ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (2 0))) (non-orig (privk b)) (uniq-orig m) - (operation nonce-test (contracted (a-1 b) (a-2 a-0)) m (4 0) + (operation nonce-test (contracted (a-2 b)) m (4 0) (enc (enc m (pubk b)) b (pubk b))) (traces ((send (enc (enc m (pubk b)) b (pubk b))) (recv (enc (enc m (pubk b)) b (pubk b)))) - ((recv (enc (enc m (pubk b)) a (pubk b))) - (send (enc (enc m (pubk a)) b (pubk a)))) + ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a (pubk b))) + (send (enc (enc (enc m (pubk b)) b (pubk a)) b (pubk a)))) + ((recv (enc (enc m (pubk b)) a-0 (pubk b))) + (send (enc (enc m (pubk a-0)) b (pubk a-0)))) ((recv (enc (enc m (pubk b)) b (pubk b))) (send (enc (enc m (pubk b)) b (pubk b)))) - ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a-0 (pubk b))) - (send (enc (enc (enc m (pubk b)) b (pubk a-0)) b (pubk a-0))))) + ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a-1 (pubk b))) + (send (enc (enc (enc m (pubk b)) b (pubk a-1)) b (pubk a-1))))) (label 13) (parent 10) (unrealized) @@ -378,26 +381,29 @@ (comment "2 in cohort - 2 not yet seen")) (defskeleton dy - (vars (m text) (b a name)) + (vars (m text) (b a a-0 name)) (defstrand init 2 (m m) (a b) (b b)) + (defstrand resp 2 (m m) (a a) (b b)) (defstrand resp 2 (m m) (a b) (b b)) - (defstrand resp 2 (m (cat (enc m (pubk b)) b)) (a a) (b b)) - (precedes ((0 0) (1 0)) ((0 0) (2 0)) ((1 1) (0 1)) ((2 1) (0 1))) + (defstrand resp 2 (m (cat (enc m (pubk b)) b)) (a a-0) (b b)) + (precedes ((0 0) (2 0)) ((0 0) (3 0)) ((1 1) (0 1)) ((2 1) (1 0)) + ((3 1) (1 0))) (non-orig (privk b)) (uniq-orig m) (operation generalization deleted (1 0)) (traces ((send (enc (enc m (pubk b)) b (pubk b))) (recv (enc (enc m (pubk b)) b (pubk b)))) + ((recv (enc (enc m (pubk b)) a (pubk b))) + (send (enc (enc m (pubk a)) b (pubk a)))) ((recv (enc (enc m (pubk b)) b (pubk b))) (send (enc (enc m (pubk b)) b (pubk b)))) - ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a (pubk b))) - (send (enc (enc (enc m (pubk b)) b (pubk a)) b (pubk a))))) + ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a-0 (pubk b))) + (send (enc (enc (enc m (pubk b)) b (pubk a-0)) b (pubk a-0))))) (label 16) (parent 13) - (seen 4) (unrealized) - (comment "1 in cohort - 0 not yet seen")) + (comment "1 in cohort - 1 not yet seen")) (defskeleton dy (vars (m text) (a b a-0 a-1 name)) @@ -429,23 +435,27 @@ (comment "1 in cohort - 1 not yet seen")) (defskeleton dy - (vars (m text) (a a-0 a-1 name)) + (vars (m text) (a a-0 a-1 a-2 name)) (defstrand init 2 (m m) (a a) (b a)) - (defstrand resp 2 (m m) (a a-0) (b a)) - (defstrand resp 2 (m (cat (enc m (pubk a)) a)) (a a-1) (b a)) + (defstrand resp 2 (m (cat (enc m (pubk a)) a)) (a a-0) (b a)) + (defstrand resp 2 (m m) (a a-1) (b a)) + (defstrand resp 2 (m (cat (enc m (pubk a)) a)) (a a-2) (b a)) (defstrand resp 2 (m m) (a a) (b a)) - (precedes ((0 0) (3 0)) ((1 1) (0 1)) ((2 1) (1 0)) ((3 1) (2 0))) + (precedes ((0 0) (1 0)) ((0 0) (4 0)) ((1 1) (0 1)) ((2 1) (0 1)) + ((3 1) (2 0)) ((4 1) (3 0))) (non-orig (privk a)) (uniq-orig m) - (operation nonce-test (contracted (b a) (a-2 a-1)) m (2 0) - (enc m (pubk a)) (enc (enc m (pubk a)) a (pubk a))) + (operation nonce-test (contracted (b a)) m (2 0) (enc m (pubk a)) + (enc (enc m (pubk a)) a (pubk a))) (traces ((send (enc (enc m (pubk a)) a (pubk a))) (recv (enc (enc m (pubk a)) a (pubk a)))) - ((recv (enc (enc m (pubk a)) a-0 (pubk a))) - (send (enc (enc m (pubk a-0)) a (pubk a-0)))) - ((recv (enc (enc (enc m (pubk a)) a (pubk a)) a-1 (pubk a))) - (send (enc (enc (enc m (pubk a)) a (pubk a-1)) a (pubk a-1)))) + ((recv (enc (enc (enc m (pubk a)) a (pubk a)) a-0 (pubk a))) + (send (enc (enc (enc m (pubk a)) a (pubk a-0)) a (pubk a-0)))) + ((recv (enc (enc m (pubk a)) a-1 (pubk a))) + (send (enc (enc m (pubk a-1)) a (pubk a-1)))) + ((recv (enc (enc (enc m (pubk a)) a (pubk a)) a-2 (pubk a))) + (send (enc (enc (enc m (pubk a)) a (pubk a-2)) a (pubk a-2)))) ((recv (enc (enc m (pubk a)) a (pubk a))) (send (enc (enc m (pubk a)) a (pubk a))))) (label 18) @@ -482,9 +492,8 @@ (send (enc (enc m (pubk a-3)) a (pubk a-3))))) (label 19) (parent 14) - (seen 18) (unrealized (5 0)) - (comment "3 in cohort - 2 not yet seen")) + (comment "3 in cohort - 3 not yet seen")) (defskeleton dy (vars (m text) (a b a-0 a-1 a-2 name)) @@ -577,6 +586,28 @@ (comment "3 in cohort - 3 not yet seen")) (defskeleton dy + (vars (m text) (b a name)) + (defstrand init 2 (m m) (a b) (b b)) + (defstrand resp 2 (m m) (a b) (b b)) + (defstrand resp 2 (m (cat (enc m (pubk b)) b)) (a a) (b b)) + (precedes ((0 0) (1 0)) ((0 0) (2 0)) ((1 1) (0 1)) ((2 1) (0 1))) + (non-orig (privk b)) + (uniq-orig m) + (operation generalization deleted (1 0)) + (traces + ((send (enc (enc m (pubk b)) b (pubk b))) + (recv (enc (enc m (pubk b)) b (pubk b)))) + ((recv (enc (enc m (pubk b)) b (pubk b))) + (send (enc (enc m (pubk b)) b (pubk b)))) + ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a (pubk b))) + (send (enc (enc (enc m (pubk b)) b (pubk a)) b (pubk a))))) + (label 23) + (parent 16) + (seen 4) + (unrealized) + (comment "1 in cohort - 0 not yet seen")) + +(defskeleton dy (vars (m text) (a b a-0 name)) (defstrand init 2 (m m) (a a) (b b)) (defstrand resp 2 (m m) (a a) (b b)) @@ -595,33 +626,68 @@ (send (enc (enc (enc m (pubk a)) b (pubk a-0)) a (pubk a-0)))) ((recv (enc (enc m (pubk b)) a (pubk b))) (send (enc (enc m (pubk a)) b (pubk a))))) - (label 23) + (label 24) (parent 17) (unrealized) (comment "1 in cohort - 1 not yet seen")) (defskeleton dy - (vars (m text) (a a-0 name)) + (vars (m text) (a a-0 a-1 name)) (defstrand init 2 (m m) (a a) (b a)) - (defstrand resp 2 (m (cat (enc m (pubk a)) a)) (a a-0) (b a)) + (defstrand resp 2 (m m) (a a-0) (b a)) + (defstrand resp 2 (m (cat (enc m (pubk a)) a)) (a a-1) (b a)) (defstrand resp 2 (m m) (a a) (b a)) - (precedes ((0 0) (2 0)) ((1 1) (0 1)) ((2 1) (1 0))) + (precedes ((0 0) (3 0)) ((1 1) (0 1)) ((2 1) (1 0)) ((3 1) (2 0))) (non-orig (privk a)) (uniq-orig m) (operation generalization deleted (1 0)) (traces ((send (enc (enc m (pubk a)) a (pubk a))) (recv (enc (enc m (pubk a)) a (pubk a)))) - ((recv (enc (enc (enc m (pubk a)) a (pubk a)) a-0 (pubk a))) - (send (enc (enc (enc m (pubk a)) a (pubk a-0)) a (pubk a-0)))) + ((recv (enc (enc m (pubk a)) a-0 (pubk a))) + (send (enc (enc m (pubk a-0)) a (pubk a-0)))) + ((recv (enc (enc (enc m (pubk a)) a (pubk a)) a-1 (pubk a))) + (send (enc (enc (enc m (pubk a)) a (pubk a-1)) a (pubk a-1)))) ((recv (enc (enc m (pubk a)) a (pubk a))) (send (enc (enc m (pubk a)) a (pubk a))))) - (label 24) + (label 25) (parent 18) (unrealized) (comment "1 in cohort - 1 not yet seen")) (defskeleton dy + (vars (m text) (b a a-0 a-1 name)) + (defstrand init 2 (m m) (a b) (b b)) + (defstrand resp 2 (m (cat (enc m (pubk b)) b)) (a a) (b b)) + (defstrand resp 2 (m m) (a a-0) (b b)) + (defstrand resp 2 (m (cat (enc m (pubk b)) b)) (a a-1) (b b)) + (defstrand resp 2 (m m) (a b) (b b)) + (defstrand resp 2 (m m) (a b) (b b)) + (precedes ((0 0) (1 0)) ((0 0) (4 0)) ((0 0) (5 0)) ((1 1) (0 1)) + ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (3 0)) ((5 1) (2 0))) + (non-orig (privk b)) + (uniq-orig m) + (operation nonce-test (contracted (a-2 b) (a-3 b)) m (5 0) + (enc (enc m (pubk b)) b (pubk b))) + (traces + ((send (enc (enc m (pubk b)) b (pubk b))) + (recv (enc (enc m (pubk b)) b (pubk b)))) + ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a (pubk b))) + (send (enc (enc (enc m (pubk b)) b (pubk a)) b (pubk a)))) + ((recv (enc (enc m (pubk b)) a-0 (pubk b))) + (send (enc (enc m (pubk a-0)) b (pubk a-0)))) + ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a-1 (pubk b))) + (send (enc (enc (enc m (pubk b)) b (pubk a-1)) b (pubk a-1)))) + ((recv (enc (enc m (pubk b)) b (pubk b))) + (send (enc (enc m (pubk b)) b (pubk b)))) + ((recv (enc (enc m (pubk b)) b (pubk b))) + (send (enc (enc m (pubk b)) b (pubk b))))) + (label 26) + (parent 19) + (unrealized) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton dy (vars (m text) (a b a-0 a-1 a-2 a-3 name)) (defstrand init 2 (m m) (a a) (b b)) (defstrand resp 2 (m (cat (enc m (pubk b)) a)) (a a-0) (b b)) @@ -652,7 +718,7 @@ (send (enc (enc m (pubk a-3)) a (pubk a-3)))) ((recv (enc (enc m (pubk b)) a (pubk b))) (send (enc (enc m (pubk a)) b (pubk a))))) - (label 25) + (label 27) (parent 19) (unrealized (5 0)) (comment "3 in cohort - 3 not yet seen")) @@ -684,7 +750,7 @@ (send (enc (enc m (pubk a-2)) a (pubk a-2)))) ((recv (enc (enc (enc m (pubk b)) a (pubk b)) a-3 (pubk b))) (send (enc (enc (enc m (pubk b)) a (pubk a-3)) b (pubk a-3))))) - (label 26) + (label 28) (parent 19) (unrealized (4 0)) (comment "2 in cohort - 2 not yet seen")) @@ -709,7 +775,7 @@ (send (enc (enc m (pubk a)) b (pubk a)))) ((recv (enc (enc (enc m (pubk b)) a (pubk b)) a-1 (pubk b))) (send (enc (enc (enc m (pubk b)) a (pubk a-1)) b (pubk a-1))))) - (label 27) + (label 29) (parent 20) (seen 6) (unrealized) @@ -735,7 +801,7 @@ (send (enc (enc (enc m (pubk b)) b (pubk a)) b (pubk a)))) ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a-0 (pubk b))) (send (enc (enc (enc m (pubk b)) b (pubk a-0)) b (pubk a-0))))) - (label 28) + (label 30) (parent 21) (unrealized) (comment "1 in cohort - 1 not yet seen")) @@ -744,11 +810,12 @@ (vars (m text) (a b a-0 a-1 a-2 name)) (defstrand init 2 (m m) (a a) (b b)) (defstrand resp 2 (m m) (a a-0) (b b)) + (defstrand resp 2 (m m) (a a) (b b)) (defstrand resp 2 (m (cat (enc m (pubk a)) b)) (a a-1) (b a)) (defstrand resp 2 (m (cat (enc m (pubk b)) a)) (a a-2) (b b)) (defstrand resp 2 (m m) (a a) (b b)) - (precedes ((0 0) (3 0)) ((0 0) (4 0)) ((1 1) (0 1)) ((2 1) (1 0)) - ((3 1) (2 0)) ((4 1) (2 0))) + (precedes ((0 0) (2 0)) ((0 0) (4 0)) ((0 0) (5 0)) ((1 1) (0 1)) + ((2 1) (1 0)) ((3 1) (1 0)) ((4 1) (3 0)) ((5 1) (3 0))) (non-orig (privk a) (privk b)) (uniq-orig m) (operation nonce-test (contracted (a-3 a)) m (5 0) @@ -758,13 +825,15 @@ (recv (enc (enc m (pubk a)) b (pubk a)))) ((recv (enc (enc m (pubk b)) a-0 (pubk b))) (send (enc (enc m (pubk a-0)) b (pubk a-0)))) + ((recv (enc (enc m (pubk b)) a (pubk b))) + (send (enc (enc m (pubk a)) b (pubk a)))) ((recv (enc (enc (enc m (pubk a)) b (pubk a)) a-1 (pubk a))) (send (enc (enc (enc m (pubk a)) b (pubk a-1)) a (pubk a-1)))) ((recv (enc (enc (enc m (pubk b)) a (pubk b)) a-2 (pubk b))) (send (enc (enc (enc m (pubk b)) a (pubk a-2)) b (pubk a-2)))) ((recv (enc (enc m (pubk b)) a (pubk b))) (send (enc (enc m (pubk a)) b (pubk a))))) - (label 29) + (label 31) (parent 22) (unrealized) (comment "1 in cohort - 1 not yet seen")) @@ -796,7 +865,7 @@ (send (enc (enc m (pubk a-3)) b (pubk a-3)))) ((recv (enc (enc m (pubk b)) a (pubk b))) (send (enc (enc m (pubk a)) b (pubk a))))) - (label 30) + (label 32) (parent 22) (unrealized (4 0)) (comment "3 in cohort - 3 not yet seen")) @@ -828,7 +897,7 @@ (send (enc (enc m (pubk a-2)) b (pubk a-2)))) ((recv (enc (enc (enc m (pubk b)) a (pubk b)) a-3 (pubk b))) (send (enc (enc (enc m (pubk b)) a (pubk a-3)) b (pubk a-3))))) - (label 31) + (label 33) (parent 22) (unrealized) (comment "1 in cohort - 1 not yet seen")) @@ -849,32 +918,62 @@ (send (enc (enc (enc m (pubk a)) b (pubk a-0)) a (pubk a-0)))) ((recv (enc (enc m (pubk b)) a (pubk b))) (send (enc (enc m (pubk a)) b (pubk a))))) - (label 32) - (parent 23) + (label 34) + (parent 24) (seen 2) (unrealized) (comment "1 in cohort - 0 not yet seen")) (defskeleton dy - (vars (m text) (a name)) + (vars (m text) (a a-0 name)) (defstrand init 2 (m m) (a a) (b a)) + (defstrand resp 2 (m (cat (enc m (pubk a)) a)) (a a-0) (b a)) (defstrand resp 2 (m m) (a a) (b a)) - (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (precedes ((0 0) (2 0)) ((1 1) (0 1)) ((2 1) (1 0))) (non-orig (privk a)) (uniq-orig m) (operation generalization deleted (1 0)) (traces ((send (enc (enc m (pubk a)) a (pubk a))) (recv (enc (enc m (pubk a)) a (pubk a)))) + ((recv (enc (enc (enc m (pubk a)) a (pubk a)) a-0 (pubk a))) + (send (enc (enc (enc m (pubk a)) a (pubk a-0)) a (pubk a-0)))) ((recv (enc (enc m (pubk a)) a (pubk a))) (send (enc (enc m (pubk a)) a (pubk a))))) - (label 33) - (parent 24) - (seen 1) + (label 35) + (parent 25) (unrealized) - (comment "1 in cohort - 0 not yet seen")) + (comment "1 in cohort - 1 not yet seen")) (defskeleton dy + (vars (m text) (b a a-0 name)) + (defstrand init 2 (m m) (a b) (b b)) + (defstrand resp 2 (m m) (a a) (b b)) + (defstrand resp 2 (m (cat (enc m (pubk b)) b)) (a a-0) (b b)) + (defstrand resp 2 (m m) (a b) (b b)) + (defstrand resp 2 (m m) (a b) (b b)) + (precedes ((0 0) (3 0)) ((0 0) (4 0)) ((1 1) (0 1)) ((2 1) (1 0)) + ((3 1) (2 0)) ((4 1) (1 0))) + (non-orig (privk b)) + (uniq-orig m) + (operation generalization deleted (1 0)) + (traces + ((send (enc (enc m (pubk b)) b (pubk b))) + (recv (enc (enc m (pubk b)) b (pubk b)))) + ((recv (enc (enc m (pubk b)) a (pubk b))) + (send (enc (enc m (pubk a)) b (pubk a)))) + ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a-0 (pubk b))) + (send (enc (enc (enc m (pubk b)) b (pubk a-0)) b (pubk a-0)))) + ((recv (enc (enc m (pubk b)) b (pubk b))) + (send (enc (enc m (pubk b)) b (pubk b)))) + ((recv (enc (enc m (pubk b)) b (pubk b))) + (send (enc (enc m (pubk b)) b (pubk b))))) + (label 36) + (parent 26) + (unrealized) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton dy (vars (m text) (a b a-0 a-1 a-2 name)) (defstrand init 2 (m m) (a a) (b b)) (defstrand resp 2 (m (cat (enc m (pubk b)) a)) (a a-0) (b b)) @@ -905,8 +1004,8 @@ (send (enc (enc m (pubk b)) a (pubk b)))) ((recv (enc (enc m (pubk b)) a (pubk b))) (send (enc (enc m (pubk a)) b (pubk a))))) - (label 34) - (parent 25) + (label 37) + (parent 27) (unrealized (2 0)) (comment "3 in cohort - 3 not yet seen")) @@ -946,8 +1045,8 @@ (send (enc (enc m (pubk a)) b (pubk a)))) ((recv (enc (enc (enc m (pubk a)) b (pubk a)) a-4 (pubk a))) (send (enc (enc (enc m (pubk a)) b (pubk a-4)) a (pubk a-4))))) - (label 35) - (parent 25) + (label 38) + (parent 27) (unrealized (7 0)) (comment "aborted")) @@ -982,8 +1081,8 @@ (send (enc (enc m (pubk a)) b (pubk a)))) ((recv (enc (enc (enc m (pubk b)) a (pubk b)) a-3 (pubk b))) (send (enc (enc (enc m (pubk b)) a (pubk a-3)) b (pubk a-3))))) - (label 36) - (parent 25) + (label 39) + (parent 27) (unrealized (4 0)) (comment "aborted")) @@ -1014,8 +1113,8 @@ (send (enc (enc m (pubk a-1)) b (pubk a-1)))) ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a-2 (pubk b))) (send (enc (enc (enc m (pubk b)) b (pubk a-2)) b (pubk a-2))))) - (label 37) - (parent 26) + (label 40) + (parent 28) (unrealized) (comment "aborted")) @@ -1050,8 +1149,8 @@ (send (enc (enc (enc m (pubk b)) a (pubk a-3)) b (pubk a-3)))) ((recv (enc (enc m (pubk b)) a-4 (pubk b))) (send (enc (enc m (pubk a-4)) b (pubk a-4))))) - (label 38) - (parent 26) + (label 41) + (parent 28) (unrealized (6 0)) (comment "aborted")) @@ -1071,33 +1170,36 @@ (send (enc (enc (enc m (pubk b)) b (pubk a)) b (pubk a)))) ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a-0 (pubk b))) (send (enc (enc (enc m (pubk b)) b (pubk a-0)) b (pubk a-0))))) - (label 39) - (parent 28) + (label 42) + (parent 30) (unrealized) (comment "aborted")) (defskeleton dy (vars (m text) (a b a-0 a-1 name)) (defstrand init 2 (m m) (a a) (b b)) + (defstrand resp 2 (m m) (a a) (b b)) (defstrand resp 2 (m (cat (enc m (pubk a)) b)) (a a-0) (b a)) (defstrand resp 2 (m (cat (enc m (pubk b)) a)) (a a-1) (b b)) (defstrand resp 2 (m m) (a a) (b b)) - (precedes ((0 0) (2 0)) ((0 0) (3 0)) ((1 1) (0 1)) ((2 1) (1 0)) - ((3 1) (1 0))) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((0 0) (4 0)) ((1 1) (0 1)) + ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (2 0))) (non-orig (privk a) (privk b)) (uniq-orig m) (operation generalization deleted (1 0)) (traces ((send (enc (enc m (pubk b)) a (pubk b))) (recv (enc (enc m (pubk a)) b (pubk a)))) + ((recv (enc (enc m (pubk b)) a (pubk b))) + (send (enc (enc m (pubk a)) b (pubk a)))) ((recv (enc (enc (enc m (pubk a)) b (pubk a)) a-0 (pubk a))) (send (enc (enc (enc m (pubk a)) b (pubk a-0)) a (pubk a-0)))) ((recv (enc (enc (enc m (pubk b)) a (pubk b)) a-1 (pubk b))) (send (enc (enc (enc m (pubk b)) a (pubk a-1)) b (pubk a-1)))) ((recv (enc (enc m (pubk b)) a (pubk b))) (send (enc (enc m (pubk a)) b (pubk a))))) - (label 40) - (parent 29) + (label 43) + (parent 31) (unrealized) (comment "aborted")) @@ -1128,8 +1230,8 @@ (send (enc (enc m (pubk a)) b (pubk a)))) ((recv (enc (enc m (pubk b)) a (pubk b))) (send (enc (enc m (pubk a)) b (pubk a))))) - (label 41) - (parent 30) + (label 44) + (parent 32) (unrealized) (comment "aborted")) @@ -1164,8 +1266,8 @@ (send (enc (enc m (pubk a)) b (pubk a)))) ((recv (enc (enc (enc m (pubk a)) b (pubk a)) a-4 (pubk a))) (send (enc (enc (enc m (pubk a)) b (pubk a-4)) a (pubk a-4))))) - (label 42) - (parent 30) + (label 45) + (parent 32) (unrealized (4 0) (6 0)) (comment "aborted")) @@ -1196,8 +1298,8 @@ (send (enc (enc m (pubk a)) b (pubk a)))) ((recv (enc (enc (enc m (pubk b)) a (pubk b)) a-3 (pubk b))) (send (enc (enc (enc m (pubk b)) a (pubk a-3)) b (pubk a-3))))) - (label 43) - (parent 30) + (label 46) + (parent 32) (unrealized) (comment "aborted")) @@ -1224,12 +1326,55 @@ (send (enc (enc m (pubk a-1)) b (pubk a-1)))) ((recv (enc (enc (enc m (pubk b)) a (pubk b)) a-2 (pubk b))) (send (enc (enc (enc m (pubk b)) a (pubk a-2)) b (pubk a-2))))) - (label 44) - (parent 31) + (label 47) + (parent 33) (unrealized) (comment "aborted")) (defskeleton dy + (vars (m text) (a name)) + (defstrand init 2 (m m) (a a) (b a)) + (defstrand resp 2 (m m) (a a) (b a)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (privk a)) + (uniq-orig m) + (operation generalization deleted (1 0)) + (traces + ((send (enc (enc m (pubk a)) a (pubk a))) + (recv (enc (enc m (pubk a)) a (pubk a)))) + ((recv (enc (enc m (pubk a)) a (pubk a))) + (send (enc (enc m (pubk a)) a (pubk a))))) + (label 48) + (parent 35) + (unrealized) + (comment "aborted")) + +(defskeleton dy + (vars (m text) (b a name)) + (defstrand init 2 (m m) (a b) (b b)) + (defstrand resp 2 (m (cat (enc m (pubk b)) b)) (a a) (b b)) + (defstrand resp 2 (m m) (a b) (b b)) + (defstrand resp 2 (m m) (a b) (b b)) + (precedes ((0 0) (2 0)) ((0 0) (3 0)) ((1 1) (0 1)) ((2 1) (1 0)) + ((3 1) (0 1))) + (non-orig (privk b)) + (uniq-orig m) + (operation generalization deleted (1 0)) + (traces + ((send (enc (enc m (pubk b)) b (pubk b))) + (recv (enc (enc m (pubk b)) b (pubk b)))) + ((recv (enc (enc (enc m (pubk b)) b (pubk b)) a (pubk b))) + (send (enc (enc (enc m (pubk b)) b (pubk a)) b (pubk a)))) + ((recv (enc (enc m (pubk b)) b (pubk b))) + (send (enc (enc m (pubk b)) b (pubk b)))) + ((recv (enc (enc m (pubk b)) b (pubk b))) + (send (enc (enc m (pubk b)) b (pubk b))))) + (label 49) + (parent 36) + (unrealized) + (comment "aborted")) + +(defskeleton dy (vars (m text) (a b a-0 a-1 name)) (defstrand init 2 (m m) (a a) (b b)) (defstrand resp 2 (m (cat (enc m (pubk b)) a)) (a a-0) (b b)) @@ -1260,40 +1405,44 @@ (send (enc (enc m (pubk b)) a (pubk b)))) ((recv (enc (enc m (pubk b)) a (pubk b))) (send (enc (enc m (pubk a)) b (pubk a))))) - (label 45) - (parent 34) + (label 50) + (parent 37) (unrealized) (comment "aborted")) (defskeleton dy - (vars (m text) (a a-0 a-1 name)) + (vars (m text) (a a-0 a-1 a-2 name)) (defstrand init 2 (m m) (a a) (b a)) - (defstrand resp 2 (m m) (a a-0) (b a)) - (defstrand resp 2 (m (cat (enc m (pubk a)) a)) (a a-1) (b a)) + (defstrand resp 2 (m (cat (enc m (pubk a)) a)) (a a-0) (b a)) + (defstrand resp 2 (m m) (a a-1) (b a)) + (defstrand resp 2 (m (cat (enc m (pubk a)) a)) (a a-2) (b a)) (defstrand resp 2 (m m) (a a) (b a)) (defstrand resp 2 (m m) (a a) (b a)) (defstrand resp 2 (m m) (a a) (b a)) - (precedes ((0 0) (3 0)) ((0 0) (5 0)) ((1 1) (0 1)) ((2 1) (1 0)) - ((3 1) (2 0)) ((4 1) (1 0)) ((5 1) (4 0))) + (precedes ((0 0) (1 0)) ((0 0) (4 0)) ((0 0) (6 0)) ((1 1) (0 1)) + ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (3 0)) ((5 1) (2 0)) + ((6 1) (5 0))) (non-orig (privk a)) (uniq-orig m) - (operation nonce-test (contracted (b a) (a-2 a-1)) m (2 0) - (enc m (pubk a)) (enc (enc m (pubk a)) a (pubk a))) + (operation nonce-test (contracted (b a)) m (2 0) (enc m (pubk a)) + (enc (enc m (pubk a)) a (pubk a))) (traces ((send (enc (enc m (pubk a)) a (pubk a))) (recv (enc (enc m (pubk a)) a (pubk a)))) - ((recv (enc (enc m (pubk a)) a-0 (pubk a))) - (send (enc (enc m (pubk a-0)) a (pubk a-0)))) - ((recv (enc (enc (enc m (pubk a)) a (pubk a)) a-1 (pubk a))) - (send (enc (enc (enc m (pubk a)) a (pubk a-1)) a (pubk a-1)))) + ((recv (enc (enc (enc m (pubk a)) a (pubk a)) a-0 (pubk a))) + (send (enc (enc (enc m (pubk a)) a (pubk a-0)) a (pubk a-0)))) + ((recv (enc (enc m (pubk a)) a-1 (pubk a))) + (send (enc (enc m (pubk a-1)) a (pubk a-1)))) + ((recv (enc (enc (enc m (pubk a)) a (pubk a)) a-2 (pubk a))) + (send (enc (enc (enc m (pubk a)) a (pubk a-2)) a (pubk a-2)))) ((recv (enc (enc m (pubk a)) a (pubk a))) (send (enc (enc m (pubk a)) a (pubk a)))) ((recv (enc (enc m (pubk a)) a (pubk a))) (send (enc (enc m (pubk a)) a (pubk a)))) ((recv (enc (enc m (pubk a)) a (pubk a))) (send (enc (enc m (pubk a)) a (pubk a))))) - (label 46) - (parent 34) + (label 51) + (parent 37) (unrealized) (comment "aborted")) @@ -1328,7 +1477,7 @@ (send (enc (enc m (pubk a)) b (pubk a)))) ((recv (enc (enc (enc m (pubk b)) a (pubk b)) a-2 (pubk b))) (send (enc (enc (enc m (pubk b)) a (pubk a-2)) b (pubk a-2))))) - (label 47) - (parent 34) + (label 52) + (parent 37) (unrealized) (comment "aborted")) diff --git a/tst/encsig.tst b/tst/encsig.tst --- a/tst/encsig.tst +++ b/tst/encsig.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol mult-keys-enc-sig basic diff --git a/tst/epmo.tst b/tst/epmo.tst --- a/tst/epmo.tst +++ b/tst/epmo.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol epmo basic diff --git a/tst/epmo_acctnum.tst b/tst/epmo_acctnum.tst --- a/tst/epmo_acctnum.tst +++ b/tst/epmo_acctnum.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol epmo_acctnum basic diff --git a/tst/ffgg.tst b/tst/ffgg.tst --- a/tst/ffgg.tst +++ b/tst/ffgg.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol ffgg basic diff --git a/tst/fragile_pruning.scm b/tst/fragile_pruning.scm new file mode 100644 --- /dev/null +++ b/tst/fragile_pruning.scm @@ -0,0 +1,39 @@ +;;; Illustrates how delicate pruning must be: +;;; to find a shape we must allow 3 almost +;;; identical instances of "adder", without +;;; pruning them even though they are renamings of +;;; each other. + +(defprotocol fragile_pruning basic + (defrole init (vars (k akey) (n n1 n2 n3 text)) + (trace + (send (enc n k)) + (recv (enc n n1 k)) + (recv (enc n n2 k)) + (recv (enc n n3 k)) + (send (enc n n1 n2 n3 k)) + (recv (enc n n1 n2 n3 n k)) + ) + (uniq-orig n) + (non-orig (invk k)) + ) + (defrole adder (vars (k akey) (n new text)) + (trace + (recv (enc n k)) + (send (enc n new k)) + ) + (uniq-orig new) + ) + (defrole final (vars (k akey) (n n1 n2 n3 text)) + (trace + (recv (enc n n1 n2 n3 k)) + (send (enc n n1 n2 n3 n k)) + ) + ) +) + +(defskeleton fragile_pruning + (vars (k akey) (n n1 n2 n3 text)) + (defstrand init 6 (k k) (n n) (n1 n1) (n2 n2) (n3 n3)) + (uniq-orig n1 n2 n3) +) diff --git a/tst/fragile_pruning.tst b/tst/fragile_pruning.tst new file mode 100644 --- /dev/null +++ b/tst/fragile_pruning.tst @@ -0,0 +1,150 @@ +(comment "CPSA 2.1.1") +(comment "All input read") + +(defprotocol fragile_pruning basic + (defrole init + (vars (k akey) (n n1 n2 n3 text)) + (trace (send (enc n k)) (recv (enc n n1 k)) (recv (enc n n2 k)) + (recv (enc n n3 k)) (send (enc n n1 n2 n3 k)) + (recv (enc n n1 n2 n3 n k))) + (non-orig (invk k)) + (uniq-orig n)) + (defrole adder + (vars (k akey) (n new text)) + (trace (recv (enc n k)) (send (enc n new k))) + (uniq-orig new)) + (defrole final + (vars (k akey) (n n1 n2 n3 text)) + (trace (recv (enc n n1 n2 n3 k)) (send (enc n n1 n2 n3 n k))))) + +(defskeleton fragile_pruning + (vars (n n1 n2 n3 text) (k akey)) + (defstrand init 6 (n n) (n1 n1) (n2 n2) (n3 n3) (k k)) + (non-orig (invk k)) + (uniq-orig n n1 n2 n3) + (traces + ((send (enc n k)) (recv (enc n n1 k)) (recv (enc n n2 k)) + (recv (enc n n3 k)) (send (enc n n1 n2 n3 k)) + (recv (enc n n1 n2 n3 n k)))) + (label 0) + (unrealized (0 1) (0 2) (0 3) (0 5)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton fragile_pruning + (vars (n n1 n2 n3 new text) (k akey)) + (defstrand init 6 (n n) (n1 n1) (n2 n2) (n3 n3) (k k)) + (defstrand adder 2 (n n) (new new) (k k)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (invk k)) + (uniq-orig n n1 n2 n3 new) + (operation nonce-test (added-strand adder 2) n (0 1) (enc n k)) + (traces + ((send (enc n k)) (recv (enc n n1 k)) (recv (enc n n2 k)) + (recv (enc n n3 k)) (send (enc n n1 n2 n3 k)) + (recv (enc n n1 n2 n3 n k))) + ((recv (enc n k)) (send (enc n new k)))) + (label 1) + (parent 0) + (unrealized (0 1) (0 2) (0 3) (0 5)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton fragile_pruning + (vars (n n2 n3 new text) (k akey)) + (defstrand init 6 (n n) (n1 new) (n2 n2) (n3 n3) (k k)) + (defstrand adder 2 (n n) (new new) (k k)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (invk k)) + (uniq-orig n n2 n3 new) + (operation nonce-test (contracted (n1 new)) n (0 1) (enc n k) + (enc n new k)) + (traces + ((send (enc n k)) (recv (enc n new k)) (recv (enc n n2 k)) + (recv (enc n n3 k)) (send (enc n new n2 n3 k)) + (recv (enc n new n2 n3 n k))) + ((recv (enc n k)) (send (enc n new k)))) + (label 2) + (parent 1) + (unrealized (0 2) (0 3) (0 5)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton fragile_pruning + (vars (n n3 new text) (k akey)) + (defstrand init 6 (n n) (n1 new) (n2 new) (n3 n3) (k k)) + (defstrand adder 2 (n n) (new new) (k k)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (invk k)) + (uniq-orig n n3 new) + (operation nonce-test (contracted (n2 new)) n (0 2) (enc n k) + (enc n new k)) + (traces + ((send (enc n k)) (recv (enc n new k)) (recv (enc n new k)) + (recv (enc n n3 k)) (send (enc n new new n3 k)) + (recv (enc n new new n3 n k))) + ((recv (enc n k)) (send (enc n new k)))) + (label 3) + (parent 2) + (unrealized (0 3) (0 5)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton fragile_pruning + (vars (n new text) (k akey)) + (defstrand init 6 (n n) (n1 new) (n2 new) (n3 new) (k k)) + (defstrand adder 2 (n n) (new new) (k k)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (invk k)) + (uniq-orig n new) + (operation nonce-test (contracted (n3 new)) n (0 3) (enc n k) + (enc n new k)) + (traces + ((send (enc n k)) (recv (enc n new k)) (recv (enc n new k)) + (recv (enc n new k)) (send (enc n new new new k)) + (recv (enc n new new new n k))) + ((recv (enc n k)) (send (enc n new k)))) + (label 4) + (parent 3) + (unrealized (0 5)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton fragile_pruning + (vars (n new text) (k akey)) + (defstrand init 6 (n n) (n1 new) (n2 new) (n3 new) (k k)) + (defstrand adder 2 (n n) (new new) (k k)) + (defstrand final 2 (n n) (n1 new) (n2 new) (n3 new) (k k)) + (precedes ((0 0) (1 0)) ((1 1) (0 1)) ((1 1) (2 0)) ((2 1) (0 5))) + (non-orig (invk k)) + (uniq-orig n new) + (operation nonce-test (added-strand final 2) n (0 5) (enc n k) + (enc n new k) (enc n new new new k)) + (traces + ((send (enc n k)) (recv (enc n new k)) (recv (enc n new k)) + (recv (enc n new k)) (send (enc n new new new k)) + (recv (enc n new new new n k))) + ((recv (enc n k)) (send (enc n new k))) + ((recv (enc n new new new k)) (send (enc n new new new n k)))) + (label 5) + (parent 4) + (unrealized (2 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton fragile_pruning + (vars (n new text) (k akey)) + (defstrand init 6 (n n) (n1 new) (n2 new) (n3 new) (k k)) + (defstrand adder 2 (n n) (new new) (k k)) + (defstrand final 2 (n n) (n1 new) (n2 new) (n3 new) (k k)) + (precedes ((0 0) (1 0)) ((0 4) (2 0)) ((1 1) (0 1)) ((2 1) (0 5))) + (non-orig (invk k)) + (uniq-orig n new) + (operation nonce-test (added-strand init 5) n (2 0) (enc n k) + (enc n new k)) + (traces + ((send (enc n k)) (recv (enc n new k)) (recv (enc n new k)) + (recv (enc n new k)) (send (enc n new new new k)) + (recv (enc n new new new n k))) + ((recv (enc n k)) (send (enc n new k))) + ((recv (enc n new new new k)) (send (enc n new new new n k)))) + (label 6) + (parent 5) + (unrealized) + (shape)) + +(comment "Nothing left to do") diff --git a/tst/isoreject.tst b/tst/isoreject.tst --- a/tst/isoreject.tst +++ b/tst/isoreject.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol isoreject basic diff --git a/tst/kelly1.tst b/tst/kelly1.tst --- a/tst/kelly1.tst +++ b/tst/kelly1.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol kelly1 basic diff --git a/tst/kerberos.tst b/tst/kerberos.tst --- a/tst/kerberos.tst +++ b/tst/kerberos.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol kerberos basic diff --git a/tst/missing_contraction.scm b/tst/missing_contraction.scm --- a/tst/missing_contraction.scm +++ b/tst/missing_contraction.scm @@ -23,7 +23,6 @@ (deflistener (enc a m (pubk c))) (uniq-orig m) (non-orig (privk a))) - (defskeleton missing-contraction (vars (m text) (a b c name)) diff --git a/tst/missing_contraction.tst b/tst/missing_contraction.tst --- a/tst/missing_contraction.tst +++ b/tst/missing_contraction.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol missing-contraction basic diff --git a/tst/neuman-stubblebine-reauth.tst b/tst/neuman-stubblebine-reauth.tst --- a/tst/neuman-stubblebine-reauth.tst +++ b/tst/neuman-stubblebine-reauth.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol neuman-stubblebine basic diff --git a/tst/neuman-stubblebine.tst b/tst/neuman-stubblebine.tst --- a/tst/neuman-stubblebine.tst +++ b/tst/neuman-stubblebine.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol neuman-stubblebine basic diff --git a/tst/no_contraction.tst b/tst/no_contraction.tst --- a/tst/no_contraction.tst +++ b/tst/no_contraction.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol no-contraction basic diff --git a/tst/non_transforming.tst b/tst/non_transforming.tst --- a/tst/non_transforming.tst +++ b/tst/non_transforming.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol non_transforming basic @@ -164,10 +164,9 @@ ((recv (enc c c (pubk B1))) (send (enc c (pubk B1))))) (label 7) (parent 5) - (seen 10) (unrealized) (shape) - (comment "2 in cohort - 1 not yet seen")) + (comment "2 in cohort - 2 not yet seen")) (defskeleton non_transforming (vars (a d text) (B1 name)) @@ -214,14 +213,34 @@ (defstrand recv 2 (a d) (b d) (B B1)) (defstrand sender 1 (a d) (b d) (B B1)) (defstrand breaker 2 (a d) (b d) (B B1)) - (precedes ((1 0) (2 0)) ((2 1) (0 0))) + (defstrand breaker 2 (a d) (b d) (B B1)) + (precedes ((1 0) (2 0)) ((1 0) (3 0)) ((2 1) (0 0)) ((3 1) (0 1))) (non-orig (privk B1)) (uniq-orig d) (operation collapsed 2 1) (traces ((recv (enc d (pubk B1))) (recv (enc d (pubk B1)))) ((send (enc d d (pubk B1)))) + ((recv (enc d d (pubk B1))) (send (enc d (pubk B1)))) ((recv (enc d d (pubk B1))) (send (enc d (pubk B1))))) (label 10) + (parent 7) + (seen 11) + (unrealized) + (comment "1 in cohort - 0 not yet seen")) + +(defskeleton non_transforming + (vars (d text) (B1 name)) + (defstrand recv 2 (a d) (b d) (B B1)) + (defstrand sender 1 (a d) (b d) (B B1)) + (defstrand breaker 2 (a d) (b d) (B B1)) + (precedes ((1 0) (2 0)) ((2 1) (0 0))) + (non-orig (privk B1)) + (uniq-orig d) + (operation collapsed 4 3) + (traces ((recv (enc d (pubk B1))) (recv (enc d (pubk B1)))) + ((send (enc d d (pubk B1)))) + ((recv (enc d d (pubk B1))) (send (enc d (pubk B1))))) + (label 11) (parent 7) (unrealized) (shape)) diff --git a/tst/nonaug-prune.scm b/tst/nonaug-prune.scm new file mode 100644 --- /dev/null +++ b/tst/nonaug-prune.scm @@ -0,0 +1,42 @@ +;; This protocol shows that it is possible to prune +;; two strands of a parent skeleton after augmenting +;; with a new strand. + +(defprotocol nonaug-prune basic + (defrole orig + (vars (n text) (A B name) (k akey)) + (trace + (send (enc n B B k)) + (send (enc n A k)) + (recv (enc n A A A k))) + (uniq-orig n) + (non-orig (invk k))) + (defrole trans1 + (vars (n text) (A C name) (k akey)) + (trace + (recv (enc n A A k)) + (recv (enc n A k)) + (send (enc n n C k)))) + (defrole trans2 + (vars (n text) (A name) (k akey)) + (trace + (recv (enc n A k)) + (send (enc n A A A k)))) +) + +;; (defskeleton nonaug-prune +;; (vars (n text) (A B C name) (k akey)) +;; (defstrand trans1 3 (n n) (A A) (C C) (k k)) +;; (defstrand orig 3 (n n) (A A) (B B) (k k)) +;; (precedes ((1 0) (0 0)) ((0 2) (1 2)))) + +;; (defskeleton nonaug-prune +;; (vars (n text) (A B name) (k akey)) +;; (defstrand orig 3 (n n) (A A) (B B) (k k))) + +(defskeleton nonaug-prune + (vars (n text) (A B name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand trans2 2 (n n) (A A) (k k)) + (defstrand orig 3 (n n) (A A)(B B) (k k)) + (precedes ((2 0) (0 0)) ((2 0) (1 0)))) diff --git a/tst/nonaug-prune.tst b/tst/nonaug-prune.tst new file mode 100644 --- /dev/null +++ b/tst/nonaug-prune.tst @@ -0,0 +1,371 @@ +(comment "CPSA 2.1.1") +(comment "All input read") + +(defprotocol nonaug-prune basic + (defrole orig + (vars (n text) (A B name) (k akey)) + (trace (send (enc n B B k)) (send (enc n A k)) + (recv (enc n A A A k))) + (non-orig (invk k)) + (uniq-orig n)) + (defrole trans1 + (vars (n text) (A C name) (k akey)) + (trace (recv (enc n A A k)) (recv (enc n A k)) + (send (enc n n C k)))) + (defrole trans2 + (vars (n text) (A name) (k akey)) + (trace (recv (enc n A k)) (send (enc n A A A k))))) + +(defskeleton nonaug-prune + (vars (n text) (A B name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand trans2 2 (n n) (A A) (k k)) + (defstrand orig 3 (n n) (A A) (B B) (k k)) + (precedes ((2 0) (0 0)) ((2 0) (1 0))) + (non-orig (invk k)) + (uniq-orig n) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((recv (enc n A k)) (send (enc n A A A k))) + ((send (enc n B B k)) (send (enc n A k)) (recv (enc n A A A k)))) + (label 0) + (unrealized (0 0) (1 0) (2 2)) + (comment "2 in cohort - 2 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (B C name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A B) (B B) (k k)) + (defstrand trans1 3 (n n) (A B) (C C) (k k)) + (precedes ((2 0) (0 0)) ((2 0) (1 0)) ((2 0) (3 0)) ((3 2) (2 2))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand trans1 3) n (2 2) (enc n B k) + (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n B k)) (recv (enc n B B B k))) + ((recv (enc n B B k)) (recv (enc n B k)) (send (enc n n C k)))) + (label 1) + (parent 0) + (unrealized (0 0) (1 0) (2 2) (3 1)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (A B name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A A) (B B) (k k)) + (defstrand trans2 2 (n n) (A A) (k k)) + (precedes ((1 0) (0 0)) ((1 0) (2 0)) ((2 1) (1 2))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand trans2 2) n (2 2) (enc n A k) + (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n A k)) (recv (enc n A A A k))) + ((recv (enc n A k)) (send (enc n A A A k)))) + (label 2) + (parent 0) + (unrealized (0 0) (2 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (B C name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A B) (B B) (k k)) + (defstrand trans1 3 (n n) (A B) (C C) (k k)) + (precedes ((2 0) (0 0)) ((2 0) (1 0)) ((2 0) (3 0)) ((2 1) (3 1)) + ((3 2) (2 2))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand orig 2) n (3 1) (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n B k)) (recv (enc n B B B k))) + ((recv (enc n B B k)) (recv (enc n B k)) (send (enc n n C k)))) + (label 3) + (parent 1) + (unrealized (0 0) (1 0) (2 2)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (A B name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A A) (B B) (k k)) + (defstrand trans2 2 (n n) (A A) (k k)) + (precedes ((1 0) (0 0)) ((1 1) (2 0)) ((2 1) (1 2))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand orig 2) n (2 0) (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n A k)) (recv (enc n A A A k))) + ((recv (enc n A k)) (send (enc n A A A k)))) + (label 4) + (parent 2) + (unrealized (0 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (B C name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A B) (B B) (k k)) + (defstrand trans1 3 (n n) (A B) (C C) (k k)) + (defstrand trans2 2 (n n) (A B) (k k)) + (precedes ((1 0) (0 0)) ((1 0) (2 0)) ((1 0) (3 0)) ((1 1) (2 1)) + ((2 2) (1 2)) ((3 1) (1 2))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand trans2 2) n (2 2) (enc n B k) + (enc n n C k) (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n B k)) (recv (enc n B B B k))) + ((recv (enc n B B k)) (recv (enc n B k)) (send (enc n n C k))) + ((recv (enc n B k)) (send (enc n B B B k)))) + (label 5) + (parent 3) + (unrealized (0 0) (3 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (A B name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A A) (B B) (k k)) + (defstrand trans2 2 (n n) (A A) (k k)) + (precedes ((1 1) (0 0)) ((1 1) (2 0)) ((2 1) (1 2))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand orig 2) n (0 0) (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n A k)) (recv (enc n A A A k))) + ((recv (enc n A k)) (send (enc n A A A k)))) + (label 6) + (parent 4) + (unrealized (0 0)) + (comment "3 in cohort - 3 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (B C name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A B) (B B) (k k)) + (defstrand trans1 3 (n n) (A B) (C C) (k k)) + (defstrand trans2 2 (n n) (A B) (k k)) + (precedes ((1 0) (0 0)) ((1 0) (2 0)) ((1 1) (2 1)) ((1 1) (3 0)) + ((2 2) (1 2)) ((3 1) (1 2))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand orig 2) n (3 0) (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n B k)) (recv (enc n B B B k))) + ((recv (enc n B B k)) (recv (enc n B k)) (send (enc n n C k))) + ((recv (enc n B k)) (send (enc n B B B k)))) + (label 7) + (parent 5) + (unrealized (0 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (A name) (k akey)) + (defstrand trans2 2 (n n) (A A) (k k)) + (defstrand orig 3 (n n) (A A) (B A) (k k)) + (defstrand trans2 2 (n n) (A A) (k k)) + (precedes ((1 1) (0 0)) ((1 1) (2 0)) ((2 1) (1 2))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (contracted (B A)) n (0 0) (enc n A k) + (enc n A A k)) + (traces ((recv (enc n A k)) (send (enc n A A A k))) + ((send (enc n A A k)) (send (enc n A k)) (recv (enc n A A A k))) + ((recv (enc n A k)) (send (enc n A A A k)))) + (label 8) + (parent 6) + (unrealized) + (shape) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (B C name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A B) (B B) (k k)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand trans1 3 (n n) (A B) (C C) (k k)) + (precedes ((1 0) (3 0)) ((1 1) (0 0)) ((1 1) (2 0)) ((2 1) (1 2)) + ((3 2) (0 0))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand trans1 3) n (0 0) (enc n B k) + (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n B k)) (recv (enc n B B B k))) + ((recv (enc n B k)) (send (enc n B B B k))) + ((recv (enc n B B k)) (recv (enc n B k)) (send (enc n n C k)))) + (label 9) + (parent 6) + (unrealized (3 1)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (A B name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A A) (B B) (k k)) + (defstrand trans2 2 (n n) (A A) (k k)) + (defstrand trans2 2 (n n) (A A) (k k)) + (precedes ((1 0) (3 0)) ((1 1) (0 0)) ((1 1) (2 0)) ((2 1) (1 2)) + ((3 1) (0 0))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand trans2 2) n (0 0) (enc n A k) + (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n A k)) (recv (enc n A A A k))) + ((recv (enc n A k)) (send (enc n A A A k))) + ((recv (enc n A k)) (send (enc n A A A k)))) + (label 10) + (parent 6) + (unrealized (0 0) (3 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (B C name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A B) (B B) (k k)) + (defstrand trans1 3 (n n) (A B) (C C) (k k)) + (defstrand trans2 2 (n n) (A B) (k k)) + (precedes ((1 0) (2 0)) ((1 1) (0 0)) ((1 1) (2 1)) ((1 1) (3 0)) + ((2 2) (1 2)) ((3 1) (1 2))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand orig 2) n (0 0) (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n B k)) (recv (enc n B B B k))) + ((recv (enc n B B k)) (recv (enc n B k)) (send (enc n n C k))) + ((recv (enc n B k)) (send (enc n B B B k)))) + (label 11) + (parent 7) + (seen 8) + (unrealized) + (comment "1 in cohort - 0 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (A name) (k akey)) + (defstrand trans2 2 (n n) (A A) (k k)) + (defstrand orig 3 (n n) (A A) (B A) (k k)) + (precedes ((0 1) (1 2)) ((1 1) (0 0))) + (non-orig (invk k)) + (uniq-orig n) + (operation collapsed 2 0) + (traces ((recv (enc n A k)) (send (enc n A A A k))) + ((send (enc n A A k)) (send (enc n A k)) (recv (enc n A A A k)))) + (label 12) + (parent 8) + (unrealized) + (shape)) + +(defskeleton nonaug-prune + (vars (n text) (B C name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A B) (B B) (k k)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand trans1 3 (n n) (A B) (C C) (k k)) + (precedes ((1 0) (3 0)) ((1 1) (2 0)) ((1 1) (3 1)) ((2 1) (1 2)) + ((3 2) (0 0))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand orig 2) n (3 1) (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n B k)) (recv (enc n B B B k))) + ((recv (enc n B k)) (send (enc n B B B k))) + ((recv (enc n B B k)) (recv (enc n B k)) (send (enc n n C k)))) + (label 13) + (parent 9) + (seen 8) + (unrealized) + (comment "1 in cohort - 0 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (A B name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A A) (B B) (k k)) + (defstrand trans2 2 (n n) (A A) (k k)) + (defstrand trans2 2 (n n) (A A) (k k)) + (precedes ((1 1) (2 0)) ((1 1) (3 0)) ((2 1) (1 2)) ((3 1) (0 0))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand orig 2) n (3 0) (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n A k)) (recv (enc n A A A k))) + ((recv (enc n A k)) (send (enc n A A A k))) + ((recv (enc n A k)) (send (enc n A A A k)))) + (label 14) + (parent 10) + (unrealized (0 0)) + (comment "2 in cohort - 2 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (A name) (k akey)) + (defstrand trans2 2 (n n) (A A) (k k)) + (defstrand orig 3 (n n) (A A) (B A) (k k)) + (defstrand trans2 2 (n n) (A A) (k k)) + (defstrand trans2 2 (n n) (A A) (k k)) + (precedes ((1 1) (2 0)) ((1 1) (3 0)) ((2 1) (1 2)) ((3 1) (0 0))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (contracted (B A)) n (0 0) (enc n A k) + (enc n A A k) (enc n A A A k)) + (traces ((recv (enc n A k)) (send (enc n A A A k))) + ((send (enc n A A k)) (send (enc n A k)) (recv (enc n A A A k))) + ((recv (enc n A k)) (send (enc n A A A k))) + ((recv (enc n A k)) (send (enc n A A A k)))) + (label 15) + (parent 14) + (seen 8) + (unrealized) + (comment "1 in cohort - 0 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (B C name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A B) (B B) (k k)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand trans1 3 (n n) (A B) (C C) (k k)) + (precedes ((1 0) (4 0)) ((1 1) (2 0)) ((1 1) (3 0)) ((2 1) (1 2)) + ((3 1) (0 0)) ((4 2) (0 0))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand trans1 3) n (0 0) (enc n B k) + (enc n B B k) (enc n B B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n B k)) (recv (enc n B B B k))) + ((recv (enc n B k)) (send (enc n B B B k))) + ((recv (enc n B k)) (send (enc n B B B k))) + ((recv (enc n B B k)) (recv (enc n B k)) (send (enc n n C k)))) + (label 16) + (parent 14) + (unrealized (4 1)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton nonaug-prune + (vars (n text) (B C name) (k akey)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand orig 3 (n n) (A B) (B B) (k k)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand trans2 2 (n n) (A B) (k k)) + (defstrand trans1 3 (n n) (A B) (C C) (k k)) + (precedes ((1 0) (4 0)) ((1 1) (2 0)) ((1 1) (3 0)) ((1 1) (4 1)) + ((2 1) (1 2)) ((3 1) (0 0)) ((4 2) (0 0))) + (non-orig (invk k)) + (uniq-orig n) + (operation nonce-test (added-strand orig 2) n (4 1) (enc n B B k)) + (traces ((recv (enc n B k)) (send (enc n B B B k))) + ((send (enc n B B k)) (send (enc n B k)) (recv (enc n B B B k))) + ((recv (enc n B k)) (send (enc n B B B k))) + ((recv (enc n B k)) (send (enc n B B B k))) + ((recv (enc n B B k)) (recv (enc n B k)) (send (enc n n C k)))) + (label 17) + (parent 16) + (seen 13) + (unrealized) + (comment "1 in cohort - 0 not yet seen")) + +(comment "Nothing left to do") diff --git a/tst/ns.scm b/tst/ns.scm --- a/tst/ns.scm +++ b/tst/ns.scm @@ -23,6 +23,15 @@ (uniq-orig n1) (comment "Initiator 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) + (comment "Double initiator point-of-view")) + ;;; The responder point-of-view (defskeleton ns (vars (a name) (n2 text)) diff --git a/tst/ns.tst b/tst/ns.tst --- a/tst/ns.tst +++ b/tst/ns.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol ns basic @@ -75,6 +75,161 @@ (comment "Needham-Schroeder with no role origination assumptions")) (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) + (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 3) + (unrealized (0 1) (1 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 (n2 n2-1) (n1 n1-0) (b b) (a a)) + (precedes ((1 0) (2 0)) ((2 1) (1 1))) + (non-orig (privk a) (privk b)) + (uniq-orig n1 n1-0) + (operation nonce-test (added-strand resp 2) n1-0 (1 1) + (enc n1-0 a (pubk b))) + (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 4) + (parent 3) + (unrealized (0 1) (1 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) (a a) (b b)) + (defstrand init 3 (n1 n1-0) (n2 n2-0) (a a) (b b)) + (defstrand resp 2 (n2 n2-0) (n1 n1-0) (b b) (a a)) + (precedes ((1 0) (2 0)) ((2 1) (1 1))) + (non-orig (privk a) (privk b)) + (uniq-orig n1 n1-0) + (operation nonce-test (contracted (n2-1 n2-0)) n1-0 (1 1) + (enc n1-0 n2-0 (pubk a)) (enc n1-0 a (pubk b))) + (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 5) + (parent 4) + (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 (n2 n2-0) (n1 n1-0) (b b) (a a)) + (defstrand resp 2 (n2 n2-1) (n1 n1) (b b) (a a)) + (precedes ((0 0) (3 0)) ((1 0) (2 0)) ((2 1) (1 1)) ((3 1) (0 1))) + (non-orig (privk a) (privk b)) + (uniq-orig n1 n1-0) + (operation nonce-test (added-strand resp 2) n1 (0 1) + (enc n1 a (pubk b))) + (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 6) + (parent 5) + (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 (n2 n2) (n1 n1-0) (b b) (a a)) + (defstrand resp 2 (n2 n2-0) (n1 n1) (b b) (a a)) + (precedes ((0 0) (3 0)) ((1 0) (2 0)) ((2 1) (1 1)) ((3 1) (0 1))) + (non-orig (privk a) (privk b)) + (uniq-orig n1 n1-0) + (operation nonce-test (contracted (n2-1 n2-0)) n1 (0 1) + (enc n1 n2-0 (pubk a)) (enc n1 a (pubk b))) + (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 7) + (parent 6) + (unrealized) + (shape) + (comment "2 in cohort - 2 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)) + (defstrand resp 2 (n2 n2) (n1 n1) (b b) (a a)) + (precedes ((0 0) (1 0)) ((0 0) (2 0)) ((1 1) (0 1)) ((2 1) (0 1))) + (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)))) + ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a)))) + ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a))))) + (label 8) + (parent 7) + (seen 9) + (unrealized) + (comment "1 in cohort - 0 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 collapsed 3 2) + (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 9) + (parent 7) + (unrealized) + (shape)) + +(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)) @@ -83,7 +238,7 @@ (traces ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a))) (recv (enc n2 (pubk b))))) - (label 3) + (label 10) (unrealized (0 2)) (comment "1 in cohort - 1 not yet seen")) @@ -101,8 +256,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 4) - (parent 3) + (label 11) + (parent 10) (unrealized) (shape)) @@ -132,7 +287,7 @@ (traces ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a))) (send (enc n2 (pubk b))))) - (label 5) + (label 12) (unrealized (0 1)) (comment "1 in cohort - 1 not yet seen")) @@ -149,8 +304,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 6) - (parent 5) + (label 13) + (parent 12) (unrealized (0 1)) (comment "1 in cohort - 1 not yet seen")) @@ -167,8 +322,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 7) - (parent 6) + (label 14) + (parent 13) (unrealized) (shape)) @@ -198,7 +353,7 @@ (traces ((recv (enc n1 a (pubk b))) (send (enc n1 n2 (pubk a))) (recv (enc n2 (pubk b))))) - (label 8) + (label 15) (unrealized (0 2)) (comment "1 in cohort - 1 not yet seen")) @@ -216,8 +371,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 9) - (parent 8) + (label 16) + (parent 15) (unrealized (0 0) (0 2)) (comment "2 in cohort - 2 not yet seen")) @@ -235,8 +390,8 @@ (recv (enc n2 (pubk b)))) ((send (enc n1 a (pubk b))) (recv (enc n1 n2 (pubk a))) (send (enc n2 (pubk b))))) - (label 10) - (parent 9) + (label 17) + (parent 16) (unrealized) (shape)) @@ -256,8 +411,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 11) - (parent 9) + (label 18) + (parent 16) (unrealized (0 0) (0 2)) (comment "1 in cohort - 1 not yet seen")) @@ -277,9 +432,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 12) - (parent 11) - (seen 10) + (label 19) + (parent 18) + (seen 17) (unrealized) (comment "1 in cohort - 0 not yet seen")) @@ -305,7 +460,7 @@ (traces ((send (enc n1 n3 a (pubk b))) (recv (enc n1 n2 (pubk a))) (send (enc n2 (pubk b))))) - (label 13) + (label 20) (unrealized (0 1)) (comment "1 in cohort - 1 not yet seen")) @@ -322,8 +477,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 14) - (parent 13) + (label 21) + (parent 20) (unrealized (0 1)) (comment "1 in cohort - 1 not yet seen")) @@ -340,8 +495,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 15) - (parent 14) + (label 22) + (parent 21) (unrealized) (shape)) @@ -369,7 +524,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 16) + (label 23) (unrealized) (shape)) diff --git a/tst/nsl3.tst b/tst/nsl3.tst --- a/tst/nsl3.tst +++ b/tst/nsl3.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol nsl3 basic diff --git a/tst/nsl4cm1.tst b/tst/nsl4cm1.tst --- a/tst/nsl4cm1.tst +++ b/tst/nsl4cm1.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol nsl4cm basic @@ -114,10 +114,12 @@ (vars (na nb nc nd nc-0 nb-0 text) (a b c d name)) (defstrand init 3 (na na) (nb nb) (nc nc) (nd nd) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-0) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) - (precedes ((0 0) (2 0)) ((1 1) (0 1)) ((2 1) (1 0))) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((1 1) (0 1)) ((2 1) (0 1)) + ((3 1) (2 0))) (non-orig (privk a) (privk b) (privk c) (privk d)) (uniq-orig na) (operation nonce-test (contracted (nb-1 nb-0)) na (2 0) @@ -126,6 +128,7 @@ ((send (enc a c d na (pubk b))) (recv (enc b c d na nb nc nd (pubk a))) (send (enc nb nc nd (pubk b)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-0 (pubk d)))) ((recv (enc a c d na (pubk b))) @@ -170,13 +173,14 @@ (vars (na nb nc nd nc-0 nb-0 nd-0 text) (a b c d name)) (defstrand init 3 (na na) (nb nb) (nc nc) (nd nd) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-0) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp3 2 (na na) (nb nb-0) (nc nc-0) (nd nd-0) (a a) (b b) (c c) (d d)) - (precedes ((0 0) (2 0)) ((0 0) (3 0)) ((1 1) (0 1)) ((2 1) (1 0)) - ((3 1) (0 1))) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((0 0) (4 0)) ((1 1) (0 1)) + ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (0 1))) (non-orig (privk a) (privk b) (privk c) (privk d)) (uniq-orig na) (operation nonce-test (added-strand resp3 2) na (0 1) @@ -186,6 +190,7 @@ ((send (enc a c d na (pubk b))) (recv (enc b c d na nb nc nd (pubk a))) (send (enc nb nc nd (pubk b)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-0 (pubk d)))) ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) @@ -193,7 +198,7 @@ (send (enc b c d na nb-0 nc-0 nd-0 (pubk a))))) (label 6) (parent 4) - (unrealized (0 1) (3 0)) + (unrealized (0 1) (4 0)) (comment "1 in cohort - 1 not yet seen")) (defskeleton nsl4cm @@ -234,22 +239,24 @@ (vars (na nb nc nd nc-0 nb-0 nd-0 nb-1 text) (a b c d name)) (defstrand init 3 (na na) (nb nb) (nc nc) (nd nd) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-0) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp3 2 (na na) (nb nb-0) (nc nc-0) (nd nd-0) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-1) (a a) (b b) (c c) (d d)) - (precedes ((0 0) (2 0)) ((0 0) (4 0)) ((1 1) (0 1)) ((2 1) (1 0)) - ((3 1) (0 1)) ((4 1) (3 0))) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((0 0) (5 0)) ((1 1) (0 1)) + ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (0 1)) ((5 1) (4 0))) (non-orig (privk a) (privk b) (privk c) (privk d)) (uniq-orig na) - (operation nonce-test (added-strand resp1 2) na (3 0) + (operation nonce-test (added-strand resp1 2) na (4 0) (enc a c d na (pubk b))) (traces ((send (enc a c d na (pubk b))) (recv (enc b c d na nb nc nd (pubk a))) (send (enc nb nc nd (pubk b)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-0 (pubk d)))) ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) @@ -259,7 +266,7 @@ (send (enc a b d na nb-1 (pubk c))))) (label 8) (parent 6) - (unrealized (0 1) (3 0)) + (unrealized (0 1) (4 0)) (comment "1 in cohort - 1 not yet seen")) (defskeleton nsl4cm @@ -269,11 +276,12 @@ (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-0) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-1) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-1) (nc nc-1) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-1) (a a) (b b) (c c) (d d)) - (precedes ((0 0) (1 0)) ((0 0) (4 0)) ((1 1) (0 1)) ((2 1) (0 1)) - ((3 1) (2 0)) ((4 1) (3 0))) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((0 0) (5 0)) ((1 1) (0 1)) + ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (2 0)) ((5 1) (4 0))) (non-orig (privk a) (privk b) (privk c) (privk d)) (uniq-orig na) (operation nonce-test (contracted (nb-2 nb-1)) na (4 0) @@ -285,6 +293,7 @@ ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-0 (pubk d)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-1 (pubk c)))) ((recv (enc a b d na nb-1 (pubk c))) (send (enc a b c na nb-1 nc-1 (pubk d)))) ((recv (enc a c d na (pubk b))) @@ -336,6 +345,7 @@ (vars (na nb nc nd nc-0 nb-0 nd-0 nb-1 nc-1 text) (a b c d name)) (defstrand init 3 (na na) (nb nb) (nc nc) (nd nd) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-0) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) @@ -344,16 +354,18 @@ (defstrand resp1 2 (na na) (nb nb-1) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-1) (nc nc-1) (a a) (b b) (c c) (d d)) - (precedes ((0 0) (2 0)) ((0 0) (4 0)) ((0 0) (5 0)) ((1 1) (0 1)) - ((2 1) (1 0)) ((3 1) (0 1)) ((4 1) (3 0)) ((5 1) (3 0))) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((0 0) (5 0)) ((0 0) (6 0)) + ((1 1) (0 1)) ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (0 1)) + ((5 1) (4 0)) ((6 1) (4 0))) (non-orig (privk a) (privk b) (privk c) (privk d)) (uniq-orig na) - (operation nonce-test (added-strand resp2 2) na (3 0) + (operation nonce-test (added-strand resp2 2) na (4 0) (enc a b d na nb-1 (pubk c)) (enc a c d na (pubk b))) (traces ((send (enc a c d na (pubk b))) (recv (enc b c d na nb nc nd (pubk a))) (send (enc nb nc nd (pubk b)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-0 (pubk d)))) ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) @@ -364,19 +376,22 @@ (send (enc a b c na nb-1 nc-1 (pubk d))))) (label 11) (parent 8) - (unrealized (0 1) (3 0) (5 0)) + (unrealized (0 1) (4 0) (6 0)) (comment "1 in cohort - 1 not yet seen")) (defskeleton nsl4cm (vars (na nb nc nd nc-0 nc-1 nb-0 text) (a b c d name)) (defstrand init 3 (na na) (nb nb) (nc nc) (nd nd) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-0) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-1) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) - (precedes ((0 0) (3 0)) ((1 1) (0 1)) ((2 1) (1 0)) ((3 1) (2 0))) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((0 0) (5 0)) ((1 1) (0 1)) + ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (2 0)) ((5 1) (4 0))) (non-orig (privk a) (privk b) (privk c) (privk d)) (uniq-orig na) (operation nonce-test (contracted (nb-1 nb-0)) na (2 0) @@ -386,8 +401,10 @@ ((send (enc a c d na (pubk b))) (recv (enc b c d na nb nc nd (pubk a))) (send (enc nb nc nd (pubk b)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-0 (pubk d)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-1 (pubk d)))) ((recv (enc a c d na (pubk b))) @@ -404,13 +421,15 @@ (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-0) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-1) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-1) (nc nc-1) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-1) (a a) (b b) (c c) (d d)) (defstrand resp3 2 (na na) (nb nb-1) (nc nc-1) (nd nd-0) (a a) (b b) (c c) (d d)) - (precedes ((0 0) (1 0)) ((0 0) (4 0)) ((0 0) (5 0)) ((1 1) (0 1)) - ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (3 0)) ((5 1) (2 0))) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((0 0) (5 0)) ((0 0) (6 0)) + ((1 1) (0 1)) ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (2 0)) + ((5 1) (4 0)) ((6 1) (2 0))) (non-orig (privk a) (privk b) (privk c) (privk d)) (uniq-orig na) (operation nonce-test (added-strand resp3 2) na (2 0) @@ -423,6 +442,7 @@ ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-0 (pubk d)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-1 (pubk c)))) ((recv (enc a b d na nb-1 (pubk c))) (send (enc a b c na nb-1 nc-1 (pubk d)))) ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-1 (pubk c)))) @@ -430,7 +450,7 @@ (send (enc b c d na nb-1 nc-1 nd-0 (pubk a))))) (label 13) (parent 9) - (unrealized (0 1) (2 0) (5 0)) + (unrealized (0 1) (2 0) (6 0)) (comment "1 in cohort - 1 not yet seen")) (comment "Strand bound exceeded--aborting run") @@ -481,6 +501,7 @@ (vars (na nb nc nd nc-0 nb-0 nd-0 nb-1 nc-1 nb-2 text) (a b c d name)) (defstrand init 3 (na na) (nb nb) (nc nc) (nd nd) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-0) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) @@ -490,17 +511,18 @@ (defstrand resp2 2 (na na) (nb nb-1) (nc nc-1) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-2) (a a) (b b) (c c) (d d)) - (precedes ((0 0) (2 0)) ((0 0) (4 0)) ((0 0) (6 0)) ((1 1) (0 1)) - ((2 1) (1 0)) ((3 1) (0 1)) ((4 1) (3 0)) ((5 1) (3 0)) - ((6 1) (5 0))) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((0 0) (5 0)) ((0 0) (7 0)) + ((1 1) (0 1)) ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (0 1)) + ((5 1) (4 0)) ((6 1) (4 0)) ((7 1) (6 0))) (non-orig (privk a) (privk b) (privk c) (privk d)) (uniq-orig na) - (operation nonce-test (added-strand resp1 2) na (5 0) + (operation nonce-test (added-strand resp1 2) na (6 0) (enc a c d na (pubk b))) (traces ((send (enc a c d na (pubk b))) (recv (enc b c d na nb nc nd (pubk a))) (send (enc nb nc nd (pubk b)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-0 (pubk d)))) ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) @@ -513,22 +535,25 @@ (send (enc a b d na nb-2 (pubk c))))) (label 15) (parent 11) - (unrealized (0 1) (3 0) (5 0)) + (unrealized (0 1) (4 0) (6 0)) (comment "aborted")) (defskeleton nsl4cm (vars (na nb nc nd nc-0 nc-1 nb-0 nd-0 text) (a b c d name)) (defstrand init 3 (na na) (nb nb) (nc nc) (nd nd) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-0) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-1) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp3 2 (na na) (nb nb-0) (nc nc-0) (nd nd-0) (a a) (b b) (c c) (d d)) - (precedes ((0 0) (3 0)) ((0 0) (4 0)) ((1 1) (0 1)) ((2 1) (1 0)) - ((3 1) (2 0)) ((4 1) (0 1))) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((0 0) (5 0)) ((0 0) (6 0)) + ((1 1) (0 1)) ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (2 0)) + ((5 1) (4 0)) ((6 1) (0 1))) (non-orig (privk a) (privk b) (privk c) (privk d)) (uniq-orig na) (operation nonce-test (added-strand resp3 2) na (0 1) @@ -538,8 +563,10 @@ ((send (enc a c d na (pubk b))) (recv (enc b c d na nb nc nd (pubk a))) (send (enc nb nc nd (pubk b)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-0 (pubk d)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-1 (pubk d)))) ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) @@ -547,22 +574,25 @@ (send (enc b c d na nb-0 nc-0 nd-0 (pubk a))))) (label 16) (parent 12) - (unrealized (0 1) (4 0)) + (unrealized (0 1) (6 0)) (comment "aborted")) (defskeleton nsl4cm (vars (na nb nc nd nc-0 nc-1 nb-0 nd-0 text) (a b c d name)) (defstrand init 3 (na na) (nb nb) (nc nc) (nd nd) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-0) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-1) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp3 2 (na na) (nb nb-0) (nc nc-1) (nd nd-0) (a a) (b b) (c c) (d d)) - (precedes ((0 0) (3 0)) ((0 0) (4 0)) ((1 1) (0 1)) ((2 1) (1 0)) - ((3 1) (2 0)) ((4 1) (0 1))) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((0 0) (5 0)) ((0 0) (6 0)) + ((1 1) (0 1)) ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (2 0)) + ((5 1) (4 0)) ((6 1) (0 1))) (non-orig (privk a) (privk b) (privk c) (privk d)) (uniq-orig na) (operation nonce-test (added-strand resp3 2) na (0 1) @@ -572,8 +602,10 @@ ((send (enc a c d na (pubk b))) (recv (enc b c d na nb nc nd (pubk a))) (send (enc nb nc nd (pubk b)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-0 (pubk d)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-1 (pubk d)))) ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) @@ -581,7 +613,7 @@ (send (enc b c d na nb-0 nc-1 nd-0 (pubk a))))) (label 17) (parent 12) - (unrealized (0 1) (4 0)) + (unrealized (0 1) (6 0)) (comment "aborted")) (defskeleton nsl4cm @@ -591,18 +623,19 @@ (defstrand resp1 2 (na na) (nb nb-0) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-0) (nc nc-0) (a a) (b b) (c c) (d d)) + (defstrand resp1 2 (na na) (nb nb-1) (a a) (b b) (c c) (d d)) (defstrand resp2 2 (na na) (nb nb-1) (nc nc-1) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-1) (a a) (b b) (c c) (d d)) (defstrand resp3 2 (na na) (nb nb-1) (nc nc-1) (nd nd-0) (a a) (b b) (c c) (d d)) (defstrand resp1 2 (na na) (nb nb-2) (a a) (b b) (c c) (d d)) - (precedes ((0 0) (1 0)) ((0 0) (4 0)) ((0 0) (6 0)) ((1 1) (0 1)) - ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (3 0)) ((5 1) (2 0)) - ((6 1) (5 0))) + (precedes ((0 0) (1 0)) ((0 0) (3 0)) ((0 0) (5 0)) ((0 0) (7 0)) + ((1 1) (0 1)) ((2 1) (0 1)) ((3 1) (2 0)) ((4 1) (2 0)) + ((5 1) (4 0)) ((6 1) (2 0)) ((7 1) (6 0))) (non-orig (privk a) (privk b) (privk c) (privk d)) (uniq-orig na) - (operation nonce-test (added-strand resp1 2) na (5 0) + (operation nonce-test (added-strand resp1 2) na (6 0) (enc a c d na (pubk b))) (traces ((send (enc a c d na (pubk b))) @@ -611,6 +644,7 @@ ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-0 (pubk c)))) ((recv (enc a b d na nb-0 (pubk c))) (send (enc a b c na nb-0 nc-0 (pubk d)))) + ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-1 (pubk c)))) ((recv (enc a b d na nb-1 (pubk c))) (send (enc a b c na nb-1 nc-1 (pubk d)))) ((recv (enc a c d na (pubk b))) (send (enc a b d na nb-1 (pubk c)))) @@ -620,5 +654,5 @@ (send (enc a b d na nb-2 (pubk c))))) (label 18) (parent 13) - (unrealized (0 1) (2 0) (5 0)) + (unrealized (0 1) (2 0) (6 0)) (comment "aborted")) diff --git a/tst/nslsk.tst b/tst/nslsk.tst --- a/tst/nslsk.tst +++ b/tst/nslsk.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol nslsk basic diff --git a/tst/or.tst b/tst/or.tst --- a/tst/or.tst +++ b/tst/or.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol or basic diff --git a/tst/pca.tst b/tst/pca.tst --- a/tst/pca.tst +++ b/tst/pca.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol aic basic diff --git a/tst/pruning1.scm b/tst/pruning1.scm --- a/tst/pruning1.scm +++ b/tst/pruning1.scm @@ -1,32 +1,31 @@ -(defprotocol prune basic - (defrole init (vars (a b name) (n text)) - (trace - (send (enc n (pubk a))) - (recv (enc n (pubk b) (pubk a))) - (recv (enc n (privk b) (pubk a))) - ) - (uniq-orig n) - (non-orig (privk a)) - ) - (defrole trans (vars (a name) (n text) (k akey)) - (trace - (recv (enc n (pubk a))) - (recv k ) - (send (enc n k (pubk a))) - ) - ) - (comment "Shows a failure with generalization" - "Run this with a step count of 4")) - -(defskeleton prune - (vars (a name) (n text) (k akey)) - (defstrand init 3)) - -(defskeleton prune - (vars (n text) (a b name)) - (defstrand init 3 (n n) (a a) (b b)) - (defstrand trans 3 (n n) (a a) (k (pubk b))) - (defstrand trans 3 (n n) (a a) (k (privk b))) - (precedes ((0 0) (1 0)) ((0 0) (2 0)) ((1 2) (0 1)) ((2 2) (0 2))) -) - +(defprotocol prune basic + (defrole init (vars (a b name) (n text)) + (trace + (send (enc n (pubk a))) + (recv (enc n (pubk b) (pubk a))) + (recv (enc n (privk b) (pubk a))) + ) + (uniq-orig n) + (non-orig (privk a)) + ) + (defrole trans (vars (a name) (n text) (k akey)) + (trace + (recv (enc n (pubk a))) + (recv k ) + (send (enc n k (pubk a))) + ) + ) + (comment "Shows a failure with generalization" + "Run this with a step count of 4")) + +(defskeleton prune + (vars (a name) (n text) (k akey)) + (defstrand init 3)) + +(defskeleton prune + (vars (n text) (a b name)) + (defstrand init 3 (n n) (a a) (b b)) + (defstrand trans 3 (n n) (a a) (k (pubk b))) + (defstrand trans 3 (n n) (a a) (k (privk b))) + (precedes ((0 0) (1 0)) ((0 0) (2 0)) ((1 2) (0 1)) ((2 2) (0 2))) +) diff --git a/tst/pruning1.tst b/tst/pruning1.tst --- a/tst/pruning1.tst +++ b/tst/pruning1.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol prune basic diff --git a/tst/sigenc.tst b/tst/sigenc.tst --- a/tst/sigenc.tst +++ b/tst/sigenc.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol mult-keys-sig-enc basic diff --git a/tst/sorted_epmo_acctnum.lsp b/tst/sorted_epmo_acctnum.lsp new file mode 100644 --- /dev/null +++ b/tst/sorted_epmo_acctnum.lsp @@ -0,0 +1,84 @@ +(defprotocol sorted_epmo_acctnum basic + (defrole bank + (vars (b c m name) (acctnum price text) (hash name) (nc nm nb data)) + (trace + (recv (enc c nc nm acctnum price (pubk b))) + (send (cat (enc (enc "hash" c nc nb nm price (pubk hash)) (privk b)) + (enc nc nb (pubk c)))) + (recv (enc (enc "hash" b m nb nm (pubk hash)) (privk m)))) + (non-orig (privk hash)) + (annotations b + (1 + (forall ((pm name)) + (implies + (and (authtransfer c acctnum b price pm nm) + (reqtransfer pm b price pm nm)) + (dotransfer acctnum b price pm nm)))) + (2 + (and (says c (authtransfer c acctnum b price m nm)) + (says m (reqtransfer m b price m nm)))))) + (defrole customer + (vars (b c m hash name) (acctnum goods price text) (nc nm nb data)) + (trace + (send (enc c nc goods (pubk m))) + (recv (enc nc nm m price (pubk c))) + (send (enc c nc nm acctnum price (pubk b))) + (recv (cat (enc (enc "hash" c nc nb nm price (pubk hash)) (privk b)) + (enc nc nb (pubk c)))) + (send (cat (enc (enc "hash" c nc nb nm price (pubk hash)) (privk b)) + nb))) + (non-orig (privk b) (privk hash)) + (uniq-orig nc) + (annotations c + (1 + (says m + (implies + (exists ((acctnum2 text)) + (dotransfer acctnum2 b price m nm)) (doship m goods c)))) + (3 + (says b + (forall ((pm name)) + (implies + (and (authtransfer c acctnum b price m nm) + (reqtransfer pm b price pm nm)) + (dotransfer acctnum b price pm nm))))) + (4 (authtransfer c acctnum b price m nm)))) + (defrole merchant (vars (b c m hash name) (goods price text) (nc nm nb data)) + (trace + (recv (enc c nc goods (pubk m))) + (send (enc nc nm m price (pubk c))) + (recv (cat (enc (enc "hash" c nc nb nm price (pubk hash)) (privk b)) + nb)) + (send (enc (enc "hash" b m nb nm (pubk hash)) (privk m)))) + (non-orig (privk hash)) + (uniq-orig nm) + (annotations m + (1 + (implies + (exists ((acctnum2 text)) (dotransfer acctnum2 b price m nm)) + (doship m goods c))) + (2 + (and + (says b + (forall ((pm name)) + (exists ((acctnum2 text)) + (implies + (and (authtransfer c acctnum2 b price m nm) + (reqtransfer pm b price pm nm)) + (dotransfer acctnum2 b price pm nm))))) + (says c + (exists ((acctnum2 text)) + (authtransfer c acctnum2 b price m nm))))) + (3 (and (reqtransfer m b price m nm) (doship m goods c)))))) + +(defskeleton sorted_epmo_acctnum + (vars (b m c name) (nm nc nb data) (hash name)) + (defstrand merchant 4 (b b) (m m) (c c) (nm nm) (nc nc) (nb nb) (hash hash)) + (non-orig (privk b) (privk m) (privk c) (privk hash)) + (uniq-orig nm nc nb)) + +(defskeleton sorted_epmo_acctnum + (vars (b m c name) (nm nb nc data) (hash name) (price acctnum text)) + (defstrand bank 3 (b b) (m m) (c c) (nm nm) (nb nb) (nc nc) (hash hash)) + (non-orig (privk b) (privk m) (privk c) (privk hash)) + (uniq-orig nm nc nb)) diff --git a/tst/sorted_epmo_acctnum.scm b/tst/sorted_epmo_acctnum.scm deleted file mode 100644 --- a/tst/sorted_epmo_acctnum.scm +++ /dev/null @@ -1,84 +0,0 @@ -(defprotocol epmo_acctnum basic - (defrole bank - (vars (b c m name) (acctnum price text) (hash name) (nc nm nb data)) - (trace - (recv (enc c nc nm acctnum price (pubk b))) - (send (cat (enc (enc "hash" c nc nb nm price (pubk hash)) (privk b)) - (enc nc nb (pubk c)))) - (recv (enc (enc "hash" b m nb nm (pubk hash)) (privk m)))) - (non-orig (privk hash)) - (annotations b - (1 - (forall ((pm name)) - (implies - (and (authtransfer c acctnum b price pm nm) - (reqtransfer pm b price pm nm)) - (dotransfer acctnum b price pm nm)))) - (2 - (and (says c (authtransfer c acctnum b price m nm)) - (says m (reqtransfer m b price m nm)))))) - (defrole customer - (vars (b c m hash name) (acctnum goods price text) (nc nm nb data)) - (trace - (send (enc c nc goods (pubk m))) - (recv (enc nc nm m price (pubk c))) - (send (enc c nc nm acctnum price (pubk b))) - (recv (cat (enc (enc "hash" c nc nb nm price (pubk hash)) (privk b)) - (enc nc nb (pubk c)))) - (send (cat (enc (enc "hash" c nc nb nm price (pubk hash)) (privk b)) - nb))) - (non-orig (privk b) (privk hash)) - (uniq-orig nc) - (annotations c - (1 - (says m - (implies - (exists ((acctnum2 text)) - (dotransfer acctnum2 b price m nm)) (doship m goods c)))) - (3 - (says b - (forall ((pm name)) - (implies - (and (authtransfer c acctnum b price m nm) - (reqtransfer pm b price pm nm)) - (dotransfer acctnum b price pm nm))))) - (4 (authtransfer c acctnum b price m nm)))) - (defrole merchant (vars (b c m hash name) (goods price text) (nc nm nb data)) - (trace - (recv (enc c nc goods (pubk m))) - (send (enc nc nm m price (pubk c))) - (recv (cat (enc (enc "hash" c nc nb nm price (pubk hash)) (privk b)) - nb)) - (send (enc (enc "hash" b m nb nm (pubk hash)) (privk m)))) - (non-orig (privk hash)) - (uniq-orig nm) - (annotations m - (1 - (implies - (exists ((acctnum2 text)) (dotransfer acctnum2 b price m nm)) - (doship m goods c))) - (2 - (and - (says b - (forall ((pm name)) - (exists ((acctnum2 text)) - (implies - (and (authtransfer c acctnum2 b price m nm) - (reqtransfer pm b price pm nm)) - (dotransfer acctnum2 b price pm nm))))) - (says c - (exists ((acctnum2 text)) - (authtransfer c acctnum2 b price m nm))))) - (3 (and (reqtransfer m b price m nm) (doship m goods c)))))) - -(defskeleton epmo_acctnum - (vars (b m c name) (nm nc nb data) (hash name)) - (defstrand merchant 4 (b b) (m m) (c c) (nm nm) (nc nc) (nb nb) (hash hash)) - (non-orig (privk b) (privk m) (privk c) (privk hash)) - (uniq-orig nm nc nb)) - -(defskeleton epmo_acctnum - (vars (b m c name) (nm nb nc data) (hash name) (price acctnum text)) - (defstrand bank 3 (b b) (m m) (c c) (nm nm) (nb nb) (nc nc) (hash hash)) - (non-orig (privk b) (privk m) (privk c) (privk hash)) - (uniq-orig nm nc nb)) diff --git a/tst/sorted_epmo_acctnum.tst b/tst/sorted_epmo_acctnum.tst --- a/tst/sorted_epmo_acctnum.tst +++ b/tst/sorted_epmo_acctnum.tst @@ -1,7 +1,7 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") -(defprotocol epmo_acctnum basic +(defprotocol sorted_epmo_acctnum basic (defrole bank (vars (b c m name) (acctnum price text) (hash name) (nc nm nb data)) (trace (recv (enc c nc nm acctnum price (pubk b))) @@ -76,7 +76,7 @@ (authtransfer c acctnum2 b price m nm))))) (3 (and (reqtransfer m b price m nm) (doship m goods c)))))) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (goods price text) (nm nc nb data) (b m c hash name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) (nb nb) (b b) (c c) (m m) (hash hash)) @@ -93,7 +93,7 @@ (unrealized (0 2)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (goods price acctnum text) (nm nc nb data) (b m c hash name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) (nb nb) (b b) (c c) (m m) (hash hash)) @@ -120,7 +120,7 @@ (unrealized (0 2) (1 0)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (goods price acctnum acctnum-0 goods-0 text) (nm nc nb data) (b m c hash b-0 name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -153,7 +153,7 @@ (unrealized (0 0) (0 2) (1 0)) (comment "2 in cohort - 2 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (goods price acctnum goods-0 text) (nm nc nb data) (m c hash b name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -187,7 +187,7 @@ (unrealized (0 0) (0 2)) (comment "2 in cohort - 2 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (goods price acctnum acctnum-0 goods-0 text) (nm nc nb nb-0 data) (b m c hash b-0 hash-0 name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -230,7 +230,7 @@ (unrealized (0 0) (0 2) (1 0) (3 0)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (price acctnum goods text) (nm nc nb data) (m c hash b name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) (nb nb) (b b) (c c) (m m) (hash hash)) @@ -262,7 +262,7 @@ (unrealized (0 2)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (goods price acctnum goods-0 price-0 text) (nm nc nb nm-0 data) (m c hash b name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -300,7 +300,7 @@ (unrealized (0 0) (0 2)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (goods price acctnum acctnum-0 goods-0 text) (nm nc nb nb-0 data) (b m c hash b-0 hash-0 name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -342,7 +342,7 @@ (unrealized (0 0) (0 2) (1 0)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (price acctnum goods text) (nm nc nb data) (c hash b m name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) (nb nb) (b b) (c c) (m m) (hash hash)) @@ -381,7 +381,7 @@ (unrealized) (shape)) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (price acctnum goods price-0 text) (nm nc nb nm-0 data) (m c hash b name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -419,7 +419,7 @@ (unrealized (0 2)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (goods price acctnum goods-0 text) (nm nc nb nb-0 data) (m c hash b hash-0 name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -461,7 +461,7 @@ (unrealized (0 0) (0 2)) (comment "2 in cohort - 2 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (price price-0 acctnum goods text) (nm nc nb nm-0 data) (c hash b m name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -506,7 +506,7 @@ (unrealized) (comment "1 in cohort - 0 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (price acctnum goods text) (nm nc nb nb-0 data) (m c hash b hash-0 name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -547,7 +547,7 @@ (unrealized (0 2)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (goods price acctnum goods-0 price-0 text) (nm nc nb nb-0 nm-0 data) (m c hash b hash-0 name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -592,7 +592,7 @@ (unrealized (0 0) (0 2)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (price acctnum goods text) (nm nc nb nb-0 data) (c hash hash-0 b m name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -640,7 +640,7 @@ (unrealized) (comment "1 in cohort - 0 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (price acctnum goods price-0 text) (nm nc nb nb-0 nm-0 data) (m c hash b hash-0 name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -685,7 +685,7 @@ (unrealized (0 2)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (price price-0 acctnum goods text) (nm nc nb nb-0 nm-0 data) (c hash hash-0 b m name)) (defstrand merchant 4 (goods goods) (price price) (nc nc) (nm nm) @@ -739,7 +739,7 @@ (comment "Nothing left to do") -(defprotocol epmo_acctnum basic +(defprotocol sorted_epmo_acctnum basic (defrole bank (vars (b c m name) (acctnum price text) (hash name) (nc nm nb data)) (trace (recv (enc c nc nm acctnum price (pubk b))) @@ -814,7 +814,7 @@ (authtransfer c acctnum2 b price m nm))))) (3 (and (reqtransfer m b price m nm) (doship m goods c)))))) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price text) (nm nb nc data) (b m c hash name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) (nb nb) (b b) (c c) (m m) (hash hash)) @@ -830,7 +830,7 @@ (unrealized (0 2)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price goods price-0 text) (nm nb nc nc-0 data) (b m c hash c-0 name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -860,7 +860,7 @@ (unrealized (1 2)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price goods text) (nm nb nc data) (b m c hash name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) (nb nb) (b b) (c c) (m m) (hash hash)) @@ -888,7 +888,7 @@ (unrealized (0 0) (1 2)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price goods acctnum-0 goods-0 text) (nm nb nc data) (b m c hash b-0 m-0 name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -930,7 +930,7 @@ (unrealized (0 0) (2 1) (2 3)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price goods acctnum-0 goods-0 text) (nm nb nc data) (b m c hash b-0 name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -972,7 +972,7 @@ (unrealized (0 0) (1 0) (2 3)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price goods acctnum-0 goods-0 text) (nm nb nc data) (b m c hash name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -1013,7 +1013,7 @@ (unrealized (0 0) (1 0)) (comment "2 in cohort - 2 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price acctnum-0 goods text) (nm nb nc data) (b m c hash name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -1054,7 +1054,7 @@ (unrealized (0 0)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price goods acctnum-0 goods-0 price-0 text) (nm nb nc nm-0 data) (b m c hash name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -1099,7 +1099,7 @@ (unrealized (0 0) (1 0)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price acctnum-0 goods text) (nm nb nc data) (b m c hash name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -1140,7 +1140,7 @@ (unrealized (0 0)) (comment "2 in cohort - 2 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price acctnum-0 goods price-0 text) (nm nb nc nm-0 data) (b m c hash name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -1185,7 +1185,7 @@ (unrealized (0 0)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (price acctnum goods text) (nm nb nc data) (b m c hash name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) (nb nb) (b b) (c c) (m m) (hash hash)) @@ -1225,7 +1225,7 @@ (unrealized) (shape)) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price acctnum-0 goods text) (nm nb nc nb-0 data) (b m c hash hash-0 name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -1273,7 +1273,7 @@ (unrealized (0 0) (3 0)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price acctnum-0 goods price-0 text) (nm nb nc nm-0 data) (b m c hash name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -1318,7 +1318,7 @@ (unrealized (0 0)) (comment "2 in cohort - 2 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price acctnum-0 goods text) (nm nb nc nb-0 data) (b m c hash hash-0 name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -1366,7 +1366,7 @@ (unrealized (0 0)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (price acctnum goods price-0 text) (nm nb nc nm-0 data) (b m c hash name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -1412,7 +1412,7 @@ (unrealized) (comment "1 in cohort - 0 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price acctnum-0 goods price-0 text) (nm nb nc nm-0 nb-0 data) (b m c hash hash-0 name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -1465,7 +1465,7 @@ (unrealized (0 0) (4 0)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (price acctnum goods text) (nm nb nc nb-0 data) (b m c hash hash-0 name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -1515,7 +1515,7 @@ (unrealized) (comment "1 in cohort - 0 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (acctnum price acctnum-0 goods price-0 text) (nm nb nc nm-0 nb-0 data) (b m c hash hash-0 name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) @@ -1567,7 +1567,7 @@ (unrealized (0 0)) (comment "1 in cohort - 1 not yet seen")) -(defskeleton epmo_acctnum +(defskeleton sorted_epmo_acctnum (vars (price acctnum goods price-0 text) (nm nb nc nm-0 nb-0 data) (b m c hash hash-0 name)) (defstrand bank 3 (acctnum acctnum) (price price) (nc nc) (nm nm) diff --git a/tst/targetterms2.tst b/tst/targetterms2.tst --- a/tst/targetterms2.tst +++ b/tst/targetterms2.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol tt2 basic @@ -188,8 +188,34 @@ ((recv (enc n (pubk a))) (recv m) (send (enc n m (pubk a))))) (label 8) (parent 7) - (seen 6) (unrealized (2 1)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton tt2 + (vars (n text) (a name)) + (defstrand init 2 (n n) (a a)) + (defstrand trans 3 (m (enc n (pubk a))) (n n) (a a)) + (defstrand trans 3 (m (enc n (enc n (pubk a)) (pubk a))) (n n) (a a)) + (defstrand trans 3 (m (enc n (pubk a))) (n n) (a a)) + (precedes ((0 0) (1 0)) ((0 0) (2 0)) ((0 0) (3 0)) ((1 2) (0 1)) + ((2 2) (0 1)) ((3 2) (2 1))) + (non-orig (privk a)) + (uniq-orig n) + (operation nonce-test (contracted (m (enc n (pubk a)))) n (2 1) + (enc n (pubk a)) (enc n (enc n (pubk a)) (pubk a))) + (traces + ((send (enc n (pubk a))) + (recv (enc n (enc n (enc n (pubk a)) (pubk a)) (pubk a)))) + ((recv (enc n (pubk a))) (recv (enc n (pubk a))) + (send (enc n (enc n (pubk a)) (pubk a)))) + ((recv (enc n (pubk a))) (recv (enc n (enc n (pubk a)) (pubk a))) + (send (enc n (enc n (enc n (pubk a)) (pubk a)) (pubk a)))) + ((recv (enc n (pubk a))) (recv (enc n (pubk a))) + (send (enc n (enc n (pubk a)) (pubk a))))) + (label 9) + (parent 8) + (seen 6) + (unrealized) (comment "1 in cohort - 0 not yet seen")) (comment "Nothing left to do") diff --git a/tst/targetterms6.tst b/tst/targetterms6.tst --- a/tst/targetterms6.tst +++ b/tst/targetterms6.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol tt6 basic @@ -146,9 +146,11 @@ (defskeleton tt6 (vars (n text) (a name)) (defstrand init 2 (n n) (a a)) + (defstrand trans 3 (m (enc n (pubk a))) (n n) (a a)) (defstrand trans 3 (m (enc n (enc n (pubk a)) (pubk a))) (n n) (a a)) (defstrand trans 3 (m (enc n (pubk a))) (n n) (a a)) - (precedes ((0 0) (1 0)) ((0 0) (2 0)) ((1 2) (0 1)) ((2 2) (1 1))) + (precedes ((0 0) (1 0)) ((0 0) (2 0)) ((0 0) (3 0)) ((1 2) (0 1)) + ((2 2) (0 1)) ((3 2) (2 1))) (non-orig (privk a)) (uniq-orig n) (operation nonce-test (contracted (m (enc n (pubk a)))) n (2 1) @@ -158,6 +160,8 @@ (recv (cat (enc n (enc n (enc n (pubk a)) (pubk a)) (pubk a)) (enc n (enc n (pubk a)) (pubk a))))) + ((recv (enc n (pubk a))) (recv (enc n (pubk a))) + (send (enc n (enc n (pubk a)) (pubk a)))) ((recv (enc n (pubk a))) (recv (enc n (enc n (pubk a)) (pubk a))) (send (enc n (enc n (enc n (pubk a)) (pubk a)) (pubk a)))) ((recv (enc n (pubk a))) (recv (enc n (pubk a))) @@ -165,6 +169,29 @@ (label 6) (parent 5) (unrealized) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton tt6 + (vars (n text) (a name)) + (defstrand init 2 (n n) (a a)) + (defstrand trans 3 (m (enc n (enc n (pubk a)) (pubk a))) (n n) (a a)) + (defstrand trans 3 (m (enc n (pubk a))) (n n) (a a)) + (precedes ((0 0) (1 0)) ((0 0) (2 0)) ((1 2) (0 1)) ((2 2) (1 1))) + (non-orig (privk a)) + (uniq-orig n) + (operation generalization deleted (1 0)) + (traces + ((send (enc n (pubk a))) + (recv + (cat (enc n (enc n (enc n (pubk a)) (pubk a)) (pubk a)) + (enc n (enc n (pubk a)) (pubk a))))) + ((recv (enc n (pubk a))) (recv (enc n (enc n (pubk a)) (pubk a))) + (send (enc n (enc n (enc n (pubk a)) (pubk a)) (pubk a)))) + ((recv (enc n (pubk a))) (recv (enc n (pubk a))) + (send (enc n (enc n (pubk a)) (pubk a))))) + (label 7) + (parent 6) + (unrealized) (shape)) (comment "Nothing left to do") @@ -199,7 +226,7 @@ (send (enc n (enc n (pubk a)) (pubk a)))) ((recv (enc n (pubk a))) (recv (enc n (enc n (pubk a)) (pubk a))) (send (enc n (enc n (enc n (pubk a)) (pubk a)) (pubk a))))) - (label 7) + (label 8) (unrealized) (shape)) diff --git a/tst/uncarried_keys.tst b/tst/uncarried_keys.tst --- a/tst/uncarried_keys.tst +++ b/tst/uncarried_keys.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol uncarried-keys basic diff --git a/tst/uo.tst b/tst/uo.tst --- a/tst/uo.tst +++ b/tst/uo.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol uniq-orig basic diff --git a/tst/weird.tst b/tst/weird.tst --- a/tst/weird.tst +++ b/tst/weird.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol wierd basic diff --git a/tst/wmf.tst b/tst/wmf.tst --- a/tst/wmf.tst +++ b/tst/wmf.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol wide-mouth-frog basic diff --git a/tst/wonthull.scm b/tst/wonthull.scm new file mode 100644 --- /dev/null +++ b/tst/wonthull.scm @@ -0,0 +1,37 @@ +;;; Wonthull: Demonstrates a subtle incompleteness. +;;; +;;; The second POV skeleton given is a shape not produced +;;; or covered in the first search. The problem is that an +;;; augmentation is attempted only with the most general +;;; version of the responder strand that uses x3 as y1, not +;;; the more specific version in which this does not lead to +;;; x3 being originated in more than one place.) + +(defprotocol wonthull basic + (defrole init (vars (a name) (x1 x2 x3 x4 text)) + (trace + (send (cat (enc x1 x2 (pubk a)) (enc x3 x2 (pubk a)))) + (recv (enc "okay" x3 x4 (pubk a))) + ) + (uniq-orig x1 x2 x3) + (non-orig (privk a)) + ) + (defrole resp (vars (a name) (y1 y2 y3 text)) + (trace + (recv (enc y1 y2 (pubk a)) ) + (send (enc "okay" y3 y1 (pubk a)) ) + ) + ) +) + +(defskeleton wonthull + (vars (a name) (n text) (x1 x2 x3 x4 text)) + (defstrand init 2 (a a) (x1 x1) (x2 x2) (x3 x3) (x4 x4)) +) + +(defskeleton wonthull + (vars (a name) (n text) (x1 x2 x3 x4 text)) + (defstrand init 2 (a a) (x1 x1) (x2 x3) (x3 x3) (x4 x1)) + (defstrand resp 2 (a a) (y1 x1) (y2 x3) (y3 x3)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) +) diff --git a/tst/wonthull.tst b/tst/wonthull.tst new file mode 100644 --- /dev/null +++ b/tst/wonthull.tst @@ -0,0 +1,147 @@ +(comment "CPSA 2.1.1") +(comment "All input read") + +(defprotocol wonthull basic + (defrole init + (vars (a name) (x1 x2 x3 x4 text)) + (trace (send (cat (enc x1 x2 (pubk a)) (enc x3 x2 (pubk a)))) + (recv (enc "okay" x3 x4 (pubk a)))) + (non-orig (privk a)) + (uniq-orig x1 x2 x3)) + (defrole resp + (vars (a name) (y1 y2 y3 text)) + (trace (recv (enc y1 y2 (pubk a))) + (send (enc "okay" y3 y1 (pubk a)))))) + +(defskeleton wonthull + (vars (x1 x2 x3 x4 text) (a name)) + (defstrand init 2 (x1 x1) (x2 x2) (x3 x3) (x4 x4) (a a)) + (non-orig (privk a)) + (uniq-orig x1 x2 x3) + (traces + ((send (cat (enc x1 x2 (pubk a)) (enc x3 x2 (pubk a)))) + (recv (enc "okay" x3 x4 (pubk a))))) + (label 0) + (unrealized (0 1)) + (comment "2 in cohort - 2 not yet seen")) + +(defskeleton wonthull + (vars (x1 x2 x4 text) (a name)) + (defstrand init 2 (x1 x1) (x2 x2) (x3 x2) (x4 x4) (a a)) + (non-orig (privk a)) + (uniq-orig x1 x2) + (operation nonce-test (added-strand init 1) x2 (0 1) + (enc x2 x2 (pubk a))) + (traces + ((send (cat (enc x1 x2 (pubk a)) (enc x2 x2 (pubk a)))) + (recv (enc "okay" x2 x4 (pubk a))))) + (label 1) + (parent 0) + (unrealized (0 1)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton wonthull + (vars (x1 x2 x3 x4 y3 text) (a name)) + (defstrand init 2 (x1 x1) (x2 x2) (x3 x3) (x4 x4) (a a)) + (defstrand resp 2 (y1 x3) (y2 x2) (y3 y3) (a a)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (privk a)) + (uniq-orig x1 x2 x3) + (operation nonce-test (added-strand resp 2) x3 (0 1) + (enc x3 x2 (pubk a))) + (traces + ((send (cat (enc x1 x2 (pubk a)) (enc x3 x2 (pubk a)))) + (recv (enc "okay" x3 x4 (pubk a)))) + ((recv (enc x3 x2 (pubk a))) (send (enc "okay" y3 x3 (pubk a))))) + (label 2) + (parent 0) + (seen 3) + (unrealized (0 1)) + (comment "2 in cohort - 1 not yet seen")) + +(defskeleton wonthull + (vars (x1 x2 x4 y3 text) (a name)) + (defstrand init 2 (x1 x1) (x2 x2) (x3 x2) (x4 x4) (a a)) + (defstrand resp 2 (y1 x2) (y2 x2) (y3 y3) (a a)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (privk a)) + (uniq-orig x1 x2) + (operation nonce-test (added-strand resp 2) x2 (0 1) + (enc x1 x2 (pubk a)) (enc x2 x2 (pubk a))) + (traces + ((send (cat (enc x1 x2 (pubk a)) (enc x2 x2 (pubk a)))) + (recv (enc "okay" x2 x4 (pubk a)))) + ((recv (enc x2 x2 (pubk a))) (send (enc "okay" y3 x2 (pubk a))))) + (label 3) + (parent 1) + (unrealized (0 1)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton wonthull + (vars (x1 x2 y3 text) (a name)) + (defstrand init 2 (x1 x1) (x2 x2) (x3 y3) (x4 y3) (a a)) + (defstrand resp 2 (y1 y3) (y2 x2) (y3 y3) (a a)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (privk a)) + (uniq-orig x1 x2 y3) + (operation nonce-test (contracted (x3 y3) (x4 y3)) y3 (0 1) + (enc "okay" y3 y3 (pubk a)) (enc y3 x2 (pubk a))) + (traces + ((send (cat (enc x1 x2 (pubk a)) (enc y3 x2 (pubk a)))) + (recv (enc "okay" y3 y3 (pubk a)))) + ((recv (enc y3 x2 (pubk a))) (send (enc "okay" y3 y3 (pubk a))))) + (label 4) + (parent 2) + (unrealized) + (shape)) + +(defskeleton wonthull + (vars (x1 y3 text) (a name)) + (defstrand init 2 (x1 x1) (x2 y3) (x3 y3) (x4 y3) (a a)) + (defstrand resp 2 (y1 y3) (y2 y3) (y3 y3) (a a)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (privk a)) + (uniq-orig x1 y3) + (operation nonce-test (contracted (x2 y3) (x4 y3)) y3 (0 1) + (enc "okay" y3 y3 (pubk a)) (enc x1 y3 (pubk a)) + (enc y3 y3 (pubk a))) + (traces + ((send (cat (enc x1 y3 (pubk a)) (enc y3 y3 (pubk a)))) + (recv (enc "okay" y3 y3 (pubk a)))) + ((recv (enc y3 y3 (pubk a))) (send (enc "okay" y3 y3 (pubk a))))) + (label 5) + (parent 3) + (seen 4) + (unrealized) + (comment "1 in cohort - 0 not yet seen")) + +(comment "Nothing left to do") + +(defprotocol wonthull basic + (defrole init + (vars (a name) (x1 x2 x3 x4 text)) + (trace (send (cat (enc x1 x2 (pubk a)) (enc x3 x2 (pubk a)))) + (recv (enc "okay" x3 x4 (pubk a)))) + (non-orig (privk a)) + (uniq-orig x1 x2 x3)) + (defrole resp + (vars (a name) (y1 y2 y3 text)) + (trace (recv (enc y1 y2 (pubk a))) + (send (enc "okay" y3 y1 (pubk a)))))) + +(defskeleton wonthull + (vars (x1 x3 text) (a name)) + (defstrand init 2 (x1 x1) (x2 x3) (x3 x3) (x4 x1) (a a)) + (defstrand resp 2 (y1 x1) (y2 x3) (y3 x3) (a a)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (privk a)) + (uniq-orig x1 x3) + (traces + ((send (cat (enc x1 x3 (pubk a)) (enc x3 x3 (pubk a)))) + (recv (enc "okay" x3 x1 (pubk a)))) + ((recv (enc x1 x3 (pubk a))) (send (enc "okay" x3 x1 (pubk a))))) + (label 6) + (unrealized) + (shape)) + +(comment "Nothing left to do") diff --git a/tst/woolam.tst b/tst/woolam.tst --- a/tst/woolam.tst +++ b/tst/woolam.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol woolam basic diff --git a/tst/yahalom-6.3.6.scm b/tst/yahalom-6.3.6.scm new file mode 100644 --- /dev/null +++ b/tst/yahalom-6.3.6.scm @@ -0,0 +1,48 @@ +;;; 6.3.6 Yahalom + +(defprotocol yahalom-6:3:6 basic + (defrole init + (vars (a b s name) (n-a n-b text) (k skey) (blob mesg)) + (trace + (send (cat a n-a)) + (recv (cat (enc b k n-a n-b (ltk a s)) blob)) + (send (cat blob (enc n-b k))))) + (defrole resp + (vars (a b s name) (n-a n-b text) (k skey)) + (trace + (recv (cat a n-a)) + (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k))))) + (defrole serv + (vars (a b s name) (n-a n-b text) (k skey)) + (trace + (recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k n-a n-b (ltk a s)) (enc a k (ltk b s))))) + (uniq-orig k)) + (comment "Yahalom protocol, Section 6.3.6, Page 49") + (url "http://www.eecs.umich.edu/acal/swerve/docs/49-1.pdf")) + +(defskeleton yahalom-6:3:6 + (vars (a b s name) (n-a n-b text)) + (defstrand init 3 (a a) (b b) (s s) (n-a n-a) (n-b n-b)) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b)) + +(defskeleton yahalom-6:3:6 + (vars (a b s name) (n-a n-b text) (k skey)) + (defstrand resp 3 (a a) (b b) (s s) (n-a n-a) (n-b n-b) (k k)) + (deflistener k) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b)) + +(defskeleton yahalom-6:3:6 + (vars (a b s name) (n-a n-b text)) + (defstrand resp 3 (a a) (b b) (s s) (n-a n-a) (n-b n-b)) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b)) + +(defskeleton yahalom-6:3:6 + (vars (a b s name) (n-a n-b text)) + (defstrand serv 2 (a a) (b b) (s s) (n-a n-a) (n-b n-b)) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b)) diff --git a/tst/yahalom-6.3.6.tst b/tst/yahalom-6.3.6.tst new file mode 100644 --- /dev/null +++ b/tst/yahalom-6.3.6.tst @@ -0,0 +1,452 @@ +(comment "CPSA 2.1.1") +(comment "All input read") + +(defprotocol yahalom-6:3:6 basic + (defrole init + (vars (a b s name) (n-a n-b text) (k skey) (blob mesg)) + (trace (send (cat a n-a)) + (recv (cat (enc b k n-a n-b (ltk a s)) blob)) + (send (cat blob (enc n-b k))))) + (defrole resp + (vars (a b s name) (n-a n-b text) (k skey)) + (trace (recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k))))) + (defrole serv + (vars (a b s name) (n-a n-b text) (k skey)) + (trace (recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k n-a n-b (ltk a s)) (enc a k (ltk b s))))) + (uniq-orig k)) + (comment "Yahalom protocol, Section 6.3.6, Page 49") + (url "http://www.eecs.umich.edu/acal/swerve/docs/49-1.pdf")) + +(defskeleton yahalom-6:3:6 + (vars (blob mesg) (n-a n-b text) (a b s name) (k skey)) + (defstrand init 3 (blob blob) (n-a n-a) (n-b n-b) (a a) (b b) (s s) + (k k)) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b) + (traces + ((send (cat a n-a)) (recv (cat (enc b k n-a n-b (ltk a s)) blob)) + (send (cat blob (enc n-b k))))) + (label 0) + (unrealized (0 1)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton yahalom-6:3:6 + (vars (blob mesg) (n-a n-b text) (a b s name) (k skey)) + (defstrand init 3 (blob blob) (n-a n-a) (n-b n-b) (a a) (b b) (s s) + (k k)) + (defstrand serv 2 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (precedes ((0 0) (1 0)) ((1 1) (0 1))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k) + (operation encryption-test (added-strand serv 2) + (enc b k n-a n-b (ltk a s)) (0 1)) + (traces + ((send (cat a n-a)) (recv (cat (enc b k n-a n-b (ltk a s)) blob)) + (send (cat blob (enc n-b k)))) + ((recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k n-a n-b (ltk a s)) (enc a k (ltk b s)))))) + (label 1) + (parent 0) + (unrealized (1 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton yahalom-6:3:6 + (vars (blob mesg) (n-a n-b text) (a b s name) (k skey)) + (defstrand init 3 (blob blob) (n-a n-a) (n-b n-b) (a a) (b b) (s s) + (k k)) + (defstrand serv 2 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (defstrand resp 2 (n-a n-a) (n-b n-b) (a a) (b b) (s s)) + (precedes ((0 0) (2 0)) ((1 1) (0 1)) ((2 1) (1 0))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k) + (operation encryption-test (added-strand resp 2) + (enc a n-a n-b (ltk b s)) (1 0)) + (traces + ((send (cat a n-a)) (recv (cat (enc b k n-a n-b (ltk a s)) blob)) + (send (cat blob (enc n-b k)))) + ((recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k n-a n-b (ltk a s)) (enc a k (ltk b s))))) + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))))) + (label 2) + (parent 1) + (unrealized) + (shape)) + +(comment "Nothing left to do") + +(defprotocol yahalom-6:3:6 basic + (defrole init + (vars (a b s name) (n-a n-b text) (k skey) (blob mesg)) + (trace (send (cat a n-a)) + (recv (cat (enc b k n-a n-b (ltk a s)) blob)) + (send (cat blob (enc n-b k))))) + (defrole resp + (vars (a b s name) (n-a n-b text) (k skey)) + (trace (recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k))))) + (defrole serv + (vars (a b s name) (n-a n-b text) (k skey)) + (trace (recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k n-a n-b (ltk a s)) (enc a k (ltk b s))))) + (uniq-orig k)) + (comment "Yahalom protocol, Section 6.3.6, Page 49") + (url "http://www.eecs.umich.edu/acal/swerve/docs/49-1.pdf")) + +(defskeleton yahalom-6:3:6 + (vars (n-a n-b text) (a b s name) (k skey)) + (defstrand resp 3 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (deflistener k) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b) + (traces + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k)))) ((recv k) (send k))) + (label 3) + (unrealized (0 2)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton yahalom-6:3:6 + (vars (n-a n-b n-a-0 n-b-0 text) (a b s name) (k skey)) + (defstrand resp 3 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (deflistener k) + (defstrand serv 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s) (k k)) + (precedes ((2 1) (0 2)) ((2 1) (1 0))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k) + (operation encryption-test (added-strand serv 2) (enc a k (ltk b s)) + (0 2)) + (traces + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k)))) ((recv k) (send k)) + ((recv (cat b (enc a n-a-0 n-b-0 (ltk b s)))) + (send (cat (enc b k n-a-0 n-b-0 (ltk a s)) (enc a k (ltk b s)))))) + (label 4) + (parent 3) + (unrealized (0 2) (1 0) (2 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton yahalom-6:3:6 + (vars (n-a n-b n-a-0 n-b-0 text) (a b s name) (k skey)) + (defstrand resp 3 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (deflistener k) + (defstrand serv 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s) (k k)) + (defstrand resp 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s)) + (precedes ((2 1) (0 2)) ((2 1) (1 0)) ((3 1) (2 0))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k) + (operation encryption-test (added-strand resp 2) + (enc a n-a-0 n-b-0 (ltk b s)) (2 0)) + (traces + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k)))) ((recv k) (send k)) + ((recv (cat b (enc a n-a-0 n-b-0 (ltk b s)))) + (send (cat (enc b k n-a-0 n-b-0 (ltk a s)) (enc a k (ltk b s))))) + ((recv (cat a n-a-0)) (send (cat b (enc a n-a-0 n-b-0 (ltk b s)))))) + (label 5) + (parent 4) + (unrealized (0 2) (1 0)) + (comment "empty cohort")) + +(comment "Nothing left to do") + +(defprotocol yahalom-6:3:6 basic + (defrole init + (vars (a b s name) (n-a n-b text) (k skey) (blob mesg)) + (trace (send (cat a n-a)) + (recv (cat (enc b k n-a n-b (ltk a s)) blob)) + (send (cat blob (enc n-b k))))) + (defrole resp + (vars (a b s name) (n-a n-b text) (k skey)) + (trace (recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k))))) + (defrole serv + (vars (a b s name) (n-a n-b text) (k skey)) + (trace (recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k n-a n-b (ltk a s)) (enc a k (ltk b s))))) + (uniq-orig k)) + (comment "Yahalom protocol, Section 6.3.6, Page 49") + (url "http://www.eecs.umich.edu/acal/swerve/docs/49-1.pdf")) + +(defskeleton yahalom-6:3:6 + (vars (n-a n-b text) (a b s name) (k skey)) + (defstrand resp 3 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b) + (traces + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k))))) + (label 6) + (unrealized (0 2)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton yahalom-6:3:6 + (vars (n-a n-b n-a-0 n-b-0 text) (a b s name) (k skey)) + (defstrand resp 3 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (defstrand serv 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s) (k k)) + (precedes ((1 1) (0 2))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k) + (operation encryption-test (added-strand serv 2) (enc a k (ltk b s)) + (0 2)) + (traces + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k)))) + ((recv (cat b (enc a n-a-0 n-b-0 (ltk b s)))) + (send (cat (enc b k n-a-0 n-b-0 (ltk a s)) (enc a k (ltk b s)))))) + (label 7) + (parent 6) + (unrealized (0 2) (1 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton yahalom-6:3:6 + (vars (n-a n-b n-a-0 n-b-0 text) (a b s name) (k skey)) + (defstrand resp 3 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (defstrand serv 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s) (k k)) + (defstrand resp 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s)) + (precedes ((1 1) (0 2)) ((2 1) (1 0))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k) + (operation encryption-test (added-strand resp 2) + (enc a n-a-0 n-b-0 (ltk b s)) (1 0)) + (traces + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k)))) + ((recv (cat b (enc a n-a-0 n-b-0 (ltk b s)))) + (send (cat (enc b k n-a-0 n-b-0 (ltk a s)) (enc a k (ltk b s))))) + ((recv (cat a n-a-0)) (send (cat b (enc a n-a-0 n-b-0 (ltk b s)))))) + (label 8) + (parent 7) + (unrealized (0 2)) + (comment "2 in cohort - 2 not yet seen")) + +(defskeleton yahalom-6:3:6 + (vars (blob mesg) (n-a n-b n-a-0 n-b-0 n-a-1 text) + (a b s a-0 b-0 s-0 name) (k skey)) + (defstrand resp 3 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (defstrand serv 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s) (k k)) + (defstrand resp 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s)) + (defstrand init 3 (blob blob) (n-a n-a-1) (n-b n-b) (a a-0) (b b-0) + (s s-0) (k k)) + (precedes ((0 1) (3 1)) ((1 1) (3 1)) ((2 1) (1 0)) ((3 2) (0 2))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k) + (operation encryption-test (added-strand init 3) (enc n-b k) (0 2)) + (traces + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k)))) + ((recv (cat b (enc a n-a-0 n-b-0 (ltk b s)))) + (send (cat (enc b k n-a-0 n-b-0 (ltk a s)) (enc a k (ltk b s))))) + ((recv (cat a n-a-0)) (send (cat b (enc a n-a-0 n-b-0 (ltk b s))))) + ((send (cat a-0 n-a-1)) + (recv (cat (enc b-0 k n-a-1 n-b (ltk a-0 s-0)) blob)) + (send (cat blob (enc n-b k))))) + (label 9) + (parent 8) + (unrealized (3 1)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton yahalom-6:3:6 + (vars (n-a n-b n-a-0 n-b-0 text) (a b s name) (k skey)) + (defstrand resp 3 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (defstrand serv 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s) (k k)) + (defstrand resp 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s)) + (deflistener k) + (precedes ((1 1) (3 0)) ((2 1) (1 0)) ((3 1) (0 2))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k) + (operation encryption-test (added-listener k) (enc n-b k) (0 2)) + (traces + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k)))) + ((recv (cat b (enc a n-a-0 n-b-0 (ltk b s)))) + (send (cat (enc b k n-a-0 n-b-0 (ltk a s)) (enc a k (ltk b s))))) + ((recv (cat a n-a-0)) (send (cat b (enc a n-a-0 n-b-0 (ltk b s))))) + ((recv k) (send k))) + (label 10) + (parent 8) + (unrealized (0 2) (3 0)) + (comment "empty cohort")) + +(defskeleton yahalom-6:3:6 + (vars (blob mesg) (n-a n-b n-a-0 n-b-0 n-a-1 text) + (a b s a-0 b-0 s-0 name) (k k-0 skey)) + (defstrand resp 3 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (defstrand serv 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s) (k k)) + (defstrand resp 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s)) + (defstrand init 3 (blob blob) (n-a n-a-1) (n-b n-b) (a a-0) (b b-0) + (s s-0) (k k)) + (defstrand serv 2 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k-0)) + (precedes ((0 1) (4 0)) ((1 1) (3 1)) ((2 1) (1 0)) ((3 2) (0 2)) + ((4 1) (3 1))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k k-0) + (operation nonce-test (added-strand serv 2) n-b (3 1) + (enc a n-a n-b (ltk b s))) + (traces + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k)))) + ((recv (cat b (enc a n-a-0 n-b-0 (ltk b s)))) + (send (cat (enc b k n-a-0 n-b-0 (ltk a s)) (enc a k (ltk b s))))) + ((recv (cat a n-a-0)) (send (cat b (enc a n-a-0 n-b-0 (ltk b s))))) + ((send (cat a-0 n-a-1)) + (recv (cat (enc b-0 k n-a-1 n-b (ltk a-0 s-0)) blob)) + (send (cat blob (enc n-b k)))) + ((recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k-0 n-a n-b (ltk a s)) (enc a k-0 (ltk b s)))))) + (label 11) + (parent 9) + (unrealized (3 1)) + (comment "2 in cohort - 2 not yet seen")) + +(defskeleton yahalom-6:3:6 + (vars (blob mesg) (n-a n-b text) (a b s name) (k skey)) + (defstrand resp 3 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (defstrand serv 2 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (defstrand init 3 (blob blob) (n-a n-a) (n-b n-b) (a a) (b b) (s s) + (k k)) + (precedes ((0 1) (1 0)) ((1 1) (2 1)) ((2 0) (0 0)) ((2 2) (0 2))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k) + (operation nonce-test + (contracted (n-a-0 n-a) (n-b-0 n-b) (k-0 k) (a-0 a) (b-0 b) (s-0 s) + (n-a-1 n-a)) n-b (3 1) (enc a n-a n-b (ltk b s)) + (enc b k n-a n-b (ltk a s))) + (traces + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k)))) + ((recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k n-a n-b (ltk a s)) (enc a k (ltk b s))))) + ((send (cat a n-a)) (recv (cat (enc b k n-a n-b (ltk a s)) blob)) + (send (cat blob (enc n-b k))))) + (label 12) + (parent 11) + (unrealized) + (shape)) + +(defskeleton yahalom-6:3:6 + (vars (blob blob-0 mesg) (n-a n-b n-a-0 n-b-0 n-a-1 text) + (a b s a-0 b-0 s-0 name) (k k-0 skey)) + (defstrand resp 3 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (defstrand serv 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s) (k k)) + (defstrand resp 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s)) + (defstrand init 3 (blob blob) (n-a n-a-1) (n-b n-b) (a a-0) (b b-0) + (s s-0) (k k)) + (defstrand serv 2 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k-0)) + (defstrand init 3 (blob blob-0) (n-a n-a) (n-b n-b) (a a) (b b) (s s) + (k k-0)) + (precedes ((0 1) (4 0)) ((1 1) (3 1)) ((2 1) (1 0)) ((3 2) (0 2)) + ((4 1) (5 1)) ((5 0) (0 0)) ((5 2) (3 1))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k k-0) + (operation nonce-test (added-strand init 3) n-b (3 1) + (enc a n-a n-b (ltk b s)) (enc b k-0 n-a n-b (ltk a s))) + (traces + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k)))) + ((recv (cat b (enc a n-a-0 n-b-0 (ltk b s)))) + (send (cat (enc b k n-a-0 n-b-0 (ltk a s)) (enc a k (ltk b s))))) + ((recv (cat a n-a-0)) (send (cat b (enc a n-a-0 n-b-0 (ltk b s))))) + ((send (cat a-0 n-a-1)) + (recv (cat (enc b-0 k n-a-1 n-b (ltk a-0 s-0)) blob)) + (send (cat blob (enc n-b k)))) + ((recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k-0 n-a n-b (ltk a s)) (enc a k-0 (ltk b s))))) + ((send (cat a n-a)) + (recv (cat (enc b k-0 n-a n-b (ltk a s)) blob-0)) + (send (cat blob-0 (enc n-b k-0))))) + (label 13) + (parent 11) + (unrealized (3 1)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton yahalom-6:3:6 + (vars (blob blob-0 mesg) (n-a n-b n-a-0 n-b-0 n-a-1 text) + (a b s a-0 b-0 s-0 name) (k k-0 skey)) + (defstrand resp 3 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (defstrand serv 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s) (k k)) + (defstrand resp 2 (n-a n-a-0) (n-b n-b-0) (a a) (b b) (s s)) + (defstrand init 3 (blob blob) (n-a n-a-1) (n-b n-b) (a a-0) (b b-0) + (s s-0) (k k)) + (defstrand serv 2 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k-0)) + (defstrand init 3 (blob blob-0) (n-a n-a) (n-b n-b) (a a) (b b) (s s) + (k k-0)) + (deflistener k-0) + (precedes ((0 1) (4 0)) ((1 1) (3 1)) ((2 1) (1 0)) ((3 2) (0 2)) + ((4 1) (5 1)) ((4 1) (6 0)) ((5 0) (0 0)) ((5 2) (3 1)) + ((6 1) (3 1))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k k-0) + (operation nonce-test (added-listener k-0) n-b (3 1) (enc n-b k-0) + (enc a n-a n-b (ltk b s)) (enc b k-0 n-a n-b (ltk a s))) + (traces + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k)))) + ((recv (cat b (enc a n-a-0 n-b-0 (ltk b s)))) + (send (cat (enc b k n-a-0 n-b-0 (ltk a s)) (enc a k (ltk b s))))) + ((recv (cat a n-a-0)) (send (cat b (enc a n-a-0 n-b-0 (ltk b s))))) + ((send (cat a-0 n-a-1)) + (recv (cat (enc b-0 k n-a-1 n-b (ltk a-0 s-0)) blob)) + (send (cat blob (enc n-b k)))) + ((recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k-0 n-a n-b (ltk a s)) (enc a k-0 (ltk b s))))) + ((send (cat a n-a)) + (recv (cat (enc b k-0 n-a n-b (ltk a s)) blob-0)) + (send (cat blob-0 (enc n-b k-0)))) ((recv k-0) (send k-0))) + (label 14) + (parent 13) + (unrealized (3 1) (6 0)) + (comment "empty cohort")) + +(comment "Nothing left to do") + +(defprotocol yahalom-6:3:6 basic + (defrole init + (vars (a b s name) (n-a n-b text) (k skey) (blob mesg)) + (trace (send (cat a n-a)) + (recv (cat (enc b k n-a n-b (ltk a s)) blob)) + (send (cat blob (enc n-b k))))) + (defrole resp + (vars (a b s name) (n-a n-b text) (k skey)) + (trace (recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))) + (recv (cat (enc a k (ltk b s)) (enc n-b k))))) + (defrole serv + (vars (a b s name) (n-a n-b text) (k skey)) + (trace (recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k n-a n-b (ltk a s)) (enc a k (ltk b s))))) + (uniq-orig k)) + (comment "Yahalom protocol, Section 6.3.6, Page 49") + (url "http://www.eecs.umich.edu/acal/swerve/docs/49-1.pdf")) + +(defskeleton yahalom-6:3:6 + (vars (n-a n-b text) (a b s name) (k skey)) + (defstrand serv 2 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k) + (traces + ((recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k n-a n-b (ltk a s)) (enc a k (ltk b s)))))) + (label 15) + (unrealized (0 0)) + (comment "1 in cohort - 1 not yet seen")) + +(defskeleton yahalom-6:3:6 + (vars (n-a n-b text) (a b s name) (k skey)) + (defstrand serv 2 (n-a n-a) (n-b n-b) (a a) (b b) (s s) (k k)) + (defstrand resp 2 (n-a n-a) (n-b n-b) (a a) (b b) (s s)) + (precedes ((1 1) (0 0))) + (non-orig (ltk a s) (ltk b s)) + (uniq-orig n-a n-b k) + (operation encryption-test (added-strand resp 2) + (enc a n-a n-b (ltk b s)) (0 0)) + (traces + ((recv (cat b (enc a n-a n-b (ltk b s)))) + (send (cat (enc b k n-a n-b (ltk a s)) (enc a k (ltk b s))))) + ((recv (cat a n-a)) (send (cat b (enc a n-a n-b (ltk b s)))))) + (label 16) + (parent 15) + (unrealized) + (shape)) + +(comment "Nothing left to do") diff --git a/tst/yahalom.tst b/tst/yahalom.tst --- a/tst/yahalom.tst +++ b/tst/yahalom.tst @@ -1,4 +1,4 @@ -(comment "CPSA 2.1.0") +(comment "CPSA 2.1.1") (comment "All input read") (defprotocol yahalom basic