406 lines
19 KiB
Plaintext
406 lines
19 KiB
Plaintext
(*
|
|
(C) Copyright Andreas Viktor Hess, DTU, 2015-2020
|
|
|
|
All Rights Reserved.
|
|
|
|
Redistribution and use in source and binary forms, with or without
|
|
modification, are permitted provided that the following conditions are
|
|
met:
|
|
|
|
- Redistributions of source code must retain the above copyright
|
|
notice, this list of conditions and the following disclaimer.
|
|
|
|
- Redistributions in binary form must reproduce the above copyright
|
|
notice, this list of conditions and the following disclaimer in the
|
|
documentation and/or other materials provided with the distribution.
|
|
|
|
- Neither the name of the copyright holder nor the names of its
|
|
contributors may be used to endorse or promote products
|
|
derived from this software without specific prior written
|
|
permission.
|
|
|
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
|
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
|
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
|
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
|
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
|
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
|
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
|
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
*)
|
|
|
|
(* Title: Example_Keyserver.thy
|
|
Author: Andreas Viktor Hess, DTU
|
|
*)
|
|
|
|
|
|
section \<open>The Keyserver Example\<close>
|
|
text \<open>\label{sec:Example-Keyserver}\<close>
|
|
theory Example_Keyserver
|
|
imports "../Stateful_Compositionality"
|
|
begin
|
|
|
|
declare [[code_timing]]
|
|
|
|
subsection \<open>Setup\<close>
|
|
subsubsection \<open>Datatypes and functions setup\<close>
|
|
datatype ex_lbl = Label1 ("\<one>") | Label2 ("\<two>")
|
|
|
|
datatype ex_atom =
|
|
Agent | Value | Attack | PrivFunSec
|
|
| Bot
|
|
|
|
datatype ex_fun =
|
|
ring | valid | revoked | events | beginauth nat | endauth nat | pubkeys | seen
|
|
| invkey | tuple | tuple' | attack nat
|
|
| sign | crypt | update | pw
|
|
| encodingsecret | pubkey nat
|
|
| pubconst ex_atom nat
|
|
|
|
type_synonym ex_type = "(ex_fun, ex_atom) term_type"
|
|
type_synonym ex_var = "ex_type \<times> nat"
|
|
|
|
lemma ex_atom_UNIV:
|
|
"(UNIV::ex_atom set) = {Agent, Value, Attack, PrivFunSec, Bot}"
|
|
by (auto intro: ex_atom.exhaust)
|
|
|
|
instance ex_atom::finite
|
|
by intro_classes (metis ex_atom_UNIV finite.emptyI finite.insertI)
|
|
|
|
lemma ex_lbl_UNIV:
|
|
"(UNIV::ex_lbl set) = {Label1, Label2}"
|
|
by (auto intro: ex_lbl.exhaust)
|
|
|
|
type_synonym ex_term = "(ex_fun, ex_var) term"
|
|
type_synonym ex_terms = "(ex_fun, ex_var) terms"
|
|
|
|
primrec arity::"ex_fun \<Rightarrow> nat" where
|
|
"arity ring = 2"
|
|
| "arity valid = 3"
|
|
| "arity revoked = 3"
|
|
| "arity events = 1"
|
|
| "arity (beginauth _) = 3"
|
|
| "arity (endauth _) = 3"
|
|
| "arity pubkeys = 2"
|
|
| "arity seen = 2"
|
|
| "arity invkey = 2"
|
|
| "arity tuple = 2"
|
|
| "arity tuple' = 2"
|
|
| "arity (attack _) = 0"
|
|
| "arity sign = 2"
|
|
| "arity crypt = 2"
|
|
| "arity update = 4"
|
|
| "arity pw = 2"
|
|
| "arity (pubkey _) = 0"
|
|
| "arity encodingsecret = 0"
|
|
| "arity (pubconst _ _) = 0"
|
|
|
|
fun public::"ex_fun \<Rightarrow> bool" where
|
|
"public (pubkey _) = False"
|
|
| "public encodingsecret = False"
|
|
| "public _ = True"
|
|
|
|
fun Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t::"ex_term list \<Rightarrow> (ex_term list \<times> ex_term list)" where
|
|
"Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t [k,m] = ([Fun invkey [Fun encodingsecret [], k]], [m])"
|
|
| "Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t _ = ([], [])"
|
|
|
|
fun Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n::"ex_term list \<Rightarrow> (ex_term list \<times> ex_term list)" where
|
|
"Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n [k,m] = ([], [m])"
|
|
| "Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n _ = ([], [])"
|
|
|
|
fun Ana::"ex_term \<Rightarrow> (ex_term list \<times> ex_term list)" where
|
|
"Ana (Fun tuple T) = ([], T)"
|
|
| "Ana (Fun tuple' T) = ([], T)"
|
|
| "Ana (Fun sign T) = Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n T"
|
|
| "Ana (Fun crypt T) = Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t T"
|
|
| "Ana _ = ([], [])"
|
|
|
|
|
|
subsubsection \<open>Keyserver example: Locale interpretation\<close>
|
|
lemma assm1:
|
|
"Ana t = (K,M) \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set K) \<subseteq> fv t"
|
|
"Ana t = (K,M) \<Longrightarrow> (\<And>g S'. Fun g S' \<sqsubseteq> t \<Longrightarrow> length S' = arity g)
|
|
\<Longrightarrow> k \<in> set K \<Longrightarrow> Fun f T' \<sqsubseteq> k \<Longrightarrow> length T' = arity f"
|
|
"Ana t = (K,M) \<Longrightarrow> K \<noteq> [] \<or> M \<noteq> [] \<Longrightarrow> Ana (t \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>, M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)"
|
|
by (rule Ana.cases[of "t"], auto elim!: Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t.elims Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n.elims)+
|
|
|
|
lemma assm2: "Ana (Fun f T) = (K, M) \<Longrightarrow> set M \<subseteq> set T"
|
|
by (rule Ana.cases[of "Fun f T"]) (auto elim!: Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t.elims Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n.elims)
|
|
|
|
lemma assm6: "0 < arity f \<Longrightarrow> public f" by (cases f) simp_all
|
|
|
|
global_interpretation im: intruder_model arity public Ana
|
|
defines wf\<^sub>t\<^sub>r\<^sub>m = "im.wf\<^sub>t\<^sub>r\<^sub>m"
|
|
by unfold_locales (metis assm1(1), metis assm1(2),rule Ana.simps, metis assm2, metis assm1(3))
|
|
|
|
type_synonym ex_strand_step = "(ex_fun,ex_var) strand_step"
|
|
type_synonym ex_strand = "(ex_fun,ex_var) strand"
|
|
|
|
|
|
subsubsection \<open>Typing function\<close>
|
|
definition \<Gamma>\<^sub>v::"ex_var \<Rightarrow> ex_type" where
|
|
"\<Gamma>\<^sub>v v = (if (\<forall>t \<in> subterms (fst v). case t of
|
|
(TComp f T) \<Rightarrow> arity f > 0 \<and> arity f = length T
|
|
| _ \<Rightarrow> True)
|
|
then fst v else TAtom Bot)"
|
|
|
|
fun \<Gamma>::"ex_term \<Rightarrow> ex_type" where
|
|
"\<Gamma> (Var v) = \<Gamma>\<^sub>v v"
|
|
| "\<Gamma> (Fun (attack _) _) = TAtom Attack"
|
|
| "\<Gamma> (Fun (pubkey _) _) = TAtom Value"
|
|
| "\<Gamma> (Fun encodingsecret _) = TAtom PrivFunSec"
|
|
| "\<Gamma> (Fun (pubconst \<tau> _) _) = TAtom \<tau>"
|
|
| "\<Gamma> (Fun f T) = TComp f (map \<Gamma> T)"
|
|
|
|
|
|
subsubsection \<open>Locale interpretation: typed model\<close>
|
|
lemma assm7: "arity c = 0 \<Longrightarrow> \<exists>a. \<forall>X. \<Gamma> (Fun c X) = TAtom a" by (cases c) simp_all
|
|
|
|
lemma assm8: "0 < arity f \<Longrightarrow> \<Gamma> (Fun f X) = TComp f (map \<Gamma> X)" by (cases f) simp_all
|
|
|
|
lemma assm9: "infinite {c. \<Gamma> (Fun c []) = TAtom a \<and> public c}"
|
|
proof -
|
|
let ?T = "(range (pubconst a))::ex_fun set"
|
|
have *:
|
|
"\<And>x y::nat. x \<in> UNIV \<Longrightarrow> y \<in> UNIV \<Longrightarrow> (pubconst a x = pubconst a y) = (x = y)"
|
|
"\<And>x::nat. x \<in> UNIV \<Longrightarrow> pubconst a x \<in> ?T"
|
|
"\<And>y::ex_fun. y \<in> ?T \<Longrightarrow> \<exists>x \<in> UNIV. y = pubconst a x"
|
|
by auto
|
|
have "?T \<subseteq> {c. \<Gamma> (Fun c []) = TAtom a \<and> public c}" by auto
|
|
moreover have "\<exists>f::nat \<Rightarrow> ex_fun. bij_betw f UNIV ?T"
|
|
using bij_betwI'[OF *] by blast
|
|
hence "infinite ?T" by (metis nat_not_finite bij_betw_finite)
|
|
ultimately show ?thesis using infinite_super by blast
|
|
qed
|
|
|
|
lemma assm10: "TComp f T \<sqsubseteq> \<Gamma> t \<Longrightarrow> arity f > 0"
|
|
proof (induction rule: \<Gamma>.induct)
|
|
case (1 x)
|
|
hence *: "TComp f T \<sqsubseteq> \<Gamma>\<^sub>v x" by simp
|
|
hence "\<Gamma>\<^sub>v x \<noteq> TAtom Bot" unfolding \<Gamma>\<^sub>v_def by force
|
|
hence "\<forall>t \<in> subterms (fst x). case t of
|
|
(TComp f T) \<Rightarrow> arity f > 0 \<and> arity f = length T
|
|
| _ \<Rightarrow> True"
|
|
unfolding \<Gamma>\<^sub>v_def by argo
|
|
thus ?case using * unfolding \<Gamma>\<^sub>v_def by fastforce
|
|
qed auto
|
|
|
|
lemma assm11: "im.wf\<^sub>t\<^sub>r\<^sub>m (\<Gamma> (Var x))"
|
|
proof -
|
|
have "im.wf\<^sub>t\<^sub>r\<^sub>m (\<Gamma>\<^sub>v x)" unfolding \<Gamma>\<^sub>v_def im.wf\<^sub>t\<^sub>r\<^sub>m_def by auto
|
|
thus ?thesis by simp
|
|
qed
|
|
|
|
lemma assm12: "\<Gamma> (Var (\<tau>, n)) = \<Gamma> (Var (\<tau>, m))"
|
|
apply (cases "\<forall>t \<in> subterms \<tau>. case t of
|
|
(TComp f T) \<Rightarrow> arity f > 0 \<and> arity f = length T
|
|
| _ \<Rightarrow> True")
|
|
by (auto simp add: \<Gamma>\<^sub>v_def)
|
|
|
|
lemma Ana_const: "arity c = 0 \<Longrightarrow> Ana (Fun c T) = ([], [])"
|
|
by (cases c) simp_all
|
|
|
|
lemma Ana_subst': "Ana (Fun f T) = (K,M) \<Longrightarrow> Ana (Fun f T \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>,M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)"
|
|
by (cases f) (auto elim!: Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t.elims Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n.elims)
|
|
|
|
global_interpretation tm: typed_model' arity public Ana \<Gamma>
|
|
by (unfold_locales, unfold wf\<^sub>t\<^sub>r\<^sub>m_def[symmetric])
|
|
(metis assm7, metis assm8, metis assm9, metis assm10, metis assm11, metis assm6,
|
|
metis assm12, metis Ana_const, metis Ana_subst')
|
|
|
|
|
|
subsubsection \<open>Locale interpretation: labeled stateful typed model\<close>
|
|
global_interpretation stm: labeled_stateful_typed_model' arity public Ana \<Gamma> tuple \<one> \<two>
|
|
by standard (rule arity.simps, metis Ana_subst', metis assm12, metis Ana_const, simp)
|
|
|
|
type_synonym ex_stateful_strand_step = "(ex_fun,ex_var) stateful_strand_step"
|
|
type_synonym ex_stateful_strand = "(ex_fun,ex_var) stateful_strand"
|
|
|
|
type_synonym ex_labeled_stateful_strand_step =
|
|
"(ex_fun,ex_var,ex_lbl) labeled_stateful_strand_step"
|
|
|
|
type_synonym ex_labeled_stateful_strand =
|
|
"(ex_fun,ex_var,ex_lbl) labeled_stateful_strand"
|
|
|
|
|
|
subsection \<open>Theorem: Type-flaw resistance of the keyserver example from the CSF18 paper\<close>
|
|
abbreviation "PK n \<equiv> Var (TAtom Value,n)"
|
|
abbreviation "A n \<equiv> Var (TAtom Agent,n)"
|
|
abbreviation "X n \<equiv> (TAtom Agent,n)"
|
|
|
|
abbreviation "ringset t \<equiv> Fun ring [Fun encodingsecret [], t]"
|
|
abbreviation "validset t t' \<equiv> Fun valid [Fun encodingsecret [], t, t']"
|
|
abbreviation "revokedset t t' \<equiv> Fun revoked [Fun encodingsecret [], t, t']"
|
|
abbreviation "eventsset \<equiv> Fun events [Fun encodingsecret []]"
|
|
|
|
(* Note: We will use S\<^sub>k\<^sub>s as a constraint, but it actually represents all steps that might occur
|
|
in the protocol *)
|
|
abbreviation S\<^sub>k\<^sub>s::"(ex_fun,ex_var) stateful_strand_step list" where
|
|
"S\<^sub>k\<^sub>s \<equiv> [
|
|
insert\<langle>Fun (attack 0) [], eventsset\<rangle>,
|
|
delete\<langle>PK 0, validset (A 0) (A 0)\<rangle>,
|
|
\<forall>(TAtom Agent,0)\<langle>PK 0 not in revokedset (A 0) (A 0)\<rangle>,
|
|
\<forall>(TAtom Agent,0)\<langle>PK 0 not in validset (A 0) (A 0)\<rangle>,
|
|
insert\<langle>PK 0, validset (A 0) (A 0)\<rangle>,
|
|
insert\<langle>PK 0, ringset (A 0)\<rangle>,
|
|
insert\<langle>PK 0, revokedset (A 0) (A 0)\<rangle>,
|
|
select\<langle>PK 0, validset (A 0) (A 0)\<rangle>,
|
|
select\<langle>PK 0, ringset (A 0)\<rangle>,
|
|
receive\<langle>Fun invkey [Fun encodingsecret [], PK 0]\<rangle>,
|
|
receive\<langle>Fun sign [Fun invkey [Fun encodingsecret [], PK 0], Fun tuple' [A 0, PK 0]]\<rangle>,
|
|
send\<langle>Fun invkey [Fun encodingsecret [], PK 0]\<rangle>,
|
|
send\<langle>Fun sign [Fun invkey [Fun encodingsecret [], PK 0], Fun tuple' [A 0, PK 0]]\<rangle>
|
|
]"
|
|
|
|
theorem "stm.tfr\<^sub>s\<^sub>s\<^sub>t S\<^sub>k\<^sub>s"
|
|
proof -
|
|
let ?M = "concat (map subterms_list (trms_list\<^sub>s\<^sub>s\<^sub>t S\<^sub>k\<^sub>s@map (pair' tuple) (setops_list\<^sub>s\<^sub>s\<^sub>t S\<^sub>k\<^sub>s)))"
|
|
have "comp_tfr\<^sub>s\<^sub>s\<^sub>t arity Ana \<Gamma> tuple ?M S\<^sub>k\<^sub>s" by eval
|
|
thus ?thesis by (rule stm.tfr\<^sub>s\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>s\<^sub>t)
|
|
qed
|
|
|
|
|
|
subsection \<open>Theorem: Type-flaw resistance of the keyserver examples from the ESORICS18 paper\<close>
|
|
abbreviation "signmsg t t' \<equiv> Fun sign [t, t']"
|
|
abbreviation "cryptmsg t t' \<equiv> Fun crypt [t, t']"
|
|
abbreviation "invkeymsg t \<equiv> Fun invkey [Fun encodingsecret [], t]"
|
|
abbreviation "updatemsg a b c d \<equiv> Fun update [a,b,c,d]"
|
|
abbreviation "pwmsg t t' \<equiv> Fun pw [t, t']"
|
|
|
|
abbreviation "beginauthset n t t' \<equiv> Fun (beginauth n) [Fun encodingsecret [], t, t']"
|
|
abbreviation "endauthset n t t' \<equiv> Fun (endauth n) [Fun encodingsecret [], t, t']"
|
|
abbreviation "pubkeysset t \<equiv> Fun pubkeys [Fun encodingsecret [], t]"
|
|
abbreviation "seenset t \<equiv> Fun seen [Fun encodingsecret [], t]"
|
|
|
|
declare [[coercion "Var::ex_var \<Rightarrow> ex_term"]]
|
|
declare [[coercion_enabled]]
|
|
|
|
(* Note: S'\<^sub>k\<^sub>s contains the (slightly over-approximated) steps that can occur in the
|
|
reachable constraints of \<P>\<^sub>k\<^sub>s,\<^sub>1 and \<P>\<^sub>k\<^sub>s,\<^sub>2 modulo variable renaming *)
|
|
definition S'\<^sub>k\<^sub>s::"ex_labeled_stateful_strand_step list" where
|
|
"S'\<^sub>k\<^sub>s \<equiv> [
|
|
\<^cancel>\<open>constraint steps from the first protocol (duplicate steps are ignored)\<close>
|
|
|
|
\<^cancel>\<open>rule R^1_1\<close>
|
|
\<langle>\<one>, send\<langle>invkeymsg (PK 0)\<rangle>\<rangle>,
|
|
\<langle>\<star>, \<langle>PK 0 in validset (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<one>, receive\<langle>Fun (attack 0) []\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^2_1\<close>
|
|
\<langle>\<one>, send\<langle>signmsg (invkeymsg (PK 0)) (Fun tuple' [A 0, PK 0])\<rangle>\<rangle>,
|
|
\<langle>\<star>, \<langle>PK 0 in validset (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<star>, \<forall>X 0, X 1\<langle>PK 0 not in validset (Var (X 0)) (Var (X 1))\<rangle>\<rangle>,
|
|
\<langle>\<one>, \<forall>X 0, X 1\<langle>PK 0 not in revokedset (Var (X 0)) (Var (X 1))\<rangle>\<rangle>,
|
|
\<langle>\<star>, \<langle>PK 0 not in beginauthset 0 (A 0) (A 1)\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^3_1\<close>
|
|
\<langle>\<star>, \<langle>PK 0 in beginauthset 0 (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<star>, \<langle>PK 0 in endauthset 0 (A 0) (A 1)\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^4_1\<close>
|
|
\<langle>\<star>, receive\<langle>PK 0\<rangle>\<rangle>,
|
|
\<langle>\<star>, receive\<langle>invkeymsg (PK 0)\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^5_1\<close>
|
|
\<langle>\<one>, insert\<langle>PK 0, ringset (A 0)\<rangle>\<rangle>,
|
|
\<langle>\<star>, insert\<langle>PK 0, validset (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<star>, insert\<langle>PK 0, beginauthset 0 (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<star>, insert\<langle>PK 0, endauthset 0 (A 0) (A 1)\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^6_1\<close>
|
|
\<langle>\<one>, select\<langle>PK 0, ringset (A 0)\<rangle>\<rangle>,
|
|
\<langle>\<one>, delete\<langle>PK 0, ringset (A 0)\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^7_1\<close>
|
|
\<langle>\<star>, \<langle>PK 0 not in endauthset 0 (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<star>, delete\<langle>PK 0, validset (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<one>, insert\<langle>PK 0, revokedset (A 0) (A 1)\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^8_1\<close>
|
|
\<^cancel>\<open>nothing new\<close>
|
|
|
|
\<^cancel>\<open>rule R^9_1\<close>
|
|
\<langle>\<one>, send\<langle>PK 0\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^10_1\<close>
|
|
\<langle>\<one>, send\<langle>Fun (attack 0) []\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>constraint steps from the second protocol (duplicate steps are ignored)\<close>
|
|
\<^cancel>\<open>rule R^2_1\<close>
|
|
\<langle>\<two>, send\<langle>invkeymsg (PK 0)\<rangle>\<rangle>,
|
|
\<langle>\<star>, \<langle>PK 0 in validset (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<two>, receive\<langle>Fun (attack 1) []\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^2_2\<close>
|
|
\<langle>\<two>, send\<langle>cryptmsg (PK 0) (updatemsg (A 0) (A 1) (PK 1) (pwmsg (A 0) (A 1)))\<rangle>\<rangle>,
|
|
\<langle>\<two>, select\<langle>PK 0, pubkeysset (A 0)\<rangle>\<rangle>,
|
|
\<langle>\<two>, \<forall>X 0\<langle>PK 0 not in pubkeysset (Var (X 0))\<rangle>\<rangle>,
|
|
\<langle>\<two>, \<forall>X 0\<langle>PK 0 not in seenset (Var (X 0))\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^3_2\<close>
|
|
\<langle>\<star>, \<langle>PK 0 in beginauthset 1 (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<star>, \<langle>PK 0 in endauthset 1 (A 0) (A 1)\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^4_2\<close>
|
|
\<langle>\<star>, receive\<langle>PK 0\<rangle>\<rangle>,
|
|
\<langle>\<star>, receive\<langle>invkeymsg (PK 0)\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^5_2\<close>
|
|
\<langle>\<two>, select\<langle>PK 0, pubkeysset (A 0)\<rangle>\<rangle>,
|
|
\<langle>\<star>, insert\<langle>PK 0, beginauthset 1 (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<two>, receive\<langle>cryptmsg (PK 0) (updatemsg (A 0) (A 1) (PK 1) (pwmsg (A 0) (A 1)))\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^6_2\<close>
|
|
\<langle>\<star>, \<langle>PK 0 not in endauthset 1 (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<star>, insert\<langle>PK 0, validset (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<star>, insert\<langle>PK 0, endauthset 1 (A 0) (A 1)\<rangle>\<rangle>,
|
|
\<langle>\<two>, insert\<langle>PK 0, seenset (A 0)\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^7_2\<close>
|
|
\<langle>\<two>, receive\<langle>pwmsg (A 0) (A 1)\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^8_2\<close>
|
|
\<^cancel>\<open>nothing new\<close>
|
|
|
|
\<^cancel>\<open>rule R^9_2\<close>
|
|
\<langle>\<two>, insert\<langle>PK 0, pubkeysset (A 0)\<rangle>\<rangle>,
|
|
|
|
\<^cancel>\<open>rule R^10_2\<close>
|
|
\<langle>\<two>, send\<langle>Fun (attack 1) []\<rangle>\<rangle>
|
|
]"
|
|
|
|
theorem "stm.tfr\<^sub>s\<^sub>s\<^sub>t (unlabel S'\<^sub>k\<^sub>s)"
|
|
proof -
|
|
let ?S = "unlabel S'\<^sub>k\<^sub>s"
|
|
let ?M = "concat (map subterms_list (trms_list\<^sub>s\<^sub>s\<^sub>t ?S@map (pair' tuple) (setops_list\<^sub>s\<^sub>s\<^sub>t ?S)))"
|
|
have "comp_tfr\<^sub>s\<^sub>s\<^sub>t arity Ana \<Gamma> tuple ?M ?S" by eval
|
|
thus ?thesis by (rule stm.tfr\<^sub>s\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>s\<^sub>t)
|
|
qed
|
|
|
|
|
|
subsection \<open>Theorem: The steps of the keyserver protocols from the ESORICS18 paper satisfy the conditions for parallel composition\<close>
|
|
theorem
|
|
fixes S f
|
|
defines "S \<equiv> [PK 0, invkeymsg (PK 0), Fun encodingsecret []]@concat (
|
|
map (\<lambda>s. [s, Fun tuple [PK 0, s]])
|
|
[validset (A 0) (A 1), beginauthset 0 (A 0) (A 1), endauthset 0 (A 0) (A 1),
|
|
beginauthset 1 (A 0) (A 1), endauthset 1 (A 0) (A 1)])@
|
|
[A 0]"
|
|
and "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. t \<in> M \<and> tm.wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> im.wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> fv (t \<cdot> \<delta>) = {}}"
|
|
and "Sec \<equiv> (f (set S)) - {m. im.intruder_synth {} m}"
|
|
shows "stm.par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t S'\<^sub>k\<^sub>s Sec"
|
|
proof -
|
|
let ?N = "\<lambda>P. concat (map subterms_list (trms_list\<^sub>s\<^sub>s\<^sub>t P@map (pair' tuple) (setops_list\<^sub>s\<^sub>s\<^sub>t P)))"
|
|
let ?M = "\<lambda>l. ?N (proj_unl l S'\<^sub>k\<^sub>s)"
|
|
have "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> tuple S'\<^sub>k\<^sub>s ?M S"
|
|
unfolding S_def by eval
|
|
thus ?thesis
|
|
using stm.par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_if_comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t[of S'\<^sub>k\<^sub>s ?M S]
|
|
unfolding Sec_def f_def wf\<^sub>t\<^sub>r\<^sub>m_def[symmetric] by blast
|
|
qed
|
|
|
|
end
|