diff --git a/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean index f7683b981..e0b0e3e4c 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean @@ -4,31 +4,30 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # HMAC-MD5 (RFC 2104) on ARMv7 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling MD5's verified streaming `init` and -`update`. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`). `init` sets both states' hash values with MD5's +verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` word by word +into their buffers, and absorbs each with one call of MD5's verified +compression function. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/Arm.lean`): it finalizes the inner state with MD5's verified -streaming `finalize`, then computes the outer hash as one call of MD5's -verified compression function (`vg_md5_compress`), on a block laid out at -fixed offsets in `scratch`. It pushes 8 bytes of stack (the stack arguments of -`finalize`); `stack` is that of the shared contract, 16 bytes. +`finalize` finalizes the inner state with MD5's verified streaming `finalize`, +then computes the outer hash as one call of MD5's verified compression +function (`vg_md5_compress`), on a block laid out at fixed offsets in +`scratch`. It pushes 8 bytes of stack (the stack arguments of `finalize`); +`stack` is that of the shared contract, 16 bytes. -/ namespace VG.Artifacts.HmacMd5.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.md5I.initApi with target := Arm.target doc := Spec.Hmac.md5I.initApi.doc - code := md5H.init + code := Proof.Pbkdf2.Md.Arm.md5Md.hmacInit contract := Spec.Hmac.md5I.initContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 16 - verified := Instances.md5_init + verified := Proof.Pbkdf2.Md.Arm.Instances.md5_init spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.md5I.finalizeApi with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean index 7895f2294..50b9ec3e4 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean @@ -1,33 +1,32 @@ import VerifiedGarbage.TCB.X86.Target -import VerifiedGarbage.Proof.Hmac.Generic.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances /-! # HMAC-MD5 (RFC 2104) on x86 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling MD5's verified `init` and `update`. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/X86.lean`): it calls MD5's verified streaming `finalize` -for the inner hash, then computes the outer hash with one call of MD5's -verified compression function, on a block it lays out word by word in -`scratch`: the outer key's hash value, the inner digest, its padding and -length. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`). `init` sets both states' hash values with MD5's +verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` word by word +into their buffers, and absorbs each with one call of MD5's verified +compression function. + +`finalize` calls MD5's verified streaming `finalize` for the inner hash, then +computes the outer hash with one call of MD5's verified compression function, +on a block it lays out word by word in `scratch`: the outer key's hash value, +the inner digest, its padding and length. -/ namespace VG.Artifacts.HmacMd5.X86 -open VG.Proof.Hmac.Generic.X86 - def artifacts : List Artifact := [ { Spec.Hmac.md5I.initApi with target := X86.target doc := Spec.Hmac.md5I.initApi.doc - code := md5H.init + code := Proof.Pbkdf2.Md.X86.md5M.hmacInit contract := Spec.Hmac.md5I.initContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 48 - verified := Instances.md5_init + verified := Proof.Pbkdf2.Md.X86.Instances.md5_init spSafe := Code.all_of_allInstrs (by lit_decide) }, { Spec.Hmac.md5I.finalizeApi with target := X86.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean index 8499eab75..dd5a9c1e6 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean @@ -4,31 +4,30 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # HMAC-SHA-1 (RFC 2104) on ARMv7 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-1's verified streaming `init` and -`update`. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`). `init` sets both states' hash values with SHA-1's +verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` word by word +into their buffers, and absorbs each with one call of SHA-1's verified +compression function. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/Arm.lean`): it finalizes the inner state with SHA-1's -verified streaming `finalize`, then computes the outer hash as one call of -SHA-1's verified compression function (`vg_sha1_compress`), on a block laid -out at fixed offsets in `scratch`. It pushes 8 bytes of stack (the stack -arguments of `finalize`); `stack` is that of the shared contract, 16 bytes. +`finalize` finalizes the inner state with SHA-1's verified streaming +`finalize`, then computes the outer hash as one call of SHA-1's verified +compression function (`vg_sha1_compress`), on a block laid out at fixed +offsets in `scratch`. It pushes 8 bytes of stack (the stack arguments of +`finalize`); `stack` is that of the shared contract, 16 bytes. -/ namespace VG.Artifacts.HmacSha1.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha1I.initApi with target := Arm.target doc := Spec.Hmac.sha1I.initApi.doc - code := sha1H.init + code := Proof.Pbkdf2.Md.Arm.sha1Md.hmacInit contract := Spec.Hmac.sha1I.initContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 16 - verified := Instances.sha1_init + verified := Proof.Pbkdf2.Md.Arm.Instances.sha1_init spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha1I.finalizeApi with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean index f8fe5974a..aada4a68f 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean @@ -1,33 +1,32 @@ import VerifiedGarbage.TCB.X86.Target -import VerifiedGarbage.Proof.Hmac.Generic.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances /-! # HMAC-SHA-1 (RFC 2104) on x86 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling SHA-1's verified `init` and `update`. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/X86.lean`): it calls SHA-1's verified streaming `finalize` -for the inner hash, then computes the outer hash with one call of SHA-1's -verified compression function, on a block it lays out word by word in -`scratch`: the outer key's hash value, the inner digest, its padding and -length. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`). `init` sets both states' hash values with SHA-1's +verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` word by word +into their buffers, and absorbs each with one call of SHA-1's verified +compression function. + +`finalize` calls SHA-1's verified streaming `finalize` for the inner hash, +then computes the outer hash with one call of SHA-1's verified compression +function, on a block it lays out word by word in `scratch`: the outer key's +hash value, the inner digest, its padding and length. -/ namespace VG.Artifacts.HmacSha1.X86 -open VG.Proof.Hmac.Generic.X86 - def artifacts : List Artifact := [ { Spec.Hmac.sha1I.initApi with target := X86.target doc := Spec.Hmac.sha1I.initApi.doc - code := sha1H.init + code := Proof.Pbkdf2.Md.X86.sha1M.hmacInit contract := Spec.Hmac.sha1I.initContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 48 - verified := Instances.sha1_init + verified := Proof.Pbkdf2.Md.X86.Instances.sha1_init spSafe := Code.all_of_allInstrs (by lit_decide) }, { Spec.Hmac.sha1I.finalizeApi with target := X86.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean index d37e9bf71..e06e0debf 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean @@ -4,32 +4,31 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Sha224 /-! # HMAC-SHA-224 (RFC 2104) on ARMv7 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-224's verified streaming `init` -and SHA-256's `update`. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`). `init` sets both states' hash values with +SHA-224's verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` word +by word into their buffers, and absorbs each with one call of SHA-256's +verified compression function (`vg_sha256_compress`). -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/Arm.lean`): it finalizes the inner state with SHA-256's -verified streaming `finalize`, then computes the outer hash as one call of -SHA-256's verified compression function (`vg_sha256_compress`), on a block -laid out at fixed offsets in `scratch`. It pushes 8 bytes of stack (the stack -arguments of `finalize`); `stack` is that of the shared contract, 16 bytes. +`finalize` finalizes the inner state with SHA-256's verified streaming +`finalize`, then computes the outer hash as one call of SHA-256's verified +compression function (`vg_sha256_compress`), on a block laid out at fixed +offsets in `scratch`. It pushes 8 bytes of stack (the stack arguments of +`finalize`); `stack` is that of the shared contract, 16 bytes. -/ namespace VG.Artifacts.HmacSha224.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha224I.initApi with target := Arm.target doc := Spec.Hmac.sha224I.initApi.doc - code := sha224H.init + code := Proof.Pbkdf2.Md.Arm.sha224Md.hmacInit contract := Spec.Hmac.sha224I.initContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ writeArgs := true stack := 16 - verified := Instances.sha224_init + verified := Proof.Pbkdf2.Md.Arm.Instances.sha224_init spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha224I.finalizeApi with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean index c28cf7cbd..a5adadd77 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean @@ -4,32 +4,31 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Sha256 /-! # HMAC-SHA-256 (RFC 2104) on ARMv7 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-256's verified streaming `init` -and `update`. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`). `init` sets both states' hash values with +SHA-256's verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` word +by word into their buffers, and absorbs each with one call of SHA-256's +verified compression function. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/Arm.lean`): it finalizes the inner state with SHA-256's -verified streaming `finalize`, then computes the outer hash as one call of -SHA-256's verified compression function (`vg_sha256_compress`), on a block -laid out at fixed offsets in `scratch`. It pushes 8 bytes of stack (the stack -arguments of `finalize`); `stack` is that of the shared contract, 16 bytes. +`finalize` finalizes the inner state with SHA-256's verified streaming +`finalize`, then computes the outer hash as one call of SHA-256's verified +compression function (`vg_sha256_compress`), on a block laid out at fixed +offsets in `scratch`. It pushes 8 bytes of stack (the stack arguments of +`finalize`); `stack` is that of the shared contract, 16 bytes. -/ namespace VG.Artifacts.HmacSha256.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha256I.initApi with target := Arm.target doc := Spec.Hmac.sha256I.initApi.doc - code := sha256H.init + code := Proof.Pbkdf2.Md.Arm.sha256Md.hmacInit contract := Spec.Hmac.sha256I.initContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ writeArgs := true stack := 16 - verified := Instances.sha256_init + verified := Proof.Pbkdf2.Md.Arm.Instances.sha256_init spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha256I.finalizeApi with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean index 47b3ed7f1..193ce0a9a 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean @@ -4,31 +4,30 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # HMAC-SHA-384 (RFC 2104) on ARMv7 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-384's verified streaming `init` -and `update`. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`). `init` sets both states' hash values with +SHA-384's verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` word +by word into their buffers, and absorbs each with one call of SHA-384's +verified compression function. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/Arm.lean`): it finalizes the inner state with SHA-384's -verified streaming `finalize`, then computes the outer hash as one call of -SHA-512's verified compression function (`vg_sha512_compress`), on a block -laid out at fixed offsets in `scratch`. It pushes 8 bytes of stack (the stack -arguments of `finalize`); `stack` is that of the shared contract, 16 bytes. +`finalize` finalizes the inner state with SHA-384's verified streaming +`finalize`, then computes the outer hash as one call of SHA-512's verified +compression function (`vg_sha512_compress`), on a block laid out at fixed +offsets in `scratch`. It pushes 8 bytes of stack (the stack arguments of +`finalize`); `stack` is that of the shared contract, 16 bytes. -/ namespace VG.Artifacts.HmacSha384.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha384I.initApi with target := Arm.target doc := Spec.Hmac.sha384I.initApi.doc - code := sha384H.init + code := Proof.Pbkdf2.Md.Arm.sha384Md.hmacInit contract := Spec.Hmac.sha384I.initContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 16 - verified := Instances.sha384_init + verified := Proof.Pbkdf2.Md.Arm.Instances.sha384_init spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha384I.finalizeApi with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean index 49a85cedf..ded83686c 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean @@ -1,33 +1,32 @@ import VerifiedGarbage.TCB.X86.Target -import VerifiedGarbage.Proof.Hmac.Generic.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances /-! # HMAC-SHA-384 (RFC 2104) on x86 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling SHA-384's verified `init` and `update`. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/X86.lean`): it calls SHA-384's verified streaming `finalize` -for the inner hash, then computes the outer hash with one call of SHA-384's -verified compression function, on a block it lays out word by word in -`scratch`: the outer key's hash value, the inner digest, its padding and -length. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`). `init` sets both states' hash values with +SHA-384's verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` word +by word into their buffers, and absorbs each with one call of SHA-384's +verified compression function. + +`finalize` calls SHA-384's verified streaming `finalize` for the inner hash, +then computes the outer hash with one call of SHA-384's verified compression +function, on a block it lays out word by word in `scratch`: the outer key's +hash value, the inner digest, its padding and length. -/ namespace VG.Artifacts.HmacSha384.X86 -open VG.Proof.Hmac.Generic.X86 - def artifacts : List Artifact := [ { Spec.Hmac.sha384I.initApi with target := X86.target doc := Spec.Hmac.sha384I.initApi.doc - code := sha384H.init + code := Proof.Pbkdf2.Md.X86.sha384M.hmacInit contract := Spec.Hmac.sha384I.initContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 48 - verified := Instances.sha384_init + verified := Proof.Pbkdf2.Md.X86.Instances.sha384_init spSafe := Code.all_of_allInstrs (by lit_decide) }, { Spec.Hmac.sha384I.finalizeApi with target := X86.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean index f6112bc28..0f32dd71e 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean @@ -4,31 +4,30 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # HMAC-SHA-512 (RFC 2104) on ARMv7 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-512's verified streaming `init` -and `update`. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`). `init` sets both states' hash values with +SHA-512's verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` word +by word into their buffers, and absorbs each with one call of SHA-512's +verified compression function. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/Arm.lean`): it finalizes the inner state with SHA-512's -verified streaming `finalize`, then computes the outer hash as one call of -SHA-512's verified compression function (`vg_sha512_compress`), on a block -laid out at fixed offsets in `scratch`. It pushes 8 bytes of stack (the stack -arguments of `finalize`); `stack` is that of the shared contract, 16 bytes. +`finalize` finalizes the inner state with SHA-512's verified streaming +`finalize`, then computes the outer hash as one call of SHA-512's verified +compression function (`vg_sha512_compress`), on a block laid out at fixed +offsets in `scratch`. It pushes 8 bytes of stack (the stack arguments of +`finalize`); `stack` is that of the shared contract, 16 bytes. -/ namespace VG.Artifacts.HmacSha512.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha512I.initApi with target := Arm.target doc := Spec.Hmac.sha512I.initApi.doc - code := sha512H'.init + code := Proof.Pbkdf2.Md.Arm.sha512Md'.hmacInit contract := Spec.Hmac.sha512I.initContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 16 - verified := Instances.sha512_init + verified := Proof.Pbkdf2.Md.Arm.Instances.sha512_init spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha512I.finalizeApi with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean index b62a4f9a0..2850c8f1e 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean @@ -1,33 +1,32 @@ import VerifiedGarbage.TCB.X86.Target -import VerifiedGarbage.Proof.Hmac.Generic.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances /-! # HMAC-SHA-512 (RFC 2104) on x86 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling SHA-512's verified `init` and `update`. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/X86.lean`): it calls SHA-512's verified streaming `finalize` -for the inner hash, then computes the outer hash with one call of SHA-512's -verified compression function, on a block it lays out word by word in -`scratch`: the outer key's hash value, the inner digest, its padding and -length. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`). `init` sets both states' hash values with +SHA-512's verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` word +by word into their buffers, and absorbs each with one call of SHA-512's +verified compression function. + +`finalize` calls SHA-512's verified streaming `finalize` for the inner hash, +then computes the outer hash with one call of SHA-512's verified compression +function, on a block it lays out word by word in `scratch`: the outer key's +hash value, the inner digest, its padding and length. -/ namespace VG.Artifacts.HmacSha512.X86 -open VG.Proof.Hmac.Generic.X86 - def artifacts : List Artifact := [ { Spec.Hmac.sha512I.initApi with target := X86.target doc := Spec.Hmac.sha512I.initApi.doc - code := sha512H'.init + code := Proof.Pbkdf2.Md.X86.sha512M'.hmacInit contract := Spec.Hmac.sha512I.initContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 48 - verified := Instances.sha512_init + verified := Proof.Pbkdf2.Md.X86.Instances.sha512_init spSafe := Code.all_of_allInstrs (by lit_decide) }, { Spec.Hmac.sha512I.finalizeApi with target := X86.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean index 1a8506308..d60706e3a 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean @@ -4,31 +4,30 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # HMAC-SHA-512/224 (RFC 2104) on ARMv7 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-512/224's verified streaming -`init` and `update`. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`). `init` sets both states' hash values with +SHA-512/224's verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` +word by word into their buffers, and absorbs each with one call of +SHA-512/224's verified compression function. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/Arm.lean`): it finalizes the inner state with SHA-512/224's -verified streaming `finalize`, then computes the outer hash as one call of -SHA-512's verified compression function (`vg_sha512_compress`), on a block -laid out at fixed offsets in `scratch`. It pushes 8 bytes of stack (the stack -arguments of `finalize`); `stack` is that of the shared contract, 16 bytes. +`finalize` finalizes the inner state with SHA-512/224's verified streaming +`finalize`, then computes the outer hash as one call of SHA-512's verified +compression function (`vg_sha512_compress`), on a block laid out at fixed +offsets in `scratch`. It pushes 8 bytes of stack (the stack arguments of +`finalize`); `stack` is that of the shared contract, 16 bytes. -/ namespace VG.Artifacts.HmacSha512_224.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha512_224I.initApi with target := Arm.target doc := Spec.Hmac.sha512_224I.initApi.doc - code := sha512_224H.init + code := Proof.Pbkdf2.Md.Arm.sha512_224Md.hmacInit contract := Spec.Hmac.sha512_224I.initContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 16 - verified := Instances.sha512_224_init + verified := Proof.Pbkdf2.Md.Arm.Instances.sha512_224_init spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha512_224I.finalizeApi with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean index 7a54724d4..f7bddf4f6 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean @@ -1,33 +1,32 @@ import VerifiedGarbage.TCB.X86.Target -import VerifiedGarbage.Proof.Hmac.Generic.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances /-! # HMAC-SHA-512/224 (RFC 2104) on x86 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling SHA-512/224's verified `init` and `update`. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/X86.lean`): it calls SHA-512/224's verified streaming `finalize` -for the inner hash, then computes the outer hash with one call of SHA-512/224's -verified compression function, on a block it lays out word by word in -`scratch`: the outer key's hash value, the inner digest, its padding and -length. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`). `init` sets both states' hash values with +SHA-512/224's verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` +word by word into their buffers, and absorbs each with one call of +SHA-512/224's verified compression function. + +`finalize` calls SHA-512/224's verified streaming `finalize` for the inner +hash, then computes the outer hash with one call of SHA-512/224's verified +compression function, on a block it lays out word by word in `scratch`: the +outer key's hash value, the inner digest, its padding and length. -/ namespace VG.Artifacts.HmacSha512_224.X86 -open VG.Proof.Hmac.Generic.X86 - def artifacts : List Artifact := [ { Spec.Hmac.sha512_224I.initApi with target := X86.target doc := Spec.Hmac.sha512_224I.initApi.doc - code := sha512_224H.init + code := Proof.Pbkdf2.Md.X86.sha512_224M.hmacInit contract := Spec.Hmac.sha512_224I.initContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 48 - verified := Instances.sha512_224_init + verified := Proof.Pbkdf2.Md.X86.Instances.sha512_224_init spSafe := Code.all_of_allInstrs (by lit_decide) }, { Spec.Hmac.sha512_224I.finalizeApi with target := X86.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean index f9018522b..c0647cc78 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean @@ -4,31 +4,30 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # HMAC-SHA-512/256 (RFC 2104) on ARMv7 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-512/256's verified streaming -`init` and `update`. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`). `init` sets both states' hash values with +SHA-512/256's verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` +word by word into their buffers, and absorbs each with one call of +SHA-512/256's verified compression function. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/Arm.lean`): it finalizes the inner state with SHA-512/256's -verified streaming `finalize`, then computes the outer hash as one call of -SHA-512's verified compression function (`vg_sha512_compress`), on a block -laid out at fixed offsets in `scratch`. It pushes 8 bytes of stack (the stack -arguments of `finalize`); `stack` is that of the shared contract, 16 bytes. +`finalize` finalizes the inner state with SHA-512/256's verified streaming +`finalize`, then computes the outer hash as one call of SHA-512's verified +compression function (`vg_sha512_compress`), on a block laid out at fixed +offsets in `scratch`. It pushes 8 bytes of stack (the stack arguments of +`finalize`); `stack` is that of the shared contract, 16 bytes. -/ namespace VG.Artifacts.HmacSha512_256.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha512_256I.initApi with target := Arm.target doc := Spec.Hmac.sha512_256I.initApi.doc - code := sha512_256H.init + code := Proof.Pbkdf2.Md.Arm.sha512_256Md.hmacInit contract := Spec.Hmac.sha512_256I.initContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 16 - verified := Instances.sha512_256_init + verified := Proof.Pbkdf2.Md.Arm.Instances.sha512_256_init spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha512_256I.finalizeApi with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean index 06ca1ba7e..bb0cda1d3 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean @@ -1,33 +1,32 @@ import VerifiedGarbage.TCB.X86.Target -import VerifiedGarbage.Proof.Hmac.Generic.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances /-! # HMAC-SHA-512/256 (RFC 2104) on x86 -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling SHA-512/256's verified `init` and `update`. -`finalize` is the one for every Merkle–Damgård hash function -(`Impl/Pbkdf2/Md/X86.lean`): it calls SHA-512/256's verified streaming `finalize` -for the inner hash, then computes the outer hash with one call of SHA-512/256's -verified compression function, on a block it lays out word by word in -`scratch`: the outer key's hash value, the inner digest, its padding and -length. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`). `init` sets both states' hash values with +SHA-512/256's verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` +word by word into their buffers, and absorbs each with one call of +SHA-512/256's verified compression function. + +`finalize` calls SHA-512/256's verified streaming `finalize` for the inner +hash, then computes the outer hash with one call of SHA-512/256's verified +compression function, on a block it lays out word by word in `scratch`: the +outer key's hash value, the inner digest, its padding and length. -/ namespace VG.Artifacts.HmacSha512_256.X86 -open VG.Proof.Hmac.Generic.X86 - def artifacts : List Artifact := [ { Spec.Hmac.sha512_256I.initApi with target := X86.target doc := Spec.Hmac.sha512_256I.initApi.doc - code := sha512_256H.init + code := Proof.Pbkdf2.Md.X86.sha512_256M.hmacInit contract := Spec.Hmac.sha512_256I.initContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 48 - verified := Instances.sha512_256_init + verified := Proof.Pbkdf2.Md.X86.Instances.sha512_256_init spSafe := Code.all_of_allInstrs (by lit_decide) }, { Spec.Hmac.sha512_256I.finalizeApi with target := X86.target diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Md5/X86.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Md5/X86.lean index caf542e0c..5b44ab8f0 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Md5/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Md5/X86.lean @@ -21,7 +21,7 @@ calls, and their return address. namespace VG.Artifacts.Pbkdf2Md5.X86 -open VG.Proof.Hmac.Generic.X86 +open VG.Proof.Pbkdf2.Stream.X86 def artifacts : List Artifact := [ { Spec.Hmac.md5I.iterateApi with diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha1/X86.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha1/X86.lean index c312e4fdf..684eeae02 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha1/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha1/X86.lean @@ -21,7 +21,7 @@ calls, and their return address. namespace VG.Artifacts.Pbkdf2Sha1.X86 -open VG.Proof.Hmac.Generic.X86 +open VG.Proof.Pbkdf2.Stream.X86 def artifacts : List Artifact := [ { Spec.Hmac.sha1I.iterateApi with diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha384/X86.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha384/X86.lean index bab074b15..379a75f76 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha384/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha384/X86.lean @@ -21,7 +21,7 @@ calls, and their return address. namespace VG.Artifacts.Pbkdf2Sha384.X86 -open VG.Proof.Hmac.Generic.X86 +open VG.Proof.Pbkdf2.Stream.X86 def artifacts : List Artifact := [ { Spec.Hmac.sha384I.iterateApi with diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512/X86.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512/X86.lean index a4b81ffb7..0b4623e32 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512/X86.lean @@ -21,7 +21,7 @@ calls, and their return address. namespace VG.Artifacts.Pbkdf2Sha512.X86 -open VG.Proof.Hmac.Generic.X86 +open VG.Proof.Pbkdf2.Stream.X86 def artifacts : List Artifact := [ { Spec.Hmac.sha512I.iterateApi with diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_224/X86.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_224/X86.lean index 98e135168..11bbb3f1d 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_224/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_224/X86.lean @@ -21,7 +21,7 @@ calls, and their return address. namespace VG.Artifacts.Pbkdf2Sha512_224.X86 -open VG.Proof.Hmac.Generic.X86 +open VG.Proof.Pbkdf2.Stream.X86 def artifacts : List Artifact := [ { Spec.Hmac.sha512_224I.iterateApi with diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_256/X86.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_256/X86.lean index 6967b4bc1..7c8df5f69 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_256/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_256/X86.lean @@ -21,7 +21,7 @@ calls, and their return address. namespace VG.Artifacts.Pbkdf2Sha512_256.X86 -open VG.Proof.Hmac.Generic.X86 +open VG.Proof.Pbkdf2.Stream.X86 def artifacts : List Artifact := [ { Spec.Hmac.sha512_256I.iterateApi with diff --git a/lean/VerifiedGarbage/Generic/Sha256/X86/Hmac.lean b/lean/VerifiedGarbage/Generic/Sha256/X86/Hmac.lean index dfb33bdff..94d51c841 100644 --- a/lean/VerifiedGarbage/Generic/Sha256/X86/Hmac.lean +++ b/lean/VerifiedGarbage/Generic/Sha256/X86/Hmac.lean @@ -4,14 +4,16 @@ import VerifiedGarbage.Proof.Sha256.X86.Variants.Interface /-! # HMAC-SHA-256 (RFC 2104) on x86, for every x86 SHA-256 backend -`init` is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling SHA-256's verified streaming `init` -and the backend's `update`. `finalize` is the one for every Merkle–Damgård -hash function (`Impl/Pbkdf2/Md/X86.lean`): it calls the backend's verified -streaming `finalize` for the inner hash, then computes the outer hash with one -call of the backend's verified compression function, on a block it lays out -word by word in `scratch`: the outer key's hash value, the inner digest, its -padding and length. +`init` and `finalize` are the ones for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`). `init` sets both states' hash values with +SHA-256's verified streaming `init`, writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` word +by word into their buffers, and absorbs each with one call of the backend's +verified compression function. + +`finalize` calls the backend's verified streaming `finalize` for the inner +hash, then computes the outer hash with one call of the backend's verified +compression function, on a block it lays out word by word in `scratch`: the +outer key's hash value, the inner digest, its padding and length. -/ namespace VG.Generic.Sha256.X86.Hmac @@ -21,7 +23,7 @@ def artifacts (v : Proof.Sha256.X86.Variants.Backend) : List Artifact := [ name := Spec.Hmac.sha256I.initApi.name ++ v.suffix target := X86.target doc := Spec.Hmac.sha256I.initApi.doc - code := v.H.init + code := v.M.hmacInit contract := Spec.Hmac.sha256I.initContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ stack := 48 diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean index b2fbef190..b463d4574 100644 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean @@ -1,21 +1,28 @@ -import VerifiedGarbage.Impl.Hmac.Generic.Arm +import VerifiedGarbage.Impl.Pbkdf2.Stream.Arm import VerifiedGarbage.Impl.MdStream.Arm /-! # HMAC and PBKDF2-HMAC over any Merkle–Damgård hash function: 32-bit ARM implementation The design of x86-64 and AArch64 (`Impl/Pbkdf2/Md/X86_64.lean`, -`Impl/Pbkdf2/Md/AArch64.lean`): one implementation of HMAC's `finalize` and -of PBKDF2's iteration for every Merkle–Damgård hash function (MD5, SHA-1, -SHA-224, SHA-256 and the SHA-512 family), calling its compression function directly -on blocks laid out at fixed offsets. A `Hash` is what the code needs of one -of them: its streaming functions as HMAC's `init` calls them (`st`, with the +`Impl/Pbkdf2/Md/AArch64.lean`): one implementation of HMAC's `init` and +`finalize` and of PBKDF2's iteration for every Merkle–Damgård hash function +(MD5, SHA-1, SHA-224, SHA-256 and the SHA-512 family), calling its +compression function directly on blocks laid out at fixed offsets. A `Hash` +is what the code needs of one of them: its streaming functions as the code +calls them (`st`, `Impl/Pbkdf2/Stream/Arm.lean`, with the block size `B`, the digest size `D` and their working space), the size `N` of its hash value and `L` of its length field and the byte order of the latter, the code writing its digest, and its compression function. -* HMAC's `init` is the code of `Impl/Hmac/Generic/Arm.lean`, for the hash - function's streaming `init` and `update` (`st`). +* `init(inner = r0, outer = r1, key = r2, key_len = r3, scratch = [sp])`, + for a key of at most a block, sets both states' hash values with the + streaming `init`, and makes each absorb its block with one compression, in + its own buffer: `K₀ ⊕ ipad` is written into the inner state's buffer as + words of `0x36` in every byte, then the key's bytes XORed in with a byte + loop over the key alone (its length is public); `K₀ ⊕ opad` is that block + XORed with `0x6a` in every byte (`ipad ⊕ opad`), word by word, into the + outer state's buffer. * `finalize(inner = r0, outer = r1, count = r2:r3, out = [sp], scratch = [sp, #4])` finalizes the inner state with the hash function's streaming `finalize`, into the block (its message has a length only known @@ -38,24 +45,25 @@ latter, the code writing its digest, and its compression function. `scratch` holds the working space of the functions we call (`8 W` bytes, the streaming functions' and the compression function's), then our caller's -`r4`–`r11` and our return address, which each call replaces (where HMAC's -`init` keeps them, `Impl.Hmac.Generic.Arm.Hash.saved`), then the hash value -being compressed (`N` bytes, at `hvO`) and right after it the block (`B` -bytes, at `blkO`). The compression function is called with the hash value -at `r0`, the block at `r1` (copied from `r6`), one block in `r2` and -`scratch` in `r3`; it never writes `r0` or `r3` and preserves `r4`–`r11`, so -our variables live there: `r11` is `scratch`, `r6` the block, and, in -`iterate`, `r4` = `key`, `r5` = the steps left and `r7` = `t`; in -`finalize`, `r5` = `outer` and `r7` = `out`. `r1`, `r9`, `r10` and `r12` are -temporaries. `iterate` uses no stack; `finalize` pushes the streaming -`finalize`'s two stack arguments around its call (`push {r1, r12}`), 8 -bytes. Every address and branch depends only on the pointers and `n`. +`r4`–`r11` and our return address, which each call replaces +(`Impl.Pbkdf2.Stream.Arm.Hash.saved`), then `finalize`'s and `iterate`'s hash +value being compressed (`N` bytes, at `hvO`) and right after it the block (`B` +bytes, at `blkO`); `init` compresses in the states. The compression function +is called with the hash value at `r0`, the block at `r1` (copied from `r6`), +one block in `r2` and `scratch` in `r3`; it never writes `r0` or `r3` and +preserves `r4`–`r11`, so our variables live there: `r11` is `scratch`, `r6` +the block, and, in `iterate`, `r4` = `key`, `r5` = the steps left and `r7` = +`t`; in `finalize`, `r5` = `outer` and `r7` = `out`. `r1`, `r9`, `r10` and +`r12` are temporaries (`init`'s registers are listed with its code). `init` +and `iterate` use no stack; `finalize` pushes the streaming `finalize`'s two +stack arguments around its call (`push {r1, r12}`), 8 bytes. Every address and +branch depends only on the pointers, `key_len` and `n`. -/ namespace VG.Impl.Pbkdf2.Md.Arm open VG.Arm -open VG.Impl.Hmac.Generic.Arm (scrAt) +open VG.Impl.Pbkdf2.Stream.Arm (scrAt) open VG.Impl.MdStream.Arm (compressAt) /-- A Merkle–Damgård hash function's 32-bit ARM functions, as HMAC and @@ -65,7 +73,7 @@ structure Hash where block size `B`, the sizes of the streaming state and of the digest `D`, the words of working space `W` of `update` and `finalize` (which the layout of `scratch` starts with), and the functions. -/ - st : Impl.Hmac.Generic.Arm.Hash + st : Impl.Pbkdf2.Stream.Arm.Hash /-- The size of the hash value. -/ N : Nat /-- The size of the length field. -/ @@ -140,10 +148,62 @@ def compressBlock : Prog isa := .seq (.block [.mov .r1 (.reg .r6)]) (compressAt /-- `r0` at the hash value and `r6` at the block. -/ def atHv : List Instr := scrAt .r0 H.hvO ++ scrAt .r6 H.blkO -/-! ## HMAC's `init` and `finalize` -/ +/-! ## HMAC's `init` + +Registers: `r4` = `inner`, `r5` = `outer`, `r11` = `scratch`; in the key +loop, `r6` = the next key byte, `r8` + `N` = where it goes, `r7` = the bytes +left; for each compression, `r0` = the state, `r6` = its buffer and `r3` = +`scratch`. -/ + +/-- Saving our caller's registers and our return address, and setting up +ours. -/ +def initPrologue : List Instr := + [.ldrSp .r12 0] ++ H.st.save ++ [.mov .r4 (.reg .r0), .mov .r5 (.reg .r1), .mov .r6 (.reg .r2), + .mov .r7 (.reg .r3), .mov .r11 (.reg .r12)] + +/-- `ipad` in every byte of the inner state's buffer, a word at a time; then +the flags of `key_len = 0`, which skip the key loop for an empty key. -/ +def fillIpad : List Instr := + [.movw .r1 0x3636, .movt .r1 0x3636] ++ (List.range (H.B / 4)).map (fun k => .str .r1 .r4 (H.N + 4 * k)) ++ + [.mov .r8 (.reg .r4), .cmp .r7 (.imm 0)] + +/-- The key bytes, XORed with `ipad`, over the start of the buffer. -/ +def keyLoop : Prog isa := + .loop (.block [.ldrb .r12 .r6 0, .dp .eor .r12 .r12 (.imm 0x36), .strb .r12 .r8 H.N, + .dp .add .r6 .r6 (.imm 1), .dp .add .r8 .r8 (.imm 1), .subs .r7 .r7 (.imm 1)]) .ne + +/-- Word `k` of the outer state's buffer, from the inner one's (`r1` = +`0x6a6a6a6a`): `K₀ ⊕ opad = (K₀ ⊕ ipad) ⊕ (ipad ⊕ opad)`. -/ +def opadW (k : Nat) : List Instr := + [.ldr .r12 .r4 (H.N + 4 * k), .dp .eor .r12 .r12 (.reg .r1), .str .r12 .r5 (H.N + 4 * k)] + +/-- The outer state's buffer, and the inner state's compression set up. -/ +def fillOpad : List Instr := + [.movw .r1 0x6a6a, .movt .r1 0x6a6a] ++ (List.range (H.B / 4)).flatMap H.opadW ++ + [.mov .r0 (.reg .r4), .dp .add .r6 .r4 (.imm (BitVec.ofNat 32 H.N)), .mov .r3 (.reg .r11)] + +/-- The two blocks: `K₀ ⊕ ipad` in the inner state's buffer and `K₀ ⊕ opad` +in the outer one's, the part of `init` between the calls of the streaming +`init` and the compressions. -/ +def blocks : Prog isa := + .seq (.block H.fillIpad) (.seq (.ite .eq (.block []) H.keyLoop) (.block H.fillOpad)) + +/-- The outer state's compression set up (`r3` is still `scratch`). -/ +def toOuter : List Instr := [.mov .r0 (.reg .r5), .dp .add .r6 .r5 (.imm (BitVec.ofNat 32 H.N))] + +/-- HMAC's `init`: the streaming `init` of both states, then each state's +block compressed into its hash value. -/ +def hmacInit : Prog isa := + .seq (.block H.initPrologue) + (.seq (H.st.callInit .r4) + (.seq (H.st.callInit .r5) + (.seq H.blocks + (.seq H.compressBlock + (.seq (.block H.toOuter) + (.seq H.compressBlock + (.block H.st.restore))))))) -/-- HMAC's `init`. -/ -def hmacInit : Prog isa := H.st.init +/-! ## HMAC's `finalize` -/ /-- Saving our caller's registers, with `outer` in `r5`, `out` in `r7` and `scratch` in `r11`. -/ diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean index 5b3c06900..d638ea802 100644 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean @@ -1,23 +1,32 @@ -import VerifiedGarbage.Impl.Hmac.Generic.X86 +import VerifiedGarbage.Impl.Pbkdf2.Stream.X86 import VerifiedGarbage.Impl.MdStream.X86 /-! # HMAC and PBKDF2-HMAC over any Merkle–Damgård hash function: x86 (32-bit) implementation -One implementation of HMAC's `finalize` and of PBKDF2's iteration for every -hash function that x86 has streaming functions and a compression function -for, with blocks of 64 bytes (MD5, SHA-1, SHA-256: `Impl/MdStream/X86.lean`) -or 128 (the SHA-512 family: `Impl/Sha512/X86/Stream.lean`). A `Hash` is what the -code needs of one of them: its streaming functions, as HMAC's `init` calls -them (`Impl/Hmac/Generic/X86.lean`, with the sizes of the block, the state -and the digest), the size of its hash value and of its length field, the -byte order of the length field, the compression function (its name, code -and scratch space), and the code writing the digest of a hash value. - -Both functions compress a block that is `D` bytes of message followed by the -padding of a `B + D`-byte message, into a hash value at `ebx` with the block -right after it, at `ebx + N` (a streaming state's layout): - +One implementation of HMAC's `init` and `finalize` and of PBKDF2's iteration +for every hash function that x86 has streaming functions and a compression +function for, with blocks of 64 bytes (MD5, SHA-1, SHA-256: +`Impl/MdStream/X86.lean`) or 128 (the SHA-512 family: +`Impl/Sha512/X86/Stream.lean`). A `Hash` is what the code needs of one of +them: its streaming functions, as the code calls them +(`Impl/Pbkdf2/Stream/X86.lean`, with the sizes of the block, the state and +the digest), the size of its hash value and of its length field, the byte +order of the length field, the compression function (its name, code and +scratch space), and the code writing the digest of a hash value. + +Each function compresses a block into a hash value at `ebx`, with the block +right after it, at `ebx + N` (a streaming state's layout). `init` compresses +the key's blocks; `iterate` and `finalize`, blocks that are `D` bytes of +message followed by the padding of a `B + D`-byte message: + +* `init(inner, outer, key, key_len, scratch)`, for a key of at most a block, + sets both states' hash values with the streaming `init`, and makes each + absorb its block with one compression, in its own buffer: `K₀ ⊕ ipad` is + written into the inner state's buffer as words of `0x36` in every byte, + then the key's bytes XORed in with a byte loop over the key alone (its + length is public); `K₀ ⊕ opad` is that block XORed with `0x6a` in every + byte (`ipad ⊕ opad`), word by word, into the outer state's buffer. * `iterate(key, u, n, t, scratch)` runs `n` steps `U ← HMAC (K₀, U)`, `T ← T ⊕ U` (`VG.Spec.Pbkdf2.iterate`), for the key whose inner and outer streaming states are at `key` and `key + S`. Those have each absorbed one @@ -38,20 +47,21 @@ right after it, at `ebx + N` (a streaming state's layout): `scratch` holds the compression function's scratch space (`[0..so)`, within the working space of the streaming functions, `8 W` bytes), our caller's -`ebx`, `esi`, `edi` and `ebp` (`Impl.Hmac.Generic.X86.Hash.saved`), then our -buffers: `iterate`'s hash value and block, `finalize`'s digest. The -compression function is called as by the streaming functions, with its -arguments pushed in a frame of their own (`Impl.MdStream.X86.compressAt`), -using the 20 bytes below `esp`; it preserves `ebx`, `esi`, `edi` and `ebp`, -so our variables live there. Every copy and every write of the padding is a -32-bit word at a fixed offset. Every address and branch depends only on -`esp`, the pointers, `count` and `n`. +`ebx`, `esi`, `edi` and `ebp` (`Impl.Pbkdf2.Stream.X86.Hash.saved`), then our +buffers: `iterate`'s hash value and block, `finalize`'s digest (`init` has +none). The compression function is called as by the streaming functions, with +its arguments pushed in a frame of their own (`Impl.MdStream.X86.compressAt`), +using the 20 bytes below `esp`; it preserves `ebx`, `esi`, `edi` and `ebp`, so +our variables live there. Every copy and every write of the padding is a +32-bit word at a fixed offset; only `init`'s key loop writes bytes. Every +address and branch depends only on `esp`, the pointers, `key_len`, `count` and +`n`. -/ namespace VG.Impl.Pbkdf2.Md.X86 open VG.X86 -open VG.Impl.Hmac.Generic.X86 (at_) +open VG.Impl.Pbkdf2.Stream.X86 (at_) /-- Word `k` from `[src + o₁]` to `[dst + o₂]`, through `ecx`. -/ def cpW (src dst : Reg) (o₁ o₂ k : Nat) : List Instr := @@ -81,7 +91,7 @@ them. -/ structure Hash where /-- The streaming functions HMAC's `init` and `finalize` call, with the sizes of the block, the state and the digest. -/ - st : Impl.Hmac.Generic.X86.Hash + st : Impl.Pbkdf2.Stream.X86.Hash /-- The size of the hash value (where a state's buffer starts). -/ N : Nat /-- The size of the length field. -/ @@ -164,9 +174,62 @@ def iterate : Prog isa := (.seq (.ite .e (.block []) (.loop H.body .ne)) (.block H.st.restore)) +/-! ## HMAC's `init` + +Registers: `ebp` = `scratch`, `ebx` = `inner` (the hash value being +compressed: then `outer`), `esi` = `outer`; in the key loop, `edi` = the next +key byte, `edx` = where it goes, `ecx` = the bytes left. -/ + +/-- Saving our caller's registers, and `scratch`, `inner` and `outer` into +`ebp`, `ebx` and `esi`. -/ +def initPrologue : List Instr := + [.mov .eax (.mem (at_ .esp 20))] ++ H.st.save ++ + [.mov .ebp (.reg .eax), .mov .ebx (.mem (at_ .esp 4)), .mov .esi (.mem (at_ .esp 8))] + +/-- `ipad` in every byte of the inner state's buffer, a word at a time; +then the key and its length (whose flags skip the key loop for an empty +key), and the start of the buffer. -/ +def fillIpad : List Instr := + .mov .ecx (.imm 0x36363636) :: (List.range (H.B / 4)).map (fun k => .store (at_ .ebx (H.N + 4 * k)) .ecx) ++ + [.mov .edi (.mem (at_ .esp 12)), .mov .ecx (.mem (at_ .esp 16)), .mov .edx (.reg .ebx), + .alu .add .edx (.imm (BitVec.ofNat 32 H.N)), .alu .test .ecx (.reg .ecx)] + +/-- The key bytes, XORed with `ipad`, over the start of the buffer. -/ +def keyLoop : Prog isa := + .loop (.block [.movzx8 .eax (at_ .edi 0), .alu .xor .eax (.imm 0x36), .store8 (at_ .edx 0) .al, + .alu .add .edi (.imm 1), .alu .add .edx (.imm 1), .alu .sub .ecx (.imm 1)]) .ne + +/-- Word `k` of the outer state's buffer, from the inner one's: +`K₀ ⊕ opad = (K₀ ⊕ ipad) ⊕ (ipad ⊕ opad)`. -/ +def opadW (k : Nat) : List Instr := + [.mov .eax (.mem (at_ .ebx (H.N + 4 * k))), .alu .xor .eax (.imm 0x6a6a6a6a), + .store (at_ .esi (H.N + 4 * k)) .eax] + +/-- The outer state's buffer, and `eax` at the inner one. -/ +def fillOpad : List Instr := (List.range (H.B / 4)).flatMap H.opadW ++ H.atBlk + +/-- The two blocks: `K₀ ⊕ ipad` in the inner state's buffer and `K₀ ⊕ opad` +in the outer one's, the part of `init` between the calls of the streaming +`init` and the compressions. -/ +def blocks : Prog isa := + .seq (.block H.fillIpad) (.seq (.ite .e (.block []) keyLoop) (.block H.fillOpad)) + +/-- `ebx` at the outer state, and `eax` at its buffer. -/ +def toOuter : List Instr := .mov .ebx (.reg .esi) :: H.atBlk + +def hmacInit : Prog isa := + .seq (.block H.initPrologue) + (.seq (H.st.callInit .ebx) + (.seq (H.st.callInit .esi) + (.seq H.blocks + (.seq H.cmp + (.seq (.block H.toOuter) + (.seq H.cmp + (.block H.st.restore))))))) + /-! ## HMAC's `finalize` -Registers as in the streaming-level design (`Impl.Hmac.Generic.X86.Hash.finPrologue`): +Registers as `Impl.Pbkdf2.Stream.X86.Hash.finPrologue` sets them: `ebx` = `inner`, `esi` = `outer`, `edi` = `out`, `ebp` = `scratch`. The streaming `finalize` writes the inner digest to `scratch + buf`. -/ @@ -182,7 +245,7 @@ def finOut : List Instr := def hmacFin : Prog isa := .seq (.block H.st.finPrologue) - (.seq (H.st.callFin [] Impl.Hmac.Generic.X86.Hash.count1 .ebx H.st.buf) + (.seq (H.st.callFin [] Impl.Pbkdf2.Stream.X86.Hash.count1 .ebx H.st.buf) (.seq (.block H.finMid) (.seq H.cmp (.block H.finOut)))) diff --git a/lean/VerifiedGarbage/Impl/Hmac/Generic/Arm.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Stream/Arm.lean similarity index 51% rename from lean/VerifiedGarbage/Impl/Hmac/Generic/Arm.lean rename to lean/VerifiedGarbage/Impl/Pbkdf2/Stream/Arm.lean index 3f1b666a2..adf385cb0 100644 --- a/lean/VerifiedGarbage/Impl/Hmac/Generic/Arm.lean +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Stream/Arm.lean @@ -1,22 +1,16 @@ import VerifiedGarbage.TCB.Arm.Isa /-! -# HMAC over any streaming hash function: 32-bit ARM implementation +# Calls of a streaming hash function: 32-bit ARM -HMAC's `init`, as on x86-64 and AArch64 (`VG.Impl.Hmac.Generic.X86_64`, -`VG.Impl.Hmac.Generic.AArch64`), once for every streaming hash function whose -`init` and `update` it calls (`Hash`): - -* `init(inner = r0, outer = r1, key = r2, key_len = r3, scratch = [sp])` - writes `K₀ ⊕ ipad` and `K₀ ⊕ opad` into `scratch`, then makes the inner - state absorb the first and the outer state the second, with `init` and - `update`. - -HMAC's `finalize` and PBKDF2's `iterate` for the Merkle–Damgård hash -functions call their compression function instead -(`VG.Impl.Pbkdf2.Md.Arm`), and use the helpers here (`saved`, `buf`, -`callFin`, `scrAt`), as does the whole of PBKDF2 (`VG.Impl.Pbkdf2.Whole.Arm`, -also `copy`). +What the code over a hash function's streaming functions shares: HMAC's +`init` and `finalize` and PBKDF2's `iterate` over the Merkle–Damgård hash +functions (`VG.Impl.Pbkdf2.Md.Arm`), and the whole of PBKDF2 +(`VG.Impl.Pbkdf2.Whole.Arm`). A `Hash` is a streaming hash function's +`init`, `update` and `finalize`, with their sizes and names; `callInit` and +`callFin` call `init` and `finalize`; `save` and `restore` keep our caller's +registers and our return address in `scratch` (`saved`); `scrAt` forms an +address in `scratch`; and `copy` copies bytes. `update` and `finalize` take some of their arguments on the stack: each call of them is in a frame that pushes those (`push {r1, r7, r10, r12}` for @@ -31,14 +25,14 @@ largest of theirs); then our caller's registers that we use and our return address (`saved`), which each call replaces; then our buffers. The functions we call preserve `r4`–`r11`, so our variables live there; `r11` is always `scratch`, and `r7` and `r10` pass `update`'s stack arguments. The model -has no register-offset addressing, so the byte loops -address byte `r8` of a buffer as `[r2, #off]` with `r2 = base + r8`, and -count down in `r9` (`subs` and `bne`). Offsets into `scratch` that an ARM +has no register-offset addressing, so `copy` addresses byte `r8` of a buffer +as `[r2, #off]` with `r2 = base + r8`, and counts down in `r9` (`subs` and +`bne`). Offsets into `scratch` that an ARM instruction cannot encode as an immediate are formed with `movw r12` and an `add`. -/ -namespace VG.Impl.Hmac.Generic.Arm +namespace VG.Impl.Pbkdf2.Stream.Arm open VG.Arm @@ -93,14 +87,6 @@ def restore : List Instr := H.saved.map fun (r, d) => .ldr r .r11 d def callInit (st : Reg) : Prog isa := .seq (.block [.mov .r0 (.reg st)]) (.call H.initN H.initC) -/-- A call of `update` on the state at `r0` (set by `st`, first), with the -count `count` and the `len` bytes at `scratch + o`: `data`, `len` and -`scratch` are pushed. -/ -def callUpd (st : List Instr) (count o len : Nat) : Prog isa := - .seq (.block (st ++ scrAt .r1 o ++ [.movw .r7 (BitVec.ofNat 16 len), .mov .r10 (.reg .r11), - .movw .r2 (BitVec.ofNat 16 count), .mov .r3 (.imm 0)])) - (.frame (.push [.r1, .r7, .r10, .r12]) (.call H.updN H.updC) (.pop .r1 16)) - /-- A call of `finalize` on the state at `r0` (set by `st`, first), with the count in `r2:r3` (set by `count`) and the digest to `scratch + o`: `out` and `scratch` are pushed. -/ @@ -108,43 +94,6 @@ def callFin (st count : List Instr) (o : Nat) : Prog isa := .seq (.block (st ++ count ++ scrAt .r1 o ++ [.mov .r12 (.reg .r11)])) (.frame (.push [.r1, .r12]) (.call H.finN H.finC) (.pop .r1 8)) -/-! ## `init` - -Registers: `r4` = `inner`, `r5` = `outer`, `r6` = `key`, `r11` = `scratch`, -`r8` = the byte index, `r9` = the bytes left. `K₀ ⊕ ipad` is at -`scratch + buf`, and `K₀ ⊕ opad` right after it. -/ - -/-- The key bytes, XORed with `ipad` and `opad` into the two blocks. -/ -def keyLoop : Prog isa := - .loop (.block [.dp .add .r2 .r6 (.reg .r8), .ldrb .r12 .r2 0, .dp .eor .r1 .r12 (.imm 0x36), - .dp .add .r2 .r11 (.reg .r8), .strb .r1 .r2 H.buf, .dp .eor .r1 .r12 (.imm 0x5c), - .strb .r1 .r2 (H.buf + H.B), .dp .add .r8 .r8 (.imm 1), .subs .r9 .r9 (.imm 1)]) .ne - -/-- The zero bytes after the key, XORed likewise. -/ -def padLoop : Prog isa := - .loop (.block [.dp .add .r2 .r11 (.reg .r8), .mov .r1 (.imm 0x36), .strb .r1 .r2 H.buf, - .mov .r1 (.imm 0x5c), .strb .r1 .r2 (H.buf + H.B), .dp .add .r8 .r8 (.imm 1), - .subs .r9 .r9 (.imm 1)]) .ne - -def initPrologue : List Instr := - [.ldrSp .r12 0] ++ H.save ++ [.mov .r4 (.reg .r0), .mov .r5 (.reg .r1), .mov .r6 (.reg .r2), - .mov .r11 (.reg .r12), .mov .r8 (.imm 0), .mov .r9 (.reg .r3), .cmp .r9 (.imm 0)] - -/-- `K₀ ⊕ ipad` and `K₀ ⊕ opad` into `scratch`: the part of `init` before its calls. -/ -def initKeys : Prog isa := - .seq (.block H.initPrologue) - (.seq (.ite .eq (.block []) H.keyLoop) - (.seq (.block [.movw .r9 (BitVec.ofNat 16 H.B), .subs .r9 .r9 (.reg .r8)]) - (.ite .eq (.block []) H.padLoop))) - -def init : Prog isa := - .seq H.initKeys - (.seq (H.callInit .r4) - (.seq (H.callUpd [.mov .r0 (.reg .r4)] 0 H.buf H.B) - (.seq (H.callInit .r5) - (.seq (H.callUpd [.mov .r0 (.reg .r5)] 0 (H.buf + H.B) H.B) - (.block H.restore))))) - end Hash -end VG.Impl.Hmac.Generic.Arm +end VG.Impl.Pbkdf2.Stream.Arm diff --git a/lean/VerifiedGarbage/Impl/Hmac/Generic/X86.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Stream/X86.lean similarity index 52% rename from lean/VerifiedGarbage/Impl/Hmac/Generic/X86.lean rename to lean/VerifiedGarbage/Impl/Pbkdf2/Stream/X86.lean index 771743cc9..98965fea3 100644 --- a/lean/VerifiedGarbage/Impl/Hmac/Generic/X86.lean +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Stream/X86.lean @@ -1,20 +1,16 @@ import VerifiedGarbage.TCB.X86.Isa /-! -# HMAC over any streaming hash function: x86 (32-bit) implementation +# Calls of a streaming hash function: x86 (32-bit) -The same algorithm as on the other targets (`VG.Impl.Hmac.Generic.Arm`), once -for every streaming hash function whose `init`, `update` and `finalize` it -calls (`Hash`). Every argument is on the stack (cdecl). - -* `init(inner, outer, key, key_len, scratch)` writes `K₀ ⊕ ipad` and - `K₀ ⊕ opad` into `scratch`, then makes the inner state absorb the first - and the outer state the second, with `init` and `update`. -* `finalize(inner, outer, count, out, scratch)` starts with `finPrologue` - and a call of the streaming `finalize` on the inner state (`callFin`, - `count1`); the rest of it, the outer hash, is one call of the compression - function on a block laid out in `scratch`, written over the hash function's - compression function (`VG.Impl.Pbkdf2.Md.X86`). +What the code over a hash function's streaming functions shares: HMAC's +`init` and `finalize` and PBKDF2's `iterate` over the Merkle–Damgård hash +functions (`VG.Impl.Pbkdf2.Md.X86`), and the whole of PBKDF2 +(`VG.Impl.Pbkdf2.Whole.X86`). A `Hash` is a streaming hash function's +`init`, `update` and `finalize`, with their sizes and names; `callInit` and +`callFin` call `init` and `finalize`; `save` and `restore` keep our caller's +registers in `scratch` (`saved`); `finPrologue` and `count1` start HMAC's +`finalize`; and `copy` copies bytes. Every argument is on the stack (cdecl). Each call passes its arguments in a frame of their own, pushed last to first (`push`), which the pop loads into `eax` when the call returns: every @@ -29,12 +25,12 @@ the largest of theirs); then our caller's `ebx`, `esi`, `edi` and `ebp` (`saved`); then our buffers. The functions we call preserve those four registers, so our variables live there; `ebp` is always `scratch`, and our own arguments are read from the stack again when needed. The model has no -index registers, so the byte loops address byte `ecx` of a buffer at +index registers, so `copy` addresses byte `ecx` of a buffer at `base + off` as `[eax + off]` (or `[edx + off]`), with `eax = base + ecx` computed just before the access. -/ -namespace VG.Impl.Hmac.Generic.X86 +namespace VG.Impl.Pbkdf2.Stream.X86 open VG.X86 @@ -91,14 +87,6 @@ def restore : List Instr := .mov .eax (.reg .ebp) :: H.saved.map fun (r, d) => . def callInit (st : Reg) : Prog isa := .frame (.push [st]) (.call H.initN H.initC) (.pop .eax 1) -/-- A call of `update` on the state at `st` (set by `pre`, first), with the -count `count` (in `lo`, and `eax = 0` its high word) and the `len` bytes at -`scratch + o` (in `edx`, and `ecx = len`). -/ -def callUpd (pre : List Instr) (st lo : Reg) (count o len : Nat) : Prog isa := - .seq (.block (pre ++ [.mov .eax (.imm 0), .mov lo (.imm (BitVec.ofNat 32 count)), - .mov .ecx (.imm (BitVec.ofNat 32 len))] ++ scr .edx o)) - (.frame (.push [.ebp, .ecx, .edx, .eax, lo, st]) (.call H.updN H.updC) (.pop .eax 6)) - /-- A call of `finalize` on the state at `st` (set by `pre`, first), with the count in `eax` (low word) and `ecx` (high word), set by `count`, and the digest to `scratch + o` (in `edx`). -/ @@ -106,50 +94,6 @@ def callFin (pre count : List Instr) (st : Reg) (o : Nat) : Prog isa := .seq (.block (pre ++ count ++ scr .edx o)) (.frame (.push [.ebp, .edx, .ecx, .eax, st]) (.call H.finN H.finC) (.pop .eax 5)) -/-! ## `init` - -Registers: `ebp` = `scratch`, `esi` = `key`, `edi` = `key_len`, `ebx` = the -byte index while the keys are written; then `ebx` = `inner` and `esi` = -`outer`, and `edi` passes `update` the low word of its count. `K₀ ⊕ ipad` -is at `scratch + buf`, and `K₀ ⊕ opad` right after it. -/ - -/-- The key bytes, XORed with `ipad` and `opad` into the two blocks. -/ -def keyLoop : Prog isa := - .loop (.block [.mov .eax (.reg .esi), .alu .add .eax (.reg .ebx), .movzx8 .eax (at_ .eax 0), - .mov .ecx (.reg .eax), .alu .xor .eax (.imm 0x36), .mov .edx (.reg .ebp), .alu .add .edx (.reg .ebx), - .store8 (at_ .edx H.buf) .al, .alu .xor .ecx (.imm 0x5c), .store8 (at_ .edx (H.buf + H.B)) .cl, - .alu .add .ebx (.imm 1), .alu .cmp .ebx (.reg .edi)]) .ne - -/-- The zero bytes after the key, XORed likewise (`ipad` in `eax`, `opad` in -`ecx`). -/ -def padLoop : Prog isa := - .loop (.block [.mov .edx (.reg .ebp), .alu .add .edx (.reg .ebx), .store8 (at_ .edx H.buf) .al, - .store8 (at_ .edx (H.buf + H.B)) .cl, .alu .add .ebx (.imm 1), - .alu .cmp .ebx (.imm (BitVec.ofNat 32 H.B))]) .ne - -def initPrologue : List Instr := - [.mov .eax (.mem (at_ .esp 20))] ++ H.save ++ [.mov .ebp (.reg .eax), .mov .esi (.mem (at_ .esp 12)), - .mov .edi (.mem (at_ .esp 16)), .mov .ebx (.imm 0), .alu .test .edi (.reg .edi)] - -/-- `K₀ ⊕ ipad` and `K₀ ⊕ opad` into `scratch`: the part of `init` before its calls. -/ -def initKeys : Prog isa := - .seq (.block H.initPrologue) - (.seq (.ite .e (.block []) H.keyLoop) - (.seq (.block [.mov .eax (.imm 0x36), .mov .ecx (.imm 0x5c), .alu .cmp .ebx (.imm (BitVec.ofNat 32 H.B))]) - (.ite .e (.block []) H.padLoop))) - -/-- `inner` and `outer`, from the stack. -/ -def initStates : List Instr := [.mov .ebx (.mem (at_ .esp 4)), .mov .esi (.mem (at_ .esp 8))] - -def init : Prog isa := - .seq H.initKeys - (.seq (.block initStates) - (.seq (H.callInit .ebx) - (.seq (H.callUpd [] .ebx .edi 0 H.buf H.B) - (.seq (H.callInit .esi) - (.seq (H.callUpd [] .esi .edi 0 (H.buf + H.B) H.B) - (.block H.restore)))))) - /-! ## The start of `finalize` Registers: `ebx` = `inner`, `esi` = `outer`, `edi` = `out`, `ebp` = @@ -164,4 +108,4 @@ def count1 : List Instr := [.mov .eax (.mem (at_ .esp 12)), .mov .ecx (.mem (at_ end Hash -end VG.Impl.Hmac.Generic.X86 +end VG.Impl.Pbkdf2.Stream.X86 diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Whole/Arm.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Whole/Arm.lean index 8d3b584bf..5e2a27c82 100644 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Whole/Arm.lean +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Whole/Arm.lean @@ -1,4 +1,4 @@ -import VerifiedGarbage.Impl.Hmac.Generic.Arm +import VerifiedGarbage.Impl.Pbkdf2.Stream.Arm /-! # PBKDF2-HMAC over any streaming hash function: 32-bit ARM implementation of the whole derivation @@ -16,7 +16,7 @@ output still needs is copied to `out`. `scratch` starts with the working space of the functions we call (`8 W` bytes); then our caller's registers and our return address (as in HMAC's -code, `VG.Impl.Hmac.Generic.Arm.Hash.saved`), the key's two states, the +code, `VG.Impl.Pbkdf2.Stream.Arm.Hash.saved`), the key's two states, the salted inner state, a working state, `U`, `T`, the hashed password (the `F` bytes `finalize` writes) and `INT (i)`. The functions we call preserve `r4`–`r11`: `r11` is always `scratch`, `r5` and `r6` the salt and its @@ -36,7 +36,7 @@ Every address and branch depends only on the pointers, the lengths and `c`. namespace VG.Impl.Pbkdf2.Whole.Arm open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash copy scrAt) +open VG.Impl.Pbkdf2.Stream.Arm (Hash copy scrAt) /-- The functions PBKDF2 calls, for one hash function: its streaming functions (`H`, with their sizes), the words of working space every function diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Whole/X86.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Whole/X86.lean index 7562c423c..d2ee41afd 100644 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Whole/X86.lean +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Whole/X86.lean @@ -1,4 +1,4 @@ -import VerifiedGarbage.Impl.Hmac.Generic.X86 +import VerifiedGarbage.Impl.Pbkdf2.Stream.X86 /-! # PBKDF2-HMAC over any streaming hash function: x86 (32-bit) implementation of the whole derivation @@ -21,7 +21,7 @@ from the verified functions of one hash function (`Fns`): its streaming `scratch` starts with the working space of the functions we call (`8 W` bytes); then come our caller's `ebx`, `esi`, `edi` and `ebp` (as in HMAC's -code, `VG.Impl.Hmac.Generic.X86.Hash.saved`), the key's two states, the +code, `VG.Impl.Pbkdf2.Stream.X86.Hash.saved`), the key's two states, the salted inner state, a working state, `U`, `T`, the hashed password (the `F` bytes `finalize` writes) and `INT (i)`. Every call passes its arguments in a frame of their own, pushed last to first, which the pop loads into `eax`. @@ -36,7 +36,7 @@ only on the pointers, the lengths and `c`. namespace VG.Impl.Pbkdf2.Whole.X86 open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash copy scr at_) +open VG.Impl.Pbkdf2.Stream.X86 (Hash copy scr at_) /-- The functions PBKDF2 calls, for one hash function: its streaming functions (`H`, with their sizes), the words of working space every function diff --git a/lean/VerifiedGarbage/Impl/Scrypt/X86/Scrypt.lean b/lean/VerifiedGarbage/Impl/Scrypt/X86/Scrypt.lean index 0ba1e4ce1..569c22d7c 100644 --- a/lean/VerifiedGarbage/Impl/Scrypt/X86/Scrypt.lean +++ b/lean/VerifiedGarbage/Impl/Scrypt/X86/Scrypt.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.Impl.Scrypt.X86.RoMix -import VerifiedGarbage.Impl.Hmac.Generic.X86 +import VerifiedGarbage.Impl.Pbkdf2.Stream.X86 /-! # scrypt: x86 (32-bit) implementation @@ -35,7 +35,7 @@ bytes of `b` left, and every address is in the frame or our arguments namespace VG.Impl.Scrypt.X86 open VG.X86 -open VG.Impl.Hmac.Generic.X86 (at_) +open VG.Impl.Pbkdf2.Stream.X86 (at_) /-- `[esp + d]`. -/ abbrev sp (d : Nat) : MemOp := at_ .esp d diff --git a/lean/VerifiedGarbage/Proof/Blake2/Arm/Stream/Call.lean b/lean/VerifiedGarbage/Proof/Blake2/Arm/Stream/Call.lean index 383d01393..3d7d543e0 100644 --- a/lean/VerifiedGarbage/Proof/Blake2/Arm/Stream/Call.lean +++ b/lean/VerifiedGarbage/Proof/Blake2/Arm/Stream/Call.lean @@ -15,7 +15,7 @@ stack arguments (`t` in `r3:r11`, `last` in `r12`, `scratch` in `lr`). `call_ok` runs such a frame from the state before its push (`WP.frame`, `WP.call`), and `call_rel` relates two runs of it (`RelCT.frame`, `RelCT.call`), as for HMAC's calls of `update` -(`Proof/Hmac/Generic/Arm/Hash.lean`). The frame writes the 16 bytes below the +(`Proof/Pbkdf2/Stream/Arm/Hash.lean`). The frame writes the 16 bytes below the stack pointer (`below`), which `After` lets change. -/ diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Init.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Init.lean deleted file mode 100644 index cc490dc62..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Init.lean +++ /dev/null @@ -1,1164 +0,0 @@ -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Hash -import VerifiedGarbage.Proof.Hmac.Generic.Common -import Mathlib.Tactic.Set -import VerifiedGarbage.Proof.Framework.OmegaLit - -/-! -# HMAC over any streaming hash function on 32-bit ARM: the byte loops - -As on AArch64 (`Proof/Hmac/Generic/AArch64/Init.lean`, with the byte-list lemmas -of `Proof/Hmac/Generic/Common.lean`): the byte copy (`copy`), the exclusive-or -of `U` into `T`, and `init`'s loops that write `K₀ ⊕ ipad` and `K₀ ⊕ opad`. Each -counts `r8` up from 0 and `r9` down to 0 with `subs`, and branches on its -result. Addresses are 32 bits, zero-extended: every buffer the loops touch lies -below 2³², so byte `k` of a buffer at `p + o` is at `State.addr p + o + k`. --/ - -namespace VG.Proof.Hmac.Generic.Arm - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash copy) -open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil) -open VG.Proof.MdStream.Arm (Upd Mupd Fupd WP.cons op2_imm op2_reg wp_mov wp_add wp_subs wp_ldrb wp_strb - eval_ne sub_beq sub_ofNat) -open VG.Proof.Hmac.Common (bytesAt_length) -open VG.Proof.Hmac.Generic.Common (writeBytes_snoc bytesAt_snoc' not_mem_of_disjoint xorBytes_snoc - xorBytes_length' InRegions.right' add_ofNat_add BufMem buf_write K0 K0_length K0_lt K0_ge) -open Spec.Sha256 (bytesAt) - -/-! ## Instructions and arithmetic -/ - -theorem wp_eor {is : List Instr} {s : State} {Q : State → Prop} {d n : Reg} {o : Op2} {y : BitVec 32} - (ho : o.eval s = some y) (k : ∀ s', Upd s s' d (s.gpr n ^^^ y) → WP isa (.block is) s' Q) : - WP isa (.block (.dp .eor d n o :: is)) s Q := - WP.cons (s' := s.setReg d (s.gpr n ^^^ y)) (by simp [exec, ho]) (k _ (Upd.setReg _ _ _)) - -theorem ofNat_succ32 (k : Nat) : BitVec.ofNat 32 k + 1 = BitVec.ofNat 32 (k + 1) := by - rw [BitVec.ofNat_add]; rfl - -theorem movw_ofNat {n : Nat} (h : n < 2 ^ 16) : (BitVec.ofNat 16 n).setWidth 32 = BitVec.ofNat 32 n := by - apply BitVec.eq_of_toNat_eq - simp only [BitVec.toNat_setWidth, BitVec.toNat_ofNat] - omega_nat - -/-- Byte `k` of the buffer at `a + o`, as a loop addresses it. -/ -theorem addr3 {a : BitVec 32} {k o : Nat} (h : a.toNat + o + k < 2 ^ 32) : - State.addr (a + BitVec.ofNat 32 k + BitVec.ofNat 32 o) = State.addr a + BitVec.ofNat 64 o + BitVec.ofNat 64 k := by - rw [BitVec.add_assoc, ← BitVec.ofNat_add, addr_add (by omega_nat), BitVec.ofNat_add, BitVec.add_assoc, - BitVec.add_comm (BitVec.ofNat 64 k)] - -/-- The flags after counting `r9` down from `n - k` to `n - (k + 1)`. -/ -theorem left_z {n k : Nat} (hk : k < n) (hn : n < 2 ^ 32) : - (BitVec.ofNat 32 (n - k) - 1 == 0) = decide (n - (k + 1) = 0) := by - rw [show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_beq (by omega_nat) (by decide)] - simp only [decide_eq_decide]; omega_nat - -theorem left_val {n k : Nat} (hk : k < n) : - BitVec.ofNat 32 (n - k) - 1 = BitVec.ofNat 32 (n - (k + 1)) := by - rw [show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat (by omega_nat), Nat.sub_sub] - -/-- The registers the loops write. -/ -abbrev clob : List Reg := [.r1, .r2, .r8, .r9, .r12] - -/-- The registers `copy` writes. -/ -abbrev cclob : List Reg := [.r2, .r8, .r9, .r12] - -theorem not_cclob {r : Reg} (h : r ∉ clob) : r ∉ cclob := fun hc => - h (by simp only [List.mem_cons, List.not_mem_nil, or_false] at hc ⊢; tauto) - -theorem nm {r : Reg} {l : List Reg} (h : r ∉ l) (x : Reg) (hx : x ∈ l := by decide) : r ≠ x := - fun e => h (e ▸ hx) - -/-! ## Counted loops -/ - -/-- A do-while loop on `ne` that runs its body `n > 0` times, each run -ending with the flags of `n - (k + 1) = 0`. -/ -theorem count_loop {body : Prog isa} {n : Nat} (hn : 0 < n) (I : Nat → State → Prop) - (hstep : ∀ k < n, ∀ s, I k s → WP isa body s fun s' => I (k + 1) s' ∧ s'.z = decide (n - (k + 1) = 0)) - {s : State} (h0 : I 0 s) : WP isa (.loop body .ne) s (I n) := by - refine WP.loop (M := isa) (fun m s => ∃ k, m = n - k ∧ k < n ∧ I k s) ?_ n s ⟨0, by omega_nat, hn, h0⟩ - rintro m s ⟨k, rfl, hk, hi⟩ - refine WP.mono (hstep k hk s hi) fun s' ⟨hi', hz⟩ => ?_ - have he : isa.eval .ne s' = some (!decide (n - (k + 1) = 0)) := by - show eval .ne s' = _; rw [eval_ne, hz] - by_cases hl : k + 1 = n - · exact .inl ⟨by rw [he]; simp [hl], hl ▸ hi'⟩ - · exact .inr ⟨by rw [he]; simp; omega_nat, n - (k + 1), by omega_nat, k + 1, rfl, by omega_nat, hi'⟩ - -/-! ## `copy` -/ - -/-- After `k` bytes of a `copy` of `n` bytes from `A` to `B`. -/ -structure CopyInv (s : State) (A B : Addr) (n k : Nat) (t : State) : Prop where - rd : t.rd = s.rd - wr : t.wr = s.wr - sp : t.sp = s.sp - other : ∀ r ∉ cclob, t.gpr r = s.gpr r - r8 : t.gpr .r8 = BitVec.ofNat 32 k - r9 : t.gpr .r9 = BitVec.ofNat 32 (n - k) - mem : t.mem = writeBytes s.mem B (bytesAt s.mem A k) - -/-- The registers and memory `copy` leaves. -/ -structure Copied (s : State) (B : Addr) (xs : List Byte) (t : State) : Prop where - rd : t.rd = s.rd - wr : t.wr = s.wr - sp : t.sp = s.sp - other : ∀ r ∉ cclob, t.gpr r = s.gpr r - mem : t.mem = writeBytes s.mem B xs - -theorem copy_ok {src dst : Reg} (hs : src ∉ cclob) (hd : dst ∉ cclob) - {so d n : Nat} (hso : so < 4096) (hdo : d < 4096) (hn : 0 < n) (hn' : n < 2 ^ 16) {s : State} - (hsw : (s.gpr src).toNat + so + n ≤ 2 ^ 32) (hdw : (s.gpr dst).toNat + d + n ≤ 2 ^ 32) - (hin : ∀ k < n, InRegions (s.rd ++ s.wr) (State.addr (s.gpr src) + BitVec.ofNat 64 so + BitVec.ofNat 64 k) 1) - (hout : ∀ k < n, InRegions s.wr (State.addr (s.gpr dst) + BitVec.ofNat 64 d + BitVec.ofNat 64 k) 1) - (hsep : Region.Disjoint ⟨State.addr (s.gpr src) + BitVec.ofNat 64 so, n⟩ - ⟨State.addr (s.gpr dst) + BitVec.ofNat 64 d, n⟩) : - WP isa (copy src so dst d n) s fun t => - Copied s (State.addr (s.gpr dst) + BitVec.ofNat 64 d) - (bytesAt s.mem (State.addr (s.gpr src) + BitVec.ofNat 64 so) n) t := by - set A := State.addr (s.gpr src) + BitVec.ofNat 64 so - set B := State.addr (s.gpr dst) + BitVec.ofNat 64 d - refine WP.seq (wp_mov (op2_imm (by decide)) fun s₀ u₀ => VG.Proof.Hmac.Generic.Arm.wp_movw fun s₁ u₁ => - WP.block_nil ?_) - have i0 : CopyInv s A B n 0 s₁ := - ⟨by rw [u₁.rd, u₀.rd], by rw [u₁.wr, u₀.wr], by rw [u₁.sp, u₀.sp], - fun r hr => by rw [u₁.other r (nm hr .r9), u₀.other r (nm hr .r8)], - by rw [u₁.other _ (by decide), u₀.gpr]; rfl, by rw [u₁.gpr, movw_ofNat hn']; rfl, - by rw [u₁.mem, u₀.mem, bytesAt, List.range_zero, List.map_nil, writeBytes_nil]⟩ - refine WP.mono (count_loop hn (CopyInv s A B n) (fun k hk t h => ?_) i0) - fun t h => ⟨h.rd, h.wr, h.sp, h.other, h.mem⟩ - refine wp_add (op2_reg _ _) fun t₁ u₁ => ?_ - refine wp_ldrb (a := A + BitVec.ofNat 64 k) hso - (by rw [u₁.gpr, h.other src hs, h.r8, addr3 (by omega_nat)]) - (by rw [u₁.rd, u₁.wr, h.rd, h.wr]; exact hin k hk) fun t₂ u₂ => ?_ - refine wp_add (op2_reg _ _) fun t₃ u₃ => ?_ - refine wp_strb (a := B + BitVec.ofNat 64 k) hdo - (by rw [u₃.gpr, u₂.other dst (nm hd .r12), u₁.other dst (nm hd .r2), h.other dst hd, - u₂.other .r8 (by decide), u₁.other .r8 (by decide), h.r8, addr3 (by omega_nat)]) - (by rw [u₃.wr, u₂.wr, u₁.wr, h.wr]; exact hout k hk) fun t₄ m₄ => ?_ - refine wp_add (op2_imm (by decide)) fun t₅ u₅ => wp_subs (op2_imm (by decide)) fun t₆ u₆ z₆ => - WP.block_nil ?_ - have h8 : t₅.gpr .r8 = BitVec.ofNat 32 (k + 1) := by - rw [u₅.gpr, m₄.gpr, u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), h.r8, - ofNat_succ32] - have h9 : t₅.gpr .r9 = BitVec.ofNat 32 (n - k) := by - rw [u₅.other _ (by decide), m₄.gpr, u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), h.r9] - refine ⟨⟨by rw [u₆.rd, u₅.rd, m₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], - by rw [u₆.wr, u₅.wr, m₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], - by rw [u₆.sp, u₅.sp, m₄.sp, u₃.sp, u₂.sp, u₁.sp, h.sp], - fun r hr => by - rw [u₆.other r (nm hr .r9), u₅.other r (nm hr .r8), m₄.gpr, u₃.other r (nm hr .r2), u₂.other r (nm hr .r12), - u₁.other r (nm hr .r2), h.other r hr], - by rw [u₆.other _ (by decide), h8], by rw [u₆.gpr, h9, left_val hk], ?_⟩, ?_⟩ - · have hl : (bytesAt s.mem A k).length = k := bytesAt_length _ _ _ - have v : (t₃.gpr .r12).setWidth 8 = s.mem (A + BitVec.ofNat 64 k) := by - rw [u₃.other _ (by decide), u₂.gpr, u₁.mem, h.mem] - simp only [writeBytes, hl, not_mem_of_disjoint hsep hk (Nat.le_of_lt hk) (by omega_nat), ↓reduceIte] - ext i hi; simp - have e' := writeBytes_snoc s.mem B (bytesAt s.mem A k) (s.mem (A + BitVec.ofNat 64 k)) - (by rw [hl]; omega_nat) - rw [hl] at e' - rw [u₆.mem, u₅.mem, m₄.mem, v, u₃.mem, u₂.mem, u₁.mem, h.mem, bytesAt_snoc', e'] - · rw [z₆, h9, left_z hk (by omega_nat)] - -/-! ## The exclusive-or of `U` into `T` -/ - -theorem xor_byte32 (a b : Byte) : ((b.setWidth 32 ^^^ a.setWidth 32).setWidth 8) = b ^^^ a := by - ext i hi - simp [BitVec.getElem_xor] - -/-- After `k` bytes of the exclusive-or of `[U]` into `[T]`. -/ -structure XorInv (s : State) (U T : Addr) (n k : Nat) (t : State) : Prop where - rd : t.rd = s.rd - wr : t.wr = s.wr - sp : t.sp = s.sp - other : ∀ r ∉ clob, t.gpr r = s.gpr r - r8 : t.gpr .r8 = BitVec.ofNat 32 k - r9 : t.gpr .r9 = BitVec.ofNat 32 (n - k) - mem : t.mem = writeBytes s.mem T (Spec.Pbkdf2.xorBytes (bytesAt s.mem T k) (bytesAt s.mem U k)) - -/-- `T ← T ⊕ U`, `n` bytes, with `U` at `r11 + uo` and `T` at `r5`. -/ -theorem xor_ok {uo n : Nat} (huo : uo < 4096) (hn : 0 < n) (hn' : n < 2 ^ 16) {s : State} - (huw : (s.gpr .r11).toNat + uo + n ≤ 2 ^ 32) (htw : (s.gpr .r5).toNat + n ≤ 2 ^ 32) - (hinU : ∀ k < n, InRegions (s.rd ++ s.wr) (State.addr (s.gpr .r11) + BitVec.ofNat 64 uo + BitVec.ofNat 64 k) 1) - (houtT : ∀ k < n, InRegions s.wr (State.addr (s.gpr .r5) + BitVec.ofNat 64 k) 1) - (hsep : Region.Disjoint ⟨State.addr (s.gpr .r11) + BitVec.ofNat 64 uo, n⟩ ⟨State.addr (s.gpr .r5), n⟩) : - WP isa (.seq (.block [.mov .r8 (.imm 0), .movw .r9 (BitVec.ofNat 16 n)]) - (.loop (.block [.dp .add .r2 .r11 (.reg .r8), .ldrb .r12 .r2 uo, .dp .add .r2 .r5 (.reg .r8), - .ldrb .r1 .r2 0, .dp .eor .r1 .r1 (.reg .r12), .strb .r1 .r2 0, .dp .add .r8 .r8 (.imm 1), - .subs .r9 .r9 (.imm 1)]) .ne)) s - fun t => XorInv s (State.addr (s.gpr .r11) + BitVec.ofNat 64 uo) (State.addr (s.gpr .r5)) n n t := by - set U := State.addr (s.gpr .r11) + BitVec.ofNat 64 uo - set T := State.addr (s.gpr .r5) - refine WP.seq (wp_mov (op2_imm (by decide)) fun s₀ u₀ => VG.Proof.Hmac.Generic.Arm.wp_movw fun s₁ u₁ => - WP.block_nil ?_) - have i0 : XorInv s U T n 0 s₁ := - ⟨by rw [u₁.rd, u₀.rd], by rw [u₁.wr, u₀.wr], by rw [u₁.sp, u₀.sp], - fun r hr => by rw [u₁.other r (nm hr .r9), u₀.other r (nm hr .r8)], - by rw [u₁.other _ (by decide), u₀.gpr]; rfl, by rw [u₁.gpr, movw_ofNat hn']; rfl, - by rw [u₁.mem, u₀.mem]; simp [bytesAt, Spec.Pbkdf2.xorBytes, writeBytes_nil]⟩ - refine count_loop hn (XorInv s U T n) (fun k hk t h => ?_) i0 - have hl : (bytesAt s.mem T k).length = k := bytesAt_length _ _ _ - have hl' : (Spec.Pbkdf2.xorBytes (bytesAt s.mem T k) (bytesAt s.mem U k)).length = k := by - rw [xorBytes_length' _ _ (by simp [bytesAt_length]), hl] - have rU : t.mem (U + BitVec.ofNat 64 k) = s.mem (U + BitVec.ofNat 64 k) := by - rw [h.mem]; simp only [writeBytes, hl', not_mem_of_disjoint hsep hk (Nat.le_of_lt hk) (by omega_nat), ↓reduceIte] - have rT : t.mem (T + BitVec.ofNat 64 k) = s.mem (T + BitVec.ofNat 64 k) := by - rw [h.mem] - simp only [writeBytes, hl', show T + BitVec.ofNat 64 k - T = BitVec.ofNat 64 k by rw [BitVec.add_comm, BitVec.add_sub_cancel], - BitVec.toNat_ofNat, Nat.mod_eq_of_lt (show k < 2 ^ 64 by omega_nat), Nat.lt_irrefl, ↓reduceIte] - have g11 := h.other .r11 (by decide) - have g5 := h.other .r5 (by decide) - refine wp_add (op2_reg _ _) fun t₁ u₁ => ?_ - refine wp_ldrb (a := U + BitVec.ofNat 64 k) huo (by rw [u₁.gpr, g11, h.r8, addr3 (by omega_nat)]) - (by rw [u₁.rd, u₁.wr, h.rd, h.wr]; exact hinU k hk) fun t₂ u₂ => ?_ - refine wp_add (op2_reg _ _) fun t₃ u₃ => ?_ - have a₃ : State.addr (t₃.gpr .r2 + BitVec.ofNat 32 0) = T + BitVec.ofNat 64 k := by - rw [u₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), u₂.other _ (by decide), - u₁.other _ (by decide), g5, h.r8, addr3 (by omega_nat)] - exact congrArg (· + BitVec.ofNat 64 k) (BitVec.add_zero _) - refine wp_ldrb (a := T + BitVec.ofNat 64 k) (by decide) a₃ - (by rw [u₃.rd, u₃.wr, u₂.rd, u₂.wr, u₁.rd, u₁.wr, h.rd, h.wr]; exact InRegions.right' (houtT k hk)) - fun t₄ u₄ => ?_ - refine wp_eor (op2_reg _ _) fun t₅ u₅ => ?_ - refine wp_strb (a := T + BitVec.ofNat 64 k) (by decide) - (by rw [u₅.other _ (by decide), u₄.other _ (by decide)]; exact a₃) - (by rw [u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr]; exact houtT k hk) fun t₆ m₆ => ?_ - refine wp_add (op2_imm (by decide)) fun t₇ u₇ => wp_subs (op2_imm (by decide)) fun t₈ u₈ z₈ => - WP.block_nil ?_ - have h8 : t₇.gpr .r8 = BitVec.ofNat 32 (k + 1) := by - rw [u₇.gpr, m₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), - u₂.other _ (by decide), u₁.other _ (by decide), h.r8, ofNat_succ32] - have h9 : t₇.gpr .r9 = BitVec.ofNat 32 (n - k) := by - rw [u₇.other _ (by decide), m₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), - u₂.other _ (by decide), u₁.other _ (by decide), h.r9] - refine ⟨⟨by rw [u₈.rd, u₇.rd, m₆.rd, u₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], - by rw [u₈.wr, u₇.wr, m₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], - by rw [u₈.sp, u₇.sp, m₆.sp, u₅.sp, u₄.sp, u₃.sp, u₂.sp, u₁.sp, h.sp], - fun r hr => by - rw [u₈.other r (nm hr .r9), u₇.other r (nm hr .r8), m₆.gpr, u₅.other r (nm hr .r1), u₄.other r (nm hr .r1), - u₃.other r (nm hr .r2), u₂.other r (nm hr .r12), u₁.other r (nm hr .r2), h.other r hr], - by rw [u₈.other _ (by decide), h8], by rw [u₈.gpr, h9, left_val hk], ?_⟩, ?_⟩ - · have hv : (t₅.gpr .r1).setWidth 8 = s.mem (T + BitVec.ofNat 64 k) ^^^ s.mem (U + BitVec.ofNat 64 k) := by - rw [u₅.gpr, u₄.gpr, u₄.other .r12 (by decide), u₃.other .r12 (by decide), u₂.gpr, u₃.mem, u₂.mem, - u₁.mem, xor_byte32, rU, rT] - have e' := writeBytes_snoc s.mem T (Spec.Pbkdf2.xorBytes (bytesAt s.mem T k) (bytesAt s.mem U k)) - (s.mem (T + BitVec.ofNat 64 k) ^^^ s.mem (U + BitVec.ofNat 64 k)) (by rw [hl']; omega_nat) - rw [hl'] at e' - rw [u₈.mem, u₇.mem, m₆.mem, hv, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem, h.mem, e', - bytesAt_snoc', bytesAt_snoc', xorBytes_snoc _ _ _ _ (by simp [bytesAt_length])] - · rw [z₈, h9, left_z hk (by omega_nat)] - -/-! ## `init`'s key and pad loops - -`K₀ ⊕ ipad` is written at `P = scratch + buf` and `K₀ ⊕ opad` at `P + B`, -byte by byte (as on x86-64, `BufMem`): first the key's `kl` bytes (read at -`K`), then the zeros that pad it to `B`. -/ - -variable (H : Hash) - -/-- Where the loops are. -/ -structure LoopRegs (scr kp : BitVec 32) (s : State) : Prop where - r11 : s.gpr .r11 = scr - r6 : s.gpr .r6 = kp - -theorem LoopRegs.keep {scr kp : BitVec 32} {s t : State} (h : LoopRegs scr kp s) - (hk : ∀ r ∉ clob, t.gpr r = s.gpr r) : LoopRegs scr kp t := - ⟨by rw [hk _ (by decide), h.r11], by rw [hk _ (by decide), h.r6]⟩ - -/-- The loops' invariant, from the state `s` they start in. -/ -structure KeyInv (s : State) (P K : Addr) (kl j : Nat) (t : State) : Prop where - rd : t.rd = s.rd - wr : t.wr = s.wr - sp : t.sp = s.sp - other : ∀ r ∉ clob, t.gpr r = s.gpr r - r8 : t.gpr .r8 = BitVec.ofNat 32 j - mem : BufMem H.B P (K0 s.mem K kl H.B) s.mem j t.mem - -/-- The regions the loops access, and the sizes. -/ -structure LoopMem (scr kp : BitVec 32) (kl : Nat) (s : State) : Prop where - kl_le : kl ≤ H.B - key : ∀ k < kl, InRegions (s.rd ++ s.wr) (State.addr kp + BitVec.ofNat 64 k) 1 - buf : ∀ k < 2 * H.B, InRegions s.wr (State.addr scr + BitVec.ofNat 64 H.buf + BitVec.ofNat 64 k) 1 - disj : Region.Disjoint ⟨State.addr kp, kl⟩ ⟨State.addr scr + BitVec.ofNat 64 H.buf, 2 * H.B⟩ - hB : H.B ≤ 128 - hbuf : H.buf + H.B < 4096 - nscr : scr.toNat + H.buf + 2 * H.B ≤ 2 ^ 32 - nkey : kp.toNat + kl ≤ 2 ^ 32 - -/-- The bodies of `init`'s loops. -/ -def keyBody : List Instr := - [.dp .add .r2 .r6 (.reg .r8), .ldrb .r12 .r2 0, .dp .eor .r1 .r12 (.imm 0x36), - .dp .add .r2 .r11 (.reg .r8), .strb .r1 .r2 H.buf, .dp .eor .r1 .r12 (.imm 0x5c), - .strb .r1 .r2 (H.buf + H.B), .dp .add .r8 .r8 (.imm 1), .subs .r9 .r9 (.imm 1)] - -def padBody : List Instr := - [.dp .add .r2 .r11 (.reg .r8), .mov .r1 (.imm 0x36), .strb .r1 .r2 H.buf, - .mov .r1 (.imm 0x5c), .strb .r1 .r2 (H.buf + H.B), .dp .add .r8 .r8 (.imm 1), - .subs .r9 .r9 (.imm 1)] - -theorem keyLoop_eq : H.keyLoop = .loop (.block (keyBody H)) .ne := rfl -theorem padLoop_eq : H.padLoop = .loop (.block (padBody H)) .ne := rfl - -theorem pad_byte32 (b : Byte) (v : BitVec 32) : (b.setWidth 32 ^^^ v).setWidth 8 = b ^^^ v.setWidth 8 := by - ext i hi - simp [BitVec.getElem_setWidth, BitVec.getElem_xor] - -theorem ipad32 : (0x36 : BitVec 32).setWidth 8 = Spec.Hmac.ipad := by decide -theorem opad32 : (0x5c : BitVec 32).setWidth 8 = Spec.Hmac.opad := by decide -theorem zero_ipad : (0x36 : BitVec 32).setWidth 8 = (0 : Byte) ^^^ Spec.Hmac.ipad := by decide -theorem zero_opad : (0x5c : BitVec 32).setWidth 8 = (0 : Byte) ^^^ Spec.Hmac.opad := by decide - -theorem key_step {scr kp : BitVec 32} {kl : Nat} {s : State} (hr : LoopRegs scr kp s) - (hm : LoopMem H scr kp kl s) {j : Nat} (hj : j < kl) {t : State} - (h : KeyInv H s (State.addr scr + BitVec.ofNat 64 H.buf) (State.addr kp) kl j t) - (h9 : t.gpr .r9 = BitVec.ofNat 32 (kl - j)) : - WP isa (.block (keyBody H)) t fun t' => (KeyInv H s (State.addr scr + BitVec.ofNat 64 H.buf) (State.addr kp) kl (j + 1) t' ∧ - t'.gpr .r9 = BitVec.ofNat 32 (kl - (j + 1))) ∧ t'.z = decide (kl - (j + 1) = 0) := by - have hkl := hm.kl_le - have hB := hm.hB - have hbuf := hm.hbuf - have hn := hm.nscr - have hnk := hm.nkey - set P := State.addr scr + BitVec.ofNat 64 H.buf - set K := State.addr kp - have hl : j < (K0 s.mem K kl H.B).length := by rw [K0_length _ _ hkl]; omega_nat - have rt := hr.keep h.other - have hbyte : t.mem (K + BitVec.ofNat 64 j) = (K0 s.mem K kl H.B)[j] := by - rw [K0_lt hj hl] - refine h.mem.frame _ fun r hr' hc => ?_ - simp only [List.mem_singleton] at hr'; subst hr' - exact hm.disj _ (Proof.MdStream.Arm.contains_offset (n := 1) (by omega_nat) (by omega_nat)) hc - refine wp_add (op2_reg _ _) fun t₁ u₁ => ?_ - refine wp_ldrb (a := K + BitVec.ofNat 64 j) (by decide) - (by rw [u₁.gpr, rt.r6, h.r8, addr3 (by omega_nat)]; exact congrArg (· + BitVec.ofNat 64 j) (BitVec.add_zero _)) - (by rw [u₁.rd, u₁.wr, h.rd, h.wr]; exact hm.key j hj) fun t₂ u₂ => ?_ - refine wp_eor (op2_imm (by decide)) fun t₃ u₃ => ?_ - refine wp_add (op2_reg _ _) fun t₄ u₄ => ?_ - have a4 : ∀ o, o + j < 2 ^ 32 - scr.toNat → State.addr (t₄.gpr .r2 + BitVec.ofNat 32 o) = - State.addr scr + BitVec.ofNat 64 o + BitVec.ofNat 64 j := fun o ho => by - rw [u₄.gpr, u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), rt.r11, - u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), h.r8, addr3 (by omega_nat)] - refine wp_strb (a := P + BitVec.ofNat 64 j) (by omega_nat) (a4 _ (by omega_nat)) - (by rw [u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr]; exact hm.buf j (by omega_nat)) fun t₅ m₅ => ?_ - refine wp_eor (op2_imm (by decide)) fun t₆ u₆ => ?_ - refine wp_strb (a := P + BitVec.ofNat 64 H.B + BitVec.ofNat 64 j) hbuf - (by rw [u₆.other _ (by decide), m₅.gpr, a4 _ (by omega_nat)]; simp only [P, add_ofNat_add]) - (by rw [u₆.wr, m₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr, add_ofNat_add]; exact hm.buf (H.B + j) (by omega_nat)) - fun t₇ m₇ => ?_ - refine wp_add (op2_imm (by decide)) fun t₈ u₈ => wp_subs (op2_imm (by decide)) fun t₉ u₉ z₉ => - WP.block_nil ?_ - have k : ∀ r ∉ clob, t₉.gpr r = t.gpr r := fun r hr' => by - rw [u₉.other r (nm hr' .r9), u₈.other r (nm hr' .r8), m₇.gpr, u₆.other r (nm hr' .r1), m₅.gpr, - u₄.other r (nm hr' .r2), u₃.other r (nm hr' .r1), u₂.other r (nm hr' .r12), u₁.other r (nm hr' .r2)] - have h8 : t₈.gpr .r8 = BitVec.ofNat 32 (j + 1) := by - rw [u₈.gpr, m₇.gpr, u₆.other _ (by decide), m₅.gpr, u₄.other _ (by decide), u₃.other _ (by decide), - u₂.other _ (by decide), u₁.other _ (by decide), h.r8, ofNat_succ32] - have h9' : t₈.gpr .r9 = BitVec.ofNat 32 (kl - j) := by - rw [u₈.other _ (by decide), m₇.gpr, u₆.other _ (by decide), m₅.gpr, u₄.other _ (by decide), - u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), h9] - refine ⟨⟨⟨by rw [u₉.rd, u₈.rd, m₇.rd, u₆.rd, m₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], - by rw [u₉.wr, u₈.wr, m₇.wr, u₆.wr, m₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], - by rw [u₉.sp, u₈.sp, m₇.sp, u₆.sp, m₅.sp, u₄.sp, u₃.sp, u₂.sp, u₁.sp, h.sp], - fun r hr' => by rw [k r hr', h.other r hr'], by rw [u₉.other _ (by decide), h8], ?_⟩, - by rw [u₉.gpr, h9', left_val hj]⟩, by rw [z₉, h9', left_z hj (by omega_nat)]⟩ - have r12 : t₃.gpr .r12 = (t.mem (K + BitVec.ofNat 64 j)).setWidth 32 := by - rw [u₃.other _ (by decide), u₂.gpr, u₁.mem] - have v₁ : (t₄.gpr .r1).setWidth 8 = (K0 s.mem K kl H.B)[j] ^^^ Spec.Hmac.ipad := by - rw [u₄.other _ (by decide), u₃.gpr, u₂.gpr, u₁.mem, pad_byte32, hbyte, ipad32] - have v₂ : (t₆.gpr .r1).setWidth 8 = (K0 s.mem K kl H.B)[j] ^^^ Spec.Hmac.opad := by - rw [u₆.gpr, m₅.gpr, u₄.other .r12 (by decide), r12, pad_byte32, hbyte, opad32] - rw [u₉.mem, u₈.mem, m₇.mem, v₂, u₆.mem, m₅.mem, v₁, u₄.mem, u₃.mem, u₂.mem, u₁.mem] - exact buf_write h.mem hB (by omega_nat) hl - -theorem pad_step {scr kp : BitVec 32} {kl : Nat} {s₀ : State} (hr : LoopRegs scr kp s₀) - (hm : LoopMem H scr kp kl s₀) {j : Nat} (hj : kl ≤ j) (hj' : j < H.B) {t : State} - (h : KeyInv H s₀ (State.addr scr + BitVec.ofNat 64 H.buf) (State.addr kp) kl j t) - (h9 : t.gpr .r9 = BitVec.ofNat 32 (H.B - j)) : - WP isa (.block (padBody H)) t fun t' => - (KeyInv H s₀ (State.addr scr + BitVec.ofNat 64 H.buf) (State.addr kp) kl (j + 1) t' ∧ - t'.gpr .r9 = BitVec.ofNat 32 (H.B - (j + 1))) ∧ t'.z = decide (H.B - (j + 1) = 0) := by - have hkl := hm.kl_le - have hB := hm.hB - have hbuf := hm.hbuf - have hn := hm.nscr - set P := State.addr scr + BitVec.ofNat 64 H.buf - set K := State.addr kp - have hl : j < (K0 s₀.mem K kl H.B).length := by rw [K0_length _ _ hkl]; omega_nat - have rt := hr.keep h.other - refine wp_add (op2_reg _ _) fun t₁ u₁ => ?_ - have a1 : ∀ o, o + j < 2 ^ 32 - scr.toNat → State.addr (t₁.gpr .r2 + BitVec.ofNat 32 o) = - State.addr scr + BitVec.ofNat 64 o + BitVec.ofNat 64 j := fun o ho => by - rw [u₁.gpr, rt.r11, h.r8, addr3 (by omega_nat)] - refine wp_mov (op2_imm (by decide)) fun t₂ u₂ => ?_ - refine wp_strb (a := P + BitVec.ofNat 64 j) (by omega_nat) (by rw [u₂.other _ (by decide)]; exact a1 _ (by omega_nat)) - (by rw [u₂.wr, u₁.wr, h.wr]; exact hm.buf j (by omega_nat)) fun t₃ m₃ => ?_ - refine wp_mov (op2_imm (by decide)) fun t₄ u₄ => ?_ - refine wp_strb (a := P + BitVec.ofNat 64 H.B + BitVec.ofNat 64 j) hbuf - (by rw [u₄.other _ (by decide), m₃.gpr, u₂.other _ (by decide), a1 _ (by omega_nat)]; simp only [P, add_ofNat_add]) - (by rw [u₄.wr, m₃.wr, u₂.wr, u₁.wr, h.wr, add_ofNat_add]; exact hm.buf (H.B + j) (by omega_nat)) fun t₅ m₅ => ?_ - refine wp_add (op2_imm (by decide)) fun t₆ u₆ => wp_subs (op2_imm (by decide)) fun t₇ u₇ z₇ => - WP.block_nil ?_ - have h8 : t₆.gpr .r8 = BitVec.ofNat 32 (j + 1) := by - rw [u₆.gpr, m₅.gpr, u₄.other _ (by decide), m₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), h.r8, - ofNat_succ32] - have h9' : t₆.gpr .r9 = BitVec.ofNat 32 (H.B - j) := by - rw [u₆.other _ (by decide), m₅.gpr, u₄.other _ (by decide), m₃.gpr, u₂.other _ (by decide), - u₁.other _ (by decide), h9] - refine ⟨⟨⟨by rw [u₇.rd, u₆.rd, m₅.rd, u₄.rd, m₃.rd, u₂.rd, u₁.rd, h.rd], - by rw [u₇.wr, u₆.wr, m₅.wr, u₄.wr, m₃.wr, u₂.wr, u₁.wr, h.wr], - by rw [u₇.sp, u₆.sp, m₅.sp, u₄.sp, m₃.sp, u₂.sp, u₁.sp, h.sp], - fun r hr' => by - rw [u₇.other r (nm hr' .r9), u₆.other r (nm hr' .r8), m₅.gpr, u₄.other r (nm hr' .r1), m₃.gpr, - u₂.other r (nm hr' .r1), u₁.other r (nm hr' .r2), h.other r hr'], - by rw [u₇.other _ (by decide), h8], ?_⟩, by rw [u₇.gpr, h9', left_val hj']⟩, - by rw [z₇, h9', left_z hj' (by omega_nat)]⟩ - rw [u₇.mem, u₆.mem, m₅.mem, u₄.gpr, u₄.mem, m₃.mem, u₂.gpr, u₂.mem, u₁.mem, zero_ipad, zero_opad, - ← K0_ge (m := s₀.mem) (K := K) (B := H.B) hj hl] - exact buf_write h.mem hB hj' hl - -/-- The key loop, skipped for an empty key: from `r8 = 0`, `r9 = kl` and the flags of `kl = 0`. -/ -theorem key_ok {scr kp : BitVec 32} {kl : Nat} {s : State} (hr : LoopRegs scr kp s) (hm : LoopMem H scr kp kl s) - (h8 : s.gpr .r8 = BitVec.ofNat 32 0) (h9 : s.gpr .r9 = BitVec.ofNat 32 kl) (hz : s.z = decide (kl = 0)) : - WP isa (.ite .eq (.block []) H.keyLoop) s - (KeyInv H s (State.addr scr + BitVec.ofNat 64 H.buf) (State.addr kp) kl kl) := by - have hkl := hm.kl_le - have hB := hm.hB - have i0 : KeyInv H s (State.addr scr + BitVec.ofNat 64 H.buf) (State.addr kp) kl 0 s := - ⟨rfl, rfl, rfl, fun _ _ => rfl, h8, ⟨by simp [bytesAt], by simp [bytesAt], Frame.refl _ _⟩⟩ - refine WP.ite (decide (kl = 0)) (by show eval .eq s = _; rw [VG.Proof.MdStream.Arm.eval_eq, hz]) - (fun h0 => WP.block_nil ?_) fun h0 => ?_ - · have : kl = 0 := by simpa using h0 - subst this; exact i0 - · have hpos : 0 < kl := by simp at h0; omega_nat - rw [keyLoop_eq] - exact WP.mono (count_loop hpos (fun k t => KeyInv H s (State.addr scr + BitVec.ofNat 64 H.buf) (State.addr kp) kl k t ∧ - t.gpr .r9 = BitVec.ofNat 32 (kl - k)) - (fun k hk t ⟨h, h9'⟩ => key_step H hr hm hk h h9') ⟨i0, by rw [h9, Nat.sub_zero]⟩) fun _ h => h.1 - -/-- The pad loop, skipped for a key of `B` bytes: from `r8 = kl`. -/ -theorem pad_ok {scr kp : BitVec 32} {kl : Nat} {s₀ : State} (hr : LoopRegs scr kp s₀) (hm : LoopMem H scr kp kl s₀) - {t : State} (h : KeyInv H s₀ (State.addr scr + BitVec.ofNat 64 H.buf) (State.addr kp) kl kl t) : - WP isa (.seq (.block [.movw .r9 (BitVec.ofNat 16 H.B), .subs .r9 .r9 (.reg .r8)]) - (.ite .eq (.block []) H.padLoop)) t - (KeyInv H s₀ (State.addr scr + BitVec.ofNat 64 H.buf) (State.addr kp) kl H.B) := by - have hkl := hm.kl_le - have hB := hm.hB - refine WP.seq (VG.Proof.Hmac.Generic.Arm.wp_movw fun t₁ u₁ => wp_subs (op2_reg _ _) fun t₂ u₂ z₂ => - WP.block_nil ?_) - have e9 : t₁.gpr .r9 - t₁.gpr .r8 = BitVec.ofNat 32 (H.B - kl) := by - rw [u₁.gpr, u₁.other _ (by decide), h.r8, movw_ofNat (by omega_nat), sub_ofNat hkl] - have i0 : KeyInv H s₀ (State.addr scr + BitVec.ofNat 64 H.buf) (State.addr kp) kl kl t₂ := - ⟨by rw [u₂.rd, u₁.rd, h.rd], by rw [u₂.wr, u₁.wr, h.wr], by rw [u₂.sp, u₁.sp, h.sp], - fun r hr' => by rw [u₂.other r (nm hr' .r9), u₁.other r (nm hr' .r9), h.other r hr'], - by rw [u₂.other _ (by decide), u₁.other _ (by decide), h.r8], by rw [u₂.mem, u₁.mem]; exact h.mem⟩ - have hz : t₂.z = decide (kl = H.B) := by - rw [z₂, e9, VG.Proof.MdStream.Arm.ofNat_beq_zero (by omega_nat)] - exact decide_eq_decide.mpr (by omega_nat) - refine WP.ite (decide (kl = H.B)) (by show eval .eq t₂ = _; rw [VG.Proof.MdStream.Arm.eval_eq, hz]) - (fun h0 => WP.block_nil ?_) fun h0 => ?_ - · have : kl = H.B := by simpa using h0 - exact this ▸ i0 - · have hlt : kl < H.B := by simp at h0; omega_nat - rw [padLoop_eq] - have := count_loop (n := H.B - kl) (by omega_nat) - (fun k t => KeyInv H s₀ (State.addr scr + BitVec.ofNat 64 H.buf) (State.addr kp) kl (kl + k) t ∧ - t.gpr .r9 = BitVec.ofNat 32 (H.B - (kl + k))) - (fun k hk t ⟨hk', h9⟩ => WP.mono (pad_step H hr hm (j := kl + k) (by omega_nat) (by omega_nat) hk' h9) - fun t' ⟨⟨a, b⟩, c⟩ => ⟨⟨by rw [← Nat.add_assoc]; exact a, by rw [b, Nat.add_assoc]⟩, - by rw [c]; exact decide_eq_decide.mpr (by omega_nat)⟩) - (s := t₂) ⟨by simpa using i0, by rw [u₂.gpr, e9, Nat.add_zero]⟩ - rw [show kl + (H.B - kl) = H.B by omega_nat] at this - exact WP.mono this fun _ h => h.1 - -end VG.Proof.Hmac.Generic.Arm - -/-! -# HMAC over any streaming hash function on 32-bit ARM: our caller's registers - -As on AArch64 (`Proof/Hmac/Generic/AArch64/Init.lean`): the callee-saved -registers we use, and our return address `lr`, are stored in `scratch` after -the working space of the functions we call (`Hash.saved`), with `scratch` in -`r12`, and loaded back at the end, with `scratch` in `r11`, which is loaded -last. --/ - -namespace VG.Proof.Hmac.Generic.Arm - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash) -open VG.Proof.MdStream.Arm (contains_offset) -open VG.Proof.MdStream.Arm (Upd wp_ldr saveMem saveList_ok readW_writeW_save sub_offset) -open VG.Proof.Hmac.Generic.Common (InRegions.right' add_ofNat_add) - -variable (H : Hash) - -/-- The registers saved, in the order of their slots. -/ -abbrev savedRegs : List Reg := [.r4, .r5, .r6, .r7, .r8, .r9, .r10, .lr, .r11] - -theorem preserved_saved : ∀ r ∈ preserved, r ∈ savedRegs := by decide - -/-- Where the registers are saved. -/ -abbrev saveR (scr : BitVec 32) : Region := ⟨State.addr scr + BitVec.ofNat 64 (8 * H.W), 36⟩ - -/-- The registers of `s₀` saved in the memory `m`. -/ -def SavedRegs (scr : BitVec 32) (s₀ : State) (m : Mem) : Prop := - ∀ p ∈ H.saved, m.readW (State.addr scr + BitVec.ofNat 64 p.2) 32 = s₀.gpr p.1 - -theorem saved_mem {p : Reg × Nat} (hp : p ∈ H.saved) : 8 * H.W ≤ p.2 ∧ p.2 + 4 ≤ 8 * H.W + 36 := by - simp only [Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp - rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> simp only <;> omega_nat - -theorem saved_pairwise : H.saved.Pairwise (fun p q => p.2 + 4 ≤ q.2 ∨ q.2 + 4 ≤ p.2) := by - simp [Hash.saved] - -/-- Slot `d` of the save area. -/ -theorem slot_sub (scr : BitVec 32) {d : Nat} (h₁ : 8 * H.W ≤ d) (h₂ : d + 4 ≤ 8 * H.W + 36) : - Region.Sub ⟨State.addr scr + BitVec.ofNat 64 d, 4⟩ (saveR H scr) := by - rw [show d = 8 * H.W + (d - 8 * H.W) by omega_nat, ← add_ofNat_add] - exact sub_offset (by omega_nat) (by omega_nat) - -theorem SavedRegs.frame {scr : BitVec 32} {s₀ : State} {m m' : Mem} (h : SavedRegs H scr s₀ m) - {rs : List Region} (hf : Frame rs m m') (hd : ∀ r ∈ rs, (saveR H scr).Disjoint r) : - SavedRegs H scr s₀ m' := fun p hp => by - obtain ⟨h₁, h₂⟩ := saved_mem H hp - rw [← h p hp] - exact hf.readW (r := ⟨_, 4⟩) (Region.contains_self _ _) - (fun r hr => (hd r hr).sub_left (slot_sub H scr h₁ h₂)) (by decide) - -theorem saveMem_other (m : Mem) (B : Addr) (g : Reg → BitVec 32) {d : Nat} (hd : d < 2 ^ 32) : - ∀ l : List (Reg × Nat), (∀ q ∈ l, q.2 < 2 ^ 32 ∧ (d + 4 ≤ q.2 ∨ q.2 + 4 ≤ d)) → - (saveMem m B g l).readW (B + BitVec.ofNat 64 d) 32 = m.readW (B + BitVec.ofNat 64 d) 32 - | [], _ => rfl - | q :: l, h => by - rw [saveMem, saveMem_other _ B g hd l fun q' hq' => h q' (List.mem_cons_of_mem _ hq'), - readW_writeW_save _ _ _ hd (h q (by simp)).1 (h q (by simp)).2] - -theorem saveMem_read (B : Addr) (g : Reg → BitVec 32) : - ∀ (m : Mem) (l : List (Reg × Nat)), l.Pairwise (fun p q => p.2 + 4 ≤ q.2 ∨ q.2 + 4 ≤ p.2) → - (∀ p ∈ l, p.2 < 2 ^ 32) → ∀ p ∈ l, (saveMem m B g l).readW (B + BitVec.ofNat 64 p.2) 32 = g p.1 - | _, [], _, _, p, hp => by cases hp - | m, q :: l, hpw, hb, p, hp => by - rw [List.pairwise_cons] at hpw - rcases List.mem_cons.mp hp with rfl | hp - · rw [saveMem, saveMem_other _ _ _ (hb p (by simp)) l - (fun q' hq' => ⟨hb q' (List.mem_cons_of_mem _ hq'), hpw.1 q' hq'⟩), Mem.readW_writeW_self32] - · rw [saveMem] - exact saveMem_read B g _ l hpw.2 (fun q' hq' => hb q' (List.mem_cons_of_mem _ hq')) p hp - -theorem saveMem_frameR (B : Addr) (g : Reg → BitVec 32) (o L : Nat) (hL : o + L < 2 ^ 64) : - ∀ (m : Mem) (l : List (Reg × Nat)), (∀ p ∈ l, o ≤ p.2 ∧ p.2 + 4 ≤ o + L) → - Frame [⟨B + BitVec.ofNat 64 o, L⟩] m (saveMem m B g l) - | _, [], _ => Frame.refl _ _ - | m, p :: l, hl => by - obtain ⟨h₁, h₂⟩ := hl p (by simp) - have c : (⟨B + BitVec.ofNat 64 o, L⟩ : Region).Contains (B + BitVec.ofNat 64 p.2) (32 / 8) := by - rw [show p.2 = o + (p.2 - o) by omega_nat, ← add_ofNat_add] - exact contains_offset (by omega_nat) (by omega_nat) - exact ((Frame.refl _ _).writeW (List.mem_singleton_self _) _ c).trans - (saveMem_frameR B g o L hL _ l fun q hq => hl q (List.mem_cons_of_mem _ hq)) - -theorem save_eq : H.save = H.saved.map (fun p => Instr.str p.1 .r12 p.2) := rfl - -/-- Saving the registers, with `scratch` in `r12`. -/ -theorem save_ok {s : State} {scr : BitVec 32} {L : Nat} (h12 : s.gpr .r12 = scr) (hW : H.W ≤ 64) - (hsc : ⟨State.addr scr, L⟩ ∈ s.wr) (hL : 8 * H.W + 36 ≤ L) (hfit : scr.toNat + L ≤ 2 ^ 32) - {rest : List Instr} {Q : State → Prop} - (k : ∀ s', s'.gpr = s.gpr → s'.rd = s.rd → s'.wr = s.wr → s'.sp = s.sp → - Frame [saveR H scr] s.mem s'.mem → SavedRegs H scr s s'.mem → WP isa (.block rest) s' Q) : - WP isa (.block (H.save ++ rest)) s Q := by - rw [save_eq] - refine saveList_ok H.saved s Q (fun p hp => ?_) fun s' g rd wr sp m => k s' g rd wr sp ?_ ?_ - · obtain ⟨h₁, h₂⟩ := saved_mem H hp - rw [h12] - exact ⟨by omega_nat, by omega_nat, ⟨_, hsc, contains_offset (by omega_nat) (by omega_nat)⟩⟩ - · rw [m, h12] - exact saveMem_frameR _ _ _ _ (by omega_nat) _ _ fun p hp => saved_mem H hp - · intro p hp - rw [m, h12] - exact saveMem_read _ _ _ _ (saved_pairwise H) (fun q hq => by have := saved_mem H hq; omega_nat) p hp - -theorem restoreList_ok {b : Reg} {rest : List Instr} (l : List (Reg × Nat)) : - ∀ (s : State) (Q : State → Prop), (l.map Prod.fst).Nodup → - (∀ p ∈ l, p.1 ≠ b ∧ p.2 < 4096 ∧ (s.gpr b).toNat + p.2 < 2 ^ 32 ∧ - InRegions (s.rd ++ s.wr) (State.addr (s.gpr b) + BitVec.ofNat 64 p.2) 4) → - (∀ s', (∀ p ∈ l, s'.gpr p.1 = s.mem.readW (State.addr (s.gpr b) + BitVec.ofNat 64 p.2) 32) → - (∀ r, r ∉ l.map Prod.fst → s'.gpr r = s.gpr r) → s'.mem = s.mem → s'.rd = s.rd → s'.wr = s.wr → - s'.sp = s.sp → WP isa (.block rest) s' Q) → - WP isa (.block (l.map (fun p => Instr.ldr p.1 b p.2) ++ rest)) s Q := by - induction l with - | nil => intro s Q _ _ k; exact k s (fun _ h => by cases h) (fun _ _ => rfl) rfl rfl rfl rfl - | cons p l ih => - intro s Q hnd hl k - obtain ⟨h0, h1, h2, h3⟩ := hl p (by simp) - simp only [List.map_cons, List.nodup_cons] at hnd - refine wp_ldr h1 (addr_add h2) h3 fun s₁ u₁ => ?_ - have eb : s₁.gpr b = s.gpr b := u₁.other _ (Ne.symm h0) - refine ih s₁ Q hnd.2 (fun q hq => ?_) fun s' hl' ho hm hrd hwr hsp => k s' (fun q hq => ?_) - (fun r hr => ?_) (hm.trans u₁.mem) (hrd.trans u₁.rd) (hwr.trans u₁.wr) (hsp.trans u₁.sp) - · rw [eb, u₁.rd, u₁.wr]; exact hl q (List.mem_cons_of_mem _ hq) - · rcases List.mem_cons.mp hq with rfl | hq - · rw [ho _ hnd.1, u₁.gpr] - · rw [hl' q hq, u₁.mem, eb] - · simp only [List.map_cons, List.mem_cons, not_or] at hr - rw [ho r hr.2, u₁.other r hr.1] - -/-- The slots loaded before `r11`. -/ -def saved8 : List (Reg × Nat) := - [(.r4, 8 * H.W), (.r5, 8 * H.W + 4), (.r6, 8 * H.W + 8), (.r7, 8 * H.W + 12), (.r8, 8 * H.W + 16), - (.r9, 8 * H.W + 20), (.r10, 8 * H.W + 24), (.lr, 8 * H.W + 28)] - -theorem restore_eq : - H.restore = (saved8 H).map (fun p => Instr.ldr p.1 .r11 p.2) ++ ([.ldr .r11 .r11 (8 * H.W + 32)] : List Instr) := rfl - -theorem saved8_fst : (saved8 H).map Prod.fst = [.r4, .r5, .r6, .r7, .r8, .r9, .r10, .lr] := rfl - -theorem saved8_sub {p : Reg × Nat} (hp : p ∈ saved8 H) : p ∈ H.saved := by - simp only [saved8, Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp ⊢ - rcases hp with h | h | h | h | h | h | h | h <;> simp [h] - -/-- Loading them back, with `scratch` in `r11` (loaded last). -/ -theorem restore_ok {s : State} {scr : BitVec 32} {L : Nat} (h11 : s.gpr .r11 = scr) (hW : H.W ≤ 64) - {s₀ : State} (hs : SavedRegs H scr s₀ s.mem) (hsc : ⟨State.addr scr, L⟩ ∈ s.wr) (hL : 8 * H.W + 36 ≤ L) - (hfit : scr.toNat + L ≤ 2 ^ 32) : - WP isa (.block H.restore) s fun s' => s'.mem = s.mem ∧ s'.rd = s.rd ∧ s'.wr = s.wr ∧ - s'.sp = s.sp ∧ (∀ r ∈ savedRegs, s'.gpr r = s₀.gpr r) ∧ - (∀ r, r ∉ savedRegs → s'.gpr r = s.gpr r) := by - have io : ∀ {t : State}, t.rd = s.rd → t.wr = s.wr → ∀ {d}, d + 4 ≤ L → - InRegions (t.rd ++ t.wr) (State.addr scr + BitVec.ofNat 64 d) 4 := fun hr hw d hd => by - rw [hr, hw]; exact InRegions.right' ⟨_, hsc, contains_offset hd (by omega_nat)⟩ - rw [restore_eq] - refine restoreList_ok (saved8 H) s _ (by rw [saved8_fst]; decide) (fun p hp => ?_) - fun s₁ hl ho hm hrd hwr hsp => ?_ - · have := saved_mem H (saved8_sub H hp) - refine ⟨?_, by omega_nat, by rw [h11]; omega_nat, by rw [h11]; exact io rfl rfl (by omega_nat)⟩ - simp only [saved8, List.mem_cons, List.not_mem_nil, or_false] at hp - rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> (dsimp only; decide) - have e11 : s₁.gpr .r11 = scr := by - rw [ho _ (by rw [saved8_fst]; decide), h11] - refine wp_ldr (by omega_nat) (addr_add (by rw [e11]; omega_nat)) (by rw [e11]; exact io hrd hwr (by omega_nat)) - fun s₂ u => WP.block_nil ⟨by rw [u.mem, hm], by rw [u.rd, hrd], by rw [u.wr, hwr], by rw [u.sp, hsp], - fun r hr => ?_, fun r hr => ?_⟩ - · have hv : ∀ p ∈ saved8 H, s₂.gpr p.1 = s₀.gpr p.1 := fun p hp => by - have h1 : p.1 ≠ .r11 := by - simp only [saved8, List.mem_cons, List.not_mem_nil, or_false] at hp - rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> (dsimp only; decide) - rw [u.other _ h1, hl p hp, h11, hs p (saved8_sub H hp)] - simp only [savedRegs, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl - · exact hv (.r4, 8 * H.W) (by simp [saved8]) - · exact hv (.r5, 8 * H.W + 4) (by simp [saved8]) - · exact hv (.r6, 8 * H.W + 8) (by simp [saved8]) - · exact hv (.r7, 8 * H.W + 12) (by simp [saved8]) - · exact hv (.r8, 8 * H.W + 16) (by simp [saved8]) - · exact hv (.r9, 8 * H.W + 20) (by simp [saved8]) - · exact hv (.r10, 8 * H.W + 24) (by simp [saved8]) - · exact hv (.lr, 8 * H.W + 28) (by simp [saved8]) - · rw [u.gpr, e11, hm, hs (.r11, 8 * H.W + 32) (by simp [Hash.saved])] - · simp only [savedRegs, List.mem_cons, List.not_mem_nil, or_false, not_or] at hr - rw [u.other r hr.2.2.2.2.2.2.2.2, ho r (by - rw [saved8_fst] - simp only [List.mem_cons, List.not_mem_nil, or_false, not_or]; exact ⟨hr.1, hr.2.1, hr.2.2.1, - hr.2.2.2.1, hr.2.2.2.2.1, hr.2.2.2.2.2.1, hr.2.2.2.2.2.2.1, hr.2.2.2.2.2.2.2.1⟩)] - -theorem saved_ne {p : Reg × Nat} (hp : p ∈ H.saved) {r : Reg} (hr : r ∉ savedRegs) : p.1 ≠ r := by - rintro rfl - simp only [Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp - rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> simp at hr - -/-- The registers saved from a state that agrees on them. -/ -theorem SavedRegs.of_eq {scr : BitVec 32} {s₀ s₁ : State} {m : Mem} (h : SavedRegs H scr s₁ m) - (he : ∀ r ∈ savedRegs, s₁.gpr r = s₀.gpr r) : SavedRegs H scr s₀ m := fun p hp => by - rw [h p hp] - refine he _ ?_ - simp only [Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp - rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> simp - -/-! ## Odds and ends -/ - -theorem below_eq {s t : State} (h : s.sp = t.sp) : below s = below t := by simp only [below, h] - -theorem toNat_addr (a : BitVec 32) : (State.addr a).toNat = a.toNat := by - simp only [State.addr, BitVec.toNat_setWidth] - exact Nat.mod_eq_of_lt (by have := a.isLt; omega_nat) - -theorem covers_one {rs : List Region} {r : Region} (h : r ∈ rs) : Covers [r] rs := - Covers.of_sub fun r' hr' => by - simp only [List.mem_singleton] at hr' - exact ⟨r, h, 0, by rw [hr']; simp, by rw [hr']; simp⟩ - -end VG.Proof.Hmac.Generic.Arm - -/-! -# HMAC over any streaming hash function on 32-bit ARM: `init`, correct - -As on AArch64 (`Proof/Hmac/Generic/AArch64/Init.lean`). `scratch` is a stack -argument, loaded into `r12` first; every callee-saved register (and `lr`) is -saved in it, and loaded back at the end. The functions we call keep -`r4`–`r11`, which hold our variables. --/ - -namespace VG.Proof.Hmac.Generic.Arm.Init - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash scrAt) -open VG.Proof.Hmac.Generic.Arm -open VG.Proof.MdStream.Arm (contains_offset) -open VG.Proof.MdStream.Arm (Upd Fupd wp_mov wp_add wp_cmp wp_ldrSp op2_imm op2_reg sub_offset - ofNat_beq_zero) -open VG.Proof.Hmac.Generic.Common (add_ofNat_add bytesAt_prefix_congr inRegions_of_sub K0 K0_length - off_disj off_disj0 sub_of_off sub_of_self bytes_keep take_map_xor) -open Spec.Sha256 (bytesAt) -open Spec.Hmac (xorPad ipad opad blockKey) - -variable {H : Hash} (hH : HashOK H) (sc : Nat) - -section -variable (s₀ : State) - -abbrev inn : BitVec 32 := s₀.gpr .r0 -abbrev out : BitVec 32 := s₀.gpr .r1 -abbrev kp : BitVec 32 := s₀.gpr .r2 -abbrev kl : Nat := (s₀.gpr .r3).toNat -abbrev scr : BitVec 32 := stackArg s₀ 0 -abbrev inR : Region := ⟨State.addr (inn s₀), H.S⟩ -abbrev outR : Region := ⟨State.addr (out s₀), H.S⟩ -abbrev keyR : Region := ⟨State.addr (kp s₀), kl s₀⟩ -abbrev scR : Region := ⟨State.addr (scr s₀), 8 * sc⟩ -abbrev argR : Region := ⟨stackArgAddr s₀ 0, 4⟩ -abbrev stkR : Region := below s₀ -/-- The padded keys. -/ -abbrev P : Addr := State.addr (scr s₀) + BitVec.ofNat 64 H.buf -abbrev bufR : Region := ⟨P (H := H) s₀, 2 * H.B⟩ -abbrev calR : Region := ⟨State.addr (scr s₀), hH.Wb⟩ -/-- Byte `o` of `scratch`, as a register holds it. -/ -abbrev dO (o : Nat) : BitVec 32 := scr s₀ + BitVec.ofNat 32 o - -end - -theorem kl_lt (s₀ : State) : kl s₀ < 2 ^ 32 := (s₀.gpr .r3).isLt - -/-- The precondition, with the sizes of `H`. -/ -structure Pre (s₀ : State) : Prop where - kl_le : kl s₀ ≤ H.B - rd : s₀.rd = [keyR s₀, argR s₀] - wr : s₀.wr = [inR (H := H) s₀, outR (H := H) s₀, scR sc s₀] - i_o : (inR (H := H) s₀).Disjoint (outR (H := H) s₀) - i_s : (inR (H := H) s₀).Disjoint (scR sc s₀) - o_s : (outR (H := H) s₀).Disjoint (scR sc s₀) - k_s : (keyR s₀).Disjoint (scR sc s₀) - a_i : (argR s₀).Disjoint (inR (H := H) s₀) - a_o : (argR s₀).Disjoint (outR (H := H) s₀) - a_s : (argR s₀).Disjoint (scR sc s₀) - b_i : (stkR s₀).Disjoint (inR (H := H) s₀) - b_o : (stkR s₀).Disjoint (outR (H := H) s₀) - b_s : (stkR s₀).Disjoint (scR sc s₀) - ni : (inn s₀).toNat + H.S ≤ 2 ^ 32 - no : (out s₀).toNat + H.S ≤ 2 ^ 32 - nk : (kp s₀).toNat + kl s₀ ≤ 2 ^ 32 - nw : (scr s₀).toNat + 8 * sc ≤ 2 ^ 32 - sp16 : 16 ≤ s₀.sp.toNat - spf : s₀.sp.toNat + 4 ≤ 2 ^ 32 - fits : H.buf + 2 * H.B ≤ 8 * sc - hB : H.B ≤ 128 - hW : H.W ≤ 64 - hS : H.S ≤ 256 - -theorem pre_of {s₀ : State} (h : (initG hH.SH sc).pre s₀) (hfit : H.buf + 2 * H.B ≤ 8 * sc) : - Pre (H := H) sc s₀ := by - obtain ⟨h0, h1, h2, h3, h4, h5, _, _, h8, h9, h10, h11, h12, h13, _, h15, h16, h17, h18, h19, h20, h21⟩ := h - have hS := hH.hS - have hB := hH.hB - simp only [hS, hB] at * - exact ⟨h0, h1, h2, h3, h4, h5, h8, h9, h10, h11, h12, h13, h15, h16, h17, h18, h19, h20, h21, hfit, hH.hBB, - hH.hW, hH.hSB⟩ - -/-! ## The parts of `scratch` -/ - -section -variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) -include hp - -theorem sub_sc {o n : Nat} (h : o + n ≤ 8 * sc) : - Region.Sub ⟨State.addr (scr s₀) + BitVec.ofNat 64 o, n⟩ (scR sc s₀) := - sub_offset h (by have := hp.nw; omega_nat) - -include hH in -theorem cal_sub : Region.Sub (calR hH s₀) (scR sc s₀) := by - have := hH.hWb; have := hp.fits; simp only [Hash.buf] at this - exact Region.sub_prefix (by omega_nat) - -theorem save_sub : Region.Sub (saveR H (scr s₀)) (scR sc s₀) := by - have := hp.fits; simp only [Hash.buf] at this; exact sub_sc hp (by omega_nat) - -theorem buf_sub : Region.Sub (bufR (H := H) s₀) (scR sc s₀) := by - have := hp.fits; have := hp.nw - exact sub_offset hp.fits (by omega_nat) - -omit hp in -theorem padI_sub : Region.Sub ⟨P (H := H) s₀, H.B⟩ (bufR (H := H) s₀) := Region.sub_prefix (by omega_nat) - -theorem padO_sub : Region.Sub ⟨P (H := H) s₀ + BitVec.ofNat 64 H.B, H.B⟩ (bufR (H := H) s₀) := - sub_offset (by omega_nat) (by have := hp.hB; omega_nat) - -include hH in -theorem cal_save : (calR hH s₀).Disjoint (saveR H (scr s₀)) := by - have := hH.hWb; have := hp.hW - exact off_disj0 _ (m := hH.Wb) (b := 8 * H.W) (n := 36) (by omega_nat) (by omega_nat) - -include hH in -theorem cal_buf : (calR hH s₀).Disjoint (bufR (H := H) s₀) := by - have := hH.hWb; have := hp.hW; have := hp.hB - exact off_disj0 _ (m := hH.Wb) (b := 8 * H.W + 36) (n := 2 * H.B) (by omega_nat) (by omega_nat) - -theorem save_buf : (saveR H (scr s₀)).Disjoint (bufR (H := H) s₀) := by - have := hp.hW; have := hp.hB - exact off_disj _ (a := 8 * H.W) (m := 36) (b := 8 * H.W + 36) (n := 2 * H.B) (by omega_nat) (by omega_nat) - (by omega_nat) - -theorem addr_dO {o : Nat} (ho : o + 1 ≤ 8 * sc) : - State.addr (dO s₀ o) = State.addr (scr s₀) + BitVec.ofNat 64 o := - addr_add (by have := hp.nw; omega_nat) - -theorem toNat_dO {o : Nat} (ho : o + 1 ≤ 8 * sc) : (dO s₀ o).toNat = (scr s₀).toNat + o := by - have := hp.nw - rw [BitVec.toNat_add, BitVec.toNat_ofNat, Nat.mod_eq_of_lt (a := o) (by omega_nat), Nat.mod_eq_of_lt (by omega_nat)] - -end - -/-! ## What the calls keep -/ - -/-- The registers and memory kept from the prologue on. -/ -structure KR (s₀ s : State) : Prop where - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - sp : s.sp = s₀.sp - r4 : s.gpr .r4 = inn s₀ - r5 : s.gpr .r5 = out s₀ - r11 : s.gpr .r11 = scr s₀ - saved : SavedRegs H (scr s₀) s₀ s.mem - -/-- The registers `KR` fixes. -/ -abbrev kregs : List Reg := [.r4, .r5, .r11] - -/-- `KR` survives changes to other registers, and to memory away from the -save area. -/ -theorem KR.keep {s₀ s s' : State} (h : KR (H := H) s₀ s) (hrd : s'.rd = s.rd) (hwr : s'.wr = s.wr) - (hsp : s'.sp = s.sp) (hg : ∀ r ∈ kregs, s'.gpr r = s.gpr r) {rs : List Region} - (hf : Frame rs s.mem s'.mem) (hs : ∀ r ∈ rs, (saveR H (scr s₀)).Disjoint r) : KR (H := H) s₀ s' := - ⟨hrd.trans h.rd, hwr.trans h.wr, hsp.trans h.sp, (hg _ (by simp)).trans h.r4, - (hg _ (by simp)).trans h.r5, (hg _ (by simp)).trans h.r11, h.saved.frame H hf hs⟩ - -theorem kregs_pres : ∀ r ∈ kregs, r ∈ preserved ∧ r ≠ .lr := by decide - -/-! ## The keys -/ - -/-- The key padded to a block, from the initial memory. -/ -abbrev K0₀ (s₀ : State) : List Byte := K0 s₀.mem (State.addr (kp s₀)) (kl s₀) H.B - -/-- After `initKeys`. -/ -structure PhK (s₀ s : State) : Prop where - kr : KR (H := H) s₀ s - bufI : bytesAt s.mem (P (H := H) s₀) H.B = xorPad (K0₀ (H := H) s₀) ipad - bufO : bytesAt s.mem (P (H := H) s₀ + BitVec.ofNat 64 H.B) H.B = xorPad (K0₀ (H := H) s₀) opad - -theorem keys_ok {s₀ : State} (hp : Pre (H := H) sc s₀) : WP isa H.initKeys s₀ (PhK (H := H) s₀) := by - have hB := hp.hB; have hW := hp.hW; have hf := hp.fits; have nw := hp.nw - simp only [Hash.buf] at hf - have hsc : ⟨State.addr (scr s₀), 8 * sc⟩ ∈ s₀.wr := by rw [hp.wr]; simp - refine WP.seq ?_ - simp only [Hash.initPrologue, List.singleton_append] - refine wp_ldrSp (a := stackArgAddr s₀ 0) (by decide) rfl (by rw [hp.rd]; exact ⟨argR s₀, by simp, - Region.contains_self _ _⟩) fun s₁ u₁ => ?_ - refine save_ok H (scr := scr s₀) u₁.gpr hW (by rw [u₁.wr]; exact hsc) (by omega_nat) (by omega_nat) - fun s₂ g₂ rd₂ wr₂ sp₂ f₂ sv₂ => ?_ - refine wp_mov (op2_reg _ _) fun s₃ u₃ => wp_mov (op2_reg _ _) fun s₄ u₄ => wp_mov (op2_reg _ _) fun s₅ u₅ => - wp_mov (op2_reg _ _) fun s₆ u₆ => wp_mov (op2_imm (by decide)) fun s₇ u₇ => wp_mov (op2_reg _ _) fun s₈ u₈ => - wp_cmp (op2_imm (by decide)) fun s₉ f₉ z₉ => WP.block_nil ?_ - have e₂ : ∀ r, r ≠ .r12 → s₂.gpr r = s₀.gpr r := fun r hr => by rw [g₂, u₁.other r hr] - have h4 : s₉.gpr .r4 = inn s₀ := by - rw [f₉.gpr, u₈.other _ (by decide), u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), - u₄.other _ (by decide), u₃.gpr, e₂ _ (by decide)] - have h5 : s₉.gpr .r5 = out s₀ := by - rw [f₉.gpr, u₈.other _ (by decide), u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), - u₄.gpr, u₃.other _ (by decide), e₂ _ (by decide)] - have h6 : s₉.gpr .r6 = kp s₀ := by - rw [f₉.gpr, u₈.other _ (by decide), u₇.other _ (by decide), u₆.other _ (by decide), u₅.gpr, - u₄.other _ (by decide), u₃.other _ (by decide), e₂ _ (by decide)] - have h11 : s₉.gpr .r11 = scr s₀ := by - rw [f₉.gpr, u₈.other _ (by decide), u₇.other _ (by decide), u₆.gpr, u₅.other _ (by decide), - u₄.other _ (by decide), u₃.other _ (by decide), g₂, u₁.gpr]; rfl - have h8 : s₉.gpr .r8 = BitVec.ofNat 32 0 := by rw [f₉.gpr, u₈.other _ (by decide), u₇.gpr]; rfl - have h9 : s₉.gpr .r9 = BitVec.ofNat 32 (kl s₀) := by - rw [f₉.gpr, u₈.gpr, u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), - u₄.other _ (by decide), u₃.other _ (by decide), e₂ _ (by decide), BitVec.ofNat_toNat, BitVec.setWidth_eq] - have hz : s₉.z = decide (kl s₀ = 0) := by - have h9' : s₈.gpr .r9 = BitVec.ofNat 32 (kl s₀) := by rw [← f₉.gpr]; exact h9 - rw [z₉, h9', show ∀ x : BitVec 32, x - 0 = x from fun x => BitVec.sub_zero x, - ofNat_beq_zero (s₀.gpr .r3).isLt] - have hm₉ : s₉.mem = s₂.mem := by rw [f₉.mem, u₈.mem, u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem] - have hrd : s₉.rd = s₀.rd := by rw [f₉.rd, u₈.rd, u₇.rd, u₆.rd, u₅.rd, u₄.rd, u₃.rd, rd₂, u₁.rd] - have hwr : s₉.wr = s₀.wr := by rw [f₉.wr, u₈.wr, u₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, wr₂, u₁.wr] - have hsp : s₉.sp = s₀.sp := by rw [f₉.sp, u₈.sp, u₇.sp, u₆.sp, u₅.sp, u₄.sp, u₃.sp, sp₂, u₁.sp] - have hr : LoopRegs (scr s₀) (kp s₀) s₉ := ⟨h11, h6⟩ - have hm : LoopMem H (scr s₀) (kp s₀) (kl s₀) s₉ := - ⟨hp.kl_le, fun k hk => by - rw [hrd, hwr, hp.rd] - exact inRegions_of_sub (R := keyR s₀) (by simp) (fun _ h => h) (Nat.lt_trans (kl_lt s₀) (by decide)) - hk |>.elim fun r ⟨hr, hc⟩ => ⟨r, List.mem_append_left _ hr, hc⟩, - fun k hk => by - rw [hwr, hp.wr]; exact inRegions_of_sub (R := scR sc s₀) (by simp) (buf_sub hp) (by omega_nat) hk, - hp.k_s.sub_right (buf_sub hp), hB, by simp only [Hash.buf]; omega_nat, by simp only [Hash.buf]; omega_nat, - hp.nk⟩ - refine WP.seq (WP.mono (key_ok H hr hm h8 h9 hz) fun t ht => pad_ok H hr hm ht) |>.mono fun t ht => ?_ - -- The key's bytes are those of the initial memory. - have fk : Frame [saveR H (scr s₀)] s₀.mem s₉.mem := by rw [hm₉, ← u₁.mem]; exact f₂ - have eK : K0 s₉.mem (State.addr (kp s₀)) (kl s₀) H.B = K0₀ (H := H) s₀ := by - simp only [K0, K0₀] - congr 1 - refine bytesAt_prefix_congr fun i hi => fk.bytes (R := keyR s₀) (by - simp only [List.mem_singleton]; rintro r rfl; exact (hp.k_s.sub_right (save_sub hp))) (Nat.le_of_lt (Nat.lt_trans (kl_lt s₀) (by decide))) hi - have hg : ∀ r ∉ clob, t.gpr r = s₉.gpr r := ht.other - have sv : SavedRegs H (scr s₀) s₀ s₉.mem := hm₉ ▸ sv₂.of_eq H fun r hr => u₁.other r (by - simp only [savedRegs, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> decide) - refine ⟨⟨by rw [ht.rd, hrd], by rw [ht.wr, hwr], by rw [ht.sp, hsp], - by rw [hg _ (by decide), h4], by rw [hg _ (by decide), h5], by rw [hg _ (by decide), h11], - sv.frame H ht.mem.frame (by simp only [List.mem_singleton]; rintro r rfl; exact save_buf hp)⟩, - ?_, ?_⟩ - · rw [ht.mem.bufI, eK, take_map_xor (K0_length _ _ hp.kl_le)] - · rw [ht.mem.bufO, eK, take_map_xor (K0_length _ _ hp.kl_le)] - -/-! ## The calls -/ - -section -variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) -include hp - -theorem state_disj {p : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) : - Region.Disjoint ⟨State.addr p, H.S⟩ (scR sc s₀) ∧ (stkR s₀).Disjoint ⟨State.addr p, H.S⟩ ∧ - p.toNat + H.S ≤ 2 ^ 32 := by - rcases hpR with rfl | rfl - · exact ⟨hp.i_s, hp.b_i, hp.ni⟩ - · exact ⟨hp.o_s, hp.b_o, hp.no⟩ - -theorem state_in {p : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) : ⟨State.addr p, H.S⟩ ∈ s₀.wr := by - rw [hp.wr]; rcases hpR with rfl | rfl <;> simp - -omit hp in -theorem kr_mov {s t : State} (hk : KR (H := H) s₀ s) {d : Reg} (hd : d ∉ kregs) {v : BitVec 32} - (u : Upd s t d v) : KR (H := H) s₀ t := - hk.keep u.rd u.wr u.sp (fun r hr => u.other r fun h => hd (h ▸ hr)) (rs := []) - (by rw [u.mem]; exact Frame.refl _ _) (by simp) - -/-- `KR` after a call that writes `rs`. -/ -theorem kr_after {t s' : State} (hk : KR (H := H) s₀ t) {rs : List Region} (ha : After t rs s') - (hs : ∀ r ∈ rs, (saveR H (scr s₀)).Disjoint r) : KR (H := H) s₀ s' := by - have f := ha.frame - rw [below_eq hk.sp] at f - refine hk.keep ha.rd ha.wr ha.sp (fun r hr => ha.cs r (kregs_pres r hr).1 (kregs_pres r hr).2) f ?_ - simp only [List.mem_append, List.mem_singleton] - rintro r (hr | rfl) - · exact hs r hr - · exact hp.b_s.symm.sub_left (save_sub hp) - -omit hp in -theorem initArgs_ok {s : State} (hk : KR (H := H) s₀ s) {st : Reg} {p : BitVec 32} (hs : s.gpr st = p) : - WP isa (.block [.mov .r0 (.reg st)]) s fun t => KR (H := H) s₀ t ∧ t.gpr .r0 = p ∧ t.mem = s.mem := - wp_mov (op2_reg _ _) fun _ u₁ => WP.block_nil ⟨kr_mov hk (by decide) u₁, by rw [u₁.gpr, hs], u₁.mem⟩ - -theorem initCall_ok {t : State} (hk : KR (H := H) s₀ t) {p : BitVec 32} (hd : t.gpr .r0 = p) - (hpR : p = inn s₀ ∨ p = out s₀) {Q : State → Prop} - (hQ : ∀ s', KR (H := H) s₀ s' → Frame [⟨State.addr p, H.S⟩, stkR s₀] t.mem s'.mem → - hH.SH.Repr s'.mem (State.addr p) [] → Q s') : - WP isa (.call H.initN H.initC) t Q := by - obtain ⟨dS, _, np⟩ := state_disj hp hpR - refine init_call hH hd np (by rw [hk.wr]; exact covers_one (state_in hp hpR)) fun s' ha hr => ?_ - have f := ha.frame - rw [below_eq hk.sp] at f - exact hQ s' (kr_after hp hk ha (by - simp only [List.mem_singleton]; rintro r rfl; exact dS.symm.sub_left (save_sub hp))) f hr - -theorem callInit_ok {s : State} (hk : KR (H := H) s₀ s) {st : Reg} {p : BitVec 32} (hs : s.gpr st = p) - (hpR : p = inn s₀ ∨ p = out s₀) {Q : State → Prop} - (hQ : ∀ s', KR (H := H) s₀ s' → Frame [⟨State.addr p, H.S⟩, stkR s₀] s.mem s'.mem → - hH.SH.Repr s'.mem (State.addr p) [] → Q s') : - WP isa (H.callInit st) s Q := - WP.seq (WP.mono (initArgs_ok hk hs) fun _ ⟨k, d, m⟩ => - initCall_ok hH hp k d hpR fun s' k' f r => hQ s' k' (m ▸ f) r) - -theorem updArgs_ok {s : State} (hk : KR (H := H) s₀ s) {st : Reg} {p : BitVec 32} - (hs : s.gpr st = p) (hpR : p = inn s₀ ∨ p = out s₀) {o : Nat} (ho : o = H.buf ∨ o = H.buf + H.B) : - WP isa (.block (([.mov .r0 (.reg st)] : List Instr) ++ scrAt .r1 o ++ ([.movw .r7 (BitVec.ofNat 16 H.B), - .mov .r10 (.reg .r11), .movw .r2 (BitVec.ofNat 16 0), .mov .r3 (.imm 0)] : List Instr))) s fun t => - KR (H := H) s₀ t ∧ UpdArgs hH t p (dO s₀ o) (scr s₀) H.B ∧ count t = BitVec.ofNat 64 0 ∧ - t.mem = s.mem := by - obtain ⟨dS, dK, np⟩ := state_disj hp hpR - have hB := hp.hB; have hW := hp.hW; have hf := hp.fits; have nw := hp.nw - simp only [Hash.buf] at hf ho - have ho' : o + H.B ≤ 8 * sc := by omega_nat - have ea := addr_dO hp (o := o) (by omega_nat) - have dsub : Region.Sub ⟨State.addr (dO s₀ o), H.B⟩ (bufR (H := H) s₀) := by - rw [ea] - rcases ho with rfl | rfl - · exact padI_sub - · rw [← add_ofNat_add]; exact padO_sub hp - have dsc : Region.Sub ⟨State.addr (dO s₀ o), H.B⟩ (scR sc s₀) := fun a h => buf_sub hp a (dsub a h) - simp only [scrAt, List.cons_append, List.nil_append] - refine wp_mov (op2_reg _ _) fun s₁ u₁ => wp_movw fun s₂ u₂ => wp_add (op2_reg _ _) fun s₃ u₃ => - wp_movw fun s₄ u₄ => wp_mov (op2_reg _ _) fun s₅ u₅ => wp_movw fun s₆ u₆ => - wp_mov (op2_imm (by decide)) fun s₇ u₇ => WP.block_nil ?_ - have k₇ : KR (H := H) s₀ s₇ := - kr_mov (kr_mov (kr_mov (kr_mov (kr_mov (kr_mov (kr_mov hk (by decide) u₁) (by decide) u₂) (by decide) u₃) - (by decide) u₄) (by decide) u₅) (by decide) u₆) (by decide) u₇ - have h11 : s.gpr .r11 = scr s₀ := hk.r11 - have hm : s₇.mem = s.mem := by rw [u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem] - refine ⟨k₇, ?_, count_movw (c := 0) (by decide) (by rw [u₇.other _ (by decide), u₆.gpr]) u₇.gpr, hm⟩ - exact - { r0 := by rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), - u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.gpr, hs] - r1 := by rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), - u₄.other _ (by decide), u₃.gpr, u₂.gpr, u₂.other _ (by decide), u₁.other _ (by decide), h11, - movw_ofNat (by omega_nat)] - r7 := by rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, - movw_ofNat (by omega_nat)] - r10 := by rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.gpr, u₄.other _ (by decide), - u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), h11] - hlen := by omega_nat - sp16 := by rw [k₇.sp]; exact hp.sp16 - cd := by - rw [k₇.rd, k₇.wr, ea] - exact Covers.of_sub fun r hr => by - simp only [List.mem_singleton] at hr; subst hr - exact sub_of_off (L := 8 * sc) (by rw [hp.rd, hp.wr]; simp) ho' - cw := by - rw [k₇.wr] - exact Covers.of_sub fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact sub_of_self (r := ⟨State.addr p, H.S⟩) (state_in hp hpR) (Nat.le_refl _) - · exact sub_of_self (r := scR sc s₀) (by rw [hp.wr]; simp) (by - have := hH.hWb; show hH.Wb ≤ 8 * sc; omega_nat) - st_sc := dS.sub_right (cal_sub hH hp) - d_st := dS.symm.sub_left dsc - d_sc := (cal_buf hH hp).symm.sub_left dsub - b_st := by rw [below_eq k₇.sp]; exact dK - b_d := by rw [below_eq k₇.sp]; exact hp.b_s.sub_right dsc - b_sc := by rw [below_eq k₇.sp]; exact hp.b_s.sub_right (cal_sub hH hp) - nst := np - nd := by rw [toNat_dO hp (by omega_nat)]; omega_nat - nsc := by have := hH.hWb; omega_nat } - -theorem updCall_ok {t : State} (hk : KR (H := H) s₀ t) {p d : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) - (ha : UpdArgs hH t p d (scr s₀) H.B) (hc : count t = BitVec.ofNat 64 0) {Q : State → Prop} - (hQ : ∀ s', KR (H := H) s₀ s' → Frame [⟨State.addr p, H.S⟩, calR hH s₀, stkR s₀] t.mem s'.mem → - (hH.SH.Repr t.mem (State.addr p) [] → - hH.SH.Repr s'.mem (State.addr p) ([] ++ bytesAt t.mem (State.addr d) H.B)) → Q s') : - WP isa (.frame (.push upd4) (.call H.updN H.updC) (.pop .r1 16)) t Q := by - obtain ⟨dS, _⟩ := state_disj hp hpR - refine upd_frame hH ha fun s' ha' hpost => ?_ - have f := ha'.frame - rw [below_eq hk.sp] at f - refine hQ s' (kr_after hp hk ha' ?_) f fun hr => hpost [] hr (by rw [hc]; rfl) - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact dS.symm.sub_left (save_sub hp) - · exact (cal_save hH hp).symm - -theorem callUpd_ok {s : State} (hk : KR (H := H) s₀ s) {st : Reg} {p : BitVec 32} - (hs : s.gpr st = p) (hpR : p = inn s₀ ∨ p = out s₀) {o : Nat} (ho : o = H.buf ∨ o = H.buf + H.B) - {Q : State → Prop} - (hQ : ∀ s', KR (H := H) s₀ s' → Frame [⟨State.addr p, H.S⟩, calR hH s₀, stkR s₀] s.mem s'.mem → - (hH.SH.Repr s.mem (State.addr p) [] → - hH.SH.Repr s'.mem (State.addr p) ([] ++ bytesAt s.mem (State.addr (scr s₀) + BitVec.ofNat 64 o) H.B)) → - Q s') : - WP isa (H.callUpd [.mov .r0 (.reg st)] 0 o H.B) s Q := by - have hf := hp.fits; have := hp.hB; have ho' := ho; simp only [Hash.buf] at hf ho' - have ea := addr_dO hp (o := o) (by omega_nat) - exact WP.seq (WP.mono (updArgs_ok hH hp hk hs hpR ho) fun t ⟨k, a, c, m⟩ => - updCall_ok hH hp k hpR a c fun s' k' f r => hQ s' k' (m ▸ f) fun hr => by - have := r (m ▸ hr); rwa [m, ea] at this) - -/-! ## Correctness -/ - -omit hp in -include hH in -theorem repr_keep {rs : List Region} {m m' : Mem} (hf : Frame rs m m') {p : Addr} - (hd : ∀ r ∈ rs, Region.Disjoint ⟨p, H.S⟩ r) {msg : List Byte} (hr : hH.SH.Repr m p msg) : - hH.SH.Repr m' p msg := - hH.repr _ _ _ _ _ (fun i hi => hf.bytes (R := ⟨p, H.S⟩) hd (by show H.S ≤ 2 ^ 64; have := hH.hSB; omega_nat) hi) hr - -theorem blockKey_eq : blockKey hH.SH.H (bytesAt s₀.mem (State.addr (kp s₀)) (kl s₀)) = K0₀ (H := H) s₀ := by - have := hp.kl_le - have hb := hH.hB - simp only [blockKey, K0₀, K0, Proof.Hmac.Common.bytesAt_length, hb, show ¬ (H.B < kl s₀) by omega_nat, - ↓reduceIte] - -omit hp in -/-- The end: `abiPreserved`, from `KR` and `restore`. -/ -theorem abi_of {s s' : State} (hk : KR (H := H) s₀ s) (hsp : s'.sp = s.sp) - (hg : ∀ r ∈ savedRegs, s'.gpr r = s₀.gpr r) : abiPreserved s₀ s' := - ⟨fun r hr => hg r (preserved_saved r hr), by rw [hsp, hk.sp]⟩ - -theorem correct : - WP isa H.init s₀ fun s' => abiPreserved s₀ s' ∧ (initG hH.SH sc).post s₀ s' := by - have hB := hp.hB; have hW := hp.hW; have hf := hp.fits - simp only [Hash.buf] at hf - -- Where things are. - have dIS : Region.Disjoint ⟨P (H := H) s₀, H.B⟩ (inR (H := H) s₀) := - hp.i_s.symm.sub_left fun a h => buf_sub hp a (padI_sub a h) - have dIO : Region.Disjoint ⟨P (H := H) s₀, H.B⟩ (outR (H := H) s₀) := - hp.o_s.symm.sub_left fun a h => buf_sub hp a (padI_sub a h) - have dOS : Region.Disjoint ⟨P (H := H) s₀ + BitVec.ofNat 64 H.B, H.B⟩ (inR (H := H) s₀) := - hp.i_s.symm.sub_left fun a h => buf_sub hp a (padO_sub hp a h) - have dOO : Region.Disjoint ⟨P (H := H) s₀ + BitVec.ofNat 64 H.B, H.B⟩ (outR (H := H) s₀) := - hp.o_s.symm.sub_left fun a h => buf_sub hp a (padO_sub hp a h) - have dIK : Region.Disjoint ⟨P (H := H) s₀, H.B⟩ (stkR s₀) := - hp.b_s.symm.sub_left fun a h => buf_sub hp a (padI_sub a h) - have dOK : Region.Disjoint ⟨P (H := H) s₀ + BitVec.ofNat 64 H.B, H.B⟩ (stkR s₀) := - hp.b_s.symm.sub_left fun a h => buf_sub hp a (padO_sub hp a h) - have dOC : Region.Disjoint ⟨P (H := H) s₀ + BitVec.ofNat 64 H.B, H.B⟩ (calR hH s₀) := - (cal_buf hH hp).symm.sub_left (padO_sub hp) - have eO : State.addr (scr s₀) + BitVec.ofNat 64 (H.buf + H.B) = P (H := H) s₀ + BitVec.ofNat 64 H.B := by - rw [P, add_ofNat_add] - refine WP.seq (WP.mono (keys_ok sc hp) fun s₁ h₁ => ?_) - refine WP.seq (callInit_ok hH hp h₁.kr (st := .r4) h₁.kr.r4 (.inl rfl) fun s₂ k₂ f₂ r₂ => ?_) - have bI₂ := (bytes_keep f₂ (p := P (H := H) s₀) (n := H.B) (by - simp only [List.mem_cons, List.not_mem_nil, or_false]; rintro r (rfl | rfl) <;> with_reducible assumption) - (by omega_nat)).trans h₁.bufI - have bO₂ := (bytes_keep f₂ (p := P (H := H) s₀ + BitVec.ofNat 64 H.B) (n := H.B) (by - simp only [List.mem_cons, List.not_mem_nil, or_false]; rintro r (rfl | rfl) <;> with_reducible assumption) - (by omega_nat)).trans h₁.bufO - refine WP.seq (callUpd_ok hH hp k₂ k₂.r4 (.inl rfl) (.inl rfl) fun s₃ k₃ f₃ r₃ => ?_) - have rI₃ := r₃ r₂ - rw [List.nil_append, bI₂] at rI₃ - have bO₃ := (bytes_keep f₃ (p := P (H := H) s₀ + BitVec.ofNat 64 H.B) (n := H.B) (by - simp only [List.mem_cons, List.not_mem_nil, or_false]; rintro r (rfl | rfl | rfl) <;> with_reducible assumption) - (by omega_nat)).trans bO₂ - refine WP.seq (callInit_ok hH hp k₃ (st := .r5) k₃.r5 (.inr rfl) fun s₄ k₄ f₄ r₄ => ?_) - have rI₄ := repr_keep hH f₄ (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact hp.i_o - · exact hp.b_i.symm) rI₃ - have bO₄ := (bytes_keep f₄ (p := P (H := H) s₀ + BitVec.ofNat 64 H.B) (n := H.B) (by - simp only [List.mem_cons, List.not_mem_nil, or_false]; rintro r (rfl | rfl) <;> with_reducible assumption) - (by omega_nat)).trans bO₃ - refine WP.seq (callUpd_ok hH hp k₄ k₄.r5 (.inr rfl) (.inr rfl) fun s₅ k₅ f₅ r₅ => ?_) - have rO₅ := r₅ r₄ - rw [List.nil_append, eO, bO₄] at rO₅ - have rI₅ := repr_keep hH f₅ (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact hp.i_o - · exact hp.i_s.sub_right (cal_sub hH hp) - · exact hp.b_i.symm) rI₄ - have hsc : ⟨State.addr (scr s₀), 8 * sc⟩ ∈ s₅.wr := by rw [k₅.wr, hp.wr]; simp - refine WP.mono (restore_ok H k₅.r11 hW k₅.saved hsc (by omega_nat) hp.nw) fun s' ⟨hm, _, _, hsp, hg, _⟩ => ?_ - refine ⟨abi_of k₅ hsp hg, ?_⟩ - show hH.SH.Repr s'.mem (State.addr (inn s₀)) _ ∧ hH.SH.Repr s'.mem (State.addr (out s₀)) _ - rw [hm, blockKey_eq hH hp] - exact ⟨rI₅, rO₅⟩ - -end - -end VG.Proof.Hmac.Generic.Arm.Init diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Instances.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Instances.lean deleted file mode 100644 index e2dbc4fe6..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Instances.lean +++ /dev/null @@ -1,373 +0,0 @@ -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Init -import VerifiedGarbage.Proof.Hmac.Generic.Implies -import VerifiedGarbage.Proof.Framework.Arm.Contract -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Hashes -import VerifiedGarbage.Proof.Framework.OmegaLit - -/-! -# HMAC over any streaming hash function on 32-bit ARM: `init`, constant time - -As on AArch64 (`Proof/Hmac/Generic/AArch64/Instances.lean`). The prologue -loads `scratch` from the stack, so its taint check starts with the stack -argument public (`argTaint`). --/ - -namespace VG.Proof.Hmac.Generic.Arm.Init - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash scrAt) -open VG.Proof.Hmac.Generic.Arm - -/-- The registers `KR` fixes that the code between the calls uses. -/ -abbrev pubRegs : List Reg := [.r4, .r5, .r11] - -/-- The argument registers. -/ -abbrev args : List Reg := [.r0, .r1, .r2, .r3] - -/-- The block that sets up a call of `update` from `st`, at offset `o`. -/ -abbrev updBlock (H : Hash) (st : Reg) (o : Nat) : List Instr := - ([.mov .r0 (.reg st)] : List Instr) ++ scrAt .r1 o ++ ([.movw .r7 (BitVec.ofNat 16 H.B), .mov .r10 (.reg .r11), - .movw .r2 (BitVec.ofNat 16 0), .mov .r3 (.imm 0)] : List Instr) - -/-- The taint checks of the pieces of `init` between its calls. -/ -structure Checks (H : Hash) : Prop where - keys : ∃ hc, (VG.Taint.check taint (argTaint args 4) H.initKeys hc).isSome = true - argI : ∀ st ∈ [Reg.r4, .r5], ∃ hc, - (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block [.mov .r0 (.reg st)]) hc).isSome = true - argU₁ : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block (updBlock H .r4 H.buf)) hc).isSome = true - argU₂ : ∃ hc, - (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block (updBlock H .r5 (H.buf + H.B))) hc).isSome = true - restore : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block H.restore) hc).isSome = true - -/-- The public arguments are the same. -/ -structure PubEq (s₀ s₀' : State) : Prop where - sp : s₀.sp = s₀'.sp - r0 : s₀.gpr .r0 = s₀'.gpr .r0 - r1 : s₀.gpr .r1 = s₀'.gpr .r1 - r2 : s₀.gpr .r2 = s₀'.gpr .r2 - r3 : s₀.gpr .r3 = s₀'.gpr .r3 - a0 : stackArg s₀ 0 = stackArg s₀' 0 - -variable {H : Hash} (hH : HashOK H) {sc : Nat} (hc : Checks H) -variable {s₀ s₀' : State} (hp : Pre (H := H) sc s₀) (hp' : Pre (H := H) sc s₀') (hq : PubEq s₀ s₀') - -theorem kr_agree {s s' : State} (hq : PubEq s₀ s₀') (h : KR (H := H) s₀ s) (h' : KR (H := H) s₀' s') : - ∀ r ∈ pubRegs, s.gpr r = s'.gpr r := by - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · rw [h.r4, h'.r4, inn, inn, hq.r0] - · rw [h.r5, h'.r5, out, out, hq.r1] - · rw [h.r11, h'.r11, scr, scr, hq.a0] - -/-- The stack argument lies outside the writable regions. -/ -theorem args_wf {t : State} (h : Pre (H := H) sc t) : - t.sp.toNat + 4 ≤ 2 ^ 32 ∧ ∀ r ∈ t.wr, Region.Disjoint ⟨State.addr t.sp, 4⟩ r := by - have e : (⟨State.addr t.sp, 4⟩ : Region) = argR t := by simp [stackArgAddr] - refine ⟨h.spf, ?_⟩ - simp only [e, h.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact h.a_i - · exact h.a_o - · exact h.a_s - -include hH hc hp hp' hq - -/-- A call of `init` on the state in `st` (`r4` for `inner`, `r5` for `outer`). -/ -theorem callInit_rel {st : Reg} (hst : st = .r4 ∨ st = .r5) : - RelCT isa (fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s') (H.callInit st) - fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s' := by - -- The state's address, the same in both runs. - let p : BitVec 32 := if st = .r4 then inn s₀ else out s₀ - have hpR : p = inn s₀ ∨ p = out s₀ := by by_cases h : st = .r4 <;> simp [p, h] - have hpR' : p = inn s₀' ∨ p = out s₀' := by - show p = s₀'.gpr .r0 ∨ p = s₀'.gpr .r1; rw [← hq.r0, ← hq.r1]; exact hpR - have hs : ∀ {t : State}, KR (H := H) s₀ t → t.gpr st = p := fun h => by - rcases hst with rfl | rfl - · simp [p, h.r4] - · simp [p, h.r5] - have hs' : ∀ {t : State}, KR (H := H) s₀' t → t.gpr st = p := fun h => by - rcases hst with rfl | rfl - · simp [p, h.r4, hq.r0] - · simp [p, h.r5, hq.r1] - obtain ⟨_, _, np⟩ := state_disj hp hpR - have ha : RelCT isa (fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s') (.block [.mov .r0 (.reg st)]) - fun s s' => (KR (H := H) s₀ s ∧ s.gpr .r0 = p ∧ True) ∧ (KR (H := H) s₀' s' ∧ s'.gpr .r0 = p ∧ True) := - rel_taint pubRegs (fun _ _ h h' => kr_agree hq h h') (hc.argI st (by rcases hst with rfl | rfl <;> simp)) - (fun _ h => WP.mono (initArgs_ok h (hs h)) fun _ ⟨k, d, _⟩ => ⟨k, d, trivial⟩) - (fun _ h => WP.mono (initArgs_ok h (hs' h)) fun _ ⟨k, d, _⟩ => ⟨k, d, trivial⟩) - refine ha.seq (rel_wp (F := fun s => KR (H := H) s₀ s ∧ s.gpr .r0 = p ∧ True) - (F' := fun s => KR (H := H) s₀' s ∧ s.gpr .r0 = p ∧ True) - (init_rel hH (st := p) fun s s' h => ?_) - (fun _ ⟨k, d, _⟩ => initCall_ok hH hp k d hpR fun _ k' _ _ => k') - (fun _ ⟨k, d, _⟩ => initCall_ok hH hp' k d hpR' fun _ k' _ _ => k')) - obtain ⟨⟨k, d, _⟩, ⟨k', d', _⟩⟩ := h - exact ⟨d, d', np, by rw [k.wr]; exact covers_one (state_in hp hpR), - by rw [k'.wr]; exact covers_one (state_in hp' hpR')⟩ - -omit hc in -/-- A call of `update` on the state in `st`, with the bytes at `scratch + o`. -/ -theorem callUpd_rel {st : Reg} (hst : st = .r4 ∨ st = .r5) {o : Nat} (ho : o = H.buf ∨ o = H.buf + H.B) - (hck : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block (updBlock H st o)) hc).isSome = true) : - RelCT isa (fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s') (H.callUpd [.mov .r0 (.reg st)] 0 o H.B) - fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s' := by - let p : BitVec 32 := if st = .r4 then inn s₀ else out s₀ - have hpR : p = inn s₀ ∨ p = out s₀ := by by_cases h : st = .r4 <;> simp [p, h] - have hpR' : p = inn s₀' ∨ p = out s₀' := by - show p = s₀'.gpr .r0 ∨ p = s₀'.gpr .r1; rw [← hq.r0, ← hq.r1]; exact hpR - have hs : ∀ {t : State}, KR (H := H) s₀ t → t.gpr st = p := fun h => by - rcases hst with rfl | rfl - · simp [p, h.r4] - · simp [p, h.r5] - have hs' : ∀ {t : State}, KR (H := H) s₀' t → t.gpr st = p := fun h => by - rcases hst with rfl | rfl - · simp [p, h.r4, hq.r0] - · simp [p, h.r5, hq.r1] - have e8' : scr s₀' = scr s₀ := hq.a0.symm - have e8 : dO s₀' o = dO s₀ o := by rw [dO, dO, e8'] - have ha : RelCT isa (fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s') (.block (updBlock H st o)) - fun s s' => (KR (H := H) s₀ s ∧ UpdArgs hH s p (dO s₀ o) (scr s₀) H.B ∧ count s = BitVec.ofNat 64 0) ∧ - (KR (H := H) s₀' s' ∧ UpdArgs hH s' p (dO s₀ o) (scr s₀) H.B ∧ count s' = BitVec.ofNat 64 0) := - rel_taint pubRegs (fun _ _ h h' => kr_agree hq h h') hck - (fun _ h => WP.mono (updArgs_ok hH hp h (hs h) hpR ho) fun _ ⟨k, a, c, _⟩ => ⟨k, a, c⟩) - (fun _ h => WP.mono (updArgs_ok hH hp' h (hs' h) hpR' ho) fun _ ⟨k, a, c, _⟩ => - ⟨k, e8 ▸ e8' ▸ a, c⟩) - refine ha.seq (rel_wp - (F := fun s => KR (H := H) s₀ s ∧ UpdArgs hH s p (dO s₀ o) (scr s₀) H.B ∧ count s = BitVec.ofNat 64 0) - (F' := fun s => KR (H := H) s₀' s ∧ UpdArgs hH s p (dO s₀ o) (scr s₀) H.B ∧ count s = BitVec.ofNat 64 0) - (upd_rel hH (sp := s₀.sp) (st := p) (d := dO s₀ o) (sc := scr s₀) (len := H.B) - fun s s' ⟨⟨k, a, c⟩, ⟨k', a', c'⟩⟩ => ⟨a, a', by rw [c, c'], k.sp, by rw [k'.sp, hq.sp]⟩) - (fun _ ⟨k, a, c⟩ => updCall_ok hH hp k hpR a c fun _ k' _ _ => k') - (fun _ ⟨k, a, c⟩ => updCall_ok hH hp' k hpR' (e8.symm ▸ e8'.symm ▸ a) c fun _ k' _ _ => k')) - -theorem ct : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.init fun _ _ => True := by - have keys : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.initKeys - fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s' := - rel_agree (argTaint args 4) (fun s s' e e' => by - subst e e' - refine agree_argTaint (fun r hr => ?_) hq.sp (args_wf hp) (args_wf hp') - (argMem_of (j := 1) hq.sp hp.spf fun i hi => by rw [show i = 0 by omega_nat]; exact hq.a0) - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl - · exact hq.r0 - · exact hq.r1 - · exact hq.r2 - · exact hq.r3) hc.keys - (fun _ e => by subst e; exact WP.mono (keys_ok sc hp) fun _ h => h.kr) - (fun _ e => by subst e; exact WP.mono (keys_ok sc hp') fun _ h => h.kr) - obtain ⟨_, hr⟩ := hc.restore - have restore : RelCT isa (fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s') (.block H.restore) - fun _ _ => True := - RelCT.taint (A := taint) (Taint.ofRegs pubRegs) (fun _ _ h => - Taint.agree_ofRegs (kr_agree hq h.1 h.2)) hr - exact keys.seq ((callInit_rel hH hc hp hp' hq (.inl rfl)).seq - ((callUpd_rel hH hp hp' hq (.inl rfl) (.inl rfl) hc.argU₁).seq - ((callInit_rel hH hc hp hp' hq (.inr rfl)).seq - ((callUpd_rel hH hp hp' hq (.inr rfl) (.inr rfl) hc.argU₂).seq restore)))) - -end VG.Proof.Hmac.Generic.Arm.Init - -namespace VG.Proof.Hmac.Generic.Arm.Init - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash) - -/-- `init` is verified against `initG`, given the taint checks, which the -kernel evaluates for each hash function. -/ -theorem verified {H : Hash} (hH : HashOK H) {sc : Nat} (hc : Checks H) - (hfit : H.buf + 2 * H.B ≤ 8 * sc) (hsat : ∃ s, (initG hH.SH sc).pre s) : - Verified Arm.target H.init (initG hH.SH sc) := by - refine ⟨fun s hs => ?_, fun s₁ s₂ t₁ t₂ s₁' s₂' h₁ h₂ hpub e₁ e₂ => ?_, hsat⟩ - · obtain ⟨t, s', he, hg, hpost⟩ := correct hH (pre_of hH sc hs hfit) - exact ⟨t, s', he, hg, hpost⟩ - · obtain ⟨h1, h2, h3, h4, h5, h6⟩ := hpub - exact (ct hH hc (pre_of hH sc h₁ hfit) (pre_of hH sc h₂ hfit) ⟨h1, h2, h3, h4, h5, h6⟩ - _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 - -end VG.Proof.Hmac.Generic.Arm.Init - -/-! -# HMAC over the streaming hash functions on 32-bit ARM: the instances - -As on AArch64 (`Proof/Hmac/Generic/AArch64/Instances.lean`): the generic proofs -at each hash function of `Hashes.lean`, moved to the shared contracts of -`Spec/Hmac/Generic.lean` (`sig_implies`), which the artifacts are emitted with. --/ - -namespace VG.Proof.Hmac.Generic.Arm.Instances - -open VG.Arm -open VG.Proof.Hmac.Generic.Arm - -/-- A state satisfying `init`'s precondition, with states of `S` bytes and -`8 sc` bytes of scratch space (and a one-byte key); `scratch`, at `0x4000`, -is the stack argument. -/ -def initSat (S sc : Nat) : State where - gpr r := match r with - | .r0 => 0x1000 | .r1 => 0x2000 | .r2 => 0x3000 | .r3 => 1 - | _ => 0 - sp := 0x6000 - n := false - z := false - c := false - v := false - mem a := if a = 0x6001 then 0x40 else 0 - rd := [⟨0x3000, 1⟩, ⟨0x6000, 4⟩] - wr := [⟨0x1000, S⟩, ⟨0x2000, S⟩, ⟨0x4000, 8 * sc⟩] - -/-- A state satisfying `finalize`'s precondition, with states of `S` bytes, -a digest of `D` bytes and `8 sc` bytes of scratch space; `out`, at `0x3000`, -and `scratch`, at `0x4000`, are the stack arguments. -/ -def finSat (S D sc : Nat) : State where - gpr r := match r with - | .r0 => 0x1000 | .r1 => 0x2000 - | _ => 0 - sp := 0x6000 - n := false - z := false - c := false - v := false - mem a := if a = 0x6001 then 0x30 else if a = 0x6005 then 0x40 else 0 - rd := [⟨0x2000, S⟩, ⟨0x6000, 8⟩] - wr := [⟨0x1000, S⟩, ⟨0x3000, D⟩, ⟨0x4000, 8 * sc⟩] - -/-- `initG` implies the shared contract for any hash function and scratch space -(`generic_implies`), given that the shared contract is satisfiable. -/ -theorem initImp (S : Spec.Hmac.StreamingHash) (W : Nat) (h : ∃ s, (Spec.Hmac.initContract S W Arm.abi 16).pre s) : - (initG S W).Implies (Spec.Hmac.initContract S W Arm.abi 16) := by - generic_implies [ - Spec.Hmac.initContract, Spec.Hmac.initSig, initG, below, count, Arm.abi, Arm.argRegs, - Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using h - -/-- `finG` implies the shared contract for any hash function and scratch space -(`generic_implies`), given that the shared contract is satisfiable. -/ -theorem finImp (S : Spec.Hmac.StreamingHash) (W : Nat) (h : ∃ s, (Spec.Hmac.finalizeContract S W Arm.abi 16).pre s) : - (finG S W).Implies (Spec.Hmac.finalizeContract S W Arm.abi 16) := by - generic_implies [ - Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, finG, below, count, Arm.abi, Arm.argRegs, - Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using h - -/-! ## SHA-1 -/ - -theorem sha1_initChecks : Init.Checks sha1H where - keys := ⟨_, by taint_decide⟩ - argI := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - argU₁ := ⟨_, by taint_decide⟩ - argU₂ := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha1_initImp : (initG Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.initContract Arm.abi 16) := - initImp Spec.Hmac.sha1S 56 (by - inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.sha1S, Spec.Hmac.sha1, initG, below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 84 56) - -theorem sha1_finImp : (finG Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.finalizeContract Arm.abi 16) := - finImp Spec.Hmac.sha1S 56 (by - inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha1S, Spec.Hmac.sha1, finG, below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 84 20 56) - -theorem sha1_init : Verified Arm.target sha1H.init (Spec.Hmac.sha1I.initContract Arm.abi 16) := - (Init.verified sha1OK sha1_initChecks (by decide) sha1_initImp.sat_left).of_implies sha1_initImp - -/-! ## MD5 -/ - -theorem md5_initChecks : Init.Checks md5H where - keys := ⟨_, by taint_decide⟩ - argI := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - argU₁ := ⟨_, by taint_decide⟩ - argU₂ := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem md5_initImp : (initG Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.initContract Arm.abi 16) := - initImp Spec.Hmac.md5S 48 (by - inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.md5S, Spec.Hmac.md5, initG, below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 80 48) - -theorem md5_finImp : (finG Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.finalizeContract Arm.abi 16) := - finImp Spec.Hmac.md5S 48 (by - inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.md5S, Spec.Hmac.md5, finG, below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 80 16 48) - -theorem md5_init : Verified Arm.target md5H.init (Spec.Hmac.md5I.initContract Arm.abi 16) := - (Init.verified md5OK md5_initChecks (by decide) md5_initImp.sat_left).of_implies md5_initImp - -/-- `Init.Checks` looks at the sizes of a hash function but its digest's. -/ -theorem Init.Checks.of_eq {H H' : Impl.Hmac.Generic.Arm.Hash} (hB : H.B = H'.B) (hS : H.S = H'.S) - (hW : H.W = H'.W) (h : Init.Checks H) : Init.Checks H' := by - obtain ⟨B, S, D, F, W, iN, iC, uN, uC, fN, fC⟩ := H - obtain ⟨B', S', D', F', W', iN', iC', uN', uC', fN', fC'⟩ := H' - dsimp only at hB hS hW; subst hB hS hW - exact ⟨h.keys, h.argI, h.argU₁, h.argU₂, h.restore⟩ - -/-! ## SHA-384 -/ - -theorem sha384_initChecks : Init.Checks sha384H where - keys := ⟨_, by taint_decide⟩ - argI := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - argU₁ := ⟨_, by taint_decide⟩ - argU₂ := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha384_initImp : (initG Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I.initContract Arm.abi 16) := - initImp Spec.Hmac.sha384S 234 (by - inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.sha384S, Spec.Hmac.sha384, initG, below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 192 234) - -theorem sha384_finImp : (finG Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I.finalizeContract Arm.abi 16) := - finImp Spec.Hmac.sha384S 234 (by - inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha384S, Spec.Hmac.sha384, finG, below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 192 48 234) - -theorem sha384_init : Verified Arm.target sha384H.init (Spec.Hmac.sha384I.initContract Arm.abi 16) := - (Init.verified sha384OK sha384_initChecks (by decide) sha384_initImp.sat_left).of_implies sha384_initImp - -/-! ## SHA-512 -/ - -theorem sha512_initChecks : Init.Checks sha512H' := - Init.Checks.of_eq (H := sha384H) rfl rfl rfl sha384_initChecks - -theorem sha512_initImp : (initG Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I.initContract Arm.abi 16) := - initImp Spec.Hmac.sha512S 234 - sha384_initImp.sat - -theorem sha512_finImp : (finG Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I.finalizeContract Arm.abi 16) := - finImp Spec.Hmac.sha512S 234 (by - inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha512S, Spec.Hmac.sha512, finG, below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 192 64 234) - -theorem sha512_init : Verified Arm.target sha512H'.init (Spec.Hmac.sha512I.initContract Arm.abi 16) := - (Init.verified sha512OK sha512_initChecks (by decide) sha512_initImp.sat_left).of_implies sha512_initImp - - -/-! ## SHA-512/224 -/ - -theorem sha512_224_initChecks : Init.Checks sha512_224H := - Init.Checks.of_eq (H := sha384H) rfl rfl rfl sha384_initChecks - -theorem sha512_224_initImp : (initG Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac.sha512_224I.initContract Arm.abi 16) := - initImp Spec.Hmac.sha512_224S 234 - sha384_initImp.sat - -theorem sha512_224_finImp : (finG Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac.sha512_224I.finalizeContract Arm.abi 16) := - finImp Spec.Hmac.sha512_224S 234 (by - inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha512_224S, Spec.Hmac.sha512_224, finG, below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 192 28 234) - -theorem sha512_224_init : Verified Arm.target sha512_224H.init (Spec.Hmac.sha512_224I.initContract Arm.abi 16) := - (Init.verified sha512_224OK sha512_224_initChecks (by decide) sha512_224_initImp.sat_left).of_implies sha512_224_initImp - -/-! ## SHA-512/256 -/ - -theorem sha512_256_initChecks : Init.Checks sha512_256H := - Init.Checks.of_eq (H := sha384H) rfl rfl rfl sha384_initChecks - -theorem sha512_256_initImp : (initG Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac.sha512_256I.initContract Arm.abi 16) := - initImp Spec.Hmac.sha512_256S 234 - sha384_initImp.sat - -theorem sha512_256_finImp : (finG Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac.sha512_256I.finalizeContract Arm.abi 16) := - finImp Spec.Hmac.sha512_256S 234 (by - inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha512_256S, Spec.Hmac.sha512_256, finG, below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 192 32 234) - -theorem sha512_256_init : Verified Arm.target sha512_256H.init (Spec.Hmac.sha512_256I.initContract Arm.abi 16) := - (Init.verified sha512_256OK sha512_256_initChecks (by decide) sha512_256_initImp.sat_left).of_implies sha512_256_initImp - -end VG.Proof.Hmac.Generic.Arm.Instances diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha256.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha256.lean deleted file mode 100644 index 85851a51a..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha256.lean +++ /dev/null @@ -1,88 +0,0 @@ -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Instances -import VerifiedGarbage.Proof.Sha256.Arm.Shared - -/-! -# HMAC-SHA-256 on 32-bit ARM - -`HashOK` for SHA-256 (`sha256OK`): its streaming functions -(`vg_sha256_init`, `vg_sha256_update` and `vg_sha256_finalize`, whose -contracts for `update` and `finalize` hold from any initial hash value); and -the generic HMAC proofs at it, moved to the shared contracts of -`Spec.Hmac.sha256I` (as for the hash functions of `Hashes.lean` in -`Instances.lean`). --/ - -namespace VG.Proof.Hmac.Generic.Arm - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash) - -/-- SHA-256's functions: a 96-byte streaming state, 20 words of working -space and a 32-byte digest. -/ -def sha256H : Hash := ⟨64, 96, 32, 32, 20, "vg_sha256_init", Impl.Sha256.Arm.Stream.init, - "vg_sha256_update", Impl.Sha256.Arm.Stream.update, "vg_sha256_finalize", Impl.Sha256.Arm.Stream.finalize⟩ - -def sha256OK : HashOK sha256H where - SH := Spec.Hmac.sha256S - Wb := 160 - hS := rfl - hD := rfl - hB := rfl - hDF := by decide - hF := by decide - hD0 := by decide - hS0 := by decide - hSB := by decide - hB0 := by decide - hBB := by decide - hWb := by decide - hW := by decide - repr := Common.sha256_repr - init := Proof.Sha256.Arm.Stream.init_verified - upd := Proof.Sha256.Arm.Stream.Update.update_verified.of_implies - { pre := fun _ h => h - post := fun _ _ _ h m hr hc => h Spec.Sha256.H0 m hr hc - pub := fun _ _ _ _ h => h - sat := Proof.Sha256.Arm.Stream.Update.update_verified.2.2 } - fin := Proof.Sha256.Arm.Stream.Finalize.finalize_verified.of_implies - { pre := fun _ h => h - post := fun s s' _ h m hr _ hc => by - show List.take 32 (Spec.Sha256.bytesAt s'.mem _ 32) = _ - rw [List.take_of_length_le (by simp [Spec.Sha256.bytesAt])] - exact h Spec.Sha256.H0 m hr hc - pub := fun _ _ _ _ h => h - sat := Proof.Sha256.Arm.Stream.Finalize.finalize_verified.2.2 } - initNF := by decide +kernel - updNF := by decide +kernel - finNF := by decide +kernel - -end VG.Proof.Hmac.Generic.Arm - -namespace VG.Proof.Hmac.Generic.Arm.Instances - -open VG.Arm -open VG.Proof.Hmac.Generic.Arm - -theorem sha256_initChecks : Init.Checks sha256H where - keys := ⟨_, by taint_decide⟩ - argI := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - argU₁ := ⟨_, by taint_decide⟩ - argU₂ := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha256_initImp : (initG Spec.Hmac.sha256S 104).Implies (Spec.Hmac.sha256I.initContract Arm.abi 16) := - initImp Spec.Hmac.sha256S 104 (by - inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.sha256S, Spec.Hmac.sha256, initG, below, - count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 96 104) - -theorem sha256_finImp : (finG Spec.Hmac.sha256S 104).Implies (Spec.Hmac.sha256I.finalizeContract Arm.abi 16) := - finImp Spec.Hmac.sha256S 104 (by - inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha256S, Spec.Hmac.sha256, finG, - below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 96 32 104) - -theorem sha256_init : Verified Arm.target sha256H.init (Spec.Hmac.sha256I.initContract Arm.abi 16) := - (Init.verified sha256OK sha256_initChecks (by decide) sha256_initImp.sat_left).of_implies sha256_initImp - -end VG.Proof.Hmac.Generic.Arm.Instances diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Init.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Init.lean deleted file mode 100644 index ec2feacb2..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Init.lean +++ /dev/null @@ -1,1339 +0,0 @@ -import VerifiedGarbage.Proof.Hmac.Generic.X86.Hash -import Mathlib.Tactic.Set -import Mathlib.Tactic.Tauto -import VerifiedGarbage.Proof.Hmac.Generic.Common -import VerifiedGarbage.Proof.Framework.OffsetBelow -import VerifiedGarbage.Proof.Framework.OmegaLit - -/-! -# HMAC over any streaming hash function on x86 (32-bit): `init`, correct - -The byte loops, our caller's registers, then `init` (one module, as nothing -else imports the first two). --/ - -/-! -## The byte loops - -As on the other targets -(`Proof/Hmac/Generic/Arm/Init.lean`, whose byte-list lemmas from x86-64 -are reused): the byte copy (`copy`), the exclusive-or of `U` into `T`, and -`init`'s loops that write `K₀ ⊕ ipad` and `K₀ ⊕ opad`. Each counts an index -up from 0 and compares it with its bound. The model has no index registers, -so each access computes its address first: byte `k` of a buffer at -`p + o` is at `[x + o]` with `x = p + k`, which is `p + o + k`, as nothing -wraps around the 32-bit address space. --/ - -namespace VG.Proof.Hmac.Generic.X86 - -open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash copy at_) -open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil) -open VG.Proof.Sha256.X86.Stream (Upd Mupd Fupd WP.cons wp_mov wp_movi wp_add wp_addi wp_cmp wp_cmpi wp_test - wp_movzx8 wp_store8 sub_beq sub_ofNat eval_e eval_ne ofNat_beq_zero) -open VG.Proof.Hmac.Common (bytesAt_length) -open VG.Proof.Hmac.Generic.Common (writeBytes_snoc bytesAt_snoc' not_mem_of_disjoint xorBytes_snoc xorBytes_length' - InRegions.right' add_ofNat_add BufMem buf_write K0 K0_length K0_lt K0_ge) -open Spec.Sha256 (bytesAt) - -/-! ## Instructions and arithmetic -/ - -section -variable {is : List Instr} {s : State} {Q : State → Prop} - -theorem wp_xori {d : Reg} {v : BitVec 32} (k : ∀ s', Upd s s' d (s.gpr d ^^^ v) → WP isa (.block is) s' Q) : - WP isa (.block (.alu .xor d (.imm v) :: is)) s Q := - WP.cons rfl (k _ (Upd.flags _ _ _ _ _ _)) - -theorem wp_xor {d r : Reg} (k : ∀ s', Upd s s' d (s.gpr d ^^^ s.gpr r) → WP isa (.block is) s' Q) : - WP isa (.block (.alu .xor d (.reg r) :: is)) s Q := - WP.cons rfl (k _ (Upd.flags _ _ _ _ _ _)) - -end - -theorem ea_at (s : State) (b : Reg) (d : Nat) : s.ea (at_ b d) = addr (s.gpr b) d := rfl - -theorem ofNat_succ32 (k : Nat) : BitVec.ofNat 32 k + 1 = BitVec.ofNat 32 (k + 1) := by - rw [BitVec.ofNat_add]; rfl - -/-- Byte `k` of the buffer at `a + o`, as a loop addresses it. -/ -theorem addr3 {a : BitVec 32} {k o : Nat} (h : a.toNat + o + k < 2 ^ 32) : - addr (a + BitVec.ofNat 32 k) o = a.setWidth 64 + BitVec.ofNat 64 o + BitVec.ofNat 64 k := by - rw [VG.Proof.Sha256.X86.Stream.addr_add_ofNat (by omega_nat), add_ofNat_add, Nat.add_comm] - -/-- The flags after counting up to `k + 1 ≤ n`. -/ -theorem count_z {n k : Nat} (hk : k < n) (hn : n < 2 ^ 32) : - (BitVec.ofNat 32 (k + 1) - BitVec.ofNat 32 n == 0) = decide (k + 1 = n) := - sub_beq (by omega_nat) hn - -/-- The registers the loops write. -/ -abbrev clob : List Reg := [.eax, .ecx, .edx, .ebx] - -/-- The registers `copy` writes. -/ -abbrev cclob : List Reg := [.eax, .ecx, .edx] - -theorem not_cclob {r : Reg} (h : r ∉ clob) : r ∉ cclob := fun hc => - h (by simp only [List.mem_cons, List.not_mem_nil, or_false] at hc ⊢; tauto) - -theorem nm {r : Reg} {l : List Reg} (h : r ∉ l) (x : Reg) (hx : x ∈ l := by decide) : r ≠ x := - fun e => h (e ▸ hx) - -/-! ## Counted loops -/ - -/-- A do-while loop on `ne` that runs its body `n > 0` times, each run -ending with the flags of `k + 1 = n`. -/ -theorem count_loop {body : Prog isa} {n : Nat} (hn : 0 < n) (I : Nat → State → Prop) - (hstep : ∀ k < n, ∀ s, I k s → WP isa body s fun s' => I (k + 1) s' ∧ s'.zf = some (decide (k + 1 = n))) - {s : State} (h0 : I 0 s) : WP isa (.loop body .ne) s (I n) := by - refine WP.loop (M := isa) (fun m s => ∃ k, m = n - k ∧ k < n ∧ I k s) ?_ n s ⟨0, by omega_nat, hn, h0⟩ - rintro m s ⟨k, rfl, hk, hi⟩ - refine WP.mono (hstep k hk s hi) fun s' ⟨hi', hz⟩ => ?_ - have he : isa.eval .ne s' = some (!decide (k + 1 = n)) := by - show eval .ne s' = _; rw [eval_ne, hz]; rfl - by_cases hl : k + 1 = n - · exact .inl ⟨by rw [he]; simp [hl], hl ▸ hi'⟩ - · exact .inr ⟨by rw [he]; simp [hl], n - (k + 1), by omega_nat, k + 1, rfl, by omega_nat, hi'⟩ - -/-! ## `copy` -/ - -/-- After `k` bytes of a `copy` from `A` to `B`. -/ -structure CopyInv (s : State) (A B : Addr) (k : Nat) (t : State) : Prop where - rd : t.rd = s.rd - wr : t.wr = s.wr - other : ∀ r ∉ cclob, t.gpr r = s.gpr r - ecx : t.gpr .ecx = BitVec.ofNat 32 k - mem : t.mem = writeBytes s.mem B (bytesAt s.mem A k) - -/-- The registers and memory `copy` leaves. -/ -structure Copied (s : State) (B : Addr) (xs : List Byte) (t : State) : Prop where - rd : t.rd = s.rd - wr : t.wr = s.wr - other : ∀ r ∉ cclob, t.gpr r = s.gpr r - mem : t.mem = writeBytes s.mem B xs - -theorem copy_ok {src dst : Reg} (hs : src ∉ cclob) (hd : dst ∉ cclob) - {so d n : Nat} (hn : 0 < n) (hn' : n < 2 ^ 32) {s : State} - (hsw : (s.gpr src).toNat + so + n ≤ 2 ^ 32) (hdw : (s.gpr dst).toNat + d + n ≤ 2 ^ 32) - (hin : ∀ k < n, InRegions (s.rd ++ s.wr) ((s.gpr src).setWidth 64 + BitVec.ofNat 64 so + BitVec.ofNat 64 k) 1) - (hout : ∀ k < n, InRegions s.wr ((s.gpr dst).setWidth 64 + BitVec.ofNat 64 d + BitVec.ofNat 64 k) 1) - (hsep : Region.Disjoint ⟨(s.gpr src).setWidth 64 + BitVec.ofNat 64 so, n⟩ - ⟨(s.gpr dst).setWidth 64 + BitVec.ofNat 64 d, n⟩) : - WP isa (copy src so dst d n) s fun t => - Copied s ((s.gpr dst).setWidth 64 + BitVec.ofNat 64 d) - (bytesAt s.mem ((s.gpr src).setWidth 64 + BitVec.ofNat 64 so) n) t := by - set A := (s.gpr src).setWidth 64 + BitVec.ofNat 64 so - set B := (s.gpr dst).setWidth 64 + BitVec.ofNat 64 d - refine WP.seq (wp_movi fun s₀ u₀ => WP.block_nil ?_) - have i0 : CopyInv s A B 0 s₀ := - ⟨u₀.rd, u₀.wr, fun r hr => u₀.other r (nm hr .ecx), u₀.gpr, - by rw [u₀.mem, bytesAt, List.range_zero, List.map_nil, writeBytes_nil]⟩ - refine WP.mono (count_loop hn (CopyInv s A B) (fun k hk t h => ?_) i0) - fun t h => ⟨h.rd, h.wr, h.other, h.mem⟩ - refine wp_mov fun t₁ u₁ => wp_add fun t₂ u₂ => ?_ - refine wp_movzx8 (a := A + BitVec.ofNat 64 k) - (by rw [ea_at, u₂.gpr, u₁.gpr, u₁.other _ (by decide), h.other src hs, h.ecx, addr3 (by omega_nat)]) - (by rw [u₂.rd, u₂.wr, u₁.rd, u₁.wr, h.rd, h.wr]; exact hin k hk) fun t₃ u₃ => ?_ - refine wp_mov fun t₄ u₄ => wp_add fun t₅ u₅ => ?_ - refine wp_store8 (a := B + BitVec.ofNat 64 k) - (by rw [ea_at, u₅.gpr, u₄.gpr, u₄.other .ecx (by decide), u₃.other .ecx (by decide), u₂.other .ecx (by decide), - u₁.other .ecx (by decide), u₃.other _ (nm hd .edx), u₂.other _ (nm hd .eax), - u₁.other _ (nm hd .eax), h.other dst hd, h.ecx, addr3 (by omega_nat)]) - (by rw [u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr]; exact hout k hk) fun t₆ m₆ => ?_ - refine wp_addi fun t₇ u₇ => wp_cmpi fun t₈ f₈ _ z₈ => WP.block_nil ?_ - have h7 : t₇.gpr .ecx = BitVec.ofNat 32 (k + 1) := by - rw [u₇.gpr, m₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), - u₂.other _ (by decide), u₁.other _ (by decide), h.ecx, ofNat_succ32] - refine ⟨⟨by rw [f₈.rd, u₇.rd, m₆.rd, u₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], - by rw [f₈.wr, u₇.wr, m₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], - fun r hr => by - rw [f₈.gpr, u₇.other r (nm hr .ecx), m₆.gpr, u₅.other r (nm hr .eax), u₄.other r (nm hr .eax), - u₃.other r (nm hr .edx), u₂.other r (nm hr .eax), u₁.other r (nm hr .eax), h.other r hr], - by rw [f₈.gpr, h7], ?_⟩, ?_⟩ - · have hl : (bytesAt s.mem A k).length = k := bytesAt_length _ _ _ - have v : (t₅.gpr .edx).setWidth 8 = s.mem (A + BitVec.ofNat 64 k) := by - rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, u₂.mem, u₁.mem, h.mem] - simp only [writeBytes, hl, not_mem_of_disjoint hsep hk (Nat.le_of_lt hk) (by omega_nat), ↓reduceIte] - ext i hi; simp - have e' := writeBytes_snoc s.mem B (bytesAt s.mem A k) (s.mem (A + BitVec.ofNat 64 k)) - (by rw [hl]; omega_nat) - rw [hl] at e' - rw [f₈.mem, u₇.mem, m₆.mem, show Reg8.dl.reg = .edx from rfl, v, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem, - h.mem, bytesAt_snoc', e'] - · rw [z₈, h7, count_z hk hn'] - -/-! ## The exclusive-or of `U` into `T` -/ - -theorem xor_byte32 (a b : Byte) : ((a.setWidth 32 ^^^ b.setWidth 32).setWidth 8) = b ^^^ a := by - ext i hi - simp [BitVec.getElem_xor, Bool.xor_comm] - -/-- After `k` bytes of the exclusive-or of `[U]` into `[T]`. -/ -structure XorInv (s : State) (U T : Addr) (k : Nat) (t : State) : Prop where - rd : t.rd = s.rd - wr : t.wr = s.wr - other : ∀ r ∉ clob, t.gpr r = s.gpr r - ecx : t.gpr .ecx = BitVec.ofNat 32 k - mem : t.mem = writeBytes s.mem T (Spec.Pbkdf2.xorBytes (bytesAt s.mem T k) (bytesAt s.mem U k)) - -/-- `T ← T ⊕ U`, `n` bytes, with `U` at `ebp + uo` and `T` at `esi`. -/ -theorem xor_ok {uo n : Nat} (hn : 0 < n) (hn' : n < 2 ^ 32) {s : State} - (huw : (s.gpr .ebp).toNat + uo + n ≤ 2 ^ 32) (htw : (s.gpr .esi).toNat + n ≤ 2 ^ 32) - (hinU : ∀ k < n, InRegions (s.rd ++ s.wr) ((s.gpr .ebp).setWidth 64 + BitVec.ofNat 64 uo + BitVec.ofNat 64 k) 1) - (houtT : ∀ k < n, InRegions s.wr ((s.gpr .esi).setWidth 64 + BitVec.ofNat 64 k) 1) - (hsep : Region.Disjoint ⟨(s.gpr .ebp).setWidth 64 + BitVec.ofNat 64 uo, n⟩ ⟨(s.gpr .esi).setWidth 64, n⟩) : - WP isa (.seq (.block [.mov .ecx (.imm 0)]) - (.loop (.block [.mov .eax (.reg .ebp), .alu .add .eax (.reg .ecx), .movzx8 .edx (at_ .eax uo), - .mov .eax (.reg .esi), .alu .add .eax (.reg .ecx), .movzx8 .ebx (at_ .eax 0), .alu .xor .edx (.reg .ebx), - .store8 (at_ .eax 0) .dl, .alu .add .ecx (.imm 1), .alu .cmp .ecx (.imm (BitVec.ofNat 32 n))]) .ne)) s - fun t => XorInv s ((s.gpr .ebp).setWidth 64 + BitVec.ofNat 64 uo) ((s.gpr .esi).setWidth 64) n t := by - set U := (s.gpr .ebp).setWidth 64 + BitVec.ofNat 64 uo - set T := (s.gpr .esi).setWidth 64 - refine WP.seq (wp_movi fun s₀ u₀ => WP.block_nil ?_) - have i0 : XorInv s U T 0 s₀ := - ⟨u₀.rd, u₀.wr, fun r hr => u₀.other r (nm hr .ecx), u₀.gpr, - by rw [u₀.mem]; simp [bytesAt, Spec.Pbkdf2.xorBytes, writeBytes_nil]⟩ - refine count_loop hn (XorInv s U T) (fun k hk t h => ?_) i0 - have hl : (bytesAt s.mem T k).length = k := bytesAt_length _ _ _ - have hl' : (Spec.Pbkdf2.xorBytes (bytesAt s.mem T k) (bytesAt s.mem U k)).length = k := by - rw [xorBytes_length' _ _ (by simp [bytesAt_length]), hl] - have rU : t.mem (U + BitVec.ofNat 64 k) = s.mem (U + BitVec.ofNat 64 k) := by - rw [h.mem]; simp only [writeBytes, hl', not_mem_of_disjoint hsep hk (Nat.le_of_lt hk) (by omega_nat), ↓reduceIte] - have rT : t.mem (T + BitVec.ofNat 64 k) = s.mem (T + BitVec.ofNat 64 k) := by - rw [h.mem] - simp only [writeBytes, hl', Offset.add_sub_cancel_left, - BitVec.toNat_ofNat, Nat.mod_eq_of_lt (show k < 2 ^ 64 by omega_nat), Nat.lt_irrefl, ↓reduceIte] - have gb := h.other .ebp (by decide) - have gs := h.other .esi (by decide) - refine wp_mov fun t₁ u₁ => wp_add fun t₂ u₂ => ?_ - refine wp_movzx8 (a := U + BitVec.ofNat 64 k) - (by rw [ea_at, u₂.gpr, u₁.gpr, u₁.other _ (by decide), gb, h.ecx, addr3 (by omega_nat)]) - (by rw [u₂.rd, u₂.wr, u₁.rd, u₁.wr, h.rd, h.wr]; exact hinU k hk) fun t₃ u₃ => ?_ - refine wp_mov fun t₄ u₄ => wp_add fun t₅ u₅ => ?_ - have a₅ : t₅.ea (at_ .eax 0) = T + BitVec.ofNat 64 k := by - rw [ea_at, u₅.gpr, u₄.gpr, u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), - u₁.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), gs, h.ecx, - addr3 (by omega_nat)] - exact congrArg (· + BitVec.ofNat 64 k) (BitVec.add_zero _) - refine wp_movzx8 (a := T + BitVec.ofNat 64 k) a₅ - (by rw [u₅.rd, u₅.wr, u₄.rd, u₄.wr, u₃.rd, u₃.wr, u₂.rd, u₂.wr, u₁.rd, u₁.wr, h.rd, h.wr] - exact InRegions.right' (houtT k hk)) fun t₆ u₆ => ?_ - refine wp_xor fun t₇ u₇ => ?_ - refine wp_store8 (a := T + BitVec.ofNat 64 k) - (by rw [ea_at, u₇.other _ (by decide), u₆.other _ (by decide)]; exact a₅) - (by rw [u₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr]; exact houtT k hk) fun t₈ m₈ => ?_ - refine wp_addi fun t₉ u₉ => wp_cmpi fun t₁₀ f₁₀ _ z₁₀ => WP.block_nil ?_ - have h9 : t₉.gpr .ecx = BitVec.ofNat 32 (k + 1) := by - rw [u₉.gpr, m₈.gpr, u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), - u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), h.ecx, - ofNat_succ32] - refine ⟨⟨by rw [f₁₀.rd, u₉.rd, m₈.rd, u₇.rd, u₆.rd, u₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], - by rw [f₁₀.wr, u₉.wr, m₈.wr, u₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], - fun r hr => by - rw [f₁₀.gpr, u₉.other r (nm hr .ecx), m₈.gpr, u₇.other r (nm hr .edx), u₆.other r (nm hr .ebx), - u₅.other r (nm hr .eax), u₄.other r (nm hr .eax), u₃.other r (nm hr .edx), u₂.other r (nm hr .eax), - u₁.other r (nm hr .eax), h.other r hr], - by rw [f₁₀.gpr, h9], ?_⟩, ?_⟩ - · have hv : (t₇.gpr .edx).setWidth 8 = s.mem (T + BitVec.ofNat 64 k) ^^^ s.mem (U + BitVec.ofNat 64 k) := by - rw [u₇.gpr, u₆.other .edx (by decide), u₆.gpr, u₅.other .edx (by decide), - u₄.other .edx (by decide), u₃.gpr, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem, xor_byte32, rU, rT] - have e' := writeBytes_snoc s.mem T (Spec.Pbkdf2.xorBytes (bytesAt s.mem T k) (bytesAt s.mem U k)) - (s.mem (T + BitVec.ofNat 64 k) ^^^ s.mem (U + BitVec.ofNat 64 k)) (by rw [hl']; omega_nat) - rw [hl'] at e' - rw [f₁₀.mem, u₉.mem, m₈.mem, show Reg8.dl.reg = .edx from rfl, hv, u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem, - u₂.mem, u₁.mem, h.mem, e', bytesAt_snoc', bytesAt_snoc', xorBytes_snoc _ _ _ _ (by simp [bytesAt_length])] - · rw [z₁₀, h9, count_z hk hn'] - -/-! ## `init`'s key and pad loops - -`K₀ ⊕ ipad` is written at `P = scratch + buf` and `K₀ ⊕ opad` at `P + B`, -byte by byte (as on x86-64, `BufMem`): first the key's `kl` bytes (read at -`K`), then the zeros that pad it to `B`. `ebx` is the index, `esi` the key, -`edi` its length and `ebp` `scratch`. -/ - -variable (H : Hash) - -/-- Where the loops are. -/ -structure LoopRegs (scr kp : BitVec 32) (kl : Nat) (s : State) : Prop where - ebp : s.gpr .ebp = scr - esi : s.gpr .esi = kp - edi : s.gpr .edi = BitVec.ofNat 32 kl - -theorem LoopRegs.keep {scr kp : BitVec 32} {kl : Nat} {s t : State} (h : LoopRegs scr kp kl s) - (hk : ∀ r ∉ clob, t.gpr r = s.gpr r) : LoopRegs scr kp kl t := - ⟨by rw [hk _ (by decide), h.ebp], by rw [hk _ (by decide), h.esi], by rw [hk _ (by decide), h.edi]⟩ - -/-- The loops' invariant, from the state `s` they start in. -/ -structure KeyInv (s : State) (P K : Addr) (kl j : Nat) (t : State) : Prop where - rd : t.rd = s.rd - wr : t.wr = s.wr - other : ∀ r ∉ clob, t.gpr r = s.gpr r - ebx : t.gpr .ebx = BitVec.ofNat 32 j - mem : BufMem H.B P (K0 s.mem K kl H.B) s.mem j t.mem - -/-- The regions the loops access, and the sizes. -/ -structure LoopMem (scr kp : BitVec 32) (kl : Nat) (s : State) : Prop where - kl_le : kl ≤ H.B - key : ∀ k < kl, InRegions (s.rd ++ s.wr) (kp.setWidth 64 + BitVec.ofNat 64 k) 1 - buf : ∀ k < 2 * H.B, InRegions s.wr (scr.setWidth 64 + BitVec.ofNat 64 H.buf + BitVec.ofNat 64 k) 1 - disj : Region.Disjoint ⟨kp.setWidth 64, kl⟩ ⟨scr.setWidth 64 + BitVec.ofNat 64 H.buf, 2 * H.B⟩ - hB : H.B ≤ 128 - nscr : scr.toNat + H.buf + 2 * H.B ≤ 2 ^ 32 - nkey : kp.toNat + kl ≤ 2 ^ 32 - -/-- The bodies of `init`'s loops. -/ -def keyBody : List Instr := - [.mov .eax (.reg .esi), .alu .add .eax (.reg .ebx), .movzx8 .eax (at_ .eax 0), - .mov .ecx (.reg .eax), .alu .xor .eax (.imm 0x36), .mov .edx (.reg .ebp), .alu .add .edx (.reg .ebx), - .store8 (at_ .edx H.buf) .al, .alu .xor .ecx (.imm 0x5c), .store8 (at_ .edx (H.buf + H.B)) .cl, - .alu .add .ebx (.imm 1), .alu .cmp .ebx (.reg .edi)] - -def padBody : List Instr := - [.mov .edx (.reg .ebp), .alu .add .edx (.reg .ebx), .store8 (at_ .edx H.buf) .al, - .store8 (at_ .edx (H.buf + H.B)) .cl, .alu .add .ebx (.imm 1), - .alu .cmp .ebx (.imm (BitVec.ofNat 32 H.B))] - -theorem keyLoop_eq : H.keyLoop = .loop (.block (keyBody H)) .ne := rfl -theorem padLoop_eq : H.padLoop = .loop (.block (padBody H)) .ne := rfl - -theorem pad_byte32 (b : Byte) (v : BitVec 32) : (b.setWidth 32 ^^^ v).setWidth 8 = b ^^^ v.setWidth 8 := by - ext i hi - simp [BitVec.getElem_setWidth, BitVec.getElem_xor] - -theorem ipad32 : (0x36 : BitVec 32).setWidth 8 = Spec.Hmac.ipad := by decide -theorem opad32 : (0x5c : BitVec 32).setWidth 8 = Spec.Hmac.opad := by decide -theorem zero_ipad : (0x36 : BitVec 32).setWidth 8 = (0 : Byte) ^^^ Spec.Hmac.ipad := by decide -theorem zero_opad : (0x5c : BitVec 32).setWidth 8 = (0 : Byte) ^^^ Spec.Hmac.opad := by decide - -theorem key_step {scr kp : BitVec 32} {kl : Nat} {s : State} (hr : LoopRegs scr kp kl s) - (hm : LoopMem H scr kp kl s) {j : Nat} (hj : j < kl) {t : State} - (h : KeyInv H s (scr.setWidth 64 + BitVec.ofNat 64 H.buf) (kp.setWidth 64) kl j t) : - WP isa (.block (keyBody H)) t fun t' => - KeyInv H s (scr.setWidth 64 + BitVec.ofNat 64 H.buf) (kp.setWidth 64) kl (j + 1) t' ∧ - t'.zf = some (decide (j + 1 = kl)) := by - have hkl := hm.kl_le - have hB := hm.hB - have hn := hm.nscr - have hnk := hm.nkey - set P := scr.setWidth 64 + BitVec.ofNat 64 H.buf - set K := kp.setWidth 64 - have hl : j < (K0 s.mem K kl H.B).length := by rw [K0_length _ _ hkl]; omega_nat - have rt := hr.keep h.other - have hbyte : t.mem (K + BitVec.ofNat 64 j) = (K0 s.mem K kl H.B)[j] := by - rw [K0_lt hj hl] - refine h.mem.frame _ fun r hr' hc => ?_ - simp only [List.mem_singleton] at hr'; subst hr' - exact hm.disj _ (Proof.Sha256.X86.contains_offset (n := 1) (by omega_nat) (by omega_nat)) hc - refine wp_mov fun t₁ u₁ => wp_add fun t₂ u₂ => ?_ - refine wp_movzx8 (a := K + BitVec.ofNat 64 j) - (by rw [ea_at, u₂.gpr, u₁.gpr, u₁.other _ (by decide), rt.esi, h.ebx, addr3 (by omega_nat)] - exact congrArg (· + BitVec.ofNat 64 j) (BitVec.add_zero _)) - (by rw [u₂.rd, u₂.wr, u₁.rd, u₁.wr, h.rd, h.wr]; exact hm.key j hj) fun t₃ u₃ => ?_ - refine wp_mov fun t₄ u₄ => wp_xori fun t₅ u₅ => wp_mov fun t₆ u₆ => wp_add fun t₇ u₇ => ?_ - have a7 : ∀ o, o + j < 2 ^ 32 - scr.toNat → t₇.ea (at_ .edx o) = scr.setWidth 64 + BitVec.ofNat 64 o + - BitVec.ofNat 64 j := fun o ho => by - rw [ea_at, u₇.gpr, u₆.gpr, u₆.other .ebx (by decide), u₅.other .ebx (by decide), u₄.other .ebx (by decide), - u₃.other .ebx (by decide), u₂.other .ebx (by decide), u₁.other .ebx (by decide), - u₅.other .ebp (by decide), u₄.other .ebp (by decide), u₃.other .ebp (by decide), - u₂.other .ebp (by decide), u₁.other .ebp (by decide), rt.ebp, h.ebx, addr3 (by omega_nat)] - refine wp_store8 (a := P + BitVec.ofNat 64 j) (a7 _ (by omega_nat)) - (by rw [u₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr]; exact hm.buf j (by omega_nat)) fun t₈ m₈ => ?_ - refine wp_xori fun t₉ u₉ => ?_ - refine wp_store8 (a := P + BitVec.ofNat 64 H.B + BitVec.ofNat 64 j) - (by rw [ea_at, u₉.other _ (by decide), m₈.gpr, ← ea_at, a7 _ (by omega_nat)]; simp only [P, add_ofNat_add]) - (by rw [u₉.wr, m₈.wr, u₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr, add_ofNat_add] - exact hm.buf (H.B + j) (by omega_nat)) - fun t₁₀ m₁₀ => ?_ - refine wp_addi fun t₁₁ u₁₁ => wp_cmp fun t₁₂ f₁₂ _ z₁₂ => WP.block_nil ?_ - have k : ∀ r ∉ clob, t₁₂.gpr r = t.gpr r := fun r hr' => by - rw [f₁₂.gpr, u₁₁.other r (nm hr' .ebx), m₁₀.gpr, u₉.other r (nm hr' .ecx), m₈.gpr, - u₇.other r (nm hr' .edx), u₆.other r (nm hr' .edx), u₅.other r (nm hr' .eax), u₄.other r (nm hr' .ecx), - u₃.other r (nm hr' .eax), u₂.other r (nm hr' .eax), u₁.other r (nm hr' .eax)] - have h11 : t₁₁.gpr .ebx = BitVec.ofNat 32 (j + 1) := by - rw [u₁₁.gpr, m₁₀.gpr, u₉.other _ (by decide), m₈.gpr, u₇.other _ (by decide), u₆.other _ (by decide), - u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), - u₁.other _ (by decide), h.ebx, ofNat_succ32] - have hdi : t₁₁.gpr .edi = BitVec.ofNat 32 kl := by - rw [u₁₁.other _ (by decide), m₁₀.gpr, u₉.other _ (by decide), m₈.gpr, u₇.other _ (by decide), - u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), - u₂.other _ (by decide), u₁.other _ (by decide), rt.edi] - refine ⟨⟨by rw [f₁₂.rd, u₁₁.rd, m₁₀.rd, u₉.rd, m₈.rd, u₇.rd, u₆.rd, u₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], - by rw [f₁₂.wr, u₁₁.wr, m₁₀.wr, u₉.wr, m₈.wr, u₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], - fun r hr' => by rw [k r hr', h.other r hr'], by rw [f₁₂.gpr, h11], ?_⟩, - by rw [z₁₂, h11, hdi, count_z hj (by omega_nat)]⟩ - have v₁ : (t₇.gpr Reg8.al.reg).setWidth 8 = (K0 s.mem K kl H.B)[j] ^^^ Spec.Hmac.ipad := by - show (t₇.gpr .eax).setWidth 8 = _ - rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.gpr, u₄.other _ (by decide), u₃.gpr, u₂.mem, - u₁.mem, pad_byte32, hbyte, ipad32] - have v₂ : (t₉.gpr Reg8.cl.reg).setWidth 8 = (K0 s.mem K kl H.B)[j] ^^^ Spec.Hmac.opad := by - show (t₉.gpr .ecx).setWidth 8 = _ - rw [u₉.gpr, m₈.gpr, u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, - u₃.gpr, u₂.mem, u₁.mem, pad_byte32, hbyte, opad32] - rw [f₁₂.mem, u₁₁.mem, m₁₀.mem, v₂, u₉.mem, m₈.mem, v₁, u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem, - u₂.mem, u₁.mem] - exact buf_write h.mem hB (by omega_nat) hl - -theorem pad_step {scr kp : BitVec 32} {kl : Nat} {s₀ : State} (hr : LoopRegs scr kp kl s₀) - (hm : LoopMem H scr kp kl s₀) {j : Nat} (hj : kl ≤ j) (hj' : j < H.B) {t : State} - (h : KeyInv H s₀ (scr.setWidth 64 + BitVec.ofNat 64 H.buf) (kp.setWidth 64) kl j t) - (hax : t.gpr .eax = 0x36) (hcx : t.gpr .ecx = 0x5c) : - WP isa (.block (padBody H)) t fun t' => - (KeyInv H s₀ (scr.setWidth 64 + BitVec.ofNat 64 H.buf) (kp.setWidth 64) kl (j + 1) t' ∧ - t'.gpr .eax = 0x36 ∧ t'.gpr .ecx = 0x5c) ∧ t'.zf = some (decide (j + 1 = H.B)) := by - have hkl := hm.kl_le - have hB := hm.hB - have hn := hm.nscr - set P := scr.setWidth 64 + BitVec.ofNat 64 H.buf - set K := kp.setWidth 64 - have hl : j < (K0 s₀.mem K kl H.B).length := by rw [K0_length _ _ hkl]; omega_nat - have rt := hr.keep h.other - refine wp_mov fun t₁ u₁ => wp_add fun t₂ u₂ => ?_ - have a2 : ∀ o, o + j < 2 ^ 32 - scr.toNat → t₂.ea (at_ .edx o) = scr.setWidth 64 + BitVec.ofNat 64 o + - BitVec.ofNat 64 j := fun o ho => by - rw [ea_at, u₂.gpr, u₁.gpr, u₁.other .ebx (by decide), rt.ebp, h.ebx, addr3 (by omega_nat)] - refine wp_store8 (a := P + BitVec.ofNat 64 j) (a2 _ (by omega_nat)) - (by rw [u₂.wr, u₁.wr, h.wr]; exact hm.buf j (by omega_nat)) fun t₃ m₃ => ?_ - refine wp_store8 (a := P + BitVec.ofNat 64 H.B + BitVec.ofNat 64 j) - (by rw [ea_at, m₃.gpr, ← ea_at, a2 _ (by omega_nat)]; simp only [P, add_ofNat_add]) - (by rw [m₃.wr, u₂.wr, u₁.wr, h.wr, add_ofNat_add]; exact hm.buf (H.B + j) (by omega_nat)) fun t₄ m₄ => ?_ - refine wp_addi fun t₅ u₅ => wp_cmpi fun t₆ f₆ _ z₆ => WP.block_nil ?_ - have h5 : t₅.gpr .ebx = BitVec.ofNat 32 (j + 1) := by - rw [u₅.gpr, m₄.gpr, m₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), h.ebx, ofNat_succ32] - have k : ∀ r, r ≠ .edx → r ≠ .ebx → t₆.gpr r = t.gpr r := fun r h1 h2 => by - rw [f₆.gpr, u₅.other r h2, m₄.gpr, m₃.gpr, u₂.other r h1, u₁.other r h1] - refine ⟨⟨⟨by rw [f₆.rd, u₅.rd, m₄.rd, m₃.rd, u₂.rd, u₁.rd, h.rd], - by rw [f₆.wr, u₅.wr, m₄.wr, m₃.wr, u₂.wr, u₁.wr, h.wr], - fun r hr' => by rw [k r (nm hr' .edx) (nm hr' .ebx), h.other r hr'], by rw [f₆.gpr, h5], ?_⟩, - by rw [k _ (by decide) (by decide), hax], by rw [k _ (by decide) (by decide), hcx]⟩, - by rw [z₆, h5, count_z hj' (by omega_nat)]⟩ - have e₁ : (t₂.gpr Reg8.al.reg).setWidth 8 = (0 : Byte) ^^^ Spec.Hmac.ipad := by - show (t₂.gpr .eax).setWidth 8 = _ - rw [u₂.other _ (by decide), u₁.other _ (by decide), hax, zero_ipad] - have e₂ : (t₃.gpr Reg8.cl.reg).setWidth 8 = (0 : Byte) ^^^ Spec.Hmac.opad := by - show (t₃.gpr .ecx).setWidth 8 = _ - rw [m₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), hcx, zero_opad] - rw [f₆.mem, u₅.mem, m₄.mem, e₂, m₃.mem, e₁, u₂.mem, u₁.mem, ← K0_ge (m := s₀.mem) (K := K) (B := H.B) hj hl] - exact buf_write h.mem hB hj' hl - -theorem test_z (x : BitVec 32) : (x &&& x == 0) = decide (x.toNat = 0) := by - rw [BitVec.and_self] - by_cases h : x.toNat = 0 - · have : x = 0 := BitVec.eq_of_toNat_eq (by simpa using h) - simp [this] - · simp only [h, decide_false, beq_eq_false_iff_ne, ne_eq] - intro e; exact h (by rw [e]; rfl) - -/-- The key loop, skipped for an empty key: from `ebx = 0` and the flags of `kl = 0`. -/ -theorem key_ok {scr kp : BitVec 32} {kl : Nat} {s : State} (hr : LoopRegs scr kp kl s) - (hm : LoopMem H scr kp kl s) (hb : s.gpr .ebx = BitVec.ofNat 32 0) (hz : s.zf = some (decide (kl = 0))) : - WP isa (.ite .e (.block []) H.keyLoop) s - (KeyInv H s (scr.setWidth 64 + BitVec.ofNat 64 H.buf) (kp.setWidth 64) kl kl) := by - have hkl := hm.kl_le - have hB := hm.hB - have i0 : KeyInv H s (scr.setWidth 64 + BitVec.ofNat 64 H.buf) (kp.setWidth 64) kl 0 s := - ⟨rfl, rfl, fun _ _ => rfl, hb, ⟨by simp [bytesAt], by simp [bytesAt], Frame.refl _ _⟩⟩ - refine WP.ite (decide (kl = 0)) (by show eval .e s = _; rw [eval_e, hz]) (fun h0 => WP.block_nil ?_) - fun h0 => ?_ - · have : kl = 0 := by simpa using h0 - subst this; exact i0 - · have hpos : 0 < kl := by simp at h0; omega_nat - rw [keyLoop_eq] - exact count_loop hpos _ (fun k hk t h => key_step H hr hm hk h) i0 - -/-- The pad loop, skipped for a key of `B` bytes: from `ebx = kl`. -/ -theorem pad_ok {scr kp : BitVec 32} {kl : Nat} {s₀ : State} (hr : LoopRegs scr kp kl s₀) - (hm : LoopMem H scr kp kl s₀) {t : State} - (h : KeyInv H s₀ (scr.setWidth 64 + BitVec.ofNat 64 H.buf) (kp.setWidth 64) kl kl t) : - WP isa (.seq (.block [.mov .eax (.imm 0x36), .mov .ecx (.imm 0x5c), .alu .cmp .ebx (.imm (BitVec.ofNat 32 H.B))]) - (.ite .e (.block []) H.padLoop)) t - (KeyInv H s₀ (scr.setWidth 64 + BitVec.ofNat 64 H.buf) (kp.setWidth 64) kl H.B) := by - have hkl := hm.kl_le - have hB := hm.hB - refine WP.seq (wp_movi fun t₁ u₁ => wp_movi fun t₂ u₂ => wp_cmpi fun t₃ f₃ _ z₃ => WP.block_nil ?_) - have i0 : KeyInv H s₀ (scr.setWidth 64 + BitVec.ofNat 64 H.buf) (kp.setWidth 64) kl kl t₃ := - ⟨by rw [f₃.rd, u₂.rd, u₁.rd, h.rd], by rw [f₃.wr, u₂.wr, u₁.wr, h.wr], - fun r hr' => by rw [f₃.gpr, u₂.other r (nm hr' .ecx), u₁.other r (nm hr' .eax), h.other r hr'], - by rw [f₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), h.ebx], - by rw [f₃.mem, u₂.mem, u₁.mem]; exact h.mem⟩ - have hax : t₃.gpr .eax = 0x36 := by rw [f₃.gpr, u₂.other _ (by decide), u₁.gpr] - have hcx : t₃.gpr .ecx = 0x5c := by rw [f₃.gpr, u₂.gpr] - have hz : t₃.zf = some (decide (kl = H.B)) := by - rw [z₃, u₂.other _ (by decide), u₁.other _ (by decide), h.ebx, sub_beq (by omega_nat) (by omega_nat)] - refine WP.ite (decide (kl = H.B)) (by show eval .e t₃ = _; rw [eval_e, hz]) (fun h0 => WP.block_nil ?_) - fun h0 => ?_ - · have : kl = H.B := by simpa using h0 - exact this ▸ i0 - · have hlt : kl < H.B := by simp at h0; omega_nat - rw [padLoop_eq] - have := count_loop (n := H.B - kl) (by omega_nat) - (fun k t => KeyInv H s₀ (scr.setWidth 64 + BitVec.ofNat 64 H.buf) (kp.setWidth 64) kl (kl + k) t ∧ - t.gpr .eax = 0x36 ∧ t.gpr .ecx = 0x5c) - (fun k hk t ⟨hk', ha, hc⟩ => WP.mono (pad_step H hr hm (j := kl + k) (by omega_nat) (by omega_nat) hk' ha hc) - fun t' ⟨⟨a, b, c⟩, d⟩ => ⟨⟨by rw [← Nat.add_assoc]; exact a, b, c⟩, - by rw [d]; exact congrArg some (decide_eq_decide.mpr (by omega_nat))⟩) - (s := t₃) ⟨by simpa using i0, hax, hcx⟩ - rw [show kl + (H.B - kl) = H.B by omega_nat] at this - exact WP.mono this fun _ h => h.1 - -end VG.Proof.Hmac.Generic.X86 - -/-! -## Our caller's registers - -As on the other targets -(`Proof/Hmac/Generic/Arm/Init.lean`): the callee-saved registers we use -(`ebx`, `esi`, `edi`, `ebp`) are stored in `scratch` after the working -space of the functions we call (`Hash.saved`), with `scratch` in `eax`, and -loaded back at the end, with `scratch` copied from `ebp` into `eax` first. --/ - -namespace VG.Proof.Hmac.Generic.X86 - -open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash at_) -open VG.Proof.Sha256.X86 (contains_offset) -open VG.Proof.Sha256.X86.Stream (Upd Mupd wp_mov wp_movm wp_store sub_offset) -open VG.Proof.Hmac.Generic.Common (InRegions.right' add_ofNat_add) - -variable (H : Hash) - -/-- The registers saved, in the order of their slots. -/ -abbrev savedRegs : List Reg := [.ebx, .esi, .edi, .ebp] - -theorem callee_saved : ∀ r ∈ calleeSaved, r ≠ .esp → r ∈ savedRegs := by decide - -/-- Where the registers are saved. -/ -abbrev saveR (scr : BitVec 32) : Region := ⟨scr.setWidth 64 + BitVec.ofNat 64 (8 * H.W), 16⟩ - -/-- The registers of `s₀` saved in the memory `m`. -/ -def SavedRegs (scr : BitVec 32) (s₀ : State) (m : Mem) : Prop := - ∀ p ∈ H.saved, m.readW (scr.setWidth 64 + BitVec.ofNat 64 p.2) 32 = s₀.gpr p.1 - -theorem saved_mem {p : Reg × Nat} (hp : p ∈ H.saved) : 8 * H.W ≤ p.2 ∧ p.2 + 4 ≤ 8 * H.W + 16 := by - simp only [Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp - rcases hp with rfl | rfl | rfl | rfl <;> simp only <;> omega_nat - -theorem saved_pairwise : H.saved.Pairwise (fun p q => p.2 + 4 ≤ q.2 ∨ q.2 + 4 ≤ p.2) := by - simp [Hash.saved] - -/-- Slot `d` of the save area. -/ -theorem slot_sub (scr : BitVec 32) {d : Nat} (h₁ : 8 * H.W ≤ d) (h₂ : d + 4 ≤ 8 * H.W + 16) : - Region.Sub ⟨scr.setWidth 64 + BitVec.ofNat 64 d, 4⟩ (saveR H scr) := by - rw [show d = 8 * H.W + (d - 8 * H.W) by omega_nat, ← add_ofNat_add] - exact sub_offset (by omega_nat) (by omega_nat) - -theorem SavedRegs.frame {scr : BitVec 32} {s₀ : State} {m m' : Mem} (h : SavedRegs H scr s₀ m) - {rs : List Region} (hf : Frame rs m m') (hd : ∀ r ∈ rs, (saveR H scr).Disjoint r) : - SavedRegs H scr s₀ m' := fun p hp => by - obtain ⟨h₁, h₂⟩ := saved_mem H hp - rw [← h p hp] - exact hf.readW (r := ⟨_, 4⟩) (Region.contains_self _ _) - (fun r hr => (hd r hr).sub_left (slot_sub H scr h₁ h₂)) (by decide) - -/-- The registers saved from a state that agrees on them. -/ -theorem SavedRegs.of_eq {scr : BitVec 32} {s₀ s₁ : State} {m : Mem} (h : SavedRegs H scr s₁ m) - (he : ∀ r ∈ savedRegs, s₁.gpr r = s₀.gpr r) : SavedRegs H scr s₀ m := fun p hp => by - rw [h p hp] - refine he _ ?_ - simp only [Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp - rcases hp with rfl | rfl | rfl | rfl <;> simp - -/-- The memory after storing `g r` at `B + d` for each `(r, d)` of `l`. -/ -def saveMem (m : Mem) (B : Addr) (g : Reg → BitVec 32) : List (Reg × Nat) → Mem - | [] => m - | (r, d) :: l => saveMem (m.writeW (B + BitVec.ofNat 64 d) (g r)) B g l - -theorem saveList_ok {rest : List Instr} (l : List (Reg × Nat)) : - ∀ (s : State) (Q : State → Prop), - (∀ p ∈ l, (s.gpr .eax).toNat + p.2 < 2 ^ 32 ∧ - InRegions s.wr ((s.gpr .eax).setWidth 64 + BitVec.ofNat 64 p.2) 4) → - (∀ s', s'.gpr = s.gpr → s'.rd = s.rd → s'.wr = s.wr → - s'.mem = saveMem s.mem ((s.gpr .eax).setWidth 64) s.gpr l → WP isa (.block rest) s' Q) → - WP isa (.block (l.map (fun p => Instr.store (at_ .eax p.2) p.1) ++ rest)) s Q := by - induction l with - | nil => intro s Q _ k; exact k s rfl rfl rfl rfl - | cons p l ih => - intro s Q hl k - obtain ⟨h1, h2⟩ := hl p (by simp) - refine wp_store (a := (s.gpr .eax).setWidth 64 + BitVec.ofNat 64 p.2) - (by rw [ea_at, addr_eq h1]) h2 fun s₁ u₁ => ?_ - refine ih s₁ Q (fun q hq => ?_) fun s' g rd wr m => k s' (g.trans u₁.gpr) (rd.trans u₁.rd) - (wr.trans u₁.wr) ?_ - · rw [u₁.gpr, u₁.wr]; exact hl q (List.mem_cons_of_mem _ hq) - · rw [m, u₁.mem, u₁.gpr]; rfl - -theorem readW_writeW_save (m : Mem) (B : Addr) (v : BitVec 32) {d e : Nat} (hd : d < 2 ^ 32) - (he : e < 2 ^ 32) (h : d + 4 ≤ e ∨ e + 4 ≤ d) : - (m.writeW (B + BitVec.ofNat 64 e) v).readW (B + BitVec.ofNat 64 d) 32 = m.readW (B + BitVec.ofNat 64 d) 32 := - Mem.readW_writeW_sep (Offset.sep B h (by omega_nat) (by omega_nat)) (by decide) - -theorem saveMem_other (m : Mem) (B : Addr) (g : Reg → BitVec 32) {d : Nat} (hd : d < 2 ^ 32) : - ∀ l : List (Reg × Nat), (∀ q ∈ l, q.2 < 2 ^ 32 ∧ (d + 4 ≤ q.2 ∨ q.2 + 4 ≤ d)) → - (saveMem m B g l).readW (B + BitVec.ofNat 64 d) 32 = m.readW (B + BitVec.ofNat 64 d) 32 - | [], _ => rfl - | q :: l, h => by - rw [saveMem, saveMem_other _ B g hd l fun q' hq' => h q' (List.mem_cons_of_mem _ hq'), - readW_writeW_save _ _ _ hd (h q (by simp)).1 (h q (by simp)).2] - -theorem saveMem_read (B : Addr) (g : Reg → BitVec 32) : - ∀ (m : Mem) (l : List (Reg × Nat)), l.Pairwise (fun p q => p.2 + 4 ≤ q.2 ∨ q.2 + 4 ≤ p.2) → - (∀ p ∈ l, p.2 < 2 ^ 32) → ∀ p ∈ l, (saveMem m B g l).readW (B + BitVec.ofNat 64 p.2) 32 = g p.1 - | _, [], _, _, p, hp => by cases hp - | m, q :: l, hpw, hb, p, hp => by - rw [List.pairwise_cons] at hpw - rcases List.mem_cons.mp hp with rfl | hp - · rw [saveMem, saveMem_other _ _ _ (hb p (by simp)) l - (fun q' hq' => ⟨hb q' (List.mem_cons_of_mem _ hq'), hpw.1 q' hq'⟩), Mem.readW_writeW_self32] - · rw [saveMem] - exact saveMem_read B g _ l hpw.2 (fun q' hq' => hb q' (List.mem_cons_of_mem _ hq')) p hp - -theorem saveMem_frameR (B : Addr) (g : Reg → BitVec 32) (o L : Nat) (hL : o + L < 2 ^ 64) : - ∀ (m : Mem) (l : List (Reg × Nat)), (∀ p ∈ l, o ≤ p.2 ∧ p.2 + 4 ≤ o + L) → - Frame [⟨B + BitVec.ofNat 64 o, L⟩] m (saveMem m B g l) - | _, [], _ => Frame.refl _ _ - | m, p :: l, hl => by - obtain ⟨h₁, h₂⟩ := hl p (by simp) - have c : (⟨B + BitVec.ofNat 64 o, L⟩ : Region).Contains (B + BitVec.ofNat 64 p.2) (32 / 8) := by - rw [show p.2 = o + (p.2 - o) by omega_nat, ← add_ofNat_add] - exact contains_offset (by omega_nat) (by omega_nat) - exact ((Frame.refl _ _).writeW (List.mem_singleton_self _) _ c).trans - (saveMem_frameR B g o L hL _ l fun q hq => hl q (List.mem_cons_of_mem _ hq)) - -theorem save_eq : H.save = H.saved.map (fun p => Instr.store (at_ .eax p.2) p.1) := rfl - -/-- Saving the registers, with `scratch` in `eax`. -/ -theorem save_ok {s : State} {scr : BitVec 32} {L : Nat} (hax : s.gpr .eax = scr) (hW : H.W ≤ 64) - (hsc : ⟨scr.setWidth 64, L⟩ ∈ s.wr) (hL : 8 * H.W + 16 ≤ L) (hfit : scr.toNat + L ≤ 2 ^ 32) - {rest : List Instr} {Q : State → Prop} - (k : ∀ s', s'.gpr = s.gpr → s'.rd = s.rd → s'.wr = s.wr → - Frame [saveR H scr] s.mem s'.mem → SavedRegs H scr s s'.mem → WP isa (.block rest) s' Q) : - WP isa (.block (H.save ++ rest)) s Q := by - rw [save_eq] - refine saveList_ok H.saved s Q (fun p hp => ?_) fun s' g rd wr m => k s' g rd wr ?_ ?_ - · obtain ⟨h₁, h₂⟩ := saved_mem H hp - rw [hax] - exact ⟨by omega_nat, ⟨_, hsc, contains_offset (by omega_nat) (by omega_nat)⟩⟩ - · rw [m, hax] - exact saveMem_frameR _ _ _ _ (by omega_nat) _ _ fun p hp => saved_mem H hp - · intro p hp - rw [m, hax] - exact saveMem_read _ _ _ _ (saved_pairwise H) (fun q hq => by have := saved_mem H hq; omega_nat) p hp - -theorem restoreList_ok {rest : List Instr} (l : List (Reg × Nat)) : - ∀ (s : State) (Q : State → Prop), (l.map Prod.fst).Nodup → - (∀ p ∈ l, p.1 ≠ .eax ∧ (s.gpr .eax).toNat + p.2 < 2 ^ 32 ∧ - InRegions (s.rd ++ s.wr) ((s.gpr .eax).setWidth 64 + BitVec.ofNat 64 p.2) 4) → - (∀ s', (∀ p ∈ l, s'.gpr p.1 = s.mem.readW ((s.gpr .eax).setWidth 64 + BitVec.ofNat 64 p.2) 32) → - (∀ r, r ∉ l.map Prod.fst → s'.gpr r = s.gpr r) → s'.mem = s.mem → s'.rd = s.rd → s'.wr = s.wr → - WP isa (.block rest) s' Q) → - WP isa (.block (l.map (fun p => Instr.mov p.1 (.mem (at_ .eax p.2))) ++ rest)) s Q := by - induction l with - | nil => intro s Q _ _ k; exact k s (fun _ h => by cases h) (fun _ _ => rfl) rfl rfl rfl - | cons p l ih => - intro s Q hnd hl k - obtain ⟨h0, h2, h3⟩ := hl p (by simp) - simp only [List.map_cons, List.nodup_cons] at hnd - refine wp_movm (a := (s.gpr .eax).setWidth 64 + BitVec.ofNat 64 p.2) (by rw [ea_at, addr_eq h2]) h3 - fun s₁ u₁ => ?_ - have eb : s₁.gpr .eax = s.gpr .eax := u₁.other _ (Ne.symm h0) - refine ih s₁ Q hnd.2 (fun q hq => ?_) fun s' hl' ho hm hrd hwr => k s' (fun q hq => ?_) - (fun r hr => ?_) (hm.trans u₁.mem) (hrd.trans u₁.rd) (hwr.trans u₁.wr) - · rw [eb, u₁.rd, u₁.wr]; exact hl q (List.mem_cons_of_mem _ hq) - · rcases List.mem_cons.mp hq with rfl | hq - · rw [ho _ hnd.1, u₁.gpr] - · rw [hl' q hq, u₁.mem, eb] - · simp only [List.map_cons, List.mem_cons, not_or] at hr - rw [ho r hr.2, u₁.other r hr.1] - -theorem restore_eq : - H.restore = .mov .eax (.reg .ebp) :: H.saved.map (fun p => Instr.mov p.1 (.mem (at_ .eax p.2))) := rfl - -theorem saved_fst : H.saved.map Prod.fst = savedRegs := rfl - -/-- Loading them back, with `scratch` in `ebp`. -/ -theorem restore_ok {s : State} {scr : BitVec 32} {L : Nat} (hbp : s.gpr .ebp = scr) {s₀ : State} (hs : SavedRegs H scr s₀ s.mem) (hsc : ⟨scr.setWidth 64, L⟩ ∈ s.wr) (hL : 8 * H.W + 16 ≤ L) - (hfit : scr.toNat + L ≤ 2 ^ 32) : - WP isa (.block H.restore) s fun s' => s'.mem = s.mem ∧ s'.rd = s.rd ∧ s'.wr = s.wr ∧ - (∀ r ∈ savedRegs, s'.gpr r = s₀.gpr r) ∧ (∀ r, r ∉ savedRegs → r ≠ .eax → s'.gpr r = s.gpr r) := by - rw [restore_eq] - refine wp_mov fun s₁ u₁ => ?_ - have e₁ : s₁.gpr .eax = scr := by rw [u₁.gpr, hbp] - rw [← List.append_nil (List.map _ _)] - refine restoreList_ok H.saved s₁ _ (by rw [saved_fst]; decide) (fun p hp => ?_) - fun s₂ hl ho hm hrd hwr => WP.block_nil ⟨by rw [hm, u₁.mem], by rw [hrd, u₁.rd], by rw [hwr, u₁.wr], - fun r hr => ?_, fun r hr hr' => ?_⟩ - · have := saved_mem H hp - refine ⟨?_, by rw [e₁]; omega_nat, ?_⟩ - · simp only [Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp - rcases hp with rfl | rfl | rfl | rfl <;> (dsimp only; decide) - · rw [e₁, u₁.rd, u₁.wr]; exact InRegions.right' ⟨_, hsc, contains_offset (by omega_nat) (by omega_nat)⟩ - · have hv : ∀ p ∈ H.saved, s₂.gpr p.1 = s₀.gpr p.1 := fun p hp => by - rw [hl p hp, e₁, u₁.mem, hs p hp] - simp only [savedRegs, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl - · exact hv (.ebx, 8 * H.W) (by simp [Hash.saved]) - · exact hv (.esi, 8 * H.W + 4) (by simp [Hash.saved]) - · exact hv (.edi, 8 * H.W + 8) (by simp [Hash.saved]) - · exact hv (.ebp, 8 * H.W + 12) (by simp [Hash.saved]) - · rw [ho r (by rw [saved_fst]; exact hr), u₁.other r hr'] - -/-! ## Odds and ends -/ - -theorem toNat_setWidth (a : BitVec 32) : (a.setWidth 64).toNat = a.toNat := by - simp only [BitVec.toNat_setWidth] - exact Nat.mod_eq_of_lt (by have := a.isLt; omega_nat) - -/-- `x + o`, as a register holds it, where nothing wraps around. -/ -theorem setWidth_add {x : BitVec 32} {o : Nat} (h : x.toNat + o < 2 ^ 32) : - (x + BitVec.ofNat 32 o).setWidth 64 = x.setWidth 64 + BitVec.ofNat 64 o := by - have := addr_eq (x := x) (k := o) h - simpa only [addr] using this - -theorem toNat_add_ofNat {x : BitVec 32} {o : Nat} (h : x.toNat + o < 2 ^ 32) : - (x + BitVec.ofNat 32 o).toNat = x.toNat + o := by - rw [BitVec.toNat_add, BitVec.toNat_ofNat, Nat.mod_eq_of_lt (a := o) (by omega_nat), Nat.mod_eq_of_lt h] - -/-! ## The stack - -The 48 bytes below `esp` lie below the return address and the arguments; -what does not write those leaves them, and our arguments, as on entry. -/ - -theorem stk_ret {E : BitVec 32} (hE : 48 ≤ E.toNat) (_hf : E.toNat + 4 ≤ 2 ^ 32) : - (below E 48).Disjoint ⟨E.setWidth 64, 4⟩ := by - unfold below - rw [Taint.sub_setWidth hE] - exact Offset.below_disjoint _ (by omega_nat) - -theorem stk_args {E : BitVec 32} {n : Nat} (hE : 48 ≤ E.toNat) (hf : E.toNat + 4 + n ≤ 2 ^ 32) : - (below E 48).Disjoint ⟨addr E 4, n⟩ := by - rcases Nat.eq_zero_or_pos n with rfl | hn - · intro a _ h₂; simp only [Region.Contains] at h₂; omega_nat - unfold below - rw [Taint.sub_setWidth hE, addr_eq (by omega_nat)] - exact Offset.disjoint_below_above _ (by omega_nat) - -/-- Argument `i` is at `4 i` bytes into the arguments. -/ -theorem argAddr_eq (s : State) (i : Nat) : - argAddr s i = (s.gpr .esp + BitVec.ofNat 32 (4 + 4 * i)).setWidth 64 := rfl - -theorem arg_sub {E : BitVec 32} {s : State} (hs : s.gpr .esp = E) {n i : Nat} (hi : 4 * i + 4 ≤ n) - (hf : E.toNat + 4 + n ≤ 2 ^ 32) : Region.Sub ⟨argAddr s i, 4⟩ ⟨addr E 4, n⟩ := by - rw [argAddr_eq, hs, addr_eq (by omega_nat), show (E + BitVec.ofNat 32 (4 + 4 * i)).setWidth 64 = - addr E (4 + 4 * i) from rfl, addr_eq (by omega_nat)] - exact Offset.sub _ (by omega_nat) (by omega_nat) - -theorem arg_contains {E : BitVec 32} {s : State} (hs : s.gpr .esp = E) {n i : Nat} (hi : 4 * i + 4 ≤ n) - (hf : E.toNat + 4 + n ≤ 2 ^ 32) : (⟨addr E 4, n⟩ : Region).Contains (argAddr s i) 4 := by - rw [argAddr_eq, hs, addr_eq (by omega_nat), show (E + BitVec.ofNat 32 (4 + 4 * i)).setWidth 64 = - addr E (4 + 4 * i) from rfl, addr_eq (by omega_nat)] - exact Offset.contains _ (by omega_nat) (by omega_nat) (by omega_nat) - -/-- The arguments are kept by what writes elsewhere. -/ -theorem arg_keep {E : BitVec 32} {s₀ s : State} (h₀ : s₀.gpr .esp = E) (hs : s.gpr .esp = E) {n : Nat} - (hf : E.toNat + 4 + n ≤ 2 ^ 32) {rs : List Region} (hm : Frame rs s₀.mem s.mem) - (hd : ∀ r ∈ rs, Region.Disjoint ⟨addr E 4, n⟩ r) {i : Nat} (hi : 4 * i + 4 ≤ n) : arg s i = arg s₀ i := by - simp only [arg] - rw [show argAddr s i = argAddr s₀ i by rw [argAddr_eq, argAddr_eq, hs, h₀]] - exact hm.readW (r := ⟨argAddr s₀ i, 4⟩) (Region.contains_self _ _) - (fun r hr => (hd r hr).sub_left (arg_sub h₀ hi hf)) (by decide) - -end VG.Proof.Hmac.Generic.X86 - -/-! -## `init`, correct - -As on the other targets -(`Proof/Hmac/Generic/Arm/Init.lean`). The arguments are on the stack: -`scratch`, then `key` and `key_len` are loaded first (after our caller's -registers are saved in `scratch`), and `inner` and `outer` once the keys are -written. The functions we call keep `ebx`, `esi`, `edi` and `ebp`, which -hold `inner`, `outer`, the low word of `update`'s count and `scratch`. --/ - -namespace VG.Proof.Hmac.Generic.X86.Init - -open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash at_) -open VG.Proof.Hmac.Generic.X86 -open VG.Proof.Sha256.X86 (contains_offset) -open VG.Proof.Sha256.X86.Stream (Upd Fupd wp_mov wp_movi wp_movm wp_add wp_addi wp_test sub_offset) -open VG.Proof.Hmac.Generic.Common (add_ofNat_add bytesAt_prefix_congr inRegions_of_sub K0 K0_length - off_disj off_disj0 sub_of_off sub_of_self bytes_keep take_map_xor) -open Spec.Sha256 (bytesAt) -open Spec.Hmac (xorPad ipad opad blockKey) - -variable {H : Hash} (hH : HashOK H) (sc : Nat) - -section -variable (s₀ : State) - -abbrev E : BitVec 32 := s₀.gpr .esp -abbrev inn : BitVec 32 := arg s₀ 0 -abbrev out : BitVec 32 := arg s₀ 1 -abbrev kp : BitVec 32 := arg s₀ 2 -abbrev kl : Nat := (arg s₀ 3).toNat -abbrev scr : BitVec 32 := arg s₀ 4 -abbrev inR : Region := ⟨(inn s₀).setWidth 64, H.S⟩ -abbrev outR : Region := ⟨(out s₀).setWidth 64, H.S⟩ -abbrev keyR : Region := ⟨(kp s₀).setWidth 64, kl s₀⟩ -abbrev scR : Region := ⟨(scr s₀).setWidth 64, 8 * sc⟩ -abbrev argR : Region := ⟨addr (E s₀) 4, 20⟩ -abbrev retR : Region := ⟨(E s₀).setWidth 64, 4⟩ -abbrev stkR : Region := below (E s₀) 48 -/-- The padded keys. -/ -abbrev P : Addr := (scr s₀).setWidth 64 + BitVec.ofNat 64 H.buf -abbrev bufR : Region := ⟨P (H := H) s₀, 2 * H.B⟩ -abbrev calR : Region := ⟨(scr s₀).setWidth 64, hH.Wb⟩ -/-- Byte `o` of `scratch`, as a register holds it. -/ -abbrev dO (o : Nat) : BitVec 32 := scr s₀ + BitVec.ofNat 32 o - -end - -theorem kl_lt (s₀ : State) : kl s₀ < 2 ^ 32 := (arg s₀ 3).isLt - -/-- The precondition, with the sizes of `H`. -/ -structure Pre (s₀ : State) : Prop where - kl_le : kl s₀ ≤ H.B - rd : s₀.rd = [keyR s₀, argR s₀] - wr : s₀.wr = [inR (H := H) s₀, outR (H := H) s₀, scR sc s₀] - i_o : (inR (H := H) s₀).Disjoint (outR (H := H) s₀) - i_s : (inR (H := H) s₀).Disjoint (scR sc s₀) - o_s : (outR (H := H) s₀).Disjoint (scR sc s₀) - k_i : (keyR s₀).Disjoint (inR (H := H) s₀) - k_o : (keyR s₀).Disjoint (outR (H := H) s₀) - k_s : (keyR s₀).Disjoint (scR sc s₀) - a_i : (argR s₀).Disjoint (inR (H := H) s₀) - a_o : (argR s₀).Disjoint (outR (H := H) s₀) - a_s : (argR s₀).Disjoint (scR sc s₀) - r_i : (retR s₀).Disjoint (inR (H := H) s₀) - r_o : (retR s₀).Disjoint (outR (H := H) s₀) - r_s : (retR s₀).Disjoint (scR sc s₀) - b_i : (stkR s₀).Disjoint (inR (H := H) s₀) - b_o : (stkR s₀).Disjoint (outR (H := H) s₀) - b_k : (stkR s₀).Disjoint (keyR s₀) - b_s : (stkR s₀).Disjoint (scR sc s₀) - ni : (inn s₀).toNat + H.S ≤ 2 ^ 32 - no : (out s₀).toNat + H.S ≤ 2 ^ 32 - nk : (kp s₀).toNat + kl s₀ ≤ 2 ^ 32 - nw : (scr s₀).toNat + 8 * sc ≤ 2 ^ 32 - sp48 : 48 ≤ (E s₀).toNat - spf : (E s₀).toNat + 24 ≤ 2 ^ 32 - fits : H.buf + 2 * H.B ≤ 8 * sc - hB : H.B ≤ 128 - hB0 : 0 < H.B - hW : H.W ≤ 64 - hS : H.S ≤ 256 - -theorem pre_of {s₀ : State} (h : (initG hH.SH sc).pre s₀) (hfit : H.buf + 2 * H.B ≤ 8 * sc) : - Pre (H := H) sc s₀ := by - obtain ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, - h21, h22, h23, h24⟩ := h - have hS := hH.hS - have hB := hH.hB - have e : (⟨(s₀.gpr .esp).setWidth 64 - 48, 48⟩ : Region) = stkR s₀ := by - simp only [stkR, below]; rw [Taint.sub_setWidth h23]; rfl - simp only [hS, hB, e] at * - exact ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, h21, h22, - h23, h24, hfit, hH.hBB, hH.hB0, hH.hW, hH.hSB⟩ - -/-! ## The parts of `scratch` -/ - -section -variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) -include hp - -theorem sub_sc {o n : Nat} (h : o + n ≤ 8 * sc) : - Region.Sub ⟨(scr s₀).setWidth 64 + BitVec.ofNat 64 o, n⟩ (scR sc s₀) := - sub_offset h (by have := hp.nw; omega_nat) - -include hH in -theorem cal_sub : Region.Sub (calR hH s₀) (scR sc s₀) := by - have := hH.hWb; have := hp.fits; simp only [Hash.buf] at this - exact Region.sub_prefix (by omega_nat) - -theorem save_sub : Region.Sub (saveR H (scr s₀)) (scR sc s₀) := by - have := hp.fits; simp only [Hash.buf] at this; exact sub_sc hp (by omega_nat) - -theorem buf_sub : Region.Sub (bufR (H := H) s₀) (scR sc s₀) := by - have := hp.fits; have := hp.nw - exact sub_offset hp.fits (by omega_nat) - -omit hp in -theorem padI_sub : Region.Sub ⟨P (H := H) s₀, H.B⟩ (bufR (H := H) s₀) := Region.sub_prefix (by omega_nat) - -theorem padO_sub : Region.Sub ⟨P (H := H) s₀ + BitVec.ofNat 64 H.B, H.B⟩ (bufR (H := H) s₀) := - sub_offset (by omega_nat) (by have := hp.hB; omega_nat) - -include hH in -theorem cal_save : (calR hH s₀).Disjoint (saveR H (scr s₀)) := by - have := hH.hWb; have := hp.hW - exact off_disj0 _ (m := hH.Wb) (b := 8 * H.W) (n := 16) (by omega_nat) (by omega_nat) - -include hH in -theorem cal_buf : (calR hH s₀).Disjoint (bufR (H := H) s₀) := by - have := hH.hWb; have := hp.hW; have := hp.hB - exact off_disj0 _ (m := hH.Wb) (b := 8 * H.W + 16) (n := 2 * H.B) (by omega_nat) (by omega_nat) - -theorem save_buf : (saveR H (scr s₀)).Disjoint (bufR (H := H) s₀) := by - have := hp.hW; have := hp.hB - exact off_disj _ (a := 8 * H.W) (m := 16) (b := 8 * H.W + 16) (n := 2 * H.B) (by omega_nat) (by omega_nat) - (by omega_nat) - -theorem addr_dO {o : Nat} (ho : o + 1 ≤ 8 * sc) : - (dO s₀ o).setWidth 64 = (scr s₀).setWidth 64 + BitVec.ofNat 64 o := - setWidth_add (by have := hp.nw; omega_nat) - -theorem toNat_dO {o : Nat} (ho : o + 1 ≤ 8 * sc) : (dO s₀ o).toNat = (scr s₀).toNat + o := - toNat_add_ofNat (by have := hp.nw; omega_nat) - -theorem stk_arg : (stkR s₀).Disjoint (argR s₀) := stk_args hp.sp48 (by have := hp.spf; omega_nat) - -theorem stk_ret' : (stkR s₀).Disjoint (retR s₀) := stk_ret hp.sp48 (by have := hp.spf; omega_nat) - -end - -/-! ## What the pieces keep -/ - -/-- The regions everything writes: our buffers and the stack below `esp`. -/ -abbrev wrs (s₀ : State) : List Region := [inR (H := H) s₀, outR (H := H) s₀, scR sc s₀, stkR s₀] - -/-- The registers and memory kept from the prologue on. -/ -structure KR (s₀ s : State) : Prop where - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - esp : s.gpr .esp = E s₀ - ebp : s.gpr .ebp = scr s₀ - saved : SavedRegs H (scr s₀) s₀ s.mem - frame : Frame (wrs (H := H) sc s₀) s₀.mem s.mem - -/-- The registers `KR` fixes. -/ -abbrev kregs : List Reg := [.esp, .ebp] - -theorem kregs_callee : ∀ r ∈ kregs, r ∈ calleeSaved := by decide - -section -variable {sc : Nat} - -/-- `KR` survives changes to other registers, and to memory in our buffers -(away from the save area) and the stack. -/ -theorem KR.keep {s₀ s s' : State} (h : KR (H := H) sc s₀ s) (hrd : s'.rd = s.rd) (hwr : s'.wr = s.wr) - (hg : ∀ r ∈ kregs, s'.gpr r = s.gpr r) {rs : List Region} (hf : Frame rs s.mem s'.mem) - (hs : ∀ r ∈ rs, (saveR H (scr s₀)).Disjoint r) - (hsub : ∀ r ∈ rs, ∃ r' ∈ wrs (H := H) sc s₀, Region.Sub r r') : KR (H := H) sc s₀ s' := - ⟨hrd.trans h.rd, hwr.trans h.wr, (hg _ (by simp)).trans h.esp, (hg _ (by simp)).trans h.ebp, - h.saved.frame H hf hs, h.frame.trans (hf.sub hsub)⟩ - -theorem KR.upd {s₀ s s' : State} (h : KR (H := H) sc s₀ s) {d : Reg} (hd : d ∉ kregs) {v : BitVec 32} - (u : Upd s s' d v) : KR (H := H) sc s₀ s' := - h.keep u.rd u.wr (fun r hr => u.other r fun e => hd (e ▸ hr)) (rs := []) - (by rw [u.mem]; exact Frame.refl _ _) (by simp) (by simp) - -end - -section -variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) -include hp - -/-- The arguments, while `KR` holds. -/ -theorem KR.argEq {s : State} (hk : KR (H := H) sc s₀ s) {i : Nat} (hi : i < 5) : VG.X86.arg s i = VG.X86.arg s₀ i := - arg_keep rfl hk.esp (n := 20) (by have := hp.spf; omega_nat) hk.frame (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl | rfl) - · exact hp.a_i - · exact hp.a_o - · exact hp.a_s - · exact (stk_arg hp).symm) (by omega_nat) - -/-- The return address, while `KR` holds. -/ -theorem KR.ret {s : State} (hk : KR (H := H) sc s₀ s) : - s.mem.readW ((E s₀).setWidth 64) 32 = s₀.mem.readW ((E s₀).setWidth 64) 32 := - hk.frame.readW (r := retR s₀) (Region.contains_self _ _) (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl | rfl) - · exact hp.r_i - · exact hp.r_o - · exact hp.r_s - · exact (stk_ret' hp).symm) (by decide) - -/-- `KR` after a call that writes `rs`, parts of our buffers. -/ -theorem KR.call {s s' : State} (hk : KR (H := H) sc s₀ s) {rs : List Region} (ha : After s rs s') - (hs : ∀ r ∈ rs, (saveR H (scr s₀)).Disjoint r) (hsub : ∀ r ∈ rs, ∃ r' ∈ wrs (H := H) sc s₀, Region.Sub r r') : - KR (H := H) sc s₀ s' := by - have f := ha.frame - rw [show stk s = stkR s₀ by rw [stk, hk.esp]] at f - refine hk.keep ha.rd ha.wr (fun r hr => ha.cs r (kregs_callee r hr)) f ?_ ?_ - · simp only [List.mem_append, List.mem_singleton] - rintro r (hr | rfl) - · exact hs r hr - · exact hp.b_s.symm.sub_left (save_sub hp) - · simp only [List.mem_append, List.mem_singleton] - rintro r (hr | rfl) - · exact hsub r hr - · exact ⟨stkR s₀, by simp, fun _ h => h⟩ - -theorem argR_in : argR s₀ ∈ s₀.rd ++ s₀.wr := by rw [hp.rd]; simp - -omit hp in -theorem argW {s : State} (hs : s.gpr .esp = E s₀) (i : Nat) : - s.ea (at_ .esp (4 + 4 * i)) = argAddr s₀ i := by - rw [ea_at, hs]; rfl - -theorem argIn {s : State} (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) {i : Nat} (hi : i < 5) : - InRegions (s.rd ++ s.wr) (argAddr s₀ i) 4 := by - rw [hrd, hwr] - exact ⟨argR s₀, argR_in hp, arg_contains rfl (by omega_nat) (by have := hp.spf; omega_nat)⟩ - -/-- An argument, read from memory while `KR` holds. -/ -theorem KR.readArg {s : State} (hk : KR (H := H) sc s₀ s) {i : Nat} (hi : i < 5) : - s.mem.readW (argAddr s₀ i) 32 = VG.X86.arg s₀ i := by - have := hk.argEq hp hi - simp only [VG.X86.arg] at this ⊢ - rwa [show argAddr s i = argAddr s₀ i by rw [argAddr_eq, argAddr_eq, hk.esp]] at this - -end - -/-! ## The keys -/ - -/-- The key padded to a block, from the initial memory. -/ -abbrev K0₀ (s₀ : State) : List Byte := K0 s₀.mem ((kp s₀).setWidth 64) (kl s₀) H.B - -/-- After `initKeys`. -/ -structure PhK (s₀ s : State) : Prop where - kr : KR (H := H) sc s₀ s - bufI : bytesAt s.mem (P (H := H) s₀) H.B = xorPad (K0₀ (H := H) s₀) ipad - bufO : bytesAt s.mem (P (H := H) s₀ + BitVec.ofNat 64 H.B) H.B = xorPad (K0₀ (H := H) s₀) opad - -theorem keys_ok {s₀ : State} (hp : Pre (H := H) sc s₀) : WP isa H.initKeys s₀ (PhK (H := H) sc s₀) := by - have hB := hp.hB; have hW := hp.hW; have hf := hp.fits; have nw := hp.nw - simp only [Hash.buf] at hf - have hsc : ⟨(scr s₀).setWidth 64, 8 * sc⟩ ∈ s₀.wr := by rw [hp.wr]; simp - have dA : ∀ r ∈ [saveR H (scr s₀)], (argR s₀).Disjoint r := by - simp only [List.mem_singleton]; rintro r rfl; exact hp.a_s.sub_right (save_sub hp) - refine WP.seq ?_ - simp only [Hash.initPrologue, List.singleton_append] - refine wp_movm (a := argAddr s₀ 4) (argW rfl 4) (argIn hp rfl rfl (by decide)) fun s₁ u₁ => ?_ - refine save_ok H (scr := scr s₀) u₁.gpr hW (by rw [u₁.wr]; exact hsc) (by omega_nat) (by omega_nat) - fun s₂ g₂ rd₂ wr₂ f₂ sv₂ => ?_ - have e₂ : ∀ r, r ≠ .eax → s₂.gpr r = s₀.gpr r := fun r hr => by rw [g₂, u₁.other r hr] - have f₂' : Frame [saveR H (scr s₀)] s₀.mem s₂.mem := by rw [← u₁.mem]; exact f₂ - have rA : ∀ i < 5, s₂.mem.readW (argAddr s₀ i) 32 = arg s₀ i := fun i hi => - f₂'.readW (r := ⟨argAddr s₀ i, 4⟩) (Region.contains_self _ _) (fun r hr => - (dA r hr).sub_left (arg_sub rfl (by omega_nat) (by have := hp.spf; omega_nat))) (by decide) - refine wp_mov fun s₃ u₃ => ?_ - refine wp_movm (a := argAddr s₀ 2) (by rw [ea_at, u₃.other _ (by decide), e₂ _ (by decide)]; rfl) - (by rw [u₃.rd, u₃.wr, rd₂, wr₂, u₁.rd, u₁.wr]; exact argIn hp rfl rfl (by decide)) fun s₄ u₄ => ?_ - refine wp_movm (a := argAddr s₀ 3) (by - rw [ea_at, u₄.other _ (by decide), u₃.other _ (by decide), e₂ _ (by decide)]; rfl) - (by rw [u₄.rd, u₄.wr, u₃.rd, u₃.wr, rd₂, wr₂, u₁.rd, u₁.wr]; exact argIn hp rfl rfl (by decide)) - fun s₅ u₅ => ?_ - refine wp_movi fun s₆ u₆ => wp_test fun s₇ f₇ z₇ => WP.block_nil ?_ - have hm₇ : s₇.mem = s₂.mem := by rw [f₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem] - have hrd : s₇.rd = s₀.rd := by rw [f₇.rd, u₆.rd, u₅.rd, u₄.rd, u₃.rd, rd₂, u₁.rd] - have hwr : s₇.wr = s₀.wr := by rw [f₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, wr₂, u₁.wr] - have hbp : s₇.gpr .ebp = scr s₀ := by - rw [f₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, g₂, u₁.gpr]; rfl - have hsi : s₇.gpr .esi = kp s₀ := by - rw [f₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, u₃.mem, rA 2 (by decide)] - have hdi : s₇.gpr .edi = BitVec.ofNat 32 (kl s₀) := by - rw [f₇.gpr, u₆.other _ (by decide), u₅.gpr, u₄.mem, u₃.mem, rA 3 (by decide), BitVec.ofNat_toNat, - BitVec.setWidth_eq] - have hbx : s₇.gpr .ebx = BitVec.ofNat 32 0 := by rw [f₇.gpr, u₆.gpr]; rfl - have hsp : s₇.gpr .esp = E s₀ := by - rw [f₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), - e₂ _ (by decide)] - have hz : s₇.zf = some (decide (kl s₀ = 0)) := by - rw [z₇, u₆.other _ (by decide), u₅.gpr, u₄.mem, u₃.mem, rA 3 (by decide), test_z] - have hr : LoopRegs (scr s₀) (kp s₀) (kl s₀) s₇ := ⟨hbp, hsi, hdi⟩ - have hm : LoopMem H (scr s₀) (kp s₀) (kl s₀) s₇ := - ⟨hp.kl_le, fun k hk => by - rw [hrd, hwr, hp.rd] - exact inRegions_of_sub (R := keyR s₀) (by simp) (fun _ h => h) (Nat.lt_trans (kl_lt s₀) (by decide)) - hk |>.elim fun r ⟨hr, hc⟩ => ⟨r, List.mem_append_left _ hr, hc⟩, - fun k hk => by - rw [hwr, hp.wr]; exact inRegions_of_sub (R := scR sc s₀) (by simp) (buf_sub hp) (by omega_nat) hk, - hp.k_s.sub_right (buf_sub hp), hB, by simp only [Hash.buf]; omega_nat, hp.nk⟩ - refine WP.seq (WP.mono (key_ok H hr hm hbx hz) fun t ht => pad_ok H hr hm ht) |>.mono fun t ht => ?_ - -- The key's bytes are those of the initial memory. - have fk : Frame [saveR H (scr s₀)] s₀.mem s₇.mem := by rw [hm₇]; exact f₂' - have eK : K0 s₇.mem ((kp s₀).setWidth 64) (kl s₀) H.B = K0₀ (H := H) s₀ := by - simp only [K0, K0₀] - congr 1 - refine bytesAt_prefix_congr fun i hi => fk.bytes (R := keyR s₀) (by - simp only [List.mem_singleton]; rintro r rfl; exact (hp.k_s.sub_right (save_sub hp))) - (Nat.le_of_lt (Nat.lt_trans (kl_lt s₀) (by decide))) hi - have hg : ∀ r ∉ clob, t.gpr r = s₇.gpr r := ht.other - have sv : SavedRegs H (scr s₀) s₀ s₇.mem := hm₇ ▸ sv₂.of_eq H fun r hr => u₁.other r (by - simp only [savedRegs, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl <;> decide) - have ft : Frame [bufR (H := H) s₀] s₇.mem t.mem := ht.mem.frame - refine ⟨⟨by rw [ht.rd, hrd], by rw [ht.wr, hwr], by rw [hg _ (by decide), hsp], by rw [hg _ (by decide), hbp], - sv.frame H ft (by simp only [List.mem_singleton]; rintro r rfl; exact save_buf hp), - (fk.sub fun r hr => by - simp only [List.mem_singleton] at hr; subst hr; exact ⟨scR sc s₀, by simp, save_sub hp⟩).trans - (ft.sub fun r hr => by - simp only [List.mem_singleton] at hr; subst hr; exact ⟨scR sc s₀, by simp, buf_sub hp⟩)⟩, ?_, ?_⟩ - · rw [ht.mem.bufI, eK, take_map_xor (K0_length _ _ hp.kl_le)] - · rw [ht.mem.bufO, eK, take_map_xor (K0_length _ _ hp.kl_le)] - -/-! ## The calls -/ - -/-- `KR`, with `inner` in `ebx` and `outer` in `esi`. -/ -structure KS (s₀ s : State) : Prop extends KR (H := H) sc s₀ s where - ebx : s.gpr .ebx = inn s₀ - esi : s.gpr .esi = out s₀ - -section -variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) -include hp - -theorem states_ok {s : State} (hk : KR (H := H) sc s₀ s) : - WP isa (.block Hash.initStates) s fun t => KS (H := H) sc s₀ t ∧ t.mem = s.mem := by - refine wp_movm (a := argAddr s₀ 0) (argW hk.esp 0) (argIn hp hk.rd hk.wr (by decide)) fun t₁ u₁ => ?_ - refine wp_movm (a := argAddr s₀ 1) (by rw [ea_at, u₁.other _ (by decide), hk.esp]; rfl) - (by rw [u₁.rd, u₁.wr]; exact argIn hp hk.rd hk.wr (by decide)) fun t₂ u₂ => WP.block_nil ?_ - exact ⟨⟨(hk.upd (by decide) u₁).upd (by decide) u₂, by rw [u₂.other _ (by decide), u₁.gpr, hk.readArg hp (by decide)], - by rw [u₂.gpr, u₁.mem, hk.readArg hp (by decide)]⟩, by rw [u₂.mem, u₁.mem]⟩ - -theorem state_disj {p : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) : - Region.Disjoint ⟨p.setWidth 64, H.S⟩ (scR sc s₀) ∧ (stkR s₀).Disjoint ⟨p.setWidth 64, H.S⟩ ∧ - (saveR H (scr s₀)).Disjoint ⟨p.setWidth 64, H.S⟩ ∧ p.toNat + H.S ≤ 2 ^ 32 := by - rcases hpR with rfl | rfl - · exact ⟨hp.i_s, hp.b_i, hp.i_s.symm.sub_left (save_sub hp), hp.ni⟩ - · exact ⟨hp.o_s, hp.b_o, hp.o_s.symm.sub_left (save_sub hp), hp.no⟩ - -theorem state_in {p : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) : ⟨p.setWidth 64, H.S⟩ ∈ s₀.wr := by - rw [hp.wr]; rcases hpR with rfl | rfl <;> simp - -omit hp in -theorem state_wrs {p : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) : - ∃ r' ∈ wrs (H := H) sc s₀, Region.Sub ⟨p.setWidth 64, H.S⟩ r' := by - rcases hpR with rfl | rfl - · exact ⟨inR (H := H) s₀, by simp, fun _ h => h⟩ - · exact ⟨outR (H := H) s₀, by simp, fun _ h => h⟩ - -omit hp in -theorem stk_eq {s : State} (hk : KR (H := H) sc s₀ s) : stk s = stkR s₀ := by rw [stk, hk.esp] - -/-- `KS` after a call that writes `rs`. -/ -theorem KS.call {s s' : State} (hk : KS (H := H) sc s₀ s) {rs : List Region} (ha : After s rs s') - (hs : ∀ r ∈ rs, (saveR H (scr s₀)).Disjoint r) (hsub : ∀ r ∈ rs, ∃ r' ∈ wrs (H := H) sc s₀, Region.Sub r r') : - KS (H := H) sc s₀ s' := - ⟨hk.toKR.call hp ha hs hsub, by rw [ha.cs .ebx (by simp [calleeSaved]), hk.ebx], - by rw [ha.cs .esi (by simp [calleeSaved]), hk.esi]⟩ - -theorem callInit_ok {s : State} (hk : KS (H := H) sc s₀ s) {st : Reg} {p : BitVec 32} - (hst : st = .ebx ∧ p = inn s₀ ∨ st = .esi ∧ p = out s₀) {Q : State → Prop} - (hQ : ∀ s', KS (H := H) sc s₀ s' → Frame [⟨p.setWidth 64, H.S⟩, stkR s₀] s.mem s'.mem → - hH.SH.Repr s'.mem (p.setWidth 64) [] → Q s') : - WP isa (H.callInit st) s Q := by - have hpR : p = inn s₀ ∨ p = out s₀ := by rcases hst with ⟨_, h⟩ | ⟨_, h⟩ <;> simp [h] - obtain ⟨dS, dK, dV, np⟩ := state_disj hp hpR - have hsp := hk.esp - refine init_frame hH (st := p) - { hst := by rcases hst with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩; exacts [hk.ebx, hk.esi] - hr := by rcases hst with ⟨rfl, _⟩ | ⟨rfl, _⟩ <;> decide - sp48 := by rw [hsp]; exact hp.sp48 - cw := by rw [hk.wr]; exact covers_one (state_in hp hpR) - b_st := by rw [stk_eq hk.toKR]; exact dK - nst := np } fun s' ha hr => ?_ - have f := ha.frame - rw [stk_eq hk.toKR] at f - exact hQ s' (hk.call hp ha (by simp only [List.mem_singleton]; rintro r rfl; exact dV) - (by simp only [List.mem_singleton]; rintro r rfl; exact state_wrs hpR)) f hr - -/-- The block before `update`'s frame, from `st` at offset `o`. -/ -abbrev updBlock (H : Hash) (o : Nat) : List Instr := - [] ++ ([.mov .eax (.imm 0), .mov .edi (.imm (BitVec.ofNat 32 0)), .mov .ecx (.imm (BitVec.ofNat 32 H.B))] : List Instr) ++ - Impl.Hmac.Generic.X86.scr .edx o - -theorem updArgs_ok {s : State} (hk : KS (H := H) sc s₀ s) {st : Reg} {p : BitVec 32} - (hst : st = .ebx ∧ p = inn s₀ ∨ st = .esi ∧ p = out s₀) {o : Nat} (ho : o = H.buf ∨ o = H.buf + H.B) : - WP isa (.block (updBlock H o)) s fun t => - KS (H := H) sc s₀ t ∧ UpdArgs hH t .edi st p (dO s₀ o) (scr s₀) (BitVec.ofNat 32 0) H.B ∧ t.mem = s.mem := by - have hpR : p = inn s₀ ∨ p = out s₀ := by rcases hst with ⟨_, h⟩ | ⟨_, h⟩ <;> simp [h] - obtain ⟨dS, dK, dV, np⟩ := state_disj hp hpR - have hB := hp.hB; have hB0 := hp.hB0; have hW := hp.hW; have hf := hp.fits; have nw := hp.nw - simp only [Hash.buf] at hf ho - have ho' : o + H.B ≤ 8 * sc := by omega_nat - have ea := addr_dO hp (o := o) (by omega_nat) - have dsub : Region.Sub ⟨(dO s₀ o).setWidth 64, H.B⟩ (bufR (H := H) s₀) := by - rw [ea] - rcases ho with rfl | rfl - · exact padI_sub - · rw [← add_ofNat_add]; exact padO_sub hp - have dsc : Region.Sub ⟨(dO s₀ o).setWidth 64, H.B⟩ (scR sc s₀) := fun a h => buf_sub hp a (dsub a h) - simp only [updBlock, Impl.Hmac.Generic.X86.scr, List.cons_append, List.nil_append] - refine wp_movi fun s₁ u₁ => wp_movi fun s₂ u₂ => wp_movi fun s₃ u₃ => wp_mov fun s₄ u₄ => - wp_addi fun s₅ u₅ => WP.block_nil ?_ - have g : ∀ r, r ≠ .eax → r ≠ .edi → r ≠ .ecx → r ≠ .edx → s₅.gpr r = s.gpr r := fun r h1 h2 h3 h4 => by - rw [u₅.other r h4, u₄.other r h4, u₃.other r h3, u₂.other r h2, u₁.other r h1] - have k₅ : KS (H := H) sc s₀ s₅ := - ⟨((((hk.toKR.upd (by decide) u₁).upd (by decide) u₂).upd (by decide) u₃).upd (by decide) u₄).upd - (by decide) u₅, by rw [g _ (by decide) (by decide) (by decide) (by decide), hk.ebx], - by rw [g _ (by decide) (by decide) (by decide) (by decide), hk.esi]⟩ - have hm : s₅.mem = s.mem := by rw [u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem] - refine ⟨k₅, ?_, hm⟩ - exact - { hst := by - rcases hst with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ - · exact k₅.ebx - · exact k₅.esi - hlo := by rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), u₂.gpr] - eax := by rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), - u₁.gpr] - ecx := by rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr] - edx := by rw [u₅.gpr, u₄.gpr, u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), - hk.ebp] - ebp := k₅.ebp - hr := by rcases hst with ⟨rfl, _⟩ | ⟨rfl, _⟩ <;> decide - hl := by decide - hlen := by omega_nat - sp48 := by rw [k₅.esp]; exact hp.sp48 - cd := by - rw [k₅.rd, k₅.wr, ea] - exact Covers.of_sub fun r hr => by - simp only [List.mem_singleton] at hr; subst hr - exact sub_of_off (L := 8 * sc) (by rw [hp.rd, hp.wr]; simp) ho' - cw := by - rw [k₅.wr] - exact Covers.of_sub fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact sub_of_self (r := ⟨p.setWidth 64, H.S⟩) (state_in hp hpR) (Nat.le_refl _) - · exact sub_of_self (r := scR sc s₀) (by rw [hp.wr]; simp) (by - have := hH.hWb; show hH.Wb ≤ 8 * sc; omega_nat) - st_sc := dS.sub_right (cal_sub hH hp) - d_st := dS.symm.sub_left dsc - d_sc := (cal_buf hH hp).symm.sub_left dsub - b_st := by rw [stk_eq k₅.toKR]; exact dK - b_d := by rw [stk_eq k₅.toKR]; exact hp.b_s.sub_right dsc - b_sc := by rw [stk_eq k₅.toKR]; exact hp.b_s.sub_right (cal_sub hH hp) - nst := np - nd := by rw [toNat_dO hp (by omega_nat)]; omega_nat - nsc := by have := hH.hWb; omega_nat } - -theorem updCall_ok {t : State} (hk : KS (H := H) sc s₀ t) {st : Reg} {p d : BitVec 32} - (hpR : p = inn s₀ ∨ p = out s₀) (ha : UpdArgs hH t .edi st p d (scr s₀) (BitVec.ofNat 32 0) H.B) - {Q : State → Prop} - (hQ : ∀ s', KS (H := H) sc s₀ s' → Frame [⟨p.setWidth 64, H.S⟩, calR hH s₀, stkR s₀] t.mem s'.mem → - (hH.SH.Repr t.mem (p.setWidth 64) [] → - hH.SH.Repr s'.mem (p.setWidth 64) ([] ++ bytesAt t.mem (d.setWidth 64) H.B)) → Q s') : - WP isa (.frame (.push (upd6 .edi st)) (.call H.updN H.updC) (.pop .eax (upd6 .edi st).length)) t Q := by - obtain ⟨dS, dK, dV, np⟩ := state_disj hp hpR - refine upd_frame hH ha fun s' ha' hpost => ?_ - have f := ha'.frame - rw [stk_eq hk.toKR] at f - refine hQ s' (hk.call hp ha' ?_ ?_) f fun hr => hpost [] hr (by rw [zero_append_ofNat (by decide)]; rfl) - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact dV - · exact (cal_save hH hp).symm - · intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact state_wrs hpR - · exact ⟨scR sc s₀, by simp, cal_sub hH hp⟩ - -theorem callUpd_ok {s : State} (hk : KS (H := H) sc s₀ s) {st : Reg} {p : BitVec 32} - (hst : st = .ebx ∧ p = inn s₀ ∨ st = .esi ∧ p = out s₀) {o : Nat} (ho : o = H.buf ∨ o = H.buf + H.B) - {Q : State → Prop} - (hQ : ∀ s', KS (H := H) sc s₀ s' → Frame [⟨p.setWidth 64, H.S⟩, calR hH s₀, stkR s₀] s.mem s'.mem → - (hH.SH.Repr s.mem (p.setWidth 64) [] → - hH.SH.Repr s'.mem (p.setWidth 64) ([] ++ bytesAt s.mem ((scr s₀).setWidth 64 + BitVec.ofNat 64 o) H.B)) → - Q s') : - WP isa (H.callUpd [] st .edi 0 o H.B) s Q := by - have hpR : p = inn s₀ ∨ p = out s₀ := by rcases hst with ⟨_, h⟩ | ⟨_, h⟩ <;> simp [h] - have hf := hp.fits; have := hp.hB; have := hp.hB0; have ho' := ho; simp only [Hash.buf] at hf ho' - have ea := addr_dO hp (o := o) (by omega_nat) - refine WP.seq (WP.mono (updArgs_ok hH hp hk hst ho) fun t ⟨k, a, m⟩ => - updCall_ok hH hp k hpR a fun s' k' f r => hQ s' k' (m ▸ f) fun hr => ?_) - have := r (m ▸ hr) - rwa [m, ea] at this - -/-! ## Correctness -/ - -omit hp in -include hH in -theorem repr_keep {rs : List Region} {m m' : Mem} (hf : Frame rs m m') {p : Addr} - (hd : ∀ r ∈ rs, Region.Disjoint ⟨p, H.S⟩ r) {msg : List Byte} (hr : hH.SH.Repr m p msg) : - hH.SH.Repr m' p msg := - hH.repr _ _ _ _ _ (fun i hi => hf.bytes (R := ⟨p, H.S⟩) hd (by show H.S ≤ 2 ^ 64; have := hH.hSB; omega_nat) hi) hr - -include hH in -theorem blockKey_eq : - blockKey hH.SH.H (bytesAt s₀.mem ((kp s₀).setWidth 64) (kl s₀)) = K0₀ (H := H) s₀ := by - have := hp.kl_le - have hb := hH.hB - simp only [blockKey, K0₀, K0, Proof.Hmac.Common.bytesAt_length, hb, show ¬ (H.B < kl s₀) by omega_nat, - ↓reduceIte] - -theorem correct : - WP isa H.init s₀ fun s' => abiPreserved s₀ s' ∧ (initG hH.SH sc).post s₀ s' := by - have hB := hp.hB; have hW := hp.hW; have hf := hp.fits - simp only [Hash.buf] at hf - -- Where things are. - have dIS : Region.Disjoint ⟨P (H := H) s₀, H.B⟩ (inR (H := H) s₀) := - hp.i_s.symm.sub_left fun a h => buf_sub hp a (padI_sub a h) - have dIO : Region.Disjoint ⟨P (H := H) s₀, H.B⟩ (outR (H := H) s₀) := - hp.o_s.symm.sub_left fun a h => buf_sub hp a (padI_sub a h) - have dOS : Region.Disjoint ⟨P (H := H) s₀ + BitVec.ofNat 64 H.B, H.B⟩ (inR (H := H) s₀) := - hp.i_s.symm.sub_left fun a h => buf_sub hp a (padO_sub hp a h) - have dOO : Region.Disjoint ⟨P (H := H) s₀ + BitVec.ofNat 64 H.B, H.B⟩ (outR (H := H) s₀) := - hp.o_s.symm.sub_left fun a h => buf_sub hp a (padO_sub hp a h) - have dIK : Region.Disjoint ⟨P (H := H) s₀, H.B⟩ (stkR s₀) := - hp.b_s.symm.sub_left fun a h => buf_sub hp a (padI_sub a h) - have dOK : Region.Disjoint ⟨P (H := H) s₀ + BitVec.ofNat 64 H.B, H.B⟩ (stkR s₀) := - hp.b_s.symm.sub_left fun a h => buf_sub hp a (padO_sub hp a h) - have dOC : Region.Disjoint ⟨P (H := H) s₀ + BitVec.ofNat 64 H.B, H.B⟩ (calR hH s₀) := - (cal_buf hH hp).symm.sub_left (padO_sub hp) - have eO : (scr s₀).setWidth 64 + BitVec.ofNat 64 (H.buf + H.B) = P (H := H) s₀ + BitVec.ofNat 64 H.B := by - rw [P, add_ofNat_add] - refine WP.seq (WP.mono (keys_ok sc hp) fun s₁ h₁ => ?_) - refine WP.seq (WP.mono (states_ok hp h₁.kr) fun s₂ ⟨k₂, m₂⟩ => ?_) - have bI₂ : bytesAt s₂.mem (P (H := H) s₀) H.B = xorPad (K0₀ (H := H) s₀) ipad := by rw [m₂]; exact h₁.bufI - have bO₂ : bytesAt s₂.mem (P (H := H) s₀ + BitVec.ofNat 64 H.B) H.B = xorPad (K0₀ (H := H) s₀) opad := by - rw [m₂]; exact h₁.bufO - refine WP.seq (callInit_ok hH hp k₂ (.inl ⟨rfl, rfl⟩) fun s₃ k₃ f₃ r₃ => ?_) - have bI₃ := (bytes_keep f₃ (p := P (H := H) s₀) (n := H.B) (by - simp only [List.mem_cons, List.not_mem_nil, or_false]; rintro r (rfl | rfl) ; exacts [dIS, dIK]) - (by omega_nat)).trans bI₂ - have bO₃ := (bytes_keep f₃ (p := P (H := H) s₀ + BitVec.ofNat 64 H.B) (n := H.B) (by - simp only [List.mem_cons, List.not_mem_nil, or_false]; rintro r (rfl | rfl) ; exacts [dOS, dOK]) - (by omega_nat)).trans bO₂ - refine WP.seq (callUpd_ok hH hp k₃ (.inl ⟨rfl, rfl⟩) (.inl rfl) fun s₄ k₄ f₄ r₄ => ?_) - have rI₄ := r₄ r₃ - rw [List.nil_append, show (scr s₀).setWidth 64 + BitVec.ofNat 64 H.buf = P (H := H) s₀ from rfl, bI₃] at rI₄ - have bO₄ := (bytes_keep f₄ (p := P (H := H) s₀ + BitVec.ofNat 64 H.B) (n := H.B) (by - simp only [List.mem_cons, List.not_mem_nil, or_false]; rintro r (rfl | rfl | rfl) ; exacts [dOS, dOC, dOK]) - (by omega_nat)).trans bO₃ - refine WP.seq (callInit_ok hH hp k₄ (.inr ⟨rfl, rfl⟩) fun s₅ k₅ f₅ r₅ => ?_) - have rI₅ := repr_keep hH f₅ (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact hp.i_o - · exact hp.b_i.symm) rI₄ - have bO₅ := (bytes_keep f₅ (p := P (H := H) s₀ + BitVec.ofNat 64 H.B) (n := H.B) (by - simp only [List.mem_cons, List.not_mem_nil, or_false]; rintro r (rfl | rfl) ; exacts [dOO, dOK]) - (by omega_nat)).trans bO₄ - refine WP.seq (callUpd_ok hH hp k₅ (.inr ⟨rfl, rfl⟩) (.inr rfl) fun s₆ k₆ f₆ r₆ => ?_) - have rO₆ := r₆ r₅ - rw [List.nil_append, eO, bO₅] at rO₆ - have rI₆ := repr_keep hH f₆ (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact hp.i_o - · exact hp.i_s.sub_right (cal_sub hH hp) - · exact hp.b_i.symm) rI₅ - have hsc : ⟨(scr s₀).setWidth 64, 8 * sc⟩ ∈ s₆.wr := by rw [k₆.wr, hp.wr]; simp - refine WP.mono (restore_ok H k₆.ebp k₆.saved hsc (by omega_nat) hp.nw) fun s' ⟨hm, _, _, hg, ho⟩ => ?_ - refine ⟨⟨fun r hr => ?_, by rw [hm]; exact k₆.toKR.ret hp⟩, ?_⟩ - · by_cases he : r = .esp - · subst he; rw [ho _ (by decide) (by decide), k₆.esp] - · exact hg r (callee_saved r hr he) - · show hH.SH.Repr s'.mem ((inn s₀).setWidth 64) _ ∧ hH.SH.Repr s'.mem ((out s₀).setWidth 64) _ - rw [hm, blockKey_eq hH hp] - exact ⟨rI₆, rO₆⟩ - -end - -end VG.Proof.Hmac.Generic.X86.Init diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/InitCT.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/InitCT.lean deleted file mode 100644 index 62c5a0992..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/InitCT.lean +++ /dev/null @@ -1,218 +0,0 @@ -import VerifiedGarbage.Proof.Hmac.Generic.X86.Init -import VerifiedGarbage.Proof.Framework.OmegaLit - -/-! -# HMAC over any streaming hash function on x86 (32-bit): `init`, constant time - -As on the other targets (`Proof/Hmac/Generic/Arm/Instances.lean`): the pieces -between the calls are checked by the taint analysis, from the registers that -hold our variables and, where they read them, the arguments on the stack -(`argTaint`); the calls are related by `init_rel` and `upd_rel`. --/ - -namespace VG.Proof.Hmac.Generic.X86.Init - -open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash) -open VG.Proof.Hmac.Generic.X86 - -/-- The taint checks of the pieces of `init` between its calls. -/ -structure Checks (H : Hash) : Prop where - keys : ∃ hc, (VG.Taint.check taint (argTaint [] (4 + 4 * 5)) H.initKeys hc).isSome = true - states : ∃ hc, (VG.Taint.check taint (argTaint [.ebp] (4 + 4 * 5)) (.block Hash.initStates) hc).isSome = true - upd : ∀ o ∈ [H.buf, H.buf + H.B], ∃ hc, - (VG.Taint.check taint (τr [.esp, .ebp, .ebx, .esi]) (.block (updBlock H o)) hc).isSome = true - restore : ∃ hc, (VG.Taint.check taint (τr [.ebp]) (.block H.restore) hc).isSome = true - -/-- The public arguments are the same. -/ -structure PubEq (s₀ s₀' : State) : Prop where - esp : s₀.gpr .esp = s₀'.gpr .esp - args : ∀ i < 5, arg s₀ i = arg s₀' i - -variable {H : Hash} (hH : HashOK H) {sc : Nat} (hc : Checks H) -variable {s₀ s₀' : State} (hp : Pre (H := H) sc s₀) (hp' : Pre (H := H) sc s₀') (hq : PubEq s₀ s₀') - -/-- The arguments lie outside the writable regions. -/ -theorem args_out {t : State} (h : Pre (H := H) sc t) {s : State} (hsp : s.gpr .esp = E t) (hwr : s.wr = t.wr) : - ArgsOut 5 s := by - have e : (⟨(s.gpr .esp).setWidth 64, 4 + 4 * 5⟩ : Region) = ⟨(E t).setWidth 64, 4 + 20⟩ := by rw [hsp] - refine ⟨by rw [hsp]; exact h.spf, ?_⟩ - rw [e, hwr, h.wr] - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact Taint.frame_disjoint (by have := h.spf; omega_nat) h.r_i h.a_i - · exact Taint.frame_disjoint (by have := h.spf; omega_nat) h.r_o h.a_o - · exact Taint.frame_disjoint (by have := h.spf; omega_nat) h.r_s h.a_s - -include hH hp hp' hq - -omit hH hp hp' hq in -theorem hpR {st : Reg} {p : BitVec 32} {t : State} (hst : st = .ebx ∧ p = inn t ∨ st = .esi ∧ p = out t) : - p = inn t ∨ p = out t := by - rcases hst with ⟨_, h⟩ | ⟨_, h⟩ <;> simp [h] - -omit hH hp hp' in -theorem kr_agree {s s' : State} (h : KR (H := H) sc s₀ s) (h' : KR (H := H) sc s₀' s') : - ∀ r ∈ [Reg.ebp], s.gpr r = s'.gpr r := by - intro r hr - simp only [List.mem_singleton] at hr; subst hr - rw [h.ebp, h'.ebp, scr, scr, hq.args 4 (by decide)] - -omit hH hp hp' in -theorem ks_agree {s s' : State} (h : KS (H := H) sc s₀ s) (h' : KS (H := H) sc s₀' s') : - ∀ r ∈ [Reg.esp, .ebp, .ebx, .esi], s.gpr r = s'.gpr r := by - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl - · rw [h.esp, h'.esp, E, E, hq.esp] - · rw [h.ebp, h'.ebp, scr, scr, hq.args 4 (by decide)] - · rw [h.ebx, h'.ebx, inn, inn, hq.args 0 (by decide)] - · rw [h.esi, h'.esi, out, out, hq.args 1 (by decide)] - -/-- A call of `init` on the state in `st` (`ebx` for `inner`, `esi` for `outer`). -/ -theorem callInit_rel {st : Reg} {p : BitVec 32} (hst : st = .ebx ∧ p = inn s₀ ∨ st = .esi ∧ p = out s₀) : - RelCT isa (fun s s' => KS (H := H) sc s₀ s ∧ KS (H := H) sc s₀' s') (H.callInit st) - fun s s' => KS (H := H) sc s₀ s ∧ KS (H := H) sc s₀' s' := by - have hst' : st = .ebx ∧ p = inn s₀' ∨ st = .esi ∧ p = out s₀' := by - rcases hst with ⟨h1, h2⟩ | ⟨h1, h2⟩ - · exact .inl ⟨h1, by rw [h2, inn, inn, hq.args 0 (by decide)]⟩ - · exact .inr ⟨h1, by rw [h2, out, out, hq.args 1 (by decide)]⟩ - have hpR : p = inn s₀ ∨ p = out s₀ := by rcases hst with ⟨_, h⟩ | ⟨_, h⟩ <;> simp [h] - have hpR' : p = inn s₀' ∨ p = out s₀' := by rcases hst' with ⟨_, h⟩ | ⟨_, h⟩ <;> simp [h] - refine rel_wp (F := KS (H := H) sc s₀) (F' := KS (H := H) sc s₀') - (init_rel hH (sp := E s₀) (r := st) (st := p) fun s s' ⟨k, k'⟩ => ?_) - (fun _ k => callInit_ok hH hp k hst fun _ k' _ _ => k') - (fun _ k => callInit_ok hH hp' k hst' fun _ k' _ _ => k') - obtain ⟨_, dK, _, np⟩ := state_disj hp hpR - obtain ⟨_, dK', _, np'⟩ := state_disj hp' hpR' - refine ⟨{ hst := ?_, hr := ?_, sp48 := ?_, cw := ?_, b_st := ?_, nst := np }, - { hst := ?_, hr := ?_, sp48 := ?_, cw := ?_, b_st := ?_, nst := np' }, k.esp, by rw [k'.esp, E, E, hq.esp]⟩ - · rcases hst with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩; exacts [k.ebx, k.esi] - · rcases hst with ⟨rfl, _⟩ | ⟨rfl, _⟩ <;> decide - · rw [k.esp]; exact hp.sp48 - · rw [k.wr]; exact covers_one (state_in hp hpR) - · rw [stk_eq k.toKR]; exact dK - · rcases hst' with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩; exacts [k'.ebx, k'.esi] - · rcases hst with ⟨rfl, _⟩ | ⟨rfl, _⟩ <;> decide - · rw [k'.esp]; exact hp'.sp48 - · rw [k'.wr]; exact covers_one (state_in hp' hpR') - · rw [stk_eq k'.toKR]; exact dK' - -omit hc in -/-- A call of `update` on the state in `st`, with the bytes at `scratch + o`. -/ -theorem callUpd_rel {st : Reg} {p : BitVec 32} (hst : st = .ebx ∧ p = inn s₀ ∨ st = .esi ∧ p = out s₀) {o : Nat} - (ho : o = H.buf ∨ o = H.buf + H.B) - (hck : ∃ hc, (VG.Taint.check taint (τr [.esp, .ebp, .ebx, .esi]) (.block (updBlock H o)) hc).isSome = true) : - RelCT isa (fun s s' => KS (H := H) sc s₀ s ∧ KS (H := H) sc s₀' s') (H.callUpd [] st .edi 0 o H.B) - fun s s' => KS (H := H) sc s₀ s ∧ KS (H := H) sc s₀' s' := by - have hst' : st = .ebx ∧ p = inn s₀' ∨ st = .esi ∧ p = out s₀' := by - rcases hst with ⟨h1, h2⟩ | ⟨h1, h2⟩ - · exact .inl ⟨h1, by rw [h2, inn, inn, hq.args 0 (by decide)]⟩ - · exact .inr ⟨h1, by rw [h2, out, out, hq.args 1 (by decide)]⟩ - have e4 : scr s₀' = scr s₀ := (hq.args 4 (by decide)).symm - have e8 : dO s₀' o = dO s₀ o := by rw [dO, dO, e4] - have ha : RelCT isa (fun s s' => KS (H := H) sc s₀ s ∧ KS (H := H) sc s₀' s') (.block (updBlock H o)) - fun s s' => (KS (H := H) sc s₀ s ∧ UpdArgs hH s .edi st p (dO s₀ o) (scr s₀) (BitVec.ofNat 32 0) H.B) ∧ - (KS (H := H) sc s₀' s' ∧ UpdArgs hH s' .edi st p (dO s₀ o) (scr s₀) (BitVec.ofNat 32 0) H.B) := - rel_agree (τr [.esp, .ebp, .ebx, .esi]) (fun _ _ h h' => agree_regs (ks_agree hq h h')) hck - (fun _ h => WP.mono (updArgs_ok hH hp h hst ho) fun _ ⟨k, a, _⟩ => ⟨k, a⟩) - (fun _ h => WP.mono (updArgs_ok hH hp' h hst' ho) fun _ ⟨k, a, _⟩ => ⟨k, e8 ▸ e4 ▸ a⟩) - refine ha.seq (rel_wp - (F := fun s => KS (H := H) sc s₀ s ∧ UpdArgs hH s .edi st p (dO s₀ o) (scr s₀) (BitVec.ofNat 32 0) H.B) - (F' := fun s => KS (H := H) sc s₀' s ∧ UpdArgs hH s .edi st p (dO s₀ o) (scr s₀) (BitVec.ofNat 32 0) H.B) - (upd_rel hH (sp := E s₀) fun s s' ⟨⟨k, a⟩, ⟨k', a'⟩⟩ => ⟨a, a', k.esp, by rw [k'.esp, E, E, hq.esp]⟩) - (fun _ ⟨k, a⟩ => updCall_ok hH hp k (hpR hst) a fun _ k' _ _ => k') - (fun _ ⟨k, a⟩ => updCall_ok hH hp' k (hpR hst') (e4.symm ▸ a) fun _ k' _ _ => k')) - -include hc in -theorem ct : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.init fun _ _ => True := by - have keys : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.initKeys - fun s s' => KR (H := H) sc s₀ s ∧ KR (H := H) sc s₀' s' := - rel_agree (argTaint [] (4 + 4 * 5)) (fun s s' e e' => by - subst e e' - exact agree_argTaint (fun r hr => nomatch hr) hq.esp (args_out hp rfl rfl) (args_out hp' rfl rfl) - hq.args) hc.keys - (fun _ e => by subst e; exact WP.mono (keys_ok sc hp) fun _ h => h.kr) - (fun _ e => by subst e; exact WP.mono (keys_ok sc hp') fun _ h => h.kr) - have states : RelCT isa (fun s s' => KR (H := H) sc s₀ s ∧ KR (H := H) sc s₀' s') (.block Hash.initStates) - fun s s' => KS (H := H) sc s₀ s ∧ KS (H := H) sc s₀' s' := - rel_agree (argTaint [.ebp] (4 + 4 * 5)) (fun s s' k k' => - agree_argTaint (kr_agree hq k k') (by rw [k.esp, k'.esp, E, E, hq.esp]) (args_out hp k.esp k.wr) - (args_out hp' k'.esp k'.wr) fun i hi => by rw [k.argEq hp hi, k'.argEq hp' hi, hq.args i hi]) hc.states - (fun _ k => WP.mono (states_ok hp k) fun _ h => h.1) - (fun _ k => WP.mono (states_ok hp' k) fun _ h => h.1) - obtain ⟨_, hr⟩ := hc.restore - have restore : RelCT isa (fun s s' => KS (H := H) sc s₀ s ∧ KS (H := H) sc s₀' s') (.block H.restore) - fun _ _ => True := - RelCT.taint (A := taint) (τr [.ebp]) (fun _ _ h => agree_regs (kr_agree hq h.1.toKR h.2.toKR)) hr - exact keys.seq (states.seq ((callInit_rel hH hp hp' hq (.inl ⟨rfl, rfl⟩)).seq - ((callUpd_rel hH hp hp' hq (.inl ⟨rfl, rfl⟩) (.inl rfl) (hc.upd _ (by simp))).seq - ((callInit_rel hH hp hp' hq (.inr ⟨rfl, rfl⟩)).seq - ((callUpd_rel hH hp hp' hq (.inr ⟨rfl, rfl⟩) (.inr rfl) (hc.upd _ (by simp))).seq restore))))) - -end VG.Proof.Hmac.Generic.X86.Init - -namespace VG.Proof.Hmac.Generic.X86.Init - -open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash) -open VG.Proof.Hmac.Generic.X86 - -/-- `init` is verified against `initG`, given the taint checks, which the -kernel evaluates for each hash function. -/ -theorem verified {H : Hash} (hH : HashOK H) {sc : Nat} (hc : Checks H) - (hfit : H.buf + 2 * H.B ≤ 8 * sc) (hsat : ∃ s, (initG hH.SH sc).pre s) : - Verified X86.target H.init (initG hH.SH sc) := by - refine ⟨fun s hs => ?_, fun s₁ s₂ t₁ t₂ s₁' s₂' h₁ h₂ hpub e₁ e₂ => ?_, hsat⟩ - · obtain ⟨t, s', he, hg, hpost⟩ := correct hH (pre_of hH sc hs hfit) - exact ⟨t, s', he, hg, hpost⟩ - · obtain ⟨h1, h2⟩ := hpub - exact (ct hH hc (pre_of hH sc h₁ hfit) (pre_of hH sc h₂ hfit) ⟨h1, h2⟩ - _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 - -/-- The regions `init` reads and writes, of those `initW` gives it. -/ -def narrowRd (s : State) : List Region := - [⟨(arg s 2).setWidth 64, (arg s 3).toNat⟩, ⟨argAddr s 0, 20⟩] -def narrowWr (S sc : Nat) (s : State) : List Region := - [⟨(arg s 0).setWidth 64, S⟩, ⟨(arg s 1).setWidth 64, S⟩, ⟨(arg s 4).setWidth 64, 8 * sc⟩] - -/-- `init` is verified against `initW`, which lets it write its arguments: -the code only reads them. -/ -theorem verifiedW {H : Hash} (hH : HashOK H) {sc : Nat} (hc : Checks H) - (hfit : H.buf + 2 * H.B ≤ 8 * sc) (hsat : ∃ s, (initW hH.SH sc).pre s) : - Verified X86.target H.init (initW hH.SH sc) := by - have pre : ∀ s, (initW hH.SH sc).pre s → - (initG hH.SH sc).pre (s.withRegions (narrowRd s) (narrowWr hH.SH.stateBytes sc s)) := by - intro s h - obtain ⟨h0, _, _, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, h21, - h22, h23, h24⟩ := h - simp only [initG, narrowRd, narrowWr, arg_withRegions, argAddr_withRegions, State.withRegions_gpr, - State.withRegions_rd, State.withRegions_wr] - exact ⟨h0, trivial, trivial, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, h21, - h22, h23, h24⟩ - refine Verified.narrowTo (verified hH hc hfit (hsat.elim fun s hs => ⟨_, pre s hs⟩)) - (narrowRd) (narrowWr hH.SH.stateBytes sc) pre (fun s h => ?_) (fun s h => ?_) - (fun _ _ _ h => h) (fun _ _ _ _ h => h) hsat - · obtain ⟨_, h1, h2, _⟩ := h - rw [h1, h2] - refine Covers.of_sub fun r hr => ?_ - simp only [narrowRd, narrowWr, List.cons_append, List.nil_append, List.mem_cons, List.not_mem_nil, - or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl - · exact ⟨_, List.mem_append_left _ List.mem_cons_self, 0, by simp, by simp⟩ - · exact ⟨_, List.mem_append_right _ (List.mem_cons_of_mem _ (List.mem_cons_of_mem _ - (List.mem_cons_of_mem _ List.mem_cons_self))), 0, by simp, by simp⟩ - · exact ⟨_, List.mem_append_right _ List.mem_cons_self, 0, by simp, by simp⟩ - · exact ⟨_, List.mem_append_right _ (List.mem_cons_of_mem _ List.mem_cons_self), 0, by simp, by simp⟩ - · exact ⟨_, List.mem_append_right _ (List.mem_cons_of_mem _ (List.mem_cons_of_mem _ List.mem_cons_self)), 0, - by simp, by simp⟩ - · obtain ⟨_, _, h2, _⟩ := h - rw [h2] - refine Covers.of_sub fun r hr => ?_ - simp only [narrowWr, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact ⟨_, List.mem_cons_self, 0, by simp, by simp⟩ - · exact ⟨_, List.mem_cons_of_mem _ List.mem_cons_self, 0, by simp, by simp⟩ - · exact ⟨_, List.mem_cons_of_mem _ (List.mem_cons_of_mem _ List.mem_cons_self), 0, by simp, by simp⟩ - -end VG.Proof.Hmac.Generic.X86.Init diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Instances.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Instances.lean deleted file mode 100644 index fe51942bf..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Instances.lean +++ /dev/null @@ -1,161 +0,0 @@ -import VerifiedGarbage.Proof.Framework.Contract -import VerifiedGarbage.Proof.Hmac.Generic.X86.Lit -import VerifiedGarbage.Proof.Hmac.Generic.X86.InitCT -import VerifiedGarbage.Proof.Hmac.Generic.X86.Hashes - -/-! -# HMAC over the streaming hash functions on x86 (32-bit): the instances of `init` - -The generic proof of `init` (`InitCT.lean`) at each hash function of -`Hashes.lean`, moved to the shared contract of `Spec/Hmac/Generic.lean` -(`sig_implies`), which the artifacts are emitted with. `finalize` is written -over the compression function instead: `Proof/Pbkdf2/Md/X86/Instances.lean`. --/ - -namespace VG.Proof.Hmac.Generic.X86.Instances - -open VG.X86 -open VG.Proof.Hmac.Generic.X86 - -/-- Memory holding the arguments `0x1000, 0x1400, 0x1800, 0, 0x2000` of -`init` at `0x6004`. -/ -def initMem : Mem := fun a => - if a = 0x6005 then 0x10 else if a = 0x6009 then 0x14 else if a = 0x600D then 0x18 else - if a = 0x6015 then 0x20 else 0 - -/-- A state satisfying `init`'s precondition, with states of `S` bytes and -`8 sc` bytes of scratch space (and an empty key), with the arguments writable. -/ -def initSat (S sc : Nat) : State where - gpr r := match r with - | .esp => 0x6000 | _ => 0 - cf := none - zf := none - sf := none - of := none - mem := initMem - rd := [⟨0x1800, 0⟩] - wr := [⟨0x1000, S⟩, ⟨0x1400, S⟩, ⟨0x2000, 8 * sc⟩, ⟨0x6004, 20⟩] - -theorem initSat_args (S sc : Nat) : - arg (initSat S sc) 0 = 0x1000 ∧ arg (initSat S sc) 1 = 0x1400 ∧ arg (initSat S sc) 2 = 0x1800 ∧ - arg (initSat S sc) 3 = 0 ∧ arg (initSat S sc) 4 = 0x2000 ∧ argAddr (initSat S sc) 0 = 0x6004 ∧ - (initSat S sc).gpr .esp = 0x6000 := by - have e : ∀ i, arg (initSat S sc) i = arg (initSat 0 0) i := fun _ => rfl - have e' : argAddr (initSat S sc) 0 = argAddr (initSat 0 0) 0 := rfl - rw [e, e, e, e, e, e'] - refine ⟨?_, ?_, ?_, ?_, ?_, ?_, rfl⟩ <;> decide - -/-! ## SHA-1 -/ - -theorem sha1_initChecks : Init.Checks sha1H where - keys := ⟨_, by taint_decide⟩ - states := ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha1_initImp : (initW Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.initContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 84 56 - sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, - Spec.Hmac.sha1I, Spec.Hmac.sha1S, Spec.Hmac.sha1, initW, initG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 84 56 - -theorem sha1_init : Verified X86.target sha1H.init (Spec.Hmac.sha1I.initContract X86.abi 48) := - (Init.verifiedW sha1OK sha1_initChecks (by decide) sha1_initImp.sat_left).of_implies sha1_initImp - -/-! ## MD5 -/ - -theorem md5_initChecks : Init.Checks md5H where - keys := ⟨_, by taint_decide⟩ - states := ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem md5_initImp : (initW Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.initContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 80 48 - sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, - Spec.Hmac.md5I, Spec.Hmac.md5S, Spec.Hmac.md5, initW, initG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 80 48 - -theorem md5_init : Verified X86.target md5H.init (Spec.Hmac.md5I.initContract X86.abi 48) := - (Init.verifiedW md5OK md5_initChecks (by decide) md5_initImp.sat_left).of_implies md5_initImp - -/-- `Init.Checks` looks at the sizes of a hash function but its digest's. -/ -theorem Init.Checks.of_eq {H H' : Impl.Hmac.Generic.X86.Hash} (hB : H.B = H'.B) (hS : H.S = H'.S) - (hW : H.W = H'.W) (h : Init.Checks H) : Init.Checks H' := by - obtain ⟨B, S, D, F, W, iN, iC, uN, uC, fN, fC⟩ := H - obtain ⟨B', S', D', F', W', iN', iC', uN', uC', fN', fC'⟩ := H' - dsimp only at hB hS hW; subst hB hS hW - exact ⟨h.keys, h.states, h.upd, h.restore⟩ - -/-! ## SHA-384 -/ - -theorem sha384_initChecks : Init.Checks sha384H where - keys := ⟨_, by taint_decide⟩ - states := ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha384_initImp : (initW Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I.initContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 192 234 - sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, - Spec.Hmac.sha384I, Spec.Hmac.sha384S, Spec.Hmac.sha384, initW, initG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 192 234 - -theorem sha384_init : Verified X86.target sha384H.init (Spec.Hmac.sha384I.initContract X86.abi 48) := - (Init.verifiedW sha384OK sha384_initChecks (by decide) sha384_initImp.sat_left).of_implies sha384_initImp - -/-! ## SHA-512 -/ - -theorem sha512_initChecks : Init.Checks sha512H' := - Init.Checks.of_eq (H := sha384H) rfl rfl rfl sha384_initChecks - -theorem sha512_initImp : (initW Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I.initContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 192 234 - sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, - Spec.Hmac.sha512I, Spec.Hmac.sha512S, Spec.Hmac.sha512, initW, initG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 192 234 - -theorem sha512_init : Verified X86.target sha512H'.init (Spec.Hmac.sha512I.initContract X86.abi 48) := - (Init.verifiedW sha512OK sha512_initChecks (by decide) sha512_initImp.sat_left).of_implies sha512_initImp - -/-! ## SHA-512/224 -/ - -theorem sha512_224_initChecks : Init.Checks sha512_224H := - Init.Checks.of_eq (H := sha384H) rfl rfl rfl sha384_initChecks - -theorem sha512_224_initImp : (initW Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac.sha512_224I.initContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 192 234 - sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, - Spec.Hmac.sha512_224I, Spec.Hmac.sha512_224S, Spec.Hmac.sha512_224, initW, initG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 192 234 - -theorem sha512_224_init : Verified X86.target sha512_224H.init (Spec.Hmac.sha512_224I.initContract X86.abi 48) := - (Init.verifiedW sha512_224OK sha512_224_initChecks (by decide) sha512_224_initImp.sat_left).of_implies sha512_224_initImp - -/-! ## SHA-512/256 -/ - -theorem sha512_256_initChecks : Init.Checks sha512_256H := - Init.Checks.of_eq (H := sha384H) rfl rfl rfl sha384_initChecks - -theorem sha512_256_initImp : (initW Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac.sha512_256I.initContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 192 234 - sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, - Spec.Hmac.sha512_256I, Spec.Hmac.sha512_256S, Spec.Hmac.sha512_256, initW, initG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 192 234 - -theorem sha512_256_init : Verified X86.target sha512_256H.init (Spec.Hmac.sha512_256I.initContract X86.abi 48) := - (Init.verifiedW sha512_256OK sha512_256_initChecks (by decide) sha512_256_initImp.sat_left).of_implies sha512_256_initImp - -end VG.Proof.Hmac.Generic.X86.Instances diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Lit.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Lit.lean deleted file mode 100644 index c3f63068e..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Lit.lean +++ /dev/null @@ -1,23 +0,0 @@ -import VerifiedGarbage.Proof.Framework.X86.Lit -import VerifiedGarbage.Proof.Hmac.Generic.X86.Hashes - -/-! -# HMAC over every hash on X86: `init` as literals - -HMAC's `init` at each hash function, as literals (`materialize_code`, -`Proof/Framework/Lit.lean`) that refer to the hash functions' literals: the -registration files' `spSafe` checks evaluate them. `finalize` and PBKDF2's -`iterate`, written over the compression function, are in -`Proof/Pbkdf2/Md/X86/Lit.lean`. --/ - -namespace VG.Proof.Hmac.Generic.X86 - -materialize_code sha1HInit := sha1H.init -materialize_code md5HInit := md5H.init -materialize_code sha384HInit := sha384H.init -materialize_code sha512HInit := sha512H'.init -materialize_code sha512_224HInit := sha512_224H.init -materialize_code sha512_256HInit := sha512_256H.init - -end VG.Proof.Hmac.Generic.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Hash.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Hash.lean index e2a5e850c..4192bf68f 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Hash.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Hash.lean @@ -1,6 +1,6 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Compress import VerifiedGarbage.Proof.Pbkdf2.MdStep -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Init +import VerifiedGarbage.Proof.Pbkdf2.Stream.Arm.Common /-! # HMAC and PBKDF2-HMAC over any Merkle–Damgård hash function on ARMv7: the hash function @@ -12,7 +12,9 @@ Merkle–Damgård hash function `md` (`Md`) whose digest code does what it shoul words the code stores (`len`), with a verified compression function (`CompOk`); its streaming functions are verified against the contracts HMAC's generic proofs call them with (`stream`); its specification is `md` from the -initial hash value `iv`, with the digest the first `D` bytes of `md`'s; and +initial hash value `iv` (a state represents a message as the specification +has it exactly when it does as `md` has it: `repr`, `back`), with the digest +the first `D` bytes of `md`'s; and its sizes fit (`Sizes`). -/ @@ -56,10 +58,11 @@ structure HashOK (H : Hash) where /-- The constant length field is that of a `B + D`-byte message. -/ len : wordsBytes (lenWords H.be H.L (H.B + H.D)) = md.lenBytes (H.B + H.D) /-- The streaming functions, verified. -/ - stream : Hmac.Generic.Arm.HashOK H.st + stream : Pbkdf2.Stream.Arm.HashOK H.st /-- The specification is `md` from `iv`, with a `D`-byte digest. -/ iv : md.HV repr : ∀ mem p m, stream.SH.Repr mem p m → md.Repr iv mem p m + back : ∀ mem p m, md.Repr iv mem p m → stream.SH.Repr mem p m hash : ∀ m, stream.SH.H.hash m = (md.hash iv m).take H.D sizes : Sizes H diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFin.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFin.lean index 8f03707f8..1963f6d82 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFin.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFin.lean @@ -5,22 +5,22 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Hash `finalize` (`Impl/Pbkdf2/Md/Arm.lean`) finalizes the inner state with the hash function's streaming `finalize`, in a frame that pushes its stack arguments -(`fin_frame`, `Proof/Hmac/Generic/Arm/Hash.lean`), into the block; copies the +(`fin_frame`, `Proof/Pbkdf2/Stream/Arm/Hash.lean`), into the block; copies the outer state's hash value to the hash value being compressed and writes the padding after the inner digest; compresses the block once (`compressBlock_ok`); and writes the digest to `out`. `Md.hmac_outer` says that this is HMAC. The contract is `finG` -(`Proof/Hmac/Generic/Arm/Hash.lean`), the shared one's at 16 bytes of stack. +(`Proof/Pbkdf2/Stream/Arm/Hash.lean`), the shared one's at 16 bytes of stack. -/ namespace VG.Proof.Pbkdf2.Md.Arm.Fin open VG VG.Arm open VG.Impl.Pbkdf2.Md.Arm (Hash copyW padFrom constW lenWords) -open VG.Impl.Hmac.Generic.Arm (scrAt) +open VG.Impl.Pbkdf2.Stream.Arm (scrAt) open VG.Proof.Pbkdf2.Md.Arm open VG.Proof.MdStream (Md) -open VG.Proof.Hmac.Generic.Arm (finG below count SavedRegs saveR savedRegs preserved_saved FinArgs fin_frame +open VG.Proof.Pbkdf2.Stream.Arm (finG below count SavedRegs saveR savedRegs preserved_saved FinArgs fin_frame After below_eq) open VG.Proof.MdStream.Arm (Upd wp_mov wp_ldrSp op2_reg) open VG.Spec.Sha256 (bytesAt) @@ -232,7 +232,7 @@ theorem pro_ok : WP isa (.block H.finPrologue) s₀ fun s => KR H sc s₀ s ∧ simp only [List.singleton_append] refine wp_ldrSp (a := stackArgAddr s₀ 1) (by decide) rfl ⟨argR s₀, aR, by rw [sa1 hp]; exact Offset.contains_base _ (by omega) (by omega)⟩ fun s₁ u₁ => ?_ - refine Hmac.Generic.Arm.save_ok H.st (scr := scr s₀) u₁.gpr hW (by rw [u₁.wr]; exact sR) (L := 8 * sc) + refine Pbkdf2.Stream.Arm.save_ok H.st (scr := scr s₀) u₁.gpr hW (by rw [u₁.wr]; exact sR) (L := 8 * sc) (by omega) nw fun s₂ g₂ rd₂ wr₂ sp₂ f₂ sv₂ => ?_ have hsp₂ : s₂.sp = s₀.sp := by rw [sp₂, u₁.sp] refine wp_mov (op2_reg _ _) fun s₃ u₃ => @@ -328,7 +328,7 @@ theorem finCall_ok {t : State} (hk : KR H sc s₀ t) (ha : FinArgs hH.stream t ( Frame [inR H s₀, ⟨blkA H s₀, H.N⟩, ⟨scA s₀, hH.stream.Wb⟩, below s₀] t.mem s'.mem → (∀ m, hH.SH.Repr t.mem (State.addr (inn s₀)) m → m.length < 2 ^ 64 → count t = BitVec.ofNat 64 m.length → bytesAt s'.mem (blkA H s₀) H.D = hH.SH.H.hash m) → Q s') : - WP isa (.frame (.push Hmac.Generic.Arm.fin2) (.call H.st.finN H.st.finC) (.pop .r1 8)) t Q := + WP isa (.frame (.push Pbkdf2.Stream.Arm.fin2) (.call H.st.finN H.st.finC) (.pop .r1 8)) t Q := fin_frame hH.stream ha fun s' ha' hpost => by have hz := hH.sizes have := hz.W; have := hH.stream.hWb; have := hz.DN; have := hz.NL; have hfi := hp.fits @@ -575,7 +575,7 @@ theorem out_ok {md : Md H.B H.N H.L} (ho : OutOk md H.out) {s : State} (h : KR' bytesAt s'.mem (State.addr (op s₀)) H.D = (md.digest (md.stateAt s.mem (hvA H s₀))).take H.D := by intro s₁ h11 hrd hwr hsp hsv hb have hfi := hp.fits; rw [buf_eq H] at hfi - exact WP.mono (Hmac.Generic.Arm.restore_ok H.st h11 hz.W hsv (by rw [hwr, h.wr, hp.wr]; simp) (L := 8 * sc) + exact WP.mono (Pbkdf2.Stream.Arm.restore_ok H.st h11 hz.W hsv (by rw [hwr, h.wr, hp.wr]; simp) (L := 8 * sc) (by omega) hp.nw) fun s' ⟨hm, _, _, hsp', hg, _⟩ => ⟨⟨fun r hr => hg r (preserved_saved r hr), by rw [hsp', hsp, h.sp]⟩, by rw [hm]; exact hb⟩ have sdisj : ∀ {R : Region}, R ∈ [opR H s₀, ⟨blkA H s₀, H.N⟩] → (saveR H.st (scr s₀)).Disjoint R := by @@ -650,7 +650,7 @@ theorem correct {H : Hash} (hH : HashOK H) {sc : Nat} {s₀ : State} (hp : Pre H have hz := hH.sizes have := hz.N64; have := hz.DN; have := hz.NL; have := hp.fits have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega - unfold Hash.hmacFin Impl.Hmac.Generic.Arm.Hash.callFin + unfold Hash.hmacFin Impl.Pbkdf2.Stream.Arm.Hash.callFin refine WP.seq (WP.mono (pro_ok hH hp) fun s₁ ⟨k₁, r0₁, c₁, f₁⟩ => ?_) refine WP.seq (WP.seq (WP.mono (fin1Args_ok hH hp k₁ r0₁) fun t₁ ⟨kt₁, a₁, ct₁, mt₁⟩ => finCall_ok hH hp kt₁ a₁ fun s₂ k₂ _ d₂ => ?_)) @@ -664,7 +664,7 @@ theorem correct {H : Hash} (hH : HashOK H) {sc : Nat} {s₀ : State} (hp : Pre H -- The inner digest. have rI : hH.SH.Repr t₁.mem (State.addr (inn s₀)) (xorPad k0 ipad ++ text) := by rw [mt₁] - refine Hmac.Generic.Arm.Init.repr_keep hH.stream f₁ (fun r hr => ?_) hrI + refine Pbkdf2.Stream.Arm.repr_keep hH.stream f₁ (fun r hr => ?_) hrI simp only [List.mem_singleton] at hr; subst hr rw [hz.S]; exact (save_disj hz hp _ (by simp)).symm have dig := d₂ _ rI (by rw [hl0]; rw [hk0'] at hlen; exact hlen) (by rw [ct₁, c₁, hcnt, hl0, hH.hB]) diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFinCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFinCT.lean index a8ea8ec39..e8f08a113 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFinCT.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFinCT.lean @@ -9,7 +9,7 @@ determines our registers from the public arguments alone, so the taint analysis proves the blocks between the calls constant time from them (`Checks`, evaluated for each hash function); the call of the streaming `finalize` is constant time by its own proof (`fin_rel`, -`Proof/Hmac/Generic/Arm/Hash.lean`), and the call of the compression function +`Proof/Pbkdf2/Stream/Arm/Hash.lean`), and the call of the compression function by its own (`compressBlock_rel`). -/ @@ -17,9 +17,9 @@ namespace VG.Proof.Pbkdf2.Md.Arm.Fin open VG VG.Arm open VG.Impl.Pbkdf2.Md.Arm (Hash) -open VG.Impl.Hmac.Generic.Arm (scrAt) +open VG.Impl.Pbkdf2.Stream.Arm (scrAt) open VG.Proof.Pbkdf2.Md.Arm -open VG.Proof.Hmac.Generic.Arm (finG count FinArgs fin_rel) +open VG.Proof.Pbkdf2.Stream.Arm (finG count FinArgs fin_rel) /-- The registers the blocks after the outer hash value is set up use. -/ abbrev regsO : List Reg := [.r0, .r3, .r5, .r6, .r7, .r11] @@ -120,7 +120,7 @@ theorem fin_ct {H : Hash} (hH : HashOK H) (hc : Checks H) {sc : Nat} {s₀ s₀' (fun _ ⟨k, r0, c⟩ => WP.mono (fin1Args_ok hH hp k r0) fun _ ⟨k, a, c', _⟩ => ⟨k, a, c'.trans c⟩) (fun _ ⟨k, r0, c⟩ => WP.mono (fin1Args_ok hH hp' k r0) fun _ ⟨k, a, c', _⟩ => ⟨k, a, c'.trans c⟩) have call : RelCT isa (fun s s' => F₁ s₀ s ∧ F₁ s₀' s') - (.frame (.push Hmac.Generic.Arm.fin2) (.call H.st.finN H.st.finC) (.pop .r1 8)) + (.frame (.push Pbkdf2.Stream.Arm.fin2) (.call H.st.finN H.st.finC) (.pop .r1 8)) fun s s' => KR H sc s₀ s ∧ KR H sc s₀' s' := rel_wp (fin_rel hH.stream (sp := s₀.sp) (st := inn s₀) (o := blk H s₀) (sc := scr s₀) fun s s' ⟨h, h'⟩ => ⟨h.2.1, by rw [← e.1, ← e.2.1, ← e.2.2.1]; exact h'.2.1, by rw [h.2.2, h'.2.2, hcnt], h.1.sp, @@ -143,7 +143,7 @@ theorem fin_ct {H : Hash} (hH : HashOK H) (hc : Checks H) {sc : Nat} {s₀ s₀' obtain ⟨_, ho⟩ := hc.out have out : RelCT isa (fun s s' => KR' H sc s₀ s ∧ KR' H sc s₀' s') (.block H.finOut) fun _ _ => True := RelCT.taint (A := taint) (Taint.ofRegs regsO) (fun _ _ h => Taint.agree_ofRegs (kr'_agree hq h.1 h.2)) ho - unfold Hash.hmacFin Impl.Hmac.Generic.Arm.Hash.callFin + unfold Hash.hmacFin Impl.Pbkdf2.Stream.Arm.Hash.callFin exact pro.seq ((f1.seq call).seq (mid.seq (cmp.seq out))) /-! ## Verified -/ diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInit.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInit.lean new file mode 100644 index 000000000..75f2bccec --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInit.lean @@ -0,0 +1,764 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Hash +import VerifiedGarbage.Proof.Pbkdf2.MdInit + +/-! +# HMAC's `init` over a Merkle–Damgård hash function on ARMv7: correct + +As on x86 (`Proof/Pbkdf2/Md/X86/HmacInit.lean`): HMAC's `init` +(`Impl/Pbkdf2/Md/Arm.lean`) saves our caller's registers (`pro_ok`), calls +the streaming `init` on both states (`callInit_ok`), writes `ipad` in every +byte of the inner state's buffer (`fill_ok`) and the key XORed into its +start (`keys_ok`), the outer buffer from the inner one, word by word +(`opad_ok`), and compresses each buffer into its state's hash value +(`compressBlock_ok`): each state then represents its block +(`Md.repr_block`). The contract is `initG` +(`Proof/Pbkdf2/Stream/Arm/Hash.lean`), the shared one's at 16 bytes of stack. +-/ + +namespace VG.Proof.Pbkdf2.Md.Arm + +open VG VG.Arm +open VG.Impl.Pbkdf2.Md.Arm (Hash) +open VG.Proof.MdStream.Arm (Upd Mupd Fupd wp_mov wp_add wp_ldr wp_str wp_ldrb wp_strb wp_subs wp_cmp op2_imm + op2_reg eval_eq) +open VG.Proof.Pbkdf2.Stream.Arm (count_loop addr3 left_z left_val) +open VG.Proof.Hmac.Common (bytesAt_length bytesAt_add) +open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil writeBytes_frame) +open VG.Spec.Sha256 (bytesAt) + +/-! ## Words of a constant, and words XORed with a constant -/ + +/-- `n` words of `r1` stored at `[r4 + o]`, `[r4 + o + 4]`, … -/ +theorem fillW_ok {y : BitVec 32} {o : Nat} {b : Byte} (n : Nat) (ho : o + 4 * n ≤ 4096) : + ∀ (rest : List Instr) (s : State) (Q : State → Prop), s.gpr .r1 = b ++ b ++ b ++ b → + s.gpr .r4 = y → y.toNat + o + 4 * n ≤ 2 ^ 32 → + (∀ k < n, InRegions s.wr (State.addr y + BitVec.ofNat 64 (o + 4 * k)) 4) → + (∀ s', s'.gpr = s.gpr → s'.rd = s.rd → s'.wr = s.wr → s'.sp = s.sp → + s'.mem = writeBytes s.mem (State.addr y + BitVec.ofNat 64 o) (List.replicate (4 * n) b) → + WP isa (.block rest) s' Q) → + WP isa (.block ((List.range n).map (fun k => Instr.str .r1 .r4 (o + 4 * k)) ++ rest)) s Q := by + induction n with + | zero => + intro rest s Q _ _ _ _ k + exact k s rfl rfl rfl rfl (by simp [writeBytes_nil]) + | succ n ih => + intro rest s Q hc hy fy hout k + rw [List.range_succ, List.map_append, List.map_singleton, List.append_assoc] + refine ih (by omega) _ s Q hc hy (by omega) (fun j hj => hout j (by omega)) fun s₁ g₁ rd₁ wr₁ sp₁ m₁ => ?_ + simp only [List.cons_append, List.nil_append] + refine wp_str (a := State.addr y + BitVec.ofNat 64 (o + 4 * n)) (by omega) + (by rw [g₁, hy, addr_add (by omega)]) (by rw [wr₁]; exact hout n (by omega)) fun s₂ u₂ => ?_ + refine k s₂ (by rw [u₂.gpr, g₁]) (by rw [u₂.rd, rd₁]) (by rw [u₂.wr, wr₁]) (by rw [u₂.sp, sp₁]) ?_ + rw [u₂.mem, m₁, g₁, hc, MdInit.writeW_rep, ← Memory.add_ofNat, + Memory.writeBytes_append' _ _ _ (by rw [List.length_replicate]) (by simp; omega), + List.replicate_append_replicate, show 4 * n + 4 = 4 * (n + 1) by omega] + +/-- The outer state's buffer, from the inner one's: `n` words of +`[r4 + N + 4 k]`, XORed with `r1 = 0x6a6a6a6a`, into `[r5 + N + 4 k]`. -/ +theorem opadW_ok (H : Hash) {x y : BitVec 32} (n : Nat) (ho : H.N + 4 * n ≤ 4096) : + ∀ (rest : List Instr) (s : State) (Q : State → Prop), s.gpr .r1 = 0x6a6a6a6a → s.gpr .r4 = x → + s.gpr .r5 = y → x.toNat + H.N + 4 * n ≤ 2 ^ 32 → y.toNat + H.N + 4 * n ≤ 2 ^ 32 → + (∀ k < n, InRegions (s.rd ++ s.wr) (State.addr x + BitVec.ofNat 64 (H.N + 4 * k)) 4) → + (∀ k < n, InRegions s.wr (State.addr y + BitVec.ofNat 64 (H.N + 4 * k)) 4) → + Region.Disjoint ⟨State.addr x + BitVec.ofNat 64 H.N, 4 * n⟩ ⟨State.addr y + BitVec.ofNat 64 H.N, 4 * n⟩ → + (∀ s', (∀ r, r ≠ .r12 → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → s'.sp = s.sp → + s'.mem = writeBytes s.mem (State.addr y + BitVec.ofNat 64 H.N) + ((bytesAt s.mem (State.addr x + BitVec.ofNat 64 H.N) (4 * n)).map (· ^^^ 0x6a)) → + WP isa (.block rest) s' Q) → + WP isa (.block ((List.range n).flatMap H.opadW ++ rest)) s Q := by + induction n with + | zero => + intro rest s Q _ _ _ _ _ _ _ _ k + exact k s (fun _ _ => rfl) rfl rfl rfl (by simp [bytesAt, writeBytes_nil]) + | succ n ih => + intro rest s Q h1 hx hy fx fy hin hout hsep k + rw [List.range_succ, List.flatMap_append, List.flatMap_singleton, List.append_assoc] + refine ih (by omega) _ s Q h1 hx hy (by omega) (by omega) (fun j hj => hin j (by omega)) + (fun j hj => hout j (by omega)) + ((hsep.sub_left (Region.sub_prefix (by omega))).sub_right (Region.sub_prefix (by omega))) + fun s₁ g₁ rd₁ wr₁ sp₁ m₁ => ?_ + simp only [Hash.opadW, List.cons_append, List.nil_append] + refine wp_ldr (a := State.addr x + BitVec.ofNat 64 (H.N + 4 * n)) (by omega) + (by rw [g₁ _ (by decide), hx, addr_add (by omega)]) (by rw [rd₁, wr₁]; exact hin n (by omega)) + fun s₂ u₂ => wp_eor (op2_reg _ _) fun s₃ u₃ => ?_ + refine wp_str (a := State.addr y + BitVec.ofNat 64 (H.N + 4 * n)) (by omega) + (by rw [u₃.other _ (by decide), u₂.other _ (by decide), g₁ _ (by decide), hy, addr_add (by omega)]) + (by rw [u₃.wr, u₂.wr, wr₁]; exact hout n (by omega)) fun s₄ u₄ => ?_ + refine k s₄ (fun r hr => by rw [u₄.gpr, u₃.other r hr, u₂.other r hr, g₁ r hr]) + (by rw [u₄.rd, u₃.rd, u₂.rd, rd₁]) (by rw [u₄.wr, u₃.wr, u₂.wr, wr₁]) (by rw [u₄.sp, u₃.sp, u₂.sp, sp₁]) ?_ + have hl : ((bytesAt s.mem (State.addr x + BitVec.ofNat 64 H.N) (4 * n)).map (· ^^^ (0x6a : Byte))).length = + 4 * n := by simp [bytesAt_length] + have f₁ : Frame [⟨State.addr y + BitVec.ofNat 64 H.N, 4 * n⟩] s.mem s₁.mem := by + rw [m₁]; exact writeBytes_frame _ _ _ (by rw [hl]; exact Region.contains_self _ _) + have dX : ∀ r ∈ [(⟨State.addr y + BitVec.ofNat 64 H.N, 4 * n⟩ : Region)], + Region.Disjoint ⟨State.addr x + BitVec.ofNat 64 H.N + BitVec.ofNat 64 (4 * n), 4⟩ r := by + simp only [List.mem_singleton]; rintro r rfl + exact (hsep.sub_left (Offset.sub_base _ (by omega))).sub_right (Region.sub_prefix (by omega)) + have v : s₃.gpr .r12 = s₁.mem.readW (State.addr x + BitVec.ofNat 64 (H.N + 4 * n)) 32 ^^^ 0x6a6a6a6a := by + rw [u₃.gpr, u₂.gpr, u₂.other _ (by decide), g₁ _ (by decide), h1] + rw [u₄.mem, v, u₃.mem, u₂.mem, ← Memory.add_ofNat, ← Memory.add_ofNat, + f₁.readW (r := ⟨_, 4⟩) (Region.contains_self _ _) dX (by decide), MdInit.c6a, MdInit.writeW_xorRep, m₁, + Memory.writeBytes_append' _ _ _ (by rw [hl]) (by simp [bytesAt_length]; omega), ← List.map_append, + ← bytesAt_add, show 4 * n + 4 = 4 * (n + 1) by omega] + +/-! ## The key loop -/ + +/-- After `j` bytes of the key loop, from `s`: the key at `kp`, its bytes, +XORed with `ipad`, written at `p + N`. -/ +structure KeyInv (s : State) (kp p : BitVec 32) (N kl j : Nat) (t : State) : Prop where + rd : t.rd = s.rd + wr : t.wr = s.wr + sp : t.sp = s.sp + other : ∀ r, r ≠ .r6 → r ≠ .r7 → r ≠ .r8 → r ≠ .r12 → t.gpr r = s.gpr r + r6 : t.gpr .r6 = kp + BitVec.ofNat 32 j + r8 : t.gpr .r8 = p + BitVec.ofNat 32 j + r7 : t.gpr .r7 = BitVec.ofNat 32 (kl - j) + mem : t.mem = writeBytes s.mem (State.addr p + BitVec.ofNat 64 N) + ((bytesAt s.mem (State.addr kp) j).map (· ^^^ Spec.Hmac.ipad)) + +theorem key_step (H : Hash) {s : State} {kp p : BitVec 32} {kl : Nat} (hkp : kp.toNat + kl ≤ 2 ^ 32) + (hp : p.toNat + H.N + kl ≤ 2 ^ 32) (hkl : kl < 2 ^ 32) (hN : H.N < 4096) + (hin : ∀ j < kl, InRegions (s.rd ++ s.wr) (State.addr kp + BitVec.ofNat 64 j) 1) + (hout : ∀ j < kl, InRegions s.wr (State.addr p + BitVec.ofNat 64 H.N + BitVec.ofNat 64 j) 1) + (hsep : Region.Disjoint ⟨State.addr kp, kl⟩ ⟨State.addr p + BitVec.ofNat 64 H.N, kl⟩) {j : Nat} (hj : j < kl) + {t : State} (h : KeyInv s kp p H.N kl j t) : + WP isa (.block [.ldrb .r12 .r6 0, .dp .eor .r12 .r12 (.imm 0x36), .strb .r12 .r8 H.N, + .dp .add .r6 .r6 (.imm 1), .dp .add .r8 .r8 (.imm 1), .subs .r7 .r7 (.imm 1)]) t + fun t' => KeyInv s kp p H.N kl (j + 1) t' ∧ t'.z = decide (kl - (j + 1) = 0) := by + have hl : ((bytesAt s.mem (State.addr kp) j).map (· ^^^ Spec.Hmac.ipad)).length = j := by + simp [bytesAt_length] + have hbyte : t.mem (State.addr kp + BitVec.ofNat 64 j) = s.mem (State.addr kp + BitVec.ofNat 64 j) := by + rw [h.mem] + refine (writeBytes_frame _ _ _ (by rw [hl]; exact Region.contains_self _ _)).bytes + (R := ⟨State.addr kp, kl⟩) (by + simp only [List.mem_singleton]; rintro r rfl + exact hsep.sub_right (Region.sub_prefix (by omega))) (by show kl ≤ 2 ^ 64; omega) hj + refine wp_ldrb (a := State.addr kp + BitVec.ofNat 64 j) (by decide) + (by rw [h.r6, addr3 (by omega), BitVec.add_zero]) (by rw [h.rd, h.wr]; exact hin j hj) + fun t₁ u₁ => wp_eor (op2_imm (by decide)) fun t₂ u₂ => ?_ + refine wp_strb (a := State.addr p + BitVec.ofNat 64 H.N + BitVec.ofNat 64 j) hN + (by rw [u₂.other _ (by decide), u₁.other _ (by decide), h.r8, addr3 (by omega)]) + (by rw [u₂.wr, u₁.wr, h.wr]; exact hout j hj) fun t₃ u₃ => ?_ + refine wp_add (op2_imm (by decide)) fun t₄ u₄ => wp_add (op2_imm (by decide)) fun t₅ u₅ => + wp_subs (op2_imm (by decide)) fun t₆ u₆ z₆ => WP.block_nil ?_ + have r7₅ : t₅.gpr .r7 = BitVec.ofNat 32 (kl - j) := by + rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), + h.r7] + have v : (t₂.gpr .r12).setWidth 8 = s.mem (State.addr kp + BitVec.ofNat 64 j) ^^^ Spec.Hmac.ipad := by + rw [u₂.gpr, u₁.gpr, MdInit.xor_byte, hbyte]; rfl + refine ⟨⟨by rw [u₆.rd, u₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], + by rw [u₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], by rw [u₆.sp, u₅.sp, u₄.sp, u₃.sp, u₂.sp, u₁.sp, h.sp], + fun r h6 h7 h8 h12 => by + rw [u₆.other r h7, u₅.other r h8, u₄.other r h6, u₃.gpr, u₂.other r h12, u₁.other r h12, + h.other r h6 h7 h8 h12], + by rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, u₃.gpr, u₂.other _ (by decide), + u₁.other _ (by decide), h.r6, BitVec.add_assoc, Proof.Pbkdf2.Stream.Arm.ofNat_succ32], + by rw [u₆.other _ (by decide), u₅.gpr, u₄.other _ (by decide), u₃.gpr, u₂.other _ (by decide), + u₁.other _ (by decide), h.r8, BitVec.add_assoc, Proof.Pbkdf2.Stream.Arm.ofNat_succ32], + by rw [u₆.gpr, r7₅, left_val hj], ?_⟩, ?_⟩ + · rw [u₆.mem, u₅.mem, u₄.mem, u₃.mem, v, u₂.mem, u₁.mem, h.mem] + have e := VG.Proof.Hmac.Generic.Common.writeBytes_snoc s.mem (State.addr p + BitVec.ofNat 64 H.N) + ((bytesAt s.mem (State.addr kp) j).map (· ^^^ Spec.Hmac.ipad)) + (s.mem (State.addr kp + BitVec.ofNat 64 j) ^^^ Spec.Hmac.ipad) (by rw [hl]; omega) + rw [hl] at e + rw [e, VG.Proof.Hmac.Generic.Common.bytesAt_snoc', List.map_append, List.map_singleton] + · rw [z₆, r7₅, left_z hj hkl] + +/-- The key loop, skipped for an empty key: from the flags of `kl = 0`. -/ +theorem key_ok (H : Hash) {s : State} {kp p : BitVec 32} {kl : Nat} (hkp : kp.toNat + kl ≤ 2 ^ 32) + (hp : p.toNat + H.N + kl ≤ 2 ^ 32) (hkl : kl < 2 ^ 32) (hN : H.N < 4096) + (hin : ∀ j < kl, InRegions (s.rd ++ s.wr) (State.addr kp + BitVec.ofNat 64 j) 1) + (hout : ∀ j < kl, InRegions s.wr (State.addr p + BitVec.ofNat 64 H.N + BitVec.ofNat 64 j) 1) + (hsep : Region.Disjoint ⟨State.addr kp, kl⟩ ⟨State.addr p + BitVec.ofNat 64 H.N, kl⟩) + (h0 : KeyInv s kp p H.N kl 0 s) (hz : s.z = decide (kl = 0)) : + WP isa (.ite .eq (.block []) H.keyLoop) s (KeyInv s kp p H.N kl kl) := by + refine WP.ite (decide (kl = 0)) (by show eval .eq s = _; rw [eval_eq, hz]) (fun e => WP.block_nil ?_) + fun e => ?_ + · have : kl = 0 := by simpa using e + subst this; exact h0 + · exact count_loop (by simp at e; omega) _ (fun j hj t h => key_step H hkp hp hkl hN hin hout hsep hj h) h0 + +end VG.Proof.Pbkdf2.Md.Arm + +namespace VG.Proof.Pbkdf2.Md.Arm.HmacInit + +open VG VG.Arm +open VG.Impl.Pbkdf2.Md.Arm (Hash) +open VG.Proof.Pbkdf2.Md.Arm +open VG.Proof.MdStream (Md) +open VG.Proof.Pbkdf2.Stream.Arm (initG below SavedRegs saveR savedRegs preserved_saved After below_eq covers_one + init_call save_ok restore_ok) +open VG.Proof.MdStream.Arm (Upd Fupd wp_mov wp_add wp_cmp wp_ldrSp op2_imm op2_reg cmp0) +open VG.Proof.Hmac.Common (bytesAt_length xorPad_length) +open VG.Proof.Hmac.Generic.Common (bytesAt_writeBytes_self') +open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil writeBytes_frame) +open VG.Spec.Sha256 (bytesAt) +open VG.Spec.Hmac (xorPad ipad opad blockKey) + +/-! ## The precondition -/ + +section +variable (s₀ : State) + +abbrev inn : BitVec 32 := s₀.gpr .r0 +abbrev out : BitVec 32 := s₀.gpr .r1 +abbrev kp : BitVec 32 := s₀.gpr .r2 +abbrev kl : Nat := (s₀.gpr .r3).toNat +abbrev scr : BitVec 32 := stackArg s₀ 0 +abbrev keyR : Region := ⟨State.addr (kp s₀), kl s₀⟩ +abbrev argR : Region := ⟨stackArgAddr s₀ 0, 4⟩ + +end + +section +variable (H : Hash) (sc : Nat) (s₀ : State) + +abbrev inR : Region := ⟨State.addr (inn s₀), H.N + H.B⟩ +abbrev outR : Region := ⟨State.addr (out s₀), H.N + H.B⟩ +abbrev scR : Region := ⟨State.addr (scr s₀), 8 * sc⟩ +/-- The compression function's scratch space. -/ +abbrev cmpR : Region := ⟨State.addr (scr s₀), H.so⟩ + +end + +structure Pre (H : Hash) (sc : Nat) (s₀ : State) : Prop where + kl_le : kl s₀ ≤ H.B + rd : s₀.rd = [keyR s₀, argR s₀] + wr : s₀.wr = [inR H s₀, outR H s₀, scR sc s₀] + i_o : (inR H s₀).Disjoint (outR H s₀) + i_s : (inR H s₀).Disjoint (scR sc s₀) + o_s : (outR H s₀).Disjoint (scR sc s₀) + k_i : (keyR s₀).Disjoint (inR H s₀) + k_o : (keyR s₀).Disjoint (outR H s₀) + k_s : (keyR s₀).Disjoint (scR sc s₀) + a_i : (argR s₀).Disjoint (inR H s₀) + a_o : (argR s₀).Disjoint (outR H s₀) + a_s : (argR s₀).Disjoint (scR sc s₀) + b_i : (below s₀).Disjoint (inR H s₀) + b_o : (below s₀).Disjoint (outR H s₀) + b_k : (below s₀).Disjoint (keyR s₀) + b_s : (below s₀).Disjoint (scR sc s₀) + ni : (inn s₀).toNat + (H.N + H.B) ≤ 2 ^ 32 + no : (out s₀).toNat + (H.N + H.B) ≤ 2 ^ 32 + nk : (kp s₀).toNat + kl s₀ ≤ 2 ^ 32 + nw : (scr s₀).toNat + 8 * sc ≤ 2 ^ 32 + sp16 : 16 ≤ s₀.sp.toNat + spf : s₀.sp.toNat + 4 ≤ 2 ^ 32 + fits : H.st.buf ≤ 8 * sc + +theorem pre_of {H : Hash} (hH : HashOK H) {sc : Nat} {s₀ : State} (h : (initG hH.SH sc).pre s₀) + (hfit : H.st.buf ≤ 8 * sc) : Pre H sc s₀ := by + obtain ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, h21⟩ := h + have hS : hH.SH.stateBytes = H.N + H.B := hH.hS + have hB := hH.hB + simp only [hS, hB] at * + exact ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, h21, hfit⟩ + +/-! ## Sizes and regions -/ + +section +variable {H : Hash} (hz : Sizes H) {sc : Nat} {s₀ : State} (hp : Pre H sc s₀) +include hz hp + +theorem bounds : H.st.buf = 8 * H.st.W + 36 ∧ 8 * H.st.W + 36 ≤ 8 * sc ∧ (scr s₀).toNat + 8 * sc ≤ 2 ^ 32 ∧ + H.so ≤ 8 * H.st.W ∧ H.st.W ≤ 64 ∧ H.N ≤ 64 ∧ H.N % 4 = 0 ∧ H.B % 4 = 0 ∧ 64 ≤ H.B ∧ H.B ≤ 128 ∧ + (inn s₀).toNat + (H.N + H.B) ≤ 2 ^ 32 ∧ (out s₀).toNat + (H.N + H.B) ≤ 2 ^ 32 ∧ + (kp s₀).toNat + kl s₀ ≤ 2 ^ 32 ∧ kl s₀ ≤ H.B := by + have hB : H.B % 4 = 0 ∧ 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> rw [h] <;> decide + exact ⟨rfl, hp.fits, hp.nw, hz.so, hz.W, hz.N64, hz.N4, hB.1, hB.2.1, hB.2.2, hp.ni, hp.no, hp.nk, hp.kl_le⟩ + +theorem save_sub : Region.Sub (saveR H.st (scr s₀)) (scR sc s₀) := by + have := bounds hz hp; exact Offset.sub_base _ (by omega) + +theorem cmp_sub : Region.Sub (cmpR H s₀) (scR sc s₀) := by + have := bounds hz hp; exact Region.sub_prefix (by omega) + +theorem save_cmp : (saveR H.st (scr s₀)).Disjoint (cmpR H s₀) := by + have := bounds hz hp + exact Offset.disjoint_base _ (by omega) (by omega) + +omit hz hp in +/-- A part of a state at `p`. -/ +theorem st_sub (p : BitVec 32) {a n : Nat} (h : a + n ≤ H.N + H.B) : + Region.Sub ⟨State.addr p + BitVec.ofNat 64 a, n⟩ ⟨State.addr p, H.N + H.B⟩ := Offset.sub_base _ h + +/-- The states, `scratch` and the stack below the stack pointer, as the code sees them. -/ +theorem st_facts {p : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) : + Region.Disjoint ⟨State.addr p, H.N + H.B⟩ (scR sc s₀) ∧ (below s₀).Disjoint ⟨State.addr p, H.N + H.B⟩ ∧ + (saveR H.st (scr s₀)).Disjoint ⟨State.addr p, H.N + H.B⟩ ∧ p.toNat + (H.N + H.B) ≤ 2 ^ 32 ∧ + ⟨State.addr p, H.N + H.B⟩ ∈ s₀.wr := by + rcases hpR with rfl | rfl + · exact ⟨hp.i_s, hp.b_i, hp.i_s.symm.sub_left (save_sub hz hp), hp.ni, by rw [hp.wr]; simp⟩ + · exact ⟨hp.o_s, hp.b_o, hp.o_s.symm.sub_left (save_sub hz hp), hp.no, by rw [hp.wr]; simp⟩ + +end + +/-! ## What the pieces keep -/ + +/-- The regions everything writes: our buffers and the stack below the stack pointer. -/ +abbrev wrs (H : Hash) (sc : Nat) (s₀ : State) : List Region := [inR H s₀, outR H s₀, scR sc s₀, below s₀] + +/-- The registers and memory kept from the prologue on. -/ +structure KR (H : Hash) (sc : Nat) (s₀ s : State) : Prop where + rd : s.rd = s₀.rd + wr : s.wr = s₀.wr + sp : s.sp = s₀.sp + r4 : s.gpr .r4 = inn s₀ + r5 : s.gpr .r5 = out s₀ + r11 : s.gpr .r11 = scr s₀ + saved : SavedRegs H.st (scr s₀) s₀ s.mem + frame : Frame (wrs H sc s₀) s₀.mem s.mem + +/-- The registers `KR` fixes. -/ +abbrev kregs : List Reg := [.r4, .r5, .r11] + +theorem kregs_pres : ∀ r ∈ kregs, r ∈ preserved ∧ r ≠ .lr := by decide + +section +variable {H : Hash} {sc : Nat} {s₀ : State} + +theorem KR.keep {s s' : State} (h : KR H sc s₀ s) (hrd : s'.rd = s.rd) (hwr : s'.wr = s.wr) + (hsp : s'.sp = s.sp) (hg : ∀ r ∈ kregs, s'.gpr r = s.gpr r) {rs : List Region} + (hf : Frame rs s.mem s'.mem) (hs : ∀ r ∈ rs, (saveR H.st (scr s₀)).Disjoint r) + (hsub : ∀ r ∈ rs, ∃ r' ∈ wrs H sc s₀, Region.Sub r r') : KR H sc s₀ s' := + ⟨hrd.trans h.rd, hwr.trans h.wr, hsp.trans h.sp, (hg _ (by simp)).trans h.r4, + (hg _ (by simp)).trans h.r5, (hg _ (by simp)).trans h.r11, h.saved.frame H.st hf hs, + h.frame.trans (hf.sub hsub)⟩ + +theorem KR.upd {s s' : State} (h : KR H sc s₀ s) {d : Reg} (hd : d ∉ kregs) {v : BitVec 32} + (u : Upd s s' d v) : KR H sc s₀ s' := + h.keep u.rd u.wr u.sp (fun r hr => u.other r fun e => hd (e ▸ hr)) (rs := []) + (by rw [u.mem]; exact Frame.refl _ _) (by simp) (by simp) + +/-- The key, while `KR` holds. -/ +theorem KR.key {s : State} (hp : Pre H sc s₀) (hk : KR H sc s₀ s) : + bytesAt s.mem (State.addr (kp s₀)) (kl s₀) = bytesAt s₀.mem (State.addr (kp s₀)) (kl s₀) := + Memory.frame_bytesAt hk.frame (by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl | rfl) + · exact hp.k_i + · exact hp.k_o + · exact hp.k_s + · exact hp.b_k.symm) (Nat.le_of_lt (Nat.lt_trans (s₀.gpr .r3).isLt (by decide))) + +end + +/-! ## The pieces -/ + +/-- The offsets of the buffers in a state can be added as immediates. -/ +theorem enc_small : ∀ n < 65, encodable (BitVec.ofNat 32 n) = true := by decide + +section +variable {H : Hash} (hz : Sizes H) {sc : Nat} {s₀ : State} (hp : Pre H sc s₀) +include hz hp + +theorem pro_ok : WP isa (.block H.initPrologue) s₀ fun s => KR H sc s₀ s ∧ s.gpr .r6 = kp s₀ ∧ + s.gpr .r7 = BitVec.ofNat 32 (kl s₀) := by + obtain ⟨hb, hf, nw, -, hW, -⟩ := bounds hz hp + have hsc : scR sc s₀ ∈ s₀.wr := by rw [hp.wr]; simp + unfold Hash.initPrologue + simp only [List.singleton_append] + refine wp_ldrSp (a := stackArgAddr s₀ 0) (by decide) rfl + (by rw [hp.rd]; exact ⟨argR s₀, by simp, Region.contains_self _ _⟩) fun s₁ u₁ => ?_ + refine save_ok H.st (scr := scr s₀) u₁.gpr hW (by rw [u₁.wr]; exact hsc) (L := 8 * sc) (by omega) nw + fun s₂ g₂ rd₂ wr₂ sp₂ f₂ sv₂ => ?_ + refine wp_mov (op2_reg _ _) fun s₃ u₃ => wp_mov (op2_reg _ _) fun s₄ u₄ => wp_mov (op2_reg _ _) fun s₅ u₅ => + wp_mov (op2_reg _ _) fun s₆ u₆ => wp_mov (op2_reg _ _) fun s₇ u₇ => WP.block_nil ?_ + have e₂ : ∀ r, r ≠ .r12 → s₂.gpr r = s₀.gpr r := fun r hr => by rw [g₂, u₁.other r hr] + have hm : s₇.mem = s₂.mem := by rw [u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem] + have f₂' : Frame [saveR H.st (scr s₀)] s₀.mem s₂.mem := by rw [← u₁.mem]; exact f₂ + refine ⟨⟨by rw [u₇.rd, u₆.rd, u₅.rd, u₄.rd, u₃.rd, rd₂, u₁.rd], by rw [u₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, wr₂, u₁.wr], + by rw [u₇.sp, u₆.sp, u₅.sp, u₄.sp, u₃.sp, sp₂, u₁.sp], + by rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, + e₂ _ (by decide)], + by rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, u₃.other _ (by decide), + e₂ _ (by decide)], + by rw [u₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), + g₂, u₁.gpr]; rfl, + hm ▸ sv₂.of_eq H.st fun r hr => u₁.other r (by + simp only [savedRegs, List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> decide), + hm ▸ f₂'.sub fun r hr => by + simp only [List.mem_singleton] at hr; subst hr + exact ⟨scR sc s₀, by simp, save_sub hz hp⟩⟩, + by rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.gpr, u₄.other _ (by decide), u₃.other _ (by decide), + e₂ _ (by decide)], + by rw [u₇.other _ (by decide), u₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), + e₂ _ (by decide), BitVec.ofNat_toNat, BitVec.setWidth_eq]⟩ + +/-- A call of the streaming `init` on the state at `p`, in `r0`. -/ +theorem initCall_ok (hH : HashOK H) {t : State} (hk : KR H sc s₀ t) {p : BitVec 32} + (hpR : p = inn s₀ ∨ p = out s₀) (h0 : t.gpr .r0 = p) {Q : State → Prop} + (hQ : ∀ s', KR H sc s₀ s' → (∀ r ∈ [Reg.r6, .r7], s'.gpr r = t.gpr r) → + Frame [⟨State.addr p, H.N + H.B⟩, below s₀] t.mem s'.mem → hH.SH.Repr s'.mem (State.addr p) [] → Q s') : + WP isa (.call H.st.initN H.st.initC) t Q := by + obtain ⟨_, _, dV, np, hin⟩ := st_facts hz hp hpR + have hS : H.st.S = H.N + H.B := hz.S + refine init_call hH.stream (st := p) h0 (by rw [hS]; exact np) (by rw [hk.wr, hS]; exact covers_one hin) + fun s' ha hr => ?_ + rw [hS] at ha + have f := ha.frame + rw [below_eq hk.sp] at f + have f' : Frame [⟨State.addr p, H.N + H.B⟩, below s₀] t.mem s'.mem := f + refine hQ s' (hk.keep ha.rd ha.wr ha.sp (fun r hr => ha.cs r (kregs_pres r hr).1 (kregs_pres r hr).2) f' ?_ ?_) + (fun r hr => ?_) f' hr + · simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · exact dV + · exact hp.b_s.symm.sub_left (save_sub hz hp) + · simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · rcases hpR with rfl | rfl + · exact ⟨inR H s₀, by simp, fun _ h => h⟩ + · exact ⟨outR H s₀, by simp, fun _ h => h⟩ + · exact ⟨below s₀, by simp, fun _ h => h⟩ + · simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl + · exact ha.cs .r6 (by decide) (by decide) + · exact ha.cs .r7 (by decide) (by decide) + +omit hz hp in +/-- `r0` at the state in `st`. -/ +theorem initArg_ok {s : State} (hk : KR H sc s₀ s) {st : Reg} {p : BitVec 32} + (hst : st = .r4 ∧ p = inn s₀ ∨ st = .r5 ∧ p = out s₀) : + WP isa (.block [.mov .r0 (.reg st)]) s fun t => KR H sc s₀ t ∧ t.gpr .r0 = p ∧ + (∀ r ∈ [Reg.r6, .r7], t.gpr r = s.gpr r) ∧ t.mem = s.mem := + wp_mov (op2_reg _ _) fun _ u₁ => WP.block_nil ⟨hk.upd (by rcases hst with ⟨rfl, _⟩ | ⟨rfl, _⟩ <;> decide) u₁, + by rw [u₁.gpr]; rcases hst with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩; exacts [hk.r4, hk.r5], + fun r hr => u₁.other r (by simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl <;> decide), u₁.mem⟩ + +/-- A call of the streaming `init` on the state at `p`, in `st`. -/ +theorem callInit_ok (hH : HashOK H) {s : State} (hk : KR H sc s₀ s) {st : Reg} {p : BitVec 32} + (hst : st = .r4 ∧ p = inn s₀ ∨ st = .r5 ∧ p = out s₀) {Q : State → Prop} + (hQ : ∀ s', KR H sc s₀ s' → (∀ r ∈ [Reg.r6, .r7], s'.gpr r = s.gpr r) → + Frame [⟨State.addr p, H.N + H.B⟩, below s₀] s.mem s'.mem → hH.SH.Repr s'.mem (State.addr p) [] → Q s') : + WP isa (H.st.callInit st) s Q := by + have hpR : p = inn s₀ ∨ p = out s₀ := by rcases hst with ⟨_, h⟩ | ⟨_, h⟩ <;> simp [h] + unfold Impl.Pbkdf2.Stream.Arm.Hash.callInit + exact WP.seq (WP.mono (initArg_ok hk hst) fun t ⟨k, d, g, m⟩ => + initCall_ok hz hp hH k hpR d fun s' k' g' f r => hQ s' k' (fun r hr => (g' r hr).trans (g r hr)) (m ▸ f) r) + +/-- A word of the buffer of the state at `p`. -/ +theorem buf_word {p : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) {k : Nat} (hk : k < H.B / 4) : + InRegions s₀.wr (State.addr p + BitVec.ofNat 64 (H.N + 4 * k)) 4 := by + obtain ⟨-, -, -, -, -, hN, -, hB4, -⟩ := bounds hz hp + obtain ⟨-, -, -, np, hin⟩ := st_facts hz hp hpR + exact ⟨_, hin, Offset.contains_base _ (by omega) (by omega)⟩ + +/-- `ipad` in every byte of the inner buffer, and the flags of `key_len = 0`. -/ +theorem fill_ok {s : State} (hk : KR H sc s₀ s) (h6 : s.gpr .r6 = kp s₀) + (h7 : s.gpr .r7 = BitVec.ofNat 32 (kl s₀)) : + WP isa (.block H.fillIpad) s fun t => KR H sc s₀ t ∧ t.gpr .r6 = kp s₀ ∧ + t.gpr .r7 = BitVec.ofNat 32 (kl s₀) ∧ t.gpr .r8 = inn s₀ ∧ t.z = decide (kl s₀ = 0) ∧ + t.mem = writeBytes s.mem (State.addr (inn s₀) + BitVec.ofNat 64 H.N) (List.replicate H.B 0x36) := by + obtain ⟨-, -, -, -, -, hN, -, hB4, hB64, hB, ni, -⟩ := bounds hz hp + have h4 : 4 * (H.B / 4) = H.B := by omega + simp only [Hash.fillIpad, List.cons_append, List.append_assoc] + refine wp_movw fun s₁ u₁ => wp_movt fun s₂ u₂ => ?_ + have c₂ : s₂.gpr .r1 = (0x36 : Byte) ++ (0x36 : Byte) ++ (0x36 : Byte) ++ (0x36 : Byte) := by + rw [u₂.gpr, u₁.gpr]; decide + have hr4 : s₂.gpr .r4 = inn s₀ := by rw [u₂.other _ (by decide), u₁.other _ (by decide), hk.r4] + refine fillW_ok (H.B / 4) (by omega) _ s₂ _ c₂ hr4 (by omega) + (fun j hj => by rw [u₂.wr, u₁.wr, hk.wr]; exact buf_word hz hp (.inl rfl) hj) fun s₃ g₃ rd₃ wr₃ sp₃ m₃ => ?_ + rw [h4] at m₃ + refine wp_mov (op2_reg _ _) fun s₄ u₄ => wp_cmp (op2_imm (by decide)) fun s₅ f₅ z₅ => WP.block_nil ?_ + have g : ∀ r, r ≠ .r1 → r ≠ .r8 → s₅.gpr r = s.gpr r := fun r h1 h8 => by + rw [f₅.gpr, u₄.other r h8, g₃, u₂.other r h1, u₁.other r h1] + have sB := st_sub (H := H) (inn s₀) (a := H.N) (n := H.B) (by omega) + have f : Frame [⟨State.addr (inn s₀) + BitVec.ofNat 64 H.N, H.B⟩] s.mem s₅.mem := by + rw [f₅.mem, u₄.mem, m₃, u₂.mem, u₁.mem] + exact writeBytes_frame _ _ _ (by simp only [List.length_replicate]; exact Region.contains_self _ _) + refine ⟨hk.keep (by rw [f₅.rd, u₄.rd, rd₃, u₂.rd, u₁.rd]) (by rw [f₅.wr, u₄.wr, wr₃, u₂.wr, u₁.wr]) + (by rw [f₅.sp, u₄.sp, sp₃, u₂.sp, u₁.sp]) (fun r hr => g r (by revert hr; decide +revert) + (by revert hr; decide +revert)) f + (by + simp only [List.mem_singleton]; rintro r rfl + exact (hp.i_s.symm.sub_left (save_sub hz hp)).sub_right sB) + (by simp only [List.mem_singleton]; rintro r rfl; exact ⟨_, by simp, sB⟩), + by rw [g _ (by decide) (by decide), h6], by rw [g _ (by decide) (by decide), h7], + by rw [f₅.gpr, u₄.gpr, g₃, hr4], ?_, by rw [f₅.mem, u₄.mem, m₃, u₂.mem, u₁.mem]⟩ + rw [z₅, u₄.other _ (by decide), g₃, u₂.other _ (by decide), u₁.other _ (by decide), h7, + cmp0 (s₀.gpr .r3).isLt] + +/-- The key loop: the key XORed with `ipad` over the start of the inner buffer. -/ +theorem keys_ok {s : State} (hk : KR H sc s₀ s) (h6 : s.gpr .r6 = kp s₀) (h7 : s.gpr .r7 = BitVec.ofNat 32 (kl s₀)) + (h8 : s.gpr .r8 = inn s₀) (hzf : s.z = decide (kl s₀ = 0)) + (hm : bytesAt s.mem (State.addr (inn s₀) + BitVec.ofNat 64 H.N) H.B = List.replicate H.B 0x36) : + WP isa (.ite .eq (.block []) H.keyLoop) s fun t => KR H sc s₀ t ∧ + Frame [⟨State.addr (inn s₀) + BitVec.ofNat 64 H.N, H.B⟩] s.mem t.mem ∧ + bytesAt t.mem (State.addr (inn s₀) + BitVec.ofNat 64 H.N) H.B = + (bytesAt s₀.mem (State.addr (kp s₀)) (kl s₀)).map (· ^^^ ipad) ++ List.replicate (H.B - kl s₀) ipad := by + obtain ⟨-, -, -, -, -, hN, -, -, hB64, hB, ni, -, nk, hkl⟩ := bounds hz hp + have kl32 : kl s₀ < 2 ^ 32 := (s₀.gpr .r3).isLt + have hin : ∀ j < kl s₀, InRegions (s.rd ++ s.wr) (State.addr (kp s₀) + BitVec.ofNat 64 j) 1 := fun j hj => by + rw [hk.rd, hp.rd]; exact ⟨keyR s₀, by simp, Offset.contains_base _ (by omega) (by omega)⟩ + have hout : ∀ j < kl s₀, InRegions s.wr (State.addr (inn s₀) + BitVec.ofNat 64 H.N + BitVec.ofNat 64 j) 1 := + fun j hj => by + rw [hk.wr, hp.wr, Memory.add_ofNat] + exact ⟨inR H s₀, by simp, Offset.contains_base _ (by omega) (by omega)⟩ + have hsep : Region.Disjoint ⟨State.addr (kp s₀), kl s₀⟩ ⟨State.addr (inn s₀) + BitVec.ofNat 64 H.N, kl s₀⟩ := + hp.k_i.sub_right (st_sub _ (by omega)) + have h0 : KeyInv s (kp s₀) (inn s₀) H.N (kl s₀) 0 s := + ⟨rfl, rfl, rfl, fun _ _ _ _ _ => rfl, by rw [h6]; exact (BitVec.add_zero _).symm, + by rw [h8]; exact (BitVec.add_zero _).symm, by rw [h7, Nat.sub_zero], + by rw [show bytesAt s.mem (State.addr (kp s₀)) 0 = [] from rfl, List.map_nil, writeBytes_nil]⟩ + refine WP.mono (key_ok H (by omega) (by omega) kl32 (by omega) hin hout hsep h0 hzf) fun t ht => ?_ + have hl : ((bytesAt s.mem (State.addr (kp s₀)) (kl s₀)).map (· ^^^ ipad)).length = kl s₀ := by + simp [bytesAt_length] + have sB := st_sub (H := H) (inn s₀) (a := H.N) (n := H.B) (by omega) + have ft : Frame [⟨State.addr (inn s₀) + BitVec.ofNat 64 H.N, H.B⟩] s.mem t.mem := by + rw [ht.mem]; exact writeBytes_frame _ _ _ (by rw [hl]; exact Memory.contains_base hkl) + refine ⟨hk.keep ht.rd ht.wr ht.sp (fun r hr => ht.other r (by revert hr; decide +revert) + (by revert hr; decide +revert) (by revert hr; decide +revert) (by revert hr; decide +revert)) ft + (by + simp only [List.mem_singleton]; rintro r rfl + exact (hp.i_s.symm.sub_left (save_sub hz hp)).sub_right sB) + (by simp only [List.mem_singleton]; rintro r rfl; exact ⟨_, by simp, sB⟩), ft, ?_⟩ + rw [ht.mem, MdInit.bytes_over (by rw [hl]; omega) (by omega) hm, hl, hk.key hp] + rfl + +/-- What the compression of the buffer of the state at `p` needs. -/ +theorem callOk {s : State} (hk : KR H sc s₀ s) {p : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) + (h0 : s.gpr .r0 = p) (h3 : s.gpr .r3 = scr s₀) (h6 : s.gpr .r6 = p + BitVec.ofNat 32 H.N) : + CallOk s H.N H.B H.so p (scr s₀) (p + BitVec.ofNat 32 H.N) := by + obtain ⟨hb, hf, nw, hso, hW, hN, -, -, hB64, hB, -⟩ := bounds hz hp + obtain ⟨dS, _, _, np, hin⟩ := st_facts hz hp hpR + have ap : State.addr (p + BitVec.ofNat 32 H.N) = State.addr p + BitVec.ofNat 64 H.N := addr_add (by omega) + have tp : (p + BitVec.ofNat 32 H.N).toNat = p.toNat + H.N := by + rw [BitVec.toNat_add, BitVec.toNat_ofNat, Nat.mod_eq_of_lt (a := H.N) (by omega), Nat.mod_eq_of_lt (by omega)] + have sN : Region.Sub ⟨State.addr p, H.N⟩ ⟨State.addr p, H.N + H.B⟩ := Region.sub_prefix (by omega) + have sB := st_sub (H := H) p (a := H.N) (n := H.B) (by omega) + have sS : scR sc s₀ ∈ s.wr := by rw [hk.wr, hp.wr]; simp + have hin' : ⟨State.addr p, H.N + H.B⟩ ∈ s.wr := by rw [hk.wr]; exact hin + refine ⟨h0, h3, h6, by omega, by rw [tp]; omega, by omega, dS.sub_left sN |>.sub_right (cmp_sub hz hp), + by rw [ap]; exact Offset.disjoint_base _ (Nat.le_refl _) (by omega), + by rw [ap]; exact dS.sub_left sB |>.sub_right (cmp_sub hz hp), ?_, ?_⟩ + · refine Covers.of_sub fun r hr => ?_ + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl + · rw [ap]; exact ⟨_, List.mem_append_right _ hin', H.N, rfl, by simp only; omega⟩ + · exact ⟨_, List.mem_append_right _ hin', 0, (BitVec.add_zero _).symm, by simp only; omega⟩ + · exact ⟨_, List.mem_append_right _ sS, 0, (BitVec.add_zero _).symm, by simp only; omega⟩ + · refine Covers.of_sub fun r hr => ?_ + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl + · exact ⟨_, hin', 0, (BitVec.add_zero _).symm, by simp only; omega⟩ + · exact ⟨_, sS, 0, (BitVec.add_zero _).symm, by simp only; omega⟩ + +/-- The outer buffer from the inner one, and the inner state's compression set up. -/ +theorem opad_ok {s : State} (hk : KR H sc s₀ s) : + WP isa (.block H.fillOpad) s fun t => KR H sc s₀ t ∧ t.gpr .r0 = inn s₀ ∧ t.gpr .r3 = scr s₀ ∧ + t.gpr .r6 = inn s₀ + BitVec.ofNat 32 H.N ∧ + t.mem = writeBytes s.mem (State.addr (out s₀) + BitVec.ofNat 64 H.N) + ((bytesAt s.mem (State.addr (inn s₀) + BitVec.ofNat 64 H.N) H.B).map (· ^^^ 0x6a)) := by + obtain ⟨-, -, -, -, -, hN, -, hB4, hB64, hB, ni, no, -⟩ := bounds hz hp + have h4 : 4 * (H.B / 4) = H.B := by omega + have sBI := st_sub (H := H) (inn s₀) (a := H.N) (n := H.B) (by omega) + have sBO := st_sub (H := H) (out s₀) (a := H.N) (n := H.B) (by omega) + simp only [Hash.fillOpad, List.cons_append, List.append_assoc] + refine wp_movw fun s₁ u₁ => wp_movt fun s₂ u₂ => ?_ + have c₂ : s₂.gpr .r1 = 0x6a6a6a6a := by rw [u₂.gpr, u₁.gpr]; decide + refine opadW_ok H (H.B / 4) (by omega) _ s₂ _ c₂ (by rw [u₂.other _ (by decide), u₁.other _ (by decide), hk.r4]) + (by rw [u₂.other _ (by decide), u₁.other _ (by decide), hk.r5]) (by omega) (by omega) + (fun j hj => by rw [u₂.wr, u₂.rd, u₁.wr, u₁.rd, hk.wr, hk.rd] + exact Hmac.Generic.Common.InRegions.right' (buf_word hz hp (.inl rfl) hj)) + (fun j hj => by rw [u₂.wr, u₁.wr, hk.wr]; exact buf_word hz hp (.inr rfl) hj) + (by rw [h4]; exact (hp.i_o.sub_left sBI).sub_right sBO) fun s₃ g₃ rd₃ wr₃ sp₃ m₃ => ?_ + rw [h4, u₂.mem, u₁.mem] at m₃ + refine wp_mov (op2_reg _ _) fun s₄ u₄ => + wp_add (op2_imm (enc_small _ (by omega))) fun s₅ u₅ => wp_mov (op2_reg _ _) fun s₆ u₆ => WP.block_nil ?_ + have g : ∀ r, r ≠ .r1 → r ≠ .r12 → s₃.gpr r = s.gpr r := fun r h1 h12 => by + rw [g₃ r h12, u₂.other r h1, u₁.other r h1] + have hl : ((bytesAt s.mem (State.addr (inn s₀) + BitVec.ofNat 64 H.N) H.B).map (· ^^^ (0x6a : Byte))).length = + H.B := by simp [bytesAt_length] + have f : Frame [⟨State.addr (out s₀) + BitVec.ofNat 64 H.N, H.B⟩] s.mem s₆.mem := by + rw [u₆.mem, u₅.mem, u₄.mem, m₃]; exact writeBytes_frame _ _ _ (by rw [hl]; exact Region.contains_self _ _) + refine ⟨hk.keep (by rw [u₆.rd, u₅.rd, u₄.rd, rd₃, u₂.rd, u₁.rd]) (by rw [u₆.wr, u₅.wr, u₄.wr, wr₃, u₂.wr, u₁.wr]) + (by rw [u₆.sp, u₅.sp, u₄.sp, sp₃, u₂.sp, u₁.sp]) + (fun r hr => by + rw [u₆.other r (by revert hr; decide +revert), u₅.other r (by revert hr; decide +revert), + u₄.other r (by revert hr; decide +revert), g r (by revert hr; decide +revert) (by revert hr; decide +revert)]) + f + (by + simp only [List.mem_singleton]; rintro r rfl + exact (hp.o_s.symm.sub_left (save_sub hz hp)).sub_right sBO) + (by simp only [List.mem_singleton]; rintro r rfl; exact ⟨_, by simp, sBO⟩), + by rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, g _ (by decide) (by decide), hk.r4], + by rw [u₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), g _ (by decide) (by decide), hk.r11], + by rw [u₆.other _ (by decide), u₅.gpr, u₄.other _ (by decide), g _ (by decide) (by decide), hk.r4], + by rw [u₆.mem, u₅.mem, u₄.mem, m₃]⟩ + +/-- The two blocks, as the constant-time proof needs them. -/ +theorem blocks_ok {s : State} (hk : KR H sc s₀ s) (h6 : s.gpr .r6 = kp s₀) + (h7 : s.gpr .r7 = BitVec.ofNat 32 (kl s₀)) : + WP isa H.blocks s fun t => KR H sc s₀ t ∧ t.gpr .r0 = inn s₀ ∧ t.gpr .r3 = scr s₀ ∧ + t.gpr .r6 = inn s₀ + BitVec.ofNat 32 H.N := by + have := (bounds hz hp).2.2.2.2.2.2.2.2.2.1 + refine WP.seq (WP.mono (fill_ok hz hp hk h6 h7) fun s₄ ⟨k₄, d₄, c₄, e₄, z₄, m₄⟩ => ?_) + refine WP.seq (WP.mono (keys_ok hz hp k₄ d₄ c₄ e₄ z₄ (by + rw [m₄, bytesAt_writeBytes_self' (List.length_replicate ..) (by omega)])) fun s₅ ⟨k₅, _⟩ => ?_) + exact WP.mono (opad_ok hz hp k₅) fun _ ⟨k₆, a, b, c, _⟩ => ⟨k₆, a, b, c⟩ + +/-- The compression of the buffer of the state at `p`, at `r0`, with its +buffer at `r6` and `scratch` at `r3`. -/ +theorem cmpS_ok (hH : HashOK H) {s : State} (hk : KR H sc s₀ s) {p : BitVec 32} + (hpR : p = inn s₀ ∨ p = out s₀) (h0 : s.gpr .r0 = p) (h3 : s.gpr .r3 = scr s₀) + (h6 : s.gpr .r6 = p + BitVec.ofNat 32 H.N) {Q : State → Prop} + (hQ : ∀ s', KR H sc s₀ s' → s'.gpr .r3 = scr s₀ → + Frame [⟨State.addr p, H.N⟩, cmpR H s₀] s.mem s'.mem → + hH.md.stateAt s'.mem (State.addr p) = hH.md.compress (hH.md.stateAt s.mem (State.addr p)) + (hH.md.blockAt s.mem (State.addr p + BitVec.ofNat 64 H.N)) → Q s') : + WP isa H.compressBlock s Q := by + obtain ⟨hb, hf, nw, hso, hW, hN, -, -, hB64, hB, -⟩ := bounds hz hp + obtain ⟨_, _, dV, np, _⟩ := st_facts hz hp hpR + have sN : Region.Sub ⟨State.addr p, H.N⟩ ⟨State.addr p, H.N + H.B⟩ := Region.sub_prefix (by omega) + refine compressBlock_ok hH.comp (callOk hz hp hk hpR h0 h3 h6) fun s' hrd hwr hcs h0' h3' hsp hfr hst => ?_ + rw [addr_add (by omega)] at hst + refine hQ s' (hk.keep hrd hwr hsp (fun r hr => hcs r (kregs_pres r hr).1 (kregs_pres r hr).2) hfr ?_ ?_) h3' hfr hst + · simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · exact dV.sub_right sN + · exact save_cmp hz hp + · simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · rcases hpR with rfl | rfl + · exact ⟨inR H s₀, by simp, sN⟩ + · exact ⟨outR H s₀, by simp, sN⟩ + · exact ⟨scR sc s₀, by simp, cmp_sub hz hp⟩ + +omit hp in +/-- The outer state's compression set up. -/ +theorem toOuter_ok {s : State} (hk : KR H sc s₀ s) (h3 : s.gpr .r3 = scr s₀) : + WP isa (.block H.toOuter) s fun t => KR H sc s₀ t ∧ t.gpr .r0 = out s₀ ∧ t.gpr .r3 = scr s₀ ∧ + t.gpr .r6 = out s₀ + BitVec.ofNat 32 H.N ∧ t.mem = s.mem := by + have := hz.N64 + unfold Hash.toOuter + refine wp_mov (op2_reg _ _) fun s₁ u₁ => wp_add (op2_imm (enc_small _ (by omega))) fun s₂ u₂ => WP.block_nil ?_ + exact ⟨(hk.upd (by decide) u₁).upd (by decide) u₂, by rw [u₂.other _ (by decide), u₁.gpr, hk.r5], + by rw [u₂.other _ (by decide), u₁.other _ (by decide), h3], by rw [u₂.gpr, u₁.other _ (by decide), hk.r5], + by rw [u₂.mem, u₁.mem]⟩ + +end + +/-! ## Correctness -/ + +section +variable {H : Hash} {sc : Nat} {s₀ : State} (hH : HashOK H) (hp : Pre H sc s₀) +include hH hp + +omit hp in +theorem keep_st {rs : List Region} {m m' : Mem} (hf : Frame rs m m') {p : Addr} + (hd : ∀ r ∈ rs, Region.Disjoint ⟨p, H.N⟩ r) : hH.md.stateAt m' p = hH.md.stateAt m p := + hH.md.stateAt_congr fun i hi => hf.bytes (R := ⟨p, H.N⟩) hd (by have := hH.sizes.N64; show H.N ≤ 2 ^ 64; omega) hi + +omit hp in +theorem keep_repr {rs : List Region} {m m' : Mem} (hf : Frame rs m m') {p : Addr} + (hd : ∀ r ∈ rs, Region.Disjoint ⟨p, H.N + H.B⟩ r) {x : List Byte} (hr : hH.md.Repr hH.iv m p x) : + hH.md.Repr hH.iv m' p x := + hH.md.repr_congr (by have := hH.B_ge; omega) (fun i hi => hf.bytes (R := ⟨p, H.N + H.B⟩) hd + (by have := hH.B_le; have := hH.sizes.N64; show H.N + H.B ≤ 2 ^ 64; omega) hi) hr + +theorem correct : + WP isa H.hmacInit s₀ fun s' => abiPreserved s₀ s' ∧ (initG hH.SH sc).post s₀ s' := by + have hz := hH.sizes + obtain ⟨hb, hf, nw, hso, hW, hN, hN4, hB4, hB64, hB, ni, no, nk, hkl⟩ := bounds hz hp + have hl := hH.link + -- Where things are. + have sNI := st_sub (H := H) (inn s₀) (a := 0) (n := H.N) (by omega) + have sNO := st_sub (H := H) (out s₀) (a := 0) (n := H.N) (by omega) + rw [BitVec.add_zero] at sNI sNO + have sBI := st_sub (H := H) (inn s₀) (a := H.N) (n := H.B) (by omega) + have sBO := st_sub (H := H) (out s₀) (a := H.N) (n := H.B) (by omega) + have nb : ∀ (x : BitVec 32), Region.Disjoint ⟨State.addr x, H.N⟩ ⟨State.addr x + BitVec.ofNat 64 H.N, H.B⟩ := + fun _ => Offset.base_disjoint _ (Nat.le_refl _) (by omega) + have iv0 : ∀ {m : Mem} {p : Addr}, hH.SH.Repr m p [] → hH.md.stateAt m p = hH.iv := fun h => by + have := (hl.repr _ _ _ h).1 + rwa [List.length_nil, Nat.zero_div, Md.compressList_zero] at this + refine WP.seq (WP.mono (pro_ok hz hp) fun s₁ ⟨k₁, r6₁, r7₁⟩ => ?_) + refine WP.seq (callInit_ok hz hp hH k₁ (.inl ⟨rfl, rfl⟩) fun s₂ k₂ g₂ _ r₂ => ?_) + refine WP.seq (callInit_ok hz hp hH k₂ (.inr ⟨rfl, rfl⟩) fun s₃ k₃ g₃ f₃ r₃ => ?_) + have r6₃ : s₃.gpr .r6 = kp s₀ := by rw [g₃ _ (by simp), g₂ _ (by simp), r6₁] + have r7₃ : s₃.gpr .r7 = BitVec.ofNat 32 (kl s₀) := by rw [g₃ _ (by simp), g₂ _ (by simp), r7₁] + have vI₃ : hH.md.stateAt s₃.mem (State.addr (inn s₀)) = hH.iv := by + rw [keep_st hH f₃ (by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · exact hp.i_o.sub_left sNI + · exact hp.b_i.symm.sub_left sNI), iv0 r₂] + have vO₃ := iv0 r₃ + refine WP.seq (WP.seq (WP.mono (fill_ok hz hp k₃ r6₃ r7₃) fun s₄ ⟨k₄, d₄, c₄, e₄, z₄, m₄⟩ => ?_)) + have rep₄ : bytesAt s₄.mem (State.addr (inn s₀) + BitVec.ofNat 64 H.N) H.B = List.replicate H.B 0x36 := by + rw [m₄, bytesAt_writeBytes_self' (List.length_replicate ..) (by omega)] + have f₄ : Frame [⟨State.addr (inn s₀) + BitVec.ofNat 64 H.N, H.B⟩] s₃.mem s₄.mem := by + rw [m₄]; exact writeBytes_frame _ _ _ (by rw [List.length_replicate]; exact Region.contains_self _ _) + refine WP.seq (WP.mono (keys_ok hz hp k₄ d₄ c₄ e₄ z₄ rep₄) fun s₅ ⟨k₅, f₅, bI₅⟩ => ?_) + refine WP.mono (opad_ok hz hp k₅) fun s₆ ⟨k₆, a₆, b₆, c₆, m₆⟩ => ?_ + have hl6 : ((bytesAt s₅.mem (State.addr (inn s₀) + BitVec.ofNat 64 H.N) H.B).map (· ^^^ (0x6a : Byte))).length = + H.B := by simp [bytesAt_length] + have f₆ : Frame [⟨State.addr (out s₀) + BitVec.ofNat 64 H.N, H.B⟩] s₅.mem s₆.mem := by + rw [m₆]; exact writeBytes_frame _ _ _ (by rw [hl6]; exact Region.contains_self _ _) + have bO₆ : bytesAt s₆.mem (State.addr (out s₀) + BitVec.ofNat 64 H.N) H.B = + (bytesAt s₅.mem (State.addr (inn s₀) + BitVec.ofNat 64 H.N) H.B).map (· ^^^ 0x6a) := by + rw [m₆, bytesAt_writeBytes_self' hl6 (by omega)] + have bI₆ : bytesAt s₆.mem (State.addr (inn s₀) + BitVec.ofNat 64 H.N) H.B = + bytesAt s₅.mem (State.addr (inn s₀) + BitVec.ofNat 64 H.N) H.B := + Memory.frame_bytesAt f₆ (by + simp only [List.mem_singleton]; rintro r rfl; exact (hp.i_o.sub_left sBI).sub_right sBO) (by omega) + -- The hash values are those `init` left. + have vI₆ : hH.md.stateAt s₆.mem (State.addr (inn s₀)) = hH.iv := by + rw [keep_st hH f₆ (by + simp only [List.mem_singleton]; rintro r rfl; exact (hp.i_o.sub_left sNI).sub_right sBO), + keep_st hH f₅ (by simp only [List.mem_singleton]; rintro r rfl; exact nb _), + keep_st hH f₄ (by simp only [List.mem_singleton]; rintro r rfl; exact nb _), vI₃] + have vO₆ : hH.md.stateAt s₆.mem (State.addr (out s₀)) = hH.iv := by + rw [keep_st hH f₆ (by simp only [List.mem_singleton]; rintro r rfl; exact nb _), + keep_st hH f₅ (by + simp only [List.mem_singleton]; rintro r rfl; exact (hp.i_o.symm.sub_left sNO).sub_right sBI), + keep_st hH f₄ (by + simp only [List.mem_singleton]; rintro r rfl; exact (hp.i_o.symm.sub_left sNO).sub_right sBI), vO₃] + refine WP.seq (cmpS_ok hz hp hH k₆ (.inl rfl) a₆ b₆ c₆ fun s₇ k₇ r3₇ f₇ e₇ => ?_) + refine WP.seq (WP.mono (toOuter_ok hz k₇ r3₇) fun s₈ ⟨k₈, a₈, b₈, c₈, m₈⟩ => ?_) + refine WP.seq (cmpS_ok hz hp hH k₈ (.inr rfl) a₈ b₈ c₈ fun s₉ k₉ _ f₉ e₉ => ?_) + -- The key. + have hK : xorPad (blockKey hH.SH.H (bytesAt s₀.mem (State.addr (kp s₀)) (kl s₀))) ipad = + bytesAt s₅.mem (State.addr (inn s₀) + BitVec.ofNat 64 H.N) H.B := by + rw [bI₅, MdInit.blockKey_short _ (by rw [bytesAt_length, hH.hB]; exact hkl), MdInit.xorPad_short, + bytesAt_length, hH.hB] + have hKl : (xorPad (blockKey hH.SH.H (bytesAt s₀.mem (State.addr (kp s₀)) (kl s₀))) ipad).length = H.B := by + rw [hK, bytesAt_length] + -- The inner state. + have rI₇ := Md.repr_block (H := hH.md) (iv := hH.iv) (by omega) hKl (by rw [bI₆, hK]) (by rw [e₇, vI₆]) + have dI₉ : ∀ r ∈ [(⟨State.addr (out s₀), H.N⟩ : Region), cmpR H s₀], + Region.Disjoint ⟨State.addr (inn s₀), H.N + H.B⟩ r := by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · exact hp.i_o.sub_right sNO + · exact hp.i_s.sub_right (cmp_sub hz hp) + have rI₉ := keep_repr hH f₉ dI₉ (m₈ ▸ rI₇) + -- The outer state. + have d₇ : ∀ {a n : Nat}, a + n ≤ H.N + H.B → ∀ r ∈ [(⟨State.addr (inn s₀), H.N⟩ : Region), cmpR H s₀], + Region.Disjoint ⟨State.addr (out s₀) + BitVec.ofNat 64 a, n⟩ r := by + intro a n h + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · exact (hp.i_o.symm.sub_left (st_sub _ h)).sub_right sNI + · exact (hp.o_s.sub_left (st_sub _ h)).sub_right (cmp_sub hz hp) + have vO₈ : hH.md.stateAt s₈.mem (State.addr (out s₀)) = hH.iv := by + rw [m₈, keep_st hH f₇ (by have := d₇ (a := 0) (n := H.N) (by omega); rwa [BitVec.add_zero] at this), vO₆] + have bO₈ : bytesAt s₈.mem (State.addr (out s₀) + BitVec.ofNat 64 H.N) H.B = + xorPad (blockKey hH.SH.H (bytesAt s₀.mem (State.addr (kp s₀)) (kl s₀))) opad := by + rw [m₈, Memory.frame_bytesAt f₇ (d₇ (by omega)) (by omega), bO₆, ← hK, MdInit.xorPad_6a] + have rO₉ := Md.repr_block (H := hH.md) (iv := hH.iv) (by omega) + (by rw [xorPad_length, ← xorPad_length _ ipad, hKl]) bO₈ (by rw [e₉, vO₈]) + -- The end. + have hsc : ⟨State.addr (scr s₀), 8 * sc⟩ ∈ s₉.wr := by rw [k₉.wr, hp.wr]; simp + refine WP.mono (restore_ok H.st k₉.r11 hW k₉.saved hsc (by omega) nw) fun s' ⟨hm, _, _, hsp, hg, _⟩ => ?_ + refine ⟨⟨fun r hr => hg r (preserved_saved r hr), by rw [hsp, k₉.sp]⟩, ?_⟩ + show hH.SH.Repr s'.mem (State.addr (inn s₀)) _ ∧ hH.SH.Repr s'.mem (State.addr (out s₀)) _ + rw [hm] + exact ⟨hH.back _ _ _ rI₉, hH.back _ _ _ rO₉⟩ + +end + +end VG.Proof.Pbkdf2.Md.Arm.HmacInit diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInitCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInitCT.lean new file mode 100644 index 000000000..04fddc30e --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInitCT.lean @@ -0,0 +1,196 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.HmacInit +import VerifiedGarbage.Proof.Framework.Arm.ArgTaint + +/-! +# HMAC's `init` over a Merkle–Damgård hash function on ARMv7: constant time + +As `finalize` (`HmacFinCT.lean`): correctness determines our registers from +the public arguments alone, so the taint analysis proves the blocks between +the calls constant time from them (`Checks`, evaluated for each hash +function); the calls of the streaming `init` are constant time by its own +proof (`init_rel`, `Proof/Pbkdf2/Stream/Arm/Hash.lean`), and those of the +compression function by its own (`compressBlock_rel`). +-/ + +namespace VG.Proof.Pbkdf2.Md.Arm.HmacInit + +open VG VG.Arm +open VG.Impl.Pbkdf2.Md.Arm (Hash) +open VG.Proof.Pbkdf2.Md.Arm +open VG.Proof.Pbkdf2.Stream.Arm (initG init_rel covers_one) + +/-- The registers that the pieces between the calls use, which hold our +variables: `inner`, `outer`, the key and its length, and `scratch`. -/ +abbrev regsK : List Reg := [.r4, .r5, .r6, .r7, .r11] + +/-- The taint checks of the pieces of `init` between its calls, which +depend on the hash function's sizes. -/ +structure Checks (H : Hash) : Prop where + pro : ∃ hc, (taint.check (argTaint [.r0, .r1, .r2, .r3] 4) (.block H.initPrologue) hc).isSome = true + arg : ∀ st ∈ [Reg.r4, .r5], ∃ hc, (taint.check (Taint.ofRegs regsK) (.block [.mov .r0 (.reg st)]) hc).isSome = true + blocks : ∃ hc, (taint.check (Taint.ofRegs regsK) H.blocks hc).isSome = true + toOuter : ∃ hc, (taint.check (Taint.ofRegs kregs) (.block H.toOuter) hc).isSome = true + restore : ∃ hc, (taint.check (Taint.ofRegs kregs) (.block H.st.restore) hc).isSome = true + +/-- The public arguments are the same. -/ +structure PubEq (s₀ s₀' : State) : Prop where + sp : s₀.sp = s₀'.sp + r0 : s₀.gpr .r0 = s₀'.gpr .r0 + r1 : s₀.gpr .r1 = s₀'.gpr .r1 + r2 : s₀.gpr .r2 = s₀'.gpr .r2 + r3 : s₀.gpr .r3 = s₀'.gpr .r3 + a0 : stackArg s₀ 0 = stackArg s₀' 0 + +section +variable {H : Hash} {sc : Nat} {s₀ s₀' : State} + +theorem kr_agree (hq : PubEq s₀ s₀') {s s' : State} (h : KR H sc s₀ s) (h' : KR H sc s₀' s') : + ∀ r ∈ kregs, s.gpr r = s'.gpr r := by + intro r hr + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl + · rw [h.r4, h'.r4, inn, inn, hq.r0] + · rw [h.r5, h'.r5, out, out, hq.r1] + · rw [h.r11, h'.r11, scr, scr, hq.a0] + +/-- `KR`, with the key and its length in `r6` and `r7`. -/ +def KK (H : Hash) (sc : Nat) (s₀ s : State) : Prop := + KR H sc s₀ s ∧ s.gpr .r6 = kp s₀ ∧ s.gpr .r7 = BitVec.ofNat 32 (kl s₀) + +theorem kk_agree (hq : PubEq s₀ s₀') {s s' : State} (h : KK H sc s₀ s) (h' : KK H sc s₀' s') : + ∀ r ∈ regsK, s.gpr r = s'.gpr r := by + intro r hr + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl | rfl | rfl + · exact kr_agree hq h.1 h'.1 _ (by simp) + · exact kr_agree hq h.1 h'.1 _ (by simp) + · rw [h.2.1, h'.2.1, kp, kp, hq.r2] + · rw [h.2.2, h'.2.2, kl, kl, hq.r3] + · exact kr_agree hq h.1 h'.1 _ (by simp) + +end + +section +variable {H : Hash} (hH : HashOK H) {sc : Nat} {s₀ s₀' : State} (hp : Pre H sc s₀) (hp' : Pre H sc s₀') + (hq : PubEq s₀ s₀') +include hH hp hp' hq + +/-- A call of the streaming `init` on the state in `st` (`r4` for `inner`, +`r5` for `outer`). -/ +theorem callInit_rel (hc : Checks H) {st : Reg} {p : BitVec 32} + (hst : st = .r4 ∧ p = inn s₀ ∨ st = .r5 ∧ p = out s₀) : + RelCT isa (fun s s' => KK H sc s₀ s ∧ KK H sc s₀' s') (H.st.callInit st) + fun s s' => KK H sc s₀ s ∧ KK H sc s₀' s' := by + have hz := hH.sizes + have hst' : st = .r4 ∧ p = inn s₀' ∨ st = .r5 ∧ p = out s₀' := by + rcases hst with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · exact .inl ⟨h1, by rw [h2, inn, inn, hq.r0]⟩ + · exact .inr ⟨h1, by rw [h2, out, out, hq.r1]⟩ + have hpR : p = inn s₀ ∨ p = out s₀ := by rcases hst with ⟨_, h⟩ | ⟨_, h⟩ <;> simp [h] + have hpR' : p = inn s₀' ∨ p = out s₀' := by rcases hst' with ⟨_, h⟩ | ⟨_, h⟩ <;> simp [h] + obtain ⟨_, _, _, np, hin⟩ := st_facts hz hp hpR + obtain ⟨_, _, _, _, hin'⟩ := st_facts hz hp' hpR' + have hS : H.st.S = H.N + H.B := hz.S + let F : State → State → Prop := fun t₀ s => KR H sc t₀ s ∧ s.gpr .r0 = p ∧ s.gpr .r6 = kp t₀ ∧ + s.gpr .r7 = BitVec.ofNat 32 (kl t₀) + have ha : RelCT isa (fun s s' => KK H sc s₀ s ∧ KK H sc s₀' s') (.block [.mov .r0 (.reg st)]) + fun s s' => F s₀ s ∧ F s₀' s' := + rel_agree (Taint.ofRegs regsK) (fun _ _ h h' => Taint.agree_ofRegs (kk_agree hq h h')) + (hc.arg st (by rcases hst with ⟨rfl, _⟩ | ⟨rfl, _⟩ <;> simp)) + (fun _ ⟨k, r6, r7⟩ => WP.mono (initArg_ok k hst) fun _ ⟨k', d, g, _⟩ => + ⟨k', d, by rw [g _ (by simp), r6], by rw [g _ (by simp), r7]⟩) + (fun _ ⟨k, r6, r7⟩ => WP.mono (initArg_ok k hst') fun _ ⟨k', d, g, _⟩ => + ⟨k', d, by rw [g _ (by simp), r6], by rw [g _ (by simp), r7]⟩) + unfold Impl.Pbkdf2.Stream.Arm.Hash.callInit + refine ha.seq (rel_wp (init_rel hH.stream (st := p) fun s s' ⟨⟨k, d, _⟩, ⟨k', d', _⟩⟩ => + ⟨d, d', by rw [hS]; exact np, by rw [k.wr, hS]; exact covers_one hin, by rw [k'.wr, hS]; exact covers_one hin'⟩) + (fun _ ⟨k, d, r6, r7⟩ => initCall_ok hz hp hH k hpR d fun _ k' g _ _ => + ⟨k', by rw [g _ (by simp), r6], by rw [g _ (by simp), r7]⟩) + (fun _ ⟨k, d, r6, r7⟩ => initCall_ok hz hp' hH k hpR' d fun _ k' g _ _ => + ⟨k', by rw [g _ (by simp), r6], by rw [g _ (by simp), r7]⟩)) + +/-- The compression of the buffer of the state at `p`. -/ +theorem cmpS_rel {p p' : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) (hpR' : p' = inn s₀' ∨ p' = out s₀') + (he : p' = p) : + RelCT isa (fun s s' => (KR H sc s₀ s ∧ s.gpr .r0 = p ∧ s.gpr .r3 = scr s₀ ∧ + s.gpr .r6 = p + BitVec.ofNat 32 H.N) ∧ + (KR H sc s₀' s' ∧ s'.gpr .r0 = p' ∧ s'.gpr .r3 = scr s₀' ∧ s'.gpr .r6 = p' + BitVec.ofNat 32 H.N)) + H.compressBlock fun s s' => (KR H sc s₀ s ∧ s.gpr .r3 = scr s₀) ∧ (KR H sc s₀' s' ∧ s'.gpr .r3 = scr s₀') := by + have hz := hH.sizes + have e : scr s₀' = scr s₀ := hq.a0.symm + exact rel_wp (compressBlock_rel (H := hH.md) (so := H.so) hH.comp (name := H.compN) (st := p) (scr := scr s₀) + (src := p + BitVec.ofNat 32 H.N) fun s s' ⟨⟨k, a, b, c⟩, ⟨k', a', b', c'⟩⟩ => by + have c₂ := callOk hz hp' k' hpR' a' b' c' + rw [he, e] at c₂ + exact ⟨callOk hz hp k hpR a b c, c₂⟩) + (fun _ ⟨k, a, b, c⟩ => cmpS_ok hz hp hH k hpR a b c fun _ k' r3 _ _ => ⟨k', r3⟩) + (fun _ ⟨k, a, b, c⟩ => cmpS_ok hz hp' hH k hpR' a b c fun _ k' r3 _ _ => ⟨k', r3⟩) + +include hH hp hp' hq in +theorem ct (hc : Checks H) : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.hmacInit fun _ _ => True := by + have hz := hH.sizes + have aw : ∀ {t : State}, Pre H sc t → + t.sp.toNat + 4 ≤ 2 ^ 32 ∧ ∀ r ∈ t.wr, Region.Disjoint ⟨State.addr t.sp, 4⟩ r := fun {t} h => by + have e : (⟨State.addr t.sp, 4⟩ : Region) = argR t := by simp [stackArgAddr] + refine ⟨h.spf, ?_⟩ + simp only [e, h.wr, List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl) + · exact h.a_i + · exact h.a_o + · exact h.a_s + have pro : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') (.block H.initPrologue) + fun s s' => KK H sc s₀ s ∧ KK H sc s₀' s' := + rel_agree (argTaint [.r0, .r1, .r2, .r3] 4) (fun s s' e e' => by + rw [e, e'] + refine agree_argTaint (fun r hr => ?_) hq.sp (aw hp) (aw hp') + (argMem_of (j := 1) hq.sp hp.spf fun i hi => by rw [show i = 0 by omega]; exact hq.a0) + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl | rfl + · exact hq.r0 + · exact hq.r1 + · exact hq.r2 + · exact hq.r3) hc.pro + (fun _ e => by rw [e]; exact pro_ok hz hp) + (fun _ e => by rw [e]; exact pro_ok hz hp') + have blk : RelCT isa (fun s s' => KK H sc s₀ s ∧ KK H sc s₀' s') H.blocks + fun s s' => (KR H sc s₀ s ∧ s.gpr .r0 = inn s₀ ∧ s.gpr .r3 = scr s₀ ∧ + s.gpr .r6 = inn s₀ + BitVec.ofNat 32 H.N) ∧ + (KR H sc s₀' s' ∧ s'.gpr .r0 = inn s₀' ∧ s'.gpr .r3 = scr s₀' ∧ s'.gpr .r6 = inn s₀' + BitVec.ofNat 32 H.N) := + rel_agree (Taint.ofRegs regsK) (fun _ _ h h' => Taint.agree_ofRegs (kk_agree hq h h')) hc.blocks + (fun _ ⟨k, r6, r7⟩ => blocks_ok hz hp k r6 r7) + (fun _ ⟨k, r6, r7⟩ => blocks_ok hz hp' k r6 r7) + have tO : RelCT isa (fun s s' => (KR H sc s₀ s ∧ s.gpr .r3 = scr s₀) ∧ (KR H sc s₀' s' ∧ s'.gpr .r3 = scr s₀')) + (.block H.toOuter) + fun s s' => (KR H sc s₀ s ∧ s.gpr .r0 = out s₀ ∧ s.gpr .r3 = scr s₀ ∧ + s.gpr .r6 = out s₀ + BitVec.ofNat 32 H.N) ∧ + (KR H sc s₀' s' ∧ s'.gpr .r0 = out s₀' ∧ s'.gpr .r3 = scr s₀' ∧ s'.gpr .r6 = out s₀' + BitVec.ofNat 32 H.N) := + rel_agree (Taint.ofRegs kregs) (fun _ _ h h' => Taint.agree_ofRegs (kr_agree hq h.1 h'.1)) hc.toOuter + (fun _ ⟨k, r3⟩ => WP.mono (toOuter_ok hz k r3) fun _ ⟨k', a, b, c, _⟩ => ⟨k', a, b, c⟩) + (fun _ ⟨k, r3⟩ => WP.mono (toOuter_ok hz k r3) fun _ ⟨k', a, b, c, _⟩ => ⟨k', a, b, c⟩) + obtain ⟨_, hr⟩ := hc.restore + have restore : RelCT isa (fun s s' => (KR H sc s₀ s ∧ s.gpr .r3 = scr s₀) ∧ (KR H sc s₀' s' ∧ s'.gpr .r3 = scr s₀')) + (.block H.st.restore) fun _ _ => True := + RelCT.taint (A := taint) (Taint.ofRegs kregs) (fun _ _ h => Taint.agree_ofRegs (kr_agree hq h.1.1 h.2.1)) hr + exact pro.seq ((callInit_rel hH hp hp' hq hc (.inl ⟨rfl, rfl⟩)).seq + ((callInit_rel hH hp hp' hq hc (.inr ⟨rfl, rfl⟩)).seq + (blk.seq ((cmpS_rel hH hp hp' hq (.inl rfl) (.inl rfl) hq.r0.symm).seq + (tO.seq ((cmpS_rel hH hp hp' hq (.inr rfl) (.inr rfl) hq.r1.symm).seq restore)))))) + +end + +/-! ## Verified -/ + +theorem pubEq_of {S : Spec.Hmac.StreamingHash} {W : Nat} {s₁ s₂ : State} (h : (initG S W).pub s₁ s₂) : + PubEq s₁ s₂ := + ⟨h.1, h.2.1, h.2.2.1, h.2.2.2.1, h.2.2.2.2.1, h.2.2.2.2.2⟩ + +/-- HMAC's `init` is verified against `initG`, for any hash function the +proof supports (`HashOK`), whose pieces of code the taint analysis accepts +(`Checks`). -/ +theorem verified {H : Hash} (hH : HashOK H) (hc : Checks H) {sc : Nat} (hfit : H.st.buf ≤ 8 * sc) + (hsat : ∃ s, (initG hH.SH sc).pre s) : + Verified Arm.target H.hmacInit (initG hH.SH sc) := by + refine ⟨fun s hs => correct hH (pre_of hH hs hfit), fun s₁ s₂ t₁ t₂ s₁' s₂' h₁ h₂ hpub e₁ e₂ => ?_, hsat⟩ + exact (ct hH (pre_of hH h₁ hfit) (pre_of hH h₂ hfit) (pubEq_of hpub) hc _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 + +end VG.Proof.Pbkdf2.Md.Arm.HmacInit diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean index 462709158..a1bfc37dc 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean @@ -1,7 +1,10 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.IterateCT import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.HmacFinCT +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.HmacInitCT import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Sha512 -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Instances +import VerifiedGarbage.Proof.Pbkdf2.Stream.Arm.Hashes +import VerifiedGarbage.Proof.Hmac.Generic.Implies +import VerifiedGarbage.Proof.Framework.Arm.Contract import VerifiedGarbage.Proof.Sha1.Arm.Stream.Md import VerifiedGarbage.Proof.Md5.Arm.Stream.Md import VerifiedGarbage.Proof.Sha1.Arm.Lit @@ -12,21 +15,21 @@ import VerifiedGarbage.Proof.Sha512.Arm.Shared # HMAC and PBKDF2-HMAC over Merkle–Damgård hash functions on ARMv7: the instances MD5, SHA-1 and the SHA-512 family as `Hash`es (their streaming functions as -HMAC's `init` calls them, `Proof/Hmac/Generic/Arm/Hashes.lean`, with their -hash value, length field, digest code and compression function), what the -proofs need of them (`HashOK`, from the hash functions' own proofs), and the -generic proofs of HMAC's `finalize` and PBKDF2's iteration (`HmacFinCT.lean`, -`IterateCT.lean`) at each of them, moved to the shared contracts of -`Spec/Hmac/Generic.lean` and `Spec/Pbkdf2/Generic.lean`, which the artifacts -are emitted with. SHA-256 and SHA-224 are in `Sha256.lean` and -`Sha224.lean`. +the code calls them, `Proof/Pbkdf2/Stream/Arm/Hashes.lean`, with their hash +value, length field, digest code and compression function), what the proofs +need of them (`HashOK`, from the hash functions' own proofs), and the generic +proofs of HMAC's `init` and `finalize` and PBKDF2's iteration +(`HmacInitCT.lean`, `HmacFinCT.lean`, `IterateCT.lean`) at each of them, moved +to the shared contracts of `Spec/Hmac/Generic.lean` and +`Spec/Pbkdf2/Generic.lean`, which the artifacts are emitted with. SHA-256 and +SHA-224 are in `Sha256.lean` and `Sha224.lean`. -/ namespace VG.Proof.Pbkdf2.Md.Arm open VG VG.Arm VG.Proof.MdStream open VG.Impl.Pbkdf2.Md.Arm (Hash) -open VG.Proof.Hmac.Generic.Arm (iterG below sha1H md5H sha384H sha512H' sha512_224H sha512_256H sha1OK md5OK +open VG.Proof.Pbkdf2.Stream.Arm (iterG below sha1H md5H sha384H sha512H' sha512_224H sha512_256H sha1OK md5OK sha384OK sha512OK sha512_224OK sha512_256OK) /-! ## The hash functions -/ @@ -60,7 +63,7 @@ value `iv` and streaming `init` named `initN`: a 64-byte hash value, a 16-byte big-endian length field, and `vg_sha512_compress`, with 224 bytes of scratch space. -/ def sha512Md (D : Nat) (initN : String) (iv : Spec.Sha512.HashValue) : Hash where - st := Hmac.Generic.Arm.sha512H D initN iv + st := Pbkdf2.Stream.Arm.sha512H D initN iv N := 64 L := 16 be := true @@ -93,6 +96,7 @@ def sha1MdOK : HashOK sha1Md where stream := sha1OK iv := Spec.Sha1.H0 repr _ _ _ h := h + back _ _ _ h := h hash m := by show Spec.Sha1.hash m = _ rw [Proof.Sha1.hash_eq] @@ -117,6 +121,7 @@ def md5MdOK : HashOK md5Md where stream := md5OK iv := Spec.Md5.H0 repr _ _ _ h := h + back _ _ _ h := h hash m := by show Spec.Md5.hash m = _ rw [Proof.Md5.hash_eq] @@ -131,7 +136,7 @@ theorem sha512_comp : CompOk Proof.Sha512.md 224 Impl.Sha512.Arm.compress := /-- `HashOK` for the member of the SHA-512 family with a `D`-byte digest, from the initial hash value `iv`. -/ def sha512MdOK {D : Nat} {initN : String} {iv : Spec.Sha512.HashValue} - (hs : Hmac.Generic.Arm.HashOK (Hmac.Generic.Arm.sha512H D initN iv)) + (hs : Pbkdf2.Stream.Arm.HashOK (Pbkdf2.Stream.Arm.sha512H D initN iv)) (hR : hs.SH.Repr = Spec.Sha512.Repr iv) (hh : ∀ m, hs.SH.H.hash m = (Spec.Sha512.finalHash iv m).take D) (hz : Sizes (sha512Md D initN iv)) (hlen : wordsBytes (Impl.Pbkdf2.Md.Arm.lenWords true 16 (128 + D)) = Proof.Sha512.md.lenBytes (128 + D)) : @@ -148,6 +153,7 @@ def sha512MdOK {D : Nat} {initN : String} {iv : Spec.Sha512.HashValue} stream := hs iv := iv repr mem p m h := by rw [hR] at h; exact Proof.Sha512.repr_iff.mp h + back mem p m h := by rw [hR]; exact Proof.Sha512.repr_iff.mpr h hash m := by rw [hh, Proof.Sha512.finalHash_eq]; rfl sizes := hz @@ -178,7 +184,55 @@ namespace VG.Proof.Pbkdf2.Md.Arm.Instances open VG.Arm open VG.Proof.Pbkdf2.Md.Arm -open VG.Proof.Hmac.Generic.Arm (iterG below) +open VG.Proof.Pbkdf2.Stream.Arm (initG finG iterG below count) + +/-- A state satisfying `init`'s precondition, with states of `S` bytes and +`8 sc` bytes of scratch space (and a one-byte key); `scratch`, at `0x4000`, +is the stack argument. -/ +def initSat (S sc : Nat) : State where + gpr r := match r with + | .r0 => 0x1000 | .r1 => 0x2000 | .r2 => 0x3000 | .r3 => 1 + | _ => 0 + sp := 0x6000 + n := false + z := false + c := false + v := false + mem a := if a = 0x6001 then 0x40 else 0 + rd := [⟨0x3000, 1⟩, ⟨0x6000, 4⟩] + wr := [⟨0x1000, S⟩, ⟨0x2000, S⟩, ⟨0x4000, 8 * sc⟩] + +/-- A state satisfying `finalize`'s precondition, with states of `S` bytes, +a digest of `D` bytes and `8 sc` bytes of scratch space; `out`, at `0x3000`, +and `scratch`, at `0x4000`, are the stack arguments. -/ +def finSat (S D sc : Nat) : State where + gpr r := match r with + | .r0 => 0x1000 | .r1 => 0x2000 + | _ => 0 + sp := 0x6000 + n := false + z := false + c := false + v := false + mem a := if a = 0x6001 then 0x30 else if a = 0x6005 then 0x40 else 0 + rd := [⟨0x2000, S⟩, ⟨0x6000, 8⟩] + wr := [⟨0x1000, S⟩, ⟨0x3000, D⟩, ⟨0x4000, 8 * sc⟩] + +/-- `initG` implies the shared contract for any hash function and scratch space +(`generic_implies`), given that the shared contract is satisfiable. -/ +theorem initImp (S : Spec.Hmac.StreamingHash) (W : Nat) (h : ∃ s, (Spec.Hmac.initContract S W Arm.abi 16).pre s) : + (initG S W).Implies (Spec.Hmac.initContract S W Arm.abi 16) := by + generic_implies [ + Spec.Hmac.initContract, Spec.Hmac.initSig, initG, below, count, Arm.abi, Arm.argRegs, + Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using h + +/-- `finG` implies the shared contract for any hash function and scratch space +(`generic_implies`), given that the shared contract is satisfiable. -/ +theorem finImp (S : Spec.Hmac.StreamingHash) (W : Nat) (h : ∃ s, (Spec.Hmac.finalizeContract S W Arm.abi 16).pre s) : + (finG S W).Implies (Spec.Hmac.finalizeContract S W Arm.abi 16) := by + generic_implies [ + Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, finG, below, count, Arm.abi, Arm.argRegs, + Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using h /-- A state satisfying `iterate`'s precondition, with states of `S` bytes, a digest of `D` bytes and `8 sc` bytes of scratch space; `scratch`, at @@ -221,9 +275,28 @@ theorem sha1_iterImp : (iterG Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.itera theorem sha1_iterate : Verified Arm.target sha1Md.iterate (Spec.Hmac.sha1I.iterateContract Arm.abi 16) := (Iterate.verified sha1MdOK sha1_iterChecks (by decide) sha1_iterImp.sat_left).of_implies sha1_iterImp +theorem sha1_initChecks : HmacInit.Checks sha1Md := + ⟨⟨_, by taint_decide⟩, by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩⟩ + +theorem sha1_initImp : (initG Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.initContract Arm.abi 16) := + initImp Spec.Hmac.sha1S 56 (by + inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.sha1S, Spec.Hmac.sha1, initG, below, + count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 84 56) + +theorem sha1_finImp : (finG Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.finalizeContract Arm.abi 16) := + finImp Spec.Hmac.sha1S 56 (by + inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha1S, Spec.Hmac.sha1, finG, + below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 84 20 56) + +theorem sha1_init : Verified Arm.target sha1Md.hmacInit (Spec.Hmac.sha1I.initContract Arm.abi 16) := + (HmacInit.verified sha1MdOK sha1_initChecks (by decide) sha1_initImp.sat_left).of_implies sha1_initImp + theorem sha1_finalize : Verified Arm.target sha1Md.hmacFin (Spec.Hmac.sha1I.finalizeContract Arm.abi 16) := - (Fin.verified sha1MdOK sha1_finChecks (by decide) Hmac.Generic.Arm.Instances.sha1_finImp.sat_left).of_implies - Hmac.Generic.Arm.Instances.sha1_finImp + (Fin.verified sha1MdOK sha1_finChecks (by decide) sha1_finImp.sat_left).of_implies + sha1_finImp /-! ## MD5 -/ @@ -242,9 +315,28 @@ theorem md5_iterImp : (iterG Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.iterateC theorem md5_iterate : Verified Arm.target md5Md.iterate (Spec.Hmac.md5I.iterateContract Arm.abi 16) := (Iterate.verified md5MdOK md5_iterChecks (by decide) md5_iterImp.sat_left).of_implies md5_iterImp +theorem md5_initChecks : HmacInit.Checks md5Md := + ⟨⟨_, by taint_decide⟩, by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩⟩ + +theorem md5_initImp : (initG Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.initContract Arm.abi 16) := + initImp Spec.Hmac.md5S 48 (by + inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.md5S, Spec.Hmac.md5, initG, below, + count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 80 48) + +theorem md5_finImp : (finG Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.finalizeContract Arm.abi 16) := + finImp Spec.Hmac.md5S 48 (by + inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.md5S, Spec.Hmac.md5, finG, + below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 80 16 48) + +theorem md5_init : Verified Arm.target md5Md.hmacInit (Spec.Hmac.md5I.initContract Arm.abi 16) := + (HmacInit.verified md5MdOK md5_initChecks (by decide) md5_initImp.sat_left).of_implies md5_initImp + theorem md5_finalize : Verified Arm.target md5Md.hmacFin (Spec.Hmac.md5I.finalizeContract Arm.abi 16) := - (Fin.verified md5MdOK md5_finChecks (by decide) Hmac.Generic.Arm.Instances.md5_finImp.sat_left).of_implies - Hmac.Generic.Arm.Instances.md5_finImp + (Fin.verified md5MdOK md5_finChecks (by decide) md5_finImp.sat_left).of_implies + md5_finImp /-! ## SHA-384 -/ @@ -263,9 +355,28 @@ theorem sha384_iterImp : (iterG Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384 theorem sha384_iterate : Verified Arm.target sha384Md.iterate (Spec.Hmac.sha384I.iterateContract Arm.abi 16) := (Iterate.verified sha384MdOK sha384_iterChecks (by decide) sha384_iterImp.sat_left).of_implies sha384_iterImp +theorem sha384_initChecks : HmacInit.Checks sha384Md := + ⟨⟨_, by taint_decide⟩, by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩⟩ + +theorem sha384_initImp : (initG Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I.initContract Arm.abi 16) := + initImp Spec.Hmac.sha384S 234 (by + inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.sha384S, Spec.Hmac.sha384, initG, below, + count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 192 234) + +theorem sha384_finImp : (finG Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I.finalizeContract Arm.abi 16) := + finImp Spec.Hmac.sha384S 234 (by + inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha384S, Spec.Hmac.sha384, finG, + below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 192 48 234) + +theorem sha384_init : Verified Arm.target sha384Md.hmacInit (Spec.Hmac.sha384I.initContract Arm.abi 16) := + (HmacInit.verified sha384MdOK sha384_initChecks (by decide) sha384_initImp.sat_left).of_implies sha384_initImp + theorem sha384_finalize : Verified Arm.target sha384Md.hmacFin (Spec.Hmac.sha384I.finalizeContract Arm.abi 16) := - (Fin.verified sha384MdOK sha384_finChecks (by decide) Hmac.Generic.Arm.Instances.sha384_finImp.sat_left).of_implies - Hmac.Generic.Arm.Instances.sha384_finImp + (Fin.verified sha384MdOK sha384_finChecks (by decide) sha384_finImp.sat_left).of_implies + sha384_finImp /-! ## SHA-512 -/ @@ -284,9 +395,28 @@ theorem sha512_iterImp : (iterG Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512 theorem sha512_iterate : Verified Arm.target sha512Md'.iterate (Spec.Hmac.sha512I.iterateContract Arm.abi 16) := (Iterate.verified sha512MdOK' sha512_iterChecks (by decide) sha512_iterImp.sat_left).of_implies sha512_iterImp +theorem sha512_initChecks : HmacInit.Checks sha512Md' := + ⟨⟨_, by taint_decide⟩, by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩⟩ + +theorem sha512_initImp : (initG Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I.initContract Arm.abi 16) := + initImp Spec.Hmac.sha512S 234 (by + inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.sha512S, Spec.Hmac.sha512, initG, below, + count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 192 234) + +theorem sha512_finImp : (finG Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I.finalizeContract Arm.abi 16) := + finImp Spec.Hmac.sha512S 234 (by + inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha512S, Spec.Hmac.sha512, finG, + below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 192 64 234) + +theorem sha512_init : Verified Arm.target sha512Md'.hmacInit (Spec.Hmac.sha512I.initContract Arm.abi 16) := + (HmacInit.verified sha512MdOK' sha512_initChecks (by decide) sha512_initImp.sat_left).of_implies sha512_initImp + theorem sha512_finalize : Verified Arm.target sha512Md'.hmacFin (Spec.Hmac.sha512I.finalizeContract Arm.abi 16) := - (Fin.verified sha512MdOK' sha512_finChecks (by decide) Hmac.Generic.Arm.Instances.sha512_finImp.sat_left).of_implies - Hmac.Generic.Arm.Instances.sha512_finImp + (Fin.verified sha512MdOK' sha512_finChecks (by decide) sha512_finImp.sat_left).of_implies + sha512_finImp /-! ## SHA-512/224 -/ @@ -305,9 +435,28 @@ theorem sha512_224_iterImp : (iterG Spec.Hmac.sha512_224S 234).Implies (Spec.Hma theorem sha512_224_iterate : Verified Arm.target sha512_224Md.iterate (Spec.Hmac.sha512_224I.iterateContract Arm.abi 16) := (Iterate.verified sha512_224MdOK sha512_224_iterChecks (by decide) sha512_224_iterImp.sat_left).of_implies sha512_224_iterImp +theorem sha512_224_initChecks : HmacInit.Checks sha512_224Md := + ⟨⟨_, by taint_decide⟩, by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩⟩ + +theorem sha512_224_initImp : (initG Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac.sha512_224I.initContract Arm.abi 16) := + initImp Spec.Hmac.sha512_224S 234 (by + inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.sha512_224S, Spec.Hmac.sha512_224, initG, below, + count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 192 234) + +theorem sha512_224_finImp : (finG Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac.sha512_224I.finalizeContract Arm.abi 16) := + finImp Spec.Hmac.sha512_224S 234 (by + inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha512_224S, Spec.Hmac.sha512_224, finG, + below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 192 28 234) + +theorem sha512_224_init : Verified Arm.target sha512_224Md.hmacInit (Spec.Hmac.sha512_224I.initContract Arm.abi 16) := + (HmacInit.verified sha512_224MdOK sha512_224_initChecks (by decide) sha512_224_initImp.sat_left).of_implies sha512_224_initImp + theorem sha512_224_finalize : Verified Arm.target sha512_224Md.hmacFin (Spec.Hmac.sha512_224I.finalizeContract Arm.abi 16) := - (Fin.verified sha512_224MdOK sha512_224_finChecks (by decide) Hmac.Generic.Arm.Instances.sha512_224_finImp.sat_left).of_implies - Hmac.Generic.Arm.Instances.sha512_224_finImp + (Fin.verified sha512_224MdOK sha512_224_finChecks (by decide) sha512_224_finImp.sat_left).of_implies + sha512_224_finImp /-! ## SHA-512/256 -/ @@ -326,8 +475,27 @@ theorem sha512_256_iterImp : (iterG Spec.Hmac.sha512_256S 234).Implies (Spec.Hma theorem sha512_256_iterate : Verified Arm.target sha512_256Md.iterate (Spec.Hmac.sha512_256I.iterateContract Arm.abi 16) := (Iterate.verified sha512_256MdOK sha512_256_iterChecks (by decide) sha512_256_iterImp.sat_left).of_implies sha512_256_iterImp +theorem sha512_256_initChecks : HmacInit.Checks sha512_256Md := + ⟨⟨_, by taint_decide⟩, by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩⟩ + +theorem sha512_256_initImp : (initG Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac.sha512_256I.initContract Arm.abi 16) := + initImp Spec.Hmac.sha512_256S 234 (by + inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.sha512_256S, Spec.Hmac.sha512_256, initG, below, + count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 192 234) + +theorem sha512_256_finImp : (finG Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac.sha512_256I.finalizeContract Arm.abi 16) := + finImp Spec.Hmac.sha512_256S 234 (by + inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha512_256S, Spec.Hmac.sha512_256, finG, + below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 192 32 234) + +theorem sha512_256_init : Verified Arm.target sha512_256Md.hmacInit (Spec.Hmac.sha512_256I.initContract Arm.abi 16) := + (HmacInit.verified sha512_256MdOK sha512_256_initChecks (by decide) sha512_256_initImp.sat_left).of_implies sha512_256_initImp + theorem sha512_256_finalize : Verified Arm.target sha512_256Md.hmacFin (Spec.Hmac.sha512_256I.finalizeContract Arm.abi 16) := - (Fin.verified sha512_256MdOK sha512_256_finChecks (by decide) Hmac.Generic.Arm.Instances.sha512_256_finImp.sat_left).of_implies - Hmac.Generic.Arm.Instances.sha512_256_finImp + (Fin.verified sha512_256MdOK sha512_256_finChecks (by decide) sha512_256_finImp.sat_left).of_implies + sha512_256_finImp end VG.Proof.Pbkdf2.Md.Arm.Instances diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Iterate.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Iterate.lean index d11d14b83..8a74c7808 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Iterate.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Iterate.lean @@ -9,7 +9,7 @@ generic streaming proofs describe (`Md`), whose digest code and length field are as `HashOK` says, with any correct compression function (`CompOk`), used as a black box through its proof; `Md.hmac_step` says that its two compressions per step compute HMAC. The contract is `iterG` -(`Proof/Hmac/Generic/Arm/Hash.lean`), the shared one's at 16 bytes of stack, +(`Proof/Pbkdf2/Stream/Arm/Hash.lean`), the shared one's at 16 bytes of stack, although the function uses none. -/ @@ -19,7 +19,7 @@ open VG VG.Arm open VG.Impl.Pbkdf2.Md.Arm (Hash copyW padFrom constW xorW lenWords) open VG.Proof.Pbkdf2.Md.Arm open VG.Proof.MdStream (Md) -open VG.Proof.Hmac.Generic.Arm (iterG below SavedRegs saveR savedRegs preserved_saved) +open VG.Proof.Pbkdf2.Stream.Arm (iterG below SavedRegs saveR savedRegs preserved_saved) open VG.Proof.MdStream.Arm (Upd Fupd wp_mov wp_ldrSp wp_cmp wp_subs op2_imm op2_reg eval_eq eval_ne ofNat_beq_zero sub_ofNat) open VG.Spec.Sha256 (bytesAt) @@ -638,7 +638,7 @@ theorem setup_ok {rest : List Instr} {Q : State → Prop} (k : ∀ s, Setup H s simp only [List.append_assoc, List.singleton_append] refine wp_ldrSp (a := stackArgAddr s₀ 0) (by decide) rfl ⟨argR s₀, by simp [hp.rd], Region.contains_self _ _⟩ fun s₁ u₁ => ?_ - refine Hmac.Generic.Arm.save_ok H.st (scr := scr s₀) u₁.gpr hz.W (by rw [u₁.wr, hp.wr]; simp) (L := 8 * sc) + refine Pbkdf2.Stream.Arm.save_ok H.st (scr := scr s₀) u₁.gpr hz.W (by rw [u₁.wr, hp.wr]; simp) (L := 8 * sc) (by omega) hp.ns fun s₂ g₂ rd₂ wr₂ sp₂ f₂ sv₂ => ?_ simp only [List.cons_append, List.nil_append] refine wp_mov (op2_reg _ _) fun s₃ u₃ => wp_mov (op2_reg _ _) fun s₄ u₄ => wp_mov (op2_reg _ _) fun s₅ u₅ => @@ -796,7 +796,7 @@ theorem epilogue_ok {md : Md H.B H.N H.L} {S : Spec.Hmac.StreamingHash} {iv : md {s : State} (h : Inv H sc md s₀ 0 s) : WP isa (.block H.st.restore) s fun s' => abiPreserved s₀ s' ∧ (iterG S sc).post s₀ s' := by have hf := hp.fits; have := hz.W; rw [buf_eq H] at hf - refine WP.mono (Hmac.Generic.Arm.restore_ok H.st h.r11 hz.W h.saved (by rw [h.wr, hp.wr]; simp) (L := 8 * sc) + refine WP.mono (Pbkdf2.Stream.Arm.restore_ok H.st h.r11 hz.W h.saved (by rw [h.wr, hp.wr]; simp) (L := 8 * sc) (by omega) hp.ns) fun s' ⟨hm, _, _, hsp, hg, _⟩ => ⟨⟨fun r hr => hg r (preserved_saved r hr), by rw [hsp, h.sp]⟩, fun k0 hk hi ho => ?_⟩ have hT := h.val diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/IterateCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/IterateCT.lean index 97b70ddd5..b1a8cc2cf 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/IterateCT.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/IterateCT.lean @@ -24,7 +24,7 @@ open VG.Impl.Pbkdf2.Md.Arm (Hash xorW) open VG.Proof.Pbkdf2.Md.Arm open VG.Proof.MdStream (Md) open VG.Proof.MdStream.Arm (wp_mov op2_reg eval_eq eval_ne) -open VG.Proof.Hmac.Generic.Arm (iterG) +open VG.Proof.Pbkdf2.Stream.Arm (iterG) open VG.Spec.Sha256 (bytesAt) /-- The registers the blocks between the calls use. -/ diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean index b50a9e592..029a73721 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean @@ -1,23 +1,23 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Sha256 -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Sha224 +import VerifiedGarbage.Proof.Pbkdf2.Stream.Arm.Sha224 /-! # HMAC-SHA-224 and PBKDF2-HMAC-SHA-224 over the compression function on ARMv7 -SHA-224 as a `Hash`: its streaming functions as HMAC's `init` calls them -(`sha224H`, `Proof/Hmac/Generic/Arm/Sha224.lean`), SHA-256's hash value, -length field, digest code and compression function (`Sha256.lean`); what -the proofs need of it (`HashOK`), with SHA-256's `Md` from SHA-224's initial -hash value and the digest its first 28 bytes; and the generic proofs at it, -moved to the shared contracts of `Spec.Hmac.sha224I` (as for the hash -functions of `Instances.lean`). +SHA-224 as a `Hash`: its streaming functions as the code calls them +(`sha224H`, `Proof/Pbkdf2/Stream/Arm/Sha224.lean`), SHA-256's hash value, +length field, digest code and compression function (`Sha256.lean`); what the +proofs need of it (`HashOK`), with SHA-256's `Md` from SHA-224's initial hash +value and the digest its first 28 bytes; and the generic proofs at it, moved +to the shared contracts of `Spec.Hmac.sha224I` (as for the hash functions of +`Instances.lean`). -/ namespace VG.Proof.Pbkdf2.Md.Arm open VG VG.Arm VG.Proof.MdStream open VG.Impl.Pbkdf2.Md.Arm (Hash) -open VG.Proof.Hmac.Generic.Arm (sha224H sha224OK) +open VG.Proof.Pbkdf2.Stream.Arm (sha224H sha224OK) /-- SHA-224: SHA-256's 32-byte hash value, big-endian length field and `vg_sha256_compress`, with 112 bytes of scratch space. -/ @@ -44,6 +44,7 @@ def sha224MdOK : HashOK sha224Md where stream := sha224OK iv := Spec.Sha256.H0_224 repr _ _ _ h := h + back _ _ _ h := h hash _ := rfl sizes := ⟨.inl rfl, by decide, by decide, by decide, by decide, by decide, by decide, by decide, by decide, by decide, by decide, by decide, by decide, by decide⟩ @@ -54,7 +55,7 @@ namespace VG.Proof.Pbkdf2.Md.Arm.Instances open VG.Arm open VG.Proof.Pbkdf2.Md.Arm -open VG.Proof.Hmac.Generic.Arm (iterG below) +open VG.Proof.Pbkdf2.Stream.Arm (initG finG iterG below count) theorem sha224_iterChecks : Iterate.Checks sha224Md := ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, @@ -71,8 +72,27 @@ theorem sha224_iterImp : (iterG Spec.Hmac.sha224S 104).Implies (Spec.Hmac.sha224 theorem sha224_iterate : Verified Arm.target sha224Md.iterate (Spec.Hmac.sha224I.iterateContract Arm.abi 16) := (Iterate.verified sha224MdOK sha224_iterChecks (by decide) sha224_iterImp.sat_left).of_implies sha224_iterImp +theorem sha224_initChecks : HmacInit.Checks sha224Md := + ⟨⟨_, by taint_decide⟩, by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩⟩ + +theorem sha224_initImp : (initG Spec.Hmac.sha224S 104).Implies (Spec.Hmac.sha224I.initContract Arm.abi 16) := + initImp Spec.Hmac.sha224S 104 (by + inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.sha224S, Spec.Hmac.sha224, initG, below, + count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 96 104) + +theorem sha224_finImp : (finG Spec.Hmac.sha224S 104).Implies (Spec.Hmac.sha224I.finalizeContract Arm.abi 16) := + finImp Spec.Hmac.sha224S 104 (by + inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha224S, Spec.Hmac.sha224, finG, + below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 96 28 104) + +theorem sha224_init : Verified Arm.target sha224Md.hmacInit (Spec.Hmac.sha224I.initContract Arm.abi 16) := + (HmacInit.verified sha224MdOK sha224_initChecks (by decide) sha224_initImp.sat_left).of_implies sha224_initImp + theorem sha224_finalize : Verified Arm.target sha224Md.hmacFin (Spec.Hmac.sha224I.finalizeContract Arm.abi 16) := - (Fin.verified sha224MdOK sha224_finChecks (by decide) Hmac.Generic.Arm.Instances.sha224_finImp.sat_left).of_implies - Hmac.Generic.Arm.Instances.sha224_finImp + (Fin.verified sha224MdOK sha224_finChecks (by decide) sha224_finImp.sat_left).of_implies + sha224_finImp end VG.Proof.Pbkdf2.Md.Arm.Instances diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha256.lean index 841ce9a1b..6ef87c011 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha256.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha256.lean @@ -1,13 +1,13 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Sha256 +import VerifiedGarbage.Proof.Pbkdf2.Stream.Arm.Sha256 import VerifiedGarbage.Proof.Sha256.Arm.Stream.Md import VerifiedGarbage.Proof.Sha256.Arm.Lit /-! # HMAC-SHA-256 and PBKDF2-HMAC-SHA-256 over the compression function on ARMv7 -SHA-256 as a `Hash`: its streaming functions as HMAC's `init` calls them -(`sha256H`, `Proof/Hmac/Generic/Arm/Sha256.lean`), its hash value, length +SHA-256 as a `Hash`: its streaming functions as the code calls them +(`sha256H`, `Proof/Pbkdf2/Stream/Arm/Sha256.lean`), its hash value, length field, digest code and compression function (`vg_sha256_compress`, which SHA-224 shares: `Sha224.lean`); what the proofs need of it (`HashOK`), with SHA-256's `Md` from `H0`; and the generic proofs at it, moved to the shared @@ -19,7 +19,7 @@ namespace VG.Proof.Pbkdf2.Md.Arm open VG VG.Arm VG.Proof.MdStream open VG.Impl.Pbkdf2.Md.Arm (Hash) -open VG.Proof.Hmac.Generic.Arm (sha256H sha256OK) +open VG.Proof.Pbkdf2.Stream.Arm (sha256H sha256OK) /-- SHA-256: a 32-byte hash value, a big-endian length field and `vg_sha256_compress`, with 112 bytes of scratch space. -/ @@ -50,6 +50,7 @@ def sha256MdOK : HashOK sha256Md where stream := sha256OK iv := Spec.Sha256.H0 repr _ _ _ h := h + back _ _ _ h := h hash m := by show Spec.Sha256.hash m = _ rw [Proof.Sha256.hash_eq] @@ -63,7 +64,7 @@ namespace VG.Proof.Pbkdf2.Md.Arm.Instances open VG.Arm open VG.Proof.Pbkdf2.Md.Arm -open VG.Proof.Hmac.Generic.Arm (iterG below) +open VG.Proof.Pbkdf2.Stream.Arm (initG finG iterG below count) theorem sha256_iterChecks : Iterate.Checks sha256Md := ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, @@ -80,8 +81,27 @@ theorem sha256_iterImp : (iterG Spec.Hmac.sha256S 104).Implies (Spec.Hmac.sha256 theorem sha256_iterate : Verified Arm.target sha256Md.iterate (Spec.Hmac.sha256I.iterateContract Arm.abi 16) := (Iterate.verified sha256MdOK sha256_iterChecks (by decide) sha256_iterImp.sat_left).of_implies sha256_iterImp +theorem sha256_initChecks : HmacInit.Checks sha256Md := + ⟨⟨_, by taint_decide⟩, by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩⟩ + +theorem sha256_initImp : (initG Spec.Hmac.sha256S 104).Implies (Spec.Hmac.sha256I.initContract Arm.abi 16) := + initImp Spec.Hmac.sha256S 104 (by + inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.sha256S, Spec.Hmac.sha256, initG, below, + count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 96 104) + +theorem sha256_finImp : (finG Spec.Hmac.sha256S 104).Implies (Spec.Hmac.sha256I.finalizeContract Arm.abi 16) := + finImp Spec.Hmac.sha256S 104 (by + inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha256S, Spec.Hmac.sha256, finG, + below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 96 32 104) + +theorem sha256_init : Verified Arm.target sha256Md.hmacInit (Spec.Hmac.sha256I.initContract Arm.abi 16) := + (HmacInit.verified sha256MdOK sha256_initChecks (by decide) sha256_initImp.sat_left).of_implies sha256_initImp + theorem sha256_finalize : Verified Arm.target sha256Md.hmacFin (Spec.Hmac.sha256I.finalizeContract Arm.abi 16) := - (Fin.verified sha256MdOK sha256_finChecks (by decide) Hmac.Generic.Arm.Instances.sha256_finImp.sat_left).of_implies - Hmac.Generic.Arm.Instances.sha256_finImp + (Fin.verified sha256MdOK sha256_finChecks (by decide) sha256_finImp.sat_left).of_implies + sha256_finImp end VG.Proof.Pbkdf2.Md.Arm.Instances diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Words.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Words.lean index 4566a103e..04ad6dbfc 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Words.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Words.lean @@ -18,7 +18,7 @@ namespace VG.Proof.Pbkdf2.Md.Arm open VG VG.Arm open VG.Impl.Pbkdf2.Md.Arm (cp copyW padFrom constW xorW) -open VG.Impl.Hmac.Generic.Arm (scrAt) +open VG.Impl.Pbkdf2.Stream.Arm (scrAt) open VG.Proof.MdStream (Md bytes32) open VG.Proof.MdStream.Arm (Upd Mupd wp_mov wp_add wp_ldr wp_str op2_imm op2_reg writeW_le) open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil writeBytes_append) diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Block.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Block.lean index cc48950c2..fcaa58f26 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Block.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Block.lean @@ -1,7 +1,7 @@ import VerifiedGarbage.Proof.Pbkdf2.MdHmac import VerifiedGarbage.Proof.Pbkdf2.Memory -import VerifiedGarbage.Proof.Hmac.Generic.X86.Init -import VerifiedGarbage.Proof.Hmac.Generic.X86.Hash +import VerifiedGarbage.Proof.Pbkdf2.Stream.X86.Common +import VerifiedGarbage.Proof.Pbkdf2.Stream.X86.Hash import VerifiedGarbage.Impl.Pbkdf2.Md.X86 /-! @@ -21,10 +21,10 @@ namespace VG.Proof.Pbkdf2.Md.X86 open VG.X86 open VG.Impl.Pbkdf2.Md.X86 (Hash cpW copyW wordOf storeW tail) -open VG.Impl.Hmac.Generic.X86 (at_) +open VG.Impl.Pbkdf2.Stream.X86 (at_) open VG.Proof.MdStream (Md) open VG.Proof.Sha256.X86.Stream (Upd Mupd wp_mov wp_movi wp_movm wp_store wp_addi sub_offset) -open VG.Proof.Hmac.Generic.X86 (ea_at stk After after_of stk_sub stk_sub' setWidth_add toNat_add_ofNat +open VG.Proof.Pbkdf2.Stream.X86 (ea_at stk After after_of stk_sub stk_sub' setWidth_add toNat_add_ofNat rel_agree) open VG.Proof.Hmac.Common (bytesAt_length bytesAt_add bytesAt_writeBytes_sep) open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil writeBytes_append writeBytes_frame) @@ -523,14 +523,17 @@ theorem digest_ok {H : Hash} (hz : Sizes H) {md : Md H.B H.N H.L} (hout : OutOk /-- A hash function's x86 functions, verified: its streaming functions, as HMAC's `init` and `finalize` call them (`HashOK`), and its `Md`, from the initial hash value `iv`, which is the hash function of the specification -(`link`), whose stored hash value depends only on its bytes (`reloc`), whose +(`link`, and `back`: a state represents a message as the specification has +it if it does as `md` has it), whose stored hash value depends only on its +bytes (`reloc`), whose padding of a `B + D`-byte message is the code's (`tail`), whose digest the code's `out` writes, and whose compression function is verified (`comp`). -/ structure MdOk (H : Hash) where - hH : VG.Proof.Hmac.Generic.X86.HashOK H.st + hH : VG.Proof.Pbkdf2.Stream.X86.HashOK H.st md : Md H.B H.N H.L iv : md.HV link : md.Link hH.SH iv H.D + back : ∀ m p x, md.Repr iv m p x → hH.SH.Repr m p x reloc : md.Reloc tail : md.tailPad H.D = H.tailB out : OutOk md H.out diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean index d9805474f..6f7fb6baa 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Block -import VerifiedGarbage.Proof.Hmac.Generic.X86.Hashes +import VerifiedGarbage.Proof.Pbkdf2.Stream.X86.Hashes import VerifiedGarbage.Proof.Sha512.Md import VerifiedGarbage.Proof.Sha512.X86.Stream.Finalize @@ -7,7 +7,7 @@ import VerifiedGarbage.Proof.Sha512.X86.Stream.Finalize # HMAC and PBKDF2-HMAC on x86 (32-bit): the Merkle–Damgård hash functions MD5, SHA-1 and the SHA-512 family as `Hash`es of `Impl/Pbkdf2/Md/X86.lean`: -their streaming functions (`Proof/Hmac/Generic/X86/Hashes.lean`), their +their streaming functions (`Proof/Pbkdf2/Stream/X86/Hashes.lean`), their compression functions and the code writing their digests (`Impl.MdStream.X86.out32` for MD5 and SHA-1, SHA-512's `outW`), and what the proofs know of them (`MdOk`), from their own proofs: the `Md` of the generic @@ -22,7 +22,7 @@ namespace VG.Proof.Pbkdf2.Md.X86 open VG.X86 open VG.Impl.Pbkdf2.Md.X86 (Hash) open VG.Proof.MdStream (Md) -open VG.Proof.Hmac.Generic.X86 (md5H sha1H sha512H md5OK sha1OK sha384OK sha512OK sha512_224OK sha512_256OK) +open VG.Proof.Pbkdf2.Stream.X86 (md5H sha1H sha512H md5OK sha1OK sha384OK sha512OK sha512_224OK sha512_256OK) open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil writeBytes_append writeBytes_frame) /-! ## The hash functions -/ @@ -185,6 +185,7 @@ def md5Ok : MdOk md5M where show Spec.Md5.hash m = _ rw [Proof.Md5.hash_eq] exact (List.take_of_length_le (Nat.le_of_eq (Proof.Md5.md.digest_length _))).symm, by decide, by decide⟩ + back _ _ _ h := h reloc m m' p q h := by apply Vector.ext intro j hj @@ -203,6 +204,7 @@ def sha1Ok : MdOk sha1M where show Spec.Sha1.hash m = _ rw [Proof.Sha1.hash_eq] exact (List.take_of_length_le (Nat.le_of_eq (Proof.Sha1.md.digest_length _))).symm, by decide, by decide⟩ + back _ _ _ h := h reloc m m' p q h := by apply Vector.ext intro j hj @@ -216,7 +218,7 @@ def sha1Ok : MdOk sha1M where /-- `MdOk` for a member of the SHA-512 family, whose digest is the first `D` bytes of the final hash value. -/ def sha512Ok {D : Nat} {initN : String} {iv : Spec.Sha512.HashValue} - (hO : VG.Proof.Hmac.Generic.X86.HashOK (sha512H D initN iv)) (hR : hO.SH.Repr = Spec.Sha512.Repr iv) + (hO : VG.Proof.Pbkdf2.Stream.X86.HashOK (sha512H D initN iv)) (hR : hO.SH.Repr = Spec.Sha512.Repr iv) (hh : ∀ m, hO.SH.H.hash m = (Spec.Sha512.finalHash iv m).take D) (hB : hO.SH.H.blockSize = 128) (hS : hO.SH.stateBytes = 192) (hD : hO.SH.digestBytes = D) (hD64 : D ≤ 64) (tail : Proof.Sha512.md.tailPad D = (sha512M D initN iv).tailB) (sizes : Sizes (sha512M D initN iv)) : @@ -225,6 +227,7 @@ def sha512Ok {D : Nat} {initN : String} {iv : Spec.Sha512.HashValue} md := Proof.Sha512.md iv := iv link := ⟨hB, hS, hD, fun _ _ _ h => by rw [hR] at h; exact h, hh, hD64, by have := sizes.DL; omega⟩ + back _ _ _ h := by rw [hR]; exact h reloc m m' p q h := by apply Vector.ext intro j hj diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFin.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFin.lean index a60b14407..941d4c956 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFin.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFin.lean @@ -1,16 +1,16 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Block -import VerifiedGarbage.Proof.Hmac.Generic.X86.Finalize +import VerifiedGarbage.Proof.Pbkdf2.Stream.X86.Finalize /-! # HMAC over a Merkle–Damgård hash function on x86 (32-bit): `finalize`, correct -HMAC's `finalize` (`Impl/Pbkdf2/Md/X86.lean`) starts as in the streaming-level -design: the prologue and the call of the hash function's streaming `finalize` -on the inner state, which writes the inner digest to `scratch` -(`Proof/Hmac/Generic/X86/Finalize.lean`, whose `KR` the rest keeps). Then the -inner state gets the outer hash value and, in its buffer, the digest and the -padding (`mid_ok`); one compression (`cmpF_ok`) gives the outer hash value, -whose digest is the MAC (`out_ok`): `Md.Link.hmac_outer`. +HMAC's `finalize` (`Impl/Pbkdf2/Md/X86.lean`) starts with the prologue and the +call of the hash function's streaming `finalize` on the inner state, which +writes the inner digest to `scratch` (`Proof/Pbkdf2/Stream/X86/Finalize.lean`, +whose `KR` the rest keeps). Then the inner state gets the outer hash value +and, in its buffer, the digest and the padding (`mid_ok`); one compression +(`cmpF_ok`) gives the outer hash value, whose digest is the MAC (`out_ok`): +`Md.Link.hmac_outer`. -/ namespace VG.Proof.Pbkdf2.Md.X86.HmacFin @@ -19,9 +19,9 @@ open VG.X86 open VG.Impl.Pbkdf2.Md.X86 (Hash copyW) open VG.Proof.Pbkdf2.Md.X86 open VG.Proof.MdStream (Md) -open VG.Proof.Hmac.Generic.X86 (HashOK finG SavedRegs saveR savedRegs restore_ok callee_saved ea_at stk After +open VG.Proof.Pbkdf2.Stream.X86 (HashOK finG SavedRegs saveR savedRegs restore_ok callee_saved ea_at stk After setWidth_add toNat_add_ofNat) -open VG.Proof.Hmac.Generic.X86.Finalize (Pre KR E inn outer op scr inR outerR opR scR stkR T tR calR tO wr_mem +open VG.Proof.Pbkdf2.Stream.X86.Finalize (Pre KR E inn outer op scr inR outerR opR scR stkR T tR calR tO wr_mem save_sub t_sub save_t wrs kregs kregs_callee stk_eq pro_ok fin1Args_ok finCall_ok) open VG.Proof.Hmac.Generic.Common (InRegions.right' bytesAt_writeBytes_self' bytesAt_take covers_one) open VG.Proof.Sha256.X86.Stream (Upd wp_mov sub_offset) @@ -345,14 +345,14 @@ theorem correct : WP isa H.hmacFin s₀ fun s' => abiPreserved s₀ s' ∧ (finG rintro r (rfl | rfl | rfl | rfl) · exact hp.i_o.symm · exact hp.o_s.sub_right (t_sub hp) - · exact hp.o_s.sub_right (VG.Proof.Hmac.Generic.X86.Finalize.cal_sub hO.hH hp) + · exact hp.o_s.sub_right (VG.Proof.Pbkdf2.Stream.X86.Finalize.cal_sub hO.hH hp) · exact hp.b_o.symm - have rO₂ := Hmac.Generic.X86.Init.repr_keep hO.hH f₂ o₂ (m₁ ▸ Hmac.Generic.X86.Init.repr_keep hO.hH f₁ oI hrO) + have rO₂ := Pbkdf2.Stream.X86.repr_keep hO.hH f₂ o₂ (m₁ ▸ Pbkdf2.Stream.X86.repr_keep hO.hH f₁ oI hrO) -- The inner digest. - have dig := d₂ _ (m₁ ▸ Hmac.Generic.X86.Init.repr_keep hO.hH f₁ (by + have dig := d₂ _ (m₁ ▸ Pbkdf2.Stream.X86.repr_keep hO.hH f₁ (by simp only [List.mem_singleton]; rintro r rfl; exact hp.i_s.sub_right (save_sub hp)) hrI) (by rw [hl0]; rw [hk0] at hlen; exact hlen) - (by rw [show arg s₀ 3 ++ arg s₀ 2 = Hmac.Generic.X86.countF s₀ from rfl, hcnt, hl0]) + (by rw [show arg s₀ 3 ++ arg s₀ 2 = Pbkdf2.Stream.X86.countF s₀ from rfl, hcnt, hl0]) rw [← bytesAt_take _ _ hDF] at dig -- The outer hash value. have lo : (xorPad k0 opad).length = H.B := by simp [xorPad, hk0] diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFinCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFinCT.lean index c06a15b61..6d8c24229 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFinCT.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFinCT.lean @@ -3,13 +3,13 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.X86.HmacFin /-! # HMAC over a Merkle–Damgård hash function on x86 (32-bit): `finalize`, constant time -As for the streaming-level functions (`Proof/Hmac/Generic/X86/`): the pieces -between the calls are checked by the taint analysis, the prologue and the -arguments of the first call, which read the arguments on the stack, with them -public (`argTaint`); the call of the streaming `finalize` is related by -`fin_rel`, that of the compression function by `cmp_rel`. Then `finalize` is -verified against the contract with the arguments read only (`finG`), and with -them writable (`finW`). +As for HMAC's `init` (`HmacInitCT.lean`): the pieces between the calls are +checked by the taint analysis, the prologue and the arguments of the first +call, which read the arguments on the stack, with them public (`argTaint`); +the call of the streaming `finalize` is related by `fin_rel`, that of the +compression function by `cmp_rel`. Then `finalize` is verified against the +contract with the arguments read only (`finG`), and with them writable +(`finW`). -/ namespace VG.Proof.Pbkdf2.Md.X86.HmacFin @@ -17,16 +17,16 @@ namespace VG.Proof.Pbkdf2.Md.X86.HmacFin open VG.X86 open VG.Impl.Pbkdf2.Md.X86 (Hash) open VG.Proof.Pbkdf2.Md.X86 -open VG.Proof.Hmac.Generic.X86 (HashOK finG finW argTaint ArgsOut agree_argTaint rel_agree rel_wp stk fin_rel +open VG.Proof.Pbkdf2.Stream.X86 (HashOK finG finW argTaint ArgsOut agree_argTaint rel_agree rel_wp stk fin_rel FinArgs fin5) -open VG.Proof.Hmac.Generic.X86.Finalize (Pre KR E inn outer op scr tO pre_of pro_ok fin1Args_ok finCall_ok +open VG.Proof.Pbkdf2.Stream.X86.Finalize (Pre KR E inn outer op scr tO pre_of pro_ok fin1Args_ok finCall_ok stk_eq) /-- The taint checks of the pieces of `finalize` between its calls. -/ structure Checks (H : Hash) : Prop where pro : ∃ hc, (VG.Taint.check taint (argTaint [] (4 + 4 * 6)) (.block H.st.finPrologue) hc).isSome = true fin1 : ∃ hc, (VG.Taint.check taint (argTaint [.ebp, .ebx, .edi] (4 + 4 * 6)) - (.block ([] ++ Impl.Hmac.Generic.X86.Hash.count1 ++ Impl.Hmac.Generic.X86.scr .edx H.st.buf)) hc).isSome = true + (.block ([] ++ Impl.Pbkdf2.Stream.X86.Hash.count1 ++ Impl.Pbkdf2.Stream.X86.scr .edx H.st.buf)) hc).isSome = true mid : ∃ hc, (VG.Taint.check taint (τr [.esp, .ebp, .ebx, .edi, .esi]) (.block H.finMid) hc).isSome = true out : ∃ hc, (VG.Taint.check taint (τr [.esp, .ebp, .ebx, .edi]) (.block H.finOut) hc).isSome = true @@ -86,7 +86,7 @@ theorem ct : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.hmacFin fun _ _ = -- The call of the streaming `finalize`. have a1 : RelCT isa (fun s s' => (KR (H := H.st) sc s₀ s ∧ s.gpr .esi = outer s₀) ∧ (KR (H := H.st) sc s₀' s' ∧ s'.gpr .esi = outer s₀')) - (.block ([] ++ Impl.Hmac.Generic.X86.Hash.count1 ++ Impl.Hmac.Generic.X86.scr .edx H.st.buf)) + (.block ([] ++ Impl.Pbkdf2.Stream.X86.Hash.count1 ++ Impl.Pbkdf2.Stream.X86.scr .edx H.st.buf)) fun s s' => (KR (H := H.st) sc s₀ s ∧ FinArgs hH s .ebx (inn s₀) (tO (H := H.st) s₀) (scr s₀) (arg s₀ 2) (arg s₀ 3) ∧ s.gpr .esi = outer s₀) ∧ (KR (H := H.st) sc s₀' s' ∧ @@ -149,8 +149,8 @@ namespace VG.Proof.Pbkdf2.Md.X86.HmacFin open VG.X86 open VG.Impl.Pbkdf2.Md.X86 (Hash) open VG.Proof.Pbkdf2.Md.X86 -open VG.Proof.Hmac.Generic.X86 (finG finW) -open VG.Proof.Hmac.Generic.X86.Finalize (pre_of) +open VG.Proof.Pbkdf2.Stream.X86 (finG finW) +open VG.Proof.Pbkdf2.Stream.X86.Finalize (pre_of) /-- `finalize` is verified against `finG`, given the taint checks, which the kernel evaluates for each hash function. -/ diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInit.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInit.lean new file mode 100644 index 000000000..03c86c97d --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInit.lean @@ -0,0 +1,818 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Block +import VerifiedGarbage.Proof.Pbkdf2.MdInit + +/-! +# HMAC over a Merkle–Damgård hash function on x86 (32-bit): `init`, correct + +HMAC's `init` (`Impl/Pbkdf2/Md/X86.lean`): the prologue (`pro_ok`), the +streaming `init` of both states (`callInit_ok`), `ipad` in every byte of the +inner state's buffer (`fill_ok`) and the key XORed into its start +(`key_ok`), the outer buffer from the inner one, word by word +(`opadW_ok`), and one compression of each buffer into its state's hash +value (`cmpI_ok`, `cmpO_ok`): each state then represents its block +(`Md.repr_block`). +-/ + +namespace VG.Proof.Pbkdf2.Md.X86 + +open VG.X86 +open VG.Impl.Pbkdf2.Stream.X86 (at_) +open VG.Impl.Pbkdf2.Md.X86 (Hash) +open VG.Proof.Sha256.X86.Stream (Upd Mupd Fupd wp_mov wp_movi wp_movm wp_store wp_addi wp_subi wp_test + wp_movzx8 wp_store8 ofNat_beq_zero ofNat_pred ofNat_succ addr_add_ofNat) +open VG.Proof.Pbkdf2.Stream.X86 (ea_at wp_xori count_loop) +open VG.Proof.Hmac.Common (bytesAt_length bytesAt_add bytesAt_writeBytes_sep extractLsb'_read) +open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil writeBytes_append writeBytes_frame) +open Spec.Sha256 (bytesAt) + +/-! ## Words of a constant, and words XORed with a constant -/ + +/-- `n` words of `ecx` stored at `[y + o]`, `[y + o + 4]`, … -/ +theorem fillW_ok {dst : Reg} {y : BitVec 32} {o : Nat} {b : Byte} (n : Nat) : + ∀ (rest : List Instr) (s : State) (Q : State → Prop), s.gpr .ecx = b ++ b ++ b ++ b → + s.gpr dst = y → y.toNat + o + 4 * n ≤ 2 ^ 32 → (∀ k < n, InRegions s.wr (addr y (o + 4 * k)) 4) → + (∀ s', s'.gpr = s.gpr → s'.rd = s.rd → s'.wr = s.wr → + s'.mem = writeBytes s.mem (y.setWidth 64 + BitVec.ofNat 64 o) (List.replicate (4 * n) b) → + WP isa (.block rest) s' Q) → + WP isa (.block ((List.range n).map (fun k => Instr.store (at_ dst (o + 4 * k)) .ecx) ++ rest)) s Q := by + induction n with + | zero => + intro rest s Q _ _ _ _ k + exact k s rfl rfl rfl (by simp [writeBytes_nil]) + | succ n ih => + intro rest s Q hc hy fy hout k + rw [List.range_succ, List.map_append, List.map_singleton, List.append_assoc] + refine ih _ s Q hc hy (by omega) (fun j hj => hout j (by omega)) fun s₁ g₁ rd₁ wr₁ m₁ => ?_ + simp only [List.cons_append, List.nil_append] + refine wp_store (a := addr y (o + 4 * n)) (by rw [ea_at, g₁, hy]) (by rw [wr₁]; exact hout n (by omega)) + fun s₂ u₂ => ?_ + refine k s₂ (by rw [u₂.gpr, g₁]) (by rw [u₂.rd, rd₁]) (by rw [u₂.wr, wr₁]) ?_ + rw [u₂.mem, m₁, g₁, hc, addr_word fy (by omega : n < n + 1), MdInit.writeW_rep, + Memory.writeBytes_append' _ _ _ (by rw [List.length_replicate]) (by simp; omega), List.replicate_append_replicate, + show 4 * n + 4 = 4 * (n + 1) by omega] + +/-- The outer state's buffer, from the inner one's: `n` words of +`[ebx + N + 4 k]`, XORed with `0x6a` in every byte, into `[esi + N + 4 k]`. -/ +theorem opadW_ok (H : Hash) {x y : BitVec 32} (n : Nat) : + ∀ (rest : List Instr) (s : State) (Q : State → Prop), s.gpr .ebx = x → s.gpr .esi = y → + x.toNat + H.N + 4 * n ≤ 2 ^ 32 → y.toNat + H.N + 4 * n ≤ 2 ^ 32 → + (∀ k < n, InRegions (s.rd ++ s.wr) (addr x (H.N + 4 * k)) 4) → + (∀ k < n, InRegions s.wr (addr y (H.N + 4 * k)) 4) → + Region.Disjoint ⟨x.setWidth 64 + BitVec.ofNat 64 H.N, 4 * n⟩ ⟨y.setWidth 64 + BitVec.ofNat 64 H.N, 4 * n⟩ → + (∀ s', (∀ r, r ≠ .eax → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → + s'.mem = writeBytes s.mem (y.setWidth 64 + BitVec.ofNat 64 H.N) + ((bytesAt s.mem (x.setWidth 64 + BitVec.ofNat 64 H.N) (4 * n)).map (· ^^^ 0x6a)) → + WP isa (.block rest) s' Q) → + WP isa (.block ((List.range n).flatMap H.opadW ++ rest)) s Q := by + induction n with + | zero => + intro rest s Q _ _ _ _ _ _ _ k + exact k s (fun _ _ => rfl) rfl rfl (by simp [bytesAt, writeBytes_nil]) + | succ n ih => + intro rest s Q hx hy fx fy hin hout hsep k + rw [List.range_succ, List.flatMap_append, List.flatMap_singleton, List.append_assoc] + refine ih _ s Q hx hy (by omega) (by omega) (fun j hj => hin j (by omega)) (fun j hj => hout j (by omega)) + ((hsep.sub_left (Region.sub_prefix (by omega))).sub_right (Region.sub_prefix (by omega))) + fun s₁ g₁ rd₁ wr₁ m₁ => ?_ + simp only [Hash.opadW, List.cons_append, List.nil_append] + refine wp_movm (a := addr x (H.N + 4 * n)) (by rw [ea_at, g₁ _ (by decide), hx]) + (by rw [rd₁, wr₁]; exact hin n (by omega)) fun s₂ u₂ => wp_xori fun s₃ u₃ => ?_ + refine wp_store (a := addr y (H.N + 4 * n)) + (by rw [ea_at, u₃.other _ (by decide), u₂.other _ (by decide), g₁ _ (by decide), hy]) + (by rw [u₃.wr, u₂.wr, wr₁]; exact hout n (by omega)) fun s₄ u₄ => ?_ + refine k s₄ (fun r hr => by rw [u₄.gpr, u₃.other r hr, u₂.other r hr, g₁ r hr]) + (by rw [u₄.rd, u₃.rd, u₂.rd, rd₁]) (by rw [u₄.wr, u₃.wr, u₂.wr, wr₁]) ?_ + have hl : ((bytesAt s.mem (x.setWidth 64 + BitVec.ofNat 64 H.N) (4 * n)).map (· ^^^ (0x6a : Byte))).length = + 4 * n := by simp [bytesAt_length] + have f₁ : Frame [⟨y.setWidth 64 + BitVec.ofNat 64 H.N, 4 * n⟩] s.mem s₁.mem := by + rw [m₁]; exact writeBytes_frame _ _ _ (by rw [hl]; exact Region.contains_self _ _) + have dX : ∀ r ∈ [(⟨y.setWidth 64 + BitVec.ofNat 64 H.N, 4 * n⟩ : Region)], + Region.Disjoint ⟨x.setWidth 64 + BitVec.ofNat 64 H.N + BitVec.ofNat 64 (4 * n), 4⟩ r := by + simp only [List.mem_singleton]; rintro r rfl + exact (hsep.sub_left (Offset.sub_base _ (by omega))).sub_right (Region.sub_prefix (by omega)) + rw [u₄.mem, u₃.gpr, u₂.gpr, u₃.mem, u₂.mem, addr_word fx (by omega : n < n + 1), + addr_word fy (by omega : n < n + 1), + f₁.readW (r := ⟨_, 4⟩) (Region.contains_self _ _) dX (by decide), MdInit.c6a, MdInit.writeW_xorRep, m₁, + Memory.writeBytes_append' _ _ _ (by rw [hl]) (by simp [bytesAt_length]; omega), ← List.map_append, + ← bytesAt_add, show 4 * n + 4 = 4 * (n + 1) by omega] + +/-! ## The key loop -/ + +/-- After `j` bytes of the key loop, from `s`: the key at `K`, its `kl` +bytes, XORed with `ipad`, written at `P`. -/ +structure KeyInv (s : State) (kp p : BitVec 32) (kl j : Nat) (t : State) : Prop where + rd : t.rd = s.rd + wr : t.wr = s.wr + other : ∀ r, r ≠ .eax → r ≠ .ecx → r ≠ .edx → r ≠ .edi → t.gpr r = s.gpr r + edi : t.gpr .edi = kp + BitVec.ofNat 32 j + edx : t.gpr .edx = p + BitVec.ofNat 32 j + ecx : t.gpr .ecx = BitVec.ofNat 32 (kl - j) + mem : t.mem = writeBytes s.mem (p.setWidth 64) ((bytesAt s.mem (kp.setWidth 64) j).map (· ^^^ Spec.Hmac.ipad)) + +theorem key_step {s : State} {kp p : BitVec 32} {kl : Nat} (hkp : kp.toNat + kl ≤ 2 ^ 32) + (hp : p.toNat + kl ≤ 2 ^ 32) (hkl : kl < 2 ^ 32) + (hin : ∀ j < kl, InRegions (s.rd ++ s.wr) (kp.setWidth 64 + BitVec.ofNat 64 j) 1) + (hout : ∀ j < kl, InRegions s.wr (p.setWidth 64 + BitVec.ofNat 64 j) 1) + (hsep : Region.Disjoint ⟨kp.setWidth 64, kl⟩ ⟨p.setWidth 64, kl⟩) {j : Nat} (hj : j < kl) {t : State} + (h : KeyInv s kp p kl j t) : + WP isa (.block [.movzx8 .eax (at_ .edi 0), .alu .xor .eax (.imm 0x36), .store8 (at_ .edx 0) .al, + .alu .add .edi (.imm 1), .alu .add .edx (.imm 1), .alu .sub .ecx (.imm 1)]) t + fun t' => KeyInv s kp p kl (j + 1) t' ∧ t'.zf = some (decide (j + 1 = kl)) := by + have hl : ((bytesAt s.mem (kp.setWidth 64) j).map (· ^^^ Spec.Hmac.ipad)).length = j := by + simp [bytesAt_length] + have hbyte : t.mem (kp.setWidth 64 + BitVec.ofNat 64 j) = s.mem (kp.setWidth 64 + BitVec.ofNat 64 j) := by + rw [h.mem] + refine (writeBytes_frame _ _ _ (by rw [hl]; exact Region.contains_self _ _)).bytes + (R := ⟨kp.setWidth 64, kl⟩) (by + simp only [List.mem_singleton]; rintro r rfl + exact hsep.sub_right (Region.sub_prefix (by omega))) (by show kl ≤ 2 ^ 64; omega) hj + refine wp_movzx8 (a := kp.setWidth 64 + BitVec.ofNat 64 j) + (by rw [ea_at, h.edi, addr_add_ofNat (by omega), Nat.add_zero]) (by rw [h.rd, h.wr]; exact hin j hj) + fun t₁ u₁ => wp_xori fun t₂ u₂ => ?_ + refine wp_store8 (a := p.setWidth 64 + BitVec.ofNat 64 j) + (by rw [ea_at, u₂.other _ (by decide), u₁.other _ (by decide), h.edx, addr_add_ofNat (by omega), Nat.add_zero]) + (by rw [u₂.wr, u₁.wr, h.wr]; exact hout j hj) fun t₃ u₃ => ?_ + refine wp_addi fun t₄ u₄ => wp_addi fun t₅ u₅ => wp_subi fun t₆ u₆ z₆ => WP.block_nil ?_ + have ecx₅ : t₅.gpr .ecx = BitVec.ofNat 32 (kl - j) := by + rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), + h.ecx] + have v : (t₂.gpr Reg8.al.reg).setWidth 8 = s.mem (kp.setWidth 64 + BitVec.ofNat 64 j) ^^^ Spec.Hmac.ipad := by + show (t₂.gpr .eax).setWidth 8 = _ + rw [u₂.gpr, u₁.gpr, MdInit.xor_byte, hbyte]; rfl + refine ⟨⟨by rw [u₆.rd, u₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], + by rw [u₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], + fun r h1 h2 h3 h4 => by + rw [u₆.other r h2, u₅.other r h3, u₄.other r h4, u₃.gpr, u₂.other r h1, u₁.other r h1, h.other r h1 h2 h3 h4], + by rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, u₃.gpr, u₂.other _ (by decide), + u₁.other _ (by decide), h.edi, ofNat_succ, BitVec.add_assoc], + by rw [u₆.other _ (by decide), u₅.gpr, u₄.other _ (by decide), u₃.gpr, u₂.other _ (by decide), + u₁.other _ (by decide), h.edx, ofNat_succ, BitVec.add_assoc], + by rw [u₆.gpr, ecx₅, ofNat_pred (by omega), show kl - j - 1 = kl - (j + 1) by omega], ?_⟩, ?_⟩ + · rw [u₆.mem, u₅.mem, u₄.mem, u₃.mem, v, u₂.mem, u₁.mem, h.mem] + have e := VG.Proof.Hmac.Generic.Common.writeBytes_snoc s.mem (p.setWidth 64) + ((bytesAt s.mem (kp.setWidth 64) j).map (· ^^^ Spec.Hmac.ipad)) + (s.mem (kp.setWidth 64 + BitVec.ofNat 64 j) ^^^ Spec.Hmac.ipad) (by rw [hl]; omega) + rw [hl] at e + rw [e, VG.Proof.Hmac.Generic.Common.bytesAt_snoc', List.map_append, List.map_singleton] + · rw [z₆, ecx₅, ofNat_pred (by omega), ofNat_beq_zero (by omega)] + exact congrArg some (decide_eq_decide.mpr (by omega)) + +/-- The key loop, skipped for an empty key: from the flags of `kl = 0`. -/ +theorem key_ok {s : State} {kp p : BitVec 32} {kl : Nat} (hkp : kp.toNat + kl ≤ 2 ^ 32) + (hp : p.toNat + kl ≤ 2 ^ 32) (hkl : kl < 2 ^ 32) + (hin : ∀ j < kl, InRegions (s.rd ++ s.wr) (kp.setWidth 64 + BitVec.ofNat 64 j) 1) + (hout : ∀ j < kl, InRegions s.wr (p.setWidth 64 + BitVec.ofNat 64 j) 1) + (hsep : Region.Disjoint ⟨kp.setWidth 64, kl⟩ ⟨p.setWidth 64, kl⟩) + (h0 : KeyInv s kp p kl 0 s) (hz : s.zf = some (decide (kl = 0))) : + WP isa (.ite .e (.block []) Hash.keyLoop) s (KeyInv s kp p kl kl) := by + refine WP.ite (decide (kl = 0)) (by show eval .e s = _; rw [VG.Proof.Sha256.X86.Stream.eval_e, hz]) + (fun e => WP.block_nil ?_) fun e => ?_ + · have : kl = 0 := by simpa using e + subst this; exact h0 + · exact count_loop (by simp at e; omega) _ (fun j hj t h => key_step hkp hp hkl hin hout hsep hj h) h0 + +end VG.Proof.Pbkdf2.Md.X86 + +namespace VG.Proof.Pbkdf2.Md.X86.HmacInit + +open VG.X86 +open VG.Impl.Pbkdf2.Md.X86 (Hash) +open VG.Impl.Pbkdf2.Stream.X86 (at_) +open VG.Proof.Pbkdf2.Md.X86 +open VG.Proof.MdStream (Md) +open VG.Proof.Pbkdf2.Stream.X86 (HashOK initG SavedRegs saveR savedRegs save_ok restore_ok callee_saved ea_at stk + After stk_args stk_ret arg_keep arg_contains arg_sub argAddr_eq init_frame setWidth_add toNat_add_ofNat) +open VG.Proof.Hmac.Generic.Common (off_disj off_disj0 covers_one InRegions.right' bytesAt_writeBytes_self') +open VG.Proof.Sha256.X86.Stream (Upd wp_mov wp_movi wp_movm wp_add wp_addi wp_test sub_offset ofNat_beq_zero) +open VG.Proof.Hmac.Common (bytesAt_length bytesAt_add bytesAt_writeBytes_sep xorPad_length) +open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil writeBytes_frame) +open Spec.Sha256 (bytesAt) +open Spec.Hmac (xorPad ipad opad blockKey) + +variable {H : Hash} (sc : Nat) + +section +variable (s₀ : State) + +abbrev E : BitVec 32 := s₀.gpr .esp +abbrev inn : BitVec 32 := arg s₀ 0 +abbrev out : BitVec 32 := arg s₀ 1 +abbrev kp : BitVec 32 := arg s₀ 2 +abbrev kl : Nat := (arg s₀ 3).toNat +abbrev scr : BitVec 32 := arg s₀ 4 +abbrev inR : Region := ⟨(inn s₀).setWidth 64, H.N + H.B⟩ +abbrev outR : Region := ⟨(out s₀).setWidth 64, H.N + H.B⟩ +abbrev keyR : Region := ⟨(kp s₀).setWidth 64, kl s₀⟩ +abbrev scR : Region := ⟨(scr s₀).setWidth 64, 8 * sc⟩ +abbrev argR : Region := ⟨addr (E s₀) 4, 20⟩ +abbrev retR : Region := ⟨(E s₀).setWidth 64, 4⟩ +abbrev stkR : Region := below (E s₀) 48 +/-- The compression function's scratch space. -/ +abbrev cmpR : Region := ⟨(scr s₀).setWidth 64, H.so⟩ + +end + +/-- The precondition. -/ +structure Pre (s₀ : State) : Prop where + kl_le : kl s₀ ≤ H.B + rd : s₀.rd = [keyR s₀, argR s₀] + wr : s₀.wr = [inR (H := H) s₀, outR (H := H) s₀, scR sc s₀] + i_o : (inR (H := H) s₀).Disjoint (outR (H := H) s₀) + i_s : (inR (H := H) s₀).Disjoint (scR sc s₀) + o_s : (outR (H := H) s₀).Disjoint (scR sc s₀) + k_i : (keyR s₀).Disjoint (inR (H := H) s₀) + k_o : (keyR s₀).Disjoint (outR (H := H) s₀) + k_s : (keyR s₀).Disjoint (scR sc s₀) + a_i : (argR s₀).Disjoint (inR (H := H) s₀) + a_o : (argR s₀).Disjoint (outR (H := H) s₀) + a_s : (argR s₀).Disjoint (scR sc s₀) + r_i : (retR s₀).Disjoint (inR (H := H) s₀) + r_o : (retR s₀).Disjoint (outR (H := H) s₀) + r_s : (retR s₀).Disjoint (scR sc s₀) + b_i : (stkR s₀).Disjoint (inR (H := H) s₀) + b_o : (stkR s₀).Disjoint (outR (H := H) s₀) + b_k : (stkR s₀).Disjoint (keyR s₀) + b_s : (stkR s₀).Disjoint (scR sc s₀) + ni : (inn s₀).toNat + (H.N + H.B) ≤ 2 ^ 32 + no : (out s₀).toNat + (H.N + H.B) ≤ 2 ^ 32 + nk : (kp s₀).toNat + kl s₀ ≤ 2 ^ 32 + nw : (scr s₀).toNat + 8 * sc ≤ 2 ^ 32 + sp48 : 48 ≤ (E s₀).toNat + spf : (E s₀).toNat + 24 ≤ 2 ^ 32 + fits : H.st.buf ≤ 8 * sc + +theorem pre_of (hO : MdOk H) {s₀ : State} (h : (initG hO.hH.SH sc).pre s₀) (hfit : H.st.buf ≤ 8 * sc) : + Pre (H := H) sc s₀ := by + obtain ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, + h21, h22, h23, h24⟩ := h + have hS : hO.hH.SH.stateBytes = H.N + H.B := hO.hH.hS.trans hO.sizes.S + have hB := hO.hH.hB + have e : (⟨(s₀.gpr .esp).setWidth 64 - 48, 48⟩ : Region) = stkR s₀ := by + simp only [stkR, below]; rw [Taint.sub_setWidth h23]; rfl + simp only [hS, hB, e] at * + exact ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, h21, h22, + h23, h24, hfit⟩ + +/-! ## Sizes and regions -/ + +section +variable {H : Hash} (hz : Sizes H) {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) +include hz hp + +theorem bounds : H.st.buf = 8 * H.st.W + 16 ∧ 8 * H.st.W + 16 ≤ 8 * sc ∧ (scr s₀).toNat + 8 * sc ≤ 2 ^ 32 ∧ + H.so ≤ 8 * H.st.W ∧ H.st.W ≤ 64 ∧ 0 < H.N ∧ H.N ≤ 64 ∧ H.N % 4 = 0 ∧ H.B % 4 = 0 ∧ 64 ≤ H.B ∧ H.B ≤ 128 ∧ + (inn s₀).toNat + (H.N + H.B) ≤ 2 ^ 32 ∧ (out s₀).toNat + (H.N + H.B) ≤ 2 ^ 32 ∧ + (kp s₀).toNat + kl s₀ ≤ 2 ^ 32 ∧ kl s₀ ≤ H.B := by + have := hz.B4 + exact ⟨rfl, hp.fits, hp.nw, hz.so, hz.W, hz.N.1, hz.N.2.1, hz.N.2.2, this.1, this.2.1, this.2.2, hp.ni, hp.no, + hp.nk, hp.kl_le⟩ + +theorem save_sub : Region.Sub (saveR H.st (scr s₀)) (scR sc s₀) := by + have := bounds hz hp; exact sub_offset (by omega) (by omega) + +theorem cmp_sub : Region.Sub (cmpR (H := H) s₀) (scR sc s₀) := by + have := bounds hz hp; exact Region.sub_prefix (by omega) + +theorem save_cmp : (saveR H.st (scr s₀)).Disjoint (cmpR (H := H) s₀) := by + have := bounds hz hp + exact Offset.disjoint_base _ (by omega) (by omega) + +omit hz hp in +/-- A part of a state at `p`. -/ +theorem st_sub (p : BitVec 32) {a n : Nat} (h : a + n ≤ H.N + H.B) : + Region.Sub ⟨p.setWidth 64 + BitVec.ofNat 64 a, n⟩ ⟨p.setWidth 64, H.N + H.B⟩ := Offset.sub_base _ h + +/-- The states, `scratch` and the stack below `esp`, as the code sees them. -/ +theorem st_facts {p : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) : + Region.Disjoint ⟨p.setWidth 64, H.N + H.B⟩ (scR sc s₀) ∧ (stkR s₀).Disjoint ⟨p.setWidth 64, H.N + H.B⟩ ∧ + (saveR H.st (scr s₀)).Disjoint ⟨p.setWidth 64, H.N + H.B⟩ ∧ p.toNat + (H.N + H.B) ≤ 2 ^ 32 ∧ + ⟨p.setWidth 64, H.N + H.B⟩ ∈ s₀.wr := by + rcases hpR with rfl | rfl + · exact ⟨hp.i_s, hp.b_i, hp.i_s.symm.sub_left (save_sub hz hp), hp.ni, by rw [hp.wr]; simp⟩ + · exact ⟨hp.o_s, hp.b_o, hp.o_s.symm.sub_left (save_sub hz hp), hp.no, by rw [hp.wr]; simp⟩ + +end + +/-! ## What the pieces keep -/ + +/-- The regions everything writes: our buffers and the stack below `esp`. -/ +abbrev wrs (s₀ : State) : List Region := [inR (H := H) s₀, outR (H := H) s₀, scR sc s₀, stkR s₀] + +/-- The registers and memory kept from the prologue on. -/ +structure KR (s₀ s : State) : Prop where + rd : s.rd = s₀.rd + wr : s.wr = s₀.wr + esp : s.gpr .esp = E s₀ + ebp : s.gpr .ebp = scr s₀ + esi : s.gpr .esi = out s₀ + saved : SavedRegs H.st (scr s₀) s₀ s.mem + frame : Frame (wrs (H := H) sc s₀) s₀.mem s.mem + +/-- The registers `KR` fixes. -/ +abbrev kregs : List Reg := [.esp, .ebp, .esi] + +theorem kregs_callee : ∀ r ∈ kregs, r ∈ calleeSaved := by decide + +section +variable {sc : Nat} + +theorem KR.keep {s₀ s s' : State} (h : KR (H := H) sc s₀ s) (hrd : s'.rd = s.rd) (hwr : s'.wr = s.wr) + (hg : ∀ r ∈ kregs, s'.gpr r = s.gpr r) {rs : List Region} (hf : Frame rs s.mem s'.mem) + (hs : ∀ r ∈ rs, (saveR H.st (scr s₀)).Disjoint r) + (hsub : ∀ r ∈ rs, ∃ r' ∈ wrs (H := H) sc s₀, Region.Sub r r') : KR (H := H) sc s₀ s' := + ⟨hrd.trans h.rd, hwr.trans h.wr, (hg _ (by simp)).trans h.esp, (hg _ (by simp)).trans h.ebp, + (hg _ (by simp)).trans h.esi, h.saved.frame H.st hf hs, h.frame.trans (hf.sub hsub)⟩ + +theorem KR.upd {s₀ s s' : State} (h : KR (H := H) sc s₀ s) {d : Reg} (hd : d ∉ kregs) {v : BitVec 32} + (u : Upd s s' d v) : KR (H := H) sc s₀ s' := + h.keep u.rd u.wr (fun r hr => u.other r fun e => hd (e ▸ hr)) (rs := []) + (by rw [u.mem]; exact Frame.refl _ _) (by simp) (by simp) + +theorem stk_eq {s₀ s : State} (hk : KR (H := H) sc s₀ s) : stk s = stkR s₀ := by rw [stk, hk.esp] + +end + +section +variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) +include hp + +theorem stk_arg : (stkR s₀).Disjoint (argR s₀) := stk_args hp.sp48 (by have := hp.spf; omega) + +theorem stk_ret' : (stkR s₀).Disjoint (retR s₀) := stk_ret hp.sp48 (by have := hp.spf; omega) + +theorem argIn {s : State} (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) {i : Nat} (hi : i < 5) : + InRegions (s.rd ++ s.wr) (argAddr s₀ i) 4 := by + rw [hrd, hwr] + exact ⟨argR s₀, by rw [hp.rd]; simp, arg_contains rfl (by omega) (by have := hp.spf; omega)⟩ + +theorem KR.argEq {s : State} (hk : KR (H := H) sc s₀ s) {i : Nat} (hi : i < 5) : arg s i = arg s₀ i := + arg_keep rfl hk.esp (n := 20) (by have := hp.spf; omega) hk.frame (by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl | rfl) + · exact hp.a_i + · exact hp.a_o + · exact hp.a_s + · exact (stk_arg hp).symm) (by omega) + +theorem KR.readArg {s : State} (hk : KR (H := H) sc s₀ s) {i : Nat} (hi : i < 5) : + s.mem.readW (argAddr s₀ i) 32 = arg s₀ i := by + have := hk.argEq hp hi + simp only [arg] at this ⊢ + rwa [show argAddr s i = argAddr s₀ i by rw [argAddr_eq, argAddr_eq, hk.esp]] at this + +theorem KR.ret {s : State} (hk : KR (H := H) sc s₀ s) : + s.mem.readW ((E s₀).setWidth 64) 32 = s₀.mem.readW ((E s₀).setWidth 64) 32 := + hk.frame.readW (r := retR s₀) (Region.contains_self _ _) (by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl | rfl) + · exact hp.r_i + · exact hp.r_o + · exact hp.r_s + · exact (stk_ret' hp).symm) (by decide) + +/-- The key, while `KR` holds. -/ +theorem KR.key {s : State} (hk : KR (H := H) sc s₀ s) : + bytesAt s.mem ((kp s₀).setWidth 64) (kl s₀) = bytesAt s₀.mem ((kp s₀).setWidth 64) (kl s₀) := + Memory.frame_bytesAt hk.frame (by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl | rfl) + · exact hp.k_i + · exact hp.k_o + · exact hp.k_s + · exact hp.b_k.symm) (Nat.le_of_lt (Nat.lt_trans (arg s₀ 3).isLt (by decide))) + +end + +/-! ## The pieces -/ + +section +variable {sc : Nat} {s₀ : State} (hz : Sizes H) (hp : Pre (H := H) sc s₀) +include hz hp + +theorem pro_ok : WP isa (.block H.initPrologue) s₀ fun s => KR (H := H) sc s₀ s ∧ s.gpr .ebx = inn s₀ := by + obtain ⟨hb, hf, nw, -, hW, -⟩ := bounds hz hp + have sR : scR sc s₀ ∈ s₀.wr := by rw [hp.wr]; simp + have dA : ∀ r ∈ [saveR H.st (scr s₀)], (argR s₀).Disjoint r := by + simp only [List.mem_singleton]; rintro r rfl; exact hp.a_s.sub_right (save_sub hz hp) + simp only [Hash.initPrologue, List.singleton_append] + refine wp_movm (a := argAddr s₀ 4) (by rw [ea_at]; rfl) (argIn hp rfl rfl (by decide)) fun s₁ u₁ => ?_ + refine save_ok H.st (scr := scr s₀) u₁.gpr hW (by rw [u₁.wr]; exact sR) (by omega) (by omega) + fun s₂ g₂ rd₂ wr₂ f₂ sv₂ => ?_ + have e₂ : ∀ r, r ≠ .eax → s₂.gpr r = s₀.gpr r := fun r hr => by rw [g₂, u₁.other r hr] + have f₂' : Frame [saveR H.st (scr s₀)] s₀.mem s₂.mem := by rw [← u₁.mem]; exact f₂ + have rA : ∀ i < 5, s₂.mem.readW (argAddr s₀ i) 32 = arg s₀ i := fun i hi => + f₂'.readW (r := ⟨argAddr s₀ i, 4⟩) (Region.contains_self _ _) (fun r hr => + (dA r hr).sub_left (arg_sub rfl (by omega) (by have := hp.spf; omega))) (by decide) + have i₂ : ∀ i < 5, InRegions (s₂.rd ++ s₂.wr) (argAddr s₀ i) 4 := fun i hi => by + rw [rd₂, wr₂, u₁.rd, u₁.wr]; exact argIn hp rfl rfl hi + refine wp_mov fun s₃ u₃ => ?_ + refine wp_movm (a := argAddr s₀ 0) (by rw [ea_at, u₃.other _ (by decide), e₂ _ (by decide)]; rfl) + (by rw [u₃.rd, u₃.wr]; exact i₂ 0 (by decide)) fun s₄ u₄ => ?_ + refine wp_movm (a := argAddr s₀ 1) (by + rw [ea_at, u₄.other _ (by decide), u₃.other _ (by decide), e₂ _ (by decide)]; rfl) + (by rw [u₄.rd, u₄.wr, u₃.rd, u₃.wr]; exact i₂ 1 (by decide)) fun s₅ u₅ => WP.block_nil ?_ + have hm : s₅.mem = s₂.mem := by rw [u₅.mem, u₄.mem, u₃.mem] + refine ⟨⟨by rw [u₅.rd, u₄.rd, u₃.rd, rd₂, u₁.rd], by rw [u₅.wr, u₄.wr, u₃.wr, wr₂, u₁.wr], + by rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), e₂ _ (by decide)], + by rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, g₂, u₁.gpr]; rfl, + by rw [u₅.gpr, u₄.mem, u₃.mem, rA 1 (by decide)], + hm ▸ sv₂.of_eq H.st fun r hr => u₁.other r (by + simp only [savedRegs, List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl | rfl <;> decide), + (hm ▸ f₂').sub fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact ⟨scR sc s₀, by simp, save_sub hz hp⟩⟩, + by rw [u₅.other _ (by decide), u₄.gpr, u₃.mem, rA 0 (by decide)]⟩ + +end + +/-! ## The calls -/ + +section +variable {sc : Nat} {s₀ : State} (hz : Sizes H) (hp : Pre (H := H) sc s₀) +include hz hp + +/-- `KR` after a call that writes `rs`, parts of our buffers. -/ +theorem KR.call {s s' : State} (hk : KR (H := H) sc s₀ s) {rs : List Region} (ha : After s rs s') + (hs : ∀ r ∈ rs, (saveR H.st (scr s₀)).Disjoint r) (hsub : ∀ r ∈ rs, ∃ r' ∈ wrs (H := H) sc s₀, Region.Sub r r') : + KR (H := H) sc s₀ s' := by + have f := ha.frame + rw [stk_eq hk] at f + refine hk.keep ha.rd ha.wr (fun r hr => ha.cs r (kregs_callee r hr)) f ?_ ?_ + · simp only [List.mem_append, List.mem_singleton] + rintro r (hr | rfl) + · exact hs r hr + · exact hp.b_s.symm.sub_left (save_sub hz hp) + · simp only [List.mem_append, List.mem_singleton] + rintro r (hr | rfl) + · exact hsub r hr + · exact ⟨stkR s₀, by simp, fun _ h => h⟩ + +/-- What a call of the streaming `init` on the state at `p`, in `st`, needs. -/ +theorem initArgs {s : State} (hk : KR (H := H) sc s₀ s) {st : Reg} {p : BitVec 32} + (hst : st = .ebx ∧ p = inn s₀ ∨ st = .esi ∧ p = out s₀) (hsr : s.gpr st = p) : + VG.Proof.Pbkdf2.Stream.X86.InitArgs (H := H.st) s st p := by + have hpR : p = inn s₀ ∨ p = out s₀ := by rcases hst with ⟨_, h⟩ | ⟨_, h⟩ <;> simp [h] + obtain ⟨_, dK, _, np, hin⟩ := st_facts hz hp hpR + have hS : H.st.S = H.N + H.B := hz.S + exact + { hst := hsr + hr := by rcases hst with ⟨rfl, _⟩ | ⟨rfl, _⟩ <;> decide + sp48 := by rw [hk.esp]; exact hp.sp48 + cw := by rw [hk.wr, hS]; exact covers_one hin + b_st := by rw [stk_eq hk, hS]; exact dK + nst := by rw [hS]; exact np } + +/-- A call of the streaming `init` on the state at `p`, in `st`. -/ +theorem callInit_ok (hO : MdOk H) {s : State} (hk : KR (H := H) sc s₀ s) {st : Reg} {p : BitVec 32} + (hst : st = .ebx ∧ p = inn s₀ ∨ st = .esi ∧ p = out s₀) (hsr : s.gpr st = p) {Q : State → Prop} + (hQ : ∀ s', KR (H := H) sc s₀ s' → s'.gpr .ebx = s.gpr .ebx → + Frame [⟨p.setWidth 64, H.N + H.B⟩, stkR s₀] s.mem s'.mem → hO.hH.SH.Repr s'.mem (p.setWidth 64) [] → Q s') : + WP isa (H.st.callInit st) s Q := by + have hpR : p = inn s₀ ∨ p = out s₀ := by rcases hst with ⟨_, h⟩ | ⟨_, h⟩ <;> simp [h] + obtain ⟨_, _, dV, _, _⟩ := st_facts hz hp hpR + have hS : H.st.S = H.N + H.B := hz.S + refine init_frame hO.hH (initArgs hz hp hk hst hsr) fun s' ha hr => ?_ + rw [hS] at ha + have f := ha.frame + rw [stk_eq hk] at f + exact hQ s' (KR.call hz hp hk ha (by simp only [List.mem_singleton]; rintro r rfl; exact dV) + (by + simp only [List.mem_singleton]; rintro r rfl + rcases hpR with rfl | rfl + · exact ⟨inR (H := H) s₀, by simp, fun _ h => h⟩ + · exact ⟨outR (H := H) s₀, by simp, fun _ h => h⟩)) (ha.cs .ebx (by decide)) f hr + +/-- What the compression of the buffer of the state at `p`, in `ebx`, with +`eax` at the buffer, needs. -/ +theorem cmpArgs {s : State} (hk : KR (H := H) sc s₀ s) {p : BitVec 32} + (hpR : p = inn s₀ ∨ p = out s₀) (hbx : s.gpr .ebx = p) (hax : s.gpr .eax = p + BitVec.ofNat 32 H.N) : + CmpArgs H.N H.B H.so s p (scr s₀) := by + obtain ⟨hb, hf, nw, hso, hW, -⟩ := bounds hz hp + obtain ⟨dS, dK, dV, np, hin⟩ := st_facts hz hp hpR + exact + { ebx := hbx, eax := hax, ebp := hk.ebp, sp48 := by rw [hk.esp]; exact hp.sp48 + cst := by rw [hk.wr]; exact covers_one hin + csc := by + rw [hk.wr] + exact Covers.of_sub fun r hr => by + simp only [List.mem_singleton] at hr; subst hr + exact ⟨scR sc s₀, by rw [hp.wr]; simp, 0, by simp, by simp only; omega⟩ + st_sc := dS.sub_right (cmp_sub hz hp) + b_st := by rw [stk_eq hk]; exact dK + b_sc := by rw [stk_eq hk]; exact hp.b_s.sub_right (cmp_sub hz hp) + nst := np + nsc := by omega } + +/-- The compression of the buffer of the state at `p`, in `ebx`, with `eax` +at the buffer. -/ +theorem cmpS_ok (hO : MdOk H) {s : State} (hk : KR (H := H) sc s₀ s) {p : BitVec 32} + (hpR : p = inn s₀ ∨ p = out s₀) (hbx : s.gpr .ebx = p) (hax : s.gpr .eax = p + BitVec.ofNat 32 H.N) + {Q : State → Prop} + (hQ : ∀ s', KR (H := H) sc s₀ s' → s'.gpr .ebx = p → + Frame [⟨p.setWidth 64, H.N⟩, cmpR (H := H) s₀, stkR s₀] s.mem s'.mem → + hO.md.stateAt s'.mem (p.setWidth 64) = hO.md.compress (hO.md.stateAt s.mem (p.setWidth 64)) + (hO.md.blockAt s.mem (p.setWidth 64 + BitVec.ofNat 64 H.N)) → Q s') : + WP isa H.cmp s Q := by + obtain ⟨hb, hf, nw, hso, hW, hN0, hN, -, -, hB64, -⟩ := bounds hz hp + obtain ⟨dS, dK, dV, np, hin⟩ := st_facts hz hp hpR + refine cmp_ok hO.comp (by omega) (cmpArgs hz hp hk hpR hbx hax) fun s' ha e => ?_ + have f := ha.frame + rw [stk_eq hk] at f + have sN : Region.Sub ⟨p.setWidth 64, H.N⟩ ⟨p.setWidth 64, H.N + H.B⟩ := Region.sub_prefix (by omega) + refine hQ s' (KR.call hz hp hk ha ?_ ?_) (ha.cs .ebx (by decide) |>.trans hbx) (f.mono (by simp)) e + · simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · exact dV.sub_right sN + · exact save_cmp hz hp + · simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · rcases hpR with rfl | rfl + · exact ⟨inR (H := H) s₀, by simp, sN⟩ + · exact ⟨outR (H := H) s₀, by simp, sN⟩ + · exact ⟨scR sc s₀, by simp, cmp_sub hz hp⟩ + +end + +/-! ## The blocks -/ + +section +variable {sc : Nat} {s₀ : State} (hz : Sizes H) (hp : Pre (H := H) sc s₀) +include hz hp + +/-- A word of the buffer of the state at `p`. -/ +theorem buf_word {p : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) {k : Nat} (hk : k < H.B / 4) : + InRegions s₀.wr (addr p (H.N + 4 * k)) 4 := by + obtain ⟨-, -, -, -, -, -, hN, -, hB4, -⟩ := bounds hz hp + obtain ⟨-, -, -, np, hin⟩ := st_facts hz hp hpR + rw [addr_eq (by omega)] + exact ⟨_, hin, Offset.contains_base _ (by omega) (by omega)⟩ + +/-- `ipad` in every byte of the inner buffer, then the key's arguments. -/ +theorem fill_ok {s : State} (hk : KR (H := H) sc s₀ s) (hbx : s.gpr .ebx = inn s₀) : + WP isa (.block H.fillIpad) s fun t => KR (H := H) sc s₀ t ∧ t.gpr .ebx = inn s₀ ∧ t.gpr .edi = kp s₀ ∧ + t.gpr .edx = inn s₀ + BitVec.ofNat 32 H.N ∧ t.gpr .ecx = BitVec.ofNat 32 (kl s₀) ∧ + t.zf = some (decide (kl s₀ = 0)) ∧ + t.mem = writeBytes s.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N) (List.replicate H.B 0x36) := by + obtain ⟨-, -, -, -, -, -, hN, -, hB4, hB64, hB, ni, -⟩ := bounds hz hp + have h4 : 4 * (H.B / 4) = H.B := by omega + simp only [Hash.fillIpad, List.cons_append] + refine wp_movi fun s₁ u₁ => ?_ + refine fillW_ok (H.B / 4) _ s₁ _ (b := 0x36) (u₁.gpr.trans (by decide)) (by rw [u₁.other _ (by decide), hbx]) + (by omega) (fun j hj => by rw [u₁.wr, hk.wr]; exact buf_word hz hp (.inl rfl) hj) fun s₂ g₂ rd₂ wr₂ m₂ => ?_ + rw [h4] at m₂ + have f₂ : Frame [⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩] s.mem s₂.mem := by + rw [m₂, u₁.mem]; exact writeBytes_frame _ _ _ (by simp only [List.length_replicate]; exact Region.contains_self _ _) + have sB : Region.Sub ⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩ (inR (H := H) s₀) := st_sub _ (by omega) + have k₂ : KR (H := H) sc s₀ s₂ := hk.keep (by rw [rd₂, u₁.rd]) (by rw [wr₂, u₁.wr]) + (fun r hr => by rw [g₂, u₁.other r (by revert hr; decide +revert)]) f₂ + (by + simp only [List.mem_singleton]; rintro r rfl + exact (hp.i_s.symm.sub_left (save_sub hz hp)).sub_right sB) + (by simp only [List.mem_singleton]; rintro r rfl; exact ⟨_, by simp, sB⟩) + refine wp_movm (a := argAddr s₀ 2) (by rw [ea_at, k₂.esp]; rfl) (argIn hp k₂.rd k₂.wr (by decide)) + fun s₃ u₃ => ?_ + refine wp_movm (a := argAddr s₀ 3) (by rw [ea_at, u₃.other _ (by decide), k₂.esp]; rfl) + (by rw [u₃.rd, u₃.wr]; exact argIn hp k₂.rd k₂.wr (by decide)) fun s₄ u₄ => ?_ + refine wp_mov fun s₅ u₅ => wp_addi fun s₆ u₆ => wp_test fun s₇ f₇ z₇ => WP.block_nil ?_ + have hcx : s₇.gpr .ecx = arg s₀ 3 := by + rw [f₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, u₃.mem, k₂.readArg hp (by decide)] + have bx₂ : s₂.gpr .ebx = inn s₀ := by rw [g₂, u₁.other _ (by decide), hbx] + have bx : s₇.gpr .ebx = inn s₀ := by + rw [f₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), bx₂] + have k₇ : KR (H := H) sc s₀ s₇ := + ((((k₂.upd (by decide) u₃).upd (by decide) u₄).upd (by decide) u₅).upd (by decide) u₆).keep f₇.rd f₇.wr + (fun r _ => by rw [f₇.gpr]) (rs := []) (by rw [f₇.mem]; exact Frame.refl _ _) (by simp) (by simp) + refine ⟨k₇, bx, ?_, ?_, ?_, ?_, by rw [f₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem, m₂, u₁.mem]⟩ + · rw [f₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, + k₂.readArg hp (by decide)] + · rw [f₇.gpr, u₆.gpr, u₅.gpr, u₄.other _ (by decide), u₃.other _ (by decide), bx₂] + · rw [hcx, kl, BitVec.ofNat_toNat, BitVec.setWidth_eq] + · rw [z₇, ← f₇.gpr, hcx, VG.Proof.Pbkdf2.Stream.X86.test_z] + + +/-- The key loop: the key XORed with `ipad` over the start of the inner buffer. -/ +theorem keys_ok {s : State} (hk : KR (H := H) sc s₀ s) (hbx : s.gpr .ebx = inn s₀) (hdi : s.gpr .edi = kp s₀) + (hdx : s.gpr .edx = inn s₀ + BitVec.ofNat 32 H.N) (hcx : s.gpr .ecx = BitVec.ofNat 32 (kl s₀)) + (hzf : s.zf = some (decide (kl s₀ = 0))) + (hm : bytesAt s.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.B = List.replicate H.B 0x36) : + WP isa (.ite .e (.block []) Hash.keyLoop) s fun t => KR (H := H) sc s₀ t ∧ t.gpr .ebx = inn s₀ ∧ + Frame [⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩] s.mem t.mem ∧ + bytesAt t.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.B = + (bytesAt s₀.mem ((kp s₀).setWidth 64) (kl s₀)).map (· ^^^ ipad) ++ List.replicate (H.B - kl s₀) ipad := by + obtain ⟨-, -, -, -, -, -, hN, -, -, hB64, hB, ni, -, nk, hkl⟩ := bounds hz hp + have kl32 : kl s₀ < 2 ^ 32 := (arg s₀ 3).isLt + have ap : (inn s₀ + BitVec.ofNat 32 H.N).setWidth 64 = (inn s₀).setWidth 64 + BitVec.ofNat 64 H.N := + setWidth_add (by omega) + have tp : (inn s₀ + BitVec.ofNat 32 H.N).toNat = (inn s₀).toNat + H.N := toNat_add_ofNat (by omega) + have hin : ∀ j < kl s₀, InRegions (s.rd ++ s.wr) ((kp s₀).setWidth 64 + BitVec.ofNat 64 j) 1 := fun j hj => by + rw [hk.rd, hp.rd]; exact ⟨keyR s₀, by simp, Offset.contains_base _ (by omega) (by omega)⟩ + have hout : ∀ j < kl s₀, InRegions s.wr ((inn s₀ + BitVec.ofNat 32 H.N).setWidth 64 + BitVec.ofNat 64 j) 1 := + fun j hj => by + rw [hk.wr, hp.wr, ap, Memory.add_ofNat] + exact ⟨inR (H := H) s₀, by simp, Offset.contains_base _ (by omega) (by omega)⟩ + have hsep : Region.Disjoint ⟨(kp s₀).setWidth 64, kl s₀⟩ ⟨(inn s₀ + BitVec.ofNat 32 H.N).setWidth 64, kl s₀⟩ := by + rw [ap]; exact hp.k_i.sub_right (st_sub _ (by omega)) + have h0 : KeyInv s (kp s₀) (inn s₀ + BitVec.ofNat 32 H.N) (kl s₀) 0 s := + ⟨rfl, rfl, fun _ _ _ _ _ => rfl, by rw [hdi]; exact (BitVec.add_zero _).symm, + by rw [hdx]; exact (BitVec.add_zero _).symm, by rw [hcx, Nat.sub_zero], + by rw [show bytesAt s.mem ((kp s₀).setWidth 64) 0 = [] from rfl, List.map_nil, writeBytes_nil]⟩ + refine WP.mono (key_ok (by omega) (by rw [tp]; omega) kl32 hin hout hsep h0 hzf) fun t ht => ?_ + have hl : ((bytesAt s.mem ((kp s₀).setWidth 64) (kl s₀)).map (· ^^^ ipad)).length = kl s₀ := by + simp [bytesAt_length] + have sB := st_sub (H := H) (inn s₀) (a := H.N) (n := H.B) (by omega) + have ft : Frame [⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩] s.mem t.mem := by + rw [ht.mem, ap]; exact writeBytes_frame _ _ _ (by rw [hl]; exact Memory.contains_base hkl) + refine ⟨hk.keep ht.rd ht.wr (fun r hr => ht.other r (by revert hr; decide +revert) (by revert hr; decide +revert) + (by revert hr; decide +revert) (by revert hr; decide +revert)) ft + (by + simp only [List.mem_singleton]; rintro r rfl + exact (hp.i_s.symm.sub_left (save_sub hz hp)).sub_right sB) + (by simp only [List.mem_singleton]; rintro r rfl; exact ⟨_, by simp, sB⟩), + by rw [ht.other _ (by decide) (by decide) (by decide) (by decide), hbx], ft, ?_⟩ + rw [ht.mem, ap, MdInit.bytes_over (by rw [hl]; omega) (by omega) hm, hl, hk.key hp] + rfl + + +/-- The outer buffer from the inner one, and `eax` at the inner one. -/ +theorem opad_ok {s : State} (hk : KR (H := H) sc s₀ s) (hbx : s.gpr .ebx = inn s₀) : + WP isa (.block H.fillOpad) s fun t => KR (H := H) sc s₀ t ∧ t.gpr .ebx = inn s₀ ∧ + t.gpr .eax = inn s₀ + BitVec.ofNat 32 H.N ∧ + t.mem = writeBytes s.mem ((out s₀).setWidth 64 + BitVec.ofNat 64 H.N) + ((bytesAt s.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.B).map (· ^^^ 0x6a)) := by + obtain ⟨-, -, -, -, -, -, hN, -, hB4, hB64, hB, ni, no, -⟩ := bounds hz hp + have h4 : 4 * (H.B / 4) = H.B := by omega + have sBI := st_sub (H := H) (inn s₀) (a := H.N) (n := H.B) (by omega) + have sBO := st_sub (H := H) (out s₀) (a := H.N) (n := H.B) (by omega) + unfold Hash.fillOpad + refine opadW_ok H (H.B / 4) _ s _ hbx hk.esi (by omega) (by omega) + (fun j hj => by rw [hk.wr, hk.rd]; exact InRegions.right' (buf_word hz hp (.inl rfl) hj)) + (fun j hj => by rw [hk.wr]; exact buf_word hz hp (.inr rfl) hj) + (by rw [h4]; exact (hp.i_o.sub_left sBI).sub_right sBO) fun s₁ g₁ rd₁ wr₁ m₁ => ?_ + rw [h4] at m₁ + rw [← List.append_nil H.atBlk] + refine atBlk_ok fun s₂ e₂ g₂ m₂ rd₂ wr₂ => WP.block_nil ?_ + have hl : ((bytesAt s.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.B).map (· ^^^ (0x6a : Byte))).length = + H.B := by simp [bytesAt_length] + have f : Frame [⟨(out s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩] s.mem s₂.mem := by + rw [m₂, m₁]; exact writeBytes_frame _ _ _ (by rw [hl]; exact Region.contains_self _ _) + refine ⟨hk.keep (by rw [rd₂, rd₁]) (by rw [wr₂, wr₁]) + (fun r hr => by rw [g₂ r (by revert hr; decide +revert), g₁ r (by revert hr; decide +revert)]) f + (by + simp only [List.mem_singleton]; rintro r rfl + exact (hp.o_s.symm.sub_left (save_sub hz hp)).sub_right sBO) + (by simp only [List.mem_singleton]; rintro r rfl; exact ⟨_, by simp, sBO⟩), + by rw [g₂ _ (by decide), g₁ _ (by decide), hbx], by rw [e₂, g₁ _ (by decide), hbx], by rw [m₂, m₁]⟩ + + +/-- The two blocks, as the constant-time proof needs them. -/ +theorem blocks_ok {s : State} (hk : KR (H := H) sc s₀ s) (hbx : s.gpr .ebx = inn s₀) : + WP isa H.blocks s fun t => KR (H := H) sc s₀ t ∧ t.gpr .ebx = inn s₀ ∧ + t.gpr .eax = inn s₀ + BitVec.ofNat 32 H.N := by + have := (bounds hz hp).2.2.2.2.2.2.2.2.2.2.1 + refine WP.seq (WP.mono (fill_ok hz hp hk hbx) fun s₄ ⟨k₄, b₄, d₄, x₄, c₄, z₄, m₄⟩ => ?_) + refine WP.seq (WP.mono (keys_ok hz hp k₄ b₄ d₄ x₄ c₄ z₄ (by + rw [m₄, bytesAt_writeBytes_self' (List.length_replicate ..) (by omega)])) fun s₅ ⟨k₅, b₅, _⟩ => ?_) + exact WP.mono (opad_ok hz hp k₅ b₅) fun _ ⟨k₆, b₆, a₆, _⟩ => ⟨k₆, b₆, a₆⟩ + +omit hz hp in +/-- `ebx` at the outer state, and `eax` at its buffer. -/ +theorem toOuter_ok {s : State} (hk : KR (H := H) sc s₀ s) : + WP isa (.block H.toOuter) s fun t => KR (H := H) sc s₀ t ∧ t.gpr .ebx = out s₀ ∧ + t.gpr .eax = out s₀ + BitVec.ofNat 32 H.N ∧ t.mem = s.mem := by + unfold Hash.toOuter + refine wp_mov fun s₁ u₁ => ?_ + rw [← List.append_nil H.atBlk] + refine atBlk_ok fun s₂ e₂ g₂ m₂ rd₂ wr₂ => WP.block_nil ?_ + have k₁ := hk.upd (by decide) u₁ + exact ⟨k₁.keep rd₂ wr₂ (fun r hr => g₂ r (by revert hr; decide +revert)) (rs := []) + (by rw [m₂]; exact Frame.refl _ _) (by simp) (by simp), + by rw [g₂ _ (by decide), u₁.gpr, hk.esi], by rw [e₂, u₁.gpr, hk.esi], by rw [m₂, u₁.mem]⟩ + +end + + +/-! ## Correctness -/ + +section +variable {sc : Nat} {s₀ : State} (hO : MdOk H) (hp : Pre (H := H) sc s₀) +include hO hp + +omit hp in +theorem keep_st {rs : List Region} {m m' : Mem} (hf : Frame rs m m') {p : Addr} + (hd : ∀ r ∈ rs, Region.Disjoint ⟨p, H.N⟩ r) : hO.md.stateAt m' p = hO.md.stateAt m p := + hO.md.stateAt_congr fun i hi => hf.bytes (R := ⟨p, H.N⟩) hd (by have := hO.sizes.N; show H.N ≤ 2 ^ 64; omega) hi + +omit hp in +theorem keep_repr {rs : List Region} {m m' : Mem} (hf : Frame rs m m') {p : Addr} + (hd : ∀ r ∈ rs, Region.Disjoint ⟨p, H.N + H.B⟩ r) {x : List Byte} (hr : hO.md.Repr hO.iv m p x) : + hO.md.Repr hO.iv m' p x := + hO.md.repr_congr (by have := hO.sizes.B4; omega) (fun i hi => hf.bytes (R := ⟨p, H.N + H.B⟩) hd + (by have := hO.sizes.B4; have := hO.sizes.N; show H.N + H.B ≤ 2 ^ 64; omega) hi) hr + +theorem correct : + WP isa H.hmacInit s₀ fun s' => abiPreserved s₀ s' ∧ (initG hO.hH.SH sc).post s₀ s' := by + have hz := hO.sizes + obtain ⟨hb, hf, nw, hso, hW, hN0, hN, hN4, hB4, hB64, hB, ni, no, nk, hkl⟩ := bounds hz hp + have hl := hO.link + -- Where things are. + have sNI := st_sub (H := H) (inn s₀) (a := 0) (n := H.N) (by omega) + have sNO := st_sub (H := H) (out s₀) (a := 0) (n := H.N) (by omega) + rw [BitVec.add_zero] at sNI sNO + have sBI := st_sub (H := H) (inn s₀) (a := H.N) (n := H.B) (by omega) + have sBO := st_sub (H := H) (out s₀) (a := H.N) (n := H.B) (by omega) + have nb : ∀ (x : BitVec 32), Region.Disjoint ⟨x.setWidth 64, H.N⟩ ⟨x.setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩ := + fun _ => Offset.base_disjoint _ (Nat.le_refl _) (by omega) + have iv0 : ∀ {m : Mem} {p : Addr}, hO.hH.SH.Repr m p [] → hO.md.stateAt m p = hO.iv := fun h => by + have := (hl.repr _ _ _ h).1 + rwa [List.length_nil, Nat.zero_div, Md.compressList_zero] at this + refine WP.seq (WP.mono (pro_ok hz hp) fun s₁ ⟨k₁, b₁⟩ => ?_) + refine WP.seq (callInit_ok hz hp hO k₁ (.inl ⟨rfl, rfl⟩) b₁ fun s₂ k₂ b₂ _ r₂ => ?_) + refine WP.seq (callInit_ok hz hp hO k₂ (.inr ⟨rfl, rfl⟩) k₂.esi fun s₃ k₃ b₃ f₃ r₃ => ?_) + have vI₃ : hO.md.stateAt s₃.mem ((inn s₀).setWidth 64) = hO.iv := by + rw [keep_st hO f₃ (by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · exact hp.i_o.sub_left sNI + · exact hp.b_i.symm.sub_left sNI), iv0 r₂] + have vO₃ := iv0 r₃ + refine WP.seq (WP.seq (WP.mono (fill_ok hz hp k₃ (b₃.trans (b₂.trans b₁))) + fun s₄ ⟨k₄, b₄, d₄, x₄, c₄, z₄, m₄⟩ => ?_)) + have rep₄ : bytesAt s₄.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.B = List.replicate H.B 0x36 := by + rw [m₄, bytesAt_writeBytes_self' (List.length_replicate ..) (by omega)] + have f₄ : Frame [⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩] s₃.mem s₄.mem := by + rw [m₄]; exact writeBytes_frame _ _ _ (by rw [List.length_replicate]; exact Region.contains_self _ _) + refine WP.seq (WP.mono (keys_ok hz hp k₄ b₄ d₄ x₄ c₄ z₄ rep₄) fun s₅ ⟨k₅, b₅, f₅, bI₅⟩ => ?_) + refine WP.mono (opad_ok hz hp k₅ b₅) fun s₆ ⟨k₆, b₆, a₆, m₆⟩ => ?_ + have hl6 : ((bytesAt s₅.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.B).map (· ^^^ (0x6a : Byte))).length = + H.B := by simp [bytesAt_length] + have f₆ : Frame [⟨(out s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩] s₅.mem s₆.mem := by + rw [m₆]; exact writeBytes_frame _ _ _ (by rw [hl6]; exact Region.contains_self _ _) + have bO₆ : bytesAt s₆.mem ((out s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.B = + (bytesAt s₅.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.B).map (· ^^^ 0x6a) := by + rw [m₆, bytesAt_writeBytes_self' hl6 (by omega)] + have bI₆ : bytesAt s₆.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.B = + bytesAt s₅.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.B := + Memory.frame_bytesAt f₆ (by + simp only [List.mem_singleton]; rintro r rfl; exact (hp.i_o.sub_left sBI).sub_right sBO) (by omega) + -- The hash values are those `init` left. + have vI₆ : hO.md.stateAt s₆.mem ((inn s₀).setWidth 64) = hO.iv := by + rw [keep_st hO f₆ (by + simp only [List.mem_singleton]; rintro r rfl; exact (hp.i_o.sub_left sNI).sub_right sBO), + keep_st hO f₅ (by simp only [List.mem_singleton]; rintro r rfl; exact nb _), + keep_st hO f₄ (by simp only [List.mem_singleton]; rintro r rfl; exact nb _), vI₃] + have vO₆ : hO.md.stateAt s₆.mem ((out s₀).setWidth 64) = hO.iv := by + rw [keep_st hO f₆ (by simp only [List.mem_singleton]; rintro r rfl; exact nb _), + keep_st hO f₅ (by + simp only [List.mem_singleton]; rintro r rfl; exact (hp.i_o.symm.sub_left sNO).sub_right sBI), + keep_st hO f₄ (by + simp only [List.mem_singleton]; rintro r rfl; exact (hp.i_o.symm.sub_left sNO).sub_right sBI), vO₃] + refine WP.seq (cmpS_ok hz hp hO k₆ (.inl rfl) b₆ a₆ fun s₇ k₇ _ f₇ e₇ => ?_) + refine WP.seq (WP.mono (toOuter_ok k₇) fun s₈ ⟨k₈, b₈, a₈, m₈⟩ => ?_) + refine WP.seq (cmpS_ok hz hp hO k₈ (.inr rfl) b₈ a₈ fun s₉ k₉ _ f₉ e₉ => ?_) + -- The key. + have hK : xorPad (blockKey hO.hH.SH.H (bytesAt s₀.mem ((kp s₀).setWidth 64) (kl s₀))) ipad = + bytesAt s₅.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.B := by + rw [bI₅, MdInit.blockKey_short _ (by rw [bytesAt_length, hO.hH.hB]; exact hkl), MdInit.xorPad_short, + bytesAt_length, hO.hH.hB] + have hKl : (xorPad (blockKey hO.hH.SH.H (bytesAt s₀.mem ((kp s₀).setWidth 64) (kl s₀))) ipad).length = H.B := by + rw [hK, bytesAt_length] + -- The inner state. + have rI₇ := Md.repr_block (H := hO.md) (iv := hO.iv) (by omega) hKl (by rw [bI₆, hK]) (by rw [e₇, vI₆]) + have dI₉ : ∀ r ∈ [(⟨(out s₀).setWidth 64, H.N⟩ : Region), cmpR (H := H) s₀, stkR s₀], + Region.Disjoint ⟨(inn s₀).setWidth 64, H.N + H.B⟩ r := by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl) + · exact hp.i_o.sub_right sNO + · exact hp.i_s.sub_right (cmp_sub hz hp) + · exact hp.b_i.symm + have rI₉ := keep_repr hO f₉ dI₉ (m₈ ▸ rI₇) + -- The outer state. + have d₇ : ∀ {a n : Nat}, a + n ≤ H.N + H.B → ∀ r ∈ [(⟨(inn s₀).setWidth 64, H.N⟩ : Region), cmpR (H := H) s₀, + stkR s₀], Region.Disjoint ⟨(out s₀).setWidth 64 + BitVec.ofNat 64 a, n⟩ r := by + intro a n h + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl) + · exact (hp.i_o.symm.sub_left (st_sub _ h)).sub_right sNI + · exact (hp.o_s.sub_left (st_sub _ h)).sub_right (cmp_sub hz hp) + · exact hp.b_o.symm.sub_left (st_sub _ h) + have vO₈ : hO.md.stateAt s₈.mem ((out s₀).setWidth 64) = hO.iv := by + rw [m₈, keep_st hO f₇ (by have := d₇ (a := 0) (n := H.N) (by omega); rwa [BitVec.add_zero] at this), vO₆] + have bO₈ : bytesAt s₈.mem ((out s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.B = + xorPad (blockKey hO.hH.SH.H (bytesAt s₀.mem ((kp s₀).setWidth 64) (kl s₀))) opad := by + rw [m₈, Memory.frame_bytesAt f₇ (d₇ (by omega)) (by omega), bO₆, ← hK, MdInit.xorPad_6a] + have rO₉ := Md.repr_block (H := hO.md) (iv := hO.iv) (by omega) (by rw [xorPad_length, ← xorPad_length _ ipad, hKl]) + bO₈ (by rw [e₉, vO₈]) + -- The end. + have hsc : ⟨(scr s₀).setWidth 64, 8 * sc⟩ ∈ s₉.wr := by rw [k₉.wr, hp.wr]; simp + refine WP.mono (restore_ok H.st k₉.ebp k₉.saved hsc (by omega) nw) fun s' ⟨hm, _, _, hg, ho⟩ => ?_ + refine ⟨⟨fun r hr => ?_, by rw [hm]; exact k₉.ret hp⟩, ?_⟩ + · by_cases he : r = .esp + · subst he; rw [ho _ (by decide) (by decide), k₉.esp] + · exact hg r (callee_saved r hr he) + · show hO.hH.SH.Repr s'.mem ((inn s₀).setWidth 64) _ ∧ hO.hH.SH.Repr s'.mem ((out s₀).setWidth 64) _ + rw [hm] + exact ⟨hO.back _ _ _ rI₉, hO.back _ _ _ rO₉⟩ + +end + +end VG.Proof.Pbkdf2.Md.X86.HmacInit diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInitCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInitCT.lean new file mode 100644 index 000000000..469589b95 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInitCT.lean @@ -0,0 +1,215 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.HmacInit + +/-! +# HMAC over a Merkle–Damgård hash function on x86 (32-bit): `init`, constant time + +As `finalize` (`HmacFinCT.lean`): the pieces between the calls are checked +by the taint analysis, the prologue and the blocks, which read the arguments +on the stack, with them public (`argTaint`); the calls of the streaming +`init` are related by `init_rel`, those of the compression function by +`cmp_rel`. Then `init` is verified against the contract with the arguments +read only (`initG`), and with them writable (`initW`). +-/ + +namespace VG.Proof.Pbkdf2.Md.X86.HmacInit + +open VG.X86 +open VG.Impl.Pbkdf2.Md.X86 (Hash) +open VG.Proof.Pbkdf2.Md.X86 +open VG.Proof.Pbkdf2.Stream.X86 (initG initW argTaint ArgsOut agree_argTaint rel_agree rel_wp init_rel) + +/-- The taint checks of the pieces of `init` between its calls. -/ +structure Checks (H : Hash) : Prop where + pro : ∃ hc, (VG.Taint.check taint (argTaint [] (4 + 4 * 5)) (.block H.initPrologue) hc).isSome = true + blocks : ∃ hc, (VG.Taint.check taint (argTaint [.ebp, .ebx, .esi] (4 + 4 * 5)) H.blocks hc).isSome = true + toOuter : ∃ hc, (VG.Taint.check taint (τr [.esp, .ebp, .esi]) (.block H.toOuter) hc).isSome = true + restore : ∃ hc, (VG.Taint.check taint (τr [.ebp]) (.block H.st.restore) hc).isSome = true + +/-- The public arguments are the same. -/ +structure PubEq (s₀ s₀' : State) : Prop where + esp : s₀.gpr .esp = s₀'.gpr .esp + args : ∀ i < 5, arg s₀ i = arg s₀' i + +variable {H : Hash} (hO : MdOk H) {sc : Nat} (hc : Checks H) +variable {s₀ s₀' : State} (hp : Pre (H := H) sc s₀) (hp' : Pre (H := H) sc s₀') (hq : PubEq s₀ s₀') + +/-- The arguments lie outside the writable regions. -/ +theorem args_out {t : State} (h : Pre (H := H) sc t) {s : State} (hsp : s.gpr .esp = E t) (hwr : s.wr = t.wr) : + ArgsOut 5 s := by + have e : (⟨(s.gpr .esp).setWidth 64, 4 + 4 * 5⟩ : Region) = ⟨(E t).setWidth 64, 4 + 20⟩ := by rw [hsp] + refine ⟨by rw [hsp]; exact h.spf, ?_⟩ + rw [e, hwr, h.wr] + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl) + · exact Taint.frame_disjoint (by have := h.spf; omega) h.r_i h.a_i + · exact Taint.frame_disjoint (by have := h.spf; omega) h.r_o h.a_o + · exact Taint.frame_disjoint (by have := h.spf; omega) h.r_s h.a_s + +include hq in +theorem kr_agree {s s' : State} (h : KR (H := H) sc s₀ s) (h' : KR (H := H) sc s₀' s') : + ∀ r ∈ [Reg.esp, .ebp, .esi], s.gpr r = s'.gpr r := by + intro r hr + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl + · rw [h.esp, h'.esp, E, E, hq.esp] + · rw [h.ebp, h'.ebp, scr, scr, hq.args 4 (by decide)] + · rw [h.esi, h'.esi, out, out, hq.args 1 (by decide)] + +include hO hp hp' hq + +/-- A call of the streaming `init` on the state in `st` (`ebx` for `inner`, +`esi` for `outer`), with `ebx` at `inner`. -/ +theorem callInit_rel {st : Reg} {p : BitVec 32} (hst : st = .ebx ∧ p = inn s₀ ∨ st = .esi ∧ p = out s₀) : + RelCT isa (fun s s' => (KR (H := H) sc s₀ s ∧ s.gpr .ebx = inn s₀) ∧ (KR (H := H) sc s₀' s' ∧ s'.gpr .ebx = inn s₀')) + (H.st.callInit st) + fun s s' => (KR (H := H) sc s₀ s ∧ s.gpr .ebx = inn s₀) ∧ (KR (H := H) sc s₀' s' ∧ s'.gpr .ebx = inn s₀') := by + have hz := hO.sizes + have hst' : st = .ebx ∧ p = inn s₀' ∨ st = .esi ∧ p = out s₀' := by + rcases hst with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · exact .inl ⟨h1, by rw [h2, inn, inn, hq.args 0 (by decide)]⟩ + · exact .inr ⟨h1, by rw [h2, out, out, hq.args 1 (by decide)]⟩ + have hsr : ∀ {t u : State}, KR (H := H) sc t u → u.gpr .ebx = inn t → + (st = .ebx ∧ p = inn t ∨ st = .esi ∧ p = out t) → u.gpr st = p := fun k b h => by + rcases h with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact b + · exact k.esi + refine rel_wp (F := fun s => KR (H := H) sc s₀ s ∧ s.gpr .ebx = inn s₀) + (F' := fun s => KR (H := H) sc s₀' s ∧ s.gpr .ebx = inn s₀') + (init_rel hO.hH (sp := E s₀) (r := st) (st := p) fun s s' ⟨⟨k, b⟩, ⟨k', b'⟩⟩ => + ⟨initArgs hz hp k hst (hsr k b hst), initArgs hz hp' k' hst' (hsr k' b' hst'), k.esp, + by rw [k'.esp, E, E, hq.esp]⟩) + (fun _ ⟨k, b⟩ => callInit_ok hz hp hO k hst (hsr k b hst) fun _ k' b' _ _ => ⟨k', b'.trans b⟩) + (fun _ ⟨k, b⟩ => callInit_ok hz hp' hO k hst' (hsr k b hst') fun _ k' b' _ _ => ⟨k', b'.trans b⟩) + +/-- A compression of the buffer of the state at `p`, in `ebx`, with `eax` +at it. -/ +theorem cmpS_rel {p p' : BitVec 32} (hpR : p = inn s₀ ∨ p = out s₀) (hpR' : p' = inn s₀' ∨ p' = out s₀') + (he : p' = p) : + RelCT isa (fun s s' => (KR (H := H) sc s₀ s ∧ s.gpr .ebx = p ∧ s.gpr .eax = p + BitVec.ofNat 32 H.N) ∧ + (KR (H := H) sc s₀' s' ∧ s'.gpr .ebx = p' ∧ s'.gpr .eax = p' + BitVec.ofNat 32 H.N)) H.cmp + fun s s' => KR (H := H) sc s₀ s ∧ KR (H := H) sc s₀' s' := by + have hz := hO.sizes + have hB : 0 < H.B := by have := hz.B4; omega + have e4 : scr s₀' = scr s₀ := (hq.args 4 (by decide)).symm + exact rel_wp (cmp_rel hO.comp hB (sp := E s₀) fun s s' ⟨⟨k, b, a⟩, ⟨k', b', a'⟩⟩ => + ⟨cmpArgs hz hp k hpR b a, by have := cmpArgs hz hp' k' hpR' b' a'; rwa [he, e4] at this, k.esp, + by rw [k'.esp, E, E, hq.esp]⟩) + (fun _ ⟨k, b, a⟩ => cmpS_ok hz hp hO k hpR b a fun _ k' _ _ _ => k') + (fun _ ⟨k, b, a⟩ => cmpS_ok hz hp' hO k hpR' b a fun _ k' _ _ _ => k') + +include hc in +theorem ct : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.hmacInit fun _ _ => True := by + have hz := hO.sizes + have e0 : inn s₀' = inn s₀ := (hq.args 0 (by decide)).symm + have e1 : out s₀' = out s₀ := (hq.args 1 (by decide)).symm + -- The prologue. + have pro : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') (.block H.initPrologue) + fun s s' => (KR (H := H) sc s₀ s ∧ s.gpr .ebx = inn s₀) ∧ (KR (H := H) sc s₀' s' ∧ s'.gpr .ebx = inn s₀') := + rel_agree (argTaint [] (4 + 4 * 5)) (fun s s' e e' => by + subst e e' + exact agree_argTaint (fun r hr => nomatch hr) hq.esp (args_out hp rfl rfl) (args_out hp' rfl rfl) + hq.args) hc.pro + (fun _ e => by subst e; exact pro_ok hz hp) + (fun _ e => by subst e; exact pro_ok hz hp') + -- The blocks. + have blk : RelCT isa (fun s s' => (KR (H := H) sc s₀ s ∧ s.gpr .ebx = inn s₀) ∧ + (KR (H := H) sc s₀' s' ∧ s'.gpr .ebx = inn s₀')) H.blocks + fun s s' => (KR (H := H) sc s₀ s ∧ s.gpr .ebx = inn s₀ ∧ s.gpr .eax = inn s₀ + BitVec.ofNat 32 H.N) ∧ + (KR (H := H) sc s₀' s' ∧ s'.gpr .ebx = inn s₀' ∧ s'.gpr .eax = inn s₀' + BitVec.ofNat 32 H.N) := + rel_agree (argTaint [.ebp, .ebx, .esi] (4 + 4 * 5)) (fun s s' ⟨k, b⟩ ⟨k', b'⟩ => + agree_argTaint (fun r hr => by + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl + · exact kr_agree hq k k' _ (by simp) + · rw [b, b', e0] + · exact kr_agree hq k k' _ (by simp)) + (kr_agree hq k k' _ (by simp)) (args_out hp k.esp k.wr) (args_out hp' k'.esp k'.wr) + fun i hi => by rw [k.argEq hp hi, k'.argEq hp' hi, hq.args i hi]) hc.blocks + (fun _ ⟨k, b⟩ => blocks_ok hz hp k b) + (fun _ ⟨k, b⟩ => blocks_ok hz hp' k b) + -- From the inner state to the outer one. + have tO : RelCT isa (fun s s' => KR (H := H) sc s₀ s ∧ KR (H := H) sc s₀' s') (.block H.toOuter) + fun s s' => (KR (H := H) sc s₀ s ∧ s.gpr .ebx = out s₀ ∧ s.gpr .eax = out s₀ + BitVec.ofNat 32 H.N) ∧ + (KR (H := H) sc s₀' s' ∧ s'.gpr .ebx = out s₀' ∧ s'.gpr .eax = out s₀' + BitVec.ofNat 32 H.N) := + rel_agree (τr [.esp, .ebp, .esi]) (fun _ _ k k' => agree_regs (kr_agree hq k k')) hc.toOuter + (fun _ k => WP.mono (toOuter_ok k) fun _ ⟨k', b, a, _⟩ => ⟨k', b, a⟩) + (fun _ k => WP.mono (toOuter_ok k) fun _ ⟨k', b, a, _⟩ => ⟨k', b, a⟩) + -- The end. + obtain ⟨_, hr⟩ := hc.restore + have restore : RelCT isa (fun s s' => KR (H := H) sc s₀ s ∧ KR (H := H) sc s₀' s') (.block H.st.restore) + fun _ _ => True := + RelCT.taint (A := taint) (τr [.ebp]) (fun _ _ h => agree_regs fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact kr_agree hq h.1 h.2 _ (by simp)) hr + exact pro.seq ((callInit_rel hO hp hp' hq (.inl ⟨rfl, rfl⟩)).seq + ((callInit_rel hO hp hp' hq (.inr ⟨rfl, rfl⟩)).seq + (blk.seq ((cmpS_rel hO hp hp' hq (.inl rfl) (.inl rfl) e0).seq + (tO.seq ((cmpS_rel hO hp hp' hq (.inr rfl) (.inr rfl) e1).seq restore)))))) + +end VG.Proof.Pbkdf2.Md.X86.HmacInit + +namespace VG.Proof.Pbkdf2.Md.X86.HmacInit + +open VG.X86 +open VG.Impl.Pbkdf2.Md.X86 (Hash) +open VG.Proof.Pbkdf2.Md.X86 +open VG.Proof.Pbkdf2.Stream.X86 (initG initW) + +/-- `init` is verified against `initG`, given the taint checks, which the +kernel evaluates for each hash function. -/ +theorem verified {H : Hash} (hO : MdOk H) {sc : Nat} (hc : Checks H) (hfit : H.st.buf ≤ 8 * sc) + (hsat : ∃ s, (initG hO.hH.SH sc).pre s) : + Verified X86.target H.hmacInit (initG hO.hH.SH sc) := by + refine ⟨fun s hs => ?_, fun s₁ s₂ t₁ t₂ s₁' s₂' h₁ h₂ hpub e₁ e₂ => ?_, hsat⟩ + · obtain ⟨t, s', he, hg, hpost⟩ := correct hO (pre_of sc hO hs hfit) + exact ⟨t, s', he, hg, hpost⟩ + · obtain ⟨h1, h2⟩ := hpub + exact (ct hO hc (pre_of sc hO h₁ hfit) (pre_of sc hO h₂ hfit) ⟨h1, h2⟩ + _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 + +/-- The regions `init` reads and writes, of those `initW` gives it. -/ +def narrowRd (s : State) : List Region := + [⟨(arg s 2).setWidth 64, (arg s 3).toNat⟩, ⟨argAddr s 0, 20⟩] +def narrowWr (S sc : Nat) (s : State) : List Region := + [⟨(arg s 0).setWidth 64, S⟩, ⟨(arg s 1).setWidth 64, S⟩, ⟨(arg s 4).setWidth 64, 8 * sc⟩] + +/-- `init` is verified against `initW`, which lets it write its arguments: +the code only reads them. -/ +theorem verifiedW {H : Hash} (hO : MdOk H) {sc : Nat} (hc : Checks H) (hfit : H.st.buf ≤ 8 * sc) + (hsat : ∃ s, (initW hO.hH.SH sc).pre s) : + Verified X86.target H.hmacInit (initW hO.hH.SH sc) := by + have pre : ∀ s, (initW hO.hH.SH sc).pre s → + (initG hO.hH.SH sc).pre (s.withRegions (narrowRd s) + (narrowWr hO.hH.SH.stateBytes sc s)) := by + intro s h + obtain ⟨h0, _, _, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, h21, + h22, h23, h24⟩ := h + simp only [initG, narrowRd, narrowWr, arg_withRegions, + argAddr_withRegions, State.withRegions_gpr, State.withRegions_rd, State.withRegions_wr] + exact ⟨h0, trivial, trivial, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, h21, + h22, h23, h24⟩ + refine Verified.narrowTo (verified hO hc hfit (hsat.elim fun s hs => ⟨_, pre s hs⟩)) + (narrowRd) (narrowWr hO.hH.SH.stateBytes sc) pre (fun s h => ?_) + (fun s h => ?_) (fun _ _ _ h => h) (fun _ _ _ _ h => h) hsat + · obtain ⟨_, h1, h2, _⟩ := h + rw [h1, h2] + refine Covers.of_sub fun r hr => ?_ + simp only [narrowRd, narrowWr, List.cons_append, List.nil_append, + List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl | rfl | rfl + · exact ⟨_, List.mem_append_left _ List.mem_cons_self, 0, by simp, by simp⟩ + · exact ⟨_, List.mem_append_right _ (List.mem_cons_of_mem _ (List.mem_cons_of_mem _ + (List.mem_cons_of_mem _ List.mem_cons_self))), 0, by simp, by simp⟩ + · exact ⟨_, List.mem_append_right _ List.mem_cons_self, 0, by simp, by simp⟩ + · exact ⟨_, List.mem_append_right _ (List.mem_cons_of_mem _ List.mem_cons_self), 0, by simp, by simp⟩ + · exact ⟨_, List.mem_append_right _ (List.mem_cons_of_mem _ (List.mem_cons_of_mem _ List.mem_cons_self)), 0, + by simp, by simp⟩ + · obtain ⟨_, _, h2, _⟩ := h + rw [h2] + refine Covers.of_sub fun r hr => ?_ + simp only [narrowWr, List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl + · exact ⟨_, List.mem_cons_self, 0, by simp, by simp⟩ + · exact ⟨_, List.mem_cons_of_mem _ List.mem_cons_self, 0, by simp, by simp⟩ + · exact ⟨_, List.mem_cons_of_mem _ (List.mem_cons_of_mem _ List.mem_cons_self), 0, by simp, by simp⟩ + +end VG.Proof.Pbkdf2.Md.X86.HmacInit diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean index fd625e6d4..070e707c3 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean @@ -2,22 +2,23 @@ import VerifiedGarbage.Proof.Framework.Contract import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Lit import VerifiedGarbage.Proof.Pbkdf2.Md.X86.IterateCT import VerifiedGarbage.Proof.Pbkdf2.Md.X86.HmacFinCT +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.HmacInitCT /-! -# HMAC's `finalize` and PBKDF2's `iterate` on x86 (32-bit): the instances +# HMAC's `init` and `finalize` and PBKDF2's `iterate` on x86 (32-bit): the instances -The generic proofs (`IterateCT.lean`, `HmacFinCT.lean`) at each hash function -of `Hashes.lean`, with the taint checks of their blocks, which the kernel -evaluates for each hash function, moved to the shared contracts of -`Spec/Hmac/Generic.lean` and `Spec/Pbkdf2/Generic.lean` (`sig_implies`), which -the artifacts are emitted with. +The generic proofs (`IterateCT.lean`, `HmacInitCT.lean`, `HmacFinCT.lean`) at +each hash function of `Hashes.lean`, with the taint checks of their blocks, +which the kernel evaluates for each hash function, moved to the shared +contracts of `Spec/Hmac/Generic.lean` and `Spec/Pbkdf2/Generic.lean` +(`sig_implies`), which the artifacts are emitted with. -/ namespace VG.Proof.Pbkdf2.Md.X86.Instances open VG.X86 open VG.Proof.Pbkdf2.Md.X86 -open VG.Proof.Hmac.Generic.X86 (finW finG iterW iterG countF) +open VG.Proof.Pbkdf2.Stream.X86 (initW initG finW finG iterW iterG countF) /-- Memory holding the arguments `0x1000, 0x1400, 0, 0x1800, 0x2000` of `iterate` at `0x6004`. -/ @@ -77,6 +78,34 @@ theorem finSat_args (S D sc : Nat) : rw [e, e, e, e, e, e, e'] refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, rfl⟩ <;> decide +/-- Memory holding the arguments `0x1000, 0x1400, 0x1800, 0, 0x2000` of +`init` at `0x6004`. -/ +def initMem : Mem := fun a => + if a = 0x6005 then 0x10 else if a = 0x6009 then 0x14 else if a = 0x600D then 0x18 else + if a = 0x6015 then 0x20 else 0 + +/-- A state satisfying `init`'s precondition, with states of `S` bytes and +`8 sc` bytes of scratch space (and an empty key), with the arguments writable. -/ +def initSat (S sc : Nat) : State where + gpr r := match r with + | .esp => 0x6000 | _ => 0 + cf := none + zf := none + sf := none + of := none + mem := initMem + rd := [⟨0x1800, 0⟩] + wr := [⟨0x1000, S⟩, ⟨0x1400, S⟩, ⟨0x2000, 8 * sc⟩, ⟨0x6004, 20⟩] + +theorem initSat_args (S sc : Nat) : + arg (initSat S sc) 0 = 0x1000 ∧ arg (initSat S sc) 1 = 0x1400 ∧ arg (initSat S sc) 2 = 0x1800 ∧ + arg (initSat S sc) 3 = 0 ∧ arg (initSat S sc) 4 = 0x2000 ∧ argAddr (initSat S sc) 0 = 0x6004 ∧ + (initSat S sc).gpr .esp = 0x6000 := by + have e : ∀ i, arg (initSat S sc) i = arg (initSat 0 0) i := fun _ => rfl + have e' : argAddr (initSat S sc) 0 = argAddr (initSat 0 0) 0 := rfl + rw [e, e, e, e, e, e'] + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, rfl⟩ <;> decide + /-! ## MD5 -/ theorem md5_iterChecks : Iterate.Checks md5M where @@ -112,6 +141,22 @@ theorem md5_iterate : Verified X86.target md5M.iterate (Spec.Hmac.md5I.iterateCo theorem md5_finalize : Verified X86.target md5M.hmacFin (Spec.Hmac.md5I.finalizeContract X86.abi 48) := (HmacFin.verifiedW md5Ok md5_finChecks (by decide) md5_finImp.sat_left).of_implies md5_finImp +theorem md5_initChecks : HmacInit.Checks md5M where + pro := ⟨_, by taint_decide⟩ + blocks := ⟨_, by taint_decide⟩ + toOuter := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem md5_initImp : (initW Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.initContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 80 48 + sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, + Spec.Hmac.md5I, Spec.Hmac.md5S, Spec.Hmac.md5, initW, initG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 80 48 + +theorem md5_init : Verified X86.target md5M.hmacInit (Spec.Hmac.md5I.initContract X86.abi 48) := + (HmacInit.verifiedW md5Ok md5_initChecks (by decide) md5_initImp.sat_left).of_implies md5_initImp + /-! ## SHA-1 -/ theorem sha1_iterChecks : Iterate.Checks sha1M where @@ -147,6 +192,22 @@ theorem sha1_iterate : Verified X86.target sha1M.iterate (Spec.Hmac.sha1I.iterat theorem sha1_finalize : Verified X86.target sha1M.hmacFin (Spec.Hmac.sha1I.finalizeContract X86.abi 48) := (HmacFin.verifiedW sha1Ok sha1_finChecks (by decide) sha1_finImp.sat_left).of_implies sha1_finImp +theorem sha1_initChecks : HmacInit.Checks sha1M where + pro := ⟨_, by taint_decide⟩ + blocks := ⟨_, by taint_decide⟩ + toOuter := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem sha1_initImp : (initW Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.initContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 84 56 + sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, + Spec.Hmac.sha1I, Spec.Hmac.sha1S, Spec.Hmac.sha1, initW, initG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 84 56 + +theorem sha1_init : Verified X86.target sha1M.hmacInit (Spec.Hmac.sha1I.initContract X86.abi 48) := + (HmacInit.verifiedW sha1Ok sha1_initChecks (by decide) sha1_initImp.sat_left).of_implies sha1_initImp + /-! ## SHA-384 -/ theorem sha384_iterChecks : Iterate.Checks sha384M where @@ -182,6 +243,22 @@ theorem sha384_iterate : Verified X86.target sha384M.iterate (Spec.Hmac.sha384I. theorem sha384_finalize : Verified X86.target sha384M.hmacFin (Spec.Hmac.sha384I.finalizeContract X86.abi 48) := (HmacFin.verifiedW sha384Ok sha384_finChecks (by decide) sha384_finImp.sat_left).of_implies sha384_finImp +theorem sha384_initChecks : HmacInit.Checks sha384M where + pro := ⟨_, by taint_decide⟩ + blocks := ⟨_, by taint_decide⟩ + toOuter := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem sha384_initImp : (initW Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I.initContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 192 234 + sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, + Spec.Hmac.sha384I, Spec.Hmac.sha384S, Spec.Hmac.sha384, initW, initG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 192 234 + +theorem sha384_init : Verified X86.target sha384M.hmacInit (Spec.Hmac.sha384I.initContract X86.abi 48) := + (HmacInit.verifiedW sha384Ok sha384_initChecks (by decide) sha384_initImp.sat_left).of_implies sha384_initImp + /-! ## SHA-512 -/ theorem sha512_iterChecks : Iterate.Checks sha512M' where @@ -217,6 +294,22 @@ theorem sha512_iterate : Verified X86.target sha512M'.iterate (Spec.Hmac.sha512I theorem sha512_finalize : Verified X86.target sha512M'.hmacFin (Spec.Hmac.sha512I.finalizeContract X86.abi 48) := (HmacFin.verifiedW sha512Ok' sha512_finChecks (by decide) sha512_finImp.sat_left).of_implies sha512_finImp +theorem sha512_initChecks : HmacInit.Checks sha512M' where + pro := ⟨_, by taint_decide⟩ + blocks := ⟨_, by taint_decide⟩ + toOuter := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem sha512_initImp : (initW Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I.initContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 192 234 + sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, + Spec.Hmac.sha512I, Spec.Hmac.sha512S, Spec.Hmac.sha512, initW, initG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 192 234 + +theorem sha512_init : Verified X86.target sha512M'.hmacInit (Spec.Hmac.sha512I.initContract X86.abi 48) := + (HmacInit.verifiedW sha512Ok' sha512_initChecks (by decide) sha512_initImp.sat_left).of_implies sha512_initImp + /-! ## SHA-512/224 -/ theorem sha512_224_iterChecks : Iterate.Checks sha512_224M where @@ -252,6 +345,22 @@ theorem sha512_224_iterate : Verified X86.target sha512_224M.iterate (Spec.Hmac. theorem sha512_224_finalize : Verified X86.target sha512_224M.hmacFin (Spec.Hmac.sha512_224I.finalizeContract X86.abi 48) := (HmacFin.verifiedW sha512_224Ok sha512_224_finChecks (by decide) sha512_224_finImp.sat_left).of_implies sha512_224_finImp +theorem sha512_224_initChecks : HmacInit.Checks sha512_224M where + pro := ⟨_, by taint_decide⟩ + blocks := ⟨_, by taint_decide⟩ + toOuter := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem sha512_224_initImp : (initW Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac.sha512_224I.initContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 192 234 + sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, + Spec.Hmac.sha512_224I, Spec.Hmac.sha512_224S, Spec.Hmac.sha512_224, initW, initG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 192 234 + +theorem sha512_224_init : Verified X86.target sha512_224M.hmacInit (Spec.Hmac.sha512_224I.initContract X86.abi 48) := + (HmacInit.verifiedW sha512_224Ok sha512_224_initChecks (by decide) sha512_224_initImp.sat_left).of_implies sha512_224_initImp + /-! ## SHA-512/256 -/ theorem sha512_256_iterChecks : Iterate.Checks sha512_256M where @@ -287,4 +396,20 @@ theorem sha512_256_iterate : Verified X86.target sha512_256M.iterate (Spec.Hmac. theorem sha512_256_finalize : Verified X86.target sha512_256M.hmacFin (Spec.Hmac.sha512_256I.finalizeContract X86.abi 48) := (HmacFin.verifiedW sha512_256Ok sha512_256_finChecks (by decide) sha512_256_finImp.sat_left).of_implies sha512_256_finImp +theorem sha512_256_initChecks : HmacInit.Checks sha512_256M where + pro := ⟨_, by taint_decide⟩ + blocks := ⟨_, by taint_decide⟩ + toOuter := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem sha512_256_initImp : (initW Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac.sha512_256I.initContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 192 234 + sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, + Spec.Hmac.sha512_256I, Spec.Hmac.sha512_256S, Spec.Hmac.sha512_256, initW, initG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 192 234 + +theorem sha512_256_init : Verified X86.target sha512_256M.hmacInit (Spec.Hmac.sha512_256I.initContract X86.abi 48) := + (HmacInit.verifiedW sha512_256Ok sha512_256_initChecks (by decide) sha512_256_initImp.sat_left).of_implies sha512_256_initImp + end VG.Proof.Pbkdf2.Md.X86.Instances diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Iterate.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Iterate.lean index 3b418a594..173485072 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Iterate.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Iterate.lean @@ -15,10 +15,10 @@ namespace VG.Proof.Pbkdf2.Md.X86.Iterate open VG.X86 open VG.Impl.Pbkdf2.Md.X86 (Hash copyW) -open VG.Impl.Hmac.Generic.X86 (at_) +open VG.Impl.Pbkdf2.Stream.X86 (at_) open VG.Proof.Pbkdf2.Md.X86 open VG.Proof.MdStream (Md) -open VG.Proof.Hmac.Generic.X86 (HashOK iterG SavedRegs saveR savedRegs save_ok restore_ok callee_saved ea_at stk +open VG.Proof.Pbkdf2.Stream.X86 (HashOK iterG SavedRegs saveR savedRegs save_ok restore_ok callee_saved ea_at stk After setWidth_add toNat_add_ofNat stk_ret stk_args arg_contains arg_keep argAddr_eq saved_mem test_z) open VG.Proof.Hmac.Generic.Common (InRegions.right' bytesAt_writeBytes_self' bytesAt_take covers_one) open VG.Proof.Sha256.X86.Stream (Upd Mupd Fupd wp_mov wp_movi wp_movm wp_store wp_addi wp_subi wp_test @@ -666,7 +666,7 @@ theorem pro_ok : WP isa (.block H.prologue) s₀ fun s => Inv hO sc s₀ (nn s have f₂' : Frame [saveR H.st (scr s₀)] s₀.mem s₂.mem := by rw [← u₁.mem]; exact f₂ have rA : ∀ i < 5, s₂.mem.readW (argAddr s₀ i) 32 = arg s₀ i := fun i hi => f₂'.readW (r := ⟨argAddr s₀ i, 4⟩) (Region.contains_self _ _) (fun r hr => - (dA r hr).sub_left (VG.Proof.Hmac.Generic.X86.arg_sub rfl (by omega) (by have := hp.spf; omega))) (by decide) + (dA r hr).sub_left (VG.Proof.Pbkdf2.Stream.X86.arg_sub rfl (by omega) (by have := hp.spf; omega))) (by decide) have i₂ : ∀ i < 5, InRegions (s₂.rd ++ s₂.wr) (argAddr s₀ i) 4 := fun i hi => by rw [rd₂, wr₂, u₁.rd, u₁.wr]; exact argIn hp rfl rfl hi refine wp_mov fun s₃ u₃ => ?_ diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/IterateCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/IterateCT.lean index 2ea36f6bd..baffe889a 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/IterateCT.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/IterateCT.lean @@ -3,13 +3,12 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Iterate /-! # PBKDF2-HMAC's iteration over a Merkle–Damgård hash function on x86 (32-bit): constant time -As for the streaming-level functions (`Proof/Hmac/Generic/X86/`): the pieces -between the calls are checked by the taint analysis, those that read the -arguments on the stack (the prologue, and the end of a step, which loads `t`) -with the arguments public (`argTaint`); the calls of the compression function -are related by `cmp_rel`, from its contract. Then `iterate` is verified -against the contract with the arguments read only (`iterG`), and with them -writable (`iterW`). +As for HMAC's `init` (`HmacInitCT.lean`): the pieces between the calls are +checked by the taint analysis, those that read the arguments on the stack (the +prologue, and the end of a step, which loads `t`) with the arguments public +(`argTaint`); the calls of the compression function are related by `cmp_rel`, +from its contract. Then `iterate` is verified against the contract with the +arguments read only (`iterG`), and with them writable (`iterW`). -/ namespace VG.Proof.Pbkdf2.Md.X86.Iterate @@ -17,7 +16,7 @@ namespace VG.Proof.Pbkdf2.Md.X86.Iterate open VG.X86 open VG.Impl.Pbkdf2.Md.X86 (Hash) open VG.Proof.Pbkdf2.Md.X86 -open VG.Proof.Hmac.Generic.X86 (HashOK iterG iterW argTaint ArgsOut agree_argTaint rel_agree rel_wp stk) +open VG.Proof.Pbkdf2.Stream.X86 (HashOK iterG iterW argTaint ArgsOut agree_argTaint rel_agree rel_wp stk) open VG.Proof.Sha256.X86.Stream (eval_e eval_ne) open Spec.Sha256 (bytesAt) @@ -232,7 +231,7 @@ namespace VG.Proof.Pbkdf2.Md.X86.Iterate open VG.X86 open VG.Impl.Pbkdf2.Md.X86 (Hash) open VG.Proof.Pbkdf2.Md.X86 -open VG.Proof.Hmac.Generic.X86 (iterG iterW) +open VG.Proof.Pbkdf2.Stream.X86 (iterG iterW) /-- `iterate` is verified against `iterG`, given the taint checks, which the kernel evaluates for each hash function. -/ diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Lit.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Lit.lean index 1a244ab72..9a3c996bd 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Lit.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Lit.lean @@ -2,27 +2,33 @@ import VerifiedGarbage.Proof.Framework.X86.Lit import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Hashes /-! -# HMAC's `finalize` and PBKDF2's `iterate` on x86 (32-bit): the code as literals +# HMAC's `init` and `finalize` and PBKDF2's `iterate` on x86 (32-bit): the code as literals -`Hash.hmacFin` and `Hash.iterate` (`Impl/Pbkdf2/Md/X86.lean`) at each hash +`Hash.hmacInit`, `Hash.hmacFin` and `Hash.iterate` (`Impl/Pbkdf2/Md/X86.lean`) at each hash function of `Hashes.lean`, as literals (`materialize_code`, `Proof/Framework/Lit.lean`) that refer to the literals of the functions they -call (the compression functions, and the streaming `finalize`): the +call (the compression functions, and the streaming `init` and `finalize`): the registration files' `spSafe` checks evaluate them. -/ namespace VG.Proof.Pbkdf2.Md.X86 +materialize_code md5MInit := md5M.hmacInit materialize_code md5MFinalize := md5M.hmacFin materialize_code md5MIterate := md5M.iterate +materialize_code sha1MInit := sha1M.hmacInit materialize_code sha1MFinalize := sha1M.hmacFin materialize_code sha1MIterate := sha1M.iterate +materialize_code sha384MInit := sha384M.hmacInit materialize_code sha384MFinalize := sha384M.hmacFin materialize_code sha384MIterate := sha384M.iterate +materialize_code sha512MInit := sha512M'.hmacInit materialize_code sha512MFinalize := sha512M'.hmacFin materialize_code sha512MIterate := sha512M'.iterate +materialize_code sha512_224MInit := sha512_224M.hmacInit materialize_code sha512_224MFinalize := sha512_224M.hmacFin materialize_code sha512_224MIterate := sha512_224M.iterate +materialize_code sha512_256MInit := sha512_256M.hmacInit materialize_code sha512_256MFinalize := sha512_256M.hmacFin materialize_code sha512_256MIterate := sha512_256M.iterate diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Sha256.lean index 8480a8413..f083250e4 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Sha256.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Sha256.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances -import VerifiedGarbage.Proof.Hmac.Generic.X86.Sha256 +import VerifiedGarbage.Proof.Pbkdf2.Stream.X86.Sha256 /-! # HMAC-SHA-256 and PBKDF2-HMAC-SHA-256 over the compression function on x86 (32-bit), for every backend @@ -20,7 +20,7 @@ namespace VG.Proof.Pbkdf2.Md.X86 open VG.X86 open VG.Impl.Pbkdf2.Md.X86 (Hash) -open VG.Proof.Hmac.Generic.X86 (Sha256Stream sha256OK) +open VG.Proof.Pbkdf2.Stream.X86 (Sha256Stream sha256OK) open VG.Proof.Sha256.X86.Variants (mdHash) /-- SHA-256 with the compression function `cmpN`/`cmpC` and the streaming @@ -40,6 +40,7 @@ def sha256Ok (v : Sha256Stream) (cmpN : String) {cmpC : Prog isa} (hc : CompOk P rw [Proof.Sha256.hash_eq] exact (List.take_of_length_le (Nat.le_of_eq (Proof.Sha256.md.digest_length _))).symm, show 32 ≤ 32 by decide, show 32 + 8 < 64 by decide⟩ + back _ _ _ h := h reloc m m' p q h := by apply Vector.ext intro j hj @@ -69,7 +70,7 @@ namespace VG.Proof.Pbkdf2.Md.X86.Instances open VG.X86 open VG.Proof.Pbkdf2.Md.X86 -open VG.Proof.Hmac.Generic.X86 (Sha256Stream finW finG iterW iterG countF) +open VG.Proof.Pbkdf2.Stream.X86 (Sha256Stream initW initG finW finG iterW iterG countF) theorem sha256Shape_iterChecks : Iterate.Checks sha256Shape where pro := ⟨_, by taint_decide⟩ @@ -78,6 +79,12 @@ theorem sha256Shape_iterChecks : Iterate.Checks sha256Shape where tail := ⟨_, by taint_decide⟩ restore := ⟨_, by taint_decide⟩ +theorem sha256Shape_initChecks : HmacInit.Checks sha256Shape where + pro := ⟨_, by taint_decide⟩ + blocks := ⟨_, by taint_decide⟩ + toOuter := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + theorem sha256Shape_finChecks : HmacFin.Checks sha256Shape where pro := ⟨_, by taint_decide⟩ fin1 := ⟨_, by taint_decide⟩ @@ -89,6 +96,11 @@ theorem sha256_iterChecks (v : Sha256Stream) (cmpN : String) (cmpC : Prog isa) : let h := sha256Shape_iterChecks ⟨h.pro, h.load, h.mid, h.tail, h.restore⟩ +theorem sha256_initChecks (v : Sha256Stream) (cmpN : String) (cmpC : Prog isa) : + HmacInit.Checks (sha256M v cmpN cmpC) := + let h := sha256Shape_initChecks + ⟨h.pro, h.blocks, h.toOuter, h.restore⟩ + theorem sha256_finChecks (v : Sha256Stream) (cmpN : String) (cmpC : Prog isa) : HmacFin.Checks (sha256M v cmpN cmpC) := let h := sha256Shape_finChecks @@ -101,6 +113,13 @@ theorem sha256_iterImp : (iterW Spec.Hmac.sha256S 104).Implies (Spec.Hmac.sha256 X86.argBytes] [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 96 32 104 +theorem sha256_initImp : (initW Spec.Hmac.sha256S 104).Implies (Spec.Hmac.sha256I.initContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 96 104 + sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, + Spec.Hmac.sha256I, Spec.Hmac.sha256S, Spec.Hmac.sha256, initW, initG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 96 104 + theorem sha256_finImp : (finW Spec.Hmac.sha256S 104).Implies (Spec.Hmac.sha256I.finalizeContract X86.abi 48) := by obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 96 32 104 sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, @@ -123,3 +142,18 @@ theorem sha256_finalize (v : Sha256Stream) (cmpN : String) {cmpC : Prog isa} (show 8 * 20 + 16 + 32 ≤ 8 * 104 by decide) sha256_finImp.sat_left).of_implies sha256_finImp end VG.Proof.Pbkdf2.Md.X86.Instances + +namespace VG.Proof.Pbkdf2.Md.X86.Instances + +open VG.X86 +open VG.Proof.Pbkdf2.Md.X86 +open VG.Proof.Pbkdf2.Stream.X86 (Sha256Stream) + +/-- HMAC's `init` for SHA-256 with any backend. -/ +theorem sha256_init (v : Sha256Stream) (cmpN : String) {cmpC : Prog isa} + (hc : CompOk Proof.Sha256.md 112 cmpC) : + Verified X86.target (sha256M v cmpN cmpC).hmacInit (Spec.Hmac.sha256I.initContract X86.abi 48) := + (HmacInit.verifiedW (sha256Ok v cmpN hc) (sha256_initChecks v cmpN cmpC) + (show 8 * 20 + 16 ≤ 8 * 104 by decide) sha256_initImp.sat_left).of_implies sha256_initImp + +end VG.Proof.Pbkdf2.Md.X86.Instances diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/MdInit.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/MdInit.lean new file mode 100644 index 000000000..c2f0243e8 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/MdInit.lean @@ -0,0 +1,122 @@ +import VerifiedGarbage.Proof.Pbkdf2.MdStep +import VerifiedGarbage.Proof.Hmac.Common +import VerifiedGarbage.Proof.Pbkdf2.Memory +import VerifiedGarbage.Proof.Framework.Bswap + +/-! +# HMAC over a Merkle–Damgård hash function: a key's states as one compression each + +HMAC's `init`, for a key of at most a block, makes each streaming state +absorb one block (`K₀ ⊕ ipad`, `K₀ ⊕ opad`): one compression of the +initial hash value. A state whose hash value is that compression, of the +block stored in its buffer, represents the block (`repr_block`), for any +hash function the streaming proofs describe (`Md`), whatever the target. +The outer block is the inner one with `ipad ⊕ opad = 0x6a` in every byte +(`xorPad_6a`), and the key of at most a block is padded with zeros +(`blockKey_short`). The blocks are written word by word: words of a byte +repeated (`writeW_rep`), and words of the inner block XORed with `0x6a` +repeated (`writeW_xorRep`), with the key's bytes over the first ones +(`bytes_over`). +-/ + +namespace VG.Proof.MdStream.Md + +open VG.Spec.Hmac (xorPad ipad opad blockKey) +open VG.Spec.Sha256 (bytesAt) + +variable {B N L : Nat} {H : Md B N L} + +/-- The streaming state at `p`, whose hash value is `iv` compressed with the +block in its buffer when that held `x`, represents `x`. -/ +theorem repr_block {iv : H.HV} {m m' : Mem} {p : Addr} {x : List Byte} (hB : 0 < B) (hx : x.length = B) + (hb : bytesAt m (p + BitVec.ofNat 64 N) B = x) + (hs : H.stateAt m' p = H.compress iv (H.blockAt m (p + BitVec.ofNat 64 N))) : H.Repr iv m' p x := by + refine ⟨?_, ?_⟩ + · rw [hs, hx, Nat.div_self hB, compressList_one] + refine congrArg (H.compress iv) (H.parse_congr fun k hk => ?_) + rw [← hb, Hmac.Common.bytesAt_getD' _ _ hk] + · rw [hx, Nat.mod_self, Nat.div_self hB, Nat.mul_one, ← hx, List.drop_length] + rfl + +end VG.Proof.MdStream.Md + +namespace VG.Proof.Pbkdf2.MdInit + +open VG.Spec.Hmac (xorPad ipad opad blockKey) +open VG.Spec.Sha256 (bytesAt) +open VG.Proof.Sha256.Stream (writeBytes) +open VG.Proof.Hmac.Common (bytesAt_length bytesAt_add bytesAt_writeBytes_sep bytesAt_writeBytes_self + extractLsb'_read) + +/-! ## Words of bytes -/ + +/-- A word whose four bytes are `b`. -/ +theorem writeW_rep (m : Mem) (a : Addr) (b : Byte) : + m.writeW a (b ++ b ++ b ++ b) = writeBytes m a (List.replicate 4 b) := + Memory.writeW_bytes _ _ _ _ (by + show [_, _, _, _] = [b, b, b, b] + simp (disch := decide) only [BitVec.setWidth_eq, Nat.mul_zero, Nat.reduceMul, VG.extractLsb'_append_byte_lo, + VG.extractLsb'_append_byte_hi, Nat.reduceSub, BitVec.extractLsb'_eq_self]) + +/-- A word read from memory, XORed with `c` repeated, is its bytes XORed with `c`. -/ +theorem writeW_xorRep (m m' : Mem) (d a : Addr) (c : Byte) : + m.writeW d (m'.readW a 32 ^^^ (c ++ c ++ c ++ c)) = writeBytes m d ((bytesAt m' a 4).map (· ^^^ c)) := by + refine Memory.writeW_bytes _ _ _ _ ?_ + simp only [bytesAt, List.map_map] + refine List.map_congr_left fun j hj => ?_ + have hj := List.mem_range.mp hj + simp only [Function.comp, Mem.readW, BitVec.setWidth_eq] + rw [BitVec.extractLsb'_xor, extractLsb'_read _ _ hj] + congr 1 + rcases (by omega : j = 0 ∨ j = 1 ∨ j = 2 ∨ j = 3) with rfl | rfl | rfl | rfl <;> + simp (disch := decide) only [Nat.mul_zero, Nat.reduceMul, VG.extractLsb'_append_byte_lo, + VG.extractLsb'_append_byte_hi, Nat.reduceSub, BitVec.extractLsb'_eq_self] + +/-- `0x6a` in every byte. -/ +theorem c6a : (0x6a6a6a6a : BitVec 32) = (0x6a : Byte) ++ (0x6a : Byte) ++ (0x6a : Byte) ++ (0x6a : Byte) := by + decide + +/-- A byte XORed with the low byte of `v`. -/ +theorem xor_byte (b : Byte) (v : BitVec 32) : ((b.setWidth 32) ^^^ v).setWidth 8 = b ^^^ v.setWidth 8 := by + ext i hi + simp [BitVec.getElem_setWidth, BitVec.getElem_xor] + +/-- Bytes all `b`, with the first ones overwritten. -/ +theorem bytes_over {m : Mem} {q : Addr} {xs : List Byte} {n : Nat} {b : Byte} (hl : xs.length ≤ n) (hn : n < 2 ^ 64) + (hm : bytesAt m q n = List.replicate n b) : + bytesAt (writeBytes m q xs) q n = xs ++ List.replicate (n - xs.length) b := by + have hs : Mem.Sep (q + BitVec.ofNat 64 xs.length) (n - xs.length) q xs.length := by + have := Offset.sep q (d := xs.length) (n := n - xs.length) (e := 0) (k := xs.length) (.inr (by omega)) + (by omega) (by omega) + rwa [BitVec.add_zero] at this + have e := bytesAt_add (writeBytes m q xs) q xs.length (n - xs.length) + have e' := bytesAt_add m q xs.length (n - xs.length) + rw [show xs.length + (n - xs.length) = n by omega] at e e' + rw [e, bytesAt_writeBytes_self _ _ _ (by omega), bytesAt_writeBytes_sep _ _ hs (by omega)] + rw [hm] at e' + rw [show bytesAt m (q + BitVec.ofNat 64 xs.length) (n - xs.length) = (List.replicate n b).drop xs.length by + rw [e', List.drop_left' (bytesAt_length _ _ _)], List.drop_replicate] + +/-! ## The keys -/ + +/-- `K₀ ⊕ ipad ⊕ 0x6a = K₀ ⊕ opad`. -/ +theorem xorPad_6a (k : List Byte) : (xorPad k ipad).map (· ^^^ 0x6a) = xorPad k opad := by + simp only [xorPad, List.map_map] + refine List.map_congr_left fun b _ => ?_ + simp only [Function.comp, BitVec.xor_assoc] + rfl + +/-- A key of at most a block, padded with zeros. -/ +theorem blockKey_short (H : Spec.Hmac.HashFunction) {key : List Byte} (h : key.length ≤ H.blockSize) : + blockKey H key = key ++ List.replicate (H.blockSize - key.length) 0 := by + simp only [blockKey, show ¬ (H.blockSize < key.length) by omega, ↓reduceIte] + +/-- The bytes of `K₀ ⊕ ipad`, for a key of `kl ≤ B` bytes: the key's +bytes XORed with `ipad`, then `ipad`. -/ +theorem xorPad_short (key : List Byte) (B : Nat) : + xorPad (key ++ List.replicate (B - key.length) 0) ipad = + key.map (· ^^^ ipad) ++ List.replicate (B - key.length) ipad := by + simp only [xorPad, List.map_append, List.map_replicate] + rfl + +end VG.Proof.Pbkdf2.MdInit diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Common.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Common.lean new file mode 100644 index 000000000..8089538c8 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Common.lean @@ -0,0 +1,464 @@ +import VerifiedGarbage.Proof.Pbkdf2.Stream.Arm.Hash +import VerifiedGarbage.Proof.Hmac.Generic.Common +import Mathlib.Tactic.Set +import VerifiedGarbage.Proof.Framework.OmegaLit + +/-! +# Calls of a streaming hash function on 32-bit ARM: the byte loops + +As on AArch64 (`Proof/Hmac/Generic/AArch64/Init.lean`, with the byte-list lemmas +of `Proof/Hmac/Generic/Common.lean`): the byte copy (`copy`) and the +exclusive-or of `U` into `T`, which the whole of PBKDF2 uses. Each counts `r8` +up from 0 and `r9` down to 0 with `subs`, and branches on its result. Addresses are 32 bits, zero-extended: every buffer the loops touch lies +below 2³², so byte `k` of a buffer at `p + o` is at `State.addr p + o + k`. +-/ + +namespace VG.Proof.Pbkdf2.Stream.Arm + +open VG.Arm +open VG.Impl.Pbkdf2.Stream.Arm (Hash copy) +open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil) +open VG.Proof.MdStream.Arm (Upd Mupd Fupd WP.cons op2_imm op2_reg wp_mov wp_add wp_subs wp_ldrb wp_strb + eval_ne sub_beq sub_ofNat) +open VG.Proof.Hmac.Common (bytesAt_length) +open VG.Proof.Hmac.Generic.Common (writeBytes_snoc bytesAt_snoc' not_mem_of_disjoint xorBytes_snoc + xorBytes_length' InRegions.right' add_ofNat_add BufMem buf_write K0 K0_length K0_lt K0_ge) +open Spec.Sha256 (bytesAt) + +/-! ## Instructions and arithmetic -/ + +theorem wp_eor {is : List Instr} {s : State} {Q : State → Prop} {d n : Reg} {o : Op2} {y : BitVec 32} + (ho : o.eval s = some y) (k : ∀ s', Upd s s' d (s.gpr n ^^^ y) → WP isa (.block is) s' Q) : + WP isa (.block (.dp .eor d n o :: is)) s Q := + WP.cons (s' := s.setReg d (s.gpr n ^^^ y)) (by simp [exec, ho]) (k _ (Upd.setReg _ _ _)) + +theorem ofNat_succ32 (k : Nat) : BitVec.ofNat 32 k + 1 = BitVec.ofNat 32 (k + 1) := by + rw [BitVec.ofNat_add]; rfl + +theorem movw_ofNat {n : Nat} (h : n < 2 ^ 16) : (BitVec.ofNat 16 n).setWidth 32 = BitVec.ofNat 32 n := by + apply BitVec.eq_of_toNat_eq + simp only [BitVec.toNat_setWidth, BitVec.toNat_ofNat] + omega_nat + +/-- Byte `k` of the buffer at `a + o`, as a loop addresses it. -/ +theorem addr3 {a : BitVec 32} {k o : Nat} (h : a.toNat + o + k < 2 ^ 32) : + State.addr (a + BitVec.ofNat 32 k + BitVec.ofNat 32 o) = State.addr a + BitVec.ofNat 64 o + BitVec.ofNat 64 k := by + rw [BitVec.add_assoc, ← BitVec.ofNat_add, addr_add (by omega_nat), BitVec.ofNat_add, BitVec.add_assoc, + BitVec.add_comm (BitVec.ofNat 64 k)] + +/-- The flags after counting `r9` down from `n - k` to `n - (k + 1)`. -/ +theorem left_z {n k : Nat} (hk : k < n) (hn : n < 2 ^ 32) : + (BitVec.ofNat 32 (n - k) - 1 == 0) = decide (n - (k + 1) = 0) := by + rw [show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_beq (by omega_nat) (by decide)] + simp only [decide_eq_decide]; omega_nat + +theorem left_val {n k : Nat} (hk : k < n) : + BitVec.ofNat 32 (n - k) - 1 = BitVec.ofNat 32 (n - (k + 1)) := by + rw [show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat (by omega_nat), Nat.sub_sub] + +/-- The registers the loops write. -/ +abbrev clob : List Reg := [.r1, .r2, .r8, .r9, .r12] + +/-- The registers `copy` writes. -/ +abbrev cclob : List Reg := [.r2, .r8, .r9, .r12] + +theorem nm {r : Reg} {l : List Reg} (h : r ∉ l) (x : Reg) (hx : x ∈ l := by decide) : r ≠ x := + fun e => h (e ▸ hx) + +/-! ## Counted loops -/ + +/-- A do-while loop on `ne` that runs its body `n > 0` times, each run +ending with the flags of `n - (k + 1) = 0`. -/ +theorem count_loop {body : Prog isa} {n : Nat} (hn : 0 < n) (I : Nat → State → Prop) + (hstep : ∀ k < n, ∀ s, I k s → WP isa body s fun s' => I (k + 1) s' ∧ s'.z = decide (n - (k + 1) = 0)) + {s : State} (h0 : I 0 s) : WP isa (.loop body .ne) s (I n) := by + refine WP.loop (M := isa) (fun m s => ∃ k, m = n - k ∧ k < n ∧ I k s) ?_ n s ⟨0, by omega_nat, hn, h0⟩ + rintro m s ⟨k, rfl, hk, hi⟩ + refine WP.mono (hstep k hk s hi) fun s' ⟨hi', hz⟩ => ?_ + have he : isa.eval .ne s' = some (!decide (n - (k + 1) = 0)) := by + show eval .ne s' = _; rw [eval_ne, hz] + by_cases hl : k + 1 = n + · exact .inl ⟨by rw [he]; simp [hl], hl ▸ hi'⟩ + · exact .inr ⟨by rw [he]; simp; omega_nat, n - (k + 1), by omega_nat, k + 1, rfl, by omega_nat, hi'⟩ + +/-! ## `copy` -/ + +/-- After `k` bytes of a `copy` of `n` bytes from `A` to `B`. -/ +structure CopyInv (s : State) (A B : Addr) (n k : Nat) (t : State) : Prop where + rd : t.rd = s.rd + wr : t.wr = s.wr + sp : t.sp = s.sp + other : ∀ r ∉ cclob, t.gpr r = s.gpr r + r8 : t.gpr .r8 = BitVec.ofNat 32 k + r9 : t.gpr .r9 = BitVec.ofNat 32 (n - k) + mem : t.mem = writeBytes s.mem B (bytesAt s.mem A k) + +/-- The registers and memory `copy` leaves. -/ +structure Copied (s : State) (B : Addr) (xs : List Byte) (t : State) : Prop where + rd : t.rd = s.rd + wr : t.wr = s.wr + sp : t.sp = s.sp + other : ∀ r ∉ cclob, t.gpr r = s.gpr r + mem : t.mem = writeBytes s.mem B xs + +theorem copy_ok {src dst : Reg} (hs : src ∉ cclob) (hd : dst ∉ cclob) + {so d n : Nat} (hso : so < 4096) (hdo : d < 4096) (hn : 0 < n) (hn' : n < 2 ^ 16) {s : State} + (hsw : (s.gpr src).toNat + so + n ≤ 2 ^ 32) (hdw : (s.gpr dst).toNat + d + n ≤ 2 ^ 32) + (hin : ∀ k < n, InRegions (s.rd ++ s.wr) (State.addr (s.gpr src) + BitVec.ofNat 64 so + BitVec.ofNat 64 k) 1) + (hout : ∀ k < n, InRegions s.wr (State.addr (s.gpr dst) + BitVec.ofNat 64 d + BitVec.ofNat 64 k) 1) + (hsep : Region.Disjoint ⟨State.addr (s.gpr src) + BitVec.ofNat 64 so, n⟩ + ⟨State.addr (s.gpr dst) + BitVec.ofNat 64 d, n⟩) : + WP isa (copy src so dst d n) s fun t => + Copied s (State.addr (s.gpr dst) + BitVec.ofNat 64 d) + (bytesAt s.mem (State.addr (s.gpr src) + BitVec.ofNat 64 so) n) t := by + set A := State.addr (s.gpr src) + BitVec.ofNat 64 so + set B := State.addr (s.gpr dst) + BitVec.ofNat 64 d + refine WP.seq (wp_mov (op2_imm (by decide)) fun s₀ u₀ => VG.Proof.Pbkdf2.Stream.Arm.wp_movw fun s₁ u₁ => + WP.block_nil ?_) + have i0 : CopyInv s A B n 0 s₁ := + ⟨by rw [u₁.rd, u₀.rd], by rw [u₁.wr, u₀.wr], by rw [u₁.sp, u₀.sp], + fun r hr => by rw [u₁.other r (nm hr .r9), u₀.other r (nm hr .r8)], + by rw [u₁.other _ (by decide), u₀.gpr]; rfl, by rw [u₁.gpr, movw_ofNat hn']; rfl, + by rw [u₁.mem, u₀.mem, bytesAt, List.range_zero, List.map_nil, writeBytes_nil]⟩ + refine WP.mono (count_loop hn (CopyInv s A B n) (fun k hk t h => ?_) i0) + fun t h => ⟨h.rd, h.wr, h.sp, h.other, h.mem⟩ + refine wp_add (op2_reg _ _) fun t₁ u₁ => ?_ + refine wp_ldrb (a := A + BitVec.ofNat 64 k) hso + (by rw [u₁.gpr, h.other src hs, h.r8, addr3 (by omega_nat)]) + (by rw [u₁.rd, u₁.wr, h.rd, h.wr]; exact hin k hk) fun t₂ u₂ => ?_ + refine wp_add (op2_reg _ _) fun t₃ u₃ => ?_ + refine wp_strb (a := B + BitVec.ofNat 64 k) hdo + (by rw [u₃.gpr, u₂.other dst (nm hd .r12), u₁.other dst (nm hd .r2), h.other dst hd, + u₂.other .r8 (by decide), u₁.other .r8 (by decide), h.r8, addr3 (by omega_nat)]) + (by rw [u₃.wr, u₂.wr, u₁.wr, h.wr]; exact hout k hk) fun t₄ m₄ => ?_ + refine wp_add (op2_imm (by decide)) fun t₅ u₅ => wp_subs (op2_imm (by decide)) fun t₆ u₆ z₆ => + WP.block_nil ?_ + have h8 : t₅.gpr .r8 = BitVec.ofNat 32 (k + 1) := by + rw [u₅.gpr, m₄.gpr, u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), h.r8, + ofNat_succ32] + have h9 : t₅.gpr .r9 = BitVec.ofNat 32 (n - k) := by + rw [u₅.other _ (by decide), m₄.gpr, u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), h.r9] + refine ⟨⟨by rw [u₆.rd, u₅.rd, m₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], + by rw [u₆.wr, u₅.wr, m₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], + by rw [u₆.sp, u₅.sp, m₄.sp, u₃.sp, u₂.sp, u₁.sp, h.sp], + fun r hr => by + rw [u₆.other r (nm hr .r9), u₅.other r (nm hr .r8), m₄.gpr, u₃.other r (nm hr .r2), u₂.other r (nm hr .r12), + u₁.other r (nm hr .r2), h.other r hr], + by rw [u₆.other _ (by decide), h8], by rw [u₆.gpr, h9, left_val hk], ?_⟩, ?_⟩ + · have hl : (bytesAt s.mem A k).length = k := bytesAt_length _ _ _ + have v : (t₃.gpr .r12).setWidth 8 = s.mem (A + BitVec.ofNat 64 k) := by + rw [u₃.other _ (by decide), u₂.gpr, u₁.mem, h.mem] + simp only [writeBytes, hl, not_mem_of_disjoint hsep hk (Nat.le_of_lt hk) (by omega_nat), ↓reduceIte] + ext i hi; simp + have e' := writeBytes_snoc s.mem B (bytesAt s.mem A k) (s.mem (A + BitVec.ofNat 64 k)) + (by rw [hl]; omega_nat) + rw [hl] at e' + rw [u₆.mem, u₅.mem, m₄.mem, v, u₃.mem, u₂.mem, u₁.mem, h.mem, bytesAt_snoc', e'] + · rw [z₆, h9, left_z hk (by omega_nat)] + +/-! ## The exclusive-or of `U` into `T` -/ + +theorem xor_byte32 (a b : Byte) : ((b.setWidth 32 ^^^ a.setWidth 32).setWidth 8) = b ^^^ a := by + ext i hi + simp [BitVec.getElem_xor] + +/-- After `k` bytes of the exclusive-or of `[U]` into `[T]`. -/ +structure XorInv (s : State) (U T : Addr) (n k : Nat) (t : State) : Prop where + rd : t.rd = s.rd + wr : t.wr = s.wr + sp : t.sp = s.sp + other : ∀ r ∉ clob, t.gpr r = s.gpr r + r8 : t.gpr .r8 = BitVec.ofNat 32 k + r9 : t.gpr .r9 = BitVec.ofNat 32 (n - k) + mem : t.mem = writeBytes s.mem T (Spec.Pbkdf2.xorBytes (bytesAt s.mem T k) (bytesAt s.mem U k)) + +/-- `T ← T ⊕ U`, `n` bytes, with `U` at `r11 + uo` and `T` at `r5`. -/ +theorem xor_ok {uo n : Nat} (huo : uo < 4096) (hn : 0 < n) (hn' : n < 2 ^ 16) {s : State} + (huw : (s.gpr .r11).toNat + uo + n ≤ 2 ^ 32) (htw : (s.gpr .r5).toNat + n ≤ 2 ^ 32) + (hinU : ∀ k < n, InRegions (s.rd ++ s.wr) (State.addr (s.gpr .r11) + BitVec.ofNat 64 uo + BitVec.ofNat 64 k) 1) + (houtT : ∀ k < n, InRegions s.wr (State.addr (s.gpr .r5) + BitVec.ofNat 64 k) 1) + (hsep : Region.Disjoint ⟨State.addr (s.gpr .r11) + BitVec.ofNat 64 uo, n⟩ ⟨State.addr (s.gpr .r5), n⟩) : + WP isa (.seq (.block [.mov .r8 (.imm 0), .movw .r9 (BitVec.ofNat 16 n)]) + (.loop (.block [.dp .add .r2 .r11 (.reg .r8), .ldrb .r12 .r2 uo, .dp .add .r2 .r5 (.reg .r8), + .ldrb .r1 .r2 0, .dp .eor .r1 .r1 (.reg .r12), .strb .r1 .r2 0, .dp .add .r8 .r8 (.imm 1), + .subs .r9 .r9 (.imm 1)]) .ne)) s + fun t => XorInv s (State.addr (s.gpr .r11) + BitVec.ofNat 64 uo) (State.addr (s.gpr .r5)) n n t := by + set U := State.addr (s.gpr .r11) + BitVec.ofNat 64 uo + set T := State.addr (s.gpr .r5) + refine WP.seq (wp_mov (op2_imm (by decide)) fun s₀ u₀ => VG.Proof.Pbkdf2.Stream.Arm.wp_movw fun s₁ u₁ => + WP.block_nil ?_) + have i0 : XorInv s U T n 0 s₁ := + ⟨by rw [u₁.rd, u₀.rd], by rw [u₁.wr, u₀.wr], by rw [u₁.sp, u₀.sp], + fun r hr => by rw [u₁.other r (nm hr .r9), u₀.other r (nm hr .r8)], + by rw [u₁.other _ (by decide), u₀.gpr]; rfl, by rw [u₁.gpr, movw_ofNat hn']; rfl, + by rw [u₁.mem, u₀.mem]; simp [bytesAt, Spec.Pbkdf2.xorBytes, writeBytes_nil]⟩ + refine count_loop hn (XorInv s U T n) (fun k hk t h => ?_) i0 + have hl : (bytesAt s.mem T k).length = k := bytesAt_length _ _ _ + have hl' : (Spec.Pbkdf2.xorBytes (bytesAt s.mem T k) (bytesAt s.mem U k)).length = k := by + rw [xorBytes_length' _ _ (by simp [bytesAt_length]), hl] + have rU : t.mem (U + BitVec.ofNat 64 k) = s.mem (U + BitVec.ofNat 64 k) := by + rw [h.mem]; simp only [writeBytes, hl', not_mem_of_disjoint hsep hk (Nat.le_of_lt hk) (by omega_nat), ↓reduceIte] + have rT : t.mem (T + BitVec.ofNat 64 k) = s.mem (T + BitVec.ofNat 64 k) := by + rw [h.mem] + simp only [writeBytes, hl', show T + BitVec.ofNat 64 k - T = BitVec.ofNat 64 k by rw [BitVec.add_comm, BitVec.add_sub_cancel], + BitVec.toNat_ofNat, Nat.mod_eq_of_lt (show k < 2 ^ 64 by omega_nat), Nat.lt_irrefl, ↓reduceIte] + have g11 := h.other .r11 (by decide) + have g5 := h.other .r5 (by decide) + refine wp_add (op2_reg _ _) fun t₁ u₁ => ?_ + refine wp_ldrb (a := U + BitVec.ofNat 64 k) huo (by rw [u₁.gpr, g11, h.r8, addr3 (by omega_nat)]) + (by rw [u₁.rd, u₁.wr, h.rd, h.wr]; exact hinU k hk) fun t₂ u₂ => ?_ + refine wp_add (op2_reg _ _) fun t₃ u₃ => ?_ + have a₃ : State.addr (t₃.gpr .r2 + BitVec.ofNat 32 0) = T + BitVec.ofNat 64 k := by + rw [u₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), u₂.other _ (by decide), + u₁.other _ (by decide), g5, h.r8, addr3 (by omega_nat)] + exact congrArg (· + BitVec.ofNat 64 k) (BitVec.add_zero _) + refine wp_ldrb (a := T + BitVec.ofNat 64 k) (by decide) a₃ + (by rw [u₃.rd, u₃.wr, u₂.rd, u₂.wr, u₁.rd, u₁.wr, h.rd, h.wr]; exact InRegions.right' (houtT k hk)) + fun t₄ u₄ => ?_ + refine wp_eor (op2_reg _ _) fun t₅ u₅ => ?_ + refine wp_strb (a := T + BitVec.ofNat 64 k) (by decide) + (by rw [u₅.other _ (by decide), u₄.other _ (by decide)]; exact a₃) + (by rw [u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr]; exact houtT k hk) fun t₆ m₆ => ?_ + refine wp_add (op2_imm (by decide)) fun t₇ u₇ => wp_subs (op2_imm (by decide)) fun t₈ u₈ z₈ => + WP.block_nil ?_ + have h8 : t₇.gpr .r8 = BitVec.ofNat 32 (k + 1) := by + rw [u₇.gpr, m₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), + u₂.other _ (by decide), u₁.other _ (by decide), h.r8, ofNat_succ32] + have h9 : t₇.gpr .r9 = BitVec.ofNat 32 (n - k) := by + rw [u₇.other _ (by decide), m₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), + u₂.other _ (by decide), u₁.other _ (by decide), h.r9] + refine ⟨⟨by rw [u₈.rd, u₇.rd, m₆.rd, u₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], + by rw [u₈.wr, u₇.wr, m₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], + by rw [u₈.sp, u₇.sp, m₆.sp, u₅.sp, u₄.sp, u₃.sp, u₂.sp, u₁.sp, h.sp], + fun r hr => by + rw [u₈.other r (nm hr .r9), u₇.other r (nm hr .r8), m₆.gpr, u₅.other r (nm hr .r1), u₄.other r (nm hr .r1), + u₃.other r (nm hr .r2), u₂.other r (nm hr .r12), u₁.other r (nm hr .r2), h.other r hr], + by rw [u₈.other _ (by decide), h8], by rw [u₈.gpr, h9, left_val hk], ?_⟩, ?_⟩ + · have hv : (t₅.gpr .r1).setWidth 8 = s.mem (T + BitVec.ofNat 64 k) ^^^ s.mem (U + BitVec.ofNat 64 k) := by + rw [u₅.gpr, u₄.gpr, u₄.other .r12 (by decide), u₃.other .r12 (by decide), u₂.gpr, u₃.mem, u₂.mem, + u₁.mem, xor_byte32, rU, rT] + have e' := writeBytes_snoc s.mem T (Spec.Pbkdf2.xorBytes (bytesAt s.mem T k) (bytesAt s.mem U k)) + (s.mem (T + BitVec.ofNat 64 k) ^^^ s.mem (U + BitVec.ofNat 64 k)) (by rw [hl']; omega_nat) + rw [hl'] at e' + rw [u₈.mem, u₇.mem, m₆.mem, hv, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem, h.mem, e', + bytesAt_snoc', bytesAt_snoc', xorBytes_snoc _ _ _ _ (by simp [bytesAt_length])] + · rw [z₈, h9, left_z hk (by omega_nat)] + +end VG.Proof.Pbkdf2.Stream.Arm + +/-! +# HMAC over any streaming hash function on 32-bit ARM: our caller's registers + +As on AArch64 (`Proof/Hmac/Generic/AArch64/Init.lean`): the callee-saved +registers we use, and our return address `lr`, are stored in `scratch` after +the working space of the functions we call (`Hash.saved`), with `scratch` in +`r12`, and loaded back at the end, with `scratch` in `r11`, which is loaded +last. +-/ + +namespace VG.Proof.Pbkdf2.Stream.Arm + +open VG.Arm +open VG.Impl.Pbkdf2.Stream.Arm (Hash) +open VG.Proof.MdStream.Arm (contains_offset) +open VG.Proof.MdStream.Arm (Upd wp_ldr saveMem saveList_ok readW_writeW_save sub_offset) +open VG.Proof.Hmac.Generic.Common (InRegions.right' add_ofNat_add) + +variable (H : Hash) + +/-- The registers saved, in the order of their slots. -/ +abbrev savedRegs : List Reg := [.r4, .r5, .r6, .r7, .r8, .r9, .r10, .lr, .r11] + +theorem preserved_saved : ∀ r ∈ preserved, r ∈ savedRegs := by decide + +/-- Where the registers are saved. -/ +abbrev saveR (scr : BitVec 32) : Region := ⟨State.addr scr + BitVec.ofNat 64 (8 * H.W), 36⟩ + +/-- The registers of `s₀` saved in the memory `m`. -/ +def SavedRegs (scr : BitVec 32) (s₀ : State) (m : Mem) : Prop := + ∀ p ∈ H.saved, m.readW (State.addr scr + BitVec.ofNat 64 p.2) 32 = s₀.gpr p.1 + +theorem saved_mem {p : Reg × Nat} (hp : p ∈ H.saved) : 8 * H.W ≤ p.2 ∧ p.2 + 4 ≤ 8 * H.W + 36 := by + simp only [Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp + rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> simp only <;> omega_nat + +theorem saved_pairwise : H.saved.Pairwise (fun p q => p.2 + 4 ≤ q.2 ∨ q.2 + 4 ≤ p.2) := by + simp [Hash.saved] + +/-- Slot `d` of the save area. -/ +theorem slot_sub (scr : BitVec 32) {d : Nat} (h₁ : 8 * H.W ≤ d) (h₂ : d + 4 ≤ 8 * H.W + 36) : + Region.Sub ⟨State.addr scr + BitVec.ofNat 64 d, 4⟩ (saveR H scr) := by + rw [show d = 8 * H.W + (d - 8 * H.W) by omega_nat, ← add_ofNat_add] + exact sub_offset (by omega_nat) (by omega_nat) + +theorem SavedRegs.frame {scr : BitVec 32} {s₀ : State} {m m' : Mem} (h : SavedRegs H scr s₀ m) + {rs : List Region} (hf : Frame rs m m') (hd : ∀ r ∈ rs, (saveR H scr).Disjoint r) : + SavedRegs H scr s₀ m' := fun p hp => by + obtain ⟨h₁, h₂⟩ := saved_mem H hp + rw [← h p hp] + exact hf.readW (r := ⟨_, 4⟩) (Region.contains_self _ _) + (fun r hr => (hd r hr).sub_left (slot_sub H scr h₁ h₂)) (by decide) + +theorem saveMem_other (m : Mem) (B : Addr) (g : Reg → BitVec 32) {d : Nat} (hd : d < 2 ^ 32) : + ∀ l : List (Reg × Nat), (∀ q ∈ l, q.2 < 2 ^ 32 ∧ (d + 4 ≤ q.2 ∨ q.2 + 4 ≤ d)) → + (saveMem m B g l).readW (B + BitVec.ofNat 64 d) 32 = m.readW (B + BitVec.ofNat 64 d) 32 + | [], _ => rfl + | q :: l, h => by + rw [saveMem, saveMem_other _ B g hd l fun q' hq' => h q' (List.mem_cons_of_mem _ hq'), + readW_writeW_save _ _ _ hd (h q (by simp)).1 (h q (by simp)).2] + +theorem saveMem_read (B : Addr) (g : Reg → BitVec 32) : + ∀ (m : Mem) (l : List (Reg × Nat)), l.Pairwise (fun p q => p.2 + 4 ≤ q.2 ∨ q.2 + 4 ≤ p.2) → + (∀ p ∈ l, p.2 < 2 ^ 32) → ∀ p ∈ l, (saveMem m B g l).readW (B + BitVec.ofNat 64 p.2) 32 = g p.1 + | _, [], _, _, p, hp => by cases hp + | m, q :: l, hpw, hb, p, hp => by + rw [List.pairwise_cons] at hpw + rcases List.mem_cons.mp hp with rfl | hp + · rw [saveMem, saveMem_other _ _ _ (hb p (by simp)) l + (fun q' hq' => ⟨hb q' (List.mem_cons_of_mem _ hq'), hpw.1 q' hq'⟩), Mem.readW_writeW_self32] + · rw [saveMem] + exact saveMem_read B g _ l hpw.2 (fun q' hq' => hb q' (List.mem_cons_of_mem _ hq')) p hp + +theorem saveMem_frameR (B : Addr) (g : Reg → BitVec 32) (o L : Nat) (hL : o + L < 2 ^ 64) : + ∀ (m : Mem) (l : List (Reg × Nat)), (∀ p ∈ l, o ≤ p.2 ∧ p.2 + 4 ≤ o + L) → + Frame [⟨B + BitVec.ofNat 64 o, L⟩] m (saveMem m B g l) + | _, [], _ => Frame.refl _ _ + | m, p :: l, hl => by + obtain ⟨h₁, h₂⟩ := hl p (by simp) + have c : (⟨B + BitVec.ofNat 64 o, L⟩ : Region).Contains (B + BitVec.ofNat 64 p.2) (32 / 8) := by + rw [show p.2 = o + (p.2 - o) by omega_nat, ← add_ofNat_add] + exact contains_offset (by omega_nat) (by omega_nat) + exact ((Frame.refl _ _).writeW (List.mem_singleton_self _) _ c).trans + (saveMem_frameR B g o L hL _ l fun q hq => hl q (List.mem_cons_of_mem _ hq)) + +theorem save_eq : H.save = H.saved.map (fun p => Instr.str p.1 .r12 p.2) := rfl + +/-- Saving the registers, with `scratch` in `r12`. -/ +theorem save_ok {s : State} {scr : BitVec 32} {L : Nat} (h12 : s.gpr .r12 = scr) (hW : H.W ≤ 64) + (hsc : ⟨State.addr scr, L⟩ ∈ s.wr) (hL : 8 * H.W + 36 ≤ L) (hfit : scr.toNat + L ≤ 2 ^ 32) + {rest : List Instr} {Q : State → Prop} + (k : ∀ s', s'.gpr = s.gpr → s'.rd = s.rd → s'.wr = s.wr → s'.sp = s.sp → + Frame [saveR H scr] s.mem s'.mem → SavedRegs H scr s s'.mem → WP isa (.block rest) s' Q) : + WP isa (.block (H.save ++ rest)) s Q := by + rw [save_eq] + refine saveList_ok H.saved s Q (fun p hp => ?_) fun s' g rd wr sp m => k s' g rd wr sp ?_ ?_ + · obtain ⟨h₁, h₂⟩ := saved_mem H hp + rw [h12] + exact ⟨by omega_nat, by omega_nat, ⟨_, hsc, contains_offset (by omega_nat) (by omega_nat)⟩⟩ + · rw [m, h12] + exact saveMem_frameR _ _ _ _ (by omega_nat) _ _ fun p hp => saved_mem H hp + · intro p hp + rw [m, h12] + exact saveMem_read _ _ _ _ (saved_pairwise H) (fun q hq => by have := saved_mem H hq; omega_nat) p hp + +theorem restoreList_ok {b : Reg} {rest : List Instr} (l : List (Reg × Nat)) : + ∀ (s : State) (Q : State → Prop), (l.map Prod.fst).Nodup → + (∀ p ∈ l, p.1 ≠ b ∧ p.2 < 4096 ∧ (s.gpr b).toNat + p.2 < 2 ^ 32 ∧ + InRegions (s.rd ++ s.wr) (State.addr (s.gpr b) + BitVec.ofNat 64 p.2) 4) → + (∀ s', (∀ p ∈ l, s'.gpr p.1 = s.mem.readW (State.addr (s.gpr b) + BitVec.ofNat 64 p.2) 32) → + (∀ r, r ∉ l.map Prod.fst → s'.gpr r = s.gpr r) → s'.mem = s.mem → s'.rd = s.rd → s'.wr = s.wr → + s'.sp = s.sp → WP isa (.block rest) s' Q) → + WP isa (.block (l.map (fun p => Instr.ldr p.1 b p.2) ++ rest)) s Q := by + induction l with + | nil => intro s Q _ _ k; exact k s (fun _ h => by cases h) (fun _ _ => rfl) rfl rfl rfl rfl + | cons p l ih => + intro s Q hnd hl k + obtain ⟨h0, h1, h2, h3⟩ := hl p (by simp) + simp only [List.map_cons, List.nodup_cons] at hnd + refine wp_ldr h1 (addr_add h2) h3 fun s₁ u₁ => ?_ + have eb : s₁.gpr b = s.gpr b := u₁.other _ (Ne.symm h0) + refine ih s₁ Q hnd.2 (fun q hq => ?_) fun s' hl' ho hm hrd hwr hsp => k s' (fun q hq => ?_) + (fun r hr => ?_) (hm.trans u₁.mem) (hrd.trans u₁.rd) (hwr.trans u₁.wr) (hsp.trans u₁.sp) + · rw [eb, u₁.rd, u₁.wr]; exact hl q (List.mem_cons_of_mem _ hq) + · rcases List.mem_cons.mp hq with rfl | hq + · rw [ho _ hnd.1, u₁.gpr] + · rw [hl' q hq, u₁.mem, eb] + · simp only [List.map_cons, List.mem_cons, not_or] at hr + rw [ho r hr.2, u₁.other r hr.1] + +/-- The slots loaded before `r11`. -/ +def saved8 : List (Reg × Nat) := + [(.r4, 8 * H.W), (.r5, 8 * H.W + 4), (.r6, 8 * H.W + 8), (.r7, 8 * H.W + 12), (.r8, 8 * H.W + 16), + (.r9, 8 * H.W + 20), (.r10, 8 * H.W + 24), (.lr, 8 * H.W + 28)] + +theorem restore_eq : + H.restore = (saved8 H).map (fun p => Instr.ldr p.1 .r11 p.2) ++ ([.ldr .r11 .r11 (8 * H.W + 32)] : List Instr) := rfl + +theorem saved8_fst : (saved8 H).map Prod.fst = [.r4, .r5, .r6, .r7, .r8, .r9, .r10, .lr] := rfl + +theorem saved8_sub {p : Reg × Nat} (hp : p ∈ saved8 H) : p ∈ H.saved := by + simp only [saved8, Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp ⊢ + rcases hp with h | h | h | h | h | h | h | h <;> simp [h] + +/-- Loading them back, with `scratch` in `r11` (loaded last). -/ +theorem restore_ok {s : State} {scr : BitVec 32} {L : Nat} (h11 : s.gpr .r11 = scr) (hW : H.W ≤ 64) + {s₀ : State} (hs : SavedRegs H scr s₀ s.mem) (hsc : ⟨State.addr scr, L⟩ ∈ s.wr) (hL : 8 * H.W + 36 ≤ L) + (hfit : scr.toNat + L ≤ 2 ^ 32) : + WP isa (.block H.restore) s fun s' => s'.mem = s.mem ∧ s'.rd = s.rd ∧ s'.wr = s.wr ∧ + s'.sp = s.sp ∧ (∀ r ∈ savedRegs, s'.gpr r = s₀.gpr r) ∧ + (∀ r, r ∉ savedRegs → s'.gpr r = s.gpr r) := by + have io : ∀ {t : State}, t.rd = s.rd → t.wr = s.wr → ∀ {d}, d + 4 ≤ L → + InRegions (t.rd ++ t.wr) (State.addr scr + BitVec.ofNat 64 d) 4 := fun hr hw d hd => by + rw [hr, hw]; exact InRegions.right' ⟨_, hsc, contains_offset hd (by omega_nat)⟩ + rw [restore_eq] + refine restoreList_ok (saved8 H) s _ (by rw [saved8_fst]; decide) (fun p hp => ?_) + fun s₁ hl ho hm hrd hwr hsp => ?_ + · have := saved_mem H (saved8_sub H hp) + refine ⟨?_, by omega_nat, by rw [h11]; omega_nat, by rw [h11]; exact io rfl rfl (by omega_nat)⟩ + simp only [saved8, List.mem_cons, List.not_mem_nil, or_false] at hp + rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> (dsimp only; decide) + have e11 : s₁.gpr .r11 = scr := by + rw [ho _ (by rw [saved8_fst]; decide), h11] + refine wp_ldr (by omega_nat) (addr_add (by rw [e11]; omega_nat)) (by rw [e11]; exact io hrd hwr (by omega_nat)) + fun s₂ u => WP.block_nil ⟨by rw [u.mem, hm], by rw [u.rd, hrd], by rw [u.wr, hwr], by rw [u.sp, hsp], + fun r hr => ?_, fun r hr => ?_⟩ + · have hv : ∀ p ∈ saved8 H, s₂.gpr p.1 = s₀.gpr p.1 := fun p hp => by + have h1 : p.1 ≠ .r11 := by + simp only [saved8, List.mem_cons, List.not_mem_nil, or_false] at hp + rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> (dsimp only; decide) + rw [u.other _ h1, hl p hp, h11, hs p (saved8_sub H hp)] + simp only [savedRegs, List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + · exact hv (.r4, 8 * H.W) (by simp [saved8]) + · exact hv (.r5, 8 * H.W + 4) (by simp [saved8]) + · exact hv (.r6, 8 * H.W + 8) (by simp [saved8]) + · exact hv (.r7, 8 * H.W + 12) (by simp [saved8]) + · exact hv (.r8, 8 * H.W + 16) (by simp [saved8]) + · exact hv (.r9, 8 * H.W + 20) (by simp [saved8]) + · exact hv (.r10, 8 * H.W + 24) (by simp [saved8]) + · exact hv (.lr, 8 * H.W + 28) (by simp [saved8]) + · rw [u.gpr, e11, hm, hs (.r11, 8 * H.W + 32) (by simp [Hash.saved])] + · simp only [savedRegs, List.mem_cons, List.not_mem_nil, or_false, not_or] at hr + rw [u.other r hr.2.2.2.2.2.2.2.2, ho r (by + rw [saved8_fst] + simp only [List.mem_cons, List.not_mem_nil, or_false, not_or]; exact ⟨hr.1, hr.2.1, hr.2.2.1, + hr.2.2.2.1, hr.2.2.2.2.1, hr.2.2.2.2.2.1, hr.2.2.2.2.2.2.1, hr.2.2.2.2.2.2.2.1⟩)] + +/-- The registers saved from a state that agrees on them. -/ +theorem SavedRegs.of_eq {scr : BitVec 32} {s₀ s₁ : State} {m : Mem} (h : SavedRegs H scr s₁ m) + (he : ∀ r ∈ savedRegs, s₁.gpr r = s₀.gpr r) : SavedRegs H scr s₀ m := fun p hp => by + rw [h p hp] + refine he _ ?_ + simp only [Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp + rcases hp with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> simp + +/-! ## Odds and ends -/ + +theorem below_eq {s t : State} (h : s.sp = t.sp) : below s = below t := by simp only [below, h] + +theorem toNat_addr (a : BitVec 32) : (State.addr a).toNat = a.toNat := by + simp only [State.addr, BitVec.toNat_setWidth] + exact Nat.mod_eq_of_lt (by have := a.isLt; omega_nat) + +theorem covers_one {rs : List Region} {r : Region} (h : r ∈ rs) : Covers [r] rs := + Covers.of_sub fun r' hr' => by + simp only [List.mem_singleton] at hr' + exact ⟨r, h, 0, by rw [hr']; simp, by rw [hr']; simp⟩ + +/-- A streaming state is kept by what writes elsewhere. -/ +theorem repr_keep {H : Hash} (hH : HashOK H) {rs : List Region} {m m' : Mem} (hf : Frame rs m m') {p : Addr} + (hd : ∀ r ∈ rs, Region.Disjoint ⟨p, H.S⟩ r) {msg : List Byte} (hr : hH.SH.Repr m p msg) : + hH.SH.Repr m' p msg := + hH.repr _ _ _ _ _ (fun i hi => hf.bytes (R := ⟨p, H.S⟩) hd (by show H.S ≤ 2 ^ 64; have := hH.hSB; omega_nat) hi) hr + +end VG.Proof.Pbkdf2.Stream.Arm diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hash.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Hash.lean similarity index 99% rename from lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hash.lean rename to lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Hash.lean index 553c73d4d..7d3e17934 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hash.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Hash.lean @@ -5,7 +5,7 @@ import VerifiedGarbage.Proof.Framework.Contract import VerifiedGarbage.Proof.Framework.Arm.Frame import VerifiedGarbage.Proof.Framework.Arm.Taint import VerifiedGarbage.Proof.MdStream.Arm.Common -import VerifiedGarbage.Impl.Hmac.Generic.Arm +import VerifiedGarbage.Impl.Pbkdf2.Stream.Arm import VerifiedGarbage.Proof.Framework.Offset import VerifiedGarbage.Proof.Framework.OffsetBelow import VerifiedGarbage.Proof.Framework.OmegaLit @@ -29,7 +29,7 @@ The contracts the proofs are written against, as on x86-64 and AArch64 (`Contract.Implies`). -/ -namespace VG.Proof.Hmac.Generic.Arm +namespace VG.Proof.Pbkdf2.Stream.Arm open VG.Arm open Spec.Hmac (StreamingHash xorPad ipad opad blockKey hmacBlockKey) @@ -175,7 +175,7 @@ def iterG : Contract isa where s₁.sp = s₂.sp ∧ s₁.gpr .r0 = s₂.gpr .r0 ∧ s₁.gpr .r1 = s₂.gpr .r1 ∧ s₁.gpr .r2 = s₂.gpr .r2 ∧ s₁.gpr .r3 = s₂.gpr .r3 ∧ stackArg s₁ 0 = stackArg s₂ 0 -end VG.Proof.Hmac.Generic.Arm +end VG.Proof.Pbkdf2.Stream.Arm /-! # HMAC over any streaming hash function on 32-bit ARM: the functions we call @@ -194,10 +194,10 @@ before its push. A frame writes the 16 bytes below the stack pointer, which them (`RelCT.call`, `RelCT.frame`). -/ -namespace VG.Proof.Hmac.Generic.Arm +namespace VG.Proof.Pbkdf2.Stream.Arm open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash) +open VG.Impl.Pbkdf2.Stream.Arm (Hash) open VG.Proof.MdStream.Arm (Upd WP.cons op2_imm op2_reg) open Spec.Hmac (StreamingHash) open Spec.Sha256 (bytesAt) @@ -787,4 +787,4 @@ theorem rel_wp {F F' G G' : State → Prop} {c : Prog isa} RelCT isa (fun s s' => F s ∧ F' s') c fun s s' => G s ∧ G' s' := (hct.wp fun s s' h => ⟨hw s h.1, hw' s' h.2⟩).mono (fun _ _ h => h) fun _ _ h => h.2 -end VG.Proof.Hmac.Generic.Arm +end VG.Proof.Pbkdf2.Stream.Arm diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hashes.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Hashes.lean similarity index 96% rename from lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hashes.lean rename to lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Hashes.lean index 9d2a22ac4..07cf62eb4 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hashes.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Hashes.lean @@ -1,4 +1,4 @@ -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Hash +import VerifiedGarbage.Proof.Pbkdf2.Stream.Arm.Hash import VerifiedGarbage.Proof.Sha1.Arm.Shared import VerifiedGarbage.Proof.Md5.Arm.Shared import VerifiedGarbage.Proof.Sha512.Arm.Shared @@ -8,16 +8,16 @@ import VerifiedGarbage.Proof.Hmac.Generic.Common # HMAC over any streaming hash function on 32-bit ARM: the hash functions `HashOK` for SHA-1, MD5 and the SHA-512 family, from their own proofs, as on -x86 (`Proof/Hmac/Generic/X86/Hashes.lean`). Their contracts are `initK`, +x86 (`Proof/Pbkdf2/Stream/X86/Hashes.lean`). Their contracts are `initK`, `updK` and `finK` at their sizes, but for the length bound of SHA-1's and MD5's `finK`, and for the SHA-512 family's, which hold from any initial hash value. SHA-256's and SHA-224's are in `Sha256.lean` and `Sha224.lean`. -/ -namespace VG.Proof.Hmac.Generic.Arm +namespace VG.Proof.Pbkdf2.Stream.Arm open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash) +open VG.Impl.Pbkdf2.Stream.Arm (Hash) open VG.Proof.Hmac.Generic.Common (sha1_repr md5_repr sha512_repr finalHash_length) /-! ## SHA-1 -/ @@ -155,4 +155,4 @@ def sha512_224OK : HashOK sha512_224H := sha512FamOK Spec.Hmac.sha512_224S 28 "v def sha512_256OK : HashOK sha512_256H := sha512FamOK Spec.Hmac.sha512_256S 32 "vg_sha512_256_init" Spec.Sha512.H0_512_256 rfl rfl rfl rfl (fun _ => rfl) (by decide) (by decide) (by decide +kernel) -end VG.Proof.Hmac.Generic.Arm +end VG.Proof.Pbkdf2.Stream.Arm diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha224.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Sha224.lean similarity index 56% rename from lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha224.lean rename to lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Sha224.lean index e2b95412f..08d0c581f 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha224.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Sha224.lean @@ -1,21 +1,19 @@ -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Instances +import VerifiedGarbage.Proof.Pbkdf2.Stream.Arm.Hashes import VerifiedGarbage.Proof.Sha256.Arm.Shared /-! -# HMAC-SHA-224 on 32-bit ARM +# SHA-224's streaming functions on 32-bit ARM `HashOK` for SHA-224 (`sha224OK`): SHA-256's streaming functions from SHA-224's initial hash value (`vg_sha224_init`, then `vg_sha256_update` and `vg_sha256_finalize`, whose contracts hold from any initial hash value), with -the digest the first 28 bytes of the final hash value; and the generic HMAC -proofs at it, moved to the shared contracts of `Spec.Hmac.sha224I` (as for the -hash functions of `Hashes.lean` in `Instances.lean`). +the digest the first 28 bytes of the final hash value. -/ -namespace VG.Proof.Hmac.Generic.Arm +namespace VG.Proof.Pbkdf2.Stream.Arm open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash) +open VG.Impl.Pbkdf2.Stream.Arm (Hash) open VG.Proof.Hmac.Generic.Common (readW_reloc bytesAt_reloc) /-- SHA-224's functions: SHA-256's streaming state, 96 bytes, and working @@ -71,33 +69,4 @@ def sha224OK : HashOK sha224H where updNF := by decide +kernel finNF := by decide +kernel -end VG.Proof.Hmac.Generic.Arm - -namespace VG.Proof.Hmac.Generic.Arm.Instances - -open VG.Arm -open VG.Proof.Hmac.Generic.Arm - -theorem sha224_initChecks : Init.Checks sha224H where - keys := ⟨_, by taint_decide⟩ - argI := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro st (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - argU₁ := ⟨_, by taint_decide⟩ - argU₂ := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha224_initImp : (initG Spec.Hmac.sha224S 104).Implies (Spec.Hmac.sha224I.initContract Arm.abi 16) := - initImp Spec.Hmac.sha224S 104 (by - inst_sat [Spec.Hmac.initContract, Spec.Hmac.initSig, Spec.Hmac.sha224S, Spec.Hmac.sha224, initG, below, - count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using initSat 96 104) - -theorem sha224_finImp : (finG Spec.Hmac.sha224S 104).Implies (Spec.Hmac.sha224I.finalizeContract Arm.abi 16) := - finImp Spec.Hmac.sha224S 104 (by - inst_sat [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.sha224S, Spec.Hmac.sha224, finG, - below, count, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using finSat 96 28 104) - -theorem sha224_init : Verified Arm.target sha224H.init (Spec.Hmac.sha224I.initContract Arm.abi 16) := - (Init.verified sha224OK sha224_initChecks (by decide) sha224_initImp.sat_left).of_implies sha224_initImp - -end VG.Proof.Hmac.Generic.Arm.Instances +end VG.Proof.Pbkdf2.Stream.Arm diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Sha256.lean new file mode 100644 index 000000000..03463a598 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Sha256.lean @@ -0,0 +1,56 @@ +import VerifiedGarbage.Proof.Pbkdf2.Stream.Arm.Hashes +import VerifiedGarbage.Proof.Sha256.Arm.Shared + +/-! +# SHA-256's streaming functions on 32-bit ARM + +`HashOK` for SHA-256 (`sha256OK`): its streaming functions +(`vg_sha256_init`, `vg_sha256_update` and `vg_sha256_finalize`, whose +contracts for `update` and `finalize` hold from any initial hash value). +-/ + +namespace VG.Proof.Pbkdf2.Stream.Arm + +open VG.Arm +open VG.Impl.Pbkdf2.Stream.Arm (Hash) + +/-- SHA-256's functions: a 96-byte streaming state, 20 words of working +space and a 32-byte digest. -/ +def sha256H : Hash := ⟨64, 96, 32, 32, 20, "vg_sha256_init", Impl.Sha256.Arm.Stream.init, + "vg_sha256_update", Impl.Sha256.Arm.Stream.update, "vg_sha256_finalize", Impl.Sha256.Arm.Stream.finalize⟩ + +def sha256OK : HashOK sha256H where + SH := Spec.Hmac.sha256S + Wb := 160 + hS := rfl + hD := rfl + hB := rfl + hDF := by decide + hF := by decide + hD0 := by decide + hS0 := by decide + hSB := by decide + hB0 := by decide + hBB := by decide + hWb := by decide + hW := by decide + repr := Hmac.Generic.Common.sha256_repr + init := Proof.Sha256.Arm.Stream.init_verified + upd := Proof.Sha256.Arm.Stream.Update.update_verified.of_implies + { pre := fun _ h => h + post := fun _ _ _ h m hr hc => h Spec.Sha256.H0 m hr hc + pub := fun _ _ _ _ h => h + sat := Proof.Sha256.Arm.Stream.Update.update_verified.2.2 } + fin := Proof.Sha256.Arm.Stream.Finalize.finalize_verified.of_implies + { pre := fun _ h => h + post := fun s s' _ h m hr _ hc => by + show List.take 32 (Spec.Sha256.bytesAt s'.mem _ 32) = _ + rw [List.take_of_length_le (by simp [Spec.Sha256.bytesAt])] + exact h Spec.Sha256.H0 m hr hc + pub := fun _ _ _ _ h => h + sat := Proof.Sha256.Arm.Stream.Finalize.finalize_verified.2.2 } + initNF := by decide +kernel + updNF := by decide +kernel + finNF := by decide +kernel + +end VG.Proof.Pbkdf2.Stream.Arm diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Common.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Common.lean new file mode 100644 index 000000000..11efd6ee1 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Common.lean @@ -0,0 +1,526 @@ +import VerifiedGarbage.Proof.Pbkdf2.Stream.X86.Hash +import Mathlib.Tactic.Set +import Mathlib.Tactic.Tauto +import VerifiedGarbage.Proof.Hmac.Generic.Common +import VerifiedGarbage.Proof.Framework.OffsetBelow +import VerifiedGarbage.Proof.Framework.OmegaLit + +/-! +# Calls of a streaming hash function on x86 (32-bit): byte loops, registers, stack + +The byte loops, our caller's registers and the stack, which HMAC's `init` and +`finalize`, PBKDF2's `iterate` (`Proof/Pbkdf2/Md/X86/`) and the whole of +PBKDF2 (`Proof/Pbkdf2/Whole/X86/`) share. +-/ + +/-! +## The byte loops + +As on the other targets +(`Proof/Pbkdf2/Stream/Arm/Common.lean`, whose byte-list lemmas from x86-64 +are reused): the byte copy (`copy`) and the exclusive-or of `U` into `T`. +Each counts an index up from 0 and compares it with its bound. The model has no index registers, +so each access computes its address first: byte `k` of a buffer at +`p + o` is at `[x + o]` with `x = p + k`, which is `p + o + k`, as nothing +wraps around the 32-bit address space. +-/ + +namespace VG.Proof.Pbkdf2.Stream.X86 + +open VG.X86 +open VG.Impl.Pbkdf2.Stream.X86 (Hash copy at_) +open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil) +open VG.Proof.Sha256.X86.Stream (Upd Mupd Fupd WP.cons wp_mov wp_movi wp_add wp_addi wp_cmp wp_cmpi wp_test + wp_movzx8 wp_store8 sub_beq sub_ofNat eval_e eval_ne ofNat_beq_zero) +open VG.Proof.Hmac.Common (bytesAt_length) +open VG.Proof.Hmac.Generic.Common (writeBytes_snoc bytesAt_snoc' not_mem_of_disjoint xorBytes_snoc xorBytes_length' + InRegions.right' add_ofNat_add BufMem buf_write K0 K0_length K0_lt K0_ge) +open Spec.Sha256 (bytesAt) + +/-! ## Instructions and arithmetic -/ + +section +variable {is : List Instr} {s : State} {Q : State → Prop} + +theorem wp_xori {d : Reg} {v : BitVec 32} (k : ∀ s', Upd s s' d (s.gpr d ^^^ v) → WP isa (.block is) s' Q) : + WP isa (.block (.alu .xor d (.imm v) :: is)) s Q := + WP.cons rfl (k _ (Upd.flags _ _ _ _ _ _)) + +theorem wp_xor {d r : Reg} (k : ∀ s', Upd s s' d (s.gpr d ^^^ s.gpr r) → WP isa (.block is) s' Q) : + WP isa (.block (.alu .xor d (.reg r) :: is)) s Q := + WP.cons rfl (k _ (Upd.flags _ _ _ _ _ _)) + +end + +/-- The zero flag of `test x, x`. -/ +theorem test_z (x : BitVec 32) : (x &&& x == 0) = decide (x.toNat = 0) := by + rw [BitVec.and_self] + by_cases h : x.toNat = 0 + · have : x = 0 := BitVec.eq_of_toNat_eq (by simpa using h) + simp [this] + · simp only [h, decide_false, beq_eq_false_iff_ne, ne_eq] + intro e; exact h (by rw [e]; rfl) + +theorem ea_at (s : State) (b : Reg) (d : Nat) : s.ea (at_ b d) = addr (s.gpr b) d := rfl + +theorem ofNat_succ32 (k : Nat) : BitVec.ofNat 32 k + 1 = BitVec.ofNat 32 (k + 1) := by + rw [BitVec.ofNat_add]; rfl + +/-- Byte `k` of the buffer at `a + o`, as a loop addresses it. -/ +theorem addr3 {a : BitVec 32} {k o : Nat} (h : a.toNat + o + k < 2 ^ 32) : + addr (a + BitVec.ofNat 32 k) o = a.setWidth 64 + BitVec.ofNat 64 o + BitVec.ofNat 64 k := by + rw [VG.Proof.Sha256.X86.Stream.addr_add_ofNat (by omega_nat), add_ofNat_add, Nat.add_comm] + +/-- The flags after counting up to `k + 1 ≤ n`. -/ +theorem count_z {n k : Nat} (hk : k < n) (hn : n < 2 ^ 32) : + (BitVec.ofNat 32 (k + 1) - BitVec.ofNat 32 n == 0) = decide (k + 1 = n) := + sub_beq (by omega_nat) hn + +/-- The registers the loops write. -/ +abbrev clob : List Reg := [.eax, .ecx, .edx, .ebx] + +/-- The registers `copy` writes. -/ +abbrev cclob : List Reg := [.eax, .ecx, .edx] + +theorem nm {r : Reg} {l : List Reg} (h : r ∉ l) (x : Reg) (hx : x ∈ l := by decide) : r ≠ x := + fun e => h (e ▸ hx) + +/-! ## Counted loops -/ + +/-- A do-while loop on `ne` that runs its body `n > 0` times, each run +ending with the flags of `k + 1 = n`. -/ +theorem count_loop {body : Prog isa} {n : Nat} (hn : 0 < n) (I : Nat → State → Prop) + (hstep : ∀ k < n, ∀ s, I k s → WP isa body s fun s' => I (k + 1) s' ∧ s'.zf = some (decide (k + 1 = n))) + {s : State} (h0 : I 0 s) : WP isa (.loop body .ne) s (I n) := by + refine WP.loop (M := isa) (fun m s => ∃ k, m = n - k ∧ k < n ∧ I k s) ?_ n s ⟨0, by omega_nat, hn, h0⟩ + rintro m s ⟨k, rfl, hk, hi⟩ + refine WP.mono (hstep k hk s hi) fun s' ⟨hi', hz⟩ => ?_ + have he : isa.eval .ne s' = some (!decide (k + 1 = n)) := by + show eval .ne s' = _; rw [eval_ne, hz]; rfl + by_cases hl : k + 1 = n + · exact .inl ⟨by rw [he]; simp [hl], hl ▸ hi'⟩ + · exact .inr ⟨by rw [he]; simp [hl], n - (k + 1), by omega_nat, k + 1, rfl, by omega_nat, hi'⟩ + +/-! ## `copy` -/ + +/-- After `k` bytes of a `copy` from `A` to `B`. -/ +structure CopyInv (s : State) (A B : Addr) (k : Nat) (t : State) : Prop where + rd : t.rd = s.rd + wr : t.wr = s.wr + other : ∀ r ∉ cclob, t.gpr r = s.gpr r + ecx : t.gpr .ecx = BitVec.ofNat 32 k + mem : t.mem = writeBytes s.mem B (bytesAt s.mem A k) + +/-- The registers and memory `copy` leaves. -/ +structure Copied (s : State) (B : Addr) (xs : List Byte) (t : State) : Prop where + rd : t.rd = s.rd + wr : t.wr = s.wr + other : ∀ r ∉ cclob, t.gpr r = s.gpr r + mem : t.mem = writeBytes s.mem B xs + +theorem copy_ok {src dst : Reg} (hs : src ∉ cclob) (hd : dst ∉ cclob) + {so d n : Nat} (hn : 0 < n) (hn' : n < 2 ^ 32) {s : State} + (hsw : (s.gpr src).toNat + so + n ≤ 2 ^ 32) (hdw : (s.gpr dst).toNat + d + n ≤ 2 ^ 32) + (hin : ∀ k < n, InRegions (s.rd ++ s.wr) ((s.gpr src).setWidth 64 + BitVec.ofNat 64 so + BitVec.ofNat 64 k) 1) + (hout : ∀ k < n, InRegions s.wr ((s.gpr dst).setWidth 64 + BitVec.ofNat 64 d + BitVec.ofNat 64 k) 1) + (hsep : Region.Disjoint ⟨(s.gpr src).setWidth 64 + BitVec.ofNat 64 so, n⟩ + ⟨(s.gpr dst).setWidth 64 + BitVec.ofNat 64 d, n⟩) : + WP isa (copy src so dst d n) s fun t => + Copied s ((s.gpr dst).setWidth 64 + BitVec.ofNat 64 d) + (bytesAt s.mem ((s.gpr src).setWidth 64 + BitVec.ofNat 64 so) n) t := by + set A := (s.gpr src).setWidth 64 + BitVec.ofNat 64 so + set B := (s.gpr dst).setWidth 64 + BitVec.ofNat 64 d + refine WP.seq (wp_movi fun s₀ u₀ => WP.block_nil ?_) + have i0 : CopyInv s A B 0 s₀ := + ⟨u₀.rd, u₀.wr, fun r hr => u₀.other r (nm hr .ecx), u₀.gpr, + by rw [u₀.mem, bytesAt, List.range_zero, List.map_nil, writeBytes_nil]⟩ + refine WP.mono (count_loop hn (CopyInv s A B) (fun k hk t h => ?_) i0) + fun t h => ⟨h.rd, h.wr, h.other, h.mem⟩ + refine wp_mov fun t₁ u₁ => wp_add fun t₂ u₂ => ?_ + refine wp_movzx8 (a := A + BitVec.ofNat 64 k) + (by rw [ea_at, u₂.gpr, u₁.gpr, u₁.other _ (by decide), h.other src hs, h.ecx, addr3 (by omega_nat)]) + (by rw [u₂.rd, u₂.wr, u₁.rd, u₁.wr, h.rd, h.wr]; exact hin k hk) fun t₃ u₃ => ?_ + refine wp_mov fun t₄ u₄ => wp_add fun t₅ u₅ => ?_ + refine wp_store8 (a := B + BitVec.ofNat 64 k) + (by rw [ea_at, u₅.gpr, u₄.gpr, u₄.other .ecx (by decide), u₃.other .ecx (by decide), u₂.other .ecx (by decide), + u₁.other .ecx (by decide), u₃.other _ (nm hd .edx), u₂.other _ (nm hd .eax), + u₁.other _ (nm hd .eax), h.other dst hd, h.ecx, addr3 (by omega_nat)]) + (by rw [u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr]; exact hout k hk) fun t₆ m₆ => ?_ + refine wp_addi fun t₇ u₇ => wp_cmpi fun t₈ f₈ _ z₈ => WP.block_nil ?_ + have h7 : t₇.gpr .ecx = BitVec.ofNat 32 (k + 1) := by + rw [u₇.gpr, m₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), + u₂.other _ (by decide), u₁.other _ (by decide), h.ecx, ofNat_succ32] + refine ⟨⟨by rw [f₈.rd, u₇.rd, m₆.rd, u₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], + by rw [f₈.wr, u₇.wr, m₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], + fun r hr => by + rw [f₈.gpr, u₇.other r (nm hr .ecx), m₆.gpr, u₅.other r (nm hr .eax), u₄.other r (nm hr .eax), + u₃.other r (nm hr .edx), u₂.other r (nm hr .eax), u₁.other r (nm hr .eax), h.other r hr], + by rw [f₈.gpr, h7], ?_⟩, ?_⟩ + · have hl : (bytesAt s.mem A k).length = k := bytesAt_length _ _ _ + have v : (t₅.gpr .edx).setWidth 8 = s.mem (A + BitVec.ofNat 64 k) := by + rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, u₂.mem, u₁.mem, h.mem] + simp only [writeBytes, hl, not_mem_of_disjoint hsep hk (Nat.le_of_lt hk) (by omega_nat), ↓reduceIte] + ext i hi; simp + have e' := writeBytes_snoc s.mem B (bytesAt s.mem A k) (s.mem (A + BitVec.ofNat 64 k)) + (by rw [hl]; omega_nat) + rw [hl] at e' + rw [f₈.mem, u₇.mem, m₆.mem, show Reg8.dl.reg = .edx from rfl, v, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem, + h.mem, bytesAt_snoc', e'] + · rw [z₈, h7, count_z hk hn'] + +/-! ## The exclusive-or of `U` into `T` -/ + +theorem xor_byte32 (a b : Byte) : ((a.setWidth 32 ^^^ b.setWidth 32).setWidth 8) = b ^^^ a := by + ext i hi + simp [BitVec.getElem_xor, Bool.xor_comm] + +/-- After `k` bytes of the exclusive-or of `[U]` into `[T]`. -/ +structure XorInv (s : State) (U T : Addr) (k : Nat) (t : State) : Prop where + rd : t.rd = s.rd + wr : t.wr = s.wr + other : ∀ r ∉ clob, t.gpr r = s.gpr r + ecx : t.gpr .ecx = BitVec.ofNat 32 k + mem : t.mem = writeBytes s.mem T (Spec.Pbkdf2.xorBytes (bytesAt s.mem T k) (bytesAt s.mem U k)) + +/-- `T ← T ⊕ U`, `n` bytes, with `U` at `ebp + uo` and `T` at `esi`. -/ +theorem xor_ok {uo n : Nat} (hn : 0 < n) (hn' : n < 2 ^ 32) {s : State} + (huw : (s.gpr .ebp).toNat + uo + n ≤ 2 ^ 32) (htw : (s.gpr .esi).toNat + n ≤ 2 ^ 32) + (hinU : ∀ k < n, InRegions (s.rd ++ s.wr) ((s.gpr .ebp).setWidth 64 + BitVec.ofNat 64 uo + BitVec.ofNat 64 k) 1) + (houtT : ∀ k < n, InRegions s.wr ((s.gpr .esi).setWidth 64 + BitVec.ofNat 64 k) 1) + (hsep : Region.Disjoint ⟨(s.gpr .ebp).setWidth 64 + BitVec.ofNat 64 uo, n⟩ ⟨(s.gpr .esi).setWidth 64, n⟩) : + WP isa (.seq (.block [.mov .ecx (.imm 0)]) + (.loop (.block [.mov .eax (.reg .ebp), .alu .add .eax (.reg .ecx), .movzx8 .edx (at_ .eax uo), + .mov .eax (.reg .esi), .alu .add .eax (.reg .ecx), .movzx8 .ebx (at_ .eax 0), .alu .xor .edx (.reg .ebx), + .store8 (at_ .eax 0) .dl, .alu .add .ecx (.imm 1), .alu .cmp .ecx (.imm (BitVec.ofNat 32 n))]) .ne)) s + fun t => XorInv s ((s.gpr .ebp).setWidth 64 + BitVec.ofNat 64 uo) ((s.gpr .esi).setWidth 64) n t := by + set U := (s.gpr .ebp).setWidth 64 + BitVec.ofNat 64 uo + set T := (s.gpr .esi).setWidth 64 + refine WP.seq (wp_movi fun s₀ u₀ => WP.block_nil ?_) + have i0 : XorInv s U T 0 s₀ := + ⟨u₀.rd, u₀.wr, fun r hr => u₀.other r (nm hr .ecx), u₀.gpr, + by rw [u₀.mem]; simp [bytesAt, Spec.Pbkdf2.xorBytes, writeBytes_nil]⟩ + refine count_loop hn (XorInv s U T) (fun k hk t h => ?_) i0 + have hl : (bytesAt s.mem T k).length = k := bytesAt_length _ _ _ + have hl' : (Spec.Pbkdf2.xorBytes (bytesAt s.mem T k) (bytesAt s.mem U k)).length = k := by + rw [xorBytes_length' _ _ (by simp [bytesAt_length]), hl] + have rU : t.mem (U + BitVec.ofNat 64 k) = s.mem (U + BitVec.ofNat 64 k) := by + rw [h.mem]; simp only [writeBytes, hl', not_mem_of_disjoint hsep hk (Nat.le_of_lt hk) (by omega_nat), ↓reduceIte] + have rT : t.mem (T + BitVec.ofNat 64 k) = s.mem (T + BitVec.ofNat 64 k) := by + rw [h.mem] + simp only [writeBytes, hl', Offset.add_sub_cancel_left, + BitVec.toNat_ofNat, Nat.mod_eq_of_lt (show k < 2 ^ 64 by omega_nat), Nat.lt_irrefl, ↓reduceIte] + have gb := h.other .ebp (by decide) + have gs := h.other .esi (by decide) + refine wp_mov fun t₁ u₁ => wp_add fun t₂ u₂ => ?_ + refine wp_movzx8 (a := U + BitVec.ofNat 64 k) + (by rw [ea_at, u₂.gpr, u₁.gpr, u₁.other _ (by decide), gb, h.ecx, addr3 (by omega_nat)]) + (by rw [u₂.rd, u₂.wr, u₁.rd, u₁.wr, h.rd, h.wr]; exact hinU k hk) fun t₃ u₃ => ?_ + refine wp_mov fun t₄ u₄ => wp_add fun t₅ u₅ => ?_ + have a₅ : t₅.ea (at_ .eax 0) = T + BitVec.ofNat 64 k := by + rw [ea_at, u₅.gpr, u₄.gpr, u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), + u₁.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), gs, h.ecx, + addr3 (by omega_nat)] + exact congrArg (· + BitVec.ofNat 64 k) (BitVec.add_zero _) + refine wp_movzx8 (a := T + BitVec.ofNat 64 k) a₅ + (by rw [u₅.rd, u₅.wr, u₄.rd, u₄.wr, u₃.rd, u₃.wr, u₂.rd, u₂.wr, u₁.rd, u₁.wr, h.rd, h.wr] + exact InRegions.right' (houtT k hk)) fun t₆ u₆ => ?_ + refine wp_xor fun t₇ u₇ => ?_ + refine wp_store8 (a := T + BitVec.ofNat 64 k) + (by rw [ea_at, u₇.other _ (by decide), u₆.other _ (by decide)]; exact a₅) + (by rw [u₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr]; exact houtT k hk) fun t₈ m₈ => ?_ + refine wp_addi fun t₉ u₉ => wp_cmpi fun t₁₀ f₁₀ _ z₁₀ => WP.block_nil ?_ + have h9 : t₉.gpr .ecx = BitVec.ofNat 32 (k + 1) := by + rw [u₉.gpr, m₈.gpr, u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), + u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), h.ecx, + ofNat_succ32] + refine ⟨⟨by rw [f₁₀.rd, u₉.rd, m₈.rd, u₇.rd, u₆.rd, u₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd, h.rd], + by rw [f₁₀.wr, u₉.wr, m₈.wr, u₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], + fun r hr => by + rw [f₁₀.gpr, u₉.other r (nm hr .ecx), m₈.gpr, u₇.other r (nm hr .edx), u₆.other r (nm hr .ebx), + u₅.other r (nm hr .eax), u₄.other r (nm hr .eax), u₃.other r (nm hr .edx), u₂.other r (nm hr .eax), + u₁.other r (nm hr .eax), h.other r hr], + by rw [f₁₀.gpr, h9], ?_⟩, ?_⟩ + · have hv : (t₇.gpr .edx).setWidth 8 = s.mem (T + BitVec.ofNat 64 k) ^^^ s.mem (U + BitVec.ofNat 64 k) := by + rw [u₇.gpr, u₆.other .edx (by decide), u₆.gpr, u₅.other .edx (by decide), + u₄.other .edx (by decide), u₃.gpr, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem, xor_byte32, rU, rT] + have e' := writeBytes_snoc s.mem T (Spec.Pbkdf2.xorBytes (bytesAt s.mem T k) (bytesAt s.mem U k)) + (s.mem (T + BitVec.ofNat 64 k) ^^^ s.mem (U + BitVec.ofNat 64 k)) (by rw [hl']; omega_nat) + rw [hl'] at e' + rw [f₁₀.mem, u₉.mem, m₈.mem, show Reg8.dl.reg = .edx from rfl, hv, u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem, + u₂.mem, u₁.mem, h.mem, e', bytesAt_snoc', bytesAt_snoc', xorBytes_snoc _ _ _ _ (by simp [bytesAt_length])] + · rw [z₁₀, h9, count_z hk hn'] + +end VG.Proof.Pbkdf2.Stream.X86 + +/-! +## Our caller's registers + +As on the other targets +(`Proof/Pbkdf2/Stream/Arm/Common.lean`): the callee-saved registers we use +(`ebx`, `esi`, `edi`, `ebp`) are stored in `scratch` after the working +space of the functions we call (`Hash.saved`), with `scratch` in `eax`, and +loaded back at the end, with `scratch` copied from `ebp` into `eax` first. +-/ + +namespace VG.Proof.Pbkdf2.Stream.X86 + +open VG.X86 +open VG.Impl.Pbkdf2.Stream.X86 (Hash at_) +open VG.Proof.Sha256.X86 (contains_offset) +open VG.Proof.Sha256.X86.Stream (Upd Mupd wp_mov wp_movm wp_store sub_offset) +open VG.Proof.Hmac.Generic.Common (InRegions.right' add_ofNat_add) + +variable (H : Hash) + +/-- The registers saved, in the order of their slots. -/ +abbrev savedRegs : List Reg := [.ebx, .esi, .edi, .ebp] + +theorem callee_saved : ∀ r ∈ calleeSaved, r ≠ .esp → r ∈ savedRegs := by decide + +/-- Where the registers are saved. -/ +abbrev saveR (scr : BitVec 32) : Region := ⟨scr.setWidth 64 + BitVec.ofNat 64 (8 * H.W), 16⟩ + +/-- The registers of `s₀` saved in the memory `m`. -/ +def SavedRegs (scr : BitVec 32) (s₀ : State) (m : Mem) : Prop := + ∀ p ∈ H.saved, m.readW (scr.setWidth 64 + BitVec.ofNat 64 p.2) 32 = s₀.gpr p.1 + +theorem saved_mem {p : Reg × Nat} (hp : p ∈ H.saved) : 8 * H.W ≤ p.2 ∧ p.2 + 4 ≤ 8 * H.W + 16 := by + simp only [Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp + rcases hp with rfl | rfl | rfl | rfl <;> simp only <;> omega_nat + +theorem saved_pairwise : H.saved.Pairwise (fun p q => p.2 + 4 ≤ q.2 ∨ q.2 + 4 ≤ p.2) := by + simp [Hash.saved] + +/-- Slot `d` of the save area. -/ +theorem slot_sub (scr : BitVec 32) {d : Nat} (h₁ : 8 * H.W ≤ d) (h₂ : d + 4 ≤ 8 * H.W + 16) : + Region.Sub ⟨scr.setWidth 64 + BitVec.ofNat 64 d, 4⟩ (saveR H scr) := by + rw [show d = 8 * H.W + (d - 8 * H.W) by omega_nat, ← add_ofNat_add] + exact sub_offset (by omega_nat) (by omega_nat) + +theorem SavedRegs.frame {scr : BitVec 32} {s₀ : State} {m m' : Mem} (h : SavedRegs H scr s₀ m) + {rs : List Region} (hf : Frame rs m m') (hd : ∀ r ∈ rs, (saveR H scr).Disjoint r) : + SavedRegs H scr s₀ m' := fun p hp => by + obtain ⟨h₁, h₂⟩ := saved_mem H hp + rw [← h p hp] + exact hf.readW (r := ⟨_, 4⟩) (Region.contains_self _ _) + (fun r hr => (hd r hr).sub_left (slot_sub H scr h₁ h₂)) (by decide) + +/-- The registers saved from a state that agrees on them. -/ +theorem SavedRegs.of_eq {scr : BitVec 32} {s₀ s₁ : State} {m : Mem} (h : SavedRegs H scr s₁ m) + (he : ∀ r ∈ savedRegs, s₁.gpr r = s₀.gpr r) : SavedRegs H scr s₀ m := fun p hp => by + rw [h p hp] + refine he _ ?_ + simp only [Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp + rcases hp with rfl | rfl | rfl | rfl <;> simp + +/-- The memory after storing `g r` at `B + d` for each `(r, d)` of `l`. -/ +def saveMem (m : Mem) (B : Addr) (g : Reg → BitVec 32) : List (Reg × Nat) → Mem + | [] => m + | (r, d) :: l => saveMem (m.writeW (B + BitVec.ofNat 64 d) (g r)) B g l + +theorem saveList_ok {rest : List Instr} (l : List (Reg × Nat)) : + ∀ (s : State) (Q : State → Prop), + (∀ p ∈ l, (s.gpr .eax).toNat + p.2 < 2 ^ 32 ∧ + InRegions s.wr ((s.gpr .eax).setWidth 64 + BitVec.ofNat 64 p.2) 4) → + (∀ s', s'.gpr = s.gpr → s'.rd = s.rd → s'.wr = s.wr → + s'.mem = saveMem s.mem ((s.gpr .eax).setWidth 64) s.gpr l → WP isa (.block rest) s' Q) → + WP isa (.block (l.map (fun p => Instr.store (at_ .eax p.2) p.1) ++ rest)) s Q := by + induction l with + | nil => intro s Q _ k; exact k s rfl rfl rfl rfl + | cons p l ih => + intro s Q hl k + obtain ⟨h1, h2⟩ := hl p (by simp) + refine wp_store (a := (s.gpr .eax).setWidth 64 + BitVec.ofNat 64 p.2) + (by rw [ea_at, addr_eq h1]) h2 fun s₁ u₁ => ?_ + refine ih s₁ Q (fun q hq => ?_) fun s' g rd wr m => k s' (g.trans u₁.gpr) (rd.trans u₁.rd) + (wr.trans u₁.wr) ?_ + · rw [u₁.gpr, u₁.wr]; exact hl q (List.mem_cons_of_mem _ hq) + · rw [m, u₁.mem, u₁.gpr]; rfl + +theorem readW_writeW_save (m : Mem) (B : Addr) (v : BitVec 32) {d e : Nat} (hd : d < 2 ^ 32) + (he : e < 2 ^ 32) (h : d + 4 ≤ e ∨ e + 4 ≤ d) : + (m.writeW (B + BitVec.ofNat 64 e) v).readW (B + BitVec.ofNat 64 d) 32 = m.readW (B + BitVec.ofNat 64 d) 32 := + Mem.readW_writeW_sep (Offset.sep B h (by omega_nat) (by omega_nat)) (by decide) + +theorem saveMem_other (m : Mem) (B : Addr) (g : Reg → BitVec 32) {d : Nat} (hd : d < 2 ^ 32) : + ∀ l : List (Reg × Nat), (∀ q ∈ l, q.2 < 2 ^ 32 ∧ (d + 4 ≤ q.2 ∨ q.2 + 4 ≤ d)) → + (saveMem m B g l).readW (B + BitVec.ofNat 64 d) 32 = m.readW (B + BitVec.ofNat 64 d) 32 + | [], _ => rfl + | q :: l, h => by + rw [saveMem, saveMem_other _ B g hd l fun q' hq' => h q' (List.mem_cons_of_mem _ hq'), + readW_writeW_save _ _ _ hd (h q (by simp)).1 (h q (by simp)).2] + +theorem saveMem_read (B : Addr) (g : Reg → BitVec 32) : + ∀ (m : Mem) (l : List (Reg × Nat)), l.Pairwise (fun p q => p.2 + 4 ≤ q.2 ∨ q.2 + 4 ≤ p.2) → + (∀ p ∈ l, p.2 < 2 ^ 32) → ∀ p ∈ l, (saveMem m B g l).readW (B + BitVec.ofNat 64 p.2) 32 = g p.1 + | _, [], _, _, p, hp => by cases hp + | m, q :: l, hpw, hb, p, hp => by + rw [List.pairwise_cons] at hpw + rcases List.mem_cons.mp hp with rfl | hp + · rw [saveMem, saveMem_other _ _ _ (hb p (by simp)) l + (fun q' hq' => ⟨hb q' (List.mem_cons_of_mem _ hq'), hpw.1 q' hq'⟩), Mem.readW_writeW_self32] + · rw [saveMem] + exact saveMem_read B g _ l hpw.2 (fun q' hq' => hb q' (List.mem_cons_of_mem _ hq')) p hp + +theorem saveMem_frameR (B : Addr) (g : Reg → BitVec 32) (o L : Nat) (hL : o + L < 2 ^ 64) : + ∀ (m : Mem) (l : List (Reg × Nat)), (∀ p ∈ l, o ≤ p.2 ∧ p.2 + 4 ≤ o + L) → + Frame [⟨B + BitVec.ofNat 64 o, L⟩] m (saveMem m B g l) + | _, [], _ => Frame.refl _ _ + | m, p :: l, hl => by + obtain ⟨h₁, h₂⟩ := hl p (by simp) + have c : (⟨B + BitVec.ofNat 64 o, L⟩ : Region).Contains (B + BitVec.ofNat 64 p.2) (32 / 8) := by + rw [show p.2 = o + (p.2 - o) by omega_nat, ← add_ofNat_add] + exact contains_offset (by omega_nat) (by omega_nat) + exact ((Frame.refl _ _).writeW (List.mem_singleton_self _) _ c).trans + (saveMem_frameR B g o L hL _ l fun q hq => hl q (List.mem_cons_of_mem _ hq)) + +theorem save_eq : H.save = H.saved.map (fun p => Instr.store (at_ .eax p.2) p.1) := rfl + +/-- Saving the registers, with `scratch` in `eax`. -/ +theorem save_ok {s : State} {scr : BitVec 32} {L : Nat} (hax : s.gpr .eax = scr) (hW : H.W ≤ 64) + (hsc : ⟨scr.setWidth 64, L⟩ ∈ s.wr) (hL : 8 * H.W + 16 ≤ L) (hfit : scr.toNat + L ≤ 2 ^ 32) + {rest : List Instr} {Q : State → Prop} + (k : ∀ s', s'.gpr = s.gpr → s'.rd = s.rd → s'.wr = s.wr → + Frame [saveR H scr] s.mem s'.mem → SavedRegs H scr s s'.mem → WP isa (.block rest) s' Q) : + WP isa (.block (H.save ++ rest)) s Q := by + rw [save_eq] + refine saveList_ok H.saved s Q (fun p hp => ?_) fun s' g rd wr m => k s' g rd wr ?_ ?_ + · obtain ⟨h₁, h₂⟩ := saved_mem H hp + rw [hax] + exact ⟨by omega_nat, ⟨_, hsc, contains_offset (by omega_nat) (by omega_nat)⟩⟩ + · rw [m, hax] + exact saveMem_frameR _ _ _ _ (by omega_nat) _ _ fun p hp => saved_mem H hp + · intro p hp + rw [m, hax] + exact saveMem_read _ _ _ _ (saved_pairwise H) (fun q hq => by have := saved_mem H hq; omega_nat) p hp + +theorem restoreList_ok {rest : List Instr} (l : List (Reg × Nat)) : + ∀ (s : State) (Q : State → Prop), (l.map Prod.fst).Nodup → + (∀ p ∈ l, p.1 ≠ .eax ∧ (s.gpr .eax).toNat + p.2 < 2 ^ 32 ∧ + InRegions (s.rd ++ s.wr) ((s.gpr .eax).setWidth 64 + BitVec.ofNat 64 p.2) 4) → + (∀ s', (∀ p ∈ l, s'.gpr p.1 = s.mem.readW ((s.gpr .eax).setWidth 64 + BitVec.ofNat 64 p.2) 32) → + (∀ r, r ∉ l.map Prod.fst → s'.gpr r = s.gpr r) → s'.mem = s.mem → s'.rd = s.rd → s'.wr = s.wr → + WP isa (.block rest) s' Q) → + WP isa (.block (l.map (fun p => Instr.mov p.1 (.mem (at_ .eax p.2))) ++ rest)) s Q := by + induction l with + | nil => intro s Q _ _ k; exact k s (fun _ h => by cases h) (fun _ _ => rfl) rfl rfl rfl + | cons p l ih => + intro s Q hnd hl k + obtain ⟨h0, h2, h3⟩ := hl p (by simp) + simp only [List.map_cons, List.nodup_cons] at hnd + refine wp_movm (a := (s.gpr .eax).setWidth 64 + BitVec.ofNat 64 p.2) (by rw [ea_at, addr_eq h2]) h3 + fun s₁ u₁ => ?_ + have eb : s₁.gpr .eax = s.gpr .eax := u₁.other _ (Ne.symm h0) + refine ih s₁ Q hnd.2 (fun q hq => ?_) fun s' hl' ho hm hrd hwr => k s' (fun q hq => ?_) + (fun r hr => ?_) (hm.trans u₁.mem) (hrd.trans u₁.rd) (hwr.trans u₁.wr) + · rw [eb, u₁.rd, u₁.wr]; exact hl q (List.mem_cons_of_mem _ hq) + · rcases List.mem_cons.mp hq with rfl | hq + · rw [ho _ hnd.1, u₁.gpr] + · rw [hl' q hq, u₁.mem, eb] + · simp only [List.map_cons, List.mem_cons, not_or] at hr + rw [ho r hr.2, u₁.other r hr.1] + +theorem restore_eq : + H.restore = .mov .eax (.reg .ebp) :: H.saved.map (fun p => Instr.mov p.1 (.mem (at_ .eax p.2))) := rfl + +theorem saved_fst : H.saved.map Prod.fst = savedRegs := rfl + +/-- Loading them back, with `scratch` in `ebp`. -/ +theorem restore_ok {s : State} {scr : BitVec 32} {L : Nat} (hbp : s.gpr .ebp = scr) {s₀ : State} (hs : SavedRegs H scr s₀ s.mem) (hsc : ⟨scr.setWidth 64, L⟩ ∈ s.wr) (hL : 8 * H.W + 16 ≤ L) + (hfit : scr.toNat + L ≤ 2 ^ 32) : + WP isa (.block H.restore) s fun s' => s'.mem = s.mem ∧ s'.rd = s.rd ∧ s'.wr = s.wr ∧ + (∀ r ∈ savedRegs, s'.gpr r = s₀.gpr r) ∧ (∀ r, r ∉ savedRegs → r ≠ .eax → s'.gpr r = s.gpr r) := by + rw [restore_eq] + refine wp_mov fun s₁ u₁ => ?_ + have e₁ : s₁.gpr .eax = scr := by rw [u₁.gpr, hbp] + rw [← List.append_nil (List.map _ _)] + refine restoreList_ok H.saved s₁ _ (by rw [saved_fst]; decide) (fun p hp => ?_) + fun s₂ hl ho hm hrd hwr => WP.block_nil ⟨by rw [hm, u₁.mem], by rw [hrd, u₁.rd], by rw [hwr, u₁.wr], + fun r hr => ?_, fun r hr hr' => ?_⟩ + · have := saved_mem H hp + refine ⟨?_, by rw [e₁]; omega_nat, ?_⟩ + · simp only [Hash.saved, List.mem_cons, List.not_mem_nil, or_false] at hp + rcases hp with rfl | rfl | rfl | rfl <;> (dsimp only; decide) + · rw [e₁, u₁.rd, u₁.wr]; exact InRegions.right' ⟨_, hsc, contains_offset (by omega_nat) (by omega_nat)⟩ + · have hv : ∀ p ∈ H.saved, s₂.gpr p.1 = s₀.gpr p.1 := fun p hp => by + rw [hl p hp, e₁, u₁.mem, hs p hp] + simp only [savedRegs, List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl | rfl + · exact hv (.ebx, 8 * H.W) (by simp [Hash.saved]) + · exact hv (.esi, 8 * H.W + 4) (by simp [Hash.saved]) + · exact hv (.edi, 8 * H.W + 8) (by simp [Hash.saved]) + · exact hv (.ebp, 8 * H.W + 12) (by simp [Hash.saved]) + · rw [ho r (by rw [saved_fst]; exact hr), u₁.other r hr'] + +/-! ## Odds and ends -/ + +theorem toNat_setWidth (a : BitVec 32) : (a.setWidth 64).toNat = a.toNat := by + simp only [BitVec.toNat_setWidth] + exact Nat.mod_eq_of_lt (by have := a.isLt; omega_nat) + +/-- `x + o`, as a register holds it, where nothing wraps around. -/ +theorem setWidth_add {x : BitVec 32} {o : Nat} (h : x.toNat + o < 2 ^ 32) : + (x + BitVec.ofNat 32 o).setWidth 64 = x.setWidth 64 + BitVec.ofNat 64 o := by + have := addr_eq (x := x) (k := o) h + simpa only [addr] using this + +theorem toNat_add_ofNat {x : BitVec 32} {o : Nat} (h : x.toNat + o < 2 ^ 32) : + (x + BitVec.ofNat 32 o).toNat = x.toNat + o := by + rw [BitVec.toNat_add, BitVec.toNat_ofNat, Nat.mod_eq_of_lt (a := o) (by omega_nat), Nat.mod_eq_of_lt h] + +/-! ## The stack + +The 48 bytes below `esp` lie below the return address and the arguments; +what does not write those leaves them, and our arguments, as on entry. -/ + +theorem stk_ret {E : BitVec 32} (hE : 48 ≤ E.toNat) (_hf : E.toNat + 4 ≤ 2 ^ 32) : + (below E 48).Disjoint ⟨E.setWidth 64, 4⟩ := by + unfold below + rw [Taint.sub_setWidth hE] + exact Offset.below_disjoint _ (by omega_nat) + +theorem stk_args {E : BitVec 32} {n : Nat} (hE : 48 ≤ E.toNat) (hf : E.toNat + 4 + n ≤ 2 ^ 32) : + (below E 48).Disjoint ⟨addr E 4, n⟩ := by + rcases Nat.eq_zero_or_pos n with rfl | hn + · intro a _ h₂; simp only [Region.Contains] at h₂; omega_nat + unfold below + rw [Taint.sub_setWidth hE, addr_eq (by omega_nat)] + exact Offset.disjoint_below_above _ (by omega_nat) + +/-- Argument `i` is at `4 i` bytes into the arguments. -/ +theorem argAddr_eq (s : State) (i : Nat) : + argAddr s i = (s.gpr .esp + BitVec.ofNat 32 (4 + 4 * i)).setWidth 64 := rfl + +/-- Where argument `i` is read, while `esp` is as on entry. -/ +theorem argW {s₀ s : State} (hs : s.gpr .esp = s₀.gpr .esp) (i : Nat) : + s.ea (at_ .esp (4 + 4 * i)) = argAddr s₀ i := by + rw [ea_at, hs]; rfl + +theorem arg_sub {E : BitVec 32} {s : State} (hs : s.gpr .esp = E) {n i : Nat} (hi : 4 * i + 4 ≤ n) + (hf : E.toNat + 4 + n ≤ 2 ^ 32) : Region.Sub ⟨argAddr s i, 4⟩ ⟨addr E 4, n⟩ := by + rw [argAddr_eq, hs, addr_eq (by omega_nat), show (E + BitVec.ofNat 32 (4 + 4 * i)).setWidth 64 = + addr E (4 + 4 * i) from rfl, addr_eq (by omega_nat)] + exact Offset.sub _ (by omega_nat) (by omega_nat) + +theorem arg_contains {E : BitVec 32} {s : State} (hs : s.gpr .esp = E) {n i : Nat} (hi : 4 * i + 4 ≤ n) + (hf : E.toNat + 4 + n ≤ 2 ^ 32) : (⟨addr E 4, n⟩ : Region).Contains (argAddr s i) 4 := by + rw [argAddr_eq, hs, addr_eq (by omega_nat), show (E + BitVec.ofNat 32 (4 + 4 * i)).setWidth 64 = + addr E (4 + 4 * i) from rfl, addr_eq (by omega_nat)] + exact Offset.contains _ (by omega_nat) (by omega_nat) (by omega_nat) + +/-- The arguments are kept by what writes elsewhere. -/ +theorem arg_keep {E : BitVec 32} {s₀ s : State} (h₀ : s₀.gpr .esp = E) (hs : s.gpr .esp = E) {n : Nat} + (hf : E.toNat + 4 + n ≤ 2 ^ 32) {rs : List Region} (hm : Frame rs s₀.mem s.mem) + (hd : ∀ r ∈ rs, Region.Disjoint ⟨addr E 4, n⟩ r) {i : Nat} (hi : 4 * i + 4 ≤ n) : arg s i = arg s₀ i := by + simp only [arg] + rw [show argAddr s i = argAddr s₀ i by rw [argAddr_eq, argAddr_eq, hs, h₀]] + exact hm.readW (r := ⟨argAddr s₀ i, 4⟩) (Region.contains_self _ _) + (fun r hr => (hd r hr).sub_left (arg_sub h₀ hi hf)) (by decide) + +/-- A streaming state is kept by what writes elsewhere. -/ +theorem repr_keep {H : Hash} (hH : HashOK H) {rs : List Region} {m m' : Mem} (hf : Frame rs m m') {p : Addr} + (hd : ∀ r ∈ rs, Region.Disjoint ⟨p, H.S⟩ r) {msg : List Byte} (hr : hH.SH.Repr m p msg) : + hH.SH.Repr m' p msg := + hH.repr _ _ _ _ _ (fun i hi => hf.bytes (R := ⟨p, H.S⟩) hd (by show H.S ≤ 2 ^ 64; have := hH.hSB; omega_nat) hi) hr + +end VG.Proof.Pbkdf2.Stream.X86 diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Contract.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Contract.lean similarity index 99% rename from lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Contract.lean rename to lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Contract.lean index 69887606a..186a0f3a0 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Contract.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Contract.lean @@ -5,7 +5,7 @@ import VerifiedGarbage.TCB.X86.Target # HMAC and PBKDF2-HMAC over any streaming hash function: the x86 contracts The contracts the proofs are written against, as on the other targets -(`Proof/Hmac/Generic/Arm/Hash.lean`). Every argument is on the stack (cdecl). +(`Proof/Pbkdf2/Stream/Arm/Hash.lean`). Every argument is on the stack (cdecl). * `initK`, `updK` and `finK` are the x86 contracts of a hash function's streaming `init`, `update` and `finalize` (`Proof.Sha512.initX86` and the @@ -24,7 +24,7 @@ The contracts the proofs are written against, as on the other targets them. -/ -namespace VG.Proof.Hmac.Generic.X86 +namespace VG.Proof.Pbkdf2.Stream.X86 open VG.X86 open Spec.Hmac (StreamingHash xorPad ipad opad blockKey hmacBlockKey) @@ -274,4 +274,4 @@ def iterW : Contract isa where post := (iterG S W).post pub := (iterG S W).pub -end VG.Proof.Hmac.Generic.X86 +end VG.Proof.Pbkdf2.Stream.X86 diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Finalize.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Finalize.lean similarity index 95% rename from lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Finalize.lean rename to lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Finalize.lean index 859e146b6..198fc8f95 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Finalize.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Finalize.lean @@ -1,4 +1,4 @@ -import VerifiedGarbage.Proof.Hmac.Generic.X86.Init +import VerifiedGarbage.Proof.Pbkdf2.Stream.X86.Common import VerifiedGarbage.Proof.Hmac.Generic.Common import VerifiedGarbage.Proof.Framework.OmegaLit @@ -7,19 +7,18 @@ import VerifiedGarbage.Proof.Framework.OmegaLit HMAC's `finalize` (`Impl/Pbkdf2/Md/X86.lean`) starts by finalizing the inner state with the hash function's streaming `finalize`, called with the code of -the streaming-level design (`Impl/Hmac/Generic/X86.lean`): the prologue -(`pro_ok`) loads `scratch`, `inner`, `outer` and `out` (after our caller's -registers are saved in `scratch`), and the count just before the call, which -passes it on (`fin1Args_ok`, `finCall_ok`). What the rest keeps is `KR`; +`Impl/Pbkdf2/Stream/X86.lean`: the prologue (`pro_ok`) loads `scratch`, +`inner`, `outer` and `out` (after our caller's registers are saved in +`scratch`), and the count just before the call, which passes it on +(`fin1Args_ok`, `finCall_ok`). What the rest keeps is `KR`; `Proof/Pbkdf2/Md/X86/HmacFin.lean` continues from there. -/ -namespace VG.Proof.Hmac.Generic.X86.Finalize +namespace VG.Proof.Pbkdf2.Stream.X86.Finalize open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash copy at_) -open VG.Proof.Hmac.Generic.X86 -open VG.Proof.Hmac.Generic.X86.Init (argW argIn) +open VG.Impl.Pbkdf2.Stream.X86 (Hash copy at_) +open VG.Proof.Pbkdf2.Stream.X86 open VG.Proof.Hmac.Generic.Common (inRegions_of_sub off_disj off_disj0 sub_of_off sub_of_self bytes_keep bytesAt_take bytesAt_writeBytes_self') open VG.Proof.Sha256.X86 (contains_offset) @@ -317,10 +316,10 @@ theorem finArgs {t : State} (hk : KR (H := H) sc s₀ t) {lo hi : BitVec 32} (ha /-- The first call's arguments: the count from the stack. -/ theorem fin1Args_ok {s : State} (hk : KR (H := H) sc s₀ s) : - WP isa (.block ([] ++ Hash.count1 ++ Impl.Hmac.Generic.X86.scr .edx H.buf)) s fun t => + WP isa (.block ([] ++ Hash.count1 ++ Impl.Pbkdf2.Stream.X86.scr .edx H.buf)) s fun t => KR (H := H) sc s₀ t ∧ FinArgs hH t .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (arg s₀ 2) (arg s₀ 3) ∧ t.gpr .esi = s.gpr .esi ∧ t.mem = s.mem := by - simp only [Hash.count1, Impl.Hmac.Generic.X86.scr, List.cons_append, List.nil_append] + simp only [Hash.count1, Impl.Pbkdf2.Stream.X86.scr, List.cons_append, List.nil_append] refine wp_movm (a := argAddr s₀ 2) (by rw [ea_at, hk.esp]; rfl) (argIn hp hk.rd hk.wr (by decide)) fun s₁ u₁ => ?_ refine wp_movm (a := argAddr s₀ 3) (by rw [ea_at, u₁.other _ (by decide), hk.esp]; rfl) @@ -361,4 +360,4 @@ theorem finCall_ok {t : State} (hk : KR (H := H) sc s₀ t) {lo hi : BitVec 32} end -end VG.Proof.Hmac.Generic.X86.Finalize +end VG.Proof.Pbkdf2.Stream.X86.Finalize diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hash.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Hash.lean similarity index 99% rename from lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hash.lean rename to lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Hash.lean index e851260b2..af73c2de3 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hash.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Hash.lean @@ -1,16 +1,16 @@ -import VerifiedGarbage.Proof.Hmac.Generic.X86.Contract +import VerifiedGarbage.Proof.Pbkdf2.Stream.X86.Contract import VerifiedGarbage.Proof.Framework.OffsetBelow import VerifiedGarbage.Proof.Framework.RelCT import VerifiedGarbage.Proof.Framework.Contract import VerifiedGarbage.Proof.Framework.X86.RelCT import VerifiedGarbage.Proof.Sha256.X86.Stream.Common -import VerifiedGarbage.Impl.Hmac.Generic.X86 +import VerifiedGarbage.Impl.Pbkdf2.Stream.X86 import VerifiedGarbage.Proof.Framework.OmegaLit /-! # HMAC over any streaming hash function on x86 (32-bit): the functions we call -As on the other targets (`Proof/Hmac/Generic/Arm/Hash.lean`): `HashOK H` is +As on the other targets (`Proof/Pbkdf2/Stream/Arm/Hash.lean`): `HashOK H` is what the proofs know of the hash function `H`: its streaming functions are verified against `initK`, `updK` and `finK`, never write `esp` and use at most 20 bytes of stack, the representation of its streaming state is determined by @@ -24,10 +24,10 @@ callee's precondition, `CallPre`). A call writes the 48 bytes below `esp` relate two runs of them (`RelCT.callWith`). -/ -namespace VG.Proof.Hmac.Generic.X86 +namespace VG.Proof.Pbkdf2.Stream.X86 open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash) +open VG.Impl.Pbkdf2.Stream.X86 (Hash) open VG.Proof.Sha256.X86.Stream (Upd WP.cons) open Spec.Hmac (StreamingHash) open Spec.Sha256 (bytesAt) @@ -571,4 +571,4 @@ theorem rel_wp {F F' G G' : State → Prop} {c : Prog isa} RelCT isa (fun s s' => F s ∧ F' s') c fun s s' => G s ∧ G' s' := (hct.wp fun s s' h => ⟨hw s h.1, hw' s' h.2⟩).mono (fun _ _ h => h) fun _ _ h => h.2 -end VG.Proof.Hmac.Generic.X86 +end VG.Proof.Pbkdf2.Stream.X86 diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hashes.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Hashes.lean similarity index 97% rename from lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hashes.lean rename to lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Hashes.lean index 8afe36e00..b45dc7870 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hashes.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Hashes.lean @@ -1,4 +1,4 @@ -import VerifiedGarbage.Proof.Hmac.Generic.X86.Hash +import VerifiedGarbage.Proof.Pbkdf2.Stream.X86.Hash import VerifiedGarbage.Proof.Hmac.Generic.Common import VerifiedGarbage.Proof.Sha512.X86.Stream.Init import VerifiedGarbage.Proof.Sha512.X86.Stream.Update @@ -12,7 +12,7 @@ import VerifiedGarbage.Proof.Md5.X86.Stream.Md # HMAC over any streaming hash function on x86 (32-bit): the hash functions `HashOK` for SHA-1, MD5 and the SHA-512 family, from their own proofs, as on -the other targets (`Proof/Hmac/Generic/Arm/Hashes.lean`). Their contracts are +the other targets (`Proof/Pbkdf2/Stream/Arm/Hashes.lean`). Their contracts are `initK`, `updK` and `finK` at their sizes, but for the SHA-512 family's `update` and `finalize`, which hold from any initial hash value, and whose `finalize` only reads its arguments (`finKr`). Another hash function with @@ -21,10 +21,10 @@ registration file for each of its functions. SHA-256's, for each of its backends, are in `Sha256.lean`. -/ -namespace VG.Proof.Hmac.Generic.X86 +namespace VG.Proof.Pbkdf2.Stream.X86 open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash) +open VG.Impl.Pbkdf2.Stream.X86 (Hash) open VG.Proof.Hmac.Generic.Common (sha1_repr md5_repr sha512_repr finalHash_length) /-- No instruction of `c` writes `esp`, from a check that runs in the kernel. -/ @@ -219,4 +219,4 @@ def sha512_256OK : HashOK sha512_256H := sha512FamOK Spec.Hmac.sha512_256S 32 "v Spec.Sha512.H0_512_256 rfl rfl rfl rfl (fun _ => rfl) (by decide) (by decide) (nosp_of (by lit_decide)) (by lit_decide) -end VG.Proof.Hmac.Generic.X86 +end VG.Proof.Pbkdf2.Stream.X86 diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Sha256.lean similarity index 57% rename from lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Sha256.lean rename to lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Sha256.lean index 12e20eb4a..338783398 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Sha256.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Sha256.lean @@ -1,23 +1,20 @@ -import VerifiedGarbage.Proof.Hmac.Generic.X86.Instances +import VerifiedGarbage.Proof.Pbkdf2.Stream.X86.Hashes import VerifiedGarbage.Proof.Sha256.X86.Shared import VerifiedGarbage.Proof.Sha256.X86.Variants.Code /-! -# HMAC-SHA-256 on x86 (32-bit): `init`, for every backend +# SHA-256's streaming functions on x86 (32-bit), for every backend SHA-256 has an implementation of its compression function for each variant of its interface on x86 (`Variants/Sha256/X86/`), and its streaming `update` and `finalize` made with each (`Sha256Stream`, verified for any initial hash -value): `sha256OK` is `HashOK` for any of them, with `vg_sha256_init`. The -generic proof of `init` (`InitCT.lean`) at it is moved to the shared contract -of `Spec.Hmac.sha256I`. Its taint checks depend only on the sizes, so they are -evaluated once, for every backend (`sha256Core`). +value): `sha256OK` is `HashOK` for any of them, with `vg_sha256_init`. -/ -namespace VG.Proof.Hmac.Generic.X86 +namespace VG.Proof.Pbkdf2.Stream.X86 open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash) +open VG.Impl.Pbkdf2.Stream.X86 (Hash) open VG.Proof.Sha256.X86.Variants (hmacHash) /-- SHA-256's streaming `update` and `finalize` made with one implementation @@ -58,7 +55,7 @@ def sha256OK (v : Sha256Stream) : HashOK (sha256H v) where hBB := show 64 ≤ 128 by decide hWb := show 160 ≤ 8 * 20 by decide hW := show 20 ≤ 64 by decide - repr := Common.sha256_repr + repr := Hmac.Generic.Common.sha256_repr init := Proof.Sha256.X86.Stream.init_verified upd := v.updOK.of_implies { pre := fun _ h => h @@ -80,36 +77,4 @@ def sha256OK (v : Sha256Stream) : HashOK (sha256H v) where updSU := v.updSU finSU := v.finSU -/-- SHA-256's sizes, without the functions: the code HMAC's `init` runs -between its calls depends on nothing else. -/ -def sha256Core : Hash := hmacHash "" (.block []) (.block []) - -end VG.Proof.Hmac.Generic.X86 - -namespace VG.Proof.Hmac.Generic.X86.Instances - -open VG.X86 -open VG.Proof.Hmac.Generic.X86 - -theorem sha256_initChecks : Init.Checks sha256Core where - keys := ⟨_, by taint_decide⟩ - states := ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha256_initImp : (initW Spec.Hmac.sha256S 104).Implies (Spec.Hmac.sha256I.initContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := initSat_args 96 104 - sig_implies [Spec.Hmac.Instance.initContract, Spec.Hmac.initContract, Spec.Hmac.initSig, - Spec.Hmac.sha256I, Spec.Hmac.sha256S, Spec.Hmac.sha256, initW, initG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 96 104 - -/-- HMAC's `init` with any backend's streaming functions. -/ -theorem sha256_init (v : Sha256Stream) : - Verified X86.target (sha256H v).init (Spec.Hmac.sha256I.initContract X86.abi 48) := - (Init.verifiedW (sha256OK v) (Init.Checks.of_eq (H := sha256Core) rfl rfl rfl sha256_initChecks) - (show 8 * 20 + 16 + 2 * 64 ≤ 8 * 104 by decide) sha256_initImp.sat_left).of_implies sha256_initImp - -end VG.Proof.Hmac.Generic.X86.Instances +end VG.Proof.Pbkdf2.Stream.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Block.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Block.lean index cb14c7d1d..a1cff47b9 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Block.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Block.lean @@ -14,8 +14,8 @@ namespace VG.Proof.Pbkdf2.Whole.Arm open VG.Arm open VG.Impl.Pbkdf2.Whole.Arm (Fns) -open VG.Impl.Hmac.Generic.Arm (Hash scrAt copy) -open VG.Proof.Hmac.Generic.Arm (HashOK cclob count) +open VG.Impl.Pbkdf2.Stream.Arm (Hash scrAt copy) +open VG.Proof.Pbkdf2.Stream.Arm (HashOK cclob count) open VG.Proof.MdStream.Arm (Upd Mupd Fupd wp_mov wp_add wp_sub wp_cmp wp_rev wp_str op2_imm op2_reg) open VG.Proof.Hmac.Generic.Common (bytes_keep) open VG.Proof.Hmac.Common (bytesAt_length xorPad_length) diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/CT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/CT.lean index 2fe895f3c..bc74fc924 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/CT.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/CT.lean @@ -19,8 +19,8 @@ namespace VG.Proof.Pbkdf2.Whole.Arm open VG.Arm open VG.Impl.Pbkdf2.Whole.Arm (Fns) -open VG.Impl.Hmac.Generic.Arm (Hash scrAt copy) -open VG.Proof.Hmac.Generic.Arm (HashOK count FinArgs init_rel fin_rel) +open VG.Impl.Pbkdf2.Stream.Arm (Hash scrAt copy) +open VG.Proof.Pbkdf2.Stream.Arm (HashOK count FinArgs init_rel fin_rel) open VG.Proof.MdStream.Arm (eval_eq) open Spec.Sha256 (bytesAt) open Spec.Hmac (xorPad ipad opad) diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Calls.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Calls.lean index 250385475..b13692bd4 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Calls.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Calls.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.Spec.Pbkdf2.Generic -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Hash +import VerifiedGarbage.Proof.Pbkdf2.Stream.Arm.Hash import VerifiedGarbage.Proof.Framework.Sig import VerifiedGarbage.Proof.Framework.Arm.Contract import VerifiedGarbage.Proof.Framework.Arm.CallF @@ -25,7 +25,7 @@ namespace VG.Proof.Pbkdf2.Whole.Arm open VG.Arm open VG.Arm.FrameStack open Spec.Hmac (StreamingHash xorPad ipad opad blockKey hmacBlockKey) -open VG.Proof.Hmac.Generic.Arm (ce0 ce1 ce2 ce3) +open VG.Proof.Pbkdf2.Stream.Arm (ce0 ce1 ce2 ce3) open Spec.Sha256 (bytesAt) /-- What a caller uses of a proof of `Verified Arm.target c k`: that `c` @@ -67,9 +67,9 @@ theorem below_stk {s : State} {n : Nat} (hn : n ≤ 24) : Region.Sub ⟨State.addr s.sp - BitVec.ofNat 64 n, n⟩ (stk s) := fun x hx => Offset.below_mono _ (a := n) (b := 24) hn (by decide) x hx -/-- A call of a streaming function in its frame (`Proof/Hmac/Generic/Arm/Hash.lean`). -/ +/-- A call of a streaming function in its frame (`Proof/Pbkdf2/Stream/Arm/Hash.lean`). -/ theorem After.of_hmac {s s' : State} {ws : List Region} - (h : Hmac.Generic.Arm.After s ws s') : After s ws s' := + (h : Pbkdf2.Stream.Arm.After s ws s') : After s ws s' := ⟨h.rd, h.wr, h.sp, h.cs, Frame.sub h.frame fun r hr => by rcases List.mem_append.mp hr with hr | hr · exact ⟨r, List.mem_append_left _ hr, fun _ h => h⟩ @@ -107,7 +107,7 @@ theorem p2_arg0 (h : 8 ≤ s.sp.toNat) {rd wr : List Region} : simp only [stackArg, stackArgAddr, State.withRegions_mem, State.withRegions_sp, State.callEntry_mem, State.callEntry_sp, p2_sp, Nat.mul_zero] rw [p2_mem, BitVec.add_zero, a84 h, a8 h, - Mem.readW_writeW_sep (Hmac.Generic.Arm.sep_base_off _ (by decide) (by decide)) (by decide), + Mem.readW_writeW_sep (Pbkdf2.Stream.Arm.sep_base_off _ (by decide) (by decide)) (by decide), Mem.readW_writeW_self32] theorem p2_arg1 {rd wr : List Region} : @@ -190,7 +190,7 @@ theorem frame2_rel {ra rb t : Reg} (hrs : regList [ra, rb] = true) {n : String} Covers (rd ++ wr) ((pushed [ra, rb] s₂).rd ++ (pushed [ra, rb] s₂).wr) ∧ Covers wr (pushed [ra, rb] s₂).wr) : RelCT isa P (.frame (.push [ra, rb]) (.call n c) (.pop t 8)) fun _ _ => True := by refine RelCT.frame (fun s₁ s₂ hp => (h s₁ s₂ hp).1) (RelCT.call hv hct rd wr fun a b ⟨s₁, s₂, hp, pa, pb⟩ => ?_) - rw [Hmac.Generic.Arm.push_eq hrs pa, Hmac.Generic.Arm.push_eq hrs pb] + rw [Pbkdf2.Stream.Arm.push_eq hrs pa, Pbkdf2.Stream.Arm.push_eq hrs pb] exact (h s₁ s₂ hp).2 /-- The representation of a streaming state depends only on its bytes. -/ diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Common.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Common.lean index 8ddb7c72f..17feddd5b 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Common.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Common.lean @@ -1,6 +1,6 @@ import VerifiedGarbage.Impl.Pbkdf2.Whole.Arm import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Calls -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Init +import VerifiedGarbage.Proof.Pbkdf2.Stream.Arm.Common import VerifiedGarbage.Proof.Hmac.Generic.Common /-! @@ -8,7 +8,7 @@ import VerifiedGarbage.Proof.Hmac.Generic.Common As on x86 (`Proof/Pbkdf2/Whole/X86/Common.lean`): `FnsOK F` is what the proof knows of the functions `pbkdf2` calls (the hash function's streaming -functions, `VG.Proof.Hmac.Generic.Arm.HashOK`, and HMAC's `init` and +functions, `VG.Proof.Pbkdf2.Stream.Arm.HashOK`, and HMAC's `init` and `finalize` and PBKDF2's `iterate`, sound for their shared contracts with 16 bytes of stack). Then the precondition of `pbkdf2` (`Pre`, from the shared contract with 24 bytes of stack), the parts of its `scratch`, and what every @@ -20,8 +20,8 @@ namespace VG.Proof.Pbkdf2.Whole.Arm open VG.Arm open VG.Arm.FrameStack open VG.Impl.Pbkdf2.Whole.Arm (Fns) -open VG.Impl.Hmac.Generic.Arm (Hash scrAt) -open VG.Proof.Hmac.Generic.Arm (HashOK SavedRegs saveR) +open VG.Impl.Pbkdf2.Stream.Arm (Hash scrAt) +open VG.Proof.Pbkdf2.Stream.Arm (HashOK SavedRegs saveR) open VG.Proof.Hmac.Generic.Common (bytes_keep) open VG.Proof.MdStream.Arm (Upd) open Spec.Sha256 (bytesAt) @@ -386,10 +386,10 @@ theorem scr_ok {s₀ s : State} (hk : KR F s₀ s) {d : Reg} {o : Nat} (ho : o < (k : ∀ s', Upd12 s s' d (dO s₀ o) → WP isa (.block rest) s' Q) : WP isa (.block (scrAt d o ++ rest)) s Q := by simp only [scrAt, List.cons_append, List.nil_append] - refine Hmac.Generic.Arm.wp_movw fun s₁ u₁ => VG.Proof.MdStream.Arm.wp_add (VG.Proof.MdStream.Arm.op2_reg _ _) + refine Pbkdf2.Stream.Arm.wp_movw fun s₁ u₁ => VG.Proof.MdStream.Arm.wp_add (VG.Proof.MdStream.Arm.op2_reg _ _) fun s₂ u₂ => k s₂ ⟨?_, fun r h₁ h₂ => by rw [u₂.other r h₁, u₁.other r h₂], by rw [u₂.mem, u₁.mem], by rw [u₂.rd, u₁.rd], by rw [u₂.wr, u₁.wr], by rw [u₂.sp, u₁.sp]⟩ - rw [u₂.gpr, u₁.gpr, u₁.other _ (by decide), hk.r11, Hmac.Generic.Arm.movw_ofNat ho] + rw [u₂.gpr, u₁.gpr, u₁.other _ (by decide), hk.r11, Pbkdf2.Stream.Arm.movw_ofNat ho] /-- `adc d, n, #y`. -/ theorem wp_adc {is : List Instr} {s : State} {Q : State → Prop} {d n : Reg} {o : Op2} {y : BitVec 32} diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean index 84a4039a6..09f5c9587 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean @@ -1,13 +1,12 @@ import VerifiedGarbage.Proof.Framework.Contract import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.CT -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Instances import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # PBKDF2-HMAC on 32-bit ARM, the whole derivation: the instances The generic proof (`CT.lean`) at each hash function of -`Proof/Hmac/Generic/Arm/Hashes.lean`: the functions it calls are verified by +`Proof/Pbkdf2/Stream/Arm/Hashes.lean`: the functions it calls are verified by their own registration files (with 16 bytes of stack, the most their frames use: `armStack`), the taint checks are evaluated by the kernel, and a state satisfies the shared contract (`pbkSat`). @@ -18,7 +17,7 @@ namespace VG.Proof.Pbkdf2.Whole.Arm open VG.Arm open VG.Arm.FrameStack open VG.Impl.Pbkdf2.Whole.Arm (Fns) -open VG.Proof.Hmac.Generic.Arm (sha1H md5H sha384H sha512H' sha512_224H sha512_256H sha1OK md5OK sha384OK +open VG.Proof.Pbkdf2.Stream.Arm (sha1H md5H sha384H sha512H' sha512_224H sha512_256H sha1OK md5OK sha384OK sha512OK sha512_224OK sha512_256OK) /-- The functions `pbkdf2` calls for the hash function `M` of the instance @@ -28,7 +27,7 @@ def fnsOf (I : Spec.Hmac.Instance) (M : Impl.Pbkdf2.Md.Arm.Hash) : Fns where H := M.st W := I.scratch hiN := I.initApi.name - hiC := M.st.init + hiC := M.hmacInit hfN := I.finalizeApi.name hfC := M.hmacFin itN := I.iterateApi.name @@ -65,7 +64,7 @@ def sha1OKF : FnsOK sha1F where Wi := 56 Wf := 56 Wt := 56 - hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha1_init + hi := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha1_init hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha1_finalize it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha1_iterate hiSt := by decide +kernel @@ -104,7 +103,7 @@ def md5OKF : FnsOK md5F where Wi := 48 Wf := 48 Wt := 48 - hi := .of_verified Proof.Hmac.Generic.Arm.Instances.md5_init + hi := .of_verified Proof.Pbkdf2.Md.Arm.Instances.md5_init hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.md5_finalize it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.md5_iterate hiSt := by decide +kernel @@ -143,7 +142,7 @@ def sha384OKF : FnsOK sha384F where Wi := 234 Wf := 234 Wt := 234 - hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha384_init + hi := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha384_init hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha384_finalize it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha384_iterate hiSt := by decide +kernel @@ -182,7 +181,7 @@ def sha512OKF : FnsOK sha512F where Wi := 234 Wf := 234 Wt := 234 - hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha512_init + hi := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha512_init hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha512_finalize it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha512_iterate hiSt := by decide +kernel @@ -221,7 +220,7 @@ def sha512_224OKF : FnsOK sha512_224F where Wi := 234 Wf := 234 Wt := 234 - hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha512_224_init + hi := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha512_224_init hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha512_224_finalize it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha512_224_iterate hiSt := by decide +kernel @@ -260,7 +259,7 @@ def sha512_256OKF : FnsOK sha512_256F where Wi := 234 Wf := 234 Wt := 234 - hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha512_256_init + hi := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha512_256_init hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha512_256_finalize it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha512_256_iterate hiSt := by decide +kernel diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Key.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Key.lean index 2f4fd14b0..426b4fae3 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Key.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Key.lean @@ -5,7 +5,7 @@ import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Upd # PBKDF2-HMAC on 32-bit ARM, the whole derivation: the prologue and the key As on x86 (`Proof/Pbkdf2/Whole/X86/Key.lean`): the prologue saves our caller's -registers in `scratch` (`save_ok`, `VG.Proof.Hmac.Generic.Arm.save_ok` for any +registers in `scratch` (`save_ok`, `VG.Proof.Pbkdf2.Stream.Arm.save_ok` for any amount of working space before the save area that an immediate offset reaches) and keeps the arguments in registers; then the key is the password, or its digest if it is longer than a block (`key_ok`): either gives the same `K₀`. @@ -15,8 +15,8 @@ namespace VG.Proof.Pbkdf2.Whole.Arm open VG.Arm open VG.Impl.Pbkdf2.Whole.Arm (Fns) -open VG.Impl.Hmac.Generic.Arm (Hash scrAt) -open VG.Proof.Hmac.Generic.Arm (HashOK SavedRegs saveR FinArgs init_call fin_frame count saveMem_frameR +open VG.Impl.Pbkdf2.Stream.Arm (Hash scrAt) +open VG.Proof.Pbkdf2.Stream.Arm (HashOK SavedRegs saveR FinArgs init_call fin_frame count saveMem_frameR saveMem_read saved_mem saved_pairwise savedRegs) open VG.Proof.MdStream.Arm (Upd Fupd wp_mov wp_ldrSp op2_imm op2_reg saveList_ok contains_offset eval_eq) open VG.Proof.Hmac.Generic.Common (bytes_keep bytesAt_take) @@ -26,7 +26,7 @@ open Spec.Hmac (blockKey) variable {F : Fns} -/-- Saving the registers, with `scratch` in `r12`: `VG.Proof.Hmac.Generic.Arm.save_ok`, for any +/-- Saving the registers, with `scratch` in `r12`: `VG.Proof.Pbkdf2.Stream.Arm.save_ok`, for any working space before the save area that an immediate offset reaches. -/ theorem save_ok (H : Hash) {s : State} {sc : BitVec 32} {L : Nat} (h12 : s.gpr .r12 = sc) (hW : 8 * H.W + 36 ≤ 4096) (hsc : ⟨State.addr sc, L⟩ ∈ s.wr) (hL : 8 * H.W + 36 ≤ L) @@ -34,7 +34,7 @@ theorem save_ok (H : Hash) {s : State} {sc : BitVec 32} {L : Nat} (h12 : s.gpr . (k : ∀ s', s'.gpr = s.gpr → s'.rd = s.rd → s'.wr = s.wr → s'.sp = s.sp → Frame [saveR H sc] s.mem s'.mem → SavedRegs H sc s s'.mem → WP isa (.block rest) s' Q) : WP isa (.block (H.save ++ rest)) s Q := by - rw [Hmac.Generic.Arm.save_eq] + rw [Pbkdf2.Stream.Arm.save_eq] refine saveList_ok H.saved s Q (fun p hp => ?_) fun s' g rd wr sp m => k s' g rd wr sp ?_ ?_ · obtain ⟨h₁, h₂⟩ := saved_mem H hp rw [h12] @@ -107,7 +107,7 @@ theorem prologue_ok : WP isa (.block F.prologue) s₀ (KK F s₀) := by /-! ## The stack and `scratch`, while `KR` holds -/ omit hp hz in -theorem below_sub {s : State} (hk : KR F s₀ s) : Region.Sub (Hmac.Generic.Arm.below s) (stkR s₀) := by +theorem below_sub {s : State} (hk : KR F s₀ s) : Region.Sub (Pbkdf2.Stream.Arm.below s) (stkR s₀) := by rw [← hk.stkE]; exact below_stk (n := 16) (by decide) omit hz in @@ -117,7 +117,7 @@ theorem b24 {s : State} (hk : KR F s₀ s) {R : Region} (hR : Region.Sub R (scR omit hz in theorem b16 {s : State} (hk : KR F s₀ s) {R : Region} (hR : Region.Sub R (scR s₀ F)) : - (Hmac.Generic.Arm.below s).Disjoint R := + (Pbkdf2.Stream.Arm.below s).Disjoint R := (hp.b_s.sub_left (below_sub hk)).sub_right hR omit hz in @@ -133,11 +133,11 @@ theorem cov_low {s : State} (hk : KR F s₀ s) {k : Nat} (h : k ≤ F.L8) : omit hz in theorem cov_pw {s : State} (hk : KR F s₀ s) : Covers [pwR s₀] (s.rd ++ s.wr) := - Hmac.Generic.Arm.covers_one (List.mem_append_left _ (by rw [hk.rd, hp.rd]; simp)) + Pbkdf2.Stream.Arm.covers_one (List.mem_append_left _ (by rw [hk.rd, hp.rd]; simp)) omit hz in theorem cov_salt {s : State} (hk : KR F s₀ s) : Covers [saltR s₀] (s.rd ++ s.wr) := - Hmac.Generic.Arm.covers_one (List.mem_append_left _ (by rw [hk.rd, hp.rd]; simp)) + Pbkdf2.Stream.Arm.covers_one (List.mem_append_left _ (by rw [hk.rd, hp.rd]; simp)) /-! ## Hashing a password longer than a block -/ @@ -351,9 +351,9 @@ omit hp hz hH in theorem hk7_ok {s : State} (hk : KR F s₀ s) (ho : F.hkO < 2 ^ 16) (hD : F.H.D < 2 ^ 16) : WP isa (.block (scrAt .r2 F.hkO ++ ([.movw .r3 (BitVec.ofNat 16 F.H.D)] : List Instr))) s fun t => KR F s₀ t ∧ t.gpr .r2 = dO s₀ F.hkO ∧ t.gpr .r3 = BitVec.ofNat 32 F.H.D ∧ t.mem = s.mem := - scr_ok hk ho fun s₁ u₁ => Hmac.Generic.Arm.wp_movw fun s₂ u₂ => WP.block_nil + scr_ok hk ho fun s₁ u₁ => Pbkdf2.Stream.Arm.wp_movw fun s₂ u₂ => WP.block_nil ⟨(hk.upd12 (by decide) u₁).upd (by decide) u₂, by rw [u₂.other _ (by decide), u₁.gpr], - by rw [u₂.gpr, Hmac.Generic.Arm.movw_ofNat hD], by rw [u₂.mem, u₁.mem]⟩ + by rw [u₂.gpr, Pbkdf2.Stream.Arm.movw_ofNat hD], by rw [u₂.mem, u₁.mem]⟩ theorem hashKey_ok {s : State} (hk : KK F s₀ s) : WP isa F.hashKey s fun t => KR F s₀ t ∧ t.gpr .r2 = dO s₀ F.hkO ∧ t.gpr .r3 = BitVec.ofNat 32 F.H.D ∧ diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Loop.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Loop.lean index d273e241d..a3c6b1059 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Loop.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Loop.lean @@ -15,8 +15,8 @@ namespace VG.Proof.Pbkdf2.Whole.Arm open VG.Arm open VG.Impl.Pbkdf2.Whole.Arm (Fns) -open VG.Impl.Hmac.Generic.Arm (Hash scrAt copy) -open VG.Proof.Hmac.Generic.Arm (HashOK cclob count count_loop nm addr3 ofNat_succ32 left_val left_z CopyInv +open VG.Impl.Pbkdf2.Stream.Arm (Hash scrAt copy) +open VG.Proof.Pbkdf2.Stream.Arm (HashOK cclob count count_loop nm addr3 ofNat_succ32 left_val left_z CopyInv SavedRegs savedRegs saved8 saved8_fst saved8_sub saved_mem restoreList_ok restore_eq) open VG.Proof.MdStream.Arm (Upd Mupd Fupd wp_mov wp_add wp_sub wp_subs wp_cmp wp_rev wp_ldr wp_str wp_ldrb wp_strb op2_imm op2_reg sub_beq sub_ofNat contains_offset eval_eq) @@ -81,7 +81,7 @@ theorem copyLoop_ok {src dst : Reg} (hs : src ∉ cclob) (hd : dst ∉ cclob) /-! ## Restoring our caller's registers -/ -/-- `VG.Proof.Hmac.Generic.Arm.restore_ok`, for any working space before +/-- `VG.Proof.Pbkdf2.Stream.Arm.restore_ok`, for any working space before the save area that an immediate offset reaches. -/ theorem restore_ok (H : Hash) {s : State} {scr : BitVec 32} {L : Nat} (h11 : s.gpr .r11 = scr) (hW : 8 * H.W + 36 ≤ 4096) {s₀ : State} (hs : SavedRegs H scr s₀ s.mem) (hsc : ⟨State.addr scr, L⟩ ∈ s.wr) @@ -283,11 +283,11 @@ theorem outLen_ok {k : Nat} (hk : k * F.H.D < ol s₀) {s : State} (h : Inv hF s rw [z₃, e₂, toNat_ofNat32 (by omega), toNat_ofNat32 (by omega)] refine WP.ite (decide (ol s₀ - k * F.H.D < F.H.D)) (by show eval .eq s₃ = _; rw [eval_eq, z]) (fun hT => WP.block_nil ?_) - fun hF' => Hmac.Generic.Arm.wp_movw fun s₄ u₄ => WP.block_nil ⟨i₃.upd hp hz (by decide) u₄, ?_, by rw [u₄.mem, m₃']⟩ + fun hF' => Pbkdf2.Stream.Arm.wp_movw fun s₄ u₄ => WP.block_nil ⟨i₃.upd hp hz (by decide) u₄, ?_, by rw [u₄.mem, m₃']⟩ · have : ol s₀ - k * F.H.D < F.H.D := of_decide_eq_true hT exact ⟨i₃, by rw [e₃, Nat.min_eq_left (Nat.le_of_lt this)], m₃'⟩ · have : ¬ ol s₀ - k * F.H.D < F.H.D := of_decide_eq_false hF' - rw [u₄.gpr, Hmac.Generic.Arm.movw_ofNat (by omega), Nat.min_eq_right (by omega)] + rw [u₄.gpr, Pbkdf2.Stream.Arm.movw_ofNat (by omega), Nat.min_eq_right (by omega)] /-- Copying `n` bytes of `T` to `out` after the `k D` written. -/ theorem outLoop_ok {k n : Nat} (hn : 0 < n) (hkn : k * F.H.D + n ≤ ol s₀) (hnD : n ≤ F.H.D) {s : State} @@ -475,7 +475,7 @@ theorem correct : WP isa F.pbkdf2 s₀ fun s' => abiPreserved s₀ s' ∧ have hr := hz.reach; have := end_le hz; have := layout (F := F) refine WP.mono (restore_ok F.L k₅.r11 (by simp only [Fns.L]; omega) k₅.saved (by rw [k₅.wr]; exact sc_mem hp) (show 8 * F.W + 36 ≤ F.L8 by omega) hp.nsc) - fun s' ⟨hm, _, _, hsp, hg⟩ => ⟨⟨fun r hr => hg r (Hmac.Generic.Arm.preserved_saved r hr), by rw [hsp, k₅.sp]⟩, ?_⟩ + fun s' ⟨hm, _, _, hsp, hg⟩ => ⟨⟨fun r hr => hg r (Pbkdf2.Stream.Arm.preserved_saved r hr), by rw [hsp, k₅.sp]⟩, ?_⟩ have ob := h₅.outB have e : dn F s₀ (nbk F s₀) = ol s₀ := Whole.done_nb hD.1 rw [e] at ob diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Setup.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Setup.lean index 0f41c2a77..34d0d5972 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Setup.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Setup.lean @@ -13,8 +13,8 @@ namespace VG.Proof.Pbkdf2.Whole.Arm open VG.Arm open VG.Impl.Pbkdf2.Whole.Arm (Fns) -open VG.Impl.Hmac.Generic.Arm (Hash scrAt copy) -open VG.Proof.Hmac.Generic.Arm (HashOK Copied copy_ok cclob count) +open VG.Impl.Pbkdf2.Stream.Arm (Hash scrAt copy) +open VG.Proof.Pbkdf2.Stream.Arm (HashOK Copied copy_ok cclob count) open VG.Proof.MdStream.Arm (Upd wp_mov op2_imm op2_reg) open VG.Proof.Hmac.Common (bytesAt_length writeBytes_at bytesAt_getD' xorPad_length) open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame) @@ -224,7 +224,7 @@ theorem su4_ok {s : State} (hk : KR F s₀ s) : refine scr_ok hk (by omega) fun s₁ u₁ => ?_ have k₁ := hk.upd12 (by decide) u₁ refine wp_mov (op2_reg _ _) fun s₂ u₂ => wp_mov (op2_reg _ _) fun s₃ u₃ => wp_mov (op2_reg _ _) fun s₄ u₄ => - Hmac.Generic.Arm.wp_movw fun s₅ u₅ => wp_mov (op2_imm (by decide)) fun s₆ u₆ => WP.block_nil ?_ + Pbkdf2.Stream.Arm.wp_movw fun s₅ u₅ => wp_mov (op2_imm (by decide)) fun s₆ u₆ => WP.block_nil ?_ have k₆ := ((((k₁.upd (by decide) u₂).upd (by decide) u₃).upd (by decide) u₄).upd (by decide) u₅).upd (by decide) u₆ refine ⟨k₆, ?_, ?_, ?_, ?_, ?_, by rw [u₆.mem, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem]⟩ @@ -237,7 +237,7 @@ theorem su4_ok {s : State} (hk : KR F s₀ s) : · rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide) (by decide), hk.r11] · simp only [count] - rw [u₆.gpr, u₆.other .r2 (by decide), u₅.gpr, Hmac.Generic.Arm.movw_ofNat (by omega), zero_append, + rw [u₆.gpr, u₆.other .r2 (by decide), u₅.gpr, Pbkdf2.Stream.Arm.movw_ofNat (by omega), zero_append, BitVec.toNat_ofNat, Nat.mod_eq_of_lt (by omega)] omit hF in diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha224.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha224.lean index 1752fd4d7..10a8dabba 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha224.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha224.lean @@ -5,7 +5,7 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Sha224 # PBKDF2-HMAC-SHA-224 on 32-bit ARM, the whole derivation The generic proof (`CT.lean`) at SHA-224 -(`Proof/Hmac/Generic/Arm/Sha224.lean`), as for the other hash functions +(`Proof/Pbkdf2/Stream/Arm/Sha224.lean`), as for the other hash functions (`Instances.lean`). -/ @@ -13,7 +13,7 @@ namespace VG.Proof.Pbkdf2.Whole.Arm open VG.Arm open VG.Impl.Pbkdf2.Whole.Arm (Fns) -open VG.Proof.Hmac.Generic.Arm (sha224H sha224OK) +open VG.Proof.Pbkdf2.Stream.Arm (sha224H sha224OK) def sha224F : Fns := fnsOf Spec.Hmac.sha224I Md.Arm.sha224Md @@ -25,7 +25,7 @@ def sha224OKF : FnsOK sha224F where Wi := 104 Wf := 104 Wt := 104 - hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha224_init + hi := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha224_init hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha224_finalize it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha224_iterate hiSt := by decide +kernel diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha256.lean index 1725234e7..002445bf9 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha256.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha256.lean @@ -5,7 +5,7 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Sha256 # PBKDF2-HMAC-SHA-256 on 32-bit ARM, the whole derivation The generic proof (`CT.lean`) at SHA-256 -(`Proof/Hmac/Generic/Arm/Sha256.lean`), as for the other hash functions +(`Proof/Pbkdf2/Stream/Arm/Sha256.lean`), as for the other hash functions (`Instances.lean`). -/ @@ -13,7 +13,7 @@ namespace VG.Proof.Pbkdf2.Whole.Arm open VG.Arm open VG.Impl.Pbkdf2.Whole.Arm (Fns) -open VG.Proof.Hmac.Generic.Arm (sha256OK) +open VG.Proof.Pbkdf2.Stream.Arm (sha256OK) def sha256F : Fns := fnsOf Spec.Hmac.sha256I Md.Arm.sha256Md @@ -25,7 +25,7 @@ def sha256OKF : FnsOK sha256F where Wi := 104 Wf := 104 Wt := 104 - hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha256_init + hi := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha256_init hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha256_finalize it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha256_iterate hiSt := by decide +kernel diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Upd.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Upd.lean index 4b191892c..bede2acaf 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Upd.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Upd.lean @@ -3,7 +3,7 @@ import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Calls /-! # PBKDF2-HMAC on 32-bit ARM, the whole derivation: `update`, in its frame, of any length -`VG.Proof.Hmac.Generic.Arm.UpdArgs` and `upd_frame`, for data of any length +`VG.Proof.Pbkdf2.Stream.Arm.UpdArgs` and `upd_frame`, for data of any length that fits the address space (HMAC's functions only absorb constants of fewer than 2¹⁶ bytes, which `movw` sets; we absorb the password and the salt). -/ @@ -11,8 +11,8 @@ than 2¹⁶ bytes, which `movw` sets; we absorb the password and the salt). namespace VG.Proof.Pbkdf2.Whole.Arm open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash) -open VG.Proof.Hmac.Generic.Arm (HashOK updK below count ce0 ce1 ce2 ce3 addr_sub addr_sub_add sep_off +open VG.Impl.Pbkdf2.Stream.Arm (Hash) +open VG.Proof.Pbkdf2.Stream.Arm (HashOK updK below count ce0 ce1 ce2 ce3 addr_sub addr_sub_add sep_off contains_off frame_app after_frame push_eq) open Spec.Sha256 (bytesAt) @@ -157,7 +157,7 @@ end UpdL theorem upd_frame {s : State} {st d sc : BitVec 32} {len : Nat} (h : UpdL hH s st d sc len) {Q : State → Prop} - (hQ : ∀ s', Hmac.Generic.Arm.After s [⟨State.addr st, H.S⟩, ⟨State.addr sc, hH.Wb⟩] s' → + (hQ : ∀ s', Pbkdf2.Stream.Arm.After s [⟨State.addr st, H.S⟩, ⟨State.addr sc, hH.Wb⟩] s' → (∀ m, hH.SH.Repr s.mem (State.addr st) m → count s = BitVec.ofNat 64 m.length → hH.SH.Repr s'.mem (State.addr st) (m ++ bytesAt s.mem (State.addr d) len)) → Q s') : WP isa (.frame (.push upd4) (.call H.updN H.updC) (.pop .r1 16)) s Q := by diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Block.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Block.lean index 665e73407..f76029bbe 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Block.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Block.lean @@ -14,8 +14,8 @@ namespace VG.Proof.Pbkdf2.Whole.X86 open VG.X86 open VG.Impl.Pbkdf2.Whole.X86 (Fns) -open VG.Impl.Hmac.Generic.X86 (Hash at_ copy) -open VG.Proof.Hmac.Generic.X86 (HashOK UpdArgs upd_frame cclob zero_append_ofNat) +open VG.Impl.Pbkdf2.Stream.X86 (Hash at_ copy) +open VG.Proof.Pbkdf2.Stream.X86 (HashOK UpdArgs upd_frame cclob zero_append_ofNat) open VG.Proof.Sha256.X86.Stream (Upd wp_mov wp_movi wp_movm wp_addi wp_store wp_bswap wp_test) open VG.Proof.Hmac.Generic.Common (bytes_keep) open VG.Proof.Hmac.Common (bytesAt_length xorPad_length) @@ -157,7 +157,7 @@ theorem loopInit_ok {s : State} (hk : KR F s₀ s) (hst : States hF s₀ s.mem) · rw [f₆.gpr, u₅.other _ (by decide), u₄.gpr]; simp [dn, Whole.done] · rw [f₆.mem, u₅.mem, u₄.mem, m₃.mem, Mem.readW_writeW_self32, u₂.gpr, u₁.gpr]; rfl · simp [dn, Whole.done, bytesAt] - · rw [z₆, u₅.gpr, Hmac.Generic.X86.test_z] + · rw [z₆, u₅.gpr, Pbkdf2.Stream.X86.test_z] /-! ## A step: the working state, and `INT (i)` -/ @@ -189,7 +189,7 @@ theorem b2_ok {k : Nat} {s : State} (h : Inv hF s₀ k s) : refine wp_arg hp i₁.kr (by decide) fun s₂ u₂ => wp_addi fun s₃ u₃ => wp_movi fun s₄ u₄ => wp_movi fun s₅ u₅ => ?_ have i₅ := (((i₁.upd hp hz (by decide) u₂).upd hp hz (by decide) u₃).upd hp hz (by decide) u₄).upd hp hz (by decide) u₅ - rw [← List.append_nil (VG.Impl.Hmac.Generic.X86.scr .edx F.intO)] + rw [← List.append_nil (VG.Impl.Pbkdf2.Stream.X86.scr .edx F.intO)] refine scr_ok i₅.kr fun s₆ u₆ => WP.block_nil ⟨i₅.upd hp hz (by decide) u₆, ?_, ?_, ?_, ?_, u₆.gpr, ?_⟩ · rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.gpr] @@ -293,7 +293,7 @@ theorem b4_ok {k : Nat} {s : State} (h : Inv hF s₀ k s) : have i₂ := i₁.upd hp hz (by decide) u₂ refine wp_arg hp i₂.kr (by decide) fun s₃ u₃ => wp_addi fun s₄ u₄ => wp_movi fun s₅ u₅ => ?_ have i₅ := ((i₂.upd hp hz (by decide) u₃).upd hp hz (by decide) u₄).upd hp hz (by decide) u₅ - rw [← List.append_nil (VG.Impl.Hmac.Generic.X86.scr .edi F.uO)] + rw [← List.append_nil (VG.Impl.Pbkdf2.Stream.X86.scr .edi F.uO)] refine scr_ok i₅.kr fun s₆ u₆ => WP.block_nil ⟨i₅.upd hp hz (by decide) u₆, ?_, ?_, ?_, ?_, u₆.gpr, ?_⟩ · rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.gpr] diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/CT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/CT.lean index ab6dc8330..d0735c462 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/CT.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/CT.lean @@ -17,8 +17,8 @@ namespace VG.Proof.Pbkdf2.Whole.X86 open VG.X86 open VG.Impl.Pbkdf2.Whole.X86 (Fns) -open VG.Impl.Hmac.Generic.X86 (Hash at_ copy) -open VG.Proof.Hmac.Generic.X86 (HashOK argTaint ArgsOut agree_argTaint rel_agree rel_wp init_rel upd_rel fin_rel) +open VG.Impl.Pbkdf2.Stream.X86 (Hash at_ copy) +open VG.Proof.Pbkdf2.Stream.X86 (HashOK argTaint ArgsOut agree_argTaint rel_agree rel_wp init_rel upd_rel fin_rel) open VG.Proof.Sha256.X86.Stream (eval_e eval_ne) open Spec.Sha256 (bytesAt) open Spec.Hmac (xorPad ipad opad) @@ -32,15 +32,15 @@ abbrev Ck (rs : List Reg) (c : Prog isa) : Prop := structure Checks (F : Fns) : Prop where pro : Ck [] (.block F.prologue) cmp : Ck [.ebp] (.block F.cmpPw) - hk1 : Ck [.ebp] (.block (VG.Impl.Hmac.Generic.X86.scr .edi F.stWO)) + hk1 : Ck [.ebp] (.block (VG.Impl.Pbkdf2.Stream.X86.scr .edi F.stWO)) hk3 : Ck [.ebp] (.block [.mov .eax (.imm 0), .mov .esi (.imm 0), .mov .ecx (Fns.argM 1), .mov .edx (Fns.argM 0)]) - hk5 : Ck [.ebp] (.block ([.mov .eax (Fns.argM 1), .mov .ecx (.imm 0)] ++ VG.Impl.Hmac.Generic.X86.scr .edx F.hkO)) + hk5 : Ck [.ebp] (.block ([.mov .eax (Fns.argM 1), .mov .ecx (.imm 0)] ++ VG.Impl.Pbkdf2.Stream.X86.scr .edx F.hkO)) hk7 : Ck [.ebp] - (.block (VG.Impl.Hmac.Generic.X86.scr .edx F.hkO ++ [.mov .ecx (.imm (BitVec.ofNat 32 F.H.D))])) + (.block (VG.Impl.Pbkdf2.Stream.X86.scr .edx F.hkO ++ [.mov .ecx (.imm (BitVec.ofNat 32 F.H.D))])) short : Ck [.ebp] (.block [.mov .edx (Fns.argM 0)]) - su1 : Ck [.ebp] (.block (VG.Impl.Hmac.Generic.X86.scr .edi F.st0O ++ VG.Impl.Hmac.Generic.X86.scr .esi F.st1O)) + su1 : Ck [.ebp] (.block (VG.Impl.Pbkdf2.Stream.X86.scr .edi F.st0O ++ VG.Impl.Pbkdf2.Stream.X86.scr .esi F.st1O)) su3 : Ck [.ebp] (copy .ebp F.st0O .ebp F.stSO F.H.S) - su4 : Ck [.ebp] (.block (VG.Impl.Hmac.Generic.X86.scr .edi F.stSO ++ [.mov .eax (.imm 0), + su4 : Ck [.ebp] (.block (VG.Impl.Pbkdf2.Stream.X86.scr .edi F.stSO ++ [.mov .eax (.imm 0), .mov .esi (.imm (BitVec.ofNat 32 F.H.B)), .mov .ecx (Fns.argM 3), .mov .edx (Fns.argM 2)])) init : Ck [.ebp] (.block F.loopInit) b1 : Ck [.ebp, .ebx] (copy .ebp F.stSO .ebp F.stWO F.H.S) diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Calls.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Calls.lean index 18d756d4f..04c29a833 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Calls.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Calls.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.Spec.Pbkdf2.Generic -import VerifiedGarbage.Proof.Hmac.Generic.X86.Hash +import VerifiedGarbage.Proof.Pbkdf2.Stream.X86.Hash import VerifiedGarbage.Proof.Framework.Sig import VerifiedGarbage.Proof.Framework.OmegaLit @@ -60,10 +60,10 @@ structure After (s : State) (ws : List Region) (s' : State) : Prop where theorem After.esp {s s' : State} {ws : List Region} (h : After s ws s') : s'.gpr .esp = s.gpr .esp := h.cs .esp (by simp [calleeSaved]) -/-- A call of a hash function's streaming function (`Proof/Hmac/Generic/X86/Hash.lean`), +/-- A call of a hash function's streaming function (`Proof/Pbkdf2/Stream/X86/Hash.lean`), which writes only the 48 bytes below `esp`. -/ theorem After.of_hmac {s s' : State} {ws : List Region} (h76 : 76 ≤ (s.gpr .esp).toNat) - (h : Hmac.Generic.X86.After s ws s') : After s ws s' := + (h : Pbkdf2.Stream.X86.After s ws s') : After s ws s' := ⟨h.rd, h.wr, h.cs, Frame.below_mono h.frame (by decide) h76⟩ theorem below_eq {E : BitVec 32} {k : Nat} (h : k ≤ E.toNat) : diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Common.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Common.lean index 8859f95f4..e8b6e0970 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Common.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Common.lean @@ -1,13 +1,13 @@ import VerifiedGarbage.Impl.Pbkdf2.Whole.X86 import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.Contract -import VerifiedGarbage.Proof.Hmac.Generic.X86.Init +import VerifiedGarbage.Proof.Pbkdf2.Stream.X86.Common import VerifiedGarbage.Proof.Hmac.Generic.Common /-! # PBKDF2-HMAC on x86 (32-bit), the whole derivation: the functions it calls, and its parts `FnsOK F` is what the proof knows of the functions `pbkdf2` calls: the hash -function's streaming functions (`VG.Proof.Hmac.Generic.X86.HashOK`), and +function's streaming functions (`VG.Proof.Pbkdf2.Stream.X86.HashOK`), and HMAC's `init` and `finalize` and PBKDF2's `iterate`, sound for their shared contracts with 48 bytes of stack (`Sound`), with some working space each, at most the `8 W` bytes they get. Then the precondition of `pbkdf2` (`Pre`), the @@ -18,8 +18,8 @@ namespace VG.Proof.Pbkdf2.Whole.X86 open VG.X86 open VG.Impl.Pbkdf2.Whole.X86 (Fns) -open VG.Impl.Hmac.Generic.X86 (Hash at_) -open VG.Proof.Hmac.Generic.X86 (HashOK SavedRegs saveR) +open VG.Impl.Pbkdf2.Stream.X86 (Hash at_) +open VG.Proof.Pbkdf2.Stream.X86 (HashOK SavedRegs saveR) open VG.Proof.Hmac.Generic.Common (bytes_keep) open Spec.Sha256 (bytesAt) @@ -168,11 +168,11 @@ include hp hz omit hz in theorem dO_addr {o : Nat} (ho : o < F.L8) : (dO s₀ o).setWidth 64 = A s₀ o := by - have := hp.nsc; exact Hmac.Generic.X86.setWidth_add (by omega) + have := hp.nsc; exact Pbkdf2.Stream.X86.setWidth_add (by omega) omit hz in theorem dO_toNat {o : Nat} (ho : o < F.L8) : (dO s₀ o).toNat = (scr s₀).toNat + o := by - have := hp.nsc; exact Hmac.Generic.X86.toNat_add_ofNat (by omega) + have := hp.nsc; exact Pbkdf2.Stream.X86.toNat_add_ofNat (by omega) omit hp hz in theorem part_sub {o n : Nat} (h : o + n ≤ F.L8) : Region.Sub (sR s₀ o n) (scR s₀ F) := @@ -306,7 +306,7 @@ theorem KR.argEq {s : State} (hk : KR F s₀ s) {i : Nat} (hi : i < 8) : arg s i · exact hp.o_a.symm · exact hp.s_a.symm · exact hp.b_a.symm - exact Hmac.Generic.X86.arg_keep rfl hk.esp (n := 32) (by have := hp.spf; omega) hk.frame hd (by omega) + exact Pbkdf2.Stream.X86.arg_keep rfl hk.esp (n := 32) (by have := hp.spf; omega) hk.frame hd (by omega) omit hp in theorem argW {s : State} (hs : s.gpr .esp = E s₀) (i : Nat) : @@ -317,7 +317,7 @@ theorem argIn {s : State} (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) {i : Nat InRegions (s.rd ++ s.wr) (argAddr s₀ i) 4 := by rw [hrd, hwr, hp.rd, hp.wr] exact ⟨argR s₀, by simp, by - rw [argR_eq]; exact Hmac.Generic.X86.arg_contains rfl (by omega) (by have := hp.spf; omega)⟩ + rw [argR_eq]; exact Pbkdf2.Stream.X86.arg_contains rfl (by omega) (by have := hp.spf; omega)⟩ /-- An argument, read from memory while `KR` holds. -/ theorem KR.readArg {s : State} (hk : KR F s₀ s) {i : Nat} (hi : i < 8) : @@ -325,7 +325,7 @@ theorem KR.readArg {s : State} (hk : KR F s₀ s) {i : Nat} (hi : i < 8) : have := hk.argEq hp hi simp only [arg] at this ⊢ rwa [show argAddr s i = argAddr s₀ i by - rw [Hmac.Generic.X86.argAddr_eq, Hmac.Generic.X86.argAddr_eq, hk.esp]] at this + rw [Pbkdf2.Stream.X86.argAddr_eq, Pbkdf2.Stream.X86.argAddr_eq, hk.esp]] at this /-- `mov d, [esp + 4 + 4 i]`: argument `i`, while `KR` holds. -/ theorem wp_arg {s : State} (hk : KR F s₀ s) {d : Reg} {i : Nat} (hi : i < 8) {is : List Instr} @@ -374,8 +374,8 @@ end /-- `d ← scratch + o`, while `KR` holds. -/ theorem scr_ok {s₀ s : State} (hk : KR F s₀ s) {d : Reg} {o : Nat} {rest : List Instr} {Q : State → Prop} (k : ∀ s', VG.Proof.Sha256.X86.Stream.Upd s s' d (dO s₀ o) → WP isa (.block rest) s' Q) : - WP isa (.block (VG.Impl.Hmac.Generic.X86.scr d o ++ rest)) s Q := by - simp only [VG.Impl.Hmac.Generic.X86.scr, List.cons_append, List.nil_append] + WP isa (.block (VG.Impl.Pbkdf2.Stream.X86.scr d o ++ rest)) s Q := by + simp only [VG.Impl.Pbkdf2.Stream.X86.scr, List.cons_append, List.nil_append] refine VG.Proof.Sha256.X86.Stream.wp_mov fun s₁ u₁ => VG.Proof.Sha256.X86.Stream.wp_addi fun s₂ u₂ => k s₂ ⟨?_, fun r hr => by rw [u₂.other r hr, u₁.other r hr], by rw [u₂.mem, u₁.mem], by rw [u₂.rd, u₁.rd], by rw [u₂.wr, u₁.wr]⟩ diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Instances.lean index 52baf63fc..746a50c75 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Instances.lean @@ -1,7 +1,6 @@ import VerifiedGarbage.Proof.Framework.Contract import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.Lit import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.CT -import VerifiedGarbage.Proof.Hmac.Generic.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances /-! @@ -17,7 +16,7 @@ namespace VG.Proof.Pbkdf2.Whole.X86 open VG.X86 open VG.Impl.Pbkdf2.Whole.X86 (Fns) -open VG.Proof.Hmac.Generic.X86 (nosp_of sha1OK md5OK sha384OK sha512OK sha512_224OK sha512_256OK) +open VG.Proof.Pbkdf2.Stream.X86 (nosp_of sha1OK md5OK sha384OK sha512OK sha512_224OK sha512_256OK) /-! ## SHA-1 -/ @@ -46,7 +45,7 @@ def sha1OKF : FnsOK sha1F where Wi := 56 Wf := 56 Wt := 56 - hi := .of_verified Proof.Hmac.Generic.X86.Instances.sha1_init + hi := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha1_init hf := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha1_finalize it := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha1_iterate hiSp := nosp_of (by lit_decide) @@ -99,7 +98,7 @@ def md5OKF : FnsOK md5F where Wi := 48 Wf := 48 Wt := 48 - hi := .of_verified Proof.Hmac.Generic.X86.Instances.md5_init + hi := .of_verified Proof.Pbkdf2.Md.X86.Instances.md5_init hf := .of_verified Proof.Pbkdf2.Md.X86.Instances.md5_finalize it := .of_verified Proof.Pbkdf2.Md.X86.Instances.md5_iterate hiSp := nosp_of (by lit_decide) @@ -152,7 +151,7 @@ def sha384OKF : FnsOK sha384F where Wi := 234 Wf := 234 Wt := 234 - hi := .of_verified Proof.Hmac.Generic.X86.Instances.sha384_init + hi := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha384_init hf := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha384_finalize it := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha384_iterate hiSp := nosp_of (by lit_decide) @@ -205,7 +204,7 @@ def sha512OKF : FnsOK sha512F where Wi := 234 Wf := 234 Wt := 234 - hi := .of_verified Proof.Hmac.Generic.X86.Instances.sha512_init + hi := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha512_init hf := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha512_finalize it := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha512_iterate hiSp := nosp_of (by lit_decide) @@ -258,7 +257,7 @@ def sha512_224OKF : FnsOK sha512_224F where Wi := 234 Wf := 234 Wt := 234 - hi := .of_verified Proof.Hmac.Generic.X86.Instances.sha512_224_init + hi := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha512_224_init hf := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha512_224_finalize it := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha512_224_iterate hiSp := nosp_of (by lit_decide) @@ -311,7 +310,7 @@ def sha512_256OKF : FnsOK sha512_256F where Wi := 234 Wf := 234 Wt := 234 - hi := .of_verified Proof.Hmac.Generic.X86.Instances.sha512_256_init + hi := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha512_256_init hf := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha512_256_finalize it := .of_verified Proof.Pbkdf2.Md.X86.Instances.sha512_256_iterate hiSp := nosp_of (by lit_decide) diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Key.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Key.lean index e573e7235..c4fd0cda2 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Key.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Key.lean @@ -4,7 +4,7 @@ import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.Common # PBKDF2-HMAC on x86 (32-bit), the whole derivation: the prologue and the key The prologue saves our caller's registers in `scratch` (`save_ok`, which is -`VG.Proof.Hmac.Generic.X86.save_ok` for any amount of working space before the +`VG.Proof.Pbkdf2.Stream.X86.save_ok` for any amount of working space before the save area); then the key is the password, or its digest if it is longer than a block (`key_ok`): either gives the same `K₀` (`KeyAt`). -/ @@ -13,8 +13,8 @@ namespace VG.Proof.Pbkdf2.Whole.X86 open VG.X86 open VG.Impl.Pbkdf2.Whole.X86 (Fns) -open VG.Impl.Hmac.Generic.X86 (Hash at_) -open VG.Proof.Hmac.Generic.X86 (HashOK SavedRegs saveR InitArgs UpdArgs FinArgs init_frame upd_frame fin_frame +open VG.Impl.Pbkdf2.Stream.X86 (Hash at_) +open VG.Proof.Pbkdf2.Stream.X86 (HashOK SavedRegs saveR InitArgs UpdArgs FinArgs init_frame upd_frame fin_frame saveList_ok saveMem_frameR saveMem_read saved_mem saved_pairwise zero_append_ofNat) open VG.Proof.Sha256.X86.Stream (Upd Fupd wp_mov wp_movi wp_movm wp_cmpi wp_test wp_addi wp_bswap wp_store) open VG.Proof.Sha256.X86 (contains_offset) @@ -25,14 +25,14 @@ open Spec.Hmac (blockKey) variable {F : Fns} -/-- Saving the registers, with `scratch` in `eax`: `VG.Proof.Hmac.Generic.X86.save_ok`, for any `H.W`. -/ +/-- Saving the registers, with `scratch` in `eax`: `VG.Proof.Pbkdf2.Stream.X86.save_ok`, for any `H.W`. -/ theorem save_ok (H : Hash) {s : State} {sc : BitVec 32} {L : Nat} (hax : s.gpr .eax = sc) (hsc : ⟨sc.setWidth 64, L⟩ ∈ s.wr) (hL : 8 * H.W + 16 ≤ L) (hfit : sc.toNat + L ≤ 2 ^ 32) {rest : List Instr} {Q : State → Prop} (k : ∀ s', s'.gpr = s.gpr → s'.rd = s.rd → s'.wr = s.wr → Frame [saveR H sc] s.mem s'.mem → SavedRegs H sc s s'.mem → WP isa (.block rest) s' Q) : WP isa (.block (H.save ++ rest)) s Q := by - rw [Hmac.Generic.X86.save_eq] + rw [Pbkdf2.Stream.X86.save_eq] refine saveList_ok H.saved s Q (fun p hp => ?_) fun s' g rd wr m => k s' g rd wr ?_ ?_ · obtain ⟨h₁, h₂⟩ := saved_mem H hp rw [hax] @@ -62,7 +62,7 @@ theorem prologue_ok : WP isa (.block F.prologue) s₀ (KR F s₀) := by by rw [u₃.gpr, g₂, u₁.gpr]; rfl, ?_, ?_⟩ · rw [u₃.mem] exact sv₂.of_eq F.L fun r hr => u₁.other r (by - simp only [Hmac.Generic.X86.savedRegs, List.mem_cons, List.not_mem_nil, or_false] at hr + simp only [Pbkdf2.Stream.X86.savedRegs, List.mem_cons, List.not_mem_nil, or_false] at hr rcases hr with rfl | rfl | rfl | rfl <;> decide) · rw [u₃.mem, ← u₁.mem] exact f₂.sub fun r hr => by @@ -71,8 +71,8 @@ theorem prologue_ok : WP isa (.block F.prologue) s₀ (KR F s₀) := by /-! ## The stack and `scratch`, while `KR` holds -/ omit hz in -theorem stk48_sub {s : State} (hk : KR F s₀ s) : Region.Sub (Hmac.Generic.X86.stk s) (stkR s₀) := by - rw [Hmac.Generic.X86.stk, hk.esp]; exact below_sub (by decide) hp.sp76 +theorem stk48_sub {s : State} (hk : KR F s₀ s) : Region.Sub (Pbkdf2.Stream.X86.stk s) (stkR s₀) := by + rw [Pbkdf2.Stream.X86.stk, hk.esp]; exact below_sub (by decide) hp.sp76 omit hz in /-- A region of `scratch` is apart from the stack below `esp`. -/ @@ -82,7 +82,7 @@ theorem b76 {s : State} (hk : KR F s₀ s) {R : Region} (hR : Region.Sub R (scR omit hz in theorem b48 {s : State} (hk : KR F s₀ s) {R : Region} (hR : Region.Sub R (scR s₀ F)) : - (Hmac.Generic.X86.stk s).Disjoint R := + (Pbkdf2.Stream.X86.stk s).Disjoint R := (hp.b_s.sub_left (stk48_sub hp hk)).sub_right hR omit hz in @@ -112,9 +112,9 @@ include hH omit hp hz hH in /-- `edi ← scratch + stWO`. -/ theorem hk1_ok {s : State} (hk : KR F s₀ s) : - WP isa (.block (VG.Impl.Hmac.Generic.X86.scr .edi F.stWO)) s fun t => + WP isa (.block (VG.Impl.Pbkdf2.Stream.X86.scr .edi F.stWO)) s fun t => KR F s₀ t ∧ t.gpr .edi = dO s₀ F.stWO ∧ t.mem = s.mem := by - rw [← List.append_nil (VG.Impl.Hmac.Generic.X86.scr .edi F.stWO)] + rw [← List.append_nil (VG.Impl.Pbkdf2.Stream.X86.scr .edi F.stWO)] exact scr_ok hk fun s₁ u₁ => WP.block_nil ⟨hk.upd (by decide) u₁, u₁.gpr, u₁.mem⟩ omit hH in @@ -212,13 +212,13 @@ omit hz hH in /-- `finalize`'s arguments: the digest into `scratch`. -/ theorem hk5_ok {s : State} (hk : KR F s₀ s) (hdi : s.gpr .edi = dO s₀ F.stWO) : WP isa (.block (([.mov .eax (Fns.argM 1), .mov .ecx (.imm 0)] : List Instr) ++ - VG.Impl.Hmac.Generic.X86.scr .edx F.hkO)) s + VG.Impl.Pbkdf2.Stream.X86.scr .edx F.hkO)) s fun t => KR F s₀ t ∧ t.gpr .edi = dO s₀ F.stWO ∧ t.gpr .eax = arg s₀ 1 ∧ t.gpr .ecx = 0 ∧ t.gpr .edx = dO s₀ F.hkO ∧ t.mem = s.mem := by simp only [List.cons_append, List.nil_append] refine wp_arg hp hk (by decide) fun s₁ u₁ => wp_movi fun s₂ u₂ => ?_ have k₂ := (hk.upd (by decide) u₁).upd (by decide) u₂ - rw [← List.append_nil (VG.Impl.Hmac.Generic.X86.scr .edx F.hkO)] + rw [← List.append_nil (VG.Impl.Pbkdf2.Stream.X86.scr .edx F.hkO)] refine scr_ok k₂ fun s₃ u₃ => WP.block_nil ⟨k₂.upd (by decide) u₃, ?_, ?_, ?_, u₃.gpr, by rw [u₃.mem, u₂.mem, u₁.mem]⟩ · rw [u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), hdi] @@ -281,7 +281,7 @@ theorem hk6_ok {s : State} (hk : KR F s₀ s) (hdi : s.gpr .edi = dO s₀ F.stWO omit hp hz hH in theorem hk7_ok {s : State} (hk : KR F s₀ s) : - WP isa (.block (VG.Impl.Hmac.Generic.X86.scr .edx F.hkO ++ + WP isa (.block (VG.Impl.Pbkdf2.Stream.X86.scr .edx F.hkO ++ ([.mov .ecx (.imm (BitVec.ofNat 32 F.H.D))] : List Instr))) s fun t => KR F s₀ t ∧ t.gpr .edx = dO s₀ F.hkO ∧ t.gpr .ecx = BitVec.ofNat 32 F.H.D ∧ t.mem = s.mem := scr_ok hk fun s₁ u₁ => wp_movi fun s₂ u₂ => WP.block_nil ⟨(hk.upd (by decide) u₁).upd (by decide) u₂, diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Lit.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Lit.lean index 97db62574..ff7c535ff 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Lit.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Lit.lean @@ -1,4 +1,3 @@ -import VerifiedGarbage.Proof.Hmac.Generic.X86.Lit import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Lit import VerifiedGarbage.Impl.Pbkdf2.Whole.X86 @@ -6,9 +5,8 @@ import VerifiedGarbage.Impl.Pbkdf2.Whole.X86 # PBKDF2-HMAC on x86 (32-bit), the whole derivation: the functions it calls, and its code as literals For each hash function of `Proof/Pbkdf2/Md/X86/Hashes.lean`, the functions -`pbkdf2` calls (`Fns`): its streaming functions, HMAC's `init` -(`Impl/Hmac/Generic/X86.lean`) and `finalize` and PBKDF2's `iterate` -(`Impl/Pbkdf2/Md/X86.lean`) for it, by the names they are registered with; and +`pbkdf2` calls (`Fns`): its streaming functions, HMAC's `init` and +`finalize` and PBKDF2's `iterate` (`Impl/Pbkdf2/Md/X86.lean`) for it, by the names they are registered with; and `pbkdf2` as a literal (`materialize_code`, `Proof/Framework/Lit.lean`), which the registration files' `spSafe` checks evaluate. -/ @@ -24,7 +22,7 @@ def fnsOf (I : Spec.Hmac.Instance) (M : Impl.Pbkdf2.Md.X86.Hash) : Fns where H := M.st W := I.scratch hiN := I.initApi.name - hiC := M.st.init + hiC := M.hmacInit hfN := I.finalizeApi.name hfC := M.hmacFin itN := I.iterateApi.name diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Loop.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Loop.lean index 9e954cbe1..446296bba 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Loop.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Loop.lean @@ -13,8 +13,8 @@ namespace VG.Proof.Pbkdf2.Whole.X86 open VG.X86 open VG.Impl.Pbkdf2.Whole.X86 (Fns) -open VG.Impl.Hmac.Generic.X86 (Hash at_ copy) -open VG.Proof.Hmac.Generic.X86 (HashOK cclob count_loop nm ea_at addr3 ofNat_succ32) +open VG.Impl.Pbkdf2.Stream.X86 (Hash at_ copy) +open VG.Proof.Pbkdf2.Stream.X86 (HashOK cclob count_loop nm ea_at addr3 ofNat_succ32) open VG.Proof.Sha256.X86.Stream (Upd Mupd Fupd wp_mov wp_movi wp_movm wp_add wp_addi wp_sub wp_subi wp_cmp wp_cmpi wp_store wp_bswap wp_movzx8 wp_store8 sub_beq sub_ofNat) open VG.Proof.Hmac.Generic.Common (bytes_keep writeBytes_snoc bytesAt_snoc' not_mem_of_disjoint) @@ -127,7 +127,7 @@ theorem b7_ok {k : Nat} {s : State} (h : Inv hF s₀ k s) : have i₂ := i₁.upd hp hz (by decide) u₂ refine wp_arg hp i₂.kr (by decide) fun s₃ u₃ => wp_subi fun s₄ u₄ _ => ?_ have i₄ := (i₂.upd hp hz (by decide) u₃).upd hp hz (by decide) u₄ - rw [← List.append_nil (VG.Impl.Hmac.Generic.X86.scr .edx F.tO)] + rw [← List.append_nil (VG.Impl.Pbkdf2.Stream.X86.scr .edx F.tO)] refine scr_ok i₄.kr fun s₅ u₅ => WP.block_nil ⟨i₄.upd hp hz (by decide) u₅, ?_, ?_, ?_, u₅.gpr, ?_⟩ · rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.gpr] · rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), u₂.gpr] @@ -248,9 +248,9 @@ theorem outLoop_ok {k n : Nat} (hn : 0 < n) (hkn : k * F.H.D + n ≤ ol s₀) (h have hdn : dn F s₀ k = k * F.H.D := by show min _ _ = _; omega have hno := hp.no have eO : (out s₀ + BitVec.ofNat 32 (k * F.H.D)).setWidth 64 = (out s₀).setWidth 64 + BitVec.ofNat 64 (k * F.H.D) := - Hmac.Generic.X86.setWidth_add (by have : ol s₀ = (arg s₀ 6).toNat := rfl; omega) + Pbkdf2.Stream.X86.setWidth_add (by have : ol s₀ = (arg s₀ 6).toNat := rfl; omega) have tO' : (out s₀ + BitVec.ofNat 32 (k * F.H.D)).toNat = (out s₀).toNat + k * F.H.D := - Hmac.Generic.X86.toNat_add_ofNat (by have : ol s₀ = (arg s₀ 6).toNat := rfl; omega) + Pbkdf2.Stream.X86.toNat_add_ofNat (by have : ol s₀ = (arg s₀ 6).toNat := rfl; omega) have osub : Region.Sub ⟨(out s₀).setWidth 64 + BitVec.ofNat 64 (k * F.H.D), n⟩ (outR s₀) := Offset.sub_base _ hkn unfold Fns.outLoop @@ -415,12 +415,12 @@ theorem correct : WP isa F.pbkdf2 s₀ fun s' => abiPreserved s₀ s' ∧ (pbkG refine WP.seq (WP.mono (loop_ok hp hz i₄ z₄) fun s₅ h₅ => ?_) have k₅ := h₅.kr have hL := L8_le hz; have eL : F.L8 = (F.W + F.H.S) * 8 := rfl - refine WP.mono (Hmac.Generic.X86.restore_ok F.L k₅.ebp k₅.saved (by rw [k₅.wr]; exact sc_mem hp) + refine WP.mono (Pbkdf2.Stream.X86.restore_ok F.L k₅.ebp k₅.saved (by rw [k₅.wr]; exact sc_mem hp) (show 8 * F.W + 16 ≤ F.L8 by have := hz.fits; omega) hp.nsc) fun s' ⟨hm, _, _, hg, ho⟩ => ⟨⟨fun r hr => ?_, by rw [hm]; exact k₅.ret hp⟩, ?_⟩ · by_cases he : r = .esp · subst he; rw [ho _ (by decide) (by decide), k₅.esp] - · exact hg r (Hmac.Generic.X86.callee_saved r hr he) + · exact hg r (Pbkdf2.Stream.X86.callee_saved r hr he) · have ob := h₅.outB have e : dn F s₀ (nbk F s₀) = ol s₀ := Whole.done_nb hD.1 rw [e] at ob diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Setup.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Setup.lean index 4dfc70cf7..e96ff0ff7 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Setup.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Setup.lean @@ -13,8 +13,8 @@ namespace VG.Proof.Pbkdf2.Whole.X86 open VG.X86 open VG.Impl.Pbkdf2.Whole.X86 (Fns) -open VG.Impl.Hmac.Generic.X86 (Hash at_ copy) -open VG.Proof.Hmac.Generic.X86 (HashOK UpdArgs upd_frame CopyInv Copied copy_ok cclob) +open VG.Impl.Pbkdf2.Stream.X86 (Hash at_ copy) +open VG.Proof.Pbkdf2.Stream.X86 (HashOK UpdArgs upd_frame CopyInv Copied copy_ok cclob) open VG.Proof.Sha256.X86.Stream (Upd wp_mov wp_movi wp_movm) open VG.Proof.Hmac.Generic.Common (bytes_keep bytesAt_writeBytes_self') open VG.Proof.Hmac.Common (bytesAt_length writeBytes_at bytesAt_getD' xorPad_length) @@ -106,11 +106,11 @@ theorem keyed_ok {s : State} (hk : KR F s₀ s) : WP isa F.key s (Keyed hF s₀) omit hp hz in theorem su1_ok {s : State} (h : Keyed hF s₀ s) : - WP isa (.block (VG.Impl.Hmac.Generic.X86.scr .edi F.st0O ++ VG.Impl.Hmac.Generic.X86.scr .esi F.st1O)) s + WP isa (.block (VG.Impl.Pbkdf2.Stream.X86.scr .edi F.st0O ++ VG.Impl.Pbkdf2.Stream.X86.scr .esi F.st1O)) s fun t => Keyed hF s₀ t ∧ t.gpr .edi = dO s₀ F.st0O ∧ t.gpr .esi = dO s₀ F.st1O := by refine scr_ok h.kr fun s₁ u₁ => ?_ have k₁ := h.kr.upd (by decide) u₁ - rw [← List.append_nil (VG.Impl.Hmac.Generic.X86.scr .esi F.st1O)] + rw [← List.append_nil (VG.Impl.Pbkdf2.Stream.X86.scr .esi F.st1O)] refine scr_ok k₁ fun s₂ u₂ => WP.block_nil ⟨⟨k₁.upd (by decide) u₂, ?_, ?_, ?_⟩, ?_, u₂.gpr⟩ · rw [u₂.other _ (by decide), u₁.other _ (by decide), h.edx] · rw [u₂.other _ (by decide), u₁.other _ (by decide), h.ecx] @@ -211,7 +211,7 @@ theorem su3_ok {s : State} (hk : KR F s₀ s) (r0 : hF.hH.SH.Repr s.mem (A s₀ omit hz hF in /-- `update`'s arguments: the salt. -/ theorem su4_ok {s : State} (hk : KR F s₀ s) : - WP isa (.block (VG.Impl.Hmac.Generic.X86.scr .edi F.stSO ++ ([.mov .eax (.imm 0), + WP isa (.block (VG.Impl.Pbkdf2.Stream.X86.scr .edi F.stSO ++ ([.mov .eax (.imm 0), .mov .esi (.imm (BitVec.ofNat 32 F.H.B)), .mov .ecx (Fns.argM 3), .mov .edx (Fns.argM 2)] : List Instr))) s fun t => KR F s₀ t ∧ t.gpr .edi = dO s₀ F.stSO ∧ t.gpr .esi = BitVec.ofNat 32 F.H.B ∧ t.gpr .eax = 0 ∧ t.gpr .ecx = arg s₀ 3 ∧ t.gpr .edx = salt s₀ ∧ t.mem = s.mem := by @@ -305,7 +305,7 @@ theorem su5_ok {s : State} (hk : KR F s₀ s) (hdi : s.gpr .edi = dO s₀ F.stSO · exact low_disj hz (by omega) (by omega) |>.symm · exact (b48 hp hk (part_sub (by omega))).symm · have := r (xorPad (K0 hF s₀) ipad) (by rw [ea]; exact rS) (by - rw [xorPad_length, hkl, Hmac.Generic.X86.zero_append_ofNat (by have := hz.B; omega)]) + rw [xorPad_length, hkl, Pbkdf2.Stream.X86.zero_append_ofNat (by have := hz.B; omega)]) rw [ea, hk.saltBytes hp] at this exact this diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Sha256.lean index 12f34de9a..7ae493007 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Sha256.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Sha256.lean @@ -21,7 +21,7 @@ open VG.Proof.Sha256.X86.Variants (Backend) /-- The functions `pbkdf2` calls for SHA-256 with the backend `v`, verified. -/ def sha256OKF (v : Backend) : FnsOK v.F where - hH := Proof.Hmac.Generic.X86.sha256OK v.stream + hH := Proof.Pbkdf2.Stream.X86.sha256OK v.stream Wi := 104 Wf := 104 Wt := 104 diff --git a/lean/VerifiedGarbage/Proof/Scrypt/Arm/Whole/Calls.lean b/lean/VerifiedGarbage/Proof/Scrypt/Arm/Whole/Calls.lean index 3f7101048..4534ff4a8 100644 --- a/lean/VerifiedGarbage/Proof/Scrypt/Arm/Whole/Calls.lean +++ b/lean/VerifiedGarbage/Proof/Scrypt/Arm/Whole/Calls.lean @@ -136,7 +136,7 @@ theorem frame4_rel {n : String} {c : Prog isa} {k : Contract isa} Covers (rd ++ wr) ((pushed fr4 s₂).rd ++ (pushed fr4 s₂).wr) ∧ Covers wr (pushed fr4 s₂).wr) : RelCT isa P (.frame (.push fr4) (.call n c) (.pop .r12 16)) fun _ _ => True := by refine RelCT.frame (fun s₁ s₂ hp => (h s₁ s₂ hp).1) (RelCT.call hv hct rd wr fun a b ⟨s₁, s₂, hp, pa, pb⟩ => ?_) - rw [Hmac.Generic.Arm.push_eq (by decide) pa, Hmac.Generic.Arm.push_eq (by decide) pb] + rw [Pbkdf2.Stream.Arm.push_eq (by decide) pa, Pbkdf2.Stream.Arm.push_eq (by decide) pb] exact (h s₁ s₂ hp).2 /-! ## The stack below the stack pointer -/ diff --git a/lean/VerifiedGarbage/Proof/Scrypt/Arm/Whole/Verified.lean b/lean/VerifiedGarbage/Proof/Scrypt/Arm/Whole/Verified.lean index 38e320800..05d2da8fb 100644 --- a/lean/VerifiedGarbage/Proof/Scrypt/Arm/Whole/Verified.lean +++ b/lean/VerifiedGarbage/Proof/Scrypt/Arm/Whole/Verified.lean @@ -97,8 +97,8 @@ theorem pbkdf2_stack {F : Impl.Pbkdf2.Whole.Arm.Fns} (hi : F.H.initC.noFrames = (h₂ : armStack F.hfC ≤ 16) (h₃ : armStack F.itC ≤ 16) : armStack F.pbkdf2 ≤ 24 := by simp only [Impl.Pbkdf2.Whole.Arm.Fns.pbkdf2, Impl.Pbkdf2.Whole.Arm.Fns.key, Impl.Pbkdf2.Whole.Arm.Fns.hashKey, Impl.Pbkdf2.Whole.Arm.Fns.setup, Impl.Pbkdf2.Whole.Arm.Fns.block, - Impl.Pbkdf2.Whole.Arm.Fns.outLen, Impl.Pbkdf2.Whole.Arm.Fns.outLoop, Impl.Hmac.Generic.Arm.copy, - Impl.Hmac.Generic.Arm.Hash.callInit, armStack, armStack_zero hi, armStack_zero hu, armStack_zero hf, + Impl.Pbkdf2.Whole.Arm.Fns.outLen, Impl.Pbkdf2.Whole.Arm.Fns.outLoop, Impl.Pbkdf2.Stream.Arm.copy, + Impl.Pbkdf2.Stream.Arm.Hash.callInit, armStack, armStack_zero hi, armStack_zero hu, armStack_zero hf, List.length_cons, List.length_nil] omega @@ -106,8 +106,8 @@ theorem pbkdf2_stack {F : Impl.Pbkdf2.Whole.Arm.Fns} (hi : F.H.initC.noFrames = abbrev pbkC : Prog isa := Proof.Pbkdf2.Whole.Arm.sha256F.pbkdf2 theorem pbk_stack : armStack pbkC ≤ 24 := - pbkdf2_stack Proof.Hmac.Generic.Arm.sha256OK.initNF Proof.Hmac.Generic.Arm.sha256OK.updNF - Proof.Hmac.Generic.Arm.sha256OK.finNF Proof.Pbkdf2.Whole.Arm.sha256OKF.hiSt + pbkdf2_stack Proof.Pbkdf2.Stream.Arm.sha256OK.initNF Proof.Pbkdf2.Stream.Arm.sha256OK.updNF + Proof.Pbkdf2.Stream.Arm.sha256OK.finNF Proof.Pbkdf2.Whole.Arm.sha256OKF.hiSt Proof.Pbkdf2.Whole.Arm.sha256OKF.hfSt Proof.Pbkdf2.Whole.Arm.sha256OKF.itSt /-- `vg_scrypt`. -/ diff --git a/lean/VerifiedGarbage/Proof/Scrypt/X86/Whole/Verified.lean b/lean/VerifiedGarbage/Proof/Scrypt/X86/Whole/Verified.lean index be8b085b5..dd4ff278f 100644 --- a/lean/VerifiedGarbage/Proof/Scrypt/X86/Whole/Verified.lean +++ b/lean/VerifiedGarbage/Proof/Scrypt/X86/Whole/Verified.lean @@ -125,8 +125,8 @@ theorem pbk_stack : stackUse (pbkOf v) ≤ 76 := by have hi : stackUse Impl.Sha256.X86.Stream.init ≤ 20 := by lit_decide simp only [pbkOf, Impl.Pbkdf2.Whole.X86.Fns.pbkdf2, Impl.Pbkdf2.Whole.X86.Fns.key, Impl.Pbkdf2.Whole.X86.Fns.hashKey, Impl.Pbkdf2.Whole.X86.Fns.setup, Impl.Pbkdf2.Whole.X86.Fns.block, - Impl.Pbkdf2.Whole.X86.Fns.outLen, Impl.Pbkdf2.Whole.X86.Fns.outLoop, Impl.Hmac.Generic.X86.copy, - Impl.Hmac.Generic.X86.Hash.callInit, Backend.F, Proof.Sha256.X86.Variants.pbkdf2Fns, + Impl.Pbkdf2.Whole.X86.Fns.outLen, Impl.Pbkdf2.Whole.X86.Fns.outLoop, Impl.Pbkdf2.Stream.X86.copy, + Impl.Pbkdf2.Stream.X86.Hash.callInit, Backend.F, Proof.Sha256.X86.Variants.pbkdf2Fns, Proof.Sha256.X86.Variants.fns, Proof.Sha256.X86.Variants.hmacHash, Proof.Pbkdf2.Md.X86.sha256M, stackUse, frameBytes, List.length_cons, List.length_nil] at * omega diff --git a/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Code.lean b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Code.lean index a7324fcc4..549358510 100644 --- a/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Code.lean +++ b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Code.lean @@ -9,9 +9,9 @@ import VerifiedGarbage.Spec.Pbkdf2.Generic SHA-256 has backends on x86 (`Interface.lean`): implementations of its compression function, each with the streaming `update` and `finalize` made -with it. HMAC and PBKDF2 are the code of every other hash function, at -SHA-256 made with a backend: its streaming functions as HMAC's `init` calls -them (`hmacHash`), SHA-256 as a Merkle–Damgård hash function for HMAC's +with it. HMAC and PBKDF2 are the code of every other hash function, at SHA-256 +made with a backend: its streaming functions as the code calls them +(`hmacHash`), SHA-256 as a Merkle–Damgård hash function for HMAC's `init` and `finalize` and PBKDF2's iteration, which call the compression function (`mdHash`, `Impl/Pbkdf2/Md/X86.lean`), and the functions the whole of PBKDF2 calls (`fns`, `Impl/Pbkdf2/Whole/X86.lean`), by the names the generic @@ -25,7 +25,7 @@ open VG.X86 /-- SHA-256's streaming functions, with a backend's `update` and `finalize` (`updC`, `finC`), named with its suffix: a 96-byte state, 20 words of working space and a 32-byte digest. -/ -def hmacHash (suffix : String) (updC finC : Prog isa) : Impl.Hmac.Generic.X86.Hash := +def hmacHash (suffix : String) (updC finC : Prog isa) : Impl.Pbkdf2.Stream.X86.Hash := ⟨64, 96, 32, 32, 20, Spec.Sha256.initApi.name, Impl.Sha256.X86.Stream.init, Spec.Sha256.updateApi.name ++ suffix, updC, Spec.Sha256.finalizeApi.name ++ suffix, finC⟩ @@ -41,7 +41,7 @@ def fns (suffix cmpN : String) (cmpC updC finC : Prog isa) : Impl.Pbkdf2.Whole.X H := hmacHash suffix updC finC W := Spec.Hmac.sha256I.scratch hiN := Spec.Hmac.sha256I.initApi.name ++ suffix - hiC := (hmacHash suffix updC finC).init + hiC := (mdHash suffix cmpN cmpC updC finC).hmacInit hfN := Spec.Hmac.sha256I.finalizeApi.name ++ suffix hfC := (mdHash suffix cmpN cmpC updC finC).hmacFin itN := Spec.Hmac.sha256I.iterateApi.name ++ suffix diff --git a/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Interface.lean b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Interface.lean index db9c71716..7d6bcff37 100644 --- a/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Interface.lean +++ b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Interface.lean @@ -11,13 +11,13 @@ function built on it (in `Generic/Sha256/X86/`) is emitted once for each backend, named with its suffix (see `TCB/Emit.lean`): its own functions, the compression function and the streaming ones made with it (`functions`), and HMAC's `init` and `finalize`, PBKDF2's `iterate` and the whole of PBKDF2, -the implementations for every hash function (`Impl/Hmac/Generic/X86.lean`, -`Impl/Pbkdf2/Md/X86.lean`, `Impl/Pbkdf2/Whole/X86.lean`) at SHA-256 made -with the backend (`Code.lean`). HMAC's `init` calls the backend's streaming -`update` (`stream`); HMAC's `finalize` its streaming `finalize` and its -compression function; PBKDF2's iteration its compression function. They are -proven once for every backend, against the contracts of `Spec.Hmac.sha256I` -(`Proof/Hmac/Generic/X86/Sha256.lean`, `Proof/Pbkdf2/Md/X86/Sha256.lean`, +the implementations for every hash function (`Impl/Pbkdf2/Md/X86.lean`, +`Impl/Pbkdf2/Whole/X86.lean`) at SHA-256 made with the backend +(`Code.lean`). HMAC's `init` calls SHA-256's streaming `init` and the +backend's compression function; HMAC's `finalize` the backend's streaming +`finalize` (`stream`) and its compression function; PBKDF2's iteration its +compression function. They are proven once for every backend, against the +contracts of `Spec.Hmac.sha256I` (`Proof/Pbkdf2/Md/X86/Sha256.lean`, `Proof/Pbkdf2/Whole/X86/Sha256.lean`), from what the backend proves of its compression function and streaming functions. So adding an implementation of the compression function also emits the SHA-256, HMAC and PBKDF2 functions @@ -27,7 +27,7 @@ that call it. What the kernel checks of each backend's code (that it keeps namespace VG.Proof.Sha256.X86.Variants open VG.X86 -open VG.Proof.Hmac.Generic.X86 (Sha256Stream sha256H) +open VG.Proof.Pbkdf2.Stream.X86 (Sha256Stream) open VG.Proof.Pbkdf2.Md.X86 (sha256M) structure StreamFn where @@ -66,14 +66,14 @@ structure Backend where functions : List StreamFn /-- No instruction of the functions built on it writes `esp` (the artifacts' `spSafe`). -/ - initSp : (sha256H stream).init.all (fun i => !isa.writesSp i) = true + initSp : (sha256M stream cmpN cmpC).hmacInit.all (fun i => !isa.writesSp i) = true finSp : (sha256M stream cmpN cmpC).hmacFin.all (fun i => !isa.writesSp i) = true iterSp : (sha256M stream cmpN cmpC).iterate.all (fun i => !isa.writesSp i) = true pbkdf2Sp : (pbkdf2Fns stream cmpN cmpC).pbkdf2.all (fun i => !isa.writesSp i) = true /-- What the whole of PBKDF2 needs of the functions it calls: they keep `esp`, and use at most 48 bytes of stack. -/ - initNoSp : NoSp (sha256H stream).init - initStack : stackUse (sha256H stream).init ≤ 48 + initNoSp : NoSp (sha256M stream cmpN cmpC).hmacInit + initStack : stackUse (sha256M stream cmpN cmpC).hmacInit ≤ 48 finalizeNoSp : NoSp (sha256M stream cmpN cmpC).hmacFin finalizeStack : stackUse (sha256M stream cmpN cmpC).hmacFin ≤ 48 iterNoSp : NoSp (sha256M stream cmpN cmpC).iterate @@ -86,9 +86,6 @@ variable (v : Backend) /-- What the names of the functions emitted for it end with. -/ abbrev suffix : String := v.stream.suffix -/-- SHA-256's streaming functions, as HMAC's `init` calls them. -/ -abbrev H : Impl.Hmac.Generic.X86.Hash := sha256H v.stream - /-- SHA-256 as a Merkle–Damgård hash function, as HMAC's `finalize` and PBKDF2's iteration call it. -/ abbrev M : Impl.Pbkdf2.Md.X86.Hash := sha256M v.stream v.cmpN v.cmpC @@ -100,8 +97,8 @@ abbrev F : Impl.Pbkdf2.Whole.X86.Fns := pbkdf2Fns v.stream v.cmpN v.cmpC call it. -/ theorem comp : Proof.Pbkdf2.Md.X86.CompOk Proof.Sha256.md 112 v.cmpC := ⟨v.cmp, v.cmpSp, v.cmpStack⟩ -theorem hmacInit : Verified X86.target v.H.init (Spec.Hmac.sha256I.initContract X86.abi 48) := - Proof.Hmac.Generic.X86.Instances.sha256_init v.stream +theorem hmacInit : Verified X86.target v.M.hmacInit (Spec.Hmac.sha256I.initContract X86.abi 48) := + Proof.Pbkdf2.Md.X86.Instances.sha256_init v.stream v.cmpN v.comp theorem hmacFin : Verified X86.target v.M.hmacFin (Spec.Hmac.sha256I.finalizeContract X86.abi 48) := Proof.Pbkdf2.Md.X86.Instances.sha256_finalize v.stream v.cmpN v.comp diff --git a/lean/VerifiedGarbage/Variants/Sha256/X86/Scalar.lean b/lean/VerifiedGarbage/Variants/Sha256/X86/Scalar.lean index 460aba75b..45d408187 100644 --- a/lean/VerifiedGarbage/Variants/Sha256/X86/Scalar.lean +++ b/lean/VerifiedGarbage/Variants/Sha256/X86/Scalar.lean @@ -11,7 +11,7 @@ which HMAC's and PBKDF2's functions call (`Generic/Sha256/X86/`). namespace VG.Variants.Sha256.X86.Scalar open VG.X86 -open VG.Proof.Hmac.Generic.X86 (Sha256Stream sha256H) +open VG.Proof.Pbkdf2.Stream.X86 (Sha256Stream) open VG.Proof.Pbkdf2.Md.X86 (sha256M) open VG.Proof.Sha256.X86.Variants (pbkdf2Fns) @@ -27,7 +27,7 @@ def stream : Sha256Stream where updSU := by lit_decide finSU := by lit_decide -materialize_code sha256HInit := (sha256H stream).init +materialize_code sha256HInit := (sha256M stream "vg_sha256_compress" Impl.Sha256.X86.compress).hmacInit materialize_code sha256HFinalize := (sha256M stream "vg_sha256_compress" Impl.Sha256.X86.compress).hmacFin materialize_code sha256HIterate := (sha256M stream "vg_sha256_compress" Impl.Sha256.X86.compress).iterate materialize_code sha256HPbkdf2 := (pbkdf2Fns stream "vg_sha256_compress" Impl.Sha256.X86.compress).pbkdf2 diff --git a/lean/VerifiedGarbage/Variants/Sha256/X86/ShaNi.lean b/lean/VerifiedGarbage/Variants/Sha256/X86/ShaNi.lean index 9fb0249c8..fb421af3a 100644 --- a/lean/VerifiedGarbage/Variants/Sha256/X86/ShaNi.lean +++ b/lean/VerifiedGarbage/Variants/Sha256/X86/ShaNi.lean @@ -14,7 +14,7 @@ open VG VG.X86 open VG.Proof.Sha256.X86.Stream (params dims) open VG.Proof.Sha256 (md) open VG.Proof.MdStream VG.Proof.MdStream.X86 -open VG.Proof.Hmac.Generic.X86 (Sha256Stream sha256H) +open VG.Proof.Pbkdf2.Stream.X86 (Sha256Stream) open VG.Proof.Pbkdf2.Md.X86 (sha256M) open VG.Proof.Sha256.X86.Variants (pbkdf2Fns) @@ -67,7 +67,7 @@ def stream : Sha256Stream where updSU := by lit_decide finSU := by lit_decide -materialize_code sha256HInit := (sha256H stream).init +materialize_code sha256HInit := (sha256M stream cmpN cmpC).hmacInit materialize_code sha256HFinalize := (sha256M stream cmpN cmpC).hmacFin materialize_code sha256HIterate := (sha256M stream cmpN cmpC).iterate materialize_code sha256HPbkdf2 := (pbkdf2Fns stream cmpN cmpC).pbkdf2 diff --git a/src/asm/arm/hmac_md5.rs b/src/asm/arm/hmac_md5.rs index 57e4b4307..b727e9899 100644 --- a/src/asm/arm/hmac_md5.rs +++ b/src/asm/arm/hmac_md5.rs @@ -32,64 +32,105 @@ pub(crate) unsafe extern "C" fn vg_hmac_md5_init(inner: *mut [u8; 80], outer: *m "mov r4, r0", "mov r5, r1", "mov r6, r2", + "mov r7, r3", "mov r11, r12", - "mov r8, #0", - "mov r9, r3", - "cmp r9, #0", + "mov r0, r4", + "bl {vg_md5_init}", + "mov r0, r5", + "bl {vg_md5_init}", + "movw r1, #13878", + "movt r1, #13878", + "str r1, [r4, #16]", + "str r1, [r4, #20]", + "str r1, [r4, #24]", + "str r1, [r4, #28]", + "str r1, [r4, #32]", + "str r1, [r4, #36]", + "str r1, [r4, #40]", + "str r1, [r4, #44]", + "str r1, [r4, #48]", + "str r1, [r4, #52]", + "str r1, [r4, #56]", + "str r1, [r4, #60]", + "str r1, [r4, #64]", + "str r1, [r4, #68]", + "str r1, [r4, #72]", + "str r1, [r4, #76]", + "mov r8, r4", + "cmp r7, #0", "beq 20f", "22:", - "add r2, r6, r8", - "ldrb r12, [r2, #0]", - "eor r1, r12, #54", - "add r2, r11, r8", - "strb r1, [r2, #148]", - "eor r1, r12, #92", - "strb r1, [r2, #212]", + "ldrb r12, [r6, #0]", + "eor r12, r12, #54", + "strb r12, [r8, #16]", + "add r6, r6, #1", "add r8, r8, #1", - "subs r9, r9, #1", + "subs r7, r7, #1", "bne 22b", "b 21f", "20:", "21:", - "movw r9, #64", - "subs r9, r9, r8", - "beq 23f", - "25:", - "add r2, r11, r8", - "mov r1, #54", - "strb r1, [r2, #148]", - "mov r1, #92", - "strb r1, [r2, #212]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "b 24f", - "23:", - "24:", + "movw r1, #27242", + "movt r1, #27242", + "ldr r12, [r4, #16]", + "eor r12, r12, r1", + "str r12, [r5, #16]", + "ldr r12, [r4, #20]", + "eor r12, r12, r1", + "str r12, [r5, #20]", + "ldr r12, [r4, #24]", + "eor r12, r12, r1", + "str r12, [r5, #24]", + "ldr r12, [r4, #28]", + "eor r12, r12, r1", + "str r12, [r5, #28]", + "ldr r12, [r4, #32]", + "eor r12, r12, r1", + "str r12, [r5, #32]", + "ldr r12, [r4, #36]", + "eor r12, r12, r1", + "str r12, [r5, #36]", + "ldr r12, [r4, #40]", + "eor r12, r12, r1", + "str r12, [r5, #40]", + "ldr r12, [r4, #44]", + "eor r12, r12, r1", + "str r12, [r5, #44]", + "ldr r12, [r4, #48]", + "eor r12, r12, r1", + "str r12, [r5, #48]", + "ldr r12, [r4, #52]", + "eor r12, r12, r1", + "str r12, [r5, #52]", + "ldr r12, [r4, #56]", + "eor r12, r12, r1", + "str r12, [r5, #56]", + "ldr r12, [r4, #60]", + "eor r12, r12, r1", + "str r12, [r5, #60]", + "ldr r12, [r4, #64]", + "eor r12, r12, r1", + "str r12, [r5, #64]", + "ldr r12, [r4, #68]", + "eor r12, r12, r1", + "str r12, [r5, #68]", + "ldr r12, [r4, #72]", + "eor r12, r12, r1", + "str r12, [r5, #72]", + "ldr r12, [r4, #76]", + "eor r12, r12, r1", + "str r12, [r5, #76]", "mov r0, r4", - "bl {vg_md5_init}", - "mov r0, r4", - "movw r12, #148", - "add r1, r11, r12", - "movw r7, #64", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_md5_update}", - "ldr r1, [sp], #16", - "mov r0, r5", - "bl {vg_md5_init}", + "add r6, r4, #16", + "mov r3, r11", + "mov r1, r6", + "mov r2, #1", + "bl {vg_md5_compress}", "mov r0, r5", - "movw r12, #212", - "add r1, r11, r12", - "movw r7, #64", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_md5_update}", - "ldr r1, [sp], #16", + "add r6, r5, #16", + "mov r1, r6", + "mov r2, #1", + "bl {vg_md5_compress}", "ldr r4, [r11, #112]", "ldr r5, [r11, #116]", "ldr r6, [r11, #120]", @@ -101,7 +142,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_md5_init(inner: *mut [u8; 80], outer: *m "ldr r11, [r11, #144]", "bx lr", vg_md5_init = sym super::md5::vg_md5_init, - vg_md5_update = sym super::md5::vg_md5_update, + vg_md5_compress = sym super::md5::vg_md5_compress, ) } diff --git a/src/asm/arm/hmac_sha1.rs b/src/asm/arm/hmac_sha1.rs index 46785892f..0de0436fc 100644 --- a/src/asm/arm/hmac_sha1.rs +++ b/src/asm/arm/hmac_sha1.rs @@ -32,64 +32,105 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha1_init(inner: *mut [u8; 84], outer: * "mov r4, r0", "mov r5, r1", "mov r6, r2", + "mov r7, r3", "mov r11, r12", - "mov r8, #0", - "mov r9, r3", - "cmp r9, #0", + "mov r0, r4", + "bl {vg_sha1_init}", + "mov r0, r5", + "bl {vg_sha1_init}", + "movw r1, #13878", + "movt r1, #13878", + "str r1, [r4, #20]", + "str r1, [r4, #24]", + "str r1, [r4, #28]", + "str r1, [r4, #32]", + "str r1, [r4, #36]", + "str r1, [r4, #40]", + "str r1, [r4, #44]", + "str r1, [r4, #48]", + "str r1, [r4, #52]", + "str r1, [r4, #56]", + "str r1, [r4, #60]", + "str r1, [r4, #64]", + "str r1, [r4, #68]", + "str r1, [r4, #72]", + "str r1, [r4, #76]", + "str r1, [r4, #80]", + "mov r8, r4", + "cmp r7, #0", "beq 20f", "22:", - "add r2, r6, r8", - "ldrb r12, [r2, #0]", - "eor r1, r12, #54", - "add r2, r11, r8", - "strb r1, [r2, #196]", - "eor r1, r12, #92", - "strb r1, [r2, #260]", + "ldrb r12, [r6, #0]", + "eor r12, r12, #54", + "strb r12, [r8, #20]", + "add r6, r6, #1", "add r8, r8, #1", - "subs r9, r9, #1", + "subs r7, r7, #1", "bne 22b", "b 21f", "20:", "21:", - "movw r9, #64", - "subs r9, r9, r8", - "beq 23f", - "25:", - "add r2, r11, r8", - "mov r1, #54", - "strb r1, [r2, #196]", - "mov r1, #92", - "strb r1, [r2, #260]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "b 24f", - "23:", - "24:", + "movw r1, #27242", + "movt r1, #27242", + "ldr r12, [r4, #20]", + "eor r12, r12, r1", + "str r12, [r5, #20]", + "ldr r12, [r4, #24]", + "eor r12, r12, r1", + "str r12, [r5, #24]", + "ldr r12, [r4, #28]", + "eor r12, r12, r1", + "str r12, [r5, #28]", + "ldr r12, [r4, #32]", + "eor r12, r12, r1", + "str r12, [r5, #32]", + "ldr r12, [r4, #36]", + "eor r12, r12, r1", + "str r12, [r5, #36]", + "ldr r12, [r4, #40]", + "eor r12, r12, r1", + "str r12, [r5, #40]", + "ldr r12, [r4, #44]", + "eor r12, r12, r1", + "str r12, [r5, #44]", + "ldr r12, [r4, #48]", + "eor r12, r12, r1", + "str r12, [r5, #48]", + "ldr r12, [r4, #52]", + "eor r12, r12, r1", + "str r12, [r5, #52]", + "ldr r12, [r4, #56]", + "eor r12, r12, r1", + "str r12, [r5, #56]", + "ldr r12, [r4, #60]", + "eor r12, r12, r1", + "str r12, [r5, #60]", + "ldr r12, [r4, #64]", + "eor r12, r12, r1", + "str r12, [r5, #64]", + "ldr r12, [r4, #68]", + "eor r12, r12, r1", + "str r12, [r5, #68]", + "ldr r12, [r4, #72]", + "eor r12, r12, r1", + "str r12, [r5, #72]", + "ldr r12, [r4, #76]", + "eor r12, r12, r1", + "str r12, [r5, #76]", + "ldr r12, [r4, #80]", + "eor r12, r12, r1", + "str r12, [r5, #80]", "mov r0, r4", - "bl {vg_sha1_init}", - "mov r0, r4", - "movw r12, #196", - "add r1, r11, r12", - "movw r7, #64", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha1_update}", - "ldr r1, [sp], #16", - "mov r0, r5", - "bl {vg_sha1_init}", + "add r6, r4, #20", + "mov r3, r11", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha1_compress}", "mov r0, r5", - "movw r12, #260", - "add r1, r11, r12", - "movw r7, #64", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha1_update}", - "ldr r1, [sp], #16", + "add r6, r5, #20", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha1_compress}", "ldr r4, [r11, #160]", "ldr r5, [r11, #164]", "ldr r6, [r11, #168]", @@ -101,7 +142,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha1_init(inner: *mut [u8; 84], outer: * "ldr r11, [r11, #192]", "bx lr", vg_sha1_init = sym super::sha1::vg_sha1_init, - vg_sha1_update = sym super::sha1::vg_sha1_update, + vg_sha1_compress = sym super::sha1::vg_sha1_compress, ) } diff --git a/src/asm/arm/hmac_sha224.rs b/src/asm/arm/hmac_sha224.rs index 88ff22e86..dceb2c131 100644 --- a/src/asm/arm/hmac_sha224.rs +++ b/src/asm/arm/hmac_sha224.rs @@ -32,64 +32,105 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha224_init(inner: *mut [u8; 96], outer: "mov r4, r0", "mov r5, r1", "mov r6, r2", + "mov r7, r3", "mov r11, r12", - "mov r8, #0", - "mov r9, r3", - "cmp r9, #0", + "mov r0, r4", + "bl {vg_sha224_init}", + "mov r0, r5", + "bl {vg_sha224_init}", + "movw r1, #13878", + "movt r1, #13878", + "str r1, [r4, #32]", + "str r1, [r4, #36]", + "str r1, [r4, #40]", + "str r1, [r4, #44]", + "str r1, [r4, #48]", + "str r1, [r4, #52]", + "str r1, [r4, #56]", + "str r1, [r4, #60]", + "str r1, [r4, #64]", + "str r1, [r4, #68]", + "str r1, [r4, #72]", + "str r1, [r4, #76]", + "str r1, [r4, #80]", + "str r1, [r4, #84]", + "str r1, [r4, #88]", + "str r1, [r4, #92]", + "mov r8, r4", + "cmp r7, #0", "beq 20f", "22:", - "add r2, r6, r8", - "ldrb r12, [r2, #0]", - "eor r1, r12, #54", - "add r2, r11, r8", - "strb r1, [r2, #196]", - "eor r1, r12, #92", - "strb r1, [r2, #260]", + "ldrb r12, [r6, #0]", + "eor r12, r12, #54", + "strb r12, [r8, #32]", + "add r6, r6, #1", "add r8, r8, #1", - "subs r9, r9, #1", + "subs r7, r7, #1", "bne 22b", "b 21f", "20:", "21:", - "movw r9, #64", - "subs r9, r9, r8", - "beq 23f", - "25:", - "add r2, r11, r8", - "mov r1, #54", - "strb r1, [r2, #196]", - "mov r1, #92", - "strb r1, [r2, #260]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "b 24f", - "23:", - "24:", + "movw r1, #27242", + "movt r1, #27242", + "ldr r12, [r4, #32]", + "eor r12, r12, r1", + "str r12, [r5, #32]", + "ldr r12, [r4, #36]", + "eor r12, r12, r1", + "str r12, [r5, #36]", + "ldr r12, [r4, #40]", + "eor r12, r12, r1", + "str r12, [r5, #40]", + "ldr r12, [r4, #44]", + "eor r12, r12, r1", + "str r12, [r5, #44]", + "ldr r12, [r4, #48]", + "eor r12, r12, r1", + "str r12, [r5, #48]", + "ldr r12, [r4, #52]", + "eor r12, r12, r1", + "str r12, [r5, #52]", + "ldr r12, [r4, #56]", + "eor r12, r12, r1", + "str r12, [r5, #56]", + "ldr r12, [r4, #60]", + "eor r12, r12, r1", + "str r12, [r5, #60]", + "ldr r12, [r4, #64]", + "eor r12, r12, r1", + "str r12, [r5, #64]", + "ldr r12, [r4, #68]", + "eor r12, r12, r1", + "str r12, [r5, #68]", + "ldr r12, [r4, #72]", + "eor r12, r12, r1", + "str r12, [r5, #72]", + "ldr r12, [r4, #76]", + "eor r12, r12, r1", + "str r12, [r5, #76]", + "ldr r12, [r4, #80]", + "eor r12, r12, r1", + "str r12, [r5, #80]", + "ldr r12, [r4, #84]", + "eor r12, r12, r1", + "str r12, [r5, #84]", + "ldr r12, [r4, #88]", + "eor r12, r12, r1", + "str r12, [r5, #88]", + "ldr r12, [r4, #92]", + "eor r12, r12, r1", + "str r12, [r5, #92]", "mov r0, r4", - "bl {vg_sha224_init}", - "mov r0, r4", - "movw r12, #196", - "add r1, r11, r12", - "movw r7, #64", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha256_update}", - "ldr r1, [sp], #16", - "mov r0, r5", - "bl {vg_sha224_init}", + "add r6, r4, #32", + "mov r3, r11", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha256_compress}", "mov r0, r5", - "movw r12, #260", - "add r1, r11, r12", - "movw r7, #64", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha256_update}", - "ldr r1, [sp], #16", + "add r6, r5, #32", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha256_compress}", "ldr r4, [r11, #160]", "ldr r5, [r11, #164]", "ldr r6, [r11, #168]", @@ -101,7 +142,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha224_init(inner: *mut [u8; 96], outer: "ldr r11, [r11, #192]", "bx lr", vg_sha224_init = sym super::sha256::vg_sha224_init, - vg_sha256_update = sym super::sha256::vg_sha256_update, + vg_sha256_compress = sym super::sha256::vg_sha256_compress, ) } diff --git a/src/asm/arm/hmac_sha256.rs b/src/asm/arm/hmac_sha256.rs index ed5431eb0..73ec6d2f0 100644 --- a/src/asm/arm/hmac_sha256.rs +++ b/src/asm/arm/hmac_sha256.rs @@ -32,64 +32,105 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha256_init(inner: *mut [u8; 96], outer: "mov r4, r0", "mov r5, r1", "mov r6, r2", + "mov r7, r3", "mov r11, r12", - "mov r8, #0", - "mov r9, r3", - "cmp r9, #0", + "mov r0, r4", + "bl {vg_sha256_init}", + "mov r0, r5", + "bl {vg_sha256_init}", + "movw r1, #13878", + "movt r1, #13878", + "str r1, [r4, #32]", + "str r1, [r4, #36]", + "str r1, [r4, #40]", + "str r1, [r4, #44]", + "str r1, [r4, #48]", + "str r1, [r4, #52]", + "str r1, [r4, #56]", + "str r1, [r4, #60]", + "str r1, [r4, #64]", + "str r1, [r4, #68]", + "str r1, [r4, #72]", + "str r1, [r4, #76]", + "str r1, [r4, #80]", + "str r1, [r4, #84]", + "str r1, [r4, #88]", + "str r1, [r4, #92]", + "mov r8, r4", + "cmp r7, #0", "beq 20f", "22:", - "add r2, r6, r8", - "ldrb r12, [r2, #0]", - "eor r1, r12, #54", - "add r2, r11, r8", - "strb r1, [r2, #196]", - "eor r1, r12, #92", - "strb r1, [r2, #260]", + "ldrb r12, [r6, #0]", + "eor r12, r12, #54", + "strb r12, [r8, #32]", + "add r6, r6, #1", "add r8, r8, #1", - "subs r9, r9, #1", + "subs r7, r7, #1", "bne 22b", "b 21f", "20:", "21:", - "movw r9, #64", - "subs r9, r9, r8", - "beq 23f", - "25:", - "add r2, r11, r8", - "mov r1, #54", - "strb r1, [r2, #196]", - "mov r1, #92", - "strb r1, [r2, #260]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "b 24f", - "23:", - "24:", + "movw r1, #27242", + "movt r1, #27242", + "ldr r12, [r4, #32]", + "eor r12, r12, r1", + "str r12, [r5, #32]", + "ldr r12, [r4, #36]", + "eor r12, r12, r1", + "str r12, [r5, #36]", + "ldr r12, [r4, #40]", + "eor r12, r12, r1", + "str r12, [r5, #40]", + "ldr r12, [r4, #44]", + "eor r12, r12, r1", + "str r12, [r5, #44]", + "ldr r12, [r4, #48]", + "eor r12, r12, r1", + "str r12, [r5, #48]", + "ldr r12, [r4, #52]", + "eor r12, r12, r1", + "str r12, [r5, #52]", + "ldr r12, [r4, #56]", + "eor r12, r12, r1", + "str r12, [r5, #56]", + "ldr r12, [r4, #60]", + "eor r12, r12, r1", + "str r12, [r5, #60]", + "ldr r12, [r4, #64]", + "eor r12, r12, r1", + "str r12, [r5, #64]", + "ldr r12, [r4, #68]", + "eor r12, r12, r1", + "str r12, [r5, #68]", + "ldr r12, [r4, #72]", + "eor r12, r12, r1", + "str r12, [r5, #72]", + "ldr r12, [r4, #76]", + "eor r12, r12, r1", + "str r12, [r5, #76]", + "ldr r12, [r4, #80]", + "eor r12, r12, r1", + "str r12, [r5, #80]", + "ldr r12, [r4, #84]", + "eor r12, r12, r1", + "str r12, [r5, #84]", + "ldr r12, [r4, #88]", + "eor r12, r12, r1", + "str r12, [r5, #88]", + "ldr r12, [r4, #92]", + "eor r12, r12, r1", + "str r12, [r5, #92]", "mov r0, r4", - "bl {vg_sha256_init}", - "mov r0, r4", - "movw r12, #196", - "add r1, r11, r12", - "movw r7, #64", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha256_update}", - "ldr r1, [sp], #16", - "mov r0, r5", - "bl {vg_sha256_init}", + "add r6, r4, #32", + "mov r3, r11", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha256_compress}", "mov r0, r5", - "movw r12, #260", - "add r1, r11, r12", - "movw r7, #64", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha256_update}", - "ldr r1, [sp], #16", + "add r6, r5, #32", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha256_compress}", "ldr r4, [r11, #160]", "ldr r5, [r11, #164]", "ldr r6, [r11, #168]", @@ -101,7 +142,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha256_init(inner: *mut [u8; 96], outer: "ldr r11, [r11, #192]", "bx lr", vg_sha256_init = sym super::sha256::vg_sha256_init, - vg_sha256_update = sym super::sha256::vg_sha256_update, + vg_sha256_compress = sym super::sha256::vg_sha256_compress, ) } diff --git a/src/asm/arm/hmac_sha384.rs b/src/asm/arm/hmac_sha384.rs index 4e8b802ad..007f848d5 100644 --- a/src/asm/arm/hmac_sha384.rs +++ b/src/asm/arm/hmac_sha384.rs @@ -32,64 +32,169 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha384_init(inner: *mut [u8; 192], outer "mov r4, r0", "mov r5, r1", "mov r6, r2", + "mov r7, r3", "mov r11, r12", - "mov r8, #0", - "mov r9, r3", - "cmp r9, #0", + "mov r0, r4", + "bl {vg_sha384_init}", + "mov r0, r5", + "bl {vg_sha384_init}", + "movw r1, #13878", + "movt r1, #13878", + "str r1, [r4, #64]", + "str r1, [r4, #68]", + "str r1, [r4, #72]", + "str r1, [r4, #76]", + "str r1, [r4, #80]", + "str r1, [r4, #84]", + "str r1, [r4, #88]", + "str r1, [r4, #92]", + "str r1, [r4, #96]", + "str r1, [r4, #100]", + "str r1, [r4, #104]", + "str r1, [r4, #108]", + "str r1, [r4, #112]", + "str r1, [r4, #116]", + "str r1, [r4, #120]", + "str r1, [r4, #124]", + "str r1, [r4, #128]", + "str r1, [r4, #132]", + "str r1, [r4, #136]", + "str r1, [r4, #140]", + "str r1, [r4, #144]", + "str r1, [r4, #148]", + "str r1, [r4, #152]", + "str r1, [r4, #156]", + "str r1, [r4, #160]", + "str r1, [r4, #164]", + "str r1, [r4, #168]", + "str r1, [r4, #172]", + "str r1, [r4, #176]", + "str r1, [r4, #180]", + "str r1, [r4, #184]", + "str r1, [r4, #188]", + "mov r8, r4", + "cmp r7, #0", "beq 20f", "22:", - "add r2, r6, r8", - "ldrb r12, [r2, #0]", - "eor r1, r12, #54", - "add r2, r11, r8", - "strb r1, [r2, #308]", - "eor r1, r12, #92", - "strb r1, [r2, #436]", + "ldrb r12, [r6, #0]", + "eor r12, r12, #54", + "strb r12, [r8, #64]", + "add r6, r6, #1", "add r8, r8, #1", - "subs r9, r9, #1", + "subs r7, r7, #1", "bne 22b", "b 21f", "20:", "21:", - "movw r9, #128", - "subs r9, r9, r8", - "beq 23f", - "25:", - "add r2, r11, r8", - "mov r1, #54", - "strb r1, [r2, #308]", - "mov r1, #92", - "strb r1, [r2, #436]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "b 24f", - "23:", - "24:", + "movw r1, #27242", + "movt r1, #27242", + "ldr r12, [r4, #64]", + "eor r12, r12, r1", + "str r12, [r5, #64]", + "ldr r12, [r4, #68]", + "eor r12, r12, r1", + "str r12, [r5, #68]", + "ldr r12, [r4, #72]", + "eor r12, r12, r1", + "str r12, [r5, #72]", + "ldr r12, [r4, #76]", + "eor r12, r12, r1", + "str r12, [r5, #76]", + "ldr r12, [r4, #80]", + "eor r12, r12, r1", + "str r12, [r5, #80]", + "ldr r12, [r4, #84]", + "eor r12, r12, r1", + "str r12, [r5, #84]", + "ldr r12, [r4, #88]", + "eor r12, r12, r1", + "str r12, [r5, #88]", + "ldr r12, [r4, #92]", + "eor r12, r12, r1", + "str r12, [r5, #92]", + "ldr r12, [r4, #96]", + "eor r12, r12, r1", + "str r12, [r5, #96]", + "ldr r12, [r4, #100]", + "eor r12, r12, r1", + "str r12, [r5, #100]", + "ldr r12, [r4, #104]", + "eor r12, r12, r1", + "str r12, [r5, #104]", + "ldr r12, [r4, #108]", + "eor r12, r12, r1", + "str r12, [r5, #108]", + "ldr r12, [r4, #112]", + "eor r12, r12, r1", + "str r12, [r5, #112]", + "ldr r12, [r4, #116]", + "eor r12, r12, r1", + "str r12, [r5, #116]", + "ldr r12, [r4, #120]", + "eor r12, r12, r1", + "str r12, [r5, #120]", + "ldr r12, [r4, #124]", + "eor r12, r12, r1", + "str r12, [r5, #124]", + "ldr r12, [r4, #128]", + "eor r12, r12, r1", + "str r12, [r5, #128]", + "ldr r12, [r4, #132]", + "eor r12, r12, r1", + "str r12, [r5, #132]", + "ldr r12, [r4, #136]", + "eor r12, r12, r1", + "str r12, [r5, #136]", + "ldr r12, [r4, #140]", + "eor r12, r12, r1", + "str r12, [r5, #140]", + "ldr r12, [r4, #144]", + "eor r12, r12, r1", + "str r12, [r5, #144]", + "ldr r12, [r4, #148]", + "eor r12, r12, r1", + "str r12, [r5, #148]", + "ldr r12, [r4, #152]", + "eor r12, r12, r1", + "str r12, [r5, #152]", + "ldr r12, [r4, #156]", + "eor r12, r12, r1", + "str r12, [r5, #156]", + "ldr r12, [r4, #160]", + "eor r12, r12, r1", + "str r12, [r5, #160]", + "ldr r12, [r4, #164]", + "eor r12, r12, r1", + "str r12, [r5, #164]", + "ldr r12, [r4, #168]", + "eor r12, r12, r1", + "str r12, [r5, #168]", + "ldr r12, [r4, #172]", + "eor r12, r12, r1", + "str r12, [r5, #172]", + "ldr r12, [r4, #176]", + "eor r12, r12, r1", + "str r12, [r5, #176]", + "ldr r12, [r4, #180]", + "eor r12, r12, r1", + "str r12, [r5, #180]", + "ldr r12, [r4, #184]", + "eor r12, r12, r1", + "str r12, [r5, #184]", + "ldr r12, [r4, #188]", + "eor r12, r12, r1", + "str r12, [r5, #188]", "mov r0, r4", - "bl {vg_sha384_init}", - "mov r0, r4", - "movw r12, #308", - "add r1, r11, r12", - "movw r7, #128", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", - "mov r0, r5", - "bl {vg_sha384_init}", + "add r6, r4, #64", + "mov r3, r11", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", "mov r0, r5", - "movw r12, #436", - "add r1, r11, r12", - "movw r7, #128", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", + "add r6, r5, #64", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", "ldr r4, [r11, #272]", "ldr r5, [r11, #276]", "ldr r6, [r11, #280]", @@ -101,7 +206,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha384_init(inner: *mut [u8; 192], outer "ldr r11, [r11, #304]", "bx lr", vg_sha384_init = sym super::sha512::vg_sha384_init, - vg_sha512_update = sym super::sha512::vg_sha512_update, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/arm/hmac_sha512.rs b/src/asm/arm/hmac_sha512.rs index 0580facfb..22acb3511 100644 --- a/src/asm/arm/hmac_sha512.rs +++ b/src/asm/arm/hmac_sha512.rs @@ -32,64 +32,169 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_init(inner: *mut [u8; 192], outer "mov r4, r0", "mov r5, r1", "mov r6, r2", + "mov r7, r3", "mov r11, r12", - "mov r8, #0", - "mov r9, r3", - "cmp r9, #0", + "mov r0, r4", + "bl {vg_sha512_init}", + "mov r0, r5", + "bl {vg_sha512_init}", + "movw r1, #13878", + "movt r1, #13878", + "str r1, [r4, #64]", + "str r1, [r4, #68]", + "str r1, [r4, #72]", + "str r1, [r4, #76]", + "str r1, [r4, #80]", + "str r1, [r4, #84]", + "str r1, [r4, #88]", + "str r1, [r4, #92]", + "str r1, [r4, #96]", + "str r1, [r4, #100]", + "str r1, [r4, #104]", + "str r1, [r4, #108]", + "str r1, [r4, #112]", + "str r1, [r4, #116]", + "str r1, [r4, #120]", + "str r1, [r4, #124]", + "str r1, [r4, #128]", + "str r1, [r4, #132]", + "str r1, [r4, #136]", + "str r1, [r4, #140]", + "str r1, [r4, #144]", + "str r1, [r4, #148]", + "str r1, [r4, #152]", + "str r1, [r4, #156]", + "str r1, [r4, #160]", + "str r1, [r4, #164]", + "str r1, [r4, #168]", + "str r1, [r4, #172]", + "str r1, [r4, #176]", + "str r1, [r4, #180]", + "str r1, [r4, #184]", + "str r1, [r4, #188]", + "mov r8, r4", + "cmp r7, #0", "beq 20f", "22:", - "add r2, r6, r8", - "ldrb r12, [r2, #0]", - "eor r1, r12, #54", - "add r2, r11, r8", - "strb r1, [r2, #308]", - "eor r1, r12, #92", - "strb r1, [r2, #436]", + "ldrb r12, [r6, #0]", + "eor r12, r12, #54", + "strb r12, [r8, #64]", + "add r6, r6, #1", "add r8, r8, #1", - "subs r9, r9, #1", + "subs r7, r7, #1", "bne 22b", "b 21f", "20:", "21:", - "movw r9, #128", - "subs r9, r9, r8", - "beq 23f", - "25:", - "add r2, r11, r8", - "mov r1, #54", - "strb r1, [r2, #308]", - "mov r1, #92", - "strb r1, [r2, #436]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "b 24f", - "23:", - "24:", + "movw r1, #27242", + "movt r1, #27242", + "ldr r12, [r4, #64]", + "eor r12, r12, r1", + "str r12, [r5, #64]", + "ldr r12, [r4, #68]", + "eor r12, r12, r1", + "str r12, [r5, #68]", + "ldr r12, [r4, #72]", + "eor r12, r12, r1", + "str r12, [r5, #72]", + "ldr r12, [r4, #76]", + "eor r12, r12, r1", + "str r12, [r5, #76]", + "ldr r12, [r4, #80]", + "eor r12, r12, r1", + "str r12, [r5, #80]", + "ldr r12, [r4, #84]", + "eor r12, r12, r1", + "str r12, [r5, #84]", + "ldr r12, [r4, #88]", + "eor r12, r12, r1", + "str r12, [r5, #88]", + "ldr r12, [r4, #92]", + "eor r12, r12, r1", + "str r12, [r5, #92]", + "ldr r12, [r4, #96]", + "eor r12, r12, r1", + "str r12, [r5, #96]", + "ldr r12, [r4, #100]", + "eor r12, r12, r1", + "str r12, [r5, #100]", + "ldr r12, [r4, #104]", + "eor r12, r12, r1", + "str r12, [r5, #104]", + "ldr r12, [r4, #108]", + "eor r12, r12, r1", + "str r12, [r5, #108]", + "ldr r12, [r4, #112]", + "eor r12, r12, r1", + "str r12, [r5, #112]", + "ldr r12, [r4, #116]", + "eor r12, r12, r1", + "str r12, [r5, #116]", + "ldr r12, [r4, #120]", + "eor r12, r12, r1", + "str r12, [r5, #120]", + "ldr r12, [r4, #124]", + "eor r12, r12, r1", + "str r12, [r5, #124]", + "ldr r12, [r4, #128]", + "eor r12, r12, r1", + "str r12, [r5, #128]", + "ldr r12, [r4, #132]", + "eor r12, r12, r1", + "str r12, [r5, #132]", + "ldr r12, [r4, #136]", + "eor r12, r12, r1", + "str r12, [r5, #136]", + "ldr r12, [r4, #140]", + "eor r12, r12, r1", + "str r12, [r5, #140]", + "ldr r12, [r4, #144]", + "eor r12, r12, r1", + "str r12, [r5, #144]", + "ldr r12, [r4, #148]", + "eor r12, r12, r1", + "str r12, [r5, #148]", + "ldr r12, [r4, #152]", + "eor r12, r12, r1", + "str r12, [r5, #152]", + "ldr r12, [r4, #156]", + "eor r12, r12, r1", + "str r12, [r5, #156]", + "ldr r12, [r4, #160]", + "eor r12, r12, r1", + "str r12, [r5, #160]", + "ldr r12, [r4, #164]", + "eor r12, r12, r1", + "str r12, [r5, #164]", + "ldr r12, [r4, #168]", + "eor r12, r12, r1", + "str r12, [r5, #168]", + "ldr r12, [r4, #172]", + "eor r12, r12, r1", + "str r12, [r5, #172]", + "ldr r12, [r4, #176]", + "eor r12, r12, r1", + "str r12, [r5, #176]", + "ldr r12, [r4, #180]", + "eor r12, r12, r1", + "str r12, [r5, #180]", + "ldr r12, [r4, #184]", + "eor r12, r12, r1", + "str r12, [r5, #184]", + "ldr r12, [r4, #188]", + "eor r12, r12, r1", + "str r12, [r5, #188]", "mov r0, r4", - "bl {vg_sha512_init}", - "mov r0, r4", - "movw r12, #308", - "add r1, r11, r12", - "movw r7, #128", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", - "mov r0, r5", - "bl {vg_sha512_init}", + "add r6, r4, #64", + "mov r3, r11", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", "mov r0, r5", - "movw r12, #436", - "add r1, r11, r12", - "movw r7, #128", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", + "add r6, r5, #64", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", "ldr r4, [r11, #272]", "ldr r5, [r11, #276]", "ldr r6, [r11, #280]", @@ -101,7 +206,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_init(inner: *mut [u8; 192], outer "ldr r11, [r11, #304]", "bx lr", vg_sha512_init = sym super::sha512::vg_sha512_init, - vg_sha512_update = sym super::sha512::vg_sha512_update, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/arm/hmac_sha512_224.rs b/src/asm/arm/hmac_sha512_224.rs index e5856aa75..11a51ea3a 100644 --- a/src/asm/arm/hmac_sha512_224.rs +++ b/src/asm/arm/hmac_sha512_224.rs @@ -32,64 +32,169 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_224_init(inner: *mut [u8; 192], o "mov r4, r0", "mov r5, r1", "mov r6, r2", + "mov r7, r3", "mov r11, r12", - "mov r8, #0", - "mov r9, r3", - "cmp r9, #0", + "mov r0, r4", + "bl {vg_sha512_224_init}", + "mov r0, r5", + "bl {vg_sha512_224_init}", + "movw r1, #13878", + "movt r1, #13878", + "str r1, [r4, #64]", + "str r1, [r4, #68]", + "str r1, [r4, #72]", + "str r1, [r4, #76]", + "str r1, [r4, #80]", + "str r1, [r4, #84]", + "str r1, [r4, #88]", + "str r1, [r4, #92]", + "str r1, [r4, #96]", + "str r1, [r4, #100]", + "str r1, [r4, #104]", + "str r1, [r4, #108]", + "str r1, [r4, #112]", + "str r1, [r4, #116]", + "str r1, [r4, #120]", + "str r1, [r4, #124]", + "str r1, [r4, #128]", + "str r1, [r4, #132]", + "str r1, [r4, #136]", + "str r1, [r4, #140]", + "str r1, [r4, #144]", + "str r1, [r4, #148]", + "str r1, [r4, #152]", + "str r1, [r4, #156]", + "str r1, [r4, #160]", + "str r1, [r4, #164]", + "str r1, [r4, #168]", + "str r1, [r4, #172]", + "str r1, [r4, #176]", + "str r1, [r4, #180]", + "str r1, [r4, #184]", + "str r1, [r4, #188]", + "mov r8, r4", + "cmp r7, #0", "beq 20f", "22:", - "add r2, r6, r8", - "ldrb r12, [r2, #0]", - "eor r1, r12, #54", - "add r2, r11, r8", - "strb r1, [r2, #308]", - "eor r1, r12, #92", - "strb r1, [r2, #436]", + "ldrb r12, [r6, #0]", + "eor r12, r12, #54", + "strb r12, [r8, #64]", + "add r6, r6, #1", "add r8, r8, #1", - "subs r9, r9, #1", + "subs r7, r7, #1", "bne 22b", "b 21f", "20:", "21:", - "movw r9, #128", - "subs r9, r9, r8", - "beq 23f", - "25:", - "add r2, r11, r8", - "mov r1, #54", - "strb r1, [r2, #308]", - "mov r1, #92", - "strb r1, [r2, #436]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "b 24f", - "23:", - "24:", + "movw r1, #27242", + "movt r1, #27242", + "ldr r12, [r4, #64]", + "eor r12, r12, r1", + "str r12, [r5, #64]", + "ldr r12, [r4, #68]", + "eor r12, r12, r1", + "str r12, [r5, #68]", + "ldr r12, [r4, #72]", + "eor r12, r12, r1", + "str r12, [r5, #72]", + "ldr r12, [r4, #76]", + "eor r12, r12, r1", + "str r12, [r5, #76]", + "ldr r12, [r4, #80]", + "eor r12, r12, r1", + "str r12, [r5, #80]", + "ldr r12, [r4, #84]", + "eor r12, r12, r1", + "str r12, [r5, #84]", + "ldr r12, [r4, #88]", + "eor r12, r12, r1", + "str r12, [r5, #88]", + "ldr r12, [r4, #92]", + "eor r12, r12, r1", + "str r12, [r5, #92]", + "ldr r12, [r4, #96]", + "eor r12, r12, r1", + "str r12, [r5, #96]", + "ldr r12, [r4, #100]", + "eor r12, r12, r1", + "str r12, [r5, #100]", + "ldr r12, [r4, #104]", + "eor r12, r12, r1", + "str r12, [r5, #104]", + "ldr r12, [r4, #108]", + "eor r12, r12, r1", + "str r12, [r5, #108]", + "ldr r12, [r4, #112]", + "eor r12, r12, r1", + "str r12, [r5, #112]", + "ldr r12, [r4, #116]", + "eor r12, r12, r1", + "str r12, [r5, #116]", + "ldr r12, [r4, #120]", + "eor r12, r12, r1", + "str r12, [r5, #120]", + "ldr r12, [r4, #124]", + "eor r12, r12, r1", + "str r12, [r5, #124]", + "ldr r12, [r4, #128]", + "eor r12, r12, r1", + "str r12, [r5, #128]", + "ldr r12, [r4, #132]", + "eor r12, r12, r1", + "str r12, [r5, #132]", + "ldr r12, [r4, #136]", + "eor r12, r12, r1", + "str r12, [r5, #136]", + "ldr r12, [r4, #140]", + "eor r12, r12, r1", + "str r12, [r5, #140]", + "ldr r12, [r4, #144]", + "eor r12, r12, r1", + "str r12, [r5, #144]", + "ldr r12, [r4, #148]", + "eor r12, r12, r1", + "str r12, [r5, #148]", + "ldr r12, [r4, #152]", + "eor r12, r12, r1", + "str r12, [r5, #152]", + "ldr r12, [r4, #156]", + "eor r12, r12, r1", + "str r12, [r5, #156]", + "ldr r12, [r4, #160]", + "eor r12, r12, r1", + "str r12, [r5, #160]", + "ldr r12, [r4, #164]", + "eor r12, r12, r1", + "str r12, [r5, #164]", + "ldr r12, [r4, #168]", + "eor r12, r12, r1", + "str r12, [r5, #168]", + "ldr r12, [r4, #172]", + "eor r12, r12, r1", + "str r12, [r5, #172]", + "ldr r12, [r4, #176]", + "eor r12, r12, r1", + "str r12, [r5, #176]", + "ldr r12, [r4, #180]", + "eor r12, r12, r1", + "str r12, [r5, #180]", + "ldr r12, [r4, #184]", + "eor r12, r12, r1", + "str r12, [r5, #184]", + "ldr r12, [r4, #188]", + "eor r12, r12, r1", + "str r12, [r5, #188]", "mov r0, r4", - "bl {vg_sha512_224_init}", - "mov r0, r4", - "movw r12, #308", - "add r1, r11, r12", - "movw r7, #128", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", - "mov r0, r5", - "bl {vg_sha512_224_init}", + "add r6, r4, #64", + "mov r3, r11", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", "mov r0, r5", - "movw r12, #436", - "add r1, r11, r12", - "movw r7, #128", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", + "add r6, r5, #64", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", "ldr r4, [r11, #272]", "ldr r5, [r11, #276]", "ldr r6, [r11, #280]", @@ -101,7 +206,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_224_init(inner: *mut [u8; 192], o "ldr r11, [r11, #304]", "bx lr", vg_sha512_224_init = sym super::sha512::vg_sha512_224_init, - vg_sha512_update = sym super::sha512::vg_sha512_update, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/arm/hmac_sha512_256.rs b/src/asm/arm/hmac_sha512_256.rs index fbf34fba2..ca25df995 100644 --- a/src/asm/arm/hmac_sha512_256.rs +++ b/src/asm/arm/hmac_sha512_256.rs @@ -32,64 +32,169 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_256_init(inner: *mut [u8; 192], o "mov r4, r0", "mov r5, r1", "mov r6, r2", + "mov r7, r3", "mov r11, r12", - "mov r8, #0", - "mov r9, r3", - "cmp r9, #0", + "mov r0, r4", + "bl {vg_sha512_256_init}", + "mov r0, r5", + "bl {vg_sha512_256_init}", + "movw r1, #13878", + "movt r1, #13878", + "str r1, [r4, #64]", + "str r1, [r4, #68]", + "str r1, [r4, #72]", + "str r1, [r4, #76]", + "str r1, [r4, #80]", + "str r1, [r4, #84]", + "str r1, [r4, #88]", + "str r1, [r4, #92]", + "str r1, [r4, #96]", + "str r1, [r4, #100]", + "str r1, [r4, #104]", + "str r1, [r4, #108]", + "str r1, [r4, #112]", + "str r1, [r4, #116]", + "str r1, [r4, #120]", + "str r1, [r4, #124]", + "str r1, [r4, #128]", + "str r1, [r4, #132]", + "str r1, [r4, #136]", + "str r1, [r4, #140]", + "str r1, [r4, #144]", + "str r1, [r4, #148]", + "str r1, [r4, #152]", + "str r1, [r4, #156]", + "str r1, [r4, #160]", + "str r1, [r4, #164]", + "str r1, [r4, #168]", + "str r1, [r4, #172]", + "str r1, [r4, #176]", + "str r1, [r4, #180]", + "str r1, [r4, #184]", + "str r1, [r4, #188]", + "mov r8, r4", + "cmp r7, #0", "beq 20f", "22:", - "add r2, r6, r8", - "ldrb r12, [r2, #0]", - "eor r1, r12, #54", - "add r2, r11, r8", - "strb r1, [r2, #308]", - "eor r1, r12, #92", - "strb r1, [r2, #436]", + "ldrb r12, [r6, #0]", + "eor r12, r12, #54", + "strb r12, [r8, #64]", + "add r6, r6, #1", "add r8, r8, #1", - "subs r9, r9, #1", + "subs r7, r7, #1", "bne 22b", "b 21f", "20:", "21:", - "movw r9, #128", - "subs r9, r9, r8", - "beq 23f", - "25:", - "add r2, r11, r8", - "mov r1, #54", - "strb r1, [r2, #308]", - "mov r1, #92", - "strb r1, [r2, #436]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "b 24f", - "23:", - "24:", + "movw r1, #27242", + "movt r1, #27242", + "ldr r12, [r4, #64]", + "eor r12, r12, r1", + "str r12, [r5, #64]", + "ldr r12, [r4, #68]", + "eor r12, r12, r1", + "str r12, [r5, #68]", + "ldr r12, [r4, #72]", + "eor r12, r12, r1", + "str r12, [r5, #72]", + "ldr r12, [r4, #76]", + "eor r12, r12, r1", + "str r12, [r5, #76]", + "ldr r12, [r4, #80]", + "eor r12, r12, r1", + "str r12, [r5, #80]", + "ldr r12, [r4, #84]", + "eor r12, r12, r1", + "str r12, [r5, #84]", + "ldr r12, [r4, #88]", + "eor r12, r12, r1", + "str r12, [r5, #88]", + "ldr r12, [r4, #92]", + "eor r12, r12, r1", + "str r12, [r5, #92]", + "ldr r12, [r4, #96]", + "eor r12, r12, r1", + "str r12, [r5, #96]", + "ldr r12, [r4, #100]", + "eor r12, r12, r1", + "str r12, [r5, #100]", + "ldr r12, [r4, #104]", + "eor r12, r12, r1", + "str r12, [r5, #104]", + "ldr r12, [r4, #108]", + "eor r12, r12, r1", + "str r12, [r5, #108]", + "ldr r12, [r4, #112]", + "eor r12, r12, r1", + "str r12, [r5, #112]", + "ldr r12, [r4, #116]", + "eor r12, r12, r1", + "str r12, [r5, #116]", + "ldr r12, [r4, #120]", + "eor r12, r12, r1", + "str r12, [r5, #120]", + "ldr r12, [r4, #124]", + "eor r12, r12, r1", + "str r12, [r5, #124]", + "ldr r12, [r4, #128]", + "eor r12, r12, r1", + "str r12, [r5, #128]", + "ldr r12, [r4, #132]", + "eor r12, r12, r1", + "str r12, [r5, #132]", + "ldr r12, [r4, #136]", + "eor r12, r12, r1", + "str r12, [r5, #136]", + "ldr r12, [r4, #140]", + "eor r12, r12, r1", + "str r12, [r5, #140]", + "ldr r12, [r4, #144]", + "eor r12, r12, r1", + "str r12, [r5, #144]", + "ldr r12, [r4, #148]", + "eor r12, r12, r1", + "str r12, [r5, #148]", + "ldr r12, [r4, #152]", + "eor r12, r12, r1", + "str r12, [r5, #152]", + "ldr r12, [r4, #156]", + "eor r12, r12, r1", + "str r12, [r5, #156]", + "ldr r12, [r4, #160]", + "eor r12, r12, r1", + "str r12, [r5, #160]", + "ldr r12, [r4, #164]", + "eor r12, r12, r1", + "str r12, [r5, #164]", + "ldr r12, [r4, #168]", + "eor r12, r12, r1", + "str r12, [r5, #168]", + "ldr r12, [r4, #172]", + "eor r12, r12, r1", + "str r12, [r5, #172]", + "ldr r12, [r4, #176]", + "eor r12, r12, r1", + "str r12, [r5, #176]", + "ldr r12, [r4, #180]", + "eor r12, r12, r1", + "str r12, [r5, #180]", + "ldr r12, [r4, #184]", + "eor r12, r12, r1", + "str r12, [r5, #184]", + "ldr r12, [r4, #188]", + "eor r12, r12, r1", + "str r12, [r5, #188]", "mov r0, r4", - "bl {vg_sha512_256_init}", - "mov r0, r4", - "movw r12, #308", - "add r1, r11, r12", - "movw r7, #128", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", - "mov r0, r5", - "bl {vg_sha512_256_init}", + "add r6, r4, #64", + "mov r3, r11", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", "mov r0, r5", - "movw r12, #436", - "add r1, r11, r12", - "movw r7, #128", - "mov r10, r11", - "movw r2, #0", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", + "add r6, r5, #64", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", "ldr r4, [r11, #272]", "ldr r5, [r11, #276]", "ldr r6, [r11, #280]", @@ -101,7 +206,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_256_init(inner: *mut [u8; 192], o "ldr r11, [r11, #304]", "bx lr", vg_sha512_256_init = sym super::sha512::vg_sha512_256_init, - vg_sha512_update = sym super::sha512::vg_sha512_update, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/x86/hmac_md5.rs b/src/asm/x86/hmac_md5.rs index 2e791ba46..5da293ea3 100644 --- a/src/asm/x86/hmac_md5.rs +++ b/src/asm/x86/hmac_md5.rs @@ -27,83 +27,117 @@ pub(crate) unsafe extern "C" fn vg_hmac_md5_init(inner: *mut [u8; 80], outer: *m "mov DWORD PTR [eax+120], edi", "mov DWORD PTR [eax+124], ebp", "mov ebp, eax", - "mov esi, DWORD PTR [esp+12]", - "mov edi, DWORD PTR [esp+16]", - "mov ebx, 0", - "test edi, edi", + "mov ebx, DWORD PTR [esp+4]", + "mov esi, DWORD PTR [esp+8]", + "push ebx", + "call {vg_md5_init}", + "pop eax", + "push esi", + "call {vg_md5_init}", + "pop eax", + "mov ecx, 909522486", + "mov DWORD PTR [ebx+16], ecx", + "mov DWORD PTR [ebx+20], ecx", + "mov DWORD PTR [ebx+24], ecx", + "mov DWORD PTR [ebx+28], ecx", + "mov DWORD PTR [ebx+32], ecx", + "mov DWORD PTR [ebx+36], ecx", + "mov DWORD PTR [ebx+40], ecx", + "mov DWORD PTR [ebx+44], ecx", + "mov DWORD PTR [ebx+48], ecx", + "mov DWORD PTR [ebx+52], ecx", + "mov DWORD PTR [ebx+56], ecx", + "mov DWORD PTR [ebx+60], ecx", + "mov DWORD PTR [ebx+64], ecx", + "mov DWORD PTR [ebx+68], ecx", + "mov DWORD PTR [ebx+72], ecx", + "mov DWORD PTR [ebx+76], ecx", + "mov edi, DWORD PTR [esp+12]", + "mov ecx, DWORD PTR [esp+16]", + "mov edx, ebx", + "add edx, 16", + "test ecx, ecx", "je 20f", "22:", - "mov eax, esi", - "add eax, ebx", - "movzx eax, BYTE PTR [eax]", - "mov ecx, eax", + "movzx eax, BYTE PTR [edi]", "xor eax, 54", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+128], al", - "xor ecx, 92", - "mov BYTE PTR [edx+192], cl", - "add ebx, 1", - "cmp ebx, edi", + "mov BYTE PTR [edx], al", + "add edi, 1", + "add edx, 1", + "sub ecx, 1", "jne 22b", "jmp 21f", "20:", "21:", - "mov eax, 54", - "mov ecx, 92", - "cmp ebx, 64", - "je 23f", - "25:", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+128], al", - "mov BYTE PTR [edx+192], cl", - "add ebx, 1", - "cmp ebx, 64", - "jne 25b", - "jmp 24f", - "23:", - "24:", - "mov ebx, DWORD PTR [esp+4]", - "mov esi, DWORD PTR [esp+8]", - "push ebx", - "call {vg_md5_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 64", - "mov edx, ebp", - "add edx, 128", + "mov eax, DWORD PTR [ebx+16]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+16], eax", + "mov eax, DWORD PTR [ebx+20]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+20], eax", + "mov eax, DWORD PTR [ebx+24]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+24], eax", + "mov eax, DWORD PTR [ebx+28]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+28], eax", + "mov eax, DWORD PTR [ebx+32]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+32], eax", + "mov eax, DWORD PTR [ebx+36]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+36], eax", + "mov eax, DWORD PTR [ebx+40]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+40], eax", + "mov eax, DWORD PTR [ebx+44]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+44], eax", + "mov eax, DWORD PTR [ebx+48]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+48], eax", + "mov eax, DWORD PTR [ebx+52]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+52], eax", + "mov eax, DWORD PTR [ebx+56]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+56], eax", + "mov eax, DWORD PTR [ebx+60]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+60], eax", + "mov eax, DWORD PTR [ebx+64]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+64], eax", + "mov eax, DWORD PTR [ebx+68]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+68], eax", + "mov eax, DWORD PTR [ebx+72]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+72], eax", + "mov eax, DWORD PTR [ebx+76]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+76], eax", + "mov eax, ebx", + "add eax, 16", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", "push ebx", - "call {vg_md5_update}", - "pop eax", - "pop eax", + "call {vg_md5_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "push esi", - "call {vg_md5_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 64", - "mov edx, ebp", - "add edx, 192", + "mov ebx, esi", + "mov eax, ebx", + "add eax, 16", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", - "push esi", - "call {vg_md5_update}", - "pop eax", - "pop eax", + "push ebx", + "call {vg_md5_compress}", "pop eax", "pop eax", "pop eax", @@ -115,7 +149,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_md5_init(inner: *mut [u8; 80], outer: *m "mov ebp, DWORD PTR [eax+124]", "ret", vg_md5_init = sym super::md5::vg_md5_init, - vg_md5_update = sym super::md5::vg_md5_update, + vg_md5_compress = sym super::md5::vg_md5_compress, ) } diff --git a/src/asm/x86/hmac_sha1.rs b/src/asm/x86/hmac_sha1.rs index 2cbd18812..285778e9d 100644 --- a/src/asm/x86/hmac_sha1.rs +++ b/src/asm/x86/hmac_sha1.rs @@ -27,83 +27,117 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha1_init(inner: *mut [u8; 84], outer: * "mov DWORD PTR [eax+168], edi", "mov DWORD PTR [eax+172], ebp", "mov ebp, eax", - "mov esi, DWORD PTR [esp+12]", - "mov edi, DWORD PTR [esp+16]", - "mov ebx, 0", - "test edi, edi", + "mov ebx, DWORD PTR [esp+4]", + "mov esi, DWORD PTR [esp+8]", + "push ebx", + "call {vg_sha1_init}", + "pop eax", + "push esi", + "call {vg_sha1_init}", + "pop eax", + "mov ecx, 909522486", + "mov DWORD PTR [ebx+20], ecx", + "mov DWORD PTR [ebx+24], ecx", + "mov DWORD PTR [ebx+28], ecx", + "mov DWORD PTR [ebx+32], ecx", + "mov DWORD PTR [ebx+36], ecx", + "mov DWORD PTR [ebx+40], ecx", + "mov DWORD PTR [ebx+44], ecx", + "mov DWORD PTR [ebx+48], ecx", + "mov DWORD PTR [ebx+52], ecx", + "mov DWORD PTR [ebx+56], ecx", + "mov DWORD PTR [ebx+60], ecx", + "mov DWORD PTR [ebx+64], ecx", + "mov DWORD PTR [ebx+68], ecx", + "mov DWORD PTR [ebx+72], ecx", + "mov DWORD PTR [ebx+76], ecx", + "mov DWORD PTR [ebx+80], ecx", + "mov edi, DWORD PTR [esp+12]", + "mov ecx, DWORD PTR [esp+16]", + "mov edx, ebx", + "add edx, 20", + "test ecx, ecx", "je 20f", "22:", - "mov eax, esi", - "add eax, ebx", - "movzx eax, BYTE PTR [eax]", - "mov ecx, eax", + "movzx eax, BYTE PTR [edi]", "xor eax, 54", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+176], al", - "xor ecx, 92", - "mov BYTE PTR [edx+240], cl", - "add ebx, 1", - "cmp ebx, edi", + "mov BYTE PTR [edx], al", + "add edi, 1", + "add edx, 1", + "sub ecx, 1", "jne 22b", "jmp 21f", "20:", "21:", - "mov eax, 54", - "mov ecx, 92", - "cmp ebx, 64", - "je 23f", - "25:", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+176], al", - "mov BYTE PTR [edx+240], cl", - "add ebx, 1", - "cmp ebx, 64", - "jne 25b", - "jmp 24f", - "23:", - "24:", - "mov ebx, DWORD PTR [esp+4]", - "mov esi, DWORD PTR [esp+8]", - "push ebx", - "call {vg_sha1_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 64", - "mov edx, ebp", - "add edx, 176", + "mov eax, DWORD PTR [ebx+20]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+20], eax", + "mov eax, DWORD PTR [ebx+24]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+24], eax", + "mov eax, DWORD PTR [ebx+28]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+28], eax", + "mov eax, DWORD PTR [ebx+32]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+32], eax", + "mov eax, DWORD PTR [ebx+36]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+36], eax", + "mov eax, DWORD PTR [ebx+40]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+40], eax", + "mov eax, DWORD PTR [ebx+44]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+44], eax", + "mov eax, DWORD PTR [ebx+48]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+48], eax", + "mov eax, DWORD PTR [ebx+52]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+52], eax", + "mov eax, DWORD PTR [ebx+56]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+56], eax", + "mov eax, DWORD PTR [ebx+60]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+60], eax", + "mov eax, DWORD PTR [ebx+64]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+64], eax", + "mov eax, DWORD PTR [ebx+68]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+68], eax", + "mov eax, DWORD PTR [ebx+72]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+72], eax", + "mov eax, DWORD PTR [ebx+76]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+76], eax", + "mov eax, DWORD PTR [ebx+80]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+80], eax", + "mov eax, ebx", + "add eax, 20", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", "push ebx", - "call {vg_sha1_update}", - "pop eax", - "pop eax", + "call {vg_sha1_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "push esi", - "call {vg_sha1_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 64", - "mov edx, ebp", - "add edx, 240", + "mov ebx, esi", + "mov eax, ebx", + "add eax, 20", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", - "push esi", - "call {vg_sha1_update}", - "pop eax", - "pop eax", + "push ebx", + "call {vg_sha1_compress}", "pop eax", "pop eax", "pop eax", @@ -115,7 +149,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha1_init(inner: *mut [u8; 84], outer: * "mov ebp, DWORD PTR [eax+172]", "ret", vg_sha1_init = sym super::sha1::vg_sha1_init, - vg_sha1_update = sym super::sha1::vg_sha1_update, + vg_sha1_compress = sym super::sha1::vg_sha1_compress, ) } diff --git a/src/asm/x86/hmac_sha256.rs b/src/asm/x86/hmac_sha256.rs index 5e6355734..26b173818 100644 --- a/src/asm/x86/hmac_sha256.rs +++ b/src/asm/x86/hmac_sha256.rs @@ -27,83 +27,117 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha256_init(inner: *mut [u8; 96], outer: "mov DWORD PTR [eax+168], edi", "mov DWORD PTR [eax+172], ebp", "mov ebp, eax", - "mov esi, DWORD PTR [esp+12]", - "mov edi, DWORD PTR [esp+16]", - "mov ebx, 0", - "test edi, edi", + "mov ebx, DWORD PTR [esp+4]", + "mov esi, DWORD PTR [esp+8]", + "push ebx", + "call {vg_sha256_init}", + "pop eax", + "push esi", + "call {vg_sha256_init}", + "pop eax", + "mov ecx, 909522486", + "mov DWORD PTR [ebx+32], ecx", + "mov DWORD PTR [ebx+36], ecx", + "mov DWORD PTR [ebx+40], ecx", + "mov DWORD PTR [ebx+44], ecx", + "mov DWORD PTR [ebx+48], ecx", + "mov DWORD PTR [ebx+52], ecx", + "mov DWORD PTR [ebx+56], ecx", + "mov DWORD PTR [ebx+60], ecx", + "mov DWORD PTR [ebx+64], ecx", + "mov DWORD PTR [ebx+68], ecx", + "mov DWORD PTR [ebx+72], ecx", + "mov DWORD PTR [ebx+76], ecx", + "mov DWORD PTR [ebx+80], ecx", + "mov DWORD PTR [ebx+84], ecx", + "mov DWORD PTR [ebx+88], ecx", + "mov DWORD PTR [ebx+92], ecx", + "mov edi, DWORD PTR [esp+12]", + "mov ecx, DWORD PTR [esp+16]", + "mov edx, ebx", + "add edx, 32", + "test ecx, ecx", "je 20f", "22:", - "mov eax, esi", - "add eax, ebx", - "movzx eax, BYTE PTR [eax]", - "mov ecx, eax", + "movzx eax, BYTE PTR [edi]", "xor eax, 54", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+176], al", - "xor ecx, 92", - "mov BYTE PTR [edx+240], cl", - "add ebx, 1", - "cmp ebx, edi", + "mov BYTE PTR [edx], al", + "add edi, 1", + "add edx, 1", + "sub ecx, 1", "jne 22b", "jmp 21f", "20:", "21:", - "mov eax, 54", - "mov ecx, 92", - "cmp ebx, 64", - "je 23f", - "25:", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+176], al", - "mov BYTE PTR [edx+240], cl", - "add ebx, 1", - "cmp ebx, 64", - "jne 25b", - "jmp 24f", - "23:", - "24:", - "mov ebx, DWORD PTR [esp+4]", - "mov esi, DWORD PTR [esp+8]", - "push ebx", - "call {vg_sha256_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 64", - "mov edx, ebp", - "add edx, 176", + "mov eax, DWORD PTR [ebx+32]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+32], eax", + "mov eax, DWORD PTR [ebx+36]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+36], eax", + "mov eax, DWORD PTR [ebx+40]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+40], eax", + "mov eax, DWORD PTR [ebx+44]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+44], eax", + "mov eax, DWORD PTR [ebx+48]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+48], eax", + "mov eax, DWORD PTR [ebx+52]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+52], eax", + "mov eax, DWORD PTR [ebx+56]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+56], eax", + "mov eax, DWORD PTR [ebx+60]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+60], eax", + "mov eax, DWORD PTR [ebx+64]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+64], eax", + "mov eax, DWORD PTR [ebx+68]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+68], eax", + "mov eax, DWORD PTR [ebx+72]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+72], eax", + "mov eax, DWORD PTR [ebx+76]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+76], eax", + "mov eax, DWORD PTR [ebx+80]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+80], eax", + "mov eax, DWORD PTR [ebx+84]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+84], eax", + "mov eax, DWORD PTR [ebx+88]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+88], eax", + "mov eax, DWORD PTR [ebx+92]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+92], eax", + "mov eax, ebx", + "add eax, 32", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", "push ebx", - "call {vg_sha256_update}", - "pop eax", - "pop eax", + "call {vg_sha256_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "push esi", - "call {vg_sha256_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 64", - "mov edx, ebp", - "add edx, 240", + "mov ebx, esi", + "mov eax, ebx", + "add eax, 32", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", - "push esi", - "call {vg_sha256_update}", - "pop eax", - "pop eax", + "push ebx", + "call {vg_sha256_compress}", "pop eax", "pop eax", "pop eax", @@ -115,7 +149,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha256_init(inner: *mut [u8; 96], outer: "mov ebp, DWORD PTR [eax+172]", "ret", vg_sha256_init = sym super::sha256::vg_sha256_init, - vg_sha256_update = sym super::sha256::vg_sha256_update, + vg_sha256_compress = sym super::sha256::vg_sha256_compress, ) } @@ -287,83 +321,117 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha256_init_shani(inner: *mut [u8; 96], "mov DWORD PTR [eax+168], edi", "mov DWORD PTR [eax+172], ebp", "mov ebp, eax", - "mov esi, DWORD PTR [esp+12]", - "mov edi, DWORD PTR [esp+16]", - "mov ebx, 0", - "test edi, edi", + "mov ebx, DWORD PTR [esp+4]", + "mov esi, DWORD PTR [esp+8]", + "push ebx", + "call {vg_sha256_init}", + "pop eax", + "push esi", + "call {vg_sha256_init}", + "pop eax", + "mov ecx, 909522486", + "mov DWORD PTR [ebx+32], ecx", + "mov DWORD PTR [ebx+36], ecx", + "mov DWORD PTR [ebx+40], ecx", + "mov DWORD PTR [ebx+44], ecx", + "mov DWORD PTR [ebx+48], ecx", + "mov DWORD PTR [ebx+52], ecx", + "mov DWORD PTR [ebx+56], ecx", + "mov DWORD PTR [ebx+60], ecx", + "mov DWORD PTR [ebx+64], ecx", + "mov DWORD PTR [ebx+68], ecx", + "mov DWORD PTR [ebx+72], ecx", + "mov DWORD PTR [ebx+76], ecx", + "mov DWORD PTR [ebx+80], ecx", + "mov DWORD PTR [ebx+84], ecx", + "mov DWORD PTR [ebx+88], ecx", + "mov DWORD PTR [ebx+92], ecx", + "mov edi, DWORD PTR [esp+12]", + "mov ecx, DWORD PTR [esp+16]", + "mov edx, ebx", + "add edx, 32", + "test ecx, ecx", "je 20f", "22:", - "mov eax, esi", - "add eax, ebx", - "movzx eax, BYTE PTR [eax]", - "mov ecx, eax", + "movzx eax, BYTE PTR [edi]", "xor eax, 54", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+176], al", - "xor ecx, 92", - "mov BYTE PTR [edx+240], cl", - "add ebx, 1", - "cmp ebx, edi", + "mov BYTE PTR [edx], al", + "add edi, 1", + "add edx, 1", + "sub ecx, 1", "jne 22b", "jmp 21f", "20:", "21:", - "mov eax, 54", - "mov ecx, 92", - "cmp ebx, 64", - "je 23f", - "25:", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+176], al", - "mov BYTE PTR [edx+240], cl", - "add ebx, 1", - "cmp ebx, 64", - "jne 25b", - "jmp 24f", - "23:", - "24:", - "mov ebx, DWORD PTR [esp+4]", - "mov esi, DWORD PTR [esp+8]", - "push ebx", - "call {vg_sha256_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 64", - "mov edx, ebp", - "add edx, 176", + "mov eax, DWORD PTR [ebx+32]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+32], eax", + "mov eax, DWORD PTR [ebx+36]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+36], eax", + "mov eax, DWORD PTR [ebx+40]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+40], eax", + "mov eax, DWORD PTR [ebx+44]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+44], eax", + "mov eax, DWORD PTR [ebx+48]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+48], eax", + "mov eax, DWORD PTR [ebx+52]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+52], eax", + "mov eax, DWORD PTR [ebx+56]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+56], eax", + "mov eax, DWORD PTR [ebx+60]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+60], eax", + "mov eax, DWORD PTR [ebx+64]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+64], eax", + "mov eax, DWORD PTR [ebx+68]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+68], eax", + "mov eax, DWORD PTR [ebx+72]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+72], eax", + "mov eax, DWORD PTR [ebx+76]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+76], eax", + "mov eax, DWORD PTR [ebx+80]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+80], eax", + "mov eax, DWORD PTR [ebx+84]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+84], eax", + "mov eax, DWORD PTR [ebx+88]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+88], eax", + "mov eax, DWORD PTR [ebx+92]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+92], eax", + "mov eax, ebx", + "add eax, 32", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", "push ebx", - "call {vg_sha256_update_shani}", - "pop eax", - "pop eax", + "call {vg_sha256_compress_shani}", "pop eax", "pop eax", "pop eax", "pop eax", - "push esi", - "call {vg_sha256_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 64", - "mov edx, ebp", - "add edx, 240", + "mov ebx, esi", + "mov eax, ebx", + "add eax, 32", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", - "push esi", - "call {vg_sha256_update_shani}", - "pop eax", - "pop eax", + "push ebx", + "call {vg_sha256_compress_shani}", "pop eax", "pop eax", "pop eax", @@ -375,7 +443,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha256_init_shani(inner: *mut [u8; 96], "mov ebp, DWORD PTR [eax+172]", "ret", vg_sha256_init = sym super::sha256::vg_sha256_init, - vg_sha256_update_shani = sym super::sha256::vg_sha256_update_shani, + vg_sha256_compress_shani = sym super::sha256::vg_sha256_compress_shani, ) } diff --git a/src/asm/x86/hmac_sha384.rs b/src/asm/x86/hmac_sha384.rs index a66beb3cb..b2e5f98c6 100644 --- a/src/asm/x86/hmac_sha384.rs +++ b/src/asm/x86/hmac_sha384.rs @@ -27,83 +27,181 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha384_init(inner: *mut [u8; 192], outer "mov DWORD PTR [eax+280], edi", "mov DWORD PTR [eax+284], ebp", "mov ebp, eax", - "mov esi, DWORD PTR [esp+12]", - "mov edi, DWORD PTR [esp+16]", - "mov ebx, 0", - "test edi, edi", + "mov ebx, DWORD PTR [esp+4]", + "mov esi, DWORD PTR [esp+8]", + "push ebx", + "call {vg_sha384_init}", + "pop eax", + "push esi", + "call {vg_sha384_init}", + "pop eax", + "mov ecx, 909522486", + "mov DWORD PTR [ebx+64], ecx", + "mov DWORD PTR [ebx+68], ecx", + "mov DWORD PTR [ebx+72], ecx", + "mov DWORD PTR [ebx+76], ecx", + "mov DWORD PTR [ebx+80], ecx", + "mov DWORD PTR [ebx+84], ecx", + "mov DWORD PTR [ebx+88], ecx", + "mov DWORD PTR [ebx+92], ecx", + "mov DWORD PTR [ebx+96], ecx", + "mov DWORD PTR [ebx+100], ecx", + "mov DWORD PTR [ebx+104], ecx", + "mov DWORD PTR [ebx+108], ecx", + "mov DWORD PTR [ebx+112], ecx", + "mov DWORD PTR [ebx+116], ecx", + "mov DWORD PTR [ebx+120], ecx", + "mov DWORD PTR [ebx+124], ecx", + "mov DWORD PTR [ebx+128], ecx", + "mov DWORD PTR [ebx+132], ecx", + "mov DWORD PTR [ebx+136], ecx", + "mov DWORD PTR [ebx+140], ecx", + "mov DWORD PTR [ebx+144], ecx", + "mov DWORD PTR [ebx+148], ecx", + "mov DWORD PTR [ebx+152], ecx", + "mov DWORD PTR [ebx+156], ecx", + "mov DWORD PTR [ebx+160], ecx", + "mov DWORD PTR [ebx+164], ecx", + "mov DWORD PTR [ebx+168], ecx", + "mov DWORD PTR [ebx+172], ecx", + "mov DWORD PTR [ebx+176], ecx", + "mov DWORD PTR [ebx+180], ecx", + "mov DWORD PTR [ebx+184], ecx", + "mov DWORD PTR [ebx+188], ecx", + "mov edi, DWORD PTR [esp+12]", + "mov ecx, DWORD PTR [esp+16]", + "mov edx, ebx", + "add edx, 64", + "test ecx, ecx", "je 20f", "22:", - "mov eax, esi", - "add eax, ebx", - "movzx eax, BYTE PTR [eax]", - "mov ecx, eax", + "movzx eax, BYTE PTR [edi]", "xor eax, 54", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+288], al", - "xor ecx, 92", - "mov BYTE PTR [edx+416], cl", - "add ebx, 1", - "cmp ebx, edi", + "mov BYTE PTR [edx], al", + "add edi, 1", + "add edx, 1", + "sub ecx, 1", "jne 22b", "jmp 21f", "20:", "21:", - "mov eax, 54", - "mov ecx, 92", - "cmp ebx, 128", - "je 23f", - "25:", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+288], al", - "mov BYTE PTR [edx+416], cl", - "add ebx, 1", - "cmp ebx, 128", - "jne 25b", - "jmp 24f", - "23:", - "24:", - "mov ebx, DWORD PTR [esp+4]", - "mov esi, DWORD PTR [esp+8]", - "push ebx", - "call {vg_sha384_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 128", - "mov edx, ebp", - "add edx, 288", + "mov eax, DWORD PTR [ebx+64]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+64], eax", + "mov eax, DWORD PTR [ebx+68]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+68], eax", + "mov eax, DWORD PTR [ebx+72]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+72], eax", + "mov eax, DWORD PTR [ebx+76]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+76], eax", + "mov eax, DWORD PTR [ebx+80]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+80], eax", + "mov eax, DWORD PTR [ebx+84]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+84], eax", + "mov eax, DWORD PTR [ebx+88]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+88], eax", + "mov eax, DWORD PTR [ebx+92]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+92], eax", + "mov eax, DWORD PTR [ebx+96]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+96], eax", + "mov eax, DWORD PTR [ebx+100]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+100], eax", + "mov eax, DWORD PTR [ebx+104]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+104], eax", + "mov eax, DWORD PTR [ebx+108]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+108], eax", + "mov eax, DWORD PTR [ebx+112]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+112], eax", + "mov eax, DWORD PTR [ebx+116]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+116], eax", + "mov eax, DWORD PTR [ebx+120]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+120], eax", + "mov eax, DWORD PTR [ebx+124]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+124], eax", + "mov eax, DWORD PTR [ebx+128]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+128], eax", + "mov eax, DWORD PTR [ebx+132]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+132], eax", + "mov eax, DWORD PTR [ebx+136]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+136], eax", + "mov eax, DWORD PTR [ebx+140]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+140], eax", + "mov eax, DWORD PTR [ebx+144]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+144], eax", + "mov eax, DWORD PTR [ebx+148]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+148], eax", + "mov eax, DWORD PTR [ebx+152]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+152], eax", + "mov eax, DWORD PTR [ebx+156]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+156], eax", + "mov eax, DWORD PTR [ebx+160]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+160], eax", + "mov eax, DWORD PTR [ebx+164]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+164], eax", + "mov eax, DWORD PTR [ebx+168]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+168], eax", + "mov eax, DWORD PTR [ebx+172]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+172], eax", + "mov eax, DWORD PTR [ebx+176]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+176], eax", + "mov eax, DWORD PTR [ebx+180]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+180], eax", + "mov eax, DWORD PTR [ebx+184]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+184], eax", + "mov eax, DWORD PTR [ebx+188]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+188], eax", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", + "call {vg_sha512_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "push esi", - "call {vg_sha384_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 128", - "mov edx, ebp", - "add edx, 416", + "mov ebx, esi", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", - "push esi", - "call {vg_sha512_update}", - "pop eax", - "pop eax", + "push ebx", + "call {vg_sha512_compress}", "pop eax", "pop eax", "pop eax", @@ -115,7 +213,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha384_init(inner: *mut [u8; 192], outer "mov ebp, DWORD PTR [eax+284]", "ret", vg_sha384_init = sym super::sha512::vg_sha384_init, - vg_sha512_update = sym super::sha512::vg_sha512_update, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/x86/hmac_sha512.rs b/src/asm/x86/hmac_sha512.rs index a3731e699..f0e1d83b7 100644 --- a/src/asm/x86/hmac_sha512.rs +++ b/src/asm/x86/hmac_sha512.rs @@ -27,83 +27,181 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_init(inner: *mut [u8; 192], outer "mov DWORD PTR [eax+280], edi", "mov DWORD PTR [eax+284], ebp", "mov ebp, eax", - "mov esi, DWORD PTR [esp+12]", - "mov edi, DWORD PTR [esp+16]", - "mov ebx, 0", - "test edi, edi", + "mov ebx, DWORD PTR [esp+4]", + "mov esi, DWORD PTR [esp+8]", + "push ebx", + "call {vg_sha512_init}", + "pop eax", + "push esi", + "call {vg_sha512_init}", + "pop eax", + "mov ecx, 909522486", + "mov DWORD PTR [ebx+64], ecx", + "mov DWORD PTR [ebx+68], ecx", + "mov DWORD PTR [ebx+72], ecx", + "mov DWORD PTR [ebx+76], ecx", + "mov DWORD PTR [ebx+80], ecx", + "mov DWORD PTR [ebx+84], ecx", + "mov DWORD PTR [ebx+88], ecx", + "mov DWORD PTR [ebx+92], ecx", + "mov DWORD PTR [ebx+96], ecx", + "mov DWORD PTR [ebx+100], ecx", + "mov DWORD PTR [ebx+104], ecx", + "mov DWORD PTR [ebx+108], ecx", + "mov DWORD PTR [ebx+112], ecx", + "mov DWORD PTR [ebx+116], ecx", + "mov DWORD PTR [ebx+120], ecx", + "mov DWORD PTR [ebx+124], ecx", + "mov DWORD PTR [ebx+128], ecx", + "mov DWORD PTR [ebx+132], ecx", + "mov DWORD PTR [ebx+136], ecx", + "mov DWORD PTR [ebx+140], ecx", + "mov DWORD PTR [ebx+144], ecx", + "mov DWORD PTR [ebx+148], ecx", + "mov DWORD PTR [ebx+152], ecx", + "mov DWORD PTR [ebx+156], ecx", + "mov DWORD PTR [ebx+160], ecx", + "mov DWORD PTR [ebx+164], ecx", + "mov DWORD PTR [ebx+168], ecx", + "mov DWORD PTR [ebx+172], ecx", + "mov DWORD PTR [ebx+176], ecx", + "mov DWORD PTR [ebx+180], ecx", + "mov DWORD PTR [ebx+184], ecx", + "mov DWORD PTR [ebx+188], ecx", + "mov edi, DWORD PTR [esp+12]", + "mov ecx, DWORD PTR [esp+16]", + "mov edx, ebx", + "add edx, 64", + "test ecx, ecx", "je 20f", "22:", - "mov eax, esi", - "add eax, ebx", - "movzx eax, BYTE PTR [eax]", - "mov ecx, eax", + "movzx eax, BYTE PTR [edi]", "xor eax, 54", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+288], al", - "xor ecx, 92", - "mov BYTE PTR [edx+416], cl", - "add ebx, 1", - "cmp ebx, edi", + "mov BYTE PTR [edx], al", + "add edi, 1", + "add edx, 1", + "sub ecx, 1", "jne 22b", "jmp 21f", "20:", "21:", - "mov eax, 54", - "mov ecx, 92", - "cmp ebx, 128", - "je 23f", - "25:", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+288], al", - "mov BYTE PTR [edx+416], cl", - "add ebx, 1", - "cmp ebx, 128", - "jne 25b", - "jmp 24f", - "23:", - "24:", - "mov ebx, DWORD PTR [esp+4]", - "mov esi, DWORD PTR [esp+8]", - "push ebx", - "call {vg_sha512_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 128", - "mov edx, ebp", - "add edx, 288", + "mov eax, DWORD PTR [ebx+64]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+64], eax", + "mov eax, DWORD PTR [ebx+68]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+68], eax", + "mov eax, DWORD PTR [ebx+72]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+72], eax", + "mov eax, DWORD PTR [ebx+76]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+76], eax", + "mov eax, DWORD PTR [ebx+80]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+80], eax", + "mov eax, DWORD PTR [ebx+84]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+84], eax", + "mov eax, DWORD PTR [ebx+88]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+88], eax", + "mov eax, DWORD PTR [ebx+92]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+92], eax", + "mov eax, DWORD PTR [ebx+96]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+96], eax", + "mov eax, DWORD PTR [ebx+100]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+100], eax", + "mov eax, DWORD PTR [ebx+104]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+104], eax", + "mov eax, DWORD PTR [ebx+108]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+108], eax", + "mov eax, DWORD PTR [ebx+112]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+112], eax", + "mov eax, DWORD PTR [ebx+116]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+116], eax", + "mov eax, DWORD PTR [ebx+120]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+120], eax", + "mov eax, DWORD PTR [ebx+124]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+124], eax", + "mov eax, DWORD PTR [ebx+128]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+128], eax", + "mov eax, DWORD PTR [ebx+132]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+132], eax", + "mov eax, DWORD PTR [ebx+136]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+136], eax", + "mov eax, DWORD PTR [ebx+140]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+140], eax", + "mov eax, DWORD PTR [ebx+144]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+144], eax", + "mov eax, DWORD PTR [ebx+148]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+148], eax", + "mov eax, DWORD PTR [ebx+152]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+152], eax", + "mov eax, DWORD PTR [ebx+156]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+156], eax", + "mov eax, DWORD PTR [ebx+160]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+160], eax", + "mov eax, DWORD PTR [ebx+164]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+164], eax", + "mov eax, DWORD PTR [ebx+168]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+168], eax", + "mov eax, DWORD PTR [ebx+172]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+172], eax", + "mov eax, DWORD PTR [ebx+176]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+176], eax", + "mov eax, DWORD PTR [ebx+180]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+180], eax", + "mov eax, DWORD PTR [ebx+184]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+184], eax", + "mov eax, DWORD PTR [ebx+188]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+188], eax", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", + "call {vg_sha512_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "push esi", - "call {vg_sha512_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 128", - "mov edx, ebp", - "add edx, 416", + "mov ebx, esi", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", - "push esi", - "call {vg_sha512_update}", - "pop eax", - "pop eax", + "push ebx", + "call {vg_sha512_compress}", "pop eax", "pop eax", "pop eax", @@ -115,7 +213,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_init(inner: *mut [u8; 192], outer "mov ebp, DWORD PTR [eax+284]", "ret", vg_sha512_init = sym super::sha512::vg_sha512_init, - vg_sha512_update = sym super::sha512::vg_sha512_update, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/x86/hmac_sha512_224.rs b/src/asm/x86/hmac_sha512_224.rs index c830ca8aa..fce59562d 100644 --- a/src/asm/x86/hmac_sha512_224.rs +++ b/src/asm/x86/hmac_sha512_224.rs @@ -27,83 +27,181 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_224_init(inner: *mut [u8; 192], o "mov DWORD PTR [eax+280], edi", "mov DWORD PTR [eax+284], ebp", "mov ebp, eax", - "mov esi, DWORD PTR [esp+12]", - "mov edi, DWORD PTR [esp+16]", - "mov ebx, 0", - "test edi, edi", + "mov ebx, DWORD PTR [esp+4]", + "mov esi, DWORD PTR [esp+8]", + "push ebx", + "call {vg_sha512_224_init}", + "pop eax", + "push esi", + "call {vg_sha512_224_init}", + "pop eax", + "mov ecx, 909522486", + "mov DWORD PTR [ebx+64], ecx", + "mov DWORD PTR [ebx+68], ecx", + "mov DWORD PTR [ebx+72], ecx", + "mov DWORD PTR [ebx+76], ecx", + "mov DWORD PTR [ebx+80], ecx", + "mov DWORD PTR [ebx+84], ecx", + "mov DWORD PTR [ebx+88], ecx", + "mov DWORD PTR [ebx+92], ecx", + "mov DWORD PTR [ebx+96], ecx", + "mov DWORD PTR [ebx+100], ecx", + "mov DWORD PTR [ebx+104], ecx", + "mov DWORD PTR [ebx+108], ecx", + "mov DWORD PTR [ebx+112], ecx", + "mov DWORD PTR [ebx+116], ecx", + "mov DWORD PTR [ebx+120], ecx", + "mov DWORD PTR [ebx+124], ecx", + "mov DWORD PTR [ebx+128], ecx", + "mov DWORD PTR [ebx+132], ecx", + "mov DWORD PTR [ebx+136], ecx", + "mov DWORD PTR [ebx+140], ecx", + "mov DWORD PTR [ebx+144], ecx", + "mov DWORD PTR [ebx+148], ecx", + "mov DWORD PTR [ebx+152], ecx", + "mov DWORD PTR [ebx+156], ecx", + "mov DWORD PTR [ebx+160], ecx", + "mov DWORD PTR [ebx+164], ecx", + "mov DWORD PTR [ebx+168], ecx", + "mov DWORD PTR [ebx+172], ecx", + "mov DWORD PTR [ebx+176], ecx", + "mov DWORD PTR [ebx+180], ecx", + "mov DWORD PTR [ebx+184], ecx", + "mov DWORD PTR [ebx+188], ecx", + "mov edi, DWORD PTR [esp+12]", + "mov ecx, DWORD PTR [esp+16]", + "mov edx, ebx", + "add edx, 64", + "test ecx, ecx", "je 20f", "22:", - "mov eax, esi", - "add eax, ebx", - "movzx eax, BYTE PTR [eax]", - "mov ecx, eax", + "movzx eax, BYTE PTR [edi]", "xor eax, 54", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+288], al", - "xor ecx, 92", - "mov BYTE PTR [edx+416], cl", - "add ebx, 1", - "cmp ebx, edi", + "mov BYTE PTR [edx], al", + "add edi, 1", + "add edx, 1", + "sub ecx, 1", "jne 22b", "jmp 21f", "20:", "21:", - "mov eax, 54", - "mov ecx, 92", - "cmp ebx, 128", - "je 23f", - "25:", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+288], al", - "mov BYTE PTR [edx+416], cl", - "add ebx, 1", - "cmp ebx, 128", - "jne 25b", - "jmp 24f", - "23:", - "24:", - "mov ebx, DWORD PTR [esp+4]", - "mov esi, DWORD PTR [esp+8]", - "push ebx", - "call {vg_sha512_224_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 128", - "mov edx, ebp", - "add edx, 288", + "mov eax, DWORD PTR [ebx+64]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+64], eax", + "mov eax, DWORD PTR [ebx+68]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+68], eax", + "mov eax, DWORD PTR [ebx+72]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+72], eax", + "mov eax, DWORD PTR [ebx+76]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+76], eax", + "mov eax, DWORD PTR [ebx+80]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+80], eax", + "mov eax, DWORD PTR [ebx+84]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+84], eax", + "mov eax, DWORD PTR [ebx+88]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+88], eax", + "mov eax, DWORD PTR [ebx+92]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+92], eax", + "mov eax, DWORD PTR [ebx+96]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+96], eax", + "mov eax, DWORD PTR [ebx+100]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+100], eax", + "mov eax, DWORD PTR [ebx+104]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+104], eax", + "mov eax, DWORD PTR [ebx+108]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+108], eax", + "mov eax, DWORD PTR [ebx+112]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+112], eax", + "mov eax, DWORD PTR [ebx+116]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+116], eax", + "mov eax, DWORD PTR [ebx+120]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+120], eax", + "mov eax, DWORD PTR [ebx+124]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+124], eax", + "mov eax, DWORD PTR [ebx+128]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+128], eax", + "mov eax, DWORD PTR [ebx+132]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+132], eax", + "mov eax, DWORD PTR [ebx+136]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+136], eax", + "mov eax, DWORD PTR [ebx+140]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+140], eax", + "mov eax, DWORD PTR [ebx+144]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+144], eax", + "mov eax, DWORD PTR [ebx+148]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+148], eax", + "mov eax, DWORD PTR [ebx+152]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+152], eax", + "mov eax, DWORD PTR [ebx+156]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+156], eax", + "mov eax, DWORD PTR [ebx+160]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+160], eax", + "mov eax, DWORD PTR [ebx+164]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+164], eax", + "mov eax, DWORD PTR [ebx+168]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+168], eax", + "mov eax, DWORD PTR [ebx+172]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+172], eax", + "mov eax, DWORD PTR [ebx+176]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+176], eax", + "mov eax, DWORD PTR [ebx+180]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+180], eax", + "mov eax, DWORD PTR [ebx+184]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+184], eax", + "mov eax, DWORD PTR [ebx+188]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+188], eax", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", + "call {vg_sha512_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "push esi", - "call {vg_sha512_224_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 128", - "mov edx, ebp", - "add edx, 416", + "mov ebx, esi", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", - "push esi", - "call {vg_sha512_update}", - "pop eax", - "pop eax", + "push ebx", + "call {vg_sha512_compress}", "pop eax", "pop eax", "pop eax", @@ -115,7 +213,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_224_init(inner: *mut [u8; 192], o "mov ebp, DWORD PTR [eax+284]", "ret", vg_sha512_224_init = sym super::sha512::vg_sha512_224_init, - vg_sha512_update = sym super::sha512::vg_sha512_update, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/x86/hmac_sha512_256.rs b/src/asm/x86/hmac_sha512_256.rs index 3f688167c..439790f10 100644 --- a/src/asm/x86/hmac_sha512_256.rs +++ b/src/asm/x86/hmac_sha512_256.rs @@ -27,83 +27,181 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_256_init(inner: *mut [u8; 192], o "mov DWORD PTR [eax+280], edi", "mov DWORD PTR [eax+284], ebp", "mov ebp, eax", - "mov esi, DWORD PTR [esp+12]", - "mov edi, DWORD PTR [esp+16]", - "mov ebx, 0", - "test edi, edi", + "mov ebx, DWORD PTR [esp+4]", + "mov esi, DWORD PTR [esp+8]", + "push ebx", + "call {vg_sha512_256_init}", + "pop eax", + "push esi", + "call {vg_sha512_256_init}", + "pop eax", + "mov ecx, 909522486", + "mov DWORD PTR [ebx+64], ecx", + "mov DWORD PTR [ebx+68], ecx", + "mov DWORD PTR [ebx+72], ecx", + "mov DWORD PTR [ebx+76], ecx", + "mov DWORD PTR [ebx+80], ecx", + "mov DWORD PTR [ebx+84], ecx", + "mov DWORD PTR [ebx+88], ecx", + "mov DWORD PTR [ebx+92], ecx", + "mov DWORD PTR [ebx+96], ecx", + "mov DWORD PTR [ebx+100], ecx", + "mov DWORD PTR [ebx+104], ecx", + "mov DWORD PTR [ebx+108], ecx", + "mov DWORD PTR [ebx+112], ecx", + "mov DWORD PTR [ebx+116], ecx", + "mov DWORD PTR [ebx+120], ecx", + "mov DWORD PTR [ebx+124], ecx", + "mov DWORD PTR [ebx+128], ecx", + "mov DWORD PTR [ebx+132], ecx", + "mov DWORD PTR [ebx+136], ecx", + "mov DWORD PTR [ebx+140], ecx", + "mov DWORD PTR [ebx+144], ecx", + "mov DWORD PTR [ebx+148], ecx", + "mov DWORD PTR [ebx+152], ecx", + "mov DWORD PTR [ebx+156], ecx", + "mov DWORD PTR [ebx+160], ecx", + "mov DWORD PTR [ebx+164], ecx", + "mov DWORD PTR [ebx+168], ecx", + "mov DWORD PTR [ebx+172], ecx", + "mov DWORD PTR [ebx+176], ecx", + "mov DWORD PTR [ebx+180], ecx", + "mov DWORD PTR [ebx+184], ecx", + "mov DWORD PTR [ebx+188], ecx", + "mov edi, DWORD PTR [esp+12]", + "mov ecx, DWORD PTR [esp+16]", + "mov edx, ebx", + "add edx, 64", + "test ecx, ecx", "je 20f", "22:", - "mov eax, esi", - "add eax, ebx", - "movzx eax, BYTE PTR [eax]", - "mov ecx, eax", + "movzx eax, BYTE PTR [edi]", "xor eax, 54", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+288], al", - "xor ecx, 92", - "mov BYTE PTR [edx+416], cl", - "add ebx, 1", - "cmp ebx, edi", + "mov BYTE PTR [edx], al", + "add edi, 1", + "add edx, 1", + "sub ecx, 1", "jne 22b", "jmp 21f", "20:", "21:", - "mov eax, 54", - "mov ecx, 92", - "cmp ebx, 128", - "je 23f", - "25:", - "mov edx, ebp", - "add edx, ebx", - "mov BYTE PTR [edx+288], al", - "mov BYTE PTR [edx+416], cl", - "add ebx, 1", - "cmp ebx, 128", - "jne 25b", - "jmp 24f", - "23:", - "24:", - "mov ebx, DWORD PTR [esp+4]", - "mov esi, DWORD PTR [esp+8]", - "push ebx", - "call {vg_sha512_256_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 128", - "mov edx, ebp", - "add edx, 288", + "mov eax, DWORD PTR [ebx+64]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+64], eax", + "mov eax, DWORD PTR [ebx+68]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+68], eax", + "mov eax, DWORD PTR [ebx+72]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+72], eax", + "mov eax, DWORD PTR [ebx+76]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+76], eax", + "mov eax, DWORD PTR [ebx+80]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+80], eax", + "mov eax, DWORD PTR [ebx+84]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+84], eax", + "mov eax, DWORD PTR [ebx+88]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+88], eax", + "mov eax, DWORD PTR [ebx+92]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+92], eax", + "mov eax, DWORD PTR [ebx+96]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+96], eax", + "mov eax, DWORD PTR [ebx+100]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+100], eax", + "mov eax, DWORD PTR [ebx+104]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+104], eax", + "mov eax, DWORD PTR [ebx+108]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+108], eax", + "mov eax, DWORD PTR [ebx+112]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+112], eax", + "mov eax, DWORD PTR [ebx+116]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+116], eax", + "mov eax, DWORD PTR [ebx+120]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+120], eax", + "mov eax, DWORD PTR [ebx+124]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+124], eax", + "mov eax, DWORD PTR [ebx+128]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+128], eax", + "mov eax, DWORD PTR [ebx+132]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+132], eax", + "mov eax, DWORD PTR [ebx+136]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+136], eax", + "mov eax, DWORD PTR [ebx+140]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+140], eax", + "mov eax, DWORD PTR [ebx+144]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+144], eax", + "mov eax, DWORD PTR [ebx+148]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+148], eax", + "mov eax, DWORD PTR [ebx+152]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+152], eax", + "mov eax, DWORD PTR [ebx+156]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+156], eax", + "mov eax, DWORD PTR [ebx+160]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+160], eax", + "mov eax, DWORD PTR [ebx+164]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+164], eax", + "mov eax, DWORD PTR [ebx+168]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+168], eax", + "mov eax, DWORD PTR [ebx+172]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+172], eax", + "mov eax, DWORD PTR [ebx+176]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+176], eax", + "mov eax, DWORD PTR [ebx+180]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+180], eax", + "mov eax, DWORD PTR [ebx+184]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+184], eax", + "mov eax, DWORD PTR [ebx+188]", + "xor eax, 1785358954", + "mov DWORD PTR [esi+188], eax", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", + "call {vg_sha512_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "push esi", - "call {vg_sha512_256_init}", - "pop eax", - "mov eax, 0", - "mov edi, 0", - "mov ecx, 128", - "mov edx, ebp", - "add edx, 416", + "mov ebx, esi", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push edi", - "push esi", - "call {vg_sha512_update}", - "pop eax", - "pop eax", + "push ebx", + "call {vg_sha512_compress}", "pop eax", "pop eax", "pop eax", @@ -115,7 +213,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_256_init(inner: *mut [u8; 192], o "mov ebp, DWORD PTR [eax+284]", "ret", vg_sha512_256_init = sym super::sha512::vg_sha512_256_init, - vg_sha512_update = sym super::sha512::vg_sha512_update, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) }