307 lines
13 KiB
Plaintext
307 lines
13 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_TLS.thy
|
|
Author: Andreas Viktor Hess, DTU
|
|
*)
|
|
|
|
section \<open>Proving Type-Flaw Resistance of the TLS Handshake Protocol\<close>
|
|
text \<open>\label{sec:Example-TLS}\<close>
|
|
theory Example_TLS
|
|
imports "../Typed_Model"
|
|
begin
|
|
|
|
declare [[code_timing]]
|
|
|
|
subsection \<open>TLS example: Datatypes and functions setup\<close>
|
|
datatype ex_atom = PrivKey | SymKey | PubConst | Agent | Nonce | Bot
|
|
|
|
datatype ex_fun =
|
|
clientHello | clientKeyExchange | clientFinished
|
|
| serverHello | serverCert | serverHelloDone
|
|
| finished | changeCipher | x509 | prfun | master | pmsForm
|
|
| sign | hash | crypt | pub | concat | privkey nat
|
|
| pubconst ex_atom nat
|
|
|
|
type_synonym ex_type = "(ex_fun, ex_atom) term_type"
|
|
type_synonym ex_var = "ex_type \<times> nat"
|
|
|
|
instance ex_atom::finite
|
|
proof
|
|
let ?S = "UNIV::ex_atom set"
|
|
have "?S = {PrivKey, SymKey, PubConst, Agent, Nonce, Bot}" by (auto intro: ex_atom.exhaust)
|
|
thus "finite ?S" by (metis finite.emptyI finite.insertI)
|
|
qed
|
|
|
|
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 changeCipher = 0"
|
|
| "arity clientFinished = 4"
|
|
| "arity clientHello = 5"
|
|
| "arity clientKeyExchange = 1"
|
|
| "arity concat = 5"
|
|
| "arity crypt = 2"
|
|
| "arity finished = 1"
|
|
| "arity hash = 1"
|
|
| "arity master = 3"
|
|
| "arity pmsForm = 1"
|
|
| "arity prfun = 1"
|
|
| "arity (privkey _) = 0"
|
|
| "arity pub = 1"
|
|
| "arity (pubconst _ _) = 0"
|
|
| "arity serverCert = 1"
|
|
| "arity serverHello = 5"
|
|
| "arity serverHelloDone = 0"
|
|
| "arity sign = 2"
|
|
| "arity x509 = 2"
|
|
|
|
fun public::"ex_fun \<Rightarrow> bool" where
|
|
"public (privkey _) = 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 [Fun pub [k],m] = ([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 crypt T) = Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t T"
|
|
| "Ana (Fun finished T) = ([], T)"
|
|
| "Ana (Fun master T) = ([], T)"
|
|
| "Ana (Fun pmsForm T) = ([], T)"
|
|
| "Ana (Fun serverCert T) = ([], T)"
|
|
| "Ana (Fun serverHello T) = ([], T)"
|
|
| "Ana (Fun sign T) = Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n T"
|
|
| "Ana (Fun x509 T) = ([], T)"
|
|
| "Ana _ = ([], [])"
|
|
|
|
|
|
subsection \<open>TLS 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"
|
|
and wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s = "im.wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s"
|
|
by unfold_locales (metis assm1(1), metis assm1(2), rule Ana.simps, metis assm2, metis assm1(3))
|
|
|
|
|
|
subsection \<open>TLS Example: 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 (privkey _) _) = TAtom PrivKey"
|
|
| "\<Gamma> (Fun changeCipher _) = TAtom PubConst"
|
|
| "\<Gamma> (Fun serverHelloDone _) = TAtom PubConst"
|
|
| "\<Gamma> (Fun (pubconst \<tau> _) _) = TAtom \<tau>"
|
|
| "\<Gamma> (Fun f T) = TComp f (map \<Gamma> T)"
|
|
|
|
|
|
subsection \<open>TLS Example: 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_keys_subterm: "Ana t = (K,T) \<Longrightarrow> k \<in> set K \<Longrightarrow> k \<sqsubset> t"
|
|
proof (induct t rule: Ana.induct)
|
|
case (1 U)
|
|
then obtain m where "U = [Fun pub [k], m]" "K = [k]" "T = [m]"
|
|
by (auto elim!: Ana\<^sub>c\<^sub>r\<^sub>y\<^sub>p\<^sub>t.elims Ana\<^sub>s\<^sub>i\<^sub>g\<^sub>n.elims)
|
|
thus ?case using Fun_subterm_inside_params[of k crypt U] by auto
|
|
qed (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_keys_subterm)
|
|
|
|
subsection \<open>TLS example: Proving type-flaw resistance\<close>
|
|
abbreviation \<Gamma>\<^sub>v_clientHello where
|
|
"\<Gamma>\<^sub>v_clientHello \<equiv>
|
|
TComp clientHello [TAtom Nonce, TAtom Nonce, TAtom Nonce, TAtom Nonce, TAtom Nonce]"
|
|
|
|
abbreviation \<Gamma>\<^sub>v_serverHello where
|
|
"\<Gamma>\<^sub>v_serverHello \<equiv>
|
|
TComp serverHello [TAtom Nonce, TAtom Nonce, TAtom Nonce, TAtom Nonce, TAtom Nonce]"
|
|
|
|
abbreviation \<Gamma>\<^sub>v_pub where
|
|
"\<Gamma>\<^sub>v_pub \<equiv> TComp pub [TAtom PrivKey]"
|
|
|
|
abbreviation \<Gamma>\<^sub>v_x509 where
|
|
"\<Gamma>\<^sub>v_x509 \<equiv> TComp x509 [TAtom Agent, \<Gamma>\<^sub>v_pub]"
|
|
|
|
abbreviation \<Gamma>\<^sub>v_sign where
|
|
"\<Gamma>\<^sub>v_sign \<equiv> TComp sign [TAtom PrivKey, \<Gamma>\<^sub>v_x509]"
|
|
|
|
abbreviation \<Gamma>\<^sub>v_serverCert where
|
|
"\<Gamma>\<^sub>v_serverCert \<equiv> TComp serverCert [\<Gamma>\<^sub>v_sign]"
|
|
|
|
abbreviation \<Gamma>\<^sub>v_pmsForm where
|
|
"\<Gamma>\<^sub>v_pmsForm \<equiv> TComp pmsForm [TAtom SymKey]"
|
|
|
|
abbreviation \<Gamma>\<^sub>v_crypt where
|
|
"\<Gamma>\<^sub>v_crypt \<equiv> TComp crypt [\<Gamma>\<^sub>v_pub, \<Gamma>\<^sub>v_pmsForm]"
|
|
|
|
abbreviation \<Gamma>\<^sub>v_clientKeyExchange where
|
|
"\<Gamma>\<^sub>v_clientKeyExchange \<equiv>
|
|
TComp clientKeyExchange [\<Gamma>\<^sub>v_crypt]"
|
|
|
|
abbreviation \<Gamma>\<^sub>v_HSMsgs where
|
|
"\<Gamma>\<^sub>v_HSMsgs \<equiv> TComp concat [
|
|
\<Gamma>\<^sub>v_clientHello,
|
|
\<Gamma>\<^sub>v_serverHello,
|
|
\<Gamma>\<^sub>v_serverCert,
|
|
TAtom PubConst,
|
|
\<Gamma>\<^sub>v_clientKeyExchange]"
|
|
|
|
(* Variables from TLS *)
|
|
abbreviation "T\<^sub>1 n \<equiv> Var (TAtom Nonce,n)"
|
|
abbreviation "T\<^sub>2 n \<equiv> Var (TAtom Nonce,n)"
|
|
abbreviation "R\<^sub>A n \<equiv> Var (TAtom Nonce,n)"
|
|
abbreviation "R\<^sub>B n \<equiv> Var (TAtom Nonce,n)"
|
|
abbreviation "S n \<equiv> Var (TAtom Nonce,n)"
|
|
abbreviation "Cipher n \<equiv> Var (TAtom Nonce,n)"
|
|
abbreviation "Comp n \<equiv> Var (TAtom Nonce,n)"
|
|
abbreviation "B n \<equiv> Var (TAtom Agent,n)"
|
|
abbreviation "Pr\<^sub>c\<^sub>a n \<equiv> Var (TAtom PrivKey,n)"
|
|
abbreviation "PMS n \<equiv> Var (TAtom SymKey,n)"
|
|
abbreviation "P\<^sub>B n \<equiv> Var (TComp pub [TAtom PrivKey],n)"
|
|
abbreviation "HSMsgs n \<equiv> Var (\<Gamma>\<^sub>v_HSMsgs,n)"
|
|
|
|
subsubsection \<open>Defining the over-approximation set\<close>
|
|
abbreviation clientHello\<^sub>t\<^sub>r\<^sub>m where
|
|
"clientHello\<^sub>t\<^sub>r\<^sub>m \<equiv> Fun clientHello [T\<^sub>1 0, R\<^sub>A 1, S 2, Cipher 3, Comp 4]"
|
|
|
|
abbreviation serverHello\<^sub>t\<^sub>r\<^sub>m where
|
|
"serverHello\<^sub>t\<^sub>r\<^sub>m \<equiv> Fun serverHello [T\<^sub>2 0, R\<^sub>B 1, S 2, Cipher 3, Comp 4]"
|
|
|
|
abbreviation serverCert\<^sub>t\<^sub>r\<^sub>m where
|
|
"serverCert\<^sub>t\<^sub>r\<^sub>m \<equiv> Fun serverCert [Fun sign [Pr\<^sub>c\<^sub>a 0, Fun x509 [B 1, P\<^sub>B 2]]]"
|
|
|
|
abbreviation serverHelloDone\<^sub>t\<^sub>r\<^sub>m where
|
|
"serverHelloDone\<^sub>t\<^sub>r\<^sub>m \<equiv> Fun serverHelloDone []"
|
|
|
|
abbreviation clientKeyExchange\<^sub>t\<^sub>r\<^sub>m where
|
|
"clientKeyExchange\<^sub>t\<^sub>r\<^sub>m \<equiv> Fun clientKeyExchange [Fun crypt [P\<^sub>B 0, Fun pmsForm [PMS 1]]]"
|
|
|
|
abbreviation changeCipher\<^sub>t\<^sub>r\<^sub>m where
|
|
"changeCipher\<^sub>t\<^sub>r\<^sub>m \<equiv> Fun changeCipher []"
|
|
|
|
abbreviation finished\<^sub>t\<^sub>r\<^sub>m where
|
|
"finished\<^sub>t\<^sub>r\<^sub>m \<equiv> Fun finished [Fun prfun [
|
|
Fun clientFinished [
|
|
Fun prfun [Fun master [PMS 0, R\<^sub>A 1, R\<^sub>B 2]],
|
|
R\<^sub>A 3, R\<^sub>B 4, Fun hash [HSMsgs 5]
|
|
]
|
|
]]"
|
|
|
|
definition M\<^sub>T\<^sub>L\<^sub>S::"ex_term list" where
|
|
"M\<^sub>T\<^sub>L\<^sub>S \<equiv> [
|
|
clientHello\<^sub>t\<^sub>r\<^sub>m,
|
|
serverHello\<^sub>t\<^sub>r\<^sub>m,
|
|
serverCert\<^sub>t\<^sub>r\<^sub>m,
|
|
serverHelloDone\<^sub>t\<^sub>r\<^sub>m,
|
|
clientKeyExchange\<^sub>t\<^sub>r\<^sub>m,
|
|
changeCipher\<^sub>t\<^sub>r\<^sub>m,
|
|
finished\<^sub>t\<^sub>r\<^sub>m
|
|
]"
|
|
|
|
|
|
subsection \<open>Theorem: The TLS handshake protocol is type-flaw resistant\<close>
|
|
theorem "tm.tfr\<^sub>s\<^sub>e\<^sub>t (set M\<^sub>T\<^sub>L\<^sub>S)"
|
|
by (rule tm.tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t') eval
|
|
|
|
end
|