From 671debf879a17509cef68e23c5a47848a17d5038 Mon Sep 17 00:00:00 2001 From: "Achim D. Brucker" Date: Fri, 23 Dec 2016 10:06:07 +0000 Subject: [PATCH] Initial commit. --- Examples/DMZ/DMZ.thy | 75 + Examples/DMZ/DMZDatatype.thy | 120 + Examples/DMZ/DMZInteger.thy | 133 + Examples/Examples.thy | 50 + Examples/NAT-FW/NAT-FW.thy | 292 ++ .../PersonalFirewall/PersonalFirewall.thy | 45 + .../PersonalFirewallDatatype.thy | 108 + .../PersonalFirewall/PersonalFirewallInt.thy | 113 + .../PersonalFirewall/PersonalFirewallIpv4.thy | 103 + Examples/Transformation/Transformation.thy | 44 + Examples/Transformation/Transformation01.thy | 268 ++ Examples/Transformation/Transformation02.thy | 219 ++ Examples/VoIP/VoIP.thy | 136 + FWNormalisation/ElementaryRules.thy | 76 + FWNormalisation/FWNormalisation.thy | 42 + FWNormalisation/FWNormalisationCore.thy | 654 +++++ .../NormalisationGenericProofs.thy | 2397 +++++++++++++++++ FWNormalisation/NormalisationIPPProofs.thy | 1959 ++++++++++++++ .../NormalisationIntegerPortProof.thy | 1971 ++++++++++++++ LICENSE | 34 + NAT/NAT.thy | 170 ++ PacketFilter/DatatypeAddress.thy | 62 + PacketFilter/DatatypePort.thy | 93 + PacketFilter/IPv4.thy | 88 + PacketFilter/IPv4_TCPUDP.thy | 83 + PacketFilter/IntegerAddress.thy | 48 + PacketFilter/IntegerPort.thy | 85 + PacketFilter/IntegerPort_TCPUDP.thy | 111 + PacketFilter/NetworkCore.thy | 182 ++ PacketFilter/NetworkModels.thy | 79 + PacketFilter/PacketFilter.thy | 45 + PacketFilter/PolicyCombinators.thy | 86 + PacketFilter/PolicyCore.thy | 70 + PacketFilter/PortCombinators.thy | 183 ++ PacketFilter/Ports.thy | 78 + PacketFilter/ProtocolPortCombinators.thy | 180 ++ README.md | 31 + ROOT | 11 + StatefulFW/FTP.thy | 248 ++ StatefulFW/FTPVOIP.thy | 314 +++ StatefulFW/FTP_WithPolicy.thy | 77 + StatefulFW/LTL_alike.thy | 160 ++ StatefulFW/Stateful.thy | 106 + StatefulFW/StatefulFW.thy | 44 + StatefulFW/VOIP.thy | 321 +++ UPF-Firewall.thy | 48 + document/introduction.tex | 12 + document/root.bib | 254 ++ document/root.tex | 159 ++ 49 files changed, 12267 insertions(+) create mode 100644 Examples/DMZ/DMZ.thy create mode 100644 Examples/DMZ/DMZDatatype.thy create mode 100644 Examples/DMZ/DMZInteger.thy create mode 100644 Examples/Examples.thy create mode 100644 Examples/NAT-FW/NAT-FW.thy create mode 100644 Examples/PersonalFirewall/PersonalFirewall.thy create mode 100644 Examples/PersonalFirewall/PersonalFirewallDatatype.thy create mode 100644 Examples/PersonalFirewall/PersonalFirewallInt.thy create mode 100644 Examples/PersonalFirewall/PersonalFirewallIpv4.thy create mode 100644 Examples/Transformation/Transformation.thy create mode 100644 Examples/Transformation/Transformation01.thy create mode 100644 Examples/Transformation/Transformation02.thy create mode 100644 Examples/VoIP/VoIP.thy create mode 100644 FWNormalisation/ElementaryRules.thy create mode 100644 FWNormalisation/FWNormalisation.thy create mode 100644 FWNormalisation/FWNormalisationCore.thy create mode 100644 FWNormalisation/NormalisationGenericProofs.thy create mode 100644 FWNormalisation/NormalisationIPPProofs.thy create mode 100644 FWNormalisation/NormalisationIntegerPortProof.thy create mode 100644 LICENSE create mode 100644 NAT/NAT.thy create mode 100644 PacketFilter/DatatypeAddress.thy create mode 100644 PacketFilter/DatatypePort.thy create mode 100644 PacketFilter/IPv4.thy create mode 100644 PacketFilter/IPv4_TCPUDP.thy create mode 100644 PacketFilter/IntegerAddress.thy create mode 100644 PacketFilter/IntegerPort.thy create mode 100644 PacketFilter/IntegerPort_TCPUDP.thy create mode 100644 PacketFilter/NetworkCore.thy create mode 100644 PacketFilter/NetworkModels.thy create mode 100644 PacketFilter/PacketFilter.thy create mode 100644 PacketFilter/PolicyCombinators.thy create mode 100644 PacketFilter/PolicyCore.thy create mode 100644 PacketFilter/PortCombinators.thy create mode 100644 PacketFilter/Ports.thy create mode 100644 PacketFilter/ProtocolPortCombinators.thy create mode 100644 README.md create mode 100644 ROOT create mode 100644 StatefulFW/FTP.thy create mode 100644 StatefulFW/FTPVOIP.thy create mode 100644 StatefulFW/FTP_WithPolicy.thy create mode 100644 StatefulFW/LTL_alike.thy create mode 100644 StatefulFW/Stateful.thy create mode 100644 StatefulFW/StatefulFW.thy create mode 100644 StatefulFW/VOIP.thy create mode 100644 UPF-Firewall.thy create mode 100644 document/introduction.tex create mode 100644 document/root.bib create mode 100644 document/root.tex diff --git a/Examples/DMZ/DMZ.thy b/Examples/DMZ/DMZ.thy new file mode 100644 index 0000000..f16951d --- /dev/null +++ b/Examples/DMZ/DMZ.thy @@ -0,0 +1,75 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +section {* A Simple DMZ Setup *} +theory + DMZ +imports + DMZDatatype + DMZInteger +begin + +text{* This scenario is slightly more complicated than the SimpleDMZ +one, as we now also model specific servers within one +network. Therefore, we cannot use anymore the modelling using +datatype synonym, but only use the one where an address is modelled as an +integer (with ports). + +The scenario is the following: + +\begin{labeling}{Networks:} +\item[Networks:] + \begin{itemize} + \item Intranet (Company intern network) + \item DMZ (demilitarised zone, servers, etc), containing + at least two distinct servers ``mail'' and ``web'' + \item Internet (``all others'') + \end{itemize} +\item[Policy:] + \begin{itemize} + \item allow http(s) from Intranet to Internet + \item deny all trafic from Internet to Intranet + \item allo imaps and smtp from intranet to mailserver + \item allow smtp from Internet to mailserver + \item allow http(s) from Internet to webserver + \item deny everything else + \end{itemize} + +\end{labeling} +*} + +end diff --git a/Examples/DMZ/DMZDatatype.thy b/Examples/DMZ/DMZDatatype.thy new file mode 100644 index 0000000..fc5e885 --- /dev/null +++ b/Examples/DMZ/DMZDatatype.thy @@ -0,0 +1,120 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* DMZ Datatype *} +theory + DMZDatatype +imports + "../../UPF-Firewall" +begin + +text{* This is the fourth scenario, slightly more complicated than the +previous one, as we now also model specific servers within one +network. Therefore, we could not use anymore the modelling using +datatype synonym, but only use the one where an address is modelled as an +integer (with ports). + +Just for comparison, this theory is the same scenario with datatype synonym +anyway, but with four distinct networks instead of one contained in +another. As there is no corresponding network model included, we need +to define a custom one. *} + + +datatype Adr = Intranet | Internet | Mail | Web | DMZ +instance Adr::adr .. +type_synonym port = int +type_synonym Networks = "Adr \ port" + + +definition + intranet::"Networks net" where + "intranet = {{(a,b). a= Intranet}}" +definition + dmz :: "Networks net" where + "dmz = {{(a,b). a= DMZ}}" +definition + mail :: "Networks net" where + "mail = {{(a,b). a=Mail}}" +definition + web :: "Networks net" where + "web = {{(a,b). a=Web}}" +definition + internet :: "Networks net" where + "internet = {{(a,b). a= Internet}}" + +definition + Intranet_mail_port :: "(Networks ,DummyContent) FWPolicy" where + "Intranet_mail_port = (allow_from_ports_to {21::port,14} intranet mail)" + +definition + Intranet_Internet_port :: "(Networks,DummyContent) FWPolicy" where + "Intranet_Internet_port = allow_from_ports_to {80::port,90} intranet internet" + +definition + Internet_web_port :: "(Networks,DummyContent) FWPolicy" where + "Internet_web_port = (allow_from_ports_to {80::port,90} internet web)" + +definition + Internet_mail_port :: "(Networks,DummyContent) FWPolicy" where + "Internet_mail_port = (allow_all_from_port_to internet (21::port) dmz)" + +definition + policyPort :: "(Networks, DummyContent) FWPolicy" where + "policyPort = deny_all ++ + Intranet_Internet_port ++ + Intranet_mail_port ++ + Internet_mail_port ++ + Internet_web_port" + + +text {* We only want to create test cases which are sent between the +three main networks --- e.g. not between the mailserver and the +dmz. Therefore, the constraint looks as follows. *} + +definition + not_in_same_net :: "(Networks,DummyContent) packet \ bool" where + "not_in_same_net x = ((src x \ internet \ \ dest x \ internet) \ + (src x \ intranet \ \ dest x \ intranet) \ + (src x \ dmz \ \ dest x \ dmz))" + +lemmas PolicyLemmas = dmz_def internet_def intranet_def mail_def web_def + Internet_web_port_def Internet_mail_port_def + Intranet_Internet_port_def Intranet_mail_port_def + src_def dest_def src_port dest_port in_subnet_def + + +end diff --git a/Examples/DMZ/DMZInteger.thy b/Examples/DMZ/DMZInteger.thy new file mode 100644 index 0000000..dc4e087 --- /dev/null +++ b/Examples/DMZ/DMZInteger.thy @@ -0,0 +1,133 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* DMZ: Integer *} +theory + DMZInteger +imports + "../../UPF-Firewall" +begin + +text{* This scenario is slightly more complicated than the SimpleDMZ +one, as we now also model specific servers within one +network. Therefore, we cannot use anymore the modelling using +datatype synonym, but only use the one where an address is modelled as an +integer (with ports). + +The scenario is the following: + +\begin{labeling}{Networks:} +\item[Networks:] + \begin{itemize} + \item Intranet (Company intern network) + \item DMZ (demilitarised zone, servers, etc), containing + at least two distinct servers ``mail'' and ``web'' + \item Internet (``all others'') + \end{itemize} +\item[Policy:] + \begin{itemize} + \item allow http(s) from Intranet to Internet + \item deny all trafic from Internet to Intranet + \item allo imaps and smtp from intranet to mailserver + \item allow smtp from Internet to mailserver + \item allow http(s) from Internet to webserver + \item deny everything else + \end{itemize} + +\end{labeling} +*} + + +definition + intranet::"adr\<^sub>i\<^sub>p net" where + "intranet = {{(a,b) . (a > 1 \ a < 4) }}" +definition + dmz :: "adr\<^sub>i\<^sub>p net" where + "dmz = {{(a,b). (a > 6) \ (a < 11)}}" +definition + mail :: "adr\<^sub>i\<^sub>p net" where + "mail = {{(a,b). a = 7}}" +definition + web :: "adr\<^sub>i\<^sub>p net" where + "web = {{(a,b). a = 8 }}" +definition + internet :: "adr\<^sub>i\<^sub>p net" where + "internet = {{(a,b). \ ( (a > 1 \ a < 4) \ (a > 6) \ (a < 11)) }}" + + +definition + Intranet_mail_port :: "(adr\<^sub>i\<^sub>p,'b) FWPolicy" where + "Intranet_mail_port = (allow_from_to_ports {21::port,14} intranet mail)" + +definition + Intranet_Internet_port :: "(adr\<^sub>i\<^sub>p,'b) FWPolicy" where + "Intranet_Internet_port = allow_from_to_ports {80::port,90} intranet internet" + +definition + Internet_web_port :: "(adr\<^sub>i\<^sub>p,'b) FWPolicy" where + "Internet_web_port = (allow_from_to_ports {80::port,90} internet web)" + +definition + Internet_mail_port :: "(adr\<^sub>i\<^sub>p,'b) FWPolicy" where + "Internet_mail_port = (allow_all_from_port_to internet (21::port) dmz )" + + + +definition + policyPort :: "(adr\<^sub>i\<^sub>p, DummyContent) FWPolicy" where + "policyPort = deny_all ++ + Intranet_Internet_port ++ + Intranet_mail_port ++ + Internet_mail_port ++ + Internet_web_port" + + +text {* We only want to create test cases which are sent between the three main networks --- + e.g. not between the mailserver and the dmz. Therefore, the constraint looks as follows. *} + +definition + not_in_same_net :: "(adr\<^sub>i\<^sub>p,DummyContent) packet \ bool" where + "not_in_same_net x = ((src x \ internet \ \ dest x \ internet) \ + (src x \ intranet \ \ dest x \ intranet) \ + (src x \ dmz \ \ dest x \ dmz))" + +lemmas PolicyLemmas = policyPort_def dmz_def internet_def intranet_def mail_def web_def + Intranet_Internet_port_def Intranet_mail_port_def Internet_web_port_def + Internet_mail_port_def src_def dest_def IntegerPort.src_port + in_subnet_def IntegerPort.dest_port + +end diff --git a/Examples/Examples.thy b/Examples/Examples.thy new file mode 100644 index 0000000..9e7b0ae --- /dev/null +++ b/Examples/Examples.thy @@ -0,0 +1,50 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +chapter {* Examples *} +theory + Examples +imports + "DMZ/DMZ" + "VoIP/VoIP" + "Transformation/Transformation" + "NAT-FW/NAT-FW" + "PersonalFirewall/PersonalFirewall" +begin + +end + diff --git a/Examples/NAT-FW/NAT-FW.thy b/Examples/NAT-FW/NAT-FW.thy new file mode 100644 index 0000000..522f78f --- /dev/null +++ b/Examples/NAT-FW/NAT-FW.thy @@ -0,0 +1,292 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +section {* Example: NAT *} +theory + "NAT-FW" +imports + "../../UPF-Firewall" +begin + + +definition subnet1 :: "adr\<^sub>i\<^sub>p net" where + "subnet1 = {{(d,e). d > 1 \ d < 256}}" + +definition subnet2 :: "adr\<^sub>i\<^sub>p net" where + "subnet2 = {{(d,e). d > 500 \ d < 1256}}" + + +definition + "accross_subnets x \ + ((src x \ subnet1 \ (dest x \ subnet2)) \ + (src x \ subnet2 \ (dest x \ subnet1)))" + +definition + filter :: "(adr\<^sub>i\<^sub>p, DummyContent) FWPolicy" where + "filter = allow_from_port_to (1::port) subnet1 subnet2 ++ + allow_from_port_to (2::port) subnet1 subnet2 ++ + allow_from_port_to (3::port) subnet1 subnet2 ++ deny_all" + +definition + nat_0 where + "nat_0 = (A\<^sub>f(\x. {x}))" + + +lemmas UnfoldPolicy0 =filter_def nat_0_def + NATLemmas + ProtocolPortCombinators.ProtocolCombinators + adr\<^sub>i\<^sub>pLemmas + packet_defs accross_subnets_def + subnet1_def subnet2_def + + +lemmas subnets = subnet1_def subnet2_def + + + + + +definition Adr11 :: "int set" +where "Adr11 = {d. d > 2 \ d < 3}" + +definition Adr21 :: "int set" where + "Adr21 = {d. d > 502 \ d < 503}" + + +definition nat_1 where + "nat_1 = nat_0 ++ (srcPat2pool_IntPort Adr11 Adr21)" + + +definition policy_1 where + "policy_1 = ((\ (x,y). x) o_f + ((nat_1 \\<^sub>2 filter) o (\ x. (x,x))))" + + +lemmas UnfoldPolicy1 = UnfoldPolicy0 nat_1_def Adr11_def Adr21_def policy_1_def + + + + +definition Adr12 :: "int set" +where "Adr12 = {d. d > 4 \ d < 6}" + +definition Adr22 :: "int set" where + "Adr22 = {d. d > 504 \ d < 506}" + + +definition nat_2 where + "nat_2 = nat_1 ++ (srcPat2pool_IntPort Adr12 Adr22)" + + +definition policy_2 where + "policy_2 = ((\ (x,y). x) o_f + ((nat_2 \\<^sub>2 filter) o (\ x. (x,x))))" + + +lemmas UnfoldPolicy2 = UnfoldPolicy1 nat_2_def Adr12_def Adr22_def policy_2_def + + + + +definition Adr13 :: "int set" +where "Adr13 = {d. d > 6 \ d < 9}" + +definition Adr23 :: "int set" where + "Adr23 = {d. d > 506 \ d < 509}" + + +definition nat_3 where + "nat_3 = nat_2 ++ (srcPat2pool_IntPort Adr13 Adr23)" + + +definition policy_3 where + "policy_3 = ((\ (x,y). x) o_f + ((nat_3 \\<^sub>2 filter) o (\ x. (x,x))))" + + +lemmas UnfoldPolicy3 = UnfoldPolicy2 nat_3_def Adr13_def Adr23_def policy_3_def + + + + +definition Adr14 :: "int set" +where "Adr14 = {d. d > 8 \ d < 12}" + +definition Adr24 :: "int set" where + "Adr24 = {d. d > 508 \ d < 512}" + + +definition nat_4 where + "nat_4 = nat_3 ++ (srcPat2pool_IntPort Adr14 Adr24)" + + +definition policy_4 where + "policy_4 = ((\ (x,y). x) o_f + ((nat_4 \\<^sub>2 filter) o (\ x. (x,x))))" + + +lemmas UnfoldPolicy4 = UnfoldPolicy3 nat_4_def Adr14_def Adr24_def policy_4_def + + + + +definition Adr15 :: "int set" +where "Adr15 = {d. d > 10 \ d < 15}" + +definition Adr25 :: "int set" where + "Adr25 = {d. d > 510 \ d < 515}" + + +definition nat_5 where + "nat_5 = nat_4 ++ (srcPat2pool_IntPort Adr15 Adr25)" + + +definition policy_5 where + "policy_5 = ((\ (x,y). x) o_f + ((nat_5 \\<^sub>2 filter) o (\ x. (x,x))))" + + +lemmas UnfoldPolicy5 = UnfoldPolicy4 nat_5_def Adr15_def Adr25_def policy_5_def + + + + +definition Adr16 :: "int set" +where "Adr16 = {d. d > 12 \ d < 18}" + +definition Adr26 :: "int set" where + "Adr26 = {d. d > 512 \ d < 518}" + + +definition nat_6 where + "nat_6 = nat_5 ++ (srcPat2pool_IntPort Adr16 Adr26)" + + +definition policy_6 where + "policy_6 = ((\ (x,y). x) o_f + ((nat_6 \\<^sub>2 filter) o (\ x. (x,x))))" + + +lemmas UnfoldPolicy6 = UnfoldPolicy5 nat_6_def Adr16_def Adr26_def policy_6_def + + + + +definition Adr17 :: "int set" +where "Adr17 = {d. d > 14 \ d < 21}" + +definition Adr27 :: "int set" where + "Adr27 = {d. d > 514 \ d < 521}" + + +definition nat_7 where + "nat_7 = nat_6 ++ (srcPat2pool_IntPort Adr17 Adr27)" + + +definition policy_7 where + "policy_7 = ((\ (x,y). x) o_f + ((nat_7 \\<^sub>2 filter) o (\ x. (x,x))))" + + +lemmas UnfoldPolicy7 = UnfoldPolicy6 nat_7_def Adr17_def Adr27_def policy_7_def + + + + +definition Adr18 :: "int set" +where "Adr18 = {d. d > 16 \ d < 24}" + +definition Adr28 :: "int set" where + "Adr28 = {d. d > 516 \ d < 524}" + + +definition nat_8 where + "nat_8 = nat_7 ++ (srcPat2pool_IntPort Adr18 Adr28)" + + +definition policy_8 where + "policy_8 = ((\ (x,y). x) o_f + ((nat_8 \\<^sub>2 filter) o (\ x. (x,x))))" + + +lemmas UnfoldPolicy8 = UnfoldPolicy7 nat_8_def Adr18_def Adr28_def policy_8_def + + + + +definition Adr19 :: "int set" +where "Adr19 = {d. d > 18 \ d < 27}" + +definition Adr29 :: "int set" where + "Adr29 = {d. d > 518 \ d < 527}" + + +definition nat_9 where + "nat_9 = nat_8 ++ (srcPat2pool_IntPort Adr19 Adr29)" + + +definition policy_9 where + "policy_9 = ((\ (x,y). x) o_f + ((nat_9 \\<^sub>2 filter) o (\ x. (x,x))))" + + +lemmas UnfoldPolicy9 = UnfoldPolicy8 nat_9_def Adr19_def Adr29_def policy_9_def + + + + +definition Adr110 :: "int set" +where "Adr110 = {d. d > 20 \ d < 30}" + +definition Adr210 :: "int set" where + "Adr210 = {d. d > 520 \ d < 530}" + + +definition nat_10 where + "nat_10 = nat_9 ++ (srcPat2pool_IntPort Adr110 Adr210)" + + +definition policy_10 where + "policy_10 = ((\ (x,y). x) o_f + ((nat_10 \\<^sub>2 filter) o (\ x. (x,x))))" + + +lemmas UnfoldPolicy10 = UnfoldPolicy9 nat_10_def Adr110_def Adr210_def policy_10_def + + + +end diff --git a/Examples/PersonalFirewall/PersonalFirewall.thy b/Examples/PersonalFirewall/PersonalFirewall.thy new file mode 100644 index 0000000..ba98c54 --- /dev/null +++ b/Examples/PersonalFirewall/PersonalFirewall.thy @@ -0,0 +1,45 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +section {* Personal Firewall *} +theory + PersonalFirewall +imports + PersonalFirewallInt + PersonalFirewallIpv4 +begin +end diff --git a/Examples/PersonalFirewall/PersonalFirewallDatatype.thy b/Examples/PersonalFirewall/PersonalFirewallDatatype.thy new file mode 100644 index 0000000..2563a22 --- /dev/null +++ b/Examples/PersonalFirewall/PersonalFirewallDatatype.thy @@ -0,0 +1,108 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Personal Firewall: Datatype *} +theory + PersonalFirewallDatatype +imports + FWTesting +begin + +text{* The most basic firewall scenario; there is a personal PC on one +side and the Internet on the other. There are two policies: the first +one allows all traffic from the PC to the Internet and denies all +coming into the PC. The second policy only allows specific ports from +the PC. This scenario comes in three variants: the first one specifies +the allowed protocols directly, the second together with their +respective port numbers, the third one only with the port numbers. *} + +datatype Adr = pc | internet + +type_synonym DatatypeTwoNets = "Adr \ int" + +instance Adr::adr .. + +defs (overloaded) + src_port_def: "src_port (x::(DatatypeTwoNets,'b) packet) \ snd (src x)" + dest_port_def: "dest_port (x::(DatatypeTwoNets,'b) packet) \ snd (dest x)" + +definition + PC :: "DatatypeTwoNets net" where +"PC = {{(a,b). a = pc}}" + +definition + Internet :: "DatatypeTwoNets net" where +"Internet = {{(a,b). a = internet}}" + + +text{* +Definition of the testing constraint +*} + +definition + not_in_same_net :: "(DatatypeTwoNets,DummyContent) packet \ bool" where +"not_in_same_net x = ((src x \ PC \ dest x \ Internet) \ (src x \ Internet \ dest x \ PC))" + +text {* +Definitions of the policies + +In fact, the short definitions wouldn't have to be written down - they +are the automatically simplified versions of their big counterparts. + +*} + +definition + strictPolicy :: "(DatatypeTwoNets,DummyContent) FWPolicy" where +"strictPolicy = deny_all ++ allow_all_from_to PC Internet" + +definition + PortPolicy :: "(DatatypeTwoNets,'b) FWPolicy" where +"PortPolicy = deny_all ++ allow_from_ports_to {80::port,24,21} PC Internet" + +definition + PortPolicyBig :: "(DatatypeTwoNets,'b) FWPolicy" where +"PortPolicyBig = + allow_from_port_to (80::port) PC Internet \ + allow_from_port_to (24::port) PC Internet \ + allow_from_port_to (21::port) PC Internet \ + deny_all" + + +lemmas policyLemmas = strictPolicy_def PortPolicy_def PC_def Internet_def PortPolicyBig_def src_def dest_def src_port_def dest_port_def + PolicyCombinators PortCombinators in_subnet_def + +end diff --git a/Examples/PersonalFirewall/PersonalFirewallInt.thy b/Examples/PersonalFirewall/PersonalFirewallInt.thy new file mode 100644 index 0000000..e9231b5 --- /dev/null +++ b/Examples/PersonalFirewall/PersonalFirewallInt.thy @@ -0,0 +1,113 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection{* Personal Firewall: Integer *} +theory + PersonalFirewallInt +imports + "../../UPF-Firewall" +begin + +text{* +The most basic firewall scenario; there is a personal PC on one side and the Internet on the other. +There are two policies: the first one allows all traffic from the PC to the Internet and denies +all coming into the PC. The second policy only allows specific ports from the PC. This scenario +comes in three variants: the first one specifies the allowed protocols directly, the second together +with their respective port numbers, the third one only with the port numbers. +*} + + + +text{* +Definitions of the subnets +*} + +definition + PC :: "(adr\<^sub>i\<^sub>p net)" where +"PC = {{(a,b). a = 3}}" + +definition + Internet :: "adr\<^sub>i\<^sub>p net" where +"Internet = {{(a,b). \ (a = 3)}}" + + + +text{* +Definition of the testing constraint +*} + + + +definition + not_in_same_net :: "(adr\<^sub>i\<^sub>p,DummyContent) packet \ bool" where +"not_in_same_net x = ((src x \ PC \ dest x \ Internet) \ (src x \ Internet \ dest x \ PC))" + +text {* +Definitions of the policies +*} + + + +definition + strictPolicy :: "(adr\<^sub>i\<^sub>p,DummyContent) FWPolicy" where +"strictPolicy = deny_all ++ allow_all_from_to PC Internet" + +definition + PortPolicy :: "(adr\<^sub>i\<^sub>p,DummyContent) FWPolicy" where +"PortPolicy = deny_all ++ allow_from_ports_to {http,smtp,ftp} PC Internet" + +definition + PortPolicyBig :: "(adr\<^sub>i\<^sub>p,DummyContent) FWPolicy" where +"PortPolicyBig = deny_all ++ + allow_from_port_to http PC Internet ++ + allow_from_port_to smtp PC Internet ++ + allow_from_port_to ftp PC Internet" + + +lemmas policyLemmas = strictPolicy_def PortPolicy_def PC_def + Internet_def PortPolicyBig_def src_def dest_def + adr\<^sub>i\<^sub>pLemmas content_def + PortCombinators in_subnet_def PortPolicyBig_def id_def + + +declare Ports [simp add] + +definition wellformed_packet::"(adr\<^sub>i\<^sub>p,DummyContent) packet \ bool" where + "wellformed_packet p = (content p = data)" + + +end diff --git a/Examples/PersonalFirewall/PersonalFirewallIpv4.thy b/Examples/PersonalFirewall/PersonalFirewallIpv4.thy new file mode 100644 index 0000000..6ac6de2 --- /dev/null +++ b/Examples/PersonalFirewall/PersonalFirewallIpv4.thy @@ -0,0 +1,103 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Personal Firewall IPv4 *} +theory + PersonalFirewallIpv4 +imports + "../../UPF-Firewall" +begin + + +text{* + +The most basic firewall scenario; there is a personal PC on one side and the Internet on the other. +There are two policies: the first one allows all traffic from the PC to the Internet and denies +all coming into the PC. The second policy only allows specific ports from the PC. This scenario +comes in three variants: the first one specifies the allowed protocols directly, the second together +with their respective port numbers, the third one only with the port numbers. + +*} + + +text{* +Definitions of the subnets +*} + +definition + PC :: "(ipv4 net)" where +"PC = {{((a,b,c,d),e). a = 1 \ b = 3 \ c = 5 \ d = 2}}" + +definition + Internet :: "ipv4 net" where +"Internet = {{((a,b,c,d),e). \ (a = 1 \ b = 3 \ c = 5 \ d = 2)}}" + + +text{* +Definition of the testing constraint +*} + +definition + not_in_same_net :: "(ipv4,DummyContent) packet \ bool" where +"not_in_same_net x = ((src x \ PC \ dest x \ Internet) \ (src x \ Internet \ dest x \ PC))" + +text {* +Definitions of the policies +*} + +definition + strictPolicy :: "(ipv4,DummyContent) FWPolicy" where +"strictPolicy = deny_all ++ allow_all_from_to PC Internet" + +definition + PortPolicy :: "(ipv4,DummyContent) FWPolicy" where +"PortPolicy = deny_all ++ allow_from_ports_to {80::port,24,21} PC Internet" + +definition + PortPolicyBig :: "(ipv4,DummyContent) FWPolicy" where +"PortPolicyBig = deny_all ++ allow_from_port_to (80::port) PC Internet++ allow_from_port_to (24::port) PC Internet++ allow_from_port_to (21::port) PC Internet" + + +lemmas policyLemmas = strictPolicy_def PortPolicy_def PC_def + Internet_def PortPolicyBig_def src_def dest_def + IPv4.src_port + IPv4.dest_port PolicyCombinators + PortCombinators in_subnet_def PortPolicyBig_def + + + +end diff --git a/Examples/Transformation/Transformation.thy b/Examples/Transformation/Transformation.thy new file mode 100644 index 0000000..0f6eac4 --- /dev/null +++ b/Examples/Transformation/Transformation.thy @@ -0,0 +1,44 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +section {* Demonstrating Policy Transformations *} +theory Transformation +imports + Transformation01 + Transformation02 +begin +end diff --git a/Examples/Transformation/Transformation01.thy b/Examples/Transformation/Transformation01.thy new file mode 100644 index 0000000..07d29bd --- /dev/null +++ b/Examples/Transformation/Transformation01.thy @@ -0,0 +1,268 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Transformation Example 1 *} +theory + Transformation01 +imports + "../../UPF-Firewall" +begin + +definition + FWLink :: "adr\<^sub>i\<^sub>p net" where +"FWLink = {{(a,b). a = 1}}" + +definition + any :: "adr\<^sub>i\<^sub>p net" where +"any = {{(a,b). a > 5}}" + +definition + i4:: "adr\<^sub>i\<^sub>p net" where +"i4 = {{(a,b). a = 2 }}" + +definition + i27:: "adr\<^sub>i\<^sub>p net" where +"i27 = {{(a,b). a = 3 }}" + +definition + eth_intern:: "adr\<^sub>i\<^sub>p net" where +"eth_intern = {{(a,b). a = 4 }}" + +definition + eth_private:: "adr\<^sub>i\<^sub>p net" where +"eth_private = {{(a,b). a = 5 }}" + + +definition +(* Mandatory: Global *) + + MG2 :: "(adr\<^sub>i\<^sub>p net,port) Combinators" where +"MG2 = AllowPortFromTo i27 any 1 \ + AllowPortFromTo i27 any 2 \ + AllowPortFromTo i27 any 3" + +definition + MG3 :: "(adr\<^sub>i\<^sub>p net,port) Combinators" where +"MG3 = AllowPortFromTo any FWLink 1" + +definition + MG4 :: "(adr\<^sub>i\<^sub>p net,port) Combinators" where +"MG4 = AllowPortFromTo FWLink FWLink 4" + +definition + MG7 :: "(adr\<^sub>i\<^sub>p net,port) Combinators" where +"MG7 = AllowPortFromTo FWLink i4 6 \ + AllowPortFromTo FWLink i4 7" + +definition + MG8 :: "(adr\<^sub>i\<^sub>p net,port) Combinators" where +"MG8 = AllowPortFromTo FWLink i4 6 \ + AllowPortFromTo FWLink i4 7" + +(* Default Global *) + +definition + DG3:: "(adr\<^sub>i\<^sub>p net,port) Combinators" where +"DG3 = AllowPortFromTo any any 7" + + + +definition +"Policy = DenyAll \ MG8 \ MG7 \ MG4 \ MG3 \ MG2 \ DG3" + + + + lemmas PolicyLemmas = Policy_def + FWLink_def + any_def + + i27_def + i4_def + + eth_intern_def + eth_private_def + + MG2_def MG3_def MG4_def MG7_def MG8_def + DG3_def + + +lemmas PolicyL = MG2_def MG3_def MG4_def MG7_def MG8_def + DG3_def Policy_def + +definition + not_in_same_net :: "(adr\<^sub>i\<^sub>p,DummyContent) packet \ bool" where +"not_in_same_net x = (((src x \ i27) \ ( \ (dest x \ i27))) \ + ((src x \ i4) \ ( \ (dest x \ i4))) \ + ((src x \ eth_intern) \ ( \ (dest x \ eth_intern))) \ + ((src x \ eth_private) \ ( \ (dest x \ eth_private))))" + +consts fixID :: id +consts fixContent :: DummyContent + +definition "fixElements p = (id p = fixID \ content p = fixContent)" + +lemmas fixDefs = fixElements_def NetworkCore.id_def NetworkCore.content_def + + + +lemma sets_distinct1: "(n::int) \ m \ {(a,b). a = n} \ {(a,b). a = m}" +apply auto +done + +lemma sets_distinct2: "(m::int) \ n \ {(a,b). a = n} \ {(a,b). a = m}" +apply auto +done + + + +lemma sets_distinct3: "{((a::int),(b::int)). a = n} \ {(a,b). a > n}" +apply auto +done + + +lemma sets_distinct4: "{((a::int),(b::int)). a > n} \ {(a,b). a = n}" +apply auto +done + + +lemma aux: "\a \ c; a \ d; c = d\ \ False" +apply auto +done + + +lemma sets_distinct5: "(s::int) < g \ {(a::int, b::int). a = s} \ {(a::int, b::int). g < a}" +apply (auto simp: sets_distinct3) +apply (subgoal_tac "(s,4) \ {(a::int,b::int). a = (s)}") +apply (subgoal_tac "(s,4) \ {(a::int,b::int). g < a}") +apply (erule aux) +apply assumption+ +apply simp +by blast + + +lemma sets_distinct6: "(s::int) < g \ {(a::int, b::int). g < a} \ {(a::int, b::int). a = s}" +apply (rule not_sym) +apply (rule sets_distinct5) +by simp + + +lemma distinctNets: "FWLink \ any \ FWLink \ i4 \ FWLink \ i27 \ FWLink \ eth_intern \ FWLink \ eth_private \ +any \ FWLink \ any \ i4 \ any \ i27 \ any \ eth_intern \ any \ eth_private \ i4 \ FWLink \ +i4 \ any \ i4 \ i27 \ i4 \ eth_intern \ i4 \ eth_private \ i27 \ FWLink \ i27 \ any \ +i27 \ i4 \ i27 \ eth_intern \ i27 \ eth_private \ eth_intern \ FWLink \ eth_intern \ any \ +eth_intern \ i4 \ eth_intern \ i27 \ eth_intern \ eth_private \ eth_private \ FWLink \ +eth_private \ any \ eth_private \ i4 \ eth_private \ i27 \ eth_private \ eth_intern" +apply (simp add: PolicyLemmas sets_distinct1 sets_distinct2 sets_distinct3 sets_distinct4 sets_distinct5 sets_distinct6) +done + + + +lemma aux5: "\x \ a; y\b; (x \ y \ x \ b) \ (a \ b \ a \ y)\ \ {x,a} \ {y,b}" + apply auto +done + + +lemma aux2: "{a,b} = {b,a}" + apply auto +done + +(* +lemma noMT: "\ x \ set (policy2list Policy). dom (C x) \ {}" +apply (simp add: PolicyLemmas) +apply (simp add: PLemmas PolicyLemmas) +by arith +*) + + +lemma ANDex: "allNetsDistinct (policy2list Policy)" +apply (simp add: PolicyL allNetsDistinct_def distinctNets) +apply (auto simp: PLemmas PolicyLemmas netsDistinct_def sets_distinct5 sets_distinct6) +done + +(* +lemma count_the_rules: "(int (length(policy2list (list2FWpolicy(normalize Policy)))) = post) \ +(int(length (policy2list Policy)) = pre) \ + (int (length((normalize Policy))) = Partitions)" +apply (insert distinctNets noMT) +apply (simp add: normalize_def PolicyL bothNets_def aux5 aux2 Nets_List_def, thin_tac "?X",thin_tac "?S") +oops + + + +lemma normedPolicy: "normalize Policy = X" +apply (insert distinctNets noMT) +apply (simp add: normalize_def PolicyL bothNets_def aux5 aux2 Nets_List_def, thin_tac "?X",thin_tac "?S") +oops +*) + +fun (sequential) numberOfRules where + "numberOfRules (a\b) = numberOfRules a + numberOfRules b" + |"numberOfRules a = (1::int)" + + + + +fun numberOfRulesList where + "numberOfRulesList (x#xs) = ((numberOfRules x)#(numberOfRulesList xs)) " + |"numberOfRulesList [] = []" + +(* +lemma "numberOfRulesList (normalize Policy) = X" +apply (insert distinctNets noMT) +apply (simp add: normalize_def PolicyL bothNets_def aux5 aux2 Nets_List_def, thin_tac "?X",thin_tac "?S") +oops +*) + +lemma all_in_list: "all_in_list (policy2list Policy) (Nets_List Policy)" +apply (simp add: PolicyL) +apply (unfold Nets_List_def) +apply (unfold bothNets_def) +apply (insert distinctNets) +apply simp +done + +lemmas normalizeUnfold = normalize_def Policy_def Nets_List_def bothNets_def aux aux2 bothNets_def + +(* +lemma noMT2: "\ x \ set (policy2list Policy). dom (C x) \ {}" +apply (simp add: PLemmas normalize_def bothNets_def + PolicyLemmas aux5 aux2 Nets_List_def ) +by (metis zless_add1_eq) +*) + + +end diff --git a/Examples/Transformation/Transformation02.thy b/Examples/Transformation/Transformation02.thy new file mode 100644 index 0000000..3362158 --- /dev/null +++ b/Examples/Transformation/Transformation02.thy @@ -0,0 +1,219 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Transforamtion Example 2 *} +theory + Transformation02 +imports + "../../UPF-Firewall" +begin + +definition + FWLink :: "adr\<^sub>i\<^sub>p net" where +"FWLink = {{(a,b). a = 1}}" + +definition + any :: "adr\<^sub>i\<^sub>p net" where +"any = {{(a,b). a > 5}}" + +definition + i4_32:: "adr\<^sub>i\<^sub>p net" where +"i4_32 = {{(a,b). a = 2 }}" + +definition + i10_32:: "adr\<^sub>i\<^sub>p net" where +"i10_32 = {{(a,b). a = 3 }}" + +definition + eth_intern:: "adr\<^sub>i\<^sub>p net" where +"eth_intern = {{(a,b). a = 4 }}" + +definition + eth_private:: "adr\<^sub>i\<^sub>p net" where +"eth_private = {{(a,b). a = 5 }}" + + + +definition + D1a :: "(adr\<^sub>i\<^sub>p net, port) Combinators" where +"D1a = AllowPortFromTo eth_intern any 1 \ + AllowPortFromTo eth_intern any 2" + + +definition + D1b :: "(adr\<^sub>i\<^sub>p net, port) Combinators" where +"D1b = AllowPortFromTo eth_private any 1 \ + AllowPortFromTo eth_private any 2" + +definition + D2a :: "(adr\<^sub>i\<^sub>p net, port) Combinators" where +"D2a = AllowPortFromTo any i4_32 21" + + +definition + D2b :: "(adr\<^sub>i\<^sub>p net, port) Combinators" where +"D2b = AllowPortFromTo any i10_32 21 \ + AllowPortFromTo any i10_32 43" + + + +definition + Policy :: "(adr\<^sub>i\<^sub>p net, port) Combinators" where +"Policy = DenyAll \ D2b \ D2a \ D1b \ D1a" + +lemmas PolicyLemmas = Policy_def D1a_def D1b_def D2a_def D2b_def + + + lemmas PolicyL = Policy_def + FWLink_def + any_def + i10_32_def + i4_32_def + eth_intern_def + eth_private_def + D1a_def D1b_def D2a_def D2b_def + +consts fixID :: id +consts fixContent :: DummyContent + +definition "fixElements p = (id p = fixID \ content p = fixContent)" + +lemmas fixDefs = fixElements_def NetworkCore.id_def NetworkCore.content_def + + + +lemma sets_distinct1: "(n::int) \ m \ {(a,b). a = n} \ {(a,b). a = m}" +apply auto +done + +lemma sets_distinct2: "(m::int) \ n \ {(a,b). a = n} \ {(a,b). a = m}" +apply auto +done + + + +lemma sets_distinct3: "{((a::int),(b::int)). a = n} \ {(a,b). a > n}" +apply auto +done + + +lemma sets_distinct4: "{((a::int),(b::int)). a > n} \ {(a,b). a = n}" +apply auto +done + + +lemma aux: "\a \ c; a \ d; c = d\ \ False" +apply auto +done + + +lemma sets_distinct5: "(s::int) < g \ {(a::int, b::int). a = s} \ {(a::int, b::int). g < a}" +apply (auto simp: sets_distinct3) +apply (subgoal_tac "(s,4) \ {(a::int,b::int). a = (s)}") +apply (subgoal_tac "(s,4) \ {(a::int,b::int). g < a}") +apply (erule aux) +apply assumption+ +apply simp +by blast + +lemma sets_distinct6: "(s::int) < g \ {(a::int, b::int). g < a} \ {(a::int, b::int). a = s}" +apply (rule not_sym) +apply (rule sets_distinct5) +by simp + + +lemma distinctNets: "FWLink \ any \ FWLink \ i4_32 \ FWLink \ i10_32 \ +FWLink \ eth_intern \ FWLink \ eth_private \ any \ FWLink \ any \ +i4_32 \ any \ i10_32 \ any \ eth_intern \ any \ eth_private \ i4_32 \ +FWLink \ i4_32 \ any \ i4_32 \ i10_32 \ i4_32 \ eth_intern \ i4_32 \ +eth_private \ i10_32 \ FWLink \ i10_32 \ any \ i10_32 \ i4_32 \ i10_32 +\ eth_intern \ i10_32 \ eth_private \ eth_intern \ FWLink \ eth_intern +\ any \ eth_intern \ i4_32 \ eth_intern \ i10_32 \ eth_intern \ +eth_private \ eth_private \ FWLink \ eth_private \ any \ eth_private \ +i4_32 \ eth_private \ i10_32 \ eth_private \ eth_intern " +apply (simp add: PolicyL sets_distinct1 sets_distinct2 sets_distinct3 + sets_distinct4 sets_distinct5 sets_distinct6) +done + + + +lemma aux5: "\x \ a; y\b; (x \ y \ x \ b) \ (a \ b \ a \ y)\ \ {x,a} \ {y,b}" + apply auto +done + + +lemma aux2: "{a,b} = {b,a}" + apply auto +done + + + + +lemma ANDex: "allNetsDistinct (policy2list Policy)" +apply (simp add: PolicyLemmas allNetsDistinct_def distinctNets) +apply (simp add: PolicyL) +apply (auto simp: PLemmas PolicyL netsDistinct_def sets_distinct5 sets_distinct6 sets_distinct1 sets_distinct2) +done + +fun (sequential) numberOfRules where + "numberOfRules (a\b) = numberOfRules a + numberOfRules b" + |"numberOfRules a = (1::int)" + + + + +fun numberOfRulesList where + "numberOfRulesList (x#xs) = ((numberOfRules x)#(numberOfRulesList xs)) " + |"numberOfRulesList [] = []" + + + +lemma all_in_list: "all_in_list (policy2list Policy) (Nets_List Policy)" +apply (simp add: PolicyLemmas) +apply (unfold Nets_List_def) +apply (unfold bothNets_def) +apply (insert distinctNets) +apply simp +done + + +lemmas normalizeUnfold = normalize_def PolicyL Nets_List_def bothNets_def aux aux2 bothNets_def sets_distinct1 sets_distinct2 sets_distinct3 sets_distinct4 sets_distinct5 sets_distinct6 aux5 aux2 + + +end + + diff --git a/Examples/VoIP/VoIP.thy b/Examples/VoIP/VoIP.thy new file mode 100644 index 0000000..586b29a --- /dev/null +++ b/Examples/VoIP/VoIP.thy @@ -0,0 +1,136 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +section {* Voice over IP *} +theory VoIP +imports + "../../UPF-Firewall" +begin + + +text{* In this theory we generate the test data for correct runs of +the FTP protocol. As usual, we start with definining the networks and +the policy. We use a rather simple policy which allows only FTP +connections starting from the Intranet and going to the Internet, and +deny everything else. *} + +definition + intranet :: "adr\<^sub>i\<^sub>p net" where + "intranet = {{(a,e) . a = 3}}" + +definition + internet :: "adr\<^sub>i\<^sub>p net" where + "internet = {{(a,c). a > 4}}" + +definition + gatekeeper :: "adr\<^sub>i\<^sub>p net" where + "gatekeeper = {{(a,c). a =4}}" + + +definition + voip_policy :: "(adr\<^sub>i\<^sub>p,address voip_msg) FWPolicy" where + "voip_policy = A\<^sub>U" + + +text{* The next two constants check if an address is in the Intranet +or in the Internet respectively.*} + +definition + is_in_intranet :: "address \ bool" where + "is_in_intranet a = (a = 3)" + +definition + is_gatekeeper :: "address \ bool" where + "is_gatekeeper a = (a = 4)" + +definition + is_in_internet :: "address \ bool" where + "is_in_internet a = (a > 4)" + + +text{* +The next definition is our starting state: an empty trace and the just defined policy.*} + +definition + "\_0_voip" :: "(adr\<^sub>i\<^sub>p, address voip_msg) history \ + (adr\<^sub>i\<^sub>p, address voip_msg) FWPolicy" +where + "\_0_voip = ([],voip_policy)" + +text{*Next we state the conditions we have on our trace: a normal +behaviour FTP run from the intranet to some server in the internet on +port 21.*} + +definition "accept_voip" :: "(adr\<^sub>i\<^sub>p, address voip_msg) history \ bool" where + "accept_voip t = + (\ c s g i p1 p2. t \ NB_voip c s g i p1 p2 \ is_in_intranet c \ is_in_internet s + \ is_gatekeeper g)" + + + +fun packet_with_id where + "packet_with_id [] i = []" +|"packet_with_id (x#xs) i = + (if id x = i then (x#(packet_with_id xs i)) else (packet_with_id xs i))" + + +text{*The depth of the test case generation corresponds to the maximal +length of generated traces. 4 is the minimum to get a full FTP +protocol run. *} + + + + + +fun ids1 where + "ids1 i (x#xs) = (id x = i \ ids1 i xs)" +|"ids1 i [] = True" + +lemmas ST_simps = Let_def valid_SE_def unit_SE_def bind_SE_def + subnet_of_int_def p_accept_def content_def + is_in_intranet_def is_in_internet_def intranet_def internet_def exI + subnetOf_lemma subnetOf_lemma2 subnetOf_lemma3 subnetOf_lemma4 voip_policy_def + NetworkCore.id_def is_arq_def is_fin_def + is_connect_def is_setup_def ports_open_def subnet_of_adr_def + VOIP.NB_voip_def \_0_voip_def PLemmas VOIP_TRPolicy_def + policy2MON_def applyPolicy_def + + + + + +end diff --git a/FWNormalisation/ElementaryRules.thy b/FWNormalisation/ElementaryRules.thy new file mode 100644 index 0000000..32523f2 --- /dev/null +++ b/FWNormalisation/ElementaryRules.thy @@ -0,0 +1,76 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Elementary Firewall Policy Transformation Rules *} +theory ElementaryRules +imports FWNormalisationCore +begin + + +text{* + This theory contains those elementary transformation rules which are presented in the ICST + 2010 paper~\cite{brucker.ea:firewall:2010}. They are not used elsewhere. +*} + +lemma elem1: + "C (AllowPortFromTo x y p \ DenyAllFromTo x y) = C (DenyAllFromTo x y)" +by (rule ext, auto simp: PLemmas) + + +lemma elem2: + "C ((a \ b) \ c) = C (a \ (b \ c))" +by (simp add: C.simps) + +lemma elem3: + "C (AllowPortFromTo x y a \ AllowPortFromTo x y b) = + C (AllowPortFromTo x y b \ AllowPortFromTo x y a)" +by (rule ext, auto simp: PLemmas) + +lemma elem4: + "C (a \ DenyAll) = C DenyAll" +by (rule ext, auto simp: PLemmas) + +lemma elem5: + "C (DenyAllFromTo x y \ DenyAllFromTo u v) = C (DenyAllFromTo u v \ DenyAllFromTo x y)" +by (rule ext, auto simp: PLemmas) + + +lemma elem6: + "dom (C a) \ dom (C b) = {} \ C (a \ b) = C (b \ a)" +by (rule ext, metis C.simps(4) map_add_comm) + +end diff --git a/FWNormalisation/FWNormalisation.thy b/FWNormalisation/FWNormalisation.thy new file mode 100644 index 0000000..9ad2469 --- /dev/null +++ b/FWNormalisation/FWNormalisation.thy @@ -0,0 +1,42 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +chapter {* Firewall Policy Normalisation *} +theory FWNormalisation +imports NormalisationIPPProofs +begin + +end diff --git a/FWNormalisation/FWNormalisationCore.thy b/FWNormalisation/FWNormalisationCore.thy new file mode 100644 index 0000000..7cabc60 --- /dev/null +++ b/FWNormalisation/FWNormalisationCore.thy @@ -0,0 +1,654 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Policy Normalisation: Core Definitions *} +theory + FWNormalisationCore +imports + "../PacketFilter/PacketFilter" +begin + +text{* + This theory contains all the definitions used for policy normalisation as described + in~\cite{brucker.ea:icst:2010,brucker.ea:formal-fw-testing:2014}. + + The normalisation procedure transforms policies into semantically equivalent ones which are + ``easier'' to test. It is organized into nine phases. We impose the following two restrictions + on the input policies: + \begin{itemize} + \item Each policy must contain a $\mathtt{DenyAll}$ rule. If this restriction were to be lifted, + the $\mathtt{insertDenies}$ phase would have to be adjusted accordingly. + \item For each pair of networks $n_1$ and $n_2$, the networks are either disjoint or equal. If + this restriction were to be lifted, we would need some additional phases before the start + of the normalisation procedure presented below. This rule would split single rules into + several by splitting up the networks such that they are all pairwise disjoint or equal. + Such a transformation is clearly semantics-preserving and the condition would hold after + these phases. + \end{itemize} + As a result, the procedure generates a list of policies, in which: + \begin{itemize} + \item each element of the list contains a policy which completely specifies the blocking behavior + between two networks, and + \item there are no shadowed rules. + \end{itemize} + This result is desirable since the test case generation for rules between networks $A$ and $B$ + is independent of the rules that specify the behavior for traffic flowing between networks $C$ + and $D$. Thus, the different segments of the policy can be processed individually. The + normalization procedure does not aim to minimize the number of rules. While it does remove + unnecessary ones, it also adds new ones, enabling a policy to be split into several independent + parts. +*} + +text{* + Policy transformations are functions that map policies to policies. We decided to represent + policy transformations as \emph{syntactic rules}; this choice paves the way for expressing the + entire normalisation process inside HOL by functions manipulating abstract policy syntax. +*} + + +subsubsection{* Basics *} +text{* We define a very simple policy language: *} + +datatype ('\,'\) Combinators = + DenyAll +| DenyAllFromTo '\ '\ +| AllowPortFromTo '\ '\ '\ +| Conc "(('\,'\) Combinators)" "(('\,'\) Combinators)" (infixr "\" 80) + +text{* + And define the semantic interpretation of it. For technical reasons, we fix here the type to + policies over IntegerPort addresses. However, we could easily provide definitions for other + address types as well, using a generic consts for the type definition and a primitive recursive + definition for each desired address model. *} + +subsubsection{* Auxiliary definitions and functions. *} +text{* + This subsubsection defines several functions which are useful later for the combinators, invariants, + and proofs. +*} +fun srcNet where + "srcNet (DenyAllFromTo x y) = x" +|"srcNet (AllowPortFromTo x y p) = x" +|"srcNet DenyAll = undefined" +|"srcNet (v \ va) = undefined" + +fun destNet where + "destNet (DenyAllFromTo x y) = y" +|"destNet (AllowPortFromTo x y p) = y" +|"destNet DenyAll = undefined" +|"destNet (v \ va) = undefined" + +fun srcnets where + "srcnets DenyAll = [] " +|"srcnets (DenyAllFromTo x y) = [x] " +|"srcnets (AllowPortFromTo x y p) = [x] " +|"(srcnets (x \ y)) = (srcnets x)@(srcnets y)" + +fun destnets where + "destnets DenyAll = [] " +|"destnets (DenyAllFromTo x y) = [y] " +|"destnets (AllowPortFromTo x y p) = [y] " +|"(destnets (x \ y)) = (destnets x)@(destnets y)" + +fun (sequential) net_list_aux where + "net_list_aux [] = []" +|"net_list_aux (DenyAll#xs) = net_list_aux xs" +|"net_list_aux ((DenyAllFromTo x y)#xs) = x#y#(net_list_aux xs)" +|"net_list_aux ((AllowPortFromTo x y p)#xs) = x#y#(net_list_aux xs)" +|"net_list_aux ((x\y)#xs) = (net_list_aux [x])@(net_list_aux [y])@(net_list_aux xs)" + +fun net_list where "net_list p = remdups (net_list_aux p)" + +definition bothNets where "bothNets x = (zip (srcnets x) (destnets x))" + +fun (sequential) normBothNets where + "normBothNets ((a,b)#xs) = (if ((b,a) \ set xs) \ (a,b) \ set (xs) + then (normBothNets xs) + else (a,b)#(normBothNets xs))" +|"normBothNets x = x" + +fun makeSets where + "makeSets ((a,b)#xs) = ({a,b}#(makeSets xs))" +|"makeSets [] = []" + +fun bothNet where + "bothNet DenyAll = {}" +|"bothNet (DenyAllFromTo a b) = {a,b}" +|"bothNet (AllowPortFromTo a b p) = {a,b}" +|"bothNet (v \ va) = undefined " + +text{* + $Nets\_List$ provides from a list of rules a list where the entries are the appearing sets of + source and destination network of each rule. +*} + +definition Nets_List + where + "Nets_List x = makeSets (normBothNets (bothNets x))" + +fun (sequential) first_srcNet where + "first_srcNet (x\y) = first_srcNet x" +| "first_srcNet x = srcNet x" + +fun (sequential) first_destNet where + "first_destNet (x\y) = first_destNet x" +| "first_destNet x = destNet x" + +fun (sequential) first_bothNet where + "first_bothNet (x\y) = first_bothNet x" +|"first_bothNet x = bothNet x" + +fun (sequential) in_list where + "in_list DenyAll l = True" +|"in_list x l = (bothNet x \ set l)" + +fun all_in_list where + "all_in_list [] l = True" +|"all_in_list (x#xs) l = (in_list x l \ all_in_list xs l)" + +fun (sequential) member where + "member a (x\xs) = ((member a x) \ (member a xs))" +|"member a x = (a = x)" + +fun sdnets where + "sdnets DenyAll = {}" +| "sdnets (DenyAllFromTo a b) = {(a,b)}" +| "sdnets (AllowPortFromTo a b c) = {(a,b)}" +| "sdnets (a \ b) = sdnets a \ sdnets b" + +definition packet_Nets where "packet_Nets x a b = ((src x \ a \ dest x \ b) \ + (src x \ b \ dest x \ a))" + +definition subnetsOfAdr where "subnetsOfAdr a = {x. a \ x}" + +definition fst_set where "fst_set s = {a. \ b. (a,b) \ s}" + +definition snd_set where "snd_set s = {a. \ b. (b,a) \ s}" + +fun memberP where + "memberP r (x#xs) = (member r x \ memberP r xs)" +|"memberP r [] = False" + +fun firstList where + "firstList (x#xs) = (first_bothNet x)" +|"firstList [] = {}" + +subsubsection{* Invariants *} + +text{* If there is a DenyAll, it is at the first position *} +fun wellformed_policy1:: "(('\, '\) Combinators) list \ bool" where + "wellformed_policy1 [] = True" +| "wellformed_policy1 (x#xs) = (DenyAll \ (set xs))" + +text{* There is a DenyAll at the first position *} +fun wellformed_policy1_strong:: "(('\, '\) Combinators) list \ bool" +where + "wellformed_policy1_strong [] = False" +| "wellformed_policy1_strong (x#xs) = (x=DenyAll \ (DenyAll \ (set xs)))" + + +text{* All two networks are either disjoint or equal. *} +definition netsDistinct where "netsDistinct a b = (\ (\ x. x \ a \ x \ b))" + +definition twoNetsDistinct where + "twoNetsDistinct a b c d = (netsDistinct a c \ netsDistinct b d)" + +definition allNetsDistinct where + "allNetsDistinct p = (\ a b. (a \ b \ a \ set (net_list p) \ + b \ set (net_list p)) \ netsDistinct a b)" + +definition disjSD_2 where + "disjSD_2 x y = (\ a b c d. ((a,b)\sdnets x \ (c,d) \sdnets y \ + (twoNetsDistinct a b c d \ twoNetsDistinct a b d c)))" + +text{* The policy is given as a list of single rules. *} +fun singleCombinators where +"singleCombinators [] = True" +|"singleCombinators ((x\y)#xs) = False" +|"singleCombinators (x#xs) = singleCombinators xs" + +definition onlyTwoNets where + "onlyTwoNets x = ((\ a b. (sdnets x = {(a,b)})) \ (\ a b. sdnets x = {(a,b),(b,a)}))" + +text{* Each entry of the list contains rules between two networks only. *} +fun OnlyTwoNets where + "OnlyTwoNets (DenyAll#xs) = OnlyTwoNets xs" +|"OnlyTwoNets (x#xs) = (onlyTwoNets x \ OnlyTwoNets xs)" +|"OnlyTwoNets [] = True" + +fun noDenyAll where + "noDenyAll (x#xs) = ((\ member DenyAll x) \ noDenyAll xs)" +|"noDenyAll [] = True" + +fun noDenyAll1 where + "noDenyAll1 (DenyAll#xs) = noDenyAll xs" +| "noDenyAll1 xs = noDenyAll xs" + +fun separated where + "separated (x#xs) = ((\ s. s \ set xs \ disjSD_2 x s) \ separated xs)" +| "separated [] = True" + +fun NetsCollected where + "NetsCollected (x#xs) = (((first_bothNet x \ firstList xs) \ + (\a\set xs. first_bothNet x \ first_bothNet a)) \ NetsCollected (xs))" +| "NetsCollected [] = True" + +fun NetsCollected2 where + "NetsCollected2 (x#xs) = (xs = [] \ (first_bothNet x \ firstList xs \ + NetsCollected2 xs))" +|"NetsCollected2 [] = True" + +subsubsection{* Transformations *} + +text {* + The following two functions transform a policy into a list of single rules and vice-versa - by + staying on the combinator level. +*} + +fun policy2list::"('\, '\) Combinators \ + (('\, '\) Combinators) list" where + "policy2list (x \ y) = (concat [(policy2list x),(policy2list y)])" +|"policy2list x = [x]" + +fun list2FWpolicy::"(('\, '\) Combinators) list \ + (('\, '\) Combinators)" where + "list2FWpolicy [] = undefined " +|"list2FWpolicy (x#[]) = x" +|"list2FWpolicy (x#y) = x \ (list2FWpolicy y)" + +text{* Remove all the rules appearing before a DenyAll. There are two alternative versions. *} + +fun removeShadowRules1 where + "removeShadowRules1 (x#xs) = (if (DenyAll \ set xs) + then ((removeShadowRules1 xs)) + else x#xs)" +| "removeShadowRules1 [] = []" + +fun removeShadowRules1_alternative_rev where + "removeShadowRules1_alternative_rev [] = []" +| "removeShadowRules1_alternative_rev (DenyAll#xs) = [DenyAll]" +| "removeShadowRules1_alternative_rev [x] = [x]" +| "removeShadowRules1_alternative_rev (x#xs)= + x#(removeShadowRules1_alternative_rev xs)" + +definition removeShadowRules1_alternative where + "removeShadowRules1_alternative p = + rev (removeShadowRules1_alternative_rev (rev p))" + +text{* Remove all the rules which allow a port, but are shadowed by a deny between these subnets *} + +fun removeShadowRules2:: "(('\, '\) Combinators) list \ + (('\, '\) Combinators) list" +where + "(removeShadowRules2 ((AllowPortFromTo x y p)#z)) = + (if (((DenyAllFromTo x y) \ set z)) + then ((removeShadowRules2 z)) + else (((AllowPortFromTo x y p)#(removeShadowRules2 z))))" +| "removeShadowRules2 (x#y) = x#(removeShadowRules2 y)" +| "removeShadowRules2 [] = []" + +text{* Sorting a pocliy. We first need to define an ordering on +rules. This ordering depends on the $Nets\_List$ of a policy. *} + +fun smaller :: "('\, '\) Combinators \ + ('\, '\) Combinators \ + (('\) set) list \ bool" +where + "smaller DenyAll x l = True" +| "smaller x DenyAll l = False" +| "smaller x y l = + ((x = y) \ (if (bothNet x) = (bothNet y) then + (case y of (DenyAllFromTo a b) \ (x = DenyAllFromTo b a) + | _ \ True) + else + (position (bothNet x) l <= position (bothNet y) l)))" + +text{* We provide two different sorting algorithms: Quick Sort (qsort) and Insertion Sort (sort) *} + +fun qsort where + "qsort [] l = []" +| "qsort (x#xs) l = (qsort [y\xs. \ (smaller x y l)] l) @ [x] @ (qsort [y\xs. smaller x y l] l)" + +lemma qsort_permutes: + "set (qsort xs l) = set xs" + apply (induct xs l rule: qsort.induct) + apply (simp_all) + apply auto + done + +lemma set_qsort [simp]: "set (qsort xs l) = set xs" + apply (induct xs l rule: qsort.induct) + apply (simp_all) + apply auto + done + +fun insort where + "insort a [] l = [a]" + | "insort a (x#xs) l = (if (smaller a x l) then a#x#xs else x#(insort a xs l))" + +fun sort where + "sort [] l = []" +| "sort (x#xs) l = insort x (sort xs l) l" + + + +fun sorted where +"sorted [] l \ True" | +"sorted [x] l \ True" | +"sorted (x#y#zs) l \ smaller x y l \ sorted (y#zs) l" + +fun separate where + "separate (DenyAll#x) = DenyAll#(separate x)" +| "separate (x#y#z) = (if (first_bothNet x = first_bothNet y) + then (separate ((x\y)#z)) + else (x#(separate(y#z))))" +|"separate x = x" + +text {* +Insert the DenyAllFromTo rules, such that traffic between two networks can be tested individually +*} + +fun insertDenies where + "insertDenies (x#xs) = (case x of DenyAll \ (DenyAll#(insertDenies xs)) + | _ \ (DenyAllFromTo (first_srcNet x) (first_destNet x) \ + (DenyAllFromTo (first_destNet x) (first_srcNet x)) \ x)# + (insertDenies xs))" +| "insertDenies [] = []" + +text{* Remove duplicate rules. This is especially necessary as +insertDenies might have inserted duplicate rules. + +The second function is supposed to work on a list of policies. Only +rules which are duplicated within the same policy are removed. *} + + +fun removeDuplicates where + "removeDuplicates (x\xs) = (if member x xs then (removeDuplicates xs) + else x\(removeDuplicates xs))" +| "removeDuplicates x = x" + +fun removeAllDuplicates where + "removeAllDuplicates (x#xs) = ((removeDuplicates (x))#(removeAllDuplicates xs))" +|"removeAllDuplicates x = x" + +text {* Insert a DenyAll at the beginning of a policy. *} +fun insertDeny where + "insertDeny (DenyAll#xs) = DenyAll#xs" +|"insertDeny xs = DenyAll#xs" + + +definition "sort' p l = sort l p" + +definition "qsort' p l = qsort l p" + + +declare dom_eq_empty_conv [simp del] + +fun list2policyR::"(('\, '\) Combinators) list \ + (('\, '\) Combinators)" where + "list2policyR (x#[]) = x" +|"list2policyR (x#y) = (list2policyR y) \ x" +|"list2policyR [] = undefined " + + +text{* We provide the definitions for two address representations. *} + + +subsubsection{* IntPort *} + +fun C :: "(adr\<^sub>i\<^sub>p net, port) Combinators \ (adr\<^sub>i\<^sub>p,DummyContent) packet \ unit" +where +" C DenyAll = deny_all" +|"C (DenyAllFromTo x y) = deny_all_from_to x y" +|"C (AllowPortFromTo x y p) = allow_from_to_port p x y" +|"C (x \ y) = C x ++ C y" + + + + +fun CRotate :: "(adr\<^sub>i\<^sub>p net, port) Combinators \ (adr\<^sub>i\<^sub>p,DummyContent) packet \ unit" +where +" CRotate DenyAll = C DenyAll" +|"CRotate (DenyAllFromTo x y) = C (DenyAllFromTo x y)" +|"CRotate (AllowPortFromTo x y p) = C (AllowPortFromTo x y p)" +|"CRotate (x \ y) = ((CRotate y) ++ ((CRotate x)))" + + +fun rotatePolicy where + "rotatePolicy DenyAll = DenyAll" +| "rotatePolicy (DenyAllFromTo a b) = DenyAllFromTo a b" +| "rotatePolicy (AllowPortFromTo a b p) = AllowPortFromTo a b p" +| "rotatePolicy (a\b) = (rotatePolicy b) \ (rotatePolicy a)" + + +lemma check: "rev (policy2list (rotatePolicy p)) = policy2list p" +apply (induct p) +apply simp +apply simp_all +done + + + +text{* + All rules appearing at the left of a DenyAllFromTo, have disjunct domains from it (except DenyAll) +*} +fun (sequential) wellformed_policy2 where + "wellformed_policy2 [] = True" +| "wellformed_policy2 (DenyAll#xs) = wellformed_policy2 xs" +| "wellformed_policy2 (x#xs) = ((\ c a b. c = DenyAllFromTo a b \ c \ set xs \ + Map.dom (C x) \ Map.dom (C c) = {}) \ wellformed_policy2 xs)" + +text{* An allow rule is disjunct with all rules appearing at the right of it. This invariant is not + necessary as it is a consequence from others, but facilitates some proofs. *} + +fun (sequential) wellformed_policy3::"((adr\<^sub>i\<^sub>p net,port) Combinators) list \ bool" where + "wellformed_policy3 [] = True" +| "wellformed_policy3 ((AllowPortFromTo a b p)#xs) = ((\ r. r \ set xs \ + dom (C r) \ dom (C (AllowPortFromTo a b p)) = {}) \ wellformed_policy3 xs)" +| "wellformed_policy3 (x#xs) = wellformed_policy3 xs" + + +definition + "normalize' p = (removeAllDuplicates o insertDenies o separate o + (sort' (Nets_List p)) o removeShadowRules2 o remdups o + (rm_MT_rules C) o insertDeny o removeShadowRules1 o + policy2list) p" + +definition + "normalizeQ' p = (removeAllDuplicates o insertDenies o separate o + (qsort' (Nets_List p)) o removeShadowRules2 o remdups o + (rm_MT_rules C) o insertDeny o removeShadowRules1 o + policy2list) p" + + +definition normalize :: + "(adr\<^sub>i\<^sub>p net, port) Combinators \ + (adr\<^sub>i\<^sub>p net, port) Combinators list" +where + "normalize p = (removeAllDuplicates (insertDenies (separate (sort + (removeShadowRules2 (remdups ((rm_MT_rules C) (insertDeny + (removeShadowRules1 (policy2list p)))))) ((Nets_List p))))))" + +definition + "normalize_manual_order p l = removeAllDuplicates (insertDenies (separate + (sort (removeShadowRules2 (remdups ((rm_MT_rules C) (insertDeny + (removeShadowRules1 (policy2list p)))))) ((l)))))" + + + + +definition normalizeQ :: + "(adr\<^sub>i\<^sub>p net, port) Combinators \ + (adr\<^sub>i\<^sub>p net, port) Combinators list" +where + "normalizeQ p = (removeAllDuplicates (insertDenies (separate (qsort + (removeShadowRules2 (remdups ((rm_MT_rules C) (insertDeny + (removeShadowRules1 (policy2list p)))))) ((Nets_List p))))))" + +definition + "normalize_manual_orderQ p l = removeAllDuplicates (insertDenies (separate + (qsort (removeShadowRules2 (remdups ((rm_MT_rules C) (insertDeny + (removeShadowRules1 (policy2list p)))))) ((l)))))" + +text{* Of course, normalize is equal to normalize', the latter looks nicer though. *} +lemma "normalize = normalize'" +by (rule ext, simp add: normalize_def normalize'_def sort'_def) + + + +declare C.simps [simp del] + + +subsubsection{* TCP\_UDP\_IntegerPort *} + +fun Cp :: "(adr\<^sub>i\<^sub>p\<^sub>p net, protocol \ port) Combinators \ + (adr\<^sub>i\<^sub>p\<^sub>p,DummyContent) packet \ unit" +where + " Cp DenyAll = deny_all" +|"Cp (DenyAllFromTo x y) = deny_all_from_to x y" +|"Cp (AllowPortFromTo x y p) = allow_from_to_port_prot (fst p) (snd p) x y" +|"Cp (x \ y) = Cp x ++ Cp y" + + +fun Dp :: "(adr\<^sub>i\<^sub>p\<^sub>p net, protocol \ port) Combinators \ + (adr\<^sub>i\<^sub>p\<^sub>p,DummyContent) packet \ unit" +where +" Dp DenyAll = Cp DenyAll" +|"Dp (DenyAllFromTo x y) = Cp (DenyAllFromTo x y)" +|"Dp (AllowPortFromTo x y p) = Cp (AllowPortFromTo x y p)" +|"Dp (x \ y) = Cp (y \ x)" + + + + +text{* All rules appearing at the left of a DenyAllFromTo, have disjunct domains from it + (except DenyAll) *} +fun (sequential) wellformed_policy2Pr where + "wellformed_policy2Pr [] = True" +| "wellformed_policy2Pr (DenyAll#xs) = wellformed_policy2Pr xs" +| "wellformed_policy2Pr (x#xs) = ((\ c a b. c = DenyAllFromTo a b \ c \ set xs \ + Map.dom (Cp x) \ Map.dom (Cp c) = {}) \ wellformed_policy2Pr xs)" + +text{* An allow rule is disjunct with all rules appearing at the right of it. This invariant is not + necessary as it is a consequence from others, but facilitates some proofs. *} + +fun (sequential) wellformed_policy3Pr::"((adr\<^sub>i\<^sub>p\<^sub>p net, protocol \ port) Combinators) list \ bool" where + "wellformed_policy3Pr [] = True" +| "wellformed_policy3Pr ((AllowPortFromTo a b p)#xs) = ((\ r. r \ set xs \ + dom (Cp r) \ dom (Cp (AllowPortFromTo a b p)) = {}) \ wellformed_policy3Pr xs)" +| "wellformed_policy3Pr (x#xs) = wellformed_policy3Pr xs" + + + + +definition + normalizePr' :: "(adr\<^sub>i\<^sub>p\<^sub>p net, protocol \ port) Combinators + \ (adr\<^sub>i\<^sub>p\<^sub>p net, protocol \ port) Combinators list" where + "normalizePr' p = (removeAllDuplicates o insertDenies o separate o + (sort' (Nets_List p)) o removeShadowRules2 o remdups o + (rm_MT_rules Cp) o insertDeny o removeShadowRules1 o + policy2list) p" + + +definition normalizePr :: +"(adr\<^sub>i\<^sub>p\<^sub>p net, protocol \ port) Combinators + \ (adr\<^sub>i\<^sub>p\<^sub>p net, protocol \ port) Combinators list" where + "normalizePr p = (removeAllDuplicates (insertDenies (separate (sort + (removeShadowRules2 (remdups ((rm_MT_rules Cp) (insertDeny + (removeShadowRules1 (policy2list p)))))) ((Nets_List p))))))" + +definition + "normalize_manual_orderPr p l = removeAllDuplicates (insertDenies (separate + (sort (removeShadowRules2 (remdups ((rm_MT_rules Cp) (insertDeny + (removeShadowRules1 (policy2list p)))))) ((l)))))" + + +definition + normalizePrQ' :: "(adr\<^sub>i\<^sub>p\<^sub>p net, protocol \ port) Combinators + \ (adr\<^sub>i\<^sub>p\<^sub>p net, protocol \ port) Combinators list" where + "normalizePrQ' p = (removeAllDuplicates o insertDenies o separate o + (qsort' (Nets_List p)) o removeShadowRules2 o remdups o + (rm_MT_rules Cp) o insertDeny o removeShadowRules1 o + policy2list) p" + + +definition normalizePrQ :: +"(adr\<^sub>i\<^sub>p\<^sub>p net, protocol \ port) Combinators + \ (adr\<^sub>i\<^sub>p\<^sub>p net, protocol \ port) Combinators list" where + "normalizePrQ p = (removeAllDuplicates (insertDenies (separate (qsort + (removeShadowRules2 (remdups ((rm_MT_rules Cp) (insertDeny + (removeShadowRules1 (policy2list p)))))) ((Nets_List p))))))" + +definition + "normalize_manual_orderPrQ p l = removeAllDuplicates (insertDenies (separate + (qsort (removeShadowRules2 (remdups ((rm_MT_rules Cp) (insertDeny + (removeShadowRules1 (policy2list p)))))) ((l)))))" + + +text{* Of course, normalize is equal to normalize', the latter looks nicer though. *} +lemma "normalizePr = normalizePr'" +by (rule ext, simp add: normalizePr_def normalizePr'_def sort'_def) + + +text{* The following definition helps in creating the test specification for the individual parts + of a normalized policy. *} +definition makeFUTPr where + "makeFUTPr FUT p x n = + (packet_Nets x (fst (normBothNets (bothNets p)!n)) + (snd(normBothNets (bothNets p)!n)) \ + FUT x = Cp ((normalizePr p)!Suc n) x)" + + +declare Cp.simps [simp del] + + +lemmas PLemmas = C.simps Cp.simps dom_def PolicyCombinators.PolicyCombinators + PortCombinators.PortCombinatorsCore aux + ProtocolPortCombinators.ProtocolCombinatorsCore src_def dest_def in_subnet_def + adr\<^sub>i\<^sub>p\<^sub>pLemmas adr\<^sub>i\<^sub>p\<^sub>pLemmas + + +lemma aux: "\x \ a; y\b; (x \ y \ x \ b) \ (a \ b \ a \ y)\ \ {x,a} \ {y,b}" + by (auto) + + + +lemma aux2: "{a,b} = {b,a}" + by auto + + +end diff --git a/FWNormalisation/NormalisationGenericProofs.thy b/FWNormalisation/NormalisationGenericProofs.thy new file mode 100644 index 0000000..3d01156 --- /dev/null +++ b/FWNormalisation/NormalisationGenericProofs.thy @@ -0,0 +1,2397 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection{* Normalisation Proofs (Generic) *} +theory NormalisationGenericProofs + imports + FWNormalisationCore +begin + +text {* This theory contains the generic proofs of the normalisation +procedure, i.e. those which are independent from the concrete +semantical interpretation function. *} + + +lemma domNMT: "dom X \ {} \ X \ \" + apply auto + done + +lemma denyNMT: "deny_all \ \" + apply (rule domNMT) + apply (simp add: deny_all_def dom_def) + done + + +lemma wellformed_policy1_charn[rule_format] : "wellformed_policy1 p \ +DenyAll \ set p \ (\ p'. p = DenyAll # p' \ DenyAll \ set p')" + by(induct p,simp_all) + + +lemma singleCombinatorsConc: "singleCombinators (x#xs) \ singleCombinators xs" + by (case_tac x,simp_all) + +lemma aux0_0: "singleCombinators x \ \ (\ a b. (a\b) \ set x)" + apply (induct x, simp_all) + apply (rule allI)+ + by (case_tac a,simp_all) + + +lemma aux0_4: "(a \ set x \ a \ set y) = (a \ set (x@y))" + by auto + +lemma aux0_1: "\singleCombinators xs; singleCombinators [x]\ \ + singleCombinators (x#xs)" + by (case_tac x,simp_all) + + +lemma aux0_6: "\singleCombinators xs; \ (\ a b. x = a \ b)\ \ + singleCombinators(x#xs)" + apply (rule aux0_1,simp_all) + apply (case_tac x,simp_all) + apply auto + done + +lemma aux0_5: " \ (\ a b. (a\b) \ set x) \ singleCombinators x" + apply (induct x) + apply simp_all + by (metis aux0_6) + + + +lemma ANDConc[rule_format]: "allNetsDistinct (a#p) \ allNetsDistinct (p)" + apply (simp add: allNetsDistinct_def) + apply (case_tac "a") + by simp_all + + +lemma aux6: "twoNetsDistinct a1 a2 a b \ + dom (deny_all_from_to a1 a2) \ dom (deny_all_from_to a b) = {}" + by (auto simp: twoNetsDistinct_def netsDistinct_def src_def dest_def + in_subnet_def PolicyCombinators.PolicyCombinators dom_def) + +lemma aux5[rule_format]: "(DenyAllFromTo a b) \ set p \ a \ set (net_list p)" + by (rule net_list_aux.induct,simp_all) + + +lemma aux5a[rule_format]: "(DenyAllFromTo b a) \ set p \ a \ set (net_list p)" + by (rule net_list_aux.induct,simp_all) + +lemma aux5c[rule_format]: + "(AllowPortFromTo a b po) \ set p \ a \ set (net_list p)" + by (rule net_list_aux.induct,simp_all) + +lemma aux5d[rule_format]: + "(AllowPortFromTo b a po) \ set p \ a \ set (net_list p)" + by (rule net_list_aux.induct,simp_all) + +lemma aux10[rule_format]: "a \ set (net_list p) \ a \ set (net_list_aux p)" + by simp + + +lemma srcInNetListaux[simp]: "\x \ set p; singleCombinators[x]; x \ DenyAll\ \ + srcNet x \ set (net_list_aux p)" + apply (induct p) + apply simp_all + apply (case_tac "x = a", simp_all) + apply (case_tac a, simp_all)+ + done + + +lemma destInNetListaux[simp]: "\x \ set p; singleCombinators[x]; x \ DenyAll\ \ + destNet x \ set (net_list_aux p)" + apply (induct p) + apply simp_all + apply (case_tac "x = a", simp_all) + apply (case_tac a, simp_all)+ + done + + +lemma tND1: "\allNetsDistinct p; x \ set p; y \ set p; a = srcNet x; + b = destNet x; c = srcNet y; d = destNet y; a \ c; + singleCombinators[x]; x \ DenyAll; singleCombinators[y]; + y \ DenyAll\ \ twoNetsDistinct a b c d" + by (simp add: allNetsDistinct_def twoNetsDistinct_def) + +lemma tND2: "\allNetsDistinct p; x \ set p; y \ set p; a = srcNet x; + b = destNet x; c = srcNet y; d = destNet y; b \ d; + singleCombinators[x]; x \ DenyAll; singleCombinators[y]; + y \ DenyAll\ \ twoNetsDistinct a b c d" + by (simp add: allNetsDistinct_def twoNetsDistinct_def) + +lemma tND: "\allNetsDistinct p; x \ set p; y \ set p; a = srcNet x; + b = destNet x; c = srcNet y; d = destNet y; a \ c \ b \ d; + singleCombinators[x]; x \ DenyAll; singleCombinators[y]; y \ DenyAll\ + \ twoNetsDistinct a b c d" + apply (case_tac "a \ c", simp_all) + apply (erule_tac x = x and y =y in tND1, simp_all) + apply (erule_tac x = x and y =y in tND2, simp_all) + done + +lemma aux7: "\DenyAllFromTo a b \ set p; allNetsDistinct ((DenyAllFromTo c d)#p); + a\ c\ b\ d\ \ twoNetsDistinct a b c d" + apply (erule_tac x = "DenyAllFromTo a b" and y = "DenyAllFromTo c d" in tND) + by simp_all + +lemma aux7a: "\DenyAllFromTo a b \ set p; + allNetsDistinct ((AllowPortFromTo c d po)#p); a \ c\ b \ d\ \ + twoNetsDistinct a b c d" + apply (erule_tac x = "DenyAllFromTo a b" and + y = "AllowPortFromTo c d po" in tND) + by simp_all + +lemma nDComm: assumes ab: "netsDistinct a b" shows ba: "netsDistinct b a" + apply (insert ab) + by (auto simp: netsDistinct_def in_subnet_def) + +lemma tNDComm: + assumes abcd: "twoNetsDistinct a b c d" shows "twoNetsDistinct c d a b" + apply (insert abcd) + by (metis twoNetsDistinct_def nDComm) + +lemma aux[rule_format]: "a \ set (removeShadowRules2 p) \ a \ set p" + apply (case_tac a) + by (rule removeShadowRules2.induct, simp_all)+ + +lemma aux12: "\a \ x; b \ x\ \ a \ b" + by auto + + + +lemma ND0aux1[rule_format]: "DenyAllFromTo x y \ set b \ + x \ set (net_list_aux b)" + by (metis aux5 net_list.simps set_remdups) + +lemma ND0aux2[rule_format]: "DenyAllFromTo x y \ set b \ + y \ set (net_list_aux b)" + by (metis aux5a net_list.simps set_remdups) + +lemma ND0aux3[rule_format]: "AllowPortFromTo x y p \ set b \ + x \ set (net_list_aux b)" + by (metis aux5c net_list.simps set_remdups) + +lemma ND0aux4[rule_format]: "AllowPortFromTo x y p \ set b \ + y \ set (net_list_aux b)" + by (metis aux5d net_list.simps set_remdups) + +lemma aNDSubsetaux[rule_format]: "singleCombinators a \ set a \ set b \ + set (net_list_aux a) \ set (net_list_aux b)" + apply (induct a) + apply simp_all + apply clarify + apply (drule mp, erule singleCombinatorsConc) + apply (case_tac "a1") + apply (simp_all add: contra_subsetD) + apply (metis contra_subsetD) + apply (metis ND0aux1 ND0aux2 contra_subsetD) + apply (metis ND0aux3 ND0aux4 contra_subsetD) + done + +lemma aNDSetsEqaux[rule_format]: "singleCombinators a \ singleCombinators b \ + set a = set b \ set (net_list_aux a) = set (net_list_aux b)" + apply (rule impI)+ + apply (rule equalityI) + apply (rule aNDSubsetaux, simp_all)+ + done + +lemma aNDSubset: "\singleCombinators a;set a \ set b; allNetsDistinct b\ \ + allNetsDistinct a" + apply (simp add: allNetsDistinct_def) + apply (rule allI)+ + apply (rule impI)+ + apply (drule_tac x = "aa" in spec, drule_tac x = "ba" in spec) + apply (metis subsetD aNDSubsetaux) + done + +lemma aNDSetsEq: "\singleCombinators a; singleCombinators b; set a = set b; + allNetsDistinct b\ \ allNetsDistinct a" + apply (simp add: allNetsDistinct_def) + apply (rule allI)+ + apply (rule impI)+ + apply (drule_tac x = "aa" in spec, drule_tac x = "ba" in spec) + apply (metis aNDSetsEqaux ) + done + +lemma SCConca: "\singleCombinators p; singleCombinators [a]\ \ + singleCombinators (a#p)" + by (case_tac "a",simp_all) + +lemma aux3[simp]: "\singleCombinators p; singleCombinators [a]; + allNetsDistinct (a#p)\ \ allNetsDistinct (a#a#p)" + apply (insert aNDSubset[of "(a#a#p)" "(a#p)"]) + by (simp add: SCConca) + + + + + +lemma wp1_aux1a[rule_format]: "xs \ [] \ wellformed_policy1_strong (xs @ [x]) \ + wellformed_policy1_strong xs" + by (induct xs,simp_all) + +lemma wp1alternative_RS1[rule_format]: "DenyAll \ set p \ + wellformed_policy1_strong (removeShadowRules1 p)" + by (induct p,simp_all) + +lemma wellformed_eq: "DenyAll \ set p \ + ((wellformed_policy1 p) = (wellformed_policy1_strong p))" + by (induct p,simp_all) + +lemma set_insort: "set(insort x xs l) = insert x (set xs)" + by (induct xs) auto + +lemma set_sort[simp]: "set(sort xs l) = set xs" + by (induct xs) (simp_all add:set_insort) + + +lemma set_sortQ: "set(qsort xs l) = set xs" + by simp + +lemma aux79[rule_format]: "y \ set (insort x a l) \ y \ x \ y \ set a" + apply (induct a) + by auto + +lemma aux80: "\y \ set p; y \ x\ \ y \ set (insort x (sort p l) l)" + apply (metis aux79 set_sort) + done + + +lemma WP1Conca: "DenyAll \ set p \ wellformed_policy1 (a#p)" + by (case_tac a,simp_all) + + +lemma saux[simp]: "(insort DenyAll p l) = DenyAll#p" + by (induct_tac p,simp_all) + +lemma saux3[rule_format]: "DenyAllFromTo a b \ set list \ + DenyAllFromTo c d \ set list \ (a \ c) \ (b \ d)" + by blast + +lemma waux2[rule_format]: " (DenyAll \ set xs) \ wellformed_policy1 xs" + by (induct_tac xs,simp_all) + +lemma waux3[rule_format]: "\x \ a; x \ set p\ \ x \ set (insort a p l)" + by (metis aux79) + +lemma wellformed1_sorted_aux[rule_format]: "wellformed_policy1 (x#p) \ + wellformed_policy1 (insort x p l)" + apply (case_tac x,simp_all) + by (rule waux2,rule waux3, simp_all)+ + + +lemma wellformed1_sorted_auxQ[rule_format]: "wellformed_policy1 (p) \ + wellformed_policy1 (qsort p l)" +proof (induct p) + case Nil show ?case by simp +next + case (Cons a S) then show ?case + apply simp_all + apply (cases a,simp_all) + by (metis Combinators.simps append_Cons append_Nil qsort.simps(2) set_ConsD set_qsort waux2)+ + qed + + + + +lemma SR1Subset: "set (removeShadowRules1 p) \ set p" + apply (induct_tac p, simp_all) + apply (case_tac a, simp_all) + by auto + +lemma SCSubset[rule_format]: " singleCombinators b \ set a \ set b \ + singleCombinators a" +proof (induct a) + case Nil thus ?case by simp +next + case (Cons x xs) thus ?case + by (meson aux0_0 aux0_5 subsetCE) +qed + +lemma setInsert[simp]: "set list \ insert a (set list)" + by auto + +lemma SC_RS1[rule_format,simp]: "singleCombinators p \ allNetsDistinct p \ + singleCombinators (removeShadowRules1 p)" + apply (induct_tac p) + apply simp_all + using ANDConc singleCombinatorsConc by blast + +lemma RS2Set[rule_format]: "set (removeShadowRules2 p) \ set p" + by (induct p, simp_all) (case_tac a, auto) + + +lemma WP1: "a \ set list \ a \ set (removeShadowRules2 list)" + using RS2Set [of list] by blast + + +lemma denyAllDom[simp]: "x \ dom (deny_all)" + by (simp add: UPFDefs(24) domI) + +lemma lCdom2: "(list2FWpolicy (a @ (b @ c))) = (list2FWpolicy ((a@b)@c))" + by auto + + +lemma SCConcEnd: "singleCombinators (xs @ [xa]) \ singleCombinators xs" + by (induct "xs", simp_all, case_tac a, simp_all) + +lemma list2FWpolicyconc[rule_format]: "a \ [] \ + (list2FWpolicy (xa # a)) = (xa) \ (list2FWpolicy a)" + by (induct a,simp_all) + + +lemma wp1n_tl [rule_format]: "wellformed_policy1_strong p \ + p = (DenyAll#(tl p))" + by (induct p, simp_all) + +lemma foo2: "a \ set ps \ + a \ set ss \ + set p = set s \ + p = (a#(ps)) \ + s = (a#ss) \ + set (ps) = set (ss)" + by auto + + +lemma SCnotConc[rule_format,simp]: "a\b \ set p \ singleCombinators p \False" + by (induct p, simp_all, case_tac aa, simp_all) + +lemma auxx8: "removeShadowRules1_alternative_rev [x] = [x]" + by (case_tac "x", simp_all) + +lemma RS1End[rule_format]: "x \ DenyAll \ removeShadowRules1 (xs @ [x]) = + (removeShadowRules1 xs)@[x]" + by (induct_tac xs, simp_all) + +lemma aux114: "x \ DenyAll \ removeShadowRules1_alternative_rev (x#xs) = + x#(removeShadowRules1_alternative_rev xs)" + apply (induct_tac xs) + apply (auto simp: auxx8) + by (case_tac "x", simp_all) + +lemma aux115[rule_format]: "x \ DenyAll\removeShadowRules1_alternative (xs@[x]) + = (removeShadowRules1_alternative xs)@[x]" + apply (simp add: removeShadowRules1_alternative_def aux114) + done + +lemma RS1_DA[simp]: "removeShadowRules1 (xs @ [DenyAll]) = [DenyAll]" + by (induct_tac xs, simp_all) + +lemma rSR1_eq: "removeShadowRules1_alternative = removeShadowRules1" + apply (rule ext) + apply (simp add: removeShadowRules1_alternative_def) + apply (rule_tac xs = x in rev_induct) + apply simp_all + apply (case_tac "xa = DenyAll", simp_all) + apply (metis RS1End aux114 rev.simps(2)) + done + +lemma domInterMT[rule_format]: "\dom a \ dom b = {}; x \ dom a\ \ x \ dom b" + by auto + +lemma domComm: "dom a \ dom b = dom b \ dom a" + by auto + + +lemma r_not_DA_in_tl[rule_format]: + "wellformed_policy1_strong p \ a \ set p\ a \ DenyAll \ a \ set (tl p)" + by (induct p,simp_all) + +lemma wp1_aux1aa[rule_format]: "wellformed_policy1_strong p \ DenyAll \ set p" + by (induct p,simp_all) + +lemma mauxa: "(\ r. a b = \r\) = (a b \ \)" + by auto + +lemma l2p_aux[rule_format]: "list \ [] \ + list2FWpolicy (a # list) = a \(list2FWpolicy list)" + by (induct "list", simp_all) + +lemma l2p_aux2[rule_format]: "list = [] \ list2FWpolicy (a # list) = a" + by simp + + + +lemma aux7aa: + assumes 1 : "AllowPortFromTo a b poo \ set p" + and 2 : "allNetsDistinct ((AllowPortFromTo c d po) # p)" + and 3 : "a \ c \ b \ d" + shows "twoNetsDistinct a b c d" (is "?H") +proof(cases "a \ c") print_cases + case True assume *:"a \ c" show ?H + by (meson "1" "2" True allNetsDistinct_def aux5c list.set_intros(1) + list.set_intros(2) twoNetsDistinct_def) +next + case False assume *:"\(a \ c)" show "twoNetsDistinct a b c d" + by (meson "1" "2" "3" False allNetsDistinct_def aux5d list.set_intros(1) + list.set_intros(2) twoNetsDistinct_def) +qed + + +lemma ANDConcEnd: "\ allNetsDistinct (xs @ [xa]); singleCombinators xs\ \ + allNetsDistinct xs" + by (rule aNDSubset) auto + +lemma WP1ConcEnd[rule_format]: + "wellformed_policy1 (xs@[xa]) \ wellformed_policy1 xs" + by (induct xs, simp_all) + +lemma NDComm: "netsDistinct a b = netsDistinct b a" + by (auto simp: netsDistinct_def in_subnet_def) + + +lemma wellformed1_sorted[simp]: + assumes wp1: "wellformed_policy1 p" + shows "wellformed_policy1 (sort p l)" +proof (cases p) + case Nil thus ?thesis by simp +next + case (Cons x xs) thus ?thesis + proof (cases "x = DenyAll") + case True thus ?thesis using assms Cons by simp + next + case False thus ?thesis using assms + by (metis Cons set_sort False waux2 wellformed_eq + wellformed_policy1_strong.simps(2)) + qed +qed + + +lemma wellformed1_sortedQ[simp]: + assumes wp1: "wellformed_policy1 p" + shows "wellformed_policy1 (qsort p l)" +proof (cases p) + case Nil thus ?thesis by simp +next + case (Cons x xs) thus ?thesis + proof (cases "x = DenyAll") + case True thus ?thesis using assms Cons by simp + next + case False thus ?thesis using assms + by (metis Cons set_qsort False waux2 wellformed_eq + wellformed_policy1_strong.simps(2)) + qed +qed + + + + +lemma SC1[simp]: "singleCombinators p \singleCombinators (removeShadowRules1 p)" + by (erule SCSubset) (rule SR1Subset) + +lemma SC2[simp]: "singleCombinators p \singleCombinators (removeShadowRules2 p)" + by (erule SCSubset) (rule RS2Set) + + +lemma SC3[simp]: "singleCombinators p \ singleCombinators (sort p l)" + by (erule SCSubset) simp + + + +lemma SC3Q[simp]: "singleCombinators p \ singleCombinators (qsort p l)" + by (erule SCSubset) simp + +lemma aND_RS1[simp]: "\singleCombinators p; allNetsDistinct p\ \ + allNetsDistinct (removeShadowRules1 p)" + apply (rule aNDSubset) + apply (erule SC_RS1, simp_all) + apply (rule SR1Subset) + done + +lemma aND_RS2[simp]: "\singleCombinators p; allNetsDistinct p\ \ + allNetsDistinct (removeShadowRules2 p)" + apply (rule aNDSubset) + apply (erule SC2, simp_all) + apply (rule RS2Set) + done + +lemma aND_sort[simp]: "\singleCombinators p; allNetsDistinct p\ \ + allNetsDistinct (sort p l)" + apply (rule aNDSubset) + by (erule SC3, simp_all) + + + +lemma aND_sortQ[simp]: "\singleCombinators p; allNetsDistinct p\ \ + allNetsDistinct (qsort p l)" + apply (rule aNDSubset) + by (erule SC3Q, simp_all) + + + +lemma inRS2[rule_format,simp]: "x \ set p \ x \ set (removeShadowRules2 p)" + apply (insert RS2Set [of p]) + by blast + +lemma distinct_RS2[rule_format,simp]: "distinct p \ + distinct (removeShadowRules2 p)" + apply (induct p) + apply simp_all + apply clarify + apply (case_tac "a") + by auto + +lemma setPaireq: " {x, y} = {a, b} \ x = a \ y = b \ x = b \ y = a" + by (metis doubleton_eq_iff) + +lemma position_positive[rule_format]: "a \ set l \ position a l > 0" + by (induct l, simp_all) + +lemma pos_noteq[rule_format]: + "a \ set l \ b \ set l \ c \ set l \ + a \ b \ position a l \ position b l \ position b l \ position c l \ + a \ c" +proof(induct l) + case Nil show ?case by simp +next + case (Cons a R) show ?case + by (metis (no_types, lifting) Cons.hyps One_nat_def Suc_le_mono le_antisym + length_greater_0_conv list.size(3) nat.inject position.simps(2) + position_positive set_ConsD) +qed + +lemma setPair_noteq: "{a,b} \ {c,d} \ \ ((a = c) \ (b = d))" + by auto + +lemma setPair_noteq_allow: "{a,b} \ {c,d} \ \ ((a = c) \ (b = d) \ P)" + by auto + +lemma order_trans: + "\in_list x l; in_list y l; in_list z l; singleCombinators [x]; + singleCombinators [y]; singleCombinators [z]; smaller x y l; smaller y z l\ \ + smaller x z l" + apply (case_tac x, simp_all) + apply (case_tac z, simp_all) + apply (case_tac y, simp_all) + apply (case_tac y, simp_all) + apply (rule conjI|rule impI)+ + apply (simp add: setPaireq) + apply (rule conjI|rule impI)+ + apply (simp_all split: if_splits) + apply metis+ + apply auto[1] + apply (simp add: setPaireq) + apply (rule impI,case_tac y, simp_all) + apply (simp_all split: if_splits, metis,simp_all add: setPair_noteq setPair_noteq_allow) + apply (case_tac z, simp_all) + apply (case_tac y, simp_all) + apply (case_tac y, simp_all) + apply (intro impI|rule conjI)+ + apply (simp_all split: if_splits) + apply (simp add: setPair_noteq) + apply (erule pos_noteq, simp_all) + apply auto[1] + apply (rule conjI,simp add: setPair_noteq_allow) + apply (erule pos_noteq, simp_all) + apply auto[1] + apply (rule impI,rule disjI2) + apply (case_tac y, simp_all split: if_splits ) + apply metis + apply (simp_all add: setPair_noteq_allow) + done + +lemma sortedConcStart[rule_format]: + "sorted (a # aa # p) l \ in_list a l \ in_list aa l \ all_in_list p l\ + singleCombinators [a] \ singleCombinators [aa] \ singleCombinators p \ + sorted (a#p) l" + apply (induct p) + apply simp_all + apply (rule impI)+ + apply simp + apply (rule_tac y = "aa" in order_trans) + apply simp_all + apply (case_tac ab, simp_all) + done + +lemma singleCombinatorsStart[simp]: "singleCombinators (x#xs) \ + singleCombinators [x]" + by (case_tac x, simp_all) + + +lemma sorted_is_smaller[rule_format]: + "sorted (a # p) l \ in_list a l \ in_list b l \ all_in_list p l \ + singleCombinators [a] \ singleCombinators p \ b \ set p \ smaller a b l" + apply (induct p) + apply (auto intro: singleCombinatorsConc sortedConcStart) + done + +lemma sortedConcEnd[rule_format]: "sorted (a # p) l \ in_list a l \ + all_in_list p l \ singleCombinators [a] \ + singleCombinators p \ sorted p l" + apply (induct p) + apply (auto intro: singleCombinatorsConc sortedConcStart) + done + +lemma in_set_in_list[rule_format]: "a \ set p \ all_in_list p l\ in_list a l" + by (induct p) auto + +lemma sorted_Consb[rule_format]: + "all_in_list (x#xs) l \ singleCombinators (x#xs) \ + (sorted xs l & (ALL y:set xs. smaller x y l)) \ (sorted (x#xs) l) " + apply(induct xs arbitrary: x) + apply (auto simp: order_trans) + done + +lemma sorted_Cons: "\all_in_list (x#xs) l; singleCombinators (x#xs)\ \ + (sorted xs l & (ALL y:set xs. smaller x y l)) = (sorted (x#xs) l)" + apply auto + apply (rule sorted_Consb, simp_all) + apply (metis singleCombinatorsConc singleCombinatorsStart sortedConcEnd) + apply (erule sorted_is_smaller) + apply (auto intro: singleCombinatorsConc singleCombinatorsStart in_set_in_list) + done + +lemma smaller_antisym: "\\ smaller a b l; in_list a l; in_list b l; + singleCombinators[a]; singleCombinators [b]\ \ + smaller b a l" + apply (case_tac a) + apply simp_all + apply (case_tac b) + apply simp_all + apply (simp_all split: if_splits) + apply (rule setPaireq) + apply simp + apply (case_tac b) + apply simp_all + apply (simp_all split: if_splits) + done + +lemma set_insort_insert: "set (insort x xs l) \ insert x (set xs)" + by (induct xs) auto + +lemma all_in_listSubset[rule_format]: "all_in_list b l \singleCombinators a \ + set a \ set b \ all_in_list a l" + by (induct_tac a) (auto intro: in_set_in_list singleCombinatorsConc) + +lemma singleCombinators_insort: "\singleCombinators [x]; singleCombinators xs\ \ + singleCombinators (insort x xs l)" + by (metis NormalisationGenericProofs.set_insort aux0_0 aux0_1 aux0_5 list.simps(15)) + +lemma all_in_list_insort: "\all_in_list xs l; singleCombinators (x#xs); + in_list x l\ \ all_in_list (insort x xs l) l" + apply (rule_tac b = "x#xs" in all_in_listSubset) + apply simp_all + apply (metis singleCombinatorsConc singleCombinatorsStart + singleCombinators_insort) + apply (rule set_insort_insert) + done + +lemma sorted_ConsA:"\all_in_list (x#xs) l; singleCombinators (x#xs)\ \ + (sorted (x#xs) l) = (sorted xs l & (ALL y:set xs. smaller x y l))" + by (metis sorted_Cons) + +lemma is_in_insort: "y \ set xs \ y \ set (insort x xs l)" + by (simp add: NormalisationGenericProofs.set_insort) + + + +lemma sorted_insorta[rule_format]: + assumes 1 : "sorted (insort x xs l) l" + and 2 : "all_in_list (x#xs) l" + and 3 : "all_in_list (x#xs) l" + and 4 : "distinct (x#xs)" + and 5 : "singleCombinators [x]" + and 6 : "singleCombinators xs" + shows "sorted xs l" +proof (insert 1 2 3 4 5 6, induct xs) + case Nil show ?case by simp +next + case (Cons a xs) + then show ?case + apply simp + apply (auto intro: is_in_insort sorted_ConsA set_insort singleCombinators_insort + singleCombinatorsConc sortedConcEnd all_in_list_insort) + apply(cases "smaller x a l", simp_all) + by (metis NormalisationGenericProofs.set_insort NormalisationGenericProofs.sorted_Cons + all_in_list.simps(2) all_in_list_insort aux0_1 insert_iff singleCombinatorsConc + singleCombinatorsStart singleCombinators_insort) +qed + + +lemma sorted_insortb[rule_format]: + "sorted xs l \ all_in_list (x#xs) l \ distinct (x#xs) \ + singleCombinators [x] \ singleCombinators xs \ sorted (insort x xs l) l" +proof (induct xs) + case Nil show ?case by simp_all +next + case (Cons a xs) + have * : "sorted (a # xs) l \ all_in_list (x # a # xs) l \ + distinct (x # a # xs) \ singleCombinators [x] \ + singleCombinators (a # xs) \ sorted (insort x xs l) l" + apply(insert Cons.hyps)apply simp_all + apply (metis sorted_Cons all_in_list.simps(2) singleCombinatorsConc) + done + show ?case + apply(insert Cons.hyps) + apply (rule impI)+ + apply (insert *, auto intro!: sorted_Consb) + proof (rule_tac b = "x#xs" in all_in_listSubset) + show "in_list x l \ all_in_list xs l \ all_in_list (x # xs) l" + by simp_all + next + show "singleCombinators [x] \ + singleCombinators (a # xs) \ + FWNormalisationCore.sorted (FWNormalisationCore.insort x xs l) l \ + singleCombinators (FWNormalisationCore.insort x xs l)" + apply (rule singleCombinators_insort, simp_all) + by (erule singleCombinatorsConc) + next + show "set (FWNormalisationCore.insort x xs l) \ set (x # xs)" + using NormalisationGenericProofs.set_insort_insert by auto + next + show "singleCombinators [x] \ + singleCombinators (a # xs) \ + singleCombinators (a # FWNormalisationCore.insort x xs l)" + by (metis SCConca singleCombinatorsConc singleCombinatorsStart + singleCombinators_insort) + next + fix y + show "FWNormalisationCore.sorted (a # xs) l \ + singleCombinators [x] \ singleCombinators (a # xs) \ + in_list x l \ in_list a l \ all_in_list xs l \ + \ smaller x a l \ y \ set (FWNormalisationCore.insort x xs l) \ + smaller a y l" + by (metis NormalisationGenericProofs.set_insort in_set_in_list insert_iff + singleCombinatorsConc singleCombinatorsStart smaller_antisym + sorted_is_smaller) + qed +qed + + +lemma sorted_insort: + "\all_in_list (x#xs) l; distinct(x#xs); singleCombinators [x]; + singleCombinators xs\ \ + sorted (insort x xs l) l = sorted xs l" + by (auto intro: sorted_insorta sorted_insortb) + +lemma distinct_insort: "distinct (insort x xs l) = (x \ set xs \ distinct xs)" + by(induct xs)(auto simp:set_insort) + +lemma distinct_sort[simp]: "distinct (sort xs l) = distinct xs" + by(induct xs)(simp_all add:distinct_insort) + + +lemma sort_is_sorted[rule_format]: + "all_in_list p l \ distinct p \ singleCombinators p \ sorted (sort p l) l" + apply (induct p) + apply (auto intro: SC3 all_in_listSubset singleCombinatorsConc sorted_insort) + apply (subst sorted_insort) + apply (auto intro: singleCombinatorsConc all_in_listSubset SC3) + apply (erule all_in_listSubset) + by (auto intro: SC3 singleCombinatorsConc sorted_insort) + + + + +lemma smaller_sym[rule_format]: "all_in_list [a] l \ smaller a a l" + by (case_tac a,simp_all) + + +lemma SC_sublist[rule_format]: + "singleCombinators xs \ singleCombinators (qsort [y\xs. P y] l)" + by (auto intro: SCSubset) + + +lemma all_in_list_sublist[rule_format]: + "singleCombinators xs \ all_in_list xs l \ all_in_list (qsort [y\xs. P y] l) l" + by (auto intro: all_in_listSubset SC_sublist) + + +lemma SC_sublist2[rule_format]: + "singleCombinators xs \ singleCombinators ([y\xs. P y])" + by (auto intro: SCSubset) + + +lemma all_in_list_sublist2[rule_format]: + "singleCombinators xs \ all_in_list xs l \ all_in_list ( [y\xs. P y]) l" + by (auto intro: all_in_listSubset SC_sublist2) + + +lemma all_in_listAppend[rule_format]: + "all_in_list (xs) l \ all_in_list (ys) l \ all_in_list (xs @ ys) l" + by (induct xs) simp_all + + + +lemma distinct_sortQ[rule_format]: + "singleCombinators xs \ all_in_list xs l \ distinct xs \ distinct (qsort xs l)" + apply (induct xs l rule: qsort.induct) + apply (auto simp: SC_sublist2 singleCombinatorsConc all_in_list_sublist2) + done + + +lemma singleCombinatorsAppend[rule_format]: + "singleCombinators (xs) \ singleCombinators (ys) \ singleCombinators (xs @ ys)" + apply (induct xs, auto) + apply (case_tac a,simp_all)+ + done + +lemma sorted_append1[rule_format]: + "all_in_list xs l \ singleCombinators xs \ + all_in_list ys l \ singleCombinators ys \ + (sorted (xs@ys) l \ + (sorted xs l & sorted ys l & (\x \ set xs. \y \ set ys. smaller x y l)))" + apply(induct xs) + apply(simp_all) + by (metis NormalisationGenericProofs.sorted_Cons all_in_list.simps(2) all_in_listAppend aux0_1 + aux0_4 singleCombinatorsAppend singleCombinatorsConc singleCombinatorsStart) + +lemma sorted_append2[rule_format]: + "all_in_list xs l\ singleCombinators xs \ + all_in_list ys l \ singleCombinators ys \ + (sorted xs l & sorted ys l & (\x \ set xs. \y \ set ys. smaller x y l)) \ + (sorted (xs@ys) l)" + apply (induct xs) + apply simp_all + by (metis NormalisationGenericProofs.sorted_Cons all_in_list.simps(2) all_in_listAppend aux0_1 + aux0_4 singleCombinatorsAppend singleCombinatorsConc singleCombinatorsStart) + +lemma sorted_append[rule_format]: + "all_in_list xs l \ singleCombinators xs \ + all_in_list ys l \ singleCombinators ys \ + (sorted (xs@ys) l) = + (sorted xs l & sorted ys l & (\x \ set xs. \y \ set ys. smaller x y l))" + apply (rule impI)+ + apply (rule iffI) + apply (rule sorted_append1,simp_all) + apply (rule sorted_append2,simp_all) + done + + + + +lemma sort_is_sortedQ[rule_format]: + "all_in_list p l \ singleCombinators p \ sorted (qsort p l) l" +proof (induct p l rule: qsort.induct) print_cases + case 1 show ?case by simp +next + case 2 fix x::"('a,'b) Combinators" fix xs::"('a,'b) Combinators list" fix l + show "all_in_list [y\xs . \ smaller x y l] l \ + singleCombinators [y\xs . \ smaller x y l] \ + sorted (qsort [y\xs . \ smaller x y l] l) l \ + all_in_list [y\xs . smaller x y l] l \ + singleCombinators [y\xs . smaller x y l] \ + sorted (qsort [y\xs . smaller x y l] l) l \ + all_in_list(x#xs) l \ singleCombinators(x#xs) \ sorted (qsort(x#xs) l) l" + apply (intro impI) + apply (simp_all add: SC_sublist all_in_list_sublist all_in_list_sublist2 + singleCombinatorsConc SC_sublist2) + proof (subst sorted_append) + show "in_list x l \ all_in_list xs l \ + singleCombinators (x # xs) \ + all_in_list (qsort [y\xs . \ smaller x y l] l) l" + by (metis all_in_list_sublist singleCombinatorsConc) + next + show "in_list x l \ all_in_list xs l \ + singleCombinators (x # xs) \ + singleCombinators (qsort [y\xs . \ smaller x y l] l)" + apply (auto simp: SC_sublist all_in_list_sublist SC_sublist2 + all_in_list_sublist2 sorted_Cons sorted_append not_le) + apply (metis SC3Q SC_sublist2 singleCombinatorsConc) + done + next + show "sorted (qsort [y\xs . \ smaller x y l] l) l \ + sorted (qsort [y\xs . smaller x y l] l) l \ + in_list x l \ all_in_list xs l \ singleCombinators (x # xs) \ + all_in_list (x # qsort [y\xs . smaller x y l] l) l" + using all_in_list.simps(2) all_in_list_sublist singleCombinatorsConc by blast + next + show "sorted (qsort [y\xs . smaller x y l] l) l \ + in_list x l \ all_in_list xs l \ singleCombinators (x # xs) \ + singleCombinators (x # qsort [y\xs . smaller x y l] l)" + using SC_sublist aux0_1 singleCombinatorsConc singleCombinatorsStart by blast + next + show "sorted (qsort [y\xs . \ smaller x y l] l) l \ + sorted (qsort [y\xs . smaller x y l] l) l \ + in_list x l \ all_in_list xs l \ + singleCombinators (x # xs) \ + FWNormalisationCore.sorted (qsort [y\xs . \ smaller x y l] l) l \ + FWNormalisationCore.sorted (x # qsort [y\xs . smaller x y l] l) l \ + (\x'\set (qsort [y\xs . \ smaller x y l] l). + \y\set (x # qsort [y\xs . smaller x y l] l). smaller x' y l)" + apply auto + apply (metis (mono_tags, lifting) SC_sublist all_in_list.simps(2) + all_in_list_sublist aux0_1 mem_Collect_eq set_filter set_qsort + singleCombinatorsConc singleCombinatorsStart sorted_Consb) + apply (metis aux0_0 aux0_6 in_set_in_list singleCombinatorsConc + singleCombinatorsStart smaller_antisym) + by (metis (no_types, lifting) NormalisationGenericProofs.order_trans aux0_0 + aux0_6 in_set_in_list + singleCombinatorsConc singleCombinatorsStart smaller_antisym) + qed +qed + + +lemma inSet_not_MT: "a \ set p \ p \ []" + by auto + +lemma RS1n_assoc: + "x \ DenyAll \ removeShadowRules1_alternative xs @ [x] = + removeShadowRules1_alternative (xs @ [x])" + by (simp add: removeShadowRules1_alternative_def aux114) + +lemma RS1n_nMT[rule_format,simp]: "p \ []\ removeShadowRules1_alternative p \ []" + apply (simp add: removeShadowRules1_alternative_def) + apply (rule_tac xs = p in rev_induct, simp_all) + apply (case_tac "xs = []", simp_all) + apply (case_tac x, simp_all) + apply (rule_tac xs = "xs" in rev_induct, simp_all) + apply (case_tac x, simp_all)+ + done + +lemma RS1N_DA[simp]: "removeShadowRules1_alternative (a@[DenyAll]) = [DenyAll]" + by (simp add: removeShadowRules1_alternative_def) + + +lemma WP1n_DA_notinSet[rule_format]: "wellformed_policy1_strong p \ + DenyAll \ set (tl p)" + by (induct p) (simp_all) + +lemma mt_sym: "dom a \ dom b = {} \ dom b \ dom a = {}" + by auto + +lemma DAnotTL[rule_format]: + "xs \ [] \ wellformed_policy1 (xs @ [DenyAll]) \ False" + by (induct xs, simp_all) + + +lemma AND_tl[rule_format]: "allNetsDistinct ( p) \ allNetsDistinct (tl p)" + apply (induct p, simp_all) + by (auto intro: ANDConc) + + +lemma distinct_tl[rule_format]: "distinct p \ distinct (tl p)" + by (induct p, simp_all) + + +lemma SC_tl[rule_format]: "singleCombinators ( p) \ singleCombinators (tl p)" + by (induct p, simp_all) (auto intro: singleCombinatorsConc) + +lemma Conc_not_MT: "p = x#xs \ p \ []" + by auto + +lemma wp1_tl[rule_format]: + "p \ [] \ wellformed_policy1 p \ wellformed_policy1 (tl p)" + by (induct p) (auto intro: waux2) + + +lemma wp1_eq[rule_format]: + "wellformed_policy1_strong p \ wellformed_policy1 p" + apply (case_tac "DenyAll \ set p") + apply (subst wellformed_eq) + apply (auto elim: waux2) + done + + +lemma wellformed1_alternative_sorted: + "wellformed_policy1_strong p \ wellformed_policy1_strong (sort p l)" + by (case_tac "p", simp_all) + + + +lemma wp1n_RS2[rule_format]: + "wellformed_policy1_strong p \ wellformed_policy1_strong (removeShadowRules2 p)" + by (induct p, simp_all) + +lemma RS2_NMT[rule_format]: "p \ [] \ removeShadowRules2 p \ []" + apply (induct p, simp_all) + apply (case_tac "p \ []", simp_all) + apply (case_tac "a", simp_all)+ + done + + +lemma wp1_alternative_not_mt[simp]: "wellformed_policy1_strong p \ p \ []" + by auto + +lemma AIL1[rule_format,simp]: "all_in_list p l \ + all_in_list (removeShadowRules1 p) l" + by (induct_tac p, simp_all) + + + +lemma wp1ID: "wellformed_policy1_strong (insertDeny (removeShadowRules1 p))" + by (induct p, simp_all, case_tac a, simp_all) + +lemma dRD[simp]: "distinct (remdups p)" + by simp + +lemma AILrd[rule_format,simp]: "all_in_list p l \ all_in_list (remdups p) l" + by (induct p, simp_all) + + +lemma AILiD[rule_format,simp]: "all_in_list p l \ all_in_list (insertDeny p) l" + apply (induct p, simp_all) + apply (rule impI, simp) + apply (case_tac "a", simp_all) + done + +lemma SCrd[rule_format,simp]:"singleCombinators p\ singleCombinators(remdups p)" + apply (induct p, simp_all) + apply (case_tac a) + apply simp_all + done + +lemma SCRiD[rule_format,simp]: "singleCombinators p \ + singleCombinators(insertDeny p)" + apply (induct p, simp_all) + apply (case_tac "a", simp_all) + done + + +lemma WP1rd[rule_format,simp]: + "wellformed_policy1_strong p \ wellformed_policy1_strong (remdups p)" + by (induct p, simp_all) + +lemma ANDrd[rule_format,simp]: + "singleCombinators p \ allNetsDistinct p \ allNetsDistinct (remdups p)" + apply (rule impI)+ + apply (rule_tac b = p in aNDSubset) + apply simp_all + done + +lemma ANDiD[rule_format,simp]: + "allNetsDistinct p \ allNetsDistinct (insertDeny p)" + apply (induct p, simp_all) + apply (simp add: allNetsDistinct_def) + apply (auto intro: ANDConc) + apply (case_tac "a",simp_all add: allNetsDistinct_def) + done + + +lemma mr_iD[rule_format]: + "wellformed_policy1_strong p \ matching_rule x p = matching_rule x (insertDeny p)" + by (induct p, simp_all) + +lemma WP1iD[rule_format,simp]: "wellformed_policy1_strong p \ + wellformed_policy1_strong (insertDeny p)" + by (induct p, simp_all) + + +lemma DAiniD: "DenyAll \ set (insertDeny p)" + by (induct p, simp_all, case_tac a, simp_all) + +lemma p2lNmt: "policy2list p \ []" + by (rule policy2list.induct, simp_all) + +lemma AIL2[rule_format,simp]: + "all_in_list p l \ all_in_list (removeShadowRules2 p) l" + by (induct_tac p, simp_all, case_tac a, simp_all) + + +lemma SCConc: "singleCombinators x \ singleCombinators y \ singleCombinators (x@y)" + apply (rule aux0_5) + apply (metis aux0_0 aux0_4) + done + +lemma SCp2l: "singleCombinators (policy2list p)" + by (induct_tac p) (auto intro: SCConc) + + +lemma subnetAux: "Dd \ A \ {} \ A \ B \ Dd \ B \ {}" + by auto + +lemma soadisj: "x \ subnetsOfAdr a \ y \ subnetsOfAdr a \ \ netsDistinct x y" + by(simp add: subnetsOfAdr_def netsDistinct_def,auto) + +lemma not_member: "\ member a (x\y) \ \ member a x" + apply auto + done + +lemma soadisj2: "(\ a x y. x \ subnetsOfAdr a \ y \ subnetsOfAdr a \ \ netsDistinct x y)" + by (simp add: subnetsOfAdr_def netsDistinct_def, auto) + +lemma ndFalse1: + "(\a b c d. (a,b)\A \ (c,d)\B \ netsDistinct a c) \ + \(a, b)\A. a \ subnetsOfAdr D \ + \(a, b)\B. a \ subnetsOfAdr D \ False" + apply (auto simp: soadisj) + using soadisj2 by blast + + +lemma ndFalse2: "(\a b c d. (a,b)\A \ (c,d)\B \ netsDistinct b d) \ + \(a, b)\A. b \ subnetsOfAdr D \ + \(a, b)\B. b \ subnetsOfAdr D \ False" + apply (auto simp: soadisj) + using soadisj2 by blast + + +lemma tndFalse: "(\a b c d. (a,b)\A \ (c,d)\B \ twoNetsDistinct a b c d) \ + \(a, b)\A. a \ subnetsOfAdr (D::('a::adr)) \ b \ subnetsOfAdr (F::'a) \ + \(a, b)\B. a \ subnetsOfAdr D\ b\ subnetsOfAdr F + \ False" + apply (simp add: twoNetsDistinct_def) + apply (auto simp: ndFalse1 ndFalse2) + apply (metis soadisj) + done + +lemma sepnMT[rule_format]: "p \ [] \ (separate p) \ []" + by (induct p rule: separate.induct) simp_all + +lemma sepDA[rule_format]: "DenyAll \ set p \ DenyAll \ set (separate p)" + by (induct p rule: separate.induct) simp_all + + +lemma setnMT: "set a = set b \ a \ [] \ b \ []" + by auto + +lemma sortnMT: "p \ [] \ sort p l \ []" + by (metis set_sort setnMT) + +lemma idNMT[rule_format]: "p \ [] \ insertDenies p \ []" + apply (induct p, simp_all) + apply (case_tac a, simp_all) + done + +lemma OTNoTN[rule_format]: " OnlyTwoNets p \ x \ DenyAll \ x \ set p \ onlyTwoNets x" + apply (induct p, simp_all, rename_tac a p) + apply (intro impI conjI, simp) + apply (case_tac a, simp_all) + apply (drule mp, simp_all) + apply (case_tac a, simp_all) + done + +lemma first_isIn[rule_format]: "\ member DenyAll x \ (first_srcNet x,first_destNet x) \ sdnets x" + by (induct x,case_tac x, simp_all) + + +lemma sdnets2: + "\a b. sdnets x = {(a, b), (b, a)} \ \ member DenyAll x \ + sdnets x = {(first_srcNet x, first_destNet x), (first_destNet x, first_srcNet x)}" +proof - + have * : "\a b. sdnets x = {(a, b), (b, a)} \ \ member DenyAll x + \ (first_srcNet x, first_destNet x) \ sdnets x" + by (erule first_isIn) + + show "\a b. sdnets x = {(a, b), (b, a)} \ \ member DenyAll x \ + sdnets x = {(first_srcNet x, first_destNet x), (first_destNet x, first_srcNet x)}" + using * by auto +qed + +lemma alternativelistconc1[rule_format]: + "a \ set (net_list_aux [x]) \ a \ set (net_list_aux [x,y])" + by (induct x,simp_all) + +lemma alternativelistconc2[rule_format]: + "a \ set (net_list_aux [x]) \ a \ set (net_list_aux [y,x])" + by (induct y, simp_all) + + +lemma noDA[rule_format]: + "noDenyAll xs \ s \ set xs \ \ member DenyAll s" + by (induct xs, simp_all) + +lemma isInAlternativeList: + "(aa \ set (net_list_aux [a]) \ aa \ set (net_list_aux p)) \ aa \ set (net_list_aux (a # p))" + by (case_tac a,simp_all) + +lemma netlistaux: + "x \ set (net_list_aux (a # p))\ x \ set (net_list_aux ([a])) \ x \ set (net_list_aux (p))" + apply (case_tac " x \ set (net_list_aux [a])", simp_all) + apply (case_tac a, simp_all) + done + +lemma firstInNet[rule_format]: + "\ member DenyAll a \ first_destNet a \ set (net_list_aux (a # p))" + apply (rule Combinators.induct, simp_all) + apply (metis netlistaux) + done + +lemma firstInNeta[rule_format]: + "\ member DenyAll a \ first_srcNet a \ set (net_list_aux (a # p))" + apply (rule Combinators.induct, simp_all) + apply (metis netlistaux) + done + +lemma disjComm: "disjSD_2 a b \ disjSD_2 b a" + apply (simp add: disjSD_2_def) + apply (intro allI impI conjI) + using tNDComm apply blast + by (meson tNDComm twoNetsDistinct_def) + + +lemma disjSD2aux: + "disjSD_2 a b \ \ member DenyAll a \ \ member DenyAll b \ + disjSD_2 (DenyAllFromTo (first_srcNet a) (first_destNet a) \ + DenyAllFromTo (first_destNet a) (first_srcNet a) \ a) + b" + apply (drule disjComm,rule disjComm) + apply (simp add: disjSD_2_def) + using first_isIn by blast + + +lemma noDA1eq[rule_format]: "noDenyAll p \ noDenyAll1 p" + by (induct p, simp,rename_tac a p, case_tac a, simp_all) + + +lemma noDA1C[rule_format]: "noDenyAll1 (a#p) \ noDenyAll1 p" + by (case_tac a, simp_all,rule impI, rule noDA1eq, simp)+ + +lemma disjSD_2IDa: + "disjSD_2 x y \ + \ member DenyAll x \ + \ member DenyAll y \ + a = first_srcNet x \ + b = first_destNet x \ + disjSD_2 (DenyAllFromTo a b \ DenyAllFromTo b a \ x) y" + by(simp add:disjSD2aux) + + +lemma noDAID[rule_format]: "noDenyAll p \ noDenyAll (insertDenies p)" + by (induct p, simp_all,case_tac a, simp_all) + + +lemma isInIDo[rule_format]: + "noDenyAll p \ s \ set (insertDenies p) \ + (\! a. s = (DenyAllFromTo (first_srcNet a) (first_destNet a)) \ + (DenyAllFromTo (first_destNet a) (first_srcNet a)) \ a \ a \ set p)" + apply (induct p, simp, rename_tac a p) + apply (case_tac "a = DenyAll", simp) + apply (case_tac a, auto) + done + +lemma id_aux1[rule_format]: "DenyAllFromTo (first_srcNet s) (first_destNet s) \ + DenyAllFromTo (first_destNet s) (first_srcNet s) \ s\ set (insertDenies p) + \ s \ set p" + by (induct p, simp_all, rename_tac a p, case_tac a, simp_all) + + +lemma id_aux2: + "noDenyAll p \ + \s. s \ set p \ disjSD_2 a s \ + \ member DenyAll a \ + DenyAllFromTo (first_srcNet s) (first_destNet s) \ + DenyAllFromTo (first_destNet s) (first_srcNet s) \ s \ set (insertDenies p) \ + disjSD_2 a (DenyAllFromTo (first_srcNet s) (first_destNet s) \ + DenyAllFromTo (first_destNet s) (first_srcNet s) \ s)" + by (metis disjComm disjSD2aux isInIDo noDA) + + + +lemma id_aux4[rule_format]: + "noDenyAll p \ \s. s \ set p \ disjSD_2 a s \ + s \ set (insertDenies p) \ \ member DenyAll a \ + disjSD_2 a s" + apply (subgoal_tac " \a. s = + DenyAllFromTo (first_srcNet a) (first_destNet a) \ + DenyAllFromTo (first_destNet a) (first_srcNet a) \ a \ + a \ set p") + apply (drule_tac Q = "disjSD_2 a s" in exE, simp_all, rule id_aux2, simp_all) + using isInIDo by blast + + + (* XXX *) + + +lemma sepNetsID[rule_format]: + "noDenyAll1 p \ separated p \ separated (insertDenies p)" + apply (induct p, simp) + apply (rename_tac a p, auto) + using noDA1C apply blast + apply (case_tac "a = DenyAll", auto) + apply (simp add: disjSD_2_def) + apply (case_tac a,auto) + apply (rule disjSD_2IDa, simp_all, rule id_aux4, simp_all, metis noDA noDAID)+ + done + +lemma aNDDA[rule_format]: "allNetsDistinct p \ allNetsDistinct(DenyAll#p)" + by (case_tac p,auto simp: allNetsDistinct_def) + + +lemma OTNConc[rule_format]: "OnlyTwoNets (y # z) \ OnlyTwoNets z" + by (case_tac y, simp_all) + +lemma first_bothNetsd: "\ member DenyAll x \ first_bothNet x = {first_srcNet x, first_destNet x}" + by (induct x) simp_all + +lemma bNaux: + "\ member DenyAll x \ \ member DenyAll y \ + first_bothNet x = first_bothNet y \ + {first_srcNet x, first_destNet x} = {first_srcNet y, first_destNet y}" + by (simp add: first_bothNetsd) + +lemma setPair: "{a,b} = {a,d} \ b = d" + by (metis setPaireq) + +lemma setPair1: "{a,b} = {d,a} \ b = d" + by (metis Un_empty_right Un_insert_right insert_absorb2 setPaireq) + +lemma setPair4: "{a,b} = {c,d} \ a \ c \ a = d" + by auto + +lemma otnaux1: " {x, y, x, y} = {x,y}" + by auto + + +lemma OTNIDaux4: "{x,y,x} = {y,x}" + by auto + +lemma setPair5: "{a,b} = {c,d} \ a \ c \ a = d" + by auto + +lemma otnaux: " + \first_bothNet x = first_bothNet y; \ member DenyAll x; \ member DenyAll y; + onlyTwoNets y; onlyTwoNets x\ \ + onlyTwoNets (x \ y)" + apply (simp add: onlyTwoNets_def) + apply (subgoal_tac "{first_srcNet x, first_destNet x} = + {first_srcNet y, first_destNet y}") + apply (case_tac "(\a b. sdnets y = {(a, b)})") + apply simp_all + apply (case_tac "(\a b. sdnets x = {(a, b)})") + apply simp_all + apply (subgoal_tac "sdnets x = {(first_srcNet x, first_destNet x)}") + apply (subgoal_tac "sdnets y = {(first_srcNet y, first_destNet y)}") + apply simp + apply (case_tac "first_srcNet x = first_srcNet y") + apply simp_all + apply (rule disjI1) + apply (rule setPair) + apply simp + apply (subgoal_tac "first_srcNet x = first_destNet y") + apply simp + apply (subgoal_tac "first_destNet x = first_srcNet y") + apply simp + apply (rule_tac x ="first_srcNet y" in exI, + rule_tac x = "first_destNet y" in exI,simp) + apply (rule setPair1) + apply simp + apply (rule setPair4) + apply simp_all + apply (metis first_isIn singletonE) + apply (metis first_isIn singletonE) + apply (subgoal_tac "sdnets x = {(first_srcNet x, first_destNet x), + (first_destNet x, first_srcNet x)}") + apply (subgoal_tac "sdnets y = {(first_srcNet y, first_destNet y)}") + apply simp + apply (case_tac "first_srcNet x = first_srcNet y") + apply simp_all + apply (subgoal_tac "first_destNet x = first_destNet y") + apply simp + apply (rule setPair) + apply simp + apply (subgoal_tac "first_srcNet x = first_destNet y") + apply simp + apply (subgoal_tac "first_destNet x = first_srcNet y") + apply simp + apply (rule_tac x ="first_srcNet y" in exI, + rule_tac x = "first_destNet y" in exI) + apply (metis OTNIDaux4 insert_commute ) + apply (rule setPair1) + apply simp + apply (rule setPair5) + apply assumption + apply simp + apply (metis first_isIn singletonE) + apply (rule sdnets2) + apply simp_all + apply (case_tac "(\a b. sdnets x = {(a, b)})") + apply simp_all + apply (subgoal_tac "sdnets x = {(first_srcNet x, first_destNet x)}") + apply (subgoal_tac "sdnets y = {(first_srcNet y, first_destNet y), + (first_destNet y, first_srcNet y)}") + apply simp + apply (case_tac "first_srcNet x = first_srcNet y") + apply simp_all + apply (subgoal_tac "first_destNet x = first_destNet y") + apply simp + apply (rule_tac x ="first_srcNet y" in exI, + rule_tac x = "first_destNet y" in exI) + apply (metis OTNIDaux4 insert_commute ) + apply (rule setPair) + apply simp + apply (subgoal_tac "first_srcNet x = first_destNet y") + apply simp + apply (subgoal_tac "first_destNet x = first_srcNet y") + apply simp + apply (rule setPair1) + apply simp + apply (rule setPair4) + apply assumption + apply simp + apply (rule sdnets2) + apply simp + apply simp + apply (metis singletonE first_isIn) + apply (subgoal_tac "sdnets x = {(first_srcNet x, first_destNet x), + (first_destNet x, first_srcNet x)}") + apply (subgoal_tac "sdnets y = {(first_srcNet y, first_destNet y), + (first_destNet y, first_srcNet y)}") + apply simp + apply (case_tac "first_srcNet x = first_srcNet y") + apply simp_all + apply (subgoal_tac "first_destNet x = first_destNet y") + apply simp + apply (rule_tac x ="first_srcNet y" in exI, + rule_tac x = "first_destNet y" in exI) + apply (rule otnaux1) + apply (rule setPair) + apply simp + apply (subgoal_tac "first_srcNet x = first_destNet y") + apply simp + apply (subgoal_tac "first_destNet x = first_srcNet y") + apply simp + apply (rule_tac x ="first_srcNet y" in exI, + rule_tac x = "first_destNet y" in exI) + apply (metis OTNIDaux4 insert_commute) + apply (rule setPair1) + apply simp + apply (rule setPair4) + apply assumption + apply simp + apply (rule sdnets2,simp_all)+ + apply (rule bNaux, simp_all) + done + +lemma OTNSepaux: + "onlyTwoNets (a \ y) \ OnlyTwoNets z \ OnlyTwoNets (separate (a \ y # z)) \ + \ member DenyAll a \ \ member DenyAll y \ + noDenyAll z \ onlyTwoNets a \ OnlyTwoNets (y # z) \ first_bothNet a = first_bothNet y \ + OnlyTwoNets (separate (a \ y # z))" + apply (drule mp) + apply simp_all + apply (rule conjI) + apply (rule otnaux) + apply simp_all + apply (rule_tac p = "(y # z)" in OTNoTN) + apply simp_all + apply (metis member.simps(2)) + apply (simp add: onlyTwoNets_def) + apply (rule_tac y = y in OTNConc,simp) + done + +lemma OTNSEp[rule_format]: + "noDenyAll1 p \ OnlyTwoNets p \ OnlyTwoNets (separate p)" + apply (induct p rule: separate.induct) + by (simp_all add: OTNSepaux noDA1eq) + +lemma nda[rule_format]: + "singleCombinators (a#p) \ noDenyAll p \ noDenyAll1 (a # p)" + apply (induct p,simp_all) + apply (case_tac a, simp_all)+ + done + +lemma nDAcharn[rule_format]: "noDenyAll p = (\ r \ set p. \ member DenyAll r)" + by (induct p) simp_all + + +lemma nDAeqSet: "set p = set s \ noDenyAll p = noDenyAll s" + by (simp add: nDAcharn) + +lemma nDASCaux[rule_format]: + "DenyAll \ set p \ singleCombinators p \ r \ set p \ \ member DenyAll r" + apply (case_tac r, simp_all) + using SCnotConc by blast + + +lemma nDASC[rule_format]: + "wellformed_policy1 p \ singleCombinators p \ noDenyAll1 p" + apply (induct p, simp_all) + using nDASCaux nDAcharn nda singleCombinatorsConc by blast + + +lemma noDAAll[rule_format]: "noDenyAll p = (\ memberP DenyAll p)" + by (induct p) simp_all + + +lemma memberPsep[symmetric]: "memberP x p = memberP x (separate p)" + by (induct p rule: separate.induct) simp_all + + +lemma noDAsep[rule_format]: "noDenyAll p \ noDenyAll (separate p)" + by (simp add:noDAAll,subst memberPsep, simp) + + +lemma noDA1sep[rule_format]: "noDenyAll1 p \ noDenyAll1 (separate p)" + by (induct p rule:separate.induct, simp_all add: noDAsep) + + +lemma isInAlternativeLista: + "(aa \ set (net_list_aux [a]))\ aa \ set (net_list_aux (a # p))" + by (case_tac a,auto) + + +lemma isInAlternativeListb: + "(aa \ set (net_list_aux p))\ aa \ set (net_list_aux (a # p))" + by (case_tac a,simp_all) + + +lemma ANDSepaux: "allNetsDistinct (x # y # z) \ allNetsDistinct (x \ y # z)" + apply (simp add: allNetsDistinct_def) + apply (intro allI impI, rename_tac a b) + apply (drule_tac x = a in spec, drule_tac x = b in spec) + by (meson isInAlternativeList) + + +lemma netlistalternativeSeparateaux: + "net_list_aux [y] @ net_list_aux z = net_list_aux (y # z)" + by (case_tac y, simp_all) + +lemma netlistalternativeSeparate: "net_list_aux p = net_list_aux (separate p)" + by (induct p rule:separate.induct, simp_all) (simp_all add: netlistalternativeSeparateaux) + + +lemma ANDSepaux2: + "allNetsDistinct(x#y#z) \ allNetsDistinct(separate(y#z)) \ allNetsDistinct(x#separate(y#z))" + apply (simp add: allNetsDistinct_def) + by (metis isInAlternativeList netlistalternativeSeparate netlistaux) + + + +lemma ANDSep[rule_format]: "allNetsDistinct p \ allNetsDistinct(separate p)" + apply (induct p rule: separate.induct, simp_all) + apply (metis ANDConc aNDDA) + apply (metis ANDConc ANDSepaux ANDSepaux2) + apply (metis ANDConc ANDSepaux ANDSepaux2) + apply (metis ANDConc ANDSepaux ANDSepaux2) + done + +lemma wp1_alternativesep[rule_format]: + "wellformed_policy1_strong p \ wellformed_policy1_strong (separate p)" + by (metis sepDA separate.simps(1) wellformed_policy1_strong.simps(2) wp1n_tl) + + +lemma noDAsort[rule_format]: "noDenyAll1 p \ noDenyAll1 (sort p l)" + apply (case_tac "p",simp_all) + apply (case_tac "a = DenyAll", auto) + using NormalisationGenericProofs.set_sort nDAeqSet apply blast +proof - + fix a::"('a,'b)Combinators" fix list + have * : "a \ DenyAll \ noDenyAll1 (a # list) \ noDenyAll (a#list)" by (case_tac a, simp_all) + show "a \ DenyAll \ noDenyAll1 (a # list) \ noDenyAll1 (insort a (sort list l) l)" + apply(cases "insort a (sort list l) l", simp_all) + by (metis "*" NormalisationGenericProofs.set_insort NormalisationGenericProofs.set_sort + list.simps(15) nDAeqSet noDA1eq) +qed + + +lemma OTNSC[rule_format]: "singleCombinators p \ OnlyTwoNets p" + apply (induct p,simp_all) + apply (rename_tac a p) + apply (rule impI,drule mp) + apply (erule singleCombinatorsConc) + apply (case_tac a, simp_all) + apply (simp add: onlyTwoNets_def)+ + done + +lemma fMTaux: "\ member DenyAll x \ first_bothNet x \ {}" + by (metis first_bothNetsd insert_commute insert_not_empty) + +lemma fl2[rule_format]: "firstList (separate p) = firstList p" + by (rule separate.induct) simp_all + + +lemma fl3[rule_format]: "NetsCollected p \ (first_bothNet x \ firstList p \ + (\a\set p. first_bothNet x \ first_bothNet a))\ NetsCollected (x#p)" + by (induct p) simp_all + + +lemma sortedConc[rule_format]: " sorted (a # p) l \ sorted p l" + by (induct p) simp_all + + +lemma smalleraux2: + "{a,b} \ set l \ {c,d} \ set l \ {a,b} \ {c,d} \ + smaller (DenyAllFromTo a b) (DenyAllFromTo c d) l \ + \ smaller (DenyAllFromTo c d) (DenyAllFromTo a b) l" + by (metis bothNet.simps(2) pos_noteq smaller.simps(5)) + + +lemma smalleraux2a: + "{a,b} \ set l \ {c,d} \ set l \ {a,b} \ {c,d} \ + smaller (DenyAllFromTo a b) (AllowPortFromTo c d p) l \ + \ smaller (AllowPortFromTo c d p) (DenyAllFromTo a b) l" + by (simp) (metis eq_imp_le pos_noteq) + + +lemma smalleraux2b: + "{a,b} \ set l \ {c,d} \ set l \ {a,b} \ {c,d} \ y = DenyAllFromTo a b \ + smaller (AllowPortFromTo c d p) y l \ + \ smaller y (AllowPortFromTo c d p) l" + by (simp) (metis eq_imp_le pos_noteq) + + +lemma smalleraux2c: + "{a,b} \ set l\{c,d}\set l\{a,b} \ {c,d} \ y = AllowPortFromTo a b q \ +smaller (AllowPortFromTo c d p) y l \ \ smaller y (AllowPortFromTo c d p) l" + by (simp) (metis pos_noteq) + +lemma smalleraux3: + assumes "x \ set l" and " y \ set l" and "x \ y" and "x = bothNet a" and "y = bothNet b" + and "smaller a b l" and "singleCombinators [a]" and "singleCombinators [b]" + shows "\ smaller b a l" +proof (cases a) + case DenyAll thus ?thesis using assms by (case_tac b,simp_all) +next + case (DenyAllFromTo c d) thus ?thesis + proof (cases b) + case DenyAll thus ?thesis using assms DenyAll DenyAllFromTo by simp + next + case (DenyAllFromTo e f) thus ?thesis using assms DenyAllFromTo + by (metis DenyAllFromTo `a = DenyAllFromTo c d` bothNet.simps(2) smalleraux2) + next + case (AllowPortFromTo e f g) thus ?thesis + using assms DenyAllFromTo AllowPortFromTo by simp (metis eq_imp_le pos_noteq) + next + case (Conc e f) thus ?thesis using assms by simp + qed +next + case (AllowPortFromTo c d p) thus ?thesis + proof (cases b) + case DenyAll thus ?thesis using assms AllowPortFromTo DenyAll by simp + next + case (DenyAllFromTo e f) thus ?thesis + using assms by simp (metis AllowPortFromTo DenyAllFromTo bothNet.simps(3) smalleraux2a) + next + case (AllowPortFromTo e f g) thus ?thesis + using assms by(simp)(metis AllowPortFromTo `a = AllowPortFromTo c d p` + bothNet.simps(3) smalleraux2c) + next + case (Conc e f) thus ?thesis using assms by simp + qed +next + case (Conc c d) thus ?thesis using assms by simp +qed + +thm Combinators.split + +lemma smalleraux3a: + "a \ DenyAll \ b \ DenyAll \ in_list b l \ in_list a l \ + bothNet a \ bothNet b \ smaller a b l \ singleCombinators [a] \ + singleCombinators [b] \ \ smaller b a l" + apply (rule smalleraux3,simp_all) + apply (case_tac a, simp_all) + apply (case_tac b, simp_all) + done + +lemma posaux[rule_format]: "position a l < position b l \ a \ b" + by (induct l) simp_all + +lemma posaux6[rule_format]: + "a \ set l \ b \ set l \ a \ b \ position a l \ position b l" + by (induct l) (simp_all add: position_positive) + + +lemma notSmallerTransaux[rule_format]: + "x \ DenyAll \ r \ DenyAll \ + singleCombinators [x] \ singleCombinators [y] \ singleCombinators [r] \ + \ smaller y x l \ smaller x y l \ smaller x r l \ smaller y r l \ + in_list x l \ in_list y l \ in_list r l \ \ smaller r x l" + by (metis order_trans) + + +lemma notSmallerTrans[rule_format]: + "x \ DenyAll \ r \ DenyAll \ singleCombinators (x#y#z) \ + \ smaller y x l \ sorted (x#y#z) l \ r \ set z \ + all_in_list (x#y#z) l \ \ smaller r x l" + apply (rule impI)+ + apply (rule notSmallerTransaux, simp_all) + apply (metis singleCombinatorsConc singleCombinatorsStart) + apply (metis SCSubset equalityE remdups.simps(2) set_remdups + singleCombinatorsConc singleCombinatorsStart) + apply metis + apply (metis sorted.simps(3) in_set_in_list singleCombinatorsConc + singleCombinatorsStart sortedConcStart sorted_is_smaller) + apply (metis sorted_Cons all_in_list.simps(2) + singleCombinatorsConc) + apply (metis,metis in_set_in_list) + done + +lemma NCSaux1[rule_format]: + "noDenyAll p \ {x, y} \ set l \ all_in_list p l\ singleCombinators p \ + sorted (DenyAllFromTo x y # p) l \ {x, y} \ firstList p \ + DenyAllFromTo u v \ set p \ {x, y} \ {u, v}" +proof (cases p) + case Nil thus ?thesis by simp +next + case (Cons a list) + then show ?thesis apply simp + apply (intro impI conjI) + apply (metis bothNet.simps(2) first_bothNet.simps(3)) + proof - + assume 1: "{x, y} \ set l" and 2: "in_list a l \ all_in_list list l" + and 3 : "singleCombinators (a # list)" + and 4 : "smaller (DenyAllFromTo x y) a l \ sorted (a # list) l" + and 5 : "DenyAllFromTo u v \ set list" + and 6 : "\ member DenyAll a \ noDenyAll list" + have * : "smaller ((DenyAllFromTo x y)::(('a,'b)Combinators)) (DenyAllFromTo u v) l" + apply (insert 1 2 3 4 5, rule_tac y = a in order_trans, simp_all) + using in_set_in_list apply fastforce + by (simp add: sorted_ConsA) + + have ** :"{x, y} \ first_bothNet a \ + \ smaller ((DenyAllFromTo u v)::('a, 'b) Combinators) (DenyAllFromTo x y) l" + apply (insert 1 2 3 4 5 6, + rule_tac y = "a" and z = "list" in notSmallerTrans, + simp_all del: smaller.simps) + apply (rule smalleraux3a,simp_all del: smaller.simps) + apply (case_tac a, simp_all del: smaller.simps) + by (metis aux0_0 first_bothNet.elims list.set_intros(1)) + show " {x, y} \ first_bothNet a \ {x, y} \ {u, v}" + using 3 "*" "**" by force + qed +qed + +lemma posaux3[rule_format]:"a \ set l \ b \ set l \ a \ b \ position a l \ position b l" + apply (induct l, auto) + by(metis position_positive)+ + +lemma posaux4[rule_format]: + "singleCombinators [a] \ a\ DenyAll \ b \ DenyAll \ in_list a l \in_list b l \ + smaller a b l\ x = (bothNet a) \ y = (bothNet b) \ + position x l <= position y l" +proof (cases a) + case DenyAll then show ?thesis by simp +next + case (DenyAllFromTo c d) thus ?thesis + proof (cases b) + case DenyAll thus ?thesis by simp + next + case (DenyAllFromTo e f) thus ?thesis using DenyAllFromTo + by (auto simp: eq_imp_le `a = DenyAllFromTo c d`) + next + case (AllowPortFromTo e f p) thus ?thesis using `a = DenyAllFromTo c d` by simp + next + case (Conc e f) thus ?thesis using Conc `a = DenyAllFromTo c d` by simp + qed +next + case (AllowPortFromTo c d p) thus ?thesis + proof (cases b) + case DenyAll thus ?thesis by simp + next + case (DenyAllFromTo e f) thus ?thesis using AllowPortFromTo by simp + next + case (AllowPortFromTo e f p2) thus ?thesis using `a = AllowPortFromTo c d p` by simp + next + case (Conc e f) thus ?thesis using AllowPortFromTo by simp + qed +next + case (Conc c d) thus ?thesis by simp +qed + + + (* a terrible proof, but I didn't get it better; + complex context dependencies into huge case-distinction cascades. bu *) +lemma NCSaux2[rule_format]: + "noDenyAll p \ {a, b} \ set l \ all_in_list p l \singleCombinators p \ + sorted (DenyAllFromTo a b # p) l \ {a, b} \ firstList p \ + AllowPortFromTo u v w \ set p \ {a, b} \ {u, v}" +proof (cases p) + case Nil then show ?thesis by simp +next + case (Cons aa list) + have * : "{a, b} \ set l \ in_list aa l \ all_in_list list l \ + singleCombinators (aa # list) \ AllowPortFromTo u v w \ set list \ + smaller (DenyAllFromTo a b) aa l \ sorted (aa # list) l \ + smaller (DenyAllFromTo a b) (AllowPortFromTo u v w) l" + apply (rule_tac y = aa in order_trans,simp_all del: smaller.simps) + using in_set_in_list apply fastforce + using NormalisationGenericProofs.sorted_Cons all_in_list.simps(2) by blast + have **: "AllowPortFromTo u v w \ set list \ + in_list aa l \ all_in_list list l \ + in_list (AllowPortFromTo u v w) l" + apply (rule_tac p = list in in_set_in_list) + apply simp_all + done + assume "p = aa # list" + then show ?thesis + apply simp + apply (intro impI conjI,hypsubst, simp) + apply (subgoal_tac "smaller (DenyAllFromTo a b) (AllowPortFromTo u v w) l") + apply (subgoal_tac "\ smaller (AllowPortFromTo u v w) (DenyAllFromTo a b) l") + apply (rule_tac l = l in posaux) + apply (rule_tac y = "position (first_bothNet aa) l" in basic_trans_rules(22)) + apply (simp_all split: if_splits) + apply (case_tac aa, simp_all) + apply (case_tac "a = x21 \ b = x22", simp_all) + apply (case_tac "a = x21", simp_all) + apply (simp add: order.not_eq_order_implies_strict posaux6) + apply (simp add: order.not_eq_order_implies_strict posaux6) + apply (simp add: order.not_eq_order_implies_strict posaux6) + apply (rule basic_trans_rules(18)) + apply (rule_tac a = "DenyAllFromTo a b" and b = aa in posaux4, simp_all) + apply (case_tac aa,simp_all) + apply (case_tac aa, simp_all) + apply (rule posaux3, simp_all) + apply (case_tac aa, simp_all) + apply (rule_tac a = aa and b = "AllowPortFromTo u v w" in posaux4, simp_all) + apply (case_tac aa,simp_all) + apply (rule_tac p = list in sorted_is_smaller, simp_all) + apply (case_tac aa, simp_all) + apply (case_tac aa, simp_all) + apply (rule_tac a = aa and b = "AllowPortFromTo u v w" in posaux4, simp_all) + apply (case_tac aa,simp_all) + using ** apply auto[1] + apply (metis all_in_list.simps(2) sorted_Cons) + apply (case_tac aa, simp_all) + apply (metis ** bothNet.simps(3) in_list.simps(3) posaux6) + using * by force +qed + + + +lemma NCSaux3[rule_format]: + "noDenyAll p \ {a, b} \ set l \ all_in_list p l \singleCombinators p \ + sorted (AllowPortFromTo a b w # p) l \ {a, b} \ firstList p \ + DenyAllFromTo u v \ set p \ {a, b} \ {u, v}" + apply (case_tac p, simp_all,intro impI conjI,hypsubst,simp) +proof - + fix aa::"('a, 'b) Combinators" fix list::"('a, 'b) Combinators list" + assume 1 : "\ member DenyAll aa \ noDenyAll list" and 2: "{a, b} \ set l " + and 3 : "in_list aa l \ all_in_list list l" and 4: "singleCombinators (aa # list)" + and 5 : "smaller (AllowPortFromTo a b w) aa l \ sorted (aa # list) l" + and 6 : "{a, b} \ first_bothNet aa" and 7: "DenyAllFromTo u v \ set list" + have *: "\ smaller (DenyAllFromTo u v) (AllowPortFromTo a b w) l" + apply (insert 1 2 3 4 5 6 7, rule_tac y = aa and z = list in notSmallerTrans) + apply (simp_all del: smaller.simps) + apply (rule smalleraux3a,simp_all del: smaller.simps) + apply (case_tac aa, simp_all del: smaller.simps) + apply (case_tac aa, simp_all del: smaller.simps) + done + have **: "smaller (AllowPortFromTo a b w) (DenyAllFromTo u v) l" + apply (insert 1 2 3 4 5 6 7,rule_tac y = aa in order_trans,simp_all del: smaller.simps) + apply (subgoal_tac "in_list (DenyAllFromTo u v) l", simp) + apply (rule_tac p = list in in_set_in_list, simp_all) + apply (rule_tac p = list in sorted_is_smaller,simp_all del: smaller.simps) + apply (subgoal_tac "in_list (DenyAllFromTo u v) l", simp) + apply (rule_tac p = list in in_set_in_list, simp_all) + apply (erule singleCombinatorsConc) + done + show "{a, b} \ {u, v}" by (insert * **, simp split: if_splits) +qed + + +lemma NCSaux4[rule_format]: + "noDenyAll p \ {a, b} \ set l \ all_in_list p l \ singleCombinators p \ + sorted (AllowPortFromTo a b c # p) l \ {a, b} \ firstList p \ + AllowPortFromTo u v w \ set p \ {a, b} \ {u, v}" + apply (cases p, simp_all) + apply (intro impI conjI) + apply (hypsubst,simp_all) +proof - + fix aa::"('a, 'b) Combinators" fix list::"('a, 'b) Combinators list" + assume 1 : "\ member DenyAll aa \ noDenyAll list" and 2: "{a, b} \ set l " + and 3 : "in_list aa l \ all_in_list list l" and 4: "singleCombinators (aa # list)" + and 5 : "smaller (AllowPortFromTo a b c) aa l \ sorted (aa # list) l" + and 6 : "{a, b} \ first_bothNet aa" and 7: "AllowPortFromTo u v w \ set list" + have *: "\ smaller (AllowPortFromTo u v w) (AllowPortFromTo a b c) l" + apply (insert 1 2 3 4 5 6 7, rule_tac y = aa and z = list in notSmallerTrans) + apply (simp_all del: smaller.simps) + apply (rule smalleraux3a,simp_all del: smaller.simps) + apply (case_tac aa, simp_all del: smaller.simps) + apply (case_tac aa, simp_all del: smaller.simps) + done + have **: "smaller (AllowPortFromTo a b c) (AllowPortFromTo u v w) l" + apply(insert 1 2 3 4 5 6 7) + apply (case_tac aa, simp_all del: smaller.simps) + apply (rule_tac y = aa in order_trans,simp_all del: smaller.simps) + apply (subgoal_tac "in_list (AllowPortFromTo u v w) l", simp) + apply (rule_tac p = list in in_set_in_list, simp) + apply (case_tac aa, simp_all del: smaller.simps) + apply (rule_tac p = list in sorted_is_smaller,simp_all del: smaller.simps) + apply (subgoal_tac "in_list (AllowPortFromTo u v w) l", simp) + apply (rule_tac p = list in in_set_in_list, simp, simp) + apply (rule_tac y = aa in order_trans,simp_all del: smaller.simps) + apply (subgoal_tac "in_list (AllowPortFromTo u v w) l", simp) + using in_set_in_list apply blast + by (metis all_in_list.simps(2) bothNet.simps(3) in_list.simps(3) + singleCombinators.simps(5) sorted_ConsA) + show "{a, b} \ {u, v}" by (insert * **, simp_all split: if_splits) +qed + + +lemma NetsCollectedSorted[rule_format]: + "noDenyAll1 p \ all_in_list p l \ singleCombinators p \ sorted p l \ NetsCollected p" + apply (induct p) + apply simp + apply (intro impI,drule mp,erule noDA1C,drule mp,simp) + apply (drule mp,erule singleCombinatorsConc) + apply (drule mp,erule sortedConc) +proof - + fix a::" ('a, 'b) Combinators" fix p:: " ('a, 'b) Combinators list" + assume 1: "noDenyAll1 (a # p)" and 2:"all_in_list (a # p) l" + and 3: "singleCombinators (a # p)" and 4: "sorted (a # p) l" and 5: "NetsCollected p" + show "NetsCollected (a # p)" + apply(insert 1 2 3 4 5, rule fl3) + apply(simp, rename_tac "aa") + proof (cases a) + case DenyAll + fix aa::"('a, 'b) Combinators" + assume 6: "aa \ set p" + show "first_bothNet a \ first_bothNet aa" + apply(insert 1 2 3 4 5 6 `a = DenyAll`, simp_all) + using fMTaux noDA by blast + next + case (DenyAllFromTo x21 x22) + fix aa::"('a, 'b) Combinators" + assume 6: "first_bothNet a \ firstList p" and 7 :"aa \ set p" + show "first_bothNet a \ first_bothNet aa" + apply(insert 1 2 3 4 5 6 7 `a = DenyAllFromTo x21 x22`) + apply(case_tac aa, simp_all) + apply (meson NCSaux1) + apply (meson NCSaux2) + using SCnotConc by auto[1] + next + case (AllowPortFromTo x31 x32 x33) + fix aa::"('a, 'b) Combinators" + assume 6: "first_bothNet a \ firstList p" and 7 :"aa \ set p" + show "first_bothNet a \ first_bothNet aa" + apply(insert 1 2 3 4 6 7 `a = AllowPortFromTo x31 x32 x33`) + apply(case_tac aa, simp_all) + apply (meson NCSaux3) + apply (meson NCSaux4) + using SCnotConc by auto + next + case (Conc x41 x42) + fix aa::"('a, 'b) Combinators" + show "first_bothNet a \ first_bothNet aa" + by(insert 3 4 `a = x41 \ x42`,simp) + qed +qed + + + +lemma NetsCollectedSort: "distinct p \noDenyAll1 p \ all_in_list p l \ + singleCombinators p \ NetsCollected (sort p l)" + apply (rule_tac l = l in NetsCollectedSorted,rule noDAsort, simp_all) + apply (rule_tac b=p in all_in_listSubset) + by (auto intro: sort_is_sorted) + + + +lemma fBNsep[rule_format]: "(\a\set z. {b,c} \ first_bothNet a) \ + (\a\set (separate z). {b,c} \ first_bothNet a)" + apply (induct z rule: separate.induct, simp) + by (rule impI, simp)+ + + + +lemma fBNsep1[rule_format]: " (\a\set z. first_bothNet x \ first_bothNet a) \ + (\a\set (separate z). first_bothNet x \ first_bothNet a)" + apply (induct z rule: separate.induct, simp) + by (rule impI, simp)+ + + + +lemma NetsCollectedSepauxa: + "{b,c}\firstList z \ noDenyAll1 z \ \a\set z. {b,c}\first_bothNet a \ NetsCollected z \ + NetsCollected (separate z) \ {b, c} \ firstList (separate z) \ a \ set (separate z) \ + {b, c} \ first_bothNet a" + by (rule fBNsep) simp_all + + +lemma NetsCollectedSepaux: + "first_bothNet (x::('a,'b)Combinators) \ first_bothNet y \ \ member DenyAll y \ noDenyAll z \ + (\a\set z. first_bothNet x \ first_bothNet a) \ NetsCollected (y # z) \ + NetsCollected (separate (y # z)) \ first_bothNet x \ firstList (separate (y # z)) \ + a \ set (separate (y # z)) \ + first_bothNet (x::('a,'b)Combinators) \ first_bothNet (a::('a,'b)Combinators)" + by (rule fBNsep1) auto + + +lemma NetsCollectedSep[rule_format]: + "noDenyAll1 p \ NetsCollected p \ NetsCollected (separate p)" +proof (induct p rule: separate.induct, simp_all, goal_cases) + fix x::"('a, 'b) Combinators list" + case 1 then show ?case + by (metis fMTaux noDA noDA1eq noDAsep) +next + fix v va y fix z::"('a, 'b) Combinators list" + case 2 then show ?case + apply (intro conjI impI, simp) + apply (metis NetsCollectedSepaux fl3 noDA1eq noDenyAll.simps(1)) + by (metis noDA1eq noDenyAll.simps(1)) +next + fix v va vb y fix z::"('a, 'b) Combinators list" + case 3 then show ?case + apply (intro conjI impI) + apply (metis NetsCollectedSepaux fl3 noDA1eq noDenyAll.simps(1)) + by (metis noDA1eq noDenyAll.simps(1)) +next + fix v va y fix z::"('a, 'b) Combinators list" + case 4 then show ?case + by (metis NetsCollectedSepaux fl3 noDA1eq noDenyAll.simps(1)) +qed + + +lemma OTNaux: + "onlyTwoNets a \ \ member DenyAll a \ (x,y) \ sdnets a \ + (x = first_srcNet a \ y = first_destNet a) \ (x = first_destNet a \ y = first_srcNet a)" + apply (case_tac "(x = first_srcNet a \ y = first_destNet a)",simp_all add: onlyTwoNets_def) + apply (case_tac "(\aa b. sdnets a = {(aa, b)})", simp_all) + apply (subgoal_tac "sdnets a = {(first_srcNet a,first_destNet a)}", simp_all) + apply (metis singletonE first_isIn) + apply (subgoal_tac"sdnets a = {(first_srcNet a,first_destNet a),(first_destNet a, first_srcNet a)}") + by(auto intro!: sdnets2) + +lemma sdnets_charn: "onlyTwoNets a \ \ member DenyAll a \ +sdnets a = {(first_srcNet a,first_destNet a)} \ +sdnets a = {(first_srcNet a, first_destNet a),(first_destNet a, first_srcNet a)}" + apply (case_tac "sdnets a = {(first_srcNet a, first_destNet a)}", simp_all add: onlyTwoNets_def) + apply (case_tac "(\aa b. sdnets a = {(aa, b)})", simp_all) + apply (metis singletonE first_isIn) + apply (subgoal_tac "sdnets a = {(first_srcNet a,first_destNet a),(first_destNet a,first_srcNet a)}") + by( auto intro!: sdnets2) + +lemma first_bothNet_charn[rule_format]: + "\ member DenyAll a \ first_bothNet a = {first_srcNet a, first_destNet a}" + by (induct a) simp_all + + +lemma sdnets_noteq: + "onlyTwoNets a \ onlyTwoNets aa \ first_bothNet a \ first_bothNet aa \ + \ member DenyAll a \ \ member DenyAll aa \ sdnets a \ sdnets aa" + apply (insert sdnets_charn [of a]) + apply (insert sdnets_charn [of aa]) + apply (insert first_bothNet_charn [of a]) + apply (insert first_bothNet_charn [of aa]) + by(metis OTNaux first_isIn insert_absorb2 insert_commute) + + + +lemma fbn_noteq: + "onlyTwoNets a \ onlyTwoNets aa \ first_bothNet a \ first_bothNet aa \ + \ member DenyAll a \ \ member DenyAll aa \ allNetsDistinct [a, aa] \ + first_srcNet a \ first_srcNet aa \ first_srcNet a \ first_destNet aa \ + first_destNet a \ first_srcNet aa \ first_destNet a \ first_destNet aa" + apply (insert sdnets_charn [of a]) + apply (insert sdnets_charn [of aa]) + by (metis first_bothNet_charn) + + +lemma NCisSD2aux: + assumes 1: "onlyTwoNets a" and 2 : "onlyTwoNets aa" and 3 : "first_bothNet a \ first_bothNet aa" + and 4: "\ member DenyAll a" and 5: "\ member DenyAll aa" and 6:" allNetsDistinct [a, aa]" + shows "disjSD_2 a aa" + apply (insert 1 2 3 4 5 6) + apply (simp add: disjSD_2_def) + apply (intro allI impI) + apply (insert sdnets_charn [of a] sdnets_charn [of aa], simp) + apply (insert sdnets_noteq [of a aa] fbn_noteq [of a aa], simp) + apply (simp add: allNetsDistinct_def twoNetsDistinct_def) +proof - + fix ab b c d + assume 7: "\ab b. ab\b \ ab\set(net_list_aux[a,aa]) \ b\set(net_list_aux [a,aa]) \ netsDistinct ab b" + and 8: "(ab, b) \ sdnets a \ (c, d) \ sdnets aa " + and 9: "sdnets a = {(first_srcNet a, first_destNet a)} \ + sdnets a = {(first_srcNet a, first_destNet a), (first_destNet a, first_srcNet a)} " + and 10: "sdnets aa = {(first_srcNet aa, first_destNet aa)} \ + sdnets aa = {(first_srcNet aa, first_destNet aa), (first_destNet aa, first_srcNet aa)}" + and 11: "sdnets a \ sdnets aa " + and 12: "first_destNet a = first_srcNet aa \ first_srcNet a = first_destNet aa \ + first_destNet aa \ first_srcNet aa" + show "(netsDistinct ab c \ netsDistinct b d) \ (netsDistinct ab d \ netsDistinct b c)" + + proof (rule conjI) + show "netsDistinct ab c \ netsDistinct b d" + apply(insert 7 8 9 10 11 12) + apply (cases "sdnets a = {(first_srcNet a, first_destNet a)}") + apply (cases "sdnets aa = {(first_srcNet aa, first_destNet aa)}", simp_all) + apply (metis 4 5 firstInNeta firstInNet alternativelistconc2) + apply (case_tac "(c = first_srcNet aa \ d = first_destNet aa)", simp_all) + apply (case_tac "(first_srcNet a) \ (first_srcNet aa)",simp_all) + apply (metis 4 5 firstInNeta alternativelistconc2) + apply (subgoal_tac "first_destNet a \ first_destNet aa") + apply (metis 4 5 firstInNet alternativelistconc2) + apply (metis 3 4 5 first_bothNetsd) + apply (case_tac "(first_destNet aa) \ (first_srcNet a)",simp_all) + apply (metis 4 5 firstInNeta firstInNet alternativelistconc2) + apply (case_tac "first_destNet aa \ first_destNet a",simp_all) + apply (subgoal_tac "first_srcNet aa \ first_destNet a") + apply (metis 4 5 firstInNeta firstInNet alternativelistconc2) + apply (metis 3 4 5 first_bothNetsd insert_commute) + apply (metis 5 firstInNeta firstInNet alternativelistconc2) + apply (case_tac "(c = first_srcNet aa \ d = first_destNet aa)", simp_all) + apply (case_tac "(ab = first_srcNet a \ b = first_destNet a)", simp_all) + apply (case_tac "(first_srcNet a) \ (first_srcNet aa)",simp_all) + apply (metis 4 5 firstInNeta alternativelistconc2) + apply (subgoal_tac "first_destNet a \ first_destNet aa") + apply (metis 4 5 firstInNet alternativelistconc2) + apply (metis 3 4 5 first_bothNetsd ) + apply (case_tac "(first_destNet aa) \ (first_srcNet a)",simp_all) + apply (metis 4 5 firstInNeta firstInNet alternativelistconc2) + apply (case_tac "first_destNet aa \ first_destNet a", simp) + apply (subgoal_tac "first_srcNet aa \ first_destNet a") + apply (metis 4 5 firstInNeta firstInNet alternativelistconc2) + apply (metis 3 4 5 first_bothNetsd insert_commute) + apply (metis) + + proof - + assume 14 : "(ab = first_srcNet a \ b = first_destNet a \ ab = first_destNet a \ b = first_srcNet a) \ (c, d) \ sdnets aa " + and 15 : "sdnets a = {(first_srcNet a, first_destNet a), (first_destNet a, first_srcNet a)} " + and 16 : "sdnets aa = {(first_srcNet aa, first_destNet aa)} \ sdnets aa = {(first_srcNet aa, first_destNet aa), (first_destNet aa, first_srcNet aa)} " + and 17 : "{(first_srcNet a, first_destNet a), (first_destNet a, first_srcNet a)} \ sdnets aa " + and 18 : "first_destNet a = first_srcNet aa \ first_srcNet a = first_destNet aa \ first_destNet aa \ first_srcNet aa " + and 19 : "first_destNet a \ first_srcNet a" + and 20 : "c = first_srcNet aa \ d \ first_destNet aa" + show " netsDistinct ab c \ netsDistinct b d" + + apply (case_tac "(ab = first_srcNet a \ b = first_destNet a)",simp_all) + apply (case_tac "c = first_srcNet aa", simp_all) + apply (metis 2 5 14 20 OTNaux) + apply (subgoal_tac "c = first_destNet aa", simp) + apply (subgoal_tac "d = first_srcNet aa", simp) + apply (case_tac "(first_srcNet a) \ (first_destNet aa)",simp_all) + apply (metis 4 5 7 firstInNeta firstInNet alternativelistconc2) + apply (subgoal_tac "first_destNet a \ first_srcNet aa") + apply (metis 4 5 7 firstInNeta firstInNet alternativelistconc2) + apply (metis 3 4 5 first_bothNetsd insert_commute) + apply (metis 2 5 14 OTNaux) + apply (metis 2 5 14 OTNaux) + apply (case_tac "c = first_srcNet aa", simp_all) + apply (metis 2 5 14 20 OTNaux) + apply (subgoal_tac "c = first_destNet aa", simp) + apply (subgoal_tac "d = first_srcNet aa", simp) + apply (case_tac "(first_destNet a) \ (first_destNet aa)",simp_all) + apply (metis 4 5 7 14 firstInNet alternativelistconc2) + apply (subgoal_tac "first_srcNet a \ first_srcNet aa") + apply (metis 4 5 7 14 firstInNeta alternativelistconc2) + apply (metis 3 4 5 first_bothNetsd insert_commute) + apply (metis 2 5 14 OTNaux) + apply (metis 2 5 14 OTNaux) + done + qed + next + show "netsDistinct ab d \ netsDistinct b c" + apply (insert 1 2 3 4 5 6 7 8 9 10 11 12) + apply (cases "sdnets a = {(first_srcNet a, first_destNet a)}") + apply (cases "sdnets aa = {(first_srcNet aa, first_destNet aa)}", simp_all) + apply (case_tac "(c = first_srcNet aa \ d = first_destNet aa)", simp_all) + apply (case_tac "(first_srcNet a) \ (first_destNet aa)", simp_all) + apply (metis firstInNeta firstInNet alternativelistconc2) + apply (subgoal_tac "first_destNet a \ first_srcNet aa") + apply (metis firstInNeta firstInNet alternativelistconc2) + apply (metis first_bothNetsd insert_commute) + apply (case_tac "(c = first_srcNet aa \ d = first_destNet aa)", simp_all) + apply (case_tac "(ab = first_srcNet a \ b = first_destNet a)", simp_all) + apply (case_tac "(first_destNet a) \ (first_srcNet aa)",simp_all) + apply (metis firstInNeta firstInNet alternativelistconc2) + apply (subgoal_tac "first_srcNet a \ first_destNet aa") + apply (metis firstInNeta firstInNet alternativelistconc2) + apply (metis first_bothNetsd insert_commute) + apply (case_tac "(first_srcNet aa) \ (first_srcNet a)",simp_all) + apply (metis firstInNeta alternativelistconc2) + apply (case_tac "first_destNet aa \ first_destNet a",simp_all) + apply (metis firstInNet alternativelistconc2) + apply (metis first_bothNetsd) + proof - + assume 13:" \ab b. ab \ b \ ab\set(net_list_aux[a,aa]) \ b \ set(net_list_aux[a,aa]) + \ netsDistinct ab b " + and 14 : "(ab = first_srcNet a \ b = first_destNet a \ + ab = first_destNet a \ b = first_srcNet a) \ (c, d) \ sdnets aa " + and 15 : " sdnets a = {(first_srcNet a, first_destNet a), + (first_destNet a, first_srcNet a)} " + and 16 : " sdnets aa = {(first_srcNet aa, first_destNet aa)} \ + sdnets aa = {(first_srcNet aa, first_destNet aa), + (first_destNet aa, first_srcNet aa)} " + and 17 : " {(first_srcNet a, first_destNet a), + (first_destNet a, first_srcNet a)} \ sdnets aa " + show "first_destNet a \ first_srcNet a \ netsDistinct ab d \ netsDistinct b c" + apply (insert 1 2 3 4 5 6 13 14 15 16 17) + apply (cases "sdnets aa = {(first_srcNet aa, first_destNet aa)}", simp_all) + apply (case_tac "(c = first_srcNet aa \ d = first_destNet aa)", simp_all) + apply (case_tac "(ab = first_srcNet a \ b = first_destNet a)", simp_all) + apply (case_tac "(first_destNet a) \ (first_srcNet aa)",simp_all) + apply (metis firstInNeta firstInNet alternativelistconc2) + apply (subgoal_tac "first_srcNet a \ first_destNet aa") + apply (metis firstInNeta firstInNet alternativelistconc2) + apply (metis first_bothNetsd insert_commute) + apply (case_tac "(first_srcNet aa) \ (first_srcNet a)",simp_all) + apply (metis firstInNeta alternativelistconc2) + apply (case_tac "first_destNet aa \ first_destNet a",simp_all) + apply (metis firstInNet alternativelistconc2) + apply (metis first_bothNetsd) + proof - + assume 20: "{(first_srcNet a, first_destNet a), (first_destNet a, first_srcNet a)} \ + {(first_srcNet aa, first_destNet aa), (first_destNet aa, first_srcNet aa)}" + and 21: "first_destNet a \ first_srcNet a" + show "netsDistinct ab d \ netsDistinct b c" + apply (case_tac "(c = first_srcNet aa \ d = first_destNet aa)", simp_all) + apply (case_tac "(ab = first_srcNet a \ b = first_destNet a)", simp_all) + apply (case_tac "(first_destNet a) \ (first_srcNet aa)", simp_all) + apply (metis 4 5 7 firstInNeta firstInNet alternativelistconc2) + apply (subgoal_tac "first_srcNet a \ first_destNet aa") + apply (metis 4 5 7 firstInNeta firstInNet alternativelistconc2) + apply (metis 20 insert_commute) + apply (case_tac "(first_srcNet aa) \ (first_srcNet a)", simp_all) + apply (metis 4 5 13 14 firstInNeta alternativelistconc2) + apply (case_tac "first_destNet aa \ first_destNet a", simp_all) + apply (metis 4 5 13 14 firstInNet alternativelistconc2) + apply (case_tac "(ab = first_srcNet a \ b = first_destNet a)", simp_all) + apply (case_tac "(first_destNet a) \ (first_srcNet aa)", simp_all) + apply (metis 20) + apply (subgoal_tac "first_srcNet a \ first_srcNet aa") + apply (metis 20) + apply (metis 21) + apply (case_tac "(first_srcNet aa) \ (first_destNet a)") + apply (metis (no_types, lifting) 2 3 4 5 7 14 OTNaux + firstInNet firstInNeta first_bothNetsd isInAlternativeList) + by (metis 2 4 5 7 20 14 OTNaux doubleton_eq_iff firstInNet + firstInNeta isInAlternativeList) + qed + qed + qed +qed + +lemma ANDaux3[rule_format]: + "y \ set xs \ a \ set (net_list_aux [y]) \ a \ set (net_list_aux xs)" + by (induct xs) (simp_all add: isInAlternativeList) + + +lemma ANDaux2: + "allNetsDistinct (x # xs) \ y \ set xs \ allNetsDistinct [x,y]" + apply (simp add: allNetsDistinct_def) + by (meson ANDaux3 isInAlternativeList netlistaux) + + + +lemma NCisSD2[rule_format]: + "\ member DenyAll a \ OnlyTwoNets (a#p) \ + NetsCollected2 (a # p) \ NetsCollected (a#p) \ + noDenyAll ( p) \ allNetsDistinct (a # p) \ s \ set p \ + disjSD_2 a s" + by (metis ANDaux2 FWNormalisationCore.member.simps(2) NCisSD2aux NetsCollected.simps(1) + NetsCollected2.simps(1) OTNConc OTNoTN empty_iff empty_set list.set_intros(1) noDA) + + +lemma separatedNC[rule_format]: + "OnlyTwoNets p \ NetsCollected2 p \ NetsCollected p \ noDenyAll1 p \ + allNetsDistinct p \ separated p" +proof (induct p, simp_all, case_tac "a = DenyAll", simp_all, goal_cases) + fix a fix p::"('a set set, 'b) Combinators list" + show "OnlyTwoNets p \ NetsCollected2 p \ NetsCollected p \ noDenyAll1 p \ + allNetsDistinct p \ separated p \ a \ DenyAll \ OnlyTwoNets (a # p) \ + first_bothNet a \ firstList p \ NetsCollected2 p \ + (\aa\set p. first_bothNet a \ first_bothNet aa) \ NetsCollected p \ + noDenyAll1 (a # p) \ allNetsDistinct (a # p) \ (\s. s \ set p \ + disjSD_2 a s) \ separated p" + apply (intro impI,drule mp, erule OTNConc,drule mp) + apply (case_tac p, simp_all) + apply (drule mp,erule noDA1C, intro conjI allI impI NCisSD2, simp_all) + apply (case_tac a, simp_all) + apply (case_tac a, simp_all) + using ANDConc by auto +next + fix a::"('a set set,'b) Combinators " fix p ::"('a set set,'b) Combinators list" + show "OnlyTwoNets p \ NetsCollected2 p \ NetsCollected p \ noDenyAll1 p \ + allNetsDistinct p \ separated p \ a = DenyAll \ OnlyTwoNets p \ + {}\firstList p \ NetsCollected2 p \ (\a\set p. {}\first_bothNet a)\NetsCollected p \ + noDenyAll p \ allNetsDistinct (DenyAll # p) \ + (\s. s \ set p \ disjSD_2 DenyAll s) \ separated p" + by (simp add: ANDConc disjSD_2_def noDA1eq) +qed + +lemma separatedNC'[rule_format]: + "OnlyTwoNets p \ NetsCollected2 p \ NetsCollected p \ noDenyAll1 p \ + allNetsDistinct p \ separated p" +proof (induct p) + case Nil show ?case by simp +next + case (Cons a p) then show ?case + apply simp + proof (cases "a = DenyAll") print_cases + case True + then show "OnlyTwoNets (a # p) \ first_bothNet a \ firstList p \ NetsCollected2 p \ + (\aa\set p. first_bothNet a \ first_bothNet aa) \ NetsCollected p \ + noDenyAll1 (a # p) \ allNetsDistinct (a # p) \ + (\s. s \ set p \ disjSD_2 a s) \ separated p" + apply(insert Cons.hyps `a = DenyAll`) + apply (intro impI,drule mp, erule OTNConc,drule mp) + apply (case_tac p, simp_all) + apply (case_tac a, simp_all) + apply (case_tac a, simp_all) + by (simp add: ANDConc disjSD_2_def noDA1eq) + next + case False + then show "OnlyTwoNets (a # p) \ first_bothNet a \ firstList p \ NetsCollected2 p \ + (\aa\set p. first_bothNet a \ first_bothNet aa) \ NetsCollected p \ + noDenyAll1 (a # p) \ allNetsDistinct (a # p) \ (\s. s \ set p \ + disjSD_2 a s) \ separated p" + apply(insert Cons.hyps `a \ DenyAll`) + by (metis NetsCollected.simps(1) NetsCollected2.simps(1) separated.simps(1) separatedNC) + qed +qed + + +lemma NC2Sep[rule_format]: "noDenyAll1 p \ NetsCollected2 (separate p)" +proof (induct p rule: separate.induct, simp_all, goal_cases) + fix x :: "('a, 'b) Combinators list" + case 1 then show ?case + by (metis fMTaux firstList.simps(1) fl2 noDA1eq noDenyAll.elims(2) separate.simps(5)) +next + fix v va fix y::" ('a, 'b) Combinators" fix z + case 2 then show ?case + by (simp add: firstList.simps(1) fl2 noDA1eq noDenyAll.simps(1)) +next + fix v va vb fix y::" ('a, 'b) Combinators" fix z + case 3 then show ?case + by (simp add: firstList.simps(1) fl2 noDA1eq noDenyAll.simps(1)) +next + fix v va fix y::" ('a, 'b) Combinators" fix z + case 4 then show ?case + by (simp add: firstList.simps(1) fl2 noDA1eq noDenyAll.simps(1)) +qed + +lemma separatedSep[rule_format]: + "OnlyTwoNets p \ NetsCollected2 p \ NetsCollected p \ + noDenyAll1 p \ allNetsDistinct p \ separated (separate p)" + by (simp add: ANDSep NC2Sep NetsCollectedSep OTNSEp noDA1sep separatedNC) + + +lemma rADnMT[rule_format]: "p \ [] \ removeAllDuplicates p \ []" + by (induct p) simp_all + + (* TODO: Prove this lemma: +lemma all2: "all_in_list (policy2list p) (Nets_List p)" +apply (induct "policy2list p" "Nets_List p" rule: all_in_list.induct) +apply simp_all +*) + +lemma remDupsNMT[rule_format]: "p \ [] \ remdups p \ []" + by (metis remdups_eq_nil_iff) + +lemma sets_distinct1: "(n::int) \ m \ {(a,b). a = n} \ {(a,b). a = m}" + by auto + +lemma sets_distinct2: "(m::int) \ n \ {(a,b). a = n} \ {(a,b). a = m}" + by auto + +lemma sets_distinct5: "(n::int) < m \ {(a,b). a = n} \ {(a,b). a = m}" + by auto + +lemma sets_distinct6: "(m::int) < n \ {(a,b). a = n} \ {(a,b). a = m}" + by auto + +end + \ No newline at end of file diff --git a/FWNormalisation/NormalisationIPPProofs.thy b/FWNormalisation/NormalisationIPPProofs.thy new file mode 100644 index 0000000..98b4abe --- /dev/null +++ b/FWNormalisation/NormalisationIPPProofs.thy @@ -0,0 +1,1959 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Normalisation Proofs: Integer Protocol *} +theory NormalisationIPPProofs +imports NormalisationIntegerPortProof +begin + +text{* Normalisation proofs which are specific to the IntegerProtocol address representation. *} + +lemma ConcAssoc: "Cp((A \ B) \ D) = Cp(A \ (B \ D))" +by (simp add: Cp.simps) + + +lemma aux26[simp]: + "twoNetsDistinct a b c d \ dom (Cp (AllowPortFromTo a b p)) \ dom (Cp (DenyAllFromTo c d)) = {}" +by(auto simp:twoNetsDistinct_def netsDistinct_def PLemmas, auto) + + +lemma wp2_aux[rule_format]: + "wellformed_policy2Pr (xs @ [x]) \ wellformed_policy2Pr xs" +by (induct xs, simp_all) (case_tac "a", simp_all) + +lemma Cdom2: "x \ dom(Cp b) \ Cp (a \ b) x = (Cp b) x" +by (auto simp: Cp.simps) + +lemma wp2Conc[rule_format]: "wellformed_policy2Pr (x#xs) \ wellformed_policy2Pr xs" +by (case_tac "x",simp_all) + +lemma DAimpliesMR_E[rule_format]: "DenyAll \ set p \ + (\ r. applied_rule_rev Cp x p = Some r)" +apply (simp add: applied_rule_rev_def) +apply (rule_tac xs = p in rev_induct, simp_all) +by (metis Cp.simps(1) denyAllDom) + + + +lemma DAimplieMR[rule_format]: "DenyAll \ set p \ applied_rule_rev Cp x p \ None" +by (auto intro: DAimpliesMR_E) + +lemma MRList1[rule_format]: "x \ dom (Cp a) \ applied_rule_rev Cp x (b@[a]) = Some a" +by (simp add: applied_rule_rev_def) + +lemma MRList2: "x \ dom (Cp a) \ applied_rule_rev Cp x (c@b@[a]) = Some a" +by (simp add: applied_rule_rev_def) + +lemma MRList3: + "x \ dom(Cp xa) \ applied_rule_rev Cp x (a@b#xs@[xa]) = applied_rule_rev Cp x (a @ b # xs)" +by (simp add: applied_rule_rev_def) + +lemma CConcEnd[rule_format]: + "Cp a x = Some y \ Cp (list2FWpolicy (xs @ [a])) x = Some y" (is "?P xs") +apply (rule_tac P = ?P in list2FWpolicy.induct) +by (simp_all add:Cp.simps) + +lemma CConcStartaux: "Cp a x = None \ (Cp aa ++ Cp a) x = Cp aa x" +by (simp add: PLemmas) + +lemma CConcStart[rule_format]: + "xs \ [] \ Cp a x = None \ Cp (list2FWpolicy (xs @ [a])) x = Cp (list2FWpolicy xs) x" +by (rule list2FWpolicy.induct) (simp_all add: PLemmas) + + +lemma mrNnt[simp]: "applied_rule_rev Cp x p = Some a \ p \ []" +by (simp add: applied_rule_rev_def)(auto) + +lemma mr_is_C[rule_format]: + "applied_rule_rev Cp x p = Some a \ Cp (list2FWpolicy (p)) x = Cp a x" +apply (simp add: applied_rule_rev_def) +apply (rule rev_induct, simp_all, safe) +apply (metis CConcEnd ) +apply (metis CConcEnd) +by (metis CConcStart applied_rule_rev_def mrNnt option.exhaust) + + +lemma CConcStart2: + "p \ [] \ x \ dom (Cp a) \ Cp(list2FWpolicy (p@[a])) x = Cp (list2FWpolicy p)x" +by (erule CConcStart,simp add: PLemmas) + +lemma CConcEnd1: + "q@p \ [] \ x \ dom (Cp a) \ Cp(list2FWpolicy(q@p@[a])) x = Cp (list2FWpolicy (q@p))x" +by (subst lCdom2) (rule CConcStart2, simp_all) + +lemma CConcEnd2[rule_format]: + "x \ dom (Cp a) \ Cp (list2FWpolicy (xs @ [a])) x = Cp a x" (is "?P xs") +by (rule_tac P = ?P in list2FWpolicy.induct) (auto simp:Cp.simps) + + +lemma bar3: + "x \ dom (Cp (list2FWpolicy (xs @ [xa]))) \ x \ dom (Cp (list2FWpolicy xs)) \ x \ dom (Cp xa)" +by auto (metis CConcStart eq_Nil_appendI l2p_aux2 option.simps(3)) + + +lemma CeqEnd[rule_format,simp]: + "a \ [] \ x \ dom (Cp(list2FWpolicy a)) \ Cp(list2FWpolicy(b@a)) x = (Cp(list2FWpolicy a)) x" +proof (induct rule: rev_induct)print_cases + case Nil show ?case by simp +next + case (snoc xa xs) show ?case + apply (case_tac "xs \ []", simp_all) + apply (case_tac "x \ dom (Cp xa)") + apply (metis CConcEnd2 MRList2 mr_is_C ) + apply (metis snoc.hyps CConcEnd1 CConcStart2 Nil_is_append_conv bar3 ) + by (metis MRList2 eq_Nil_appendI mr_is_C ) +qed + +lemma CConcStartA[rule_format,simp]: + "x \ dom (Cp a) \ x \ dom (Cp (list2FWpolicy (a # b)))" (is "?P b") +by (rule_tac P = ?P in list2FWpolicy.induct) (simp_all add: Cp.simps) + + +lemma domConc: + "x \ dom (Cp (list2FWpolicy b)) \ b \ [] \ x \ dom (Cp (list2FWpolicy (a@b)))" +by (auto simp: PLemmas) + +lemma CeqStart[rule_format,simp]: + "x \ dom (Cp (list2FWpolicy a)) \ a \ [] \ b \ [] \ + Cp (list2FWpolicy (b@a)) x = (Cp (list2FWpolicy b)) x" +by (rule list2FWpolicy.induct,simp_all) (auto simp: list2FWpolicyconc PLemmas) + + +lemma C_eq_if_mr_eq2: + "applied_rule_rev Cp x a = Some r \ applied_rule_rev Cp x b = Some r \ a\[] \ b\[] \ + (Cp (list2FWpolicy a)) x = (Cp (list2FWpolicy b)) x" +by (metis mr_is_C) + + +lemma nMRtoNone[rule_format]: + "p \ [] \ applied_rule_rev Cp x p = None \ Cp (list2FWpolicy p) x = None" +proof (induct rule: rev_induct) print_cases + case Nil show ?case by simp +next + case (snoc xa xs) show ?case + apply (case_tac "xs = []", simp_all) + by (simp_all add: snoc.hyps applied_rule_rev_def dom_def) +qed + + +lemma C_eq_if_mr_eq: + "applied_rule_rev Cp x b = applied_rule_rev Cp x a \ a \ [] \ b \ [] \ + (Cp (list2FWpolicy a)) x = (Cp (list2FWpolicy b)) x" +apply (cases "applied_rule_rev Cp x a = None", simp_all) +apply (subst nMRtoNone,simp_all) +apply (subst nMRtoNone,simp_all) +by (auto intro: C_eq_if_mr_eq2) + + +lemma notmatching_notdom: + "applied_rule_rev Cp x (p@[a]) \ Some a \ x \ dom (Cp a)" +by (simp add: applied_rule_rev_def split: if_splits) + +lemma foo3a[rule_format]: + "applied_rule_rev Cp x (a@[b]@c) = Some b \ r \ set c \ b \ set c \ x \ dom (Cp r)" +proof (induct rule: rev_induct) + case Nil show ?case by simp +next + case (snoc xa xs) show ?case + apply simp_all + apply (rule impI|rule conjI|simp)+ + apply (rule_tac p = "a @ b # xs" in notmatching_notdom,simp_all) + by (metis Cons_eq_appendI NormalisationIPPProofs.MRList2 NormalisationIPPProofs.MRList3 + append_Nil option.inject snoc.hyps) +qed + +lemma foo3D: + "wellformed_policy1 p \ p=DenyAll#ps \ applied_rule_rev Cp x p = Some DenyAll \ r\set ps \ + x \ dom (Cp r)" +by (rule_tac a = "[]" and b = "DenyAll" and c = "ps" in foo3a, simp_all) + +lemma foo4[rule_format]: + "set p = set s \ (\ r. r \ set p \ x \ dom (Cp r)) \ (\ r .r \ set s \ x \ dom (Cp r))" +by simp + +lemma foo5b[rule_format]: + "x \ dom (Cp b) \ (\ r. r \ set c \ x \ dom (Cp r))\ applied_rule_rev Cp x (b#c) = Some b" +apply (simp add: applied_rule_rev_def) +apply (rule_tac xs = c in rev_induct, simp_all) +done + +lemma mr_first: + "x \ dom (Cp b) \ (\ r. r \ set c \ x \ dom (Cp r)) \ s = b#c \ + applied_rule_rev Cp x s = Some b" +by (simp add: foo5b) + +lemma mr_charn[rule_format]: + "a \ set p \ (x \ dom (Cp a)) \(\ r. r \ set p \ x \ dom (Cp r) \ r = a) \ + applied_rule_rev Cp x p = Some a" +apply(rule_tac xs = p in rev_induct) +apply(simp_all only:applied_rule_rev_def) +apply(simp,safe,simp_all) +by(auto) + +lemma foo8: + "\ r. r \ set p \ x \ dom (Cp r) \ r = a \ set p = set s \ + \ r. r \ set s \ x \ dom (Cp r) \ r = a" +by auto + +lemma mrConcEnd[rule_format]: + "applied_rule_rev Cp x (b # p) = Some a \ a \ b \ applied_rule_rev Cp x p = Some a" +apply (simp add: applied_rule_rev_def) +apply (rule_tac xs = p in rev_induct,simp_all) +by auto + + +lemma wp3tl[rule_format]: "wellformed_policy3Pr p \ wellformed_policy3Pr (tl p)" +by (induct p, simp_all, case_tac a, simp_all) + +lemma wp3Conc[rule_format]: "wellformed_policy3Pr (a#p) \ wellformed_policy3Pr p" +by (induct p, simp_all, case_tac a, simp_all) + + +lemma foo98[rule_format]: + "applied_rule_rev Cp x (aa # p) = Some a \ x \ dom (Cp r) \ r \ set p \ a \ set p" +unfolding applied_rule_rev_def +proof (induct rule: rev_induct) + case Nil show ?case by simp +next + case (snoc xa xs) then show ?case + by simp_all (case_tac "r = xa", simp_all) +qed + + +lemma mrMTNone[simp]: "applied_rule_rev Cp x [] = None" +by (simp add: applied_rule_rev_def) + +lemma DAAux[simp]: "x \ dom (Cp DenyAll)" +by (simp add: dom_def PolicyCombinators.PolicyCombinators Cp.simps) + +lemma mrSet[rule_format]: "applied_rule_rev Cp x p = Some r \ r \ set p" +unfolding applied_rule_rev_def +by (rule_tac xs=p in rev_induct) simp_all + + +lemma mr_not_Conc: "singleCombinators p \ applied_rule_rev Cp x p \ Some (a\b)" +by (auto simp: mrSet dest: mrSet elim: SCnotConc) + + +lemma foo25[rule_format]: "wellformed_policy3Pr (p@[x]) \ wellformed_policy3Pr p" +by (induct p, simp_all, case_tac a, simp_all) + +lemma mr_in_dom[rule_format]: "applied_rule_rev Cp x p = Some a \ x \ dom (Cp a)" +by (rule_tac xs = p in rev_induct) (auto simp: applied_rule_rev_def) + + +lemma wp3EndMT[rule_format]: + "wellformed_policy3Pr (p@[xs]) \ AllowPortFromTo a b po \ set p \ + dom (Cp (AllowPortFromTo a b po)) \ dom (Cp xs) = {}" +apply (induct p,simp_all) +by (metis NormalisationIPPProofs.wp3Conc aux0_4 inf_commute list.set_intros(1) wellformed_policy3Pr.simps(2)) + + +lemma foo29: "dom (Cp a) \ {} \ dom (Cp a) \ dom (Cp b) = {} \ a \ b" +by auto + +lemma foo28: + "AllowPortFromTo a b po\set p \ dom(Cp(AllowPortFromTo a b po))\{} \ + (wellformed_policy3Pr(p@[x])) \ + x \ AllowPortFromTo a b po" +by (metis foo29 Cp.simps(3) wp3EndMT) + +lemma foo28a[rule_format]: "x \ dom (Cp a) \ dom (Cp a) \ {}" +by auto + +lemma allow_deny_dom[simp]: + "dom (Cp (AllowPortFromTo a b po)) \ dom (Cp (DenyAllFromTo a b))" +by (simp_all add: twoNetsDistinct_def netsDistinct_def PLemmas) auto + +lemma DenyAllowDisj: + "dom (Cp (AllowPortFromTo a b p)) \ {} \ + dom (Cp (DenyAllFromTo a b)) \ dom (Cp (AllowPortFromTo a b p)) \ {}" +by (metis Int_absorb1 allow_deny_dom) + +lemma foo31: + "\ r. r \ set p \ x \ dom (Cp r) \ + (r = AllowPortFromTo a b po \ r = DenyAllFromTo a b \ r = DenyAll) \ + set p = set s \ + (\r. r\set s \ x\dom(Cp r) \ r=AllowPortFromTo a b po \ r=DenyAllFromTo a b \ r = DenyAll)" +by auto + + +lemma wp1_auxa: "wellformed_policy1_strong p\(\ r. applied_rule_rev Cp x p = Some r)" +apply (rule DAimpliesMR_E) +by (erule wp1_aux1aa) + + +lemma deny_dom[simp]: + "twoNetsDistinct a b c d \ dom (Cp (DenyAllFromTo a b)) \ dom (Cp (DenyAllFromTo c d)) = {}" +by (simp add: Cp.simps) (erule aux6) + +lemma domTrans: "\dom a \ dom b; dom(b) \ dom (c) = {}\ \ dom(a) \ dom(c) = {}" +by auto + +lemma DomInterAllowsMT: + " twoNetsDistinct a b c d \ dom (Cp(AllowPortFromTo a b p)) \ dom(Cp(AllowPortFromTo c d po))={}" +apply (case_tac "p = po", simp_all) +apply (rule_tac b = "Cp (DenyAllFromTo a b)" in domTrans, simp_all) +apply (metis domComm aux26 tNDComm) +apply (simp add: twoNetsDistinct_def netsDistinct_def PLemmas) +by (auto simp: prod_eqI) + + +lemma DomInterAllowsMT_Ports: + "p \ po \ dom (Cp (AllowPortFromTo a b p)) \ dom (Cp (AllowPortFromTo c d po)) = {}" +apply (simp add: twoNetsDistinct_def netsDistinct_def PLemmas) +by (auto simp: prod_eqI) + + +lemma wellformed_policy3_charn[rule_format]: + "singleCombinators p \ distinct p \ allNetsDistinct p \ + wellformed_policy1 p \ wellformed_policy2Pr p \ wellformed_policy3Pr p" +proof (induct p) + case Nil show ?case by simp +next + case (Cons a p) then show ?case + apply (auto intro: singleCombinatorsConc ANDConc waux2 wp2Conc) + apply (case_tac a,simp_all, clarify) + apply (case_tac r,simp_all) + apply (metis Int_commute) + apply (metis DomInterAllowsMT aux7aa DomInterAllowsMT_Ports) + apply (metis aux0_0 ) + done +qed + + +lemma DistinctNetsDenyAllow: + "DenyAllFromTo b c \ set p \ AllowPortFromTo a d po \ set p\ allNetsDistinct p \ + dom (Cp (DenyAllFromTo b c)) \ dom (Cp (AllowPortFromTo a d po)) \ {}\ + b = a \ c = d" +apply (simp add: allNetsDistinct_def) +apply (frule_tac x = "b" in spec) +apply (drule_tac x = "d" in spec) +apply (drule_tac x = "a" in spec) +apply (drule_tac x = "c" in spec) +apply (metis Int_commute ND0aux1 ND0aux3 NDComm aux26 twoNetsDistinct_def ND0aux2 ND0aux4) +done + +lemma DistinctNetsAllowAllow: + "AllowPortFromTo b c poo \ set p \ AllowPortFromTo a d po \ set p \ + allNetsDistinct p \ dom(Cp(AllowPortFromTo b c poo)) \ dom(Cp(AllowPortFromTo a d po)) \ {} \ + b = a \ c = d \ poo = po" +apply (simp add: allNetsDistinct_def) +apply (frule_tac x = "b" in spec) +apply (drule_tac x = "d" in spec) +apply (drule_tac x = "a" in spec) +apply (drule_tac x = "c" in spec) +apply (metis DomInterAllowsMT DomInterAllowsMT_Ports ND0aux3 ND0aux4 NDComm twoNetsDistinct_def) +done + + + +lemma WP2RS2[simp]: + "singleCombinators p \ distinct p \ allNetsDistinct p \ + wellformed_policy2Pr (removeShadowRules2 p)" +proof (induct p) + case Nil + then show ?case by simp +next + case (Cons x xs) + have wp_xs: "wellformed_policy2Pr (removeShadowRules2 xs)" + by (metis Cons ANDConc distinct.simps(2) singleCombinatorsConc) + show ?case + proof (cases x) + case DenyAll thus ?thesis using wp_xs by simp + next + case (DenyAllFromTo a b) thus ?thesis + using wp_xs Cons + by (simp,metis DenyAllFromTo aux aux7 tNDComm deny_dom) + next + case (AllowPortFromTo a b p) thus ?thesis + using wp_xs + by (simp, metis aux26 AllowPortFromTo Cons(4) aux aux7a tNDComm) + next + case (Conc a b) thus ?thesis + by (metis Conc Cons(2) singleCombinators.simps(2)) + qed +qed + + + +lemma AD_aux: + "AllowPortFromTo a b po \ set p \ DenyAllFromTo c d \ set p \ + allNetsDistinct p \ singleCombinators p \ a \ c \ b \ d \ + dom (Cp (AllowPortFromTo a b po)) \ dom (Cp (DenyAllFromTo c d)) = {}" +by (rule aux26,rule_tac x ="AllowPortFromTo a b po" and y = "DenyAllFromTo c d" in tND) auto + + +lemma sorted_WP2[rule_format]: + "sorted p l \ all_in_list p l \ distinct p \ allNetsDistinct p \ singleCombinators p \ + wellformed_policy2Pr p" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons a p) thus ?case + proof (cases a) + case DenyAll thus ?thesis + using Cons by (auto intro: ANDConc singleCombinatorsConc sortedConcEnd) + next + case (DenyAllFromTo c d) thus ?thesis + using Cons apply (simp, intro impI conjI allI impI deny_dom) + by (auto intro: aux7 tNDComm ANDConc singleCombinatorsConc sortedConcEnd) + next + case (AllowPortFromTo c d e) thus ?thesis + using Cons apply simp + apply (intro impI conjI allI, rename_tac "aa" "b") + apply (rule aux26) + apply (rule_tac x = "AllowPortFromTo c d e" and y = "DenyAllFromTo aa b" in tND, + assumption,simp_all) + apply (subgoal_tac "smaller (AllowPortFromTo c d e) (DenyAllFromTo aa b) l") + apply (simp split: if_splits) + apply metis + apply (erule sorted_is_smaller, simp_all) + apply (metis bothNet.simps(2) in_list.simps(2) in_set_in_list) + by (auto intro: aux7 tNDComm ANDConc singleCombinatorsConc sortedConcEnd) + next + case (Conc a b) thus ?thesis using Cons by simp + qed +qed + + +lemma wellformed2_sorted[simp]: + "all_in_list p l \ distinct p \ allNetsDistinct p \ singleCombinators p \ + wellformed_policy2Pr (sort p l)" +by (metis distinct_sort set_sort sorted_WP2 SC3 aND_sort all_in_listSubset order_refl sort_is_sorted) + + +lemma wellformed2_sortedQ[simp]: + "all_in_list p l \ distinct p \ allNetsDistinct p \ singleCombinators p \ + wellformed_policy2Pr (qsort p l)" +by (metis sorted_WP2 SC3Q aND_sortQ all_in_listSubset distinct_sortQ set_sortQ sort_is_sortedQ subsetI) + + +lemma C_DenyAll[simp]: "Cp (list2FWpolicy (xs @ [DenyAll])) x = Some (deny ())" +by (auto simp: PLemmas) + + +lemma C_eq_RS1n: + "Cp(list2FWpolicy (removeShadowRules1_alternative p)) = Cp(list2FWpolicy p)" +proof (cases "p") + case Nil then show ?thesis + by (simp, metis list2FWpolicy.simps(1) rSR1_eq removeShadowRules1.simps(2)) +next + case (Cons a list) then show ?thesis + apply (hypsubst, simp) + apply (thin_tac "p = a # list") + proof (induct rule: rev_induct) + case Nil show ?case by (metis rSR1_eq removeShadowRules1.simps(2)) + next + case (snoc x xs) show ?case + apply (case_tac "xs = []", simp_all) + apply (simp add: removeShadowRules1_alternative_def) + apply (insert snoc.hyps, case_tac x, simp_all) + apply (rule ext, rename_tac xa) + apply (case_tac "x = DenyAll",simp_all add: PLemmas) + apply (rule_tac t = "removeShadowRules1_alternative (xs @ [x])" and + s = "(removeShadowRules1_alternative xs)@[x]" in subst) + apply (erule RS1n_assoc) + apply (case_tac "xa \ dom (Cp x)", simp_all) + done + qed +qed + + +lemma C_eq_RS1[simp]: +"p \ [] \ Cp(list2FWpolicy (removeShadowRules1 p)) = Cp(list2FWpolicy p)" +by (metis rSR1_eq C_eq_RS1n) + + +lemma EX_MR_aux[rule_format]: + "applied_rule_rev Cp x (DenyAll # p) \ Some DenyAll \ (\y. applied_rule_rev Cp x p = Some y)" +by (simp add: applied_rule_rev_def) (rule_tac xs = p in rev_induct, simp_all) + + +lemma EX_MR : + "applied_rule_rev Cp x p \ (Some DenyAll) \ p = DenyAll#ps \ + (applied_rule_rev Cp x p = applied_rule_rev Cp x ps)" +apply (auto,subgoal_tac "applied_rule_rev Cp x (DenyAll#ps) \ None", auto) + apply (metis mrConcEnd) +by (metis DAimpliesMR_E list.sel(1) hd_in_set list.simps(3) not_Some_eq) + + + +lemma mr_not_DA: + "wellformed_policy1_strong s \ applied_rule_rev Cp x p = Some (DenyAllFromTo a ab) \ + set p = set s \ applied_rule_rev Cp x s \ Some DenyAll" +apply (subst wp1n_tl, simp_all) +by (metis (mono_tags, lifting) Combinators.distinct(1) foo98 + mrSet mr_in_dom WP1n_DA_notinSet set_ConsD wp1n_tl) + + +lemma domsMT_notND_DD: + "dom (Cp (DenyAllFromTo a b)) \ dom (Cp (DenyAllFromTo c d)) \ {} \ \ netsDistinct a c" +by (erule contrapos_nn) (simp add: Cp.simps aux6 twoNetsDistinct_def) + + +lemma domsMT_notND_DD2: + "dom (Cp (DenyAllFromTo a b)) \ dom (Cp (DenyAllFromTo c d)) \ {} \ \ netsDistinct b d" +by (erule contrapos_nn) (simp add: Cp.simps aux6 twoNetsDistinct_def) + + +lemma domsMT_notND_DD3: + "x \ dom (Cp (DenyAllFromTo a b)) \ x \ dom (Cp (DenyAllFromTo c d)) \ \ netsDistinct a c" +by (auto intro!: domsMT_notND_DD) + + +lemma domsMT_notND_DD4: + "x \ dom (Cp (DenyAllFromTo a b)) \ x \ dom (Cp (DenyAllFromTo c d)) \ \ netsDistinct b d" +by (auto intro!: domsMT_notND_DD2) + + +lemma NetsEq_if_sameP_DD: + "allNetsDistinct p \ u\ set p \ v\ set p \ u = (DenyAllFromTo a b) \ + v = (DenyAllFromTo c d) \ x \ dom (Cp (u)) \ x \ dom (Cp (v)) \ + a = c \ b = d" +unfolding allNetsDistinct_def +by (simp)(metis allNetsDistinct_def ND0aux1 ND0aux2 domsMT_notND_DD3 domsMT_notND_DD4 ) + + +lemma rule_charn1: + assumes aND : "allNetsDistinct p" + and mr_is_allow : "applied_rule_rev Cp x p = Some (AllowPortFromTo a b po)" + and SC : "singleCombinators p" + and inp : "r \ set p" + and inDom : "x \ dom (Cp r)" + shows "(r = AllowPortFromTo a b po \ r = DenyAllFromTo a b \ r = DenyAll)" +proof (cases r) + case DenyAll show ?thesis by (metis DenyAll) +next + case (DenyAllFromTo x y) show ?thesis + by (metis DenyAllFromTo NormalisationIPPProofs.AD_aux NormalisationIPPProofs.mrSet + NormalisationIPPProofs.mr_in_dom SC aND domInterMT inDom inp mr_is_allow) +next + case (AllowPortFromTo x y b) show ?thesis + by (metis (mono_tags, lifting) AllowPortFromTo NormalisationIPPProofs.DistinctNetsAllowAllow + NormalisationIPPProofs.mrSet NormalisationIPPProofs.mr_in_dom aND domInterMT inDom + inp mr_is_allow) +next + case (Conc x y) thus ?thesis using assms by (metis aux0_0) +qed + +lemma none_MT_rulessubset[rule_format]: +"none_MT_rules Cp a \ set b \ set a \ none_MT_rules Cp b" +by (induct b,simp_all) (metis notMTnMT) + + +lemma nMTSort: "none_MT_rules Cp p \ none_MT_rules Cp (sort p l)" +by (metis set_sort nMTeqSet) + + + +lemma nMTSortQ: "none_MT_rules Cp p \ none_MT_rules Cp (qsort p l)" +by (metis set_sortQ nMTeqSet) + +lemma wp3char[rule_format]: "none_MT_rules Cp xs \ Cp (AllowPortFromTo a b po) = empty \ + wellformed_policy3Pr (xs @ [DenyAllFromTo a b]) \ + AllowPortFromTo a b po \ set xs" +by (induct xs, simp_all) (metis domNMT wp3Conc) + + + +lemma wp3charn[rule_format]: +assumes domAllow: "dom (Cp (AllowPortFromTo a b po)) \ {}" +and wp3: "wellformed_policy3Pr (xs @ [DenyAllFromTo a b])" +shows allowNotInList: "AllowPortFromTo a b po \ set xs" +apply (insert assms) +proof (induct xs) + case Nil show ?case by simp +next + case (Cons x xs) show ?case using Cons + by (simp,auto intro: wp3Conc) (auto simp: DenyAllowDisj domAllow) +qed + + +lemma rule_charn2: + assumes aND: "allNetsDistinct p" + and wp1: "wellformed_policy1 p" + and SC: "singleCombinators p" + and wp3: "wellformed_policy3Pr p" + and allow_in_list: "AllowPortFromTo c d po \ set p" + and x_in_dom_allow: "x \ dom (Cp (AllowPortFromTo c d po))" + shows "applied_rule_rev Cp x p = Some (AllowPortFromTo c d po)" + proof (insert assms, induct p rule: rev_induct) + case Nil show ?case using Nil by simp + next + case (snoc y ys) show ?case using snoc + apply simp + apply (case_tac "y = (AllowPortFromTo c d po)") + apply (simp add: applied_rule_rev_def) + apply simp_all + apply (subgoal_tac "ys \ []") + apply (subgoal_tac "applied_rule_rev Cp x ys = Some (AllowPortFromTo c d po)") + defer 1 + apply (metis ANDConcEnd SCConcEnd WP1ConcEnd foo25) + apply (metis inSet_not_MT) + proof (cases y) + case DenyAll thus ?thesis using DenyAll snoc + apply simp + by (metis DAnotTL DenyAll inSet_not_MT policy2list.simps(2)) + next + case (DenyAllFromTo a b) thus ?thesis using snoc apply simp + apply (simp_all add: applied_rule_rev_def) + apply (rule conjI) + apply (metis domInterMT wp3EndMT) + apply (rule impI) + by (metis ANDConcEnd DenyAllFromTo SCConcEnd WP1ConcEnd foo25) + next + case (AllowPortFromTo a1 a2 b) thus ?thesis using AllowPortFromTo snoc apply simp + apply (simp_all add: applied_rule_rev_def) + apply (rule conjI) + apply (metis domInterMT wp3EndMT) + by (metis ANDConcEnd AllowPortFromTo SCConcEnd WP1ConcEnd foo25 x_in_dom_allow) + next + case (Conc a b) thus ?thesis + using Conc snoc apply simp + by (metis Conc aux0_0 in_set_conv_decomp) + qed +qed + + +lemma rule_charn3: + "wellformed_policy1 p \ allNetsDistinct p \ singleCombinators p \ + wellformed_policy3Pr p \ applied_rule_rev Cp x p = Some (DenyAllFromTo c d) \ + AllowPortFromTo a b po \ set p \ x \ dom (Cp (AllowPortFromTo a b po))" +by (clarify) (simp add: NormalisationIPPProofs.rule_charn2 domI) + + +lemma rule_charn4: +assumes wp1: "wellformed_policy1 p" +and aND: "allNetsDistinct p" +and SC: "singleCombinators p" +and wp3: "wellformed_policy3Pr p" +and DA: "DenyAll \ set p" +and mr: "applied_rule_rev Cp x p = Some (DenyAllFromTo a b)" +and rinp: "r \ set p" +and xindom: "x \ dom (Cp r)" +shows "r = DenyAllFromTo a b" +proof (cases r) + case DenyAll thus ?thesis using DenyAll assms by simp +next + case (DenyAllFromTo c d) thus ?thesis + using assms apply simp + apply (erule_tac x = x and p = p and v = "(DenyAllFromTo a b)" and + u = "(DenyAllFromTo c d)" in NetsEq_if_sameP_DD, simp_all) + apply (erule mrSet) + by (erule mr_in_dom) +next + case (AllowPortFromTo c d e) thus ?thesis + using assms apply simp + apply (subgoal_tac "x \ dom (Cp (AllowPortFromTo c d e))", simp) + by (rule_tac p = p in rule_charn3, auto intro: SCnotConc) +next + case (Conc a b) thus ?thesis + using assms apply simp + by (metis Conc aux0_0) +qed + + + +lemma foo31a: + "(\ r. r \ set p \ x \ dom (Cp r) \ + (r = AllowPortFromTo a b po \ r = DenyAllFromTo a b \ r = DenyAll)) \ + set p = set s \ r \ set s \ x \ dom (Cp r) \ + (r = AllowPortFromTo a b po \ r = DenyAllFromTo a b \ r = DenyAll)" +by auto + + +lemma aux4[rule_format]: + "applied_rule_rev Cp x (a#p) = Some a \ a \ set (p) \ applied_rule_rev Cp x p = None" +by (rule rev_induct, simp_all) (intro impI,simp add: applied_rule_rev_def split: if_splits) + + +lemma mrDA_tl: +assumes mr_DA: "applied_rule_rev Cp x p = Some DenyAll" +and wp1n: "wellformed_policy1_strong p" +shows "applied_rule_rev Cp x (tl p) = None" +apply (rule aux4 [where a = DenyAll]) + apply (metis wp1n_tl mr_DA wp1n) +by (metis WP1n_DA_notinSet wp1n) + +lemma rule_charnDAFT: + "wellformed_policy1_strong p \ allNetsDistinct p \ singleCombinators p \ + wellformed_policy3Pr p \ applied_rule_rev Cp x p = Some (DenyAllFromTo a b) \ + r \ set (tl p) \ x \ dom (Cp r) \ + r = DenyAllFromTo a b" +apply (subgoal_tac "p = DenyAll#(tl p)") + apply (metis (no_types, lifting) ANDConc Combinators.distinct(1) NormalisationIPPProofs.mrConcEnd + NormalisationIPPProofs.rule_charn4 NormalisationIPPProofs.wp3Conc WP1n_DA_notinSet + singleCombinatorsConc waux2) +using wp1n_tl by auto + + +lemma mrDenyAll_is_unique: + "wellformed_policy1_strong p \ applied_rule_rev Cp x p = Some DenyAll \ r \ set (tl p) \ + x \ dom (Cp r)" +apply (rule_tac a = "[]" and b = "DenyAll" and c = "tl p" in foo3a, simp_all) + apply (metis wp1n_tl) +by (metis WP1n_DA_notinSet) + + +theorem C_eq_Sets_mr: + assumes sets_eq: "set p = set s" + and SC: "singleCombinators p" + and wp1_p: "wellformed_policy1_strong p" + and wp1_s: "wellformed_policy1_strong s" + and wp3_p: "wellformed_policy3Pr p" + and wp3_s: "wellformed_policy3Pr s" + and aND: "allNetsDistinct p" + shows "applied_rule_rev Cp x p = applied_rule_rev Cp x s" +proof (cases "applied_rule_rev Cp x p") + case None + have DA: "DenyAll \ set p" using wp1_p by (auto simp: wp1_aux1aa) + have notDA: "DenyAll \ set p" using None by (auto simp: DAimplieMR) + thus ?thesis using DA by (contradiction) +next + case (Some y) thus ?thesis + proof (cases y) + have tl_p: "p = DenyAll#(tl p)" by (metis wp1_p wp1n_tl) + have tl_s: "s = DenyAll#(tl s)" by (metis wp1_s wp1n_tl) + have tl_eq: "set (tl p) = set (tl s)" + by (metis list.sel(3) WP1n_DA_notinSet sets_eq foo2 + wellformed_policy1_charn wp1_aux1aa wp1_eq wp1_p wp1_s) + { + case DenyAll + have mr_p_is_DenyAll: "applied_rule_rev Cp x p = Some DenyAll" + by (simp add: DenyAll Some) + hence x_notin_tl_p: "\ r. r \ set (tl p) \ x \ dom (Cp r)" using wp1_p + by (auto simp: mrDenyAll_is_unique) + hence x_notin_tl_s: "\ r. r \ set (tl s) \ x \ dom (Cp r)" using tl_eq + by auto + hence mr_s_is_DenyAll: "applied_rule_rev Cp x s = Some DenyAll" using tl_s + by (auto simp: mr_first) + thus ?thesis using mr_p_is_DenyAll by simp + next + case (DenyAllFromTo a b) + have mr_p_is_DAFT: "applied_rule_rev Cp x p = Some (DenyAllFromTo a b)" + by (simp add: DenyAllFromTo Some) + have DA_notin_tl: "DenyAll \ set (tl p)" + by (metis WP1n_DA_notinSet wp1_p) + have mr_tl_p: "applied_rule_rev Cp x p = applied_rule_rev Cp x (tl p)" + by (metis Combinators.simps(4) DenyAllFromTo Some mrConcEnd tl_p) + have dom_tl_p: "\ r. r \ set (tl p) \ x \ dom (Cp r) \ + r = (DenyAllFromTo a b)" + using wp1_p aND SC wp3_p mr_p_is_DAFT + by (auto simp: rule_charnDAFT) + hence dom_tl_s: "\ r. r \ set (tl s) \ x \ dom (Cp r) \ + r = (DenyAllFromTo a b)" + using tl_eq by auto + have DAFT_in_tl_s: "DenyAllFromTo a b \ set (tl s)" using mr_tl_p + by (metis DenyAllFromTo mrSet mr_p_is_DAFT tl_eq) + have x_in_dom_DAFT: "x \ dom (Cp (DenyAllFromTo a b))" + by (metis mr_p_is_DAFT DenyAllFromTo mr_in_dom) + hence mr_tl_s_is_DAFT: "applied_rule_rev Cp x (tl s) = Some (DenyAllFromTo a b)" + using DAFT_in_tl_s dom_tl_s by (metis mr_charn) + hence mr_s_is_DAFT: "applied_rule_rev Cp x s = Some (DenyAllFromTo a b)" + using tl_s + by (metis DA_notin_tl DenyAllFromTo EX_MR mrDA_tl + not_Some_eq tl_eq wellformed_policy1_strong.simps(2)) + thus ?thesis using mr_p_is_DAFT by simp + next + case (AllowPortFromTo a b c) + have wp1s: "wellformed_policy1 s" by (metis wp1_eq wp1_s) + have mr_p_is_A: "applied_rule_rev Cp x p = Some (AllowPortFromTo a b c)" + by (simp add: AllowPortFromTo Some) + hence A_in_s: "AllowPortFromTo a b c \ set s" using sets_eq + by (auto intro: mrSet) + have x_in_dom_A: "x \ dom (Cp (AllowPortFromTo a b c))" + by (metis mr_p_is_A AllowPortFromTo mr_in_dom) + have SCs: "singleCombinators s" using SC sets_eq + by (auto intro: SCSubset) + hence ANDs: "allNetsDistinct s" using aND sets_eq SC + by (auto intro: aNDSetsEq) + hence mr_s_is_A: "applied_rule_rev Cp x s = Some (AllowPortFromTo a b c)" + using A_in_s wp1s mr_p_is_A aND SCs wp3_s x_in_dom_A + by (simp add: rule_charn2) + thus ?thesis using mr_p_is_A by simp + } +next + case (Conc a b) thus ?thesis by (metis Some mr_not_Conc SC) +qed +qed + + +lemma C_eq_Sets: +"singleCombinators p \ wellformed_policy1_strong p \ wellformed_policy1_strong s \ + wellformed_policy3Pr p \ wellformed_policy3Pr s \ allNetsDistinct p \ set p = set s \ + Cp (list2FWpolicy p) x = Cp (list2FWpolicy s) x" +by (metis C_eq_Sets_mr C_eq_if_mr_eq wellformed_policy1_strong.simps(1)) + + + +lemma C_eq_sorted: + "distinct p \ all_in_list p l \ singleCombinators p \ + wellformed_policy1_strong p\ wellformed_policy3Pr p\ allNetsDistinct p \ + Cp (list2FWpolicy (sort p l))= Cp (list2FWpolicy p)" +by (rule ext) + (meson distinct_sort set_sort C_eq_Sets wellformed2_sorted wellformed_policy3_charn SC3 aND_sort + wellformed1_alternative_sorted wp1_eq) + + +lemma C_eq_sortedQ: + "distinct p \ all_in_list p l \ singleCombinators p \ + wellformed_policy1_strong p \ wellformed_policy3Pr p \ allNetsDistinct p \ + Cp (list2FWpolicy (qsort p l))= Cp (list2FWpolicy p)" +by (rule ext) + (metis C_eq_Sets wellformed2_sortedQ wellformed_policy3_charn SC3Q aND_sortQ distinct_sortQ + set_sortQ wellformed1_sorted_auxQ wellformed_eq wp1_aux1aa) + + + + +lemma C_eq_RS2_mr: "applied_rule_rev Cp x (removeShadowRules2 p)= applied_rule_rev Cp x p" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons y ys) thus ?case + proof (cases "ys = []") + case True thus ?thesis by (cases y, simp_all) + next + case False thus ?thesis + proof (cases y) + case DenyAll thus ?thesis by (simp, metis Cons DenyAll mreq_end2) + next + case (DenyAllFromTo a b) thus ?thesis by (simp, metis Cons DenyAllFromTo mreq_end2) + next + case (AllowPortFromTo a b p) thus ?thesis + proof (cases "DenyAllFromTo a b \ set ys") + case True thus ?thesis using AllowPortFromTo Cons + apply (cases "applied_rule_rev Cp x ys = None", simp_all) + apply (subgoal_tac "x \ dom (Cp (AllowPortFromTo a b p))") + apply (subst mrconcNone, simp_all) + apply (simp add: applied_rule_rev_def ) + apply (rule contra_subsetD [OF allow_deny_dom]) + apply (erule mrNoneMT,simp) + apply (metis AllowPortFromTo mrconc) + done + next + case False thus ?thesis using False Cons AllowPortFromTo + by (simp, metis AllowPortFromTo Cons mreq_end2) qed + next + case (Conc a b) thus ?thesis + by (metis Cons mreq_end2 removeShadowRules2.simps(4)) + qed + qed +qed + + + +lemma C_eq_None[rule_format]: + "p \ [] \ applied_rule_rev Cp x p = None \ Cp (list2FWpolicy p) x = None" +unfolding applied_rule_rev_def +proof(induct rule: rev_induct) + case Nil show ?case by simp +next + case (snoc xa xs) show ?case + apply (insert snoc.hyps, intro impI, simp) + apply (case_tac "xs \ []") + apply (metis CConcStart2 option.simps(3)) + by (metis append_Nil domIff l2p_aux2 option.distinct(1)) +qed + +lemma C_eq_None2: + "a \ [] \ b \ [] \ applied_rule_rev Cp x a = None \ applied_rule_rev Cp x b = None \ + (Cp (list2FWpolicy a)) x = (Cp (list2FWpolicy b)) x" +by (auto simp: C_eq_None) + +lemma C_eq_RS2: + "wellformed_policy1_strong p \ + Cp (list2FWpolicy (removeShadowRules2 p))= Cp (list2FWpolicy p)" +apply (rule ext) +by (metis C_eq_RS2_mr C_eq_if_mr_eq RS2_NMT wp1_alternative_not_mt) + + +lemma none_MT_rulesRS2: "none_MT_rules Cp p \ none_MT_rules Cp (removeShadowRules2 p)" +by (auto simp: RS2Set none_MT_rulessubset) + +lemma CconcNone: + "dom (Cp a) = {} \ p \ [] \ Cp (list2FWpolicy (a # p)) x = Cp (list2FWpolicy p) x" +apply (case_tac "p = []", simp_all) + apply (case_tac "x\ dom (Cp (list2FWpolicy(p)))") +apply (metis Cdom2 list2FWpolicyconc) +apply (metis Cp.simps(4) map_add_dom_app_simps(2) inSet_not_MT list2FWpolicyconc set_empty2) +done + + +lemma none_MT_rulesrd[rule_format]: "none_MT_rules Cp p \ none_MT_rules Cp (remdups p)" +by (induct p, simp_all) + +lemma DARS3[rule_format]:"DenyAll \ set p\DenyAll \ set (rm_MT_rules Cp p)" +by (induct p, simp_all) + +lemma DAnMT: "dom (Cp DenyAll) \ {}" +by (simp add: dom_def Cp.simps PolicyCombinators.PolicyCombinators) + +lemma DAnMT2: "Cp DenyAll \ empty" +by (metis DAAux dom_eq_empty_conv empty_iff) + + + + +lemma wp1n_RS3[rule_format,simp]: + "wellformed_policy1_strong p \ wellformed_policy1_strong (rm_MT_rules Cp p)" +apply (induct p, simp_all) + apply (rule conjI| rule impI|simp)+ +apply (metis DAnMT) +apply (metis DARS3) +done + +lemma AILRS3[rule_format,simp]: + "all_in_list p l \ all_in_list (rm_MT_rules Cp p) l" +by (induct p, simp_all) + +lemma SCRS3[rule_format,simp]: + "singleCombinators p \ singleCombinators(rm_MT_rules Cp p)" +by (induct p, simp_all) (case_tac "a", simp_all) + + +lemma RS3subset: "set (rm_MT_rules Cp p) \ set p " +by (induct p, auto) + + +lemma ANDRS3[simp]: + "singleCombinators p \ allNetsDistinct p \ allNetsDistinct (rm_MT_rules Cp p)" +by (rule_tac b = p in aNDSubset, simp_all add:RS3subset) + + +lemma nlpaux: "x \ dom (Cp b) \ Cp (a \ b) x = Cp a x" +by (metis Cp.simps(4) map_add_dom_app_simps(3)) + +lemma notindom[rule_format]: + "a \ set p \ x \ dom (Cp (list2FWpolicy p)) \ x \ dom (Cp a)" +proof (induct p) + case Nil show ?case by simp +next + case (Cons a p) then show ?case + apply (simp_all,intro conjI impI) + apply (metis CConcStartA) + apply simp + apply (metis Cdom2 List.set_simps(2) domIff insert_absorb list.simps(2) list2FWpolicyconc set_empty) + done +qed + +lemma C_eq_rd[rule_format]: + "p \ [] \ Cp (list2FWpolicy (remdups p)) = Cp (list2FWpolicy p)" +proof (rule ext, induct p) + case Nil thus ?case by simp +next + case (Cons y ys) thus ?case + proof (cases "ys = []") + case True thus ?thesis by simp + next + case False thus ?thesis + using Cons apply simp + apply (intro conjI impI) + apply (metis Cdom2 nlpaux notindom domIff l2p_aux) + by (metis (no_types, lifting) Cdom2 nlpaux domIff l2p_aux remDupsNMT) + qed +qed + + + +lemma nMT_domMT: +"\ not_MT Cp p \ p \ [] \ r \ dom (Cp (list2FWpolicy p))" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons x xs) thus ?case + apply (simp split: if_splits) + apply (cases "xs = []",simp_all ) + by (metis CconcNone domIff) +qed + +lemma C_eq_RS3_aux[rule_format]: + "not_MT Cp p \ Cp (list2FWpolicy p) x = Cp (list2FWpolicy (rm_MT_rules Cp p)) x" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons y ys) thus ?case + proof (cases "not_MT Cp ys") + case True thus ?thesis + using Cons apply simp + apply (intro conjI impI, simp) + apply (metis CconcNone True not_MTimpnotMT) + apply (cases "x \ dom (Cp (list2FWpolicy ys))") + apply (subgoal_tac "x \ dom (Cp (list2FWpolicy (rm_MT_rules Cp ys)))") + apply (metis (mono_tags) Cons_eq_appendI NMPrm CeqEnd append_Nil not_MTimpnotMT) + apply (simp add: domIff) + apply (subgoal_tac "x \ dom (Cp (list2FWpolicy (rm_MT_rules Cp ys)))") + apply (metis l2p_aux l2p_aux2 nlpaux) + by (metis domIff) + next + case False thus ?thesis + using Cons False + proof (cases "ys = []") + case True thus ?thesis using Cons by (simp) (rule impI, simp) + next + case False thus ?thesis + using Cons False `\ not_MT Cp ys` apply (simp) + apply (intro conjI impI| simp)+ + apply (subgoal_tac "rm_MT_rules Cp ys = []") + apply (subgoal_tac "x \ dom (Cp (list2FWpolicy ys))") + apply simp_all + apply (metis l2p_aux nlpaux) + apply (erule nMT_domMT, simp_all) + by (metis SR3nMT) + qed + qed +qed + + + +lemma C_eq_id: + "wellformed_policy1_strong p \ Cp(list2FWpolicy (insertDeny p)) = Cp (list2FWpolicy p)" +by (rule ext) (metis insertDeny.simps(1) wp1n_tl) + + +lemma C_eq_RS3: +"not_MT Cp p \ Cp(list2FWpolicy (rm_MT_rules Cp p)) = Cp (list2FWpolicy p)" +by (rule ext) (erule C_eq_RS3_aux[symmetric]) + + +lemma NMPrd[rule_format]: "not_MT Cp p \ not_MT Cp (remdups p)" +by (induct p, simp_all) (auto simp: NMPcharn) + + +lemma NMPDA[rule_format]: "DenyAll \ set p \ not_MT Cp p" +by (induct p, simp_all add: DAnMT) + + +lemma NMPiD[rule_format]: "not_MT Cp (insertDeny p)" +by (insert DAiniD [of p]) (erule NMPDA) + + +lemma list2FWpolicy2list[rule_format]: + "Cp (list2FWpolicy(policy2list p)) = (Cp p)" +apply (rule ext) +apply (induct_tac p, simp_all) +apply (case_tac "x \ dom (Cp (x2))") +apply (metis Cdom2 CeqEnd domIff p2lNmt) +apply (metis CeqStart domIff p2lNmt nlpaux) +done + + +lemmas C_eq_Lemmas = none_MT_rulesRS2 none_MT_rulesrd SCp2l wp1n_RS2 wp1ID NMPiD waux2 + wp1alternative_RS1 p2lNmt list2FWpolicy2list wellformed_policy3_charn wp1_eq + +lemmas C_eq_subst_Lemmas = C_eq_sorted C_eq_sortedQ C_eq_RS2 C_eq_rd C_eq_RS3 C_eq_id + + +lemma C_eq_All_untilSorted: + "DenyAll\set(policy2list p) \ all_in_list(policy2list p) l \ allNetsDistinct(policy2list p) \ + Cp(list2FWpolicy (sort (removeShadowRules2 (remdups (rm_MT_rules Cp (insertDeny + (removeShadowRules1 (policy2list p)))))) l)) = + Cp p" +apply (subst C_eq_sorted,simp_all add: C_eq_Lemmas) +apply (subst C_eq_RS2,simp_all add: C_eq_Lemmas) +apply (subst C_eq_rd,simp_all add: C_eq_Lemmas) +apply (subst C_eq_RS3,simp_all add: C_eq_Lemmas) +apply (subst C_eq_id,simp_all add: C_eq_Lemmas) +done + + +lemma C_eq_All_untilSortedQ: + "DenyAll\ set(policy2list p) \ all_in_list(policy2list p) l \ allNetsDistinct(policy2list p) \ + Cp(list2FWpolicy (qsort (removeShadowRules2 (remdups (rm_MT_rules Cp (insertDeny + (removeShadowRules1 (policy2list p)))))) l)) = + Cp p" +apply (subst C_eq_sortedQ,simp_all add: C_eq_Lemmas) +apply (subst C_eq_RS2,simp_all add: C_eq_Lemmas) +apply (subst C_eq_rd,simp_all add: C_eq_Lemmas) +apply (subst C_eq_RS3,simp_all add: C_eq_Lemmas) +apply (subst C_eq_id,simp_all add: C_eq_Lemmas) +done + +(* or, even shorter *) + +lemma C_eq_All_untilSorted_withSimps: +"DenyAll \ set (policy2list p) \ all_in_list (policy2list p) l \ + allNetsDistinct (policy2list p) \ + Cp(list2FWpolicy(sort(removeShadowRules2(remdups(rm_MT_rules Cp (insertDeny + (removeShadowRules1(policy2list p)))))) l)) = + Cp p" +by (simp_all add: C_eq_Lemmas C_eq_subst_Lemmas) + + +lemma C_eq_All_untilSorted_withSimpsQ: +"DenyAll \ set (policy2list p) \ all_in_list (policy2list p) l \ + allNetsDistinct (policy2list p) \ + Cp(list2FWpolicy(qsort(removeShadowRules2(remdups(rm_MT_rules Cp (insertDeny + (removeShadowRules1 (policy2list p)))))) l)) = + Cp p" +by (simp_all add: C_eq_Lemmas C_eq_subst_Lemmas) + + +lemma InDomConc[rule_format]: "p \ [] \ x \ dom (Cp (list2FWpolicy (p))) \ + x \ dom (Cp (list2FWpolicy (a#p)))" +by (induct p, simp_all) (case_tac "p = []",simp_all add: dom_def Cp.simps) + + +lemma not_in_member[rule_format]: "member a b \ x \ dom (Cp b) \ x \ dom (Cp a)" +by (induct b)(simp_all add: dom_def Cp.simps) + + +lemma src_in_sdnets[rule_format]: + "\ member DenyAll x \ p \ dom (Cp x) \ subnetsOfAdr (src p) \ (fst_set (sdnets x)) \ {}" +apply (induct rule: Combinators.induct) +apply (simp_all add: fst_set_def subnetsOfAdr_def PLemmas, rename_tac x1 x2) +apply (intro impI) +apply (simp add: fst_set_def) +apply (case_tac "p \ dom (Cp x2)") +apply (rule subnetAux) +apply (auto simp: PLemmas) +done + +lemma dest_in_sdnets[rule_format]: + "\ member DenyAll x \ p \ dom (Cp x) \ subnetsOfAdr (dest p) \ (snd_set (sdnets x)) \ {}" +apply (induct rule: Combinators.induct) +apply (simp_all add: snd_set_def subnetsOfAdr_def PLemmas, rename_tac x1 x2) +apply (intro impI,simp add: snd_set_def) +apply (case_tac "p \ dom (Cp x2)") +apply (rule subnetAux) +apply (auto simp: PLemmas) +done + + + +lemma sdnets_in_subnets[rule_format]: + "p\ dom (Cp x) \ \ member DenyAll x \ + (\ (a,b)\sdnets x. a \ subnetsOfAdr (src p) \ b \ subnetsOfAdr (dest p))" +apply (rule Combinators.induct) + apply (simp_all add: PLemmas subnetsOfAdr_def) +apply (intro impI, simp) + apply (case_tac "p \ dom (Cp (x2))") +apply (auto simp: PLemmas subnetsOfAdr_def) +done + +lemma disjSD_no_p_in_both[rule_format]: + "\disjSD_2 x y; \ member DenyAll x; \ member DenyAll y; + p \ dom (Cp x); p \ dom (Cp y)\ \ False" +apply (rule_tac A = "sdnets x" and B = "sdnets y" and D = "src p" and F = "dest p" in tndFalse) +by (auto simp: dest_in_sdnets src_in_sdnets sdnets_in_subnets disjSD_2_def) + +lemma list2FWpolicy_eq: + "zs \ [] \ Cp (list2FWpolicy (x \ y # z)) p = Cp (x \ list2FWpolicy (y # z)) p" +by (metis ConcAssoc l2p_aux list2FWpolicy.simps(2)) + + + +lemma dom_sep[rule_format]: + "x \ dom (Cp (list2FWpolicy p)) \ x \ dom (Cp (list2FWpolicy(separate p)))" +proof (induct p rule: separate.induct,simp_all, goal_cases) + case (1 v va y z) then show ?case + apply (intro conjI impI) + apply (simp,drule mp) + apply (case_tac "x \ dom (Cp (DenyAllFromTo v va))") + apply (metis CConcStartA domIff l2p_aux2 list2FWpolicyconc not_Cons_self ) + apply (subgoal_tac "x \ dom (Cp (list2FWpolicy (y #z)))") + apply (metis CConcStartA Cdom2 domIff l2p_aux2 list2FWpolicyconc nlpaux) + apply (subgoal_tac "x \ dom (Cp (list2FWpolicy ((DenyAllFromTo v va)#y#z)))") + apply (simp add: dom_def Cp.simps,simp_all) + apply (case_tac "x \ dom (Cp (DenyAllFromTo v va))", simp_all) + apply (subgoal_tac "x \ dom (Cp (list2FWpolicy (y #z)))") + apply (metis InDomConc sepnMT list.simps(2)) + apply (subgoal_tac "x \ dom (Cp (list2FWpolicy ((DenyAllFromTo v va)#y#z)))") + by (simp_all add: dom_def Cp.simps) +next + case (2 v va vb y z) then show ?case + apply (intro impI conjI,simp) + apply (case_tac "x \ dom (Cp (AllowPortFromTo v va vb))") + apply (metis CConcStartA domIff l2p_aux2 list2FWpolicyconc not_Cons_self ) + apply (subgoal_tac "x \ dom (Cp (list2FWpolicy (y #z)))") + apply (metis CConcStartA Cdom2 InDomConc domIff l2p_aux2 list2FWpolicyconc nlpaux) + apply (simp add: dom_def Cp.simps, simp_all) + apply (case_tac "x \ dom (Cp (AllowPortFromTo v va vb))", simp_all) + apply (subgoal_tac "x \ dom (Cp (list2FWpolicy (y #z)))",simp) + apply (metis Conc_not_MT InDomConc sepnMT) + apply (metis domIff nlpaux) + done +next + case (3 v va y z) then show ?case + apply (intro conjI impI,simp) + apply (drule mp) + apply (case_tac "x \ dom (Cp ((v \ va)))") + apply (metis Cp.simps(4) CConcStartA ConcAssoc domIff list2FWpolicy2list list2FWpolicyconc p2lNmt) + defer 1 + apply simp_all + apply (case_tac "x \ dom (Cp ((v \ va)))",simp_all) + apply (drule mp) + apply (simp add: Cp.simps dom_def) + apply (metis InDomConc list.simps(2)sepnMT) + apply (subgoal_tac "x \ dom (Cp (list2FWpolicy (y#z)))") + apply (case_tac "x \ dom (Cp y)",simp_all) + apply (metis CConcStartA Cdom2 ConcAssoc domIff) + apply (metis InDomConc domIff l2p_aux2 list2FWpolicyconc nlpaux) + apply (case_tac "x \ dom (Cp y)",simp_all) + by (metis domIff nlpaux) +qed + +lemma domdConcStart[rule_format]: + "x \ dom (Cp (list2FWpolicy (a#b))) \ x \ dom (Cp (list2FWpolicy b)) \ x \ dom (Cp (a))" +by (induct b, simp_all) (auto simp: PLemmas) + + +lemma sep_dom2_aux: + "x \ dom (Cp (list2FWpolicy (a \ y # z))) \ x \ dom (Cp (a \ list2FWpolicy (y # z)))" +by auto (metis list2FWpolicy_eq p2lNmt) + + +lemma sep_dom2_aux2: +"(x \ dom (Cp (list2FWpolicy (separate (y # z)))) \ x \ dom (Cp (list2FWpolicy (y # z)))) \ + x \ dom (Cp (list2FWpolicy (a # separate (y # z)))) \ + x \ dom (Cp (list2FWpolicy (a \ y # z)))" +by (metis CConcStartA InDomConc domdConcStart list.simps(2) list2FWpolicy.simps(2) list2FWpolicyconc) + + +lemma sep_dom2[rule_format]: + "x \ dom (Cp (list2FWpolicy (separate p))) \ x \ dom (Cp (list2FWpolicy( p)))" +by (rule separate.induct) (simp_all add: sep_dom2_aux sep_dom2_aux2) + +lemma sepDom: "dom (Cp (list2FWpolicy p)) = dom (Cp (list2FWpolicy (separate p)))" +by (rule equalityI) (rule subsetI, (erule dom_sep|erule sep_dom2))+ + +lemma C_eq_s_ext[rule_format]: + "p \ [] \ Cp (list2FWpolicy (separate p)) a = Cp (list2FWpolicy p) a " +proof (induct rule: separate.induct, goal_cases) + case (1 x) thus ?case + apply (cases "x = []",simp_all) + apply (cases "a \ dom (Cp (list2FWpolicy x))") + apply (subgoal_tac "a \ dom (Cp (list2FWpolicy (separate x)))") + apply (metis Cdom2 list2FWpolicyconc sepDom sepnMT) + apply (metis sepDom) + by (metis nlpaux sepDom list2FWpolicyconc sepnMT) +next + case (2 v va y z) thus ?case + apply (cases "z = []",simp_all) + apply (intro conjI impI|simp)+ + apply (simp add: PLemmas(8) UPFDefs(8) list2FWpolicyconc sepnMT) + by (metis (mono_tags, lifting) Conc_not_MT Cdom2 list2FWpolicy_eq nlpaux sepDom l2p_aux sepnMT) +next + case (3 v va vb y z) thus ?case + apply (cases "z = []", simp_all) + apply (simp add: PLemmas(8) UPFDefs(8) list2FWpolicyconc sepnMT) + by (metis (no_types, hide_lams) Conc_not_MT Cdom2 nlpaux domIff l2p_aux sepnMT) +next + case (4 v va y z) thus ?case + apply (cases "z = []", simp_all) + apply (simp add: PLemmas(8) UPFDefs(8) l2p_aux sepnMT) + by (metis (no_types, lifting) ConcAssoc PLemmas(8) UPFDefs(8) list.distinct(1) + list2FWpolicyconc sepnMT) +next + case 5 thus ?case by simp +next + case 6 thus ?case by simp +next + case 7 thus ?case by simp +next + case 8 thus ?case by simp +qed + +lemma C_eq_s: "p \ [] \ Cp (list2FWpolicy (separate p)) = Cp (list2FWpolicy p)" +by (rule ext) (simp add: C_eq_s_ext) + + +(*legacy *) +lemmas sortnMTQ = NormalisationIntegerPortProof.C_eq_Lemmas_sep(14) + + +lemmas C_eq_Lemmas_sep = C_eq_Lemmas sortnMT sortnMTQ RS2_NMT NMPrd not_MTimpnotMT + + +lemma C_eq_until_separated: +"DenyAll\set(policy2list p) \ all_in_list(policy2list p) l \ allNetsDistinct(policy2list p) \ + Cp (list2FWpolicy (separate (sort (removeShadowRules2 (remdups (rm_MT_rules Cp + (insertDeny (removeShadowRules1 (policy2list p)))))) l))) = + Cp p" +by (simp add: C_eq_All_untilSorted_withSimps C_eq_s wellformed1_alternative_sorted wp1ID wp1n_RS2) + + +lemma C_eq_until_separatedQ: + "DenyAll \ set (policy2list p) \ all_in_list (policy2list p) l \ + allNetsDistinct (policy2list p) \ + Cp(list2FWpolicy(separate(qsort( + removeShadowRules2(remdups (rm_MT_rules Cp + (insertDeny (removeShadowRules1 (policy2list p)))))) l))) = + Cp p" +by (simp add: C_eq_All_untilSorted_withSimpsQ C_eq_s setnMT wp1ID wp1n_RS2) + + +lemma domID[rule_format]: + "p \ [] \ x \ dom(Cp(list2FWpolicy p)) \ x \ dom (Cp(list2FWpolicy(insertDenies p)))" +proof(induct p) + case Nil then show ?case by simp +next + case (Cons a p) then show ?case + proof(cases "p=[]", goal_cases) + case 1 then show ?case + apply(simp) apply(rule impI) + apply (cases a, simp_all) + apply (simp_all add: Cp.simps dom_def)+ + by auto + next + case 2 then show ?case + proof(cases "x \ dom(Cp(list2FWpolicy p))", goal_cases) + case 1 then show ?case + apply simp apply (rule impI) + apply (cases a, simp_all) + apply (metis InDomConc idNMT) + apply (rule InDomConc, simp_all add: idNMT)+ + done + next + case 2 then show ?case + apply simp apply (rule impI) + proof(cases "x \ dom (Cp (list2FWpolicy (insertDenies p)))", goal_cases) + case 1 then show ?case + proof(induct a) + case DenyAll then show ?case by simp + next + case (DenyAllFromTo src dest) then show ?case + by simp (rule InDomConc, simp add: idNMT) + next + case (AllowPortFromTo src dest port) then show ?case + by simp (rule InDomConc, simp add: idNMT) + next + case (Conc _ _) then show ?case + by simp(rule InDomConc, simp add: idNMT) + qed + next + case 2 then show ?case + proof (induct a) + case DenyAll then show ?case by simp + next + case (DenyAllFromTo src dest) then show ?case + by(simp,metis domIff CConcStartA list2FWpolicyconc nlpaux Cdom2) + next + case (AllowPortFromTo src dest port) then show ?case + by(simp,metis domIff CConcStartA list2FWpolicyconc nlpaux Cdom2) + next + case (Conc _ _) then show ?case + by simp (metis CConcStartA Cdom2 Conc(5) ConcAssoc domIff domdConcStart) + qed + qed + qed + qed +qed + + +lemma DA_is_deny: + "x \ dom (Cp (DenyAllFromTo a b \ DenyAllFromTo b a \ DenyAllFromTo a b)) \ +Cp (DenyAllFromTo a b\DenyAllFromTo b a \ DenyAllFromTo a b) x = Some (deny ())" +by (case_tac "x \ dom (Cp (DenyAllFromTo a b))") (simp_all add: PLemmas split: if_splits) + + +lemma iDdomAux[rule_format]: + "p \ [] \ x \ dom (Cp (list2FWpolicy p)) \ + x \ dom (Cp (list2FWpolicy (insertDenies p))) \ + Cp (list2FWpolicy (insertDenies p)) x = Some (deny ())" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons y ys) thus ?case + proof (cases y) + case DenyAll then show ?thesis by simp + next + case (DenyAllFromTo a b) then show ?thesis + using DenyAllFromTo Cons apply simp + apply (rule impI)+ + proof (cases "ys = []", goal_cases) + case 1 then show ?case by (simp add: DA_is_deny) + next + case 2 then show ?case + apply simp + apply (drule mp) + apply (metis DenyAllFromTo InDomConc ) + apply (cases "x \ dom (Cp (list2FWpolicy (insertDenies ys)))",simp_all) + apply (metis Cdom2 DenyAllFromTo idNMT list2FWpolicyconc) + apply (subgoal_tac "Cp (list2FWpolicy (DenyAllFromTo a b \ + DenyAllFromTo b a \ DenyAllFromTo a b#insertDenies ys)) x = + Cp ((DenyAllFromTo a b \ DenyAllFromTo b a \ DenyAllFromTo a b)) x ") + apply (metis DA_is_deny DenyAllFromTo domdConcStart) + apply (metis DenyAllFromTo l2p_aux2 list2FWpolicyconc nlpaux) + done + qed + next + case (AllowPortFromTo a b c) then show ?thesis using Cons AllowPortFromTo + proof (cases "ys = []", goal_cases) + case 1 then show ?case + apply (simp,intro impI) + apply (subgoal_tac "x \ dom (Cp (DenyAllFromTo a b \ DenyAllFromTo b a))") + apply (auto simp: PLemmas split: if_splits) + done + next + case 2 then show ?case + apply (simp, intro impI) + apply (drule mp) + apply (metis AllowPortFromTo InDomConc) + apply (cases "x \ dom (Cp (list2FWpolicy (insertDenies ys)))",simp_all) + apply (metis AllowPortFromTo Cdom2 idNMT list2FWpolicyconc) + apply (subgoal_tac "Cp (list2FWpolicy (DenyAllFromTo a b \ + DenyAllFromTo b a \ + AllowPortFromTo a b c#insertDenies ys)) x = + Cp ((DenyAllFromTo a b \ DenyAllFromTo b a)) x ") + apply (auto simp: PLemmas split: if_splits)[1] + by (metis AllowPortFromTo CConcStartA ConcAssoc idNMT list2FWpolicyconc nlpaux) + qed + next + case (Conc a b) then show ?thesis + proof (cases "ys = []", goal_cases) + case 1 then show ?case + apply(simp,intro impI) + apply (subgoal_tac "x \ dom (Cp (DenyAllFromTo (first_srcNet a) (first_destNet a) \ + DenyAllFromTo (first_destNet a) (first_srcNet a)))") + by (auto simp: PLemmas split: if_splits) + next + case 2 then show ?case + apply(simp,intro impI) + apply(cases "x \ dom (Cp (list2FWpolicy (insertDenies ys)))") + apply (metis Cdom2 Conc Cons InDomConc idNMT list2FWpolicyconc) + apply (subgoal_tac "Cp (list2FWpolicy(DenyAllFromTo (first_srcNet a)(first_destNet a) \ + DenyAllFromTo (first_destNet a) (first_srcNet a)\ + a \ b#insertDenies ys)) x = + Cp ((DenyAllFromTo(first_srcNet a) (first_destNet a) \ + DenyAllFromTo (first_destNet a)(first_srcNet a) \ a \ b)) x") + apply simp + defer 1 + apply (metis Conc l2p_aux2 list2FWpolicyconc nlpaux) + apply (subgoal_tac "Cp((DenyAllFromTo(first_srcNet a)(first_destNet a) \ + DenyAllFromTo (first_destNet a)(first_srcNet a)\ a \ b)) x = + Cp((DenyAllFromTo (first_srcNet a)(first_destNet a)\ + DenyAllFromTo (first_destNet a) (first_srcNet a))) x ") + apply simp + defer 1 + apply (metis CConcStartA Conc ConcAssoc nlpaux) + by (auto simp: PLemmas split: if_splits) + qed + qed +qed + +lemma iD_isD[rule_format]: + "p \ [] \ x \ dom (Cp (list2FWpolicy p)) \ + Cp (DenyAll \ list2FWpolicy (insertDenies p)) x = Cp DenyAll x" +apply (case_tac "x \ dom (Cp (list2FWpolicy (insertDenies p)))") +apply (simp add: Cp.simps(1) Cdom2 iDdomAux deny_all_def) +using NormalisationIPPProofs.nlpaux by blast + + +lemma inDomConc: + "x\dom (Cp a) \ x\dom (Cp (list2FWpolicy p)) \ x \ dom (Cp (list2FWpolicy(a#p)))" +by (metis domdConcStart) + + +lemma domsdisj[rule_format]: + "p \ [] \ (\ x s. s \ set p \ x \ dom (Cp A) \ x \ dom (Cp s)) \ y \ dom (Cp A) \ + y \ dom (Cp (list2FWpolicy p))" +proof (induct p) + case Nil show ?case by simp +next + case (Cons a p) show ?case + apply (case_tac "p = []", simp) + apply (rule_tac x = y in spec) + apply (simp add: split_tupled_all) + by (metis Cons.hyps inDomConc list.set_intros(1) list.set_intros(2)) +qed + + +lemma isSepaux: + "p \ [] \ noDenyAll (a#p) \ separated (a # p) \ + x \ dom (Cp (DenyAllFromTo (first_srcNet a) (first_destNet a) \ + DenyAllFromTo (first_destNet a) (first_srcNet a) \ a)) \ + x \ dom (Cp (list2FWpolicy p))" +apply (rule_tac A = "(DenyAllFromTo (first_srcNet a) (first_destNet a) \ + DenyAllFromTo (first_destNet a) (first_srcNet a) \ a)" in domsdisj, simp_all) +apply (rule notI) +apply (rule_tac p = xa and x ="(DenyAllFromTo (first_srcNet a) (first_destNet a) \ + DenyAllFromTo (first_destNet a) (first_srcNet a) \ a)" + and y = s in disjSD_no_p_in_both, simp_all) +using disjSD2aux noDA apply blast +using noDA by blast + + +lemma none_MT_rulessep[rule_format]: "none_MT_rules Cp p \ none_MT_rules Cp (separate p)" +by (induct p rule: separate.induct) (simp_all add: Cp.simps map_add_le_mapE map_le_antisym) + + +lemma dom_id: + "noDenyAll (a#p) \ separated (a#p) \ p \ [] \ + x \ dom (Cp (list2FWpolicy p)) \ x \ dom (Cp (a)) \ + x \ dom (Cp (list2FWpolicy (insertDenies p)))" +apply (rule_tac a = a in isSepaux, simp_all) + using idNMT apply blast + using noDAID apply blast + using id_aux4 noDA1eq sepNetsID apply blast +by (simp add: NormalisationIPPProofs.Cdom2 domIff) + + +lemma C_eq_iD_aux2[rule_format]: + "noDenyAll1 p \ separated p\ p \ []\ x \ dom (Cp (list2FWpolicy p))\ + Cp(list2FWpolicy (insertDenies p)) x = Cp(list2FWpolicy p) x" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons y ys) thus ?case + using Cons proof (cases y) + case DenyAll thus ?thesis using Cons DenyAll apply simp + apply (case_tac "ys = []", simp_all) + apply (case_tac "x \ dom (Cp (list2FWpolicy ys))",simp_all) + apply (metis Cdom2 domID idNMT list2FWpolicyconc noDA1eq) + apply (metis DenyAll iD_isD idNMT list2FWpolicyconc nlpaux) + done +next + case (DenyAllFromTo a b) thus ?thesis + using Cons apply simp + apply (rule impI|rule allI|rule conjI|simp)+ + apply (case_tac "ys = []", simp_all) + apply (metis Cdom2 ConcAssoc DenyAllFromTo) + apply (case_tac "x \ dom (Cp (list2FWpolicy ys))", simp_all) + apply (drule mp) + apply (metis noDA1eq) + apply (case_tac "x \ dom (Cp (list2FWpolicy (insertDenies ys)))") + apply (metis Cdom2 DenyAllFromTo idNMT list2FWpolicyconc) + apply (metis domID) + apply (case_tac "x \ dom (Cp (list2FWpolicy (insertDenies ys)))") + apply (subgoal_tac "Cp (list2FWpolicy (DenyAllFromTo a b \ DenyAllFromTo b a \ + DenyAllFromTo a b # insertDenies ys)) x = Some (deny ())") + apply simp_all + apply (subgoal_tac "Cp (list2FWpolicy (DenyAllFromTo a b # ys)) x = + Cp ((DenyAllFromTo a b)) x") + apply (simp add: PLemmas, simp split: if_splits) + apply (metis list2FWpolicyconc nlpaux) + apply (metis Cdom2 DenyAllFromTo iD_isD iDdomAux idNMT list2FWpolicyconc) + apply (metis Cdom2 DenyAllFromTo domIff idNMT list2FWpolicyconc nlpaux) + done +next + case (AllowPortFromTo a b c) thus ?thesis + using AllowPortFromTo Cons apply simp + apply (rule impI|rule allI|rule conjI|simp)+ + apply (case_tac "ys = []", simp_all) + apply (metis Cdom2 ConcAssoc AllowPortFromTo) + apply (case_tac "x \ dom (Cp (list2FWpolicy ys))",simp_all) + apply (drule mp) + apply (metis noDA1eq) + apply (case_tac "x \ dom (Cp (list2FWpolicy (insertDenies ys)))") + apply (metis Cdom2 AllowPortFromTo idNMT list2FWpolicyconc) + apply (metis domID) + apply (subgoal_tac "x \ dom (Cp (AllowPortFromTo a b c))") + apply (case_tac "x \ dom (Cp (list2FWpolicy (insertDenies ys)))", simp_all) + apply (metis AllowPortFromTo Cdom2 ConcAssoc l2p_aux2 list2FWpolicyconc nlpaux) + apply (meson Combinators.distinct(3) FWNormalisationCore.member.simps(4) NormalisationIPPProofs.dom_id noDenyAll.simps(1) separated.simps(1)) + apply (metis AllowPortFromTo domdConcStart) + done +next + case (Conc a b) thus ?thesis + using Cons Conc apply simp + apply (intro impI allI conjI|simp)+ + apply (case_tac "ys = []",simp_all) + apply (metis Cdom2 ConcAssoc Conc) + apply (case_tac "x \ dom (Cp (list2FWpolicy ys))",simp_all) + apply (drule mp) + apply (metis noDA1eq) + apply (case_tac "x \ dom (Cp (a \ b))") + apply (case_tac "x \ dom (Cp (list2FWpolicy (insertDenies ys)))", simp_all) + apply (subst list2FWpolicyconc) + apply (rule idNMT, simp) + apply (metis domID) + apply (metis Cdom2 Conc idNMT list2FWpolicyconc) + apply (metis Cdom2 Conc domIff idNMT list2FWpolicyconc ) + apply (case_tac "x \ dom (Cp (a \ b))") + apply (case_tac "x \ dom (Cp (list2FWpolicy (insertDenies ys)))", simp_all) + apply (subst list2FWpolicyconc) + apply (rule idNMT, simp) + apply (metis Cdom2 Conc ConcAssoc list2FWpolicyconc nlpaux) + apply (metis (lifting, no_types) FWNormalisationCore.member.simps(1) NormalisationIPPProofs.dom_id noDenyAll.simps(1) separated.simps(1)) + apply (metis Conc domdConcStart) + done + qed +qed + +lemma C_eq_iD: + "separated p \ noDenyAll1 p \ wellformed_policy1_strong p \ + Cp(list2FWpolicy (insertDenies p)) = Cp (list2FWpolicy p)" +by (rule ext) (metis CConcStartA C_eq_iD_aux2 DAAux wp1_alternative_not_mt wp1n_tl) + + +lemma noDAsortQ[rule_format]: "noDenyAll1 p \ noDenyAll1 (qsort p l)" +proof (cases "p") + case Nil then show ?thesis by simp +next + case (Cons a list) show ?thesis + apply (insert `p = a # list`, simp_all) + proof (cases "a = DenyAll") + case True + assume * : "a = DenyAll" + show "noDenyAll1(a # list) \ + noDenyAll1(qsort[y\list . \ smaller a y l] l @ a # qsort [y\list . smaller a y l] l)" + using noDAsortQ by fastforce + next + case False + assume * : "a \ DenyAll" + have ** : "noDenyAll1 (a # list) \ noDenyAll (a # list)" by(case_tac a,simp_all add:*) + show "noDenyAll1(a # list) \ + noDenyAll1(qsort[y\list . \ smaller a y l] l @ a # qsort [y\list . smaller a y l] l)" + apply (insert *,rule impI) + apply (rule noDA1eq, frule **) + by (metis append_Cons append_Nil nDAeqSet qsort.simps(2) set_sortQ) + qed +qed + +(*MOVE FORWARD*) + +lemma NetsCollectedSortQ: + "distinct p \noDenyAll1 p \ all_in_list p l \ singleCombinators p \ + NetsCollected (qsort p l)" +by(metis C_eqLemmas_id(22)) + + +lemmas CLemmas = nMTSort nMTSortQ none_MT_rulesRS2 none_MT_rulesrd + noDAsort noDAsortQ nDASC wp1_eq wp1ID SCp2l ANDSep wp1n_RS2 + OTNSEp OTNSC noDA1sep wp1_alternativesep wellformed_eq + wellformed1_alternative_sorted + + +lemmas C_eqLemmas_id = CLemmas NC2Sep NetsCollectedSep + NetsCollectedSort NetsCollectedSortQ separatedNC + + +lemma C_eq_Until_InsertDenies: + "DenyAll\set(policy2list p) \ all_in_list(policy2list p) l \ allNetsDistinct (policy2list p)\ + Cp (list2FWpolicy((insertDenies(separate(sort(removeShadowRules2 + (remdups(rm_MT_rules Cp (insertDeny (removeShadowRules1 (policy2list p)))))) l))))) = + Cp p" +by (subst C_eq_iD,simp_all add: C_eqLemmas_id) (rule C_eq_until_separated, simp_all) + + +lemma C_eq_Until_InsertDeniesQ: + "DenyAll \ set (policy2list p) \ all_in_list (policy2list p) l \ + allNetsDistinct (policy2list p) \ + Cp (list2FWpolicy ((insertDenies (separate (qsort (removeShadowRules2 + (remdups (rm_MT_rules Cp (insertDeny (removeShadowRules1 (policy2list p)))))) l))))) = + Cp p" +apply (subst C_eq_iD, simp_all add: C_eqLemmas_id) + apply (metis WP1rd set_qsort wellformed1_sortedQ wellformed_eq wp1ID wp1_alternativesep + wp1_aux1aa wp1n_RS2 wp1n_RS3) + apply (rule C_eq_until_separatedQ) +by simp_all + + +lemma C_eq_RD_aux[rule_format]: "Cp (p) x = Cp (removeDuplicates p) x" +apply (induct p, simp_all) + apply (intro conjI impI) +by (metis Cdom2 domIff nlpaux not_in_member) (metis Cp.simps(4) CConcStartaux Cdom2 domIff) + + +lemma C_eq_RAD_aux[rule_format]: + "p \ [] \ Cp (list2FWpolicy p) x = Cp (list2FWpolicy (removeAllDuplicates p)) x" +proof (induct p) + case Nil show ?case by simp +next + case (Cons a p) then show ?case + apply simp_all + apply (case_tac "p = []", simp_all) + apply (metis C_eq_RD_aux) + apply (subst list2FWpolicyconc, simp) + apply (case_tac "x \ dom (Cp (list2FWpolicy p))") + apply (subst list2FWpolicyconc) + apply (rule rADnMT, simp) + apply (subst Cdom2,simp) + apply (simp add: NormalisationIPPProofs.Cdom2 domIff) + by (metis C_eq_RD_aux nlpaux domIff list2FWpolicyconc rADnMT) +qed + +lemma C_eq_RAD: + "p \ [] \ Cp (list2FWpolicy p) = Cp (list2FWpolicy (removeAllDuplicates p)) " +by (rule ext) (erule C_eq_RAD_aux) + + +lemma C_eq_compile: +"DenyAll \ set (policy2list p) \ all_in_list (policy2list p) l \ + allNetsDistinct (policy2list p) \ + Cp (list2FWpolicy (removeAllDuplicates (insertDenies (separate + (sort (removeShadowRules2 (remdups (rm_MT_rules Cp (insertDeny + (removeShadowRules1 (policy2list p)))))) l))))) = Cp p" +by (metis C_eq_RAD C_eq_Until_InsertDenies removeAllDuplicates.simps(2)) + + +lemma C_eq_compileQ: + "DenyAll\set(policy2list p) \ all_in_list(policy2list p) l \ allNetsDistinct(policy2list p) \ + Cp (list2FWpolicy (removeAllDuplicates (insertDenies (separate (qsort + (removeShadowRules2 (remdups (rm_MT_rules Cp (insertDeny + (removeShadowRules1 (policy2list p)))))) l))))) = Cp p" +apply (subst C_eq_RAD[symmetric]) + apply (rule idNMT) +apply (metis WP1rd sepnMT sortnMTQ wellformed_policy1_strong.simps(1) wp1ID wp1n_RS2 wp1n_RS3) +apply (rule C_eq_Until_InsertDeniesQ, simp_all) +done + + +lemma C_eq_normalizePr: +"DenyAll \ set (policy2list p) \ allNetsDistinct (policy2list p) \ + all_in_list (policy2list p) (Nets_List p) \ + Cp (list2FWpolicy (normalizePr p)) = Cp p" +unfolding normalizePrQ_def +by (simp add: C_eq_compile normalizePr_def) + + +lemma C_eq_normalizePrQ: +"DenyAll \ set (policy2list p) \ allNetsDistinct (policy2list p) \ + all_in_list (policy2list p) (Nets_List p) \ + Cp (list2FWpolicy (normalizePrQ p)) = Cp p" +unfolding normalizePrQ_def +using C_eq_compileQ by auto + + +lemma domSubset3: "dom (Cp (DenyAll \ x)) = dom (Cp (DenyAll))" +by (simp add: PLemmas split_tupled_all split: option.splits) + + +lemma domSubset4: + "dom (Cp (DenyAllFromTo x y \ DenyAllFromTo y x \ AllowPortFromTo x y dn)) = + dom (Cp (DenyAllFromTo x y \ DenyAllFromTo y x))" +by (simp add: PLemmas split: option.splits decision.splits) auto + + +lemma domSubset5: + "dom (Cp (DenyAllFromTo x y \ DenyAllFromTo y x \ AllowPortFromTo y x dn)) = + dom (Cp (DenyAllFromTo x y \ DenyAllFromTo y x))" +by (simp add: PLemmas split: option.splits decision.splits) auto + + +lemma domSubset1: + "dom (Cp (DenyAllFromTo one two \ DenyAllFromTo two one \ AllowPortFromTo one two dn \ x)) = + dom (Cp (DenyAllFromTo one two \ DenyAllFromTo two one \ x))" +by (simp add: PLemmas allow_all_def deny_all_def split: option.splits decision.splits) auto + + +lemma domSubset2: + "dom (Cp (DenyAllFromTo one two \ DenyAllFromTo two one \ AllowPortFromTo two one dn \ x)) = + dom (Cp (DenyAllFromTo one two \ DenyAllFromTo two one \ x))" +by (simp add: PLemmas allow_all_def deny_all_def split: option.splits decision.splits) auto + + +lemma ConcAssoc2: "Cp (X \ Y \ ((A \ B) \ D)) = Cp (X \ Y \ A \ B \ D)" +by (simp add: Cp.simps) + + +lemma ConcAssoc3: "Cp (X \ ((Y \ A) \ D)) = Cp (X \ Y \ A \ D)" +by (simp add: Cp.simps) + + +lemma RS3_NMT[rule_format]: "DenyAll \ set p \ + rm_MT_rules Cp p \ []" +by (induct_tac p) (simp_all add: PLemmas) + + +lemma norm_notMT: "DenyAll \ set (policy2list p) \ normalizePr p \ []" +unfolding normalizePrQ_def +by (simp add: DAiniD RS3_NMT RS2_NMT idNMT normalizePr_def rADnMT sepnMT sortnMT) + + +lemma norm_notMTQ: "DenyAll \ set (policy2list p) \ normalizePrQ p \ []" +unfolding normalizePrQ_def +by (simp add: DAiniD RS3_NMT sortnMTQ RS2_NMT idNMT rADnMT sepnMT) + + +lemma domDA: "dom (Cp (DenyAll \ A)) = dom (Cp (DenyAll))" +by (rule domSubset3) + + +lemmas domain_reasoningPr = domDA ConcAssoc2 domSubset1 domSubset2 + domSubset3 domSubset4 domSubset5 domSubsetDistr1 + domSubsetDistr2 domSubsetDistrA domSubsetDistrD coerc_assoc ConcAssoc + ConcAssoc3 + + +text {* The following lemmas help with the normalisation *} +lemma list2policyR_Start[rule_format]: "p \ dom (Cp a) \ + Cp (list2policyR (a # list)) p = Cp a p" +by (induct "a # list" rule:list2policyR.induct) + (auto simp: Cp.simps dom_def map_add_def) + +lemma list2policyR_End: "p \ dom (Cp a) \ + Cp (list2policyR (a # list)) p = (Cp a \ list2policy (map Cp list)) p" +by (rule list2policyR.induct) + (simp_all add: Cp.simps dom_def map_add_def list2policy_def split: option.splits) + + +lemma l2polR_eq_el[rule_format]: "N \ [] \ + Cp( list2policyR N) p = (list2policy (map Cp N)) p" +proof (induct N) + case Nil show ?case by simp +next + case (Cons a p) show ?case + apply (insert Cons.hyps, simp_all add: list2policy_def) + by (metis list2policyR_End list2policyR_Start domStart list2policy_def) +qed + + +lemma l2polR_eq: + "N \ [] \ Cp( list2policyR N) = (list2policy (map Cp N))" +by (auto simp: list2policy_def l2polR_eq_el ) + + + + +lemma list2FWpolicys_eq_el[rule_format]: + "Filter \ [] \ Cp (list2policyR Filter) p = Cp (list2FWpolicy (rev Filter)) p" +apply (induct_tac Filter) +apply simp_all +apply (case_tac "list = []") +apply simp_all +apply (case_tac "p \ dom (Cp a)") +apply simp_all +apply (rule list2policyR_Start) +apply simp_all +apply (subgoal_tac "Cp (list2policyR (a # list)) p = Cp (list2policyR list) p") +apply (subgoal_tac "Cp (list2FWpolicy (rev list @ [a])) p = Cp (list2FWpolicy (rev list)) p") +apply simp +apply (rule CConcStart2) +apply simp +apply simp +apply (case_tac list,simp_all) +apply (simp_all add: Cp.simps dom_def map_add_def) +done + +lemma list2FWpolicys_eq: + "Filter \ [] \ + Cp (list2policyR Filter) = Cp (list2FWpolicy (rev Filter))" +by (rule ext, erule list2FWpolicys_eq_el) + + +lemma list2FWpolicys_eq_sym: + "Filter \ [] \ + Cp (list2policyR (rev Filter)) = Cp (list2FWpolicy Filter)" +by (metis list2FWpolicys_eq rev_is_Nil_conv rev_rev_ident) + + +lemma p_eq[rule_format]: "p \ [] \ + list2policy (map Cp (rev p)) = Cp (list2FWpolicy p)" +by (metis l2polR_eq list2FWpolicys_eq_sym rev.simps(1) rev_rev_ident) + + +lemma p_eq2[rule_format]: "normalizePr x \ [] \ + Cp (list2FWpolicy (normalizePr x)) = Cp x \ + list2policy (map Cp (rev (normalizePr x))) = Cp x" +by (simp add: p_eq) + + +lemma p_eq2Q[rule_format]: "normalizePrQ x \ [] \ + Cp (list2FWpolicy (normalizePrQ x)) = Cp x \ + list2policy (map Cp (rev (normalizePrQ x))) = Cp x" +by (simp add: p_eq) + + +lemma list2listNMT[rule_format]: "x \ [] \map sem x \ []" +by (case_tac x) (simp_all) + + +lemma Norm_Distr2: + "r o_f ((P \\<^sub>2 (list2policy Q)) o d) = + (list2policy ((P \\<^sub>L Q) (op \\<^sub>2) r d))" +by (rule ext, rule Norm_Distr_2) + + +lemma NATDistr: + "N \ [] \ F = Cp (list2policyR N) \ + ((\ (x,y). x) o_f ((NAT \\<^sub>2 F) o (\ x. (x,x))) = + (list2policy ( ((NAT \\<^sub>L (map Cp N)) (op \\<^sub>2) + (\ (x,y). x) (\ x. (x,x))))))" +by (simp add: l2polR_eq) (rule ext,rule Norm_Distr_2) + + +lemma C_eq_normalize_manual: + "DenyAll \ set (policy2list p) \ allNetsDistinct (policy2list p) \ + all_in_list (policy2list p) l \ + Cp (list2FWpolicy (normalize_manual_orderPr p l)) = Cp p" +unfolding normalize_manual_orderPr_def +by(simp_all add:C_eq_compile) + + +lemma p_eq2_manualQ[rule_format]: + "normalize_manual_orderPrQ x l \ [] \ + Cp (list2FWpolicy (normalize_manual_orderPrQ x l)) = Cp x \ + list2policy (map Cp (rev (normalize_manual_orderPrQ x l))) = Cp x" +by (simp add: p_eq) + + +lemma norm_notMT_manualQ: "DenyAll \ set (policy2list p) \ normalize_manual_orderPrQ p l \ []" +by (simp add: DAiniD RS3_NMT sortnMTQ RS2_NMT idNMT normalize_manual_orderPrQ_def rADnMT sepnMT) + + +lemma C_eq_normalizePr_manualQ: + "DenyAll \ set (policy2list p) \ + allNetsDistinct (policy2list p) \ + all_in_list (policy2list p) l \ + Cp (list2FWpolicy (normalize_manual_orderPrQ p l)) = Cp p" +by (simp add: normalize_manual_orderPrQ_def C_eq_compileQ) + + +lemma p_eq2_manual[rule_format]: "normalize_manual_orderPr x l \ [] \ + Cp (list2FWpolicy (normalize_manual_orderPr x l)) = Cp x \ + list2policy (map Cp (rev (normalize_manual_orderPr x l))) = Cp x" +by (simp add: p_eq) + + +lemma norm_notMT_manual: "DenyAll \ set (policy2list p) \ normalize_manual_orderPr p l \ []" +unfolding normalize_manual_orderPr_def +by (simp add: idNMT rADnMT wellformed1_alternative_sorted wp1ID wp1_alternativesep wp1n_RS2) + + + +text{* As an example, how this theorems can be used for a concrete +normalisation instantiation. *} + +lemma normalizePrNAT: + "DenyAll \ set (policy2list Filter) \ + allNetsDistinct (policy2list Filter) \ + all_in_list (policy2list Filter) (Nets_List Filter) \ + ((\ (x,y). x) o_f (((NAT \\<^sub>2 Cp Filter) o (\x. (x,x))))) = + list2policy ((NAT \\<^sub>L (map Cp (rev (normalizePr Filter)))) (op \\<^sub>2) (\ (x,y). x) (\ x. (x,x)))" +by (simp add: C_eq_normalizePr NATDistr list2FWpolicys_eq_sym norm_notMT) + + +lemma domSimpl[simp]: "dom (Cp (A \ DenyAll)) = dom (Cp (DenyAll))" +by (simp add: PLemmas) + + +end + + diff --git a/FWNormalisation/NormalisationIntegerPortProof.thy b/FWNormalisation/NormalisationIntegerPortProof.thy new file mode 100644 index 0000000..7d7d944 --- /dev/null +++ b/FWNormalisation/NormalisationIntegerPortProof.thy @@ -0,0 +1,1971 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Normalisation Proofs: Integer Port *} +theory NormalisationIntegerPortProof +imports NormalisationGenericProofs +begin + +text{* Normalisation proofs which are specific to the IntegerPort address representation. *} + +lemma ConcAssoc: "C((A \ B) \ D) = C(A \ (B \ D))" +by (simp add: C.simps) + + +lemma aux26[simp]: "twoNetsDistinct a b c d \ + dom (C (AllowPortFromTo a b p)) \ dom (C (DenyAllFromTo c d)) = {}" +by (auto simp: PLemmas twoNetsDistinct_def netsDistinct_def) auto + + +lemma wp2_aux[rule_format]: "wellformed_policy2 (xs @ [x]) \ + wellformed_policy2 xs" +by (induct xs, simp_all) (case_tac "a", simp_all) + + +lemma Cdom2: "x \ dom(C b) \ C (a \ b) x = (C b) x" +by (auto simp: C.simps) + +lemma wp2Conc[rule_format]: "wellformed_policy2 (x#xs) \ wellformed_policy2 xs" +by (case_tac "x",simp_all) + +lemma DAimpliesMR_E[rule_format]: "DenyAll \ set p \ + (\ r. applied_rule_rev C x p = Some r)" +apply (simp add: applied_rule_rev_def) +apply (rule_tac xs = p in rev_induct, simp_all) +by (metis C.simps(1) denyAllDom) + + +lemma DAimplieMR[rule_format]: "DenyAll \ set p \ applied_rule_rev C x p \ None" +by (auto intro: DAimpliesMR_E) + +lemma MRList1[rule_format]: "x \ dom (C a) \ applied_rule_rev C x (b@[a]) = Some a" +by (simp add: applied_rule_rev_def) + +lemma MRList2: "x \ dom (C a) \ applied_rule_rev C x (c@b@[a]) = Some a" +by (simp add: applied_rule_rev_def) + +lemma MRList3: + "x \ dom (C xa) \ applied_rule_rev C x (a @ b # xs @ [xa]) = applied_rule_rev C x (a @ b # xs)" +by (simp add: applied_rule_rev_def) + +lemma CConcEnd[rule_format]: + "C a x = Some y \ C (list2FWpolicy (xs @ [a])) x = Some y" + (is "?P xs") +apply (rule_tac P = ?P in list2FWpolicy.induct) +by (simp_all add:C.simps) + +lemma CConcStartaux: " C a x = None \ (C aa ++ C a) x = C aa x" +by (simp add: PLemmas) + +lemma CConcStart[rule_format]: + "xs \ [] \ C a x = None \ C (list2FWpolicy (xs @ [a])) x = C (list2FWpolicy xs) x" +apply (rule list2FWpolicy.induct) +by (simp_all add: PLemmas) + +lemma mrNnt[simp]: "applied_rule_rev C x p = Some a \ p \ []" +apply (simp add: applied_rule_rev_def) +by auto + +lemma mr_is_C[rule_format]: + "applied_rule_rev C x p = Some a \ C (list2FWpolicy (p)) x = C a x" +apply (simp add: applied_rule_rev_def) + apply (rule rev_induct,auto) + apply (metis CConcEnd) +apply (metis CConcEnd) +by (metis CConcStart applied_rule_rev_def mrNnt option.exhaust) + + +lemma CConcStart2: + "p \ [] \ x \ dom (C a) \ C (list2FWpolicy (p @ [a])) x = C (list2FWpolicy p) x" +by (erule CConcStart,simp add: PLemmas) + +lemma CConcEnd1: + "q @ p \ [] \ x \ dom (C a) \ C (list2FWpolicy (q @ p @ [a])) x = C (list2FWpolicy (q @ p)) x" +apply (subst lCdom2) +by (rule CConcStart2, simp_all) + +lemma CConcEnd2[rule_format]: + "x \ dom (C a) \ C (list2FWpolicy (xs @ [a])) x = C a x" (is "?P xs") +apply (rule_tac P = ?P in list2FWpolicy.induct) +by (auto simp:C.simps) + + +lemma bar3: + "x \ dom (C (list2FWpolicy (xs @ [xa]))) \ x \ dom (C (list2FWpolicy xs)) \ x \ dom (C xa)" +by auto (metis CConcStart eq_Nil_appendI l2p_aux2 option.simps(3)) + + +lemma CeqEnd[rule_format,simp]: + "a \ [] \ x \ dom (C (list2FWpolicy a)) \ C (list2FWpolicy(b@a)) x = (C (list2FWpolicy a)) x" +apply (rule rev_induct,simp_all) + apply (case_tac "xs \ []", simp_all) + apply (case_tac "x \ dom (C xa)") + apply (metis CConcEnd2 MRList2 mr_is_C ) +apply (metis CConcEnd1 CConcStart2 Nil_is_append_conv bar3 ) +apply (metis MRList2 eq_Nil_appendI mr_is_C ) +done + +lemma CConcStartA[rule_format,simp]: + "x \ dom (C a) \ x \ dom (C (list2FWpolicy (a # b)))" (is "?P b") +apply (rule_tac P = ?P in list2FWpolicy.induct) + apply (simp_all add: C.simps) +done + + +lemma domConc: + "x \ dom (C (list2FWpolicy b)) \ b \ [] \ x \ dom (C (list2FWpolicy (a @ b)))" +by (auto simp: PLemmas) + +lemma CeqStart[rule_format,simp]: + "x\dom(C(list2FWpolicy a)) \ a\[] \ b\[] \ C(list2FWpolicy(b@a)) x = (C(list2FWpolicy b)) x" +apply (rule list2FWpolicy.induct,simp_all) + apply (auto simp: list2FWpolicyconc PLemmas) +done + +lemma C_eq_if_mr_eq2: + "applied_rule_rev C x a = \r\ \ + applied_rule_rev C x b = \r\ \ a \ [] \ b \ [] \ + C (list2FWpolicy a) x = C (list2FWpolicy b) x" +by (metis mr_is_C) + +lemma nMRtoNone[rule_format]: + "p \ [] \ applied_rule_rev C x p = None \ C (list2FWpolicy p) x = None" +apply (rule rev_induct, simp_all) + apply (case_tac "xs = []", simp_all) +by (simp_all add: applied_rule_rev_def dom_def) + +lemma C_eq_if_mr_eq: + "applied_rule_rev C x b = applied_rule_rev C x a \ a \ [] \ b \ [] \ + C (list2FWpolicy a) x = C (list2FWpolicy b) x" +apply (cases "applied_rule_rev C x a = None", simp_all) + apply (subst nMRtoNone,simp_all) +apply (subst nMRtoNone, simp_all) +by (auto intro: C_eq_if_mr_eq2) + + + +lemma notmatching_notdom: "applied_rule_rev C x (p@[a]) \ Some a \ x \ dom (C a)" +by (simp add: applied_rule_rev_def split: if_splits) + +lemma foo3a[rule_format]: + "applied_rule_rev C x (a@[b]@c) = Some b \ r \ set c \ b \ set c \ x \ dom (C r)" +apply (rule rev_induct) + apply simp_all +apply (intro impI conjI, simp) +apply (rule_tac p = "a @ b # xs" in notmatching_notdom,simp_all) +by (metis MRList2 MRList3 append_Cons option.inject) + + +lemma foo3D: + "wellformed_policy1 p \ p = DenyAll # ps \ + applied_rule_rev C x p = \DenyAll\ \ r \ set ps \ x \ dom (C r)" +by (rule_tac a = "[]" and b = "DenyAll" and c = "ps" in foo3a, simp_all) + +lemma foo4[rule_format]: + "set p = set s \ (\ r. r \ set p \ x \ dom (C r)) \ (\ r .r \ set s \ x \ dom (C r))" +by simp + +lemma foo5b[rule_format]: + "x \ dom (C b) \ (\ r. r \ set c \ x \ dom (C r)) \ applied_rule_rev C x (b#c) = Some b" +apply (simp add: applied_rule_rev_def) +apply (rule_tac xs = c in rev_induct, simp_all) +done + +lemma mr_first: + "x \ dom (C b) \ \r. r \ set c \ x \ dom (C r) \ s = b # c \ applied_rule_rev C x s = \b\" +by (simp add: foo5b) + +lemma mr_charn[rule_format]: + "a \ set p \ (x \ dom (C a)) \ (\ r. r \ set p \ x \ dom (C r) \ r = a) \ + applied_rule_rev C x p = Some a" +unfolding applied_rule_rev_def +apply (rule_tac xs = p in rev_induct) + apply(simp) +by(safe,auto) + +lemma foo8: + "\r. r \ set p \ x \ dom (C r) \ r = a \ set p = set s \ + \r. r \ set s \ x \ dom (C r) \ r = a" +by auto + +lemma mrConcEnd[rule_format]: + "applied_rule_rev C x (b # p) = Some a \ a \ b \ applied_rule_rev C x p = Some a" +apply (simp add: applied_rule_rev_def) +by (rule_tac xs = p in rev_induct,auto) + + +lemma wp3tl[rule_format]: "wellformed_policy3 p \ wellformed_policy3 (tl p)" +by (induct p, simp_all, case_tac a, simp_all) + +lemma wp3Conc[rule_format]: "wellformed_policy3 (a#p) \ wellformed_policy3 p" +by (induct p, simp_all, case_tac a, simp_all) + + +lemma foo98[rule_format]: + "applied_rule_rev C x (aa # p) = Some a \ x \ dom (C r) \ r \ set p \ a \ set p" +unfolding applied_rule_rev_def +apply (rule rev_induct, simp_all) +apply (case_tac "r = xa", simp_all) +done + + +lemma mrMTNone[simp]: "applied_rule_rev C x [] = None" +by (simp add: applied_rule_rev_def) + +lemma DAAux[simp]: "x \ dom (C DenyAll)" +by (simp add: dom_def PolicyCombinators.PolicyCombinators C.simps) + +lemma mrSet[rule_format]: "applied_rule_rev C x p = Some r \ r \ set p" +unfolding applied_rule_rev_def +by (rule_tac xs=p in rev_induct, simp_all) + + +lemma mr_not_Conc: "singleCombinators p \ applied_rule_rev C x p \ Some (a\b)" +apply (auto simp: mrSet) +apply (drule mrSet) +apply (erule SCnotConc,simp) +done + + +lemma foo25[rule_format]: "wellformed_policy3 (p@[x]) \ wellformed_policy3 p" +by (induct p, simp_all, case_tac a, simp_all) + +lemma mr_in_dom[rule_format]: "applied_rule_rev C x p = Some a \ x \ dom (C a)" +apply (rule_tac xs = p in rev_induct) +by (auto simp: applied_rule_rev_def) + + +lemma wp3EndMT[rule_format]: + "wellformed_policy3 (p@[xs]) \ AllowPortFromTo a b po \ set p \ + dom (C (AllowPortFromTo a b po)) \ dom (C xs) = {}" +apply (induct p,simp_all) +apply (intro impI,drule mp,erule wp3Conc) +by clarify auto + +lemma foo29: "\dom (C a) \ {}; dom (C a) \ dom (C b) = {}\ \ a \ b" by auto + +lemma foo28: + "AllowPortFromTo a b po \ set p \ dom (C (AllowPortFromTo a b po)) \ {} \ + wellformed_policy3 (p @ [x]) \ x \ AllowPortFromTo a b po" +by (metis foo29 C.simps(3) wp3EndMT) + +lemma foo28a[rule_format]: "x \ dom (C a) \ dom (C a) \ {}" by auto + +lemma allow_deny_dom[simp]: + "dom (C (AllowPortFromTo a b po)) \ dom (C (DenyAllFromTo a b))" +by (simp_all add: twoNetsDistinct_def netsDistinct_def PLemmas) auto + +lemma DenyAllowDisj: + "dom (C (AllowPortFromTo a b p)) \ {} \ + dom (C (DenyAllFromTo a b)) \ dom (C (AllowPortFromTo a b p)) \ {}" +by (metis Int_absorb1 allow_deny_dom) + +lemma foo31: + "\r. r \ set p \ x \ dom (C r) \ + r = AllowPortFromTo a b po \ r = DenyAllFromTo a b \ r = DenyAll \ + set p = set s \ + \r. r \ set s \ x \ dom (C r) \ r=AllowPortFromTo a b po \ r = DenyAllFromTo a b \ r = DenyAll" +by auto + + + +lemma wp1_auxa: + "wellformed_policy1_strong p\(\ r. applied_rule_rev C x p = Some r)" +apply (rule DAimpliesMR_E) +by (erule wp1_aux1aa) + + + +lemma deny_dom[simp]: + "twoNetsDistinct a b c d \ dom (C (DenyAllFromTo a b)) \ dom (C (DenyAllFromTo c d)) = {}" +apply (simp add: C.simps) +by (erule aux6) + +lemma domTrans: "dom a \ dom b \ dom b \ dom c = {} \ dom a \ dom c = {}" by auto + +lemma DomInterAllowsMT: + "twoNetsDistinct a b c d \ +dom (C (AllowPortFromTo a b p)) \ dom (C (AllowPortFromTo c d po)) = {}" +apply (case_tac "p = po", simp_all) +apply (rule_tac b = "C (DenyAllFromTo a b)" in domTrans, simp_all) +apply (metis domComm aux26 tNDComm) +by (simp add: twoNetsDistinct_def netsDistinct_def PLemmas) auto + +lemma DomInterAllowsMT_Ports: + "p \ po \ dom (C (AllowPortFromTo a b p)) \ dom (C (AllowPortFromTo c d po)) = {}" +by (simp add: twoNetsDistinct_def netsDistinct_def PLemmas) auto + + + +lemma wellformed_policy3_charn[rule_format]: + "singleCombinators p \ distinct p \ allNetsDistinct p \ + wellformed_policy1 p \ wellformed_policy2 p \ wellformed_policy3 p" +apply (induct_tac p) +apply simp_all +apply (auto intro: singleCombinatorsConc ANDConc waux2 wp2Conc) +apply (case_tac a, simp_all, clarify) + apply (case_tac r, simp_all) + apply (metis Int_commute) +apply (metis DomInterAllowsMT aux7aa DomInterAllowsMT_Ports) +apply (metis aux0_0 ) +done + + + +lemma DistinctNetsDenyAllow: + "DenyAllFromTo b c \ set p \ + AllowPortFromTo a d po \ set p \ + allNetsDistinct p \ dom (C (DenyAllFromTo b c)) \ dom (C (AllowPortFromTo a d po)) \ {} \ + b = a \ c = d" +unfolding allNetsDistinct_def +apply (frule_tac x = "b" in spec) +apply (drule_tac x = "d" in spec) +apply (drule_tac x = "a" in spec) +apply (drule_tac x = "c" in spec) +apply (simp,metis Int_commute ND0aux1 ND0aux3 NDComm aux26 twoNetsDistinct_def ND0aux2 ND0aux4) +done + +lemma DistinctNetsAllowAllow: + "AllowPortFromTo b c poo \ set p \ + AllowPortFromTo a d po \ set p \ + allNetsDistinct p \ + dom (C (AllowPortFromTo b c poo)) \ dom (C (AllowPortFromTo a d po)) \ {} \ + b = a \ c = d \ poo = po" +unfolding allNetsDistinct_def +apply (frule_tac x = "b" in spec) +apply (drule_tac x = "d" in spec) +apply (drule_tac x = "a" in spec) +apply (drule_tac x = "c" in spec) +apply (simp,metis DomInterAllowsMT DomInterAllowsMT_Ports ND0aux3 ND0aux4 NDComm twoNetsDistinct_def) +done + + + +lemma WP2RS2[simp]: + "singleCombinators p \ distinct p \ allNetsDistinct p \ + wellformed_policy2 (removeShadowRules2 p)" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons x xs) + have wp_xs: "wellformed_policy2 (removeShadowRules2 xs)" + by (metis Cons ANDConc distinct.simps(2) singleCombinatorsConc) + show ?case + proof (cases x) + case DenyAll thus ?thesis using wp_xs by simp + next + case (DenyAllFromTo a b) thus ?thesis + using wp_xs Cons by (simp,metis DenyAllFromTo aux aux7 tNDComm deny_dom) + next + case (AllowPortFromTo a b p) thus ?thesis + using wp_xs by (simp, metis aux26 AllowPortFromTo Cons(4) aux aux7a tNDComm) + next + case (Conc a b) thus ?thesis + by (metis Conc Cons(2) singleCombinators.simps(2)) + qed +qed + + + +lemma AD_aux: + "AllowPortFromTo a b po \ set p \ DenyAllFromTo c d \ set p \ + allNetsDistinct p \ singleCombinators p \ a \ c \ b \ d \ + dom (C (AllowPortFromTo a b po)) \ dom (C (DenyAllFromTo c d)) = {}" +by (rule aux26,rule_tac x ="AllowPortFromTo a b po" and y = "DenyAllFromTo c d" in tND, auto) + + + +lemma sorted_WP2[rule_format]: "sorted p l \ all_in_list p l \ distinct p \ + allNetsDistinct p \ singleCombinators p \ wellformed_policy2 p" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons a p) thus ?case + proof (cases a) + case DenyAll thus ?thesis using Cons + by (auto intro: ANDConc singleCombinatorsConc sortedConcEnd) + next + case (DenyAllFromTo c d) thus ?thesis using Cons + apply simp + apply (intro impI conjI allI) + apply (rule deny_dom) + apply (auto intro: aux7 tNDComm ANDConc singleCombinatorsConc sortedConcEnd) + done + next + case (AllowPortFromTo c d e) thus ?thesis using Cons + apply simp + apply (intro impI conjI allI aux26) + apply (rule_tac x = "AllowPortFromTo c d e" and y = "DenyAllFromTo aa b" in tND) + apply (assumption,simp_all) + apply (subgoal_tac "smaller (AllowPortFromTo c d e) (DenyAllFromTo aa b) l") + apply (simp split: if_splits) + apply metis + apply (erule sorted_is_smaller, simp_all) + apply (metis bothNet.simps(2) in_list.simps(2) in_set_in_list) + by (auto intro: aux7 tNDComm ANDConc singleCombinatorsConc sortedConcEnd) + next + case (Conc a b) thus ?thesis using Cons by simp + qed +qed + + + + +lemma wellformed2_sorted[simp]: + "all_in_list p l \ distinct p \ allNetsDistinct p \ + singleCombinators p \ wellformed_policy2 (sort p l)" +apply (rule sorted_WP2,erule sort_is_sorted, simp_all) +apply (auto elim: all_in_listSubset intro: SC3 singleCombinatorsConc sorted_insort) +done + + +lemma wellformed2_sortedQ[simp]: "\all_in_list p l; distinct p; allNetsDistinct p; + singleCombinators p\ \ wellformed_policy2 (qsort p l)" +apply (rule sorted_WP2,erule sort_is_sortedQ, simp_all) +apply (auto elim: all_in_listSubset intro: SC3Q singleCombinatorsConc distinct_sortQ) +done + + +lemma C_DenyAll[simp]: "C (list2FWpolicy (xs @ [DenyAll])) x = Some (deny ())" +by (auto simp: PLemmas) + + +lemma C_eq_RS1n: + "C(list2FWpolicy (removeShadowRules1_alternative p)) = C(list2FWpolicy p)" +proof (cases "p")print_cases + case Nil then show ?thesis apply(simp_all) + by (metis list2FWpolicy.simps(1) rSR1_eq removeShadowRules1.simps(2)) +next + case (Cons x list) show ?thesis + apply (rule rev_induct) + apply (metis rSR1_eq removeShadowRules1.simps(2)) + apply (case_tac "xs = []", simp_all) + unfolding removeShadowRules1_alternative_def + apply (case_tac x, simp_all) + by (metis (no_types, hide_lams) CConcEnd2 CConcStart C_DenyAll RS1n_nMT aux114 + domIff removeShadowRules1_alternative_def + removeShadowRules1_alternative_rev.simps(2) rev.simps(2)) +qed + + + +lemma C_eq_RS1[simp]: + "p \ [] \ C(list2FWpolicy (removeShadowRules1 p)) = C(list2FWpolicy p)" +by (metis rSR1_eq C_eq_RS1n) + + +lemma EX_MR_aux[rule_format]: + "applied_rule_rev C x (DenyAll # p) \ Some DenyAll \ (\y. applied_rule_rev C x p = Some y)" +apply (simp add: applied_rule_rev_def) +apply (rule_tac xs = p in rev_induct, simp_all) +done + +lemma EX_MR : +"applied_rule_rev C x p \ \DenyAll\ \ p = DenyAll # ps \ + applied_rule_rev C x p = applied_rule_rev C x ps" +apply auto + apply (subgoal_tac "applied_rule_rev C x (DenyAll#ps) \ None", auto) +apply (metis mrConcEnd) +by (metis DAimpliesMR_E list.sel(1) hd_in_set list.simps(3) not_Some_eq) + + + +lemma mr_not_DA: + "wellformed_policy1_strong s \ + applied_rule_rev C x p = \DenyAllFromTo a ab\ \ set p = set s \ + applied_rule_rev C x s \ \DenyAll\" +apply (subst wp1n_tl, simp_all) + apply (subgoal_tac "x \ dom (C (DenyAllFromTo a ab))") + apply (subgoal_tac "DenyAllFromTo a ab \ set (tl s)") + apply (metis wp1n_tl foo98 wellformed_policy1_strong.simps(2)) + using mrSet r_not_DA_in_tl apply blast +by (simp add: mr_in_dom) + + +lemma domsMT_notND_DD: + "dom (C (DenyAllFromTo a b)) \ dom (C (DenyAllFromTo c d)) \ {} \ \ netsDistinct a c" +using deny_dom twoNetsDistinct_def by blast + + +lemma domsMT_notND_DD2: + "dom (C (DenyAllFromTo a b)) \ dom (C (DenyAllFromTo c d)) \ {} \ \ netsDistinct b d" +using deny_dom twoNetsDistinct_def by blast + + +lemma domsMT_notND_DD3: + "x \ dom (C (DenyAllFromTo a b)) \ x \ dom (C (DenyAllFromTo c d)) \ \ netsDistinct a c" +by(auto intro!:domsMT_notND_DD) + + +lemma domsMT_notND_DD4: + "x \ dom (C (DenyAllFromTo a b)) \ x \ dom (C (DenyAllFromTo c d)) \ \ netsDistinct b d" +by(auto intro!:domsMT_notND_DD2) + + +lemma NetsEq_if_sameP_DD: + "allNetsDistinct p \ u \ set p \ v \ set p \ u = DenyAllFromTo a b \ + v = DenyAllFromTo c d \ x \ dom (C u) \ x \ dom (C v) \ a = c \ b = d" +apply (simp add: allNetsDistinct_def) +by (metis ND0aux1 ND0aux2 domsMT_notND_DD3 domsMT_notND_DD4 ) + + +lemma rule_charn1: + assumes aND: "allNetsDistinct p" + and mr_is_allow: "applied_rule_rev C x p = Some (AllowPortFromTo a b po)" + and SC: "singleCombinators p" + and inp: "r \ set p" + and inDom: "x \ dom (C r)" + shows "(r = AllowPortFromTo a b po \ r = DenyAllFromTo a b \ r = DenyAll)" +proof (cases r) + case DenyAll show ?thesis by (metis DenyAll) +next + case (DenyAllFromTo x y) show ?thesis + by (metis AD_aux DenyAllFromTo SC aND domInterMT inDom inp mrSet mr_in_dom mr_is_allow) +next + case (AllowPortFromTo x y b) show ?thesis + by (metis (no_types, lifting) AllowPortFromTo DistinctNetsAllowAllow aND domInterMT + inDom inp mrSet mr_in_dom mr_is_allow) +next + case (Conc x y) thus ?thesis using assms by (metis aux0_0) +qed + +lemma none_MT_rulessubset[rule_format]: + "none_MT_rules C a \ set b \ set a \ none_MT_rules C b" +by (induct b,simp_all) (metis notMTnMT) + + +lemma nMTSort: "none_MT_rules C p \ none_MT_rules C (sort p l)" +by (metis set_sort nMTeqSet) + + + +lemma nMTSortQ: "none_MT_rules C p \ none_MT_rules C (qsort p l)" +by (metis set_sortQ nMTeqSet) + +lemma wp3char[rule_format]: +"none_MT_rules C xs \ C (AllowPortFromTo a b po)=\ \ wellformed_policy3(xs@[DenyAllFromTo a b]) \ + AllowPortFromTo a b po \ set xs" +apply (induct xs,simp_all) +by (metis domNMT wp3Conc) + + + +lemma wp3charn[rule_format]: +assumes domAllow: "dom (C (AllowPortFromTo a b po)) \ {}" +and wp3: "wellformed_policy3 (xs @ [DenyAllFromTo a b])" +shows "AllowPortFromTo a b po \ set xs" +apply (insert assms) +proof (induct xs) + case Nil show ?case by simp +next + case (Cons x xs) show ?case using Cons + by (simp,auto intro: wp3Conc) (auto simp: DenyAllowDisj domAllow) +qed + + +lemma rule_charn2: + assumes aND: "allNetsDistinct p" + and wp1: "wellformed_policy1 p" + and SC: "singleCombinators p" + and wp3: "wellformed_policy3 p" + and allow_in_list: "AllowPortFromTo c d po \ set p" + and x_in_dom_allow: "x \ dom (C (AllowPortFromTo c d po))" + shows "applied_rule_rev C x p = Some (AllowPortFromTo c d po)" + proof (insert assms, induct p rule: rev_induct) + case Nil show ?case using Nil by simp + next + case (snoc y ys) + then have * : " y = AllowPortFromTo c d po \ ys \ []" sorry + have ** : "applied_rule_rev C x ys = Some (AllowPortFromTo c d po)" sledgehammer sorry + show ?case using snoc + apply (case_tac "y = (AllowPortFromTo c d po)", simp_all ) + apply (simp add: applied_rule_rev_def) + apply (subgoal_tac "ys \ []") + apply (subgoal_tac "applied_rule_rev C x ys = Some (AllowPortFromTo c d po)") + defer 1 + apply (metis ANDConcEnd SCConcEnd WP1ConcEnd foo25) + apply (metis inSet_not_MT) + proof (cases y) + case DenyAll thus ?thesis using DenyAll snoc + apply simp + by (metis DAnotTL DenyAll inSet_not_MT policy2list.simps(2)) + next + case (DenyAllFromTo a b) thus ?thesis using snoc apply simp + apply (simp_all add: applied_rule_rev_def) + apply (rule conjI) + apply (metis domInterMT wp3EndMT) + apply (rule impI) + by (metis ANDConcEnd DenyAllFromTo SCConcEnd WP1ConcEnd foo25) + next + case (AllowPortFromTo a1 a2 b) thus ?thesis + using AllowPortFromTo snoc apply simp + apply (simp_all add: applied_rule_rev_def) + apply (rule conjI) + apply (metis domInterMT wp3EndMT) + by (metis ANDConcEnd AllowPortFromTo SCConcEnd WP1ConcEnd foo25 x_in_dom_allow) + next + case (Conc a b) thus ?thesis using Conc snoc apply simp + by (metis Conc aux0_0 in_set_conv_decomp) + qed +qed + +lemma rule_charn3: + " wellformed_policy1 p \ allNetsDistinct p \ singleCombinators p \ + wellformed_policy3 p \ applied_rule_rev C x p = \DenyAllFromTo c d\ \ + AllowPortFromTo a b po \ set p \ x \ dom (C (AllowPortFromTo a b po))" +by (clarify, auto simp: rule_charn2 dom_def) + +lemma rule_charn4: +assumes wp1: "wellformed_policy1 p" +and aND: "allNetsDistinct p" +and SC: "singleCombinators p" +and wp3: "wellformed_policy3 p" +and DA: "DenyAll \ set p" +and mr: "applied_rule_rev C x p = Some (DenyAllFromTo a b)" +and rinp: "r \ set p" +and xindom: "x \ dom (C r)" +shows "r = DenyAllFromTo a b" +proof (cases r) + case DenyAll thus ?thesis using DenyAll assms by simp +next + case (DenyAllFromTo c d) thus ?thesis using assms apply simp + apply (erule_tac x = x and p = p and v = "(DenyAllFromTo a b)" and + u = "(DenyAllFromTo c d)" in NetsEq_if_sameP_DD) + apply simp_all + apply (erule mrSet) + by (erule mr_in_dom) +next + case (AllowPortFromTo c d e) thus ?thesis using assms apply simp + apply (subgoal_tac "x \ dom (C (AllowPortFromTo c d e))") + apply simp + apply (rule_tac p = p in rule_charn3) + by (auto intro: SCnotConc) +next + case (Conc a b) thus ?thesis using assms apply simp + by (metis Conc aux0_0) +qed + + + +lemma foo31a: + "\r. r \ set p \ x \ dom (C r) \ r=AllowPortFromTo a b po \ r=DenyAllFromTo a b \ r=DenyAll \ + set p = set s \ r \ set s \ x \ dom (C r) \ + r = AllowPortFromTo a b po \ r = DenyAllFromTo a b \ r = DenyAll" +by auto + + +lemma aux4[rule_format]: + "applied_rule_rev C x (a#p) = Some a \ a \ set (p) \ applied_rule_rev C x p = None" +apply (rule rev_induct,simp_all) +by (metis aux0_4 empty_iff empty_set insert_iff list.simps(15) mrSet mreq_end3) + + +lemma mrDA_tl: + assumes mr_DA: "applied_rule_rev C x p = Some DenyAll" + and wp1n: "wellformed_policy1_strong p" + shows "applied_rule_rev C x (tl p) = None" + apply (rule aux4 [where a = DenyAll]) + apply (metis wp1n_tl mr_DA wp1n) + by (metis WP1n_DA_notinSet wp1n) + +lemma rule_charnDAFT: +"wellformed_policy1_strong p \ allNetsDistinct p \ singleCombinators p \ + wellformed_policy3 p \ applied_rule_rev C x p = \DenyAllFromTo a b\ \ r \ set (tl p) \ + x \ dom (C r) \ r = DenyAllFromTo a b" +apply (subgoal_tac "p = DenyAll#(tl p)") +apply (metis AND_tl Combinators.distinct(1) SC_tl list.sel(3) mrConcEnd rule_charn4 waux2 wellformed_policy1_charn wp1_aux1aa wp1_eq wp3tl) +using wp1n_tl by blast + + +lemma mrDenyAll_is_unique: + "\wellformed_policy1_strong p; applied_rule_rev C x p = Some DenyAll; + r \ set (tl p)\ \ x \ dom (C r)" +apply (rule_tac a = "[]" and b = "DenyAll" and c = "tl p" in foo3a, simp_all) + apply (metis wp1n_tl) +by (metis WP1n_DA_notinSet) + + +theorem C_eq_Sets_mr: + assumes sets_eq: "set p = set s" + and SC: "singleCombinators p" + and wp1_p: "wellformed_policy1_strong p" + and wp1_s: "wellformed_policy1_strong s" + and wp3_p: "wellformed_policy3 p" + and wp3_s: "wellformed_policy3 s" + and aND: "allNetsDistinct p" + shows "applied_rule_rev C x p = applied_rule_rev C x s" +proof (cases "applied_rule_rev C x p") + case None + have DA: "DenyAll \ set p" using wp1_p by (auto simp: wp1_aux1aa) + have notDA: "DenyAll \ set p" using None by (auto simp: DAimplieMR) + thus ?thesis using DA by (contradiction) +next + case (Some y) thus ?thesis + proof (cases y) + have tl_p: "p = DenyAll#(tl p)" by (metis wp1_p wp1n_tl) + have tl_s: "s = DenyAll#(tl s)" by (metis wp1_s wp1n_tl) + have tl_eq: "set (tl p) = set (tl s)" + by (metis list.sel(3) WP1n_DA_notinSet sets_eq foo2 + wellformed_policy1_charn wp1_aux1aa wp1_eq wp1_p wp1_s) + { case DenyAll + have mr_p_is_DenyAll: "applied_rule_rev C x p = Some DenyAll" + by (simp add: DenyAll Some) + hence x_notin_tl_p: "\ r. r \ set (tl p) \ x \ dom (C r)" using wp1_p + by (auto simp: mrDenyAll_is_unique) + hence x_notin_tl_s: "\ r. r \ set (tl s) \ x \ dom (C r)" using tl_eq + by auto + hence mr_s_is_DenyAll: "applied_rule_rev C x s = Some DenyAll" using tl_s + by (auto simp: mr_first) + thus ?thesis using mr_p_is_DenyAll by simp + } + {case (DenyAllFromTo a b) + have mr_p_is_DAFT: "applied_rule_rev C x p = Some (DenyAllFromTo a b)" + by (simp add: DenyAllFromTo Some) + have DA_notin_tl: "DenyAll \ set (tl p)" + by (metis WP1n_DA_notinSet wp1_p) + have mr_tl_p: "applied_rule_rev C x p = applied_rule_rev C x (tl p)" + by (metis Combinators.simps(4) DenyAllFromTo Some mrConcEnd tl_p) + have dom_tl_p: "\ r. r \ set (tl p) \ x \ dom (C r) \ r = (DenyAllFromTo a b)" + using wp1_p aND SC wp3_p mr_p_is_DAFT + by (auto simp: rule_charnDAFT) + hence dom_tl_s: "\ r. r \ set (tl s) \ x \ dom (C r) \ r = (DenyAllFromTo a b)" + using tl_eq by auto + have DAFT_in_tl_s: "DenyAllFromTo a b \ set (tl s)" using mr_tl_p + by (metis DenyAllFromTo mrSet mr_p_is_DAFT tl_eq) + have x_in_dom_DAFT: "x \ dom (C (DenyAllFromTo a b))" + by (metis mr_p_is_DAFT DenyAllFromTo mr_in_dom) + hence mr_tl_s_is_DAFT: "applied_rule_rev C x (tl s) = Some (DenyAllFromTo a b)" + using DAFT_in_tl_s dom_tl_s by (metis mr_charn) + hence mr_s_is_DAFT: "applied_rule_rev C x s = Some (DenyAllFromTo a b)" + using tl_s + by (metis DA_notin_tl DenyAllFromTo EX_MR mrDA_tl + not_Some_eq tl_eq wellformed_policy1_strong.simps(2)) + thus ?thesis using mr_p_is_DAFT by simp + } + {case (AllowPortFromTo a b c) + have wp1s: "wellformed_policy1 s" by (metis wp1_eq wp1_s) + have mr_p_is_A: "applied_rule_rev C x p = Some (AllowPortFromTo a b c)" + by (simp add: AllowPortFromTo Some) + hence A_in_s: "AllowPortFromTo a b c \ set s" using sets_eq + by (auto intro: mrSet) + have x_in_dom_A: "x \ dom (C (AllowPortFromTo a b c))" + by (metis mr_p_is_A AllowPortFromTo mr_in_dom) + have SCs: "singleCombinators s" using SC sets_eq + by (auto intro: SCSubset) + hence ANDs: "allNetsDistinct s" using aND sets_eq SC + by (auto intro: aNDSetsEq) + hence mr_s_is_A: "applied_rule_rev C x s = Some (AllowPortFromTo a b c)" + using A_in_s wp1s mr_p_is_A aND SCs wp3_s x_in_dom_A + by (simp add: rule_charn2) + thus ?thesis using mr_p_is_A by simp + } + case (Conc a b) thus ?thesis by (metis Some mr_not_Conc SC) + qed +qed + +lemma C_eq_Sets: + "singleCombinators p \ wellformed_policy1_strong p \ wellformed_policy1_strong s \ + wellformed_policy3 p \ wellformed_policy3 s \ allNetsDistinct p \ set p = set s \ + C (list2FWpolicy p) x = C (list2FWpolicy s) x" + by(auto intro: C_eq_if_mr_eq C_eq_Sets_mr [symmetric]) + + +lemma C_eq_sorted: + "distinct p \ all_in_list p l \ singleCombinators p \ wellformed_policy1_strong p \ + wellformed_policy3 p \ allNetsDistinct p \ + C (list2FWpolicy (FWNormalisationCore.sort p l)) = C (list2FWpolicy p)" +apply (rule ext) +by (auto intro: C_eq_Sets simp: nMTSort wellformed1_alternative_sorted + wellformed_policy3_charn wp1_eq) + + + +lemma C_eq_sortedQ: + "distinct p \ all_in_list p l \ singleCombinators p \ wellformed_policy1_strong p \ + wellformed_policy3 p \ allNetsDistinct p \ + C (list2FWpolicy (qsort p l)) = C (list2FWpolicy p)" +apply (rule ext) +apply (auto intro!: C_eq_Sets simp: nMTSortQ wellformed1_alternative_sorted distinct_sortQ + wellformed_policy3_charn wp1_eq) +by (metis set_qsort wellformed1_sortedQ wellformed_eq wp1_aux1aa) + + + +lemma C_eq_RS2_mr: "applied_rule_rev C x (removeShadowRules2 p)= applied_rule_rev C x p" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons y ys) thus ?case + proof (cases "ys = []") + case True thus ?thesis by (cases y, simp_all) + next + case False thus ?thesis + proof (cases y) + case DenyAll thus ?thesis by (simp, metis Cons DenyAll mreq_end2) + next + case (DenyAllFromTo a b) thus ?thesis + by (simp, metis Cons DenyAllFromTo mreq_end2) + next + case (AllowPortFromTo a b p) thus ?thesis + proof (cases "DenyAllFromTo a b \ set ys") + case True thus ?thesis using AllowPortFromTo Cons + apply (cases "applied_rule_rev C x ys = None", simp_all) + apply (subgoal_tac "x \ dom (C (AllowPortFromTo a b p))") + apply (subst mrconcNone, simp_all) + apply (simp add: applied_rule_rev_def ) + apply (rule contra_subsetD [OF allow_deny_dom]) + apply (erule mrNoneMT,simp) + apply (metis AllowPortFromTo mrconc) + done + next + case False thus ?thesis using False Cons AllowPortFromTo + by (simp, metis AllowPortFromTo Cons mreq_end2) qed + next + case (Conc a b) thus ?thesis + by (metis Cons mreq_end2 removeShadowRules2.simps(4)) + qed + qed +qed + + + +lemma C_eq_None[rule_format]: + "p \ [] --> applied_rule_rev C x p = None \ C (list2FWpolicy p) x = None" +apply (simp add: applied_rule_rev_def) +apply (rule rev_induct, simp_all) +apply (intro impI, simp) + apply (case_tac "xs \ []") +apply (simp_all add: dom_def) +done + +lemma C_eq_None2: + "a \ [] \ b \ [] \ applied_rule_rev C x a = \ \ applied_rule_rev C x b = \ \ + C (list2FWpolicy a) x = C (list2FWpolicy b) x" +by (auto simp: C_eq_None) + +lemma C_eq_RS2: + "wellformed_policy1_strong p \ C (list2FWpolicy (removeShadowRules2 p))= C (list2FWpolicy p)" +apply (rule ext) +by (metis C_eq_RS2_mr C_eq_if_mr_eq wellformed_policy1_strong.simps(1) wp1n_RS2) + + +lemma none_MT_rulesRS2: + "none_MT_rules C p \ none_MT_rules C (removeShadowRules2 p)" +by (auto simp: RS2Set none_MT_rulessubset) + +lemma CconcNone: + "dom (C a) = {} \ p \ [] \ C (list2FWpolicy (a # p)) x = C (list2FWpolicy p) x" +apply (case_tac "p = []", simp_all) + apply (case_tac "x\ dom (C (list2FWpolicy(p)))") +apply (metis Cdom2 list2FWpolicyconc) +apply (metis C.simps(4) map_add_dom_app_simps(2) inSet_not_MT list2FWpolicyconc set_empty2) +done + + +lemma none_MT_rulesrd[rule_format]: + "none_MT_rules C p \ none_MT_rules C (remdups p)" +by (induct p, simp_all) + +lemma DARS3[rule_format]: + "DenyAll \ set p\DenyAll \ set (rm_MT_rules C p)" +by (induct p, simp_all) + +lemma DAnMT: "dom (C DenyAll) \ {}" +by (simp add: dom_def C.simps PolicyCombinators.PolicyCombinators) + +lemma DAnMT2: "C DenyAll \ empty" +by (metis DAAux dom_eq_empty_conv empty_iff) + + + + +lemma wp1n_RS3[rule_format,simp]: + "wellformed_policy1_strong p \ wellformed_policy1_strong (rm_MT_rules C p)" +by (induct p, simp_all add: DARS3 DAnMT) + +lemma AILRS3[rule_format,simp]: + "all_in_list p l \ all_in_list (rm_MT_rules C p) l" +by (induct p, simp_all) + +lemma SCRS3[rule_format,simp]: + "singleCombinators p \ singleCombinators(rm_MT_rules C p)" +by (induct p, simp_all, case_tac "a", simp_all) + +lemma RS3subset: "set (rm_MT_rules C p) \ set p " +by (induct p, auto) + + +lemma ANDRS3[simp]: + "singleCombinators p \ allNetsDistinct p \ allNetsDistinct (rm_MT_rules C p)" +using RS3subset SCRS3 aNDSubset by blast + +lemma nlpaux: "x \ dom (C b) \ C (a \ b) x = C a x" +by (metis C.simps(4) map_add_dom_app_simps(3)) + +lemma notindom[rule_format]: + "a \ set p \ x \ dom (C (list2FWpolicy p)) \ x \ dom (C a)" +apply (induct p, simp_all) +by (metis CConcStartA Cdom2 domIff empty_iff empty_set l2p_aux) + +lemma C_eq_rd[rule_format]: + "p \ [] \ C (list2FWpolicy (remdups p)) = C (list2FWpolicy p)" +proof (rule ext,induct p) + case Nil thus ?case by simp +next + case (Cons y ys) thus ?case + proof (cases "ys = []") + case True thus ?thesis by simp + next + case False thus ?thesis using Cons + apply (simp) apply (rule conjI, rule impI) + apply (cases "x \ dom (C (list2FWpolicy ys))") + apply (metis Cdom2 False list2FWpolicyconc) + apply (metis False domIff list2FWpolicyconc nlpaux notindom) + apply (rule impI) + apply (cases "x \ dom (C (list2FWpolicy ys))") + apply (subgoal_tac "x \ dom (C (list2FWpolicy (remdups ys)))") + apply (metis Cdom2 False list2FWpolicyconc remdups_eq_nil_iff) + apply (metis domIff) + apply (subgoal_tac "x \ dom (C (list2FWpolicy (remdups ys)))") + apply (metis False list2FWpolicyconc nlpaux remdups_eq_nil_iff) + apply (metis domIff) + done + qed +qed + + + +lemma nMT_domMT: + "\ not_MT C p \ p \ [] \ r \ dom (C (list2FWpolicy p))" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons x xs) thus ?case + apply (simp split: if_splits) + apply (cases "xs = []",simp_all ) + by (metis CconcNone domIff) +qed + +lemma C_eq_RS3_aux[rule_format]: + "not_MT C p \ C (list2FWpolicy p) x = C (list2FWpolicy (rm_MT_rules C p)) x" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons y ys) + thus ?case + proof (cases "not_MT C ys") + case True thus ?thesis using Cons + apply (simp) apply(rule conjI, rule impI, simp) + apply (metis CconcNone True not_MTimpnotMT) + apply (rule impI, simp) + apply (cases "x \ dom (C (list2FWpolicy ys))") + apply (subgoal_tac "x \ dom (C (list2FWpolicy (rm_MT_rules C ys)))") + apply (metis Cdom2 NMPrm l2p_aux not_MTimpnotMT) + apply (simp add: domIff) + apply (subgoal_tac "x \ dom (C (list2FWpolicy (rm_MT_rules C ys)))") + apply (metis l2p_aux l2p_aux2 nlpaux) + apply (metis domIff) + done + next + case False thus ?thesis using Cons False + proof (cases "ys = []") + case True thus ?thesis using Cons by (simp) (rule impI, simp) + next + case False thus ?thesis + using Cons False `\ not_MT C ys` apply (simp) + by (metis SR3nMT l2p_aux list2FWpolicy.simps(2) nMT_domMT nlpaux) + qed + qed +qed + + + +lemma C_eq_id: + "wellformed_policy1_strong p \ C(list2FWpolicy (insertDeny p)) = C (list2FWpolicy p)" +by (rule ext) (auto intro: C_eq_if_mr_eq elim: mr_iD) + +lemma C_eq_RS3: + "not_MT C p \ C(list2FWpolicy (rm_MT_rules C p)) = C (list2FWpolicy p)" +by (rule ext) (erule C_eq_RS3_aux[symmetric]) + + +lemma NMPrd[rule_format]: "not_MT C p \ not_MT C (remdups p)" +by (induct p) (auto simp: NMPcharn) + + +lemma NMPDA[rule_format]: "DenyAll \ set p \ not_MT C p" +by (induct p, simp_all add: DAnMT) + + +lemma NMPiD[rule_format]: "not_MT C (insertDeny p)" +by (simp add: DAiniD NMPDA) + + +lemma list2FWpolicy2list[rule_format]: "C (list2FWpolicy(policy2list p)) = (C p)" +apply (rule ext) +apply (induct_tac p, simp_all) +by (metis (no_types, lifting) Cdom2 CeqEnd CeqStart domIff nlpaux p2lNmt) + + +lemmas C_eq_Lemmas = none_MT_rulesRS2 none_MT_rulesrd SCp2l wp1n_RS2 wp1ID NMPiD wp1_eq + wp1alternative_RS1 p2lNmt list2FWpolicy2list wellformed_policy3_charn waux2 + +lemmas C_eq_subst_Lemmas = C_eq_sorted C_eq_sortedQ C_eq_RS2 C_eq_rd C_eq_RS3 C_eq_id + +lemma C_eq_All_untilSorted: + "DenyAll\set(policy2list p) \ all_in_list(policy2list p) l \ allNetsDistinct(policy2list p) \ + C (list2FWpolicy + (FWNormalisationCore.sort + (removeShadowRules2 (remdups (rm_MT_rules C + (insertDeny (removeShadowRules1 (policy2list p)))))) l)) = + C p" +apply (subst C_eq_sorted,simp_all add: C_eq_Lemmas) +apply (subst C_eq_RS2,simp_all add: C_eq_Lemmas) +apply (subst C_eq_rd,simp_all add: C_eq_Lemmas) +apply (subst C_eq_RS3,simp_all add: C_eq_Lemmas) +apply (subst C_eq_id,simp_all add: C_eq_Lemmas) +done + + +lemma C_eq_All_untilSortedQ: + "DenyAll\set(policy2list p) \ all_in_list(policy2list p) l \ allNetsDistinct(policy2list p) \ + C (list2FWpolicy + (qsort (removeShadowRules2 (remdups (rm_MT_rules C + (insertDeny (removeShadowRules1 (policy2list p)))))) l)) = + C p" +apply (subst C_eq_sortedQ,simp_all add: C_eq_Lemmas) +apply (subst C_eq_RS2,simp_all add: C_eq_Lemmas) +apply (subst C_eq_rd,simp_all add: C_eq_Lemmas) +apply (subst C_eq_RS3,simp_all add: C_eq_Lemmas) +apply (subst C_eq_id,simp_all add: C_eq_Lemmas) +done + + +(* or, even shorter *) + +lemma C_eq_All_untilSorted_withSimps: + "DenyAll\set(policy2list p) \all_in_list(policy2list p) l \ allNetsDistinct (policy2list p) \ + C (list2FWpolicy + (FWNormalisationCore.sort + (removeShadowRules2 (remdups (rm_MT_rules C + (insertDeny (removeShadowRules1 (policy2list p)))))) l)) = + C p" +by (simp_all add: C_eq_Lemmas C_eq_subst_Lemmas) + + +lemma C_eq_All_untilSorted_withSimpsQ: + " DenyAll\set(policy2list p)\all_in_list(policy2list p) l \ allNetsDistinct(policy2list p) \ + C (list2FWpolicy + (qsort (removeShadowRules2 (remdups (rm_MT_rules C + (insertDeny (removeShadowRules1 (policy2list p)))))) l)) = + C p" +by (simp_all add: C_eq_Lemmas C_eq_subst_Lemmas) + + +lemma InDomConc[rule_format]: + "p \ [] \ x \ dom (C (list2FWpolicy (p))) \ x \ dom (C (list2FWpolicy (a#p)))" +by (induct p, simp_all) (case_tac "p = []", simp_all add: dom_def C.simps) + + +lemma not_in_member[rule_format]: "member a b \ x \ dom (C b) \ x \ dom (C a)" +by (induct b) (simp_all add: dom_def C.simps) + + +lemma src_in_sdnets[rule_format]: + "\ member DenyAll x \ p \ dom (C x) \ subnetsOfAdr (src p) \ (fst_set (sdnets x)) \ {}" +apply (induct rule: Combinators.induct) +apply (simp_all add: fst_set_def subnetsOfAdr_def PLemmas fst_set_def) +apply (intro impI) +apply (case_tac "p \ dom (C x2)") +apply (rule subnetAux) +apply (auto simp: PLemmas fst_set_def) +done + +lemma dest_in_sdnets[rule_format]: + "\ member DenyAll x \ p \ dom (C x) \ subnetsOfAdr (dest p) \ (snd_set (sdnets x)) \ {}" +apply (induct rule: Combinators.induct) +apply (simp_all add: snd_set_def subnetsOfAdr_def PLemmas) +apply (intro impI) +apply (simp add: snd_set_def) +apply (case_tac "p \ dom (C x2)") +apply (rule subnetAux) +apply (auto simp: PLemmas) +done + + + +lemma sdnets_in_subnets[rule_format]: + "p\ dom (C x) \ \ member DenyAll x \ + (\ (a,b)\sdnets x. a \ subnetsOfAdr (src p) \ b \ subnetsOfAdr (dest p))" +apply (rule Combinators.induct) +apply (simp_all add: PLemmas subnetsOfAdr_def) +apply (intro impI, simp) +apply (case_tac "p \ dom (C (x2))") +apply (auto simp: PLemmas subnetsOfAdr_def) +done + +lemma disjSD_no_p_in_both[rule_format]: + "disjSD_2 x y \ \ member DenyAll x \ \ member DenyAll y \ p \ dom(C x) \ p \ dom(C y) \ + False" +apply (rule_tac A = "sdnets x" and B = "sdnets y" and D = "src p" and F = "dest p" in tndFalse) +by (auto simp: dest_in_sdnets src_in_sdnets sdnets_in_subnets disjSD_2_def) + +lemma list2FWpolicy_eq: + "zs \ [] \ C (list2FWpolicy (x \ y # z)) p = C (x \ list2FWpolicy (y # z)) p" +by (metis ConcAssoc l2p_aux list2FWpolicy.simps(2)) + + +lemma dom_sep[rule_format]: + "x \ dom (C (list2FWpolicy p)) \ x \ dom (C (list2FWpolicy(separate p)))" +proof (induct p rule: separate.induct, simp_all, goal_cases) + case (1 v va y z) then show ?case + apply (intro conjI impI) + apply (simp,drule mp) + apply (case_tac "x \ dom (C (DenyAllFromTo v va))") + apply (metis CConcStartA domIff l2p_aux2 list2FWpolicyconc not_Cons_self ) + apply (metis Conc_not_MT domIff list2FWpolicy_eq, simp) + by (metis InDomConc domIff list.simps(3) list2FWpolicyconc nlpaux sepnMT) +next + case (2 v va vb y z) + assume * : "{v, va} = first_bothNet y \ + x \ dom (C (list2FWpolicy (AllowPortFromTo v va vb \ y # z))) \ + x \ dom (C (list2FWpolicy (separate (AllowPortFromTo v va vb \ y # z))))" + and **: "{v, va} \ first_bothNet y \ + x \ dom(C(list2FWpolicy(y#z))) \ x \ dom (C(list2FWpolicy(separate(y#z))))" + show ?case + apply (insert * **, rule impI | rule conjI)+ + apply (simp,case_tac "x \ dom (C (AllowPortFromTo v va vb))") + apply (metis CConcStartA domIff l2p_aux2 list2FWpolicyconc not_Cons_self ) + apply (subgoal_tac "x \ dom (C (list2FWpolicy (y #z)))") + apply (metis CConcStartA Cdom2 domIff l2p_aux2 list2FWpolicyconc nlpaux) + apply (simp add: dom_def C.simps) + apply (intro impI, simp_all) + apply (case_tac "x \ dom (C (AllowPortFromTo v va vb))",simp_all) + by (metis Cdom2 domIff l2p_aux list2FWpolicy.simps(3) nlpaux sepnMT) +next + case (3 v va y z) + assume * : "(first_bothNet v = first_bothNet y \ + x \ dom (C (list2FWpolicy ((v \ va) \ y # z))) \ + x \ dom (C (list2FWpolicy (separate ((v \ va) \ y # z)))))" + and ** : "(first_bothNet v \ first_bothNet y \ + x \ dom(C(list2FWpolicy(y#z))) \ x \ dom (C (list2FWpolicy (separate (y # z)))))" + show ?case + apply (insert * **, rule conjI | rule impI)+ + apply (simp,drule mp) + apply (case_tac "x \ dom (C ((v \ va)))") + apply (metis C.simps(4) CConcStartA ConcAssoc domIff list2FWpolicy2list list2FWpolicyconc p2lNmt) + apply simp_all + apply (metis Conc_not_MT domIff list2FWpolicy_eq) + by (metis CConcStartA Conc_not_MT InDomConc domIff nlpaux sepnMT) +qed + +lemma domdConcStart[rule_format]: + "x \ dom (C (list2FWpolicy (a#b))) \ x \ dom (C (list2FWpolicy b)) \ x \ dom (C (a))" +by (induct b, simp_all) (auto simp: PLemmas) + +lemma sep_dom2_aux: + " x \ dom (C (list2FWpolicy (a \ y # z))) \ x \ dom (C (a \ list2FWpolicy (y # z)))" +by (auto) (metis list2FWpolicy_eq p2lNmt) + + +lemma sep_dom2_aux2: +"x \ dom (C (list2FWpolicy (separate (y # z)))) \ x \ dom (C (list2FWpolicy (y # z))) \ + x \ dom (C (list2FWpolicy (a # separate (y # z)))) \ x \ dom (C (list2FWpolicy (a \ y # z)))" +by (metis CConcStartA InDomConc domdConcStart list.simps(2) list2FWpolicy.simps(2) list2FWpolicyconc) + + +lemma sep_dom2[rule_format]: + "x \ dom (C (list2FWpolicy (separate p))) \ x \ dom (C (list2FWpolicy( p)))" +by (rule separate.induct) (simp_all add: sep_dom2_aux sep_dom2_aux2) + +lemma sepDom: "dom (C (list2FWpolicy p)) = dom (C (list2FWpolicy (separate p)))" +apply (rule equalityI) +by (rule subsetI, (erule dom_sep|erule sep_dom2))+ + +lemma C_eq_s_ext[rule_format]: + "p \ [] \ C (list2FWpolicy (separate p)) a = C (list2FWpolicy p) a " +proof (induct rule: separate.induct, goal_cases) print_cases + case (1 x) thus ?case + apply simp + apply (cases "x = []") + apply (metis l2p_aux2 separate.simps(5)) + apply simp + apply (cases "a \ dom (C (list2FWpolicy x))") + apply (subgoal_tac "a \ dom (C (list2FWpolicy (separate x)))") + apply (metis Cdom2 list2FWpolicyconc sepDom sepnMT) + apply (metis sepDom) + apply (subgoal_tac "a \ dom (C (list2FWpolicy (separate x)))") + apply (subst list2FWpolicyconc,simp add: sepnMT) + apply (subst list2FWpolicyconc,simp add: sepnMT) + apply (metis nlpaux sepDom) + apply (metis sepDom) + done +next + case (2 v va y z) thus ?case + apply (cases "z = []", simp_all) + apply (rule conjI|rule impI|simp)+ + apply (subst list2FWpolicyconc) + apply (metis not_Cons_self sepnMT) + apply (metis C.simps(4) CConcStartaux Cdom2 domIff) + apply (rule conjI|rule impI|simp)+ + apply (erule list2FWpolicy_eq) + apply (rule impI, simp) + apply (subst list2FWpolicyconc) + apply (metis list.simps(2) sepnMT) + by (metis C.simps(4) CConcStartaux Cdom2 domIff) +next + case (3 v va vb y z) thus ?case + apply (cases "z = []", simp_all) + apply (rule conjI|rule impI|simp)+ + apply (subst list2FWpolicyconc) + apply (metis not_Cons_self sepnMT) + apply (metis C.simps(4) CConcStartaux Cdom2 domIff) + apply (rule conjI|rule impI|simp)+ + apply (erule list2FWpolicy_eq) + apply (rule impI, simp) + apply (subst list2FWpolicyconc) + apply (metis list.simps(2) sepnMT) + by (metis C.simps(4) CConcStartaux Cdom2 domIff) +next + case (4 v va y z) thus ?case + apply (cases "z = []", simp_all) + apply (rule conjI|rule impI|simp)+ + apply (subst list2FWpolicyconc) + apply (metis not_Cons_self sepnMT) + apply (metis C.simps(4) CConcStartaux Cdom2 domIff) + apply (rule conjI|rule impI|simp)+ + apply (erule list2FWpolicy_eq) + apply (rule impI, simp) + apply (subst list2FWpolicyconc) + apply (metis list.simps(2) sepnMT) + by (metis C.simps(4) CConcStartaux Cdom2 domIff) +next + case 5 thus ?case by simp +next + case 6 thus ?case by simp +next + case 7 thus ?case by simp +next + case 8 thus ?case by simp +qed + + +lemma C_eq_s: +"p \ [] \ C (list2FWpolicy (separate p)) = C (list2FWpolicy p)" +apply (rule ext) using C_eq_s_ext by blast + + +(*MOVE FORWARD*) +lemma sortnMTQ: "p \ [] \ qsort p l \ []" +by (metis set_sortQ setnMT) + + +lemmas C_eq_Lemmas_sep = + C_eq_Lemmas sortnMT sortnMTQ RS2_NMT NMPrd not_MTimpnotMT + + +lemma C_eq_until_separated: +" DenyAll\set(policy2list p) \ all_in_list(policy2list p)l \ allNetsDistinct (policy2list p) \ + C (list2FWpolicy + (separate + (FWNormalisationCore.sort + (removeShadowRules2 (remdups (rm_MT_rules C + (insertDeny (removeShadowRules1 (policy2list p)))))) l))) = + C p" +by (simp add: C_eq_All_untilSorted_withSimps C_eq_s wellformed1_alternative_sorted wp1ID wp1n_RS2) + + +lemma C_eq_until_separatedQ: +"DenyAll\set(policy2list p) \ all_in_list(policy2list p)l \ allNetsDistinct(policy2list p) \ + C (list2FWpolicy + (separate (qsort (removeShadowRules2 (remdups (rm_MT_rules C + (insertDeny (removeShadowRules1 (policy2list p)))))) l))) = + C p" + +by (simp add: C_eq_All_untilSorted_withSimpsQ C_eq_s sortnMTQ wp1ID wp1n_RS2) + + + + +lemma domID[rule_format]: "p \ [] \ x \ dom(C(list2FWpolicy p)) \ + x \ dom (C(list2FWpolicy(insertDenies p)))" +proof(induct p) + case Nil then show ?case by simp +next + case (Cons a p) then show ?case + proof(cases "p=[]",goal_cases) + case 1 then show ?case + apply(simp) apply(rule impI) + apply (cases a, simp_all) + apply (simp_all add: C.simps dom_def)+ + by auto + next + case 2 then show ?case + proof(cases "x \ dom(C(list2FWpolicy p))", goal_cases) + case 1 then show ?case + apply simp apply (rule impI) + apply (cases a, simp_all) + using InDomConc idNMT apply blast + apply (rule InDomConc, simp_all add: idNMT)+ + done + next + case 2 then show ?case + apply simp apply (rule impI) + proof(cases "x \ dom (C (list2FWpolicy (insertDenies p)))", goal_cases) + case 1 then show ?case + proof(induct a) + case DenyAll then show ?case by simp + next + case (DenyAllFromTo src dest) then show ?case + apply simp by( rule InDomConc, simp add: idNMT) + next + case (AllowPortFromTo src dest port) then show ?case + apply simp by(rule InDomConc, simp add: idNMT) + next + case (Conc _ _) then show ?case + apply simp by(rule InDomConc, simp add: idNMT) + qed + next + case 2 then show ?case + proof (induct a) + case DenyAll then show ?case by simp + next + case (DenyAllFromTo src dest) then show ?case + by(simp,metis domIff CConcStartA list2FWpolicyconc nlpaux Cdom2) + next + case (AllowPortFromTo src dest port) then show ?case + by(simp,metis domIff CConcStartA list2FWpolicyconc nlpaux Cdom2) + next + case (Conc _ _) then show ?case + by (simp,metis CConcStartA Cdom2 domIff domdConcStart) + qed + qed + qed + qed + qed + + +lemma DA_is_deny: + "x \ dom (C (DenyAllFromTo a b \ DenyAllFromTo b a \ DenyAllFromTo a b)) \ + C (DenyAllFromTo a b\DenyAllFromTo b a \ DenyAllFromTo a b) x = Some (deny ())" +apply (case_tac "x \ dom (C (DenyAllFromTo a b))") +apply (simp_all add: PLemmas) +apply (simp_all split: if_splits) +done + +lemma iDdomAux[rule_format]: + "p \ [] \ x \ dom (C (list2FWpolicy p)) \ + x \ dom (C (list2FWpolicy (insertDenies p))) \ + C (list2FWpolicy (insertDenies p)) x = Some (deny ())" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons y ys) thus ?case + proof (cases y) + case DenyAll then show ?thesis by simp + next + case (DenyAllFromTo a b) then show ?thesis using DenyAllFromTo Cons + apply simp + apply (intro impI) + proof (cases "ys = []", goal_cases) + case 1 then show ?case by (simp add: DA_is_deny) + next + case 2 then show ?case + apply simp + apply (drule mp) + apply (metis DenyAllFromTo InDomConc ) + apply (cases "x \ dom (C (list2FWpolicy (insertDenies ys)))", simp_all) + apply (metis Cdom2 DenyAllFromTo idNMT list2FWpolicyconc) + apply (subgoal_tac "C (list2FWpolicy (DenyAllFromTo a b \ + DenyAllFromTo b a \ DenyAllFromTo a b#insertDenies ys)) x = + C ((DenyAllFromTo a b \ DenyAllFromTo b a \ DenyAllFromTo a b)) x ") + apply simp + apply (rule DA_is_deny) + apply (metis DenyAllFromTo domdConcStart) + apply (metis DenyAllFromTo l2p_aux2 list2FWpolicyconc nlpaux) + done + qed + next + case (AllowPortFromTo a b c) then show ?thesis using Cons AllowPortFromTo + proof (cases "ys = []", goal_cases) + case 1 then show ?case + apply simp + apply (intro impI) + apply (subgoal_tac "x \ dom (C (DenyAllFromTo a b \ DenyAllFromTo b a))") + apply (simp_all add: PLemmas) + apply (simp split: if_splits, auto) + done + next + case 2 then show ?case + apply simp + apply (intro impI) + apply (drule mp) + apply (metis AllowPortFromTo InDomConc) + apply (cases "x \ dom (C (list2FWpolicy (insertDenies ys)))") + apply simp_all + apply (metis AllowPortFromTo Cdom2 idNMT list2FWpolicyconc) + apply (subgoal_tac "C (list2FWpolicy (DenyAllFromTo a b \ + DenyAllFromTo b a \ AllowPortFromTo a b c#insertDenies ys)) x = + C ((DenyAllFromTo a b \ DenyAllFromTo b a)) x ") + apply simp + defer 1 + apply (metis AllowPortFromTo CConcStartA ConcAssoc idNMT list2FWpolicyconc nlpaux) + apply (simp add: PLemmas, simp split: if_splits, auto) + done + qed + next + case (Conc a b) then show ?thesis + proof (cases "ys = []", goal_cases) + case 1 then show ?case + apply simp + apply (rule impI)+ + apply (subgoal_tac "x \ dom (C (DenyAllFromTo (first_srcNet a) + (first_destNet a) \ DenyAllFromTo (first_destNet a) (first_srcNet a)))") + apply (simp_all add: PLemmas) + apply (simp split: if_splits, auto) + done + next + case 2 then show ?case + apply simp + apply (intro impI) + apply (cases "x \ dom (C (list2FWpolicy (insertDenies ys)))") + apply (metis Cdom2 Conc Cons InDomConc idNMT list2FWpolicyconc) + apply (subgoal_tac "C (list2FWpolicy (DenyAllFromTo (first_srcNet a) + (first_destNet a) \ DenyAllFromTo(first_destNet a)(first_srcNet a) + \ a \ b#insertDenies ys)) x = + C ((DenyAllFromTo (first_srcNet a) (first_destNet a) \ + DenyAllFromTo (first_destNet a) (first_srcNet a) \ a \ b)) x") + apply simp + defer 1 + apply (metis Conc l2p_aux2 list2FWpolicyconc nlpaux) + apply (subgoal_tac "C((DenyAllFromTo (first_srcNet a) + (first_destNet a) \ DenyAllFromTo (first_destNet a) + (first_srcNet a) \ a \ b)) x = + C((DenyAllFromTo (first_srcNet a)(first_destNet a) \ + DenyAllFromTo(first_destNet a)(first_srcNet a))) x ") + apply simp + defer 1 + apply (metis CConcStartA Conc ConcAssoc nlpaux) + apply (simp add: PLemmas, simp split: if_splits, auto) + done + qed + qed +qed + + +lemma iD_isD[rule_format]: + "p \ [] \ x \ dom (C (list2FWpolicy p)) \ + C (DenyAll \ list2FWpolicy (insertDenies p)) x = C DenyAll x" +apply (case_tac "x \ dom (C (list2FWpolicy (insertDenies p)))") +apply (simp add: Cdom2 PLemmas(1) deny_all_def iDdomAux) +by (simp add: nlpaux) + + +lemma inDomConc:"\ x\dom (C a); x\dom (C (list2FWpolicy p))\ \ + x \ dom (C (list2FWpolicy(a#p)))" +by (metis domdConcStart) + +lemma domsdisj[rule_format]: + "p \ [] \ (\ x s. s \ set p \ x \ dom (C A) \ x \ dom (C s)) \ y \ dom (C A) \ + y \ dom (C (list2FWpolicy p))" +proof (induct p) + case Nil show ?case by simp +next + case (Cons a p) then show ?case + apply (case_tac "p = []") + apply fastforce + by (meson domdConcStart list.set_intros(1) list.set_intros(2)) +qed + +lemma isSepaux: + " p \ [] \ noDenyAll (a # p) \ separated (a # p) \ + x \ dom (C (DenyAllFromTo (first_srcNet a) (first_destNet a) \ + DenyAllFromTo (first_destNet a) (first_srcNet a) \ a)) \ + x \ dom (C (list2FWpolicy p))" +apply (rule_tac A = "(DenyAllFromTo (first_srcNet a) (first_destNet a) \ + DenyAllFromTo (first_destNet a) (first_srcNet a) \ a)" in domsdisj) +apply simp_all +by (metis Combinators.distinct(1) FWNormalisationCore.member.simps(1) + FWNormalisationCore.member.simps(3) disjSD2aux disjSD_no_p_in_both noDA) + + +lemma none_MT_rulessep[rule_format]: "none_MT_rules C p \ none_MT_rules C (separate p)" +apply(induct p rule: separate.induct) +by (simp_all add: C.simps map_add_le_mapE map_le_antisym) + +lemma dom_id: + "noDenyAll(a#p) \ separated(a#p) \ p \ [] \ x\dom(C(list2FWpolicy p)) \ x\dom (C a) \ + x \ dom (C (list2FWpolicy (insertDenies p)))" +apply (rule_tac a = a in isSepaux, simp_all) +using idNMT apply blast +using noDAID apply blast +using id_aux4 noDA1eq sepNetsID apply blast +by (metis list.set_intros(1) list.set_intros(2) list2FWpolicy.simps(2) list2FWpolicy.simps(3) notindom) + + +lemma C_eq_iD_aux2[rule_format]: + "noDenyAll1 p \ separated p\ p \ []\ x \ dom (C (list2FWpolicy p))\ + C(list2FWpolicy (insertDenies p)) x = C(list2FWpolicy p) x" +proof (induct p) + case Nil thus ?case by simp +next + case (Cons y ys) thus ?case using Cons + proof (cases y) + case DenyAll thus ?thesis using Cons DenyAll apply simp + apply (case_tac "ys = []", simp_all) + apply (case_tac "x \ dom (C (list2FWpolicy ys))",simp_all) + apply (metis Cdom2 domID idNMT list2FWpolicyconc noDA1eq) + apply (metis DenyAll iD_isD idNMT list2FWpolicyconc nlpaux) + done + next + case (DenyAllFromTo a b) thus ?thesis using Cons apply simp + apply (rule impI|rule allI|rule conjI|simp)+ + apply (case_tac "ys = []", simp_all) + apply (metis Cdom2 ConcAssoc DenyAllFromTo) + apply (case_tac "x \ dom (C (list2FWpolicy ys))", simp_all) + apply (simp add: Cdom2 domID idNMT l2p_aux noDA1eq) + apply (case_tac "x \ dom (C (list2FWpolicy (insertDenies ys)))") + apply (meson Combinators.distinct(1) FWNormalisationCore.member.simps(3) dom_id domdConcStart + noDenyAll.simps(1) separated.simps(1)) + by (metis Cdom2 DenyAllFromTo domIff dom_def domdConcStart l2p_aux l2p_aux2 nlpaux) + next + case (AllowPortFromTo a b c) thus ?thesis + using AllowPortFromTo Cons apply simp + apply (rule impI|rule allI|rule conjI|simp)+ + apply (case_tac "ys = []", simp_all) + apply (metis Cdom2 ConcAssoc AllowPortFromTo) + apply (case_tac "x \ dom (C (list2FWpolicy ys))", simp_all) + apply (simp add: Cdom2 domID idNMT list2FWpolicyconc noDA1eq) + apply (case_tac "x \ dom (C (list2FWpolicy (insertDenies ys)))") + apply (meson Combinators.distinct(3) FWNormalisationCore.member.simps(4) dom_id domdConcStart noDenyAll.simps(1) separated.simps(1)) + by (metis Cdom2 ConcAssoc l2p_aux list2FWpolicy.simps(2) nlpaux) + next + case (Conc a b) thus ?thesis using Cons Conc + apply simp + apply (rule impI|rule allI|rule conjI|simp)+ + apply (case_tac "ys = []", simp_all) + apply (metis Cdom2 ConcAssoc Conc) + apply (case_tac "x \ dom (C (list2FWpolicy ys))",simp_all) + apply (simp add: Cdom2 domID idNMT list2FWpolicyconc noDA1eq) + apply (case_tac "x \ dom (C (a \ b))") + apply (case_tac "x \ dom (C (list2FWpolicy (insertDenies ys)))",simp_all) + apply (simp add: Cdom2 domIff idNMT list2FWpolicyconc nlpaux) + apply (metis FWNormalisationCore.member.simps(1) dom_id noDenyAll.simps(1) separated.simps(1)) + by (simp add: inDomConc) + qed +qed + +lemma C_eq_iD: + "separated p \ noDenyAll1 p \ wellformed_policy1_strong p \ + C (list2FWpolicy (insertDenies p)) = C (list2FWpolicy p)" +by (rule ext) (metis CConcStartA C_eq_iD_aux2 DAAux wp1_alternative_not_mt wp1n_tl) + +(*MOVE FORWARD*) + +lemma noDAsortQ[rule_format]: "noDenyAll1 p \ noDenyAll1 (qsort p l)" +apply (case_tac "p",simp_all, rename_tac a list) + apply (case_tac "a = DenyAll",simp_all) + using nDAeqSet set_sortQ apply blast +apply (rule impI,rule noDA1eq) + apply (subgoal_tac "noDenyAll (a#list)") +apply (metis append_Cons append_Nil nDAeqSet qsort.simps(2) set_sortQ) +by (case_tac a, simp_all) + + +(*MOVE FORWARD*) + +lemma NetsCollectedSortQ: + "distinct p \noDenyAll1 p \ all_in_list p l \ singleCombinators p \ + NetsCollected (qsort p l)" +by (metis NetsCollectedSorted SC3Q all_in_list.elims(2) all_in_list.simps(1) all_in_list.simps(2) + all_in_listAppend all_in_list_sublist noDAsortQ qsort.simps(1) qsort.simps(2) + singleCombinatorsConc sort_is_sortedQ) + + +lemmas CLemmas = nMTSort nMTSortQ none_MT_rulesRS2 none_MT_rulesrd + noDAsort noDAsortQ nDASC wp1_eq wp1ID + SCp2l ANDSep wp1n_RS2 + OTNSEp OTNSC noDA1sep wp1_alternativesep wellformed_eq + wellformed1_alternative_sorted + + +lemmas C_eqLemmas_id = CLemmas NC2Sep NetsCollectedSep + NetsCollectedSort NetsCollectedSortQ separatedNC + + + +lemma C_eq_Until_InsertDenies: + "DenyAll\set(policy2list p) \ all_in_list(policy2list p)l \ allNetsDistinct(policy2list p) \ + C (list2FWpolicy + (insertDenies + (separate + (FWNormalisationCore.sort + (removeShadowRules2 (remdups (rm_MT_rules C + (insertDeny (removeShadowRules1 (policy2list p)))))) l)))) = + C p" +apply (subst C_eq_iD,simp_all add: C_eqLemmas_id) +apply (rule C_eq_until_separated, simp_all) +done + +lemma C_eq_Until_InsertDeniesQ: + "DenyAll\set(policy2list p) \ all_in_list(policy2list p)l \ allNetsDistinct(policy2list p) \ + C(list2FWpolicy + (insertDenies + (separate (qsort (removeShadowRules2 (remdups (rm_MT_rules C + (insertDeny (removeShadowRules1 (policy2list p)))))) l)))) = + C p" +apply (subst C_eq_iD,simp_all add: C_eqLemmas_id) + apply (metis WP1rd set_qsort wellformed1_sortedQ wellformed_eq wp1ID wp1_alternativesep wp1_aux1aa wp1n_RS2 wp1n_RS3) +by (rule C_eq_until_separatedQ, simp_all) + + +lemma C_eq_RD_aux[rule_format]: "C (p) x = C (removeDuplicates p) x" +apply (induct p,simp_all) +by (metis Cdom2 domIff nlpaux not_in_member) + + +lemma C_eq_RAD_aux[rule_format]: + "p \ [] \ C (list2FWpolicy p) x = C (list2FWpolicy (removeAllDuplicates p)) x" +proof (induct p) + case Nil show ?case by simp +next + case (Cons a p) show ?case + apply (case_tac "p = []", simp_all) + apply (metis C_eq_RD_aux) + apply (subst list2FWpolicyconc,simp) + apply (case_tac "x \ dom (C (list2FWpolicy p))") + apply (simp add: Cdom2 Cons.hyps domIff l2p_aux rADnMT) + by (metis C_eq_RD_aux Cons.hyps domIff list2FWpolicyconc nlpaux rADnMT) +qed + + +lemma C_eq_RAD: + "p \ [] \ C (list2FWpolicy p) = C (list2FWpolicy (removeAllDuplicates p)) " +by (rule ext,erule C_eq_RAD_aux) + + +lemma C_eq_compile: + "DenyAll\set(policy2list p) \ all_in_list(policy2list p)l \ allNetsDistinct(policy2list p) \ + C (list2FWpolicy + (removeAllDuplicates + (insertDenies + (separate + (FWNormalisationCore.sort + (removeShadowRules2 (remdups (rm_MT_rules C + (insertDeny (removeShadowRules1 (policy2list p)))))) l))))) = + C p" +apply (subst C_eq_RAD[symmetric]) +apply (rule idNMT,simp add: C_eqLemmas_id) +by (rule C_eq_Until_InsertDenies, simp_all) + + +lemma C_eq_compileQ: + "DenyAll\set(policy2list p) \ all_in_list(policy2list p)l \ allNetsDistinct(policy2list p) \ + C (list2FWpolicy + (removeAllDuplicates + (insertDenies + (separate + (qsort (removeShadowRules2 (remdups (rm_MT_rules C + (insertDeny (removeShadowRules1 (policy2list p)))))) l))))) = + C p" +apply (subst C_eq_RAD[symmetric],rule idNMT) +apply (metis WP1rd sepnMT sortnMTQ wellformed_policy1_strong.simps(1) wp1ID wp1n_RS2 wp1n_RS3) +by (rule C_eq_Until_InsertDeniesQ, simp_all) + + +lemma C_eq_normalize: +"DenyAll \ set (policy2list p) \ allNetsDistinct (policy2list p) \ + all_in_list(policy2list p)(Nets_List p) \ + C (list2FWpolicy (normalize p)) = C p" +unfolding normalize_def +by (simp add: C_eq_compile) + + +lemma C_eq_normalizeQ: + "DenyAll \ set (policy2list p) \ allNetsDistinct (policy2list p) \ + all_in_list (policy2list p) (Nets_List p) \ + C (list2FWpolicy (normalizeQ p)) = C p" +by (simp add: normalizeQ_def C_eq_compileQ) + + +lemma domSubset3: "dom (C (DenyAll \ x)) = dom (C (DenyAll))" +by (simp add: PLemmas split_tupled_all split: option.splits) + + +lemma domSubset4: + "dom (C (DenyAllFromTo x y \ DenyAllFromTo y x \ AllowPortFromTo x y dn)) = + dom (C (DenyAllFromTo x y \ DenyAllFromTo y x))" +by (auto simp: PLemmas split: option.splits decision.splits ) + + +lemma domSubset5: + "dom (C (DenyAllFromTo x y \ DenyAllFromTo y x \ AllowPortFromTo y x dn)) = + dom (C (DenyAllFromTo x y \ DenyAllFromTo y x))" +by (auto simp: PLemmas split: option.splits decision.splits ) + + + +lemma domSubset1: + "dom (C (DenyAllFromTo one two \ DenyAllFromTo two one \ AllowPortFromTo one two dn \ x)) = + dom (C (DenyAllFromTo one two \ DenyAllFromTo two one \ x))" +by (simp add: PLemmas split: option.splits decision.splits) (auto simp: allow_all_def deny_all_def) + + +lemma domSubset2: + "dom (C (DenyAllFromTo one two \ DenyAllFromTo two one \ AllowPortFromTo two one dn \ x)) = + dom (C (DenyAllFromTo one two \ DenyAllFromTo two one \ x))" +by (simp add: PLemmas split: option.splits decision.splits) (auto simp: allow_all_def deny_all_def) + + +lemma ConcAssoc2: "C (X \ Y \ ((A \ B) \ D)) = C (X \ Y \ A \ B \ D)" +by (simp add: C.simps) + + +lemma ConcAssoc3: "C (X \ ((Y \ A) \ D)) = C (X \ Y \ A \ D)" +by (simp add: C.simps) + + +lemma RS3_NMT[rule_format]: + "DenyAll \ set p \ rm_MT_rules C p \ []" +by (induct_tac p) (simp_all add: PLemmas) + + +lemma norm_notMT: "DenyAll \ set (policy2list p) \ normalize p \ []" +by (simp add: DAiniD RS2_NMT RS3_NMT idNMT normalize_def rADnMT sepnMT sortnMT) + + +lemma norm_notMTQ: "DenyAll \ set (policy2list p) \ normalizeQ p \ []" +by (simp add: DAiniD RS2_NMT RS3_NMT idNMT normalizeQ_def rADnMT sepnMT sortnMTQ) + + +lemmas domDA = NormalisationIntegerPortProof.domSubset3 (* legacy *) + + +lemmas domain_reasoning = domDA ConcAssoc2 domSubset1 domSubset2 + domSubset3 domSubset4 domSubset5 domSubsetDistr1 + domSubsetDistr2 domSubsetDistrA domSubsetDistrD coerc_assoc ConcAssoc + ConcAssoc3 + + +text {* The following lemmas help with the normalisation *} +lemma list2policyR_Start[rule_format]: "p \ dom (C a) \ + C (list2policyR (a # list)) p = C a p" +by (induct "a # list" rule:list2policyR.induct) (auto simp: C.simps dom_def map_add_def) + + +lemma list2policyR_End: "p \ dom (C a) \ + C (list2policyR (a # list)) p = (C a \ list2policy (map C list)) p" +by (rule list2policyR.induct) + (simp_all add: C.simps dom_def map_add_def list2policy_def split: option.splits) + + +lemma l2polR_eq_el[rule_format]: + "N \ [] \ C(list2policyR N) p = (list2policy (map C N)) p" +proof (induct N) + case Nil show ?case by (simp_all add: list2policy_def) +next + case (Cons a N) then show ?case + apply (case_tac "p \ dom (C a)",simp_all add: domStart list2policy_def) + apply (rule list2policyR_Start, simp_all) + apply (rule list2policyR.induct, simp_all) + apply (simp_all add: C.simps dom_def map_add_def) + apply (simp split: option.splits) + done +qed + + +lemma l2polR_eq: + "N \ [] \ C( list2policyR N) = (list2policy (map C N))" +by (auto simp: list2policy_def l2polR_eq_el ) + + +lemma list2FWpolicys_eq_el[rule_format]: + "Filter \ [] \ C (list2policyR Filter) p = C (list2FWpolicy (rev Filter)) p" +proof (induct Filter) print_cases + case Nil show ?case by (simp) +next + case (Cons a list) then show ?case + apply simp_all + apply (case_tac "list = []", simp_all) + apply (case_tac "p \ dom (C a)", simp_all) + apply (rule list2policyR_Start, simp_all) + by (metis C.simps(4) l2polR_eq list2policyR_End nlpaux) +qed + +lemma list2FWpolicys_eq: + "Filter \ [] \ C (list2policyR Filter) = C (list2FWpolicy (rev Filter))" +by (rule ext, erule list2FWpolicys_eq_el) + + +lemma list2FWpolicys_eq_sym: + "Filter \ [] \C (list2policyR (rev Filter)) = C (list2FWpolicy Filter)" +by (metis list2FWpolicys_eq rev_is_Nil_conv rev_rev_ident) + + +lemma p_eq[rule_format]: + "p \ [] \ list2policy (map C (rev p)) = C (list2FWpolicy p)" +by (metis l2polR_eq list2FWpolicys_eq_sym rev.simps(1) rev_rev_ident) + + +lemma p_eq2[rule_format]: + "normalize x \ [] \ C(list2FWpolicy(normalize x)) = C x \ + list2policy(map C (rev(normalize x))) = C x" +by (simp add: p_eq) + + +lemma p_eq2Q[rule_format]: + "normalizeQ x \ [] \ C (list2FWpolicy (normalizeQ x)) = C x \ + list2policy (map C (rev (normalizeQ x))) = C x" +by (simp add: p_eq) + + +lemma list2listNMT[rule_format]: "x \ [] \map sem x \ []" +by (case_tac x) simp_all + + +lemma Norm_Distr2: + "r o_f ((P \\<^sub>2 (list2policy Q)) o d) = (list2policy ((P \\<^sub>L Q) (op \\<^sub>2) r d))" +by (rule ext, rule Norm_Distr_2) + + +lemma NATDistr: + "N \ [] \ F = C (list2policyR N) \ + (\(x, y). x) o\<^sub>f (NAT \\<^sub>2 F \ (\x. (x, x))) = + list2policy ((NAT \\<^sub>L map C N) op \\<^sub>2 (\(x, y). x) (\x. (x, x)))" +apply (simp add: l2polR_eq) +apply (rule ext) +apply (rule Norm_Distr_2) +done + + +lemma C_eq_normalize_manual: +"DenyAll\set(policy2list p) \ allNetsDistinct(policy2list p) \ all_in_list(policy2list p) l \ + C (list2FWpolicy (normalize_manual_order p l)) = C p" +by (simp add: normalize_manual_order_def C_eq_compile) + + +lemma p_eq2_manualQ[rule_format]: + "normalize_manual_orderQ x l \ [] \ C(list2FWpolicy (normalize_manual_orderQ x l)) = C x \ + list2policy (map C (rev (normalize_manual_orderQ x l))) = C x" +by (simp add: p_eq) + + +lemma norm_notMT_manualQ: "DenyAll \ set (policy2list p) \ normalize_manual_orderQ p l \ []" +by (simp add: DAiniD RS2_NMT RS3_NMT idNMT normalize_manual_orderQ_def rADnMT sepnMT sortnMTQ) + + +lemma C_eq_normalize_manualQ: + "DenyAll\set(policy2list p) \ allNetsDistinct(policy2list p) \ all_in_list(policy2list p) l \ + C (list2FWpolicy (normalize_manual_orderQ p l)) = C p" +by (simp add: normalize_manual_orderQ_def C_eq_compileQ) + + +lemma p_eq2_manual[rule_format]: + "normalize_manual_order x l \ [] \ C (list2FWpolicy (normalize_manual_order x l)) = C x \ + list2policy (map C (rev (normalize_manual_order x l))) = C x" +by (simp add: p_eq) + + +lemma norm_notMT_manual: "DenyAll \ set (policy2list p) \ normalize_manual_order p l \ []" +by (simp add: RS2_NMT idNMT normalize_manual_order_def rADnMT sepnMT sortnMT wp1ID) + + +text{* As an example, how this theorems can be used for a concrete +normalisation instantiation. *} + +lemma normalizeNAT: + "DenyAll \ set (policy2list Filter) \ allNetsDistinct (policy2list Filter) \ + all_in_list (policy2list Filter) (Nets_List Filter) \ + (\(x, y). x) o\<^sub>f (NAT \\<^sub>2 C Filter \ (\x. (x, x))) = + list2policy ((NAT \\<^sub>L map C (rev (FWNormalisationCore.normalize Filter))) op \\<^sub>2 + (\(x, y). x) (\x. (x, x)))" +by (simp add: C_eq_normalize NATDistr list2FWpolicys_eq_sym norm_notMT) + + +lemma domSimpl[simp]: "dom (C (A \ DenyAll)) = dom (C (DenyAll))" +by (simp add: PLemmas) + + +text {* The followin theorems can be applied when prepending the usual normalisation with an +additional step and using another semantical interpretation function. This is a general recipe +which can be applied whenever one nees to combine several normalisation strategies. *} + + +lemma CRotate_eq_rotateC: "CRotate p = C (rotatePolicy p)" +by (induct p rule: rotatePolicy.induct) (simp_all add: C.simps map_add_def) + + +lemma DAinRotate: + "DenyAll \ set (policy2list p) \ DenyAll \ set (policy2list (rotatePolicy p))" +by (induct p,simp_all) (case_tac "DenyAll \ set (policy2list p1)",simp_all) + + +lemma DAUniv: "dom (CRotate (P \ DenyAll)) = UNIV" +by (metis CRotate.simps(1) CRotate.simps(4) CRotate_eq_rotateC DAAux PLemmas(4) UNIV_eq_I domSubset3) + + +lemma p_eq2R[rule_format]: + "normalize (rotatePolicy x) \ [] \ C(list2FWpolicy(normalize (rotatePolicy x))) = CRotate x \ + list2policy (map C (rev (normalize (rotatePolicy x)))) = CRotate x" +by (simp add: p_eq) + + +lemma C_eq_normalizeRotate: + "DenyAll \ set (policy2list p) \ allNetsDistinct (policy2list (rotatePolicy p)) \ + all_in_list (policy2list (rotatePolicy p)) (Nets_List (rotatePolicy p)) \ + C (list2FWpolicy + (removeAllDuplicates + (insertDenies + (separate + (sort(removeShadowRules2(remdups(rm_MT_rules C + (insertDeny(removeShadowRules1(policy2list(rotatePolicy p))))))) + (Nets_List (rotatePolicy p))))))) = + CRotate p" +by (simp add: CRotate_eq_rotateC C_eq_compile DAinRotate) + + +lemma C_eq_normalizeRotate2: + "DenyAll \ set (policy2list p) \ + allNetsDistinct (policy2list (rotatePolicy p)) \ + all_in_list (policy2list (rotatePolicy p)) (Nets_List (rotatePolicy p)) \ + C (list2FWpolicy (FWNormalisationCore.normalize (rotatePolicy p))) = CRotate p" +by (simp add: normalize_def, erule C_eq_normalizeRotate,simp_all) + + +end + + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..8b4b3a9 --- /dev/null +++ b/LICENSE @@ -0,0 +1,34 @@ +Copyright (c) 2005-2010 ETH Zurich, Switzerland + 2008-2015 Achim D. Brucker, Germany + 2009-2016 Université Paris-Sud, France + 2015-2016 The University of Sheffield, UK + +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 holders 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. diff --git a/NAT/NAT.thy b/NAT/NAT.thy new file mode 100644 index 0000000..226c2d0 --- /dev/null +++ b/NAT/NAT.thy @@ -0,0 +1,170 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection{* Network Address Translation *} +theory + NAT +imports + "../PacketFilter/PacketFilter" +begin + + +definition src2pool :: "'\ set \ ('\::adr,'\) packet \ ('\,'\) packet set" where + "src2pool t = (\ p. ({(i,s,d,da). (i = id p \ s \ t \ d = dest p \ da = content p)}))" + +definition src2poolAP where + "src2poolAP t = A\<^sub>f (src2pool t)" + +definition srcNat2pool :: "'\ set \ '\ set \ ('\::adr,'\) packet \ ('\,'\) packet set" where + "srcNat2pool srcs transl = {x. src x \ srcs} \ (src2poolAP transl)" + +definition src2poolPort :: "int set \ (adr\<^sub>i\<^sub>p,'\) packet \ (adr\<^sub>i\<^sub>p,'\) packet set" where + "src2poolPort t = (\ p. ({(i,(s1,s2),(d1,d2),da). + (i = id p \ s1 \ t \ s2 = (snd (src p)) \ d1 = (fst (dest p)) \ + d2 = snd (dest p) \ da = content p)}))" + +definition src2poolPort_Protocol :: "int set \ (adr\<^sub>i\<^sub>p\<^sub>p,'\) packet \ (adr\<^sub>i\<^sub>p\<^sub>p,'\) packet set" where + "src2poolPort_Protocol t = (\ p. ({(i,(s1,s2,s3),(d1,d2,d3), da). + (i = id p \ s1 \ t \ s2 = (fst (snd (src p))) \ s3 = snd (snd (src p)) \ + (d1,d2,d3) = dest p \ da = content p)}))" + +definition srcNat2pool_IntPort :: "address set \ address set \ + (adr\<^sub>i\<^sub>p,'\) packet \ (adr\<^sub>i\<^sub>p,'\) packet set" where + "srcNat2pool_IntPort srcs transl = + {x. fst (src x) \ srcs} \ (A\<^sub>f (src2poolPort transl))" + +definition srcNat2pool_IntProtocolPort :: "int set \ int set \ + (adr\<^sub>i\<^sub>p\<^sub>p,'\) packet \ (adr\<^sub>i\<^sub>p\<^sub>p,'\) packet set" where + "srcNat2pool_IntProtocolPort srcs transl = + {x. (fst ( (src x))) \ srcs} \ (A\<^sub>f (src2poolPort_Protocol transl))" + +definition srcPat2poolPort_t :: "int set \ (adr\<^sub>i\<^sub>p,'\) packet \ (adr\<^sub>i\<^sub>p,'\) packet set" where + "srcPat2poolPort_t t = (\ p. ({(i,(s1,s2),(d1,d2),da). + (i = id p \ s1 \ t \ d1 = (fst (dest p)) \ d2 = snd (dest p)\ da = content p)}))" + +definition srcPat2poolPort_Protocol_t :: "int set \ (adr\<^sub>i\<^sub>p\<^sub>p,'\) packet \ (adr\<^sub>i\<^sub>p\<^sub>p,'\) packet set" where + "srcPat2poolPort_Protocol_t t = (\ p. ({(i,(s1,s2,s3),(d1,d2,d3),da). + (i = id p \ s1 \ t \ s3 = src_protocol p \ (d1,d2,d3) = dest p \ da = content p)}))" + +definition srcPat2pool_IntPort :: "int set \ int set \ (adr\<^sub>i\<^sub>p,'\) packet \ + (adr\<^sub>i\<^sub>p,'\) packet set" where + "srcPat2pool_IntPort srcs transl = + {x. (fst (src x)) \ srcs} \ (A\<^sub>f (srcPat2poolPort_t transl))" + +definition srcPat2pool_IntProtocol :: + "int set \ int set \ (adr\<^sub>i\<^sub>p\<^sub>p,'\) packet \ (adr\<^sub>i\<^sub>p\<^sub>p,'\) packet set" where + + "srcPat2pool_IntProtocol srcs transl = + {x. (fst (src x)) \ srcs} \ (A\<^sub>f (srcPat2poolPort_Protocol_t transl))" + + +text{* + The following lemmas are used for achieving a normalized output format of packages after + applying NAT. This is used, e.g., by our firewall execution tool. +*} + +lemma datasimp: "{(i, (s1, s2, s3), aba). + \a aa b ba. aba = ((a, aa, b), ba) \ i = i1 \ s1 = i101 \ + s3 = iudp \ a = i110 \ aa = X606X3 \ b = X607X4 \ ba = data} + = {(i, (s1, s2, s3), aba). + i = i1 \ s1 = i101 \ s3 = iudp \ (\ ((a,aa,b),ba). a = i110 \ aa = X606X3 \ + b = X607X4 \ ba = data) aba}" +by auto + +lemma datasimp2: "{(i, (s1, s2, s3), aba). + \a aa b ba. aba = ((a, aa, b), ba) \ i = i1 \ s1 = i132 \ s3 = iudp \ + s2 = i1 \ a = i110 \ aa = i4 \ b = iudp \ ba = data} + = {(i, (s1, s2, s3), aba). + i = i1 \ s1 = i132 \ s3 = iudp \ s2 = i1 \ (\ ((a,aa,b),ba). a = i110 \ + aa = i4 \ b = iudp \ ba = data) aba}" +by auto + +lemma datasimp3: "{(i, (s1, s2, s3), aba). + \ a aa b ba. aba = ((a, aa, b), ba) \ i = i1 \ i115 < s1 \ s1 < i124 \ + s3 = iudp \ s2 = ii1 \ a = i110 \ aa = i3 \ b = itcp \ ba = data} + = {(i, (s1, s2, s3), aba). + i = i1 \ i115 < s1 \ s1 < i124 \ s3 = iudp \ s2 = ii1 \ + (\ ((a,aa,b),ba). a = i110 & aa = i3 & b = itcp & ba = data) aba}" +by auto + +lemma datasimp4: "{(i, (s1, s2, s3), aba). + \a aa b ba. aba = ((a, aa, b), ba) \ i = i1 \ s1 = i132 \ s3 = iudp \ + s2 = ii1 \ a = i110 \ aa = i7 \ b = itcp \ ba = data} + = {(i, (s1, s2, s3), aba). + i = i1 \ s1 = i132 \ s3 = iudp \ s2 = ii1 \ + (\ ((a,aa,b),ba). a = i110 \ aa = i7 \ b = itcp \ ba = data) aba}" +by auto + +lemma datasimp5: " {(i, (s1, s2, s3), aba). + i = i1 \ s1 = i101 \ s3 = iudp \ (\ ((a,aa,b),ba). a = i110 \ aa = X606X3 \ + b = X607X4 \ ba = data) aba} + = {(i, (s1, s2, s3), (a,aa,b),ba). + i = i1 \ s1 = i101 \ s3 = iudp \ a = i110 \ aa = X606X3 \ + b = X607X4 \ ba = data}" +by auto + +lemma datasimp6: "{(i, (s1, s2, s3), aba). + i = i1 \ s1 = i132 \ s3 = iudp \ s2 = i1 \ + (\ ((a,aa,b),ba). a = i110 \ aa = i4 \ b = iudp \ ba = data) aba} + = {(i, (s1, s2, s3), (a,aa,b),ba). + i = i1 \ s1 = i132 \ s3 = iudp \ s2 = i1 \ a = i110 \ + aa = i4 \ b = iudp \ ba = data}" +by auto + +lemma datasimp7: "{(i, (s1, s2, s3), aba). + i = i1 \ i115 < s1 \ s1 < i124 \ s3 = iudp \ s2 = ii1 \ + (\ ((a,aa,b),ba). a = i110 \ aa = i3 \ b = itcp \ ba = data) aba} + = {(i, (s1, s2, s3), (a,aa,b),ba). + i = i1 \ i115 < s1 \ s1 < i124 \ s3 = iudp \ s2 = ii1 + \ a = i110 \ aa = i3 \ b = itcp \ ba = data}" +by auto + +lemma datasimp8: "{(i, (s1, s2, s3), aba). i = i1 \ s1 = i132 \ s3 = iudp \ s2 = ii1 \ + (\ ((a,aa,b),ba). a = i110 \ aa = i7 \ b = itcp \ ba = data) aba} + = {(i, (s1, s2, s3), (a,aa,b),ba). i = i1 \ s1 = i132 \ s3 = iudp + \ s2 = ii1 \ a = i110 \ aa = i7 \ b = itcp \ ba = data}" +by auto + +lemmas datasimps = datasimp datasimp2 datasimp3 datasimp4 + datasimp5 datasimp6 datasimp7 datasimp8 + +lemmas NATLemmas = src2pool_def src2poolPort_def + src2poolPort_Protocol_def src2poolAP_def srcNat2pool_def + srcNat2pool_IntProtocolPort_def srcNat2pool_IntPort_def + srcPat2poolPort_t_def srcPat2poolPort_Protocol_t_def + srcPat2pool_IntPort_def srcPat2pool_IntProtocol_def +end diff --git a/PacketFilter/DatatypeAddress.thy b/PacketFilter/DatatypeAddress.thy new file mode 100644 index 0000000..e01a5ef --- /dev/null +++ b/PacketFilter/DatatypeAddress.thy @@ -0,0 +1,62 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Datatype Addresses *} +theory + DatatypeAddress +imports + NetworkCore +begin + +text{* + A theory describing a network consisting of three subnetworks. Hosts within a network are not + distinguished. +*} + +datatype DatatypeAddress = dmz_adr | intranet_adr | internet_adr + +definition + dmz::"DatatypeAddress net" where + "dmz = {{dmz_adr}}" +definition + intranet::"DatatypeAddress net" where + "intranet = {{intranet_adr}}" +definition + internet::"DatatypeAddress net" where + "internet = {{internet_adr}}" + +end diff --git a/PacketFilter/DatatypePort.thy b/PacketFilter/DatatypePort.thy new file mode 100644 index 0000000..c036948 --- /dev/null +++ b/PacketFilter/DatatypePort.thy @@ -0,0 +1,93 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Datatype Addresses with Ports *} +theory DatatypePort +imports NetworkCore +begin + +text{* + A theory describing a network consisting of three subnetworks, including port numbers modelled + as Integers. Hosts within a network are not distinguished. +*} + +datatype DatatypeAddress = dmz_adr | intranet_adr | internet_adr + +type_synonym + port = int +type_synonym + DatatypePort = "(DatatypeAddress \ port)" + +instance DatatypeAddress :: adr .. + +definition + dmz::"DatatypePort net" where + "dmz = {{(a,b). a = dmz_adr}}" +definition + intranet::"DatatypePort net" where + "intranet = {{(a,b). a = intranet_adr}}" +definition + internet::"DatatypePort net" where + "internet = {{(a,b). a = internet_adr}}" + +overloading src_port_datatype \ "src_port :: ('\::adr,'\) packet \ '\::port" +begin +definition + "src_port_datatype (x::(DatatypePort,'\) packet) \ (snd o fst o snd) x" +end + +overloading dest_port_datatype \ "dest_port :: ('\::adr,'\) packet \ '\::port" +begin +definition + "dest_port_datatype (x::(DatatypePort,'\) packet) \(snd o fst o snd o snd) x" +end + +overloading subnet_of_datatype \ "subnet_of :: '\::adr \ '\ net" +begin +definition + "subnet_of_datatype (x::DatatypePort) \ {{(a,b::int). a = fst x}}" +end + +lemma src_port : "src_port ((a,x,d,e)::(DatatypePort,'\) packet) = snd x" + by (simp add: src_port_datatype_def in_subnet) + +lemma dest_port : "dest_port ((a,d,x,e)::(DatatypePort,'\) packet) = snd x" + by (simp add: dest_port_datatype_def in_subnet) + +lemmas DatatypePortLemmas = src_port dest_port src_port_datatype_def dest_port_datatype_def + +end diff --git a/PacketFilter/IPv4.thy b/PacketFilter/IPv4.thy new file mode 100644 index 0000000..4e9f124 --- /dev/null +++ b/PacketFilter/IPv4.thy @@ -0,0 +1,88 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Formalizing IPv4 Addresses *} +theory + IPv4 +imports + NetworkCore +begin +text{* + A theory describing IPv4 addresses with ports. The host address is a four-tuple of Integers, + the port number is a single Integer. +*} + +type_synonym + ipv4_ip = "(int \ int \ int \ int)" + +type_synonym + port = "int" + +type_synonym + ipv4 = "(ipv4_ip \ port)" + +overloading src_port_ipv4 \ "src_port :: ('\::adr,'\) packet \ '\::port" +begin +definition + "src_port_ipv4 (x::(ipv4,'\) packet) \ (snd o fst o snd) x" +end + +overloading dest_port_ipv4 \ "dest_port :: ('\::adr,'\) packet \ '\::port" +begin +definition + "dest_port_ipv4 (x::(ipv4,'\) packet) \ (snd o fst o snd o snd) x" +end + +overloading subnet_of_ipv4 \ "subnet_of :: '\::adr \ '\ net" +begin +definition + "subnet_of_ipv4 (x::ipv4) \ {{(a,b::int). a = fst x}}" +end + +definition subnet_of_ip :: "ipv4_ip \ ipv4 net" +where "subnet_of_ip ip = {{(a,b). (a = ip)}}" + +lemma src_port: "src_port (a,(x::ipv4),d,e) = snd x" + by (simp add: src_port_ipv4_def in_subnet) + +lemma dest_port: "dest_port (a,d,(x::ipv4),e) = snd x" + by (simp add: dest_port_ipv4_def in_subnet) + + +lemmas IPv4Lemmas = src_port dest_port src_port_ipv4_def dest_port_ipv4_def + +end diff --git a/PacketFilter/IPv4_TCPUDP.thy b/PacketFilter/IPv4_TCPUDP.thy new file mode 100644 index 0000000..0949002 --- /dev/null +++ b/PacketFilter/IPv4_TCPUDP.thy @@ -0,0 +1,83 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* IPv4 with Ports and Protocols *} +theory IPv4_TCPUDP +imports IPv4 +begin + +type_synonym + ipv4_TCPUDP = "(ipv4_ip \ port \ protocol)" + +instance protocol :: adr .. + +overloading src_port_ipv4_TCPUDP \ "src_port :: ('\::adr,'\) packet \ '\::port" +begin +definition + "src_port_ipv4_TCPUDP (x::(ipv4_TCPUDP,'\) packet) \ (fst o snd o fst o snd) x" +end + +overloading dest_port_ipv4_TCPUDP \ "dest_port :: ('\::adr,'\) packet \ '\::port" +begin +definition + "dest_port_ipv4_TCPUDP (x::(ipv4_TCPUDP,'\) packet) \ (fst o snd o fst o snd o snd) x" +end + +overloading subnet_of_ipv4_TCPUDP \ "subnet_of :: '\::adr \ '\ net" +begin +definition + "subnet_of_ipv4_TCPUDP (x::ipv4_TCPUDP) \ {{(a,b). a = fst x}}::(ipv4_TCPUDP net)" +end + +overloading dest_protocol_ipv4_TCPUDP \ "dest_protocol :: ('\::adr,'\) packet \ protocol" +begin +definition + "dest_protocol_ipv4_TCPUDP (x::(ipv4_TCPUDP,'\) packet) \ (snd o snd o fst o snd o snd) x" +end + +definition subnet_of_ip :: "ipv4_ip \ ipv4_TCPUDP net" +where "subnet_of_ip ip = {{(a,b). (a = ip)}}" + +lemma src_port: "src_port (a,(x::ipv4_TCPUDP),d,e) = fst (snd x)" + by (simp add: src_port_ipv4_TCPUDP_def in_subnet) + +lemma dest_port: "dest_port (a,d,(x::ipv4_TCPUDP),e) = fst (snd x)" + by (simp add: dest_port_ipv4_TCPUDP_def in_subnet) + +lemmas Ipv4_TCPUDPLemmas = src_port dest_port src_port_ipv4_TCPUDP_def dest_port_ipv4_TCPUDP_def + dest_protocol_ipv4_TCPUDP_def subnet_of_ipv4_TCPUDP_def +end diff --git a/PacketFilter/IntegerAddress.thy b/PacketFilter/IntegerAddress.thy new file mode 100644 index 0000000..95ae2e7 --- /dev/null +++ b/PacketFilter/IntegerAddress.thy @@ -0,0 +1,48 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Integer Addresses *} +theory IntegerAddress +imports NetworkCore +begin + +text{* A theory where addresses are modelled as Integers.*} + +type_synonym + adr\<^sub>i = "int" + +end diff --git a/PacketFilter/IntegerPort.thy b/PacketFilter/IntegerPort.thy new file mode 100644 index 0000000..c935229 --- /dev/null +++ b/PacketFilter/IntegerPort.thy @@ -0,0 +1,85 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection{* Integer Addresses with Ports *} +theory + IntegerPort +imports + NetworkCore +begin + +text{* + A theory describing addresses which are modelled as a pair of Integers - the first being the + host address, the second the port number. +*} + +type_synonym + address = int + +type_synonym + port = int + +type_synonym + adr\<^sub>i\<^sub>p = "address \ port" + +overloading src_port_int \ "src_port :: ('\::adr,'\) packet \ '\::port" +begin +definition + "src_port_int (x::(adr\<^sub>i\<^sub>p,'\) packet) \ (snd o fst o snd) x" +end + +overloading dest_port_int \ "dest_port :: ('\::adr,'\) packet \ '\::port" +begin +definition + "dest_port_int (x::(adr\<^sub>i\<^sub>p,'\) packet) \ (snd o fst o snd o snd) x" +end + +overloading subnet_of_int \ "subnet_of :: '\::adr \ '\ net" +begin +definition + "subnet_of_int (x::(adr\<^sub>i\<^sub>p)) \ {{(a,b::int). a = fst x}}" +end + +lemma src_port: "src_port (a,x::adr\<^sub>i\<^sub>p,d,e) = snd x" + by (simp add: src_port_int_def in_subnet) + +lemma dest_port: "dest_port (a,d,x::adr\<^sub>i\<^sub>p,e) = snd x" + by (simp add: dest_port_int_def in_subnet) + +lemmas adr\<^sub>i\<^sub>pLemmas = src_port dest_port src_port_int_def dest_port_int_def + +end diff --git a/PacketFilter/IntegerPort_TCPUDP.thy b/PacketFilter/IntegerPort_TCPUDP.thy new file mode 100644 index 0000000..5502433 --- /dev/null +++ b/PacketFilter/IntegerPort_TCPUDP.thy @@ -0,0 +1,111 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Integer Addresses with Ports and Protocols *} +theory + IntegerPort_TCPUDP +imports + NetworkCore +begin + +text{* A theory describing addresses which are modelled as a pair of Integers - the first being + the host address, the second the port number.*} + +type_synonym + address = int + +type_synonym + port = int + +type_synonym + adr\<^sub>i\<^sub>p\<^sub>p = "address \ port \ protocol" + +instance protocol :: adr .. + +overloading src_port_int_TCPUDP \ "src_port :: ('\::adr,'\) packet \ '\::port" +begin +definition + "src_port_int_TCPUDP (x::(adr\<^sub>i\<^sub>p\<^sub>p,'\) packet) \ (fst o snd o fst o snd) x" +end + +overloading dest_port_int_TCPUDP \ "dest_port :: ('\::adr,'\) packet \ '\::port" +begin +definition + "dest_port_int_TCPUDP (x::(adr\<^sub>i\<^sub>p\<^sub>p,'\) packet) \ (fst o snd o fst o snd o snd) x" +end + +overloading subnet_of_int_TCPUDP \ "subnet_of :: '\::adr \ '\ net" +begin +definition + "subnet_of_int_TCPUDP (x::(adr\<^sub>i\<^sub>p\<^sub>p)) \ {{(a,b,c). a = fst x}}::adr\<^sub>i\<^sub>p\<^sub>p net" +end + +overloading src_protocol_int_TCPUDP \ "src_protocol :: ('\::adr,'\) packet \ protocol" +begin +definition + "src_protocol_int_TCPUDP (x::(adr\<^sub>i\<^sub>p\<^sub>p,'\) packet) \ (snd o snd o fst o snd) x" +end + +overloading dest_protocol_int_TCPUDP \ "dest_protocol :: ('\::adr,'\) packet \ protocol" +begin +definition + "dest_protocol_int_TCPUDP (x::(adr\<^sub>i\<^sub>p\<^sub>p,'\) packet) \ (snd o snd o fst o snd o snd) x" +end + +lemma src_port: "src_port (a,x::adr\<^sub>i\<^sub>p\<^sub>p,d,e) = fst (snd x)" + by (simp add: src_port_int_TCPUDP_def in_subnet) + +lemma dest_port: "dest_port (a,d,x::adr\<^sub>i\<^sub>p\<^sub>p,e) = fst (snd x)" + by (simp add: dest_port_int_TCPUDP_def in_subnet) + +text {* Common test constraints: *} + + +definition port_positive :: "(adr\<^sub>i\<^sub>p\<^sub>p,'b) packet \ bool" where + "port_positive x = (dest_port x > (0::port))" + +definition fix_values :: "(adr\<^sub>i\<^sub>p\<^sub>p,DummyContent) packet \ bool" where + "fix_values x = (src_port x = (1::port) \ src_protocol x = udp \ content x = data \ id x = 1)" + + +lemmas adr\<^sub>i\<^sub>p\<^sub>pLemmas = src_port dest_port src_port_int_TCPUDP_def dest_port_int_TCPUDP_def + src_protocol_int_TCPUDP_def dest_protocol_int_TCPUDP_def + subnet_of_int_TCPUDP_def + +lemmas adr\<^sub>i\<^sub>p\<^sub>pTestConstraints = port_positive_def fix_values_def + +end diff --git a/PacketFilter/NetworkCore.thy b/PacketFilter/NetworkCore.thy new file mode 100644 index 0000000..e302800 --- /dev/null +++ b/PacketFilter/NetworkCore.thy @@ -0,0 +1,182 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection{* Packets and Networks *} +theory + NetworkCore +imports + Main +begin + +text{* + In networks based e.g. on TCP/IP, a message from A to B is encapsulated in \emph{packets}, which + contain the content of the message and routing information. The routing information mainly + contains its source and its destination address. + + In the case of stateless packet filters, a firewall bases its decision upon this routing + information and, in the stateful case, on the content. Thus, we model a packet as a four-tuple of + the mentioned elements, together with an id field. +*} + +text{* The ID is an integer: *} +type_synonym id = int + +text{* + To enable different representations of addresses (e.g. IPv4 and IPv6, with or without ports), + we model them as an unconstrained type class and directly provide several instances: +*} +class adr + +type_synonym '\ src = "'\" +type_synonym '\ dest = "'\" + +instance int ::adr .. +instance nat ::adr .. + +instance "fun" :: (adr,adr) adr .. +instance prod :: (adr,adr) adr .. + +text{* + The content is also specified with an unconstrained generic type: +*} +type_synonym '\ content = "'\" + +text {* + For applications where the concrete representation of the content field does not matter (usually + the case for stateless packet filters), we provide a default type which can be used in those + cases: +*} + +datatype DummyContent = data + +text{* Finally, a packet is:*} + +type_synonym ('\,'\) packet = "id \ '\ src \ '\ dest \ '\ content" + +text{* + Protocols (e.g. http) are not modelled explicitly. In the case of stateless packet filters, they + are only visible by the destination port of a packet, which are modelled as part of the address. + Additionally, stateful firewalls often determine the protocol by the content of a packet. +*} + +definition src :: "('\::adr,'\) packet \ '\" +where "src = fst o snd " + +text{* + Port numbers (which are part of an address) are also modelled in a generic way. The integers and + the naturals are typical representations of port numbers. +*} + +class port + +instance int ::port .. +instance nat :: port .. +instance "fun" :: (port,port) port .. +instance "prod" :: (port,port) port .. + +text{* + A packet therefore has two parameters, the first being the address, the second the content. For + the sake of simplicity, we do not allow to have a different address representation format for the + source and the destination of a packet. + + To access the different parts of a packet directly, we define a couple of projectors: +*} +definition id :: "('\::adr,'\) packet \ id" +where "id = fst" + +definition dest :: "('\::adr,'\) packet \ '\ dest" +where "dest = fst o snd o snd" + +definition content :: "('\::adr,'\) packet \ '\ content" +where "content = snd o snd o snd" + +datatype protocol = tcp | udp + +lemma either: "\a \ tcp;a \ udp\ \ False" +by (case_tac a,simp_all) + +lemma either2[simp]: "(a \ tcp) = (a = udp)" +by (case_tac a,simp_all) + +lemma either3[simp]: "(a \ udp) = (a = tcp)" +by (case_tac a,simp_all) + +text{* + The following two constants give the source and destination port number of a packet. Address + representations using port numbers need to provide a definition for these types. +*} + +consts src_port :: "('\::adr,'\) packet \ '\::port" +consts dest_port :: "('\::adr,'\) packet \ '\::port" +consts src_protocol :: "('\::adr,'\) packet \ protocol" +consts dest_protocol :: "('\::adr,'\) packet \ protocol" + +text{* A subnetwork (or simply a network) is a set of sets of addresses.*} + +type_synonym '\ net = "'\ set set" + +text{* The relation {in\_subnet} (@{text "\"}) checks if an address is in a specific network. *} + +definition + in_subnet :: "'\::adr \ '\ net \ bool" (infixl "\" 100) where + "in_subnet a S = (\ s \ S. a \ s)" + + +text{* The following lemmas will be useful later. *} + +lemma in_subnet: + "(a, e) \ {{(x1,y). P x1 y}} = P a e" + by (simp add: in_subnet_def) + +lemma src_in_subnet: + "src(q,(a,e),r,t) \ {{(x1,y). P x1 y}} = P a e" + by (simp add: in_subnet_def in_subnet src_def) + +lemma dest_in_subnet: + "dest (q,r,((a),e),t) \ {{(x1,y). P x1 y}} = P a e" + by (simp add: in_subnet_def in_subnet dest_def) + +text{* + Address models should provide a definition for the following constant, returning a network + consisting of the input address only. +*} + +consts subnet_of :: "'\::adr \ '\ net" + +lemmas packet_defs = in_subnet_def id_def content_def src_def dest_def + +end diff --git a/PacketFilter/NetworkModels.thy b/PacketFilter/NetworkModels.thy new file mode 100644 index 0000000..4ec19ea --- /dev/null +++ b/PacketFilter/NetworkModels.thy @@ -0,0 +1,79 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +section{* Network Models *} +theory + NetworkModels +imports + DatatypeAddress + DatatypePort + + IntegerAddress + IntegerPort + IntegerPort_TCPUDP + + IPv4 + IPv4_TCPUDP +begin + +text{* + One can think of many different possible address representations. In this distribution, we include + seven different variants: + \begin{itemize} + \item DatatypeAddress: Three explicitly named addresses, which build up a network consisting of + three disjunct subnetworks. I.e. there are no overlaps and there is no way to distinguish + between individual hosts within a network. + \item DatatypePort: An address is a pair, with the first element being the same as above, and + the second being a port number modelled as an Integer\footnote{For technical reasons, + we always use Integers instead of Naturals. As a consequence, the (test) specifications + have to be adjusted to eliminate negative numbers.}. + \item adr\_i: An address in an Integer. + \item adr\_ip: An address is a pair of an Integer and a port (which is again an Integer). + \item adr\_ipp: An address is a triple consisting of two Integers modelling the IP address and + the port number, and the specification of the network protocol + \item IPv4: An address is a pair. The first element is a four-tuple of Integers, modelling an + IPv4 address, the second element is an Integer denoting the port number. + \item IPv4\_TCPUDP: The same as above, but including additionally the specification of the + network protocol. + \end{itemize} + + The theories of each pf the networks are relatively small. It suffices to provide the required + types, a couple of lemmas, and - if required - a definition for the source and destination ports + of a packet. +*} + +end diff --git a/PacketFilter/PacketFilter.thy b/PacketFilter/PacketFilter.thy new file mode 100644 index 0000000..6a272b8 --- /dev/null +++ b/PacketFilter/PacketFilter.thy @@ -0,0 +1,45 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) +subsection {* Network Policies: Packet Filter *} +theory + PacketFilter +imports + NetworkModels + ProtocolPortCombinators + Ports +begin +end diff --git a/PacketFilter/PolicyCombinators.thy b/PacketFilter/PolicyCombinators.thy new file mode 100644 index 0000000..e68ba39 --- /dev/null +++ b/PacketFilter/PolicyCombinators.thy @@ -0,0 +1,86 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Policy Combinators *} +theory PolicyCombinators +imports +PolicyCore +begin + +text{* In order to ease the specification of a concrete policy, we + define some combinators. Using these combinators, the specification + of a policy gets very easy, and can be done similarly as in tools + like IPTables. *} + +definition + allow_all_from :: "'\::adr net \ (('\,'\) packet \ unit)" where + "allow_all_from src_net = {pa. src pa \ src_net} \ A\<^sub>U " + +definition + deny_all_from :: "'\::adr net \ (('\,'\) packet \ unit)" where + "deny_all_from src_net = {pa. src pa \ src_net} \D\<^sub>U " + +definition + allow_all_to :: "'\::adr net \ (('\,'\) packet \ unit)" where + "allow_all_to dest_net = {pa. dest pa \ dest_net} \ A\<^sub>U" + +definition + deny_all_to :: "'\::adr net \ (('\,'\) packet \ unit)" where + "deny_all_to dest_net = {pa. dest pa \ dest_net} \D\<^sub>U " + +definition + allow_all_from_to :: "'\::adr net \ '\::adr net \ (('\,'\) packet \ unit)" where + "allow_all_from_to src_net dest_net = + {pa. src pa \ src_net \ dest pa \ dest_net} \ A\<^sub>U " + +definition + deny_all_from_to :: "'\::adr net \ '\::adr net \ (('\,'\) packet \ unit)" where + "deny_all_from_to src_net dest_net = + {pa. src pa \ src_net \ dest pa \ dest_net} \ D\<^sub>U" + + +text{* All these combinators and the default rules are put into one + single lemma called @{text PolicyCombinators} to faciliate proving + over policies. *} + + +lemmas PolicyCombinators = allow_all_from_def deny_all_from_def + allow_all_to_def deny_all_to_def allow_all_from_to_def + deny_all_from_to_def UPFDefs + + +end diff --git a/PacketFilter/PolicyCore.thy b/PacketFilter/PolicyCore.thy new file mode 100644 index 0000000..7a10078 --- /dev/null +++ b/PacketFilter/PolicyCore.thy @@ -0,0 +1,70 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Policy Core *} +theory + PolicyCore +imports NetworkCore + "$AFP/UPF/UPF" +begin + + +text{* A policy is seen as a partial mapping from packet to packet out. *} + +type_synonym ('\, '\) FWPolicy = "('\, '\) packet \ unit" + +text{* + When combining several rules, the firewall is supposed to apply the + first matching one. In our setting this means the first rule which + maps the packet in question to @{text "Some (packet out)"}. This is + exactly what happens when using the map-add operator (@{text "rule1 + ++ rule2"}). The only difference is that the rules must be given in + reverse order. +*} + + + +text{* + The constant @{text p_accept} is @{text "True"} iff the policy + accepts the packet. +*} + +definition + p_accept :: "('\, '\) packet \ ('\, '\) FWPolicy \ bool" where + "p_accept p pol = (pol p = \allow ()\)" + +end diff --git a/PacketFilter/PortCombinators.thy b/PacketFilter/PortCombinators.thy new file mode 100644 index 0000000..4c59ea2 --- /dev/null +++ b/PacketFilter/PortCombinators.thy @@ -0,0 +1,183 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Policy Combinators with Ports *} +theory PortCombinators +imports PolicyCombinators +begin + +text{* + This theory defines policy combinators for those network models which + have ports. They are provided in addition to the the ones defined in the + PolicyCombinators theory. + + This theory requires from the network models a definition for the two following constants: + \begin{itemize} + \item $src\_port :: ('\alpha,'\beta) packet \Rightarrow ('\gamma::port)$ + \item $dest\_port :: ('\alpha,'\beta) packet \Rightarrow ('\gamma::port)$ + \end{itemize} +*} + +definition + allow_all_from_port :: "'\::adr net \ ('\::port) \ (('\,'\) packet \ unit)" where + "allow_all_from_port src_net s_port = + {pa. src_port pa = s_port} \ allow_all_from src_net" + +definition + deny_all_from_port :: "'\::adr net \ '\::port \ (('\,'\) packet \ unit)" where + "deny_all_from_port src_net s_port = + {pa. src_port pa = s_port} \ deny_all_from src_net " + +definition + allow_all_to_port :: "'\::adr net \ '\::port \ (('\,'\) packet \ unit)" where + "allow_all_to_port dest_net d_port = + {pa. dest_port pa = d_port} \ allow_all_to dest_net" + +definition + deny_all_to_port :: "'\::adr net \ '\::port \ (('\,'\) packet \ unit)" where + "deny_all_to_port dest_net d_port = + {pa. dest_port pa = d_port} \ deny_all_to dest_net" + +definition +allow_all_from_port_to:: "'\::adr net \ '\::port \ '\::adr net \ (('\,'\) packet \ unit)" +where + "allow_all_from_port_to src_net s_port dest_net + = {pa. src_port pa = s_port} \ allow_all_from_to src_net dest_net" + +definition +deny_all_from_port_to::"'\::adr net \ '\::port \ '\::adr net \ (('\,'\) packet \ unit)" + where + "deny_all_from_port_to src_net s_port dest_net + = {pa. src_port pa = s_port} \ deny_all_from_to src_net dest_net " + +definition +allow_all_from_port_to_port::"'\::adr net \ '\::port \ '\::adr net \ '\::port \ + (('\,'\) packet \ unit)" where + "allow_all_from_port_to_port src_net s_port dest_net d_port = + {pa. dest_port pa = d_port} \ allow_all_from_port_to src_net s_port dest_net" + +definition + deny_all_from_port_to_port :: "'\::adr net \ '\::port \ '\::adr net \ + '\::port \ (('\,'\) packet \ unit)" where + "deny_all_from_port_to_port src_net s_port dest_net d_port = + {pa. dest_port pa = d_port} \ deny_all_from_port_to src_net s_port dest_net" + +definition + allow_all_from_to_port :: "'\::adr net \ '\::adr net \ + '\::port \ (('\,'\) packet \ unit)" where + "allow_all_from_to_port src_net dest_net d_port = + {pa. dest_port pa = d_port} \ allow_all_from_to src_net dest_net" + +definition + deny_all_from_to_port :: "'\::adr net \ '\::adr net \ '\::port \ + (('\,'\) packet \ unit)" where + "deny_all_from_to_port src_net dest_net d_port = {pa. dest_port pa = d_port} \ deny_all_from_to src_net dest_net" + +definition + allow_from_port_to :: "'\::port \ '\::adr net \ '\::adr net \ (('\,'\) packet \ unit)" +where + "allow_from_port_to port src_net dest_net = + {pa. src_port pa = port} \ allow_all_from_to src_net dest_net" + +definition + deny_from_port_to :: "'\::port \ '\::adr net \ '\::adr net \ (('\,'\) packet \ unit)" +where + "deny_from_port_to port src_net dest_net = + {pa. src_port pa = port} \ deny_all_from_to src_net dest_net" + +definition + allow_from_to_port :: "'\::port \ '\::adr net \ '\::adr net \ (('\,'\) packet \ unit)" +where + "allow_from_to_port port src_net dest_net = + {pa. dest_port pa = port} \ allow_all_from_to src_net dest_net" + +definition + deny_from_to_port :: "'\::port \ '\::adr net \ '\::adr net \ (('\,'\) packet \ unit)" +where + "deny_from_to_port port src_net dest_net = + {pa. dest_port pa = port} \ deny_all_from_to src_net dest_net" + +definition + allow_from_ports_to :: "'\::port set \ '\::adr net \ '\::adr net \ + (('\,'\) packet \ unit)" where + "allow_from_ports_to ports src_net dest_net = + {pa. src_port pa \ ports} \ allow_all_from_to src_net dest_net" + + +definition + allow_from_to_ports :: "'\::port set \ '\::adr net \ '\::adr net \ + (('\,'\) packet \ unit)" where + "allow_from_to_ports ports src_net dest_net = + {pa. dest_port pa \ ports} \ allow_all_from_to src_net dest_net" + +definition + deny_from_ports_to :: "'\::port set \ '\::adr net \ '\::adr net \ + (('\,'\) packet \ unit)" where + "deny_from_ports_to ports src_net dest_net = + {pa. src_port pa \ ports} \ deny_all_from_to src_net dest_net" + + +definition + deny_from_to_ports :: "'\::port set \ '\::adr net \ '\::adr net \ + (('\,'\) packet \ unit)" where + "deny_from_to_ports ports src_net dest_net = + {pa. dest_port pa \ ports} \ deny_all_from_to src_net dest_net" + +definition +allow_all_from_port_tos:: "'\::adr net \ ('\::port) set \ '\::adr net \ (('\,'\) packet \ unit)" +where + "allow_all_from_port_tos src_net s_port dest_net + = {pa. dest_port pa \ s_port} \ allow_all_from_to src_net dest_net" + +text{* + As before, we put all the rules into one lemma called PortCombinators to ease writing later. +*} + +lemmas PortCombinatorsCore = + allow_all_from_port_def deny_all_from_port_def allow_all_to_port_def + deny_all_to_port_def allow_all_from_to_port_def + deny_all_from_to_port_def + allow_from_ports_to_def allow_from_to_ports_def + deny_from_ports_to_def deny_from_to_ports_def + allow_all_from_port_to_def deny_all_from_port_to_def + allow_from_port_to_def allow_from_to_port_def deny_from_to_port_def + deny_from_port_to_def allow_all_from_port_tos_def + +lemmas PortCombinators = + PortCombinatorsCore PolicyCombinators + +end diff --git a/PacketFilter/Ports.thy b/PacketFilter/Ports.thy new file mode 100644 index 0000000..0f3bb3a --- /dev/null +++ b/PacketFilter/Ports.thy @@ -0,0 +1,78 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Ports *} +theory Ports +imports Main +begin + +text{* + This theory can be used if we want to specify the port numbers by names denoting their default + Integer values. If you want to use them, please add @{text Ports} to the simplifier. +*} + +definition http::int where "http = 80" + +lemma http1: "x \ 80 \ x \ http" +by (simp add: http_def) + +lemma http2: "x \ 80 \ http \ x" +by (simp add: http_def) + + +definition smtp::int where "smtp = 25" + +lemma smtp1: "x \ 25 \ x \ smtp" +by (simp add: smtp_def) + +lemma smtp2: "x \ 25 \ smtp \ x" +by (simp add: smtp_def) + + +definition ftp::int where "ftp = 21" + +lemma ftp1: "x \ 21 \ x \ ftp" +by (simp add: ftp_def) + +lemma ftp2: "x \ 21 \ ftp \ x" +by (simp add: ftp_def) + +text{* And so on for all desired port numbers. *} + +lemmas Ports = http1 http2 ftp1 ftp2 smtp1 smtp2 + +end diff --git a/PacketFilter/ProtocolPortCombinators.thy b/PacketFilter/ProtocolPortCombinators.thy new file mode 100644 index 0000000..d695979 --- /dev/null +++ b/PacketFilter/ProtocolPortCombinators.thy @@ -0,0 +1,180 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Policy Combinators with Ports and Protocols *} + +theory ProtocolPortCombinators +imports PortCombinators +begin + +text{* + This theory defines policy combinators for those network models which + have ports. They are provided in addition to the the ones defined in the + PolicyCombinators theory. + + This theory requires from the network models a definition for the two following constants: + \begin{itemize} + \item $src\_port :: ('\alpha,'\beta) packet \Rightarrow ('\gamma::port)$ + \item $dest\_port :: ('\alpha,'\beta) packet \Rightarrow ('\gamma::port)$ + \end{itemize} +*} + +definition + allow_all_from_port_prot :: "protocol \ '\::adr net \ ('\::port) \ (('\,'\) packet \ unit)" where + "allow_all_from_port_prot p src_net s_port = + {pa. dest_protocol pa = p} \ allow_all_from_port src_net s_port" + +definition + deny_all_from_port_prot :: "protocol =>'\::adr net \ '\::port \ (('\,'\) packet \ unit)" where + "deny_all_from_port_prot p src_net s_port = + {pa. dest_protocol pa = p} \ deny_all_from_port src_net s_port" + +definition + allow_all_to_port_prot :: "protocol =>'\::adr net \ '\::port \ (('\,'\) packet \ unit)" where + "allow_all_to_port_prot p dest_net d_port = + {pa. dest_protocol pa = p} \ allow_all_to_port dest_net d_port" + +definition + deny_all_to_port_prot :: "protocol =>'\::adr net \ '\::port \ (('\,'\) packet \ unit)" where + "deny_all_to_port_prot p dest_net d_port = + {pa. dest_protocol pa = p} \ deny_all_to_port dest_net d_port" + +definition +allow_all_from_port_to_prot:: "protocol =>'\::adr net \ '\::port \ '\::adr net \ (('\,'\) packet \ unit)" +where + "allow_all_from_port_to_prot p src_net s_port dest_net = + {pa. dest_protocol pa = p} \ allow_all_from_port_to src_net s_port dest_net" + +definition +deny_all_from_port_to_prot::"protocol \ '\::adr net \ '\::port \ '\::adr net \ (('\,'\) packet \ unit)" + where + "deny_all_from_port_to_prot p src_net s_port dest_net = + {pa. dest_protocol pa = p} \ deny_all_from_port_to src_net s_port dest_net" + +definition +allow_all_from_port_to_port_prot::"protocol \ '\::adr net \ '\::port \ '\::adr net \ '\::port \ + (('\,'\) packet \ unit)" where + "allow_all_from_port_to_port_prot p src_net s_port dest_net d_port = + {pa. dest_protocol pa = p} \ allow_all_from_port_to_port src_net s_port dest_net d_port " + +definition + deny_all_from_port_to_port_prot :: "protocol =>'\::adr net \ '\::port \ '\::adr net \ + '\::port \ (('\,'\) packet \ unit)" where + "deny_all_from_port_to_port_prot p src_net s_port dest_net d_port = + {pa. dest_protocol pa = p} \ deny_all_from_port_to_port src_net s_port dest_net d_port" + +definition + allow_all_from_to_port_prot :: "protocol =>'\::adr net \ '\::adr net \ + '\::port \ (('\,'\) packet \ unit)" where + "allow_all_from_to_port_prot p src_net dest_net d_port = + {pa. dest_protocol pa = p} \ allow_all_from_to_port src_net dest_net d_port " + +definition + deny_all_from_to_port_prot :: "protocol =>'\::adr net \ '\::adr net \ '\::port \ + (('\,'\) packet \ unit)" where + "deny_all_from_to_port_prot p src_net dest_net d_port = + {pa. dest_protocol pa = p} \ deny_all_from_to_port src_net dest_net d_port" + +definition + allow_from_port_to_prot :: "protocol =>'\::port \ '\::adr net \ '\::adr net \ (('\,'\) packet \ unit)" +where + "allow_from_port_to_prot p port src_net dest_net = + {pa. dest_protocol pa = p} \ allow_from_port_to port src_net dest_net" + +definition + deny_from_port_to_prot :: "protocol =>'\::port \ '\::adr net \ '\::adr net \ (('\,'\) packet \ unit)" +where + "deny_from_port_to_prot p port src_net dest_net = + {pa. dest_protocol pa = p} \ deny_from_port_to port src_net dest_net" + +definition + allow_from_to_port_prot :: "protocol =>'\::port \ '\::adr net \ '\::adr net \ (('\,'\) packet \ unit)" +where + "allow_from_to_port_prot p port src_net dest_net = + {pa. dest_protocol pa = p} \ allow_from_to_port port src_net dest_net" + +definition + deny_from_to_port_prot :: "protocol =>'\::port \ '\::adr net \ '\::adr net \ (('\,'\) packet \ unit)" +where + "deny_from_to_port_prot p port src_net dest_net = + {pa. dest_protocol pa = p} \ deny_from_to_port port src_net dest_net" + +definition + allow_from_ports_to_prot :: "protocol =>'\::port set \ '\::adr net \ '\::adr net \ + (('\,'\) packet \ unit)" where + "allow_from_ports_to_prot p ports src_net dest_net = + {pa. dest_protocol pa = p} \ allow_from_ports_to ports src_net dest_net" + + +definition + allow_from_to_ports_prot :: "protocol =>'\::port set \ '\::adr net \ '\::adr net \ + (('\,'\) packet \ unit)" where + "allow_from_to_ports_prot p ports src_net dest_net = + {pa. dest_protocol pa = p} \ allow_from_to_ports ports src_net dest_net" + +definition + deny_from_ports_to_prot :: "protocol =>'\::port set \ '\::adr net \ '\::adr net \ + (('\,'\) packet \ unit)" where + "deny_from_ports_to_prot p ports src_net dest_net = + {pa. dest_protocol pa = p} \ deny_from_ports_to ports src_net dest_net" + + +definition + deny_from_to_ports_prot :: "protocol =>'\::port set \ '\::adr net \ '\::adr net \ + (('\,'\) packet \ unit)" where + "deny_from_to_ports_prot p ports src_net dest_net = + {pa. dest_protocol pa = p} \ deny_from_to_ports ports src_net dest_net" + + +text{* As before, we put all the rules into one lemma + to ease writing later. *} + +lemmas ProtocolCombinatorsCore = + allow_all_from_port_prot_def deny_all_from_port_prot_def allow_all_to_port_prot_def + deny_all_to_port_prot_def allow_all_from_to_port_prot_def + deny_all_from_to_port_prot_def + allow_from_ports_to_prot_def allow_from_to_ports_prot_def + deny_from_ports_to_prot_def deny_from_to_ports_prot_def + allow_all_from_port_to_prot_def deny_all_from_port_to_prot_def + allow_from_port_to_prot_def allow_from_to_port_prot_def deny_from_to_port_prot_def + deny_from_port_to_prot_def + +lemmas ProtocolCombinators = PortCombinators.PortCombinators +ProtocolCombinatorsCore + + +end diff --git a/README.md b/README.md new file mode 100644 index 0000000..184815c --- /dev/null +++ b/README.md @@ -0,0 +1,31 @@ +# Formal Network Models and Their Application to Firewall Policies (UPF-Firewall) +This repository contains the development version of the (future) +[Archive of Formal Proofs (AFP)](https://www.isa-afp.org) submission +[A Formal Network Model and Their Application to Firewall Policies](https://www.isa-afp.org/entries/UPF-Firewall.shtml). + + +## Installation +This project depends on another [AFP](https://www.isa-afp.org) entry: +[The Unified Policy Framework (UPF)](https://www.isa-afp.org/entries/UPF.shtml). +Please follow the [official guidelines](https://www.isa-afp.org/using.shtml) +for installing the AFP locall. For short: +* [Download](https://www.isa-afp.org/release/afp-current.tar.gz) the complete AFP +* Extract the downloaded archive to an directory of your choice +* Let's assume the extracted archive lives in `/home/isabelle/afp`, now execute: + ``` + mkdir -p ~/.isabelle/Isabelle2016-1/etc + echo "/home/isabelle/afp" >> ~/.isabelle/Isabelle2016-1/etc/components + ``` + +## How to build +``` +isabelle build -d . UPF-Firewall +``` + +## Authors +* [Achim D. Brucker](http://www.brucker.ch/) +* Lukas Brügger +* [Burkhart Wolff](https://www.lri.fr/~wolff/) + +## License +This project is licensed under a 3-clause BSD-style license. diff --git a/ROOT b/ROOT new file mode 100644 index 0000000..1eea235 --- /dev/null +++ b/ROOT @@ -0,0 +1,11 @@ +chapter AFP + +session "UPF-Firewall" (AFP) = HOL + + description {* Formal Network Models and Their Application to Firewall Policies *} + options [timeout=600, document=pdf, document_output=document_generated, document_variants="document:outline=/proof,/ML"] + theories + "Examples/Examples" + document_files + "root.tex" + "introduction.tex" + "root.bib" diff --git a/StatefulFW/FTP.thy b/StatefulFW/FTP.thy new file mode 100644 index 0000000..c7005bc --- /dev/null +++ b/StatefulFW/FTP.thy @@ -0,0 +1,248 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* The File Transfer Prototol (ftp) *} +theory + FTP +imports + Stateful +begin + +subsubsection{* The protocol syntax *} +text{* + The File Transfer Protocol FTP is a well known example of a protocol which uses dynamic ports and + is therefore a natural choice to use as an example for our model. + + We model only a simplified version of the FTP protocol over IntegerPort addresses, still + containing all messages that matter for our purposes. It consists of the following four messages: + \begin{enumerate} + \item @{text "init"}: The client contacts the server indicating + his wish to get some data. + \item @{text "ftp_port_request p"}: The client, usually after having + received an acknowledgement of the server, indicates a port + number on which he wants to receive the data. + \item @{text "ftp_ftp_data"}: The server sends the requested data over + the new channel. There might be an arbitrary number of such + messages, including zero. + \item @{text "ftp_close"}: The client closes the connection. The + dynamic port gets closed again. + \end{enumerate} + + The content field of a packet therefore now consists of either one of those four messages or a + default one. +*} + +datatype msg = ftp_init | ftp_port_request port | ftp_data | ftp_close | ftp_other + +text{* + We now also make use of the ID field of a packet. It is used as session ID and we make the + assumption that they are all unique among different protocol runs. + + At first, we need some predicates which check if a packet is a specific FTP message and has the + correct session ID. +*} + +definition + is_init :: "id \ (adr\<^sub>i\<^sub>p, msg)packet \ bool" where + "is_init = (\ i p. (id p = i \ content p = ftp_init))" + +definition + is_ftp_port_request :: "id \ port \(adr\<^sub>i\<^sub>p, msg) packet \ bool" where + "is_ftp_port_request = (\ i port p. (id p = i \ content p = ftp_port_request port))" + +definition + is_ftp_data :: "id \ (adr\<^sub>i\<^sub>p, msg) packet \ bool" where + "is_ftp_data = (\ i p. (id p = i \ content p = ftp_data))" + +definition + is_ftp_close :: "id \ (adr\<^sub>i\<^sub>p, msg) packet \ bool" where + "is_ftp_close = (\ i p. (id p = i \ content p = ftp_close))" + +definition + port_open :: "(adr\<^sub>i\<^sub>p, msg) history \ id \ port \ bool" where + "port_open = (\ L a p. (not_before (is_ftp_close a) (is_ftp_port_request a p) L))" + +definition + is_ftp_other :: "id \ (adr\<^sub>i\<^sub>p, msg ) packet \ bool" where + "is_ftp_other = (\ i p. (id p = i \ content p = ftp_other))" + +fun are_ftp_other where + "are_ftp_other i (x#xs) = (is_ftp_other i x \ are_ftp_other i xs)" + |"are_ftp_other i [] = True" + +subsubsection{* The protocol policy specification *} +text{* + We now have to model the respective state transitions. It is important to note that state + transitions themselves allow all packets which are allowed by the policy, not only those which + are allowed by the protocol. Their only task is to change the policy. As an alternative, we could + have decided that they only allow packets which follow the protocol (e.g. come on the correct + ports), but this should in our view rather be reflected in the policy itself. + + Of course, not every message changes the policy. In such cases, we do not have to model different + cases, one is enough. In our example, only messages 2 and 4 need special transitions. The default + says that if the policy accepts the packet, it is added to the history, otherwise it is simply + dropped. The policy remains the same in both cases. +*} + +fun last_opened_port where + "last_opened_port i ((j,s,d,ftp_port_request p)#xs) = (if i=j then p else last_opened_port i xs)" +| "last_opened_port i (x#xs) = last_opened_port i xs" +| "last_opened_port x [] = undefined" + +fun FTP_STA :: "((adr\<^sub>i\<^sub>p,msg) history, adr\<^sub>i\<^sub>p, msg) FWStateTransition" +where + (* FTP_PORT_REQUEST *) + "FTP_STA ((i,s,d,ftp_port_request pr), (log, pol)) = + (if before(Not o is_ftp_close i)(is_init i) log \ + dest_port (i,s,d,ftp_port_request pr) = (21::port) + then Some (((i,s,d,ftp_port_request pr)#log, + (allow_from_to_port pr (subnet_of d) (subnet_of s)) \ pol)) + else Some (((i,s,d,ftp_port_request pr)#log,pol)))" + (* FTP_PORT_CLOSURE *) + |"FTP_STA ((i,s,d,ftp_close), (log,pol)) = + (if (\ p. port_open log i p) \ dest_port (i,s,d,ftp_close) = (21::port) + then Some ((i,s,d,ftp_close)#log, + deny_from_to_port (last_opened_port i log) (subnet_of d)(subnet_of s) \ pol) + else Some (((i,s,d,ftp_close)#log, pol)))" + + (* DEFAULT *) + |"FTP_STA (p, s) = Some (p#(fst s),snd s)" + + +fun FTP_STD :: "((adr\<^sub>i\<^sub>p,msg) history, adr\<^sub>i\<^sub>p, msg) FWStateTransition" +where "FTP_STD (p,s) = Some s" + +definition TRPolicy ::" (adr\<^sub>i\<^sub>p,msg)packet \ (adr\<^sub>i\<^sub>p,msg)history \ ((adr\<^sub>i\<^sub>p,msg)packet \ unit) + \ (unit \ (adr\<^sub>i\<^sub>p,msg)history \ ((adr\<^sub>i\<^sub>p,msg)packet \ unit))" +where "TRPolicy = ((FTP_STA,FTP_STD) \\<^sub>\ applyPolicy) o (\(x,(y,z)).((x,z),(x,(y,z))))" + +definition TRPolicy\<^sub>M\<^sub>o\<^sub>n +where "TRPolicy\<^sub>M\<^sub>o\<^sub>n = policy2MON(TRPolicy)" + +text{* If required to contain the policy in the output *} +definition TRPolicy\<^sub>M\<^sub>o\<^sub>n' +where "TRPolicy\<^sub>M\<^sub>o\<^sub>n' = policy2MON (((\(x,y,z). (z,(y,z))) o_f TRPolicy ))" + +text{* + Now we specify our test scenario in more detail. We could test: + \begin{itemize} + \item one correct FTP-Protocol run, + \item several runs after another, + \item several runs interleaved, + \item an illegal protocol run, or + \item several illegal protocol runs. + \end{itemize} + + We only do the the simplest case here: one correct protocol run. +*} + +text{* + There are four different states which are modelled as a datatype. +*} +datatype ftp_states = S0 | S1 | S2 | S3 + +text{* + The following constant is @{text "True"} for all sets which are correct FTP runs for a given + source and destination address, ID, and data-port number. +*} + + +fun + is_ftp :: "ftp_states \ adr\<^sub>i\<^sub>p \ adr\<^sub>i\<^sub>p \ id \ port \ + (adr\<^sub>i\<^sub>p,msg) history \ bool" +where + "is_ftp H c s i p [] = (H=S3)" +|"is_ftp H c s i p (x#InL) = (snd s = 21 \((\ (id,sr,de,co). (((id = i \ ( + (H=ftp_states.S2 \ sr = c \ de = s \ co = ftp_init \ is_ftp S3 c s i p InL) \ + (H=ftp_states.S1 \ sr = c \ de = s \ co = ftp_port_request p \ is_ftp S2 c s i p InL) \ + (H=ftp_states.S1 \ sr = s \ de = (fst c,p) \ co= ftp_data \ is_ftp S1 c s i p InL) \ + (H=ftp_states.S0 \ sr = c \ de = s \ co = ftp_close \ is_ftp S1 c s i p InL) ))))) x))" + + + +definition is_single_ftp_run :: "adr\<^sub>i\<^sub>p src \ adr\<^sub>i\<^sub>p dest \ id \ port \ (adr\<^sub>i\<^sub>p,msg) history set" +where "is_single_ftp_run s d i p = {x. (is_ftp S0 s d i p x)}" + +text{* + The following constant then returns a set of all the historys which denote such a normal + behaviour FTP run, again for a given source and destination address, ID, and data-port. + + The following definition returns the set of all possible interleaving of two correct FTP protocol + runs. +*} +definition + ftp_2_interleaved :: "adr\<^sub>i\<^sub>p src \ adr\<^sub>i\<^sub>p dest \ id \ port \ + adr\<^sub>i\<^sub>p src \ adr\<^sub>i\<^sub>p dest \ id \ port \ + (adr\<^sub>i\<^sub>p,msg) history set" where + "ftp_2_interleaved s1 d1 i1 p1 s2 d2 i2 p2 = + {x. (is_ftp S0 s1 d1 i1 p1 (packet_with_id x i1)) \ + (is_ftp S0 s2 d2 i2 p2 (packet_with_id x i2))}" + +lemma subnetOf_lemma: "(a::int) \ (c::int) \ \x\subnet_of (a, b::port). (c, d) \ x" +apply (rule ballI) +apply (simp add: subnet_of_int_def) +done + +lemma subnetOf_lemma2: " \x\subnet_of (a::int, b::port). (a, b) \ x" +apply (rule ballI) +apply (simp add: subnet_of_int_def) +done + +lemma subnetOf_lemma3: "(\x. x \ subnet_of (a::int, b::port))" +apply (rule exI) +apply (simp add: subnet_of_int_def) +done + +lemma subnetOf_lemma4: "\x\subnet_of (a::int, b::port). (a, c::port) \ x" +apply (rule bexI) +apply (simp_all add: subnet_of_int_def) +done + +lemma port_open_lemma: "\ (Ex (port_open [] (x::port)))" +apply (simp add: port_open_def) +done + +lemmas FTPLemmas = TRPolicy_def applyPolicy_def policy2MON_def + Let_def in_subnet_def src_def + dest_def subnet_of_int_def + is_init_def p_accept_def port_open_def is_ftp_data_def is_ftp_close_def + is_ftp_port_request_def content_def PortCombinators + exI subnetOf_lemma subnetOf_lemma2 subnetOf_lemma3 subnetOf_lemma4 + NetworkCore.id_def adr\<^sub>i\<^sub>pLemmas port_open_lemma + bind_SE_def unit_SE_def valid_SE_def +end + diff --git a/StatefulFW/FTPVOIP.thy b/StatefulFW/FTPVOIP.thy new file mode 100644 index 0000000..bcd3ded --- /dev/null +++ b/StatefulFW/FTPVOIP.thy @@ -0,0 +1,314 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* FTP and VoIP Protocol *} +theory + FTPVOIP +imports + FTP_WithPolicy VOIP +begin + +datatype ftpvoip = ARQ + | ACF int + | ARJ + | Setup port + | Connect port + | Stream + | Fin + | ftp_init + | ftp_port_request port + | ftp_data + | ftp_close + | other + + +text{* + We now also make use of the ID field of a packet. It is used as session ID and we make the + assumption that they are all unique among different protocol runs. + + At first, we need some predicates which check if a packet is a specific FTP message and has + the correct session ID. +*} + +definition + FTPVOIP_is_init :: "id \ (adr\<^sub>i\<^sub>p, ftpvoip ) packet \ bool" where + "FTPVOIP_is_init = (\ i p. (id p = i \ content p = ftp_init))" + +definition + FTPVOIP_is_port_request :: "id \ port \(adr\<^sub>i\<^sub>p, ftpvoip) packet \ bool" where + "FTPVOIP_is_port_request = (\ i port p. (id p = i \ content p = ftp_port_request port))" + +definition + FTPVOIP_is_data :: "id \ (adr\<^sub>i\<^sub>p, ftpvoip) packet \ bool" where + "FTPVOIP_is_data = (\ i p. (id p = i \ content p = ftp_data))" + +definition + FTPVOIP_is_close :: "id \ (adr\<^sub>i\<^sub>p, ftpvoip) packet \ bool" where + "FTPVOIP_is_close = (\ i p. (id p = i \ content p = ftp_close))" + +definition + FTPVOIP_port_open :: "(adr\<^sub>i\<^sub>p, ftpvoip) history \ id \ port \ bool" where + "FTPVOIP_port_open = (\ L a p. (not_before (FTPVOIP_is_close a) (FTPVOIP_is_port_request a p) L))" + +definition + FTPVOIP_is_other :: "id \ (adr\<^sub>i\<^sub>p, ftpvoip ) packet \ bool" where + "FTPVOIP_is_other = (\ i p. (id p = i \ content p = other))" + +fun FTPVOIP_are_other where + "FTPVOIP_are_other i (x#xs) = (FTPVOIP_is_other i x \ FTPVOIP_are_other i xs)" + |"FTPVOIP_are_other i [] = True" + +fun last_opened_port where + "last_opened_port i ((j,s,d,ftp_port_request p)#xs) = (if i=j then p else last_opened_port i xs)" +| "last_opened_port i (x#xs) = last_opened_port i xs" +| "last_opened_port x [] = undefined" + +fun FTPVOIP_FTP_STA :: + "((adr\<^sub>i\<^sub>p, ftpvoip) history, adr\<^sub>i\<^sub>p, ftpvoip) FWStateTransition" +where +(* FTP_PORT_REQUEST *) + "FTPVOIP_FTP_STA ((i,s,d,ftp_port_request pr), (InL, policy)) = + (if not_before (FTPVOIP_is_close i) (FTPVOIP_is_init i) InL \ + dest_port (i,s,d,ftp_port_request pr) = (21::port) then + Some (((i,s,d,ftp_port_request pr)#InL, policy ++ + (allow_from_to_port pr (subnet_of d) (subnet_of s)))) + else Some (((i,s,d,ftp_port_request pr)#InL,policy)))" + + |"FTPVOIP_FTP_STA ((i,s,d,ftp_close), (InL,policy)) = + (if (\ p. FTPVOIP_port_open InL i p) \ dest_port (i,s,d,ftp_close) = (21::port) + then Some ((i,s,d,ftp_close)#InL, policy ++ + deny_from_to_port (last_opened_port i InL) (subnet_of d) (subnet_of s)) + else Some (((i,s,d,ftp_close)#InL, policy)))" + +(* DEFAULT *) + |"FTPVOIP_FTP_STA (p, s) = Some (p#(fst s),snd s)" + + +fun FTPVOIP_FTP_STD :: "((adr\<^sub>i\<^sub>p, ftpvoip) history, adr\<^sub>i\<^sub>p, ftpvoip) FWStateTransition" +where"FTPVOIP_FTP_STD (p,s) = Some s" + + + +definition + FTPVOIP_is_arq :: "NetworkCore.id \ ('a::adr, ftpvoip) packet \ bool" where + "FTPVOIP_is_arq i p = (NetworkCore.id p = i \ content p = ARQ)" + +definition + FTPVOIP_is_fin :: "id \ ('a::adr, ftpvoip) packet \ bool" where + "FTPVOIP_is_fin i p = (id p = i \ content p = Fin)" + +definition + FTPVOIP_is_connect :: "id \ port \ ('a::adr, ftpvoip) packet \ bool" where + "FTPVOIP_is_connect i port p = (id p = i \ content p = Connect port)" + +definition + FTPVOIP_is_setup :: "id \ port \ ('a::adr, ftpvoip) packet \ bool" where + "FTPVOIP_is_setup i port p = (id p = i \ content p = Setup port)" + + +text{* + We need also an operator @{text ports_open} to get access to the two + dynamic ports. +*} +definition + FTPVOIP_ports_open :: "id \ port \ port \ (adr\<^sub>i\<^sub>p, ftpvoip) history \ bool" where + "FTPVOIP_ports_open i p L = ((not_before (FTPVOIP_is_fin i) (FTPVOIP_is_setup i (fst p)) L) \ + not_before (FTPVOIP_is_fin i) (FTPVOIP_is_connect i (snd p)) L)" + +text{* + As we do not know which entity closes the connection, we define an + operator which checks if the closer is the caller. +*} +fun + FTPVOIP_src_is_initiator :: "id \ adr\<^sub>i\<^sub>p \ (adr\<^sub>i\<^sub>p,ftpvoip) history \ bool" where + "FTPVOIP_src_is_initiator i a [] = False" +|"FTPVOIP_src_is_initiator i a (p#S) = (((id p = i) \ + (\ port. content p = Setup port) \ + ((fst (src p) = fst a))) \ + (FTPVOIP_src_is_initiator i a S))" + +definition FTPVOIP_subnet_of_adr :: "int \ adr\<^sub>i\<^sub>p net" where + "FTPVOIP_subnet_of_adr x = {{(a,b). a = x}}" + +fun FTPVOIP_VOIP_STA :: + "((adr\<^sub>i\<^sub>p, ftpvoip) history, adr\<^sub>i\<^sub>p, ftpvoip) FWStateTransition" +where + "FTPVOIP_VOIP_STA ((a,c,d,ARQ), (InL, policy)) = + Some (((a,c,d, ARQ)#InL, + (allow_from_to_port (1719::port)(subnet_of d) (subnet_of c)) \ policy))" + +|"FTPVOIP_VOIP_STA ((a,c,d,ARJ), (InL, policy)) = + (if (not_before (FTPVOIP_is_fin a) (FTPVOIP_is_arq a) InL) + then Some (((a,c,d,ARJ)#InL, + deny_from_to_port (14::port) (subnet_of c) (subnet_of d) \ policy)) + else Some (((a,c,d,ARJ)#InL,policy)))" + +|"FTPVOIP_VOIP_STA ((a,c,d,ACF callee), (InL, policy)) = + Some (((a,c,d,ACF callee)#InL, + allow_from_to_port (1720::port) (subnet_of_adr callee) (subnet_of d) \ + allow_from_to_port (1720::port) (subnet_of d) (subnet_of_adr callee) \ + deny_from_to_port (1719::port) (subnet_of d) (subnet_of c) \ + policy))" + +|"FTPVOIP_VOIP_STA ((a,c,d, Setup port), (InL, policy)) = + Some (((a,c,d,Setup port)#InL, + allow_from_to_port port (subnet_of d) (subnet_of c) \ policy))" + + |"FTPVOIP_VOIP_STA ((a,c,d, ftpvoip.Connect port), (InL, policy)) = + Some (((a,c,d,ftpvoip.Connect port)#InL, + allow_from_to_port port (subnet_of d) (subnet_of c) \ policy))" + +|"FTPVOIP_VOIP_STA ((a,c,d,Fin), (InL,policy)) = + (if \ p1 p2. FTPVOIP_ports_open a (p1,p2) InL then ( + (if FTPVOIP_src_is_initiator a c InL + then (Some (((a,c,d,Fin)#InL, +(deny_from_to_port (1720::int) (subnet_of c) (subnet_of d) ) \ +(deny_from_to_port (snd (SOME p. FTPVOIP_ports_open a p InL)) + (subnet_of c) (subnet_of d)) \ +(deny_from_to_port (fst (SOME p. FTPVOIP_ports_open a p InL)) + (subnet_of d) (subnet_of c)) \ policy))) + + else (Some (((a,c,d,Fin)#InL, +(deny_from_to_port (1720::int) (subnet_of c) (subnet_of d) ) \ +(deny_from_to_port (fst (SOME p. FTPVOIP_ports_open a p InL)) + (subnet_of c) (subnet_of d)) \ +(deny_from_to_port (snd (SOME p. FTPVOIP_ports_open a p InL)) + (subnet_of d) (subnet_of c)) \ policy))))) + + else + (Some (((a,c,d,Fin)#InL,policy))))" + + +(* The default action for all other packets *) +| "FTPVOIP_VOIP_STA (p, (InL, policy)) = + Some ((p#InL,policy)) " + +fun FTPVOIP_VOIP_STD :: + "((adr\<^sub>i\<^sub>p, ftpvoip) history, adr\<^sub>i\<^sub>p, ftpvoip) FWStateTransition" +where + "FTPVOIP_VOIP_STD (p,s) = Some s" + +definition FTP_VOIP_STA :: "((adr\<^sub>i\<^sub>p, ftpvoip) history, adr\<^sub>i\<^sub>p, ftpvoip) FWStateTransition" +where + "FTP_VOIP_STA = ((\(x,x). Some x) \\<^sub>m ((FTPVOIP_FTP_STA \\<^sub>S FTPVOIP_VOIP_STA o (\ (p,x). (p,x,x)))))" + + +definition FTP_VOIP_STD :: "((adr\<^sub>i\<^sub>p, ftpvoip) history, adr\<^sub>i\<^sub>p, ftpvoip) FWStateTransition" +where + "FTP_VOIP_STD = (\(x,x). Some x) \\<^sub>m ((FTPVOIP_FTP_STD \\<^sub>S FTPVOIP_VOIP_STD o (\ (p,x). (p,x,x))))" + +definition FTPVOIP_TRPolicy where + "FTPVOIP_TRPolicy = policy2MON ( + (((FTP_VOIP_STA,FTP_VOIP_STD) \\<^sub>\ applyPolicy) o (\ (x,(y,z)). ((x,z),(x,(y,z))))))" + +lemmas FTPVOIP_ST_simps = Let_def in_subnet_def src_def dest_def +subnet_of_int_def id_def FTPVOIP_port_open_def + FTPVOIP_is_init_def FTPVOIP_is_data_def FTPVOIP_is_port_request_def FTPVOIP_is_close_def p_accept_def content_def PortCombinators exI + NetworkCore.id_def adr\<^sub>i\<^sub>pLemmas + +datatype ftp_states2 = FS0 | FS1 | FS2 | FS3 +datatype voip_states2 = V0 | V1 | V2 | V3 | V4 | V5 + +text{* + The constant @{text "is_voip"} checks if a trace corresponds to a + legal VoIP protocol, given the IP-addresses of the three entities, + the ID, and the two dynamic ports. +*} + +fun FTPVOIP_is_voip :: "voip_states2 \ address \ address \ address \ id \ port \ + port \ (adr\<^sub>i\<^sub>p, ftpvoip) history \ bool" +where + "FTPVOIP_is_voip H s d g i p1 p2 [] = (H = V5)" +|"FTPVOIP_is_voip H s d g i p1 p2 (x#InL) = + (((\ (id,sr,de,co). + (((id = i \ +(H = V4 \ ((sr = (s,1719) \ de = (g,1719) \ co = ARQ \ + FTPVOIP_is_voip V5 s d g i p1 p2 InL))) \ +(H = V0 \ sr = (g,1719) \ de = (s,1719) \ co = ARJ \ + FTPVOIP_is_voip V4 s d g i p1 p2 InL) \ +(H = V3 \ sr = (g,1719) \ de = (s,1719) \ co = ACF d \ + FTPVOIP_is_voip V4 s d g i p1 p2 InL) \ +(H = V2 \ sr = (s,1720) \ de = (d,1720) \ co = Setup p1 \ + FTPVOIP_is_voip V3 s d g i p1 p2 InL) \ +(H = V1 \ sr = (d,1720) \ de = (s,1720) \ co = Connect p2 \ + FTPVOIP_is_voip V2 s d g i p1 p2 InL) \ +(H = V1 \ sr = (s,p1) \ de = (d,p2) \ co = Stream \ + FTPVOIP_is_voip V1 s d g i p1 p2 InL) \ +(H = V1 \ sr = (d,p2) \ de = (s,p1) \ co = Stream \ + FTPVOIP_is_voip V1 s d g i p1 p2 InL) \ +(H = V0 \ sr = (d,1720) \ de = (s,1720) \ co = Fin \ + FTPVOIP_is_voip V1 s d g i p1 p2 InL) \ +(H = V0 \ sr = (s,1720) \ de = (d,1720) \ co = Fin \ + FTPVOIP_is_voip V1 s d g i p1 p2 InL)))))) x)" + + +text{* + Finally, @{text "NB_voip"} returns the set of protocol traces which + correspond to a correct protocol run given the three addresses, the + ID, and the two dynamic ports. +*} +definition + FTPVOIP_NB_voip :: "address \ address \ address \ id \ port \ port \ + (adr\<^sub>i\<^sub>p, ftpvoip) history set" where + "FTPVOIP_NB_voip s d g i p1 p2= {x. (FTPVOIP_is_voip V0 s d g i p1 p2 x)}" + +fun + FTPVOIP_is_ftp :: "ftp_states2 \ adr\<^sub>i\<^sub>p \ adr\<^sub>i\<^sub>p \ id \ port \ + (adr\<^sub>i\<^sub>p, ftpvoip) history \ bool" +where + "FTPVOIP_is_ftp H c s i p [] = (H=FS3)" +|"FTPVOIP_is_ftp H c s i p (x#InL) = (snd s = 21 \((\ (id,sr,de,co). (((id = i \ ( + (H=FS2 \ sr = c \ de = s \ co = ftp_init \ FTPVOIP_is_ftp FS3 c s i p InL) \ + (H=FS1 \ sr = c \ de = s \ co = ftp_port_request p \ FTPVOIP_is_ftp FS2 c s i p InL) \ + (H=FS1 \ sr = s \ de = (fst c,p) \ co= ftp_data \ FTPVOIP_is_ftp FS1 c s i p InL) \ + (H=FS0 \ sr = c \ de = s \ co = ftp_close \ FTPVOIP_is_ftp FS1 c s i p InL) ))))) x))" + +definition + FTPVOIP_NB_ftp :: "adr\<^sub>i\<^sub>p src \ adr\<^sub>i\<^sub>p dest \ id \ port \ (adr\<^sub>i\<^sub>p, ftpvoip) history set" where + "FTPVOIP_NB_ftp s d i p = {x. (FTPVOIP_is_ftp FS0 s d i p x)}" + +definition + ftp_voip_interleaved :: "adr\<^sub>i\<^sub>p src \ adr\<^sub>i\<^sub>p dest \ id \ port \ + address \ address \ address \ id \ port \ port \ + (adr\<^sub>i\<^sub>p, ftpvoip) history set" + +where + "ftp_voip_interleaved s1 d1 i1 p1 vs vd vg vi vp1 vp2 = + {x. (FTPVOIP_is_ftp FS0 s1 d1 i1 p1 (packet_with_id x i1)) \ + (FTPVOIP_is_voip V0 vs vd vg vi vp1 vp2 (packet_with_id x vi))}" + +end diff --git a/StatefulFW/FTP_WithPolicy.thy b/StatefulFW/FTP_WithPolicy.thy new file mode 100644 index 0000000..c828a57 --- /dev/null +++ b/StatefulFW/FTP_WithPolicy.thy @@ -0,0 +1,77 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* FTP enriched with a security policy *} +theory + FTP_WithPolicy +imports + FTP +begin + +text{* FTP where the policy is part of the output. *} + +definition POL :: "'a \ 'a" where "POL x = x" + +text{* Variant 2 takes the policy into the output *} +fun FTP_STP :: + "((id \ port), adr\<^sub>i\<^sub>p, msg) FWStateTransitionP" +where +(* FTP_PORT_REQUEST *) + "FTP_STP (i,s,d,ftp_port_request pr) (ports, policy) = + (if p_accept (i,s,d,ftp_port_request pr) policy then + Some (allow (POL ((allow_from_to_port pr (subnet_of d) (subnet_of s)) \ policy)), + ( (ports(i\pr)),(allow_from_to_port pr (subnet_of d) (subnet_of s)) + \ policy)) + else (Some (deny (POL policy),(ports,policy))))" + +(* FTP_CLOSE *) + |"FTP_STP (i,s,d,ftp_close) (ports,policy) = + (if (p_accept (i,s,d,ftp_close) policy) then + case ports i of + Some pr \ + Some(allow (POL (deny_from_to_port pr (subnet_of d) (subnet_of s) \ policy)), + ports(i:=None), + deny_from_to_port pr (subnet_of d) (subnet_of s) \ policy) + |None \Some(allow (POL policy), ports, policy) + else Some (deny (POL policy), ports, policy))" +(* DEFAULT *) + |"FTP_STP p x = (if p_accept p (snd x) + then Some (allow (POL (snd x)),((fst x),snd x)) + else Some (deny (POL (snd x)),(fst x,snd x)))" +end + + diff --git a/StatefulFW/LTL_alike.thy b/StatefulFW/LTL_alike.thy new file mode 100644 index 0000000..681ca87 --- /dev/null +++ b/StatefulFW/LTL_alike.thy @@ -0,0 +1,160 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Termporal Combinators *} +theory LTL_alike +imports Main +begin + +text{* + In the following, we present a small embbeding of temporal combinators, that may help to + formulate typical temporal properties in traces and protocols concisely. It is based on + \emph{finite} lists, therefore the properties of this logic are not fully compatible with + LTL based on Kripke-structures. For the purpose of this demonstration, however, the difference + does not matter. +*} + +fun nxt :: "('\ list \ bool) \ '\ list \ bool" ("N") +where + "nxt p [] = False" +| "nxt p (a # S) = (p S)" + +text{* Predicate $p$ holds at first position. *} + +fun atom :: "('\ \ bool) \ '\ list \ bool" ("\_\") +where + "atom p [] = False" +| "atom p (a # S) = (p a)" + +lemma holds_mono : "\q\ s \ \q\ (s @ t)" +by(cases s,simp_all) + + +fun always :: "('\ list \ bool) \ '\ list \ bool" ("\") +where + "always p [] = True" +| "always p (a # S) = ((p (a # S)) \ always p S)" + +text{* + Always is a generalization of the \verb+list_all+ combinator from the List-library; if arguing + locally, this paves the way to a wealth of library lemmas. +*} +lemma always_is_listall : "(\ \p\) (t) = list_all (p) (t)" +by(induct t, simp_all) + +fun eventually :: "('\ list \ bool) \ '\ list \ bool" ("\") +where + "eventually p [] = False" +| "eventually p (a # S) = ((p (a # S)) \ eventually p S)" + + +text{* + Eventually is a generalization of the \verb+list_ex+ combinator from the List-library; if arguing + locally, this paves the way to a wealth of library lemmas. +*} +lemma eventually_is_listex : "(\ \p\) (t) = list_ex (p) (t)" +by(induct t, simp_all) + +text{* + The next two constants will help us later in defining the state transitions. The constant + @{text "before"} is @{text "True"} if for all elements which appear before the first element + for which @{text q} holds, @{text p} must hold. +*} + +fun before :: "('\ \ bool) \ ('\ \ bool) \ '\ list \ bool" +where + "before p q [] = False" +| "before p q (a # S) = (q a \ (p a \ (before p q S)))" + +text{* + Analogously there is an operator @{text not_before} which returns + @{text "True"} if for all elements which appear before the first + element for which @{text q} holds, @{text p} must not hold. +*} + +fun not_before :: "('\ \ bool) \ ('\ \ bool) \ '\ list \ bool" +where + "not_before p q [] = False" +| "not_before p q (a # S) = (q a \ (\ (p a) \ (not_before p q S)))" + + +lemma not_before_superfluous: +"not_before p q = before (Not o p) q" +by(rule ext,induct_tac "x", simp_all) + +text{*General "before":*} +fun until :: "('\ list \ bool) \ ('\ list \ bool) \ '\ list \ bool" (infixl "U" 66) +where + "until p q [] = False" +| "until p q (a # S) = (\ s t. a # S= s @ t \ p s \ q t)" + +text{* This leads to this amazingly tricky proof:*} +lemma before_vs_until: +"(before p q) = ((\\p\) U \q\)" +proof - + have A:"\a. q a \ (\s t. [a] = s @ t \ \ \p\ s \ \q\ t)" + apply(rule_tac x="[]" in exI) + apply(rule_tac x="[a]" in exI, simp) + done + have B:"\a. (\s t. [a] = s @ t \ \ \p\ s \ \q\ t) \ q a" + apply auto + apply(case_tac "t=[]", auto simp:List.neq_Nil_conv) + apply(case_tac "s=[]", auto simp:List.neq_Nil_conv) + done + have C:"\a aa list.(q a \ p a \ (\s t. aa # list = s @ t \ \ \p\ s \ \q\ t)) + \ (\s t. a # aa # list = s @ t \ \ \p\ s \ \q\ t)" + apply auto + apply(rule_tac x="[]" in exI) + apply(rule_tac x="a # aa # list" in exI, simp) + apply(rule_tac x="a # s" in exI) + apply(rule_tac x="t" in exI,simp) + done + have D:"\a aa list.(\s t. a # aa # list = s @ t \ \ \p\ s \ \q\ t) + \ (q a \ p a \ (\s t. aa # list = s @ t \ \ \p\ s \ \q\ t))" + apply auto + apply(case_tac "s", auto simp:List.neq_Nil_conv) + apply(case_tac "s", auto simp:List.neq_Nil_conv) + done + show ?thesis + apply(rule ext,induct_tac "x", simp, + case_tac "list",simp_all) + apply(rule iffI,erule A, erule B) + apply(rule iffI,erule C, erule D) + done +qed + +end diff --git a/StatefulFW/Stateful.thy b/StatefulFW/Stateful.thy new file mode 100644 index 0000000..86a2b40 --- /dev/null +++ b/StatefulFW/Stateful.thy @@ -0,0 +1,106 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +section {* Stateful Protocols *} +theory + Stateful +imports + "../PacketFilter/PacketFilter" + LTL_alike +begin + +text{* + The simple system of a stateless packet filter is not enough to model all common real-world + scenarios. Some protocols need further actions in order to be secured. A prominent example is + the File Transfer Protocol (FTP), which is a popular means to move files across the Internet. + It behaves quite differently from most other application layer protocols as it uses a two-way + connection establishment which opens a dynamic port. A stateless packet filter would only have + the possibility to either always open all the possible dynamic ports or not to allow that + protocol at all. Neither of these options is satisfactory. In the first case, all ports above + 1024 would have to be opened which introduces a big security hole in the system, in the second + case users wouldn't be very happy. A firewall which tracks the state of the TCP connections on + a system does not help here either, as the opening and closing of the ports takes place on the + application layer. Therefore, a firewall needs to have some knowledge of the application + protocols being run and track the states of these protocols. We next model this behaviour. + + The key point of our model is the idea that a policy remains the same as before: a mapping from + packet to packet out. We still specify for every packet, based on its source and destination + address, the expected action. The only thing that changes now is that this mapping is allowed + to change over time. This indicates that our test data will not consist of single packets but + rather of sequences thereof. + + At first we hence need a state. It is a tuple from some memory to be refined later and the + current policy. +*} + +type_synonym ('\,'\,'\) FWState = "'\ \ (('\,'\) packet \ unit)" + + + +text{* Having a state, we need of course some state transitions. Such + a transition can happen every time a new packet arrives. State + transitions can be modelled using a state-exception monad. + We provide two types of firewall monads: one *} + + +type_synonym ('\,'\,'\) FWStateTransitionP = + "('\,'\) packet \ ((('\,'\) packet \ unit) decision, ('\,'\,'\) FWState) MON\<^sub>S\<^sub>E" + +type_synonym ('\,'\,'\) FWStateTransition = + "(('\,'\) packet \ ('\,'\,'\) FWState) \ ('\,'\,'\) FWState" + +text{* The memory could be modelled as a list of accepted packets. *} +type_synonym ('\,'\) history = "('\,'\) packet list" + + +fun packet_with_id where + "packet_with_id [] i = []" +|"packet_with_id (x#xs) i = (if id x = i then (x#(packet_with_id xs i)) else (packet_with_id xs i))" + + +fun ids1 where + "ids1 i (x#xs) = (id x = i \ ids1 i xs)" +|"ids1 i [] = True" + +fun ids where + "ids a (x#xs) = (NetworkCore.id x \ a \ ids a xs)" +|"ids a [] = True" + +definition applyPolicy:: "('i \ ('i \ 'o)) \ 'o" +where "applyPolicy = (\ (x,z). z x)" + +end diff --git a/StatefulFW/StatefulFW.thy b/StatefulFW/StatefulFW.thy new file mode 100644 index 0000000..42235cf --- /dev/null +++ b/StatefulFW/StatefulFW.thy @@ -0,0 +1,44 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* Stateful Network Protocols *} +theory + StatefulFW +imports + FTPVOIP +begin +end diff --git a/StatefulFW/VOIP.thy b/StatefulFW/VOIP.thy new file mode 100644 index 0000000..5f523a5 --- /dev/null +++ b/StatefulFW/VOIP.thy @@ -0,0 +1,321 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +subsection {* A simple voice-over-ip model *} +theory VOIP +imports Stateful +begin + +text{* + + After the FTP-Protocol which was rather simple we show the strength + of the model with a more current and especially much more + complicated example, namely Voice over IP (VoIP). VoIP is + standardized by the ITU-T under the name H.323, which can be seen as + an "umbrella standard" which aggregates standards for multimedia + conferencing over packet-based networks (for a good overview of the + protocol suite, see \cite{switch_basic}). H.323 poses many problems + to firewalls. These problems include (taken from~\cite{vtel}): + \begin{itemize} + \item An H.323 call is made up of many different simultaneous + connections. + \item Most connections are made to dynamic ports. + \item The addresses and port numbers are exchanged within + the data stream of the next higher connection. + \item Calls can be initiated from outside the firewall. + \end{itemize} + +% \begin{figure} +% \centering +% \includegraphics[scale=0.4]{voip} +% \caption {The modelled VoIP-Protocol} +% \label{voip} +% \end{figure} + + Again we only consider a simplified VoIP scenario with the following + seven messages which are grouped into four subprotocols (see Figure + \ref{voip}): + \begin{itemize} + \item Registration and Admission (H.225, port 1719): The caller + contacts its gatekeeper with a call request. The gatekeeper + either rejects or confirms the request, returning the + address of the callee in the latter case. + + \begin{itemize} + \item Admission Request (ARQ) + \item Admission Reject (ARJ) + \item Admission Confirm (ACF) @{text "'a"} + \end{itemize} + \item Call Signaling (Q.931, port 1720) The caller and the callee + agree on the dynamic ports over which the call will take + place. + \begin{itemize} + \item Setup @{text "port"} + \item Connect @{text "port"} + \end{itemize} + \item Stream (dynamic ports). The call itself. In reality, several + connections are used here. + \item Fin (port 1720). + \end{itemize} + + + The two main differences to FTP are: + \begin{itemize} + \item In VoIP, we deal with three different entities: the caller, + the callee, and the gatekeeper. + \item We do not know in advance which entity will close the + connection. + \end{itemize} + + We model the protocol as seen from a firewall at the caller, namely + we are not interested in the messages from the callee to its + gatekeeper. Incoming calls are not modelled either, they would + require a different set of state transitions. +*} + + +text{* + The content of a packet now consists of one of the seven messages or + a default one. It is parameterized with the type of the address that + the gatekeeper returns. +*} + + +datatype 'a voip_msg = ARQ + | ACF 'a + | ARJ + | Setup port + | Connect port + | Stream + | Fin + | other +text{* + As before, we need operators which check if a packet contains a + specific content and ID, respectively if such a packet has appeared + in the trace. +*} + + +definition + is_arq :: "NetworkCore.id \ ('a::adr, 'b voip_msg) packet \ bool" where + "is_arq i p = (NetworkCore.id p = i \ content p = ARQ)" + + +definition + is_fin :: "id \ ('a::adr, 'b voip_msg) packet \ bool" where + "is_fin i p = (id p = i \ content p = Fin)" + +definition + is_connect :: "id \ port \ ('a::adr, 'b voip_msg) packet \ bool" where + "is_connect i port p = (id p = i \ content p = Connect port)" + +definition + is_setup :: "id \ port \ ('a::adr, 'b voip_msg) packet \ bool" where + "is_setup i port p = (id p = i \ content p = Setup port)" + + +text{* + We need also an operator @{text ports_open} to get access to the two + dynamic ports. +*} +definition + ports_open :: "id \ port \ port \ (adr\<^sub>i\<^sub>p, 'a voip_msg) history \ bool" where + "ports_open i p L = ((not_before (is_fin i) (is_setup i (fst p)) L) \ + not_before (is_fin i) (is_connect i (snd p)) L)" + + + + +text{* + As we do not know which entity closes the connection, we define an + operator which checks if the closer is the caller. +*} +fun + src_is_initiator :: "id \ adr\<^sub>i\<^sub>p \ (adr\<^sub>i\<^sub>p,'b voip_msg) history \ bool" where + "src_is_initiator i a [] = False" +|"src_is_initiator i a (p#S) = (((id p = i) \ + (\ port. content p = Setup port) \ + ((fst (src p) = fst a))) \ + (src_is_initiator i a S))" + + + +text{* + The first state transition is for those messages which do not change + the policy. In this scenario, this only happens for the Stream + messages. +*} + +definition subnet_of_adr where + "subnet_of_adr x = {{(a,b). a = x}}" + +fun VOIP_STA :: + "((adr\<^sub>i\<^sub>p,address voip_msg) history, adr\<^sub>i\<^sub>p, address voip_msg) FWStateTransition" +where + +(* + If the policy accepts the ARQ packet, we have to assure that we + will accept the returning packet of the gatekeeper (on port 1719) +*) + "VOIP_STA ((a,c,d,ARQ), (InL, policy)) = + Some (((a,c,d, ARQ)#InL, + (allow_from_to_port (1719::port)(subnet_of d) (subnet_of c)) \ policy))" +(* + And if the gatekeeper answers, no matter if it's a good or bad + answer, we can close the channel again. If the answer was positive + (ACF), we allow the caller to contact the callee and get contacted + by him over port 1720. +*) +|"VOIP_STA ((a,c,d,ARJ), (InL, policy)) = + (if (not_before (is_fin a) (is_arq a) InL) + then Some (((a,c,d,ARJ)#InL, + deny_from_to_port (14::port) (subnet_of c) (subnet_of d) \ policy)) + else Some (((a,c,d,ARJ)#InL,policy)))" + +|"VOIP_STA ((a,c,d,ACF callee), (InL, policy)) = + Some (((a,c,d,ACF callee)#InL, + allow_from_to_port (1720::port) (subnet_of_adr callee) (subnet_of d) \ + allow_from_to_port (1720::port) (subnet_of d) (subnet_of_adr callee) \ + deny_from_to_port (1719::port) (subnet_of d) (subnet_of c) \ + policy))" + +(* + In the Setup message, the caller specifies the port on which he + wants the connection to take place so we need to open it for + incoming VoIP messages. +*) + +|"VOIP_STA ((a,c,d, Setup port), (InL, policy)) = + Some (((a,c,d,Setup port)#InL, + allow_from_to_port port (subnet_of d) (subnet_of c) \ policy))" + +(* + The same happens after the Connect message of the callee. +*) + |"VOIP_STA ((a,c,d, Connect port), (InL, policy)) = + Some (((a,c,d,Connect port)#InL, + allow_from_to_port port (subnet_of d) (subnet_of c) \ policy))" + +(* + In the FIN message, we have to close all the previously opened + ports. This works as in the FTP close message, only a little bit + more complicated. +*) +|"VOIP_STA ((a,c,d,Fin), (InL,policy)) = + (if \ p1 p2. ports_open a (p1,p2) InL then ( + (if src_is_initiator a c InL + then (Some (((a,c,d,Fin)#InL, +(deny_from_to_port (1720::int) (subnet_of c) (subnet_of d) ) \ +(deny_from_to_port (snd (SOME p. ports_open a p InL)) + (subnet_of c) (subnet_of d)) \ +(deny_from_to_port (fst (SOME p. ports_open a p InL)) + (subnet_of d) (subnet_of c)) \ policy))) + + else (Some (((a,c,d,Fin)#InL, +(deny_from_to_port (1720::int) (subnet_of c) (subnet_of d) ) \ +(deny_from_to_port (fst (SOME p. ports_open a p InL)) + (subnet_of c) (subnet_of d)) \ +(deny_from_to_port (snd (SOME p. ports_open a p InL)) + (subnet_of d) (subnet_of c)) \ policy))))) + + else + (Some (((a,c,d,Fin)#InL,policy))))" + + +(* The default action for all other packets *) +| "VOIP_STA (p, (InL, policy)) = + Some ((p#InL,policy)) " + +fun VOIP_STD where + "VOIP_STD (p,s) = Some s" + + +definition VOIP_TRPolicy where + "VOIP_TRPolicy = policy2MON ( + ((VOIP_STA,VOIP_STD) \\<^sub>\ applyPolicy) o (\ (x,(y,z)). ((x,z),(x,(y,z)))))" + +text{* + For a full protocol run, six states are needed. +*} +datatype voip_states = S0 | S1 | S2 | S3 | S4 | S5 + + + +text{* + The constant @{text "is_voip"} checks if a trace corresponds to a + legal VoIP protocol, given the IP-addresses of the three entities, + the ID, and the two dynamic ports. +*} + +fun is_voip :: "voip_states \ address \ address \ address \ id \ port \ + port \ (adr\<^sub>i\<^sub>p, address voip_msg) history \ bool" +where + "is_voip H s d g i p1 p2 [] = (H = S5)" +|"is_voip H s d g i p1 p2 (x#InL) = + (((\ (id,sr,de,co). + (((id = i \ +(H = S4 \ ((sr = (s,1719) \ de = (g,1719) \ co = ARQ \ + is_voip S5 s d g i p1 p2 InL))) \ +(H = S0 \ sr = (g,1719) \ de = (s,1719) \ co = ARJ \ + is_voip S4 s d g i p1 p2 InL) \ +(H = S3 \ sr = (g,1719) \ de = (s,1719) \ co = ACF d \ + is_voip S4 s d g i p1 p2 InL) \ +(H = S2 \ sr = (s,1720) \ de = (d,1720) \ co = Setup p1 \ + is_voip S3 s d g i p1 p2 InL) \ +(H = S1 \ sr = (d,1720) \ de = (s,1720) \ co = Connect p2 \ + is_voip S2 s d g i p1 p2 InL) \ +(H = S1 \ sr = (s,p1) \ de = (d,p2) \ co = Stream \ + is_voip S1 s d g i p1 p2 InL) \ +(H = S1 \ sr = (d,p2) \ de = (s,p1) \ co = Stream \ + is_voip S1 s d g i p1 p2 InL) \ +(H = S0 \ sr = (d,1720) \ de = (s,1720) \ co = Fin \ + is_voip S1 s d g i p1 p2 InL) \ +(H = S0 \ sr = (s,1720) \ de = (d,1720) \ co = Fin \ + is_voip S1 s d g i p1 p2 InL)))))) x)" + + +text{* + Finally, @{text "NB_voip"} returns the set of protocol traces which + correspond to a correct protocol run given the three addresses, the + ID, and the two dynamic ports. +*} +definition + NB_voip :: "address \ address \ address \ id \ port \ port \ + (adr\<^sub>i\<^sub>p, address voip_msg) history set" where + "NB_voip s d g i p1 p2= {x. (is_voip S0 s d g i p1 p2 x)}" + +end diff --git a/UPF-Firewall.thy b/UPF-Firewall.thy new file mode 100644 index 0000000..1b98a55 --- /dev/null +++ b/UPF-Firewall.thy @@ -0,0 +1,48 @@ +(***************************************************************************** + * Copyright (c) 2005-2010 ETH Zurich, Switzerland + * 2008-2015 Achim D. Brucker, Germany + * 2009-2016 Université Paris-Sud, France + * 2015-2016 The University of Sheffield, UK + * + * 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 holders 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. + *****************************************************************************) + +chapter {* UPF Firewall *} +theory + "UPF-Firewall" +imports + "PacketFilter/PacketFilter" + "NAT/NAT" + "FWNormalisation/FWNormalisation" + "StatefulFW/StatefulFW" +begin +text{* This is the main entry point for specifications of firewall policies. *} +end diff --git a/document/introduction.tex b/document/introduction.tex new file mode 100644 index 0000000..2af25f0 --- /dev/null +++ b/document/introduction.tex @@ -0,0 +1,12 @@ +We present a formal model of network protocols and their application +to modeling firewall policies. The formalization is based on the +\emph{Unified Policy Framework} (UPF)~\cite{brucker.ea:upf:2014}. The +formalization was originally developed with for generating test cases +(see~\cite{brucker.ea:formal-fw-testing:2014} for details) for testing the +security configuration actual firewall and router (middle-boxes) using +HOL-TestGen~\cite{brucker.ea:formal-fw-testing:2014}. Our work focuses +on modeling application level protocols on top of tcp/ip. Thus, its +abstraction level differs from Diekmann's Network Security Policy +Verification +formalization~\cite{Network_Security_Policy_Verification-AFP}. + diff --git a/document/root.bib b/document/root.bib new file mode 100644 index 0000000..2e5bc1d --- /dev/null +++ b/document/root.bib @@ -0,0 +1,254 @@ + +@PREAMBLE{ {\providecommand{\ac}[1]{\textsc{#1}} } + # {\providecommand{\acs}[1]{\textsc{#1}} } + # {\providecommand{\acf}[1]{\textsc{#1}} } + # {\providecommand{\TAP}{T\kern-.1em\lower-.5ex\hbox{A}\kern-.1em P} } + # {\providecommand{\leanTAP}{\mbox{\sf lean\it\TAP}} } + # {\providecommand{\holz}{\textsc{hol-z}} } + # {\providecommand{\holocl}{\textsc{hol-ocl}} } + # {\providecommand{\isbn}{\textsc{isbn}} } + # {\providecommand{\Cpp}{C++} } + # {\providecommand{\Specsharp}{Spec\#} } + # {\providecommand{\doi}[1]{\href{http://dx.doi.org/#1}{doi: + {\urlstyle{rm}\nolinkurl{#1}}}}} } +@STRING{conf-tphols="\acs{tphols}" } +@STRING{iso = {International Organization for Standardization} } +@STRING{j-ar = "Journal of Automated Reasoning" } +@STRING{j-cacm = "Communications of the \acs{acm}" } +@STRING{j-acta-informatica = "Acta Informatica" } +@STRING{j-sosym = "Software and Systems Modeling" } +@STRING{j-sttt = "International Journal on Software Tools for Technology" } +@STRING{j-ist = "Information and Software Technology" } +@STRING{j-toplas= "\acs{acm} Transactions on Programming Languages and + Systems" } +@STRING{j-tosem = "\acs{acm} Transactions on Software Engineering and + Methodology" } +@STRING{j-eceasst="Electronic Communications of the \acs{easst}" } +@STRING{j-fac = "Formal Aspects of Computing" } +@STRING{j-ucs = "Journal of Universal Computer Science" } +@STRING{j-sl = "Journal of Symbolic Logic" } +@STRING{j-fp = "Journal of Functional Programming" } +@STRING{j-tkde = {\acs{ieee} Transaction on Knowledge and Data Engineering} } +@STRING{j-tse = {\acs{ieee} Transaction on Software Engineering} } +@STRING{j-entcs = {Electronic Notes in Theoretical Computer Science} } +@STRING{s-lnai = "Lecture Notes in Computer Science" } +@STRING{s-lncs = "Lecture Notes in Computer Science" } +@STRING{s-lnbip = "Lecture Notes in Business Information Processing" } +@String{j-computer = "Computer"} +@String{j-tissec = "\acs{acm} Transactions on Information and System Security"} +@STRING{omg = {Object Management Group} } +@STRING{j-ipl = {Information Processing Letters} } +@STRING{j-login = ";login: the USENIX Association newsletter" } + +@STRING{PROC = "Proceedings of the " } + + +% Publisher: +% ========== +@STRING{pub-awl = {Addison-Wesley Longman, Inc.} } +@STRING{pub-awl:adr={Reading, MA, \acs{usa}} } +@STRING{pub-springer={Springer-Verlag} } +@STRING{pub-springer:adr={Heidelberg} } +@STRING{pub-cup = {Cambridge University Press} } +@STRING{pub-cup:adr={New York, \acs{ny}, \acs{usa}} } +@STRING{pub-mit = {\acs{mit} Press} } +@STRING{pub-mit:adr={Cambridge, Massachusetts} } +@STRING{pub-springer-ny={Springer-Verlag} } +, +@STRING{pub-springer-netherlands={Springer Netherlands} } +@STRING{pub-springer-netherlands:adr={} } +@STRING{pub-springer-ny:adr={New York, \acs{ny}, \acs{usa}} } +@STRING{pub-springer-london={Springer-Verlag} } +@STRING{pub-springer-london:adr={London} } +@STRING{pub-ieee= {\acs{ieee} Computer Society} } +@STRING{pub-ieee:adr={Los Alamitos, \acs{ca}, \acs{usa}} } +@STRING{pub-prentice={Prentice Hall, Inc.} } +@STRING{pub-prentice:adr={Upper Saddle River, \acs{nj}, \acs{usa}} } +@STRING{pub-acm = {\acs{acm} Press} } +@STRING{pub-acm:adr={New York, \acs{ny} \acs{usa}} } +@STRING{pub-oxford={Oxford University Press, Inc.} } +@STRING{pub-oxford:adr={New York, \acs{ny}, \acs{usa}} } +@STRING{pub-kluwer={Kluwer Academic Publishers} } +@STRING{pub-kluwer:adr={Dordrecht} } +@STRING{pub-elsevier={Elsevier Science Publishers} } +@STRING{pub-elsevier:adr={Amsterdam} } +@STRING{pub-north={North-Holland Publishing Co.} } +@STRING{pub-north:adr={Nijmegen, The Netherlands} } +@STRING{pub-ios = {\textsc{ios} Press} } +@STRING{pub-ios:adr={Amsterdam, The Netherlands} } +@STRING{pub-heise={Heise Zeitschriften Verlag} } +@STRING{pub-heise:adr={Hannover, Germany} } + + +@INPROCEEDINGS{brucker.ea:icst:2010, + author = {Achim D. Brucker and Lukas Br\"ugger and Paul Kearney and Burkhart Wolff}, + title = {Verified Firewall Policy Transformations for Test Case Generation}, + year = 2010, + series = {Lecture Notes in Computer Science}, + publisher = {Springer-Verlag}, + copyright = {\copyright Springer-Verlag}, + booktitle = {International Conference on Software Testing {(ICST10)}}, + location = {Paris, France}, + editor = {Ana Cavalli and Sudipto Ghosh}, + annote = {To appear in LNCS}, + classification = {conference}, + pdf = {../papers/conf/firewall-reloaded.pdf}, + abstract = {We present an optimization technique for model-based generation of + test cases for firewalls. Based on a formal model for firewall + policies in higher-order logic, we derive a collection of + semantics-preserving policy transformation rules and an algorithm + that optimizes the specification with respect of the number of + test cases required for path coverage. The correctness of the rules + and the algorithm is established by formal proofs in + Isabelle/\acs{hol}. Finally, we use the normalized policies to + generate test cases with the domain-specific firewall testing tool + \testgenFW. + + The resulting procedure is characterized by a gain in efficiency + of two orders of magnitude and can handle configurations with + hundreds of rules as occur in practice. + + Our approach can be seen as an instance of a methodology to + tame inherent state-space explosions in test case generation for + security policies.} +} + + +@InCollection{ brucker.ea:test-sequence:2007, + abstract = {HOL-TestGen is a specification and test-case generation + environment extending the interactive theorem prover + Isabelle/HOL. Its method is two-staged: first, the + original formula is partitioned into test cases by + transformation into a normal form. Second, the test cases + are analyzed for ground instances (the test data) + satisfying the constraints of the test cases. Particular + emphasis is put on the control of explicit test hypotheses + which can be proven over concrete programs. + + Although originally designed for black-box unit-tests, + HOL-TestGen's underlying logic and deduction engine is + powerful enough to be used in test-sequence generation, too. + + We develop the theory for test-sequence generation with + HOL-TestGen and describe its use in a substantial case-study + in the field of computer security, namely the black-box + test of configured firewalls. }, + keywords = {security, model-based testing, specification-based + testing, firewall testing}, + location = {Zurich}, + author = {Achim D. Brucker and Burkhart Wolff}, + booktitle = {TAP 2007: Tests And Proofs}, + language = {USenglish}, + publisher = pub-springer, + series = s-lncs, + number = 4454, + editor = {Bertrand Meyer and Yuri Gurevich}, + title = {Test-Sequence Generation with {HOL-TestGen} -- With an + Application to Firewall Testing }, + categories = {holtestgen}, + classification= {conference}, + public = {yes}, + year = 2007, + doi = {10.1007/978-3-540-73770-4_9}, + pages = {149--168}, + pdf = {http://www.brucker.ch/bibliography/download/2007/brucker.ea-test-sequence-2007.pdf} + , + ps = {http://www.brucker.ch/bibliography/download/2007/brucker.ea-test-sequence-2007.ps.gz} + , + +} + +@InCollection{ brucker.ea:model-based:2008, + abstract = {Firewalls are a cornerstone of todays security + infrastructure for networks. Their configuration, + implementing a firewall policy, is inherently complex, hard + to understand, and difficult to validate. + + We present a substantial case study performed with the + model-based testing tool HOL-TestGen. Based on a formal model + of firewalls and their policies in HOL, we first + present a derived theory for simplifying policies. We + discuss different test plans for test specifications. + Finally, we show how to integrate these issues to a + domain-specific firewall testing tool HOL-TestGen/FW.}, + editor = {Kenji Suzuki and Teruo Higashino}, + location = {Tokyo, Japan}, + author = {Achim D. Brucker and Lukas Br{\"u}gger and Burkhart Wolff}, + booktitle = {Testcom/FATES 2008}, + language = {USenglish}, + publisher = pub-springer, + series = s-lncs, + number = 5047, + doi = {10.1007/978-3-540-68524-1_9}, + pages = {103--118}, + title = {Model-based Firewall Conformance Testing}, + categories = {holtestgen}, + classification= {conference}, + year = 2008, + pdf = {http://www.brucker.ch/bibliography/download/2008/brucker.ea-model-based-2008.pdf} + , + ps = {http://www.brucker.ch/bibliography/download/2008/brucker.ea-model-based-2008.ps.gz} + , + public = {yes}, + +} + +@PhDThesis{ bidder:specification:2007, + author = {Diana von Bidder}, + title = {Specification-based Firewall Testing}, + school = {ETH Zurich}, + year = 2007, + public = {yes}, + type = {Ph.D. Thesis}, + acknowledgement={none}, + classification= {thesis}, + note = {\acs{eth} Dissertation No. 17172. Diana von Bidder's + maiden name is Diana Senn.} +} + + + +@article{Network_Security_Policy_Verification-AFP, + author = {Cornelius Diekmann}, + title = {Network Security Policy Verification}, + journal = {Archive of Formal Proofs}, + month = jul, + year = 2014, + note = {\url{http://isa-afp.org/entries/Network_Security_Policy_Verification.shtml}, + Formal proof development}, + ISSN = {2150-914x}, +} + +@Article{ brucker.ea:upf:2014, + abstract = {We present the Unified Policy Framework (UPF), a generic framework for modelling security (access-control) policies. UPF emphasizes the view that a policy is a policy decision function that grants or denies access to resources, permissions, etc. In other words, instead of modelling the relations of permitted or prohibited requests directly, we model the concrete function that implements the policy decision point in a system. In more detail, UPF is based on the following four principles: 1) Functional representation of policies, 2) No conflicts are possible, 3) Three-valued decision type (allow, deny, undefined), 4) Output type not containing the decision only.}, + author = {Achim D. Brucker and Lukas Br{\"u}gger and Burkhart Wolff}, + date = {2014-11-28}, + file = {https://www.brucker.ch/bibliography/download/2014/brucker.ea-upf-outline-2014.pdf}, + filelabel = {Outline}, + issn = {2150-914x}, + journal = {Archive of Formal Proofs}, + month = {sep}, + note = {\url{http://www.isa-afp.org/entries/UPF.shtml}, Formal proof development}, + pdf = {https://www.brucker.ch/bibliography/download/2014/brucker.ea-upf-2014.pdf}, + title = {The Unified Policy Framework (UPF)}, + url = {https://www.brucker.ch/bibliography/abstract/brucker.ea-upf-2014}, + year = {2014}, +} +@Article{ brucker.ea:formal-fw-testing:2014, + abstract = {Firewalls are an important means to secure critical ICT infrastructures. As configurable off-the-shelf prod\-ucts, the effectiveness of a firewall crucially depends on both the correctness of the implementation itself as well as the correct configuration. While testing the implementation can be done once by the manufacturer, the configuration needs to be tested for each application individually. This is particularly challenging as the configuration, implementing a firewall policy, is inherently complex, hard to understand, administrated by different stakeholders and thus difficult to validate. This paper presents a formal model of both stateless and stateful firewalls (packet filters), including NAT, to which a specification-based conformance test case gen\-eration approach is applied. Furthermore, a verified optimisation technique for this approach is presented: starting from a formal model for stateless firewalls, a collection of semantics-preserving policy transformation rules and an algorithm that optimizes the specification with respect of the number of test cases required for path coverage of the model are derived. We extend an existing approach that integrates verification and testing, that is, tests and proofs to support conformance testing of network policies. The presented approach is supported by a test framework that allows to test actual firewalls using the test cases generated on the basis of the formal model. Finally, a report on several larger case studies is presented.}, + author = {Achim D. Brucker and Lukas Br{\"u}gger and Burkhart Wolff}, + doi = {10.1002/stvr.1544}, + journal = {Software Testing, Verification \& Reliability (STVR)}, + keywords = {model-based testing; conformance testing; security testing; firewall; specification-based testing; testing cloud infrastructure, transformation for testability; HOL-TestGen; test and proof; security configuration testing}, + language = {USenglish}, + number = {1}, + pages = {34--71}, + pdf = {https://www.brucker.ch/bibliography/download/2014/brucker.ea-formal-fw-testing-2014.pdf}, + publisher = {John Wiley \& Sons}, + title = {Formal Firewall Conformance Testing: An Application of Test and Proof Techniques}, + url = {https://www.brucker.ch/bibliography/abstract/brucker.ea-formal-fw-testing-2014}, + volume = {25}, + year = {2015}, +} + + diff --git a/document/root.tex b/document/root.tex new file mode 100644 index 0000000..4dea693 --- /dev/null +++ b/document/root.tex @@ -0,0 +1,159 @@ +\documentclass[11pt,DIV10,a4paper,twoside=semi,openright,titlepage]{scrreprt} +\usepackage{fixltx2e} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Overrides the (rightfully issued) warning by Koma Script that \rm +%%% etc. should not be used (they are deprecated since more than a +%%% decade) + \DeclareOldFontCommand{\rm}{\normalfont\rmfamily}{\mathrm} + \DeclareOldFontCommand{\sf}{\normalfont\sffamily}{\mathsf} + \DeclareOldFontCommand{\tt}{\normalfont\ttfamily}{\mathtt} + \DeclareOldFontCommand{\bf}{\normalfont\bfseries}{\mathbf} + \DeclareOldFontCommand{\it}{\normalfont\itshape}{\mathit} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +\usepackage{isabelle,isabellesym} +\usepackage{stmaryrd} +\usepackage{paralist} +\usepackage{xspace} +\usepackage[USenglish]{babel} +\newcommand{\testgen}{HOL-TestGen\xspace} +\newcommand{\testgenFW}{HOL-TestGen/FW\xspace} +\usepackage[numbers, sort&compress, sectionbib]{natbib} +\usepackage{graphicx} +\usepackage{color} +\sloppy + +\usepackage{amssymb} + + + +\newcommand{\isasymmodels}{\isamath{\models}} +\newcommand{\HOL}{HOL} + +\newcommand{\ie}{i.\,e.} +\newcommand{\eg}{e.\,g.} + +\usepackage{pdfsetup} + +\urlstyle{rm} +\isabellestyle{it} +\renewcommand{\isastyle}{\isastyleminor} + +\pagestyle{empty} +\begin{document} +\renewcommand{\subsubsectionautorefname}{Section} +\renewcommand{\subsectionautorefname}{Section} +\renewcommand{\sectionautorefname}{Section} +\renewcommand{\chapterautorefname}{Chapter} +\newcommand{\subtableautorefname}{\tableautorefname} +\newcommand{\subfigureautorefname}{\figureautorefname} + +\title{Formal Network Models and Their Application to Firewall Policies\\ (UPF-Firewall)} +\author{Achim D. Brucker\footnotemark[1] \quad + Lukas Br\"ugger\footnotemark[2] \quad + Burkhart Wolff\footnotemark[3]\\[1.5em] + \normalsize + \normalsize\footnotemark[1]~Department of Computer Science, The University of Sheffield, Sheffield, UK + \texorpdfstring{\\}{} + \normalsize\href{mailto:"Achim D. Brucker" + }{a.brucker@sheffield.ac.uk}\\[1em] + % + \normalsize\footnotemark[2]Information Security, ETH Zurich, 8092 Zurich, Switzerland + \texorpdfstring{\\}{} + \normalsize\href{mailto:"Lukas Bruegger" + }{Lukas.A.Bruegger@gmail.com}\\[1em] + % + \normalsize\footnotemark[3]~Univ. Paris-Sud, Laboratoire LRI, + UMR8623, 91405 Orsay, France + France\texorpdfstring{\\}{} + \normalsize\href{mailto:"Burkhart Wolff" }{burkhart.wolff@lri.fr} +} + +\pagestyle{empty} +\publishers{% + \normalfont\normalsize% + \centerline{\textsf{\textbf{\large Abstract}}} + \vspace{1ex}% + \parbox{0.8\linewidth}{% + We present a formal model of network protocols and their + application to modeling firewall policies. The formalization is + based on the \emph{Unified Policy Framework} (UPF). The + formalization was originally developed with for generating test + cases for testing the security configuration actual firewall and + router (middle-boxes) using HOL-TestGen. Our work focuses on + modeling application level protocols on top of tcp/ip. Thus, its + abstraction level differs from Diekmann's Network Security + Policy Verification formalization + } +} + +\maketitle +\cleardoublepage +\pagestyle{plain} +\tableofcontents +\cleardoublepage + +\chapter{Introduction} + \input{introduction} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% + % \input{session} + \input{UPF-Firewall} + \input{NetworkModels} + \input{NetworkCore} + \input{DatatypeAddress} + \input{DatatypePort} + \input{IntegerAddress} + \input{IntegerPort} + \input{IntegerPort_TCPUDP} + \input{IPv4} + \input{IPv4_TCPUDP.tex} + \input{PacketFilter.tex} + \input{PolicyCore} + \input{PolicyCombinators} + \input{PortCombinators} + \input{ProtocolPortCombinators} + \input{Ports} + \input{NAT} + \input{FWNormalisation.tex} + \input{FWNormalisationCore.tex} + \input{NormalisationGenericProofs.tex} + \input{NormalisationIntegerPortProof.tex} + \input{NormalisationIPPProofs.tex} + \input{Stateful} + \input{FTP} + \input{FTP_WithPolicy} + \input{VOIP} + \input{FTPVOIP} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \input{Examples.tex} + \input{DMZ.tex} + \input{DMZDatatype.tex} + \input{DMZInteger.tex} + \input{PersonalFirewall.tex} + \input{PersonalFirewallInt.tex} + \input{PersonalFirewallIpv4.tex} + \input{Transformation.tex} + \input{Transformation01.tex} + \input{Transformation02.tex} + \input{NAT-FW.tex} + \input{VoIP.tex} +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%\input{conclusion} + +\appendix +\chapter{Appendix} +\input{LTL_alike.tex} + +\begin{figure} + \includegraphics[height=\textheight]{session_graph} +\end{figure} +\bibliographystyle{abbrvnat} +\bibliography{root} +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: