From 825a7a007cf7c7dd1a73982464b625ac4ec90e5e Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 2 Oct 2026 05:25:23 +0000 Subject: [PATCH 1/9] HMAC finalize and PBKDF2 iterate on ARMv7 call the compression function (MD5, SHA-1, SHA-224, SHA-384, SHA-512, SHA-512/224, SHA-512/256) Port the compression-level design of x86-64 and AArch64 to 32-bit ARM for every Merkle-Damgard hash function but SHA-256 (which keeps its own code). New `Impl/Pbkdf2/Md/Arm.lean` (`Hash`: the streaming `Hash` plus the hash value size N, the length field L, byte order, compression scratch offset, digest-writing code and compression function): * PBKDF2 `iterate` lays out the message block once in scratch (U || 0x80 || zeros || the length of B + D bytes, as word stores). Each step copies the key's inner hash value into scratch word-wise, compresses the block once, writes the digest back over U (restoring the padding it overwrites when N > D), does the same with the outer hash value, and XORs U into T word-wise. Two compressions per step, no calls of update or finalize, no byte loops. * HMAC `finalize` calls the streaming finalize for the inner hash, then copies the outer hash value word-wise, pads the digest into a fixed block with word stores, compresses it once and writes the digest to out (via scratch and a word copy when D < N). Proofs (`Proof/Pbkdf2/Md/Arm/`), once for every hash function, against the `iterG`/`finG` contracts at 16 bytes of stack, moved to the shared `Spec.Hmac.*I.iterateContract`/`finalizeContract`: correctness against `Proof.MdStream.Md` (`Iterate.lean`, `HmacFin.lean`, with the target-independent `Md.iterate_hmac` and `Md.hmac_outer` in `Proof/Pbkdf2/MdStep.lean`); constant time with RelCT, the code between calls by `taint_decide` and the calls by `compressBlock_rel` and `fin_rel` (`IterateCT.lean`, `HmacFinCT.lean`); and the instances (`Instances.lean`, `Sha224.lean`). The whole `vg_pbkdf2_hmac_` (#564) now calls the new functions (`Proof/Pbkdf2/Whole/Arm/Instances.lean` and `Sha224.lean`, `fnsOf`). Deleted the streaming-level generic `iterate` and `finalize` on ARMv7 (`Impl/Pbkdf2/Generic/Arm.lean`, `Proof/Pbkdf2/Generic/Arm/`, `Proof/Hmac/Generic/Arm/Finalize.lean`, `finalize` in `Impl/Hmac/Generic/Arm.lean`); HMAC `init` is unchanged. No changes to TCB/ or Spec/. Instructions per PBKDF2 iteration on ARMv7 (counted by emulating the generated code; compressions included): MD5 3472 -> 1378 SHA-1 5494 -> 3296 SHA-224 7256 -> 4812 SHA-384 22554 -> 18006 SHA-512 22762 -> 18010 SHA-512/224 22294 -> 17996 SHA-512/256 22346 -> 17998 HMAC finalize (20-byte message): SHA-1 4679 -> 3542, SHA-512 21023 -> 18486. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01RjfTK5YMk2jDsiKRYs2dbn --- .../Artifacts/HmacMd5/Arm.lean | 19 +- .../Artifacts/HmacSha1/Arm.lean | 19 +- .../Artifacts/HmacSha224/Arm.lean | 19 +- .../Artifacts/HmacSha384/Arm.lean | 19 +- .../Artifacts/HmacSha512/Arm.lean | 19 +- .../Artifacts/HmacSha512_224/Arm.lean | 19 +- .../Artifacts/HmacSha512_256/Arm.lean | 19 +- .../Artifacts/Pbkdf2Md5/Arm.lean | 20 +- .../Artifacts/Pbkdf2Sha1/Arm.lean | 20 +- .../Artifacts/Pbkdf2Sha224/Arm.lean | 20 +- .../Artifacts/Pbkdf2Sha384/Arm.lean | 20 +- .../Artifacts/Pbkdf2Sha512/Arm.lean | 20 +- .../Artifacts/Pbkdf2Sha512_224/Arm.lean | 20 +- .../Artifacts/Pbkdf2Sha512_256/Arm.lean | 20 +- .../Impl/Hmac/Generic/Arm.lean | 33 +- .../Impl/Pbkdf2/Generic/Arm.lean | 72 - .../Impl/Pbkdf2/Generic/X86.lean | 3 +- lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean | 196 +++ .../Proof/Hmac/Generic/Arm/Finalize.lean | 497 ------- .../Proof/Hmac/Generic/Arm/Hash.lean | 2 +- .../Proof/Hmac/Generic/Arm/Instances.lean | 251 ---- .../Proof/Hmac/Generic/Arm/Sha224.lean | 12 - .../Proof/Hmac/Generic/X86/Finalize.lean | 2 +- .../Proof/Hmac/Generic/X86/Instances.lean | 2 +- .../Proof/Pbkdf2/Generic/Arm/Instances.lean | 1184 ----------------- .../Proof/Pbkdf2/Generic/Arm/Sha224.lean | 42 - .../Proof/Pbkdf2/Generic/X86/Instances.lean | 4 +- .../Proof/Pbkdf2/Generic/X86/Iterate.lean | 4 +- .../Proof/Pbkdf2/Generic/X86/IterateCT.lean | 4 +- .../Proof/Pbkdf2/Md/Arm/Compress.lean | 188 +++ .../Proof/Pbkdf2/Md/Arm/Hash.lean | 98 ++ .../Proof/Pbkdf2/Md/Arm/HmacFin.lean | 677 ++++++++++ .../Proof/Pbkdf2/Md/Arm/HmacFinCT.lean | 164 +++ .../Proof/Pbkdf2/Md/Arm/Instances.lean | 333 +++++ .../Proof/Pbkdf2/Md/Arm/Iterate.lean | 820 ++++++++++++ .../Proof/Pbkdf2/Md/Arm/IterateCT.lean | 264 ++++ .../Proof/Pbkdf2/Md/Arm/Sha224.lean | 85 ++ .../Proof/Pbkdf2/Md/Arm/Sha512.lean | 110 ++ .../Proof/Pbkdf2/Md/Arm/Words.lean | 325 +++++ lean/VerifiedGarbage/Proof/Pbkdf2/MdStep.lean | 27 + .../Proof/Pbkdf2/Whole/Arm/Instances.lean | 54 +- .../Proof/Pbkdf2/Whole/Arm/Sha224.lean | 8 +- src/asm/arm/hmac_md5.rs | 88 +- src/asm/arm/hmac_sha1.rs | 96 +- src/asm/arm/hmac_sha224.rs | 122 +- src/asm/arm/hmac_sha384.rs | 187 ++- src/asm/arm/hmac_sha512.rs | 160 ++- src/asm/arm/hmac_sha512_224.rs | 182 ++- src/asm/arm/hmac_sha512_256.rs | 183 ++- src/asm/arm/pbkdf2_md5.rs | 188 +-- src/asm/arm/pbkdf2_sha1.rs | 211 +-- src/asm/arm/pbkdf2_sha224.rs | 257 ++-- src/asm/arm/pbkdf2_sha384.rs | 388 ++++-- src/asm/arm/pbkdf2_sha512.rs | 396 ++++-- src/asm/arm/pbkdf2_sha512_224.rs | 373 ++++-- src/asm/arm/pbkdf2_sha512_256.rs | 376 ++++-- 56 files changed, 5738 insertions(+), 3203 deletions(-) delete mode 100644 lean/VerifiedGarbage/Impl/Pbkdf2/Generic/Arm.lean create mode 100644 lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Finalize.lean delete mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Generic/Arm/Instances.lean delete mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Generic/Arm/Sha224.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Compress.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Hash.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFin.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFinCT.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Iterate.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/IterateCT.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha512.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Words.lean diff --git a/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean index 731656186..3e1a0f2a0 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # HMAC-MD5 (RFC 2104) on ARMv7 @@ -14,9 +14,16 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling MD5's verified `init`, `update` -and `finalize`. +`init` is the one HMAC implementation for every streaming hash function +(`Impl/Hmac/Generic/Arm.lean`), calling MD5's verified streaming `init` and +`update`. + +`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. -/ namespace VG.Artifacts.HmacMd5.Arm @@ -36,11 +43,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.md5I.finalizeApi with target := Arm.target doc := Spec.Hmac.md5I.finalizeApi.doc - code := md5H.finalize + code := Proof.Pbkdf2.Md.Arm.md5Md.hmacFin contract := Spec.Hmac.md5I.finalizeContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ stack := 16 - verified := Instances.md5_finalize + verified := Proof.Pbkdf2.Md.Arm.Instances.md5_finalize spSafe := Code.all_of_forall (fun _ => rfl) _ }] end VG.Artifacts.HmacMd5.Arm diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean index e6369b751..b1880946f 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # HMAC-SHA-1 (RFC 2104) on ARMv7 @@ -14,9 +14,16 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-1's verified `init`, `update` -and `finalize`. +`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`. + +`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. -/ namespace VG.Artifacts.HmacSha1.Arm @@ -36,11 +43,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha1I.finalizeApi with target := Arm.target doc := Spec.Hmac.sha1I.finalizeApi.doc - code := sha1H.finalize + code := Proof.Pbkdf2.Md.Arm.sha1Md.hmacFin contract := Spec.Hmac.sha1I.finalizeContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ stack := 16 - verified := Instances.sha1_finalize + verified := Proof.Pbkdf2.Md.Arm.Instances.sha1_finalize spSafe := Code.all_of_forall (fun _ => rfl) _ }] end VG.Artifacts.HmacSha1.Arm diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean index bda4973bb..19d19cbe3 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Sha224 +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Sha224 /-! # HMAC-SHA-224 (RFC 2104) on ARMv7 @@ -14,9 +14,16 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-224's verified `init` and -SHA-256's `update` and `finalize`. +`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`. + +`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. -/ namespace VG.Artifacts.HmacSha224.Arm @@ -37,12 +44,12 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha224I.finalizeApi with target := Arm.target doc := Spec.Hmac.sha224I.finalizeApi.doc - code := sha224H.finalize + code := Proof.Pbkdf2.Md.Arm.sha224Md.hmacFin contract := Spec.Hmac.sha224I.finalizeContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ writeArgs := true stack := 16 - verified := Instances.sha224_finalize + verified := Proof.Pbkdf2.Md.Arm.Instances.sha224_finalize spSafe := Code.all_of_forall (fun _ => rfl) _ }] end VG.Artifacts.HmacSha224.Arm diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean index 3ea4c1a25..eafbe897a 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # HMAC-SHA-384 (RFC 2104) on ARMv7 @@ -14,9 +14,16 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-384's verified `init`, `update` -and `finalize`. +`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`. + +`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. -/ namespace VG.Artifacts.HmacSha384.Arm @@ -36,11 +43,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha384I.finalizeApi with target := Arm.target doc := Spec.Hmac.sha384I.finalizeApi.doc - code := sha384H.finalize + code := Proof.Pbkdf2.Md.Arm.sha384Md.hmacFin contract := Spec.Hmac.sha384I.finalizeContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ stack := 16 - verified := Instances.sha384_finalize + verified := Proof.Pbkdf2.Md.Arm.Instances.sha384_finalize spSafe := Code.all_of_forall (fun _ => rfl) _ }] end VG.Artifacts.HmacSha384.Arm diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean index 21500aa52..0a7ba21b4 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # HMAC-SHA-512 (RFC 2104) on ARMv7 @@ -14,9 +14,16 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-512's verified `init`, `update` -and `finalize`. +`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`. + +`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. -/ namespace VG.Artifacts.HmacSha512.Arm @@ -36,11 +43,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha512I.finalizeApi with target := Arm.target doc := Spec.Hmac.sha512I.finalizeApi.doc - code := sha512H'.finalize + code := Proof.Pbkdf2.Md.Arm.sha512Md'.hmacFin contract := Spec.Hmac.sha512I.finalizeContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ stack := 16 - verified := Instances.sha512_finalize + verified := Proof.Pbkdf2.Md.Arm.Instances.sha512_finalize spSafe := Code.all_of_forall (fun _ => rfl) _ }] end VG.Artifacts.HmacSha512.Arm diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean index fb75a7a91..46f032ba8 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # HMAC-SHA-512/224 (RFC 2104) on ARMv7 @@ -14,9 +14,16 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-512/224's verified `init`, `update` -and `finalize`. +`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`. + +`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. -/ namespace VG.Artifacts.HmacSha512_224.Arm @@ -36,11 +43,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha512_224I.finalizeApi with target := Arm.target doc := Spec.Hmac.sha512_224I.finalizeApi.doc - code := sha512_224H.finalize + code := Proof.Pbkdf2.Md.Arm.sha512_224Md.hmacFin contract := Spec.Hmac.sha512_224I.finalizeContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ stack := 16 - verified := Instances.sha512_224_finalize + verified := Proof.Pbkdf2.Md.Arm.Instances.sha512_224_finalize spSafe := Code.all_of_forall (fun _ => rfl) _ }] end VG.Artifacts.HmacSha512_224.Arm diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean index 490508503..85cd1940a 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # HMAC-SHA-512/256 (RFC 2104) on ARMv7 @@ -14,9 +14,16 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/Arm.lean`), calling SHA-512/256's verified `init`, `update` -and `finalize`. +`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`. + +`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. -/ namespace VG.Artifacts.HmacSha512_256.Arm @@ -36,11 +43,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha512_256I.finalizeApi with target := Arm.target doc := Spec.Hmac.sha512_256I.finalizeApi.doc - code := sha512_256H.finalize + code := Proof.Pbkdf2.Md.Arm.sha512_256Md.hmacFin contract := Spec.Hmac.sha512_256I.finalizeContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ stack := 16 - verified := Instances.sha512_256_finalize + verified := Proof.Pbkdf2.Md.Arm.Instances.sha512_256_finalize spSafe := Code.all_of_forall (fun _ => rfl) _ }] end VG.Artifacts.HmacSha512_256.Arm diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Md5/Arm.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Md5/Arm.lean index b219588d7..c68458b33 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Md5/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Md5/Arm.lean @@ -1,5 +1,4 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.Arm.Instances import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Instances /-! @@ -15,31 +14,30 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/Arm.lean`), calling MD5's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`): each step is two calls of MD5's verified +compression function (`vg_md5_compress`), on blocks laid out once at fixed +offsets in `scratch`. It uses no stack; `stack` is that of the shared +contract, 16 bytes. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/Arm.lean`), calling the hash function's streaming functions, HMAC's `init` and `finalize` and the iteration above. `stack` is -that of the shared contracts: 16 bytes for the iteration, and 24 for -`pbkdf2`, which pushes `update`'s 16 bytes of stack arguments, or 8 bytes -around a call of a function that uses 16. +that of the shared contract, 24 bytes: `pbkdf2` pushes `update`'s 16 bytes of +stack arguments, or 8 bytes around a call of a function that uses 16. -/ namespace VG.Artifacts.Pbkdf2Md5.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.md5I.iterateApi with target := Arm.target doc := Spec.Hmac.md5I.iterateApi.doc - code := Impl.Pbkdf2.Generic.Arm.iterate md5H + code := Proof.Pbkdf2.Md.Arm.md5Md.iterate contract := Spec.Hmac.md5I.iterateContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ stack := 16 - verified := Proof.Pbkdf2.Generic.Arm.Instances.md5 + verified := Proof.Pbkdf2.Md.Arm.Instances.md5_iterate spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.md5I.pbkdf2Api with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha1/Arm.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha1/Arm.lean index 78c5d2881..284ed6874 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha1/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha1/Arm.lean @@ -1,5 +1,4 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.Arm.Instances import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Instances /-! @@ -15,31 +14,30 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/Arm.lean`), calling SHA-1's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`): each step is two calls of SHA-1's verified +compression function (`vg_sha1_compress`), on blocks laid out once at fixed +offsets in `scratch`. It uses no stack; `stack` is that of the shared +contract, 16 bytes. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/Arm.lean`), calling the hash function's streaming functions, HMAC's `init` and `finalize` and the iteration above. `stack` is -that of the shared contracts: 16 bytes for the iteration, and 24 for -`pbkdf2`, which pushes `update`'s 16 bytes of stack arguments, or 8 bytes -around a call of a function that uses 16. +that of the shared contract, 24 bytes: `pbkdf2` pushes `update`'s 16 bytes of +stack arguments, or 8 bytes around a call of a function that uses 16. -/ namespace VG.Artifacts.Pbkdf2Sha1.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha1I.iterateApi with target := Arm.target doc := Spec.Hmac.sha1I.iterateApi.doc - code := Impl.Pbkdf2.Generic.Arm.iterate sha1H + code := Proof.Pbkdf2.Md.Arm.sha1Md.iterate contract := Spec.Hmac.sha1I.iterateContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ stack := 16 - verified := Proof.Pbkdf2.Generic.Arm.Instances.sha1 + verified := Proof.Pbkdf2.Md.Arm.Instances.sha1_iterate spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha1I.pbkdf2Api with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha224/Arm.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha224/Arm.lean index a2cf3aedc..99c604266 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha224/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha224/Arm.lean @@ -1,5 +1,4 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.Arm.Sha224 import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Sha224 /-! @@ -15,32 +14,31 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/Arm.lean`), calling SHA-256's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`): each step is two calls of SHA-256's verified +compression function (`vg_sha256_compress`), on blocks laid out once at fixed +offsets in `scratch`. It uses no stack; `stack` is that of the shared +contract, 16 bytes. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/Arm.lean`), calling the hash function's streaming functions, HMAC's `init` and `finalize` and the iteration above. `stack` is -that of the shared contracts: 16 bytes for the iteration, and 24 for -`pbkdf2`, which pushes `update`'s 16 bytes of stack arguments, or 8 bytes -around a call of a function that uses 16. +that of the shared contract, 24 bytes: `pbkdf2` pushes `update`'s 16 bytes of +stack arguments, or 8 bytes around a call of a function that uses 16. -/ namespace VG.Artifacts.Pbkdf2Sha224.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha224I.iterateApi with target := Arm.target doc := Spec.Hmac.sha224I.iterateApi.doc - code := Impl.Pbkdf2.Generic.Arm.iterate sha224H + code := Proof.Pbkdf2.Md.Arm.sha224Md.iterate contract := Spec.Hmac.sha224I.iterateContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ writeArgs := true stack := 16 - verified := Proof.Pbkdf2.Generic.Arm.Instances.sha224 + verified := Proof.Pbkdf2.Md.Arm.Instances.sha224_iterate spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha224I.pbkdf2Api with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha384/Arm.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha384/Arm.lean index f22422966..79449bed1 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha384/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha384/Arm.lean @@ -1,5 +1,4 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.Arm.Instances import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Instances /-! @@ -15,31 +14,30 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/Arm.lean`), calling SHA-384's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`): each step is two calls of SHA-512's verified +compression function (`vg_sha512_compress`), on blocks laid out once at fixed +offsets in `scratch`. It uses no stack; `stack` is that of the shared +contract, 16 bytes. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/Arm.lean`), calling the hash function's streaming functions, HMAC's `init` and `finalize` and the iteration above. `stack` is -that of the shared contracts: 16 bytes for the iteration, and 24 for -`pbkdf2`, which pushes `update`'s 16 bytes of stack arguments, or 8 bytes -around a call of a function that uses 16. +that of the shared contract, 24 bytes: `pbkdf2` pushes `update`'s 16 bytes of +stack arguments, or 8 bytes around a call of a function that uses 16. -/ namespace VG.Artifacts.Pbkdf2Sha384.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha384I.iterateApi with target := Arm.target doc := Spec.Hmac.sha384I.iterateApi.doc - code := Impl.Pbkdf2.Generic.Arm.iterate sha384H + code := Proof.Pbkdf2.Md.Arm.sha384Md.iterate contract := Spec.Hmac.sha384I.iterateContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ stack := 16 - verified := Proof.Pbkdf2.Generic.Arm.Instances.sha384 + verified := Proof.Pbkdf2.Md.Arm.Instances.sha384_iterate spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha384I.pbkdf2Api with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512/Arm.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512/Arm.lean index 89084a323..68421f472 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512/Arm.lean @@ -1,5 +1,4 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.Arm.Instances import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Instances /-! @@ -15,31 +14,30 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/Arm.lean`), calling SHA-512's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`): each step is two calls of SHA-512's verified +compression function (`vg_sha512_compress`), on blocks laid out once at fixed +offsets in `scratch`. It uses no stack; `stack` is that of the shared +contract, 16 bytes. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/Arm.lean`), calling the hash function's streaming functions, HMAC's `init` and `finalize` and the iteration above. `stack` is -that of the shared contracts: 16 bytes for the iteration, and 24 for -`pbkdf2`, which pushes `update`'s 16 bytes of stack arguments, or 8 bytes -around a call of a function that uses 16. +that of the shared contract, 24 bytes: `pbkdf2` pushes `update`'s 16 bytes of +stack arguments, or 8 bytes around a call of a function that uses 16. -/ namespace VG.Artifacts.Pbkdf2Sha512.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha512I.iterateApi with target := Arm.target doc := Spec.Hmac.sha512I.iterateApi.doc - code := Impl.Pbkdf2.Generic.Arm.iterate sha512H' + code := Proof.Pbkdf2.Md.Arm.sha512Md'.iterate contract := Spec.Hmac.sha512I.iterateContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ stack := 16 - verified := Proof.Pbkdf2.Generic.Arm.Instances.sha512 + verified := Proof.Pbkdf2.Md.Arm.Instances.sha512_iterate spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha512I.pbkdf2Api with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_224/Arm.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_224/Arm.lean index 21a14d651..7df477d1e 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_224/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_224/Arm.lean @@ -1,5 +1,4 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.Arm.Instances import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Instances /-! @@ -15,31 +14,30 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/Arm.lean`), calling SHA-512/224's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`): each step is two calls of SHA-512's verified +compression function (`vg_sha512_compress`), on blocks laid out once at fixed +offsets in `scratch`. It uses no stack; `stack` is that of the shared +contract, 16 bytes. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/Arm.lean`), calling the hash function's streaming functions, HMAC's `init` and `finalize` and the iteration above. `stack` is -that of the shared contracts: 16 bytes for the iteration, and 24 for -`pbkdf2`, which pushes `update`'s 16 bytes of stack arguments, or 8 bytes -around a call of a function that uses 16. +that of the shared contract, 24 bytes: `pbkdf2` pushes `update`'s 16 bytes of +stack arguments, or 8 bytes around a call of a function that uses 16. -/ namespace VG.Artifacts.Pbkdf2Sha512_224.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha512_224I.iterateApi with target := Arm.target doc := Spec.Hmac.sha512_224I.iterateApi.doc - code := Impl.Pbkdf2.Generic.Arm.iterate sha512_224H + code := Proof.Pbkdf2.Md.Arm.sha512_224Md.iterate contract := Spec.Hmac.sha512_224I.iterateContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ stack := 16 - verified := Proof.Pbkdf2.Generic.Arm.Instances.sha512_224 + verified := Proof.Pbkdf2.Md.Arm.Instances.sha512_224_iterate spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha512_224I.pbkdf2Api with target := Arm.target diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_256/Arm.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_256/Arm.lean index 3a62f6cd7..9703ec8b8 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_256/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_256/Arm.lean @@ -1,5 +1,4 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.Arm.Instances import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Instances /-! @@ -15,31 +14,30 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/Arm.lean`), calling SHA-512/256's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`): each step is two calls of SHA-512's verified +compression function (`vg_sha512_compress`), on blocks laid out once at fixed +offsets in `scratch`. It uses no stack; `stack` is that of the shared +contract, 16 bytes. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/Arm.lean`), calling the hash function's streaming functions, HMAC's `init` and `finalize` and the iteration above. `stack` is -that of the shared contracts: 16 bytes for the iteration, and 24 for -`pbkdf2`, which pushes `update`'s 16 bytes of stack arguments, or 8 bytes -around a call of a function that uses 16. +that of the shared contract, 24 bytes: `pbkdf2` pushes `update`'s 16 bytes of +stack arguments, or 8 bytes around a call of a function that uses 16. -/ namespace VG.Artifacts.Pbkdf2Sha512_256.Arm -open VG.Proof.Hmac.Generic.Arm - def artifacts : List Artifact := [ { Spec.Hmac.sha512_256I.iterateApi with target := Arm.target doc := Spec.Hmac.sha512_256I.iterateApi.doc - code := Impl.Pbkdf2.Generic.Arm.iterate sha512_256H + code := Proof.Pbkdf2.Md.Arm.sha512_256Md.iterate contract := Spec.Hmac.sha512_256I.iterateContract Arm.abi 16 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ stack := 16 - verified := Proof.Pbkdf2.Generic.Arm.Instances.sha512_256 + verified := Proof.Pbkdf2.Md.Arm.Instances.sha512_256_iterate spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha512_256I.pbkdf2Api with target := Arm.target diff --git a/lean/VerifiedGarbage/Impl/Hmac/Generic/Arm.lean b/lean/VerifiedGarbage/Impl/Hmac/Generic/Arm.lean index 143912669..3f1b666a2 100644 --- a/lean/VerifiedGarbage/Impl/Hmac/Generic/Arm.lean +++ b/lean/VerifiedGarbage/Impl/Hmac/Generic/Arm.lean @@ -3,18 +3,20 @@ import VerifiedGarbage.TCB.Arm.Isa /-! # HMAC over any streaming hash function: 32-bit ARM implementation -The same algorithm as on x86-64 and AArch64 (`VG.Impl.Hmac.Generic.X86_64`, +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`, `update` and `finalize` it calls (`Hash`): +`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`. -* `finalize(inner = r0, outer = r1, count = r2:r3, out = [sp], - scratch = [sp, #4])` finalizes the inner state into `scratch`, copies the - outer state over the inner one, absorbs the inner digest into it with - `update`, and finalizes it again; the MAC is copied to `out`. + +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`). `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 @@ -143,25 +145,6 @@ def init : Prog isa := (.seq (H.callUpd [.mov .r0 (.reg .r5)] 0 (H.buf + H.B) H.B) (.block H.restore))))) -/-! ## `finalize` - -Registers: `r4` = `inner`, `r5` = `outer`, `r6` = `out`, `r11` = `scratch`, -`r8` = the byte index, `r9` = the bytes left. `count` stays in `r2:r3` until -the first call. The digests are written to `scratch + buf`. -/ - -def finPrologue : List Instr := - [.ldrSp .r12 4] ++ H.save ++ [.mov .r4 (.reg .r0), .mov .r5 (.reg .r1), .ldrSp .r6 0, - .mov .r11 (.reg .r12)] - -def finalize : Prog isa := - .seq (.block H.finPrologue) - (.seq (H.callFin [.mov .r0 (.reg .r4)] [] H.buf) - (.seq (copy .r5 0 .r4 0 H.S) - (.seq (H.callUpd [.mov .r0 (.reg .r4)] H.B H.buf H.D) - (.seq (H.callFin [.mov .r0 (.reg .r4)] [.movw .r2 (BitVec.ofNat 16 (H.B + H.D)), .mov .r3 (.imm 0)] H.buf) - (.seq (copy .r11 H.buf .r6 0 H.D) - (.block H.restore)))))) - end Hash end VG.Impl.Hmac.Generic.Arm diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Generic/Arm.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Generic/Arm.lean deleted file mode 100644 index 4dbd70cde..000000000 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Generic/Arm.lean +++ /dev/null @@ -1,72 +0,0 @@ -import VerifiedGarbage.Impl.Hmac.Generic.Arm - -/-! -# PBKDF2-HMAC over any streaming hash function: 32-bit ARM implementation - -`iterate(key = r0, u = r1, n = r2, t = r3, scratch = [sp])` 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`: the same -design as on x86 (`VG.Impl.Pbkdf2.Generic.X86`). Each step -copies the inner state into `scratch`, absorbs `U` into it with `update` and -finalizes it; then does the same with the outer state and that digest, which -gives the next `U`. - -`scratch` is laid out as for HMAC (`VG.Impl.Hmac.Generic.Arm`): the working -space of the functions we call, our caller's registers and our return -address, then the state (`S` bytes), the inner digest and `U` (`F` bytes -each). Registers: `r4` = `key`, `r5` = `t`, `r6` = the steps left, `r11` = -`scratch`, `r8` = the byte index, `r9` = the bytes left. --/ - -namespace VG.Impl.Pbkdf2.Generic.Arm - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash copy scrAt) - -variable (H : Hash) - -/-- Where the state being hashed is in `scratch`. -/ -def stO : Nat := H.buf - -/-- Where the inner digest is. -/ -def tmpO : Nat := H.buf + H.S - -/-- Where `U` is. -/ -def uO : Nat := H.buf + H.S + H.F - -/-- `T ← T ⊕ U`, byte by byte. -/ -def xorLoop : Prog isa := - .seq (.block [.mov .r8 (.imm 0), .movw .r9 (BitVec.ofNat 16 H.D)]) - (.loop (.block [.dp .add .r2 .r11 (.reg .r8), .ldrb .r12 .r2 (uO H), .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) - -/-- `r2:r3 ← B + D`: the count of a state that has absorbed a block and a digest. -/ -def count2 : List Instr := [.movw .r2 (BitVec.ofNat 16 (H.B + H.D)), .mov .r3 (.imm 0)] - -/-- `r0 ← scratch + stO`: the state being hashed. -/ -def atSt : List Instr := scrAt .r0 (stO H) - -/-- One step. -/ -def body : Prog isa := - .seq (copy .r4 0 .r11 (stO H) H.S) - (.seq (H.callUpd (atSt H) H.B (uO H) H.D) - (.seq (H.callFin (atSt H) (count2 H) (tmpO H)) - (.seq (copy .r4 H.S .r11 (stO H) H.S) - (.seq (H.callUpd (atSt H) H.B (tmpO H) H.D) - (.seq (H.callFin (atSt H) (count2 H) (uO H)) - (.seq (xorLoop H) - (.block [.subs .r6 .r6 (.imm 1)]))))))) - -def prologue : List Instr := - [.ldrSp .r12 0] ++ H.save ++ [.mov .r4 (.reg .r0), .mov .r5 (.reg .r3), .mov .r6 (.reg .r2), - .mov .r11 (.reg .r12)] - -def iterate : Prog isa := - .seq (.block (prologue H)) - (.seq (copy .r1 0 .r11 (uO H) H.D) - (.seq (.block [.cmp .r6 (.imm 0)]) - (.seq (.ite .eq (.block []) (.loop (body H) .ne)) - (.block H.restore)))) - -end VG.Impl.Pbkdf2.Generic.Arm diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Generic/X86.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Generic/X86.lean index 067f30af0..c07483bc9 100644 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Generic/X86.lean +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Generic/X86.lean @@ -5,8 +5,7 @@ import VerifiedGarbage.Impl.Hmac.Generic.X86 `iterate(key, u, n, t, scratch)`, every argument on the stack (cdecl), 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`: -the same design as on 32-bit ARM (`VG.Impl.Pbkdf2.Generic.Arm`). +the key whose inner and outer streaming states are at `key` and `key + S`. Each step copies the inner state into `scratch`, absorbs `U` into it with `update` and finalizes it; then does the same with the outer state and that digest, which gives the next `U`. diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean new file mode 100644 index 000000000..59d7f0fb2 --- /dev/null +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean @@ -0,0 +1,196 @@ +import VerifiedGarbage.Impl.Hmac.Generic.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 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 +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`). +* `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 + at run time). The outer state has absorbed one block, `K₀ ⊕ opad`, so the + outer hash is one compression: of the outer state's hash value, copied to + the hash value being compressed, with the block holding the inner digest + and the padding of a `B + D`-byte message (`0x80`, zeros and the length + field), written word by word at fixed offsets. The digest of the result + goes to `out` (through the block for a truncated hash function, whose `N` + bytes of digest `out` cannot hold). +* `iterate(key = r0, u = r1, n = r2, t = r3, scratch = [sp])` 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 + N + B`: each + step is two compressions of a block that is `D` bytes of message followed + by the padding of a `B + D`-byte message, the inner hash value with the + block `U ‖ pad`, then the outer one with the block `digest ‖ pad`. The + padding is written once, before the loop; the digest's `N - D` bytes past + `D` (for a truncated hash function), which overwrite its start, are + written back after each compression. `T ⊕= U` is word by word, in `t`. + +`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`. +-/ + +namespace VG.Impl.Pbkdf2.Md.Arm + +open VG.Arm +open VG.Impl.Hmac.Generic.Arm (scrAt) +open VG.Impl.MdStream.Arm (compressAt) + +/-- A Merkle–Damgård hash function's 32-bit ARM functions, as HMAC and +PBKDF2 call them. -/ +structure Hash where + /-- The streaming functions, as HMAC's `init` and `finalize` call them: the + 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 + /-- The size of the hash value. -/ + N : Nat + /-- The size of the length field. -/ + L : Nat + /-- The length field is big-endian (little-endian otherwise). -/ + be : Bool + /-- The size of the compression function's scratch space (at most `8 W`). -/ + so : Nat + /-- Writes the digest of the hash value at `r0` to `r6` (`N` bytes); + writes only `r9` and `r10`. -/ + out : List Instr + /-- The compression function, and its name. -/ + compN : String + compC : Prog isa + +/-- Copying 32-bit word `k` from `[src + o₁]` to `[dst + o₂]`, through `r12`. -/ +def cp (src dst : Reg) (o₁ o₂ k : Nat) : List Instr := + [.ldr .r12 src (o₁ + 4 * k), .str .r12 dst (o₂ + 4 * k)] + +/-- `n` 32-bit words from `[src + o₁]` to `[dst + o₂]`. -/ +def copyW (src dst : Reg) (o₁ o₂ n : Nat) : List Instr := (List.range n).flatMap (cp src dst o₁ o₂) + +/-- `0x80` then zeros in the block at `r6`, from byte `a` up to byte `b` +(`a < b`, both multiples of 4). -/ +def padFrom (a b : Nat) : List Instr := + [.mov .r12 (.imm 0x80), .str .r12 .r6 a, .mov .r12 (.imm 0)] ++ + (List.range ((b - a) / 4 - 1)).map fun k => .str .r12 .r6 (a + 4 + 4 * k) + +/-- The constant words `ws`, stored at `[r6 + o]`, `[r6 + o + 4]`, … -/ +def constW : Nat → List (BitVec 32) → List Instr + | _, [] => [] + | o, w :: ws => [.movw .r12 (w.extractLsb' 0 16), .movt .r12 (w.extractLsb' 16 16), .str .r12 .r6 o] ++ + constW (o + 4) ws + +/-- The words of the `L`-byte length field of an `n`-byte message (its length +in bits, `8 n`), big-endian if `be`, as stored, each little-endian. -/ +def lenWords (be : Bool) (L n : Nat) : List (BitVec 32) := + (List.range (L / 4)).map fun j => + if be then rev (BitVec.ofNat 32 (8 * n / 2 ^ (32 * (L / 4 - 1 - j)))) + else BitVec.ofNat 32 (8 * n / 2 ^ (32 * j)) + +/-- `T ← T ⊕ U` for 32-bit word `k`, with `U` the block's first `D` bytes (at +`r6`) and `T` at `r7`. -/ +def xorW (k : Nat) : List Instr := + [.ldr .r12 .r6 (4 * k), .ldr .r1 .r7 (4 * k), .dp .eor .r12 .r12 (.reg .r1), .str .r12 .r7 (4 * k)] + +namespace Hash + +variable (H : Hash) + +/-- The block size and the size of the digest. -/ +abbrev B : Nat := H.st.B +abbrev D : Nat := H.st.D + +/-- Where the hash value being compressed is in `scratch`. -/ +def hvO : Nat := H.st.buf + +/-- Where the block is. -/ +def blkO : Nat := H.st.buf + H.N + +/-- The padding of a `B + D`-byte message after its `D` bytes in the block: +`0x80`, zeros, and the length field. -/ +def pad : List Instr := padFrom H.D (H.B - H.L) ++ constW (H.B - H.L) (lenWords H.be H.L (H.B + H.D)) + +/-- The digest of the hash value into the block, and the padding it +overwrote written back. -/ +def digest : List Instr := H.out ++ (if H.D < H.N then padFrom H.D H.N else []) + +/-- One compression of the block into the hash value. -/ +def compressBlock : Prog isa := .seq (.block [.mov .r1 (.reg .r6)]) (compressAt H.compN H.compC) + +/-- `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`. -/ +def hmacInit : Prog isa := H.st.init + +/-- Saving our caller's registers, with `outer` in `r5`, `out` in `r7` and +`scratch` in `r11`. -/ +def finPrologue : List Instr := + [.ldrSp .r12 4] ++ H.st.save ++ [.mov .r5 (.reg .r1), .ldrSp .r7 0, .mov .r11 (.reg .r12)] + +/-- The outer hash value, the padding after the inner digest in the block +and `scratch` in `r3`. -/ +def finMid : List Instr := [.mov .r3 (.reg .r11)] ++ H.atHv ++ copyW .r5 .r0 0 0 (H.N / 4) ++ H.pad + +/-- The MAC to `out` (through the block, if the digest is truncated), and +our caller's registers back. -/ +def finOut : List Instr := + (if H.D < H.N then H.out ++ copyW .r6 .r7 0 0 (H.D / 4) else .mov .r6 (.reg .r7) :: H.out) ++ H.st.restore + +def hmacFin : Prog isa := + .seq (.block H.finPrologue) + (.seq (H.st.callFin [] [] H.blkO) + (.seq (.block H.finMid) + (.seq H.compressBlock + (.block H.finOut)))) + +/-! ## `iterate` -/ + +/-- The hash value at `key + o` into the hash value being compressed. -/ +def loadKey (o : Nat) : List Instr := copyW .r4 .r0 o 0 (H.N / 4) + +/-- One step. -/ +def body : Prog isa := + .seq (.block (H.loadKey 0)) + (.seq H.compressBlock + (.seq (.block (H.digest ++ H.loadKey (H.N + H.B))) + (.seq H.compressBlock + (.block (H.digest ++ (List.range (H.D / 4)).flatMap xorW ++ [.subs .r5 .r5 (.imm 1)]))))) + +/-- Saving our caller's registers and our return address, setting up our +registers, and writing `U` and the padding into the block. -/ +def prologue : List Instr := + [.ldrSp .r12 0] ++ H.st.save ++ + [.mov .r11 (.reg .r12), .mov .r7 (.reg .r3), .mov .r3 (.reg .r12), .mov .r4 (.reg .r0), + .mov .r5 (.reg .r2)] ++ H.atHv ++ copyW .r1 .r6 0 0 (H.D / 4) ++ H.pad ++ [.cmp .r5 (.imm 0)] + +def iterate : Prog isa := + .seq (.block H.prologue) + (.seq (.ite .eq (.block []) (.loop H.body .ne)) + (.block H.st.restore)) + +end Hash + +end VG.Impl.Pbkdf2.Md.Arm diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Finalize.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Finalize.lean deleted file mode 100644 index a05821140..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Finalize.lean +++ /dev/null @@ -1,497 +0,0 @@ -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Init -import VerifiedGarbage.Proof.Framework.OmegaLit - -/-! -# HMAC over any streaming hash function on 32-bit ARM: `finalize`, correct - -Untrusted: everything here is checked by Lean. As on AArch64 -(`Proof/Hmac/Generic/AArch64/Finalize.lean`). `out` and `scratch` are stack -arguments, loaded into `r6` and `r12`; the count stays in `r2:r3` until the -first call. --/ - -namespace VG.Proof.Hmac.Generic.Arm.Finalize - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash copy scrAt) -open VG.Proof.Hmac.Generic.Arm -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.MdStream.Arm (contains_offset Upd wp_mov wp_add wp_ldrSp op2_imm op2_reg sub_offset) -open VG.Proof.Hmac.Common (bytesAt_length writeBytes_at bytesAt_getD' xorPad_length) -open Spec.Sha256 (bytesAt) -open VG.Proof.Sha256.Stream (writeBytes) -open Spec.Hmac (xorPad ipad opad hmacBlockKey) - -variable {H : Hash} (hH : HashOK H) (sc : Nat) - -section -variable (s₀ : State) - -abbrev inn : BitVec 32 := s₀.gpr .r0 -abbrev outer : BitVec 32 := s₀.gpr .r1 -abbrev op : BitVec 32 := stackArg s₀ 0 -abbrev scr : BitVec 32 := stackArg s₀ 1 -abbrev inR : Region := ⟨State.addr (inn s₀), H.S⟩ -abbrev outerR : Region := ⟨State.addr (outer s₀), H.S⟩ -abbrev opR : Region := ⟨State.addr (op s₀), H.D⟩ -abbrev scR : Region := ⟨State.addr (scr s₀), 8 * sc⟩ -abbrev argR : Region := ⟨stackArgAddr s₀ 0, 8⟩ -abbrev stkR : Region := below s₀ -/-- Where the digests go. -/ -abbrev T : Addr := State.addr (scr s₀) + BitVec.ofNat 64 H.buf -abbrev tR : Region := ⟨T (H := H) s₀, H.F⟩ -abbrev calR : Region := ⟨State.addr (scr s₀), hH.Wb⟩ -/-- `T`, as a register holds it. -/ -abbrev tO : BitVec 32 := scr s₀ + BitVec.ofNat 32 H.buf - -end - -/-- The precondition, with the sizes of `H`. -/ -structure Pre (s₀ : State) : Prop where - rd : s₀.rd = [outerR (H := H) s₀, argR s₀] - wr : s₀.wr = [inR (H := H) s₀, opR (H := H) s₀, scR sc s₀] - i_o : (inR (H := H) s₀).Disjoint (outerR (H := H) s₀) - i_p : (inR (H := H) s₀).Disjoint (opR (H := H) s₀) - i_s : (inR (H := H) s₀).Disjoint (scR sc s₀) - o_p : (outerR (H := H) s₀).Disjoint (opR (H := H) s₀) - o_s : (outerR (H := H) s₀).Disjoint (scR sc s₀) - p_s : (opR (H := H) s₀).Disjoint (scR sc s₀) - a_i : (argR s₀).Disjoint (inR (H := H) s₀) - a_p : (argR s₀).Disjoint (opR (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 (outerR (H := H) s₀) - b_p : (stkR s₀).Disjoint (opR (H := H) s₀) - b_s : (stkR s₀).Disjoint (scR sc s₀) - ni : (inn s₀).toNat + H.S ≤ 2 ^ 32 - no : (outer s₀).toNat + H.S ≤ 2 ^ 32 - np : (op s₀).toNat + H.D ≤ 2 ^ 32 - nw : (scr s₀).toNat + 8 * sc ≤ 2 ^ 32 - sp16 : 16 ≤ s₀.sp.toNat - spf : s₀.sp.toNat + 8 ≤ 2 ^ 32 - fits : H.buf + H.F ≤ 8 * sc - hB : 0 < H.B ∧ H.B ≤ 128 - hW : H.W ≤ 64 - hS : 0 < H.S ∧ H.S ≤ 256 - hD : 0 < H.D ∧ H.D ≤ H.F ∧ H.F ≤ 64 - -theorem pre_of {s₀ : State} (h : (finG hH.SH sc).pre s₀) (hfit : H.buf + H.F ≤ 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⟩ := h - have hS := hH.hS - have hD := hH.hD - simp only [hS, hD] at * - exact ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, hfit, - ⟨hH.hB0, hH.hBB⟩, hH.hW, ⟨hH.hS0, hH.hSB⟩, ⟨hH.hD0, hH.hDF, hH.hF⟩⟩ - -/-! ## The parts of `scratch` -/ - -section -variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) -include hp - -theorem save_sub : Region.Sub (saveR H (scr s₀)) (scR sc s₀) := by - have := hp.fits; have := hp.nw; have := hp.hW; simp only [Hash.buf] at * - exact sub_offset (by omega_nat) (by omega_nat) - -theorem t_sub : Region.Sub (tR (H := H) s₀) (scR sc s₀) := by - have := hp.fits; have := hp.nw; have := hp.hD - exact sub_offset hp.fits (by 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) - -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_t : (calR hH s₀).Disjoint (tR (H := H) s₀) := by - have := hH.hWb; have := hp.hW; have := hp.hD - exact off_disj0 _ (m := hH.Wb) (b := 8 * H.W + 36) (n := H.F) (by omega_nat) (by omega_nat) - -theorem save_t : (saveR H (scr s₀)).Disjoint (tR (H := H) s₀) := by - have := hp.hW; have := hp.hD - exact off_disj _ (a := 8 * H.W) (m := 36) (b := 8 * H.W + 36) (n := H.F) (by omega_nat) (by omega_nat) - (by omega_nat) - -theorem buf_lt : H.buf < 4096 := by - have := hp.hW; simp only [Hash.buf]; omega_nat - -theorem addr_tO : State.addr (tO (H := H) s₀) = T (H := H) s₀ := - addr_add (by have := hp.nw; have := hp.fits; have := hp.hD; omega_nat) - -theorem toNat_tO : (tO (H := H) s₀).toNat = (scr s₀).toNat + H.buf := by - have := hp.nw; have := hp.fits; have := hp.hD; have := buf_lt hp - rw [BitVec.toNat_add, BitVec.toNat_ofNat, Nat.mod_eq_of_lt (a := H.buf) (by omega_nat), - Nat.mod_eq_of_lt (by omega_nat)] - -theorem sa1 : stackArgAddr s₀ 1 = stackArgAddr s₀ 0 + BitVec.ofNat 64 4 := by - have := hp.spf - simp only [stackArgAddr] - rw [addr_add (k := 4 * 1) (by omega), addr_add (k := 4 * 0) (by omega), BitVec.add_zero] - -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 = outer s₀ - r6 : s.gpr .r6 = op 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, .r6, .r11] - -theorem kregs_pres : ∀ r ∈ kregs, r ∈ preserved ∧ r ≠ .lr := by decide -theorem kregs_clob : ∀ r ∈ kregs, r ∉ clob := by decide - -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.r6, (hg _ (by simp)).trans h.r11, - h.saved.frame H hf hs⟩ - -theorem KR.upd {s₀ s s' : State} (h : KR (H := H) s₀ s) {d : Reg} (hd : d ∉ kregs) {v : BitVec 32} - (u : Upd s s' d v) : KR (H := H) 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) - -/-! ## The pieces -/ - -section -variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) -include hp - -theorem wr_mem : scR sc s₀ ∈ s₀.wr ∧ inR (H := H) s₀ ∈ s₀.wr ∧ opR (H := H) s₀ ∈ s₀.wr := by - rw [hp.wr]; simp - -theorem KR.call {t s' : State} (hk : KR (H := H) s₀ t) {ws : List Region} (ha : After t ws s') - (hs : ∀ r ∈ ws, (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) - -theorem pro_ok : WP isa (.block H.finPrologue) s₀ fun s => KR (H := H) s₀ s ∧ s.gpr .r0 = inn s₀ ∧ - count s = count s₀ ∧ Frame [saveR H (scr s₀)] s₀.mem s.mem := by - have hW := hp.hW; have hf := hp.fits; have nw := hp.nw; have hD := hp.hD - simp only [Hash.buf] at hf - obtain ⟨sR, _, _⟩ := wr_mem hp - have aR : argR s₀ ∈ s₀.rd ++ s₀.wr := by rw [hp.rd]; simp - simp only [Hash.finPrologue, List.singleton_append] - refine wp_ldrSp (a := stackArgAddr s₀ 1) (by decide) rfl - ⟨argR s₀, aR, by rw [sa1 hp]; exact contains_offset (by omega_nat) (by omega_nat)⟩ fun s₁ u₁ => ?_ - refine save_ok H (scr := scr s₀) u₁.gpr hW (by rw [u₁.wr]; exact sR) (by omega_nat) (by omega_nat) - 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₃ => wp_mov (op2_reg _ _) fun s₄ u₄ => - wp_ldrSp (a := stackArgAddr s₀ 0) (by decide) (by rw [u₄.sp, u₃.sp, hsp₂]; rfl) - (by rw [u₄.rd, u₄.wr, u₃.rd, u₃.wr, rd₂, wr₂, u₁.rd, u₁.wr] - exact ⟨argR s₀, aR, by simp [Region.Contains]⟩) 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] - have f₂' : Frame [saveR H (scr s₀)] s₀.mem s₂.mem := by rw [← u₁.mem]; exact f₂ - have ea : s₂.mem.readW (stackArgAddr s₀ 0) 32 = op s₀ := - f₂'.readW (r := ⟨stackArgAddr s₀ 0, 4⟩) (Region.contains_self _ _) (by - simp only [List.mem_singleton]; rintro r rfl - exact (hp.a_s.sub_left (Region.sub_prefix (by omega_nat))).sub_right (save_sub hp)) (by decide) - have k : ∀ r, r ≠ .r4 → r ≠ .r5 → r ≠ .r6 → r ≠ .r11 → r ≠ .r12 → s₆.gpr r = s₀.gpr r := - fun r h4 h5 h6 h11 h12 => by - rw [u₆.other r h11, u₅.other r h6, u₄.other r h5, u₃.other r h4, e₂ r h12] - refine ⟨⟨by rw [u₆.rd, u₅.rd, u₄.rd, u₃.rd, rd₂, u₁.rd], by rw [u₆.wr, u₅.wr, u₄.wr, u₃.wr, wr₂, u₁.wr], - by rw [u₆.sp, u₅.sp, u₄.sp, u₃.sp, hsp₂], - by rw [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₄.gpr, u₃.other _ (by decide), e₂ _ (by decide)], - by rw [u₆.other _ (by decide), u₅.gpr, u₄.mem, u₃.mem, ea], - by rw [u₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), g₂, u₁.gpr]; rfl, - 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)⟩, - k _ (by decide) (by decide) (by decide) (by decide) (by decide), - by simp only [count, k _ (by decide) (by decide) (by decide) (by decide) (by decide : Reg.r2 ≠ .r12), - k _ (by decide) (by decide) (by decide) (by decide) (by decide : Reg.r3 ≠ .r12)], hm ▸ f₂'⟩ - -/-- The regions of a call of `finalize` on `inner`, into `T`. -/ -theorem finArgs {t : State} (hk : KR (H := H) s₀ t) (h0 : t.gpr .r0 = inn s₀) - (h1 : t.gpr .r1 = tO (H := H) s₀) (h12 : t.gpr .r12 = scr s₀) : - FinArgs hH t (inn s₀) (tO (H := H) s₀) (scr s₀) := by - have hwb := hH.hWb; have hf := hp.fits; have hf' := hp.fits; have hD := hp.hD; have nw := hp.nw - simp only [Hash.buf] at hf - obtain ⟨sR, iR, _⟩ := wr_mem hp - exact - { r0 := h0, r1 := h1, r12 := h12 - sp16 := by rw [hk.sp]; exact hp.sp16 - cw := by - rw [hk.wr, addr_tO hp] - 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 | rfl - · exact sub_of_self iR (Nat.le_refl _) - · exact sub_of_off sR hp.fits - · exact sub_of_self (r := scR sc s₀) sR (by show hH.Wb ≤ 8 * sc; omega_nat) - st_o := by rw [addr_tO hp]; exact hp.i_s.sub_right (t_sub hp) - st_sc := hp.i_s.sub_right (cal_sub hH hp) - o_sc := by rw [addr_tO hp]; exact (cal_t hH hp).symm - b_st := by rw [below_eq hk.sp]; exact hp.b_i - b_o := by rw [below_eq hk.sp, addr_tO hp]; exact hp.b_s.sub_right (t_sub hp) - b_sc := by rw [below_eq hk.sp]; exact hp.b_s.sub_right (cal_sub hH hp) - nst := hp.ni - no := by rw [toNat_tO hp]; omega_nat - nsc := by omega_nat } - -/-- The first call's arguments: the count still in `r2:r3`. -/ -theorem fin1Args_ok {s : State} (hk : KR (H := H) s₀ s) : - WP isa (.block (([.mov .r0 (.reg .r4)] : List Instr) ++ [] ++ scrAt .r1 H.buf ++ ([.mov .r12 (.reg .r11)] : List Instr))) s fun t => - KR (H := H) s₀ t ∧ FinArgs hH t (inn s₀) (tO (H := H) s₀) (scr s₀) ∧ count t = count s ∧ - t.mem = s.mem := by - have hl := buf_lt hp - simp only [scrAt, List.cons_append, List.nil_append, List.append_nil] - refine wp_mov (op2_reg _ _) fun s₁ u₁ => wp_movw fun s₂ u₂ => wp_add (op2_reg _ _) fun s₃ u₃ => - wp_mov (op2_reg _ _) fun s₄ u₄ => WP.block_nil ?_ - have k₄ : KR (H := H) s₀ s₄ := - (((hk.upd (by decide) u₁).upd (by decide) u₂).upd (by decide) u₃).upd (by decide) u₄ - refine ⟨k₄, finArgs hH hp k₄ ?_ ?_ ?_, ?_, by rw [u₄.mem, u₃.mem, u₂.mem, u₁.mem]⟩ - · rw [u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.gpr, hk.r4] - · rw [u₄.other _ (by decide), u₃.gpr, u₂.gpr, u₂.other _ (by decide), u₁.other _ (by decide), hk.r11, - movw_ofNat (by omega_nat)] - · rw [u₄.gpr, u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), hk.r11] - · simp only [count, u₄.other _ (show Reg.r2 ≠ .r12 by decide), u₃.other _ (show Reg.r2 ≠ .r1 by decide), - u₂.other _ (show Reg.r2 ≠ .r12 by decide), u₁.other _ (show Reg.r2 ≠ .r0 by decide), - u₄.other _ (show Reg.r3 ≠ .r12 by decide), u₃.other _ (show Reg.r3 ≠ .r1 by decide), - u₂.other _ (show Reg.r3 ≠ .r12 by decide), u₁.other _ (show Reg.r3 ≠ .r0 by decide)] - -/-- The second call's arguments: the count `B + D`. -/ -theorem fin2Args_ok {s : State} (hk : KR (H := H) s₀ s) : - WP isa (.block (([.mov .r0 (.reg .r4)] : List Instr) ++ ([.movw .r2 (BitVec.ofNat 16 (H.B + H.D)), .mov .r3 (.imm 0)] : List Instr) ++ - scrAt .r1 H.buf ++ ([.mov .r12 (.reg .r11)] : List Instr))) s fun t => - KR (H := H) s₀ t ∧ FinArgs hH t (inn s₀) (tO (H := H) s₀) (scr s₀) ∧ - count t = BitVec.ofNat 64 (H.B + H.D) ∧ t.mem = s.mem := by - have hB := hp.hB; have hD := hp.hD; have hl := buf_lt hp - simp only [scrAt, List.cons_append, List.nil_append] - refine wp_mov (op2_reg _ _) fun s₁ u₁ => wp_movw fun s₂ u₂ => wp_mov (op2_imm (by decide)) fun s₃ u₃ => - wp_movw fun s₄ u₄ => wp_add (op2_reg _ _) fun s₅ u₅ => wp_mov (op2_reg _ _) fun s₆ u₆ => WP.block_nil ?_ - have k₆ : KR (H := H) s₀ s₆ := - (((((hk.upd (by decide) u₁).upd (by decide) u₂).upd (by decide) u₃).upd (by decide) u₄).upd - (by decide) u₅).upd (by decide) u₆ - refine ⟨k₆, finArgs hH hp k₆ ?_ ?_ ?_, count_movw (by omega_nat) ?_ ?_, - by rw [u₆.mem, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem]⟩ - · rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), - u₂.other _ (by decide), u₁.gpr, hk.r4] - · rw [u₆.other _ (by decide), u₅.gpr, u₄.gpr, u₄.other _ (by decide), u₃.other _ (by decide), - u₂.other _ (by decide), u₁.other _ (by decide), hk.r11, movw_ofNat (by omega_nat)] - · rw [u₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), - u₂.other _ (by decide), u₁.other _ (by decide), hk.r11] - · 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] - -theorem finCall_ok {t : State} (hk : KR (H := H) s₀ t) (ha : FinArgs hH t (inn s₀) (tO (H := H) s₀) (scr s₀)) - {Q : State → Prop} - (hQ : ∀ s', KR (H := H) s₀ s' → Frame [inR (H := H) s₀, tR (H := H) s₀, calR hH s₀, stkR 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 (T (H := H) s₀) H.F).take H.D = hH.SH.H.hash m) → Q s') : - WP isa (.frame (.push fin2) (.call H.finN H.finC) (.pop .r1 8)) t Q := - fin_frame hH ha fun s' ha' hpost => by - have f := ha'.frame - rw [below_eq hk.sp, addr_tO hp] at f - rw [addr_tO hp] at hpost - refine hQ s' (KR.call hp hk ha' ?_) f hpost - simp only [List.mem_cons, List.not_mem_nil, or_false] - rw [addr_tO hp] - rintro r (rfl | rfl | rfl) - · exact hp.i_s.symm.sub_left (save_sub hp) - · exact save_t hp - · exact (cal_save hH hp).symm - -theorem updArgs_ok {s : State} (hk : KR (H := H) s₀ s) : - WP isa (.block (([.mov .r0 (.reg .r4)] : List Instr) ++ scrAt .r1 H.buf ++ ([.movw .r7 (BitVec.ofNat 16 H.D), - .mov .r10 (.reg .r11), .movw .r2 (BitVec.ofNat 16 H.B), .mov .r3 (.imm 0)] : List Instr))) s fun t => - KR (H := H) s₀ t ∧ UpdArgs hH t (inn s₀) (tO (H := H) s₀) (scr s₀) H.D ∧ - count t = BitVec.ofNat 64 H.B ∧ t.mem = s.mem := by - have hf := hp.fits; have hW := hp.hW; have hB := hp.hB; have hD := hp.hD; have hwb := hH.hWb - have nw := hp.nw; have hl := buf_lt hp; have hf2 := hp.fits; simp only [Hash.buf] at hf2 - obtain ⟨sR, iR, _⟩ := wr_mem hp - 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₇ := - ((((((hk.upd (by decide) u₁).upd (by decide) u₂).upd (by decide) u₃).upd (by decide) u₄).upd - (by decide) u₅).upd (by decide) u₆).upd (by decide) u₇ - have tsub : Region.Sub ⟨T (H := H) s₀, H.D⟩ (tR (H := H) s₀) := Region.sub_prefix hD.2.1 - refine ⟨k₇, ?_, count_movw (by omega_nat) (by rw [u₇.other _ (by decide), u₆.gpr]) u₇.gpr, - by rw [u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem]⟩ - 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, hk.r4] - 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), hk.r11, - 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), hk.r11] - hlen := by omega_nat - sp16 := by rw [k₇.sp]; exact hp.sp16 - cd := by - rw [k₇.rd, k₇.wr, addr_tO hp] - exact Covers.of_sub fun r hr => by - simp only [List.mem_singleton] at hr; subst hr - exact sub_of_off (List.mem_append_right _ sR) (by omega_nat) - 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 iR (Nat.le_refl _) - · exact sub_of_self (r := scR sc s₀) sR (by show hH.Wb ≤ 8 * sc; simp only [Hash.buf] at hf; omega_nat) - st_sc := hp.i_s.sub_right (cal_sub hH hp) - d_st := by rw [addr_tO hp]; exact (hp.i_s.sub_right (fun a h => t_sub hp a (tsub a h))).symm - d_sc := by rw [addr_tO hp]; exact (cal_t hH hp).symm.sub_left tsub - b_st := by rw [below_eq k₇.sp]; exact hp.b_i - b_d := by rw [below_eq k₇.sp, addr_tO hp]; exact hp.b_s.sub_right (fun a h => t_sub hp a (tsub a h)) - b_sc := by rw [below_eq k₇.sp]; exact hp.b_s.sub_right (cal_sub hH hp) - nst := hp.ni - nd := by rw [toNat_tO hp]; omega_nat - nsc := by omega_nat } - -theorem updCall_ok {t : State} (hk : KR (H := H) s₀ t) (ha : UpdArgs hH t (inn s₀) (tO (H := H) s₀) (scr s₀) H.D) - {Q : State → Prop} - (hQ : ∀ s', KR (H := H) s₀ s' → Frame [inR (H := H) s₀, calR hH s₀, stkR s₀] t.mem s'.mem → - (∀ m, hH.SH.Repr t.mem (State.addr (inn s₀)) m → count t = BitVec.ofNat 64 m.length → - hH.SH.Repr s'.mem (State.addr (inn s₀)) (m ++ bytesAt t.mem (T (H := H) s₀) H.D)) → Q s') : - WP isa (.frame (.push upd4) (.call H.updN H.updC) (.pop .r1 16)) t Q := - upd_frame hH ha fun s' ha' hpost => by - have f := ha'.frame - rw [below_eq hk.sp] at f - rw [addr_tO hp] at hpost - refine hQ s' (KR.call hp hk ha' ?_) f hpost - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact hp.i_s.symm.sub_left (save_sub hp) - · exact (cal_save hH hp).symm - -/-! ## The copies -/ - -omit hp in -theorem add_zero' (p : Addr) : p + BitVec.ofNat 64 0 = p := BitVec.add_zero p - -/-- The outer state over the inner one. -/ -theorem copy1_ok {s : State} (hk : KR (H := H) s₀ s) : - WP isa (copy .r5 0 .r4 0 H.S) s fun t => KR (H := H) s₀ t ∧ - t.mem = writeBytes s.mem (State.addr (inn s₀)) (bytesAt s.mem (State.addr (outer s₀)) H.S) := by - have hS := hp.hS; have ni := hp.ni; have no := hp.no - obtain ⟨_, iR, _⟩ := wr_mem hp - have oR : outerR (H := H) s₀ ∈ s.rd ++ s.wr := by rw [hk.rd, hp.rd]; simp - refine WP.mono (copy_ok (so := 0) (d := 0) (n := H.S) (by decide) (by decide) (by decide) (by decide) hS.1 - (by omega_nat) (by rw [hk.r5]; omega_nat) (by rw [hk.r4]; omega_nat) - (fun k hk' => by rw [hk.r5, add_zero']; exact inRegions_of_sub oR (fun _ h => h) (by omega_nat) hk') - (fun k hk' => by rw [hk.r4, add_zero', hk.wr]; exact inRegions_of_sub iR (fun _ h => h) (by omega_nat) hk') - (by rw [hk.r5, hk.r4, add_zero', add_zero']; exact hp.i_o.symm)) fun t c => ?_ - rw [hk.r4, hk.r5, add_zero', add_zero'] at c - refine ⟨hk.keep c.rd c.wr c.sp (fun r hr => c.other r (not_cclob (kregs_clob r hr))) - (c.mem ▸ Proof.Sha256.Stream.writeBytes_frame _ _ _ (R := inR (H := H) s₀) (by - rw [bytesAt_length]; exact Region.contains_self _ _)) (by - simp only [List.mem_singleton]; rintro r rfl; exact hp.i_s.symm.sub_left (save_sub hp)), c.mem⟩ - -/-- The MAC to `out`. -/ -theorem copy2_ok {s : State} (hk : KR (H := H) s₀ s) : - WP isa (copy .r11 H.buf .r6 0 H.D) s fun t => KR (H := H) s₀ t ∧ - t.mem = writeBytes s.mem (State.addr (op s₀)) (bytesAt s.mem (T (H := H) s₀) H.D) := by - have hD := hp.hD; have np := hp.np; have nw := hp.nw; have hf := hp.fits - obtain ⟨sR, _, pR⟩ := wr_mem hp - have tsub : Region.Sub ⟨T (H := H) s₀, H.D⟩ (scR sc s₀) := fun a h => t_sub hp a (Region.sub_prefix hD.2.1 a h) - refine WP.mono (copy_ok (so := H.buf) (d := 0) (n := H.D) (by decide) (by decide) (buf_lt hp) (by decide) - hD.1 (by omega_nat) (by rw [hk.r11]; omega_nat) (by rw [hk.r6]; omega_nat) - (fun k hk' => by - rw [hk.r11, hk.rd, hk.wr]; exact inRegions_of_sub (List.mem_append_right _ sR) tsub (by omega_nat) hk') - (fun k hk' => by rw [hk.r6, add_zero', hk.wr]; exact inRegions_of_sub pR (fun _ h => h) (by omega_nat) hk') - (by rw [hk.r11, hk.r6, add_zero']; exact hp.p_s.symm.sub_left tsub)) fun t c => ?_ - rw [hk.r6, hk.r11, add_zero'] at c - refine ⟨hk.keep c.rd c.wr c.sp (fun r hr => c.other r (not_cclob (kregs_clob r hr))) - (c.mem ▸ Proof.Sha256.Stream.writeBytes_frame _ _ _ (R := opR (H := H) s₀) (by - rw [bytesAt_length]; exact Region.contains_self _ _)) (by - simp only [List.mem_singleton]; rintro r rfl; exact hp.p_s.symm.sub_left (save_sub hp)), c.mem⟩ - -/-! ## Correctness -/ - -theorem correct : WP isa H.finalize s₀ fun s' => abiPreserved s₀ s' ∧ (finG hH.SH sc).post s₀ s' := by - have hD := hp.hD; have hS := hp.hS; have hB := hp.hB - have hS' := hH.hS; have hD' := hH.hD; have hB' := hH.hB - obtain ⟨sR, iR, pR⟩ := wr_mem hp - have tsub : Region.Sub ⟨T (H := H) s₀, H.D⟩ (tR (H := H) s₀) := Region.sub_prefix hD.2.1 - refine WP.seq (WP.mono (pro_ok hp) fun s₁ ⟨k₁, _, dx₁, f₁⟩ => ?_) - refine WP.seq (WP.seq (WP.mono (fin1Args_ok hH hp k₁) fun t₁ ⟨kt₁, a₁, si₁, m₁⟩ => - finCall_ok hH hp kt₁ a₁ fun s₂ k₂ f₂ d₂ => ?_)) - refine WP.seq (WP.mono (copy1_ok hp k₂) fun s₃ ⟨k₃, m₃⟩ => ?_) - refine WP.seq (WP.seq (WP.mono (updArgs_ok hH hp k₃) fun t₃ ⟨kt₃, a₃, si₃, mt₃⟩ => - updCall_ok hH hp kt₃ a₃ fun s₄ k₄ f₄ r₄ => ?_)) - refine WP.seq (WP.seq (WP.mono (fin2Args_ok hH hp k₄) fun t₄ ⟨kt₄, a₄, si₄, mt₄⟩ => - finCall_ok hH hp kt₄ a₄ fun s₅ k₅ f₅ d₅ => ?_)) - refine WP.seq (WP.mono (copy2_ok hp k₅) fun s₆ ⟨k₆, m₆⟩ => ?_) - have hL : 8 * H.W + 36 ≤ 8 * sc := by have := hp.fits; simp only [Hash.buf] at this; omega_nat - refine WP.mono (restore_ok H k₆.r11 hp.hW k₆.saved (by rw [k₆.wr]; exact sR) hL hp.nw) - fun s' ⟨hm, _, _, hsp, hg, _⟩ => - ⟨⟨fun r hr => hg r (preserved_saved r hr), by rw [hsp, k₆.sp]⟩, ?_⟩ - -- The functional part. - intro k0 text hk0 hlen hrI hcnt hrO - rw [hH.hB] at hk0 hcnt - have hl0 : (xorPad k0 ipad ++ text).length = H.B + text.length := by - rw [List.length_append, xorPad_length, hk0] - -- The outer state is untouched until it is copied. - have oI : ∀ r ∈ [saveR H (scr s₀)], Region.Disjoint (outerR (H := H) s₀) r := by - simp only [List.mem_singleton]; rintro r rfl; exact hp.o_s.sub_right (save_sub hp) - have o₂ : ∀ r ∈ [inR (H := H) s₀, tR (H := H) s₀, calR hH s₀, stkR s₀], - Region.Disjoint (outerR (H := H) s₀) r := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - 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 (cal_sub hH hp) - · exact hp.b_o.symm - have rO₂ := Init.repr_keep hH f₂ o₂ (m₁ ▸ Init.repr_keep hH f₁ oI hrO) - -- The inner digest. - have dig := d₂ _ (m₁ ▸ Init.repr_keep 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 [si₁, dx₁, hcnt, hl0]) - -- The copy of the outer state. - have rI₃ : hH.SH.Repr s₃.mem (State.addr (inn s₀)) (xorPad k0 opad) := by - refine hH.repr _ _ _ _ _ (fun i hi => ?_) rO₂ - rw [m₃, writeBytes_at _ _ _ (by rw [bytesAt_length]; exact hi) (by rw [bytesAt_length]; omega_nat), - bytesAt_getD' _ _ hi] - have t₃ : bytesAt s₃.mem (T (H := H) s₀) H.D = bytesAt s₂.mem (T (H := H) s₀) H.D := by - rw [m₃] - exact bytes_keep (Proof.Sha256.Stream.writeBytes_frame _ _ _ (R := inR (H := H) s₀) (by - rw [bytesAt_length]; exact Region.contains_self _ _)) (by - simp only [List.mem_singleton]; rintro r rfl - exact (hp.i_s.sub_right (t_sub hp)).symm.sub_left tsub) (by omega_nat) - have rI₄ := r₄ _ (mt₃ ▸ rI₃) (by rw [si₃, xorPad_length, hk0]) - rw [mt₃, t₃] at rI₄ - have hl₄ : (xorPad k0 opad ++ bytesAt s₂.mem (T (H := H) s₀) H.D).length = H.B + H.D := by - rw [List.length_append, xorPad_length, hk0, bytesAt_length] - have dig₂ := d₅ _ (mt₄ ▸ rI₄) (by rw [hl₄]; omega_nat) (by rw [si₄, hl₄]) - show bytesAt s'.mem (State.addr (op s₀)) hH.SH.digestBytes = hmacBlockKey hH.SH.H k0 text - rw [hD', hm, m₆, bytesAt_writeBytes_self' (bytesAt_length _ _ _) (by omega_nat), bytesAt_take _ _ hD.2.1, dig₂, - bytesAt_take _ _ hD.2.1, dig] - rfl - -end - -end VG.Proof.Hmac.Generic.Arm.Finalize diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hash.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hash.lean index 38ed192f3..357cf19ea 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hash.lean +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/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.Pbkdf2.Generic.Arm +import VerifiedGarbage.Impl.Hmac.Generic.Arm import VerifiedGarbage.Proof.Framework.Offset import VerifiedGarbage.Proof.Framework.OffsetBelow import VerifiedGarbage.Proof.Framework.OmegaLit diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Instances.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Instances.lean index 1bf7ea886..234bf2338 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Instances.lean @@ -1,5 +1,4 @@ import VerifiedGarbage.Proof.Hmac.Generic.Arm.Init -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Finalize import VerifiedGarbage.Proof.Hmac.Generic.Implies import VerifiedGarbage.Proof.Framework.Arm.Contract import VerifiedGarbage.Proof.Hmac.Generic.Arm.Hashes @@ -188,200 +187,6 @@ theorem verified {H : Hash} (hH : HashOK H) {sc : Nat} (hc : Checks H) end VG.Proof.Hmac.Generic.Arm.Init -/-! -# HMAC over any streaming hash function on 32-bit ARM: `finalize`, constant time - -Untrusted: everything here is checked by Lean. As for `init` (above). --/ - -namespace VG.Proof.Hmac.Generic.Arm.Finalize - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash copy scrAt) -open VG.Proof.Hmac.Generic.Arm -open VG.Proof.Hmac.Generic.Arm.Init (args) - -/-- The registers `KR` fixes that the code between the calls uses. -/ -abbrev pubRegs : List Reg := [.r4, .r5, .r6, .r11] - -/-- The block that sets up the first call of `finalize`. -/ -abbrev fin1Block (H : Hash) : List Instr := - ([.mov .r0 (.reg .r4)] : List Instr) ++ [] ++ scrAt .r1 H.buf ++ ([.mov .r12 (.reg .r11)] : List Instr) - -/-- The block that sets up the second call of `finalize`. -/ -abbrev fin2Block (H : Hash) : List Instr := - ([.mov .r0 (.reg .r4)] : List Instr) ++ ([.movw .r2 (BitVec.ofNat 16 (H.B + H.D)), .mov .r3 (.imm 0)] : List Instr) ++ - scrAt .r1 H.buf ++ ([.mov .r12 (.reg .r11)] : List Instr) - -/-- The block that sets up the call of `update`. -/ -abbrev updBlock (H : Hash) : List Instr := - ([.mov .r0 (.reg .r4)] : List Instr) ++ scrAt .r1 H.buf ++ ([.movw .r7 (BitVec.ofNat 16 H.D), .mov .r10 (.reg .r11), - .movw .r2 (BitVec.ofNat 16 H.B), .mov .r3 (.imm 0)] : List Instr) - -/-- The taint checks of the pieces of `finalize` between its calls. -/ -structure Checks (H : Hash) : Prop where - pro : ∃ hc, (VG.Taint.check taint (argTaint args 8) (.block H.finPrologue) hc).isSome = true - fin1 : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block (fin1Block H)) hc).isSome = true - copy1 : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (copy .r5 0 .r4 0 H.S) hc).isSome = true - upd : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block (updBlock H)) hc).isSome = true - fin2 : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block (fin2Block H)) hc).isSome = true - copy2 : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (copy .r11 H.buf .r6 0 H.D) hc).isSome = true - restore : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block H.restore) hc).isSome = true - -/-- The checks of the parts of `finalize` that do not depend on the size of -the digest carry over to a hash function of the same sizes but that one. -/ -theorem Checks.of_sizes {H H' : Hash} (hB : H.B = H'.B) (hS : H.S = H'.S) (hW : H.W = H'.W) (h : Checks H) - (upd : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block (updBlock H')) hc).isSome = true) - (fin2 : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block (fin2Block H')) hc).isSome = true) - (copy2 : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (copy .r11 H'.buf .r6 0 H'.D) hc).isSome = true) : - 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.pro, h.fin1, h.copy1, upd, fin2, copy2, h.restore⟩ - -/-- 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 - a1 : stackArg s₀ 1 = stackArg s₀' 1 - -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 | rfl - · rw [h.r4, h'.r4, inn, inn, hq.r0] - · rw [h.r5, h'.r5, outer, outer, hq.r1] - · rw [h.r6, h'.r6, op, op, hq.a0] - · rw [h.r11, h'.r11, scr, scr, hq.a1] - -/-- The stack arguments lie outside the writable regions. -/ -theorem args_wf {t : State} (h : Pre (H := H) sc t) : - t.sp.toNat + 8 ≤ 2 ^ 32 ∧ ∀ r ∈ t.wr, Region.Disjoint ⟨State.addr t.sp, 8⟩ r := by - have e : (⟨State.addr t.sp, 8⟩ : 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_p - · exact h.a_s - -include hH hp hp' hq - -omit hH hp hp' in -theorem eqs : inn s₀' = inn s₀ ∧ tO (H := H) s₀' = tO (H := H) s₀ ∧ scr s₀' = scr s₀ := - ⟨hq.r0.symm, by rw [tO, tO, scr, scr, hq.a1], hq.a1.symm⟩ - -omit hH in -/-- A piece of code between calls that keeps `KR`. -/ -theorem kr_rel {c : Prog isa} (hck : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) c hc).isSome = true) - (hw : ∀ {t₀ : State}, Pre (H := H) sc t₀ → ∀ s, KR (H := H) t₀ s → WP isa c s (KR (H := H) t₀)) : - RelCT isa (fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s') c - fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s' := - rel_taint pubRegs (fun _ _ h h' => kr_agree hq h h') hck (hw hp) (hw hp') - -/-- A call of `finalize` from a block that sets up its arguments. -/ -theorem fin_rel' {blk : List Instr} {c : BitVec 64} {F F' : State → Prop} - (hck : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block blk) hc).isSome = true) - (hag : ∀ s s', F s → F' s' → ∀ r ∈ pubRegs, s.gpr r = s'.gpr r) - (hb : ∀ s, F s → WP isa (.block blk) s fun t => KR (H := H) s₀ t ∧ - FinArgs hH t (inn s₀) (tO (H := H) s₀) (scr s₀) ∧ count t = c) - (hb' : ∀ s, F' s → WP isa (.block blk) s fun t => KR (H := H) s₀' t ∧ - FinArgs hH t (inn s₀') (tO (H := H) s₀') (scr s₀') ∧ count t = c) : - RelCT isa (fun s s' => F s ∧ F' s') (.seq (.block blk) (.frame (.push fin2) (.call H.finN H.finC) (.pop .r1 8))) - fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s' := by - obtain ⟨e1, e2, e3⟩ := eqs hq - have ha := rel_taint (G := fun t => KR (H := H) s₀ t ∧ FinArgs hH t (inn s₀) (tO (H := H) s₀) (scr s₀) ∧ - count t = c) - (G' := fun t => KR (H := H) s₀' t ∧ FinArgs hH t (inn s₀) (tO (H := H) s₀) (scr s₀) ∧ count t = c) - pubRegs hag hck (fun s h => hb s h) - (fun s h => WP.mono (hb' s h) fun _ ⟨k, a, x1⟩ => ⟨k, e1 ▸ e2 ▸ e3 ▸ a, x1⟩) - refine ha.seq (rel_wp (fin_rel hH (sp := s₀.sp) (st := inn s₀) (o := tO (H := H) s₀) (sc := scr s₀) - fun s s' ⟨⟨k, a, x1⟩, ⟨k', a', x1'⟩⟩ => ⟨a, a', by rw [x1, x1'], k.sp, by rw [k'.sp, hq.sp]⟩) - (fun _ ⟨k, a, _⟩ => finCall_ok hH hp k a fun _ k' _ _ => k') - (fun _ ⟨k, a, _⟩ => finCall_ok hH hp' k (e1.symm ▸ e2.symm ▸ e3.symm ▸ a) fun _ k' _ _ => k')) - -theorem ct (hc : Checks H) : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.finalize fun _ _ => True := by - obtain ⟨e1, e2, e3⟩ := eqs hq - have hcnt : count s₀ = count s₀' := by rw [count, count, hq.r2, hq.r3] - have pro : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') (.block H.finPrologue) - fun s s' => (KR (H := H) s₀ s ∧ count s = count s₀) ∧ (KR (H := H) s₀' s' ∧ count s' = count s₀') := - rel_agree (argTaint args 8) (fun s s' e e' => by - rw [e, e'] - refine agree_argTaint (fun r hr => ?_) hq.sp (args_wf hp) (args_wf hp') - (argMem_of (j := 2) hq.sp hp.spf fun i hi => by - rcases (show i = 0 ∨ i = 1 by omega_nat) with rfl | rfl - · exact hq.a0 - · exact hq.a1) - 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 WP.mono (pro_ok hp) fun _ ⟨k, _, x, _⟩ => ⟨k, x⟩) - (fun _ e => by rw [e]; exact WP.mono (pro_ok hp') fun _ ⟨k, _, x, _⟩ => ⟨k, x⟩) - have fin1 := fin_rel' hH hp hp' hq (c := count s₀) - (F := fun s => KR (H := H) s₀ s ∧ count s = count s₀) - (F' := fun s => KR (H := H) s₀' s ∧ count s = count s₀') hc.fin1 - (fun _ _ h h' => kr_agree hq h.1 h'.1) - (fun s ⟨k, x⟩ => WP.mono (fin1Args_ok hH hp k) fun _ ⟨k, a, x1, _⟩ => ⟨k, a, x1.trans x⟩) - (fun s ⟨k, x⟩ => WP.mono (fin1Args_ok hH hp' k) fun _ ⟨k, a, x1, _⟩ => ⟨k, a, x1.trans (x.trans hcnt.symm)⟩) - have fin2 := fin_rel' hH hp hp' hq (c := BitVec.ofNat 64 (H.B + H.D)) (F := KR (H := H) s₀) - (F' := KR (H := H) s₀') hc.fin2 - (fun _ _ h h' => kr_agree hq h h') - (fun s k => WP.mono (fin2Args_ok hH hp k) fun _ ⟨k, a, x1, _⟩ => ⟨k, a, x1⟩) - (fun s k => WP.mono (fin2Args_ok hH hp' k) fun _ ⟨k, a, x1, _⟩ => ⟨k, a, x1⟩) - have upd : RelCT isa (fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s') - (H.callUpd [.mov .r0 (.reg .r4)] H.B H.buf H.D) fun s s' => KR (H := H) s₀ s ∧ KR (H := H) s₀' s' := by - have ha := rel_taint (G := fun t => KR (H := H) s₀ t ∧ - UpdArgs hH t (inn s₀) (tO (H := H) s₀) (scr s₀) H.D ∧ count t = BitVec.ofNat 64 H.B) - (G' := fun t => KR (H := H) s₀' t ∧ - UpdArgs hH t (inn s₀) (tO (H := H) s₀) (scr s₀) H.D ∧ count t = BitVec.ofNat 64 H.B) - pubRegs (fun _ _ h h' => kr_agree hq h h') hc.upd - (fun s h => WP.mono (updArgs_ok hH hp h) fun _ ⟨k, a, x1, _⟩ => ⟨k, a, x1⟩) - (fun s h => WP.mono (updArgs_ok hH hp' h) fun _ ⟨k, a, x1, _⟩ => ⟨k, e1 ▸ e2 ▸ e3 ▸ a, x1⟩) - exact ha.seq (rel_wp (upd_rel hH (sp := s₀.sp) (st := inn s₀) (d := tO (H := H) s₀) (sc := scr s₀) - (len := H.D) - fun s s' ⟨⟨k, a, x1⟩, ⟨k', a', x1'⟩⟩ => ⟨a, a', by rw [x1, x1'], k.sp, by rw [k'.sp, hq.sp]⟩) - (fun _ ⟨k, a, _⟩ => updCall_ok hH hp k a fun _ k' _ _ => k') - (fun _ ⟨k, a, _⟩ => updCall_ok hH hp' k (e1.symm ▸ e2.symm ▸ e3.symm ▸ a) fun _ k' _ _ => k')) - have c1 := kr_rel hp hp' hq hc.copy1 fun hp s k => WP.mono (copy1_ok hp k) fun _ h => h.1 - have c2 := kr_rel hp hp' hq hc.copy2 fun hp s k => WP.mono (copy2_ok hp k) fun _ h => h.1 - 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 pro.seq (fin1.seq (c1.seq (upd.seq (fin2.seq (c2.seq restore))))) - -end VG.Proof.Hmac.Generic.Arm.Finalize - -namespace VG.Proof.Hmac.Generic.Arm.Finalize - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash) - -/-- `finalize` is verified against `finG`, 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 + H.F ≤ 8 * sc) (hsat : ∃ s, (finG hH.SH sc).pre s) : - Verified Arm.target H.finalize (finG hH.SH sc) := by - refine ⟨fun s hs => correct hH (pre_of hH sc hs hfit), fun s₁ s₂ t₁ t₂ s₁' s₂' h₁ h₂ hpub e₁ e₂ => ?_, hsat⟩ - obtain ⟨h1, h2, h3, h4, h5, h6, h7⟩ := hpub - exact (ct hH (pre_of hH sc h₁ hfit) (pre_of hH sc h₂ hfit) ⟨h1, h2, h3, h4, h5, h6, h7⟩ hc - _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 - -end VG.Proof.Hmac.Generic.Arm.Finalize - /-! # HMAC over the streaming hash functions on 32-bit ARM: the instances @@ -455,15 +260,6 @@ theorem sha1_initChecks : Init.Checks sha1H where argU₂ := ⟨_, by taint_decide⟩ restore := ⟨_, by taint_decide⟩ -theorem sha1_finChecks : Finalize.Checks sha1H where - pro := ⟨_, by taint_decide⟩ - fin1 := ⟨_, by taint_decide⟩ - copy1 := ⟨_, by taint_decide⟩ - upd := ⟨_, by taint_decide⟩ - fin2 := ⟨_, by taint_decide⟩ - copy2 := ⟨_, 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) @@ -475,9 +271,6 @@ theorem sha1_finImp : (finG Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.finaliz 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 -theorem sha1_finalize : Verified Arm.target sha1H.finalize (Spec.Hmac.sha1I.finalizeContract Arm.abi 16) := - (Finalize.verified sha1OK sha1_finChecks (by decide) sha1_finImp.sat_left).of_implies sha1_finImp - /-! ## MD5 -/ theorem md5_initChecks : Init.Checks md5H where @@ -489,15 +282,6 @@ theorem md5_initChecks : Init.Checks md5H where argU₂ := ⟨_, by taint_decide⟩ restore := ⟨_, by taint_decide⟩ -theorem md5_finChecks : Finalize.Checks md5H where - pro := ⟨_, by taint_decide⟩ - fin1 := ⟨_, by taint_decide⟩ - copy1 := ⟨_, by taint_decide⟩ - upd := ⟨_, by taint_decide⟩ - fin2 := ⟨_, by taint_decide⟩ - copy2 := ⟨_, 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) @@ -509,9 +293,6 @@ theorem md5_finImp : (finG Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.finalizeCo 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 -theorem md5_finalize : Verified Arm.target md5H.finalize (Spec.Hmac.md5I.finalizeContract Arm.abi 16) := - (Finalize.verified md5OK md5_finChecks (by decide) md5_finImp.sat_left).of_implies md5_finImp - /-- `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 @@ -531,15 +312,6 @@ theorem sha384_initChecks : Init.Checks sha384H where argU₂ := ⟨_, by taint_decide⟩ restore := ⟨_, by taint_decide⟩ -theorem sha384_finChecks : Finalize.Checks sha384H where - pro := ⟨_, by taint_decide⟩ - fin1 := ⟨_, by taint_decide⟩ - copy1 := ⟨_, by taint_decide⟩ - upd := ⟨_, by taint_decide⟩ - fin2 := ⟨_, by taint_decide⟩ - copy2 := ⟨_, 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) @@ -551,18 +323,11 @@ theorem sha384_finImp : (finG Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I. 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 -theorem sha384_finalize : Verified Arm.target sha384H.finalize (Spec.Hmac.sha384I.finalizeContract Arm.abi 16) := - (Finalize.verified sha384OK sha384_finChecks (by decide) sha384_finImp.sat_left).of_implies sha384_finImp - /-! ## SHA-512 -/ theorem sha512_initChecks : Init.Checks sha512H' := Init.Checks.of_eq (H := sha384H) rfl rfl rfl sha384_initChecks -theorem sha512_finChecks : Finalize.Checks sha512H' := - Finalize.Checks.of_sizes (H := sha384H) rfl rfl rfl sha384_finChecks ⟨_, 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 sha384_initImp.sat @@ -574,18 +339,12 @@ theorem sha512_finImp : (finG Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I. 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 -theorem sha512_finalize : Verified Arm.target sha512H'.finalize (Spec.Hmac.sha512I.finalizeContract Arm.abi 16) := - (Finalize.verified sha512OK sha512_finChecks (by decide) sha512_finImp.sat_left).of_implies sha512_finImp /-! ## 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_finChecks : Finalize.Checks sha512_224H := - Finalize.Checks.of_sizes (H := sha384H) rfl rfl rfl sha384_finChecks ⟨_, 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 sha384_initImp.sat @@ -597,18 +356,11 @@ theorem sha512_224_finImp : (finG Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac. 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 -theorem sha512_224_finalize : Verified Arm.target sha512_224H.finalize (Spec.Hmac.sha512_224I.finalizeContract Arm.abi 16) := - (Finalize.verified sha512_224OK sha512_224_finChecks (by decide) sha512_224_finImp.sat_left).of_implies sha512_224_finImp - /-! ## 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_finChecks : Finalize.Checks sha512_256H := - Finalize.Checks.of_sizes (H := sha384H) rfl rfl rfl sha384_finChecks ⟨_, 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 sha384_initImp.sat @@ -620,7 +372,4 @@ theorem sha512_256_finImp : (finG Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac. 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 -theorem sha512_256_finalize : Verified Arm.target sha512_256H.finalize (Spec.Hmac.sha512_256I.finalizeContract Arm.abi 16) := - (Finalize.verified sha512_256OK sha512_256_finChecks (by decide) sha512_256_finImp.sat_left).of_implies sha512_256_finImp - end VG.Proof.Hmac.Generic.Arm.Instances diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha224.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha224.lean index 955428184..6a5d08042 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha224.lean +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha224.lean @@ -88,15 +88,6 @@ theorem sha224_initChecks : Init.Checks sha224H where argU₂ := ⟨_, by taint_decide⟩ restore := ⟨_, by taint_decide⟩ -theorem sha224_finChecks : Finalize.Checks sha224H where - pro := ⟨_, by taint_decide⟩ - fin1 := ⟨_, by taint_decide⟩ - copy1 := ⟨_, by taint_decide⟩ - upd := ⟨_, by taint_decide⟩ - fin2 := ⟨_, by taint_decide⟩ - copy2 := ⟨_, 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, @@ -110,7 +101,4 @@ theorem sha224_finImp : (finG Spec.Hmac.sha224S 104).Implies (Spec.Hmac.sha224I. 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 -theorem sha224_finalize : Verified Arm.target sha224H.finalize (Spec.Hmac.sha224I.finalizeContract Arm.abi 16) := - (Finalize.verified sha224OK sha224_finChecks (by decide) sha224_finImp.sat_left).of_implies sha224_finImp - end VG.Proof.Hmac.Generic.Arm.Instances diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Finalize.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Finalize.lean index f7baf6062..fc4802e9f 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Finalize.lean +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Finalize.lean @@ -6,7 +6,7 @@ import VerifiedGarbage.Proof.Framework.OmegaLit # HMAC over any streaming hash function on x86 (32-bit): `finalize`, correct Untrusted: everything here is checked by Lean. As on the other targets -(`Proof/Hmac/Generic/Arm/Finalize.lean`). The arguments are on the stack: +(`Proof/Hmac/Generic/AArch64/Finalize.lean`). The arguments are on the stack: `scratch`, `inner`, `outer` and `out` are loaded first (after our caller's registers are saved in `scratch`), and the count just before the first call, which passes it on. diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Instances.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Instances.lean index f449a7b02..ca7101bf3 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Instances.lean @@ -7,7 +7,7 @@ import VerifiedGarbage.Proof.Hmac.Generic.X86.Hashes # HMAC over the streaming hash functions on x86 (32-bit): the instances Untrusted: everything here is checked by Lean. As on the other targets -(`Proof/Hmac/Generic/Arm/Instances.lean`): the generic proofs at each hash +(`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. diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/Arm/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/Arm/Instances.lean deleted file mode 100644 index c563da279..000000000 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/Arm/Instances.lean +++ /dev/null @@ -1,1184 +0,0 @@ -import VerifiedGarbage.Impl.Pbkdf2.Generic.Arm -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Finalize -import VerifiedGarbage.Proof.Hmac.Generic.Implies -import VerifiedGarbage.Proof.Framework.Arm.Contract -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Hashes - -/-! -# PBKDF2-HMAC over any streaming hash function on 32-bit ARM: `iterate`, correct - -Untrusted: everything here is checked by Lean. As on x86 -(`Proof/Pbkdf2/Generic/X86/Iterate.lean`). `scratch` is a stack -argument, loaded into `r12` first; the loop counts the steps left in `r6` -down with `subs`, and branches on its result. --/ - -namespace VG.Proof.Pbkdf2.Generic.Arm - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash copy scrAt) -open VG.Impl.Pbkdf2.Generic.Arm (stO tmpO uO xorLoop count2 atSt body prologue iterate) -open VG.Proof.Hmac.Generic.Arm -open VG.Proof.Hmac.Generic.Arm.Finalize (add_zero') -open VG.Proof.Hmac.Generic.Common (inRegions_of_sub xorBytes_length') -open VG.Proof.Hmac.Generic.Common (sub_of_off sub_of_self bytes_keep) -open VG.Proof.Hmac.Generic.Common (bytesAt_take bytesAt_writeBytes_self') -open VG.Proof.Hmac.Common (xorPad_length) -open VG.Proof.MdStream.Arm (Upd Fupd wp_mov wp_add wp_subs wp_cmp wp_ldrSp op2_imm op2_reg sub_offset - ofNat_beq_zero sub_ofNat eval_eq eval_ne) -open VG.Proof.Hmac.Common (bytesAt_length writeBytes_at bytesAt_getD') -open VG.Proof.Sha256.Stream (writeBytes) -open Spec.Sha256 (bytesAt) -open Spec.Hmac (xorPad ipad opad hmacBlockKey) - -variable {H : Hash} (hH : HashOK H) (sc : Nat) - -section -variable (s₀ : State) - -abbrev key : BitVec 32 := s₀.gpr .r0 -abbrev up : BitVec 32 := s₀.gpr .r1 -abbrev tp : BitVec 32 := s₀.gpr .r3 -abbrev scr : BitVec 32 := stackArg s₀ 0 -/-- The number of steps. -/ -abbrev nn : Nat := (s₀.gpr .r2).toNat -abbrev keyR : Region := ⟨State.addr (key s₀), 2 * H.S⟩ -abbrev uR : Region := ⟨State.addr (up s₀), H.D⟩ -abbrev tR : Region := ⟨State.addr (tp s₀), H.D⟩ -abbrev scR : Region := ⟨State.addr (scr s₀), 8 * sc⟩ -abbrev argR : Region := ⟨stackArgAddr s₀ 0, 4⟩ -abbrev stkR : Region := below s₀ -/-- Byte `o` of `scratch`, and its address as a register holds it. -/ -abbrev SA (o : Nat) : Addr := State.addr (scr s₀) + BitVec.ofNat 64 o -abbrev sO (o : Nat) : BitVec 32 := scr s₀ + BitVec.ofNat 32 o -/-- The state being hashed, the inner digest and `U`, in `scratch`. -/ -abbrev ST : Addr := SA s₀ (stO H) -abbrev TM : Addr := SA s₀ (tmpO H) -abbrev UA : Addr := SA s₀ (uO H) -abbrev calR : Region := ⟨State.addr (scr s₀), hH.Wb⟩ - -end - -/-- The precondition, with the sizes of `H`. -/ -structure Pre (s₀ : State) : Prop where - rd : s₀.rd = [keyR (H := H) s₀, uR (H := H) s₀, argR s₀] - wr : s₀.wr = [tR (H := H) s₀, scR sc s₀] - k_t : (keyR (H := H) s₀).Disjoint (tR (H := H) s₀) - k_s : (keyR (H := H) s₀).Disjoint (scR sc s₀) - u_t : (uR (H := H) s₀).Disjoint (tR (H := H) s₀) - u_s : (uR (H := H) s₀).Disjoint (scR sc s₀) - t_s : (tR (H := H) s₀).Disjoint (scR sc s₀) - a_t : (argR s₀).Disjoint (tR (H := H) s₀) - a_s : (argR s₀).Disjoint (scR sc s₀) - b_k : (stkR s₀).Disjoint (keyR (H := H) s₀) - b_u : (stkR s₀).Disjoint (uR (H := H) s₀) - b_t : (stkR s₀).Disjoint (tR (H := H) s₀) - b_s : (stkR s₀).Disjoint (scR sc s₀) - nk : (key s₀).toNat + 2 * H.S ≤ 2 ^ 32 - nu : (up s₀).toNat + H.D ≤ 2 ^ 32 - nt : (tp s₀).toNat + H.D ≤ 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 + H.S + 2 * H.F ≤ 8 * sc - hB : 0 < H.B ∧ H.B ≤ 128 - hW : H.W ≤ 64 - hS : 0 < H.S ∧ H.S ≤ 256 - hD : 0 < H.D ∧ H.D ≤ H.F ∧ H.F ≤ 64 - -theorem pre_of {s₀ : State} (h : (iterG hH.SH sc).pre s₀) (hfit : H.buf + H.S + 2 * H.F ≤ 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⟩ := h - have hS := hH.hS - have hD := hH.hD - simp only [hS, hD] at * - exact ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, hfit, - ⟨hH.hB0, hH.hBB⟩, hH.hW, ⟨hH.hS0, hH.hSB⟩, ⟨hH.hD0, hH.hDF, hH.hF⟩⟩ - -/-! ## The parts of `scratch` -/ - -section -variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) -include hp - -theorem bounds : H.buf = 8 * H.W + 36 ∧ H.buf + H.S + 2 * H.F ≤ 8 * sc ∧ (scr s₀).toNat + 8 * sc ≤ 2 ^ 32 ∧ - H.W ≤ 64 ∧ 0 < H.S ∧ H.S ≤ 256 ∧ 0 < H.D ∧ H.D ≤ H.F ∧ H.F ≤ 64 ∧ 0 < H.B ∧ H.B ≤ 128 := - ⟨rfl, hp.fits, hp.nw, hp.hW, hp.hS.1, hp.hS.2, hp.hD.1, hp.hD.2.1, hp.hD.2.2, hp.hB.1, hp.hB.2⟩ - -theorem off_sub {o n : Nat} (h : o + n ≤ 8 * sc) : - Region.Sub ⟨SA s₀ o, n⟩ (scR sc s₀) := - sub_offset h (by have := hp.nw; omega) - -theorem addr_sO {o : Nat} (h : o < 8 * sc) : State.addr (sO s₀ o) = SA s₀ o := - addr_add (by have := hp.nw; omega) - -theorem toNat_sO {o : Nat} (h : o < 8 * sc) : (sO 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.mod_eq_of_lt (by omega)] - -theorem save_sub : Region.Sub (saveR H (scr s₀)) (scR sc s₀) := by - obtain ⟨hb, hf, -⟩ := bounds hp; exact off_sub hp (by omega) - -theorem st_sub : Region.Sub ⟨ST (H := H) s₀, H.S⟩ (scR sc s₀) := by - obtain ⟨hb, hf, -⟩ := bounds hp; exact off_sub hp (by simp only [stO]; omega) - -theorem tm_sub : Region.Sub ⟨TM (H := H) s₀, H.F⟩ (scR sc s₀) := by - obtain ⟨hb, hf, -⟩ := bounds hp; exact off_sub hp (by simp only [tmpO]; omega) - -theorem ua_sub : Region.Sub ⟨UA (H := H) s₀, H.F⟩ (scR sc s₀) := by - obtain ⟨hb, hf, -⟩ := bounds hp; exact off_sub hp (by simp only [uO]; omega) - -include hH in -theorem cal_sub : Region.Sub (calR hH s₀) (scR sc s₀) := by - have := hH.hWb; obtain ⟨hb, hf, -⟩ := bounds hp - exact Region.sub_prefix (by omega) - -/-- The parts of `scratch` do not overlap. -/ -theorem part_disj {a m b n : Nat} (h : a + m ≤ b ∨ b + n ≤ a) (ha : a + m ≤ 8 * sc) (hb : b + n ≤ 8 * sc) : - Region.Disjoint ⟨SA s₀ a, m⟩ ⟨SA s₀ b, n⟩ := - VG.Proof.Hmac.Generic.Common.off_disj _ h (by have := hp.nw; omega) (by have := hp.nw; omega) - -include hH in -theorem cal_disj {b n : Nat} (h : 8 * H.W ≤ b) (hb : b + n ≤ 8 * sc) : - (calR hH s₀).Disjoint ⟨SA s₀ b, n⟩ := by - have := hH.hWb; have := hp.nw - exact VG.Proof.Hmac.Generic.Common.off_disj0 _ (by omega) (by omega) - -end - -/-! ## What the pieces keep -/ - -/-- The registers and memory kept from the prologue on, with `m` steps left: -everything written is in `T`, `scratch` or the stack below the stack -pointer. -/ -structure KR (s₀ : State) (m : Nat) (s : State) : Prop where - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - sp : s.sp = s₀.sp - r4 : s.gpr .r4 = key s₀ - r5 : s.gpr .r5 = tp s₀ - r6 : s.gpr .r6 = BitVec.ofNat 32 m - r11 : s.gpr .r11 = scr s₀ - saved : SavedRegs H (scr s₀) s₀ s.mem - frame : Frame [tR (H := H) s₀, scR sc s₀, stkR s₀] s₀.mem s.mem - -/-- The registers `KR` fixes. -/ -abbrev kregs : List Reg := [.r4, .r5, .r6, .r11] - -theorem kregs_pres : ∀ r ∈ kregs, r ∈ preserved ∧ r ≠ .lr := by decide -theorem kregs_clob : ∀ r ∈ kregs, r ∉ clob := by decide - -section -variable {sc : Nat} - -/-- `KR` survives changes to other registers, and to memory in `T`, -`scratch` (away from the save area) and the stack. -/ -theorem KR.keep {s₀ : State} {m : Nat} {s s' : State} (h : KR (H := H) sc s₀ m 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) - (hsub : ∀ r ∈ rs, ∃ r' ∈ [tR (H := H) s₀, scR sc s₀, stkR s₀], Region.Sub r r') : - KR (H := H) sc s₀ m 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.r6, (hg _ (by simp)).trans h.r11, - h.saved.frame H hf hs, h.frame.trans (hf.sub hsub)⟩ - -theorem KR.upd {s₀ : State} {m : Nat} {s s' : State} (h : KR (H := H) sc s₀ m s) {d : Reg} (hd : d ∉ kregs) - {v : BitVec 32} (u : Upd s s' d v) : KR (H := H) sc s₀ m 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) - -end - -section -variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) -include hp - -theorem KR.call {m : Nat} {s s' : State} (h : KR (H := H) sc s₀ m s) {ws : List Region} (ha : After s ws s') - (hs : ∀ r ∈ ws, (saveR H (scr s₀)).Disjoint r) (hsub : ∀ r ∈ ws, Region.Sub r (scR sc s₀)) : - KR (H := H) sc s₀ m s' := by - have f := ha.frame - rw [below_eq h.sp] at f - refine h.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 => ?_) (fun r hr => ?_) - · rcases List.mem_append.mp hr with hr | hr - · exact hs r hr - · simp only [List.mem_singleton] at hr; subst hr; exact hp.b_s.symm.sub_left (save_sub hp) - · rcases List.mem_append.mp hr with hr | hr - · exact ⟨scR sc s₀, by simp, hsub r hr⟩ - · simp only [List.mem_singleton] at hr; subst hr; exact ⟨stkR s₀, by simp, fun _ h => h⟩ - -theorem mem_wr : scR sc s₀ ∈ s₀.wr ∧ tR (H := H) s₀ ∈ s₀.wr := by rw [hp.wr]; simp - -theorem save_off {o n : Nat} (ho : 8 * H.W + 36 ≤ o) (h : o + n ≤ 8 * sc) : - (saveR H (scr s₀)).Disjoint ⟨SA s₀ o, n⟩ := - part_disj hp (a := 8 * H.W) (m := 36) (by omega) (by have := hp.fits; simp only [Hash.buf] at this; omega) h - -theorem off_lt {o : Nat} (ho : o ≤ uO H) : o < 4096 := by - obtain ⟨hb, -, -, hW, -, hS, -, -, hF, -⟩ := bounds hp - simp only [uO] at ho; omega - -/-! ## The copies of the key's states -/ - -theorem copyKey_ok {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m s) {o : Nat} (ho : o = 0 ∨ o = H.S) : - WP isa (copy .r4 o .r11 (stO H) H.S) s fun t => KR (H := H) sc s₀ m t ∧ - Frame [⟨ST (H := H) s₀, H.S⟩] s.mem t.mem ∧ - ∀ msg, hH.SH.Repr s₀.mem (State.addr (key s₀) + BitVec.ofNat 64 o) msg → - hH.SH.Repr t.mem (ST (H := H) s₀) msg := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, -⟩ := bounds hp - have hkn := hp.nk - have ksub : Region.Sub ⟨State.addr (key s₀) + BitVec.ofNat 64 o, H.S⟩ (keyR (H := H) s₀) := - sub_offset (by rcases ho with rfl | rfl <;> omega) (by rcases ho with rfl | rfl <;> omega) - have kR : keyR (H := H) s₀ ∈ s.rd ++ s.wr := by rw [hk.rd, hp.rd]; simp - have sR : scR sc s₀ ∈ s.wr := by rw [hk.wr]; exact (mem_wr hp).1 - have stsub := st_sub hp - refine WP.mono (copy_ok (so := o) (d := stO H) (n := H.S) (by decide) (by decide) - (by rcases ho with rfl | rfl <;> omega) (off_lt hp (by simp only [stO, uO]; omega)) hS0 (by omega) - (by rw [hk.r4]; rcases ho with rfl | rfl <;> omega) (by rw [hk.r11]; simp only [stO]; omega) - (fun k hk' => by rw [hk.r4]; exact inRegions_of_sub kR ksub (by omega) hk') - (fun k hk' => by rw [hk.r11]; exact inRegions_of_sub sR stsub (by omega) hk') - (by rw [hk.r4, hk.r11]; exact (hp.k_s.sub_left ksub).sub_right stsub)) fun t c => ?_ - rw [hk.r4, hk.r11] at c - have fr : Frame [⟨ST (H := H) s₀, H.S⟩] s.mem t.mem := - c.mem ▸ Proof.Sha256.Stream.writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact Region.contains_self _ _) - have sd : (saveR H (scr s₀)).Disjoint ⟨ST (H := H) s₀, H.S⟩ := - save_off hp (by simp only [stO]; omega) (by simp only [stO]; omega) - refine ⟨hk.keep c.rd c.wr c.sp (fun r hr => c.other r (not_cclob (kregs_clob r hr))) - fr (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact sd) - (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact ⟨_, by simp, stsub⟩), - fr, fun msg hr => ?_⟩ - refine hH.repr _ _ _ _ _ (fun i hi => ?_) hr - rw [c.mem, writeBytes_at _ _ _ (by rw [bytesAt_length]; exact hi) (by rw [bytesAt_length]; omega), - bytesAt_getD' _ _ hi] - -- The key's bytes are those of the initial memory. - refine hk.frame.bytes (R := ⟨State.addr (key s₀) + BitVec.ofNat 64 o, H.S⟩) ?_ (by show H.S ≤ 2 ^ 64; omega) hi - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact hp.k_t.sub_left ksub - · exact hp.k_s.sub_left ksub - · exact hp.b_k.symm.sub_left ksub - -/-! ## The calls -/ - -theorem updArgs_ok {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m s) {o : Nat} (ho : o = uO H ∨ o = tmpO H) : - WP isa (.block (atSt H ++ scrAt .r1 o ++ [.movw .r7 (BitVec.ofNat 16 H.D), .mov .r10 (.reg .r11), - .movw .r2 (BitVec.ofNat 16 H.B), .mov .r3 (.imm 0)])) s fun t => - KR (H := H) sc s₀ m t ∧ UpdArgs hH t (sO s₀ (stO H)) (sO s₀ o) (scr s₀) H.D ∧ - count t = BitVec.ofNat 64 H.B ∧ t.mem = s.mem := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have hwb := hH.hWb - have eu : uO H = H.buf + H.S + H.F := rfl - have et : tmpO H = H.buf + H.S := rfl - have es : stO H = H.buf := rfl - have ho' : stO H + H.S ≤ o ∧ o + H.F ≤ 8 * sc := by rcases ho with rfl | rfl <;> omega - have sR : scR sc s₀ ∈ s₀.wr := (mem_wr hp).1 - have dsub : Region.Sub ⟨SA s₀ o, H.D⟩ (scR sc s₀) := off_sub hp (by omega) - have eS := addr_sO hp (o := stO H) (by omega) - have eO := addr_sO hp (o := o) (by omega) - simp only [atSt, scrAt, List.cons_append, List.nil_append] - refine wp_movw fun s₁ u₁ => wp_add (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) sc s₀ m s₈ := - (((((((hk.upd (by decide) u₁).upd (by decide) u₂).upd (by decide) u₃).upd (by decide) u₄).upd - (by decide) u₅).upd (by decide) u₆).upd (by decide) u₇).upd (by decide) u₈ - refine ⟨k₈, ?_, count_movw (by omega) (by rw [u₈.other _ (by decide), u₇.gpr]) u₈.gpr, - by rw [u₈.mem, u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem]⟩ - 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, u₁.gpr, - u₁.other _ (by decide), hk.r11, movw_ofNat (by omega)] - 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), - u₁.other _ (by decide), hk.r11, movw_ofNat (by omega)] - r7 := by rw [u₈.other _ (by decide), u₇.other _ (by decide), u₆.other _ (by decide), u₅.gpr, - movw_ofNat (by omega)] - 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), u₁.other _ (by decide), - hk.r11] - hlen := by omega - sp16 := by rw [k₈.sp]; exact hp.sp16 - cd := by - rw [k₈.rd, k₈.wr, eO] - exact Covers.of_sub fun r hr => by - simp only [List.mem_singleton] at hr; subst hr - exact sub_of_off (List.mem_append_right _ sR) (by omega) - cw := by - rw [k₈.wr, eS] - 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_off sR (by omega) - · exact sub_of_self (r := scR sc s₀) sR (by show hH.Wb ≤ 8 * sc; omega) - st_sc := by rw [eS]; exact (cal_disj hH hp (by omega) (by omega)).symm - d_st := by rw [eO, eS]; exact part_disj hp (by omega) (by omega) (by omega) - d_sc := by rw [eO]; exact (cal_disj hH hp (by omega) (by omega)).symm - b_st := by rw [below_eq k₈.sp, eS]; exact hp.b_s.sub_right (st_sub hp) - b_d := by rw [below_eq k₈.sp, eO]; exact hp.b_s.sub_right dsub - b_sc := by rw [below_eq k₈.sp]; exact hp.b_s.sub_right (cal_sub hH hp) - nst := by rw [toNat_sO hp (by omega)]; omega - nd := by rw [toNat_sO hp (by omega)]; omega - nsc := by omega } - -theorem updCall_ok {m : Nat} {t : State} (hk : KR (H := H) sc s₀ m t) {o : Nat} (ho : o = uO H ∨ o = tmpO H) - (ha : UpdArgs hH t (sO s₀ (stO H)) (sO s₀ o) (scr s₀) H.D) {Q : State → Prop} - (hQ : ∀ s', KR (H := H) sc s₀ m s' → Frame [⟨ST (H := H) s₀, H.S⟩, calR hH s₀, stkR s₀] t.mem s'.mem → - (∀ msg, hH.SH.Repr t.mem (ST (H := H) s₀) msg → count t = BitVec.ofNat 64 msg.length → - hH.SH.Repr s'.mem (ST (H := H) s₀) (msg ++ bytesAt t.mem (SA s₀ o) H.D)) → Q s') : - WP isa (.frame (.push upd4) (.call H.updN H.updC) (.pop .r1 16)) t Q := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have hwb := hH.hWb - have eu : uO H = H.buf + H.S + H.F := rfl - have et : tmpO H = H.buf + H.S := rfl - have es : stO H = H.buf := rfl - have ho' : stO H + H.S ≤ o ∧ o + H.F ≤ 8 * sc := by rcases ho with rfl | rfl <;> omega - have eS := addr_sO hp (o := stO H) (by omega) - have eO := addr_sO hp (o := o) (by omega) - refine upd_frame hH ha fun s' ha' hpost => ?_ - have f := ha'.frame - rw [below_eq hk.sp, eS] at f - rw [eS, eO] at hpost - refine hQ s' (hk.call hp ha' ?_ ?_) f hpost - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rw [eS] - rintro r (rfl | rfl) - · exact save_off hp (by simp only [stO]; omega) (by simp only [stO]; omega) - · exact ((cal_disj hH hp (b := 8 * H.W) (n := 36) (Nat.le_refl _) (by omega))).symm - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rw [eS] - rintro r (rfl | rfl) - · exact st_sub hp - · exact cal_sub hH hp - -theorem finArgs_ok {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m s) {o : Nat} (ho : o = uO H ∨ o = tmpO H) : - WP isa (.block (atSt H ++ count2 H ++ scrAt .r1 o ++ [.mov .r12 (.reg .r11)])) s fun t => - KR (H := H) sc s₀ m t ∧ FinArgs hH t (sO s₀ (stO H)) (sO s₀ o) (scr s₀) ∧ - count t = BitVec.ofNat 64 (H.B + H.D) ∧ t.mem = s.mem := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have hwb := hH.hWb - have eu : uO H = H.buf + H.S + H.F := rfl - have et : tmpO H = H.buf + H.S := rfl - have es : stO H = H.buf := rfl - have ho' : stO H + H.S ≤ o ∧ o + H.F ≤ 8 * sc := by rcases ho with rfl | rfl <;> omega - have sR : scR sc s₀ ∈ s₀.wr := (mem_wr hp).1 - have osub : Region.Sub ⟨SA s₀ o, H.F⟩ (scR sc s₀) := off_sub hp (by omega) - have eS := addr_sO hp (o := stO H) (by omega) - have eO := addr_sO hp (o := o) (by omega) - simp only [atSt, count2, scrAt, List.cons_append, List.nil_append] - refine wp_movw fun s₁ u₁ => wp_add (op2_reg _ _) fun s₂ u₂ => wp_movw fun s₃ u₃ => - wp_mov (op2_imm (by decide)) fun s₄ u₄ => wp_movw fun s₅ u₅ => wp_add (op2_reg _ _) fun s₆ u₆ => - wp_mov (op2_reg _ _) fun s₇ u₇ => WP.block_nil ?_ - have k₇ : KR (H := H) sc s₀ m s₇ := - ((((((hk.upd (by decide) u₁).upd (by decide) u₂).upd (by decide) u₃).upd (by decide) u₄).upd - (by decide) u₅).upd (by decide) u₆).upd (by decide) u₇ - refine ⟨k₇, ?_, count_movw (by omega) ?_ ?_, by rw [u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem]⟩ - · 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₂.gpr, u₁.gpr, u₁.other _ (by decide), hk.r11, - movw_ofNat (by omega)] - r1 := by rw [u₇.other _ (by decide), u₆.gpr, u₅.gpr, u₅.other _ (by decide), u₄.other _ (by decide), - u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), hk.r11, movw_ofNat (by omega)] - r12 := by rw [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), hk.r11] - sp16 := by rw [k₇.sp]; exact hp.sp16 - cw := by - rw [k₇.wr, eS, eO] - 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 | rfl - · exact sub_of_off sR (by omega) - · exact sub_of_off sR (by omega) - · exact sub_of_self (r := scR sc s₀) sR (by show hH.Wb ≤ 8 * sc; omega) - st_o := by rw [eS, eO]; exact part_disj hp (by omega) (by omega) (by omega) - st_sc := by rw [eS]; exact (cal_disj hH hp (by omega) (by omega)).symm - o_sc := by rw [eO]; exact (cal_disj hH hp (by omega) (by omega)).symm - b_st := by rw [below_eq k₇.sp, eS]; exact hp.b_s.sub_right (st_sub hp) - b_o := by rw [below_eq k₇.sp, eO]; exact hp.b_s.sub_right osub - b_sc := by rw [below_eq k₇.sp]; exact hp.b_s.sub_right (cal_sub hH hp) - nst := by rw [toNat_sO hp (by omega)]; omega - no := by rw [toNat_sO hp (by omega)]; omega - nsc := by omega } - · 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] - -theorem finCall_ok {m : Nat} {t : State} (hk : KR (H := H) sc s₀ m t) {o : Nat} (ho : o = uO H ∨ o = tmpO H) - (ha : FinArgs hH t (sO s₀ (stO H)) (sO s₀ o) (scr s₀)) {Q : State → Prop} - (hQ : ∀ s', KR (H := H) sc s₀ m s' → - Frame [⟨ST (H := H) s₀, H.S⟩, ⟨SA s₀ o, H.F⟩, calR hH s₀, stkR s₀] t.mem s'.mem → - (∀ msg, hH.SH.Repr t.mem (ST (H := H) s₀) msg → msg.length < 2 ^ 64 → - count t = BitVec.ofNat 64 msg.length → - (bytesAt s'.mem (SA s₀ o) H.F).take H.D = hH.SH.H.hash msg) → Q s') : - WP isa (.frame (.push fin2) (.call H.finN H.finC) (.pop .r1 8)) t Q := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have hwb := hH.hWb - have eu : uO H = H.buf + H.S + H.F := rfl - have et : tmpO H = H.buf + H.S := rfl - have es : stO H = H.buf := rfl - have ho' : stO H + H.S ≤ o ∧ o + H.F ≤ 8 * sc := by rcases ho with rfl | rfl <;> omega - have eS := addr_sO hp (o := stO H) (by omega) - have eO := addr_sO hp (o := o) (by omega) - refine fin_frame hH ha fun s' ha' hpost => ?_ - have f := ha'.frame - rw [below_eq hk.sp, eS, eO] at f - rw [eS, eO] at hpost - refine hQ s' (hk.call hp ha' ?_ ?_) f hpost - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rw [eS, eO] - rintro r (rfl | rfl | rfl) - · exact save_off hp (by omega) (by omega) - · exact save_off hp (by omega) (by omega) - · exact ((cal_disj hH hp (b := 8 * H.W) (n := 36) (Nat.le_refl _) (by omega))).symm - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rw [eS, eO] - rintro r (rfl | rfl | rfl) - · exact st_sub hp - · exact off_sub hp (by omega) - · exact cal_sub hH hp - -/-! ## `T ← T ⊕ U` and the count -/ - -theorem xor'_ok {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m s) : - WP isa (xorLoop H) s fun t => KR (H := H) sc s₀ m t ∧ - t.mem = writeBytes s.mem (State.addr (tp s₀)) (Spec.Pbkdf2.xorBytes (bytesAt s.mem (State.addr (tp s₀)) H.D) - (bytesAt s.mem (UA (H := H) s₀) H.D)) := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have eu : uO H = H.buf + H.S + H.F := rfl - obtain ⟨sR, tR'⟩ := mem_wr hp - have nt := hp.nt - have usub : Region.Sub ⟨UA (H := H) s₀, H.D⟩ (scR sc s₀) := off_sub hp (by omega) - refine WP.mono (xor_ok (uo := uO H) (n := H.D) (off_lt hp (Nat.le_refl _)) hD0 (by omega) - (by rw [hk.r11]; omega) (by rw [hk.r5]; omega) - (fun k hk' => by - rw [hk.r11, hk.rd, hk.wr]; exact inRegions_of_sub (List.mem_append_right _ sR) usub (by omega) hk') - (fun k hk' => by rw [hk.r5, hk.wr]; exact inRegions_of_sub tR' (fun _ h => h) (by omega) hk') - (by rw [hk.r11, hk.r5]; exact hp.t_s.symm.sub_left usub)) fun t x => ?_ - rw [hk.r11, hk.r5] at x - refine ⟨hk.keep x.rd x.wr x.sp (fun r hr => x.other r (kregs_clob r hr)) - (x.mem ▸ Proof.Sha256.Stream.writeBytes_frame _ _ _ (R := tR (H := H) s₀) (by - rw [xorBytes_length' _ _ (by simp [bytesAt_length]), bytesAt_length]; exact Region.contains_self _ _)) - (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact hp.t_s.symm.sub_left (save_sub hp)) - (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact ⟨_, by simp, fun _ h => h⟩), x.mem⟩ - -omit hp in -theorem dec_ok {m : Nat} (hm : 1 ≤ m) (hn : m < 2 ^ 32) {s : State} (hk : KR (H := H) sc s₀ m s) : - WP isa (.block [.subs .r6 .r6 (.imm 1)]) s fun t => KR (H := H) sc s₀ (m - 1) t ∧ t.mem = s.mem ∧ - t.z = decide (m - 1 = 0) := - wp_subs (op2_imm (by decide)) fun t u z => WP.block_nil ⟨⟨by rw [u.rd, hk.rd], by rw [u.wr, hk.wr], - by rw [u.sp, hk.sp], by rw [u.other _ (by decide), hk.r4], by rw [u.other _ (by decide), hk.r5], - by rw [u.gpr, hk.r6, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat hm], - by rw [u.other _ (by decide), hk.r11], u.mem ▸ hk.saved, u.mem ▸ hk.frame⟩, - u.mem, by rw [z, hk.r6, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat hm, - ofNat_beq_zero (by omega)]⟩ - -end - -/-! ## One step -/ - -/-- The key's states represent `K₀ ⊕ ipad` and `K₀ ⊕ opad`. -/ -def KeyOK (s₀ : State) (k0 : List Byte) : Prop := - k0.length = H.B ∧ hH.SH.Repr s₀.mem (State.addr (key s₀)) (xorPad k0 ipad) ∧ - hH.SH.Repr s₀.mem (State.addr (key s₀) + BitVec.ofNat 64 H.S) (xorPad k0 opad) - -/-- With `m` steps left, what is left to compute is the rest of the whole. -/ -structure Inv (s₀ : State) (m : Nat) (s : State) : Prop where - kr : KR (H := H) sc s₀ m s - it : ∀ k0, KeyOK hH s₀ k0 → - Spec.Pbkdf2.iterate (hmacBlockKey hH.SH.H k0) (nn s₀) (bytesAt s₀.mem (State.addr (up s₀)) H.D) - (bytesAt s₀.mem (State.addr (tp s₀)) H.D) = - Spec.Pbkdf2.iterate (hmacBlockKey hH.SH.H k0) m (bytesAt s.mem (UA (H := H) s₀) H.D) - (bytesAt s.mem (State.addr (tp s₀)) H.D) - -section -variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) -include hp - -theorem body_ok {m : Nat} (hm : 1 ≤ m) (hn : m < 2 ^ 32) {s : State} (h : Inv hH sc s₀ m s) : - WP isa (body H) s fun t => Inv hH sc s₀ (m - 1) t ∧ t.z = decide (m - 1 = 0) := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have eu : uO H = H.buf + H.S + H.F := rfl - have et : tmpO H = H.buf + H.S := rfl - have es : stO H = H.buf := rfl - have hwb := hH.hWb - -- Where things are. - have ua : Region.Sub ⟨UA (H := H) s₀, H.D⟩ (scR sc s₀) := off_sub hp (by omega) - have dM₁ : Region.Disjoint ⟨TM (H := H) s₀, H.D⟩ ⟨ST (H := H) s₀, H.S⟩ := - part_disj hp (by omega) (by omega) (by omega) - have dU₁ : Region.Disjoint ⟨UA (H := H) s₀, H.D⟩ ⟨ST (H := H) s₀, H.S⟩ := - part_disj hp (by omega) (by omega) (by omega) - have dT : ∀ r : Region, Region.Sub r (scR sc s₀) → Region.Disjoint (tR (H := H) s₀) r := - fun r hr => hp.t_s.sub_right hr - have dT₄ : Region.Disjoint (tR (H := H) s₀) (stkR s₀) := hp.b_t.symm - have hDn : H.D ≤ 2 ^ 64 := by omega - -- The pieces. - refine WP.seq (WP.mono (copyKey_ok hH hp h.kr (.inl rfl)) fun c₁ ⟨kc₁, fc₁, rc₁⟩ => ?_) - refine WP.seq (WP.seq (WP.mono (updArgs_ok hH hp kc₁ (.inl rfl)) fun a₁ ⟨ka₁, aa₁, sa₁, ma₁⟩ => - updCall_ok hH hp ka₁ (.inl rfl) aa₁ fun u₁ ku₁ fu₁ ru₁ => ?_)) - refine WP.seq (WP.seq (WP.mono (finArgs_ok hH hp ku₁ (.inr rfl)) fun b₁ ⟨kb₁, ab₁, sb₁, mb₁⟩ => - finCall_ok hH hp kb₁ (.inr rfl) ab₁ fun f₁ kf₁ ff₁ rf₁ => ?_)) - refine WP.seq (WP.mono (copyKey_ok hH hp kf₁ (.inr rfl)) fun c₂ ⟨kc₂, fc₂, rc₂⟩ => ?_) - refine WP.seq (WP.seq (WP.mono (updArgs_ok hH hp kc₂ (.inr rfl)) fun a₂ ⟨ka₂, aa₂, sa₂, ma₂⟩ => - updCall_ok hH hp ka₂ (.inr rfl) aa₂ fun u₂ ku₂ fu₂ ru₂ => ?_)) - refine WP.seq (WP.seq (WP.mono (finArgs_ok hH hp ku₂ (.inl rfl)) fun b₂ ⟨kb₂, ab₂, sb₂, mb₂⟩ => - finCall_ok hH hp kb₂ (.inl rfl) ab₂ fun f₂ kf₂ ff₂ rf₂ => ?_)) - refine WP.seq (WP.mono (xor'_ok hp kf₂) fun x ⟨kx, mx⟩ => ?_) - refine WP.mono (dec_ok hm hn kx) fun t ⟨kt, mt, zt⟩ => ⟨⟨kt, fun k0 hk => ?_⟩, zt⟩ - -- The bytes of `U` and `T` at each point. - obtain ⟨hl0, hrI, hrO⟩ := hk - have U₁ : bytesAt c₁.mem (UA (H := H) s₀) H.D = bytesAt s.mem (UA (H := H) s₀) H.D := - bytes_keep fc₁ (by simp only [List.mem_singleton]; rintro r rfl; exact dU₁) hDn - have T₁ : bytesAt c₁.mem (State.addr (tp s₀)) H.D = bytesAt s.mem (State.addr (tp s₀)) H.D := - bytes_keep fc₁ (by simp only [List.mem_singleton]; rintro r rfl; exact dT _ (st_sub hp)) hDn - have T₂ : bytesAt u₁.mem (State.addr (tp s₀)) H.D = bytesAt c₁.mem (State.addr (tp s₀)) H.D := by - rw [← ma₁]; exact bytes_keep fu₁ (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact dT _ (st_sub hp) - · exact dT _ (cal_sub hH hp) - · exact dT₄) hDn - have T₃ : bytesAt f₁.mem (State.addr (tp s₀)) H.D = bytesAt u₁.mem (State.addr (tp s₀)) H.D := by - rw [← mb₁]; exact bytes_keep ff₁ (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl | rfl) - · exact dT _ (st_sub hp) - · exact dT _ (tm_sub hp) - · exact dT _ (cal_sub hH hp) - · exact dT₄) hDn - have T₄ : bytesAt c₂.mem (State.addr (tp s₀)) H.D = bytesAt f₁.mem (State.addr (tp s₀)) H.D := - bytes_keep fc₂ (by simp only [List.mem_singleton]; rintro r rfl; exact dT _ (st_sub hp)) hDn - have T₅ : bytesAt u₂.mem (State.addr (tp s₀)) H.D = bytesAt c₂.mem (State.addr (tp s₀)) H.D := by - rw [← ma₂]; exact bytes_keep fu₂ (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact dT _ (st_sub hp) - · exact dT _ (cal_sub hH hp) - · exact dT₄) hDn - have T₆ : bytesAt f₂.mem (State.addr (tp s₀)) H.D = bytesAt u₂.mem (State.addr (tp s₀)) H.D := by - rw [← mb₂]; exact bytes_keep ff₂ (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl | rfl) - · exact dT _ (st_sub hp) - · exact dT _ (ua_sub hp) - · exact dT _ (cal_sub hH hp) - · exact dT₄) hDn - have M₄ : bytesAt c₂.mem (TM (H := H) s₀) H.D = bytesAt f₁.mem (TM (H := H) s₀) H.D := - bytes_keep fc₂ (by simp only [List.mem_singleton]; rintro r rfl; exact dM₁) hDn - -- The inner hash. - have rI₁ := rc₁ _ (by rw [add_zero']; exact hrI) - have rU₁ := ru₁ _ (ma₁ ▸ rI₁) (by rw [sa₁, xorPad_length, hl0]) - rw [ma₁, U₁] at rU₁ - have hl₁ : (xorPad k0 ipad ++ bytesAt s.mem (UA (H := H) s₀) H.D).length = H.B + H.D := by - rw [List.length_append, xorPad_length, hl0, bytesAt_length] - have dig₁ := rf₁ _ (mb₁ ▸ rU₁) (by rw [hl₁]; omega) (by rw [sb₁, hl₁]) - -- The outer hash. - have rO₂ := rc₂ _ hrO - have rU₂ := ru₂ _ (ma₂ ▸ rO₂) (by rw [sa₂, xorPad_length, hl0]) - rw [ma₂, M₄, bytesAt_take _ _ hDF, dig₁] at rU₂ - have hl₂ : (xorPad k0 opad ++ hH.SH.H.hash (xorPad k0 ipad ++ bytesAt s.mem (UA (H := H) s₀) H.D)).length = - H.B + H.D := by - rw [List.length_append, xorPad_length, hl0, ← dig₁, List.length_take, bytesAt_length, Nat.min_eq_left hDF] - have dig₂ := rf₂ _ (mb₂ ▸ rU₂) (by rw [hl₂]; omega) (by rw [sb₂, hl₂]) - rw [← bytesAt_take _ _ hDF] at dig₂ - -- `T ← T ⊕ U`. - have hx : (Spec.Pbkdf2.xorBytes (bytesAt f₂.mem (State.addr (tp s₀)) H.D) - (bytesAt f₂.mem (UA (H := H) s₀) H.D)).length = H.D := by - rw [xorBytes_length' _ _ (by simp [bytesAt_length]), bytesAt_length] - have Ux : bytesAt t.mem (UA (H := H) s₀) H.D = bytesAt f₂.mem (UA (H := H) s₀) H.D := by - rw [mt, mx] - exact bytes_keep (Proof.Sha256.Stream.writeBytes_frame _ _ _ (R := tR (H := H) s₀) (by - rw [hx]; exact Region.contains_self _ _)) (by - simp only [List.mem_singleton]; rintro r rfl; exact (dT _ ua).symm) hDn - have Tx : bytesAt t.mem (State.addr (tp s₀)) H.D = Spec.Pbkdf2.xorBytes - (bytesAt f₂.mem (State.addr (tp s₀)) H.D) (bytesAt f₂.mem (UA (H := H) s₀) H.D) := by - rw [mt, mx]; exact bytesAt_writeBytes_self' hx (by omega) - rw [h.it k0 ⟨hl0, hrI, hrO⟩, show m = (m - 1) + 1 by omega, Ux, Tx, dig₂, T₆, T₅, T₄, T₃, T₂, T₁, - Nat.add_sub_cancel] - rfl - -/-! ## The prologue and the loop -/ - -omit hp in -theorem nn_lt : nn s₀ < 2 ^ 32 := (s₀.gpr .r2).isLt - -theorem pro_ok : WP isa (.block (prologue H)) s₀ fun t => KR (H := H) sc s₀ (nn s₀) t ∧ t.gpr .r1 = up s₀ ∧ - Frame [saveR H (scr s₀)] s₀.mem t.mem := by - have hW := hp.hW; have hf := hp.fits; have nw := hp.nw - simp only [Hash.buf] at hf - obtain ⟨sR, _⟩ := mem_wr hp - simp only [prologue, 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 sR) (by omega) (by omega) - 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.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] - have fs : Frame [saveR H (scr s₀)] s₀.mem s₆.mem := by rw [hm, ← u₁.mem]; exact f₂ - refine ⟨⟨by rw [u₆.rd, u₅.rd, u₄.rd, u₃.rd, rd₂, u₁.rd], by rw [u₆.wr, u₅.wr, u₄.wr, u₃.wr, wr₂, u₁.wr], - by rw [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₃.gpr, e₂ _ (by decide)], - by rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, u₃.other _ (by decide), e₂ _ (by decide)], - by rw [u₆.other _ (by decide), u₅.gpr, u₄.other _ (by decide), u₃.other _ (by decide), e₂ _ (by decide), - BitVec.ofNat_toNat, BitVec.setWidth_eq], - by rw [u₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), g₂, u₁.gpr]; rfl, - 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), - fs.sub (by simp only [List.mem_singleton]; rintro r rfl; exact ⟨scR sc s₀, by simp, save_sub hp⟩)⟩, - by rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), - e₂ _ (by decide)], fs⟩ - -/-- `U` into `scratch`. -/ -theorem copyU_ok {s : State} (hk : KR (H := H) sc s₀ (nn s₀) s) (hr1 : s.gpr .r1 = up s₀) - (hf : Frame [saveR H (scr s₀)] s₀.mem s.mem) : - WP isa (copy .r1 0 .r11 (uO H) H.D) s (Inv hH sc s₀ (nn s₀)) := by - obtain ⟨hb, hf', hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have eu : uO H = H.buf + H.S + H.F := rfl - obtain ⟨sR, tR'⟩ := mem_wr hp - have nu := hp.nu - have uR' : uR (H := H) s₀ ∈ s.rd ++ s.wr := by rw [hk.rd, hp.rd]; simp - have usub : Region.Sub ⟨UA (H := H) s₀, H.D⟩ (scR sc s₀) := off_sub hp (by omega) - refine WP.mono (copy_ok (so := 0) (d := uO H) (n := H.D) (by decide) (by decide) (by decide) - (off_lt hp (Nat.le_refl _)) hD0 (by omega) (by rw [hr1]; omega) (by rw [hk.r11]; omega) - (fun k hk' => by rw [hr1, add_zero']; exact inRegions_of_sub uR' (fun _ h => h) (by omega) hk') - (fun k hk' => by rw [hk.r11, hk.wr]; exact inRegions_of_sub sR usub (by omega) hk') - (by rw [hr1, hk.r11, add_zero']; exact hp.u_s.sub_right usub)) fun t c => ?_ - rw [hr1, hk.r11, add_zero'] at c - have fc : Frame [⟨UA (H := H) s₀, H.D⟩] s.mem t.mem := - c.mem ▸ Proof.Sha256.Stream.writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact Region.contains_self _ _) - refine ⟨hk.keep c.rd c.wr c.sp (fun r hr => c.other r (not_cclob (kregs_clob r hr))) - fc (fun r hr => by - simp only [List.mem_singleton] at hr; subst hr - exact save_off hp (by omega) (by omega)) - (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact ⟨_, by simp, usub⟩), fun k0 _ => ?_⟩ - congr 1 - · rw [c.mem, bytesAt_writeBytes_self' (bytesAt_length _ _ _) (by omega)] - exact (bytes_keep hf (by - simp only [List.mem_singleton]; rintro r rfl; exact hp.u_s.sub_right (save_sub hp)) (by omega)).symm - · exact ((bytes_keep fc (by simp only [List.mem_singleton]; rintro r rfl; exact hp.t_s.sub_right usub) - (by omega)).trans (bytes_keep hf (by - simp only [List.mem_singleton]; rintro r rfl; exact hp.t_s.sub_right (save_sub hp)) (by omega))).symm - -omit hp in -/-- `cmp r6, #0`: the flags of whether there are steps. -/ -theorem cmp_ok {s : State} (h : Inv hH sc s₀ (nn s₀) s) : - WP isa (.block [.cmp .r6 (.imm 0)]) s fun t => Inv hH sc s₀ (nn s₀) t ∧ t.z = decide (nn s₀ = 0) := by - refine wp_cmp (op2_imm (by decide)) fun s₁ f₁ z₁ => WP.block_nil ⟨⟨h.kr.keep f₁.rd f₁.wr f₁.sp - (fun r _ => by rw [f₁.gpr]) (rs := []) (by rw [f₁.mem]; exact Frame.refl _ _) (by simp) (by simp), - fun k0 hk => by rw [h.it k0 hk, f₁.mem]⟩, ?_⟩ - rw [z₁, h.kr.r6, show ∀ x : BitVec 32, x - 0 = x from fun x => BitVec.sub_zero x, ofNat_beq_zero nn_lt] - -theorem loop_ok {s : State} (h : Inv hH sc s₀ (nn s₀) s) (hz : s.z = decide (nn s₀ = 0)) : - WP isa (.ite .eq (.block []) (.loop (body H) .ne)) s (Inv hH sc s₀ 0) := by - have hlt := nn_lt (s₀ := s₀) - refine WP.ite (decide (nn s₀ = 0)) (by show eval .eq s = _; rw [eval_eq, hz]) (fun h0 => WP.block_nil ?_) - fun h0 => ?_ - · have e : nn s₀ = 0 := by simpa using h0 - exact e ▸ h - · have hpos : 1 ≤ nn s₀ := by have := of_decide_eq_false h0; omega - refine WP.loop (M := isa) (fun k t => ∃ m, k = m ∧ 1 ≤ m ∧ m ≤ nn s₀ ∧ Inv hH sc s₀ m t) ?_ (nn s₀) s - ⟨nn s₀, rfl, hpos, (Nat.le_refl _), h⟩ - rintro k t ⟨m, hkm, h1, h2, ht⟩ - refine WP.mono (body_ok hH hp h1 (by omega) ht) fun t' ⟨ht', hz'⟩ => ?_ - have he : isa.eval .ne t' = some (!decide (m - 1 = 0)) := by - show eval .ne t' = _; rw [eval_ne, hz'] - by_cases hl : m - 1 = 0 - · exact .inl ⟨by rw [he]; simp [hl], hl ▸ ht'⟩ - · exact .inr ⟨by rw [he]; simp [hl], m - 1, by omega, m - 1, rfl, by omega, by omega, ht'⟩ - -theorem correct : WP isa (iterate H) s₀ fun s' => abiPreserved s₀ s' ∧ (iterG hH.SH sc).post s₀ s' := by - obtain ⟨hb, hf', hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - refine WP.seq (WP.mono (pro_ok hp) fun s₂ ⟨k₂, x₂, f₂⟩ => ?_) - refine WP.seq (WP.mono (copyU_ok hH hp k₂ x₂ f₂) fun s₃ h₃ => ?_) - refine WP.seq (WP.mono (cmp_ok hH h₃) fun s₄ ⟨h₄, z₄⟩ => ?_) - refine WP.seq (WP.mono (loop_ok hH hp h₄ z₄) fun s₅ h₅ => ?_) - have k₅ := h₅.kr - have hL : 8 * H.W + 36 ≤ 8 * sc := by omega - refine WP.mono (restore_ok H k₅.r11 hW k₅.saved (by rw [k₅.wr]; exact (mem_wr hp).1) hL hnw) - fun s' ⟨hm, _, _, hsp, hg, _⟩ => ⟨⟨fun r hr => hg r (preserved_saved r hr), by rw [hsp, k₅.sp]⟩, ?_⟩ - intro k0 hl hrI hrO - have hS' := hH.hS; have hD' := hH.hD; have hB' := hH.hB - rw [hB'] at hl - rw [hS'] at hrO - show bytesAt s'.mem (State.addr (tp s₀)) hH.SH.digestBytes = _ - rw [hD', hm, h₅.it k0 ⟨hl, hrI, hrO⟩] - rfl - -end - -end VG.Proof.Pbkdf2.Generic.Arm - -/-! -# PBKDF2-HMAC over any streaming hash function on 32-bit ARM: `iterate`, constant time - -Untrusted: everything here is checked by Lean. As on x86 -(`Proof/Pbkdf2/Generic/X86/IterateCT.lean`); the prologue loads -`scratch` from the stack, so its taint check starts with the stack argument -public (`argTaint`). --/ - -namespace VG.Proof.Pbkdf2.Generic.Arm - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash copy scrAt) -open VG.Impl.Pbkdf2.Generic.Arm (stO tmpO uO xorLoop count2 atSt body prologue iterate) -open VG.Proof.MdStream.Arm (eval_eq eval_ne) -open VG.Proof.Hmac.Generic.Arm - -/-- The argument registers. -/ -abbrev args : List Reg := [.r0, .r1, .r2, .r3] - -/-- The registers `KR` fixes that the code between the calls uses. -/ -abbrev pubRegs : List Reg := [.r4, .r5, .r6, .r11] - -/-- The block that sets up a call of `update` on the state, with `D` bytes at `scratch + o`. -/ -abbrev updBlock (H : Hash) (o : Nat) : List Instr := - atSt H ++ scrAt .r1 o ++ [.movw .r7 (BitVec.ofNat 16 H.D), .mov .r10 (.reg .r11), - .movw .r2 (BitVec.ofNat 16 H.B), .mov .r3 (.imm 0)] - -/-- The block that sets up a call of `finalize` on the state, into `scratch + o`. -/ -abbrev finBlock (H : Hash) (o : Nat) : List Instr := - atSt H ++ count2 H ++ scrAt .r1 o ++ [.mov .r12 (.reg .r11)] - -theorem skip_check : ∃ hc, (VG.Taint.check taint (Taint.ofRegs []) (.block []) hc).isSome = true := - ⟨_, by taint_decide⟩ - -theorem cmp_check : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block [.cmp .r6 (.imm 0)]) hc).isSome = true := - ⟨_, by taint_decide⟩ - -theorem dec_check : - ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block [.subs .r6 .r6 (.imm 1)]) hc).isSome = true := - ⟨_, by taint_decide⟩ - -/-- The taint checks of the pieces of `iterate` between its calls. -/ -structure Checks (H : Hash) : Prop where - pro : ∃ hc, (VG.Taint.check taint (argTaint args 4) (.block (prologue H)) hc).isSome = true - copyU : ∃ hc, - (VG.Taint.check taint (Taint.ofRegs (.r1 :: pubRegs)) (copy .r1 0 .r11 (uO H) H.D) hc).isSome = true - copyK : ∀ o ∈ [0, H.S], ∃ hc, - (VG.Taint.check taint (Taint.ofRegs pubRegs) (copy .r4 o .r11 (stO H) H.S) hc).isSome = true - upd : ∀ o ∈ [uO H, tmpO H], ∃ hc, - (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block (updBlock H o)) hc).isSome = true - fin : ∀ o ∈ [uO H, tmpO H], ∃ hc, - (VG.Taint.check taint (Taint.ofRegs pubRegs) (.block (finBlock H o)) hc).isSome = true - xor : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) (xorLoop H) 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} -variable {s₀ s₀' : State} (hp : Pre (H := H) sc s₀) (hp' : Pre (H := H) sc s₀') (hq : PubEq s₀ s₀') - -theorem PubEq.nn (hq : PubEq s₀ s₀') : Generic.Arm.nn s₀ = Generic.Arm.nn s₀' := by - show (s₀.gpr .r2).toNat = (s₀'.gpr .r2).toNat; rw [hq.r2] - -theorem kr_agree (hq : PubEq s₀ s₀') {m : Nat} {s s' : State} (h : KR (H := H) sc s₀ m s) - (h' : KR (H := H) sc s₀' m 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 | rfl - · rw [h.r4, h'.r4, key, key, hq.r0] - · rw [h.r5, h'.r5, tp, tp, hq.r3] - · rw [h.r6, h'.r6] - · rw [h.r11, h'.r11, scr, scr, hq.a0] - -theorem eqs (hq : PubEq s₀ s₀') : scr s₀' = scr s₀ ∧ ∀ o : Nat, sO s₀' o = sO s₀ o := - ⟨hq.a0.symm, fun o => by rw [sO, sO, 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) - · exact h.a_t - · exact h.a_s - -omit hp hp' hq in -theorem UpdArgs.congr {t : State} {st st' d d' c c' : BitVec 32} {len : Nat} (h₁ : st = st') (h₂ : d = d') - (h₃ : c = c') (a : UpdArgs hH t st d c len) : UpdArgs hH t st' d' c' len := by - subst h₁ h₂ h₃; exact a - -omit hp hp' hq in -theorem FinArgs.congr {t : State} {st st' d d' c c' : BitVec 32} (h₁ : st = st') (h₂ : d = d') - (h₃ : c = c') (a : FinArgs hH t st d c) : FinArgs hH t st' d' c' := by - subst h₁ h₂ h₃; exact a - -include hH hp hp' hq - -omit hH in -/-- A piece of code between calls that keeps `KR`. -/ -theorem kr_rel {m : Nat} {c : Prog isa} - (hck : ∃ hc, (VG.Taint.check taint (Taint.ofRegs pubRegs) c hc).isSome = true) - (hw : ∀ {t₀ : State}, Pre (H := H) sc t₀ → ∀ s, KR (H := H) sc t₀ m s → WP isa c s (KR (H := H) sc t₀ m)) : - RelCT isa (fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s') c - fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s' := - rel_taint pubRegs (fun _ _ h h' => kr_agree hq h h') hck (hw hp) (hw hp') - -theorem upd_rel' {m : Nat} {o : Nat} (ho : o = uO H ∨ o = tmpO H) (hc : Checks H) : - RelCT isa (fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s') - (H.callUpd (atSt H) H.B o H.D) - fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s' := by - obtain ⟨e2, e3⟩ := eqs hq - have ha := rel_taint (G := fun t => KR (H := H) sc s₀ m t ∧ - UpdArgs hH t (sO s₀ (stO H)) (sO s₀ o) (scr s₀) H.D ∧ count t = BitVec.ofNat 64 H.B) - (G' := fun t => KR (H := H) sc s₀' m t ∧ - UpdArgs hH t (sO s₀ (stO H)) (sO s₀ o) (scr s₀) H.D ∧ count t = BitVec.ofNat 64 H.B) - pubRegs (fun _ _ h h' => kr_agree hq h h') (hc.upd o (by rcases ho with rfl | rfl <;> simp)) - (fun s h => WP.mono (updArgs_ok hH hp h ho) fun _ ⟨k, a, x1, _⟩ => ⟨k, a, x1⟩) - (fun s h => WP.mono (updArgs_ok hH hp' h ho) fun _ ⟨k, a, x1, _⟩ => - ⟨k, UpdArgs.congr hH (e3 _) (e3 o) e2 a, x1⟩) - exact ha.seq (rel_wp (upd_rel hH (sp := s₀.sp) (st := sO s₀ (stO H)) (d := sO s₀ o) (sc := scr s₀) - (len := H.D) fun s s' ⟨⟨k, a, x1⟩, ⟨k', a', x1'⟩⟩ => ⟨a, a', by rw [x1, x1'], k.sp, by rw [k'.sp, hq.sp]⟩) - (fun _ ⟨k, a, _⟩ => updCall_ok hH hp k ho a fun _ k' _ _ => k') - (fun _ ⟨k, a, _⟩ => updCall_ok hH hp' k ho (UpdArgs.congr hH (e3 _).symm (e3 o).symm e2.symm a) - fun _ k' _ _ => k')) - -theorem fin_rel' {m : Nat} {o : Nat} (ho : o = uO H ∨ o = tmpO H) (hc : Checks H) : - RelCT isa (fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s') - (H.callFin (atSt H) (count2 H) o) - fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s' := by - obtain ⟨e2, e3⟩ := eqs hq - have ha := rel_taint (G := fun t => KR (H := H) sc s₀ m t ∧ - FinArgs hH t (sO s₀ (stO H)) (sO s₀ o) (scr s₀) ∧ count t = BitVec.ofNat 64 (H.B + H.D)) - (G' := fun t => KR (H := H) sc s₀' m t ∧ - FinArgs hH t (sO s₀ (stO H)) (sO s₀ o) (scr s₀) ∧ count t = BitVec.ofNat 64 (H.B + H.D)) - pubRegs (fun _ _ h h' => kr_agree hq h h') (hc.fin o (by rcases ho with rfl | rfl <;> simp)) - (fun s h => WP.mono (finArgs_ok hH hp h ho) fun _ ⟨k, a, x1, _⟩ => ⟨k, a, x1⟩) - (fun s h => WP.mono (finArgs_ok hH hp' h ho) fun _ ⟨k, a, x1, _⟩ => - ⟨k, FinArgs.congr hH (e3 _) (e3 o) e2 a, x1⟩) - exact ha.seq (rel_wp (fin_rel hH (sp := s₀.sp) (st := sO s₀ (stO H)) (o := sO s₀ o) (sc := scr s₀) - fun s s' ⟨⟨k, a, x1⟩, ⟨k', a', x1'⟩⟩ => ⟨a, a', by rw [x1, x1'], k.sp, by rw [k'.sp, hq.sp]⟩) - (fun _ ⟨k, a, _⟩ => finCall_ok hH hp k ho a fun _ k' _ _ => k') - (fun _ ⟨k, a, _⟩ => finCall_ok hH hp' k ho (FinArgs.congr hH (e3 _).symm (e3 o).symm e2.symm a) - fun _ k' _ _ => k')) - -theorem body_rel (hc : Checks H) {m : Nat} (hm : 1 ≤ m) (hn : m < 2 ^ 32) : - RelCT isa (fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s') (body H) - fun s s' => KR (H := H) sc s₀ (m - 1) s ∧ KR (H := H) sc s₀' (m - 1) s' := by - have ck : ∀ {o : Nat}, (o = 0 ∨ o = H.S) → RelCT isa (fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s') - (copy .r4 o .r11 (stO H) H.S) fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s' := - fun ho => kr_rel hp hp' hq (m := m) (hc.copyK _ (by rcases ho with rfl | rfl <;> simp)) - fun hp s k => WP.mono (copyKey_ok hH hp k ho) fun _ h => h.1 - have x := kr_rel hp hp' hq (m := m) hc.xor fun hp s k => WP.mono (xor'_ok hp k) fun _ h => h.1 - have d := rel_taint (G := KR (H := H) sc s₀ (m - 1)) (G' := KR (H := H) sc s₀' (m - 1)) pubRegs - (fun _ _ h h' => kr_agree hq h h') dec_check - (fun s k => WP.mono (dec_ok hm hn k) fun _ h => h.1) (fun s k => WP.mono (dec_ok hm hn k) fun _ h => h.1) - exact (ck (.inl rfl)).seq ((upd_rel' hH hp hp' hq (.inl rfl) hc).seq ((fin_rel' hH hp hp' hq (.inr rfl) hc).seq - ((ck (.inr rfl)).seq ((upd_rel' hH hp hp' hq (.inr rfl) hc).seq ((fin_rel' hH hp hp' hq (.inl rfl) hc).seq - (x.seq d)))))) - -/-- The loop's invariant in two runs, with `n` steps left. -/ -abbrev LoopInv (n : Nat) (s s' : State) : Prop := - 1 ≤ n ∧ n ≤ nn s₀ ∧ Inv hH sc s₀ n s ∧ Inv hH sc s₀' n s' - -theorem step_rel (hc : Checks H) (n : Nat) : - RelCT isa (LoopInv hH (sc := sc) (s₀ := s₀) (s₀' := s₀') n) (body H) fun s s' => - isa.eval .ne s = isa.eval .ne s' ∧ - (isa.eval .ne s = some false → Inv hH sc s₀ 0 s ∧ Inv hH sc s₀' 0 s') ∧ - (isa.eval .ne s = some true → ∃ m < n, LoopInv hH (sc := sc) (s₀ := s₀) (s₀' := s₀') m s s') := by - have hlt := nn_lt (s₀ := s₀) - by_cases hn : 1 ≤ n ∧ n ≤ nn s₀ - · have b := (body_rel hH hp hp' hq hc hn.1 (by omega)).mono (P' := LoopInv hH (sc := sc) (s₀ := s₀) (s₀' := s₀') n) - (fun _ _ (h : LoopInv hH (sc := sc) (s₀ := s₀) (s₀' := s₀') n _ _) => ⟨h.2.2.1.kr, h.2.2.2.kr⟩) - fun _ _ h => h - refine (b.wp (F₁ := fun (t : State) => Inv hH sc s₀ (n - 1) t ∧ t.z = decide (n - 1 = 0)) - (F₂ := fun (t : State) => Inv hH sc s₀' (n - 1) t ∧ t.z = decide (n - 1 = 0)) - fun s s' (h : LoopInv hH (sc := sc) (s₀ := s₀) (s₀' := s₀') n _ _) => - ⟨body_ok hH hp hn.1 (by omega) h.2.2.1, body_ok hH hp' hn.1 (by omega) h.2.2.2⟩).mono - (fun _ _ h => h) fun t t' h => ?_ - obtain ⟨_, ⟨i, z⟩, ⟨i', z'⟩⟩ := h - have e : isa.eval .ne t = some (!decide (n - 1 = 0)) := by show eval .ne t = _; rw [eval_ne, z] - have e' : isa.eval .ne t' = some (!decide (n - 1 = 0)) := by show eval .ne t' = _; rw [eval_ne, z'] - rw [e, e'] - refine ⟨rfl, fun hf => ?_, fun ht => ?_⟩ - · have hl : n - 1 = 0 := by simpa using hf - exact ⟨hl ▸ i, hl ▸ i'⟩ - · have hl : n - 1 ≠ 0 := by simpa using ht - exact ⟨n - 1, by omega, by omega, by omega, i, i'⟩ - · intro _ _ _ _ _ _ h - exact absurd ⟨h.1, h.2.1⟩ hn - -theorem loop_rel (hc : Checks H) : - RelCT isa (fun s s' => (Inv hH sc s₀ (nn s₀) s ∧ s.z = decide (nn s₀ = 0)) ∧ - (Inv hH sc s₀' (nn s₀') s' ∧ s'.z = decide (nn s₀' = 0))) - (.ite .eq (.block []) (.loop (body H) .ne)) - fun s s' => Inv hH sc s₀ 0 s ∧ Inv hH sc s₀' 0 s' := by - have hN := hq.nn - have ev : ∀ {t : State} {k : Nat}, t.z = decide (k = 0) → isa.eval .eq t = some (decide (k = 0)) := - fun h => by show eval .eq _ = _; rw [eval_eq, h] - refine RelCT.ite (fun s s' h => by rw [ev h.1.2, ev h.2.2, hN]) ?_ ?_ - · by_cases e : nn s₀ = 0 - · have e' : nn s₀' = 0 := hN ▸ e - exact (rel_taint (c := .block []) (F := fun s => Inv hH sc s₀ (nn s₀) s ∧ s.z = decide (nn s₀ = 0)) - (F' := fun s => Inv hH sc s₀' (nn s₀') s ∧ s.z = decide (nn s₀' = 0)) - (G := Inv hH sc s₀ 0) (G' := Inv hH sc s₀' 0) [] - (fun s s' h h' => by simp) skip_check - (fun s h => WP.block_nil (e ▸ h.1)) (fun s h => WP.block_nil (e' ▸ h.1))).mono (fun _ _ h => h.1) - fun _ _ h => h - · intro _ _ _ _ _ _ h - have z := h.2 - rw [ev h.1.1.2] at z - exact absurd (by simpa using z) e - · refine (RelCT.loop (M := isa) (LoopInv hH (sc := sc) (s₀ := s₀) (s₀' := s₀')) (step_rel hH hp hp' hq hc) - (nn s₀)).mono (fun s s' h => ?_) fun _ _ h => h - have z := h.2 - rw [ev h.1.1.2] at z - have e : nn s₀ ≠ 0 := by simpa using z - exact ⟨by omega, (Nat.le_refl _), h.1.1.1, hN ▸ h.1.2.1⟩ - -theorem ct (hc : Checks H) : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') (iterate H) fun _ _ => True := by - have hN := hq.nn - have pro := rel_agree (F := fun s => s = s₀) (F' := fun s => s = s₀') - (G := fun s => KR (H := H) sc s₀ (nn s₀) s ∧ s.gpr .r1 = up s₀ ∧ Frame [saveR H (scr s₀)] s₀.mem s.mem) - (G' := fun s => KR (H := H) sc s₀' (nn s₀') s ∧ s.gpr .r1 = up s₀' ∧ Frame [saveR H (scr s₀')] s₀'.mem s.mem) - (argTaint args 4) (fun s s' e e' => by - rw [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]; 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 hp) (fun _ e => by rw [e]; exact pro_ok hp') - have cu := rel_taint - (F := fun s => KR (H := H) sc s₀ (nn s₀) s ∧ s.gpr .r1 = up s₀ ∧ Frame [saveR H (scr s₀)] s₀.mem s.mem) - (F' := fun s => KR (H := H) sc s₀' (nn s₀') s ∧ s.gpr .r1 = up s₀' ∧ Frame [saveR H (scr s₀')] s₀'.mem s.mem) - (G := Inv hH sc s₀ (nn s₀)) (G' := Inv hH sc s₀' (nn s₀')) (.r1 :: pubRegs) - (fun s s' h h' r hm => by - rcases List.mem_cons.mp hm with rfl | hm - · rw [h.2.1, h'.2.1, up, up, hq.r1] - · exact kr_agree hq h.1 (hN ▸ h'.1) r hm) hc.copyU - (fun s h => copyU_ok hH hp h.1 h.2.1 h.2.2) (fun s h => copyU_ok hH hp' h.1 h.2.1 h.2.2) - have cm := rel_taint (F := Inv hH sc s₀ (nn s₀)) (F' := Inv hH sc s₀' (nn s₀')) - (G := fun s => Inv hH sc s₀ (nn s₀) s ∧ s.z = decide (nn s₀ = 0)) - (G' := fun s => Inv hH sc s₀' (nn s₀') s ∧ s.z = decide (nn s₀' = 0)) pubRegs - (fun s s' h h' => kr_agree hq h.kr (hN ▸ h'.kr)) cmp_check - (fun s h => cmp_ok hH h) (fun s h => cmp_ok hH h) - obtain ⟨_, hr⟩ := hc.restore - have restore : RelCT isa (fun s s' => Inv hH sc s₀ 0 s ∧ Inv hH sc s₀' 0 s') (.block H.restore) - fun _ _ => True := - RelCT.taint (A := taint) (Taint.ofRegs pubRegs) (fun _ _ h => - Taint.agree_ofRegs (kr_agree hq h.1.kr h.2.kr)) hr - exact pro.seq (cu.seq (cm.seq ((loop_rel hH hp hp' hq hc).seq restore))) - -end VG.Proof.Pbkdf2.Generic.Arm - -namespace VG.Proof.Pbkdf2.Generic.Arm - -open VG.Arm -open VG.Impl.Hmac.Generic.Arm (Hash) -open VG.Proof.Hmac.Generic.Arm - -/-- `iterate` is verified against `iterG`, 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 + H.S + 2 * H.F ≤ 8 * sc) (hsat : ∃ s, (iterG hH.SH sc).pre s) : - Verified Arm.target (VG.Impl.Pbkdf2.Generic.Arm.iterate H) (iterG hH.SH sc) := by - refine ⟨fun s hs => correct hH (pre_of hH sc hs hfit), fun s₁ s₂ t₁ t₂ s₁' s₂' h₁ h₂ hpub e₁ e₂ => ?_, hsat⟩ - obtain ⟨h1, h2, h3, h4, h5, h6⟩ := hpub - exact (ct hH (pre_of hH sc h₁ hfit) (pre_of hH sc h₂ hfit) ⟨h1, h2, h3, h4, h5, h6⟩ hc - _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 - -end VG.Proof.Pbkdf2.Generic.Arm - -/-! -# PBKDF2-HMAC over the streaming hash functions on 32-bit ARM: the instances - -Untrusted: everything here is checked by Lean. As on x86 -(`Proof/Pbkdf2/Generic/X86/Instances.lean`): the generic proof -(above) at each hash function of -`Proof/Hmac/Generic/Arm/Hashes.lean`, moved to the shared contract of -`Spec/Pbkdf2/Generic.lean` (`sig_implies`), which the artifacts are emitted with. --/ - -namespace VG.Proof.Pbkdf2.Generic.Arm.Instances - -open VG.Arm -open VG.Proof.Hmac.Generic.Arm -open VG.Proof.Pbkdf2.Generic.Arm - -/-- 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 -`0x4000`, is the stack argument. -/ -def iterSat (S D sc : Nat) : State where - gpr r := match r with - | .r0 => 0x1000 | .r1 => 0x2000 | .r3 => 0x3000 - | _ => 0 - sp := 0x6000 - n := false - z := false - c := false - v := false - mem a := if a = 0x6001 then 0x40 else 0 - rd := [⟨0x1000, 2 * S⟩, ⟨0x2000, D⟩, ⟨0x6000, 4⟩] - wr := [⟨0x3000, D⟩, ⟨0x4000, 8 * sc⟩] - -/-- `iterG` implies the shared contract for any hash function and scratch space -(`generic_implies`), given that the shared contract is satisfiable. -/ -theorem iterImp (S : Spec.Hmac.StreamingHash) (W : Nat) (h : ∃ s, (Spec.Pbkdf2.iterateContract S W Arm.abi 16).pre s) : - (iterG S W).Implies (Spec.Pbkdf2.iterateContract S W Arm.abi 16) := by - generic_implies [ - Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, iterG, below, Arm.abi, Arm.argRegs, - Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using h - -/-! ## SHA-1 -/ - -theorem sha1_checks : Checks sha1H where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha1_imp : (iterG Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.iterateContract Arm.abi 16) := - iterImp Spec.Hmac.sha1S 56 (by - inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha1S, Spec.Hmac.sha1, iterG, below, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 84 20 56) - -theorem sha1 : Verified Arm.target (Impl.Pbkdf2.Generic.Arm.iterate sha1H) - (Spec.Hmac.sha1I.iterateContract Arm.abi 16) := - (verified sha1OK sha1_checks (by decide) sha1_imp.sat_left).of_implies sha1_imp - -/-! ## MD5 -/ - -theorem md5_checks : Checks md5H where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem md5_imp : (iterG Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.iterateContract Arm.abi 16) := - iterImp Spec.Hmac.md5S 48 (by - inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.md5S, Spec.Hmac.md5, iterG, below, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 80 16 48) - -theorem md5 : Verified Arm.target (Impl.Pbkdf2.Generic.Arm.iterate md5H) - (Spec.Hmac.md5I.iterateContract Arm.abi 16) := - (verified md5OK md5_checks (by decide) md5_imp.sat_left).of_implies md5_imp - -/-! ## SHA-384 -/ - -theorem sha384_checks : Checks sha384H where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha384_imp : (iterG Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I.iterateContract Arm.abi 16) := - iterImp Spec.Hmac.sha384S 234 (by - inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha384S, Spec.Hmac.sha384, iterG, below, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 192 48 234) - -theorem sha384 : Verified Arm.target (Impl.Pbkdf2.Generic.Arm.iterate sha384H) - (Spec.Hmac.sha384I.iterateContract Arm.abi 16) := - (verified sha384OK sha384_checks (by decide) sha384_imp.sat_left).of_implies sha384_imp - -/-! ## SHA-512 -/ - -theorem sha512_checks : Checks sha512H' where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha512_imp : (iterG Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I.iterateContract Arm.abi 16) := - iterImp Spec.Hmac.sha512S 234 (by - inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha512S, Spec.Hmac.sha512, iterG, below, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 192 64 234) - -theorem sha512 : Verified Arm.target (Impl.Pbkdf2.Generic.Arm.iterate sha512H') - (Spec.Hmac.sha512I.iterateContract Arm.abi 16) := - (verified sha512OK sha512_checks (by decide) sha512_imp.sat_left).of_implies sha512_imp - -/-! ## SHA-512/224 -/ - -theorem sha512_224_checks : Checks sha512_224H where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha512_224_imp : (iterG Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac.sha512_224I.iterateContract Arm.abi 16) := - iterImp Spec.Hmac.sha512_224S 234 (by - inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha512_224S, Spec.Hmac.sha512_224, iterG, below, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 192 28 234) - -theorem sha512_224 : Verified Arm.target (Impl.Pbkdf2.Generic.Arm.iterate sha512_224H) - (Spec.Hmac.sha512_224I.iterateContract Arm.abi 16) := - (verified sha512_224OK sha512_224_checks (by decide) sha512_224_imp.sat_left).of_implies sha512_224_imp - -/-! ## SHA-512/256 -/ - -theorem sha512_256_checks : Checks sha512_256H where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha512_256_imp : (iterG Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac.sha512_256I.iterateContract Arm.abi 16) := - iterImp Spec.Hmac.sha512_256S 234 (by - inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha512_256S, Spec.Hmac.sha512_256, iterG, below, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 192 32 234) - -theorem sha512_256 : Verified Arm.target (Impl.Pbkdf2.Generic.Arm.iterate sha512_256H) - (Spec.Hmac.sha512_256I.iterateContract Arm.abi 16) := - (verified sha512_256OK sha512_256_checks (by decide) sha512_256_imp.sat_left).of_implies sha512_256_imp - -end VG.Proof.Pbkdf2.Generic.Arm.Instances diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/Arm/Sha224.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/Arm/Sha224.lean deleted file mode 100644 index 9d168bc2b..000000000 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/Arm/Sha224.lean +++ /dev/null @@ -1,42 +0,0 @@ -import VerifiedGarbage.Proof.Pbkdf2.Generic.Arm.Instances -import VerifiedGarbage.Proof.Hmac.Generic.Arm.Sha224 - -/-! -# The PBKDF2-HMAC-SHA-224 iteration on 32-bit ARM - -Untrusted: everything here is checked by Lean. The generic proof of the -iteration (`Instances.lean`) at SHA-224 (`Proof/Hmac/Generic/Arm/Sha224.lean`), -moved to the shared contract of `Spec.Hmac.sha224I`. --/ - -namespace VG.Proof.Pbkdf2.Generic.Arm.Instances - -open VG.Arm -open VG.Proof.Hmac.Generic.Arm -open VG.Proof.Pbkdf2.Generic.Arm - -theorem sha224_checks : Checks sha224H where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha224_imp : (iterG Spec.Hmac.sha224S 104).Implies (Spec.Hmac.sha224I.iterateContract Arm.abi 16) := - iterImp Spec.Hmac.sha224S 104 (by - inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha224S, Spec.Hmac.sha224, iterG, - below, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 96 28 104) - -theorem sha224 : Verified Arm.target (Impl.Pbkdf2.Generic.Arm.iterate sha224H) - (Spec.Hmac.sha224I.iterateContract Arm.abi 16) := - (verified sha224OK sha224_checks (by decide) sha224_imp.sat_left).of_implies sha224_imp - -end VG.Proof.Pbkdf2.Generic.Arm.Instances diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Instances.lean index 46c82e8df..530e43a5f 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Instances.lean @@ -6,8 +6,8 @@ import VerifiedGarbage.Proof.Hmac.Generic.X86.Hashes /-! # PBKDF2-HMAC over the streaming hash functions on x86 (32-bit): the instances -Untrusted: everything here is checked by Lean. As on 32-bit ARM -(`Proof/Pbkdf2/Generic/Arm/Instances.lean`): the generic proof +Untrusted: everything here is checked by Lean. As for HMAC +(`Proof/Hmac/Generic/X86/Instances.lean`): the generic proof (`IterateCT.lean`) at each hash function of `Proof/Hmac/Generic/X86/Hashes.lean`, moved to the shared contract of `Spec/Pbkdf2/Generic.lean` (`sig_implies`), which the artifacts are emitted with. diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Iterate.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Iterate.lean index 86a6ad8e6..4b6bcb7cc 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Iterate.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Iterate.lean @@ -4,8 +4,8 @@ import VerifiedGarbage.Proof.Hmac.Generic.X86.Finalize /-! # PBKDF2-HMAC over any streaming hash function on x86 (32-bit): `iterate`, correct -Untrusted: everything here is checked by Lean. As on 32-bit ARM -(`Proof/Pbkdf2/Generic/Arm/Instances.lean`). The arguments are on the stack: +Untrusted: everything here is checked by Lean. As for HMAC's `finalize` +(`Proof/Hmac/Generic/X86/Finalize.lean`). The arguments are on the stack: `scratch`, `n` and `u` are loaded first (after our caller's registers are saved in `scratch`), and `key` and `t` again in each step, when needed. The loop counts the steps left in `edi` down with `sub`, and branches on its diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/IterateCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/IterateCT.lean index 264745c82..d9fe7c6c8 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/IterateCT.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/IterateCT.lean @@ -3,8 +3,8 @@ import VerifiedGarbage.Proof.Pbkdf2.Generic.X86.Iterate /-! # PBKDF2-HMAC over any streaming hash function on x86 (32-bit): `iterate`, constant time -Untrusted: everything here is checked by Lean. As on 32-bit ARM -(`Proof/Pbkdf2/Generic/Arm/Instances.lean`): the pieces between the calls +Untrusted: everything here is checked by Lean. As for HMAC's `finalize` +(`Proof/Hmac/Generic/X86/FinalizeCT.lean`): the pieces between the calls are checked by the taint analysis, those that read the arguments on the stack (the prologue, and the loads of `key` and `t`) with the arguments public (`argTaint`); the calls are related by `upd_rel` and `fin_rel`. diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Compress.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Compress.lean new file mode 100644 index 000000000..318680c56 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Compress.lean @@ -0,0 +1,188 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Words +import VerifiedGarbage.Proof.Framework.Arm.RelCT +import VerifiedGarbage.Proof.Framework.Arm.Taint + +/-! +# A Merkle–Damgård compression function on ARMv7, called on one block + +Untrusted: everything here is checked by Lean. As on AArch64 +(`Proof/Pbkdf2/AArch64/Compress.lean`): the contract of a compression +function with blocks of any size `B` (`compK`, which is that of the +streaming proofs, `Proof/MdStream/Arm/Common.lean`, for any block size, and +each hash function's own, `Proof.Sha1.compressArm` and the others, at its +sizes), what its callers need of an implementation (`CompOk`: correct, +constant time, without calls, never writing `r0` or `r3`), and the call of +it on the block at `r6` (`compressBlock`), in one run (`compressBlock_ok`) +and in two (`compressBlock_rel`). +-/ + +namespace VG.Proof.Pbkdf2.Md.Arm + +open VG VG.Arm VG.Proof.MdStream +open VG.Impl.MdStream.Arm (compressAt compressWith) +open VG.Proof.MdStream.Arm (Upd wp_mov op2_imm op2_reg) + +section +variable {B N L : Nat} (H : Md B N L) (so : Nat) + +/-- The contract of the compression function: updates the `N`-byte hash +value at `r0` with the `r2` blocks of `B` bytes at `r1`, with scratch space +`r3` (`so` bytes). -/ +def compK : Contract isa where + pre s := + let state : Region := ⟨State.addr (s.gpr .r0), N⟩ + let blocks : Region := ⟨State.addr (s.gpr .r1), B * (s.gpr .r2).toNat⟩ + let scratch : Region := ⟨State.addr (s.gpr .r3), so⟩ + s.rd = [blocks] ∧ s.wr = [state, scratch] ∧ + state.Disjoint scratch ∧ blocks.Disjoint state ∧ blocks.Disjoint scratch ∧ + (s.gpr .r0).toNat + N ≤ 2 ^ 32 ∧ (s.gpr .r1).toNat + B * (s.gpr .r2).toNat ≤ 2 ^ 32 ∧ + (s.gpr .r3).toNat + so ≤ 2 ^ 32 + post s s' := + H.stateAt s'.mem (State.addr (s.gpr .r0)) = + H.compressBlocks (H.stateAt s.mem (State.addr (s.gpr .r0))) s.mem (State.addr (s.gpr .r1)) + (s.gpr .r2).toNat + pub s₁ s₂ := + s₁.gpr .r0 = s₂.gpr .r0 ∧ s₁.gpr .r1 = s₂.gpr .r1 ∧ + s₁.gpr .r2 = s₂.gpr .r2 ∧ s₁.gpr .r3 = s₂.gpr .r3 + +/-- What a caller needs of an implementation of the compression function: +that it is correct and constant time, makes no calls, and never writes `r0` +or `r3`. -/ +structure CompOk (code : Prog isa) : Prop where + verified : ∀ s, (compK H so).pre s → ∃ t s', Exec isa code s t s' ∧ abiPreserved s s' ∧ (compK H so).post s s' + ct : ConstantTime isa (compK H so).pre (compK H so).pub code + noCalls : code.noCalls = true + keeps : ((instrs code).all fun i => dstOf i != some .r0 && dstOf i != some .r3) = true + +end + +/-- The call of the compression function on the block at `r6`. -/ +abbrev compressBlock (name : String) (code : Prog isa) : Prog isa := + .seq (.block [.mov .r1 (.reg .r6)]) (compressAt name code) + +section +variable {B N L : Nat} {H : Md B N L} {so : Nat} + +/-- What the call of the compression function on the block at `r6` (`src`), +into the hash value at `r0` (`st`), with scratch space at `r3` (`scr`), +needs. -/ +structure CallOk (s : State) (N B so : Nat) (st scr src : BitVec 32) : Prop where + r0 : s.gpr .r0 = st + r3 : s.gpr .r3 = scr + r6 : s.gpr .r6 = src + f₀ : st.toNat + N ≤ 2 ^ 32 + f₁ : src.toNat + B ≤ 2 ^ 32 + f₃ : scr.toNat + so ≤ 2 ^ 32 + st_scr : Region.Disjoint ⟨State.addr st, N⟩ ⟨State.addr scr, so⟩ + src_st : Region.Disjoint ⟨State.addr src, B⟩ ⟨State.addr st, N⟩ + src_scr : Region.Disjoint ⟨State.addr src, B⟩ ⟨State.addr scr, so⟩ + cov : Covers [⟨State.addr src, B⟩, ⟨State.addr st, N⟩, ⟨State.addr scr, so⟩] (s.rd ++ s.wr) + covW : Covers [⟨State.addr st, N⟩, ⟨State.addr scr, so⟩] s.wr + +/-- The state after the instructions that set up the call. -/ +structure CSetup (s t : State) : Prop where + r1 : t.gpr .r1 = s.gpr .r6 + r2 : t.gpr .r2 = 1 + other : ∀ r, r ≠ .r1 → r ≠ .r2 → t.gpr r = s.gpr r + mem : t.mem = s.mem + rd : t.rd = s.rd + wr : t.wr = s.wr + sp : t.sp = s.sp + +theorem csetup_ok {name : String} {code : Prog isa} (s : State) {Q : State → Prop} (k : ∀ t, CSetup s t → WP isa (.call name code) t Q) : + WP isa (compressBlock name code) s Q := by + unfold compressBlock compressAt compressWith + refine WP.seq (wp_mov (op2_reg _ _) fun s₁ u₁ => WP.block_nil ?_) + refine WP.seq (wp_mov (op2_imm (by decide)) fun s₂ u₂ => WP.block_nil (k s₂ ?_)) + exact ⟨by rw [u₂.other _ (by decide), u₁.gpr], u₂.gpr, fun r h1 h2 => by rw [u₂.other r h2, u₁.other r h1], + by rw [u₂.mem, u₁.mem], by rw [u₂.rd, u₁.rd], by rw [u₂.wr, u₁.wr], by rw [u₂.sp, u₁.sp]⟩ + +theorem one32 : (1 : BitVec 32).toNat = 1 := rfl + +theorem call_pre {s t : State} {st scr src : BitVec 32} (h : CallOk s N B so st scr src) (hs : CSetup s t) : + (compK H so).pre (t.callEntry.withRegions [⟨State.addr src, B⟩] [⟨State.addr st, N⟩, ⟨State.addr scr, so⟩]) := by + have c0 : t.callEntry.gpr .r0 = st := + (State.callEntry_gpr _ (by decide)).trans ((hs.other _ (by decide) (by decide)).trans h.r0) + have c1 : t.callEntry.gpr .r1 = src := (State.callEntry_gpr _ (by decide)).trans (hs.r1.trans h.r6) + have c2 : t.callEntry.gpr .r2 = 1 := (State.callEntry_gpr _ (by decide)).trans hs.r2 + have c3 : t.callEntry.gpr .r3 = scr := + (State.callEntry_gpr _ (by decide)).trans ((hs.other _ (by decide) (by decide)).trans h.r3) + simp only [compK, State.withRegions_gpr, State.withRegions_rd, State.withRegions_wr, c0, c1, c2, c3, one32, + Nat.mul_one] + exact ⟨trivial, trivial, h.st_scr, h.src_st, h.src_scr, h.f₀, h.f₁, h.f₃⟩ + +/-- Compressing the block at `r6` into the hash value at `r0`, with scratch +space at `r3`: the callee-saved registers other than `lr`, and `r0` and `r3`, +are kept. -/ +theorem compressBlock_ok {name : String} {code : Prog isa} (hf : CompOk H so code) {s : State} + {st scr src : BitVec 32} (h : CallOk s N B so st scr src) {Q : State → Prop} + (hQ : ∀ s', s'.rd = s.rd → s'.wr = s.wr → (∀ r ∈ preserved, r ≠ .lr → s'.gpr r = s.gpr r) → + s'.gpr .r0 = st → s'.gpr .r3 = scr → s'.sp = s.sp → + Frame [⟨State.addr st, N⟩, ⟨State.addr scr, so⟩] s.mem s'.mem → + H.stateAt s'.mem (State.addr st) = + H.compress (H.stateAt s.mem (State.addr st)) (H.blockAt s.mem (State.addr src)) → Q s') : + WP isa (compressBlock name code) s Q := by + have hk : ∀ i ∈ instrs code, dstOf i ≠ some .r0 ∧ dstOf i ≠ some .r3 := by + intro i hi + have := List.all_eq_true.mp hf.keeps i hi + simp only [Bool.and_eq_true, bne_iff_ne, ne_eq] at this + exact this + refine csetup_ok s fun t hs => ?_ + refine WP.call (k := compK H so) hf.verified (call_pre h hs) ?_ ?_ ?_ hf.noCalls + · rw [hs.rd, hs.wr]; simpa using h.cov + · rw [hs.wr]; exact h.covW + · intro s' hrd hwr hsp hfr hcs hg hpost + have c0 : t.callEntry.gpr .r0 = st := + (State.callEntry_gpr _ (by decide)).trans ((hs.other _ (by decide) (by decide)).trans h.r0) + have c1 : t.callEntry.gpr .r1 = src := (State.callEntry_gpr _ (by decide)).trans (hs.r1.trans h.r6) + have c2 : (t.callEntry.gpr .r2).toNat = 1 := by rw [State.callEntry_gpr _ (by decide), hs.r2]; rfl + simp only [compK, State.withRegions_gpr, State.withRegions_mem, State.callEntry_mem, c0, c1, c2, + hs.mem] at hpost + rw [hs.mem] at hfr + refine hQ s' (hrd.trans hs.rd) (hwr.trans hs.wr) (fun r hr hlr => ?_) + (by rw [hg _ (fun i hi => (hk i hi).1) (by decide), hs.other _ (by decide) (by decide), h.r0]) + (by rw [hg _ (fun i hi => (hk i hi).2) (by decide), hs.other _ (by decide) (by decide), h.r3]) + (hsp.trans hs.sp) hfr ?_ + · have : r ≠ .r1 ∧ r ≠ .r2 := by + simp only [preserved, List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> decide + rw [hcs r hr hlr, hs.other r this.1 this.2] + · rw [hpost, Md.compressBlocks_one] + +/-- `compressBlock` is constant time, in runs that call it on the same regions. -/ +theorem compressBlock_rel {name : String} {code : Prog isa} (hf : CompOk H so code) {st scr src : BitVec 32} + {P' : State → State → Prop} + (hP : ∀ s₁ s₂, P' s₁ s₂ → CallOk s₁ N B so st scr src ∧ CallOk s₂ N B so st scr src) : + RelCT isa P' (compressBlock name code) fun _ _ => True := by + unfold compressBlock compressAt compressWith + let M₁ : State → Prop := fun a => ∃ s, CallOk s N B so st scr src ∧ Upd s a .r1 (s.gpr .r6) + let M₂ : State → Prop := fun b => ∃ s, CallOk s N B so st scr src ∧ CSetup s b + have w₁ : ∀ s, CallOk s N B so st scr src → WP isa (.block [.mov .r1 (.reg .r6)]) s M₁ := + fun s h => wp_mov (op2_reg _ _) fun a u => WP.block_nil ⟨s, h, u⟩ + have w₂ : ∀ a, M₁ a → WP isa (.block [.mov .r2 (.imm 1)]) a M₂ := fun a ⟨s, h, u₁⟩ => + wp_mov (op2_imm (by decide)) fun b u₂ => WP.block_nil ⟨s, h, by rw [u₂.other _ (by decide), u₁.gpr], u₂.gpr, + fun r h1 h2 => by rw [u₂.other r h2, u₁.other r h1], by rw [u₂.mem, u₁.mem], by rw [u₂.rd, u₁.rd], + by rw [u₂.wr, u₁.wr], by rw [u₂.sp, u₁.sp]⟩ + have su₁ : RelCT isa P' (.block [.mov .r1 (.reg .r6)]) fun a b => M₁ a ∧ M₁ b := + ((RelCT.taint (A := taint) (P := P') (Taint.ofRegs []) (fun _ _ _ => Taint.agree_ofRegs fun r hr => by + simp at hr) (by taint_decide)).wp fun s₁ s₂ hp => ⟨w₁ s₁ (hP s₁ s₂ hp).1, w₁ s₂ (hP s₁ s₂ hp).2⟩).mono + (fun _ _ h => h) fun _ _ h => h.2 + have su₂ : RelCT isa (fun a b => M₁ a ∧ M₁ b) (.block [.mov .r2 (.imm 1)]) fun a b => M₂ a ∧ M₂ b := + ((RelCT.taint (A := taint) (Taint.ofRegs []) (fun _ _ _ => Taint.agree_ofRegs fun r hr => by + simp at hr) (by taint_decide)).wp fun a b h => ⟨w₂ a h.1, w₂ b h.2⟩).mono + (fun _ _ h => h) fun _ _ h => h.2 + refine su₁.seq (su₂.seq (RelCT.call (k := compK H so) hf.verified hf.ct [⟨State.addr src, B⟩] + [⟨State.addr st, N⟩, ⟨State.addr scr, so⟩] fun t₁ t₂ ⟨⟨σ₁, c₁, h₁⟩, ⟨σ₂, c₂, h₂⟩⟩ => ?_)) + refine ⟨call_pre c₁ h₁, call_pre c₂ h₂, ?_, by rw [h₁.rd, h₁.wr]; simpa using c₁.cov, by rw [h₁.wr]; exact c₁.covW, + by rw [h₂.rd, h₂.wr]; simpa using c₂.cov, by rw [h₂.wr]; exact c₂.covW⟩ + simp only [compK, State.withRegions_gpr, + State.callEntry_gpr _ (by decide : Reg.r0 ∉ linkRegs), State.callEntry_gpr _ (by decide : Reg.r1 ∉ linkRegs), + State.callEntry_gpr _ (by decide : Reg.r2 ∉ linkRegs), State.callEntry_gpr _ (by decide : Reg.r3 ∉ linkRegs), + h₁.r1, h₂.r1, h₁.r2, h₂.r2, h₁.other .r0 (by decide) (by decide), h₂.other .r0 (by decide) (by decide), + h₁.other .r3 (by decide) (by decide), h₂.other .r3 (by decide) (by decide), c₁.r0, c₂.r0, c₁.r3, c₂.r3, + c₁.r6, c₂.r6] + exact ⟨trivial, trivial, trivial, trivial⟩ + +end + +end VG.Proof.Pbkdf2.Md.Arm diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Hash.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Hash.lean new file mode 100644 index 000000000..74aa89772 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Hash.lean @@ -0,0 +1,98 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Compress +import VerifiedGarbage.Proof.Pbkdf2.MdStep +import VerifiedGarbage.Proof.Hmac.Generic.Arm.Init + +/-! +# HMAC and PBKDF2-HMAC over any Merkle–Damgård hash function on ARMv7: the hash function + +Untrusted: everything here is checked by Lean. As on AArch64 +(`Proof/Pbkdf2/Md/AArch64/Hash.lean`), `HashOK H` is what the proofs know of +the hash function whose code `H` describes: it is a Merkle–Damgård hash +function `md` (`Md`) whose digest code does what it should (`OutOk`) and +whose length field for a `B + D`-byte message is the constant 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 its sizes fit +(`Sizes`). +-/ + +namespace VG.Proof.Pbkdf2.Md.Arm + +open VG.Arm VG.Proof.MdStream +open VG.Impl.Pbkdf2.Md.Arm (Hash lenWords) +open Spec.Hmac (StreamingHash) + +/-- The sizes the proofs support, checked for each hash function by +`decide`: words of 4 bytes, a digest of at most the hash value, room for the +padding in the block after the digest and after the hash value, the +streaming state as the hash value followed by a block, `finalize` writing +the whole hash value, and the compression function's scratch space within +the working space of the functions we call. -/ +structure Sizes (H : Hash) : Prop where + B : H.B = 64 ∨ H.B = 128 + N4 : H.N % 4 = 0 + D4 : H.D % 4 = 0 + L4 : H.L % 4 = 0 + D0 : 0 < H.D + DN : H.D ≤ H.N + NL : H.N + H.L ≤ H.B + pad : H.D + 4 ≤ H.B - H.L + N64 : H.N ≤ 64 + L16 : H.L ≤ 16 + so : H.so ≤ 8 * H.st.W + W : H.st.W ≤ 64 + S : H.st.S = H.N + H.B + F : H.st.F = H.N + +/-- What the proofs need of a Merkle–Damgård hash function's code. -/ +structure HashOK (H : Hash) where + /-- The hash function, as the proofs see it. -/ + md : Md H.B H.N H.L + out : OutOk md H.out + /-- The compression function is verified. -/ + comp : CompOk md H.so H.compC + /-- The hash value is determined by its bytes, wherever they are. -/ + reloc : md.Reloc + /-- 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 + /-- 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 + hash : ∀ m, stream.SH.H.hash m = (md.hash iv m).take H.D + sizes : Sizes H + +namespace HashOK + +variable {H : Hash} (hH : HashOK H) + +/-- The specification. -/ +abbrev SH : StreamingHash := hH.stream.SH + +theorem hB : hH.SH.H.blockSize = H.B := hH.stream.hB +theorem hS : hH.SH.stateBytes = H.N + H.B := hH.stream.hS.trans hH.sizes.S +theorem hD : hH.SH.digestBytes = H.D := hH.stream.hD + +include hH in +theorem B_le : H.B ≤ 128 := by rcases hH.sizes.B with h | h <;> omega + +include hH in +theorem B_ge : 64 ≤ H.B := by rcases hH.sizes.B with h | h <;> omega + +include hH in +theorem B4 : H.B % 4 = 0 := by rcases hH.sizes.B with h | h <;> omega + +/-- The hash function of the specification is `md` from `iv`. -/ +theorem link : hH.md.Link hH.SH hH.iv H.D := + ⟨hH.hB, hH.hS, hH.hD, hH.repr, hH.hash, hH.sizes.DN, by have := hH.sizes.pad; have := hH.sizes.NL; omega⟩ + +/-- The length field's bytes, as stored. -/ +theorem lenBytes_eq : wordsBytes (lenWords H.be H.L (H.B + H.D)) = hH.md.lenBytes (H.B + H.D) := hH.len + +theorem lenWords_length : (lenWords H.be H.L (H.B + H.D)).length = H.L / 4 := by simp [lenWords] + +end HashOK + +end VG.Proof.Pbkdf2.Md.Arm diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFin.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFin.lean new file mode 100644 index 000000000..9d8b31e47 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFin.lean @@ -0,0 +1,677 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Hash + +/-! +# HMAC's `finalize` over a Merkle–Damgård hash function on ARMv7: correct + +Untrusted: everything here is checked by Lean. `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 +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. +-/ + +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.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 + After below_eq) +open VG.Proof.MdStream.Arm (Upd wp_mov wp_ldrSp op2_reg) +open VG.Spec.Sha256 (bytesAt) +open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame) +open VG.Proof.Hmac.Common (bytesAt_add bytesAt_length bytesAt_writeBytes_sep writeBytes_at bytesAt_getD') +open VG.Proof.Hmac.Generic.Common (bytesAt_take bytesAt_writeBytes_self' sub_of_off sub_of_self) +open VG.Spec.Hmac (xorPad ipad opad hmacBlockKey) + +/-! ## The precondition -/ + +section +variable (s₀ : State) + +abbrev inn : BitVec 32 := s₀.gpr .r0 +abbrev outer : BitVec 32 := s₀.gpr .r1 +abbrev op : BitVec 32 := stackArg s₀ 0 +abbrev scr : BitVec 32 := stackArg s₀ 1 +abbrev scA : Addr := State.addr (scr s₀) +abbrev argR : Region := ⟨stackArgAddr s₀ 0, 8⟩ + +end + +section +variable (H : Hash) (sc : Nat) (s₀ : State) + +abbrev inR : Region := ⟨State.addr (inn s₀), H.N + H.B⟩ +abbrev outerR : Region := ⟨State.addr (outer s₀), H.N + H.B⟩ +abbrev opR : Region := ⟨State.addr (op s₀), H.D⟩ +abbrev scR : Region := ⟨scA s₀, 8 * sc⟩ +/-- The hash value being compressed and the block, as registers hold them. -/ +abbrev hv : BitVec 32 := scr s₀ + BitVec.ofNat 32 H.hvO +abbrev blk : BitVec 32 := scr s₀ + BitVec.ofNat 32 H.blkO +/-- And as addresses. -/ +abbrev hvA : Addr := scA s₀ + BitVec.ofNat 64 H.hvO +abbrev blkA : Addr := scA s₀ + BitVec.ofNat 64 H.blkO + +end + +structure Pre (H : Hash) (sc : Nat) (s₀ : State) : Prop where + rd : s₀.rd = [outerR H s₀, argR s₀] + wr : s₀.wr = [inR H s₀, opR H s₀, scR sc s₀] + i_o : (inR H s₀).Disjoint (outerR H s₀) + i_p : (inR H s₀).Disjoint (opR H s₀) + i_s : (inR H s₀).Disjoint (scR sc s₀) + o_p : (outerR H s₀).Disjoint (opR H s₀) + o_s : (outerR H s₀).Disjoint (scR sc s₀) + p_s : (opR H s₀).Disjoint (scR sc s₀) + a_i : (argR s₀).Disjoint (inR H s₀) + a_p : (argR s₀).Disjoint (opR H s₀) + a_s : (argR s₀).Disjoint (scR sc s₀) + b_i : (below s₀).Disjoint (inR H s₀) + b_o : (below s₀).Disjoint (outerR H s₀) + b_p : (below s₀).Disjoint (opR H s₀) + b_s : (below s₀).Disjoint (scR sc s₀) + ni : (inn s₀).toNat + (H.N + H.B) ≤ 2 ^ 32 + no : (outer s₀).toNat + (H.N + H.B) ≤ 2 ^ 32 + np : (op s₀).toNat + H.D ≤ 2 ^ 32 + nw : (scr s₀).toNat + 8 * sc ≤ 2 ^ 32 + sp16 : 16 ≤ s₀.sp.toNat + spf : s₀.sp.toNat + 8 ≤ 2 ^ 32 + fits : H.st.buf + H.N + H.B ≤ 8 * sc + +theorem pre_of {H : Hash} (hH : HashOK H) {sc : Nat} {s₀ : State} (h : (finG hH.SH sc).pre s₀) + (hfit : H.st.buf + H.N + H.B ≤ 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⟩ := h + have hS := hH.hS + have hD := hH.hD + simp only [hS, hD] at * + exact ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, hfit⟩ + +theorem buf_eq (H : Hash) : H.st.buf = 8 * H.st.W + 36 := rfl + +theorem add0 (p : Addr) : p + BitVec.ofNat 64 0 = p := BitVec.add_zero p + +/-! ## The parts of the scratch space -/ + +section +variable {H : Hash} {sc : Nat} (hz : Sizes H) {s₀ : State} (hp : Pre H sc s₀) +include hz hp + +omit hz hp in +theorem scr_sub {a n : Nat} (h : a + n ≤ 8 * sc) : + Region.Sub ⟨scA s₀ + BitVec.ofNat 64 a, n⟩ (scR sc s₀) := + Offset.sub_base _ h + +omit hz in +theorem in_scr {s : State} (hwr : s.wr = s₀.wr) {a n : Nat} (h : a + n ≤ 8 * sc) : + InRegions s.wr (scA s₀ + BitVec.ofNat 64 a) n := + ⟨scR sc s₀, by simp [hwr, hp.wr], Offset.contains_base _ h (by have := hp.nw; omega)⟩ + +omit hz in +theorem in_scr' {s : State} (hwr : s.wr = s₀.wr) {a n : Nat} (h : a + n ≤ 8 * sc) : + InRegions (s.rd ++ s.wr) (scA s₀ + BitVec.ofNat 64 a) n := by + obtain ⟨r, hr, hc⟩ := in_scr hp hwr h + exact ⟨r, List.mem_append_right _ hr, hc⟩ + +omit hz in +theorem addr_sO {o : Nat} (h : o < 8 * sc) : + State.addr (scr s₀ + BitVec.ofNat 32 o) = scA s₀ + BitVec.ofNat 64 o := + addr_add (by have := hp.nw; omega) + +omit hz in +theorem toNat_sO {o : Nat} (h : o < 8 * sc) : (scr s₀ + BitVec.ofNat 32 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.mod_eq_of_lt (by omega)] + +theorem addr_hv : State.addr (hv H s₀) = hvA H s₀ := by + have := hp.fits; have := hz.N64; have : 64 ≤ H.B := by rcases hz.B with h | h <;> omega + exact addr_sO hp (by simp only [Hash.hvO]; omega) + +theorem addr_blk : State.addr (blk H s₀) = blkA H s₀ := by + have := hp.fits; have := hz.N64; have : 64 ≤ H.B := by rcases hz.B with h | h <;> omega + exact addr_sO hp (by simp only [Hash.blkO]; omega) + +omit hz in +theorem in_blk {s : State} (hwr : s.wr = s₀.wr) {a n : Nat} (h : a + n ≤ H.B) : + InRegions s.wr (blkA H s₀ + BitVec.ofNat 64 a) n := by + have := hp.fits + rw [Memory.add_ofNat]; exact in_scr hp hwr (by simp only [Hash.blkO]; omega) + +omit hz in +theorem save_sub : Region.Sub (saveR H.st (scr s₀)) (scR sc s₀) := by + have := hp.fits; rw [buf_eq H] at this; exact scr_sub (by omega) + +omit hz in +theorem blk_sub : Region.Sub ⟨blkA H s₀, H.B⟩ (scR sc s₀) := by + have := hp.fits; exact scr_sub (by simp only [Hash.blkO]; omega) + +theorem hv_sub : Region.Sub ⟨hvA H s₀, H.N⟩ (scR sc s₀) := by + have := hp.fits; have : 64 ≤ H.B := by rcases hz.B with h | h <;> omega + exact scr_sub (by simp only [Hash.hvO]; omega) + +/-- The saved registers are outside the hash value, the block and the +working space of the functions we call. -/ +theorem save_disj : ∀ r ∈ [⟨scA s₀, 8 * H.st.W⟩, ⟨hvA H s₀, H.N + H.B⟩, inR H s₀, opR H s₀, below s₀], + (saveR H.st (scr s₀)).Disjoint r := by + have := hz.W; have := hp.fits; have := hp.nw; rw [buf_eq H] at * + 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 Offset.disjoint_base _ (by omega) (by omega) + · exact Offset.disjoint _ (.inl (by simp only [Hash.hvO, buf_eq H]; omega)) (by omega) + (by simp only [Hash.hvO, buf_eq H]; omega) + · exact (hp.i_s.sub_right (save_sub hp)).symm + · exact (hp.p_s.sub_right (save_sub hp)).symm + · exact (hp.b_s.sub_right (save_sub hp)).symm + +end + +/-! ## What the calls keep -/ + +/-- The registers and memory kept from the prologue on: memory differs from +the entry's only in the regions we may write and below the stack pointer. -/ +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 + r5 : s.gpr .r5 = outer s₀ + r7 : s.gpr .r7 = op s₀ + r11 : s.gpr .r11 = scr s₀ + saved : SavedRegs H.st (scr s₀) s₀ s.mem + frame : Frame [inR H s₀, opR H s₀, scR sc s₀, below s₀] s₀.mem s.mem + +/-- The registers `KR` fixes. -/ +abbrev kregs : List Reg := [.r5, .r7, .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' ∈ [inR H s₀, opR H s₀, scR sc s₀, below 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.r5, + (hg _ (by simp)).trans h.r7, (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) + +end + +/-! ## The prologue and the call of `finalize` -/ + +section +variable {H : Hash} (hH : HashOK H) {sc : Nat} {s₀ : State} (hp : Pre H sc s₀) +include hp + +theorem sa1 : stackArgAddr s₀ 1 = stackArgAddr s₀ 0 + BitVec.ofNat 64 4 := by + have := hp.spf + simp only [stackArgAddr] + rw [addr_add (k := 4 * 1) (by omega), addr_add (k := 4 * 0) (by omega), BitVec.add_zero] + +theorem wr_mem : scR sc s₀ ∈ s₀.wr ∧ inR H s₀ ∈ s₀.wr ∧ opR H s₀ ∈ s₀.wr := by + rw [hp.wr]; simp + +include hH in +theorem pro_ok : WP isa (.block H.finPrologue) s₀ fun s => KR H sc s₀ s ∧ s.gpr .r0 = inn s₀ ∧ + count s = count s₀ ∧ Frame [saveR H.st (scr s₀)] s₀.mem s.mem := by + have hz := hH.sizes + have hW := hz.W; have hf := hp.fits; have nw := hp.nw; rw [buf_eq H] at hf + obtain ⟨sR, _, _⟩ := wr_mem hp + have aR : argR s₀ ∈ s₀.rd ++ s₀.wr := by rw [hp.rd]; simp + unfold Hash.finPrologue + 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) + (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₃ => + wp_ldrSp (a := stackArgAddr s₀ 0) (by decide) (by rw [u₃.sp, hsp₂]; rfl) + (by rw [u₃.rd, u₃.wr, rd₂, wr₂, u₁.rd, u₁.wr] + exact ⟨argR s₀, aR, by simp [Region.Contains]⟩) 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] + have f₂' : Frame [saveR H.st (scr s₀)] s₀.mem s₂.mem := by rw [← u₁.mem]; exact f₂ + have ea : s₂.mem.readW (stackArgAddr s₀ 0) 32 = op s₀ := + f₂'.readW (r := ⟨stackArgAddr s₀ 0, 4⟩) (Region.contains_self _ _) (by + simp only [List.mem_singleton]; rintro r rfl + exact (hp.a_s.sub_left (Region.sub_prefix (by omega))).sub_right (save_sub hp)) (by decide) + have k : ∀ r, r ≠ .r5 → r ≠ .r7 → r ≠ .r11 → r ≠ .r12 → s₅.gpr r = s₀.gpr r := + fun r h5 h7 h11 h12 => by rw [u₅.other r h11, u₄.other r h7, u₃.other r h5, e₂ r h12] + 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₅.sp, u₄.sp, u₃.sp, hsp₂], + by rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, e₂ _ (by decide)], + by rw [u₅.other _ (by decide), u₄.gpr, u₃.mem, ea], + by rw [u₅.gpr, 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 hp⟩⟩, + k _ (by decide) (by decide) (by decide) (by decide), + by simp only [count, k _ (by decide) (by decide) (by decide) (by decide : Reg.r2 ≠ .r12), + k _ (by decide) (by decide) (by decide) (by decide : Reg.r3 ≠ .r12)], hm ▸ f₂'⟩ + +/-- The regions of the call of `finalize` on `inner`, into the block. -/ +theorem finArgs {t : State} (hk : KR H sc s₀ t) (h0 : t.gpr .r0 = inn s₀) + (h1 : t.gpr .r1 = blk H s₀) (h12 : t.gpr .r12 = scr s₀) : + FinArgs hH.stream t (inn s₀) (blk H s₀) (scr s₀) := by + have hz := hH.sizes + have hwb := hH.stream.hWb; have hf := hp.fits; have nw := hp.nw; have := hz.W; have := hz.N64 + have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + have eS := hz.S; have eF := hz.F + rw [buf_eq H] at hf + obtain ⟨sR, iR, _⟩ := wr_mem hp + have ab := addr_blk hz hp + have bS : Region.Sub ⟨blkA H s₀, H.N⟩ (scR sc s₀) := fun a h => blk_sub hp a (Region.sub_prefix (by omega) a h) + have cS : Region.Sub ⟨scA s₀, hH.stream.Wb⟩ (scR sc s₀) := Region.sub_prefix (by omega) + have cB : Region.Disjoint ⟨blkA H s₀, H.N⟩ ⟨scA s₀, hH.stream.Wb⟩ := + Offset.disjoint_base _ (by simp only [Hash.blkO, buf_eq H]; omega) (by simp only [Hash.blkO, buf_eq H]; omega) + exact + { r0 := h0, r1 := h1, r12 := h12 + sp16 := by rw [hk.sp]; exact hp.sp16 + cw := by + rw [hk.wr, ab, eS, eF] + 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 | rfl + · exact sub_of_self iR (Nat.le_refl _) + · exact sub_of_off sR (by simp only [Hash.blkO, buf_eq H]; omega) + · exact sub_of_self (r := scR sc s₀) sR (by show hH.stream.Wb ≤ 8 * sc; omega) + st_o := by rw [ab, eS, eF]; exact hp.i_s.sub_right bS + st_sc := by rw [eS]; exact hp.i_s.sub_right cS + o_sc := by rw [ab, eF]; exact cB + b_st := by rw [below_eq hk.sp, eS]; exact hp.b_i + b_o := by rw [below_eq hk.sp, ab, eF]; exact hp.b_s.sub_right bS + b_sc := by rw [below_eq hk.sp]; exact hp.b_s.sub_right cS + nst := by rw [eS]; exact hp.ni + no := by rw [toNat_sO hp (by simp only [Hash.blkO, buf_eq H]; omega), eF]; simp only [Hash.blkO, buf_eq H]; omega + nsc := by omega } + +/-- The call's arguments: the count still in `r2:r3`. -/ +theorem fin1Args_ok {s : State} (hk : KR H sc s₀ s) (h0 : s.gpr .r0 = inn s₀) : + WP isa (.block (([] : List Instr) ++ [] ++ scrAt .r1 H.blkO ++ ([.mov .r12 (.reg .r11)] : List Instr))) s + fun t => KR H sc s₀ t ∧ FinArgs hH.stream t (inn s₀) (blk H s₀) (scr s₀) ∧ count t = count s ∧ + t.mem = s.mem := by + have hf := hp.fits; have := hH.sizes.W + simp only [List.nil_append] + refine scrAt_ok (by simp only [Hash.blkO, buf_eq H]; have := hH.sizes.N64; have := hH.B_le; omega) + fun s₁ g₁ d₁ m₁ rd₁ wr₁ sp₁ => wp_mov (op2_reg _ _) fun s₂ u₂ => WP.block_nil ?_ + have k₁ : KR H sc s₀ s₁ := hk.keep rd₁ wr₁ sp₁ (fun r hr => g₁ r (by + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr; rcases hr with rfl | rfl | rfl <;> decide) + (by simp only [List.mem_cons, List.not_mem_nil, or_false] at hr; rcases hr with rfl | rfl | rfl <;> decide)) + (rs := []) (by rw [m₁]; exact Frame.refl _ _) (by simp) (by simp) + have k₂ : KR H sc s₀ s₂ := k₁.upd (by decide) u₂ + refine ⟨k₂, finArgs hH hp k₂ ?_ ?_ ?_, ?_, by rw [u₂.mem, m₁]⟩ + · rw [u₂.other _ (by decide), g₁ _ (by decide) (by decide), h0] + · rw [u₂.other _ (by decide), d₁, hk.r11] + · rw [u₂.gpr, g₁ _ (by decide) (by decide), hk.r11] + · simp only [count, u₂.other _ (show Reg.r2 ≠ .r12 by decide), g₁ _ (show Reg.r2 ≠ .r1 by decide) + (show Reg.r2 ≠ .r12 by decide), u₂.other _ (show Reg.r3 ≠ .r12 by decide), + g₁ _ (show Reg.r3 ≠ .r1 by decide) (show Reg.r3 ≠ .r12 by decide)] + +theorem finCall_ok {t : State} (hk : KR H sc s₀ t) (ha : FinArgs hH.stream t (inn s₀) (blk H s₀) (scr s₀)) + {Q : State → Prop} + (hQ : ∀ s', KR H sc s₀ s' → + 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 := + 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 + rw [buf_eq H] at hfi + have ab := addr_blk hz hp + have f := ha'.frame + rw [below_eq hk.sp, ab, hz.S, hz.F] at f + rw [ab, hz.F] at hpost + have cS : Region.Sub ⟨scA s₀, hH.stream.Wb⟩ ⟨scA s₀, 8 * H.st.W⟩ := Region.sub_prefix (by omega) + have sd := save_disj hz hp + 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 + ?_ ?_) f fun m hr hl hc => ?_ + · simp only [List.mem_append, List.mem_cons, List.not_mem_nil, or_false] + rintro r ((rfl | rfl | rfl) | rfl) + · exact sd _ (by simp) + · exact (sd _ (List.mem_cons_of_mem _ (List.mem_cons_self ..))).sub_right + (Offset.sub _ (by simp only [Hash.hvO, Hash.blkO]; omega) (by simp only [Hash.hvO, Hash.blkO]; omega)) + · exact (sd _ (by simp)).sub_right cS + · exact sd _ (by simp) + · simp only [List.mem_append, List.mem_cons, List.not_mem_nil, or_false] + rintro r ((rfl | rfl | rfl) | rfl) + · exact ⟨inR H s₀, by simp, fun _ h => h⟩ + · exact ⟨scR sc s₀, by simp, fun a h => blk_sub hp a (Region.sub_prefix (by omega) a h)⟩ + · exact ⟨scR sc s₀, by simp, Region.sub_prefix (by have := hp.fits; rw [buf_eq H] at this; omega)⟩ + · exact ⟨below s₀, by simp, fun _ h => h⟩ + · rw [bytesAt_take _ _ hz.DN]; exact hpost m hr hl hc + +end + +/-! ## The outer hash value and the padding -/ + +/-- The registers during the outer hash. -/ +structure KR' (H : Hash) (sc : Nat) (s₀ s : State) : Prop extends KR H sc s₀ s where + r0 : s.gpr .r0 = hv H s₀ + r3 : s.gpr .r3 = scr s₀ + r6 : s.gpr .r6 = blk H s₀ + +section +variable {H : Hash} {sc : Nat} (hz : Sizes H) {s₀ : State} (hp : Pre H sc s₀) +include hz hp + +omit hz in +/-- What the outer hash writes: the hash value being compressed and the block. -/ +theorem hb_sub : Region.Sub ⟨hvA H s₀, H.N + H.B⟩ (scR sc s₀) := by + have := hp.fits; exact scr_sub (by simp only [Hash.hvO]; omega) + +theorem hb_kr : ∀ r ∈ [(⟨hvA H s₀, H.N + H.B⟩ : Region)], (saveR H.st (scr s₀)).Disjoint r ∧ + ∃ r' ∈ [inR H s₀, opR H s₀, scR sc s₀, below s₀], Region.Sub r r' := by + intro r hr + simp only [List.mem_singleton] at hr; subst hr + exact ⟨save_disj hz hp _ (by simp), scR sc s₀, by simp, hb_sub hp⟩ + +theorem mid_ok {md : Md H.B H.N H.L} (hR : md.Reloc) + (hlen : wordsBytes (lenWords H.be H.L (H.B + H.D)) = md.lenBytes (H.B + H.D)) {s : State} + (hk : KR H sc s₀ s) : + WP isa (.block H.finMid) s fun s' => KR' H sc s₀ s' ∧ Frame [⟨hvA H s₀, H.N + H.B⟩] s.mem s'.mem ∧ + md.stateAt s'.mem (hvA H s₀) = md.stateAt s₀.mem (State.addr (outer s₀)) ∧ + bytesAt s'.mem (blkA H s₀) H.D = bytesAt s.mem (blkA H s₀) H.D ∧ + bytesAt s'.mem (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.D) = md.tailPad H.D := by + have := hz.N64; have := hp.fits; have := hz.DN; have := hz.pad; have := hz.NL; have := hz.D4; have := hz.L4 + have := hz.L16; have := hp.nw; have := hp.no; have := hz.W; have := hz.N4 + have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + have hB4 : H.B % 4 = 0 := by rcases hz.B with h | h <;> omega + have hn : 4 * (H.N / 4) = H.N := by omega + have ablk := addr_blk hz hp; have ahv := addr_hv hz hp + have tb : (blk H s₀).toNat = (scr s₀).toNat + H.blkO := toNat_sO hp (by simp only [Hash.blkO]; omega) + have th : (hv H s₀).toNat = (scr s₀).toNat + H.hvO := toNat_sO hp (by simp only [Hash.hvO]; omega) + obtain ⟨sR, _, _⟩ := wr_mem hp + unfold Hash.finMid Hash.pad Hash.atHv + simp only [List.append_assoc, List.singleton_append] + refine wp_mov (op2_reg _ _) fun s₁ u₁ => ?_ + refine scrAt_ok (by simp only [Hash.hvO, buf_eq H]; omega) fun s₂ g₂ d₂ m₂ rd₂ wr₂ sp₂ => + scrAt_ok (by simp only [Hash.blkO, buf_eq H]; omega) fun s₃ g₃ d₃ m₃ rd₃ wr₃ sp₃ => ?_ + have r11₁ : s₁.gpr .r11 = scr s₀ := by rw [u₁.other _ (by decide), hk.r11] + have r0₃ : s₃.gpr .r0 = hv H s₀ := by rw [g₃ _ (by decide) (by decide), d₂, r11₁] + have r6₃ : s₃.gpr .r6 = blk H s₀ := by rw [d₃, g₂ _ (by decide) (by decide), r11₁] + have r5₃ : s₃.gpr .r5 = outer s₀ := by + rw [g₃ _ (by decide) (by decide), g₂ _ (by decide) (by decide), u₁.other _ (by decide), hk.r5] + have k₃ : KR H sc s₀ s₃ := (hk.upd (by decide) u₁).keep (by rw [rd₃, rd₂]) (by rw [wr₃, wr₂]) + (by rw [sp₃, sp₂]) (fun r hr => by + have : r ≠ .r0 ∧ r ≠ .r6 ∧ r ≠ .r12 := by + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr; rcases hr with rfl | rfl | rfl <;> decide + rw [g₃ r this.2.1 this.2.2, g₂ r this.1 this.2.2]) (rs := []) (by rw [m₃, m₂]; exact Frame.refl _ _) + (by simp) (by simp) + have oR : outerR H s₀ ∈ s₃.rd ++ s₃.wr := by rw [k₃.rd, hp.rd]; simp + refine copyW_ok (by decide) (by decide) 0 0 (H.N / 4) ⟨by omega, by omega⟩ _ s₃ _ + (by rw [r5₃]; omega) (by rw [r0₃, th]; simp only [Hash.hvO]; omega) + (fun j hj => ?_) (fun j hj => ?_) ?_ fun s₄ g₄ rd₄ wr₄ sp₄ m₄ => ?_ + · rw [r5₃, add0]; exact ⟨outerR H s₀, oR, Offset.contains_base _ (by omega) (by omega)⟩ + · rw [r0₃, ahv, k₃.wr, add0, show hvA H s₀ = scA s₀ + BitVec.ofNat 64 H.hvO from rfl, Memory.add_ofNat] + exact in_scr hp rfl (by simp only [Hash.hvO]; omega) + · rw [r5₃, r0₃, ahv, add0, add0, hn] + exact hp.o_s.sep (Memory.contains_base (by omega)) (Offset.contains_base _ (by simp only [Hash.hvO]; omega) + (by simp only [Hash.hvO]; omega)) + rw [r0₃, ahv, r5₃, add0, add0, hn] at m₄ + have g6 : s₄.gpr .r6 = blk H s₀ := by rw [g₄ _ (by decide), r6₃] + refine padFrom_ok (a := H.D) (b := H.B - H.L) (by omega) (by omega) (by omega) (s := s₄) (p := blk H s₀) g6 + (by rw [tb]; simp only [Hash.blkO]; omega) + (fun j hj => by rw [ablk]; exact in_blk hp (wr₄.trans k₃.wr) (by omega)) fun s₅ g₅ rd₅ wr₅ sp₅ m₅ => ?_ + rw [ablk] at m₅ + have lw := HashOK.lenWords_length (H := H) + rw [← List.append_nil (constW (H.B - H.L) (lenWords H.be H.L (H.B + H.D)))] + refine constW_ok (p := blk H s₀) (lenWords H.be H.L (H.B + H.D)) (H.B - H.L) (by rw [lw]; omega) + (by rw [lw, tb]; simp only [Hash.blkO]; omega) _ s₅ _ (by rw [g₅ _ (by decide), g6]) + (fun j hj => by rw [lw] at hj; rw [ablk]; exact in_blk hp (wr₅.trans (wr₄.trans k₃.wr)) (by omega)) + fun s₆ g₆ rd₆ wr₆ sp₆ m₆ => WP.block_nil ?_ + rw [ablk, hlen] at m₆ + have lpz : ([0x80] ++ List.replicate (H.B - H.L - H.D - 1) 0 : List Byte).length = H.B - H.L - H.D := by + simp; omega + have hM : s₆.mem = writeBytes (writeBytes (writeBytes s₃.mem (hvA H s₀) (bytesAt s₃.mem (State.addr (outer s₀)) H.N)) + (blkA H s₀ + BitVec.ofNat 64 H.D) ([0x80] ++ List.replicate (H.B - H.L - H.D - 1) 0)) + (blkA H s₀ + BitVec.ofNat 64 (H.B - H.L)) (md.lenBytes (H.B + H.D)) := by + rw [m₆, m₅, m₄] + have hG : ∀ r, r ≠ .r12 → s₆.gpr r = s₃.gpr r := fun r hr => by rw [g₆ r hr, g₅ r hr, g₄ r hr] + have eb : blkA H s₀ = hvA H s₀ + BitVec.ofNat 64 H.N := by + rw [hvA, blkA, Memory.add_ofNat]; rfl + have fM : Frame [⟨hvA H s₀, H.N + H.B⟩] s₃.mem s₆.mem := by + rw [hM] + refine ((writeBytes_frame _ _ _ ?_).trans (writeBytes_frame _ _ _ ?_)).trans (writeBytes_frame _ _ _ ?_) + · rw [bytesAt_length]; exact Memory.contains_base (by omega) + · rw [lpz, eb, Memory.add_ofNat]; exact Offset.contains_base _ (by omega) (by omega) + · rw [md.lenBytes_length, eb, Memory.add_ofNat]; exact Offset.contains_base _ (by omega) (by omega) + have m₃' : s₃.mem = s.mem := by rw [m₃, m₂, u₁.mem] + have S1 : Mem.Sep (blkA H s₀) H.D (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.L - H.D) := by + have := Offset.sep (blkA H s₀) (d := 0) (n := H.D) (e := H.D) (k := H.B - H.L - H.D) (.inl (by omega)) + (by omega) (by omega) + rwa [add0] at this + have S2 : ∀ {a n : Nat}, a + n ≤ H.B - H.L → + Mem.Sep (blkA H s₀ + BitVec.ofNat 64 a) n (blkA H s₀ + BitVec.ofNat 64 (H.B - H.L)) H.L := + fun h' => Offset.sep _ (.inl h') (by omega) (by omega) + have S3 : Mem.Sep (blkA H s₀) H.D (hvA H s₀) H.N := by + have := Offset.sep (hvA H s₀) (d := H.N) (n := H.D) (e := 0) (k := H.N) (.inr (by omega)) (by omega) (by omega) + rwa [add0, ← eb] at this + have f₄₆ : Frame [⟨blkA H s₀, H.B⟩] s₄.mem s₆.mem := by + rw [m₆, m₅] + refine (writeBytes_frame _ _ _ ?_).trans (writeBytes_frame _ _ _ ?_) + · rw [lpz]; exact Offset.contains_base _ (by omega) (by omega) + · rw [md.lenBytes_length]; exact Offset.contains_base _ (by omega) (by omega) + have dHB : Region.Disjoint ⟨hvA H s₀, H.N⟩ ⟨blkA H s₀, H.B⟩ := + Offset.disjoint _ (.inl (by simp only [Hash.hvO, Hash.blkO]; omega)) (by simp only [Hash.hvO]; omega) + (by simp only [Hash.blkO]; omega) + refine ⟨⟨k₃.keep (by rw [rd₆, rd₅, rd₄]) (by rw [wr₆, wr₅, wr₄]) (by rw [sp₆, sp₅, sp₄]) (fun r hr => hG r (by + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr; rcases hr with rfl | rfl | rfl <;> decide)) + fM (fun r hr => (hb_kr hz hp r hr).1) (fun r hr => (hb_kr hz hp r hr).2), + by rw [hG _ (by decide), r0₃], by rw [hG _ (by decide), g₃ _ (by decide) (by decide), + g₂ _ (by decide) (by decide), u₁.gpr, hk.r11], by rw [hG _ (by decide), r6₃]⟩, + m₃' ▸ fM, ?_, ?_, ?_⟩ + · refine hR _ _ _ _ fun i hi => ?_ + rw [f₄₆.bytes (R := ⟨hvA H s₀, H.N⟩) (fun r hr => by simp at hr; subst hr; exact dHB) (by show H.N ≤ 2 ^ 64; omega) hi, m₄, + writeBytes_at _ _ _ (by rw [bytesAt_length]; exact hi) (by rw [bytesAt_length]; omega), + bytesAt_getD' _ _ hi] + exact k₃.frame.bytes (R := outerR H s₀) (by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl | rfl) + · exact hp.i_o.symm + · exact hp.o_p + · exact hp.o_s + · exact hp.b_o.symm) (by show H.N + H.B ≤ 2 ^ 64; omega) (by show i < H.N + H.B; omega) + · rw [hM, bytesAt_writeBytes_sep _ _ (by + rw [md.lenBytes_length]; have := S2 (a := 0) (n := H.D) (by omega); rwa [add0] at this) (by omega), + bytesAt_writeBytes_sep _ _ (by rw [lpz]; exact S1) (by omega), + bytesAt_writeBytes_sep _ _ (by rw [bytesAt_length]; exact S3) (by omega), m₃'] + · rw [show H.B - H.D = (H.B - H.L - H.D) + H.L by omega, bytesAt_add, Memory.add_ofNat (blkA H s₀), + show H.D + (H.B - H.L - H.D) = H.B - H.L by omega, hM, + bytesAt_writeBytes_self' (md.lenBytes_length _) (by omega), + bytesAt_writeBytes_sep _ _ (by rw [md.lenBytes_length]; exact S2 (by omega)) (by omega), + bytesAt_writeBytes_self' lpz (by omega), Md.tailPad, show H.B - H.L - 1 - H.D = H.B - H.L - H.D - 1 by omega] + +end + +/-! ## The compression and the MAC -/ + +section +variable {H : Hash} {sc : Nat} (hz : Sizes H) {s₀ : State} (hp : Pre H sc s₀) +include hz hp + +/-- What the call of the compression function needs. -/ +theorem callOk_of {s : State} (h : KR' H sc s₀ s) : + CallOk s H.N H.B H.so (hv H s₀) (scr s₀) (blk H s₀) := by + have := hz.N64; have := hp.fits; have := hp.nw; have := hz.so; have hB := hz.B + have hsc : scR sc s₀ ∈ s.wr := by simp [h.wr, hp.wr] + rw [buf_eq H] at * + refine ⟨h.r0, h.r3, h.r6, by rw [toNat_sO hp (by simp only [Hash.hvO, buf_eq H]; omega)]; simp only [Hash.hvO, buf_eq H]; omega, + by rw [toNat_sO hp (by simp only [Hash.blkO, buf_eq H]; omega)]; simp only [Hash.blkO, buf_eq H]; omega, + by omega, ?_, ?_, ?_, ?_, ?_⟩ + all_goals simp only [addr_hv hz hp, addr_blk hz hp, hvA, blkA, Hash.hvO, Hash.blkO, buf_eq H] + · exact Offset.disjoint_base _ (by omega) (by omega) + · exact Offset.disjoint _ (.inr (by omega)) (by omega) (by omega) + · exact Offset.disjoint_base _ (by omega) (by omega) + · refine Covers.of_sub fun r hr => ⟨scR sc s₀, List.mem_append_right _ hsc, ?_⟩ + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl + · exact ⟨_, rfl, by dsimp only; omega⟩ + · exact ⟨_, rfl, by dsimp only; omega⟩ + · exact ⟨0, by simp, by dsimp only; omega⟩ + · refine Covers.of_sub fun r hr => ⟨scR sc s₀, hsc, ?_⟩ + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl + · exact ⟨_, rfl, by dsimp only; omega⟩ + · exact ⟨0, by simp, by dsimp only; omega⟩ + +/-- The compression of the block into the outer hash value. -/ +theorem cmp_ok {md : Md H.B H.N H.L} (hf : CompOk md H.so H.compC) {s : State} (h : KR' H sc s₀ s) + {Q : State → Prop} + (k : ∀ s', KR' H sc s₀ s' → Frame [⟨hvA H s₀, H.N⟩, ⟨scA s₀, H.so⟩] s.mem s'.mem → + md.stateAt s'.mem (hvA H s₀) = md.compress (md.stateAt s.mem (hvA H s₀)) (md.blockAt s.mem (blkA H s₀)) → + Q s') : + WP isa H.compressBlock s Q := by + have := hz.N64; have := hp.fits; have := hz.so; have := hz.W + have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + refine compressBlock_ok hf (callOk_of hz hp h) fun s' hrd hwr hcs h0 h3 hsp hfr hst => ?_ + rw [addr_hv hz hp] at hfr + rw [addr_hv hz hp, addr_blk hz hp] at hst + have sd := save_disj hz hp + rw [buf_eq H] at * + refine k s' ⟨h.toKR.keep hrd hwr hsp (fun r hr => hcs r (kregs_pres r hr).1 (kregs_pres r hr).2) hfr ?_ ?_, + h0, h3, (hcs _ (by decide) (by decide)).trans h.r6⟩ hfr hst + · simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · exact (sd _ (List.mem_cons_of_mem _ (List.mem_cons_self ..))).sub_right (Region.sub_prefix (by omega)) + · exact (sd ⟨scA s₀, 8 * H.st.W⟩ (List.mem_cons_self ..)).sub_right (Region.sub_prefix (by omega)) + · simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · exact ⟨scR sc s₀, by simp, scr_sub (by simp only [Hash.hvO, buf_eq H]; omega)⟩ + · exact ⟨scR sc s₀, by simp, Region.sub_prefix (by omega)⟩ + +/-- The MAC to `out`, and our caller's registers back. -/ +theorem out_ok {md : Md H.B H.N H.L} (ho : OutOk md H.out) {s : State} (h : KR' H sc s₀ s) : + WP isa (.block H.finOut) s fun s' => abiPreserved s₀ s' ∧ + bytesAt s'.mem (State.addr (op s₀)) H.D = (md.digest (md.stateAt s.mem (hvA H s₀))).take H.D := by + have := hz.N64; have := hp.fits; have := hz.DN; have := hz.D4; have := hz.W; have := hp.nw; have := hp.np + have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + have hD4 : 4 * (H.D / 4) = H.D := by omega + have ahv := addr_hv hz hp; have ablk := addr_blk hz hp + have th : (hv H s₀).toNat = (scr s₀).toNat + H.hvO := toNat_sO hp (by simp only [Hash.hvO]; omega) + have tb : (blk H s₀).toNat = (scr s₀).toNat + H.blkO := toNat_sO hp (by simp only [Hash.blkO]; omega) + obtain ⟨sR, _, pR⟩ := wr_mem hp + have hdl := md.digest_length (md.stateAt s.mem (hvA H s₀)) + -- The restore, after code that writes `out` and maybe the block. + have fin : ∀ s₁ : State, s₁.gpr .r11 = scr s₀ → s₁.rd = s.rd → s₁.wr = s.wr → s₁.sp = s.sp → + SavedRegs H.st (scr s₀) s₀ s₁.mem → + bytesAt s₁.mem (State.addr (op s₀)) H.D = (md.digest (md.stateAt s.mem (hvA H s₀))).take H.D → + WP isa (.block H.st.restore) s₁ fun s' => abiPreserved s₀ s' ∧ + 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) + (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 + intro R hR + have sd := save_disj hz hp + simp only [List.mem_cons, List.not_mem_nil, or_false] at hR + rcases hR with rfl | rfl + · exact sd _ (by simp) + · have hfi := hp.fits; rw [buf_eq H] at hfi + exact (sd _ (List.mem_cons_of_mem _ (List.mem_cons_self ..))).sub_right + (Offset.sub _ (by simp only [Hash.hvO, Hash.blkO]; omega) (by simp only [Hash.hvO, Hash.blkO]; omega)) + unfold Hash.finOut + by_cases hDN : H.D < H.N + · simp only [hDN, ↓reduceIte, List.append_assoc] + rw [WP.block_append_iff] + refine WP.mono (ho s ?_ ?_ ?_ ?_ ?_) fun s₁ ⟨g₁, rd₁, wr₁, sp₁, m₁⟩ => ?_ + · rw [h.r0, th]; simp only [Hash.hvO]; omega + · rw [h.r6, tb]; simp only [Hash.blkO]; omega + · rw [h.r0, ahv]; exact in_scr' hp h.wr (by simp only [Hash.hvO]; omega) + · rw [h.r6, ablk]; exact in_scr hp h.wr (by simp only [Hash.blkO]; omega) + · rw [h.r0, h.r6, ahv, ablk]; exact Offset.disjoint _ (.inl (by simp only [Hash.hvO, Hash.blkO]; omega)) + (by simp only [Hash.hvO]; omega) (by simp only [Hash.blkO]; omega) + rw [h.r6, ablk, h.r0, ahv] at m₁ + have g6 : s₁.gpr .r6 = blk H s₀ := by rw [g₁ _ (by decide) (by decide), h.r6] + have g7 : s₁.gpr .r7 = op s₀ := by rw [g₁ _ (by decide) (by decide), h.r7] + refine copyW_ok (by decide) (by decide) 0 0 (H.D / 4) ⟨by omega, by omega⟩ _ s₁ _ + (by rw [g6, tb]; simp only [Hash.blkO]; omega) (by rw [g7]; omega) + (fun j hj => ?_) (fun j hj => ?_) ?_ fun s₂ g₂ rd₂ wr₂ sp₂ m₂ => ?_ + · rw [g6, ablk, rd₁, wr₁, add0] + obtain ⟨r, hr, hc⟩ := in_blk hp h.wr (a := 4 * j) (n := 4) (by omega) + exact ⟨r, List.mem_append_right _ hr, hc⟩ + · rw [g7, wr₁, h.wr, add0]; exact ⟨opR H s₀, pR, Offset.contains_base _ (by omega) (by omega)⟩ + · rw [g6, g7, ablk, add0, add0, hD4] + exact (hp.p_s.sub_right (fun a ha => blk_sub hp a (Region.sub_prefix (by omega) a ha))).symm.sep + (Region.contains_self _ _) (Region.contains_self _ _) + rw [g7, g6, ablk, add0, add0, hD4] at m₂ + have f₁ : Frame [⟨blkA H s₀, H.N⟩] s.mem s₁.mem := by + rw [m₁]; exact writeBytes_frame _ _ _ (by rw [hdl]; exact Region.contains_self _ _) + have f₂ : Frame [opR H s₀] s₁.mem s₂.mem := by + rw [m₂]; exact writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact Region.contains_self _ _) + refine fin s₂ (by rw [g₂ _ (by decide), g₁ _ (by decide) (by decide), h.r11]) (rd₂.trans rd₁) + (wr₂.trans wr₁) (sp₂.trans sp₁) ((h.saved.frame H.st f₁ fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact sdisj (by simp)).frame H.st f₂ fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact sdisj (by simp)) ?_ + rw [m₂, bytesAt_writeBytes_self' (bytesAt_length _ _ _) (by omega), bytesAt_take _ _ hz.DN, m₁, + bytesAt_writeBytes_self' hdl (by omega)] + · simp only [hDN, ↓reduceIte, List.cons_append] + have eDN : H.D = H.N := by omega + refine wp_mov (op2_reg _ _) fun s₁ u₁ => ?_ + rw [WP.block_append_iff] + refine WP.mono (ho s₁ ?_ ?_ ?_ ?_ ?_) fun s₂ ⟨g₂, rd₂, wr₂, sp₂, m₂⟩ => ?_ + · rw [u₁.other _ (by decide), h.r0, th]; simp only [Hash.hvO]; omega + · rw [u₁.gpr, h.r7, ← eDN]; omega + · rw [u₁.other _ (by decide), h.r0, ahv, u₁.rd, u₁.wr]; exact in_scr' hp h.wr (by simp only [Hash.hvO]; omega) + · rw [u₁.gpr, h.r7, u₁.wr, h.wr, ← eDN]; exact ⟨opR H s₀, pR, Region.contains_self _ _⟩ + · rw [u₁.other _ (by decide), u₁.gpr, h.r0, h.r7, ahv, ← eDN] + exact (hp.p_s.sub_right (scr_sub (by simp only [Hash.hvO]; omega))).symm + rw [u₁.gpr, h.r7, u₁.other _ (by decide), h.r0, ahv, u₁.mem] at m₂ + have f₂ : Frame [opR H s₀] s.mem s₂.mem := by + rw [m₂]; exact writeBytes_frame _ _ _ (by rw [hdl, ← eDN]; exact Region.contains_self _ _) + refine fin s₂ (by rw [g₂ _ (by decide) (by decide), u₁.other _ (by decide), h.r11]) (rd₂.trans u₁.rd) + (wr₂.trans u₁.wr) (sp₂.trans u₁.sp) (h.saved.frame H.st f₂ fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact sdisj (by simp)) ?_ + rw [m₂, eDN, bytesAt_writeBytes_self' hdl (by omega), List.take_of_length_le (by rw [hdl])] + +end + +/-! ## Correctness -/ + +theorem correct {H : Hash} (hH : HashOK H) {sc : Nat} {s₀ : State} (hp : Pre H sc s₀) : + WP isa H.hmacFin s₀ fun s' => abiPreserved s₀ s' ∧ (finG hH.SH sc).post s₀ s' := by + 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 + 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₂ => ?_)) + refine WP.seq (WP.mono (mid_ok hz hp hH.reloc hH.len k₂) fun s₃ ⟨k₃, _, st₃, b₃, p₃⟩ => ?_) + refine WP.seq (cmp_ok hz hp hH.comp k₃ fun s₄ k₄ _ e₄ => ?_) + refine WP.mono (out_ok hz hp hH.out k₄) fun s' ⟨habi, hout⟩ => ⟨habi, ?_⟩ + intro k0 text hk0 hlen hrI hcnt hrO + have hk0' : k0.length = H.B := by rw [hk0, hH.hB] + have hl0 : (xorPad k0 ipad ++ text).length = H.B + text.length := by + rw [List.length_append, VG.Proof.Hmac.Common.xorPad_length, hk0'] + -- 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 + 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]) + -- The outer hash. + rw [st₃, blockAt_eq (by omega) p₃, b₃, dig] at e₄ + show bytesAt s'.mem (State.addr (op s₀)) hH.SH.digestBytes = hmacBlockKey hH.SH.H k0 text + rw [hH.hD, hout, e₄, Md.hmac_outer hH.link hk0 hrO] + +end VG.Proof.Pbkdf2.Md.Arm.Fin diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFinCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFinCT.lean new file mode 100644 index 000000000..6240f3c52 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacFinCT.lean @@ -0,0 +1,164 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.HmacFin +import VerifiedGarbage.Proof.Framework.Arm.ArgTaint + +/-! +# HMAC's `finalize` over a Merkle–Damgård hash function on ARMv7: constant time + +Untrusted: everything here is checked by Lean. As for `iterate` +(`IterateCT.lean`): we relate two runs (`RelCT`). 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 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 by its own (`compressBlock_rel`). +-/ + +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.Proof.Pbkdf2.Md.Arm +open VG.Proof.Hmac.Generic.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] + +/-- The taint checks of the pieces of `finalize` between its calls, which +depend on the hash function's sizes, its length field and its digest. -/ +structure Checks (H : Hash) : Prop where + pro : ∃ hc, (taint.check (argTaint [.r0, .r1, .r2, .r3] 8) (.block H.finPrologue) hc).isSome = true + fin1 : ∃ hc, (taint.check (Taint.ofRegs kregs) + (.block (([] : List Instr) ++ [] ++ scrAt .r1 H.blkO ++ [.mov .r12 (.reg .r11)])) hc).isSome = true + mid : ∃ hc, (taint.check (Taint.ofRegs kregs) (.block H.finMid) hc).isSome = true + out : ∃ hc, (taint.check (Taint.ofRegs regsO) (.block H.finOut) 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 + a1 : stackArg s₀ 1 = stackArg s₀' 1 + +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.r5, h'.r5, outer, outer, hq.r1] + · rw [h.r7, h'.r7, op, op, hq.a0] + · rw [h.r11, h'.r11, scr, scr, hq.a1] + +theorem kr'_agree (hq : PubEq s₀ s₀') {s s' : State} (h : KR' H sc s₀ s) (h' : KR' H sc s₀' s') : + ∀ r ∈ regsO, 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 | rfl + · rw [h.r0, h'.r0, hv, hv, scr, scr, hq.a1] + · rw [h.r3, h'.r3, scr, scr, hq.a1] + · exact kr_agree hq h.toKR h'.toKR _ (by simp) + · rw [h.r6, h'.r6, blk, blk, scr, scr, hq.a1] + · exact kr_agree hq h.toKR h'.toKR _ (by simp) + · exact kr_agree hq h.toKR h'.toKR _ (by simp) + +/-- Code the taint analysis checks from the registers `rs`, in two runs +whose single-run facts `F` and `F'` agree on them. -/ +theorem rel_regs {F F' G G' : State → Prop} {c : Prog isa} (rs : List Reg) + (hag : ∀ s s', F s → F' s' → ∀ r ∈ rs, s.gpr r = s'.gpr r) + (hc : ∃ hc, (taint.check (Taint.ofRegs rs) c hc).isSome = true) + (hw : ∀ s, F s → WP isa c s G) (hw' : ∀ s, F' s → WP isa c s G') : + RelCT isa (fun s s' => F s ∧ F' s') c fun s s' => G s ∧ G' s' := by + obtain ⟨_, hc⟩ := hc + exact ((RelCT.taint (A := taint) (Taint.ofRegs rs) (fun s s' h => Taint.agree_ofRegs (hag s s' h.1 h.2)) hc).wp + fun s s' h => ⟨hw s h.1, hw' s' h.2⟩).mono (fun _ _ h => h) fun _ _ h => h.2 + +end + +theorem fin_ct {H : Hash} (hH : HashOK H) (hc : Checks H) {sc : Nat} {s₀ s₀' : State} (hp : Pre H sc s₀) + (hp' : Pre H sc s₀') (hq : PubEq s₀ s₀') : + RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.hmacFin fun _ _ => True := by + have hz := hH.sizes + have e : inn s₀' = inn s₀ ∧ blk H s₀' = blk H s₀ ∧ scr s₀' = scr s₀ ∧ hv H s₀' = hv H s₀ := by + refine ⟨hq.r0.symm, ?_, hq.a1.symm, ?_⟩ <;> simp only [blk, hv, scr, hq.a1] + have hcnt : count s₀ = count s₀' := by rw [count, count, hq.r2, hq.r3] + have aw : ∀ {t : State}, Pre H sc t → + t.sp.toNat + 8 ≤ 2 ^ 32 ∧ ∀ r ∈ t.wr, Region.Disjoint ⟨State.addr t.sp, 8⟩ r := fun {t} h => by + have e : (⟨State.addr t.sp, 8⟩ : 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_p + · exact h.a_s + let P₁ : State → State → Prop := fun t₀ s => KR H sc t₀ s ∧ s.gpr .r0 = inn t₀ ∧ count s = count t₀ + let F₁ : State → State → Prop := fun t₀ s => + KR H sc t₀ s ∧ FinArgs hH.stream s (inn t₀) (blk H t₀) (scr t₀) ∧ count s = count t₀ + have pro : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') (.block H.finPrologue) fun s s' => P₁ s₀ s ∧ P₁ s₀' s' := + rel_agree (argTaint [.r0, .r1, .r2, .r3] 8) (fun s s' e e' => by + rw [e, e'] + refine agree_argTaint (fun r hr => ?_) hq.sp (aw hp) (aw hp') + (argMem_of (j := 2) hq.sp hp.spf fun i hi => by + rcases (show i = 0 ∨ i = 1 by omega) with rfl | rfl + · exact hq.a0 + · exact hq.a1) + 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 WP.mono (pro_ok hH hp) fun _ ⟨k, r0, c, _⟩ => ⟨k, r0, c⟩) + (fun _ e => by rw [e]; exact WP.mono (pro_ok hH hp') fun _ ⟨k, r0, c, _⟩ => ⟨k, r0, c⟩) + have f1 := rel_regs (F := P₁ s₀) (F' := P₁ s₀') (G := F₁ s₀) (G' := F₁ s₀') kregs + (fun _ _ h h' => kr_agree hq h.1 h'.1) hc.fin1 + (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)) + 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, + by rw [h'.1.sp, hq.sp]⟩) + (fun _ h => finCall_ok hH hp h.1 h.2.1 fun _ k _ _ => k) + (fun _ h => finCall_ok hH hp' h.1 h.2.1 fun _ k _ _ => k) + have mid := rel_regs (F := KR H sc s₀) (F' := KR H sc s₀') (G := KR' H sc s₀) (G' := KR' H sc s₀') kregs + (fun _ _ h h' => kr_agree hq h h') hc.mid + (fun _ h => WP.mono (mid_ok hz hp hH.reloc hH.len h) fun _ h => h.1) + (fun _ h => WP.mono (mid_ok hz hp' hH.reloc hH.len h) fun _ h => h.1) + have cmp : RelCT isa (fun s s' => KR' H sc s₀ s ∧ KR' H sc s₀' s') H.compressBlock + fun s s' => KR' H sc s₀ s ∧ KR' H sc s₀' s' := + rel_wp (compressBlock_rel (H := hH.md) (so := H.so) hH.comp (name := H.compN) (st := hv H s₀) (scr := scr s₀) + (src := blk H s₀) fun s s' ⟨h, h'⟩ => by + have c' := callOk_of hz hp' h' + rw [e.2.2.2, e.2.2.1, e.2.1] at c' + exact ⟨callOk_of hz hp h, c'⟩) + (fun _ h => cmp_ok hz hp hH.comp h fun _ k _ _ => k) + (fun _ h => cmp_ok hz hp' hH.comp h fun _ k _ _ => k) + 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 + exact pro.seq ((f1.seq call).seq (mid.seq (cmp.seq out))) + +/-! ## Verified -/ + +theorem pubEq_of {S : Spec.Hmac.StreamingHash} {W : Nat} {s₁ s₂ : State} (h : (finG 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.1, h.2.2.2.2.2.2⟩ + +/-- HMAC's `finalize` is verified against `finG`, 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 + H.N + H.B ≤ 8 * sc) + (hsat : ∃ s, (finG hH.SH sc).pre s) : + Verified Arm.target H.hmacFin (finG 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 (fin_ct hH hc (pre_of hH h₁ hfit) (pre_of hH h₂ hfit) (pubEq_of hpub) _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 + +end VG.Proof.Pbkdf2.Md.Arm.Fin diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean new file mode 100644 index 000000000..77dc3b584 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean @@ -0,0 +1,333 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.IterateCT +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.HmacFinCT +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Sha512 +import VerifiedGarbage.Proof.Hmac.Generic.Arm.Instances +import VerifiedGarbage.Proof.Sha1.Arm.Stream.Md +import VerifiedGarbage.Proof.Md5.Arm.Stream.Md +import VerifiedGarbage.Proof.Sha1.Arm.Lit +import VerifiedGarbage.Proof.Sha512.Arm.Lit +import VerifiedGarbage.Proof.Sha512.Arm.Shared + +/-! +# HMAC and PBKDF2-HMAC over Merkle–Damgård hash functions on ARMv7: the instances + +Untrusted: everything here is checked by Lean. 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-224 is in `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 + sha384OK sha512OK sha512_224OK sha512_256OK) + +/-! ## The hash functions -/ + +/-- SHA-1: a 20-byte hash value, a big-endian length field, and +`vg_sha1_compress`, with 112 bytes of scratch space. -/ +def sha1Md : Hash where + st := sha1H + N := 20 + L := 8 + be := true + so := 112 + out := Impl.Sha1.Arm.Stream.params.out + compN := "vg_sha1_compress" + compC := Impl.Sha1.Arm.compress + +/-- MD5: a 16-byte hash value, a little-endian length field, and +`vg_md5_compress`, with 64 bytes of scratch space. -/ +def md5Md : Hash where + st := md5H + N := 16 + L := 8 + be := false + so := 64 + out := Impl.Md5.Arm.Stream.params.out + compN := "vg_md5_compress" + compC := Impl.Md5.Arm.compress + +/-- The member of the SHA-512 family with a `D`-byte digest, initial hash +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 + N := 64 + L := 16 + be := true + so := 224 + out := (List.range 8).flatMap Impl.Sha512.Arm.Stream.outW + compN := "vg_sha512_compress" + compC := Impl.Sha512.Arm.compress + +def sha384Md : Hash := sha512Md 48 "vg_sha384_init" Spec.Sha512.H0_384 +def sha512Md' : Hash := sha512Md 64 "vg_sha512_init" Spec.Sha512.H0_512 +def sha512_224Md : Hash := sha512Md 28 "vg_sha512_224_init" Spec.Sha512.H0_512_224 +def sha512_256Md : Hash := sha512Md 32 "vg_sha512_256_init" Spec.Sha512.H0_512_256 + +/-! ## What the proofs need of them -/ + +theorem sha1_comp : CompOk Proof.Sha1.md 112 Impl.Sha1.Arm.compress := + ⟨Proof.Sha1.Arm.compress_verified.1, Proof.Sha1.Arm.compress_verified.2.1, by lit_decide, + by rw [← Code.allInstrs_eq]; lit_decide⟩ + +def sha1MdOK : HashOK sha1Md where + md := Proof.Sha1.md + out := OutOk.ofShape Proof.Sha1.Arm.Stream.shape + comp := sha1_comp + reloc m m' p q h := by + apply Vector.ext + intro j hj + simp only [Proof.Sha1.md, Spec.Sha1.stateAt, Vector.getElem_ofFn] + exact Hmac.Generic.Common.readW_reloc (n := 20) h (by omega) + len := by decide + stream := sha1OK + iv := Spec.Sha1.H0 + repr _ _ _ h := h + hash m := by + 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 + 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⟩ + +theorem md5_comp : CompOk Proof.Md5.md 64 Impl.Md5.Arm.compress := + ⟨Proof.Md5.Arm.compress_verified.1, Proof.Md5.Arm.compress_verified.2.1, by decide +kernel, + by rw [← Code.allInstrs_eq]; decide +kernel⟩ + +def md5MdOK : HashOK md5Md where + md := Proof.Md5.md + out := OutOk.ofShape Proof.Md5.Arm.Stream.shape + comp := md5_comp + reloc m m' p q h := by + apply Vector.ext + intro j hj + simp only [Proof.Md5.md, Spec.Md5.stateAt, Vector.getElem_ofFn] + exact Hmac.Generic.Common.readW_reloc (n := 16) h (by omega) + len := by decide + stream := md5OK + iv := Spec.Md5.H0 + repr _ _ _ h := h + hash m := by + 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 + 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⟩ + +theorem sha512_comp : CompOk Proof.Sha512.md 224 Impl.Sha512.Arm.compress := + ⟨Proof.Sha512.Arm.Compress.compress_verified.1, Proof.Sha512.Arm.Compress.compress_verified.2.1, by lit_decide, + by rw [← Code.allInstrs_eq]; lit_decide⟩ + +/-- `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)) + (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)) : + HashOK (sha512Md D initN iv) where + md := Proof.Sha512.md + out := sha512_out + comp := sha512_comp + reloc m m' p q h := by + apply Vector.ext + intro j hj + simp only [Proof.Sha512.md, Spec.Sha512.stateAt, Vector.getElem_ofFn] + exact Hmac.Generic.Common.readW_reloc (n := 64) h (by omega) + len := hlen + stream := hs + iv := iv + repr mem p m h := by rw [hR] at h; exact Proof.Sha512.repr_iff.mp h + hash m := by rw [hh, Proof.Sha512.finalHash_eq]; rfl + sizes := hz + +def sha384MdOK : HashOK sha384Md := + sha512MdOK sha384OK rfl (fun _ => rfl) + ⟨.inr 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⟩ (by decide) + +def sha512MdOK' : HashOK sha512Md' := + sha512MdOK sha512OK rfl + (fun m => (List.take_of_length_le (Nat.le_of_eq (Hmac.Generic.Common.finalHash_length _ m))).symm) + ⟨.inr 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⟩ (by decide) + +def sha512_224MdOK : HashOK sha512_224Md := + sha512MdOK sha512_224OK rfl (fun _ => rfl) + ⟨.inr 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⟩ (by decide) + +def sha512_256MdOK : HashOK sha512_256Md := + sha512MdOK sha512_256OK rfl (fun _ => rfl) + ⟨.inr 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⟩ (by decide) + +end VG.Proof.Pbkdf2.Md.Arm + +namespace VG.Proof.Pbkdf2.Md.Arm.Instances + +open VG.Arm +open VG.Proof.Pbkdf2.Md.Arm +open VG.Proof.Hmac.Generic.Arm (iterG below) + +/-- 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 +`0x4000`, is the stack argument. -/ +def iterSat (S D sc : Nat) : State where + gpr r := match r with + | .r0 => 0x1000 | .r1 => 0x2000 | .r3 => 0x3000 + | _ => 0 + sp := 0x6000 + n := false + z := false + c := false + v := false + mem a := if a = 0x6001 then 0x40 else 0 + rd := [⟨0x1000, 2 * S⟩, ⟨0x2000, D⟩, ⟨0x6000, 4⟩] + wr := [⟨0x3000, D⟩, ⟨0x4000, 8 * sc⟩] + +/-- `iterG` implies the shared contract for any hash function and scratch space +(`generic_implies`), given that the shared contract is satisfiable. -/ +theorem iterImp (S : Spec.Hmac.StreamingHash) (W : Nat) (h : ∃ s, (Spec.Pbkdf2.iterateContract S W Arm.abi 16).pre s) : + (iterG S W).Implies (Spec.Pbkdf2.iterateContract S W Arm.abi 16) := by + generic_implies [ + Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, iterG, below, Arm.abi, Arm.argRegs, + Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using h + +/-! ## SHA-1 -/ + +theorem sha1_iterChecks : Iterate.Checks sha1Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha1_finChecks : Fin.Checks sha1Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha1_iterImp : (iterG Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.iterateContract Arm.abi 16) := + iterImp Spec.Hmac.sha1S 56 (by + inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha1S, Spec.Hmac.sha1, iterG, below, + Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 84 20 56) + +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_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 + +/-! ## MD5 -/ + +theorem md5_iterChecks : Iterate.Checks md5Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem md5_finChecks : Fin.Checks md5Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem md5_iterImp : (iterG Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.iterateContract Arm.abi 16) := + iterImp Spec.Hmac.md5S 48 (by + inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.md5S, Spec.Hmac.md5, iterG, below, + Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 80 16 48) + +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_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 + +/-! ## SHA-384 -/ + +theorem sha384_iterChecks : Iterate.Checks sha384Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha384_finChecks : Fin.Checks sha384Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha384_iterImp : (iterG Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I.iterateContract Arm.abi 16) := + iterImp Spec.Hmac.sha384S 234 (by + inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha384S, Spec.Hmac.sha384, iterG, below, + Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 192 48 234) + +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_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 + +/-! ## SHA-512 -/ + +theorem sha512_iterChecks : Iterate.Checks sha512Md' := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha512_finChecks : Fin.Checks sha512Md' := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha512_iterImp : (iterG Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I.iterateContract Arm.abi 16) := + iterImp Spec.Hmac.sha512S 234 (by + inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha512S, Spec.Hmac.sha512, iterG, below, + Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 192 64 234) + +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_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 + +/-! ## SHA-512/224 -/ + +theorem sha512_224_iterChecks : Iterate.Checks sha512_224Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha512_224_finChecks : Fin.Checks sha512_224Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha512_224_iterImp : (iterG Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac.sha512_224I.iterateContract Arm.abi 16) := + iterImp Spec.Hmac.sha512_224S 234 (by + inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha512_224S, Spec.Hmac.sha512_224, iterG, below, + Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 192 28 234) + +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_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 + +/-! ## SHA-512/256 -/ + +theorem sha512_256_iterChecks : Iterate.Checks sha512_256Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha512_256_finChecks : Fin.Checks sha512_256Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha512_256_iterImp : (iterG Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac.sha512_256I.iterateContract Arm.abi 16) := + iterImp Spec.Hmac.sha512_256S 234 (by + inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha512_256S, Spec.Hmac.sha512_256, iterG, below, + Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 192 32 234) + +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_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 + +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 new file mode 100644 index 000000000..dd3c2386b --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Iterate.lean @@ -0,0 +1,820 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Hash + +/-! +# PBKDF2-HMAC's iteration over a Merkle–Damgård hash function on ARMv7 + +Untrusted: everything here is checked by Lean. The same proof as on x86-64 +and AArch64 (`Proof/Pbkdf2/AArch64/Iterate.lean`): the iteration +(`Impl/Pbkdf2/Md/Arm.lean`) is correct for any hash function the 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, +although the function uses none. +-/ + +namespace VG.Proof.Pbkdf2.Md.Arm.Iterate + +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.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) +open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame) +open VG.Proof.Hmac.Common (bytesAt_add bytesAt_length bytesAt_writeBytes_sep writeBytes_at bytesAt_getD') +open VG.Proof.Hmac.Generic.Common (bytesAt_take bytesAt_writeBytes_self') +open VG.Spec.Hmac (xorPad ipad opad hmacBlockKey) + +/-! ## The precondition -/ + +section +variable (s₀ : State) + +abbrev key : BitVec 32 := s₀.gpr .r0 +abbrev up : BitVec 32 := s₀.gpr .r1 +/-- The number of steps. -/ +abbrev nn : Nat := (s₀.gpr .r2).toNat +abbrev tp : BitVec 32 := s₀.gpr .r3 +abbrev scr : BitVec 32 := stackArg s₀ 0 +abbrev kA : Addr := State.addr (key s₀) +abbrev uA : Addr := State.addr (up s₀) +abbrev tA : Addr := State.addr (tp s₀) +abbrev scA : Addr := State.addr (scr s₀) +abbrev argR : Region := ⟨stackArgAddr s₀ 0, 4⟩ + +end + +section +variable (H : Hash) (sc : Nat) (s₀ : State) + +abbrev keyR : Region := ⟨kA s₀, 2 * (H.N + H.B)⟩ +abbrev uR : Region := ⟨uA s₀, H.D⟩ +abbrev tR : Region := ⟨tA s₀, H.D⟩ +abbrev scR : Region := ⟨scA s₀, 8 * sc⟩ +/-- The hash value being compressed and the block, as registers hold them. -/ +abbrev hv : BitVec 32 := scr s₀ + BitVec.ofNat 32 H.hvO +abbrev blk : BitVec 32 := scr s₀ + BitVec.ofNat 32 H.blkO +/-- And as addresses. -/ +abbrev hvA : Addr := scA s₀ + BitVec.ofNat 64 H.hvO +abbrev blkA : Addr := scA s₀ + BitVec.ofNat 64 H.blkO + +end + +structure Pre (H : Hash) (sc : Nat) (s₀ : State) : Prop where + rd : s₀.rd = [keyR H s₀, uR H s₀, argR s₀] + wr : s₀.wr = [tR H s₀, scR sc s₀] + k_t : (keyR H s₀).Disjoint (tR H s₀) + k_s : (keyR H s₀).Disjoint (scR sc s₀) + u_t : (uR H s₀).Disjoint (tR H s₀) + u_s : (uR H s₀).Disjoint (scR sc s₀) + t_s : (tR H s₀).Disjoint (scR sc s₀) + a_t : (argR s₀).Disjoint (tR H s₀) + a_s : (argR s₀).Disjoint (scR sc s₀) + nk : (key s₀).toNat + 2 * (H.N + H.B) ≤ 2 ^ 32 + nu : (up s₀).toNat + H.D ≤ 2 ^ 32 + nt : (tp s₀).toNat + H.D ≤ 2 ^ 32 + ns : (scr s₀).toNat + 8 * sc ≤ 2 ^ 32 + spf : s₀.sp.toNat + 4 ≤ 2 ^ 32 + fits : H.st.buf + H.N + H.B ≤ 8 * sc + +theorem pre_of {H : Hash} (hH : HashOK H) {sc : Nat} {s₀ : State} (h : (iterG hH.SH sc).pre s₀) + (hfit : H.st.buf + H.N + H.B ≤ 8 * sc) : Pre H sc s₀ := by + obtain ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, -, -, -, -, h13, h14, h15, h16, -, h18⟩ := h + have hS := hH.hS + have hD := hH.hD + simp only [hS, hD] at * + exact ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h13, h14, h15, h16, h18, hfit⟩ + +/-! ## The parts of the scratch space -/ + +theorem buf_eq (H : Hash) : H.st.buf = 8 * H.st.W + 36 := rfl + +section +variable {H : Hash} {sc : Nat} (hz : Sizes H) {s₀ : State} (hp : Pre H sc s₀) +include hz hp + +omit hz hp in +theorem scr_sub {a n : Nat} (h : a + n ≤ 8 * sc) : + Region.Sub ⟨scA s₀ + BitVec.ofNat 64 a, n⟩ (scR sc s₀) := + Offset.sub_base _ h + +omit hz in +theorem in_scr {s : State} (hwr : s.wr = s₀.wr) {a n : Nat} (h : a + n ≤ 8 * sc) : + InRegions s.wr (scA s₀ + BitVec.ofNat 64 a) n := + ⟨scR sc s₀, by simp [hwr, hp.wr], Offset.contains_base _ h (by have := hp.ns; omega)⟩ + +omit hz in +theorem in_scr' {s : State} (hwr : s.wr = s₀.wr) {a n : Nat} (h : a + n ≤ 8 * sc) : + InRegions (s.rd ++ s.wr) (scA s₀ + BitVec.ofNat 64 a) n := by + obtain ⟨r, hr, hc⟩ := in_scr hp hwr h + exact ⟨r, List.mem_append_right _ hr, hc⟩ + +omit hz in +/-- `scratch` plus an offset within it, as an address. -/ +theorem addr_sO {o : Nat} (h : o < 8 * sc) : + State.addr (scr s₀ + BitVec.ofNat 32 o) = scA s₀ + BitVec.ofNat 64 o := + addr_add (by have := hp.ns; omega) + +omit hz in +theorem toNat_sO {o : Nat} (h : o < 8 * sc) : (scr s₀ + BitVec.ofNat 32 o).toNat = (scr s₀).toNat + o := by + have := hp.ns + rw [BitVec.toNat_add, BitVec.toNat_ofNat, Nat.mod_eq_of_lt (a := o) (by omega), Nat.mod_eq_of_lt (by omega)] + +theorem addr_hv : State.addr (hv H s₀) = hvA H s₀ := by + have := hp.fits; have := hz.N64; have : 64 ≤ H.B := by rcases hz.B with h | h <;> omega + exact addr_sO hp (by simp only [Hash.hvO]; omega) + +theorem addr_blk : State.addr (blk H s₀) = blkA H s₀ := by + have := hp.fits; have := hz.N64; have : 64 ≤ H.B := by rcases hz.B with h | h <;> omega + exact addr_sO hp (by simp only [Hash.blkO]; omega) + +omit hz in +theorem in_blk {s : State} (hwr : s.wr = s₀.wr) {a n : Nat} (h : a + n ≤ H.B) : + InRegions s.wr (blkA H s₀ + BitVec.ofNat 64 a) n := by + have := hp.fits + rw [Memory.add_ofNat]; exact in_scr hp hwr (by simp only [Hash.blkO]; omega) + +end + +/-! ## The registers during a step -/ + +/-- The registers `iterate` keeps between its pieces (but the count). -/ +abbrev kept : List Reg := [.r0, .r3, .r4, .r6, .r7, .r11] + +theorem kept_pres : ∀ r ∈ kept, r ≠ .r0 → r ≠ .r3 → r ∈ preserved ∧ r ≠ .lr := by decide +theorem ne12 : ∀ r ∈ kept, r ≠ .r12 := by decide +theorem ne1 : ∀ r ∈ kept, r ≠ .r1 := by decide +theorem ne5 : ∀ r ∈ kept, r ≠ .r5 := by decide +theorem ne9 : ∀ r ∈ kept, r ≠ .r9 := by decide +theorem ne10 : ∀ r ∈ kept, r ≠ .r10 := by decide + +/-- What holds between the pieces of a step: the regions, our registers, +the stack pointer, and memory outside `T` and the scratch space as on entry. -/ +structure Regs (H : Hash) (sc : Nat) (s₀ s : State) : Prop where + rd : s.rd = s₀.rd + wr : s.wr = s₀.wr + sp : s.sp = s₀.sp + r0 : s.gpr .r0 = hv H s₀ + r3 : s.gpr .r3 = scr s₀ + r4 : s.gpr .r4 = key s₀ + r6 : s.gpr .r6 = blk H s₀ + r7 : s.gpr .r7 = tp s₀ + r11 : s.gpr .r11 = scr s₀ + frame : Frame [tR H s₀, scR sc s₀] s₀.mem s.mem + +section +variable {H : Hash} {sc : Nat} {s₀ : State} + +/-- `Regs` after code that keeps our registers and writes only memory in the +regions it allows. -/ +theorem Regs.write {s s' : State} (h : Regs H sc s₀ s) (hg : ∀ r ∈ kept, s'.gpr r = s.gpr r) + (hrd : s'.rd = s.rd) (hwr : s'.wr = s.wr) (hsp : s'.sp = s.sp) + (hm : Frame [tR H s₀, scR sc s₀] s.mem s'.mem) : Regs H sc s₀ s' where + rd := hrd.trans h.rd + wr := hwr.trans h.wr + sp := hsp.trans h.sp + r0 := (hg _ (by decide)).trans h.r0 + r3 := (hg _ (by decide)).trans h.r3 + r4 := (hg _ (by decide)).trans h.r4 + r6 := (hg _ (by decide)).trans h.r6 + r7 := (hg _ (by decide)).trans h.r7 + r11 := (hg _ (by decide)).trans h.r11 + frame := h.frame.trans hm + +/-- A part of the scratch space, as a frame of `Regs`. -/ +theorem frame_scr {m m' : Mem} {a n : Nat} (h : a + n ≤ 8 * sc) + (hf : Frame [⟨scA s₀ + BitVec.ofNat 64 a, n⟩] m m') : Frame [tR H s₀, scR sc s₀] m m' := + hf.sub fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact ⟨scR sc s₀, by simp, scr_sub h⟩ + +end + +theorem add0 (p : Addr) : p + BitVec.ofNat 64 0 = p := BitVec.add_zero p + +section +variable {H : Hash} {sc : Nat} (hz : Sizes H) {s₀ : State} (hp : Pre H sc s₀) +include hz hp + +/-- The hash value at `key + o` into the hash value being compressed. -/ +theorem load_ok {md : Md H.B H.N H.L} (hR : md.Reloc) {s : State} (h : Regs H sc s₀ s) {o : Nat} + (ho : o + H.N ≤ 2 * (H.N + H.B)) (ho4 : o % 4 = 0) {rest : List Instr} {Q : State → Prop} + (k : ∀ s', (∀ r, r ≠ .r12 → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → s'.sp = s.sp → + Frame [⟨hvA H s₀, H.N⟩] s.mem s'.mem → + md.stateAt s'.mem (hvA H s₀) = md.stateAt s₀.mem (kA s₀ + BitVec.ofNat 64 o) → + WP isa (.block rest) s' Q) : + WP isa (.block (H.loadKey o ++ rest)) s Q := by + have := hz.N64; have := hz.N4; have := hp.fits; have := hp.nk; have := hp.ns; have hB := hz.B + have hn : 4 * (H.N / 4) = H.N := by omega + have ahv := addr_hv hz hp + unfold Hash.loadKey + refine copyW_ok (by decide) (by decide) o 0 (H.N / 4) ⟨by omega, by omega⟩ rest s Q + (by rw [h.r4]; omega) (by rw [h.r0, toNat_sO hp (by simp only [Hash.hvO]; omega)]; simp only [Hash.hvO]; omega) + (fun j hj => ?_) (fun j hj => ?_) ?_ fun s' g' rd' wr' sp' m' => ?_ + · rw [h.r4, h.rd, hp.rd, Memory.add_ofNat] + exact ⟨keyR H s₀, by simp, Offset.contains_base _ (by omega) (by omega)⟩ + · rw [h.r0, ahv, h.wr, Memory.add_ofNat, show hvA H s₀ = scA s₀ + BitVec.ofNat 64 H.hvO from rfl, + Memory.add_ofNat] + exact in_scr hp rfl (by simp only [Hash.hvO]; omega) + · rw [h.r4, h.r0, ahv, hn, add0] + exact hp.k_s.sep (Offset.contains_base _ (by omega) (by omega)) + (Offset.contains_base _ (by simp only [Hash.hvO]; omega) (by simp only [Hash.hvO]; omega)) + rw [h.r0, ahv, h.r4, hn, add0] at m' + refine k s' g' rd' wr' sp' (by rw [m']; exact writeBytes_frame _ _ _ (by + rw [bytesAt_length]; exact Region.contains_self _ _)) ?_ + refine hR _ _ _ _ fun i hi => ?_ + rw [m', writeBytes_at _ _ _ (by rw [bytesAt_length]; exact hi) (by rw [bytesAt_length]; omega), + bytesAt_getD' _ _ hi, Memory.add_ofNat] + exact h.frame.bytes (R := keyR H s₀) (by + intro r hr + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl + · exact hp.k_t + · exact hp.k_s) (by show 2 * (H.N + H.B) ≤ 2 ^ 64; omega) (by show o + i < 2 * (H.N + H.B); omega) + +/-- What the call of the compression function needs. -/ +theorem callOk_of {s : State} (h : Regs H sc s₀ s) : + CallOk s H.N H.B H.so (hv H s₀) (scr s₀) (blk H s₀) := by + have := hz.N64; have := hp.fits; have := hp.ns; have := hz.so; have hB := hz.B + have hsc : scR sc s₀ ∈ s.wr := by simp [h.wr, hp.wr] + rw [buf_eq H] at * + refine ⟨h.r0, h.r3, h.r6, by rw [toNat_sO hp (by simp only [Hash.hvO, buf_eq H]; omega)]; simp only [Hash.hvO, buf_eq H]; omega, + by rw [toNat_sO hp (by simp only [Hash.blkO, buf_eq H]; omega)]; simp only [Hash.blkO, buf_eq H]; omega, + by omega, ?_, ?_, ?_, ?_, ?_⟩ + all_goals simp only [addr_hv hz hp, addr_blk hz hp, hvA, blkA, Hash.hvO, Hash.blkO, buf_eq H] + · exact Offset.disjoint_base _ (by omega) (by omega) + · exact Offset.disjoint _ (.inr (by omega)) (by omega) (by omega) + · exact Offset.disjoint_base _ (by omega) (by omega) + · refine Covers.of_sub fun r hr => ⟨scR sc s₀, List.mem_append_right _ hsc, ?_⟩ + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl + · exact ⟨_, rfl, by dsimp only; omega⟩ + · exact ⟨_, rfl, by dsimp only; omega⟩ + · exact ⟨0, by simp, by dsimp only; omega⟩ + · refine Covers.of_sub fun r hr => ⟨scR sc s₀, hsc, ?_⟩ + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl + · exact ⟨_, rfl, by dsimp only; omega⟩ + · exact ⟨0, by simp, by dsimp only; omega⟩ + +/-- A call of the compression function on the block. -/ +theorem cmp_ok {md : Md H.B H.N H.L} {name : String} {code : Prog isa} (hf : CompOk md H.so code) {s : State} + (h : Regs H sc s₀ s) {Q : State → Prop} + (k : ∀ s', Regs H sc s₀ s' → s'.gpr .r5 = s.gpr .r5 → + Frame [⟨hvA H s₀, H.N⟩, ⟨scA s₀, H.so⟩] s.mem s'.mem → + md.stateAt s'.mem (hvA H s₀) = md.compress (md.stateAt s.mem (hvA H s₀)) (md.blockAt s.mem (blkA H s₀)) → + Q s') : + WP isa (compressBlock name code) s Q := by + have := hz.N64; have := hp.fits; have := hz.so; have hB := hz.B + refine compressBlock_ok hf (callOk_of hz hp h) fun s' hrd hwr hcs h0 h3 hsp hfr hst => ?_ + rw [addr_hv hz hp] at hfr + rw [addr_hv hz hp, addr_blk hz hp] at hst + refine k s' (h.write (fun r hr => ?_) hrd hwr hsp (hfr.sub fun r hr => ?_)) + (hcs _ (by decide) (by decide)) hfr hst + · by_cases e0 : r = .r0 + · subst e0; rw [h0, h.r0] + by_cases e3 : r = .r3 + · subst e3; rw [h3, h.r3] + exact hcs r (kept_pres r hr e0 e3).1 (kept_pres r hr e0 e3).2 + · simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rw [buf_eq H] at * + rcases hr with rfl | rfl + · exact ⟨scR sc s₀, by simp, scr_sub (by simp only [Hash.hvO, buf_eq H]; omega)⟩ + · exact ⟨scR sc s₀, by simp, Region.sub_prefix (by omega)⟩ + +end + +/-! ## The digest into the block -/ + +section +variable {H : Hash} {sc : Nat} (hz : Sizes H) {s₀ : State} (hp : Pre H sc s₀) +include hz hp + +/-- The digest of the hash value into the block's first `D` bytes, the padding after them as it was. -/ +theorem digest_ok {md : Md H.B H.N H.L} (ho : OutOk md H.out) {s : State} (h : Regs H sc s₀ s) + (hpad : bytesAt s.mem (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.D) = md.tailPad H.D) {rest : List Instr} + {Q : State → Prop} + (k : ∀ s', (∀ r, r ≠ .r9 → r ≠ .r10 → r ≠ .r12 → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → + s'.sp = s.sp → Frame [⟨blkA H s₀, H.N⟩] s.mem s'.mem → + bytesAt s'.mem (blkA H s₀) H.D = (md.digest (md.stateAt s.mem (hvA H s₀))).take H.D → + bytesAt s'.mem (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.D) = md.tailPad H.D → WP isa (.block rest) s' Q) : + WP isa (.block (H.digest ++ rest)) s Q := by + have := hz.N64; have := hp.fits; have := hz.DN; have := hz.NL; have := hz.D4; have := hz.N4; have := hz.pad + have := hp.ns; have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + have ahv := addr_hv hz hp; have ablk := addr_blk hz hp + have tb : (blk H s₀).toNat = (scr s₀).toNat + H.blkO := toNat_sO hp (by simp only [Hash.blkO]; omega) + unfold Hash.digest + rw [List.append_assoc, WP.block_append_iff] + refine WP.mono (ho s ?_ ?_ ?_ ?_ ?_) fun s₁ ⟨g₁, rd₁, wr₁, sp₁, m₁⟩ => ?_ + · rw [h.r0, toNat_sO hp (by simp only [Hash.hvO]; omega)]; simp only [Hash.hvO]; omega + · rw [h.r6, tb]; simp only [Hash.blkO]; omega + · rw [h.r0, ahv]; exact in_scr' hp h.wr (by simp only [Hash.hvO]; omega) + · rw [h.r6, ablk]; exact in_scr hp h.wr (by simp only [Hash.blkO]; omega) + · rw [h.r0, h.r6, ahv, ablk]; exact Offset.disjoint _ (.inl (by simp only [Hash.hvO, Hash.blkO]; omega)) + (by simp only [Hash.hvO]; omega) (by simp only [Hash.blkO]; omega) + rw [h.r6, ablk, h.r0, ahv] at m₁ + have hdl := md.digest_length (md.stateAt s.mem (hvA H s₀)) + have f₁ : Frame [⟨blkA H s₀, H.N⟩] s.mem s₁.mem := by + rw [m₁]; exact writeBytes_frame _ _ _ (by rw [hdl]; exact Region.contains_self _ _) + have b₁ : bytesAt s₁.mem (blkA H s₀) H.D = (md.digest (md.stateAt s.mem (hvA H s₀))).take H.D := by + rw [bytesAt_take _ _ hz.DN, m₁, bytesAt_writeBytes_self' hdl (by omega)] + have r₁ : bytesAt s₁.mem (blkA H s₀ + BitVec.ofNat 64 H.N) (H.B - H.N) = + bytesAt s.mem (blkA H s₀ + BitVec.ofNat 64 H.N) (H.B - H.N) := by + rw [m₁] + refine bytesAt_writeBytes_sep _ _ ?_ (by omega) + have := Offset.sep (blkA H s₀) (d := H.N) (n := H.B - H.N) (e := 0) (k := H.N) (.inr (by omega)) + (by omega) (by omega) + rw [add0] at this; rw [hdl]; exact this + have hsplit : ∀ m : Mem, bytesAt m (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.D) = + bytesAt m (blkA H s₀ + BitVec.ofNat 64 H.D) (H.N - H.D) ++ + bytesAt m (blkA H s₀ + BitVec.ofNat 64 H.N) (H.B - H.N) := by + intro m + rw [show H.B - H.D = (H.N - H.D) + (H.B - H.N) by omega, bytesAt_add, Memory.add_ofNat (blkA H s₀), + show H.D + (H.N - H.D) = H.N by omega] + have hY : bytesAt s.mem (blkA H s₀ + BitVec.ofNat 64 H.N) (H.B - H.N) = (md.tailPad H.D).drop (H.N - H.D) := by + rw [← hpad, hsplit, List.drop_left' (bytesAt_length _ _ _)] + have g₁' : s₁.gpr .r6 = blk H s₀ := by rw [g₁ _ (by decide) (by decide), h.r6] + by_cases hDN : H.D < H.N + · simp only [hDN, ↓reduceIte] + refine padFrom_ok (a := H.D) (b := H.N) (by omega) (by omega) (by omega) (s := s₁) (p := blk H s₀) + g₁' (by rw [tb]; simp only [Hash.blkO]; omega) (fun j hj => by rw [ablk]; exact in_blk hp (wr₁.trans h.wr) (by omega)) + fun s₂ g₂ rd₂ wr₂ sp₂ m₂ => k s₂ (fun r h9 h10 h12 => (g₂ r h12).trans (g₁ r h9 h10)) (rd₂.trans rd₁) + (wr₂.trans wr₁) (sp₂.trans sp₁) ?_ ?_ ?_ + · rw [m₂, ablk] + refine f₁.trans (writeBytes_frame _ _ _ ?_) + simp only [List.length_append, List.length_singleton, List.length_replicate] + exact Offset.contains_base _ (by omega) (by omega) + · rw [m₂, ablk, bytesAt_writeBytes_sep _ _ ?_ (by omega), b₁] + have := Offset.sep (blkA H s₀) (d := 0) (n := H.D) (e := H.D) (k := H.N - H.D) (.inl (by omega)) + (by omega) (by omega) + rw [add0] at this + have e : ([0x80] ++ List.replicate (H.N - H.D - 1) 0 : List Byte).length = H.N - H.D := by simp; omega + rw [e]; exact this + · have hfix : [(0x80 : Byte)] ++ List.replicate (H.N - H.D - 1) 0 = (md.tailPad H.D).take (H.N - H.D) := + (md.tailPad_take (by omega) (by omega)).symm + have hfl : ((md.tailPad H.D).take (H.N - H.D)).length = H.N - H.D := by + rw [List.length_take, md.tailPad_length (by omega)]; omega + rw [hsplit, m₂, ablk, hfix, bytesAt_writeBytes_self' hfl (by omega), + bytesAt_writeBytes_sep _ _ ?_ (by omega), r₁, hY, List.take_append_drop] + have := Offset.sep (blkA H s₀) (d := H.N) (n := H.B - H.N) (e := H.D) (k := H.N - H.D) (.inr (by omega)) + (by omega) (by omega) + rw [hfl]; exact this + · simp only [hDN, ↓reduceIte, List.nil_append] + have eDN : H.D = H.N := by omega + refine k s₁ (fun r h9 h10 _ => g₁ r h9 h10) rd₁ wr₁ sp₁ f₁ b₁ ?_ + rw [hsplit, r₁, hY, eDN, Nat.sub_self, List.drop_zero] + simp [bytesAt] + +end + +/-! ## A step -/ + + +section +variable (H : Hash) (md : Md H.B H.N H.L) (s₀ : State) + +/-- A step, as the code computes it, from the key's inner and outer hash values. -/ +abbrev stepM : List Byte → List Byte := + md.step H.D (md.stateAt s₀.mem (kA s₀)) (md.stateAt s₀.mem (kA s₀ + BitVec.ofNat 64 (H.N + H.B))) + +/-- What the body writes: the compression function's scratch space, the hash +value and the block, and `T`. -/ +abbrev bodyR : List Region := [⟨scA s₀, H.so⟩, ⟨hvA H s₀, H.N + H.B⟩, tR H s₀] + +end + +/-- The loop invariant, with `r` steps left. -/ +structure Inv (H : Hash) (sc : Nat) (md : Md H.B H.N H.L) (s₀ : State) (r : Nat) (s : State) : Prop + extends Regs H sc s₀ s where + r5 : s.gpr .r5 = BitVec.ofNat 32 r + saved : SavedRegs H.st (scr s₀) s₀ s.mem + pad : bytesAt s.mem (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.D) = md.tailPad H.D + le : r ≤ nn s₀ + val : Spec.Pbkdf2.iterate (stepM H md s₀) (nn s₀) (bytesAt s₀.mem (uA s₀) H.D) (bytesAt s₀.mem (tA s₀) H.D) = + Spec.Pbkdf2.iterate (stepM H md s₀) r (bytesAt s.mem (blkA H s₀) H.D) (bytesAt s.mem (tA s₀) H.D) + +section +variable {H : Hash} {sc : Nat} (hz : Sizes H) {s₀ : State} (hp : Pre H sc s₀) +include hz hp + +/-- The saved registers are outside what the body writes. -/ +theorem saved_disj : ∀ r ∈ bodyR H s₀, (saveR H.st (scr s₀)).Disjoint r := by + have := hz.so; have := hz.W; have := hp.fits; have := hp.ns + intro r hr + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl + · exact Offset.disjoint_base _ (by omega) (by rw [buf_eq H] at *; omega) + · exact Offset.disjoint _ (.inl (by simp only [Hash.hvO, buf_eq H]; omega)) (by rw [buf_eq H] at *; omega) + (by simp only [Hash.hvO]; omega) + · exact (hp.t_s.sub_right (scr_sub (by rw [buf_eq H] at *; omega))).symm + +omit hz hp in +/-- A range of the scratch space from the hash value on, within what the body writes. -/ +theorem sub_body {a n : Nat} (h₁ : H.hvO ≤ a) (h₂ : a + n ≤ H.hvO + H.N + H.B) : + ∃ r' ∈ bodyR H s₀, Region.Sub ⟨scA s₀ + BitVec.ofNat 64 a, n⟩ r' := + ⟨⟨hvA H s₀, H.N + H.B⟩, by simp, Offset.sub _ h₁ (by omega)⟩ + +/-- A range of the block disjoint from what the compression and loading the hash value write. -/ +theorem blk_disj {a n : Nat} (h : a + n ≤ H.B) : + ∀ r ∈ [⟨hvA H s₀, H.N⟩, ⟨scA s₀, H.so⟩], Region.Disjoint ⟨blkA H s₀ + BitVec.ofNat 64 a, n⟩ r := by + have := hz.so; have := hp.fits; have := hp.ns + intro r hr + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rw [Memory.add_ofNat] + rcases hr with rfl | rfl + · exact Offset.disjoint _ (.inr (by simp only [Hash.hvO, Hash.blkO]; omega)) (by simp only [Hash.blkO]; omega) + (by simp only [Hash.hvO]; omega) + · exact Offset.disjoint_base _ (by simp only [Hash.blkO, buf_eq H]; omega) (by simp only [Hash.blkO]; omega) + +end + +section +variable {H : Hash} {sc : Nat} (hz : Sizes H) {s₀ : State} (hp : Pre H sc s₀) +include hz hp + +/-- Loading the key's hash value at `key + o` and compressing the block into it. -/ +theorem lc_ok {md : Md H.B H.N H.L} (hR : md.Reloc) {name : String} {code : Prog isa} + (hf : CompOk md H.so code) {o : Nat} (ho : o + H.N ≤ 2 * (H.N + H.B)) (ho4 : o % 4 = 0) {s : State} + (h : Regs H sc s₀ s) (hpad : bytesAt s.mem (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.D) = md.tailPad H.D) + {c : Prog isa} {Q : State → Prop} + (k : ∀ s', Regs H sc s₀ s' → s'.gpr .r5 = s.gpr .r5 → Frame (bodyR H s₀) s.mem s'.mem → + Frame [⟨scA s₀, H.so⟩, ⟨hvA H s₀, H.N⟩] s.mem s'.mem → + bytesAt s'.mem (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.D) = md.tailPad H.D → + bytesAt s'.mem (blkA H s₀) H.D = bytesAt s.mem (blkA H s₀) H.D → + md.stateAt s'.mem (hvA H s₀) = + md.compress (md.stateAt s₀.mem (kA s₀ + BitVec.ofNat 64 o)) (md.tailBlock H.D (bytesAt s.mem (blkA H s₀) H.D)) → + WP isa c s' Q) : + WP isa (.block (H.loadKey o)) s fun s' => WP isa (.seq (compressBlock name code) c) s' Q := by + have := hz.N64; have := hp.fits; have := hz.so; have := hz.DN; have := hz.pad; have := hz.NL + have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + rw [← List.append_nil (H.loadKey o)] + refine load_ok hz hp hR h (o := o) ho ho4 fun s₁ g₁ rd₁ wr₁ sp₁ f₁ e₁ => WP.block_nil ?_ + have h₁ := h.write (fun r hr => g₁ r (ne12 r hr)) rd₁ wr₁ sp₁ + (frame_scr (a := H.hvO) (by simp only [Hash.hvO]; omega) f₁) + refine WP.seq (cmp_ok hz hp hf h₁ fun s₂ h₂ x5₂ f₂ e₂ => ?_) + have fh₁ : ∀ {a n : Nat}, a + n ≤ H.B → ∀ r ∈ [(⟨hvA H s₀, H.N⟩ : Region)], + Region.Disjoint ⟨blkA H s₀ + BitVec.ofNat 64 a, n⟩ r := + fun h' r hr => blk_disj hz hp h' r (by simp at hr; simp [hr]) + have p₁ : bytesAt s₁.mem (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.D) = md.tailPad H.D := + (Memory.frame_bytesAt f₁ (fh₁ (by omega)) (by omega)).trans hpad + have u₁ : bytesAt s₁.mem (blkA H s₀) H.D = bytesAt s.mem (blkA H s₀) H.D := by + have := Memory.frame_bytesAt f₁ (fh₁ (a := 0) (n := H.D) (by omega)) (by omega); rwa [add0] at this + have u₂ : bytesAt s₂.mem (blkA H s₀) H.D = bytesAt s₁.mem (blkA H s₀) H.D := by + have := Memory.frame_bytesAt f₂ (blk_disj hz hp (a := 0) (n := H.D) (by omega)) (by omega); rwa [add0] at this + rw [e₁, blockAt_eq (by omega) p₁, u₁] at e₂ + have f : Frame [⟨scA s₀, H.so⟩, ⟨hvA H s₀, H.N⟩] s.mem s₂.mem := + (f₁.mono (by simp)).trans (f₂.mono fun r hr => by + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr ⊢; rcases hr with rfl | rfl <;> simp) + refine k s₂ h₂ (x5₂.trans (g₁ _ (by decide))) (f.sub fun r hr => ?_) f + ((Memory.frame_bytesAt f₂ (blk_disj hz hp (by omega)) (by omega)).trans p₁) (u₂.trans u₁) e₂ + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl + · exact ⟨⟨scA s₀, H.so⟩, by simp, fun _ h => h⟩ + · exact ⟨⟨hvA H s₀, H.N + H.B⟩, by simp, Region.sub_prefix (by omega)⟩ + +/-- The end of a step: the digest into the block, `T ← T ⊕ U` and the count. -/ +theorem tail_ok {md : Md H.B H.N H.L} (ho : OutOk md H.out) {s : State} (h : Regs H sc s₀ s) + (hpad : bytesAt s.mem (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.D) = md.tailPad H.D) {Q : State → Prop} + (k : ∀ s', Regs H sc s₀ s' → s'.gpr .r5 = s.gpr .r5 - 1 → s'.z = (s.gpr .r5 - 1 == 0) → + Frame (bodyR H s₀) s.mem s'.mem → + bytesAt s'.mem (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.D) = md.tailPad H.D → + bytesAt s'.mem (blkA H s₀) H.D = (md.digest (md.stateAt s.mem (hvA H s₀))).take H.D → + bytesAt s'.mem (tA s₀) H.D = + Spec.Pbkdf2.xorBytes (bytesAt s.mem (tA s₀) H.D) ((md.digest (md.stateAt s.mem (hvA H s₀))).take H.D) → + Q s') : + WP isa (.block (H.digest ++ (List.range (H.D / 4)).flatMap xorW ++ + ([.subs .r5 .r5 (.imm 1)] : List Instr))) s Q := by + have := hz.N64; have := hp.fits; have := hz.DN; have := hz.D4; have := hz.pad; have := hz.NL; have := hp.ns + have := hp.nt + have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + rw [List.append_assoc] + refine digest_ok hz hp ho h hpad fun s₆ g₆ rd₆ wr₆ sp₆ f₆ b₆ p₆ => ?_ + have h₆ := h.write (fun r hr => g₆ r (ne9 r hr) (ne10 r hr) (ne12 r hr)) rd₆ wr₆ sp₆ + (frame_scr (a := H.blkO) (by simp only [Hash.blkO]; omega) f₆) + have hd : Region.Disjoint (tR H s₀) ⟨blkA H s₀, H.D⟩ := + hp.t_s.sub_right (scr_sub (by simp only [Hash.blkO]; omega)) + have hD4 : 4 * (H.D / 4) = H.D := by omega + refine xor_ok (tp := tp s₀) (bp := blk H s₀) (D := H.D) (by rw [addr_blk hz hp]; exact hd) (by omega) hp.nt + (by rw [toNat_sO hp (by simp only [Hash.blkO]; omega)]; simp only [Hash.blkO]; omega) + (H.D / 4) (by omega) _ s₆ _ h₆.r6 h₆.r7 + (fun j hj => by + rw [addr_blk hz hp] + obtain ⟨r, hr, hc⟩ := in_blk hp h₆.wr (a := 4 * j) (n := 4) (by omega) + exact ⟨r, List.mem_append_right _ hr, hc⟩) + (fun j hj => ⟨tR H s₀, by simp [h₆.wr, hp.wr], Offset.contains_base _ (by omega) (by omega)⟩) + fun s₇ g₇ rd₇ wr₇ sp₇ m₇ => ?_ + rw [hD4, addr_blk hz hp] at m₇ + have hxl : (Spec.Pbkdf2.xorBytes (bytesAt s₆.mem (tA s₀) H.D) (bytesAt s₆.mem (blkA H s₀) H.D)).length = H.D := by + rw [Memory.xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length] + have f₇ : Frame [tR H s₀] s₆.mem s₇.mem := by + rw [m₇]; exact writeBytes_frame _ _ _ (by rw [hxl]; exact Region.contains_self _ _) + have h₇ := h₆.write (fun r hr => g₇ r (ne12 r hr) (ne1 r hr)) rd₇ wr₇ sp₇ (f₇.mono (by simp)) + refine wp_subs (op2_imm (by decide)) fun s₈ u₈ z₈ => WP.block_nil ?_ + have h₈ := h₇.write (fun r hr => u₈.other r (ne5 r hr)) u₈.rd u₈.wr u₈.sp (by rw [u₈.mem]; exact Frame.refl _ _) + have x5₇ : s₇.gpr .r5 = s.gpr .r5 := by + rw [g₇ _ (by decide) (by decide), g₆ _ (by decide) (by decide) (by decide)] + have hT₆ : bytesAt s₆.mem (tA s₀) H.D = bytesAt s.mem (tA s₀) H.D := + Memory.frame_bytesAt f₆ (fun r hr => by + simp only [List.mem_singleton] at hr; subst hr + exact hp.t_s.sub_right (scr_sub (a := H.blkO) (n := H.N) (by simp only [Hash.blkO]; omega))) (by omega) + refine k s₈ h₈ (by rw [u₈.gpr, x5₇]) (by rw [z₈, x5₇]) ?_ ?_ ?_ ?_ + · rw [u₈.mem] + refine (f₆.sub fun r hr => ?_).trans (f₇.mono (by simp)) + simp only [List.mem_singleton] at hr; subst hr + exact sub_body (by simp only [Hash.hvO, Hash.blkO]; omega) (by simp only [Hash.hvO, Hash.blkO]; omega) + · rw [u₈.mem] + exact (Memory.frame_bytesAt f₇ (fun r hr => by + simp only [List.mem_singleton] at hr; subst hr + exact (hp.t_s.sub_right (by rw [Memory.add_ofNat]; exact scr_sub (by simp only [Hash.blkO]; omega))).symm) + (by omega)).trans p₆ + · rw [u₈.mem, m₇, bytesAt_writeBytes_sep _ _ (hd.symm.sep (Region.contains_self _ _) (by + rw [hxl]; exact Region.contains_self _ _)) (by omega), b₆] + · rw [u₈.mem, m₇, bytesAt_writeBytes_self' hxl (by omega), hT₆, b₆] + +omit hz hp in +theorem iterate_succ (f : List Byte → List Byte) (n : Nat) (u t : List Byte) : + Spec.Pbkdf2.iterate f (n + 1) u t = Spec.Pbkdf2.iterate f n (f u) (Spec.Pbkdf2.xorBytes t (f u)) := rfl + +theorem body_ok {md : Md H.B H.N H.L} (ho : OutOk md H.out) (hR : md.Reloc) (hf : CompOk md H.so H.compC) + {r : Nat} {s : State} (h : Inv H sc md s₀ (r + 1) s) : + WP isa H.body s fun s' => eval .ne s' = some (r != 0) ∧ Inv H sc md s₀ r s' := by + have := hz.N64; have := hp.fits; have := hz.DN; have := hz.pad; have := hz.NL; have := hz.N4 + have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + have hB4 : H.B % 4 = 0 := by rcases hz.B with h | h <;> omega + unfold Hash.body + refine WP.seq (lc_ok hz hp hR hf (o := 0) (by omega) rfl h.toRegs h.pad fun s₂ h₂ x5₂ f₂ g₂ p₂ _ e₂ => ?_) + refine WP.seq (digest_ok hz hp ho h₂ p₂ fun s₃ g₃ rd₃ wr₃ sp₃ f₃ b₃ p₃ => ?_) + have h₃ := h₂.write (fun r hr => g₃ r (ne9 r hr) (ne10 r hr) (ne12 r hr)) rd₃ wr₃ sp₃ + (frame_scr (a := H.blkO) (by simp only [Hash.blkO]; omega) f₃) + refine lc_ok hz hp hR hf (o := H.N + H.B) (by omega) (by omega) h₃ p₃ fun s₅ h₅ x5₅ f₅ g₅ p₅ _ e₅ => ?_ + refine tail_ok hz hp ho h₅ p₅ fun s₈ h₈ x5₈ z₈ f₈ p₈ b₈ t₈ => ?_ + rw [e₅, b₃, e₂, add0] at b₈ t₈ + have x5₅' : s₅.gpr .r5 = BitVec.ofNat 32 (r + 1) := by + rw [x5₅, g₃ _ (by decide) (by decide) (by decide), x5₂, h.r5] + have hlt : r + 1 < 2 ^ 32 := by + have := h.le; have := (s₀.gpr .r2).isLt; simp only [nn] at *; omega + have e₈ : s₅.gpr .r5 - 1 = BitVec.ofNat 32 r := by + rw [x5₅', show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat (by omega), Nat.add_sub_cancel] + have fb : Frame (bodyR H s₀) s.mem s₈.mem := + ((f₂.trans (f₃.sub fun r hr => by + simp only [List.mem_singleton] at hr; subst hr + exact sub_body (by simp only [Hash.hvO, Hash.blkO]; omega) (by simp only [Hash.hvO, Hash.blkO]; omega))).trans + f₅).trans f₈ + have hT₅ : bytesAt s₅.mem (tA s₀) H.D = bytesAt s.mem (tA s₀) H.D := by + refine Memory.frame_bytesAt (rs := [⟨scA s₀, H.so⟩, ⟨hvA H s₀, H.N + H.B⟩]) + (((g₂.sub fun r hr => ?_).trans (f₃.sub fun r hr => ?_)).trans (g₅.sub fun r hr => ?_)) (fun r hr => ?_) + (by omega) + all_goals simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + · rcases hr with rfl | rfl + · exact ⟨_, by simp, fun _ h => h⟩ + · exact ⟨⟨hvA H s₀, H.N + H.B⟩, by simp, Region.sub_prefix (by omega)⟩ + · subst hr; exact ⟨⟨hvA H s₀, H.N + H.B⟩, by simp, Offset.sub _ (by simp only [Hash.hvO, Hash.blkO]; omega) + (by simp only [Hash.hvO, Hash.blkO]; omega)⟩ + · rcases hr with rfl | rfl + · exact ⟨_, by simp, fun _ h => h⟩ + · exact ⟨⟨hvA H s₀, H.N + H.B⟩, by simp, Region.sub_prefix (by omega)⟩ + · have := hz.so; have := hz.W + rcases hr with rfl | rfl + · exact hp.t_s.sub_right (Region.sub_prefix (by rw [buf_eq H] at *; omega)) + · exact hp.t_s.sub_right (scr_sub (by simp only [Hash.hvO]; omega)) + rw [hT₅] at t₈ + refine ⟨?_, h₈, by rw [x5₈, e₈], h.saved.frame H.st fb (saved_disj hz hp), p₈, by have := h.le; omega, ?_⟩ + · simp only [eval_ne, z₈, e₈, ofNat_beq_zero (by omega : r < 2 ^ 32)] + cases r <;> rfl + · rw [h.val, iterate_succ, b₈, t₈]; rfl + +theorem loop_ok {md : Md H.B H.N H.L} (ho : OutOk md H.out) (hR : md.Reloc) (hf : CompOk md H.so H.compC) + {n : Nat} {s : State} (h : Inv H sc md s₀ n s) (hzf : s.z = decide (n = 0)) : + WP isa (.ite .eq (.block []) (.loop H.body .ne)) s (Inv H sc md s₀ 0) := by + refine WP.ite (decide (n = 0)) (by show eval .eq s = _; rw [eval_eq, hzf]) (fun hb => ?_) (fun hb => ?_) + · obtain rfl : n = 0 := by simpa using hb + exact WP.block_nil h + · obtain ⟨m, rfl⟩ : ∃ m, n = m + 1 := ⟨n - 1, by simp at hb; omega⟩ + refine WP.loop (fun m s => Inv H sc md s₀ (m + 1) s) + (fun m s hs' => WP.mono (body_ok hz hp ho hR hf hs') fun s' ⟨he, hi⟩ => ?_) m s h + cases m with + | zero => exact .inl ⟨he, hi⟩ + | succ m => exact .inr ⟨he, m, by omega, hi⟩ + +end + +/-! ## The prologue -/ + +/-- After saving our caller's registers and our return address and setting +up our registers. -/ +structure Setup (H : Hash) (s₀ s : State) : Prop where + rd : s.rd = s₀.rd + wr : s.wr = s₀.wr + sp : s.sp = s₀.sp + r0 : s.gpr .r0 = hv H s₀ + r1 : s.gpr .r1 = up s₀ + r3 : s.gpr .r3 = scr s₀ + r4 : s.gpr .r4 = key s₀ + r5 : s.gpr .r5 = s₀.gpr .r2 + r6 : s.gpr .r6 = blk H s₀ + r7 : s.gpr .r7 = tp s₀ + r11 : s.gpr .r11 = scr s₀ + mem : Frame [saveR H.st (scr s₀)] s₀.mem s.mem + saved : SavedRegs H.st (scr s₀) s₀ s.mem + +theorem ofNat_toNat32 (x : BitVec 32) : BitVec.ofNat 32 x.toNat = x := by simp + +section +variable {H : Hash} {sc : Nat} (hz : Sizes H) {s₀ : State} (hp : Pre H sc s₀) +include hz hp + +omit hz in +theorem save_sub : Region.Sub (saveR H.st (scr s₀)) (scR sc s₀) := by + have := hp.fits; rw [buf_eq H] at this; exact scr_sub (by omega) + +theorem setup_ok {rest : List Instr} {Q : State → Prop} (k : ∀ s, Setup H s₀ s → WP isa (.block rest) s Q) : + WP isa (.block (([.ldrSp .r12 0] : List Instr) ++ H.st.save ++ ([.mov .r11 (.reg .r12), .mov .r7 (.reg .r3), + .mov .r3 (.reg .r12), .mov .r4 (.reg .r0), .mov .r5 (.reg .r2)] : List Instr) ++ H.atHv ++ rest)) s₀ Q := by + have := hp.fits; have := hp.ns; have := hz.W; have := hz.N64 + have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + rw [buf_eq H] at * + 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) + (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₅ => + wp_mov (op2_reg _ _) fun s₆ u₆ => wp_mov (op2_reg _ _) fun s₇ u₇ => ?_ + unfold Hash.atHv + rw [List.append_assoc] + refine scrAt_ok (by simp only [Hash.hvO, buf_eq H]; omega) fun s₈ g₈ d₈ m₈ rd₈ wr₈ sp₈ => + scrAt_ok (by simp only [Hash.blkO, buf_eq H]; omega) fun s₉ g₉ d₉ m₉ rd₉ wr₉ sp₉ => k s₉ ?_ + have e₂ : ∀ r, r ≠ .r12 → s₂.gpr r = s₀.gpr r := fun r hr => by rw [g₂, u₁.other r hr] + have e₇ : ∀ r, r ≠ .r11 → r ≠ .r7 → r ≠ .r3 → r ≠ .r4 → r ≠ .r5 → s₇.gpr r = s₂.gpr r := + fun r h11 h7 h3 h4 h5 => by rw [u₇.other r h5, u₆.other r h4, u₅.other r h3, u₄.other r h7, u₃.other r h11] + have r11₇ : s₇.gpr .r11 = scr s₀ := by + rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, + g₂, u₁.gpr]; rfl + have e₉ : ∀ r, r ≠ .r0 → r ≠ .r6 → r ≠ .r12 → s₉.gpr r = s₇.gpr r := fun r h0 h6 h12 => by + rw [g₉ r h6 h12, g₈ r h0 h12] + have r11₈ : s₈.gpr .r11 = scr s₀ := by rw [g₈ _ (by decide) (by decide), r11₇] + have hm : s₉.mem = s₂.mem := by rw [m₉, m₈, u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem] + exact { + rd := by rw [rd₉, rd₈, u₇.rd, u₆.rd, u₅.rd, u₄.rd, u₃.rd, rd₂, u₁.rd] + wr := by rw [wr₉, wr₈, u₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, wr₂, u₁.wr] + sp := by rw [sp₉, sp₈, u₇.sp, u₆.sp, u₅.sp, u₄.sp, u₃.sp, sp₂, u₁.sp] + r0 := by rw [g₉ _ (by decide) (by decide), d₈, r11₇] + r1 := by rw [e₉ _ (by decide) (by decide) (by decide), e₇ _ (by decide) (by decide) (by decide) (by decide) + (by decide), e₂ _ (by decide)] + r3 := by rw [e₉ _ (by decide) (by decide) (by decide), u₇.other _ (by decide), u₆.other _ (by decide), u₅.gpr, + u₄.other _ (by decide), u₃.other _ (by decide), g₂, u₁.gpr]; rfl + r4 := by rw [e₉ _ (by decide) (by decide) (by decide), u₇.other _ (by decide), u₆.gpr, u₅.other _ (by decide), + u₄.other _ (by decide), u₃.other _ (by decide), e₂ _ (by decide)] + r5 := by rw [e₉ _ (by decide) (by decide) (by decide), u₇.gpr, u₆.other _ (by decide), u₅.other _ (by decide), + u₄.other _ (by decide), u₃.other _ (by decide), e₂ _ (by decide)] + r6 := by rw [d₉, r11₈] + r7 := by rw [e₉ _ (by decide) (by decide) (by decide), u₇.other _ (by decide), u₆.other _ (by decide), + u₅.other _ (by decide), u₄.gpr, u₃.other _ (by decide), e₂ _ (by decide)] + r11 := by rw [e₉ _ (by decide) (by decide) (by decide), r11₇] + mem := by rw [hm]; rw [← u₁.mem]; exact f₂ + saved := by + rw [hm] + exact 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) } + +/-- Writing `U`, the padding and the length field into the block. -/ +theorem fill_ok {md : Md H.B H.N H.L} + (hlen : wordsBytes (lenWords H.be H.L (H.B + H.D)) = md.lenBytes (H.B + H.D)) {s : State} (h : Setup H s₀ s) : + WP isa (.block (copyW .r1 .r6 0 0 (H.D / 4) ++ H.pad ++ ([.cmp .r5 (.imm 0)] : List Instr))) s + fun s' => Inv H sc md s₀ (nn s₀) s' ∧ s'.z = decide (nn s₀ = 0) := by + have := hz.N64; have := hp.fits; have := hz.DN; have := hz.pad; have := hz.NL; have := hz.D4; have := hz.L4 + have := hz.L16; have := hp.ns; have := hp.nu; have := hz.W + have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + have hB4 : H.B % 4 = 0 := by rcases hz.B with h | h <;> omega + have hD4 : 4 * (H.D / 4) = H.D := by omega + have ablk := addr_blk hz hp + have tb : (blk H s₀).toNat = (scr s₀).toNat + H.blkO := toNat_sO hp (by simp only [Hash.blkO]; omega) + have hbl : ∀ {a n : Nat}, a + n ≤ H.B → H.blkO + a + n ≤ 8 * sc := fun h' => by simp only [Hash.blkO]; omega + unfold Hash.pad + simp only [List.append_assoc] + refine copyW_ok (by decide) (by decide) 0 0 (H.D / 4) ⟨by omega, by omega⟩ _ s _ + (by rw [h.r1]; omega) (by rw [h.r6, tb]; simp only [Hash.blkO]; omega) + (fun j hj => ?_) (fun j hj => ?_) ?_ fun s₁ g₁ rd₁ wr₁ sp₁ m₁ => ?_ + · rw [h.r1, h.rd, hp.rd, add0] + exact ⟨uR H s₀, by simp, Offset.contains_base _ (by omega) (by omega)⟩ + · rw [h.r6, ablk, add0]; exact in_blk hp h.wr (by omega) + · rw [h.r1, h.r6, ablk, add0, add0, hD4] + exact hp.u_s.sep (Region.contains_self _ _) + (Offset.contains_base _ (by simp only [Hash.blkO]; omega) (by simp only [Hash.blkO]; omega)) + rw [h.r6, ablk, h.r1, add0, add0, hD4] at m₁ + have g6 : s₁.gpr .r6 = blk H s₀ := by rw [g₁ _ (by decide), h.r6] + refine padFrom_ok (a := H.D) (b := H.B - H.L) (by omega) (by omega) (by omega) (s := s₁) (p := blk H s₀) g6 + (by rw [tb]; simp only [Hash.blkO]; omega) (fun j hj => by rw [ablk]; exact in_blk hp (wr₁.trans h.wr) (by omega)) + fun s₂ g₂ rd₂ wr₂ sp₂ m₂ => ?_ + rw [ablk] at m₂ + have lw := HashOK.lenWords_length (H := H) + refine constW_ok (p := blk H s₀) (lenWords H.be H.L (H.B + H.D)) (H.B - H.L) (by rw [lw]; omega) + (by rw [lw, tb]; simp only [Hash.blkO]; omega) _ s₂ _ (by rw [g₂ _ (by decide), g6]) + (fun j hj => by rw [lw] at hj; rw [ablk]; exact in_blk hp (wr₂.trans (wr₁.trans h.wr)) (by omega)) + fun s₃ g₃ rd₃ wr₃ sp₃ m₃ => ?_ + rw [ablk, hlen] at m₃ + refine wp_cmp (op2_imm (by decide)) fun s₄ u₄ z₄ => WP.block_nil ?_ + have lpz : ([0x80] ++ List.replicate (H.B - H.L - H.D - 1) 0 : List Byte).length = H.B - H.L - H.D := by + simp; omega + have hM : s₄.mem = writeBytes (writeBytes (writeBytes s.mem (blkA H s₀) (bytesAt s.mem (uA s₀) H.D)) + (blkA H s₀ + BitVec.ofNat 64 H.D) ([0x80] ++ List.replicate (H.B - H.L - H.D - 1) 0)) + (blkA H s₀ + BitVec.ofNat 64 (H.B - H.L)) (md.lenBytes (H.B + H.D)) := by + rw [u₄.mem, m₃, m₂, m₁, show H.B - H.L - H.D - 1 = H.B - H.L - H.D - 1 from rfl] + have hG : ∀ r, r ≠ .r12 → s₄.gpr r = s.gpr r := fun r hr => by + rw [u₄.gpr, g₃ r hr, g₂ r hr, g₁ r hr] + have sbB : Region.Sub ⟨blkA H s₀, H.B⟩ (scR sc s₀) := scr_sub (by have := hbl (a := 0) (n := H.B) (by omega); omega) + have fM : Frame [⟨blkA H s₀, H.B⟩] s.mem s₄.mem := by + rw [hM] + refine ((writeBytes_frame _ _ _ ?_).trans (writeBytes_frame _ _ _ ?_)).trans (writeBytes_frame _ _ _ ?_) + · rw [bytesAt_length] + have := Offset.contains_base (blkA H s₀) (d := 0) (n := H.D) (k := H.B) (by omega) (by omega) + rwa [add0] at this + · rw [lpz]; exact Offset.contains_base _ (by omega) (by omega) + · rw [md.lenBytes_length]; exact Offset.contains_base _ (by omega) (by omega) + have S1 : Mem.Sep (blkA H s₀) H.D (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.L - H.D) := by + have := Offset.sep (blkA H s₀) (d := 0) (n := H.D) (e := H.D) (k := H.B - H.L - H.D) (.inl (by omega)) + (by omega) (by omega) + rwa [add0] at this + have S2 : ∀ {a n : Nat}, a + n ≤ H.B - H.L → + Mem.Sep (blkA H s₀ + BitVec.ofNat 64 a) n (blkA H s₀ + BitVec.ofNat 64 (H.B - H.L)) H.L := + fun h' => Offset.sep _ (.inl h') (by omega) (by omega) + have fS : Frame [tR H s₀, scR sc s₀] s₀.mem s.mem := + h.mem.sub fun r hr => by + simp only [List.mem_singleton] at hr; subst hr + exact ⟨scR sc s₀, by simp, save_sub hp⟩ + have hU : bytesAt s.mem (uA s₀) H.D = bytesAt s₀.mem (uA s₀) H.D := + Memory.frame_bytesAt h.mem (fun r hr => by + simp only [List.mem_singleton] at hr; subst hr + exact hp.u_s.sub_right (save_sub hp)) (by omega) + have hT : bytesAt s₄.mem (tA s₀) H.D = bytesAt s₀.mem (tA s₀) H.D := by + refine (Memory.frame_bytesAt fM (fun r hr => ?_) (by omega)).trans + (Memory.frame_bytesAt h.mem (fun r hr => ?_) (by omega)) + · simp only [List.mem_singleton] at hr; subst hr; exact hp.t_s.sub_right sbB + · simp only [List.mem_singleton] at hr; subst hr; exact hp.t_s.sub_right (save_sub hp) + refine ⟨⟨⟨by rw [u₄.rd, rd₃, rd₂, rd₁, h.rd], by rw [u₄.wr, wr₃, wr₂, wr₁, h.wr], + by rw [u₄.sp, sp₃, sp₂, sp₁, h.sp], by rw [hG _ (by decide), h.r0], by rw [hG _ (by decide), h.r3], + by rw [hG _ (by decide), h.r4], by rw [hG _ (by decide), h.r6], by rw [hG _ (by decide), h.r7], + by rw [hG _ (by decide), h.r11], fS.trans (fM.sub fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact ⟨scR sc s₀, by simp, sbB⟩)⟩, + by rw [hG _ (by decide), h.r5, ofNat_toNat32], + h.saved.frame H.st fM (fun r hr => by + simp only [List.mem_singleton] at hr; subst hr + have := hz.W; have := hp.fits; rw [buf_eq H] at * + exact Offset.disjoint _ (.inl (by simp only [Hash.blkO, buf_eq H]; omega)) (by omega) + (by simp only [Hash.blkO, buf_eq H]; omega)), ?_, Nat.le_refl _, ?_⟩, ?_⟩ + · -- The padding and the length field. + rw [show H.B - H.D = (H.B - H.L - H.D) + H.L by omega, bytesAt_add, Memory.add_ofNat (blkA H s₀), + show H.D + (H.B - H.L - H.D) = H.B - H.L by omega, hM, + bytesAt_writeBytes_self' (md.lenBytes_length _) (by omega), + bytesAt_writeBytes_sep _ _ (by rw [md.lenBytes_length]; exact S2 (by omega)) (by omega), + bytesAt_writeBytes_self' lpz (by omega), Md.tailPad, show H.B - H.L - 1 - H.D = H.B - H.L - H.D - 1 by omega] + · -- `U` and `T`. + have hB' : bytesAt s₄.mem (blkA H s₀) H.D = bytesAt s₀.mem (uA s₀) H.D := by + rw [hM, bytesAt_writeBytes_sep _ _ (by + rw [md.lenBytes_length]; have := S2 (a := 0) (n := H.D) (by omega); rwa [add0] at this) (by omega), + bytesAt_writeBytes_sep _ _ (by rw [lpz]; exact S1) (by omega), + bytesAt_writeBytes_self' (bytesAt_length _ _ _) (by omega), hU] + rw [hB', hT] + · have c := MdStream.Arm.cmp0 (s₀.gpr .r2).isLt + rw [ofNat_toNat32] at c + rw [z₄, g₃ _ (by decide), g₂ _ (by decide), g₁ _ (by decide), h.r5, c] + +theorem prologue_ok {md : Md H.B H.N H.L} + (hlen : wordsBytes (lenWords H.be H.L (H.B + H.D)) = md.lenBytes (H.B + H.D)) : + WP isa (.block H.prologue) s₀ fun s' => Inv H sc md s₀ (nn s₀) s' ∧ s'.z = decide (nn s₀ = 0) := by + have := setup_ok hz hp (rest := copyW .r1 .r6 0 0 (H.D / 4) ++ H.pad ++ [.cmp .r5 (.imm 0)]) + fun s h => fill_ok hz hp hlen h + unfold Hash.prologue + simpa only [List.append_assoc] using this + + +theorem epilogue_ok {md : Md H.B H.N H.L} {S : Spec.Hmac.StreamingHash} {iv : md.HV} (hl : md.Link S iv H.D) + {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) + (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 + simp only [Spec.Pbkdf2.iterate] at hT + rw [hl.hS] at ho + show bytesAt s'.mem (tA s₀) S.digestBytes = _ + rw [hl.hD, hm, ← hT, Md.iterate_hmac hl hk hi ho _ (bytesAt_length _ _ _)] + +end + +/-! ## Correctness -/ + +theorem correct {H : Hash} (hH : HashOK H) {sc : Nat} {s₀ : State} (hp : Pre H sc s₀) : + WP isa H.iterate s₀ fun s' => abiPreserved s₀ s' ∧ (iterG hH.SH sc).post s₀ s' := by + unfold Hash.iterate + refine WP.seq (WP.mono (prologue_ok hH.sizes hp hH.len) fun s₁ ⟨h₁, z₁⟩ => ?_) + exact WP.seq (WP.mono (loop_ok hH.sizes hp hH.out hH.reloc hH.comp h₁ z₁) fun s₂ h₂ => + epilogue_ok hH.sizes hp hH.link h₂) + +end VG.Proof.Pbkdf2.Md.Arm.Iterate diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/IterateCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/IterateCT.lean new file mode 100644 index 000000000..87928ec7b --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/IterateCT.lean @@ -0,0 +1,264 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Iterate +import VerifiedGarbage.Proof.Framework.Arm.ArgTaint + +/-! +# PBKDF2-HMAC's iteration over a Merkle–Damgård hash function on ARMv7: constant time + +Untrusted: everything here is checked by Lean. As on AArch64 +(`Proof/Pbkdf2/AArch64/IterateCT.lean`): this holds for any compression +function (`CompOk`), so it is proven once. The taint analysis cannot prove +it without looking into the compression function (it would lose our +registers, which the compression function saves and restores in a scratch +space it also stores secrets into through a register that is not the base of +a region), so we relate two runs (`RelCT`): at every point, correctness +determines our registers from the public arguments alone, so they agree; +between the calls, the taint analysis proves each block constant time from +that (`Checks`, evaluated for each hash function, since the code depends on +its sizes); and the calls are constant time by the compression function's +own proof (`compressBlock_rel`). +-/ + +namespace VG.Proof.Pbkdf2.Md.Arm.Iterate + +open VG VG.Arm +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.Spec.Sha256 (bytesAt) + +/-- The registers the blocks between the calls use. -/ +abbrev regsS : List Reg := [.r0, .r3, .r4, .r5, .r6, .r7, .r11] + +/-- The taint checks of the pieces of `iterate` between its calls, which +depend on the hash function's sizes, its length field and its digest. -/ +structure Checks (H : Hash) : Prop where + pro : ∃ hc, (taint.check (argTaint [.r0, .r1, .r2, .r3] 4) (.block H.prologue) hc).isSome = true + load : ∃ hc, (taint.check (Taint.ofRegs regsS) (.block (H.loadKey 0)) hc).isSome = true + mid : ∃ hc, (taint.check (Taint.ofRegs regsS) (.block (H.digest ++ H.loadKey (H.N + H.B))) hc).isSome = true + fin : ∃ hc, (taint.check (Taint.ofRegs regsS) (.block (H.digest ++ (List.range (H.D / 4)).flatMap xorW ++ + [.subs .r5 .r5 (.imm 1)])) hc).isSome = true + epi : ∃ hc, (taint.check (Taint.ofRegs [.r11]) (.block H.st.restore) hc).isSome = true + ite : ∃ hc, (taint.check (Taint.ofRegs []) (.block []) 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 + +theorem PubEq.nn {s₀ s₀' : State} (hq : PubEq s₀ s₀') : nn s₀ = nn s₀' := congrArg BitVec.toNat hq.r2 + +/-- The state during a step, with `v` in `r5`. -/ +structure St (H : Hash) (sc : Nat) (md : Md H.B H.N H.L) (s₀ : State) (v : BitVec 32) (s : State) : Prop + extends Regs H sc s₀ s where + r5 : s.gpr .r5 = v + pad : bytesAt s.mem (blkA H s₀ + BitVec.ofNat 64 H.D) (H.B - H.D) = md.tailPad H.D + +section +variable {H : Hash} {sc : Nat} {md : Md H.B H.N H.L} + +/-- The registers the blocks use agree in two runs. -/ +theorem St.agree {s₀ s₀' : State} (hq : PubEq s₀ s₀') {v : BitVec 32} {s s' : State} (h : St H sc md s₀ v s) + (h' : St H sc md s₀' v s') : ∀ r ∈ regsS, 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 | rfl | rfl + · rw [h.r0, h'.r0, hv, hv, scr, scr, hq.a0] + · rw [h.r3, h'.r3, scr, scr, hq.a0] + · rw [h.r4, h'.r4, key, key, hq.r0] + · rw [h.r5, h'.r5] + · rw [h.r6, h'.r6, blk, blk, scr, scr, hq.a0] + · rw [h.r7, h'.r7, tp, tp, hq.r3] + · rw [h.r11, h'.r11, scr, scr, hq.a0] + +theorem St.of_inv {s₀ : State} {r : Nat} {s : State} (h : Inv H sc md s₀ (r + 1) s) : + St H sc md s₀ (BitVec.ofNat 32 (r + 1)) s := + ⟨h.toRegs, h.r5, h.pad⟩ + +variable (hz : Sizes H) {s₀ : State} (hp : Pre H sc s₀) {v : BitVec 32} +include hz hp + +/-! ## What each piece of a step does, in one run -/ + +theorem load_st (hR : md.Reloc) {o : Nat} (ho : o + H.N ≤ 2 * (H.N + H.B)) (ho4 : o % 4 = 0) {s : State} + (h : St H sc md s₀ v s) : + WP isa (.block (H.loadKey o)) s (St H sc md s₀ v) := by + have := hz.N64; have := hp.fits; have := hz.DN; have := hz.pad; have := hz.NL + have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + rw [← List.append_nil (H.loadKey o)] + exact load_ok hz hp hR h.toRegs ho ho4 fun s' g rd wr sp f _ => WP.block_nil + ⟨h.toRegs.write (fun r hr => g r (ne12 r hr)) rd wr sp (frame_scr (a := H.hvO) (by simp only [Hash.hvO]; omega) f), + (g _ (by decide)).trans h.r5, + (Memory.frame_bytesAt f (fun r hr => blk_disj hz hp (by omega) r (by simp at hr; simp [hr])) (by omega)).trans + h.pad⟩ + +theorem cmp_st (hf : CompOk md H.so H.compC) {s : State} (h : St H sc md s₀ v s) : + WP isa H.compressBlock s (St H sc md s₀ v) := by + have := hz.N64; have := hp.fits; have := hz.DN; have := hz.pad; have := hz.NL + have : H.B ≤ 128 := by rcases hz.B with h | h <;> omega + exact cmp_ok hz hp hf h.toRegs fun s' h' x5 f _ => + ⟨h', x5.trans h.r5, (Memory.frame_bytesAt f (blk_disj hz hp (by omega)) (by omega)).trans h.pad⟩ + +theorem mid_st (ho : OutOk md H.out) (hR : md.Reloc) {s : State} (h : St H sc md s₀ v s) : + WP isa (.block (H.digest ++ H.loadKey (H.N + H.B))) s (St H sc md s₀ v) := by + have := hz.N64; have := hp.fits; have := hz.NL; have := hz.N4 + have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + have hB4 : H.B % 4 = 0 := by rcases hz.B with h | h <;> omega + refine digest_ok hz hp ho h.toRegs h.pad fun s' g rd wr sp f _ p => ?_ + exact load_st hz hp hR (by omega) (by omega) + ⟨h.toRegs.write (fun r hr => g r (ne9 r hr) (ne10 r hr) (ne12 r hr)) rd wr sp + (frame_scr (a := H.blkO) (by simp only [Hash.blkO]; omega) f), + (g _ (by decide) (by decide) (by decide)).trans h.r5, p⟩ + +/-! ## Two runs -/ + +variable {s₀' : State} (hp' : Pre H sc s₀') (hq : PubEq s₀ s₀') +include hp' hq + +theorem cmp_rel (hf : CompOk md H.so H.compC) : + RelCT isa (fun s s' => St H sc md s₀ v s ∧ St H sc md s₀' v s') H.compressBlock fun s s' => + St H sc md s₀ v s ∧ St H sc md s₀' v s' := by + have e : hv H s₀' = hv H s₀ ∧ scr s₀' = scr s₀ ∧ blk H s₀' = blk H s₀ := by + refine ⟨?_, ?_, ?_⟩ <;> simp only [hv, blk, scr, hq.a0] + have call := compressBlock_rel (H := md) (so := H.so) hf (name := H.compN) (st := hv H s₀) (scr := scr s₀) + (src := blk H s₀) (P' := fun s s' => St H sc md s₀ v s ∧ St H sc md s₀' v s') + fun s s' ⟨h, h'⟩ => by + have c' := callOk_of hz hp' h'.toRegs + rw [e.1, e.2.1, e.2.2] at c' + exact ⟨callOk_of hz hp h.toRegs, c'⟩ + exact (call.wp fun _ _ h => ⟨cmp_st hz hp hf h.1, cmp_st hz hp' hf h.2⟩).mono + (fun _ _ h => h) fun _ _ h => h.2 + +omit hz in +/-- A block the taint analysis checks from `regsS`. -/ +theorem blk_rel {c : Prog isa} {G : State → State → Prop} + (hc : ∃ hc, (taint.check (Taint.ofRegs regsS) c hc).isSome = true) + (hw : ∀ {t₀ : State}, Pre H sc t₀ → ∀ s, St H sc md t₀ v s → WP isa c s (G t₀)) : + RelCT isa (fun s s' => St H sc md s₀ v s ∧ St H sc md s₀' v s') c fun s s' => G s₀ s ∧ G s₀' s' := by + obtain ⟨_, hc⟩ := hc + exact ((RelCT.taint (A := taint) (Taint.ofRegs regsS) (fun _ _ h => + Taint.agree_ofRegs (St.agree hq h.1 h.2)) hc).wp fun _ _ h => ⟨hw hp _ h.1, hw hp' _ h.2⟩).mono + (fun _ _ h => h) fun _ _ h => h.2 + +theorem body_rel (ho : OutOk md H.out) (hR : md.Reloc) (hf : CompOk md H.so H.compC) (hc : Checks H) {r : Nat} : + RelCT isa (fun s s' => Inv H sc md s₀ (r + 1) s ∧ Inv H sc md s₀' (r + 1) s') H.body + fun s s' => (eval .ne s = some (r != 0) ∧ Inv H sc md s₀ r s) ∧ + (eval .ne s' = some (r != 0) ∧ Inv H sc md s₀' r s') := by + have := hz.N64; have := hz.NL + have hB : 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> omega + have l0 : RelCT isa (fun s s' => St H sc md s₀ (BitVec.ofNat 32 (r + 1)) s ∧ + St H sc md s₀' (BitVec.ofNat 32 (r + 1)) s') (.block (H.loadKey 0)) + fun s s' => St H sc md s₀ (BitVec.ofNat 32 (r + 1)) s ∧ St H sc md s₀' (BitVec.ofNat 32 (r + 1)) s' := + blk_rel hp hp' hq (G := fun t₀ => St H sc md t₀ (BitVec.ofNat 32 (r + 1))) hc.load + fun hp _ h => load_st hz hp hR (by omega) rfl h + have dl : RelCT isa (fun s s' => St H sc md s₀ (BitVec.ofNat 32 (r + 1)) s ∧ + St H sc md s₀' (BitVec.ofNat 32 (r + 1)) s') (.block (H.digest ++ H.loadKey (H.N + H.B))) + fun s s' => St H sc md s₀ (BitVec.ofNat 32 (r + 1)) s ∧ St H sc md s₀' (BitVec.ofNat 32 (r + 1)) s' := + blk_rel hp hp' hq (G := fun t₀ => St H sc md t₀ (BitVec.ofNat 32 (r + 1))) hc.mid + fun hp _ h => mid_st hz hp ho hR h + obtain ⟨_, hfi⟩ := hc.fin + have fin : RelCT isa (fun s s' => St H sc md s₀ (BitVec.ofNat 32 (r + 1)) s ∧ + St H sc md s₀' (BitVec.ofNat 32 (r + 1)) s') + (.block (H.digest ++ (List.range (H.D / 4)).flatMap xorW ++ [.subs .r5 .r5 (.imm 1)])) fun _ _ => True := + RelCT.taint (A := taint) (Taint.ofRegs regsS) (fun _ _ h => Taint.agree_ofRegs (St.agree hq h.1 h.2)) hfi + have c := cmp_rel hz hp hp' hq (v := BitVec.ofNat 32 (r + 1)) hf + have hb : RelCT isa (fun s s' => Inv H sc md s₀ (r + 1) s ∧ Inv H sc md s₀' (r + 1) s') H.body fun _ _ => True := + fun s s' t t' u u' h e e' => by + unfold Hash.body at e e' + exact (l0.seq (c.seq (dl.seq (c.seq fin)))) s s' t t' u u' ⟨St.of_inv h.1, St.of_inv h.2⟩ e e' + exact (hb.wp fun _ _ h => ⟨body_ok hz hp ho hR hf h.1, body_ok hz hp' ho hR hf h.2⟩).mono + (fun _ _ h => h) fun _ _ h => h.2 + +theorem loop_rel (ho : OutOk md H.out) (hR : md.Reloc) (hf : CompOk md H.so H.compC) (hc : Checks H) {n : Nat} : + RelCT isa (fun s s' => Inv H sc md s₀ (n + 1) s ∧ Inv H sc md s₀' (n + 1) s') (.loop H.body .ne) + fun _ _ => True := + RelCT.loop (M := isa) (body := H.body) (c := .ne) (Q := fun _ _ => True) + (fun m s s' => Inv H sc md s₀ (m + 1) s ∧ Inv H sc md s₀' (m + 1) s') (fun m => by + intro s s' t t' u u' h e e' + obtain ⟨ht, ⟨z, i⟩, ⟨z', i'⟩⟩ := body_rel hz hp hp' hq ho hR hf hc _ _ _ _ _ _ h e e' + refine ⟨ht, z.trans z'.symm, fun _ => trivial, fun hc' => ?_⟩ + have hc'' : some (m != 0) = some true := z.symm.trans hc' + cases m with + | zero => cases hc'' + | succ m => exact ⟨m, by omega, i, i'⟩) n + +end + +theorem iterate_rel {H : Hash} (hH : HashOK H) (hc : Checks H) {sc : Nat} {s₀ s₀' : State} (hp : Pre H sc s₀) + (hp' : Pre H sc s₀') (hq : PubEq s₀ s₀') : + RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.iterate fun _ _ => True := by + have hz := hH.sizes + obtain ⟨_, hpr⟩ := hc.pro + obtain ⟨_, hep⟩ := hc.epi + obtain ⟨_, hit⟩ := hc.ite + have hlt : ∀ {s₀ : State}, nn s₀ < 2 ^ 32 := fun {s₀} => (s₀.gpr .r2).isLt + 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) + · exact h.a_t + · exact h.a_s + have pro : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') (.block H.prologue) fun s s' => + (Inv H sc hH.md s₀ (nn s₀) s ∧ s.z = decide (nn s₀ = 0)) ∧ + (Inv H sc hH.md s₀' (nn s₀') s' ∧ s'.z = decide (nn s₀' = 0)) := + 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) ⟨_, hpr⟩ + (fun _ e => by rw [e]; exact prologue_ok hz hp hH.len) + (fun _ e => by rw [e]; exact prologue_ok hz hp' hH.len) + have br : RelCT isa (fun s s' => (Inv H sc hH.md s₀ (nn s₀) s ∧ s.z = decide (nn s₀ = 0)) ∧ + (Inv H sc hH.md s₀' (nn s₀') s' ∧ s'.z = decide (nn s₀' = 0))) + (.ite .eq (.block []) (.loop H.body .ne)) + fun s s' => Inv H sc hH.md s₀ 0 s ∧ Inv H sc hH.md s₀' 0 s' := by + refine (RelCT.ite (fun s s' h => ?_) (RelCT.taint (A := taint) (Taint.ofRegs []) + (fun _ _ _ => Taint.agree_ofRegs (by simp)) hit) ?_).wp + (fun _ _ h => ⟨loop_ok hz hp hH.out hH.reloc hH.comp h.1.1 h.1.2, + loop_ok hz hp' hH.out hH.reloc hH.comp h.2.1 h.2.2⟩) + |>.mono (fun _ _ h => h) fun _ _ h => h.2 + · show eval .eq s = eval .eq s' + rw [eval_eq, eval_eq, h.1.2, h.2.2, hq.nn] + · intro s s' t t' u u' ⟨⟨⟨i, zi⟩, ⟨i', _⟩⟩, hc'⟩ e e' + have hc'' : some (decide (nn s₀ = 0)) = some false := by rw [← zi, ← eval_eq]; exact hc' + have hne : nn s₀ ≠ 0 := fun h0 => by rw [h0] at hc''; cases hc'' + obtain ⟨m, hm⟩ : ∃ m, nn s₀ = m + 1 := ⟨_, (Nat.succ_pred_eq_of_ne_zero hne).symm⟩ + rw [hm] at i + rw [← hq.nn, hm] at i' + exact loop_rel hz hp hp' hq hH.out hH.reloc hH.comp hc _ _ _ _ _ _ ⟨i, i'⟩ e e' + have epi : RelCT isa (fun s s' => Inv H sc hH.md s₀ 0 s ∧ Inv H sc hH.md s₀' 0 s') (.block H.st.restore) + fun _ _ => True := + RelCT.taint (A := taint) (Taint.ofRegs [.r11]) (fun _ _ h => Taint.agree_ofRegs fun r hr => by + simp only [List.mem_singleton] at hr; subst hr + rw [h.1.r11, h.2.r11, scr, scr, hq.a0]) hep + unfold Hash.iterate + exact pro.seq (br.seq epi) + +/-! ## Verified -/ + +theorem pubEq_of {S : Spec.Hmac.StreamingHash} {W : Nat} {s₁ s₂ : State} (h : (iterG 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⟩ + +/-- `iterate` is verified against `iterG`, 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 + H.N + H.B ≤ 8 * sc) + (hsat : ∃ s, (iterG hH.SH sc).pre s) : + Verified Arm.target H.iterate (iterG 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 (iterate_rel hH hc (pre_of hH h₁ hfit) (pre_of hH h₂ hfit) (pubEq_of hpub) _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 + +end VG.Proof.Pbkdf2.Md.Arm.Iterate diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean new file mode 100644 index 000000000..9a5c4534c --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean @@ -0,0 +1,85 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances +import VerifiedGarbage.Proof.Hmac.Generic.Arm.Sha224 +import VerifiedGarbage.Proof.Sha256.Arm.Stream.Md +import VerifiedGarbage.Proof.Sha256.Arm.Lit + +/-! +# HMAC-SHA-224 and PBKDF2-HMAC-SHA-224 over the compression function on ARMv7 + +Untrusted: everything here is checked by Lean. 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; 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) + +/-- SHA-224: SHA-256's 32-byte hash value, big-endian length field and +`vg_sha256_compress`, with 112 bytes of scratch space. -/ +def sha224Md : Hash where + st := sha224H + N := 32 + L := 8 + be := true + so := 112 + out := Impl.Sha256.Arm.Stream.params.out + compN := "vg_sha256_compress" + compC := Impl.Sha256.Arm.compress + +theorem sha256_comp : CompOk Proof.Sha256.md 112 Impl.Sha256.Arm.compress := + ⟨Proof.Sha256.Arm.compress_verified.1, Proof.Sha256.Arm.compress_verified.2.1, by lit_decide, + by rw [← Code.allInstrs_eq]; lit_decide⟩ + +def sha224MdOK : HashOK sha224Md where + md := Proof.Sha256.md + out := OutOk.ofShape Proof.Sha256.Arm.Stream.shape + comp := sha256_comp + reloc m m' p q h := by + apply Vector.ext + intro j hj + simp only [Proof.Sha256.md, Spec.Sha256.stateAt, Vector.getElem_ofFn] + exact Hmac.Generic.Common.readW_reloc (n := 32) h (by omega) + len := by decide + stream := sha224OK + iv := Spec.Sha256.H0_224 + repr _ _ _ 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⟩ + +end VG.Proof.Pbkdf2.Md.Arm + +namespace VG.Proof.Pbkdf2.Md.Arm.Instances + +open VG.Arm +open VG.Proof.Pbkdf2.Md.Arm +open VG.Proof.Hmac.Generic.Arm (iterG below) + +theorem sha224_iterChecks : Iterate.Checks sha224Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha224_finChecks : Fin.Checks sha224Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha224_iterImp : (iterG Spec.Hmac.sha224S 104).Implies (Spec.Hmac.sha224I.iterateContract Arm.abi 16) := + iterImp Spec.Hmac.sha224S 104 (by + inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha224S, Spec.Hmac.sha224, iterG, + below, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 96 28 104) + +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_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 + +end VG.Proof.Pbkdf2.Md.Arm.Instances diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha512.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha512.lean new file mode 100644 index 000000000..1c986e427 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha512.lean @@ -0,0 +1,110 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Words +import VerifiedGarbage.Proof.Sha512.Md +import VerifiedGarbage.Proof.Sha512.Arm.Stream.Finalize + +/-! +# The SHA-512 family's digest on ARMv7 + +Untrusted: everything here is checked by Lean. The streaming `finalize`'s +code writing the final hash value (`Impl.Sha512.Arm.Stream.outW`, each +64-bit word big-endian, from its halves stored low first) writes the digest +of `Proof.Sha512.md` (`OutOk`), as HMAC and PBKDF2 use it. +-/ + +namespace VG.Proof.Pbkdf2.Md.Arm + +open VG VG.Arm +open VG.Impl.Sha512.Arm (lo hi) +open VG.Impl.Sha512.Arm.Stream (outW) +open VG.Proof.MdStream.Arm (wp_ldr wp_str wp_rev) +open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil writeBytes_append writeBytes_frame) +open VG.Proof.Sha512.Arm.Stream.Finalize (wordBytes_split writeW_rev flat_length) +open VG.Proof.Sha512.Arm (readW_lo readW_hi) +open VG.Spec.Sha512 (HashValue stateAt wordBytes) + +/-- The first `n` words of the final hash value at `p0` (`r0`), big-endian, to `p6` (`r6`). -/ +theorem out64_ok {p0 p6 : BitVec 32} (f0 : p0.toNat + 64 ≤ 2 ^ 32) (f6 : p6.toNat + 64 ≤ 2 ^ 32) + (hd : Region.Disjoint ⟨State.addr p0, 64⟩ ⟨State.addr p6, 64⟩) : + ∀ n ≤ 8, ∀ (rest : List Instr) (s : State) (Q : State → Prop), s.gpr .r0 = p0 → s.gpr .r6 = p6 → + InRegions (s.rd ++ s.wr) (State.addr p0) 64 → InRegions s.wr (State.addr p6) 64 → + (∀ s', (∀ r, r ≠ .r9 → r ≠ .r10 → 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 p6) (((stateAt s.mem (State.addr p0)).toList.take n).flatMap wordBytes) → + WP isa (.block rest) s' Q) → + WP isa (.block ((List.range n).flatMap outW ++ rest)) s Q := by + intro n + induction n with + | zero => + intro _ rest s Q _ _ _ _ k + exact k s (fun _ _ _ => rfl) rfl rfl rfl (by simp [writeBytes_nil]) + | succ n ih => + intro hn rest s Q h0 h6 hin hout k + rw [List.range_succ, List.flatMap_append, List.flatMap_singleton, List.append_assoc] + refine ih (by omega) _ s Q h0 h6 hin hout fun s₁ g₁ rd₁ wr₁ sp₁ m₁ => ?_ + have hP := flat_length (stateAt s.mem (State.addr p0)) n (by omega) + simp only [outW, List.cons_append, List.nil_append] + have i₀ : ∀ o, o + 4 ≤ 8 → InRegions (s₁.rd ++ s₁.wr) (State.addr p0 + BitVec.ofNat 64 (8 * n + o)) 4 := + fun o ho => by + rw [rd₁, wr₁]; exact MdStream.Arm.InRegions.offset hin (by omega) (by omega) + have o₀ : ∀ o, o + 4 ≤ 8 → InRegions s₁.wr (State.addr p6 + BitVec.ofNat 64 (8 * n + o)) 4 := + fun o ho => by rw [wr₁]; exact MdStream.Arm.InRegions.offset hout (by omega) (by omega) + refine wp_ldr (a := State.addr p0 + BitVec.ofNat 64 (8 * n + 0)) (by omega) + (by rw [g₁ _ (by decide) (by decide), h0, addr_add (by omega)]; rfl) (i₀ 0 (by omega)) fun s₂ u₂ => ?_ + refine wp_ldr (a := State.addr p0 + BitVec.ofNat 64 (8 * n + 4)) (by omega) + (by rw [u₂.other _ (by decide), g₁ _ (by decide) (by decide), h0, addr_add (by omega)]) + (by rw [u₂.rd, u₂.wr]; exact i₀ 4 (by omega)) fun s₃ u₃ => wp_rev fun s₄ u₄ => wp_rev fun s₅ u₅ => ?_ + have e6 : s₅.gpr .r6 = p6 := by + rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), + g₁ _ (by decide) (by decide), h6] + refine wp_str (a := State.addr p6 + BitVec.ofNat 64 (8 * n + 0)) (by omega) + (by rw [e6, addr_add (by omega)]; rfl) (by rw [u₅.wr, u₄.wr, u₃.wr, u₂.wr]; exact o₀ 0 (by omega)) fun s₆ g₆ => ?_ + refine wp_str (a := State.addr p6 + BitVec.ofNat 64 (8 * n + 4)) (by omega) + (by rw [g₆.gpr, e6, addr_add (by omega)]) (by rw [g₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr]; exact o₀ 4 (by omega)) + fun s₇ g₇ => k s₇ (fun r h9 h10 => by + rw [g₇.gpr, g₆.gpr, u₅.other r h9, u₄.other r h10, u₃.other r h10, u₂.other r h9, g₁ r h9 h10]) + (by rw [g₇.rd, g₆.rd, u₅.rd, u₄.rd, u₃.rd, u₂.rd, rd₁]) (by rw [g₇.wr, g₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, wr₁]) + (by rw [g₇.sp, g₆.sp, u₅.sp, u₄.sp, u₃.sp, u₂.sp, sp₁]) ?_ + -- The word's halves, as in `s`: the writes so far are to `p6`. + have hread : ∀ o, o + 4 ≤ 8 → s₁.mem.readW (State.addr p0 + BitVec.ofNat 64 (8 * n + o)) 32 = + s.mem.readW (State.addr p0 + BitVec.ofNat 64 (8 * n + o)) 32 := by + intro o ho + rw [m₁] + refine (writeBytes_frame s.mem (State.addr p6) _ (R := ⟨State.addr p6, 64⟩) ?_).readW + (r := ⟨State.addr p0 + BitVec.ofNat 64 (8 * n + o), 4⟩) (Region.contains_self _ _) ?_ (by decide) + · rw [hP]; exact Memory.contains_base (by omega) + · intro r' hr' + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr' + subst hr' + exact hd.sub_left (Offset.sub_base _ (by omega)) + have hw : (stateAt s.mem (State.addr p0))[n] = s.mem.readW (State.addr p0 + BitVec.ofNat 64 (8 * n)) 64 := by + simp [stateAt] + have wlo : s.mem.readW (State.addr p0 + BitVec.ofNat 64 (8 * n + 0)) 32 = lo (stateAt s.mem (State.addr p0))[n] := by + rw [hw, readW_lo, Nat.add_zero] + have whi : s.mem.readW (State.addr p0 + BitVec.ofNat 64 (8 * n + 4)) 32 = hi (stateAt s.mem (State.addr p0))[n] := by + rw [hw, readW_hi, BitVec.ofNat_add, ← BitVec.add_assoc]; rfl + have v10 : s₅.gpr .r10 = rev (hi (stateAt s.mem (State.addr p0))[n]) := by + rw [u₅.other _ (by decide), u₄.gpr, u₃.gpr, u₂.mem, hread 4 (by omega), whi] + have v9 : s₆.gpr .r9 = rev (lo (stateAt s.mem (State.addr p0))[n]) := by + rw [g₆.gpr, u₅.gpr, u₄.other _ (by decide), u₃.other _ (by decide), u₂.gpr, hread 0 (by omega), wlo] + have a4 : State.addr p6 + BitVec.ofNat 64 (8 * n + 4) = + State.addr p6 + BitVec.ofNat 64 (8 * n + 0) + + BitVec.ofNat 64 (Spec.Sha256.wordBytes (hi (stateAt s.mem (State.addr p0))[n])).length := by + rw [BitVec.add_assoc, ← BitVec.ofNat_add]; rfl + have a8 : State.addr p6 + BitVec.ofNat 64 (8 * n + 0) = State.addr p6 + + BitVec.ofNat 64 (((stateAt s.mem (State.addr p0)).toList.take n).flatMap wordBytes).length := by + rw [hP]; rfl + rw [g₇.mem, v9, g₆.mem, v10, u₅.mem, u₄.mem, u₃.mem, u₂.mem, writeW_rev, writeW_rev, a4, + writeBytes_append _ _ _ _ (by simp [Spec.Sha256.wordBytes]), ← wordBytes_split, m₁, a8, + writeBytes_append _ _ _ _ (by rw [hP]; simp [wordBytes]; omega), List.take_add_one, + List.getElem?_eq_getElem (by simp; omega), Option.toList_some, List.flatMap_append, + List.flatMap_singleton, Vector.getElem_toList] + +/-- The SHA-512 family's digest code, as HMAC and PBKDF2 use it. -/ +theorem sha512_out : OutOk Proof.Sha512.md ((List.range 8).flatMap outW) := by + intro s f₀ f₆ hin hout hd + rw [← List.append_nil ((List.range 8).flatMap outW)] + refine out64_ok f₀ f₆ hd 8 (Nat.le_refl _) [] s _ rfl rfl hin hout fun s' g rd wr sp m => WP.block_nil + ⟨g, rd, wr, sp, ?_⟩ + rw [m, List.take_of_length_le (by simp)] + rfl + +end VG.Proof.Pbkdf2.Md.Arm diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Words.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Words.lean new file mode 100644 index 000000000..49015beb6 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Words.lean @@ -0,0 +1,325 @@ +import VerifiedGarbage.Impl.Pbkdf2.Md.Arm +import VerifiedGarbage.Proof.MdStream.Arm.Words +import VerifiedGarbage.Proof.Pbkdf2.Memory +import VerifiedGarbage.Proof.Pbkdf2.MdStep +import VerifiedGarbage.Proof.Framework.OmegaLit + +/-! +# HMAC and PBKDF2-HMAC over a Merkle–Damgård hash function on ARMv7: words + +Untrusted: everything here is checked by Lean. What the straight-line pieces +of `Impl/Pbkdf2/Md/Arm.lean` write, in one run: copies of 32-bit words +(`copyW`), the padding (`padFrom`, then the constant words `constW` of the +length field), `T ← T ⊕ U` (`xorW`), and `scratch` plus an offset in a +register (`scrAt`); and what the code writing a hash function's digest must +do (`OutOk`). +-/ + +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.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) +open VG.Proof.Hmac.Common (copy_mem bytesAt_zero bytesAt_add bytesAt_length bytesAt_writeBytes_sep + extractLsb'_read bytesAt_getD') +open VG.Proof.Pbkdf2.Memory (writeW_bytes writeBytes_append' xorBytes_length sep_after off_contains) +open VG.Spec.Sha256 (bytesAt) + +/-! ## Single instructions -/ + +section +variable {is : List Instr} {s : State} {Q : State → Prop} + +theorem wp_movw {d : Reg} {imm : BitVec 16} + (k : ∀ s', Upd s s' d (imm.setWidth 32) → WP isa (.block is) s' Q) : + WP isa (.block (.movw d imm :: is)) s Q := + MdStream.Arm.WP.cons (s' := s.setReg d (imm.setWidth 32)) rfl (k _ (Upd.setReg _ _ _)) + +theorem wp_movt {d : Reg} {imm : BitVec 16} + (k : ∀ s', Upd s s' d (imm ++ (s.gpr d).extractLsb' 0 16 : BitVec 32) → WP isa (.block is) s' Q) : + WP isa (.block (.movt d imm :: is)) s Q := + MdStream.Arm.WP.cons (s' := s.setReg d (imm ++ (s.gpr d).extractLsb' 0 16 : BitVec 32)) rfl + (k _ (Upd.setReg _ _ _)) + +theorem wp_eor {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 := + MdStream.Arm.WP.cons (s' := s.setReg d (s.gpr n ^^^ y)) (by simp [exec, ho]) (k _ (Upd.setReg _ _ _)) + +end + +theorem add_off (p : Addr) (o j : Nat) : + p + BitVec.ofNat 64 (o + j) = p + BitVec.ofNat 64 o + BitVec.ofNat 64 j := by + rw [BitVec.ofNat_add, BitVec.add_assoc] + +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 + +/-- `d ← scratch + o`, with `scratch` in `r11`. -/ +theorem scrAt_ok {d : Reg} {o : Nat} (ho : o < 2 ^ 16) {s : State} {rest : List Instr} {Q : State → Prop} + (k : ∀ s', (∀ r, r ≠ d → r ≠ .r12 → s'.gpr r = s.gpr r) → s'.gpr d = s.gpr .r11 + BitVec.ofNat 32 o → + 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 (scrAt d o ++ rest)) s Q := by + simp only [scrAt, List.cons_append, List.nil_append] + refine wp_movw fun s₁ u₁ => wp_add (op2_reg _ _) fun s₂ u₂ => k s₂ (fun r h₁ 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₂.other r h₁, u₁.other r h₂] + · rw [u₂.gpr, u₁.gpr, u₁.other _ (by decide), movw_ofNat ho] + +/-! ## Copies -/ + +/-- Copying `n` words from `[src + o₁]` to `[dst + o₂]`, through `r12`. -/ +theorem copyW_ok {src dst : Reg} (hs : src ≠ .r12) (hd : dst ≠ .r12) (o₁ o₂ : Nat) (n : Nat) + (hb : o₁ + 4 * n ≤ 4096 ∧ o₂ + 4 * n ≤ 4096) : + ∀ (rest : List Instr) (s : State) (Q : State → Prop), + (s.gpr src).toNat + o₁ + 4 * n ≤ 2 ^ 32 → (s.gpr dst).toNat + o₂ + 4 * n ≤ 2 ^ 32 → + (∀ k < n, InRegions (s.rd ++ s.wr) + (State.addr (s.gpr src) + BitVec.ofNat 64 o₁ + BitVec.ofNat 64 (4 * k)) 4) → + (∀ k < n, InRegions s.wr (State.addr (s.gpr dst) + BitVec.ofNat 64 o₂ + BitVec.ofNat 64 (4 * k)) 4) → + Mem.Sep (State.addr (s.gpr src) + BitVec.ofNat 64 o₁) (4 * n) + (State.addr (s.gpr dst) + BitVec.ofNat 64 o₂) (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 (s.gpr dst) + BitVec.ofNat 64 o₂) + (bytesAt s.mem (State.addr (s.gpr src) + BitVec.ofNat 64 o₁) (4 * n)) → + WP isa (.block rest) s' Q) → + WP isa (.block (copyW src dst o₁ o₂ n ++ rest)) s Q := by + induction n with + | zero => + intro rest s Q _ _ _ _ _ k + exact k s (fun _ _ => rfl) rfl rfl rfl (by rw [Nat.mul_zero, bytesAt_zero, writeBytes_nil]) + | succ n ih => + intro rest s Q fs fd hin hout hsep k + rw [copyW, List.range_succ, List.flatMap_append, List.flatMap_singleton, List.append_assoc] + refine ih ⟨by omega_nat, by omega_nat⟩ _ s Q (by omega_nat) (by omega_nat) (fun j hj => hin j (by omega_nat)) + (fun j hj => hout j (by omega_nat)) (fun x hx hy => hsep x (by omega_nat) (by omega_nat)) + fun s₁ g₁ rd₁ wr₁ sp₁ m₁ => ?_ + simp only [cp, List.cons_append, List.nil_append] + refine wp_ldr (a := State.addr (s.gpr src) + BitVec.ofNat 64 o₁ + BitVec.ofNat 64 (4 * n)) + (by omega_nat) (by rw [g₁ _ hs, addr_add (by omega_nat), add_off]) + (by rw [rd₁, wr₁]; exact hin n (by omega_nat)) fun s₂ u₂ => ?_ + refine wp_str (a := State.addr (s.gpr dst) + BitVec.ofNat 64 o₂ + BitVec.ofNat 64 (4 * n)) + (by omega_nat) (by rw [u₂.other _ hd, g₁ _ hd, addr_add (by omega_nat), add_off]) + (by rw [u₂.wr, wr₁]; exact hout n (by omega_nat)) + fun s₃ u₃ => k s₃ (fun r hr => by rw [u₃.gpr, u₂.other r hr, g₁ r hr]) + (by rw [u₃.rd, u₂.rd, rd₁]) (by rw [u₃.wr, u₂.wr, wr₁]) (by rw [u₃.sp, u₂.sp, sp₁]) ?_ + rw [u₃.mem, u₂.gpr, u₂.mem, m₁, Nat.mul_succ] + exact copy_mem s.mem _ _ n 4 (by rwa [← Nat.mul_succ]) (by omega_nat) + +/-! ## The padding -/ + +/-- Stores of zero (`r12`) at `r6 + a + 4 + 4 k`, for `k < n`. -/ +theorem zeros_ok {a : Nat} {p : BitVec 32} : ∀ n, a + 4 + 4 * n ≤ 4096 → p.toNat + a + 4 + 4 * n ≤ 2 ^ 32 → + ∀ (rest : List Instr) (s : State) (Q : State → Prop), + s.gpr .r6 = p → s.gpr .r12 = 0 → + (∀ k < n, InRegions s.wr (State.addr p + BitVec.ofNat 64 (a + 4 + 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 p + BitVec.ofNat 64 (a + 4)) (List.replicate (4 * n) 0) → + WP isa (.block rest) s' Q) → + WP isa (.block ((List.range n).map (fun k => Instr.str .r12 .r6 (a + 4 + 4 * k)) ++ rest)) s Q := by + intro n + induction n with + | zero => + intro _ _ rest s Q _ _ _ k + exact k s rfl rfl rfl rfl (by simp [writeBytes_nil]) + | succ n ih => + intro ha hf rest s Q h6 h12 hout k + rw [List.range_succ, List.map_append, List.map_singleton, List.append_assoc] + refine ih (by omega_nat) (by omega_nat) _ s Q h6 h12 (fun j hj => hout j (by omega_nat)) + fun s₁ g₁ rd₁ wr₁ sp₁ m₁ => ?_ + simp only [List.cons_append, List.nil_append] + refine wp_str (a := State.addr p + BitVec.ofNat 64 (a + 4 + 4 * n)) (by omega_nat) + (by rw [g₁, h6, addr_add (by omega_nat)]) (by rw [wr₁]; exact hout n (by omega_nat)) fun s₂ g₂ => + k s₂ (by rw [g₂.gpr, g₁]) (by rw [g₂.rd, rd₁]) (by rw [g₂.wr, wr₁]) (by rw [g₂.sp, sp₁]) ?_ + rw [g₂.mem, g₁, h12, m₁, writeW_bytes _ _ (0 : BitVec 32) [0, 0, 0, 0] (by decide), + writeBytes_append' _ _ _ (by rw [List.length_replicate, Memory.add_ofNat]) + (by simp; omega_nat), Nat.mul_succ, ← List.replicate_append_replicate] + rfl + +/-- `padFrom a b` writes `0x80` and zeros from byte `a` to byte `b` of the block at `r6`. -/ +theorem padFrom_ok {a b : Nat} (hab : a + 4 ≤ b) (h4 : (b - a) % 4 = 0) (hb : b ≤ 4096) {s : State} {p : BitVec 32} + (h6 : s.gpr .r6 = p) (hf : p.toNat + b ≤ 2 ^ 32) + (hout : ∀ k < (b - a) / 4, InRegions s.wr (State.addr p + BitVec.ofNat 64 (a + 4 * k)) 4) + {rest : List Instr} {Q : State → Prop} + (k : ∀ 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 p + BitVec.ofNat 64 a) ([0x80] ++ List.replicate (b - a - 1) 0) → + WP isa (.block rest) s' Q) : + WP isa (.block (padFrom a b ++ rest)) s Q := by + unfold padFrom + simp only [List.cons_append, List.nil_append] + refine wp_mov (op2_imm (by decide)) fun s₁ u₁ => ?_ + refine wp_str (a := State.addr p + BitVec.ofNat 64 a) (by omega_nat) + (by rw [u₁.other _ (by decide), h6, addr_add (by omega_nat)]) + (by rw [u₁.wr]; simpa using hout 0 (by omega_nat)) fun s₂ g₂ => ?_ + refine wp_mov (op2_imm (by decide)) fun s₃ u₃ => ?_ + refine zeros_ok (a := a) (p := p) ((b - a) / 4 - 1) (by omega_nat) (by omega_nat) rest s₃ Q + (by rw [u₃.other _ (by decide), g₂.gpr, u₁.other _ (by decide), h6]) u₃.gpr + (fun j hj => by + rw [u₃.wr, g₂.wr, u₁.wr, show a + 4 + 4 * j = a + 4 * (j + 1) by omega_nat]; exact hout (j + 1) (by omega_nat)) + fun s₄ g₄ rd₄ wr₄ sp₄ m₄ => k s₄ (fun r hr => by + rw [g₄, u₃.other r hr, g₂.gpr, u₁.other r hr]) (by rw [rd₄, u₃.rd, g₂.rd, u₁.rd]) + (by rw [wr₄, u₃.wr, g₂.wr, u₁.wr]) (by rw [sp₄, u₃.sp, g₂.sp, u₁.sp]) ?_ + rw [m₄, u₃.mem, g₂.mem, u₁.gpr, u₁.mem, + writeW_bytes _ _ (0x80 : BitVec 32) [0x80, 0, 0, 0] (by decide), + writeBytes_append' _ _ _ (by rw [List.length_cons, List.length_cons, List.length_cons, + List.length_singleton, Memory.add_ofNat]) (by simp; omega_nat), + show b - a - 1 = 3 + 4 * ((b - a) / 4 - 1) by omega_nat, ← List.replicate_append_replicate] + rfl + +/-- The bytes of words, each stored little-endian. -/ +def wordsBytes (ws : List (BitVec 32)) : List Byte := ws.flatMap (bytes32 false) + +theorem wordsBytes_length (ws : List (BitVec 32)) : (wordsBytes ws).length = 4 * ws.length := by + induction ws with + | nil => rfl + | cons w ws ih => + simp only [wordsBytes, List.flatMap_cons, List.length_append, MdStream.bytes32_length] at ih ⊢ + rw [ih, List.length_cons]; omega + +theorem movw_movt' (x : BitVec 32) : + (x.extractLsb' 16 16 ++ ((x.extractLsb' 0 16).setWidth 32).extractLsb' 0 16 : BitVec 32) = x := + movw_movt x + +/-- `constW o ws` stores the words `ws` from `r6 + o` on. -/ +theorem constW_ok {p : BitVec 32} : ∀ (ws : List (BitVec 32)) (o : Nat), o + 4 * ws.length ≤ 4096 → + p.toNat + o + 4 * ws.length ≤ 2 ^ 32 → + ∀ (rest : List Instr) (s : State) (Q : State → Prop), s.gpr .r6 = p → + (∀ k < ws.length, InRegions s.wr (State.addr p + BitVec.ofNat 64 (o + 4 * k)) 4) → + (∀ 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 p + BitVec.ofNat 64 o) (wordsBytes ws) → + WP isa (.block rest) s' Q) → + WP isa (.block (constW o ws ++ rest)) s Q + | [], o, _, _, rest, s, Q, _, _, k => k s (fun _ _ => rfl) rfl rfl rfl (by rw [wordsBytes, List.flatMap_nil, + writeBytes_nil]) + | w :: ws, o, ho, hf, rest, s, Q, h6, hout, k => by + simp only [List.length_cons] at ho hf + simp only [constW, List.cons_append, List.nil_append] + refine wp_movw fun s₁ u₁ => wp_movt fun s₂ u₂ => ?_ + have e6 : s₂.gpr .r6 = p := by rw [u₂.other _ (by decide), u₁.other _ (by decide), h6] + refine wp_str (a := State.addr p + BitVec.ofNat 64 o) (by omega_nat) (by rw [e6, addr_add (by omega_nat)]) + (by rw [u₂.wr, u₁.wr]; simpa using hout 0 (by simp)) fun s₃ g₃ => ?_ + refine constW_ok (p := p) ws (o + 4) (by omega_nat) (by omega_nat) rest s₃ Q (by rw [g₃.gpr, e6]) + (fun j hj => by + rw [g₃.wr, u₂.wr, u₁.wr, show o + 4 + 4 * j = o + 4 * (j + 1) by omega_nat] + exact hout (j + 1) (by simp; omega_nat)) fun s₄ g₄ rd₄ wr₄ sp₄ m₄ => ?_ + refine k s₄ (fun r hr => by rw [g₄ r hr, g₃.gpr, u₂.other r hr, u₁.other r hr]) + (by rw [rd₄, g₃.rd, u₂.rd, u₁.rd]) (by rw [wr₄, g₃.wr, u₂.wr, u₁.wr]) (by rw [sp₄, g₃.sp, u₂.sp, u₁.sp]) ?_ + have v : s₂.gpr .r12 = w := by rw [u₂.gpr, u₁.gpr, movw_movt'] + rw [m₄, g₃.mem, v, u₂.mem, u₁.mem, writeW_le, + writeBytes_append' _ _ _ (by rw [MdStream.bytes32_length, Memory.add_ofNat]) (by + rw [MdStream.bytes32_length, wordsBytes_length]; omega_nat)] + rfl + +/-! ## `T ← T ⊕ U` -/ + +theorem writeW_xor32 (m m' : Mem) (d a b : Addr) : + m.writeW d (m'.readW a 32 ^^^ m'.readW b 32) = + writeBytes m d (Spec.Pbkdf2.xorBytes (bytesAt m' b 4) (bytesAt m' a 4)) := by + simp only [Mem.writeW, Mem.readW] + rw [show (32 : Nat) / 8 = 4 from rfl, BitVec.setWidth_eq, BitVec.setWidth_eq, BitVec.setWidth_eq, + VG.WriteBytes.write_eq_writeBytes] + congr 1 + apply List.ext_getElem (by simp [Spec.Pbkdf2.xorBytes, bytesAt]) + intro j h₁ h₂ + simp only [List.length_map, List.length_range] at h₁ + simp only [Spec.Pbkdf2.xorBytes, bytesAt, List.getElem_map, List.getElem_range, List.getElem_zipWith] + rw [BitVec.extractLsb'_xor, Mem.extractLsb'_read _ _ h₁, Mem.extractLsb'_read _ _ h₁, BitVec.xor_comm] + +/-- `T ← T ⊕ U` for the first `n` words of `T` at `r7` (`tp`) and `U` at `r6` (`bp`). -/ +theorem xor_ok {tp bp : BitVec 32} {D : Nat} (hd : Region.Disjoint ⟨State.addr tp, D⟩ ⟨State.addr bp, D⟩) + (hD : D ≤ 4096) (ft : tp.toNat + D ≤ 2 ^ 32) (fb : bp.toNat + D ≤ 2 ^ 32) : + ∀ n, 4 * n ≤ D → ∀ (rest : List Instr) (s : State) (Q : State → Prop), s.gpr .r6 = bp → s.gpr .r7 = tp → + (∀ k < n, InRegions (s.rd ++ s.wr) (State.addr bp + BitVec.ofNat 64 (4 * k)) 4) → + (∀ k < n, InRegions s.wr (State.addr tp + BitVec.ofNat 64 (4 * k)) 4) → + (∀ s', (∀ r, r ≠ .r12 → r ≠ .r1 → 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 tp) + (Spec.Pbkdf2.xorBytes (bytesAt s.mem (State.addr tp) (4 * n)) (bytesAt s.mem (State.addr bp) (4 * n))) → + WP isa (.block rest) s' Q) → + WP isa (.block ((List.range n).flatMap xorW ++ rest)) s Q := by + intro n + induction n with + | zero => + intro _ rest s Q _ _ _ _ k + exact k s (fun _ _ _ => rfl) rfl rfl rfl (by simp [bytesAt, Spec.Pbkdf2.xorBytes, writeBytes_nil]) + | succ n ih => + intro hn rest s Q h6 h7 hin hout k + rw [List.range_succ, List.flatMap_append, List.flatMap_singleton, List.append_assoc] + refine ih (by omega_nat) _ s Q h6 h7 (fun j hj => hin j (by omega_nat)) (fun j hj => hout j (by omega_nat)) + fun s₁ g₁ rd₁ wr₁ sp₁ m₁ => ?_ + simp only [xorW, List.cons_append, List.nil_append] + have hw := hout n (by omega_nat) + refine wp_ldr (a := State.addr bp + BitVec.ofNat 64 (4 * n)) (by omega_nat) + (by rw [g₁ _ (by decide) (by decide), h6, addr_add (by omega_nat)]) (by rw [rd₁, wr₁]; exact hin n (by omega_nat)) + fun s₂ u₂ => ?_ + refine wp_ldr (a := State.addr tp + BitVec.ofNat 64 (4 * n)) (by omega_nat) + (by rw [u₂.other _ (by decide), g₁ _ (by decide) (by decide), h7, addr_add (by omega_nat)]) + (by rw [u₂.rd, u₂.wr, rd₁, wr₁]; obtain ⟨r, hr, hc⟩ := hw; exact ⟨r, List.mem_append_right _ hr, hc⟩) + fun s₃ u₃ => ?_ + refine wp_eor (op2_reg _ _) fun s₄ u₄ => ?_ + refine wp_str (a := State.addr tp + BitVec.ofNat 64 (4 * n)) (by omega_nat) + (by rw [u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), + g₁ _ (by decide) (by decide), h7, addr_add (by omega_nat)]) + (by rw [u₄.wr, u₃.wr, u₂.wr, wr₁]; exact hw) + fun s₅ g₅ => k s₅ (fun r h12 h1 => by + rw [g₅.gpr, u₄.other r h12, u₃.other r h1, u₂.other r h12, g₁ r h12 h1]) + (by rw [g₅.rd, u₄.rd, u₃.rd, u₂.rd, rd₁]) (by rw [g₅.wr, u₄.wr, u₃.wr, u₂.wr, wr₁]) + (by rw [g₅.sp, u₄.sp, u₃.sp, u₂.sp, sp₁]) ?_ + have hl : (Spec.Pbkdf2.xorBytes (bytesAt s.mem (State.addr tp) (4 * n)) + (bytesAt s.mem (State.addr bp) (4 * n))).length = 4 * n := by + rw [xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length] + have v : s₄.gpr .r12 = s₁.mem.readW (State.addr bp + BitVec.ofNat 64 (4 * n)) 32 ^^^ + s₁.mem.readW (State.addr tp + BitVec.ofNat 64 (4 * n)) 32 := by + rw [u₄.gpr, u₃.other _ (by decide), u₂.gpr, u₃.gpr, u₂.mem] + rw [g₅.mem, u₄.mem, u₃.mem, u₂.mem, v, writeW_xor32, m₁, + bytesAt_writeBytes_sep (p := State.addr tp + BitVec.ofNat 64 (4 * n)), + bytesAt_writeBytes_sep (p := State.addr bp + BitVec.ofNat 64 (4 * n))] + · have e := writeBytes_append s.mem (State.addr tp) _ + (Spec.Pbkdf2.xorBytes (bytesAt s.mem (State.addr tp + BitVec.ofNat 64 (4 * n)) 4) + (bytesAt s.mem (State.addr bp + BitVec.ofNat 64 (4 * n)) 4)) + (by rw [hl, xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length]; omega_nat) + rw [hl] at e + rw [e, Nat.mul_succ, bytesAt_add, bytesAt_add, Spec.Pbkdf2.xorBytes, Spec.Pbkdf2.xorBytes, + Spec.Pbkdf2.xorBytes, List.zipWith_append (by simp [bytesAt])] + · intro x h₁ h₂ + rw [hl] at h₂ + exact hd x (by simp only [Region.Contains]; omega_nat) (off_contains h₁ (by omega_nat) (by omega_nat)) + · omega_nat + · intro x h₁ h₂ + rw [hl] at h₂ + exact sep_after h₁ h₂ (by omega_nat) + · omega_nat + +/-! ## Digests -/ + +/-- What the code writing a hash function's digest must do: write the digest +of the hash value at `r0` to `r6`, writing only `r9` and `r10`. -/ +def OutOk {B N L : Nat} (H : Md B N L) (out : List Instr) : Prop := + ∀ s : State, (s.gpr .r0).toNat + N ≤ 2 ^ 32 → (s.gpr .r6).toNat + N ≤ 2 ^ 32 → + InRegions (s.rd ++ s.wr) (State.addr (s.gpr .r0)) N → InRegions s.wr (State.addr (s.gpr .r6)) N → + Region.Disjoint ⟨State.addr (s.gpr .r0), N⟩ ⟨State.addr (s.gpr .r6), N⟩ → + WP isa (.block out) s fun s' => (∀ r, r ≠ .r9 → r ≠ .r10 → 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 (s.gpr .r6)) (H.digest (H.stateAt s.mem (State.addr (s.gpr .r0)))) + +/-- The streaming proofs' digest code, for a hash function with 64-byte blocks. -/ +theorem OutOk.ofShape {P : Impl.MdStream.Arm.Params} {H : Md 64 P.N 8} (h : MdStream.Arm.Shape H) : + OutOk H P.out := fun s f₀ f₆ hin hout hd => + (h.out s f₀ f₆ hin hout hd).mono fun _ ⟨g, rd, wr, sp, m⟩ => ⟨fun r h9 _ => g r h9, rd, wr, sp, m⟩ + +/-! ## Blocks -/ + +/-- The block, of `D` bytes of message and the padding after them. -/ +theorem blockAt_eq {B N L D : Nat} {md : Md B N L} {m : Mem} {p : Addr} (hD : D ≤ B) + (h : bytesAt m (p + BitVec.ofNat 64 D) (B - D) = md.tailPad D) : + md.blockAt m p = md.tailBlock D (bytesAt m p D) := by + simp only [Md.blockAt, Md.tailBlock] + refine md.parse_congr fun k hk => ?_ + have e := bytesAt_add m p D (B - D) + rw [h, show D + (B - D) = B by omega] at e + rw [← e, bytesAt_getD' _ _ hk] + +end VG.Proof.Pbkdf2.Md.Arm diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/MdStep.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/MdStep.lean index 71513fa52..8df447f95 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/MdStep.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/MdStep.lean @@ -115,4 +115,31 @@ theorem iterate_congr {D : Nat} {f g : List Byte → List Byte} (hfg : ∀ u, u. rw [hfg u hu] exact ih _ _ (hg u) +/-- PBKDF2's iteration with HMAC as its pseudorandom function is the +iteration of `step`, from the hash values of a key's streaming states. -/ +theorem iterate_hmac {S : StreamingHash} {iv : H.HV} {D : Nat} (hl : H.Link S iv D) {k0 : List Byte} + (hk : k0.length = S.H.blockSize) {mem : Mem} {p q : Addr} (hi : S.Repr mem p (xorPad k0 ipad)) + (ho : S.Repr mem q (xorPad k0 opad)) (n : Nat) {u t : List Byte} (hu : u.length = D) : + Spec.Pbkdf2.iterate (hmacBlockKey S.H k0) n u t = + Spec.Pbkdf2.iterate (H.step D (H.stateAt mem p) (H.stateAt mem q)) n u t := by + have hB : 0 < B := by have := hl.DL; omega + rw [hl.hB] at hk + have li : (xorPad k0 ipad).length = B := by simp [xorPad, hk] + have lo : (xorPad k0 opad).length = B := by simp [xorPad, hk] + rw [stateAt_of_repr hB li (hl.repr _ _ _ hi), stateAt_of_repr hB lo (hl.repr _ _ _ ho)] + exact iterate_congr (fun u hu => hmac_step hl hk hu) (fun u => step_length H hl.DN _ _ u) n u t hu + +/-- HMAC's outer hash, for a key whose outer block's hash value is `ho`, of +the inner digest `x`: one compression of the block `x ‖ pad`. -/ +theorem hmac_outer {S : StreamingHash} {iv : H.HV} {D : Nat} (hl : H.Link S iv D) {k0 text : List Byte} + (hk : k0.length = S.H.blockSize) {mem : Mem} {p : Addr} (ho : S.Repr mem p (xorPad k0 opad)) : + hmacBlockKey S.H k0 text = + (H.digest (H.compress (H.stateAt mem p) (H.tailBlock D (S.H.hash (xorPad k0 ipad ++ text))))).take D := by + have hB : 0 < B := by have := hl.DL; omega + rw [hl.hB] at hk + have lo : (xorPad k0 opad).length = B := by simp [xorPad, hk] + have hx : (S.H.hash (xorPad k0 ipad ++ text)).length = D := by + rw [hl.hash, List.length_take, Md.hash, H.digest_length]; exact Nat.min_eq_left hl.DN + rw [hmacBlockKey, hl.hash, hash_block H iv lo hx hl.DL, stateAt_of_repr hB lo (hl.repr _ _ _ ho)] + end VG.Proof.MdStream.Md diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean index fc778e44e..9e363545a 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean @@ -1,7 +1,7 @@ import VerifiedGarbage.Proof.Framework.Contract import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.CT import VerifiedGarbage.Proof.Hmac.Generic.Arm.Instances -import VerifiedGarbage.Proof.Pbkdf2.Generic.Arm.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances /-! # PBKDF2-HMAC on 32-bit ARM, the whole derivation: the instances @@ -22,18 +22,18 @@ open VG.Impl.Pbkdf2.Whole.Arm (Fns) open VG.Proof.Hmac.Generic.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 `H` of the instance -`I`, with the working space of `I`'s functions, by the names they are -registered with. -/ -def fnsOf (I : Spec.Hmac.Instance) (H : Impl.Hmac.Generic.Arm.Hash) : Fns where - H := H +/-- The functions `pbkdf2` calls for the hash function `M` of the instance +`I` (`Impl/Pbkdf2/Md/Arm.lean`), with the working space of `I`'s functions, +by the names they are registered with. -/ +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 := H.init + hiC := M.st.init hfN := I.finalizeApi.name - hfC := H.finalize + hfC := M.hmacFin itN := I.iterateApi.name - itC := Impl.Pbkdf2.Generic.Arm.iterate H + itC := M.iterate /-- Memory holding the stack arguments `1, 0x1200, 0, 0x2000` of `pbkdf2` at `0x8000`. -/ def pbkMem : Mem := fun a => @@ -56,7 +56,7 @@ def pbkSat (W : Nat) : State where /-! ## SHA-1 -/ -def sha1F : Fns := fnsOf Spec.Hmac.sha1I sha1H +def sha1F : Fns := fnsOf Spec.Hmac.sha1I Md.Arm.sha1Md theorem sha1_checks : Checks sha1F := by constructor <;> exact ⟨_, by taint_decide⟩ @@ -67,8 +67,8 @@ def sha1OKF : FnsOK sha1F where Wf := 56 Wt := 56 hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha1_init - hf := .of_verified Proof.Hmac.Generic.Arm.Instances.sha1_finalize - it := .of_verified Proof.Pbkdf2.Generic.Arm.Instances.sha1 + hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha1_finalize + it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha1_iterate hiSt := by decide +kernel hfSt := by decide +kernel itSt := by decide +kernel @@ -95,7 +95,7 @@ theorem sha1 : Verified Arm.target sha1F.pbkdf2 (Spec.Hmac.sha1I.pbkdf2Contract /-! ## MD5 -/ -def md5F : Fns := fnsOf Spec.Hmac.md5I md5H +def md5F : Fns := fnsOf Spec.Hmac.md5I Md.Arm.md5Md theorem md5_checks : Checks md5F := by constructor <;> exact ⟨_, by taint_decide⟩ @@ -106,8 +106,8 @@ def md5OKF : FnsOK md5F where Wf := 48 Wt := 48 hi := .of_verified Proof.Hmac.Generic.Arm.Instances.md5_init - hf := .of_verified Proof.Hmac.Generic.Arm.Instances.md5_finalize - it := .of_verified Proof.Pbkdf2.Generic.Arm.Instances.md5 + hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.md5_finalize + it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.md5_iterate hiSt := by decide +kernel hfSt := by decide +kernel itSt := by decide +kernel @@ -134,7 +134,7 @@ theorem md5 : Verified Arm.target md5F.pbkdf2 (Spec.Hmac.md5I.pbkdf2Contract Arm /-! ## SHA-384 -/ -def sha384F : Fns := fnsOf Spec.Hmac.sha384I sha384H +def sha384F : Fns := fnsOf Spec.Hmac.sha384I Md.Arm.sha384Md theorem sha384_checks : Checks sha384F := by constructor <;> exact ⟨_, by taint_decide⟩ @@ -145,8 +145,8 @@ def sha384OKF : FnsOK sha384F where Wf := 234 Wt := 234 hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha384_init - hf := .of_verified Proof.Hmac.Generic.Arm.Instances.sha384_finalize - it := .of_verified Proof.Pbkdf2.Generic.Arm.Instances.sha384 + hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha384_finalize + it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha384_iterate hiSt := by decide +kernel hfSt := by decide +kernel itSt := by decide +kernel @@ -173,7 +173,7 @@ theorem sha384 : Verified Arm.target sha384F.pbkdf2 (Spec.Hmac.sha384I.pbkdf2Con /-! ## SHA-512 -/ -def sha512F : Fns := fnsOf Spec.Hmac.sha512I sha512H' +def sha512F : Fns := fnsOf Spec.Hmac.sha512I Md.Arm.sha512Md' theorem sha512_checks : Checks sha512F := by constructor <;> exact ⟨_, by taint_decide⟩ @@ -184,8 +184,8 @@ def sha512OKF : FnsOK sha512F where Wf := 234 Wt := 234 hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha512_init - hf := .of_verified Proof.Hmac.Generic.Arm.Instances.sha512_finalize - it := .of_verified Proof.Pbkdf2.Generic.Arm.Instances.sha512 + hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha512_finalize + it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha512_iterate hiSt := by decide +kernel hfSt := by decide +kernel itSt := by decide +kernel @@ -212,7 +212,7 @@ theorem sha512 : Verified Arm.target sha512F.pbkdf2 (Spec.Hmac.sha512I.pbkdf2Con /-! ## SHA-512/224 -/ -def sha512_224F : Fns := fnsOf Spec.Hmac.sha512_224I sha512_224H +def sha512_224F : Fns := fnsOf Spec.Hmac.sha512_224I Md.Arm.sha512_224Md theorem sha512_224_checks : Checks sha512_224F := by constructor <;> exact ⟨_, by taint_decide⟩ @@ -223,8 +223,8 @@ def sha512_224OKF : FnsOK sha512_224F where Wf := 234 Wt := 234 hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha512_224_init - hf := .of_verified Proof.Hmac.Generic.Arm.Instances.sha512_224_finalize - it := .of_verified Proof.Pbkdf2.Generic.Arm.Instances.sha512_224 + 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 hfSt := by decide +kernel itSt := by decide +kernel @@ -251,7 +251,7 @@ theorem sha512_224 : Verified Arm.target sha512_224F.pbkdf2 (Spec.Hmac.sha512_22 /-! ## SHA-512/256 -/ -def sha512_256F : Fns := fnsOf Spec.Hmac.sha512_256I sha512_256H +def sha512_256F : Fns := fnsOf Spec.Hmac.sha512_256I Md.Arm.sha512_256Md theorem sha512_256_checks : Checks sha512_256F := by constructor <;> exact ⟨_, by taint_decide⟩ @@ -262,8 +262,8 @@ def sha512_256OKF : FnsOK sha512_256F where Wf := 234 Wt := 234 hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha512_256_init - hf := .of_verified Proof.Hmac.Generic.Arm.Instances.sha512_256_finalize - it := .of_verified Proof.Pbkdf2.Generic.Arm.Instances.sha512_256 + 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 hfSt := by decide +kernel itSt := by decide +kernel diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha224.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha224.lean index 7275ebdd0..4948f1ee4 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha224.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha224.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Instances -import VerifiedGarbage.Proof.Pbkdf2.Generic.Arm.Sha224 +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Sha224 /-! # PBKDF2-HMAC-SHA-224 on 32-bit ARM, the whole derivation @@ -15,7 +15,7 @@ open VG.Arm open VG.Impl.Pbkdf2.Whole.Arm (Fns) open VG.Proof.Hmac.Generic.Arm (sha224H sha224OK) -def sha224F : Fns := fnsOf Spec.Hmac.sha224I sha224H +def sha224F : Fns := fnsOf Spec.Hmac.sha224I Md.Arm.sha224Md theorem sha224_checks : Checks sha224F := by constructor <;> exact ⟨_, by taint_decide⟩ @@ -26,8 +26,8 @@ def sha224OKF : FnsOK sha224F where Wf := 104 Wt := 104 hi := .of_verified Proof.Hmac.Generic.Arm.Instances.sha224_init - hf := .of_verified Proof.Hmac.Generic.Arm.Instances.sha224_finalize - it := .of_verified Proof.Pbkdf2.Generic.Arm.Instances.sha224 + hf := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha224_finalize + it := .of_verified Proof.Pbkdf2.Md.Arm.Instances.sha224_iterate hiSt := by decide +kernel hfSt := by decide +kernel itSt := by decide +kernel diff --git a/src/asm/arm/hmac_md5.rs b/src/asm/arm/hmac_md5.rs index 862b24758..86882b86c 100644 --- a/src/asm/arm/hmac_md5.rs +++ b/src/asm/arm/hmac_md5.rs @@ -132,56 +132,58 @@ pub(crate) unsafe extern "C" fn vg_hmac_md5_finalize(inner: *mut [u8; 80], outer "str r10, [r12, #136]", "str lr, [r12, #140]", "str r11, [r12, #144]", - "mov r4, r0", "mov r5, r1", - "ldr r6, [sp, #0]", + "ldr r7, [sp, #0]", "mov r11, r12", - "mov r0, r4", - "movw r12, #148", + "movw r12, #164", "add r1, r11, r12", "mov r12, r11", "push {{r1, r12}}", "bl {vg_md5_finalize}", "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #80", - "20:", - "add r2, r5, r8", - "ldrb r12, [r2, #0]", - "add r2, r4, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "mov r0, r4", - "movw r12, #148", - "add r1, r11, r12", - "movw r7, #16", - "mov r10, r11", - "movw r2, #64", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_md5_update}", - "ldr r1, [sp], #16", - "mov r0, r4", - "movw r2, #80", - "mov r3, #0", + "mov r3, r11", "movw r12, #148", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_md5_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #16", - "21:", - "add r2, r11, r8", - "ldrb r12, [r2, #148]", - "add r2, r6, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 21b", + "add r0, r11, r12", + "movw r12, #164", + "add r6, r11, r12", + "ldr r12, [r5, #0]", + "str r12, [r0, #0]", + "ldr r12, [r5, #4]", + "str r12, [r0, #4]", + "ldr r12, [r5, #8]", + "str r12, [r0, #8]", + "ldr r12, [r5, #12]", + "str r12, [r0, #12]", + "mov r12, #128", + "str r12, [r6, #16]", + "mov r12, #0", + "str r12, [r6, #20]", + "str r12, [r6, #24]", + "str r12, [r6, #28]", + "str r12, [r6, #32]", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "movw r12, #640", + "movt r12, #0", + "str r12, [r6, #56]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #60]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_md5_compress}", + "mov r6, r7", + "ldr r9, [r0, #0]", + "str r9, [r6, #0]", + "ldr r9, [r0, #4]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "str r9, [r6, #8]", + "ldr r9, [r0, #12]", + "str r9, [r6, #12]", "ldr r4, [r11, #112]", "ldr r5, [r11, #116]", "ldr r6, [r11, #120]", @@ -193,6 +195,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_md5_finalize(inner: *mut [u8; 80], outer "ldr r11, [r11, #144]", "bx lr", vg_md5_finalize = sym super::md5::vg_md5_finalize, - 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 1b2976334..2c4d90076 100644 --- a/src/asm/arm/hmac_sha1.rs +++ b/src/asm/arm/hmac_sha1.rs @@ -132,56 +132,66 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha1_finalize(inner: *mut [u8; 84], oute "str r10, [r12, #184]", "str lr, [r12, #188]", "str r11, [r12, #192]", - "mov r4, r0", "mov r5, r1", - "ldr r6, [sp, #0]", + "ldr r7, [sp, #0]", "mov r11, r12", - "mov r0, r4", - "movw r12, #196", + "movw r12, #216", "add r1, r11, r12", "mov r12, r11", "push {{r1, r12}}", "bl {vg_sha1_finalize}", "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #84", - "20:", - "add r2, r5, r8", - "ldrb r12, [r2, #0]", - "add r2, r4, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "mov r0, r4", - "movw r12, #196", - "add r1, r11, r12", - "movw r7, #20", - "mov r10, r11", - "movw r2, #64", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha1_update}", - "ldr r1, [sp], #16", - "mov r0, r4", - "movw r2, #84", - "mov r3, #0", + "mov r3, r11", "movw r12, #196", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha1_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #20", - "21:", - "add r2, r11, r8", - "ldrb r12, [r2, #196]", - "add r2, r6, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 21b", + "add r0, r11, r12", + "movw r12, #216", + "add r6, r11, r12", + "ldr r12, [r5, #0]", + "str r12, [r0, #0]", + "ldr r12, [r5, #4]", + "str r12, [r0, #4]", + "ldr r12, [r5, #8]", + "str r12, [r0, #8]", + "ldr r12, [r5, #12]", + "str r12, [r0, #12]", + "ldr r12, [r5, #16]", + "str r12, [r0, #16]", + "mov r12, #128", + "str r12, [r6, #20]", + "mov r12, #0", + "str r12, [r6, #24]", + "str r12, [r6, #28]", + "str r12, [r6, #32]", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #56]", + "movw r12, #0", + "movt r12, #40962", + "str r12, [r6, #60]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha1_compress}", + "mov r6, r7", + "ldr r9, [r0, #0]", + "rev r9, r9", + "str r9, [r6, #0]", + "ldr r9, [r0, #4]", + "rev r9, r9", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "rev r9, r9", + "str r9, [r6, #8]", + "ldr r9, [r0, #12]", + "rev r9, r9", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "rev r9, r9", + "str r9, [r6, #16]", "ldr r4, [r11, #160]", "ldr r5, [r11, #164]", "ldr r6, [r11, #168]", @@ -193,6 +203,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha1_finalize(inner: *mut [u8; 84], oute "ldr r11, [r11, #192]", "bx lr", vg_sha1_finalize = sym super::sha1::vg_sha1_finalize, - 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 d6c3aa2d3..f0b46926b 100644 --- a/src/asm/arm/hmac_sha224.rs +++ b/src/asm/arm/hmac_sha224.rs @@ -132,56 +132,92 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha224_finalize(inner: *mut [u8; 96], ou "str r10, [r12, #184]", "str lr, [r12, #188]", "str r11, [r12, #192]", - "mov r4, r0", "mov r5, r1", - "ldr r6, [sp, #0]", + "ldr r7, [sp, #0]", "mov r11, r12", - "mov r0, r4", - "movw r12, #196", + "movw r12, #228", "add r1, r11, r12", "mov r12, r11", "push {{r1, r12}}", "bl {vg_sha256_finalize}", "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #96", - "20:", - "add r2, r5, r8", - "ldrb r12, [r2, #0]", - "add r2, r4, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "mov r0, r4", - "movw r12, #196", - "add r1, r11, r12", - "movw r7, #28", - "mov r10, r11", - "movw r2, #64", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha256_update}", - "ldr r1, [sp], #16", - "mov r0, r4", - "movw r2, #92", - "mov r3, #0", + "mov r3, r11", "movw r12, #196", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha256_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #28", - "21:", - "add r2, r11, r8", - "ldrb r12, [r2, #196]", - "add r2, r6, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 21b", + "add r0, r11, r12", + "movw r12, #228", + "add r6, r11, r12", + "ldr r12, [r5, #0]", + "str r12, [r0, #0]", + "ldr r12, [r5, #4]", + "str r12, [r0, #4]", + "ldr r12, [r5, #8]", + "str r12, [r0, #8]", + "ldr r12, [r5, #12]", + "str r12, [r0, #12]", + "ldr r12, [r5, #16]", + "str r12, [r0, #16]", + "ldr r12, [r5, #20]", + "str r12, [r0, #20]", + "ldr r12, [r5, #24]", + "str r12, [r0, #24]", + "ldr r12, [r5, #28]", + "str r12, [r0, #28]", + "mov r12, #128", + "str r12, [r6, #28]", + "mov r12, #0", + "str r12, [r6, #32]", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #56]", + "movw r12, #0", + "movt r12, #57346", + "str r12, [r6, #60]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha256_compress}", + "ldr r9, [r0, #0]", + "rev r9, r9", + "str r9, [r6, #0]", + "ldr r9, [r0, #4]", + "rev r9, r9", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "rev r9, r9", + "str r9, [r6, #8]", + "ldr r9, [r0, #12]", + "rev r9, r9", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "rev r9, r9", + "str r9, [r6, #16]", + "ldr r9, [r0, #20]", + "rev r9, r9", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "rev r9, r9", + "str r9, [r6, #24]", + "ldr r9, [r0, #28]", + "rev r9, r9", + "str r9, [r6, #28]", + "ldr r12, [r6, #0]", + "str r12, [r7, #0]", + "ldr r12, [r6, #4]", + "str r12, [r7, #4]", + "ldr r12, [r6, #8]", + "str r12, [r7, #8]", + "ldr r12, [r6, #12]", + "str r12, [r7, #12]", + "ldr r12, [r6, #16]", + "str r12, [r7, #16]", + "ldr r12, [r6, #20]", + "str r12, [r7, #20]", + "ldr r12, [r6, #24]", + "str r12, [r7, #24]", "ldr r4, [r11, #160]", "ldr r5, [r11, #164]", "ldr r6, [r11, #168]", @@ -193,6 +229,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha224_finalize(inner: *mut [u8; 96], ou "ldr r11, [r11, #192]", "bx lr", vg_sha256_finalize = sym super::sha256::vg_sha256_finalize, - 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 1b62d593f..8b1b0462f 100644 --- a/src/asm/arm/hmac_sha384.rs +++ b/src/asm/arm/hmac_sha384.rs @@ -132,56 +132,157 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha384_finalize(inner: *mut [u8; 192], o "str r10, [r12, #296]", "str lr, [r12, #300]", "str r11, [r12, #304]", - "mov r4, r0", "mov r5, r1", - "ldr r6, [sp, #0]", + "ldr r7, [sp, #0]", "mov r11, r12", - "mov r0, r4", - "movw r12, #308", + "movw r12, #372", "add r1, r11, r12", "mov r12, r11", "push {{r1, r12}}", "bl {vg_sha512_finalize}", "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #192", - "20:", - "add r2, r5, r8", - "ldrb r12, [r2, #0]", - "add r2, r4, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "mov r0, r4", - "movw r12, #308", - "add r1, r11, r12", - "movw r7, #48", - "mov r10, r11", - "movw r2, #128", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", - "mov r0, r4", - "movw r2, #176", - "mov r3, #0", + "mov r3, r11", "movw r12, #308", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha512_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #48", - "21:", - "add r2, r11, r8", - "ldrb r12, [r2, #308]", - "add r2, r6, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 21b", + "add r0, r11, r12", + "movw r12, #372", + "add r6, r11, r12", + "ldr r12, [r5, #0]", + "str r12, [r0, #0]", + "ldr r12, [r5, #4]", + "str r12, [r0, #4]", + "ldr r12, [r5, #8]", + "str r12, [r0, #8]", + "ldr r12, [r5, #12]", + "str r12, [r0, #12]", + "ldr r12, [r5, #16]", + "str r12, [r0, #16]", + "ldr r12, [r5, #20]", + "str r12, [r0, #20]", + "ldr r12, [r5, #24]", + "str r12, [r0, #24]", + "ldr r12, [r5, #28]", + "str r12, [r0, #28]", + "ldr r12, [r5, #32]", + "str r12, [r0, #32]", + "ldr r12, [r5, #36]", + "str r12, [r0, #36]", + "ldr r12, [r5, #40]", + "str r12, [r0, #40]", + "ldr r12, [r5, #44]", + "str r12, [r0, #44]", + "ldr r12, [r5, #48]", + "str r12, [r0, #48]", + "ldr r12, [r5, #52]", + "str r12, [r0, #52]", + "ldr r12, [r5, #56]", + "str r12, [r0, #56]", + "ldr r12, [r5, #60]", + "str r12, [r0, #60]", + "mov r12, #128", + "str r12, [r6, #48]", + "mov r12, #0", + "str r12, [r6, #52]", + "str r12, [r6, #56]", + "str r12, [r6, #60]", + "str r12, [r6, #64]", + "str r12, [r6, #68]", + "str r12, [r6, #72]", + "str r12, [r6, #76]", + "str r12, [r6, #80]", + "str r12, [r6, #84]", + "str r12, [r6, #88]", + "str r12, [r6, #92]", + "str r12, [r6, #96]", + "str r12, [r6, #100]", + "str r12, [r6, #104]", + "str r12, [r6, #108]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #112]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #116]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #120]", + "movw r12, #0", + "movt r12, #32773", + "str r12, [r6, #124]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", + "ldr r9, [r0, #0]", + "ldr r10, [r0, #4]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #0]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "ldr r10, [r0, #12]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #8]", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "ldr r10, [r0, #20]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #16]", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "ldr r10, [r0, #28]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #24]", + "str r9, [r6, #28]", + "ldr r9, [r0, #32]", + "ldr r10, [r0, #36]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #32]", + "str r9, [r6, #36]", + "ldr r9, [r0, #40]", + "ldr r10, [r0, #44]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #40]", + "str r9, [r6, #44]", + "ldr r9, [r0, #48]", + "ldr r10, [r0, #52]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #48]", + "str r9, [r6, #52]", + "ldr r9, [r0, #56]", + "ldr r10, [r0, #60]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #56]", + "str r9, [r6, #60]", + "ldr r12, [r6, #0]", + "str r12, [r7, #0]", + "ldr r12, [r6, #4]", + "str r12, [r7, #4]", + "ldr r12, [r6, #8]", + "str r12, [r7, #8]", + "ldr r12, [r6, #12]", + "str r12, [r7, #12]", + "ldr r12, [r6, #16]", + "str r12, [r7, #16]", + "ldr r12, [r6, #20]", + "str r12, [r7, #20]", + "ldr r12, [r6, #24]", + "str r12, [r7, #24]", + "ldr r12, [r6, #28]", + "str r12, [r7, #28]", + "ldr r12, [r6, #32]", + "str r12, [r7, #32]", + "ldr r12, [r6, #36]", + "str r12, [r7, #36]", + "ldr r12, [r6, #40]", + "str r12, [r7, #40]", + "ldr r12, [r6, #44]", + "str r12, [r7, #44]", "ldr r4, [r11, #272]", "ldr r5, [r11, #276]", "ldr r6, [r11, #280]", @@ -193,6 +294,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha384_finalize(inner: *mut [u8; 192], o "ldr r11, [r11, #304]", "bx lr", vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, - 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 93e15e741..4e0ec4554 100644 --- a/src/asm/arm/hmac_sha512.rs +++ b/src/asm/arm/hmac_sha512.rs @@ -132,56 +132,130 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_finalize(inner: *mut [u8; 192], o "str r10, [r12, #296]", "str lr, [r12, #300]", "str r11, [r12, #304]", - "mov r4, r0", "mov r5, r1", - "ldr r6, [sp, #0]", + "ldr r7, [sp, #0]", "mov r11, r12", - "mov r0, r4", - "movw r12, #308", + "movw r12, #372", "add r1, r11, r12", "mov r12, r11", "push {{r1, r12}}", "bl {vg_sha512_finalize}", "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #192", - "20:", - "add r2, r5, r8", - "ldrb r12, [r2, #0]", - "add r2, r4, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "mov r0, r4", - "movw r12, #308", - "add r1, r11, r12", - "movw r7, #64", - "mov r10, r11", - "movw r2, #128", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", - "mov r0, r4", - "movw r2, #192", - "mov r3, #0", + "mov r3, r11", "movw r12, #308", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha512_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #64", - "21:", - "add r2, r11, r8", - "ldrb r12, [r2, #308]", - "add r2, r6, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 21b", + "add r0, r11, r12", + "movw r12, #372", + "add r6, r11, r12", + "ldr r12, [r5, #0]", + "str r12, [r0, #0]", + "ldr r12, [r5, #4]", + "str r12, [r0, #4]", + "ldr r12, [r5, #8]", + "str r12, [r0, #8]", + "ldr r12, [r5, #12]", + "str r12, [r0, #12]", + "ldr r12, [r5, #16]", + "str r12, [r0, #16]", + "ldr r12, [r5, #20]", + "str r12, [r0, #20]", + "ldr r12, [r5, #24]", + "str r12, [r0, #24]", + "ldr r12, [r5, #28]", + "str r12, [r0, #28]", + "ldr r12, [r5, #32]", + "str r12, [r0, #32]", + "ldr r12, [r5, #36]", + "str r12, [r0, #36]", + "ldr r12, [r5, #40]", + "str r12, [r0, #40]", + "ldr r12, [r5, #44]", + "str r12, [r0, #44]", + "ldr r12, [r5, #48]", + "str r12, [r0, #48]", + "ldr r12, [r5, #52]", + "str r12, [r0, #52]", + "ldr r12, [r5, #56]", + "str r12, [r0, #56]", + "ldr r12, [r5, #60]", + "str r12, [r0, #60]", + "mov r12, #128", + "str r12, [r6, #64]", + "mov r12, #0", + "str r12, [r6, #68]", + "str r12, [r6, #72]", + "str r12, [r6, #76]", + "str r12, [r6, #80]", + "str r12, [r6, #84]", + "str r12, [r6, #88]", + "str r12, [r6, #92]", + "str r12, [r6, #96]", + "str r12, [r6, #100]", + "str r12, [r6, #104]", + "str r12, [r6, #108]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #112]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #116]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #120]", + "movw r12, #0", + "movt r12, #6", + "str r12, [r6, #124]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", + "mov r6, r7", + "ldr r9, [r0, #0]", + "ldr r10, [r0, #4]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #0]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "ldr r10, [r0, #12]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #8]", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "ldr r10, [r0, #20]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #16]", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "ldr r10, [r0, #28]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #24]", + "str r9, [r6, #28]", + "ldr r9, [r0, #32]", + "ldr r10, [r0, #36]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #32]", + "str r9, [r6, #36]", + "ldr r9, [r0, #40]", + "ldr r10, [r0, #44]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #40]", + "str r9, [r6, #44]", + "ldr r9, [r0, #48]", + "ldr r10, [r0, #52]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #48]", + "str r9, [r6, #52]", + "ldr r9, [r0, #56]", + "ldr r10, [r0, #60]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #56]", + "str r9, [r6, #60]", "ldr r4, [r11, #272]", "ldr r5, [r11, #276]", "ldr r6, [r11, #280]", @@ -193,6 +267,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_finalize(inner: *mut [u8; 192], o "ldr r11, [r11, #304]", "bx lr", vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, - 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 c268b47b7..b93ded54c 100644 --- a/src/asm/arm/hmac_sha512_224.rs +++ b/src/asm/arm/hmac_sha512_224.rs @@ -132,56 +132,152 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_224_finalize(inner: *mut [u8; 192 "str r10, [r12, #296]", "str lr, [r12, #300]", "str r11, [r12, #304]", - "mov r4, r0", "mov r5, r1", - "ldr r6, [sp, #0]", + "ldr r7, [sp, #0]", "mov r11, r12", - "mov r0, r4", - "movw r12, #308", + "movw r12, #372", "add r1, r11, r12", "mov r12, r11", "push {{r1, r12}}", "bl {vg_sha512_finalize}", "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #192", - "20:", - "add r2, r5, r8", - "ldrb r12, [r2, #0]", - "add r2, r4, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "mov r0, r4", - "movw r12, #308", - "add r1, r11, r12", - "movw r7, #28", - "mov r10, r11", - "movw r2, #128", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", - "mov r0, r4", - "movw r2, #156", - "mov r3, #0", + "mov r3, r11", "movw r12, #308", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha512_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #28", - "21:", - "add r2, r11, r8", - "ldrb r12, [r2, #308]", - "add r2, r6, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 21b", + "add r0, r11, r12", + "movw r12, #372", + "add r6, r11, r12", + "ldr r12, [r5, #0]", + "str r12, [r0, #0]", + "ldr r12, [r5, #4]", + "str r12, [r0, #4]", + "ldr r12, [r5, #8]", + "str r12, [r0, #8]", + "ldr r12, [r5, #12]", + "str r12, [r0, #12]", + "ldr r12, [r5, #16]", + "str r12, [r0, #16]", + "ldr r12, [r5, #20]", + "str r12, [r0, #20]", + "ldr r12, [r5, #24]", + "str r12, [r0, #24]", + "ldr r12, [r5, #28]", + "str r12, [r0, #28]", + "ldr r12, [r5, #32]", + "str r12, [r0, #32]", + "ldr r12, [r5, #36]", + "str r12, [r0, #36]", + "ldr r12, [r5, #40]", + "str r12, [r0, #40]", + "ldr r12, [r5, #44]", + "str r12, [r0, #44]", + "ldr r12, [r5, #48]", + "str r12, [r0, #48]", + "ldr r12, [r5, #52]", + "str r12, [r0, #52]", + "ldr r12, [r5, #56]", + "str r12, [r0, #56]", + "ldr r12, [r5, #60]", + "str r12, [r0, #60]", + "mov r12, #128", + "str r12, [r6, #28]", + "mov r12, #0", + "str r12, [r6, #32]", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "str r12, [r6, #56]", + "str r12, [r6, #60]", + "str r12, [r6, #64]", + "str r12, [r6, #68]", + "str r12, [r6, #72]", + "str r12, [r6, #76]", + "str r12, [r6, #80]", + "str r12, [r6, #84]", + "str r12, [r6, #88]", + "str r12, [r6, #92]", + "str r12, [r6, #96]", + "str r12, [r6, #100]", + "str r12, [r6, #104]", + "str r12, [r6, #108]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #112]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #116]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #120]", + "movw r12, #0", + "movt r12, #57348", + "str r12, [r6, #124]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", + "ldr r9, [r0, #0]", + "ldr r10, [r0, #4]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #0]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "ldr r10, [r0, #12]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #8]", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "ldr r10, [r0, #20]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #16]", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "ldr r10, [r0, #28]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #24]", + "str r9, [r6, #28]", + "ldr r9, [r0, #32]", + "ldr r10, [r0, #36]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #32]", + "str r9, [r6, #36]", + "ldr r9, [r0, #40]", + "ldr r10, [r0, #44]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #40]", + "str r9, [r6, #44]", + "ldr r9, [r0, #48]", + "ldr r10, [r0, #52]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #48]", + "str r9, [r6, #52]", + "ldr r9, [r0, #56]", + "ldr r10, [r0, #60]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #56]", + "str r9, [r6, #60]", + "ldr r12, [r6, #0]", + "str r12, [r7, #0]", + "ldr r12, [r6, #4]", + "str r12, [r7, #4]", + "ldr r12, [r6, #8]", + "str r12, [r7, #8]", + "ldr r12, [r6, #12]", + "str r12, [r7, #12]", + "ldr r12, [r6, #16]", + "str r12, [r7, #16]", + "ldr r12, [r6, #20]", + "str r12, [r7, #20]", + "ldr r12, [r6, #24]", + "str r12, [r7, #24]", "ldr r4, [r11, #272]", "ldr r5, [r11, #276]", "ldr r6, [r11, #280]", @@ -193,6 +289,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_224_finalize(inner: *mut [u8; 192 "ldr r11, [r11, #304]", "bx lr", vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, - 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 a620cdd9e..9664a7294 100644 --- a/src/asm/arm/hmac_sha512_256.rs +++ b/src/asm/arm/hmac_sha512_256.rs @@ -132,56 +132,153 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_256_finalize(inner: *mut [u8; 192 "str r10, [r12, #296]", "str lr, [r12, #300]", "str r11, [r12, #304]", - "mov r4, r0", "mov r5, r1", - "ldr r6, [sp, #0]", + "ldr r7, [sp, #0]", "mov r11, r12", - "mov r0, r4", - "movw r12, #308", + "movw r12, #372", "add r1, r11, r12", "mov r12, r11", "push {{r1, r12}}", "bl {vg_sha512_finalize}", "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #192", - "20:", - "add r2, r5, r8", - "ldrb r12, [r2, #0]", - "add r2, r4, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "mov r0, r4", - "movw r12, #308", - "add r1, r11, r12", - "movw r7, #32", - "mov r10, r11", - "movw r2, #128", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", - "mov r0, r4", - "movw r2, #160", - "mov r3, #0", + "mov r3, r11", "movw r12, #308", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha512_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #32", - "21:", - "add r2, r11, r8", - "ldrb r12, [r2, #308]", - "add r2, r6, r8", - "strb r12, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 21b", + "add r0, r11, r12", + "movw r12, #372", + "add r6, r11, r12", + "ldr r12, [r5, #0]", + "str r12, [r0, #0]", + "ldr r12, [r5, #4]", + "str r12, [r0, #4]", + "ldr r12, [r5, #8]", + "str r12, [r0, #8]", + "ldr r12, [r5, #12]", + "str r12, [r0, #12]", + "ldr r12, [r5, #16]", + "str r12, [r0, #16]", + "ldr r12, [r5, #20]", + "str r12, [r0, #20]", + "ldr r12, [r5, #24]", + "str r12, [r0, #24]", + "ldr r12, [r5, #28]", + "str r12, [r0, #28]", + "ldr r12, [r5, #32]", + "str r12, [r0, #32]", + "ldr r12, [r5, #36]", + "str r12, [r0, #36]", + "ldr r12, [r5, #40]", + "str r12, [r0, #40]", + "ldr r12, [r5, #44]", + "str r12, [r0, #44]", + "ldr r12, [r5, #48]", + "str r12, [r0, #48]", + "ldr r12, [r5, #52]", + "str r12, [r0, #52]", + "ldr r12, [r5, #56]", + "str r12, [r0, #56]", + "ldr r12, [r5, #60]", + "str r12, [r0, #60]", + "mov r12, #128", + "str r12, [r6, #32]", + "mov r12, #0", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "str r12, [r6, #56]", + "str r12, [r6, #60]", + "str r12, [r6, #64]", + "str r12, [r6, #68]", + "str r12, [r6, #72]", + "str r12, [r6, #76]", + "str r12, [r6, #80]", + "str r12, [r6, #84]", + "str r12, [r6, #88]", + "str r12, [r6, #92]", + "str r12, [r6, #96]", + "str r12, [r6, #100]", + "str r12, [r6, #104]", + "str r12, [r6, #108]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #112]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #116]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #120]", + "movw r12, #0", + "movt r12, #5", + "str r12, [r6, #124]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", + "ldr r9, [r0, #0]", + "ldr r10, [r0, #4]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #0]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "ldr r10, [r0, #12]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #8]", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "ldr r10, [r0, #20]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #16]", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "ldr r10, [r0, #28]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #24]", + "str r9, [r6, #28]", + "ldr r9, [r0, #32]", + "ldr r10, [r0, #36]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #32]", + "str r9, [r6, #36]", + "ldr r9, [r0, #40]", + "ldr r10, [r0, #44]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #40]", + "str r9, [r6, #44]", + "ldr r9, [r0, #48]", + "ldr r10, [r0, #52]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #48]", + "str r9, [r6, #52]", + "ldr r9, [r0, #56]", + "ldr r10, [r0, #60]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #56]", + "str r9, [r6, #60]", + "ldr r12, [r6, #0]", + "str r12, [r7, #0]", + "ldr r12, [r6, #4]", + "str r12, [r7, #4]", + "ldr r12, [r6, #8]", + "str r12, [r7, #8]", + "ldr r12, [r6, #12]", + "str r12, [r7, #12]", + "ldr r12, [r6, #16]", + "str r12, [r7, #16]", + "ldr r12, [r6, #20]", + "str r12, [r7, #20]", + "ldr r12, [r6, #24]", + "str r12, [r7, #24]", + "ldr r12, [r6, #28]", + "str r12, [r7, #28]", "ldr r4, [r11, #272]", "ldr r5, [r11, #276]", "ldr r6, [r11, #280]", @@ -193,6 +290,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_256_finalize(inner: *mut [u8; 192 "ldr r11, [r11, #304]", "bx lr", vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, - vg_sha512_update = sym super::sha512::vg_sha512_update, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/arm/pbkdf2_md5.rs b/src/asm/arm/pbkdf2_md5.rs index 3afed2406..2add278cf 100644 --- a/src/asm/arm/pbkdf2_md5.rs +++ b/src/asm/arm/pbkdf2_md5.rs @@ -28,102 +28,103 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_md5_iterate(key: *const [u8; 160] "str r10, [r12, #136]", "str lr, [r12, #140]", "str r11, [r12, #144]", - "mov r4, r0", - "mov r5, r3", - "mov r6, r2", "mov r11, r12", - "mov r8, #0", - "movw r9, #16", - "20:", - "add r2, r1, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #244]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "cmp r6, #0", - "beq 21f", - "23:", - "mov r8, #0", - "movw r9, #80", - "24:", - "add r2, r4, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #148]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 24b", - "movw r12, #148", - "add r0, r11, r12", - "movw r12, #244", - "add r1, r11, r12", - "movw r7, #16", - "mov r10, r11", - "movw r2, #64", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_md5_update}", - "ldr r1, [sp], #16", - "movw r12, #148", - "add r0, r11, r12", - "movw r2, #80", - "mov r3, #0", - "movw r12, #228", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_md5_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #80", - "25:", - "add r2, r4, r8", - "ldrb r12, [r2, #80]", - "add r2, r11, r8", - "strb r12, [r2, #148]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "movw r12, #148", - "add r0, r11, r12", - "movw r12, #228", - "add r1, r11, r12", - "movw r7, #16", - "mov r10, r11", - "movw r2, #64", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_md5_update}", - "ldr r1, [sp], #16", + "mov r7, r3", + "mov r3, r12", + "mov r4, r0", + "mov r5, r2", "movw r12, #148", "add r0, r11, r12", - "movw r2, #80", - "mov r3, #0", - "movw r12, #244", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_md5_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #16", - "26:", - "add r2, r11, r8", - "ldrb r12, [r2, #244]", - "add r2, r5, r8", - "ldrb r1, [r2, #0]", - "eor r1, r1, r12", - "strb r1, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 26b", - "subs r6, r6, #1", - "bne 23b", - "b 22f", - "21:", + "movw r12, #164", + "add r6, r11, r12", + "ldr r12, [r1, #0]", + "str r12, [r6, #0]", + "ldr r12, [r1, #4]", + "str r12, [r6, #4]", + "ldr r12, [r1, #8]", + "str r12, [r6, #8]", + "ldr r12, [r1, #12]", + "str r12, [r6, #12]", + "mov r12, #128", + "str r12, [r6, #16]", + "mov r12, #0", + "str r12, [r6, #20]", + "str r12, [r6, #24]", + "str r12, [r6, #28]", + "str r12, [r6, #32]", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "movw r12, #640", + "movt r12, #0", + "str r12, [r6, #56]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #60]", + "cmp r5, #0", + "beq 20f", "22:", + "ldr r12, [r4, #0]", + "str r12, [r0, #0]", + "ldr r12, [r4, #4]", + "str r12, [r0, #4]", + "ldr r12, [r4, #8]", + "str r12, [r0, #8]", + "ldr r12, [r4, #12]", + "str r12, [r0, #12]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_md5_compress}", + "ldr r9, [r0, #0]", + "str r9, [r6, #0]", + "ldr r9, [r0, #4]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "str r9, [r6, #8]", + "ldr r9, [r0, #12]", + "str r9, [r6, #12]", + "ldr r12, [r4, #80]", + "str r12, [r0, #0]", + "ldr r12, [r4, #84]", + "str r12, [r0, #4]", + "ldr r12, [r4, #88]", + "str r12, [r0, #8]", + "ldr r12, [r4, #92]", + "str r12, [r0, #12]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_md5_compress}", + "ldr r9, [r0, #0]", + "str r9, [r6, #0]", + "ldr r9, [r0, #4]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "str r9, [r6, #8]", + "ldr r9, [r0, #12]", + "str r9, [r6, #12]", + "ldr r12, [r6, #0]", + "ldr r1, [r7, #0]", + "eor r12, r12, r1", + "str r12, [r7, #0]", + "ldr r12, [r6, #4]", + "ldr r1, [r7, #4]", + "eor r12, r12, r1", + "str r12, [r7, #4]", + "ldr r12, [r6, #8]", + "ldr r1, [r7, #8]", + "eor r12, r12, r1", + "str r12, [r7, #8]", + "ldr r12, [r6, #12]", + "ldr r1, [r7, #12]", + "eor r12, r12, r1", + "str r12, [r7, #12]", + "subs r5, r5, #1", + "bne 22b", + "b 21f", + "20:", + "21:", "ldr r4, [r11, #112]", "ldr r5, [r11, #116]", "ldr r6, [r11, #120]", @@ -134,8 +135,7 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_md5_iterate(key: *const [u8; 160] "ldr lr, [r11, #140]", "ldr r11, [r11, #144]", "bx lr", - vg_md5_update = sym super::md5::vg_md5_update, - vg_md5_finalize = sym super::md5::vg_md5_finalize, + vg_md5_compress = sym super::md5::vg_md5_compress, ) } diff --git a/src/asm/arm/pbkdf2_sha1.rs b/src/asm/arm/pbkdf2_sha1.rs index ecb7f9c4a..d80332a95 100644 --- a/src/asm/arm/pbkdf2_sha1.rs +++ b/src/asm/arm/pbkdf2_sha1.rs @@ -28,102 +28,126 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha1_iterate(key: *const [u8; 168 "str r10, [r12, #184]", "str lr, [r12, #188]", "str r11, [r12, #192]", - "mov r4, r0", - "mov r5, r3", - "mov r6, r2", "mov r11, r12", - "mov r8, #0", - "movw r9, #20", - "20:", - "add r2, r1, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #300]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "cmp r6, #0", - "beq 21f", - "23:", - "mov r8, #0", - "movw r9, #84", - "24:", - "add r2, r4, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #196]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 24b", - "movw r12, #196", - "add r0, r11, r12", - "movw r12, #300", - "add r1, r11, r12", - "movw r7, #20", - "mov r10, r11", - "movw r2, #64", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha1_update}", - "ldr r1, [sp], #16", - "movw r12, #196", - "add r0, r11, r12", - "movw r2, #84", - "mov r3, #0", - "movw r12, #280", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha1_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #84", - "25:", - "add r2, r4, r8", - "ldrb r12, [r2, #84]", - "add r2, r11, r8", - "strb r12, [r2, #196]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "movw r12, #196", - "add r0, r11, r12", - "movw r12, #280", - "add r1, r11, r12", - "movw r7, #20", - "mov r10, r11", - "movw r2, #64", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha1_update}", - "ldr r1, [sp], #16", + "mov r7, r3", + "mov r3, r12", + "mov r4, r0", + "mov r5, r2", "movw r12, #196", "add r0, r11, r12", - "movw r2, #84", - "mov r3, #0", - "movw r12, #300", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha1_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #20", - "26:", - "add r2, r11, r8", - "ldrb r12, [r2, #300]", - "add r2, r5, r8", - "ldrb r1, [r2, #0]", - "eor r1, r1, r12", - "strb r1, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 26b", - "subs r6, r6, #1", - "bne 23b", - "b 22f", - "21:", + "movw r12, #216", + "add r6, r11, r12", + "ldr r12, [r1, #0]", + "str r12, [r6, #0]", + "ldr r12, [r1, #4]", + "str r12, [r6, #4]", + "ldr r12, [r1, #8]", + "str r12, [r6, #8]", + "ldr r12, [r1, #12]", + "str r12, [r6, #12]", + "ldr r12, [r1, #16]", + "str r12, [r6, #16]", + "mov r12, #128", + "str r12, [r6, #20]", + "mov r12, #0", + "str r12, [r6, #24]", + "str r12, [r6, #28]", + "str r12, [r6, #32]", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #56]", + "movw r12, #0", + "movt r12, #40962", + "str r12, [r6, #60]", + "cmp r5, #0", + "beq 20f", "22:", + "ldr r12, [r4, #0]", + "str r12, [r0, #0]", + "ldr r12, [r4, #4]", + "str r12, [r0, #4]", + "ldr r12, [r4, #8]", + "str r12, [r0, #8]", + "ldr r12, [r4, #12]", + "str r12, [r0, #12]", + "ldr r12, [r4, #16]", + "str r12, [r0, #16]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha1_compress}", + "ldr r9, [r0, #0]", + "rev r9, r9", + "str r9, [r6, #0]", + "ldr r9, [r0, #4]", + "rev r9, r9", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "rev r9, r9", + "str r9, [r6, #8]", + "ldr r9, [r0, #12]", + "rev r9, r9", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "rev r9, r9", + "str r9, [r6, #16]", + "ldr r12, [r4, #84]", + "str r12, [r0, #0]", + "ldr r12, [r4, #88]", + "str r12, [r0, #4]", + "ldr r12, [r4, #92]", + "str r12, [r0, #8]", + "ldr r12, [r4, #96]", + "str r12, [r0, #12]", + "ldr r12, [r4, #100]", + "str r12, [r0, #16]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha1_compress}", + "ldr r9, [r0, #0]", + "rev r9, r9", + "str r9, [r6, #0]", + "ldr r9, [r0, #4]", + "rev r9, r9", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "rev r9, r9", + "str r9, [r6, #8]", + "ldr r9, [r0, #12]", + "rev r9, r9", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "rev r9, r9", + "str r9, [r6, #16]", + "ldr r12, [r6, #0]", + "ldr r1, [r7, #0]", + "eor r12, r12, r1", + "str r12, [r7, #0]", + "ldr r12, [r6, #4]", + "ldr r1, [r7, #4]", + "eor r12, r12, r1", + "str r12, [r7, #4]", + "ldr r12, [r6, #8]", + "ldr r1, [r7, #8]", + "eor r12, r12, r1", + "str r12, [r7, #8]", + "ldr r12, [r6, #12]", + "ldr r1, [r7, #12]", + "eor r12, r12, r1", + "str r12, [r7, #12]", + "ldr r12, [r6, #16]", + "ldr r1, [r7, #16]", + "eor r12, r12, r1", + "str r12, [r7, #16]", + "subs r5, r5, #1", + "bne 22b", + "b 21f", + "20:", + "21:", "ldr r4, [r11, #160]", "ldr r5, [r11, #164]", "ldr r6, [r11, #168]", @@ -134,8 +158,7 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha1_iterate(key: *const [u8; 168 "ldr lr, [r11, #188]", "ldr r11, [r11, #192]", "bx lr", - vg_sha1_update = sym super::sha1::vg_sha1_update, - vg_sha1_finalize = sym super::sha1::vg_sha1_finalize, + vg_sha1_compress = sym super::sha1::vg_sha1_compress, ) } diff --git a/src/asm/arm/pbkdf2_sha224.rs b/src/asm/arm/pbkdf2_sha224.rs index 87edf2bf8..acc1fc608 100644 --- a/src/asm/arm/pbkdf2_sha224.rs +++ b/src/asm/arm/pbkdf2_sha224.rs @@ -28,102 +28,172 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha224_iterate(key: *const [u8; 1 "str r10, [r12, #184]", "str lr, [r12, #188]", "str r11, [r12, #192]", - "mov r4, r0", - "mov r5, r3", - "mov r6, r2", "mov r11, r12", - "mov r8, #0", - "movw r9, #28", - "20:", - "add r2, r1, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #324]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "cmp r6, #0", - "beq 21f", - "23:", - "mov r8, #0", - "movw r9, #96", - "24:", - "add r2, r4, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #196]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 24b", - "movw r12, #196", - "add r0, r11, r12", - "movw r12, #324", - "add r1, r11, r12", - "movw r7, #28", - "mov r10, r11", - "movw r2, #64", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha256_update}", - "ldr r1, [sp], #16", - "movw r12, #196", - "add r0, r11, r12", - "movw r2, #92", - "mov r3, #0", - "movw r12, #292", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha256_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #96", - "25:", - "add r2, r4, r8", - "ldrb r12, [r2, #96]", - "add r2, r11, r8", - "strb r12, [r2, #196]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "movw r12, #196", - "add r0, r11, r12", - "movw r12, #292", - "add r1, r11, r12", - "movw r7, #28", - "mov r10, r11", - "movw r2, #64", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha256_update}", - "ldr r1, [sp], #16", + "mov r7, r3", + "mov r3, r12", + "mov r4, r0", + "mov r5, r2", "movw r12, #196", "add r0, r11, r12", - "movw r2, #92", - "mov r3, #0", - "movw r12, #324", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha256_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #28", - "26:", - "add r2, r11, r8", - "ldrb r12, [r2, #324]", - "add r2, r5, r8", - "ldrb r1, [r2, #0]", - "eor r1, r1, r12", - "strb r1, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 26b", - "subs r6, r6, #1", - "bne 23b", - "b 22f", - "21:", + "movw r12, #228", + "add r6, r11, r12", + "ldr r12, [r1, #0]", + "str r12, [r6, #0]", + "ldr r12, [r1, #4]", + "str r12, [r6, #4]", + "ldr r12, [r1, #8]", + "str r12, [r6, #8]", + "ldr r12, [r1, #12]", + "str r12, [r6, #12]", + "ldr r12, [r1, #16]", + "str r12, [r6, #16]", + "ldr r12, [r1, #20]", + "str r12, [r6, #20]", + "ldr r12, [r1, #24]", + "str r12, [r6, #24]", + "mov r12, #128", + "str r12, [r6, #28]", + "mov r12, #0", + "str r12, [r6, #32]", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #56]", + "movw r12, #0", + "movt r12, #57346", + "str r12, [r6, #60]", + "cmp r5, #0", + "beq 20f", "22:", + "ldr r12, [r4, #0]", + "str r12, [r0, #0]", + "ldr r12, [r4, #4]", + "str r12, [r0, #4]", + "ldr r12, [r4, #8]", + "str r12, [r0, #8]", + "ldr r12, [r4, #12]", + "str r12, [r0, #12]", + "ldr r12, [r4, #16]", + "str r12, [r0, #16]", + "ldr r12, [r4, #20]", + "str r12, [r0, #20]", + "ldr r12, [r4, #24]", + "str r12, [r0, #24]", + "ldr r12, [r4, #28]", + "str r12, [r0, #28]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha256_compress}", + "ldr r9, [r0, #0]", + "rev r9, r9", + "str r9, [r6, #0]", + "ldr r9, [r0, #4]", + "rev r9, r9", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "rev r9, r9", + "str r9, [r6, #8]", + "ldr r9, [r0, #12]", + "rev r9, r9", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "rev r9, r9", + "str r9, [r6, #16]", + "ldr r9, [r0, #20]", + "rev r9, r9", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "rev r9, r9", + "str r9, [r6, #24]", + "ldr r9, [r0, #28]", + "rev r9, r9", + "str r9, [r6, #28]", + "mov r12, #128", + "str r12, [r6, #28]", + "mov r12, #0", + "ldr r12, [r4, #96]", + "str r12, [r0, #0]", + "ldr r12, [r4, #100]", + "str r12, [r0, #4]", + "ldr r12, [r4, #104]", + "str r12, [r0, #8]", + "ldr r12, [r4, #108]", + "str r12, [r0, #12]", + "ldr r12, [r4, #112]", + "str r12, [r0, #16]", + "ldr r12, [r4, #116]", + "str r12, [r0, #20]", + "ldr r12, [r4, #120]", + "str r12, [r0, #24]", + "ldr r12, [r4, #124]", + "str r12, [r0, #28]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha256_compress}", + "ldr r9, [r0, #0]", + "rev r9, r9", + "str r9, [r6, #0]", + "ldr r9, [r0, #4]", + "rev r9, r9", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "rev r9, r9", + "str r9, [r6, #8]", + "ldr r9, [r0, #12]", + "rev r9, r9", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "rev r9, r9", + "str r9, [r6, #16]", + "ldr r9, [r0, #20]", + "rev r9, r9", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "rev r9, r9", + "str r9, [r6, #24]", + "ldr r9, [r0, #28]", + "rev r9, r9", + "str r9, [r6, #28]", + "mov r12, #128", + "str r12, [r6, #28]", + "mov r12, #0", + "ldr r12, [r6, #0]", + "ldr r1, [r7, #0]", + "eor r12, r12, r1", + "str r12, [r7, #0]", + "ldr r12, [r6, #4]", + "ldr r1, [r7, #4]", + "eor r12, r12, r1", + "str r12, [r7, #4]", + "ldr r12, [r6, #8]", + "ldr r1, [r7, #8]", + "eor r12, r12, r1", + "str r12, [r7, #8]", + "ldr r12, [r6, #12]", + "ldr r1, [r7, #12]", + "eor r12, r12, r1", + "str r12, [r7, #12]", + "ldr r12, [r6, #16]", + "ldr r1, [r7, #16]", + "eor r12, r12, r1", + "str r12, [r7, #16]", + "ldr r12, [r6, #20]", + "ldr r1, [r7, #20]", + "eor r12, r12, r1", + "str r12, [r7, #20]", + "ldr r12, [r6, #24]", + "ldr r1, [r7, #24]", + "eor r12, r12, r1", + "str r12, [r7, #24]", + "subs r5, r5, #1", + "bne 22b", + "b 21f", + "20:", + "21:", "ldr r4, [r11, #160]", "ldr r5, [r11, #164]", "ldr r6, [r11, #168]", @@ -134,8 +204,7 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha224_iterate(key: *const [u8; 1 "ldr lr, [r11, #188]", "ldr r11, [r11, #192]", "bx lr", - vg_sha256_update = sym super::sha256::vg_sha256_update, - vg_sha256_finalize = sym super::sha256::vg_sha256_finalize, + vg_sha256_compress = sym super::sha256::vg_sha256_compress, ) } diff --git a/src/asm/arm/pbkdf2_sha384.rs b/src/asm/arm/pbkdf2_sha384.rs index 02371c729..acbaf7a19 100644 --- a/src/asm/arm/pbkdf2_sha384.rs +++ b/src/asm/arm/pbkdf2_sha384.rs @@ -28,102 +28,303 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha384_iterate(key: *const [u8; 3 "str r10, [r12, #296]", "str lr, [r12, #300]", "str r11, [r12, #304]", - "mov r4, r0", - "mov r5, r3", - "mov r6, r2", "mov r11, r12", - "mov r8, #0", - "movw r9, #48", - "20:", - "add r2, r1, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #564]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "cmp r6, #0", - "beq 21f", - "23:", - "mov r8, #0", - "movw r9, #192", - "24:", - "add r2, r4, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #308]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 24b", - "movw r12, #308", - "add r0, r11, r12", - "movw r12, #564", - "add r1, r11, r12", - "movw r7, #48", - "mov r10, r11", - "movw r2, #128", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", - "movw r12, #308", - "add r0, r11, r12", - "movw r2, #176", - "mov r3, #0", - "movw r12, #500", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha512_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #192", - "25:", - "add r2, r4, r8", - "ldrb r12, [r2, #192]", - "add r2, r11, r8", - "strb r12, [r2, #308]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "movw r12, #308", - "add r0, r11, r12", - "movw r12, #500", - "add r1, r11, r12", - "movw r7, #48", - "mov r10, r11", - "movw r2, #128", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", + "mov r7, r3", + "mov r3, r12", + "mov r4, r0", + "mov r5, r2", "movw r12, #308", "add r0, r11, r12", - "movw r2, #176", - "mov r3, #0", - "movw r12, #564", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha512_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #48", - "26:", - "add r2, r11, r8", - "ldrb r12, [r2, #564]", - "add r2, r5, r8", - "ldrb r1, [r2, #0]", - "eor r1, r1, r12", - "strb r1, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 26b", - "subs r6, r6, #1", - "bne 23b", - "b 22f", - "21:", + "movw r12, #372", + "add r6, r11, r12", + "ldr r12, [r1, #0]", + "str r12, [r6, #0]", + "ldr r12, [r1, #4]", + "str r12, [r6, #4]", + "ldr r12, [r1, #8]", + "str r12, [r6, #8]", + "ldr r12, [r1, #12]", + "str r12, [r6, #12]", + "ldr r12, [r1, #16]", + "str r12, [r6, #16]", + "ldr r12, [r1, #20]", + "str r12, [r6, #20]", + "ldr r12, [r1, #24]", + "str r12, [r6, #24]", + "ldr r12, [r1, #28]", + "str r12, [r6, #28]", + "ldr r12, [r1, #32]", + "str r12, [r6, #32]", + "ldr r12, [r1, #36]", + "str r12, [r6, #36]", + "ldr r12, [r1, #40]", + "str r12, [r6, #40]", + "ldr r12, [r1, #44]", + "str r12, [r6, #44]", + "mov r12, #128", + "str r12, [r6, #48]", + "mov r12, #0", + "str r12, [r6, #52]", + "str r12, [r6, #56]", + "str r12, [r6, #60]", + "str r12, [r6, #64]", + "str r12, [r6, #68]", + "str r12, [r6, #72]", + "str r12, [r6, #76]", + "str r12, [r6, #80]", + "str r12, [r6, #84]", + "str r12, [r6, #88]", + "str r12, [r6, #92]", + "str r12, [r6, #96]", + "str r12, [r6, #100]", + "str r12, [r6, #104]", + "str r12, [r6, #108]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #112]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #116]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #120]", + "movw r12, #0", + "movt r12, #32773", + "str r12, [r6, #124]", + "cmp r5, #0", + "beq 20f", "22:", + "ldr r12, [r4, #0]", + "str r12, [r0, #0]", + "ldr r12, [r4, #4]", + "str r12, [r0, #4]", + "ldr r12, [r4, #8]", + "str r12, [r0, #8]", + "ldr r12, [r4, #12]", + "str r12, [r0, #12]", + "ldr r12, [r4, #16]", + "str r12, [r0, #16]", + "ldr r12, [r4, #20]", + "str r12, [r0, #20]", + "ldr r12, [r4, #24]", + "str r12, [r0, #24]", + "ldr r12, [r4, #28]", + "str r12, [r0, #28]", + "ldr r12, [r4, #32]", + "str r12, [r0, #32]", + "ldr r12, [r4, #36]", + "str r12, [r0, #36]", + "ldr r12, [r4, #40]", + "str r12, [r0, #40]", + "ldr r12, [r4, #44]", + "str r12, [r0, #44]", + "ldr r12, [r4, #48]", + "str r12, [r0, #48]", + "ldr r12, [r4, #52]", + "str r12, [r0, #52]", + "ldr r12, [r4, #56]", + "str r12, [r0, #56]", + "ldr r12, [r4, #60]", + "str r12, [r0, #60]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", + "ldr r9, [r0, #0]", + "ldr r10, [r0, #4]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #0]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "ldr r10, [r0, #12]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #8]", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "ldr r10, [r0, #20]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #16]", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "ldr r10, [r0, #28]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #24]", + "str r9, [r6, #28]", + "ldr r9, [r0, #32]", + "ldr r10, [r0, #36]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #32]", + "str r9, [r6, #36]", + "ldr r9, [r0, #40]", + "ldr r10, [r0, #44]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #40]", + "str r9, [r6, #44]", + "ldr r9, [r0, #48]", + "ldr r10, [r0, #52]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #48]", + "str r9, [r6, #52]", + "ldr r9, [r0, #56]", + "ldr r10, [r0, #60]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #56]", + "str r9, [r6, #60]", + "mov r12, #128", + "str r12, [r6, #48]", + "mov r12, #0", + "str r12, [r6, #52]", + "str r12, [r6, #56]", + "str r12, [r6, #60]", + "ldr r12, [r4, #192]", + "str r12, [r0, #0]", + "ldr r12, [r4, #196]", + "str r12, [r0, #4]", + "ldr r12, [r4, #200]", + "str r12, [r0, #8]", + "ldr r12, [r4, #204]", + "str r12, [r0, #12]", + "ldr r12, [r4, #208]", + "str r12, [r0, #16]", + "ldr r12, [r4, #212]", + "str r12, [r0, #20]", + "ldr r12, [r4, #216]", + "str r12, [r0, #24]", + "ldr r12, [r4, #220]", + "str r12, [r0, #28]", + "ldr r12, [r4, #224]", + "str r12, [r0, #32]", + "ldr r12, [r4, #228]", + "str r12, [r0, #36]", + "ldr r12, [r4, #232]", + "str r12, [r0, #40]", + "ldr r12, [r4, #236]", + "str r12, [r0, #44]", + "ldr r12, [r4, #240]", + "str r12, [r0, #48]", + "ldr r12, [r4, #244]", + "str r12, [r0, #52]", + "ldr r12, [r4, #248]", + "str r12, [r0, #56]", + "ldr r12, [r4, #252]", + "str r12, [r0, #60]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", + "ldr r9, [r0, #0]", + "ldr r10, [r0, #4]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #0]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "ldr r10, [r0, #12]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #8]", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "ldr r10, [r0, #20]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #16]", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "ldr r10, [r0, #28]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #24]", + "str r9, [r6, #28]", + "ldr r9, [r0, #32]", + "ldr r10, [r0, #36]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #32]", + "str r9, [r6, #36]", + "ldr r9, [r0, #40]", + "ldr r10, [r0, #44]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #40]", + "str r9, [r6, #44]", + "ldr r9, [r0, #48]", + "ldr r10, [r0, #52]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #48]", + "str r9, [r6, #52]", + "ldr r9, [r0, #56]", + "ldr r10, [r0, #60]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #56]", + "str r9, [r6, #60]", + "mov r12, #128", + "str r12, [r6, #48]", + "mov r12, #0", + "str r12, [r6, #52]", + "str r12, [r6, #56]", + "str r12, [r6, #60]", + "ldr r12, [r6, #0]", + "ldr r1, [r7, #0]", + "eor r12, r12, r1", + "str r12, [r7, #0]", + "ldr r12, [r6, #4]", + "ldr r1, [r7, #4]", + "eor r12, r12, r1", + "str r12, [r7, #4]", + "ldr r12, [r6, #8]", + "ldr r1, [r7, #8]", + "eor r12, r12, r1", + "str r12, [r7, #8]", + "ldr r12, [r6, #12]", + "ldr r1, [r7, #12]", + "eor r12, r12, r1", + "str r12, [r7, #12]", + "ldr r12, [r6, #16]", + "ldr r1, [r7, #16]", + "eor r12, r12, r1", + "str r12, [r7, #16]", + "ldr r12, [r6, #20]", + "ldr r1, [r7, #20]", + "eor r12, r12, r1", + "str r12, [r7, #20]", + "ldr r12, [r6, #24]", + "ldr r1, [r7, #24]", + "eor r12, r12, r1", + "str r12, [r7, #24]", + "ldr r12, [r6, #28]", + "ldr r1, [r7, #28]", + "eor r12, r12, r1", + "str r12, [r7, #28]", + "ldr r12, [r6, #32]", + "ldr r1, [r7, #32]", + "eor r12, r12, r1", + "str r12, [r7, #32]", + "ldr r12, [r6, #36]", + "ldr r1, [r7, #36]", + "eor r12, r12, r1", + "str r12, [r7, #36]", + "ldr r12, [r6, #40]", + "ldr r1, [r7, #40]", + "eor r12, r12, r1", + "str r12, [r7, #40]", + "ldr r12, [r6, #44]", + "ldr r1, [r7, #44]", + "eor r12, r12, r1", + "str r12, [r7, #44]", + "subs r5, r5, #1", + "bne 22b", + "b 21f", + "20:", + "21:", "ldr r4, [r11, #272]", "ldr r5, [r11, #276]", "ldr r6, [r11, #280]", @@ -134,8 +335,7 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha384_iterate(key: *const [u8; 3 "ldr lr, [r11, #300]", "ldr r11, [r11, #304]", "bx lr", - vg_sha512_update = sym super::sha512::vg_sha512_update, - vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/arm/pbkdf2_sha512.rs b/src/asm/arm/pbkdf2_sha512.rs index a11d494cf..cc3e06cef 100644 --- a/src/asm/arm/pbkdf2_sha512.rs +++ b/src/asm/arm/pbkdf2_sha512.rs @@ -28,102 +28,311 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha512_iterate(key: *const [u8; 3 "str r10, [r12, #296]", "str lr, [r12, #300]", "str r11, [r12, #304]", - "mov r4, r0", - "mov r5, r3", - "mov r6, r2", "mov r11, r12", - "mov r8, #0", - "movw r9, #64", - "20:", - "add r2, r1, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #564]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "cmp r6, #0", - "beq 21f", - "23:", - "mov r8, #0", - "movw r9, #192", - "24:", - "add r2, r4, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #308]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 24b", - "movw r12, #308", - "add r0, r11, r12", - "movw r12, #564", - "add r1, r11, r12", - "movw r7, #64", - "mov r10, r11", - "movw r2, #128", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", - "movw r12, #308", - "add r0, r11, r12", - "movw r2, #192", - "mov r3, #0", - "movw r12, #500", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha512_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #192", - "25:", - "add r2, r4, r8", - "ldrb r12, [r2, #192]", - "add r2, r11, r8", - "strb r12, [r2, #308]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "movw r12, #308", - "add r0, r11, r12", - "movw r12, #500", - "add r1, r11, r12", - "movw r7, #64", - "mov r10, r11", - "movw r2, #128", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", + "mov r7, r3", + "mov r3, r12", + "mov r4, r0", + "mov r5, r2", "movw r12, #308", "add r0, r11, r12", - "movw r2, #192", - "mov r3, #0", - "movw r12, #564", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha512_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #64", - "26:", - "add r2, r11, r8", - "ldrb r12, [r2, #564]", - "add r2, r5, r8", - "ldrb r1, [r2, #0]", - "eor r1, r1, r12", - "strb r1, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 26b", - "subs r6, r6, #1", - "bne 23b", - "b 22f", - "21:", + "movw r12, #372", + "add r6, r11, r12", + "ldr r12, [r1, #0]", + "str r12, [r6, #0]", + "ldr r12, [r1, #4]", + "str r12, [r6, #4]", + "ldr r12, [r1, #8]", + "str r12, [r6, #8]", + "ldr r12, [r1, #12]", + "str r12, [r6, #12]", + "ldr r12, [r1, #16]", + "str r12, [r6, #16]", + "ldr r12, [r1, #20]", + "str r12, [r6, #20]", + "ldr r12, [r1, #24]", + "str r12, [r6, #24]", + "ldr r12, [r1, #28]", + "str r12, [r6, #28]", + "ldr r12, [r1, #32]", + "str r12, [r6, #32]", + "ldr r12, [r1, #36]", + "str r12, [r6, #36]", + "ldr r12, [r1, #40]", + "str r12, [r6, #40]", + "ldr r12, [r1, #44]", + "str r12, [r6, #44]", + "ldr r12, [r1, #48]", + "str r12, [r6, #48]", + "ldr r12, [r1, #52]", + "str r12, [r6, #52]", + "ldr r12, [r1, #56]", + "str r12, [r6, #56]", + "ldr r12, [r1, #60]", + "str r12, [r6, #60]", + "mov r12, #128", + "str r12, [r6, #64]", + "mov r12, #0", + "str r12, [r6, #68]", + "str r12, [r6, #72]", + "str r12, [r6, #76]", + "str r12, [r6, #80]", + "str r12, [r6, #84]", + "str r12, [r6, #88]", + "str r12, [r6, #92]", + "str r12, [r6, #96]", + "str r12, [r6, #100]", + "str r12, [r6, #104]", + "str r12, [r6, #108]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #112]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #116]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #120]", + "movw r12, #0", + "movt r12, #6", + "str r12, [r6, #124]", + "cmp r5, #0", + "beq 20f", "22:", + "ldr r12, [r4, #0]", + "str r12, [r0, #0]", + "ldr r12, [r4, #4]", + "str r12, [r0, #4]", + "ldr r12, [r4, #8]", + "str r12, [r0, #8]", + "ldr r12, [r4, #12]", + "str r12, [r0, #12]", + "ldr r12, [r4, #16]", + "str r12, [r0, #16]", + "ldr r12, [r4, #20]", + "str r12, [r0, #20]", + "ldr r12, [r4, #24]", + "str r12, [r0, #24]", + "ldr r12, [r4, #28]", + "str r12, [r0, #28]", + "ldr r12, [r4, #32]", + "str r12, [r0, #32]", + "ldr r12, [r4, #36]", + "str r12, [r0, #36]", + "ldr r12, [r4, #40]", + "str r12, [r0, #40]", + "ldr r12, [r4, #44]", + "str r12, [r0, #44]", + "ldr r12, [r4, #48]", + "str r12, [r0, #48]", + "ldr r12, [r4, #52]", + "str r12, [r0, #52]", + "ldr r12, [r4, #56]", + "str r12, [r0, #56]", + "ldr r12, [r4, #60]", + "str r12, [r0, #60]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", + "ldr r9, [r0, #0]", + "ldr r10, [r0, #4]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #0]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "ldr r10, [r0, #12]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #8]", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "ldr r10, [r0, #20]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #16]", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "ldr r10, [r0, #28]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #24]", + "str r9, [r6, #28]", + "ldr r9, [r0, #32]", + "ldr r10, [r0, #36]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #32]", + "str r9, [r6, #36]", + "ldr r9, [r0, #40]", + "ldr r10, [r0, #44]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #40]", + "str r9, [r6, #44]", + "ldr r9, [r0, #48]", + "ldr r10, [r0, #52]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #48]", + "str r9, [r6, #52]", + "ldr r9, [r0, #56]", + "ldr r10, [r0, #60]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #56]", + "str r9, [r6, #60]", + "ldr r12, [r4, #192]", + "str r12, [r0, #0]", + "ldr r12, [r4, #196]", + "str r12, [r0, #4]", + "ldr r12, [r4, #200]", + "str r12, [r0, #8]", + "ldr r12, [r4, #204]", + "str r12, [r0, #12]", + "ldr r12, [r4, #208]", + "str r12, [r0, #16]", + "ldr r12, [r4, #212]", + "str r12, [r0, #20]", + "ldr r12, [r4, #216]", + "str r12, [r0, #24]", + "ldr r12, [r4, #220]", + "str r12, [r0, #28]", + "ldr r12, [r4, #224]", + "str r12, [r0, #32]", + "ldr r12, [r4, #228]", + "str r12, [r0, #36]", + "ldr r12, [r4, #232]", + "str r12, [r0, #40]", + "ldr r12, [r4, #236]", + "str r12, [r0, #44]", + "ldr r12, [r4, #240]", + "str r12, [r0, #48]", + "ldr r12, [r4, #244]", + "str r12, [r0, #52]", + "ldr r12, [r4, #248]", + "str r12, [r0, #56]", + "ldr r12, [r4, #252]", + "str r12, [r0, #60]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", + "ldr r9, [r0, #0]", + "ldr r10, [r0, #4]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #0]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "ldr r10, [r0, #12]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #8]", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "ldr r10, [r0, #20]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #16]", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "ldr r10, [r0, #28]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #24]", + "str r9, [r6, #28]", + "ldr r9, [r0, #32]", + "ldr r10, [r0, #36]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #32]", + "str r9, [r6, #36]", + "ldr r9, [r0, #40]", + "ldr r10, [r0, #44]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #40]", + "str r9, [r6, #44]", + "ldr r9, [r0, #48]", + "ldr r10, [r0, #52]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #48]", + "str r9, [r6, #52]", + "ldr r9, [r0, #56]", + "ldr r10, [r0, #60]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #56]", + "str r9, [r6, #60]", + "ldr r12, [r6, #0]", + "ldr r1, [r7, #0]", + "eor r12, r12, r1", + "str r12, [r7, #0]", + "ldr r12, [r6, #4]", + "ldr r1, [r7, #4]", + "eor r12, r12, r1", + "str r12, [r7, #4]", + "ldr r12, [r6, #8]", + "ldr r1, [r7, #8]", + "eor r12, r12, r1", + "str r12, [r7, #8]", + "ldr r12, [r6, #12]", + "ldr r1, [r7, #12]", + "eor r12, r12, r1", + "str r12, [r7, #12]", + "ldr r12, [r6, #16]", + "ldr r1, [r7, #16]", + "eor r12, r12, r1", + "str r12, [r7, #16]", + "ldr r12, [r6, #20]", + "ldr r1, [r7, #20]", + "eor r12, r12, r1", + "str r12, [r7, #20]", + "ldr r12, [r6, #24]", + "ldr r1, [r7, #24]", + "eor r12, r12, r1", + "str r12, [r7, #24]", + "ldr r12, [r6, #28]", + "ldr r1, [r7, #28]", + "eor r12, r12, r1", + "str r12, [r7, #28]", + "ldr r12, [r6, #32]", + "ldr r1, [r7, #32]", + "eor r12, r12, r1", + "str r12, [r7, #32]", + "ldr r12, [r6, #36]", + "ldr r1, [r7, #36]", + "eor r12, r12, r1", + "str r12, [r7, #36]", + "ldr r12, [r6, #40]", + "ldr r1, [r7, #40]", + "eor r12, r12, r1", + "str r12, [r7, #40]", + "ldr r12, [r6, #44]", + "ldr r1, [r7, #44]", + "eor r12, r12, r1", + "str r12, [r7, #44]", + "ldr r12, [r6, #48]", + "ldr r1, [r7, #48]", + "eor r12, r12, r1", + "str r12, [r7, #48]", + "ldr r12, [r6, #52]", + "ldr r1, [r7, #52]", + "eor r12, r12, r1", + "str r12, [r7, #52]", + "ldr r12, [r6, #56]", + "ldr r1, [r7, #56]", + "eor r12, r12, r1", + "str r12, [r7, #56]", + "ldr r12, [r6, #60]", + "ldr r1, [r7, #60]", + "eor r12, r12, r1", + "str r12, [r7, #60]", + "subs r5, r5, #1", + "bne 22b", + "b 21f", + "20:", + "21:", "ldr r4, [r11, #272]", "ldr r5, [r11, #276]", "ldr r6, [r11, #280]", @@ -134,8 +343,7 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha512_iterate(key: *const [u8; 3 "ldr lr, [r11, #300]", "ldr r11, [r11, #304]", "bx lr", - vg_sha512_update = sym super::sha512::vg_sha512_update, - vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/arm/pbkdf2_sha512_224.rs b/src/asm/arm/pbkdf2_sha512_224.rs index b84748a1b..36ec56724 100644 --- a/src/asm/arm/pbkdf2_sha512_224.rs +++ b/src/asm/arm/pbkdf2_sha512_224.rs @@ -28,102 +28,288 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha512_224_iterate(key: *const [u "str r10, [r12, #296]", "str lr, [r12, #300]", "str r11, [r12, #304]", - "mov r4, r0", - "mov r5, r3", - "mov r6, r2", "mov r11, r12", - "mov r8, #0", - "movw r9, #28", - "20:", - "add r2, r1, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #564]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "cmp r6, #0", - "beq 21f", - "23:", - "mov r8, #0", - "movw r9, #192", - "24:", - "add r2, r4, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #308]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 24b", - "movw r12, #308", - "add r0, r11, r12", - "movw r12, #564", - "add r1, r11, r12", - "movw r7, #28", - "mov r10, r11", - "movw r2, #128", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", - "movw r12, #308", - "add r0, r11, r12", - "movw r2, #156", - "mov r3, #0", - "movw r12, #500", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha512_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #192", - "25:", - "add r2, r4, r8", - "ldrb r12, [r2, #192]", - "add r2, r11, r8", - "strb r12, [r2, #308]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "movw r12, #308", - "add r0, r11, r12", - "movw r12, #500", - "add r1, r11, r12", - "movw r7, #28", - "mov r10, r11", - "movw r2, #128", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", + "mov r7, r3", + "mov r3, r12", + "mov r4, r0", + "mov r5, r2", "movw r12, #308", "add r0, r11, r12", - "movw r2, #156", - "mov r3, #0", - "movw r12, #564", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha512_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #28", - "26:", - "add r2, r11, r8", - "ldrb r12, [r2, #564]", - "add r2, r5, r8", - "ldrb r1, [r2, #0]", - "eor r1, r1, r12", - "strb r1, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 26b", - "subs r6, r6, #1", - "bne 23b", - "b 22f", - "21:", + "movw r12, #372", + "add r6, r11, r12", + "ldr r12, [r1, #0]", + "str r12, [r6, #0]", + "ldr r12, [r1, #4]", + "str r12, [r6, #4]", + "ldr r12, [r1, #8]", + "str r12, [r6, #8]", + "ldr r12, [r1, #12]", + "str r12, [r6, #12]", + "ldr r12, [r1, #16]", + "str r12, [r6, #16]", + "ldr r12, [r1, #20]", + "str r12, [r6, #20]", + "ldr r12, [r1, #24]", + "str r12, [r6, #24]", + "mov r12, #128", + "str r12, [r6, #28]", + "mov r12, #0", + "str r12, [r6, #32]", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "str r12, [r6, #56]", + "str r12, [r6, #60]", + "str r12, [r6, #64]", + "str r12, [r6, #68]", + "str r12, [r6, #72]", + "str r12, [r6, #76]", + "str r12, [r6, #80]", + "str r12, [r6, #84]", + "str r12, [r6, #88]", + "str r12, [r6, #92]", + "str r12, [r6, #96]", + "str r12, [r6, #100]", + "str r12, [r6, #104]", + "str r12, [r6, #108]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #112]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #116]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #120]", + "movw r12, #0", + "movt r12, #57348", + "str r12, [r6, #124]", + "cmp r5, #0", + "beq 20f", "22:", + "ldr r12, [r4, #0]", + "str r12, [r0, #0]", + "ldr r12, [r4, #4]", + "str r12, [r0, #4]", + "ldr r12, [r4, #8]", + "str r12, [r0, #8]", + "ldr r12, [r4, #12]", + "str r12, [r0, #12]", + "ldr r12, [r4, #16]", + "str r12, [r0, #16]", + "ldr r12, [r4, #20]", + "str r12, [r0, #20]", + "ldr r12, [r4, #24]", + "str r12, [r0, #24]", + "ldr r12, [r4, #28]", + "str r12, [r0, #28]", + "ldr r12, [r4, #32]", + "str r12, [r0, #32]", + "ldr r12, [r4, #36]", + "str r12, [r0, #36]", + "ldr r12, [r4, #40]", + "str r12, [r0, #40]", + "ldr r12, [r4, #44]", + "str r12, [r0, #44]", + "ldr r12, [r4, #48]", + "str r12, [r0, #48]", + "ldr r12, [r4, #52]", + "str r12, [r0, #52]", + "ldr r12, [r4, #56]", + "str r12, [r0, #56]", + "ldr r12, [r4, #60]", + "str r12, [r0, #60]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", + "ldr r9, [r0, #0]", + "ldr r10, [r0, #4]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #0]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "ldr r10, [r0, #12]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #8]", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "ldr r10, [r0, #20]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #16]", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "ldr r10, [r0, #28]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #24]", + "str r9, [r6, #28]", + "ldr r9, [r0, #32]", + "ldr r10, [r0, #36]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #32]", + "str r9, [r6, #36]", + "ldr r9, [r0, #40]", + "ldr r10, [r0, #44]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #40]", + "str r9, [r6, #44]", + "ldr r9, [r0, #48]", + "ldr r10, [r0, #52]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #48]", + "str r9, [r6, #52]", + "ldr r9, [r0, #56]", + "ldr r10, [r0, #60]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #56]", + "str r9, [r6, #60]", + "mov r12, #128", + "str r12, [r6, #28]", + "mov r12, #0", + "str r12, [r6, #32]", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "str r12, [r6, #56]", + "str r12, [r6, #60]", + "ldr r12, [r4, #192]", + "str r12, [r0, #0]", + "ldr r12, [r4, #196]", + "str r12, [r0, #4]", + "ldr r12, [r4, #200]", + "str r12, [r0, #8]", + "ldr r12, [r4, #204]", + "str r12, [r0, #12]", + "ldr r12, [r4, #208]", + "str r12, [r0, #16]", + "ldr r12, [r4, #212]", + "str r12, [r0, #20]", + "ldr r12, [r4, #216]", + "str r12, [r0, #24]", + "ldr r12, [r4, #220]", + "str r12, [r0, #28]", + "ldr r12, [r4, #224]", + "str r12, [r0, #32]", + "ldr r12, [r4, #228]", + "str r12, [r0, #36]", + "ldr r12, [r4, #232]", + "str r12, [r0, #40]", + "ldr r12, [r4, #236]", + "str r12, [r0, #44]", + "ldr r12, [r4, #240]", + "str r12, [r0, #48]", + "ldr r12, [r4, #244]", + "str r12, [r0, #52]", + "ldr r12, [r4, #248]", + "str r12, [r0, #56]", + "ldr r12, [r4, #252]", + "str r12, [r0, #60]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", + "ldr r9, [r0, #0]", + "ldr r10, [r0, #4]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #0]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "ldr r10, [r0, #12]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #8]", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "ldr r10, [r0, #20]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #16]", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "ldr r10, [r0, #28]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #24]", + "str r9, [r6, #28]", + "ldr r9, [r0, #32]", + "ldr r10, [r0, #36]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #32]", + "str r9, [r6, #36]", + "ldr r9, [r0, #40]", + "ldr r10, [r0, #44]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #40]", + "str r9, [r6, #44]", + "ldr r9, [r0, #48]", + "ldr r10, [r0, #52]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #48]", + "str r9, [r6, #52]", + "ldr r9, [r0, #56]", + "ldr r10, [r0, #60]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #56]", + "str r9, [r6, #60]", + "mov r12, #128", + "str r12, [r6, #28]", + "mov r12, #0", + "str r12, [r6, #32]", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "str r12, [r6, #56]", + "str r12, [r6, #60]", + "ldr r12, [r6, #0]", + "ldr r1, [r7, #0]", + "eor r12, r12, r1", + "str r12, [r7, #0]", + "ldr r12, [r6, #4]", + "ldr r1, [r7, #4]", + "eor r12, r12, r1", + "str r12, [r7, #4]", + "ldr r12, [r6, #8]", + "ldr r1, [r7, #8]", + "eor r12, r12, r1", + "str r12, [r7, #8]", + "ldr r12, [r6, #12]", + "ldr r1, [r7, #12]", + "eor r12, r12, r1", + "str r12, [r7, #12]", + "ldr r12, [r6, #16]", + "ldr r1, [r7, #16]", + "eor r12, r12, r1", + "str r12, [r7, #16]", + "ldr r12, [r6, #20]", + "ldr r1, [r7, #20]", + "eor r12, r12, r1", + "str r12, [r7, #20]", + "ldr r12, [r6, #24]", + "ldr r1, [r7, #24]", + "eor r12, r12, r1", + "str r12, [r7, #24]", + "subs r5, r5, #1", + "bne 22b", + "b 21f", + "20:", + "21:", "ldr r4, [r11, #272]", "ldr r5, [r11, #276]", "ldr r6, [r11, #280]", @@ -134,8 +320,7 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha512_224_iterate(key: *const [u "ldr lr, [r11, #300]", "ldr r11, [r11, #304]", "bx lr", - vg_sha512_update = sym super::sha512::vg_sha512_update, - vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/arm/pbkdf2_sha512_256.rs b/src/asm/arm/pbkdf2_sha512_256.rs index 3d94bbc47..d464d7507 100644 --- a/src/asm/arm/pbkdf2_sha512_256.rs +++ b/src/asm/arm/pbkdf2_sha512_256.rs @@ -28,102 +28,291 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha512_256_iterate(key: *const [u "str r10, [r12, #296]", "str lr, [r12, #300]", "str r11, [r12, #304]", - "mov r4, r0", - "mov r5, r3", - "mov r6, r2", "mov r11, r12", - "mov r8, #0", - "movw r9, #32", - "20:", - "add r2, r1, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #564]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 20b", - "cmp r6, #0", - "beq 21f", - "23:", - "mov r8, #0", - "movw r9, #192", - "24:", - "add r2, r4, r8", - "ldrb r12, [r2, #0]", - "add r2, r11, r8", - "strb r12, [r2, #308]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 24b", - "movw r12, #308", - "add r0, r11, r12", - "movw r12, #564", - "add r1, r11, r12", - "movw r7, #32", - "mov r10, r11", - "movw r2, #128", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", - "movw r12, #308", - "add r0, r11, r12", - "movw r2, #160", - "mov r3, #0", - "movw r12, #500", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha512_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #192", - "25:", - "add r2, r4, r8", - "ldrb r12, [r2, #192]", - "add r2, r11, r8", - "strb r12, [r2, #308]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 25b", - "movw r12, #308", - "add r0, r11, r12", - "movw r12, #500", - "add r1, r11, r12", - "movw r7, #32", - "mov r10, r11", - "movw r2, #128", - "mov r3, #0", - "push {{r1, r7, r10, r12}}", - "bl {vg_sha512_update}", - "ldr r1, [sp], #16", + "mov r7, r3", + "mov r3, r12", + "mov r4, r0", + "mov r5, r2", "movw r12, #308", "add r0, r11, r12", - "movw r2, #160", - "mov r3, #0", - "movw r12, #564", - "add r1, r11, r12", - "mov r12, r11", - "push {{r1, r12}}", - "bl {vg_sha512_finalize}", - "ldr r1, [sp], #8", - "mov r8, #0", - "movw r9, #32", - "26:", - "add r2, r11, r8", - "ldrb r12, [r2, #564]", - "add r2, r5, r8", - "ldrb r1, [r2, #0]", - "eor r1, r1, r12", - "strb r1, [r2, #0]", - "add r8, r8, #1", - "subs r9, r9, #1", - "bne 26b", - "subs r6, r6, #1", - "bne 23b", - "b 22f", - "21:", + "movw r12, #372", + "add r6, r11, r12", + "ldr r12, [r1, #0]", + "str r12, [r6, #0]", + "ldr r12, [r1, #4]", + "str r12, [r6, #4]", + "ldr r12, [r1, #8]", + "str r12, [r6, #8]", + "ldr r12, [r1, #12]", + "str r12, [r6, #12]", + "ldr r12, [r1, #16]", + "str r12, [r6, #16]", + "ldr r12, [r1, #20]", + "str r12, [r6, #20]", + "ldr r12, [r1, #24]", + "str r12, [r6, #24]", + "ldr r12, [r1, #28]", + "str r12, [r6, #28]", + "mov r12, #128", + "str r12, [r6, #32]", + "mov r12, #0", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "str r12, [r6, #56]", + "str r12, [r6, #60]", + "str r12, [r6, #64]", + "str r12, [r6, #68]", + "str r12, [r6, #72]", + "str r12, [r6, #76]", + "str r12, [r6, #80]", + "str r12, [r6, #84]", + "str r12, [r6, #88]", + "str r12, [r6, #92]", + "str r12, [r6, #96]", + "str r12, [r6, #100]", + "str r12, [r6, #104]", + "str r12, [r6, #108]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #112]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #116]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #120]", + "movw r12, #0", + "movt r12, #5", + "str r12, [r6, #124]", + "cmp r5, #0", + "beq 20f", "22:", + "ldr r12, [r4, #0]", + "str r12, [r0, #0]", + "ldr r12, [r4, #4]", + "str r12, [r0, #4]", + "ldr r12, [r4, #8]", + "str r12, [r0, #8]", + "ldr r12, [r4, #12]", + "str r12, [r0, #12]", + "ldr r12, [r4, #16]", + "str r12, [r0, #16]", + "ldr r12, [r4, #20]", + "str r12, [r0, #20]", + "ldr r12, [r4, #24]", + "str r12, [r0, #24]", + "ldr r12, [r4, #28]", + "str r12, [r0, #28]", + "ldr r12, [r4, #32]", + "str r12, [r0, #32]", + "ldr r12, [r4, #36]", + "str r12, [r0, #36]", + "ldr r12, [r4, #40]", + "str r12, [r0, #40]", + "ldr r12, [r4, #44]", + "str r12, [r0, #44]", + "ldr r12, [r4, #48]", + "str r12, [r0, #48]", + "ldr r12, [r4, #52]", + "str r12, [r0, #52]", + "ldr r12, [r4, #56]", + "str r12, [r0, #56]", + "ldr r12, [r4, #60]", + "str r12, [r0, #60]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", + "ldr r9, [r0, #0]", + "ldr r10, [r0, #4]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #0]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "ldr r10, [r0, #12]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #8]", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "ldr r10, [r0, #20]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #16]", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "ldr r10, [r0, #28]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #24]", + "str r9, [r6, #28]", + "ldr r9, [r0, #32]", + "ldr r10, [r0, #36]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #32]", + "str r9, [r6, #36]", + "ldr r9, [r0, #40]", + "ldr r10, [r0, #44]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #40]", + "str r9, [r6, #44]", + "ldr r9, [r0, #48]", + "ldr r10, [r0, #52]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #48]", + "str r9, [r6, #52]", + "ldr r9, [r0, #56]", + "ldr r10, [r0, #60]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #56]", + "str r9, [r6, #60]", + "mov r12, #128", + "str r12, [r6, #32]", + "mov r12, #0", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "str r12, [r6, #56]", + "str r12, [r6, #60]", + "ldr r12, [r4, #192]", + "str r12, [r0, #0]", + "ldr r12, [r4, #196]", + "str r12, [r0, #4]", + "ldr r12, [r4, #200]", + "str r12, [r0, #8]", + "ldr r12, [r4, #204]", + "str r12, [r0, #12]", + "ldr r12, [r4, #208]", + "str r12, [r0, #16]", + "ldr r12, [r4, #212]", + "str r12, [r0, #20]", + "ldr r12, [r4, #216]", + "str r12, [r0, #24]", + "ldr r12, [r4, #220]", + "str r12, [r0, #28]", + "ldr r12, [r4, #224]", + "str r12, [r0, #32]", + "ldr r12, [r4, #228]", + "str r12, [r0, #36]", + "ldr r12, [r4, #232]", + "str r12, [r0, #40]", + "ldr r12, [r4, #236]", + "str r12, [r0, #44]", + "ldr r12, [r4, #240]", + "str r12, [r0, #48]", + "ldr r12, [r4, #244]", + "str r12, [r0, #52]", + "ldr r12, [r4, #248]", + "str r12, [r0, #56]", + "ldr r12, [r4, #252]", + "str r12, [r0, #60]", + "mov r1, r6", + "mov r2, #1", + "bl {vg_sha512_compress}", + "ldr r9, [r0, #0]", + "ldr r10, [r0, #4]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #0]", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "ldr r10, [r0, #12]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #8]", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "ldr r10, [r0, #20]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #16]", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "ldr r10, [r0, #28]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #24]", + "str r9, [r6, #28]", + "ldr r9, [r0, #32]", + "ldr r10, [r0, #36]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #32]", + "str r9, [r6, #36]", + "ldr r9, [r0, #40]", + "ldr r10, [r0, #44]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #40]", + "str r9, [r6, #44]", + "ldr r9, [r0, #48]", + "ldr r10, [r0, #52]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #48]", + "str r9, [r6, #52]", + "ldr r9, [r0, #56]", + "ldr r10, [r0, #60]", + "rev r10, r10", + "rev r9, r9", + "str r10, [r6, #56]", + "str r9, [r6, #60]", + "mov r12, #128", + "str r12, [r6, #32]", + "mov r12, #0", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "str r12, [r6, #56]", + "str r12, [r6, #60]", + "ldr r12, [r6, #0]", + "ldr r1, [r7, #0]", + "eor r12, r12, r1", + "str r12, [r7, #0]", + "ldr r12, [r6, #4]", + "ldr r1, [r7, #4]", + "eor r12, r12, r1", + "str r12, [r7, #4]", + "ldr r12, [r6, #8]", + "ldr r1, [r7, #8]", + "eor r12, r12, r1", + "str r12, [r7, #8]", + "ldr r12, [r6, #12]", + "ldr r1, [r7, #12]", + "eor r12, r12, r1", + "str r12, [r7, #12]", + "ldr r12, [r6, #16]", + "ldr r1, [r7, #16]", + "eor r12, r12, r1", + "str r12, [r7, #16]", + "ldr r12, [r6, #20]", + "ldr r1, [r7, #20]", + "eor r12, r12, r1", + "str r12, [r7, #20]", + "ldr r12, [r6, #24]", + "ldr r1, [r7, #24]", + "eor r12, r12, r1", + "str r12, [r7, #24]", + "ldr r12, [r6, #28]", + "ldr r1, [r7, #28]", + "eor r12, r12, r1", + "str r12, [r7, #28]", + "subs r5, r5, #1", + "bne 22b", + "b 21f", + "20:", + "21:", "ldr r4, [r11, #272]", "ldr r5, [r11, #276]", "ldr r6, [r11, #280]", @@ -134,8 +323,7 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha512_256_iterate(key: *const [u "ldr lr, [r11, #300]", "ldr r11, [r11, #304]", "bx lr", - vg_sha512_update = sym super::sha512::vg_sha512_update, - vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } From c989d1f82599ed365d7f65482f7c51866746b609 Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 2 Oct 2026 06:44:53 +0000 Subject: [PATCH 2/9] x86: HMAC finalize and PBKDF2 iterate over the compression function On 32-bit x86, HMAC's `finalize` and PBKDF2's `iterate` for MD5, SHA-1, SHA-384, SHA-512, SHA-512/224 and SHA-512/256 are now written once over a description of a Merkle-Damgard hash function (`Impl/Pbkdf2/Md/X86.lean`: its streaming functions, hash value and length-field sizes, byte order, compression function and digest code), proven once against `Proof.MdStream.Md` and instantiated per hash. * `iterate` lays the block out once (U, 0x80, zeros, the length of a B + D-byte message), and each step is two compressions: the key's inner hash value with that block, then the outer one with the digest written word by word into it. The padding a truncated digest overwrites is written back, and T ^= U is computed word by word. * HMAC `finalize` calls the streaming `finalize` for the inner hash, then computes the outer hash with one compression of a fixed-layout block: the outer hash value and the digest copied word by word, the padding and length written as word stores, the MAC written to `out` (or, truncated, to scratch and copied). The whole PBKDF2 derivation calls the new functions. The streaming-level x86 `iterate` (`Impl/Pbkdf2/Generic/X86.lean`) and HMAC `finalize`, and their proofs, are removed; HMAC's `init` is unchanged. No change to TCB/ or Spec/, to the contracts, or to other targets. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01RjfTK5YMk2jDsiKRYs2dbn --- .../Artifacts/HmacMd5/X86.lean | 16 +- .../Artifacts/HmacSha1/X86.lean | 16 +- .../Artifacts/HmacSha384/X86.lean | 16 +- .../Artifacts/HmacSha512/X86.lean | 16 +- .../Artifacts/HmacSha512_224/X86.lean | 16 +- .../Artifacts/HmacSha512_256/X86.lean | 16 +- .../Artifacts/Pbkdf2Md5/X86.lean | 14 +- .../Artifacts/Pbkdf2Sha1/X86.lean | 14 +- .../Artifacts/Pbkdf2Sha384/X86.lean | 14 +- .../Artifacts/Pbkdf2Sha512/X86.lean | 14 +- .../Artifacts/Pbkdf2Sha512_224/X86.lean | 14 +- .../Artifacts/Pbkdf2Sha512_256/X86.lean | 14 +- .../Impl/Hmac/Generic/X86.lean | 28 +- .../Impl/Pbkdf2/Generic/X86.lean | 79 -- lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean | 192 ++++ .../Proof/Hmac/Generic/X86/Finalize.lean | 218 +---- .../Proof/Hmac/Generic/X86/FinalizeCT.lean | 479 ---------- .../Proof/Hmac/Generic/X86/Hash.lean | 2 +- .../Proof/Hmac/Generic/X86/InitCT.lean | 225 +++++ .../Proof/Hmac/Generic/X86/Instances.lean | 142 +-- .../Proof/Hmac/Generic/X86/Lit.lean | 24 +- .../Proof/Pbkdf2/Generic/X86/Instances.lean | 219 ----- .../Proof/Pbkdf2/Generic/X86/Iterate.lean | 770 ---------------- .../Proof/Pbkdf2/Generic/X86/IterateCT.lean | 329 ------- .../Proof/Pbkdf2/Md/X86/Block.lean | 540 ++++++++++++ .../Proof/Pbkdf2/Md/X86/Hashes.lean | 247 ++++++ .../Proof/Pbkdf2/Md/X86/HmacFin.lean | 370 ++++++++ .../Proof/Pbkdf2/Md/X86/HmacFinCT.lean | 213 +++++ .../Proof/Pbkdf2/Md/X86/Instances.lean | 291 +++++++ .../Proof/Pbkdf2/Md/X86/Iterate.lean | 819 ++++++++++++++++++ .../Proof/Pbkdf2/Md/X86/IterateCT.lean | 289 ++++++ .../Proof/Pbkdf2/Md/X86/Lit.lean | 30 + lean/VerifiedGarbage/Proof/Pbkdf2/MdHmac.lean | 54 ++ .../Proof/Pbkdf2/Whole/X86/CT.lean | 2 +- .../Proof/Pbkdf2/Whole/X86/Instances.lean | 28 +- .../Proof/Pbkdf2/Whole/X86/Lit.lean | 36 +- src/asm/x86/hmac_md5.rs | 96 +- src/asm/x86/hmac_sha1.rs | 105 ++- src/asm/x86/hmac_sha384.rs | 219 ++++- src/asm/x86/hmac_sha512.rs | 192 +++- src/asm/x86/hmac_sha512_224.rs | 209 ++++- src/asm/x86/hmac_sha512_256.rs | 211 ++++- src/asm/x86/pbkdf2_md5.rs | 224 +++-- src/asm/x86/pbkdf2_sha1.rs | 245 +++--- src/asm/x86/pbkdf2_sha384.rs | 420 ++++++--- src/asm/x86/pbkdf2_sha512.rs | 420 ++++++--- src/asm/x86/pbkdf2_sha512_224.rs | 425 ++++++--- src/asm/x86/pbkdf2_sha512_256.rs | 424 ++++++--- 48 files changed, 5653 insertions(+), 3343 deletions(-) delete mode 100644 lean/VerifiedGarbage/Impl/Pbkdf2/Generic/X86.lean create mode 100644 lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Generic/X86/FinalizeCT.lean create mode 100644 lean/VerifiedGarbage/Proof/Hmac/Generic/X86/InitCT.lean delete mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Instances.lean delete mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Iterate.lean delete mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/IterateCT.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Block.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFin.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFinCT.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Iterate.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/IterateCT.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Lit.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/MdHmac.lean diff --git a/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean index 9fecdc4eb..7525f3565 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean @@ -1,5 +1,6 @@ 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 @@ -14,9 +15,14 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling MD5's verified `init`, `update` -and `finalize`. +`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. -/ namespace VG.Artifacts.HmacMd5.X86 @@ -36,11 +42,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.md5I.finalizeApi with target := X86.target doc := Spec.Hmac.md5I.finalizeApi.doc - code := md5H.finalize + code := Proof.Pbkdf2.Md.X86.md5M.hmacFin contract := Spec.Hmac.md5I.finalizeContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ stack := 48 - verified := Instances.md5_finalize + verified := Proof.Pbkdf2.Md.X86.Instances.md5_finalize spSafe := Code.all_of_allInstrs (by lit_decide) }] end VG.Artifacts.HmacMd5.X86 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean index 09f482a4b..96dccccf4 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean @@ -1,5 +1,6 @@ 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 @@ -14,9 +15,14 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling SHA-1's verified `init`, `update` -and `finalize`. +`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. -/ namespace VG.Artifacts.HmacSha1.X86 @@ -36,11 +42,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha1I.finalizeApi with target := X86.target doc := Spec.Hmac.sha1I.finalizeApi.doc - code := sha1H.finalize + code := Proof.Pbkdf2.Md.X86.sha1M.hmacFin contract := Spec.Hmac.sha1I.finalizeContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ stack := 48 - verified := Instances.sha1_finalize + verified := Proof.Pbkdf2.Md.X86.Instances.sha1_finalize spSafe := Code.all_of_allInstrs (by lit_decide) }] end VG.Artifacts.HmacSha1.X86 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean index 32bbcdedc..22d0319ec 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean @@ -1,5 +1,6 @@ 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 @@ -14,9 +15,14 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling SHA-384's verified `init`, `update` -and `finalize`. +`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. -/ namespace VG.Artifacts.HmacSha384.X86 @@ -36,11 +42,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha384I.finalizeApi with target := X86.target doc := Spec.Hmac.sha384I.finalizeApi.doc - code := sha384H.finalize + code := Proof.Pbkdf2.Md.X86.sha384M.hmacFin contract := Spec.Hmac.sha384I.finalizeContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ stack := 48 - verified := Instances.sha384_finalize + verified := Proof.Pbkdf2.Md.X86.Instances.sha384_finalize spSafe := Code.all_of_allInstrs (by lit_decide) }] end VG.Artifacts.HmacSha384.X86 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean index 6667e2bb8..74d619afb 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean @@ -1,5 +1,6 @@ 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 @@ -14,9 +15,14 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling SHA-512's verified `init`, `update` -and `finalize`. +`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. -/ namespace VG.Artifacts.HmacSha512.X86 @@ -36,11 +42,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha512I.finalizeApi with target := X86.target doc := Spec.Hmac.sha512I.finalizeApi.doc - code := sha512H'.finalize + code := Proof.Pbkdf2.Md.X86.sha512M'.hmacFin contract := Spec.Hmac.sha512I.finalizeContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ stack := 48 - verified := Instances.sha512_finalize + verified := Proof.Pbkdf2.Md.X86.Instances.sha512_finalize spSafe := Code.all_of_allInstrs (by lit_decide) }] end VG.Artifacts.HmacSha512.X86 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean index e561e729b..f094f463c 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean @@ -1,5 +1,6 @@ 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 @@ -14,9 +15,14 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling SHA-512/224's verified `init`, `update` -and `finalize`. +`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. -/ namespace VG.Artifacts.HmacSha512_224.X86 @@ -36,11 +42,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha512_224I.finalizeApi with target := X86.target doc := Spec.Hmac.sha512_224I.finalizeApi.doc - code := sha512_224H.finalize + code := Proof.Pbkdf2.Md.X86.sha512_224M.hmacFin contract := Spec.Hmac.sha512_224I.finalizeContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ stack := 48 - verified := Instances.sha512_224_finalize + verified := Proof.Pbkdf2.Md.X86.Instances.sha512_224_finalize spSafe := Code.all_of_allInstrs (by lit_decide) }] end VG.Artifacts.HmacSha512_224.X86 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean index 56b84ccb6..bd842e001 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean @@ -1,5 +1,6 @@ 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 @@ -14,9 +15,14 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one HMAC implementation for every streaming hash function -(`Impl/Hmac/Generic/X86.lean`), calling SHA-512/256's verified `init`, `update` -and `finalize`. +`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. -/ namespace VG.Artifacts.HmacSha512_256.X86 @@ -36,11 +42,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha512_256I.finalizeApi with target := X86.target doc := Spec.Hmac.sha512_256I.finalizeApi.doc - code := sha512_256H.finalize + code := Proof.Pbkdf2.Md.X86.sha512_256M.hmacFin contract := Spec.Hmac.sha512_256I.finalizeContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ stack := 48 - verified := Instances.sha512_256_finalize + verified := Proof.Pbkdf2.Md.X86.Instances.sha512_256_finalize spSafe := Code.all_of_allInstrs (by lit_decide) }] end VG.Artifacts.HmacSha512_256.X86 diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Md5/X86.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Md5/X86.lean index 97f1bd8b1..db1877915 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Md5/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Md5/X86.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.X86.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.X86.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.Instances /-! @@ -15,9 +15,11 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/X86.lean`), calling MD5's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`): each step is two calls of MD5's verified +compression function, on a block laid out once, word by word, in `scratch` +(`U`, its padding and length), starting from the key's inner and outer hash +values. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/X86.lean`), calling the hash function's streaming @@ -35,11 +37,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.md5I.iterateApi with target := X86.target doc := Spec.Hmac.md5I.iterateApi.doc - code := Impl.Pbkdf2.Generic.X86.iterate md5H + code := Proof.Pbkdf2.Md.X86.md5M.iterate contract := Spec.Hmac.md5I.iterateContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ stack := 48 - verified := Proof.Pbkdf2.Generic.X86.Instances.md5 + verified := Proof.Pbkdf2.Md.X86.Instances.md5_iterate spSafe := Code.all_of_allInstrs (by lit_decide) }, { Spec.Hmac.md5I.pbkdf2Api with target := X86.target diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha1/X86.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha1/X86.lean index 11102a37f..83c493eb3 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha1/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha1/X86.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.X86.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.X86.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.Instances /-! @@ -15,9 +15,11 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/X86.lean`), calling SHA-1's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`): each step is two calls of SHA-1's verified +compression function, on a block laid out once, word by word, in `scratch` +(`U`, its padding and length), starting from the key's inner and outer hash +values. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/X86.lean`), calling the hash function's streaming @@ -35,11 +37,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha1I.iterateApi with target := X86.target doc := Spec.Hmac.sha1I.iterateApi.doc - code := Impl.Pbkdf2.Generic.X86.iterate sha1H + code := Proof.Pbkdf2.Md.X86.sha1M.iterate contract := Spec.Hmac.sha1I.iterateContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ stack := 48 - verified := Proof.Pbkdf2.Generic.X86.Instances.sha1 + verified := Proof.Pbkdf2.Md.X86.Instances.sha1_iterate spSafe := Code.all_of_allInstrs (by lit_decide) }, { Spec.Hmac.sha1I.pbkdf2Api with target := X86.target diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha384/X86.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha384/X86.lean index 71b7c68ba..e8d132e2d 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha384/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha384/X86.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.X86.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.X86.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.Instances /-! @@ -15,9 +15,11 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/X86.lean`), calling SHA-384's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`): each step is two calls of SHA-384's verified +compression function, on a block laid out once, word by word, in `scratch` +(`U`, its padding and length), starting from the key's inner and outer hash +values. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/X86.lean`), calling the hash function's streaming @@ -35,11 +37,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha384I.iterateApi with target := X86.target doc := Spec.Hmac.sha384I.iterateApi.doc - code := Impl.Pbkdf2.Generic.X86.iterate sha384H + code := Proof.Pbkdf2.Md.X86.sha384M.iterate contract := Spec.Hmac.sha384I.iterateContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ stack := 48 - verified := Proof.Pbkdf2.Generic.X86.Instances.sha384 + verified := Proof.Pbkdf2.Md.X86.Instances.sha384_iterate spSafe := Code.all_of_allInstrs (by lit_decide) }, { Spec.Hmac.sha384I.pbkdf2Api with target := X86.target diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512/X86.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512/X86.lean index 4418aac75..7ffded97a 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512/X86.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.X86.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.X86.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.Instances /-! @@ -15,9 +15,11 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/X86.lean`), calling SHA-512's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`): each step is two calls of SHA-512's verified +compression function, on a block laid out once, word by word, in `scratch` +(`U`, its padding and length), starting from the key's inner and outer hash +values. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/X86.lean`), calling the hash function's streaming @@ -35,11 +37,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha512I.iterateApi with target := X86.target doc := Spec.Hmac.sha512I.iterateApi.doc - code := Impl.Pbkdf2.Generic.X86.iterate sha512H' + code := Proof.Pbkdf2.Md.X86.sha512M'.iterate contract := Spec.Hmac.sha512I.iterateContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ stack := 48 - verified := Proof.Pbkdf2.Generic.X86.Instances.sha512 + verified := Proof.Pbkdf2.Md.X86.Instances.sha512_iterate spSafe := Code.all_of_allInstrs (by lit_decide) }, { Spec.Hmac.sha512I.pbkdf2Api with target := X86.target diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_224/X86.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_224/X86.lean index acf971a6c..f65bee898 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_224/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_224/X86.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.X86.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.X86.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.Instances /-! @@ -15,9 +15,11 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/X86.lean`), calling SHA-512/224's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`): each step is two calls of SHA-512/224's verified +compression function, on a block laid out once, word by word, in `scratch` +(`U`, its padding and length), starting from the key's inner and outer hash +values. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/X86.lean`), calling the hash function's streaming @@ -35,11 +37,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha512_224I.iterateApi with target := X86.target doc := Spec.Hmac.sha512_224I.iterateApi.doc - code := Impl.Pbkdf2.Generic.X86.iterate sha512_224H + code := Proof.Pbkdf2.Md.X86.sha512_224M.iterate contract := Spec.Hmac.sha512_224I.iterateContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ stack := 48 - verified := Proof.Pbkdf2.Generic.X86.Instances.sha512_224 + verified := Proof.Pbkdf2.Md.X86.Instances.sha512_224_iterate spSafe := Code.all_of_allInstrs (by lit_decide) }, { Spec.Hmac.sha512_224I.pbkdf2Api with target := X86.target diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_256/X86.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_256/X86.lean index 0f91cac3d..f1c67fe66 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_256/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha512_256/X86.lean @@ -1,5 +1,5 @@ import VerifiedGarbage.TCB.X86.Target -import VerifiedGarbage.Proof.Pbkdf2.Generic.X86.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.Instances /-! @@ -15,9 +15,11 @@ target (`Sig.layoutDoc`), from `stack` and `writeArgs`, which `ofSig` checks against the contract (after unfolding the `Instance`'s contract to the generic one, which is a `Sig.contract`). -The code is the one PBKDF2 iteration for every streaming hash function -(`Impl/Pbkdf2/Generic/X86.lean`), calling SHA-512/256's verified `update` and -`finalize`. +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`): each step is two calls of SHA-512/256's verified +compression function, on a block laid out once, word by word, in `scratch` +(`U`, its padding and length), starting from the key's inner and outer hash +values. The whole derivation, `pbkdf2`, is the one for every streaming hash function (`Impl/Pbkdf2/Whole/X86.lean`), calling the hash function's streaming @@ -35,11 +37,11 @@ def artifacts : List Artifact := [ { Spec.Hmac.sha512_256I.iterateApi with target := X86.target doc := Spec.Hmac.sha512_256I.iterateApi.doc - code := Impl.Pbkdf2.Generic.X86.iterate sha512_256H + code := Proof.Pbkdf2.Md.X86.sha512_256M.iterate contract := Spec.Hmac.sha512_256I.iterateContract X86.abi 48 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ stack := 48 - verified := Proof.Pbkdf2.Generic.X86.Instances.sha512_256 + verified := Proof.Pbkdf2.Md.X86.Instances.sha512_256_iterate spSafe := Code.all_of_allInstrs (by lit_decide) }, { Spec.Hmac.sha512_256I.pbkdf2Api with target := X86.target diff --git a/lean/VerifiedGarbage/Impl/Hmac/Generic/X86.lean b/lean/VerifiedGarbage/Impl/Hmac/Generic/X86.lean index e8f514a2b..771743cc9 100644 --- a/lean/VerifiedGarbage/Impl/Hmac/Generic/X86.lean +++ b/lean/VerifiedGarbage/Impl/Hmac/Generic/X86.lean @@ -10,10 +10,11 @@ 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)` finalizes the inner state - into `scratch`, copies the outer state over the inner one, absorbs the - inner digest into it with `update`, and finalizes it again; the MAC is - copied to `out`. +* `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`). 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 @@ -149,11 +150,10 @@ def init : Prog isa := (.seq (H.callUpd [] .esi .edi 0 (H.buf + H.B) H.B) (.block H.restore)))))) -/-! ## `finalize` +/-! ## The start of `finalize` -Registers: `ebx` = `inner`, `esi` = `outer` (then the low word of -`update`'s count), `edi` = `out`, `ebp` = `scratch`. The digests are -written to `scratch + buf`. -/ +Registers: `ebx` = `inner`, `esi` = `outer`, `edi` = `out`, `ebp` = +`scratch`. The inner digest is written to `scratch + buf`. -/ def finPrologue : List Instr := [.mov .eax (.mem (at_ .esp 24))] ++ H.save ++ [.mov .ebp (.reg .eax), .mov .ebx (.mem (at_ .esp 4)), @@ -162,18 +162,6 @@ def finPrologue : List Instr := /-- Our `count` argument, as `finalize`'s. -/ def count1 : List Instr := [.mov .eax (.mem (at_ .esp 12)), .mov .ecx (.mem (at_ .esp 16))] -/-- The count of a state that has absorbed a block and a digest, `B + D`. -/ -def count2 : List Instr := [.mov .eax (.imm (BitVec.ofNat 32 (H.B + H.D))), .mov .ecx (.imm 0)] - -def finalize : Prog isa := - .seq (.block H.finPrologue) - (.seq (H.callFin [] count1 .ebx H.buf) - (.seq (copy .esi 0 .ebx 0 H.S) - (.seq (H.callUpd [] .ebx .esi H.B H.buf H.D) - (.seq (H.callFin [] H.count2 .ebx H.buf) - (.seq (copy .ebp H.buf .edi 0 H.D) - (.block H.restore)))))) - end Hash end VG.Impl.Hmac.Generic.X86 diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Generic/X86.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Generic/X86.lean deleted file mode 100644 index 067f30af0..000000000 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Generic/X86.lean +++ /dev/null @@ -1,79 +0,0 @@ -import VerifiedGarbage.Impl.Hmac.Generic.X86 - -/-! -# PBKDF2-HMAC over any streaming hash function: x86 (32-bit) implementation - -`iterate(key, u, n, t, scratch)`, every argument on the stack (cdecl), 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`: -the same design as on 32-bit ARM (`VG.Impl.Pbkdf2.Generic.Arm`). -Each step copies the inner state into `scratch`, absorbs `U` into it with -`update` and finalizes it; then does the same with the outer state and that -digest, which gives the next `U`. - -`scratch` is laid out as for HMAC (`VG.Impl.Hmac.Generic.X86`): the working -space of the functions we call, our caller's registers, then the state (`S` -bytes), the inner digest and `U` (`F` bytes each). Registers: `ebp` = -`scratch`, `edi` = the steps left; `key` and `t` are read from the stack -into `esi` when needed, which leaves `ebx` for the address of the state -being hashed and `esi` for the low word of `update`'s count. --/ - -namespace VG.Impl.Pbkdf2.Generic.X86 - -open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash copy scr at_) - -variable (H : Hash) - -/-- Where the state being hashed is in `scratch`. -/ -def stO : Nat := H.buf - -/-- Where the inner digest is. -/ -def tmpO : Nat := H.buf + H.S - -/-- Where `U` is. -/ -def uO : Nat := H.buf + H.S + H.F - -/-- `T ← T ⊕ U`, byte by byte, with `T` at `esi`. -/ -def xorLoop : Prog isa := - .seq (.block [.mov .ecx (.imm 0)]) - (.loop (.block [.mov .eax (.reg .ebp), .alu .add .eax (.reg .ecx), .movzx8 .edx (at_ .eax (uO H)), - .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 H.D))]) .ne) - -/-- `ebx ← scratch + stO`: the state being hashed. -/ -def atSt : List Instr := scr .ebx (stO H) - -/-- `key`, from the stack. -/ -def ldKey : List Instr := [.mov .esi (.mem (at_ .esp 4))] - -/-- `t`, from the stack. -/ -def ldT : List Instr := [.mov .esi (.mem (at_ .esp 16))] - -/-- One step. -/ -def body : Prog isa := - .seq (.block ldKey) - (.seq (copy .esi 0 .ebp (stO H) H.S) - (.seq (H.callUpd (atSt H) .ebx .esi H.B (uO H) H.D) - (.seq (H.callFin (atSt H) H.count2 .ebx (tmpO H)) - (.seq (.block ldKey) - (.seq (copy .esi H.S .ebp (stO H) H.S) - (.seq (H.callUpd (atSt H) .ebx .esi H.B (tmpO H) H.D) - (.seq (H.callFin (atSt H) H.count2 .ebx (uO H)) - (.seq (.block ldT) - (.seq (xorLoop H) - (.block [.alu .sub .edi (.imm 1)])))))))))) - -def prologue : List Instr := - [.mov .eax (.mem (at_ .esp 20))] ++ H.save ++ [.mov .ebp (.reg .eax), .mov .edi (.mem (at_ .esp 12)), - .mov .esi (.mem (at_ .esp 8))] - -def iterate : Prog isa := - .seq (.block (prologue H)) - (.seq (copy .esi 0 .ebp (uO H) H.D) - (.seq (.block [.alu .test .edi (.reg .edi)]) - (.seq (.ite .e (.block []) (.loop (body H) .ne)) - (.block H.restore)))) - -end VG.Impl.Pbkdf2.Generic.X86 diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean new file mode 100644 index 000000000..7a3658b4c --- /dev/null +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean @@ -0,0 +1,192 @@ +import VerifiedGarbage.Impl.Hmac.Generic.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: `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): + +* `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 + block, so HMAC of the `D`-byte `U` is two compressions: the inner hash + value with the block `U ‖ pad`, then the outer hash value with the block + `digest ‖ pad`. The padding is written once, before the loop; the + digest's `N - D` bytes past `D` (for a truncated hash function), which + overwrite its start, are written back after each. `T ← T ⊕ U` is computed + in `t` itself, word by word. +* `finalize(inner, outer, count, out, scratch)` finalizes the inner state + into `scratch` with the hash function's streaming `finalize` (its + message has a variable length). The outer hash, of the outer block and + that digest, is then one compression: the inner state is no longer + needed, so it gets the outer hash value and, in its buffer, the digest + followed by the padding. The MAC is written to `out`: directly, or for a + digest shorter than the hash value, into the buffer and its first `D` + bytes copied. + +`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`. +-/ + +namespace VG.Impl.Pbkdf2.Md.X86 + +open VG.X86 +open VG.Impl.Hmac.Generic.X86 (at_) + +/-- Word `k` from `[src + o₁]` to `[dst + o₂]`, through `ecx`. -/ +def cpW (src dst : Reg) (o₁ o₂ k : Nat) : List Instr := + [.mov .ecx (.mem (at_ src (o₁ + 4 * k))), .store (at_ dst (o₂ + 4 * k)) .ecx] + +/-- `n` words from `[src + o₁]` to `[dst + o₂]`. -/ +def copyW (src : Reg) (o₁ : Nat) (dst : Reg) (o₂ n : Nat) : List Instr := + (List.range n).flatMap (cpW src dst o₁ o₂) + +/-- The little-endian 32-bit word of bytes `4 k … 4 k + 3` of `xs`. -/ +def wordOf (xs : List Byte) (k : Nat) : BitVec 32 := + xs.getD (4 * k + 3) 0 ++ xs.getD (4 * k + 2) 0 ++ xs.getD (4 * k + 1) 0 ++ xs.getD (4 * k) 0 + +/-- The first `4 n` bytes of `xs` at `[dst + o]`, a word at a time through `ecx`. -/ +def storeW (dst : Reg) (o : Nat) (xs : List Byte) (n : Nat) : List Instr := + (List.range n).flatMap fun k => [.mov .ecx (.imm (wordOf xs k)), .store (at_ dst (o + 4 * k)) .ecx] + +/-- The end of the last block of a `B + D`-byte message, after its last `D` +bytes: `0x80`, zeros, and the `L`-byte length field, the length in bits, +big-endian if `be` and little-endian otherwise. -/ +def tail (B D L : Nat) (be : Bool) : List Byte := + [0x80] ++ List.replicate (B - L - 1 - D) 0 ++ + (List.range L).map fun i => BitVec.ofNat 8 ((8 * (B + D)) >>> (8 * (if be then L - 1 - i else i))) + +/-- A Merkle–Damgård hash function's x86 functions, as HMAC and PBKDF2 use +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 + /-- The size of the hash value (where a state's buffer starts). -/ + N : Nat + /-- The size of the length field. -/ + L : Nat + /-- Whether the length field is big-endian. -/ + be : Bool + /-- The bytes of scratch space of the compression function. -/ + so : Nat + /-- The compression function `compress(state, blocks, n, scratch)`, and its name. -/ + compN : String + compC : Prog isa + /-- Writes the digest of the `N`-byte hash value at `ebx` to `eax`; writes + only `ecx` and `edx` (and the flags). -/ + out : List Instr + +namespace Hash + +variable (H : Hash) + +/-- The block size, and the sizes of the state and of the digest. -/ +abbrev B : Nat := H.st.B +abbrev S : Nat := H.st.S +abbrev D : Nat := H.st.D + +/-- The end of the block after the digest. -/ +def tailB : List Byte := tail H.B H.D H.L H.be + +/-! ## The block after the hash value at `ebx` -/ + +/-- `eax ← ebx + N`: the block. -/ +def atBlk : List Instr := [.mov .eax (.reg .ebx), .alu .add .eax (.imm (BitVec.ofNat 32 H.N))] + +/-- The padding after the block's first `D` bytes. -/ +def pad : List Instr := storeW .ebx (H.N + H.D) H.tailB ((H.B - H.D) / 4) + +/-- The digest of the hash value into the block, and the padding it +overwrote (for a digest shorter than the hash value) written back. -/ +def digest : List Instr := H.atBlk ++ H.out ++ storeW .ebx (H.N + H.D) H.tailB ((H.N - H.D) / 4) + +/-- One compression of the block (at `eax`) into the hash value, with the +scratch space at `ebp`. -/ +def cmp : Prog isa := Impl.MdStream.X86.compressAt H.compN H.compC .ebx .ebp + +/-! ## `iterate` + +Registers: `ebp` = `scratch`, `ebx` = the hash value being compressed (at +`scratch + buf`, the block right after it), `esi` = `key`, `edi` = the steps +left; `t` is read from the stack into `edx` for `T ← T ⊕ U`. -/ + +/-- The hash value at `key + o` into the one at `ebx`. -/ +def loadKey (o : Nat) : List Instr := copyW .esi o .ebx 0 (H.N / 4) + +/-- `T ← T ⊕ U` for word `k`, with `T` at `edx` and `U` the block's first `D` bytes. -/ +def xorW (k : Nat) : List Instr := + [.mov .ecx (.mem (at_ .ebx (H.N + 4 * k))), .alu .xor .ecx (.mem (at_ .edx (4 * k))), + .store (at_ .edx (4 * k)) .ecx] + +/-- `t`, then `T ← T ⊕ U` and the count. -/ +def tStep : List Instr := + [.mov .edx (.mem (at_ .esp 16))] ++ (List.range (H.D / 4)).flatMap H.xorW ++ [.alu .sub .edi (.imm 1)] + +/-- One step. -/ +def body : Prog isa := + .seq (.block (H.loadKey 0 ++ H.atBlk)) + (.seq H.cmp + (.seq (.block (H.digest ++ H.loadKey H.S ++ H.atBlk)) + (.seq H.cmp + (.block (H.digest ++ H.tStep))))) + +/-- Saving our caller's registers, setting up ours, and writing `U` and the +padding into the block. -/ +def prologue : List Instr := + [.mov .eax (.mem (at_ .esp 20))] ++ H.st.save ++ + [.mov .ebp (.reg .eax), .mov .esi (.mem (at_ .esp 4)), .mov .edi (.mem (at_ .esp 12)), + .mov .ebx (.reg .ebp), .alu .add .ebx (.imm (BitVec.ofNat 32 H.st.buf)), .mov .edx (.mem (at_ .esp 8))] ++ + copyW .edx 0 .ebx H.N (H.D / 4) ++ H.pad ++ [.alu .test .edi (.reg .edi)] + +def iterate : Prog isa := + .seq (.block H.prologue) + (.seq (.ite .e (.block []) (.loop H.body .ne)) + (.block H.st.restore)) + +/-! ## HMAC's `finalize` + +Registers as in the streaming-level design (`Impl.Hmac.Generic.X86.Hash.finPrologue`): +`ebx` = `inner`, `esi` = `outer`, `edi` = `out`, `ebp` = `scratch`. The +streaming `finalize` writes the inner digest to `scratch + buf`. -/ + +/-- The outer hash value over the inner state's, the inner digest into its +buffer and the padding after it, and `eax` at the buffer. -/ +def finMid : List Instr := + copyW .esi 0 .ebx 0 (H.N / 4) ++ copyW .ebp H.st.buf .ebx H.N (H.D / 4) ++ H.pad ++ H.atBlk + +/-- The MAC to `out`, and our caller's registers back. -/ +def finOut : List Instr := + (if H.D < H.N then H.atBlk ++ H.out ++ copyW .ebx H.N .edi 0 (H.D / 4) else .mov .eax (.reg .edi) :: H.out) ++ + H.st.restore + +def hmacFin : Prog isa := + .seq (.block H.st.finPrologue) + (.seq (H.st.callFin [] Impl.Hmac.Generic.X86.Hash.count1 .ebx H.st.buf) + (.seq (.block H.finMid) + (.seq H.cmp + (.block H.finOut)))) + +end Hash + +end VG.Impl.Pbkdf2.Md.X86 diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Finalize.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Finalize.lean index f7baf6062..a70bb2d87 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Finalize.lean +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Finalize.lean @@ -3,13 +3,16 @@ import VerifiedGarbage.Proof.Hmac.Generic.Common import VerifiedGarbage.Proof.Framework.OmegaLit /-! -# HMAC over any streaming hash function on x86 (32-bit): `finalize`, correct - -Untrusted: everything here is checked by Lean. As on the other targets -(`Proof/Hmac/Generic/Arm/Finalize.lean`). The arguments are on the stack: -`scratch`, `inner`, `outer` and `out` are loaded first (after our caller's -registers are saved in `scratch`), and the count just before the first -call, which passes it on. +# HMAC on x86 (32-bit): the start of `finalize` + +Untrusted: everything here is checked by Lean. 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`; `Proof/Pbkdf2/Md/X86/HmacFin.lean` continues from there. -/ namespace VG.Proof.Hmac.Generic.X86.Finalize @@ -332,20 +335,6 @@ theorem fin1Args_ok {s : State} (hk : KR (H := H) sc s₀ s) : · rw [u₄.gpr, u₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), hk.ebp] · rw [u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide)] -/-- The second call's arguments: the count `B + D`. -/ -theorem fin2Args_ok {s : State} (hk : KR (H := H) sc s₀ s) : - WP isa (.block ([] ++ H.count2 ++ Impl.Hmac.Generic.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₀) (BitVec.ofNat 32 (H.B + H.D)) 0 ∧ t.mem = s.mem := by - simp only [Hash.count2, Impl.Hmac.Generic.X86.scr, List.cons_append, List.nil_append] - refine wp_movi fun s₁ u₁ => wp_movi fun s₂ u₂ => wp_mov fun s₃ u₃ => wp_addi fun s₄ u₄ => WP.block_nil ?_ - have k₄ : KR (H := H) sc s₀ s₄ := (((hk.upd (by decide) u₁).upd (by decide) u₂).upd (by decide) u₃).upd - (by decide) u₄ - refine ⟨k₄, finArgs hH hp k₄ ?_ ?_ ?_, by rw [u₄.mem, u₃.mem, u₂.mem, u₁.mem]⟩ - · rw [u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.gpr] - · rw [u₄.other _ (by decide), u₃.other _ (by decide), u₂.gpr] - · rw [u₄.gpr, u₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), hk.ebp] - theorem finCall_ok {t : State} (hk : KR (H := H) sc s₀ t) {lo hi : BitVec 32} (ha : FinArgs hH t .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) lo hi) {Q : State → Prop} (hQ : ∀ s', KR (H := H) sc s₀ s' → s'.gpr .esi = t.gpr .esi → @@ -371,193 +360,6 @@ theorem finCall_ok {t : State} (hk : KR (H := H) sc s₀ t) {lo hi : BitVec 32} · exact .inl (t_sub hp) · exact .inl (cal_sub hH hp) -/-- `update`'s arguments: the digest at `T`, and the count `B`. -/ -theorem updArgs_ok {s : State} (hk : KR (H := H) sc s₀ s) : - WP isa (.block ([] ++ ([.mov .eax (.imm 0), .mov .esi (.imm (BitVec.ofNat 32 H.B)), - .mov .ecx (.imm (BitVec.ofNat 32 H.D))] : List Instr) ++ Impl.Hmac.Generic.X86.scr .edx H.buf)) s fun t => - KR (H := H) sc s₀ t ∧ - UpdArgs hH t .esi .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (BitVec.ofNat 32 H.B) H.D ∧ t.mem = s.mem := by - have hf := hp.fits; have hW := hp.hW; have hB := hp.hB; have hD := hp.hD; have hwb := hH.hWb - have nw := hp.nw; have hf2 := hp.fits; simp only [Hash.buf] at hf2 - obtain ⟨sR, iR, _⟩ := wr_mem hp - simp only [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 k₅ : KR (H := H) sc s₀ s₅ := - ((((hk.upd (by decide) u₁).upd (by decide) u₂).upd (by decide) u₃).upd (by decide) u₄).upd (by decide) u₅ - have tsub : Region.Sub ⟨T (H := H) s₀, H.D⟩ (tR (H := H) s₀) := Region.sub_prefix hD.2.1 - refine ⟨k₅, ?_, by rw [u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem]⟩ - exact - { hst := k₅.ebx - 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 decide - hl := by decide - hlen := by omega_nat - sp48 := by rw [k₅.esp]; exact hp.sp48 - cd := by - rw [k₅.rd, k₅.wr, addr_tO hp] - exact Covers.of_sub fun r hr => by - simp only [List.mem_singleton] at hr; subst hr - exact sub_of_off (List.mem_append_right _ sR) (by omega_nat) - 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 iR (Nat.le_refl _) - · exact sub_of_self (r := scR sc s₀) sR (by show hH.Wb ≤ 8 * sc; simp only [Hash.buf] at hf; omega_nat) - st_sc := hp.i_s.sub_right (cal_sub hH hp) - d_st := by rw [addr_tO hp]; exact (hp.i_s.sub_right (fun a h => t_sub hp a (tsub a h))).symm - d_sc := by rw [addr_tO hp]; exact (cal_t hH hp).symm.sub_left tsub - b_st := by rw [stk_eq k₅]; exact hp.b_i - b_d := by rw [stk_eq k₅, addr_tO hp]; exact hp.b_s.sub_right (fun a h => t_sub hp a (tsub a h)) - b_sc := by rw [stk_eq k₅]; exact hp.b_s.sub_right (cal_sub hH hp) - nst := hp.ni - nd := by rw [toNat_tO hp]; omega_nat - nsc := by omega_nat } - -theorem updCall_ok {t : State} (hk : KR (H := H) sc s₀ t) - (ha : UpdArgs hH t .esi .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (BitVec.ofNat 32 H.B) H.D) {Q : State → Prop} - (hQ : ∀ s', KR (H := H) sc s₀ s' → Frame [inR (H := H) s₀, calR hH s₀, stkR s₀] t.mem s'.mem → - (∀ m, hH.SH.Repr t.mem ((inn s₀).setWidth 64) m → BitVec.ofNat 64 H.B = BitVec.ofNat 64 m.length → - hH.SH.Repr s'.mem ((inn s₀).setWidth 64) (m ++ bytesAt t.mem (T (H := H) s₀) H.D)) → Q s') : - WP isa (.frame (.push (upd6 .esi .ebx)) (.call H.updN H.updC) (.pop .eax (upd6 .esi .ebx).length)) t Q := - upd_frame hH ha fun s' ha' hpost => by - have f := ha'.frame - rw [stk_eq hk] at f - rw [addr_tO hp] at hpost - refine hQ s' (hk.call hp ha' ?_ ?_) f fun m hr hc => hpost m hr (by - rw [zero_append_ofNat (by have := hp.hB; omega_nat)]; exact hc) - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact hp.i_s.symm.sub_left (save_sub hp) - · exact (cal_save hH hp).symm - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact .inr rfl - · exact .inl (cal_sub hH hp) - -/-! ## The copies -/ - -omit hp in -theorem add_zero' (p : Addr) : p + BitVec.ofNat 64 0 = p := BitVec.add_zero p - -/-- The outer state over the inner one. -/ -theorem copy1_ok {s : State} (hk : KR (H := H) sc s₀ s) (hsi : s.gpr .esi = outer s₀) : - WP isa (copy .esi 0 .ebx 0 H.S) s fun t => KR (H := H) sc s₀ t ∧ - t.mem = writeBytes s.mem ((inn s₀).setWidth 64) (bytesAt s.mem ((outer s₀).setWidth 64) H.S) := by - have hS := hp.hS; have ni := hp.ni; have no := hp.no - obtain ⟨_, iR, _⟩ := wr_mem hp - have oR : outerR (H := H) s₀ ∈ s.rd ++ s.wr := by rw [hk.rd, hp.rd]; simp - refine WP.mono (copy_ok (so := 0) (d := 0) (n := H.S) (by decide) (by decide) hS.1 - (by omega_nat) (by rw [hsi]; omega_nat) (by rw [hk.ebx]; omega_nat) - (fun k hk' => by rw [hsi, add_zero']; exact inRegions_of_sub oR (fun _ h => h) (by omega_nat) hk') - (fun k hk' => by rw [hk.ebx, add_zero', hk.wr]; exact inRegions_of_sub iR (fun _ h => h) (by omega_nat) hk') - (by rw [hsi, hk.ebx, add_zero', add_zero']; exact hp.i_o.symm)) fun t c => ?_ - rw [hk.ebx, hsi, add_zero', add_zero'] at c - refine ⟨hk.keep c.rd c.wr (fun r hr => ?_) - (c.mem ▸ Proof.Sha256.Stream.writeBytes_frame _ _ _ (R := inR (H := H) s₀) (by - rw [bytesAt_length]; exact Region.contains_self _ _)) (by - simp only [List.mem_singleton]; rintro r rfl; exact hp.i_s.symm.sub_left (save_sub hp)) - (by simp only [List.mem_singleton]; rintro r rfl; exact ⟨inR (H := H) s₀, by simp, fun _ h => h⟩), c.mem⟩ - refine c.other r fun h => ?_ - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr h - rcases hr with rfl | rfl | rfl | rfl <;> rcases h with h | h | h <;> cases h - -/-- The MAC to `out`. -/ -theorem copy2_ok {s : State} (hk : KR (H := H) sc s₀ s) : - WP isa (copy .ebp H.buf .edi 0 H.D) s fun t => KR (H := H) sc s₀ t ∧ - t.mem = writeBytes s.mem ((op s₀).setWidth 64) (bytesAt s.mem (T (H := H) s₀) H.D) := by - have hD := hp.hD; have np := hp.np; have nw := hp.nw; have hf := hp.fits - obtain ⟨sR, _, pR⟩ := wr_mem hp - have tsub : Region.Sub ⟨T (H := H) s₀, H.D⟩ (scR sc s₀) := fun a h => t_sub hp a (Region.sub_prefix hD.2.1 a h) - refine WP.mono (copy_ok (so := H.buf) (d := 0) (n := H.D) (by decide) (by decide) - hD.1 (by omega_nat) (by rw [hk.ebp]; omega_nat) (by rw [hk.edi]; omega_nat) - (fun k hk' => by - rw [hk.ebp, hk.rd, hk.wr]; exact inRegions_of_sub (List.mem_append_right _ sR) tsub (by omega_nat) hk') - (fun k hk' => by rw [hk.edi, add_zero', hk.wr]; exact inRegions_of_sub pR (fun _ h => h) (by omega_nat) hk') - (by rw [hk.ebp, hk.edi, add_zero']; exact hp.p_s.symm.sub_left tsub)) fun t c => ?_ - rw [hk.edi, hk.ebp, add_zero'] at c - refine ⟨hk.keep c.rd c.wr (fun r hr => ?_) - (c.mem ▸ Proof.Sha256.Stream.writeBytes_frame _ _ _ (R := opR (H := H) s₀) (by - rw [bytesAt_length]; exact Region.contains_self _ _)) (by - simp only [List.mem_singleton]; rintro r rfl; exact hp.p_s.symm.sub_left (save_sub hp)) - (by simp only [List.mem_singleton]; rintro r rfl; exact ⟨opR (H := H) s₀, by simp, fun _ h => h⟩), c.mem⟩ - refine c.other r fun h => ?_ - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr h - rcases hr with rfl | rfl | rfl | rfl <;> rcases h with h | h | h <;> cases h - -/-! ## Correctness -/ - -theorem correct : WP isa H.finalize s₀ fun s' => abiPreserved s₀ s' ∧ (finG hH.SH sc).post s₀ s' := by - have hD := hp.hD; have hS := hp.hS; have hB := hp.hB - have hS' := hH.hS; have hD' := hH.hD; have hB' := hH.hB - obtain ⟨sR, iR, pR⟩ := wr_mem hp - have tsub : Region.Sub ⟨T (H := H) s₀, H.D⟩ (tR (H := H) s₀) := Region.sub_prefix hD.2.1 - refine WP.seq (WP.mono (pro_ok hp) fun s₁ ⟨k₁, si₁, f₁⟩ => ?_) - refine WP.seq (WP.seq (WP.mono (fin1Args_ok hH hp k₁) fun t₁ ⟨kt₁, a₁, st₁, m₁⟩ => - finCall_ok hH hp kt₁ a₁ fun s₂ k₂ si₂ f₂ d₂ => ?_)) - refine WP.seq (WP.mono (copy1_ok hp k₂ (by rw [si₂, st₁, si₁])) fun s₃ ⟨k₃, m₃⟩ => ?_) - refine WP.seq (WP.seq (WP.mono (updArgs_ok hH hp k₃) fun t₃ ⟨kt₃, a₃, mt₃⟩ => - updCall_ok hH hp kt₃ a₃ fun s₄ k₄ f₄ r₄ => ?_)) - refine WP.seq (WP.seq (WP.mono (fin2Args_ok hH hp k₄) fun t₄ ⟨kt₄, a₄, mt₄⟩ => - finCall_ok hH hp kt₄ a₄ fun s₅ k₅ _ f₅ d₅ => ?_)) - refine WP.seq (WP.mono (copy2_ok hp k₅) fun s₆ ⟨k₆, m₆⟩ => ?_) - have hL : 8 * H.W + 16 ≤ 8 * sc := by have := hp.fits; simp only [Hash.buf] at this; omega_nat - refine WP.mono (restore_ok H k₆.ebp k₆.saved (by rw [k₆.wr]; exact sR) hL hp.nw) - 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 (callee_saved r hr he) - -- The functional part. - intro k0 text hk0 hlen hrI hcnt hrO - rw [hH.hB] at hk0 hcnt - have hl0 : (xorPad k0 ipad ++ text).length = H.B + text.length := by - rw [List.length_append, xorPad_length, hk0] - -- The outer state is untouched until it is copied. - have oI : ∀ r ∈ [saveR H (scr s₀)], Region.Disjoint (outerR (H := H) s₀) r := by - simp only [List.mem_singleton]; rintro r rfl; exact hp.o_s.sub_right (save_sub hp) - have o₂ : ∀ r ∈ [inR (H := H) s₀, tR (H := H) s₀, calR hH s₀, stkR s₀], - Region.Disjoint (outerR (H := H) s₀) r := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - 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 (cal_sub hH hp) - · exact hp.b_o.symm - have rO₂ := Init.repr_keep hH f₂ o₂ (m₁ ▸ Init.repr_keep hH f₁ oI hrO) - -- The inner digest. - have dig := d₂ _ (m₁ ▸ Init.repr_keep 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 = countF s₀ from rfl, hcnt, hl0]) - -- The copy of the outer state. - have rI₃ : hH.SH.Repr s₃.mem ((inn s₀).setWidth 64) (xorPad k0 opad) := by - refine hH.repr _ _ _ _ _ (fun i hi => ?_) rO₂ - rw [m₃, writeBytes_at _ _ _ (by rw [bytesAt_length]; exact hi) (by rw [bytesAt_length]; omega_nat), - bytesAt_getD' _ _ hi] - have t₃ : bytesAt s₃.mem (T (H := H) s₀) H.D = bytesAt s₂.mem (T (H := H) s₀) H.D := by - rw [m₃] - exact bytes_keep (Proof.Sha256.Stream.writeBytes_frame _ _ _ (R := inR (H := H) s₀) (by - rw [bytesAt_length]; exact Region.contains_self _ _)) (by - simp only [List.mem_singleton]; rintro r rfl - exact (hp.i_s.sub_right (t_sub hp)).symm.sub_left tsub) (by omega_nat) - have rI₄ := r₄ _ (mt₃ ▸ rI₃) (by rw [xorPad_length, hk0]) - rw [mt₃, t₃] at rI₄ - have hl₄ : (xorPad k0 opad ++ bytesAt s₂.mem (T (H := H) s₀) H.D).length = H.B + H.D := by - rw [List.length_append, xorPad_length, hk0, bytesAt_length] - have dig₂ := d₅ _ (mt₄ ▸ rI₄) (by rw [hl₄]; omega_nat) (by rw [hl₄, zero_append_ofNat (by omega_nat)]) - show bytesAt s'.mem ((op s₀).setWidth 64) hH.SH.digestBytes = hmacBlockKey hH.SH.H k0 text - rw [hD', hm, m₆, bytesAt_writeBytes_self' (bytesAt_length _ _ _) (by omega_nat), bytesAt_take _ _ hD.2.1, dig₂, - bytesAt_take _ _ hD.2.1, dig] - rfl - end end VG.Proof.Hmac.Generic.X86.Finalize diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/FinalizeCT.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/FinalizeCT.lean deleted file mode 100644 index cc92741d2..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/FinalizeCT.lean +++ /dev/null @@ -1,479 +0,0 @@ -import VerifiedGarbage.Proof.Hmac.Generic.X86.Init -import VerifiedGarbage.Proof.Hmac.Generic.X86.Finalize -import VerifiedGarbage.Proof.Framework.OmegaLit - -/-! -# HMAC over any streaming hash function on x86 (32-bit): constant time - -Untrusted: everything here is checked by Lean. `init`, then `finalize`. --/ - -/-! -## `init` - -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 - -/-! -## `finalize` - -As for `init` (above): the pieces between the calls are -checked by the taint analysis, the prologue and the first call's arguments -reading the arguments on the stack (`argTaint`); the calls are related by -`fin_rel` and `upd_rel`. --/ - -namespace VG.Proof.Hmac.Generic.X86.Finalize - -open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash copy) -open VG.Proof.Hmac.Generic.X86 - -/-- 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.finPrologue) hc).isSome = true - fin1 : ∃ hc, (VG.Taint.check taint (argTaint [.ebp, .ebx, .edi] (4 + 4 * 6)) - (.block ([] ++ Hash.count1 ++ Impl.Hmac.Generic.X86.scr .edx H.buf)) hc).isSome = true - copy1 : ∃ hc, (VG.Taint.check taint (τr [.esp, .ebp, .ebx, .edi, .esi]) (copy .esi 0 .ebx 0 H.S) hc).isSome = true - upd : ∃ hc, (VG.Taint.check taint (τr [.esp, .ebp, .ebx, .edi]) - (.block ([] ++ ([.mov .eax (.imm 0), .mov .esi (.imm (BitVec.ofNat 32 H.B)), - .mov .ecx (.imm (BitVec.ofNat 32 H.D))] : List Instr) ++ Impl.Hmac.Generic.X86.scr .edx H.buf)) hc).isSome = true - fin2 : ∃ hc, (VG.Taint.check taint (τr [.esp, .ebp, .ebx, .edi]) - (.block ([] ++ H.count2 ++ Impl.Hmac.Generic.X86.scr .edx H.buf)) hc).isSome = true - copy2 : ∃ hc, (VG.Taint.check taint (τr [.esp, .ebp, .ebx, .edi]) (copy .ebp H.buf .edi 0 H.D) hc).isSome = true - restore : ∃ hc, (VG.Taint.check taint (τr [.ebp]) (.block H.restore) hc).isSome = true - -/-- The checks of the parts of `finalize` that do not depend on the size of -the digest carry over to a hash function of the same sizes but that one. -/ -theorem Checks.of_sizes {H H' : Hash} (hB : H.B = H'.B) (hS : H.S = H'.S) (hW : H.W = H'.W) (h : Checks H) - (upd : ∃ hc, (VG.Taint.check taint (τr [.esp, .ebp, .ebx, .edi]) - (.block ([] ++ ([.mov .eax (.imm 0), .mov .esi (.imm (BitVec.ofNat 32 H'.B)), - .mov .ecx (.imm (BitVec.ofNat 32 H'.D))] : List Instr) ++ Impl.Hmac.Generic.X86.scr .edx H'.buf)) hc).isSome = true) - (fin2 : ∃ hc, (VG.Taint.check taint (τr [.esp, .ebp, .ebx, .edi]) - (.block ([] ++ H'.count2 ++ Impl.Hmac.Generic.X86.scr .edx H'.buf)) hc).isSome = true) - (copy2 : ∃ hc, (VG.Taint.check taint (τr [.esp, .ebp, .ebx, .edi]) (copy .ebp H'.buf .edi 0 H'.D) hc).isSome = true) : - 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.pro, h.fin1, h.copy1, upd, fin2, copy2, h.restore⟩ - -/-- The public arguments are the same. -/ -structure PubEq (s₀ s₀' : State) : Prop where - esp : s₀.gpr .esp = s₀'.gpr .esp - args : ∀ i < 6, 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 6 s := by - have e : (⟨(s.gpr .esp).setWidth 64, 4 + 4 * 6⟩ : Region) = ⟨(E t).setWidth 64, 4 + 24⟩ := 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_p h.a_p - · exact Taint.frame_disjoint (by have := h.spf; omega_nat) 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, .ebx, .edi], 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 5 (by decide)] - · rw [h.ebx, h'.ebx, inn, inn, hq.args 0 (by decide)] - · rw [h.edi, h'.edi, op, op, hq.args 4 (by decide)] - -theorem sub_regs {l l' : List Reg} (h : ∀ r ∈ l, r ∈ l') {s s' : State} (hs : ∀ r ∈ l', s.gpr r = s'.gpr r) : - ∀ r ∈ l, s.gpr r = s'.gpr r := fun r hr => hs r (h r hr) - -include hH hc hp hp' hq - -theorem ct : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.finalize fun _ _ => True := by - have e5 : scr s₀' = scr s₀ := (hq.args 5 (by decide)).symm - have e0 : inn s₀' = inn s₀ := (hq.args 0 (by decide)).symm - have eT : tO (H := H) s₀' = tO (H := H) s₀ := by rw [tO, tO, e5] - have e2 : arg s₀' 2 = arg s₀ 2 := (hq.args 2 (by decide)).symm - have e3 : arg s₀' 3 = arg s₀ 3 := (hq.args 3 (by decide)).symm - -- The prologue. - have pro : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') (.block H.finPrologue) - fun s s' => (KR (H := H) sc s₀ s ∧ s.gpr .esi = outer s₀) ∧ (KR (H := H) sc s₀' s' ∧ s'.gpr .esi = outer s₀') := - rel_agree (argTaint [] (4 + 4 * 6)) (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 WP.mono (pro_ok hp) fun _ h => ⟨h.1, h.2.1⟩) - (fun _ e => by subst e; exact WP.mono (pro_ok hp') fun _ h => ⟨h.1, h.2.1⟩) - -- The first call. - have a1 : RelCT isa (fun s s' => (KR (H := H) sc s₀ s ∧ s.gpr .esi = outer s₀) ∧ - (KR (H := H) sc s₀' s' ∧ s'.gpr .esi = outer s₀')) - (.block ([] ++ Hash.count1 ++ Impl.Hmac.Generic.X86.scr .edx H.buf)) - fun s s' => (KR (H := H) sc s₀ s ∧ FinArgs hH s .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (arg s₀ 2) (arg s₀ 3) ∧ - s.gpr .esi = outer s₀) ∧ - (KR (H := H) sc s₀' s' ∧ FinArgs hH s' .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (arg s₀ 2) (arg s₀ 3) ∧ - s'.gpr .esi = outer s₀') := - rel_agree (argTaint [.ebp, .ebx, .edi] (4 + 4 * 6)) (fun s s' ⟨k, _⟩ ⟨k', _⟩ => - agree_argTaint (sub_regs (by decide) (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.fin1 - (fun _ ⟨k, si⟩ => WP.mono (fin1Args_ok hH hp k) fun _ ⟨k₁, a, s₁, _⟩ => ⟨k₁, a, s₁.trans si⟩) - (fun _ ⟨k, si⟩ => WP.mono (fin1Args_ok hH hp' k) fun _ ⟨k₁, a, s₁, _⟩ => - ⟨k₁, by rw [← e0, ← eT, ← e5, ← e2, ← e3]; exact a, s₁.trans si⟩) - have c1 : RelCT isa (fun s s' => (KR (H := H) sc s₀ s ∧ - FinArgs hH s .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (arg s₀ 2) (arg s₀ 3) ∧ s.gpr .esi = outer s₀) ∧ - (KR (H := H) sc s₀' s' ∧ FinArgs hH s' .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (arg s₀ 2) (arg s₀ 3) ∧ - s'.gpr .esi = outer s₀')) - (.frame (.push (fin5 .ebx)) (.call H.finN H.finC) (.pop .eax (fin5 .ebx).length)) - fun s s' => (KR (H := H) sc s₀ s ∧ s.gpr .esi = outer s₀) ∧ (KR (H := H) sc s₀' s' ∧ s'.gpr .esi = outer s₀') := - rel_wp (fin_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, si⟩ => finCall_ok hH hp k a fun _ k' si' _ _ => ⟨k', si'.trans si⟩) - (fun _ ⟨k, a, si⟩ => finCall_ok hH hp' k (by rw [e0, eT, e5]; exact a) - fun _ k' si' _ _ => ⟨k', si'.trans si⟩) - -- The copy of the outer state. - have cp1 : RelCT isa (fun s s' => (KR (H := H) sc s₀ s ∧ s.gpr .esi = outer s₀) ∧ - (KR (H := H) sc s₀' s' ∧ s'.gpr .esi = outer s₀')) (copy .esi 0 .ebx 0 H.S) - fun s s' => KR (H := H) sc s₀ s ∧ KR (H := H) sc s₀' s' := - rel_agree (τr [.esp, .ebp, .ebx, .edi, .esi]) (fun s s' ⟨k, si⟩ ⟨k', si'⟩ => agree_regs fun r hr => by - 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 k k' _ (by simp) - · exact kr_agree hq k k' _ (by simp) - · exact kr_agree hq k k' _ (by simp) - · exact kr_agree hq k k' _ (by simp) - · rw [si, si', outer, outer, hq.args 1 (by decide)]) hc.copy1 - (fun _ ⟨k, si⟩ => WP.mono (copy1_ok hp k si) fun _ h => h.1) - (fun _ ⟨k, si⟩ => WP.mono (copy1_ok hp' k si) fun _ h => h.1) - -- The call of `update`. - have au : RelCT isa (fun s s' => KR (H := H) sc s₀ s ∧ KR (H := H) sc s₀' s') - (.block ([] ++ ([.mov .eax (.imm 0), .mov .esi (.imm (BitVec.ofNat 32 H.B)), - .mov .ecx (.imm (BitVec.ofNat 32 H.D))] : List Instr) ++ Impl.Hmac.Generic.X86.scr .edx H.buf)) - fun s s' => (KR (H := H) sc s₀ s ∧ - UpdArgs hH s .esi .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (BitVec.ofNat 32 H.B) H.D) ∧ - (KR (H := H) sc s₀' s' ∧ - UpdArgs hH s' .esi .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (BitVec.ofNat 32 H.B) H.D) := - rel_agree (τr [.esp, .ebp, .ebx, .edi]) (fun s s' k k' => agree_regs (kr_agree hq k k')) hc.upd - (fun _ k => WP.mono (updArgs_ok hH hp k) fun _ ⟨k₁, a, _⟩ => ⟨k₁, a⟩) - (fun _ k => WP.mono (updArgs_ok hH hp' k) fun _ ⟨k₁, a, _⟩ => ⟨k₁, by rw [← e0, ← eT, ← e5]; exact a⟩) - have cu : RelCT isa (fun s s' => (KR (H := H) sc s₀ s ∧ - UpdArgs hH s .esi .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (BitVec.ofNat 32 H.B) H.D) ∧ - (KR (H := H) sc s₀' s' ∧ - UpdArgs hH s' .esi .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (BitVec.ofNat 32 H.B) H.D)) - (.frame (.push (upd6 .esi .ebx)) (.call H.updN H.updC) (.pop .eax (upd6 .esi .ebx).length)) - fun s s' => KR (H := H) sc s₀ s ∧ KR (H := H) sc s₀' s' := - rel_wp (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 a fun _ k' _ _ => k') - (fun _ ⟨k, a⟩ => updCall_ok hH hp' k (by rw [e0, eT, e5]; exact a) fun _ k' _ _ => k') - -- The second call of `finalize`. - have a2 : RelCT isa (fun s s' => KR (H := H) sc s₀ s ∧ KR (H := H) sc s₀' s') - (.block ([] ++ H.count2 ++ Impl.Hmac.Generic.X86.scr .edx H.buf)) - fun s s' => (KR (H := H) sc s₀ s ∧ - FinArgs hH s .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (BitVec.ofNat 32 (H.B + H.D)) 0) ∧ - (KR (H := H) sc s₀' s' ∧ - FinArgs hH s' .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (BitVec.ofNat 32 (H.B + H.D)) 0) := - rel_agree (τr [.esp, .ebp, .ebx, .edi]) (fun s s' k k' => agree_regs (kr_agree hq k k')) hc.fin2 - (fun _ k => WP.mono (fin2Args_ok hH hp k) fun _ ⟨k₁, a, _⟩ => ⟨k₁, a⟩) - (fun _ k => WP.mono (fin2Args_ok hH hp' k) fun _ ⟨k₁, a, _⟩ => ⟨k₁, by rw [← e0, ← eT, ← e5]; exact a⟩) - have c2 : RelCT isa (fun s s' => (KR (H := H) sc s₀ s ∧ - FinArgs hH s .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (BitVec.ofNat 32 (H.B + H.D)) 0) ∧ - (KR (H := H) sc s₀' s' ∧ - FinArgs hH s' .ebx (inn s₀) (tO (H := H) s₀) (scr s₀) (BitVec.ofNat 32 (H.B + H.D)) 0)) - (.frame (.push (fin5 .ebx)) (.call H.finN H.finC) (.pop .eax (fin5 .ebx).length)) - fun s s' => KR (H := H) sc s₀ s ∧ KR (H := H) sc s₀' s' := - rel_wp (fin_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⟩ => finCall_ok hH hp k a fun _ k' _ _ _ => k') - (fun _ ⟨k, a⟩ => finCall_ok hH hp' k (by rw [e0, eT, e5]; exact a) fun _ k' _ _ _ => k') - -- The copy of the MAC, and the end. - have cp2 : RelCT isa (fun s s' => KR (H := H) sc s₀ s ∧ KR (H := H) sc s₀' s') (copy .ebp H.buf .edi 0 H.D) - fun s s' => KR (H := H) sc s₀ s ∧ KR (H := H) sc s₀' s' := - rel_agree (τr [.esp, .ebp, .ebx, .edi]) (fun s s' k k' => agree_regs (kr_agree hq k k')) hc.copy2 - (fun _ k => WP.mono (copy2_ok hp k) fun _ h => h.1) - (fun _ k => WP.mono (copy2_ok hp' k) fun _ h => h.1) - 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.restore) - fun _ _ => True := - RelCT.taint (A := taint) (τr [.ebp]) (fun _ _ h => - agree_regs (sub_regs (by decide) (kr_agree hq h.1 h.2))) hr - exact pro.seq ((a1.seq c1).seq (cp1.seq ((au.seq cu).seq ((a2.seq c2).seq (cp2.seq restore))))) - -end VG.Proof.Hmac.Generic.X86.Finalize - -namespace VG.Proof.Hmac.Generic.X86.Finalize - -open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash) -open VG.Proof.Hmac.Generic.X86 - -/-- `finalize` is verified against `finG`, 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 + H.F ≤ 8 * sc) (hsat : ∃ s, (finG hH.SH sc).pre s) : - Verified X86.target H.finalize (finG 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 `finalize` reads and writes, of those `finW` gives it. -/ -def narrowRd (S : Nat) (s : State) : List Region := [⟨(arg s 1).setWidth 64, S⟩, ⟨argAddr s 0, 24⟩] -def narrowWr (S D sc : Nat) (s : State) : List Region := - [⟨(arg s 0).setWidth 64, S⟩, ⟨(arg s 4).setWidth 64, D⟩, ⟨(arg s 5).setWidth 64, 8 * sc⟩] - -/-- `finalize` is verified against `finW`, 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 + H.F ≤ 8 * sc) (hsat : ∃ s, (finW hH.SH sc).pre s) : - Verified X86.target H.finalize (finW hH.SH sc) := by - have pre : ∀ s, (finW hH.SH sc).pre s → (finG hH.SH sc).pre - (s.withRegions (narrowRd hH.SH.stateBytes s) (narrowWr hH.SH.stateBytes hH.SH.digestBytes sc s)) := by - intro s h - obtain ⟨_, _, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, h21, - h22, h23⟩ := h - simp only [finG, narrowRd, narrowWr, arg_withRegions, argAddr_withRegions, State.withRegions_gpr, - State.withRegions_rd, State.withRegions_wr] - exact ⟨trivial, trivial, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, - h21, h22, h23⟩ - refine Verified.narrowTo (verified hH hc hfit (hsat.elim fun s hs => ⟨_, pre s hs⟩)) - (narrowRd hH.SH.stateBytes) (narrowWr hH.SH.stateBytes hH.SH.digestBytes 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.Finalize diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hash.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hash.lean index 2e4e384d8..e9805433f 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hash.lean +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hash.lean @@ -4,7 +4,7 @@ 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.Pbkdf2.Generic.X86 +import VerifiedGarbage.Impl.Hmac.Generic.X86 import VerifiedGarbage.Proof.Framework.OmegaLit /-! diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/InitCT.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/InitCT.lean new file mode 100644 index 000000000..7c00b5ae0 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/InitCT.lean @@ -0,0 +1,225 @@ +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 + +Untrusted: everything here is checked by Lean. +-/ + +/-! +## `init` + +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 index f449a7b02..4f95c297c 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Instances.lean @@ -1,16 +1,16 @@ import VerifiedGarbage.Proof.Framework.Contract import VerifiedGarbage.Proof.Hmac.Generic.X86.Lit -import VerifiedGarbage.Proof.Hmac.Generic.X86.FinalizeCT +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 +# HMAC over the streaming hash functions on x86 (32-bit): the instances of `init` -Untrusted: everything here is checked by Lean. As on the other targets -(`Proof/Hmac/Generic/Arm/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. +Untrusted: everything here is checked by Lean. 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 @@ -37,26 +37,6 @@ def initSat (S sc : Nat) : State where rd := [⟨0x1800, 0⟩] wr := [⟨0x1000, S⟩, ⟨0x1400, S⟩, ⟨0x2000, 8 * sc⟩, ⟨0x6004, 20⟩] -/-- Memory holding the arguments `0x1000, 0x1400, 0, 0, 0x1800, 0x2000` of -`finalize` at `0x6004`. -/ -def finMem : Mem := fun a => - if a = 0x6005 then 0x10 else if a = 0x6009 then 0x14 else if a = 0x6015 then 0x18 else - if a = 0x6019 then 0x20 else 0 - -/-- A state satisfying `finalize`'s precondition, with states of `S` bytes, -a digest of `D` bytes and `8 sc` bytes of scratch space, with the arguments -writable. -/ -def finSat (S D sc : Nat) : State where - gpr r := match r with - | .esp => 0x6000 | _ => 0 - cf := none - zf := none - sf := none - of := none - mem := finMem - rd := [⟨0x1400, S⟩] - wr := [⟨0x1000, S⟩, ⟨0x1800, D⟩, ⟨0x2000, 8 * sc⟩, ⟨0x6004, 24⟩] - 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 ∧ @@ -66,15 +46,6 @@ theorem initSat_args (S sc : Nat) : rw [e, e, e, e, e, e'] refine ⟨?_, ?_, ?_, ?_, ?_, ?_, rfl⟩ <;> decide -theorem finSat_args (S D sc : Nat) : - arg (finSat S D sc) 0 = 0x1000 ∧ arg (finSat S D sc) 1 = 0x1400 ∧ arg (finSat S D sc) 2 = 0 ∧ - arg (finSat S D sc) 3 = 0 ∧ arg (finSat S D sc) 4 = 0x1800 ∧ arg (finSat S D sc) 5 = 0x2000 ∧ - argAddr (finSat S D sc) 0 = 0x6004 ∧ (finSat S D sc).gpr .esp = 0x6000 := by - have e : ∀ i, arg (finSat S D sc) i = arg (finSat 0 0 0) i := fun _ => rfl - have e' : argAddr (finSat S D sc) 0 = argAddr (finSat 0 0 0) 0 := rfl - rw [e, e, e, e, e, e, e'] - refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, rfl⟩ <;> decide - /-! ## SHA-1 -/ theorem sha1_initChecks : Init.Checks sha1H where @@ -85,15 +56,6 @@ theorem sha1_initChecks : Init.Checks sha1H where rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ restore := ⟨_, by taint_decide⟩ -theorem sha1_finChecks : Finalize.Checks sha1H where - pro := ⟨_, by taint_decide⟩ - fin1 := ⟨_, by taint_decide⟩ - copy1 := ⟨_, by taint_decide⟩ - upd := ⟨_, by taint_decide⟩ - fin2 := ⟨_, by taint_decide⟩ - copy2 := ⟨_, 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, @@ -101,19 +63,9 @@ theorem sha1_initImp : (initW Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.initC X86.argBytes] [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 84 56 -theorem sha1_finImp : (finW Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.finalizeContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 84 20 56 - sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, - Spec.Hmac.sha1I, Spec.Hmac.sha1S, Spec.Hmac.sha1, finW, finG, countF, X86.abi, X86.argSlots, - X86.argVal, X86.argBytes] - [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 84 20 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 -theorem sha1_finalize : Verified X86.target sha1H.finalize (Spec.Hmac.sha1I.finalizeContract X86.abi 48) := - (Finalize.verifiedW sha1OK sha1_finChecks (by decide) sha1_finImp.sat_left).of_implies sha1_finImp - /-! ## MD5 -/ theorem md5_initChecks : Init.Checks md5H where @@ -124,15 +76,6 @@ theorem md5_initChecks : Init.Checks md5H where rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ restore := ⟨_, by taint_decide⟩ -theorem md5_finChecks : Finalize.Checks md5H where - pro := ⟨_, by taint_decide⟩ - fin1 := ⟨_, by taint_decide⟩ - copy1 := ⟨_, by taint_decide⟩ - upd := ⟨_, by taint_decide⟩ - fin2 := ⟨_, by taint_decide⟩ - copy2 := ⟨_, 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, @@ -140,19 +83,9 @@ theorem md5_initImp : (initW Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.initCont X86.argBytes] [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 80 48 -theorem md5_finImp : (finW Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.finalizeContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 80 16 48 - sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, - Spec.Hmac.md5I, Spec.Hmac.md5S, Spec.Hmac.md5, finW, finG, countF, X86.abi, X86.argSlots, - X86.argVal, X86.argBytes] - [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 80 16 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 -theorem md5_finalize : Verified X86.target md5H.finalize (Spec.Hmac.md5I.finalizeContract X86.abi 48) := - (Finalize.verifiedW md5OK md5_finChecks (by decide) md5_finImp.sat_left).of_implies md5_finImp - /-- `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 @@ -171,15 +104,6 @@ theorem sha384_initChecks : Init.Checks sha384H where rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ restore := ⟨_, by taint_decide⟩ -theorem sha384_finChecks : Finalize.Checks sha384H where - pro := ⟨_, by taint_decide⟩ - fin1 := ⟨_, by taint_decide⟩ - copy1 := ⟨_, by taint_decide⟩ - upd := ⟨_, by taint_decide⟩ - fin2 := ⟨_, by taint_decide⟩ - copy2 := ⟨_, 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, @@ -187,28 +111,14 @@ theorem sha384_initImp : (initW Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384 X86.argBytes] [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 192 234 -theorem sha384_finImp : (finW Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I.finalizeContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 192 48 234 - sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, - Spec.Hmac.sha384I, Spec.Hmac.sha384S, Spec.Hmac.sha384, finW, finG, countF, X86.abi, X86.argSlots, - X86.argVal, X86.argBytes] - [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 192 48 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 -theorem sha384_finalize : Verified X86.target sha384H.finalize (Spec.Hmac.sha384I.finalizeContract X86.abi 48) := - (Finalize.verifiedW sha384OK sha384_finChecks (by decide) sha384_finImp.sat_left).of_implies sha384_finImp - /-! ## SHA-512 -/ theorem sha512_initChecks : Init.Checks sha512H' := Init.Checks.of_eq (H := sha384H) rfl rfl rfl sha384_initChecks -theorem sha512_finChecks : Finalize.Checks sha512H' := - Finalize.Checks.of_sizes (H := sha384H) rfl rfl rfl sha384_finChecks ⟨_, by taint_decide⟩ ⟨_, by taint_decide⟩ - ⟨_, 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, @@ -216,28 +126,14 @@ theorem sha512_initImp : (initW Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512 X86.argBytes] [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 192 234 -theorem sha512_finImp : (finW Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I.finalizeContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 192 64 234 - sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, - Spec.Hmac.sha512I, Spec.Hmac.sha512S, Spec.Hmac.sha512, finW, finG, countF, X86.abi, X86.argSlots, - X86.argVal, X86.argBytes] - [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 192 64 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 -theorem sha512_finalize : Verified X86.target sha512H'.finalize (Spec.Hmac.sha512I.finalizeContract X86.abi 48) := - (Finalize.verifiedW sha512OK sha512_finChecks (by decide) sha512_finImp.sat_left).of_implies sha512_finImp - /-! ## 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_finChecks : Finalize.Checks sha512_224H := - Finalize.Checks.of_sizes (H := sha384H) rfl rfl rfl sha384_finChecks ⟨_, by taint_decide⟩ ⟨_, by taint_decide⟩ - ⟨_, 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, @@ -245,28 +141,14 @@ theorem sha512_224_initImp : (initW Spec.Hmac.sha512_224S 234).Implies (Spec.Hma X86.argBytes] [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 192 234 -theorem sha512_224_finImp : (finW Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac.sha512_224I.finalizeContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 192 28 234 - sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, - Spec.Hmac.sha512_224I, Spec.Hmac.sha512_224S, Spec.Hmac.sha512_224, finW, finG, countF, X86.abi, X86.argSlots, - X86.argVal, X86.argBytes] - [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 192 28 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 -theorem sha512_224_finalize : Verified X86.target sha512_224H.finalize (Spec.Hmac.sha512_224I.finalizeContract X86.abi 48) := - (Finalize.verifiedW sha512_224OK sha512_224_finChecks (by decide) sha512_224_finImp.sat_left).of_implies sha512_224_finImp - /-! ## 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_finChecks : Finalize.Checks sha512_256H := - Finalize.Checks.of_sizes (H := sha384H) rfl rfl rfl sha384_finChecks ⟨_, by taint_decide⟩ ⟨_, by taint_decide⟩ - ⟨_, 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, @@ -274,17 +156,7 @@ theorem sha512_256_initImp : (initW Spec.Hmac.sha512_256S 234).Implies (Spec.Hma X86.argBytes] [a0, a1, a2, a3, a4, e, esp, initSat] using initSat 192 234 -theorem sha512_256_finImp : (finW Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac.sha512_256I.finalizeContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 192 32 234 - sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, - Spec.Hmac.sha512_256I, Spec.Hmac.sha512_256S, Spec.Hmac.sha512_256, finW, finG, countF, X86.abi, X86.argSlots, - X86.argVal, X86.argBytes] - [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 192 32 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 -theorem sha512_256_finalize : Verified X86.target sha512_256H.finalize (Spec.Hmac.sha512_256I.finalizeContract X86.abi 48) := - (Finalize.verifiedW sha512_256OK sha512_256_finChecks (by decide) sha512_256_finImp.sat_left).of_implies sha512_256_finImp - 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 index 9a51fef8f..bd55c79c0 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Lit.lean +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Lit.lean @@ -1,35 +1,23 @@ import VerifiedGarbage.Proof.Framework.X86.Lit import VerifiedGarbage.Proof.Hmac.Generic.X86.Hashes -import VerifiedGarbage.Impl.Pbkdf2.Generic.X86 /-! -# HMAC and PBKDF2 over every hash on X86: the code as literals +# HMAC over every hash on X86: `init` as literals -Untrusted: everything here is checked by Lean. HMAC's `init` and `finalize` -and PBKDF2's `iterate` 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. +Untrusted: everything here is checked by Lean. 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 sha1HFinalize := sha1H.finalize materialize_code md5HInit := md5H.init -materialize_code md5HFinalize := md5H.finalize materialize_code sha384HInit := sha384H.init -materialize_code sha384HFinalize := sha384H.finalize materialize_code sha512HInit := sha512H'.init -materialize_code sha512HFinalize := sha512H'.finalize materialize_code sha512_224HInit := sha512_224H.init -materialize_code sha512_224HFinalize := sha512_224H.finalize materialize_code sha512_256HInit := sha512_256H.init -materialize_code sha512_256HFinalize := sha512_256H.finalize -materialize_code sha1HIterate := Impl.Pbkdf2.Generic.X86.iterate sha1H -materialize_code md5HIterate := Impl.Pbkdf2.Generic.X86.iterate md5H -materialize_code sha384HIterate := Impl.Pbkdf2.Generic.X86.iterate sha384H -materialize_code sha512HIterate := Impl.Pbkdf2.Generic.X86.iterate sha512H' -materialize_code sha512_224HIterate := Impl.Pbkdf2.Generic.X86.iterate sha512_224H -materialize_code sha512_256HIterate := Impl.Pbkdf2.Generic.X86.iterate sha512_256H end VG.Proof.Hmac.Generic.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Instances.lean deleted file mode 100644 index 46c82e8df..000000000 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Instances.lean +++ /dev/null @@ -1,219 +0,0 @@ -import VerifiedGarbage.Proof.Framework.Contract -import VerifiedGarbage.Proof.Hmac.Generic.X86.Lit -import VerifiedGarbage.Proof.Pbkdf2.Generic.X86.IterateCT -import VerifiedGarbage.Proof.Hmac.Generic.X86.Hashes - -/-! -# PBKDF2-HMAC over the streaming hash functions on x86 (32-bit): the instances - -Untrusted: everything here is checked by Lean. As on 32-bit ARM -(`Proof/Pbkdf2/Generic/Arm/Instances.lean`): the generic proof -(`IterateCT.lean`) at each hash function of -`Proof/Hmac/Generic/X86/Hashes.lean`, moved to the shared contract of -`Spec/Pbkdf2/Generic.lean` (`sig_implies`), which the artifacts are emitted with. --/ - -namespace VG.Proof.Pbkdf2.Generic.X86.Instances - -open VG.X86 -open VG.Proof.Hmac.Generic.X86 -open VG.Proof.Pbkdf2.Generic.X86 - -/-- Memory holding the arguments `0x1000, 0x1400, 0, 0x1800, 0x2000` of -`iterate` at `0x6004`. -/ -def iterMem : Mem := fun a => - if a = 0x6005 then 0x10 else if a = 0x6009 then 0x14 else if a = 0x6011 then 0x18 else - if a = 0x6015 then 0x20 else 0 - -/-- A state satisfying `iterate`'s precondition, with states of `S` bytes, a -digest of `D` bytes and `8 sc` bytes of scratch space, with the arguments -writable. -/ -def iterSat (S D sc : Nat) : State where - gpr r := match r with - | .esp => 0x6000 | _ => 0 - cf := none - zf := none - sf := none - of := none - mem := iterMem - rd := [⟨0x1000, 2 * S⟩, ⟨0x1400, D⟩] - wr := [⟨0x1800, D⟩, ⟨0x2000, 8 * sc⟩, ⟨0x6004, 20⟩] - -theorem iterSat_args (S D sc : Nat) : - arg (iterSat S D sc) 0 = 0x1000 ∧ arg (iterSat S D sc) 1 = 0x1400 ∧ arg (iterSat S D sc) 2 = 0 ∧ - arg (iterSat S D sc) 3 = 0x1800 ∧ arg (iterSat S D sc) 4 = 0x2000 ∧ argAddr (iterSat S D sc) 0 = 0x6004 ∧ - (iterSat S D sc).gpr .esp = 0x6000 := by - have e : ∀ i, arg (iterSat S D sc) i = arg (iterSat 0 0 0) i := fun _ => rfl - have e' : argAddr (iterSat S D sc) 0 = argAddr (iterSat 0 0 0) 0 := rfl - rw [e, e, e, e, e, e'] - refine ⟨?_, ?_, ?_, ?_, ?_, ?_, rfl⟩ <;> decide - -/-! ## SHA-1 -/ - -theorem sha1_checks : Checks sha1H where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha1_imp : (iterW Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.iterateContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 84 20 56 - sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, - Spec.Hmac.sha1I, Spec.Hmac.sha1S, Spec.Hmac.sha1, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 84 20 56 - -theorem sha1 : Verified X86.target (Impl.Pbkdf2.Generic.X86.iterate sha1H) - (Spec.Hmac.sha1I.iterateContract X86.abi 48) := - (verifiedW sha1OK sha1_checks (by decide) sha1_imp.sat_left).of_implies sha1_imp - -/-! ## MD5 -/ - -theorem md5_checks : Checks md5H where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem md5_imp : (iterW Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.iterateContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 80 16 48 - sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, - Spec.Hmac.md5I, Spec.Hmac.md5S, Spec.Hmac.md5, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 80 16 48 - -theorem md5 : Verified X86.target (Impl.Pbkdf2.Generic.X86.iterate md5H) - (Spec.Hmac.md5I.iterateContract X86.abi 48) := - (verifiedW md5OK md5_checks (by decide) md5_imp.sat_left).of_implies md5_imp - -/-! ## SHA-384 -/ - -theorem sha384_checks : Checks sha384H where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha384_imp : (iterW Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I.iterateContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 192 48 234 - sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, - Spec.Hmac.sha384I, Spec.Hmac.sha384S, Spec.Hmac.sha384, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 192 48 234 - -theorem sha384 : Verified X86.target (Impl.Pbkdf2.Generic.X86.iterate sha384H) - (Spec.Hmac.sha384I.iterateContract X86.abi 48) := - (verifiedW sha384OK sha384_checks (by decide) sha384_imp.sat_left).of_implies sha384_imp - -/-! ## SHA-512 -/ - -theorem sha512_checks : Checks sha512H' where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha512_imp : (iterW Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I.iterateContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 192 64 234 - sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, - Spec.Hmac.sha512I, Spec.Hmac.sha512S, Spec.Hmac.sha512, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 192 64 234 - -theorem sha512 : Verified X86.target (Impl.Pbkdf2.Generic.X86.iterate sha512H') - (Spec.Hmac.sha512I.iterateContract X86.abi 48) := - (verifiedW sha512OK sha512_checks (by decide) sha512_imp.sat_left).of_implies sha512_imp - -/-! ## SHA-512/224 -/ - -theorem sha512_224_checks : Checks sha512_224H where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha512_224_imp : (iterW Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac.sha512_224I.iterateContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 192 28 234 - sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, - Spec.Hmac.sha512_224I, Spec.Hmac.sha512_224S, Spec.Hmac.sha512_224, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 192 28 234 - -theorem sha512_224 : Verified X86.target (Impl.Pbkdf2.Generic.X86.iterate sha512_224H) - (Spec.Hmac.sha512_224I.iterateContract X86.abi 48) := - (verifiedW sha512_224OK sha512_224_checks (by decide) sha512_224_imp.sat_left).of_implies sha512_224_imp - -/-! ## SHA-512/256 -/ - -theorem sha512_256_checks : Checks sha512_256H where - pro := ⟨_, by taint_decide⟩ - copyU := ⟨_, by taint_decide⟩ - copyK := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - upd := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - fin := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro o (rfl | rfl) <;> exact ⟨_, by taint_decide⟩ - xor := ⟨_, by taint_decide⟩ - restore := ⟨_, by taint_decide⟩ - -theorem sha512_256_imp : (iterW Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac.sha512_256I.iterateContract X86.abi 48) := by - obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 192 32 234 - sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, - Spec.Hmac.sha512_256I, Spec.Hmac.sha512_256S, Spec.Hmac.sha512_256, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 192 32 234 - -theorem sha512_256 : Verified X86.target (Impl.Pbkdf2.Generic.X86.iterate sha512_256H) - (Spec.Hmac.sha512_256I.iterateContract X86.abi 48) := - (verifiedW sha512_256OK sha512_256_checks (by decide) sha512_256_imp.sat_left).of_implies sha512_256_imp - -end VG.Proof.Pbkdf2.Generic.X86.Instances diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Iterate.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Iterate.lean deleted file mode 100644 index 86a6ad8e6..000000000 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/Iterate.lean +++ /dev/null @@ -1,770 +0,0 @@ -import VerifiedGarbage.Impl.Pbkdf2.Generic.X86 -import VerifiedGarbage.Proof.Hmac.Generic.X86.Finalize - -/-! -# PBKDF2-HMAC over any streaming hash function on x86 (32-bit): `iterate`, correct - -Untrusted: everything here is checked by Lean. As on 32-bit ARM -(`Proof/Pbkdf2/Generic/Arm/Instances.lean`). The arguments are on the stack: -`scratch`, `n` and `u` are loaded first (after our caller's registers are -saved in `scratch`), and `key` and `t` again in each step, when needed. The -loop counts the steps left in `edi` down with `sub`, and branches on its -result. --/ - -namespace VG.Proof.Pbkdf2.Generic.X86 - -open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash copy at_) -open VG.Impl.Pbkdf2.Generic.X86 (stO tmpO uO xorLoop atSt ldKey ldT body prologue iterate) -open VG.Proof.Hmac.Generic.X86 -open VG.Proof.Hmac.Generic.X86.Finalize (add_zero') -open VG.Proof.Hmac.Generic.X86.Init (argW) -open VG.Proof.Hmac.Generic.Common (inRegions_of_sub xorBytes_length' sub_of_off sub_of_self bytes_keep - bytesAt_take bytesAt_writeBytes_self') -open VG.Proof.Sha256.X86.Stream (Upd Fupd wp_mov wp_movi wp_movm wp_add wp_addi wp_subi wp_test sub_offset - ofNat_beq_zero sub_ofNat eval_e eval_ne) -open VG.Proof.Hmac.Common (bytesAt_length writeBytes_at bytesAt_getD' xorPad_length) -open VG.Proof.Sha256.Stream (writeBytes) -open Spec.Sha256 (bytesAt) -open Spec.Hmac (xorPad ipad opad hmacBlockKey) - -variable {H : Hash} (hH : HashOK H) (sc : Nat) - -section -variable (s₀ : State) - -abbrev E : BitVec 32 := s₀.gpr .esp -abbrev key : BitVec 32 := arg s₀ 0 -abbrev up : BitVec 32 := arg s₀ 1 -abbrev tp : BitVec 32 := arg s₀ 3 -abbrev scr : BitVec 32 := arg s₀ 4 -/-- The number of steps. -/ -abbrev nn : Nat := (arg s₀ 2).toNat -abbrev keyR : Region := ⟨(key s₀).setWidth 64, 2 * H.S⟩ -abbrev uR : Region := ⟨(up s₀).setWidth 64, H.D⟩ -abbrev tR : Region := ⟨(tp s₀).setWidth 64, H.D⟩ -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 -/-- Byte `o` of `scratch`, and its address as a register holds it. -/ -abbrev SA (o : Nat) : Addr := (scr s₀).setWidth 64 + BitVec.ofNat 64 o -abbrev sO (o : Nat) : BitVec 32 := scr s₀ + BitVec.ofNat 32 o -/-- The state being hashed, the inner digest and `U`, in `scratch`. -/ -abbrev ST : Addr := SA s₀ (stO H) -abbrev TM : Addr := SA s₀ (tmpO H) -abbrev UA : Addr := SA s₀ (uO H) -abbrev calR : Region := ⟨(scr s₀).setWidth 64, hH.Wb⟩ - -end - -/-- The precondition, with the sizes of `H`. -/ -structure Pre (s₀ : State) : Prop where - rd : s₀.rd = [keyR (H := H) s₀, uR (H := H) s₀, argR s₀] - wr : s₀.wr = [tR (H := H) s₀, scR sc s₀] - k_t : (keyR (H := H) s₀).Disjoint (tR (H := H) s₀) - k_s : (keyR (H := H) s₀).Disjoint (scR sc s₀) - u_t : (uR (H := H) s₀).Disjoint (tR (H := H) s₀) - u_s : (uR (H := H) s₀).Disjoint (scR sc s₀) - t_s : (tR (H := H) s₀).Disjoint (scR sc s₀) - a_t : (argR s₀).Disjoint (tR (H := H) s₀) - a_s : (argR s₀).Disjoint (scR sc s₀) - r_t : (retR s₀).Disjoint (tR (H := H) s₀) - r_s : (retR s₀).Disjoint (scR sc s₀) - b_k : (stkR s₀).Disjoint (keyR (H := H) s₀) - b_u : (stkR s₀).Disjoint (uR (H := H) s₀) - b_t : (stkR s₀).Disjoint (tR (H := H) s₀) - b_s : (stkR s₀).Disjoint (scR sc s₀) - nk : (key s₀).toNat + 2 * H.S ≤ 2 ^ 32 - nu : (up s₀).toNat + H.D ≤ 2 ^ 32 - nt : (tp s₀).toNat + H.D ≤ 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 + H.S + 2 * H.F ≤ 8 * sc - hB : 0 < H.B ∧ H.B ≤ 128 - hW : H.W ≤ 64 - hS : 0 < H.S ∧ H.S ≤ 256 - hD : 0 < H.D ∧ H.D ≤ H.F ∧ H.F ≤ 64 - -theorem pre_of {s₀ : State} (h : (iterG hH.SH sc).pre s₀) (hfit : H.buf + H.S + 2 * H.F ≤ 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⟩ := h - have hS := hH.hS - have hD := hH.hD - have e : (⟨(s₀.gpr .esp).setWidth 64 - 48, 48⟩ : Region) = stkR s₀ := by - simp only [stkR, below]; rw [Taint.sub_setWidth h19]; rfl - simp only [hS, hD, e] at * - exact ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, hfit, - ⟨hH.hB0, hH.hBB⟩, hH.hW, ⟨hH.hS0, hH.hSB⟩, ⟨hH.hD0, hH.hDF, hH.hF⟩⟩ - -/-! ## The parts of `scratch` -/ - -section -variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) -include hp - -theorem bounds : H.buf = 8 * H.W + 16 ∧ H.buf + H.S + 2 * H.F ≤ 8 * sc ∧ (scr s₀).toNat + 8 * sc ≤ 2 ^ 32 ∧ - H.W ≤ 64 ∧ 0 < H.S ∧ H.S ≤ 256 ∧ 0 < H.D ∧ H.D ≤ H.F ∧ H.F ≤ 64 ∧ 0 < H.B ∧ H.B ≤ 128 := - ⟨rfl, hp.fits, hp.nw, hp.hW, hp.hS.1, hp.hS.2, hp.hD.1, hp.hD.2.1, hp.hD.2.2, hp.hB.1, hp.hB.2⟩ - -theorem off_sub {o n : Nat} (h : o + n ≤ 8 * sc) : - Region.Sub ⟨SA s₀ o, n⟩ (scR sc s₀) := - sub_offset h (by have := hp.nw; omega) - -theorem addr_sO {o : Nat} (h : o < 8 * sc) : (sO s₀ o).setWidth 64 = SA s₀ o := - setWidth_add (by have := hp.nw; omega) - -theorem toNat_sO {o : Nat} (h : o < 8 * sc) : (sO s₀ o).toNat = (scr s₀).toNat + o := - toNat_add_ofNat (by have := hp.nw; omega) - -theorem save_sub : Region.Sub (saveR H (scr s₀)) (scR sc s₀) := by - obtain ⟨hb, hf, -⟩ := bounds hp; exact off_sub hp (by omega) - -theorem st_sub : Region.Sub ⟨ST (H := H) s₀, H.S⟩ (scR sc s₀) := by - obtain ⟨hb, hf, -⟩ := bounds hp; exact off_sub hp (by simp only [stO]; omega) - -theorem tm_sub : Region.Sub ⟨TM (H := H) s₀, H.F⟩ (scR sc s₀) := by - obtain ⟨hb, hf, -⟩ := bounds hp; exact off_sub hp (by simp only [tmpO]; omega) - -theorem ua_sub : Region.Sub ⟨UA (H := H) s₀, H.F⟩ (scR sc s₀) := by - obtain ⟨hb, hf, -⟩ := bounds hp; exact off_sub hp (by simp only [uO]; omega) - -include hH in -theorem cal_sub : Region.Sub (calR hH s₀) (scR sc s₀) := by - have := hH.hWb; obtain ⟨hb, hf, -⟩ := bounds hp - exact Region.sub_prefix (by omega) - -/-- The parts of `scratch` do not overlap. -/ -theorem part_disj {a m b n : Nat} (h : a + m ≤ b ∨ b + n ≤ a) (ha : a + m ≤ 8 * sc) (hb : b + n ≤ 8 * sc) : - Region.Disjoint ⟨SA s₀ a, m⟩ ⟨SA s₀ b, n⟩ := - VG.Proof.Hmac.Generic.Common.off_disj _ h (by have := hp.nw; omega) (by have := hp.nw; omega) - -include hH in -theorem cal_disj {b n : Nat} (h : 8 * H.W ≤ b) (hb : b + n ≤ 8 * sc) : - (calR hH s₀).Disjoint ⟨SA s₀ b, n⟩ := by - have := hH.hWb; have := hp.nw - exact VG.Proof.Hmac.Generic.Common.off_disj0 _ (by omega) (by omega) - -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) - -end - -/-! ## What the pieces keep -/ - -/-- The regions everything writes: `T`, `scratch` and the stack below `esp`. -/ -abbrev wrs (s₀ : State) : List Region := [tR (H := H) s₀, scR sc s₀, stkR s₀] - -/-- The registers and memory kept from the prologue on, with `m` steps left. -/ -structure KR (s₀ : State) (m : Nat) (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₀ - edi : s.gpr .edi = BitVec.ofNat 32 m - 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, .edi] - -theorem kregs_callee : ∀ r ∈ kregs, r ∈ calleeSaved := by decide -theorem kregs_clob : ∀ r ∈ kregs, r ∉ clob := by decide - -section -variable {sc : Nat} - -theorem KR.keep {s₀ : State} {m : Nat} {s s' : State} (h : KR (H := H) sc s₀ m 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₀ m 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.edi, h.saved.frame H hf hs, h.frame.trans (hf.sub hsub)⟩ - -theorem KR.upd {s₀ : State} {m : Nat} {s s' : State} (h : KR (H := H) sc s₀ m s) {d : Reg} (hd : d ∉ kregs) - {v : BitVec 32} (u : Upd s s' d v) : KR (H := H) sc s₀ m 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₀ : State} {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m 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 mem_wr : scR sc s₀ ∈ s₀.wr ∧ tR (H := H) s₀ ∈ s₀.wr := by rw [hp.wr]; simp - -theorem argR_in : argR s₀ ∈ s₀.rd ++ s₀.wr := by rw [hp.rd]; simp - -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) (by have := hp.spf; omega)⟩ - -theorem KR.argEq {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m 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) hk.frame (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact hp.a_t - · exact hp.a_s - · exact (stk_arg hp).symm) (by omega) - -theorem KR.readArg {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m 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 - -theorem KR.ret {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m 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) - · exact hp.r_t - · exact hp.r_s - · exact (stk_ret' hp).symm) (by decide) - -theorem KR.call {m : Nat} {s s' : State} (h : KR (H := H) sc s₀ m s) {ws : List Region} (ha : After s ws s') - (hs : ∀ r ∈ ws, (saveR H (scr s₀)).Disjoint r) (hsub : ∀ r ∈ ws, Region.Sub r (scR sc s₀)) : - KR (H := H) sc s₀ m s' := by - have f := ha.frame - rw [stk_eq h] at f - refine h.keep ha.rd ha.wr (fun r hr => ha.cs r (kregs_callee r hr)) f (fun r hr => ?_) (fun r hr => ?_) - · rcases List.mem_append.mp hr with hr | hr - · exact hs r hr - · simp only [List.mem_singleton] at hr; subst hr; exact hp.b_s.symm.sub_left (save_sub hp) - · rcases List.mem_append.mp hr with hr | hr - · exact ⟨scR sc s₀, by simp, hsub r hr⟩ - · simp only [List.mem_singleton] at hr; subst hr; exact ⟨stkR s₀, by simp, fun _ h => h⟩ - -theorem save_off {o n : Nat} (ho : 8 * H.W + 16 ≤ o) (h : o + n ≤ 8 * sc) : - (saveR H (scr s₀)).Disjoint ⟨SA s₀ o, n⟩ := - part_disj hp (a := 8 * H.W) (m := 16) (by omega) (by have := hp.fits; simp only [Hash.buf] at this; omega) h - -/-! ## The loads of `key` and `t` -/ - -theorem ld_ok {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m s) {i : Nat} (hi : i = 0 ∨ i = 3) : - WP isa (.block [.mov .esi (.mem (at_ .esp (4 + 4 * i)))]) s fun t => - KR (H := H) sc s₀ m t ∧ t.gpr .esi = arg s₀ i ∧ t.mem = s.mem := by - have hi' : i < 5 := by omega - refine wp_movm (a := argAddr s₀ i) (by rw [ea_at, hk.esp]; rfl) (argIn hp hk.rd hk.wr hi') fun t u => ?_ - exact WP.block_nil ⟨hk.upd (by decide) u, by rw [u.gpr, hk.readArg hp hi'], u.mem⟩ - -/-! ## The copies of the key's states -/ - -theorem copyKey_ok {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m s) (hsi : s.gpr .esi = key s₀) {o : Nat} - (ho : o = 0 ∨ o = H.S) : - WP isa (copy .esi o .ebp (stO H) H.S) s fun t => KR (H := H) sc s₀ m t ∧ - Frame [⟨ST (H := H) s₀, H.S⟩] s.mem t.mem ∧ - ∀ msg, hH.SH.Repr s₀.mem ((key s₀).setWidth 64 + BitVec.ofNat 64 o) msg → - hH.SH.Repr t.mem (ST (H := H) s₀) msg := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, -⟩ := bounds hp - have hkn := hp.nk - have ksub : Region.Sub ⟨(key s₀).setWidth 64 + BitVec.ofNat 64 o, H.S⟩ (keyR (H := H) s₀) := - sub_offset (by rcases ho with rfl | rfl <;> omega) (by rcases ho with rfl | rfl <;> omega) - have kR : keyR (H := H) s₀ ∈ s.rd ++ s.wr := by rw [hk.rd, hp.rd]; simp - have sR : scR sc s₀ ∈ s.wr := by rw [hk.wr]; exact (mem_wr hp).1 - have stsub := st_sub hp - refine WP.mono (copy_ok (so := o) (d := stO H) (n := H.S) (by decide) (by decide) hS0 (by omega) - (by rw [hsi]; rcases ho with rfl | rfl <;> omega) (by rw [hk.ebp]; simp only [stO]; omega) - (fun k hk' => by rw [hsi]; exact inRegions_of_sub kR ksub (by omega) hk') - (fun k hk' => by rw [hk.ebp]; exact inRegions_of_sub sR stsub (by omega) hk') - (by rw [hsi, hk.ebp]; exact (hp.k_s.sub_left ksub).sub_right stsub)) fun t c => ?_ - rw [hsi, hk.ebp] at c - have fr : Frame [⟨ST (H := H) s₀, H.S⟩] s.mem t.mem := - c.mem ▸ Proof.Sha256.Stream.writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact Region.contains_self _ _) - have sd : (saveR H (scr s₀)).Disjoint ⟨ST (H := H) s₀, H.S⟩ := - save_off hp (by simp only [stO]; omega) (by simp only [stO]; omega) - refine ⟨hk.keep c.rd c.wr (fun r hr => c.other r (not_cclob (kregs_clob r hr))) - fr (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact sd) - (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact ⟨_, by simp, stsub⟩), - fr, fun msg hr => ?_⟩ - refine hH.repr _ _ _ _ _ (fun i hi => ?_) hr - rw [c.mem, writeBytes_at _ _ _ (by rw [bytesAt_length]; exact hi) (by rw [bytesAt_length]; omega), - bytesAt_getD' _ _ hi] - -- The key's bytes are those of the initial memory. - refine hk.frame.bytes (R := ⟨(key s₀).setWidth 64 + BitVec.ofNat 64 o, H.S⟩) ?_ (by show H.S ≤ 2 ^ 64; omega) hi - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact hp.k_t.sub_left ksub - · exact hp.k_s.sub_left ksub - · exact hp.b_k.symm.sub_left ksub - -/-! ## The calls -/ - -/-- The block before `update`'s frame, from the state, with `D` bytes at `scratch + o`. -/ -abbrev updBlock (H : Hash) (o : Nat) : List Instr := - atSt H ++ [.mov .eax (.imm 0), .mov .esi (.imm (BitVec.ofNat 32 H.B)), .mov .ecx (.imm (BitVec.ofNat 32 H.D))] ++ - Impl.Hmac.Generic.X86.scr .edx o - -/-- The block before `finalize`'s frame, from the state, into `scratch + o`. -/ -abbrev finBlock (H : Hash) (o : Nat) : List Instr := - atSt H ++ H.count2 ++ Impl.Hmac.Generic.X86.scr .edx o - -theorem updArgs_ok {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m s) {o : Nat} (ho : o = uO H ∨ o = tmpO H) : - WP isa (.block (updBlock H o)) s fun t => - KR (H := H) sc s₀ m t ∧ - UpdArgs hH t .esi .ebx (sO s₀ (stO H)) (sO s₀ o) (scr s₀) (BitVec.ofNat 32 H.B) H.D ∧ t.mem = s.mem := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have hwb := hH.hWb - have eu : uO H = H.buf + H.S + H.F := rfl - have et : tmpO H = H.buf + H.S := rfl - have es : stO H = H.buf := rfl - have ho' : stO H + H.S ≤ o ∧ o + H.F ≤ 8 * sc := by rcases ho with rfl | rfl <;> omega - have sR : scR sc s₀ ∈ s₀.wr := (mem_wr hp).1 - have dsub : Region.Sub ⟨SA s₀ o, H.D⟩ (scR sc s₀) := off_sub hp (by omega) - have eS := addr_sO hp (o := stO H) (by omega) - have eO := addr_sO hp (o := o) (by omega) - simp only [updBlock, atSt, Impl.Hmac.Generic.X86.scr, List.cons_append, List.nil_append] - refine wp_mov fun s₁ u₁ => wp_addi fun s₂ u₂ => 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 k₇ : KR (H := H) sc s₀ m s₇ := - ((((((hk.upd (by decide) u₁).upd (by decide) u₂).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, u₁.mem]⟩ - exact - { hst := by rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), - u₄.other _ (by decide), u₃.other _ (by decide), u₂.gpr, u₁.gpr, hk.ebp] - 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), - u₂.other _ (by decide), u₁.other _ (by decide), hk.ebp] - ebp := k₇.ebp - hr := by decide - hl := by decide - hlen := by omega - sp48 := by rw [k₇.esp]; exact hp.sp48 - cd := by - rw [k₇.rd, k₇.wr, eO] - exact Covers.of_sub fun r hr => by - simp only [List.mem_singleton] at hr; subst hr - exact sub_of_off (List.mem_append_right _ sR) (by omega) - cw := by - rw [k₇.wr, eS] - 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_off sR (by omega) - · exact sub_of_self (r := scR sc s₀) sR (by show hH.Wb ≤ 8 * sc; omega) - st_sc := by rw [eS]; exact (cal_disj hH hp (by omega) (by omega)).symm - d_st := by rw [eO, eS]; exact part_disj hp (by omega) (by omega) (by omega) - d_sc := by rw [eO]; exact (cal_disj hH hp (by omega) (by omega)).symm - b_st := by rw [stk_eq k₇, eS]; exact hp.b_s.sub_right (st_sub hp) - b_d := by rw [stk_eq k₇, eO]; exact hp.b_s.sub_right dsub - b_sc := by rw [stk_eq k₇]; exact hp.b_s.sub_right (cal_sub hH hp) - nst := by rw [toNat_sO hp (by omega)]; omega - nd := by rw [toNat_sO hp (by omega)]; omega - nsc := by omega } - -theorem updCall_ok {m : Nat} {t : State} (hk : KR (H := H) sc s₀ m t) {o : Nat} (ho : o = uO H ∨ o = tmpO H) - (ha : UpdArgs hH t .esi .ebx (sO s₀ (stO H)) (sO s₀ o) (scr s₀) (BitVec.ofNat 32 H.B) H.D) {Q : State → Prop} - (hQ : ∀ s', KR (H := H) sc s₀ m s' → Frame [⟨ST (H := H) s₀, H.S⟩, calR hH s₀, stkR s₀] t.mem s'.mem → - (∀ msg, hH.SH.Repr t.mem (ST (H := H) s₀) msg → BitVec.ofNat 64 H.B = BitVec.ofNat 64 msg.length → - hH.SH.Repr s'.mem (ST (H := H) s₀) (msg ++ bytesAt t.mem (SA s₀ o) H.D)) → Q s') : - WP isa (.frame (.push (upd6 .esi .ebx)) (.call H.updN H.updC) (.pop .eax (upd6 .esi .ebx).length)) t Q := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have hwb := hH.hWb - have eu : uO H = H.buf + H.S + H.F := rfl - have et : tmpO H = H.buf + H.S := rfl - have es : stO H = H.buf := rfl - have ho' : stO H + H.S ≤ o ∧ o + H.F ≤ 8 * sc := by rcases ho with rfl | rfl <;> omega - have eS := addr_sO hp (o := stO H) (by omega) - have eO := addr_sO hp (o := o) (by omega) - refine upd_frame hH ha fun s' ha' hpost => ?_ - have f := ha'.frame - rw [stk_eq hk, eS] at f - rw [eS, eO] at hpost - refine hQ s' (hk.call hp ha' ?_ ?_) f fun msg hr hc => hpost msg hr (by - rw [zero_append_ofNat (by omega)]; exact hc) - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rw [eS] - rintro r (rfl | rfl) - · exact save_off hp (by simp only [stO]; omega) (by simp only [stO]; omega) - · exact ((cal_disj hH hp (b := 8 * H.W) (n := 16) (Nat.le_refl _) (by omega))).symm - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rw [eS] - rintro r (rfl | rfl) - · exact st_sub hp - · exact cal_sub hH hp - -theorem finArgs_ok {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m s) {o : Nat} (ho : o = uO H ∨ o = tmpO H) : - WP isa (.block (finBlock H o)) s fun t => - KR (H := H) sc s₀ m t ∧ - FinArgs hH t .ebx (sO s₀ (stO H)) (sO s₀ o) (scr s₀) (BitVec.ofNat 32 (H.B + H.D)) 0 ∧ t.mem = s.mem := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have hwb := hH.hWb - have eu : uO H = H.buf + H.S + H.F := rfl - have et : tmpO H = H.buf + H.S := rfl - have es : stO H = H.buf := rfl - have ho' : stO H + H.S ≤ o ∧ o + H.F ≤ 8 * sc := by rcases ho with rfl | rfl <;> omega - have sR : scR sc s₀ ∈ s₀.wr := (mem_wr hp).1 - have osub : Region.Sub ⟨SA s₀ o, H.F⟩ (scR sc s₀) := off_sub hp (by omega) - have eS := addr_sO hp (o := stO H) (by omega) - have eO := addr_sO hp (o := o) (by omega) - simp only [finBlock, atSt, Hash.count2, Impl.Hmac.Generic.X86.scr, List.cons_append, List.nil_append] - refine wp_mov fun s₁ u₁ => wp_addi 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 k₆ : KR (H := H) sc s₀ m s₆ := - (((((hk.upd (by decide) u₁).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]⟩ - exact - { hst := by rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), - u₃.other _ (by decide), u₂.gpr, u₁.gpr, hk.ebp] - eax := by rw [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), - u₁.other _ (by decide), hk.ebp] - ebp := k₆.ebp - hr := by decide - sp48 := by rw [k₆.esp]; exact hp.sp48 - cw := by - rw [k₆.wr, eS, eO] - 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 | rfl - · exact sub_of_off sR (by omega) - · exact sub_of_off sR (by omega) - · exact sub_of_self (r := scR sc s₀) sR (by show hH.Wb ≤ 8 * sc; omega) - st_o := by rw [eS, eO]; exact part_disj hp (by omega) (by omega) (by omega) - st_sc := by rw [eS]; exact (cal_disj hH hp (by omega) (by omega)).symm - o_sc := by rw [eO]; exact (cal_disj hH hp (by omega) (by omega)).symm - b_st := by rw [stk_eq k₆, eS]; exact hp.b_s.sub_right (st_sub hp) - b_o := by rw [stk_eq k₆, eO]; exact hp.b_s.sub_right osub - b_sc := by rw [stk_eq k₆]; exact hp.b_s.sub_right (cal_sub hH hp) - nst := by rw [toNat_sO hp (by omega)]; omega - no := by rw [toNat_sO hp (by omega)]; omega - nsc := by omega } - -theorem finCall_ok {m : Nat} {t : State} (hk : KR (H := H) sc s₀ m t) {o : Nat} (ho : o = uO H ∨ o = tmpO H) - (ha : FinArgs hH t .ebx (sO s₀ (stO H)) (sO s₀ o) (scr s₀) (BitVec.ofNat 32 (H.B + H.D)) 0) - {Q : State → Prop} - (hQ : ∀ s', KR (H := H) sc s₀ m s' → - Frame [⟨ST (H := H) s₀, H.S⟩, ⟨SA s₀ o, H.F⟩, calR hH s₀, stkR s₀] t.mem s'.mem → - (∀ msg, hH.SH.Repr t.mem (ST (H := H) s₀) msg → msg.length < 2 ^ 64 → - BitVec.ofNat 64 (H.B + H.D) = BitVec.ofNat 64 msg.length → - (bytesAt s'.mem (SA s₀ o) H.F).take H.D = hH.SH.H.hash msg) → Q s') : - WP isa (.frame (.push (fin5 .ebx)) (.call H.finN H.finC) (.pop .eax (fin5 .ebx).length)) t Q := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have hwb := hH.hWb - have eu : uO H = H.buf + H.S + H.F := rfl - have et : tmpO H = H.buf + H.S := rfl - have es : stO H = H.buf := rfl - have ho' : stO H + H.S ≤ o ∧ o + H.F ≤ 8 * sc := by rcases ho with rfl | rfl <;> omega - have eS := addr_sO hp (o := stO H) (by omega) - have eO := addr_sO hp (o := o) (by omega) - refine fin_frame hH ha fun s' ha' hpost => ?_ - have f := ha'.frame - rw [stk_eq hk, eS, eO] at f - rw [eS, eO] at hpost - refine hQ s' (hk.call hp ha' ?_ ?_) f fun msg hr hl hc => hpost msg hr hl (by - rw [zero_append_ofNat (by omega)]; exact hc) - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rw [eS, eO] - rintro r (rfl | rfl | rfl) - · exact save_off hp (by omega) (by omega) - · exact save_off hp (by omega) (by omega) - · exact ((cal_disj hH hp (b := 8 * H.W) (n := 16) (Nat.le_refl _) (by omega))).symm - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rw [eS, eO] - rintro r (rfl | rfl | rfl) - · exact st_sub hp - · exact off_sub hp (by omega) - · exact cal_sub hH hp - -/-! ## `T ← T ⊕ U` and the count -/ - -theorem xor'_ok {m : Nat} {s : State} (hk : KR (H := H) sc s₀ m s) (hsi : s.gpr .esi = tp s₀) : - WP isa (xorLoop H) s fun t => KR (H := H) sc s₀ m t ∧ - t.mem = writeBytes s.mem ((tp s₀).setWidth 64) (Spec.Pbkdf2.xorBytes - (bytesAt s.mem ((tp s₀).setWidth 64) H.D) (bytesAt s.mem (UA (H := H) s₀) H.D)) := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have eu : uO H = H.buf + H.S + H.F := rfl - obtain ⟨sR, tR'⟩ := mem_wr hp - have nt := hp.nt - have usub : Region.Sub ⟨UA (H := H) s₀, H.D⟩ (scR sc s₀) := off_sub hp (by omega) - refine WP.mono (xor_ok (uo := uO H) (n := H.D) hD0 (by omega) - (by rw [hk.ebp]; omega) (by rw [hsi]; omega) - (fun k hk' => by - rw [hk.ebp, hk.rd, hk.wr]; exact inRegions_of_sub (List.mem_append_right _ sR) usub (by omega) hk') - (fun k hk' => by rw [hsi, hk.wr]; exact inRegions_of_sub tR' (fun _ h => h) (by omega) hk') - (by rw [hk.ebp, hsi]; exact hp.t_s.symm.sub_left usub)) fun t x => ?_ - rw [hk.ebp, hsi] at x - refine ⟨hk.keep x.rd x.wr (fun r hr => x.other r (kregs_clob r hr)) - (x.mem ▸ Proof.Sha256.Stream.writeBytes_frame _ _ _ (R := tR (H := H) s₀) (by - rw [xorBytes_length' _ _ (by simp [bytesAt_length]), bytesAt_length]; exact Region.contains_self _ _)) - (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact hp.t_s.symm.sub_left (save_sub hp)) - (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact ⟨_, by simp, fun _ h => h⟩), x.mem⟩ - -omit hp in -theorem dec_ok {m : Nat} (hm : 1 ≤ m) (hn : m < 2 ^ 32) {s : State} (hk : KR (H := H) sc s₀ m s) : - WP isa (.block [.alu .sub .edi (.imm 1)]) s fun t => KR (H := H) sc s₀ (m - 1) t ∧ t.mem = s.mem ∧ - t.zf = some (decide (m - 1 = 0)) := - wp_subi fun t u z => WP.block_nil ⟨⟨by rw [u.rd, hk.rd], by rw [u.wr, hk.wr], - by rw [u.other _ (by decide), hk.esp], by rw [u.other _ (by decide), hk.ebp], - by rw [u.gpr, hk.edi, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat hm], - u.mem ▸ hk.saved, u.mem ▸ hk.frame⟩, - u.mem, by rw [z, hk.edi, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat hm, - ofNat_beq_zero (by omega)]⟩ - -end - -/-! ## One step -/ - -/-- The key's states represent `K₀ ⊕ ipad` and `K₀ ⊕ opad`. -/ -def KeyOK (s₀ : State) (k0 : List Byte) : Prop := - k0.length = H.B ∧ hH.SH.Repr s₀.mem ((key s₀).setWidth 64) (xorPad k0 ipad) ∧ - hH.SH.Repr s₀.mem ((key s₀).setWidth 64 + BitVec.ofNat 64 H.S) (xorPad k0 opad) - -/-- With `m` steps left, what is left to compute is the rest of the whole. -/ -structure Inv (s₀ : State) (m : Nat) (s : State) : Prop where - kr : KR (H := H) sc s₀ m s - it : ∀ k0, KeyOK hH s₀ k0 → - Spec.Pbkdf2.iterate (hmacBlockKey hH.SH.H k0) (nn s₀) (bytesAt s₀.mem ((up s₀).setWidth 64) H.D) - (bytesAt s₀.mem ((tp s₀).setWidth 64) H.D) = - Spec.Pbkdf2.iterate (hmacBlockKey hH.SH.H k0) m (bytesAt s.mem (UA (H := H) s₀) H.D) - (bytesAt s.mem ((tp s₀).setWidth 64) H.D) - -section -variable {sc : Nat} {s₀ : State} (hp : Pre (H := H) sc s₀) -include hp - -theorem body_ok {m : Nat} (hm : 1 ≤ m) (hn : m < 2 ^ 32) {s : State} (h : Inv hH sc s₀ m s) : - WP isa (body H) s fun t => Inv hH sc s₀ (m - 1) t ∧ t.zf = some (decide (m - 1 = 0)) := by - obtain ⟨hb, hf, hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have eu : uO H = H.buf + H.S + H.F := rfl - have et : tmpO H = H.buf + H.S := rfl - have es : stO H = H.buf := rfl - have hwb := hH.hWb - -- Where things are. - have ua : Region.Sub ⟨UA (H := H) s₀, H.D⟩ (scR sc s₀) := off_sub hp (by omega) - have dM₁ : Region.Disjoint ⟨TM (H := H) s₀, H.D⟩ ⟨ST (H := H) s₀, H.S⟩ := - part_disj hp (by omega) (by omega) (by omega) - have dU₁ : Region.Disjoint ⟨UA (H := H) s₀, H.D⟩ ⟨ST (H := H) s₀, H.S⟩ := - part_disj hp (by omega) (by omega) (by omega) - have dT : ∀ r : Region, Region.Sub r (scR sc s₀) → Region.Disjoint (tR (H := H) s₀) r := - fun r hr => hp.t_s.sub_right hr - have dT₄ : Region.Disjoint (tR (H := H) s₀) (stkR s₀) := hp.b_t.symm - have hDn : H.D ≤ 2 ^ 64 := by omega - -- The pieces. - refine WP.seq (WP.mono (ld_ok hp h.kr (.inl rfl)) fun l₁ ⟨kl₁, sl₁, ml₁⟩ => ?_) - refine WP.seq (WP.mono (copyKey_ok hH hp kl₁ sl₁ (.inl rfl)) fun c₁ ⟨kc₁, fc₁, rc₁⟩ => ?_) - refine WP.seq (WP.seq (WP.mono (updArgs_ok hH hp kc₁ (.inl rfl)) fun a₁ ⟨ka₁, aa₁, ma₁⟩ => - updCall_ok hH hp ka₁ (.inl rfl) aa₁ fun u₁ ku₁ fu₁ ru₁ => ?_)) - refine WP.seq (WP.seq (WP.mono (finArgs_ok hH hp ku₁ (.inr rfl)) fun b₁ ⟨kb₁, ab₁, mb₁⟩ => - finCall_ok hH hp kb₁ (.inr rfl) ab₁ fun f₁ kf₁ ff₁ rf₁ => ?_)) - refine WP.seq (WP.mono (ld_ok hp kf₁ (.inl rfl)) fun l₂ ⟨kl₂, sl₂, ml₂⟩ => ?_) - refine WP.seq (WP.mono (copyKey_ok hH hp kl₂ sl₂ (.inr rfl)) fun c₂ ⟨kc₂, fc₂, rc₂⟩ => ?_) - refine WP.seq (WP.seq (WP.mono (updArgs_ok hH hp kc₂ (.inr rfl)) fun a₂ ⟨ka₂, aa₂, ma₂⟩ => - updCall_ok hH hp ka₂ (.inr rfl) aa₂ fun u₂ ku₂ fu₂ ru₂ => ?_)) - refine WP.seq (WP.seq (WP.mono (finArgs_ok hH hp ku₂ (.inl rfl)) fun b₂ ⟨kb₂, ab₂, mb₂⟩ => - finCall_ok hH hp kb₂ (.inl rfl) ab₂ fun f₂ kf₂ ff₂ rf₂ => ?_)) - refine WP.seq (WP.mono (ld_ok hp kf₂ (.inr rfl)) fun l₃ ⟨kl₃, sl₃, ml₃⟩ => ?_) - refine WP.seq (WP.mono (xor'_ok hp kl₃ sl₃) fun x ⟨kx, mx⟩ => ?_) - refine WP.mono (dec_ok hm hn kx) fun t ⟨kt, mt, zt⟩ => ⟨⟨kt, fun k0 hk => ?_⟩, zt⟩ - -- The bytes of `U` and `T` at each point. - obtain ⟨hl0, hrI, hrO⟩ := hk - have U₁ : bytesAt c₁.mem (UA (H := H) s₀) H.D = bytesAt s.mem (UA (H := H) s₀) H.D := by - rw [← ml₁]; exact bytes_keep fc₁ (by simp only [List.mem_singleton]; rintro r rfl; exact dU₁) hDn - have T₁ : bytesAt c₁.mem ((tp s₀).setWidth 64) H.D = bytesAt s.mem ((tp s₀).setWidth 64) H.D := by - rw [← ml₁]; exact bytes_keep fc₁ (by simp only [List.mem_singleton]; rintro r rfl; exact dT _ (st_sub hp)) hDn - have T₂ : bytesAt u₁.mem ((tp s₀).setWidth 64) H.D = bytesAt c₁.mem ((tp s₀).setWidth 64) H.D := by - rw [← ma₁]; exact bytes_keep fu₁ (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact dT _ (st_sub hp) - · exact dT _ (cal_sub hH hp) - · exact dT₄) hDn - have T₃ : bytesAt f₁.mem ((tp s₀).setWidth 64) H.D = bytesAt u₁.mem ((tp s₀).setWidth 64) H.D := by - rw [← mb₁]; exact bytes_keep ff₁ (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl | rfl) - · exact dT _ (st_sub hp) - · exact dT _ (tm_sub hp) - · exact dT _ (cal_sub hH hp) - · exact dT₄) hDn - have T₄ : bytesAt c₂.mem ((tp s₀).setWidth 64) H.D = bytesAt f₁.mem ((tp s₀).setWidth 64) H.D := by - rw [← ml₂]; exact bytes_keep fc₂ (by simp only [List.mem_singleton]; rintro r rfl; exact dT _ (st_sub hp)) hDn - have T₅ : bytesAt u₂.mem ((tp s₀).setWidth 64) H.D = bytesAt c₂.mem ((tp s₀).setWidth 64) H.D := by - rw [← ma₂]; exact bytes_keep fu₂ (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact dT _ (st_sub hp) - · exact dT _ (cal_sub hH hp) - · exact dT₄) hDn - have T₆ : bytesAt f₂.mem ((tp s₀).setWidth 64) H.D = bytesAt u₂.mem ((tp s₀).setWidth 64) H.D := by - rw [← mb₂]; exact bytes_keep ff₂ (by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl | rfl) - · exact dT _ (st_sub hp) - · exact dT _ (ua_sub hp) - · exact dT _ (cal_sub hH hp) - · exact dT₄) hDn - have M₄ : bytesAt c₂.mem (TM (H := H) s₀) H.D = bytesAt f₁.mem (TM (H := H) s₀) H.D := by - rw [← ml₂]; exact bytes_keep fc₂ (by simp only [List.mem_singleton]; rintro r rfl; exact dM₁) hDn - -- The inner hash. - have rI₁ := rc₁ _ (by rw [add_zero']; exact hrI) - have rU₁ := ru₁ _ (ma₁ ▸ rI₁) (by rw [xorPad_length, hl0]) - rw [ma₁, U₁] at rU₁ - have hl₁ : (xorPad k0 ipad ++ bytesAt s.mem (UA (H := H) s₀) H.D).length = H.B + H.D := by - rw [List.length_append, xorPad_length, hl0, bytesAt_length] - have dig₁ := rf₁ _ (mb₁ ▸ rU₁) (by rw [hl₁]; omega) (by rw [hl₁]) - -- The outer hash. - have rO₂ := rc₂ _ hrO - have rU₂ := ru₂ _ (ma₂ ▸ rO₂) (by rw [xorPad_length, hl0]) - rw [ma₂, M₄, bytesAt_take _ _ hDF, dig₁] at rU₂ - have hl₂ : (xorPad k0 opad ++ hH.SH.H.hash (xorPad k0 ipad ++ bytesAt s.mem (UA (H := H) s₀) H.D)).length = - H.B + H.D := by - rw [List.length_append, xorPad_length, hl0, ← dig₁, List.length_take, bytesAt_length, Nat.min_eq_left hDF] - have dig₂ := rf₂ _ (mb₂ ▸ rU₂) (by rw [hl₂]; omega) (by rw [hl₂]) - rw [← bytesAt_take _ _ hDF] at dig₂ - -- `T ← T ⊕ U`. - have hx : (Spec.Pbkdf2.xorBytes (bytesAt l₃.mem ((tp s₀).setWidth 64) H.D) - (bytesAt l₃.mem (UA (H := H) s₀) H.D)).length = H.D := by - rw [xorBytes_length' _ _ (by simp [bytesAt_length]), bytesAt_length] - have Ux : bytesAt t.mem (UA (H := H) s₀) H.D = bytesAt f₂.mem (UA (H := H) s₀) H.D := by - rw [mt, mx, ← ml₃] - exact bytes_keep (Proof.Sha256.Stream.writeBytes_frame _ _ _ (R := tR (H := H) s₀) (by - rw [hx]; exact Region.contains_self _ _)) (by - simp only [List.mem_singleton]; rintro r rfl; exact (dT _ ua).symm) hDn - have Tx : bytesAt t.mem ((tp s₀).setWidth 64) H.D = Spec.Pbkdf2.xorBytes - (bytesAt f₂.mem ((tp s₀).setWidth 64) H.D) (bytesAt f₂.mem (UA (H := H) s₀) H.D) := by - rw [mt, mx, bytesAt_writeBytes_self' hx (by omega), ml₃] - rw [h.it k0 ⟨hl0, hrI, hrO⟩, show m = (m - 1) + 1 by omega, Ux, Tx, dig₂, T₆, T₅, T₄, T₃, T₂, T₁, - Nat.add_sub_cancel] - rfl - -/-! ## The prologue and the loop -/ - -omit hp in -theorem nn_lt : nn s₀ < 2 ^ 32 := (arg s₀ 2).isLt - -theorem pro_ok : WP isa (.block (prologue H)) s₀ fun t => KR (H := H) sc s₀ (nn s₀) t ∧ t.gpr .esi = up s₀ ∧ - Frame [saveR H (scr s₀)] s₀.mem t.mem := by - have hW := hp.hW; have hf := hp.fits; have nw := hp.nw - simp only [Hash.buf] at hf - obtain ⟨sR, _⟩ := mem_wr hp - 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) - simp only [prologue, 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 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 (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₀ 2) (by rw [ea_at, u₃.other _ (by decide), e₂ _ (by decide)]; rfl) - (by rw [u₃.rd, u₃.wr]; exact i₂ 2 (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₅.other _ (by decide), u₄.gpr, u₃.mem, rA 2 (by decide), BitVec.ofNat_toNat, BitVec.setWidth_eq], - 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), - (hm ▸ f₂').sub fun r hr => by - simp only [List.mem_singleton] at hr; subst hr; exact ⟨scR sc s₀, by simp, save_sub hp⟩⟩, - by rw [u₅.gpr, u₄.mem, u₃.mem, rA 1 (by decide)], hm ▸ f₂'⟩ - -/-- `U` into `scratch`. -/ -theorem copyU_ok {s : State} (hk : KR (H := H) sc s₀ (nn s₀) s) (hsi : s.gpr .esi = up s₀) - (hf : Frame [saveR H (scr s₀)] s₀.mem s.mem) : - WP isa (copy .esi 0 .ebp (uO H) H.D) s (Inv hH sc s₀ (nn s₀)) := by - obtain ⟨hb, hf', hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - have eu : uO H = H.buf + H.S + H.F := rfl - obtain ⟨sR, tR'⟩ := mem_wr hp - have nu := hp.nu - have uR' : uR (H := H) s₀ ∈ s.rd ++ s.wr := by rw [hk.rd, hp.rd]; simp - have usub : Region.Sub ⟨UA (H := H) s₀, H.D⟩ (scR sc s₀) := off_sub hp (by omega) - refine WP.mono (copy_ok (so := 0) (d := uO H) (n := H.D) (by decide) (by decide) - hD0 (by omega) (by rw [hsi]; omega) (by rw [hk.ebp]; omega) - (fun k hk' => by rw [hsi, add_zero']; exact inRegions_of_sub uR' (fun _ h => h) (by omega) hk') - (fun k hk' => by rw [hk.ebp, hk.wr]; exact inRegions_of_sub sR usub (by omega) hk') - (by rw [hsi, hk.ebp, add_zero']; exact hp.u_s.sub_right usub)) fun t c => ?_ - rw [hsi, hk.ebp, add_zero'] at c - have fc : Frame [⟨UA (H := H) s₀, H.D⟩] s.mem t.mem := - c.mem ▸ Proof.Sha256.Stream.writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact Region.contains_self _ _) - refine ⟨hk.keep c.rd c.wr (fun r hr => c.other r (not_cclob (kregs_clob r hr))) - fc (fun r hr => by - simp only [List.mem_singleton] at hr; subst hr - exact save_off hp (by omega) (by omega)) - (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact ⟨_, by simp, usub⟩), fun k0 _ => ?_⟩ - congr 1 - · rw [c.mem, bytesAt_writeBytes_self' (bytesAt_length _ _ _) (by omega)] - exact (bytes_keep hf (by - simp only [List.mem_singleton]; rintro r rfl; exact hp.u_s.sub_right (save_sub hp)) (by omega)).symm - · exact ((bytes_keep fc (by simp only [List.mem_singleton]; rintro r rfl; exact hp.t_s.sub_right usub) - (by omega)).trans (bytes_keep hf (by - simp only [List.mem_singleton]; rintro r rfl; exact hp.t_s.sub_right (save_sub hp)) (by omega))).symm - -omit hp in -/-- `test edi, edi`: the flags of whether there are steps. -/ -theorem test_ok {s : State} (h : Inv hH sc s₀ (nn s₀) s) : - WP isa (.block [.alu .test .edi (.reg .edi)]) s fun t => Inv hH sc s₀ (nn s₀) t ∧ - t.zf = some (decide (nn s₀ = 0)) := by - refine wp_test fun s₁ f₁ z₁ => WP.block_nil ⟨⟨h.kr.keep f₁.rd f₁.wr - (fun r _ => by rw [f₁.gpr]) (rs := []) (by rw [f₁.mem]; exact Frame.refl _ _) (by simp) (by simp), - fun k0 hk => by rw [h.it k0 hk, f₁.mem]⟩, ?_⟩ - rw [z₁, h.kr.edi, test_z, Proof.Sha256.X86.Stream.toNat_ofNat_lt nn_lt] - -theorem loop_ok {s : State} (h : Inv hH sc s₀ (nn s₀) s) (hz : s.zf = some (decide (nn s₀ = 0))) : - WP isa (.ite .e (.block []) (.loop (body H) .ne)) s (Inv hH sc s₀ 0) := by - have hlt := nn_lt (s₀ := s₀) - refine WP.ite (decide (nn s₀ = 0)) (by show eval .e s = _; rw [eval_e, hz]) (fun h0 => WP.block_nil ?_) - fun h0 => ?_ - · have e : nn s₀ = 0 := by simpa using h0 - exact e ▸ h - · have hpos : 1 ≤ nn s₀ := by have := of_decide_eq_false h0; omega - refine WP.loop (M := isa) (fun k t => ∃ m, k = m ∧ 1 ≤ m ∧ m ≤ nn s₀ ∧ Inv hH sc s₀ m t) ?_ (nn s₀) s - ⟨nn s₀, rfl, hpos, (Nat.le_refl _), h⟩ - rintro k t ⟨m, hkm, h1, h2, ht⟩ - refine WP.mono (body_ok hH hp h1 (by omega) ht) fun t' ⟨ht', hz'⟩ => ?_ - have he : isa.eval .ne t' = some (!decide (m - 1 = 0)) := by - show eval .ne t' = _; rw [eval_ne, hz']; rfl - by_cases hl : m - 1 = 0 - · exact .inl ⟨by rw [he]; simp [hl], hl ▸ ht'⟩ - · exact .inr ⟨by rw [he]; simp [hl], m - 1, by omega, m - 1, rfl, by omega, by omega, ht'⟩ - -theorem correct : WP isa (iterate H) s₀ fun s' => abiPreserved s₀ s' ∧ (iterG hH.SH sc).post s₀ s' := by - obtain ⟨hb, hf', hnw, hW, hS0, hS, hD0, hDF, hF, hB0, hB⟩ := bounds hp - refine WP.seq (WP.mono (pro_ok hp) fun s₂ ⟨k₂, x₂, f₂⟩ => ?_) - refine WP.seq (WP.mono (copyU_ok hH hp k₂ x₂ f₂) fun s₃ h₃ => ?_) - refine WP.seq (WP.mono (test_ok hH h₃) fun s₄ ⟨h₄, z₄⟩ => ?_) - refine WP.seq (WP.mono (loop_ok hH hp h₄ z₄) fun s₅ h₅ => ?_) - have k₅ := h₅.kr - have hL : 8 * H.W + 16 ≤ 8 * sc := by omega - refine WP.mono (restore_ok H k₅.ebp k₅.saved (by rw [k₅.wr]; exact (mem_wr hp).1) hL hnw) - 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 (callee_saved r hr he) - intro k0 hl hrI hrO - have hS' := hH.hS; have hD' := hH.hD; have hB' := hH.hB - rw [hB'] at hl - rw [hS'] at hrO - show bytesAt s'.mem ((tp s₀).setWidth 64) hH.SH.digestBytes = _ - rw [hD', hm, h₅.it k0 ⟨hl, hrI, hrO⟩] - rfl - -end - -end VG.Proof.Pbkdf2.Generic.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/IterateCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/IterateCT.lean deleted file mode 100644 index 264745c82..000000000 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Generic/X86/IterateCT.lean +++ /dev/null @@ -1,329 +0,0 @@ -import VerifiedGarbage.Proof.Pbkdf2.Generic.X86.Iterate - -/-! -# PBKDF2-HMAC over any streaming hash function on x86 (32-bit): `iterate`, constant time - -Untrusted: everything here is checked by Lean. As on 32-bit ARM -(`Proof/Pbkdf2/Generic/Arm/Instances.lean`): the pieces between the calls -are checked by the taint analysis, those that read the arguments on the -stack (the prologue, and the loads of `key` and `t`) with the arguments -public (`argTaint`); the calls are related by `upd_rel` and `fin_rel`. --/ - -namespace VG.Proof.Pbkdf2.Generic.X86 - -open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash copy at_) -open VG.Impl.Pbkdf2.Generic.X86 (stO tmpO uO xorLoop atSt ldKey ldT body prologue iterate) -open VG.Proof.Sha256.X86.Stream (eval_e eval_ne) -open VG.Proof.Hmac.Generic.X86 - -/-- The registers `KR` fixes. -/ -abbrev pubRegs : List Reg := [.esp, .ebp, .edi] - -theorem skip_check : ∃ hc, (VG.Taint.check taint (τr []) (.block []) hc).isSome = true := - ⟨_, by taint_decide⟩ - -theorem test_check : ∃ hc, (VG.Taint.check taint (τr pubRegs) (.block [.alu .test .edi (.reg .edi)]) hc).isSome = true := - ⟨_, by taint_decide⟩ - -theorem dec_check : - ∃ hc, (VG.Taint.check taint (τr pubRegs) (.block [.alu .sub .edi (.imm 1)]) hc).isSome = true := - ⟨_, by taint_decide⟩ - -theorem ld_check {i : Nat} (hi : i = 0 ∨ i = 3) : ∃ hc, (VG.Taint.check taint (argTaint [.ebp, .edi] (4 + 4 * 5)) - (.block [.mov .esi (.mem (at_ .esp (4 + 4 * i)))]) hc).isSome = true := by - rcases hi with rfl | rfl <;> exact ⟨_, by taint_decide⟩ - -/-- The taint checks of the pieces of `iterate` between its calls. -/ -structure Checks (H : Hash) : Prop where - pro : ∃ hc, (VG.Taint.check taint (argTaint [] (4 + 4 * 5)) (.block (prologue H)) hc).isSome = true - copyU : ∃ hc, - (VG.Taint.check taint (τr (.esi :: pubRegs)) (copy .esi 0 .ebp (uO H) H.D) hc).isSome = true - copyK : ∀ o ∈ [0, H.S], ∃ hc, - (VG.Taint.check taint (τr (.esi :: pubRegs)) (copy .esi o .ebp (stO H) H.S) hc).isSome = true - upd : ∀ o ∈ [uO H, tmpO H], ∃ hc, - (VG.Taint.check taint (τr pubRegs) (.block (updBlock H o)) hc).isSome = true - fin : ∀ o ∈ [uO H, tmpO H], ∃ hc, - (VG.Taint.check taint (τr pubRegs) (.block (finBlock H o)) hc).isSome = true - xor : ∃ hc, (VG.Taint.check taint (τr (.esi :: pubRegs)) (xorLoop H) hc).isSome = true - restore : ∃ hc, (VG.Taint.check taint (τr pubRegs) (.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} -variable {s₀ s₀' : State} (hp : Pre (H := H) sc s₀) (hp' : Pre (H := H) sc s₀') (hq : PubEq s₀ s₀') - -theorem PubEq.nn (hq : PubEq s₀ s₀') : Generic.X86.nn s₀ = Generic.X86.nn s₀' := by - show (arg s₀ 2).toNat = (arg s₀' 2).toNat; rw [hq.args 2 (by decide)] - -theorem kr_agree (hq : PubEq s₀ s₀') {m : Nat} {s s' : State} (h : KR (H := H) sc s₀ m s) - (h' : KR (H := H) sc s₀' m 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.esp, h'.esp, E, E, hq.esp] - · rw [h.ebp, h'.ebp, scr, scr, hq.args 4 (by decide)] - · rw [h.edi, h'.edi] - -theorem esi_agree (hq : PubEq s₀ s₀') {m : Nat} {s s' : State} (h : KR (H := H) sc s₀ m s) - (h' : KR (H := H) sc s₀' m s') {i : Nat} (hi : i < 5) (e : s.gpr .esi = arg s₀ i) (e' : s'.gpr .esi = arg s₀' i) : - ∀ r ∈ .esi :: pubRegs, s.gpr r = s'.gpr r := by - intro r hr - rcases List.mem_cons.mp hr with rfl | hr - · rw [e, e', hq.args i hi] - · exact kr_agree hq h h' r hr - -theorem eqs (hq : PubEq s₀ s₀') : scr s₀' = scr s₀ ∧ ∀ o : Nat, sO s₀' o = sO s₀ o := - ⟨(hq.args 4 (by decide)).symm, fun o => by rw [sO, sO, scr, scr, hq.args 4 (by decide)]⟩ - -/-- 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) - · exact Taint.frame_disjoint (by have := h.spf; omega) h.r_t h.a_t - · exact Taint.frame_disjoint (by have := h.spf; omega) h.r_s h.a_s - -include hH hp hp' hq - -omit hH in -/-- A piece of code between calls that keeps `KR`. -/ -theorem kr_rel {m : Nat} {c : Prog isa} - (hck : ∃ hc, (VG.Taint.check taint (τr pubRegs) c hc).isSome = true) - (hw : ∀ {t₀ : State}, Pre (H := H) sc t₀ → ∀ s, KR (H := H) sc t₀ m s → WP isa c s (KR (H := H) sc t₀ m)) : - RelCT isa (fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s') c - fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s' := - rel_agree (τr pubRegs) (fun _ _ h h' => agree_regs (kr_agree hq h h')) hck (hw hp) (hw hp') - -omit hH in -/-- A load of `key` (`i = 0`) or `t` (`i = 3`) into `esi`. -/ -theorem ld_rel {m : Nat} {i : Nat} (hi : i = 0 ∨ i = 3) : - RelCT isa (fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s') - (.block [.mov .esi (.mem (at_ .esp (4 + 4 * i)))]) - fun s s' => (KR (H := H) sc s₀ m s ∧ s.gpr .esi = arg s₀ i) ∧ - (KR (H := H) sc s₀' m s' ∧ s'.gpr .esi = arg s₀' i) := - rel_agree (argTaint [.ebp, .edi] (4 + 4 * 5)) (fun s s' k k' => - agree_argTaint (fun r hr => kr_agree hq k k' r (by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr ⊢; tauto)) - (kr_agree hq k k' .esp (by simp)) (args_out hp k.esp k.wr) (args_out hp' k'.esp k'.wr) - fun j hj => by rw [k.argEq hp hj, k'.argEq hp' hj, hq.args j hj]) (ld_check hi) - (fun _ k => WP.mono (ld_ok hp k hi) fun _ ⟨k₁, e, _⟩ => ⟨k₁, e⟩) - (fun _ k => WP.mono (ld_ok hp' k hi) fun _ ⟨k₁, e, _⟩ => ⟨k₁, e⟩) - -theorem upd_rel' {m : Nat} {o : Nat} (ho : o = uO H ∨ o = tmpO H) (hc : Checks H) : - RelCT isa (fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s') - (H.callUpd (atSt H) .ebx .esi H.B o H.D) - fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s' := by - obtain ⟨e2, e3⟩ := eqs hq - have ha := rel_agree (G := fun t => KR (H := H) sc s₀ m t ∧ - UpdArgs hH t .esi .ebx (sO s₀ (stO H)) (sO s₀ o) (scr s₀) (BitVec.ofNat 32 H.B) H.D) - (G' := fun t => KR (H := H) sc s₀' m t ∧ - UpdArgs hH t .esi .ebx (sO s₀ (stO H)) (sO s₀ o) (scr s₀) (BitVec.ofNat 32 H.B) H.D) - (τr pubRegs) (fun _ _ h h' => agree_regs (kr_agree hq h h')) (hc.upd o (by rcases ho with rfl | rfl <;> simp)) - (fun s h => WP.mono (updArgs_ok hH hp h ho) fun _ ⟨k, a, _⟩ => ⟨k, a⟩) - (fun s h => WP.mono (updArgs_ok hH hp' h ho) fun _ ⟨k, a, _⟩ => - ⟨k, e3 (stO H) ▸ e3 o ▸ e2 ▸ a⟩) - exact ha.seq (rel_wp (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 ho a fun _ k' _ _ => k') - (fun _ ⟨k, a⟩ => updCall_ok hH hp' k ho ((e3 (stO H)).symm ▸ (e3 o).symm ▸ e2.symm ▸ a) - fun _ k' _ _ => k')) - -theorem fin_rel' {m : Nat} {o : Nat} (ho : o = uO H ∨ o = tmpO H) (hc : Checks H) : - RelCT isa (fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s') - (H.callFin (atSt H) H.count2 .ebx o) - fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s' := by - obtain ⟨e2, e3⟩ := eqs hq - have ha := rel_agree (G := fun t => KR (H := H) sc s₀ m t ∧ - FinArgs hH t .ebx (sO s₀ (stO H)) (sO s₀ o) (scr s₀) (BitVec.ofNat 32 (H.B + H.D)) 0) - (G' := fun t => KR (H := H) sc s₀' m t ∧ - FinArgs hH t .ebx (sO s₀ (stO H)) (sO s₀ o) (scr s₀) (BitVec.ofNat 32 (H.B + H.D)) 0) - (τr pubRegs) (fun _ _ h h' => agree_regs (kr_agree hq h h')) (hc.fin o (by rcases ho with rfl | rfl <;> simp)) - (fun s h => WP.mono (finArgs_ok hH hp h ho) fun _ ⟨k, a, _⟩ => ⟨k, a⟩) - (fun s h => WP.mono (finArgs_ok hH hp' h ho) fun _ ⟨k, a, _⟩ => - ⟨k, e3 (stO H) ▸ e3 o ▸ e2 ▸ a⟩) - exact ha.seq (rel_wp (fin_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⟩ => finCall_ok hH hp k ho a fun _ k' _ _ => k') - (fun _ ⟨k, a⟩ => finCall_ok hH hp' k ho ((e3 (stO H)).symm ▸ (e3 o).symm ▸ e2.symm ▸ a) - fun _ k' _ _ => k')) - -theorem body_rel (hc : Checks H) {m : Nat} (hm : 1 ≤ m) (hn : m < 2 ^ 32) : - RelCT isa (fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s') (body H) - fun s s' => KR (H := H) sc s₀ (m - 1) s ∧ KR (H := H) sc s₀' (m - 1) s' := by - have ck : ∀ {o : Nat}, (o = 0 ∨ o = H.S) → RelCT isa (fun s s' => (KR (H := H) sc s₀ m s ∧ s.gpr .esi = arg s₀ 0) ∧ - (KR (H := H) sc s₀' m s' ∧ s'.gpr .esi = arg s₀' 0)) - (copy .esi o .ebp (stO H) H.S) fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s' := - fun ho => rel_agree (τr (.esi :: pubRegs)) (fun _ _ h h' => agree_regs - (esi_agree hq h.1 h'.1 (i := 0) (by decide) h.2 h'.2)) (hc.copyK _ (by rcases ho with rfl | rfl <;> simp)) - (fun s h => WP.mono (copyKey_ok hH hp h.1 h.2 ho) fun _ h => h.1) - (fun s h => WP.mono (copyKey_ok hH hp' h.1 h.2 ho) fun _ h => h.1) - have x : RelCT isa (fun s s' => (KR (H := H) sc s₀ m s ∧ s.gpr .esi = arg s₀ 3) ∧ - (KR (H := H) sc s₀' m s' ∧ s'.gpr .esi = arg s₀' 3)) - (xorLoop H) fun s s' => KR (H := H) sc s₀ m s ∧ KR (H := H) sc s₀' m s' := - rel_agree (τr (.esi :: pubRegs)) (fun _ _ h h' => agree_regs - (esi_agree hq h.1 h'.1 (i := 3) (by decide) h.2 h'.2)) hc.xor - (fun s h => WP.mono (xor'_ok hp h.1 h.2) fun _ h => h.1) - (fun s h => WP.mono (xor'_ok hp' h.1 h.2) fun _ h => h.1) - have d := rel_agree (G := KR (H := H) sc s₀ (m - 1)) (G' := KR (H := H) sc s₀' (m - 1)) (τr pubRegs) - (fun _ _ h h' => agree_regs (kr_agree hq h h')) dec_check - (fun s k => WP.mono (dec_ok hm hn k) fun _ h => h.1) (fun s k => WP.mono (dec_ok hm hn k) fun _ h => h.1) - exact (ld_rel hp hp' hq (.inl rfl)).seq ((ck (.inl rfl)).seq ((upd_rel' hH hp hp' hq (.inl rfl) hc).seq - ((fin_rel' hH hp hp' hq (.inr rfl) hc).seq ((ld_rel hp hp' hq (.inl rfl)).seq ((ck (.inr rfl)).seq - ((upd_rel' hH hp hp' hq (.inr rfl) hc).seq ((fin_rel' hH hp hp' hq (.inl rfl) hc).seq - ((ld_rel hp hp' hq (.inr rfl)).seq (x.seq d))))))))) - -/-- The loop's invariant in two runs, with `n` steps left. -/ -abbrev LoopInv (n : Nat) (s s' : State) : Prop := - 1 ≤ n ∧ n ≤ nn s₀ ∧ Inv hH sc s₀ n s ∧ Inv hH sc s₀' n s' - -theorem step_rel (hc : Checks H) (n : Nat) : - RelCT isa (LoopInv hH (sc := sc) (s₀ := s₀) (s₀' := s₀') n) (body H) fun s s' => - isa.eval .ne s = isa.eval .ne s' ∧ - (isa.eval .ne s = some false → Inv hH sc s₀ 0 s ∧ Inv hH sc s₀' 0 s') ∧ - (isa.eval .ne s = some true → ∃ m < n, LoopInv hH (sc := sc) (s₀ := s₀) (s₀' := s₀') m s s') := by - have hlt := nn_lt (s₀ := s₀) - by_cases hn : 1 ≤ n ∧ n ≤ nn s₀ - · have b := (body_rel hH hp hp' hq hc hn.1 (by omega)).mono (P' := LoopInv hH (sc := sc) (s₀ := s₀) (s₀' := s₀') n) - (fun _ _ (h : LoopInv hH (sc := sc) (s₀ := s₀) (s₀' := s₀') n _ _) => ⟨h.2.2.1.kr, h.2.2.2.kr⟩) - fun _ _ h => h - refine (b.wp (F₁ := fun (t : State) => Inv hH sc s₀ (n - 1) t ∧ t.zf = some (decide (n - 1 = 0))) - (F₂ := fun (t : State) => Inv hH sc s₀' (n - 1) t ∧ t.zf = some (decide (n - 1 = 0))) - fun s s' (h : LoopInv hH (sc := sc) (s₀ := s₀) (s₀' := s₀') n _ _) => - ⟨body_ok hH hp hn.1 (by omega) h.2.2.1, body_ok hH hp' hn.1 (by omega) h.2.2.2⟩).mono - (fun _ _ h => h) fun t t' h => ?_ - obtain ⟨_, ⟨i, z⟩, ⟨i', z'⟩⟩ := h - have e : isa.eval .ne t = some (!decide (n - 1 = 0)) := by show eval .ne t = _; rw [eval_ne, z]; rfl - have e' : isa.eval .ne t' = some (!decide (n - 1 = 0)) := by show eval .ne t' = _; rw [eval_ne, z']; rfl - rw [e, e'] - refine ⟨rfl, fun hf => ?_, fun ht => ?_⟩ - · have hl : n - 1 = 0 := by simpa using hf - exact ⟨hl ▸ i, hl ▸ i'⟩ - · have hl : n - 1 ≠ 0 := by simpa using ht - exact ⟨n - 1, by omega, by omega, by omega, i, i'⟩ - · intro _ _ _ _ _ _ h - exact absurd ⟨h.1, h.2.1⟩ hn - -theorem loop_rel (hc : Checks H) : - RelCT isa (fun s s' => (Inv hH sc s₀ (nn s₀) s ∧ s.zf = some (decide (nn s₀ = 0))) ∧ - (Inv hH sc s₀' (nn s₀') s' ∧ s'.zf = some (decide (nn s₀' = 0)))) - (.ite .e (.block []) (.loop (body H) .ne)) - fun s s' => Inv hH sc s₀ 0 s ∧ Inv hH sc s₀' 0 s' := by - have hN := hq.nn - have ev : ∀ {t : State} {k : Nat}, t.zf = some (decide (k = 0)) → isa.eval .e t = some (decide (k = 0)) := - fun h => by show eval .e _ = _; rw [eval_e, h] - refine RelCT.ite (fun s s' h => by rw [ev h.1.2, ev h.2.2, hN]) ?_ ?_ - · by_cases e : nn s₀ = 0 - · have e' : nn s₀' = 0 := hN ▸ e - exact (rel_agree (c := .block []) - (F := fun s => Inv hH sc s₀ (nn s₀) s ∧ s.zf = some (decide (nn s₀ = 0))) - (F' := fun s => Inv hH sc s₀' (nn s₀') s ∧ s.zf = some (decide (nn s₀' = 0))) - (G := Inv hH sc s₀ 0) (G' := Inv hH sc s₀' 0) (τr []) - (fun s s' h h' => agree_regs (by simp)) skip_check - (fun s h => WP.block_nil (e ▸ h.1)) (fun s h => WP.block_nil (e' ▸ h.1))).mono (fun _ _ h => h.1) - fun _ _ h => h - · intro _ _ _ _ _ _ h - have z := h.2 - rw [ev h.1.1.2] at z - exact absurd (by simpa using z) e - · refine (RelCT.loop (M := isa) (LoopInv hH (sc := sc) (s₀ := s₀) (s₀' := s₀')) (step_rel hH hp hp' hq hc) - (nn s₀)).mono (fun s s' h => ?_) fun _ _ h => h - have z := h.2 - rw [ev h.1.1.2] at z - have e : nn s₀ ≠ 0 := by simpa using z - exact ⟨by omega, (Nat.le_refl _), h.1.1.1, hN ▸ h.1.2.1⟩ - -theorem ct (hc : Checks H) : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') (iterate H) fun _ _ => True := by - have hN := hq.nn - have pro := rel_agree (F := fun s => s = s₀) (F' := fun s => s = s₀') - (G := fun s => KR (H := H) sc s₀ (nn s₀) s ∧ s.gpr .esi = up s₀ ∧ Frame [saveR H (scr s₀)] s₀.mem s.mem) - (G' := fun s => KR (H := H) sc s₀' (nn s₀') s ∧ s.gpr .esi = up s₀' ∧ Frame [saveR H (scr s₀')] s₀'.mem s.mem) - (argTaint [] (4 + 4 * 5)) (fun s s' e e' => by - rw [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 rw [e]; exact pro_ok hp) (fun _ e => by rw [e]; exact pro_ok hp') - have cu := rel_agree - (F := fun s => KR (H := H) sc s₀ (nn s₀) s ∧ s.gpr .esi = up s₀ ∧ Frame [saveR H (scr s₀)] s₀.mem s.mem) - (F' := fun s => KR (H := H) sc s₀' (nn s₀') s ∧ s.gpr .esi = up s₀' ∧ Frame [saveR H (scr s₀')] s₀'.mem s.mem) - (G := Inv hH sc s₀ (nn s₀)) (G' := Inv hH sc s₀' (nn s₀')) (τr (.esi :: pubRegs)) - (fun s s' h h' => agree_regs (esi_agree hq h.1 (hN ▸ h'.1) (i := 1) (by decide) h.2.1 h'.2.1)) hc.copyU - (fun s h => copyU_ok hH hp h.1 h.2.1 h.2.2) (fun s h => copyU_ok hH hp' h.1 h.2.1 h.2.2) - have cm := rel_agree (F := Inv hH sc s₀ (nn s₀)) (F' := Inv hH sc s₀' (nn s₀')) - (G := fun s => Inv hH sc s₀ (nn s₀) s ∧ s.zf = some (decide (nn s₀ = 0))) - (G' := fun s => Inv hH sc s₀' (nn s₀') s ∧ s.zf = some (decide (nn s₀' = 0))) (τr pubRegs) - (fun s s' h h' => agree_regs (kr_agree hq h.kr (hN ▸ h'.kr))) test_check - (fun s h => test_ok hH h) (fun s h => test_ok hH h) - obtain ⟨_, hr⟩ := hc.restore - have restore : RelCT isa (fun s s' => Inv hH sc s₀ 0 s ∧ Inv hH sc s₀' 0 s') (.block H.restore) - fun _ _ => True := - RelCT.taint (A := taint) (τr pubRegs) (fun _ _ h => agree_regs (kr_agree hq h.1.kr h.2.kr)) hr - exact pro.seq (cu.seq (cm.seq ((loop_rel hH hp hp' hq hc).seq restore))) - -end VG.Proof.Pbkdf2.Generic.X86 - -namespace VG.Proof.Pbkdf2.Generic.X86 - -open VG.X86 -open VG.Impl.Hmac.Generic.X86 (Hash) -open VG.Proof.Hmac.Generic.X86 - -/-- `iterate` is verified against `iterG`, 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 + H.S + 2 * H.F ≤ 8 * sc) (hsat : ∃ s, (iterG hH.SH sc).pre s) : - Verified X86.target (VG.Impl.Pbkdf2.Generic.X86.iterate H) (iterG hH.SH sc) := by - refine ⟨fun s hs => correct hH (pre_of hH sc hs hfit), fun s₁ s₂ t₁ t₂ s₁' s₂' h₁ h₂ hpub e₁ e₂ => ?_, hsat⟩ - obtain ⟨h1, h2⟩ := hpub - exact (ct hH (pre_of hH sc h₁ hfit) (pre_of hH sc h₂ hfit) ⟨h1, h2⟩ hc - _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 - -/-- The regions `iterate` reads and writes, of those `iterW` gives it. -/ -def narrowRd (S D : Nat) (s : State) : List Region := - [⟨(arg s 0).setWidth 64, 2 * S⟩, ⟨(arg s 1).setWidth 64, D⟩, ⟨argAddr s 0, 20⟩] -def narrowWr (D sc : Nat) (s : State) : List Region := - [⟨(arg s 3).setWidth 64, D⟩, ⟨(arg s 4).setWidth 64, 8 * sc⟩] - -/-- `iterate` is verified against `iterW`, 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 + H.S + 2 * H.F ≤ 8 * sc) (hsat : ∃ s, (iterW hH.SH sc).pre s) : - Verified X86.target (VG.Impl.Pbkdf2.Generic.X86.iterate H) (iterW hH.SH sc) := by - have pre : ∀ s, (iterW hH.SH sc).pre s → (iterG hH.SH sc).pre - (s.withRegions (narrowRd hH.SH.stateBytes hH.SH.digestBytes s) (narrowWr hH.SH.digestBytes sc s)) := by - intro s h - obtain ⟨_, _, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20⟩ := h - simp only [iterG, narrowRd, narrowWr, arg_withRegions, argAddr_withRegions, State.withRegions_gpr, - State.withRegions_rd, State.withRegions_wr] - exact ⟨trivial, trivial, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20⟩ - refine Verified.narrowTo (verified hH hc hfit (hsat.elim fun s hs => ⟨_, pre s hs⟩)) - (narrowRd hH.SH.stateBytes hH.SH.digestBytes) (narrowWr hH.SH.digestBytes 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_left _ (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⟩ - · 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⟩ - · 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 - · 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⟩ - -end VG.Proof.Pbkdf2.Generic.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Block.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Block.lean new file mode 100644 index 000000000..682b2a5db --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Block.lean @@ -0,0 +1,540 @@ +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.Impl.Pbkdf2.Md.X86 + +/-! +# HMAC and PBKDF2-HMAC over a Merkle–Damgård hash function on x86 (32-bit): the block + +Untrusted: everything here is checked by Lean. What HMAC's `finalize` and +PBKDF2's iteration (`Impl/Pbkdf2/Md/X86.lean`) share: a hash value at `ebx` +with a block right after it, which they pad (`pad_ok`), compress into the +hash value with any verified compression function (`cmp_ok`, against the +compression contract of the hash function's `Md`, `cmpK`; `cmp_rel` relates +two runs of the call) and write the digest into (`digest_ok`, from the hash +function's own `out`, `OutOk`); and the copies of words (`copyW_ok`) and +stores of constant words (`storeW_ok`) they are made of. +-/ + +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.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 + 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) +open Spec.Sha256 (bytesAt) + +/-! ## Words -/ + +/-- Word `k` of `n` words at `[x + o]`, within the 32-bit address space. -/ +theorem addr_word {x : BitVec 32} {o n k : Nat} (h : x.toNat + o + 4 * n ≤ 2 ^ 32) (hk : k < n) : + addr x (o + 4 * k) = x.setWidth 64 + BitVec.ofNat 64 o + BitVec.ofNat 64 (4 * k) := by + rw [addr_eq (by omega), BitVec.add_assoc, ← BitVec.ofNat_add] + +/-- Copying `n` words from `[x + o₁]` to `[y + o₂]`. -/ +theorem copyW_ok {src dst : Reg} (hs : src ≠ .ecx) (hd : dst ≠ .ecx) {x y : BitVec 32} {o₁ o₂ : Nat} + (n : Nat) : ∀ (rest : List Instr) (s : State) (Q : State → Prop), + s.gpr src = x → s.gpr dst = y → x.toNat + o₁ + 4 * n ≤ 2 ^ 32 → y.toNat + o₂ + 4 * n ≤ 2 ^ 32 → + (∀ k < n, InRegions (s.rd ++ s.wr) (addr x (o₁ + 4 * k)) 4) → + (∀ k < n, InRegions s.wr (addr y (o₂ + 4 * k)) 4) → + Mem.Sep (x.setWidth 64 + BitVec.ofNat 64 o₁) (4 * n) (y.setWidth 64 + BitVec.ofNat 64 o₂) (4 * n) → + (∀ s', (∀ r, r ≠ .ecx → 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 o₂) + (bytesAt s.mem (x.setWidth 64 + BitVec.ofNat 64 o₁) (4 * n)) → + WP isa (.block rest) s' Q) → + WP isa (.block (copyW src o₁ dst o₂ n ++ 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 [copyW, 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)) + (fun a ha hb => hsep a (by omega) (by omega)) fun s₁ g₁ rd₁ wr₁ m₁ => ?_ + simp only [cpW, List.cons_append, List.nil_append] + refine wp_movm (a := addr x (o₁ + 4 * n)) (by rw [ea_at, g₁ _ hs, hx]) + (by rw [rd₁, wr₁]; exact hin n (by omega)) fun s₂ u₂ => ?_ + refine wp_store (a := addr y (o₂ + 4 * n)) (by rw [ea_at, u₂.other _ hd, g₁ _ hd, hy]) + (by rw [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, g₁ r hr]) + (by rw [u₃.rd, u₂.rd, rd₁]) (by rw [u₃.wr, u₂.wr, wr₁]) ?_ + rw [u₃.mem, u₂.gpr, u₂.mem, addr_word fx (by omega : n < n + 1), addr_word fy (by omega : n < n + 1), m₁] + have := VG.Proof.Hmac.Common.copy_mem s.mem (x.setWidth 64 + BitVec.ofNat 64 o₁) + (y.setWidth 64 + BitVec.ofNat 64 o₂) n 4 (by rw [show 4 * n + 4 = 4 * (n + 1) by omega]; exact hsep) + (by omega) + simp only [Nat.reduceMul] at this + rw [this, show 4 * (n + 1) = 4 * n + 4 by omega] + +/-- The bytes of a little-endian word made of four bytes. -/ +theorem word_bytes (a b c d : Byte) : + (List.range (32 / 8)).map (fun j => ((a ++ b ++ c ++ d : BitVec 32).setWidth (8 * (32 / 8))).extractLsb' (8 * j) 8) = + [d, c, b, a] := by + simp only [show 32 / 8 = 4 from rfl, BitVec.setWidth_eq, List.range_succ, + List.range_zero, List.nil_append, List.map_cons, List.map_nil, List.cons_append, List.cons.injEq, + and_true] + refine ⟨?_, ?_, ?_, ?_⟩ <;> + · ext i hi + simp only [BitVec.getElem_extractLsb', BitVec.getLsbD_append] + repeat' split + all_goals first | omega | (rw [← BitVec.getLsbD_eq_getElem]; congr 1; omega) + +/-- A word of `xs` is its four bytes. -/ +theorem wordOf_bytes {xs : List Byte} {k : Nat} (hk : 4 * k + 4 ≤ xs.length) : + (List.range (32 / 8)).map (fun j => ((wordOf xs k).setWidth (8 * (32 / 8))).extractLsb' (8 * j) 8) = + (xs.drop (4 * k)).take 4 := by + rw [wordOf, word_bytes] + apply List.ext_getElem (by simp; omega) + intro j h₁ h₂ + simp only [List.length_cons, List.length_nil] at h₁ + simp only [List.getElem_take, List.getElem_drop, List.getD_eq_getElem?_getD, + List.getElem?_eq_getElem (show 4 * k + 3 < xs.length by omega), List.getElem?_eq_getElem (show 4 * k + 2 < xs.length by omega), + List.getElem?_eq_getElem (show 4 * k + 1 < xs.length by omega), List.getElem?_eq_getElem (show 4 * k < xs.length by omega), + Option.getD_some] + rcases (by omega : j = 0 ∨ j = 1 ∨ j = 2 ∨ j = 3) with rfl | rfl | rfl | rfl <;> rfl + +/-- Storing the first `4 n` bytes of `xs` at `[y + o]`, a word at a time. -/ +theorem storeW_ok {dst : Reg} (hd : dst ≠ .ecx) {y : BitVec 32} {o : Nat} {xs : List Byte} (n : Nat) : + ∀ (rest : List Instr) (s : State) (Q : State → Prop), 4 * n ≤ xs.length → + s.gpr dst = y → y.toNat + o + 4 * n ≤ 2 ^ 32 → (∀ k < n, InRegions s.wr (addr y (o + 4 * k)) 4) → + (∀ s', (∀ r, r ≠ .ecx → 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 o) (xs.take (4 * n)) → + WP isa (.block rest) s' Q) → + WP isa (.block (storeW dst o xs n ++ rest)) s Q := by + induction n with + | zero => + intro rest s Q _ _ _ _ k + exact k s (fun _ _ => rfl) rfl rfl (by simp [writeBytes_nil]) + | succ n ih => + intro rest s Q hl hy fy hout k + rw [storeW, List.range_succ, List.flatMap_append, List.flatMap_singleton, List.append_assoc] + refine ih _ s Q (by omega) 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_movi fun s₂ u₂ => ?_ + refine wp_store (a := addr y (o + 4 * n)) (by rw [ea_at, u₂.other _ hd, g₁ _ hd, hy]) + (by rw [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, g₁ r hr]) + (by rw [u₃.rd, u₂.rd, rd₁]) (by rw [u₃.wr, u₂.wr, wr₁]) ?_ + have ht : (xs.take (4 * n)).length = 4 * n := by simp; omega + rw [u₃.mem, u₂.gpr, u₂.mem, m₁, addr_word fy (by omega : n < n + 1), + Memory.writeW_bytes _ _ (wordOf xs n) ((xs.drop (4 * n)).take 4) (wordOf_bytes (by omega)), + Memory.writeBytes_append' _ _ _ (by rw [ht]) (by simp; omega), show 4 * (n + 1) = 4 * n + 4 by omega, + List.take_add] + +/-! ## The compression function -/ + +/-- The contract of a compression function `compress(state, blocks, n, scratch)` +of `H`, with `so` bytes of scratch space: updates the hash value at `state` +with the `n` blocks at `blocks` (as `Proof.Md5.compressX86` and the others). -/ +def cmpK {B N L : Nat} (H : Md B N L) (so : Nat) : Contract isa where + pre s := + let state : Region := ⟨(arg s 0).setWidth 64, N⟩ + let blocks : Region := ⟨(arg s 1).setWidth 64, B * (arg s 2).toNat⟩ + let scratch : Region := ⟨(arg s 3).setWidth 64, so⟩ + let args : Region := ⟨argAddr s 0, 16⟩ + let ret : Region := ⟨(s.gpr .esp).setWidth 64, 4⟩ + s.rd = [blocks, args] ∧ s.wr = [state, scratch] ∧ + state.Disjoint scratch ∧ blocks.Disjoint state ∧ blocks.Disjoint scratch ∧ + args.Disjoint state ∧ args.Disjoint scratch ∧ ret.Disjoint state ∧ ret.Disjoint scratch ∧ + (arg s 0).toNat + N ≤ 2 ^ 32 ∧ (arg s 1).toNat + B * (arg s 2).toNat ≤ 2 ^ 32 ∧ + (arg s 3).toNat + so ≤ 2 ^ 32 ∧ (s.gpr .esp).toNat + 20 ≤ 2 ^ 32 + post s s' := + H.stateAt s'.mem ((arg s 0).setWidth 64) = + H.compressBlocks (H.stateAt s.mem ((arg s 0).setWidth 64)) s.mem ((arg s 1).setWidth 64) (arg s 2).toNat + pub s₁ s₂ := + s₁.gpr .esp = s₂.gpr .esp ∧ + arg s₁ 0 = arg s₂ 0 ∧ arg s₁ 1 = arg s₂ 1 ∧ arg s₁ 2 = arg s₂ 2 ∧ arg s₁ 3 = arg s₂ 3 + +/-- A verified compression function, as the code calls it: correct and +constant time, never writing `esp`, and calling nothing that uses the +stack. -/ +structure CompOk {B N L : Nat} (H : Md B N L) (so : Nat) (code : Prog isa) : Prop where + verified : Verified X86.target code (cmpK H so) + nosp : NoSp code + stack : stackUse code = 0 + +/-- The four words a call of the compression function pushes, last to first. -/ +abbrev cmp4 : List Reg := [.ebp, .ecx, .eax, .ebx] + +theorem cmp4_nesp : Reg.esp ∉ cmp4 := by decide + +/-- A part of a region that `rs` covers. -/ +theorem covers_off {rs : List Region} {b : Addr} {L o n : Nat} (h : Covers [⟨b, L⟩] rs) (hl : o + n ≤ L) : + Covers [⟨b + BitVec.ofNat 64 o, n⟩] rs := fun a k hi => + h a k (Covers.of_sub (fun r hr => by + simp only [List.mem_singleton] at hr; subst hr + exact ⟨_, List.mem_singleton_self _, o, rfl, hl⟩) a k hi) + +theorem covers_cons {rs : List Region} {r : Region} {l : List Region} (h : Covers [r] rs) (h' : Covers l rs) : + Covers (r :: l) rs := fun a k ⟨q, hq, hc⟩ => by + rcases List.mem_cons.mp hq with rfl | hq + · exact h a k ⟨_, List.mem_singleton_self _, hc⟩ + · exact h' a k ⟨q, hq, hc⟩ + +/-- What the frame of a call of the compression function needs of the state +before its push: the hash value at `st` in `ebx` and the block after it in +`eax`, the scratch space at `sc` in `ebp`, `ecx = 1`, the regions the callee +may write, disjoint, and from the 48 bytes below `esp`, and none wrapping +around. -/ +structure CmpArgs (N B so : Nat) (s : State) (st sc : BitVec 32) : Prop where + ebx : s.gpr .ebx = st + eax : s.gpr .eax = st + BitVec.ofNat 32 N + ebp : s.gpr .ebp = sc + sp48 : 48 ≤ (s.gpr .esp).toNat + cst : Covers [⟨st.setWidth 64, N + B⟩] s.wr + csc : Covers [⟨sc.setWidth 64, so⟩] s.wr + st_sc : Region.Disjoint ⟨st.setWidth 64, N + B⟩ ⟨sc.setWidth 64, so⟩ + b_st : (stk s).Disjoint ⟨st.setWidth 64, N + B⟩ + b_sc : (stk s).Disjoint ⟨sc.setWidth 64, so⟩ + nst : st.toNat + (N + B) ≤ 2 ^ 32 + nsc : sc.toNat + so ≤ 2 ^ 32 + +/-- The regions the compression function is given: the block and its +arguments, the hash value and its scratch space. -/ +abbrev CmpArgs.rd (N B : Nat) (st sp : BitVec 32) : List Region := + [⟨(st + BitVec.ofNat 32 N).setWidth 64, B * 1⟩, below sp 16] +abbrev CmpArgs.wr (N so : Nat) (st sc : BitVec 32) : List Region := [⟨st.setWidth 64, N⟩, ⟨sc.setWidth 64, so⟩] + +namespace CmpArgs +variable {N B so : Nat} {s : State} {st sc : BitVec 32} (h : CmpArgs N B so s st sc) (hcx : s.gpr .ecx = 1) +include h + +theorem fit : 4 * cmp4.length + 4 ≤ (s.gpr .esp).toNat := by + have := h.sp48; simp only [List.length_cons, List.length_nil]; omega + + +theorem a0 : arg (pushed cmp4 s).callEntry 0 = st := by + rw [callEntry_arg h.fit cmp4_nesp (by simp)]; simpa using h.ebx +theorem a1 : arg (pushed cmp4 s).callEntry 1 = st + BitVec.ofNat 32 N := by + rw [callEntry_arg h.fit cmp4_nesp (by simp)]; simpa using h.eax +theorem a3 : arg (pushed cmp4 s).callEntry 3 = sc := by + rw [callEntry_arg h.fit cmp4_nesp (by simp)]; simpa using h.ebp + +include hcx in +theorem a2 : arg (pushed cmp4 s).callEntry 2 = 1 := by + rw [callEntry_arg h.fit cmp4_nesp (by simp)]; simpa using hcx + +theorem blk (hB : 0 < B) : (st + BitVec.ofNat 32 N).setWidth 64 = st.setWidth 64 + BitVec.ofNat 64 N := + setWidth_add (by have := h.nst; omega) + +include hcx in +theorem callPre {L : Nat} (H : Md B N L) (hB : 0 < B) : + CallPre (cmpK H so) cmp4 (CmpArgs.rd N B st (s.gpr .esp)) (CmpArgs.wr N so st sc) s := by + have e := h.sp48 + have fit := h.fit + have nst := h.nst + have a2' : (arg (pushed cmp4 s).callEntry 2).toNat = 1 := by rw [h.a2 hcx]; rfl + have hb : (st + BitVec.ofNat 32 N).toNat = st.toNat + N := toNat_add_ofNat (by omega) + have sS : Region.Sub ⟨st.setWidth 64, N⟩ ⟨st.setWidth 64, N + B⟩ := Region.sub_prefix (by omega) + have sB : Region.Sub ⟨(st + BitVec.ofNat 32 N).setWidth 64, B * 1⟩ ⟨st.setWidth 64, N + B⟩ := by + rw [h.blk hB]; exact sub_offset (by omega) (by omega) + have dBS : Region.Disjoint ⟨(st + BitVec.ofNat 32 N).setWidth 64, B * 1⟩ ⟨st.setWidth 64, N⟩ := by + rw [h.blk hB]; exact Offset.disjoint_base _ (by omega) (by omega) + refine ⟨?_, ?_, ?_⟩ + · simp only [cmpK, State.withRegions_rd, State.withRegions_wr, State.withRegions_gpr, arg_withRegions, + argAddr_withRegions, h.a0, h.a1, h.a3, a2', callEntry_argAddr0, callEntry_esp', cmp4, + List.length_cons, List.length_nil] + have sA : Region.Sub ⟨(s.gpr .esp - BitVec.ofNat 32 (4 * 4)).setWidth 64, 16⟩ (stk s) := + stk_sub e (by omega) (by omega) + have sR : Region.Sub ⟨(s.gpr .esp - BitVec.ofNat 32 (4 * 4 + 4)).setWidth 64, 4⟩ (stk s) := + stk_sub e (by omega) (by omega) + refine ⟨trivial, trivial, h.st_sc.sub_left sS, dBS, h.st_sc.sub_left sB, (h.b_st.sub_left sA).sub_right sS, + h.b_sc.sub_left sA, (h.b_st.sub_left sR).sub_right sS, h.b_sc.sub_left sR, by omega, by rw [hb]; omega, + h.nsc, ?_⟩ + rw [sub_toNat (by omega)]; have := (s.gpr .esp).isLt; omega + · have cB : Covers [⟨(st + BitVec.ofNat 32 N).setWidth 64, B * 1⟩] s.wr := by + rw [h.blk hB]; exact covers_off h.cst (by omega) + have cS : Covers [⟨st.setWidth 64, N⟩] s.wr := by + have := covers_off (o := 0) (n := N) h.cst (by omega); simpa using this + intro a n ⟨q, hq, hc⟩ + simp only [List.cons_append, List.nil_append, List.mem_cons, List.not_mem_nil, or_false] at hq + rcases hq with rfl | rfl | rfl | rfl + · obtain ⟨q', hq', hc'⟩ := cB a n ⟨_, List.mem_singleton_self _, hc⟩ + exact InRegions_append_cons.mpr (.inr ⟨q', List.mem_append_right _ hq', hc'⟩) + · refine InRegions_append_cons.mpr (.inl ?_) + simpa using hc + · obtain ⟨q', hq', hc'⟩ := cS a n ⟨_, List.mem_singleton_self _, hc⟩ + exact InRegions_append_cons.mpr (.inr ⟨q', List.mem_append_right _ hq', hc'⟩) + · obtain ⟨q', hq', hc'⟩ := h.csc a n ⟨_, List.mem_singleton_self _, hc⟩ + exact InRegions_append_cons.mpr (.inr ⟨q', List.mem_append_right _ hq', hc'⟩) + · have cS : Covers [⟨st.setWidth 64, N⟩] s.wr := by + have := covers_off (o := 0) (n := N) h.cst (by omega); simpa using this + intro a n hi + obtain ⟨q', hq', hc'⟩ := covers_cons cS h.csc a n hi + exact ⟨q', List.mem_cons_of_mem _ hq', hc'⟩ + +theorem entry_frame : Frame [stk s] s.mem (pushed cmp4 s).callEntry.mem := + (callEntry_frame h.fit cmp4_nesp).sub fun q hq => by + simp only [List.mem_singleton] at hq; subst hq + exact ⟨_, List.mem_singleton_self _, below_sub (by simp only [List.length_cons, List.length_nil]; omega) h.sp48⟩ + +end CmpArgs + +section +variable {B N L : Nat} {H : Md B N L} {so : Nat} {name : String} {code : Prog isa} (hc : CompOk H so code) +include hc + +/-- A call of the compression function on the block after the hash value at +`st`, in a frame of its arguments: it compresses the block into the hash +value, writing only the hash value, its scratch space and the stack below +`esp`. -/ +theorem cmp_frame (hB : 0 < B) {s : State} {st sc : BitVec 32} (h : CmpArgs N B so s st sc) (hcx : s.gpr .ecx = 1) + {Q : State → Prop} + (hQ : ∀ s', After s [⟨st.setWidth 64, N⟩, ⟨sc.setWidth 64, so⟩] s' → + H.stateAt s'.mem (st.setWidth 64) = + H.compress (H.stateAt s.mem (st.setWidth 64)) (H.blockAt s.mem (st.setWidth 64 + BitVec.ofNat 64 N)) → + Q s') : + WP isa (.frame (.push cmp4) (.call name code) (.pop .eax cmp4.length)) s Q := by + have e := h.sp48 + refine WP.callWith hc.verified.1 hc.nosp (by simp) cmp4_nesp + (by rw [hc.stack]; simp only [List.length_cons, List.length_nil]; omega) (h.callPre hcx H hB) + fun s' rd' wr' cs' f' ⟨s₂, m₂, post⟩ => ?_ + rw [hc.stack] at f' + refine hQ s' (after_of e (by simp only [List.length_cons, List.length_nil]; omega) rd' wr' cs' f') ?_ + simp only [cmpK, arg_withRegions, State.withRegions_mem, h.a0, h.a1, h.a2 hcx] at post + have fE := h.entry_frame + have dS : ∀ q ∈ [stk s], (⟨st.setWidth 64, N + B⟩ : Region).Disjoint q := by + simp only [List.mem_singleton]; rintro q rfl; exact h.b_st.symm + have e₁ : H.stateAt (pushed cmp4 s).callEntry.mem (st.setWidth 64) = H.stateAt s.mem (st.setWidth 64) := + H.stateAt_congr fun i hi => fE.bytes (R := ⟨st.setWidth 64, N + B⟩) dS (by + show N + B ≤ 2 ^ 64; have := h.nst; omega) (by show i < N + B; omega) + have e₂ : H.blockAt (pushed cmp4 s).callEntry.mem (st.setWidth 64 + BitVec.ofNat 64 N) = + H.blockAt s.mem (st.setWidth 64 + BitVec.ofNat 64 N) := by + simp only [Md.blockAt] + refine H.parse_congr fun k hk => ?_ + rw [Memory.add_ofNat] + exact fE.bytes (R := ⟨st.setWidth 64, N + B⟩) dS (by show N + B ≤ 2 ^ 64; have := h.nst; omega) + (by show N + k < N + B; omega) + rw [← m₂, post, show (1 : BitVec 32).toNat = 1 from rfl, Md.compressBlocks_one, e₁, h.blk hB, e₂] + +/-- The compression of the block after the hash value at `ebx`, with `eax` +at the block. -/ +theorem cmp_ok (hB : 0 < B) {s : State} {st sc : BitVec 32} (h : CmpArgs N B so s st sc) {Q : State → Prop} + (hQ : ∀ s', After s [⟨st.setWidth 64, N⟩, ⟨sc.setWidth 64, so⟩] s' → + H.stateAt s'.mem (st.setWidth 64) = + H.compress (H.stateAt s.mem (st.setWidth 64)) (H.blockAt s.mem (st.setWidth 64 + BitVec.ofNat 64 N)) → + Q s') : + WP isa (Impl.MdStream.X86.compressAt name code .ebx .ebp) s Q := by + refine WP.seq (wp_movi fun s₁ u₁ => WP.block_nil ?_) + have h₁ : CmpArgs N B so s₁ st sc := + { ebx := by rw [u₁.other _ (by decide), h.ebx], eax := by rw [u₁.other _ (by decide), h.eax], + ebp := by rw [u₁.other _ (by decide), h.ebp], sp48 := by rw [u₁.other _ (by decide)]; exact h.sp48, + cst := by rw [u₁.wr]; exact h.cst, csc := by rw [u₁.wr]; exact h.csc, st_sc := h.st_sc, b_st := by rw [stk, u₁.other _ (by decide)]; exact h.b_st, + b_sc := by rw [stk, u₁.other _ (by decide)]; exact h.b_sc, nst := h.nst, nsc := h.nsc } + refine cmp_frame hc hB h₁ u₁.gpr fun s' ha e => hQ s' ?_ (by rw [e, u₁.mem]) + exact ⟨ha.rd.trans u₁.rd, ha.wr.trans u₁.wr, fun r hr => (ha.cs r hr).trans (u₁.other r (by + simp only [calleeSaved, List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl | rfl | rfl <;> decide)), + by have f := ha.frame; rw [stk, u₁.other _ (by decide), u₁.mem] at f; rw [stk]; exact f⟩ + +omit hc in +theorem mov1_check : ∃ hc, (VG.Taint.check taint (τr []) (.block [.mov .ecx (.imm 1)]) hc).isSome = true := + ⟨_, by taint_decide⟩ + +/-- Two runs of the compression of the block, from the same hash value and +scratch space, and the same `esp`, leak the same: the call by the compression +function's contract. -/ +theorem cmp_rel (hB : 0 < B) {P : State → State → Prop} {sp st sc : BitVec 32} + (h : ∀ s s', P s s' → CmpArgs N B so s st sc ∧ CmpArgs N B so s' st sc ∧ s.gpr .esp = sp ∧ s'.gpr .esp = sp) : + RelCT isa P (Impl.MdStream.X86.compressAt name code .ebx .ebp) fun _ _ => True := by + have wp1 : ∀ s, CmpArgs N B so s st sc ∧ s.gpr .esp = sp → WP isa (.block [.mov .ecx (.imm 1)]) s + fun t => (CmpArgs N B so t st sc ∧ t.gpr .ecx = 1) ∧ t.gpr .esp = sp := fun s ⟨a, e⟩ => + wp_movi fun s₁ u₁ => WP.block_nil + ⟨⟨{ ebx := by rw [u₁.other _ (by decide), a.ebx], eax := by rw [u₁.other _ (by decide), a.eax], + ebp := by rw [u₁.other _ (by decide), a.ebp], sp48 := by rw [u₁.other _ (by decide)]; exact a.sp48, + cst := by rw [u₁.wr]; exact a.cst, csc := by rw [u₁.wr]; exact a.csc, st_sc := a.st_sc, + b_st := by rw [stk, u₁.other _ (by decide)]; exact a.b_st, + b_sc := by rw [stk, u₁.other _ (by decide)]; exact a.b_sc, nst := a.nst, nsc := a.nsc }, u₁.gpr⟩, + by rw [u₁.other _ (by decide), e]⟩ + have r1 := rel_agree (F := fun s => CmpArgs N B so s st sc ∧ s.gpr .esp = sp) + (F' := fun s => CmpArgs N B so s st sc ∧ s.gpr .esp = sp) (τr []) (fun _ _ _ _ => agree_regs (by simp)) + mov1_check (wp1) (wp1) + refine (r1.mono (fun s s' hp => by + obtain ⟨a, a', e, e'⟩ := h s s' hp; exact ⟨⟨a, e⟩, ⟨a', e'⟩⟩) fun _ _ h => h).seq ?_ + refine RelCT.callWith (rs := cmp4) hc.verified.1 hc.verified.2.1 (CmpArgs.rd N B st sp) + (CmpArgs.wr N so st sc) fun s s' ⟨⟨⟨a, x⟩, e⟩, ⟨⟨a', x'⟩, e'⟩⟩ => ?_ + have c := a.callPre x H hB + have c' := a'.callPre x' H hB + rw [e] at c; rw [e'] at c' + refine ⟨c, c', e.trans e'.symm, ?_, ?_, ?_, ?_, ?_⟩ + · simp only [State.withRegions_gpr, callEntry_esp', e, e'] + · simp only [arg_withRegions, a.a0, a'.a0] + · simp only [arg_withRegions, a.a1, a'.a1] + · simp only [arg_withRegions, a.a2 x, a'.a2 x'] + · simp only [arg_withRegions, a.a3, a'.a3] + +end + +/-! ## The digest -/ + +/-- `out` writes the digest of the `N`-byte hash value at `ebx` to `eax`, +writing only `ecx` and `edx`. -/ +def OutOk {B N L : Nat} (H : Md B N L) (out : List Instr) : Prop := + ∀ s : State, (s.gpr .ebx).toNat + N ≤ 2 ^ 32 → (s.gpr .eax).toNat + N ≤ 2 ^ 32 → + InRegions (s.rd ++ s.wr) ((s.gpr .ebx).setWidth 64) N → InRegions s.wr ((s.gpr .eax).setWidth 64) N → + Region.Disjoint ⟨(s.gpr .ebx).setWidth 64, N⟩ ⟨(s.gpr .eax).setWidth 64, N⟩ → + WP isa (.block out) s fun s' => + (∀ r, r ≠ .ecx → r ≠ .edx → s'.gpr r = s.gpr r) ∧ s'.rd = s.rd ∧ s'.wr = s.wr ∧ + s'.mem = writeBytes s.mem ((s.gpr .eax).setWidth 64) (H.digest (H.stateAt s.mem ((s.gpr .ebx).setWidth 64))) + +/-! ## The block after the hash value at `ebx` -/ + +/-- The sizes the proofs support, checked for each hash function by `decide`: +blocks of 64 or 128 bytes, a hash value of words, a digest of words of at +most the hash value, room in the block for the digest, the `0x80` word and +the length field, a streaming state of a hash value and a block, and the +compression function's scratch space within that of the streaming +functions. -/ +structure Sizes (H : Hash) : Prop where + B : H.B = 64 ∨ H.B = 128 + N : 0 < H.N ∧ H.N ≤ 64 ∧ H.N % 4 = 0 + D : 0 < H.D ∧ H.D ≤ H.N ∧ H.D % 4 = 0 + DL : H.D + H.L + 4 ≤ H.B + S : H.S = H.N + H.B + so : H.so ≤ 8 * H.st.W + W : H.st.W ≤ 64 + F : H.D ≤ H.st.F ∧ H.st.F ≤ 64 + +/-- A range within a region that `rs` covers. -/ +theorem inReg {rs : List Region} {b : Addr} {L o n : Nat} (h : Covers [⟨b, L⟩] rs) (hl : o + n ≤ L) + (hL : L < 2 ^ 64) : InRegions rs (b + BitVec.ofNat 64 o) n := + h _ _ ⟨_, List.mem_singleton_self _, Offset.contains_base _ hl (by omega)⟩ + +section +variable {H : Hash} (hz : Sizes H) +include hz + +theorem Sizes.B4 : H.B % 4 = 0 ∧ 64 ≤ H.B ∧ H.B ≤ 128 := by rcases hz.B with h | h <;> rw [h] <;> decide + +theorem Sizes.tail_length : H.tailB.length = H.B - H.D := by + have := hz.DL + simp only [Hash.tailB, tail, List.length_append, List.length_singleton, List.length_replicate, + List.length_map, List.length_range] + omega + +omit hz in +/-- `eax` at the block. -/ +theorem atBlk_ok {s : State} {rest : List Instr} {Q : State → Prop} + (k : ∀ s', s'.gpr .eax = s.gpr .ebx + BitVec.ofNat 32 H.N → (∀ r, r ≠ .eax → 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 (H.atBlk ++ rest)) s Q := by + simp only [Hash.atBlk, List.cons_append, List.nil_append] + exact wp_mov fun s₁ u₁ => wp_addi fun s₂ u₂ => k s₂ (by rw [u₂.gpr, u₁.gpr]) + (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]) + +/-- The padding after the block's first `D` bytes. -/ +theorem pad_ok {s : State} {x : BitVec 32} (hx : s.gpr .ebx = x) (hf : x.toNat + (H.N + H.B) ≤ 2 ^ 32) + (hw : Covers [⟨x.setWidth 64, H.N + H.B⟩] s.wr) {rest : List Instr} {Q : State → Prop} + (k : ∀ s', (∀ r, r ≠ .ecx → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → + s'.mem = writeBytes s.mem (x.setWidth 64 + BitVec.ofNat 64 (H.N + H.D)) H.tailB → + WP isa (.block rest) s' Q) : + WP isa (.block (H.pad ++ rest)) s Q := by + have := hz.D; have := hz.B4; have := hz.tail_length; have := hz.DL + have h4 : 4 * ((H.B - H.D) / 4) = H.B - H.D := by omega + refine storeW_ok (by decide) _ rest s Q (by omega) hx (by omega) (fun j hj => ?_) fun s' g rd wr m => + k s' g rd wr ?_ + · rw [addr_eq (by omega)]; exact inReg hw (by omega) (by omega) + · rw [m, h4, List.take_of_length_le (by omega)] + +end + +/-- The digest of the hash value into the block, from `OutOk`, the padding +after its first `D` bytes as it was. -/ +theorem digest_ok {H : Hash} (hz : Sizes H) {md : Md H.B H.N H.L} (hout : OutOk md H.out) {s : State} + {x : BitVec 32} (hx : s.gpr .ebx = x) (hf : x.toNat + (H.N + H.B) ≤ 2 ^ 32) + (hw : Covers [⟨x.setWidth 64, H.N + H.B⟩] s.wr) + (hpad : bytesAt s.mem (x.setWidth 64 + BitVec.ofNat 64 (H.N + H.D)) (H.B - H.D) = H.tailB) + {rest : List Instr} {Q : State → Prop} + (k : ∀ s', (∀ r, r ≠ .eax → r ≠ .ecx → r ≠ .edx → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → + Frame [⟨x.setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩] s.mem s'.mem → + bytesAt s'.mem (x.setWidth 64 + BitVec.ofNat 64 H.N) H.D = (md.digest (md.stateAt s.mem (x.setWidth 64))).take H.D → + bytesAt s'.mem (x.setWidth 64 + BitVec.ofNat 64 (H.N + H.D)) (H.B - H.D) = H.tailB → + WP isa (.block rest) s' Q) : + WP isa (.block (H.digest ++ rest)) s Q := by + have := hz.D; have := hz.B4; have := hz.tail_length; have := hz.N; have := hz.DL + have h4 : 4 * ((H.N - H.D) / 4) = H.N - H.D := by omega + let X := x.setWidth 64 + have aN : (x + BitVec.ofNat 32 H.N).setWidth 64 = X + BitVec.ofNat 64 H.N := setWidth_add (by omega) + have tN : (x + BitVec.ofNat 32 H.N).toNat = x.toNat + H.N := toNat_add_ofNat (by omega) + unfold Hash.digest + simp only [List.append_assoc] + refine atBlk_ok fun s₁ e₁ g₁ m₁ rd₁ wr₁ => ?_ + rw [WP.block_append_iff] + have bx₁ : s₁.gpr .ebx = x := by rw [g₁ _ (by decide), hx] + refine WP.mono (hout s₁ (by rw [bx₁]; omega) (by rw [e₁, hx, tN]; omega) ?_ ?_ ?_) fun s₂ ⟨g₂, rd₂, wr₂, m₂⟩ => ?_ + · rw [bx₁, rd₁, wr₁] + have := inReg (o := 0) (n := H.N) hw (by omega) (by omega) + rw [BitVec.add_zero] at this + exact Proof.Hmac.Generic.Common.InRegions.right' this + · rw [e₁, hx, aN, wr₁]; exact inReg hw (by omega) (by omega) + · rw [bx₁, e₁, hx, aN]; exact Offset.base_disjoint _ (Nat.le_refl _) (by omega) + rw [e₁, hx, aN, bx₁, m₁] at m₂ + have hdl := md.digest_length (md.stateAt s.mem X) + have bx₂ : s₂.gpr .ebx = x := by rw [g₂ _ (by decide) (by decide), bx₁] + refine storeW_ok (by decide) _ rest s₂ Q (by omega) bx₂ (by omega) (fun j hj => ?_) + fun s₃ g₃ rd₃ wr₃ m₃ => k s₃ (fun r h1 h2 h3 => by rw [g₃ r h2, g₂ r h2 h3, g₁ r h1]) (by rw [rd₃, rd₂, rd₁]) + (by rw [wr₃, wr₂, wr₁]) ?_ ?_ ?_ + · rw [addr_eq (by omega), wr₂, wr₁]; exact inReg hw (by omega) (by omega) + · rw [m₃, m₂, h4] + refine (writeBytes_frame _ _ _ ?_).trans (writeBytes_frame _ _ _ ?_) + · rw [hdl]; have := Offset.contains_base (X + BitVec.ofNat 64 H.N) (d := 0) (n := H.N) (k := H.B) (by omega) + (by omega); rwa [BitVec.add_zero] at this + · rw [List.length_take, Nat.min_eq_left (by omega), ← Memory.add_ofNat] + exact Offset.contains_base _ (by omega) (by omega) + · rw [m₃, h4, bytesAt_writeBytes_sep _ _ ?_ (by omega), m₂, + Proof.Hmac.Generic.Common.bytesAt_take _ _ hz.D.2.1, + Proof.Hmac.Generic.Common.bytesAt_writeBytes_self' hdl (by omega)] + rw [List.length_take, Nat.min_eq_left (by omega), ← Memory.add_ofNat] + have := Offset.sep (X + BitVec.ofNat 64 H.N) (d := 0) (n := H.D) (e := H.D) (k := H.N - H.D) (.inl (by omega)) + (by omega) (by omega) + rwa [BitVec.add_zero] at this + · -- The padding: its first `N - D` bytes written back, the rest as it was. + have hsplit : ∀ m : Mem, bytesAt m (X + BitVec.ofNat 64 (H.N + H.D)) (H.B - H.D) = + bytesAt m (X + BitVec.ofNat 64 (H.N + H.D)) (H.N - H.D) ++ + bytesAt m (X + BitVec.ofNat 64 (H.N + H.N)) (H.B - H.N) := by + intro m + rw [show H.B - H.D = (H.N - H.D) + (H.B - H.N) by omega, bytesAt_add, Memory.add_ofNat, + show H.N + H.D + (H.N - H.D) = H.N + H.N by omega] + have hY : bytesAt s.mem (X + BitVec.ofNat 64 (H.N + H.N)) (H.B - H.N) = H.tailB.drop (H.N - H.D) := by + rw [← hpad, hsplit, List.drop_left' (bytesAt_length _ _ _)] + have r₂ : bytesAt s₂.mem (X + BitVec.ofNat 64 (H.N + H.N)) (H.B - H.N) = + bytesAt s.mem (X + BitVec.ofNat 64 (H.N + H.N)) (H.B - H.N) := by + rw [m₂, ← Memory.add_ofNat] + refine bytesAt_writeBytes_sep _ _ ?_ (by omega) + rw [hdl] + have := Offset.sep (X + BitVec.ofNat 64 H.N) (d := H.N) (n := H.B - H.N) (e := 0) (k := H.N) (.inr (by omega)) + (by omega) (by omega) + rwa [BitVec.add_zero] at this + have htl : (H.tailB.take (H.N - H.D)).length = H.N - H.D := by rw [List.length_take]; omega + rw [hsplit, m₃, h4, Proof.Hmac.Generic.Common.bytesAt_writeBytes_self' htl (by omega), + bytesAt_writeBytes_sep _ _ ?_ (by omega), r₂, hY, List.take_append_drop] + rw [htl, ← Memory.add_ofNat, ← Memory.add_ofNat] + exact Offset.sep _ (.inr (by omega)) (by omega) (by omega) + +/-! ## What the proofs know of a hash function -/ + +/-- 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 +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 + md : Md H.B H.N H.L + iv : md.HV + link : md.Link hH.SH iv H.D + reloc : md.Reloc + tail : md.tailPad H.D = H.tailB + out : OutOk md H.out + comp : CompOk md H.so H.compC + sizes : Sizes H + +end VG.Proof.Pbkdf2.Md.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean new file mode 100644 index 000000000..800538c03 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean @@ -0,0 +1,247 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Block +import VerifiedGarbage.Proof.Hmac.Generic.X86.Hashes +import VerifiedGarbage.Proof.Sha512.Md +import VerifiedGarbage.Proof.Sha512.X86.Stream.Finalize + +/-! +# HMAC and PBKDF2-HMAC on x86 (32-bit): the Merkle–Damgård hash functions + +Untrusted: everything here is checked by Lean. 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 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 streaming proofs (`Proof/Md5/Md.lean` and +the others), the digests their code writes (`out512_ok` for the SHA-512 +family), and their compression functions' contracts, which are `cmpK`. +-/ + +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.Sha256.Stream (writeBytes writeBytes_nil writeBytes_append writeBytes_frame) + +/-! ## The hash functions -/ + +/-- MD5: a 16-byte hash value, a little-endian length field and digest. -/ +def md5M : Hash := + ⟨md5H, 16, 8, false, 64, "vg_md5_compress", Impl.Md5.X86.compress, Impl.Md5.X86.Stream.params.out⟩ + +/-- SHA-1: a 20-byte hash value, a big-endian length field and digest. -/ +def sha1M : Hash := + ⟨sha1H, 20, 8, true, 112, "vg_sha1_compress", Impl.Sha1.X86.compress, Impl.Sha1.X86.Stream.params.out⟩ + +/-- The member of the SHA-512 family with a `D`-byte digest and initial hash +value `iv`: a 64-byte hash value, a big-endian 16-byte length field, and the +digest of the whole hash value (`D` bytes of which are output). -/ +def sha512M (D : Nat) (initN : String) (iv : Spec.Sha512.HashValue) : Hash := + ⟨sha512H D initN iv, 64, 16, true, 224, "vg_sha512_compress", Impl.Sha512.X86.compress, + (List.range 8).flatMap Impl.Sha512.X86.Stream.outW⟩ + +def sha384M : Hash := sha512M 48 "vg_sha384_init" Spec.Sha512.H0_384 +def sha512M' : Hash := sha512M 64 "vg_sha512_init" Spec.Sha512.H0_512 +def sha512_224M : Hash := sha512M 28 "vg_sha512_224_init" Spec.Sha512.H0_512_224 +def sha512_256M : Hash := sha512M 32 "vg_sha512_256_init" Spec.Sha512.H0_512_256 + +/-! ## The digest of a SHA-512 hash value -/ + +section +open VG.Impl.Sha512.X86.Stream (outW) +open VG.Proof.Sha256.X86.Stream (Upd Mupd wp_movm wp_store wp_bswap contains_addr sub_offset) +open VG.Proof.Sha512.X86.Stream (ea_at) +open VG.Proof.Sha512.X86.Stream.Finalize (writeW_bswap flat_length) +open VG.Proof.Sha512.Word64 (lo hi wordBytes_split) +open VG.Proof.Sha512.X86 (lo_rd64 hi_rd64) +open VG.Proof.Sha512.X86 (stateAt_get) +open Spec.Sha512 (stateAt wordBytes) + +/-- What `outW` has written after `k` words of the hash value at `x` (in +`ebx`) to `y` (in `eax`), from the memory `m₀`. -/ +structure Out512 (s₀ : State) (k : Nat) (s : State) : Prop where + gpr : ∀ r, r ≠ .ecx → r ≠ .edx → s.gpr r = s₀.gpr r + rd : s.rd = s₀.rd + wr : s.wr = s₀.wr + mem : s.mem = writeBytes s₀.mem ((s₀.gpr .eax).setWidth 64) + (((stateAt s₀.mem ((s₀.gpr .ebx).setWidth 64)).toList.take k).flatMap wordBytes) + +theorem out512_step {s₀ : State} (hbx : (s₀.gpr .ebx).toNat + 64 ≤ 2 ^ 32) + (hax : (s₀.gpr .eax).toNat + 64 ≤ 2 ^ 32) + (hin : InRegions (s₀.rd ++ s₀.wr) ((s₀.gpr .ebx).setWidth 64) 64) + (hout : InRegions s₀.wr ((s₀.gpr .eax).setWidth 64) 64) + (hd : Region.Disjoint ⟨(s₀.gpr .ebx).setWidth 64, 64⟩ ⟨(s₀.gpr .eax).setWidth 64, 64⟩) + {k : Nat} (hk : k < 8) {s : State} (h : Out512 s₀ k s) {rest : List Instr} {Q : State → Prop} + (hnext : ∀ s', Out512 s₀ (k + 1) s' → WP isa (.block rest) s' Q) : + WP isa (.block (outW k ++ rest)) s Q := by + set x := s₀.gpr .ebx + set y := s₀.gpr .eax + have hebx : s.gpr .ebx = x := h.gpr _ (by decide) (by decide) + have heax : s.gpr .eax = y := h.gpr _ (by decide) (by decide) + have hP := flat_length (stateAt s₀.mem (x.setWidth 64)) k (Nat.le_of_lt hk) + have sub : ∀ {rs : List Region} {b : BitVec 32}, b.toNat + 64 ≤ 2 ^ 32 → InRegions rs (b.setWidth 64) 64 → + ∀ o, o + 4 ≤ 8 → InRegions rs (addr b (8 * k + o)) 4 := by + intro rs b hb ⟨R, hR, hc⟩ o ho + refine ⟨R, hR, ?_⟩ + rw [addr_eq (by omega)] + have := Offset.contains_base (b.setWidth 64) (d := 8 * k + o) (n := 4) (k := 64) (by omega) (by omega) + simp only [Region.Contains] at hc this ⊢ + have e : (b.setWidth 64 + BitVec.ofNat 64 (8 * k + o) - R.base).toNat ≤ (b.setWidth 64 - R.base).toNat + (8 * k + o) := by + rw [show b.setWidth 64 + BitVec.ofNat 64 (8 * k + o) - R.base = (b.setWidth 64 - R.base) + BitVec.ofNat 64 (8 * k + o) by + rw [VG.Offset.add_sub_comm], BitVec.toNat_add, BitVec.toNat_ofNat, Nat.mod_eq_of_lt (a := 8 * k + o) (by omega)] + exact Nat.mod_le _ _ + omega + -- The word's halves, unchanged since the start. + have hread : ∀ o, o + 4 ≤ 8 → s.mem.readW (addr x (8 * k + o)) 32 = s₀.mem.readW (addr x (8 * k + o)) 32 := by + intro o ho' + rw [h.mem] + have hc : (⟨y.setWidth 64, 64⟩ : Region).Contains (y.setWidth 64) + (((stateAt s₀.mem (x.setWidth 64)).toList.take k).flatMap wordBytes).length := by + have := Offset.contains_base (y.setWidth 64) (d := 0) (n := 8 * k) (k := 64) (by omega) (by omega) + rw [hP]; rwa [show y.setWidth 64 + BitVec.ofNat 64 0 = y.setWidth 64 from BitVec.add_zero _] at this + refine (writeBytes_frame _ _ _ hc).readW + (r := ⟨addr x (8 * k + o), 4⟩) (Region.contains_self _ _) ?_ (by decide) + intro r' hr' + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr' + subst hr' + rw [addr_eq (by omega)] + exact hd.sub_left (Offset.sub_base _ (by omega)) + have hw := stateAt_get (st := x) hbx s₀.mem hk + have wlo : s₀.mem.readW (addr x (8 * k + 0)) 32 = lo (stateAt s₀.mem (x.setWidth 64))[k] := by + rw [hw, lo_rd64, Nat.add_zero] + have whi : s₀.mem.readW (addr x (8 * k + 4)) 32 = hi (stateAt s₀.mem (x.setWidth 64))[k] := by + rw [hw, hi_rd64] + simp only [outW, List.cons_append, List.nil_append] + refine wp_movm (a := addr x (8 * k + 0)) (by rw [ea_at, hebx, Nat.add_zero]) + (by rw [h.rd, h.wr]; exact sub hbx hin 0 (by omega)) fun s₁ u₁ => ?_ + refine wp_movm (a := addr x (8 * k + 4)) (by rw [ea_at, u₁.other _ (by decide), hebx]) + (by rw [u₁.rd, u₁.wr, h.rd, h.wr]; exact sub hbx hin 4 (by omega)) fun s₂ u₂ => + wp_bswap fun s₃ u₃ => wp_bswap fun s₄ u₄ => ?_ + have heax₄ : s₄.gpr .eax = y := by + rw [u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), u₁.other _ (by decide), heax] + refine wp_store (a := addr y (8 * k + 0)) (by rw [ea_at, heax₄, Nat.add_zero]) + (by rw [u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr]; exact sub hax hout 0 (by omega)) fun s₅ u₅ => ?_ + refine wp_store (a := addr y (8 * k + 4)) (by rw [ea_at, u₅.gpr, heax₄]) + (by rw [u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr]; exact sub hax hout 4 (by omega)) fun s₆ u₆ => + hnext s₆ ⟨fun r h1 h2 => ?_, 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], ?_⟩ + · rw [u₆.gpr, u₅.gpr, u₄.other r h1, u₃.other r h2, u₂.other r h2, u₁.other r h1, h.gpr r h1 h2] + · have v2 : s₄.gpr .edx = bswap (hi (stateAt s₀.mem (x.setWidth 64))[k]) := by + rw [u₄.other _ (by decide), u₃.gpr, u₂.gpr, u₁.mem, hread 4 (by omega), whi] + have v1 : s₅.gpr .ecx = bswap (lo (stateAt s₀.mem (x.setWidth 64))[k]) := by + rw [u₅.gpr, u₄.gpr, u₃.other _ (by decide), u₂.other _ (by decide), u₁.gpr, hread 0 (by omega), wlo] + have a0 : addr y (8 * k + 0) = y.setWidth 64 + + BitVec.ofNat 64 (((stateAt s₀.mem (x.setWidth 64)).toList.take k).flatMap wordBytes).length := by + rw [hP, addr_eq (by omega), Nat.add_zero] + have a4 : addr y (8 * k + 4) = y.setWidth 64 + + BitVec.ofNat 64 (((stateAt s₀.mem (x.setWidth 64)).toList.take k).flatMap wordBytes).length + + BitVec.ofNat 64 (Spec.Sha256.wordBytes (hi (stateAt s₀.mem (x.setWidth 64))[k])).length := by + rw [hP, addr_eq (by omega), BitVec.add_assoc, ← BitVec.ofNat_add]; rfl + rw [u₆.mem, v1, u₅.mem, v2, u₄.mem, u₃.mem, u₂.mem, u₁.mem, writeW_bswap, writeW_bswap, a0, a4, + writeBytes_append _ _ _ _ (by simp [Spec.Sha256.wordBytes]), ← wordBytes_split, h.mem, + writeBytes_append _ _ _ _ (by rw [hP]; simp [wordBytes]; omega), List.take_add_one, + List.getElem?_eq_getElem (by simp; omega), Option.toList_some, List.flatMap_append, + List.flatMap_singleton, Vector.getElem_toList] + +theorem out512_ok : OutOk Proof.Sha512.md ((List.range 8).flatMap outW) := by + intro s₀ hbx hax hin hout hd + have all : ∀ j ≤ 8, ∀ s, Out512 s₀ (8 - j) s → WP isa (.block (((List.range 8).drop (8 - j)).flatMap outW)) s + fun s' => Out512 s₀ 8 s' := by + intro j + induction j with + | zero => + intro _ s h + rw [show (List.range 8).drop (8 - 0) = [] from rfl, List.flatMap_nil] + exact WP.block_nil h + | succ j ih => + intro hj s h + rw [List.drop_eq_getElem_cons (by simp; omega), List.flatMap_cons, List.getElem_range] + refine out512_step hbx hax hin hout hd (by omega) h fun s' h' => ?_ + rw [show 8 - (j + 1) + 1 = 8 - j by omega] at h' ⊢ + exact ih (by omega) s' h' + have := all 8 (Nat.le_refl _) s₀ ⟨fun _ _ _ => rfl, rfl, rfl, by simp [writeBytes_nil]⟩ + rw [show 8 - 8 = 0 from rfl, List.drop_zero] at this + refine WP.mono this fun s' h => ⟨h.gpr, h.rd, h.wr, ?_⟩ + rw [h.mem, List.take_of_length_le (by simp)] + rfl + +end + +/-! ## What the proofs know of them -/ + +/-- The weaker register guarantee `OutOk` asks of `Impl.MdStream.X86`'s +`out`, from its `Shape`. -/ +theorem outOk_of_shape {P : Impl.MdStream.X86.Params} {H : Md 64 P.N 8} (hs : Proof.MdStream.X86.Shape H) : + OutOk H P.out := fun s hbx hax hin hout hd => + WP.mono (hs.out s hbx hax hin hout hd) fun _ ⟨g, rd, wr, m⟩ => ⟨fun r h _ => g r h, rd, wr, m⟩ + +def md5Ok : MdOk md5M where + hH := md5OK + md := Proof.Md5.md + iv := Spec.Md5.H0 + link := ⟨rfl, rfl, rfl, fun _ _ _ h => h, fun m => by + 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⟩ + reloc m m' p q h := by + apply Vector.ext + intro j hj + simp only [Proof.Md5.md, Spec.Md5.stateAt, Vector.getElem_ofFn] + exact Hmac.Generic.Common.readW_reloc (n := 16) h (by omega) + tail := by decide + out := outOk_of_shape Proof.Md5.X86.Stream.shape + comp := ⟨Proof.Md5.X86.compress_verified, NoSp.of_all (by lit_decide), by lit_decide⟩ + sizes := ⟨by decide, by decide, by decide, by decide, rfl, by decide, by decide, by decide⟩ + +def sha1Ok : MdOk sha1M where + hH := sha1OK + md := Proof.Sha1.md + iv := Spec.Sha1.H0 + link := ⟨rfl, rfl, rfl, fun _ _ _ h => h, fun m => by + 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⟩ + reloc m m' p q h := by + apply Vector.ext + intro j hj + simp only [Proof.Sha1.md, Spec.Sha1.stateAt, Vector.getElem_ofFn] + exact Hmac.Generic.Common.readW_reloc (n := 20) h (by omega) + tail := by decide + out := outOk_of_shape Proof.Sha1.X86.Stream.shape + comp := ⟨Proof.Sha1.X86.compress_verified, NoSp.of_all (by lit_decide), by lit_decide⟩ + sizes := ⟨by decide, by decide, by decide, by decide, rfl, by decide, by decide, by decide⟩ + +/-- `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) + (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)) : + MdOk (sha512M D initN iv) where + hH := hO + 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⟩ + reloc m m' p q h := by + apply Vector.ext + intro j hj + simp only [Proof.Sha512.md, Spec.Sha512.stateAt, Vector.getElem_ofFn] + exact Hmac.Generic.Common.readW_reloc (n := 64) h (by omega) + tail := tail + out := out512_ok + comp := ⟨Proof.Sha512.X86.Compress.compress_verified, Proof.Sha512.X86.Stream.compress_nosp, + Proof.Sha512.X86.Stream.compress_stackUse⟩ + sizes := sizes + +def sha384Ok : MdOk sha384M := sha512Ok sha384OK rfl (fun _ => rfl) rfl rfl rfl (by decide) (by decide) ⟨by decide, by decide, by decide, by decide, rfl, by decide, by decide, by decide⟩ +def sha512Ok' : MdOk sha512M' := sha512Ok sha512OK rfl + (fun m => (List.take_of_length_le (Nat.le_of_eq (Hmac.Generic.Common.finalHash_length _ m))).symm) + rfl rfl rfl (by decide) (by decide) ⟨by decide, by decide, by decide, by decide, rfl, by decide, by decide, by decide⟩ +def sha512_224Ok : MdOk sha512_224M := sha512Ok sha512_224OK rfl (fun _ => rfl) rfl rfl rfl (by decide) + (by decide) ⟨by decide, by decide, by decide, by decide, rfl, by decide, by decide, by decide⟩ +def sha512_256Ok : MdOk sha512_256M := sha512Ok sha512_256OK rfl (fun _ => rfl) rfl rfl rfl (by decide) + (by decide) ⟨by decide, by decide, by decide, by decide, rfl, by decide, by decide, by decide⟩ + +end VG.Proof.Pbkdf2.Md.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFin.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFin.lean new file mode 100644 index 000000000..dce48d589 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFin.lean @@ -0,0 +1,370 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Block +import VerifiedGarbage.Proof.Hmac.Generic.X86.Finalize + +/-! +# HMAC over a Merkle–Damgård hash function on x86 (32-bit): `finalize`, correct + +Untrusted: everything here is checked by Lean. 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`. +-/ + +namespace VG.Proof.Pbkdf2.Md.X86.HmacFin + +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 + 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 + 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) +open VG.Proof.Hmac.Common (bytesAt_length bytesAt_add bytesAt_writeBytes_sep writeBytes_at bytesAt_getD' + xorPad_length) +open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil writeBytes_append writeBytes_frame) +open Spec.Sha256 (bytesAt) +open Spec.Hmac (StreamingHash xorPad ipad opad hmacBlockKey) + +/-! ## Sizes and regions -/ + +section +variable {H : Hash} (hz : Sizes H) {sc : Nat} {s₀ : State} (hp : Pre (H := H.st) sc s₀) +include hz hp + +theorem bounds : H.st.buf = 8 * H.st.W + 16 ∧ H.st.buf + H.st.F ≤ 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 ∧ 0 < H.D ∧ H.D ≤ H.N ∧ H.B ≤ 128 ∧ 64 ≤ H.B ∧ + H.S = H.N + H.B ∧ H.D ≤ H.st.F ∧ (inn s₀).toNat + (H.N + H.B) ≤ 2 ^ 32 ∧ + (outer s₀).toNat + (H.N + H.B) ≤ 2 ^ 32 ∧ (op s₀).toNat + H.D ≤ 2 ^ 32 := by + have := hp.ni; have := hp.no; have := hp.np + have hS := hz.S + exact ⟨rfl, hp.fits, hp.nw, hz.so, hz.W, hz.N.1, hz.N.2.1, hz.D.1, hz.D.2.1, hz.B4.2.2, hz.B4.2.1, hS, hz.F.1, + by rw [← hS]; exact hp.ni, by rw [← hS]; exact hp.no, hp.np⟩ + +/-- The compression function's scratch space. -/ +abbrev cmpR (H : Hash) (s₀ : State) : Region := ⟨(scr s₀).setWidth 64, H.so⟩ + +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 hp in +theorem inR_eq : inR (H := H.st) s₀ = ⟨(inn s₀).setWidth 64, H.N + H.B⟩ := by + rw [inR, show H.st.S = H.N + H.B from hz.S] + +/-- The inner state is writable. -/ +theorem cov_in {s : State} (hwr : s.wr = s₀.wr) : Covers [⟨(inn s₀).setWidth 64, H.N + H.B⟩] s.wr := by + rw [← inR_eq hz, hwr] + exact covers_one (wr_mem hp).2.1 + +omit hp in +/-- A part of the inner state. -/ +theorem in_sub {a n : Nat} (h : a + n ≤ H.N + H.B) : + Region.Sub ⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 a, n⟩ (inR (H := H.st) s₀) := by + rw [inR_eq hz]; exact Offset.sub_base _ h + +theorem save_in {a n : Nat} (h : a + n ≤ H.N + H.B) : + (saveR H.st (scr s₀)).Disjoint ⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 a, n⟩ := + (hp.i_s.symm.sub_left (save_sub hp)).sub_right (in_sub hz h) + +/-- `KR` after code that writes only a part of the inner state and `eax`, +`ecx` and `edx`. -/ +theorem kr_write {s s' : State} (h : KR (H := H.st) sc s₀ s) (hrd : s'.rd = s.rd) (hwr : s'.wr = s.wr) + (hg : ∀ r, r ≠ .eax → r ≠ .ecx → r ≠ .edx → s'.gpr r = s.gpr r) {a n : Nat} (hl : a + n ≤ H.N + H.B) + (hf : Frame [⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 a, n⟩] s.mem s'.mem) : KR (H := H.st) sc s₀ s' := + h.keep hrd hwr (fun r hr => hg r (by revert hr; decide +revert) (by revert hr; decide +revert) + (by revert hr; decide +revert)) hf + (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact save_in hz hp hl) + (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact ⟨_, by simp, in_sub hz hl⟩) + +/-- The arguments of the compression of the inner buffer. -/ +theorem cmpArgs {s : State} (hk : KR (H := H.st) sc s₀ s) (hax : s.gpr .eax = inn s₀ + BitVec.ofNat 32 H.N) : + CmpArgs H.N H.B H.so s (inn s₀) (scr s₀) := by + have := bounds hz hp + exact + { ebx := hk.ebx, eax := hax, ebp := hk.ebp, sp48 := by rw [hk.esp]; exact hp.sp48 + cst := cov_in hz hp hk.wr + 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₀, (wr_mem hp).1, 0, by simp, by simp only; omega⟩ + st_sc := by rw [← inR_eq hz]; exact hp.i_s.sub_right (cmp_sub hz hp) + b_st := by rw [stk_eq hk, ← inR_eq hz]; exact hp.b_i + b_sc := by rw [stk_eq hk]; exact hp.b_s.sub_right (cmp_sub hz hp) + nst := by omega + nsc := by omega } + +end + +/-! ## The outer block -/ + +section +variable {H : Hash} (hO : MdOk H) {sc : Nat} {s₀ : State} (hp : Pre (H := H.st) sc s₀) +include hO hp + +/-- The outer hash value over the inner state's, the inner digest into its +buffer and the padding after it, and `eax` at the buffer. -/ +theorem mid_ok {s : State} (hk : KR (H := H.st) sc s₀ s) (hsi : s.gpr .esi = outer s₀) : + WP isa (.block H.finMid) s fun t => KR (H := H.st) sc s₀ t ∧ t.gpr .eax = inn s₀ + BitVec.ofNat 32 H.N ∧ + hO.md.stateAt t.mem ((inn s₀).setWidth 64) = hO.md.stateAt s.mem ((outer s₀).setWidth 64) ∧ + bytesAt t.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.D = bytesAt s.mem (T (H := H.st) s₀) H.D ∧ + bytesAt t.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 (H.N + H.D)) (H.B - H.D) = H.tailB ∧ + Frame [inR (H := H.st) s₀] s.mem t.mem := by + have hz := hO.sizes + obtain ⟨hb, hf, hw, hso, hW, hN0, hN, hD0, hDN, hB, hB64, hS, hDF, ni, no, np⟩ := bounds hz hp + have hN4 := hz.N.2.2; have hD4 := hz.D.2.2; have tl := hz.tail_length; have hDL := hz.DL + have hn4 : 4 * (H.N / 4) = H.N := by omega + have hd4 : 4 * (H.D / 4) = H.D := by omega + obtain ⟨sR, iR, _⟩ := wr_mem hp + have oc : Covers [⟨(outer s₀).setWidth 64, H.N + H.B⟩] (s.rd ++ s.wr) := + covers_one (by rw [hk.rd, hp.rd, ← hS]; simp) + have sc' : Covers [scR sc s₀] (s.rd ++ s.wr) := covers_one (by rw [hk.rd, hk.wr, hp.wr]; simp) + have ic := cov_in hz hp hk.wr + simp only [Hash.finMid, List.append_assoc] + -- The outer hash value. + refine copyW_ok (by decide) (by decide) (H.N / 4) _ s _ hsi hk.ebx (by omega) (by omega) + (fun j hj => by rw [addr_eq (by omega)]; exact inReg oc (by omega) (by omega)) + (fun j hj => by rw [addr_eq (by omega)]; exact inReg ic (by omega) (by omega)) ?_ fun s₁ g₁ rd₁ wr₁ m₁ => ?_ + · rw [hn4, BitVec.add_zero, BitVec.add_zero] + have c₁ : (outerR (H := H.st) s₀).Contains ((outer s₀).setWidth 64) H.N := + Memory.contains_base (show H.N ≤ H.st.S by rw [show H.st.S = H.N + H.B from hz.S]; omega) + have c₂ : (inR (H := H.st) s₀).Contains ((inn s₀).setWidth 64) H.N := + Memory.contains_base (show H.N ≤ H.st.S by rw [show H.st.S = H.N + H.B from hz.S]; omega) + exact hp.i_o.symm.sep c₁ c₂ + rw [hn4, BitVec.add_zero, BitVec.add_zero] at m₁ + have f₁ : Frame [⟨(inn s₀).setWidth 64, H.N⟩] s.mem s₁.mem := by + rw [m₁]; exact writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact Region.contains_self _ _) + -- The digest. + refine copyW_ok (by decide) (by decide) (H.D / 4) _ s₁ _ (by rw [g₁ _ (by decide), hk.ebp]) + (by rw [g₁ _ (by decide), hk.ebx]) (by omega) (by omega) + (fun j hj => by rw [addr_eq (by omega), rd₁, wr₁]; exact inReg sc' (by omega) (by omega)) + (fun j hj => by rw [addr_eq (by omega), wr₁]; exact inReg ic (by omega) (by omega)) ?_ fun s₂ g₂ rd₂ wr₂ m₂ => ?_ + · rw [hd4] + exact hp.i_s.symm.sep (Offset.contains_base _ (by omega) (by omega)) + (by rw [inR_eq hz]; exact Offset.contains_base _ (by omega) (by omega)) + rw [hd4] at m₂ + have f₂ : Frame [⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.D⟩] s₁.mem s₂.mem := by + rw [m₂]; exact writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact Region.contains_self _ _) + -- The padding, and `eax` at the buffer. + refine pad_ok hz (x := inn s₀) (by rw [g₂ _ (by decide), g₁ _ (by decide), hk.ebx]) (by omega) + (by rw [wr₂, wr₁]; exact ic) fun s₃ g₃ rd₃ wr₃ m₃ => ?_ + rw [← List.append_nil H.atBlk] + refine atBlk_ok fun s₄ e₄ g₄ m₄ rd₄ wr₄ => WP.block_nil ?_ + have f₃ : Frame [⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 (H.N + H.D), H.B - H.D⟩] s₂.mem s₄.mem := by + rw [m₄, m₃]; exact writeBytes_frame _ _ _ (by rw [tl]; exact Region.contains_self _ _) + have fI : Frame [inR (H := H.st) s₀] s.mem s₄.mem := + ((f₁.sub fun r hr => by + simp only [List.mem_singleton] at hr; subst hr + have := in_sub hz (s₀ := s₀) (a := 0) (n := H.N) (by omega); rw [BitVec.add_zero] at this + exact ⟨_, List.mem_singleton_self _, this⟩).trans + (f₂.sub fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact ⟨_, List.mem_singleton_self _, in_sub hz (by omega)⟩)).trans + (f₃.sub fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact ⟨_, List.mem_singleton_self _, in_sub hz (by omega)⟩) + have k₄ : KR (H := H.st) sc s₀ s₄ := hk.keep (by rw [rd₄, rd₃, rd₂, rd₁]) (by rw [wr₄, wr₃, wr₂, wr₁]) + (fun r hr => by + rw [g₄ r (by revert hr; decide +revert), g₃ r (by revert hr; decide +revert), + g₂ r (by revert hr; decide +revert), g₁ r (by revert hr; decide +revert)]) fI + (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact hp.i_s.symm.sub_left (save_sub hp)) + (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact ⟨_, by simp, fun _ h => h⟩) + -- The bytes before the padding are not written by it, and those before the digest not by it. + have d₃ : ∀ {a n : Nat}, a + n ≤ H.N + H.D → + ∀ r ∈ [(⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 (H.N + H.D), H.B - H.D⟩ : Region)], + Region.Disjoint ⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 a, n⟩ r := by + intro a n h r hr + simp only [List.mem_singleton] at hr; subst hr + exact Offset.disjoint _ (.inl h) (by omega) (by omega) + refine ⟨k₄, by rw [e₄, g₃ _ (by decide), g₂ _ (by decide), g₁ _ (by decide), hk.ebx], ?_, ?_, ?_, fI⟩ + · refine hO.reloc _ _ _ _ fun i hi => ?_ + have dN : ∀ {a n : Nat}, H.N ≤ a → a + n ≤ H.N + H.B → + ∀ r ∈ [(⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 a, n⟩ : Region)], + Region.Disjoint ⟨(inn s₀).setWidth 64, H.N⟩ r := by + intro a n h₁ h₂ r hr + simp only [List.mem_singleton] at hr; subst hr + exact Offset.base_disjoint _ h₁ (by omega) + rw [f₃.bytes (R := ⟨(inn s₀).setWidth 64, H.N⟩) (dN (by omega) (by omega)) (by show H.N ≤ 2 ^ 64; omega) hi, + f₂.bytes (R := ⟨(inn s₀).setWidth 64, H.N⟩) (dN (by omega) (by omega)) (by show H.N ≤ 2 ^ 64; omega) hi, m₁, + writeBytes_at _ _ _ (by rw [bytesAt_length]; exact hi) (by rw [bytesAt_length]; omega), bytesAt_getD' _ _ hi] + · rw [Memory.frame_bytesAt f₃ (d₃ (by omega)) (by omega), m₂, bytesAt_writeBytes_self' (bytesAt_length _ _ _) (by omega)] + have dT : ∀ r ∈ [(⟨(inn s₀).setWidth 64, H.N⟩ : Region)], Region.Disjoint ⟨T (H := H.st) s₀, H.D⟩ r := by + simp only [List.mem_singleton]; rintro r rfl + refine (hp.i_s.symm.sub_left fun a ha => t_sub hp a (Region.sub_prefix hDF a ha)).sub_right ?_ + rw [inR_eq hz]; exact Region.sub_prefix (by omega) + exact Memory.frame_bytesAt f₁ dT (by omega) + · rw [m₄, m₃, ← tl, bytesAt_writeBytes_self' rfl (by omega)] + +/-- The compression of the inner buffer into the outer hash value. -/ +theorem cmpF_ok {s : State} (hk : KR (H := H.st) sc s₀ s) (hax : s.gpr .eax = inn s₀ + BitVec.ofNat 32 H.N) + {Q : State → Prop} + (k : ∀ s', KR (H := H.st) sc s₀ s' → + Frame [⟨(inn s₀).setWidth 64, H.N⟩, cmpR H s₀, stkR s₀] s.mem s'.mem → + hO.md.stateAt s'.mem ((inn s₀).setWidth 64) = hO.md.compress (hO.md.stateAt s.mem ((inn s₀).setWidth 64)) + (hO.md.blockAt s.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N)) → Q s') : + WP isa H.cmp s Q := by + have hz := hO.sizes + obtain ⟨hb, hf, hw, hso, hW, hN0, hN, -⟩ := bounds hz hp + have hB := hz.B4 + refine cmp_ok hO.comp (by omega) (cmpArgs hz hp hk hax) fun s₃ ha e₃ => ?_ + have f := ha.frame + rw [stk_eq hk] at f + have sI : Region.Sub ⟨(inn s₀).setWidth 64, H.N⟩ (inR (H := H.st) s₀) := by + have := in_sub hz (s₀ := s₀) (a := 0) (n := H.N) (by omega); rwa [BitVec.add_zero] at this + refine k s₃ (hk.keep ha.rd ha.wr (fun r hr => ha.cs r (kregs_callee r hr)) f ?_ ?_) (f.mono (by simp)) e₃ + · simp only [List.cons_append, List.nil_append, List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl) + · exact (hp.i_s.symm.sub_left (save_sub hp)).sub_right sI + · exact save_cmp hz hp + · exact hp.b_s.symm.sub_left (save_sub hp) + · simp only [List.cons_append, List.nil_append, List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl) + · exact ⟨_, by simp, sI⟩ + · exact ⟨scR sc s₀, by simp, cmp_sub hz hp⟩ + · exact ⟨stkR s₀, by simp, fun _ h => h⟩ + +/-- The MAC to `out`, and our caller's registers back. -/ +theorem out_ok {s : State} (hk : KR (H := H.st) sc s₀ s) : + WP isa (.block H.finOut) s fun s' => abiPreserved s₀ s' ∧ + bytesAt s'.mem ((op s₀).setWidth 64) H.D = (hO.md.digest (hO.md.stateAt s.mem ((inn s₀).setWidth 64))).take H.D := by + have hz := hO.sizes + obtain ⟨hb, hf, hw, hso, hW, hN0, hN, hD0, hDN, hB, hB64, hS, hDF, ni, no, np⟩ := bounds hz hp + have hD4 := hz.D.2.2 + have hd4 : 4 * (H.D / 4) = H.D := by omega + have eD : H.st.D = H.D := rfl + obtain ⟨sR, iR, pR⟩ := wr_mem hp + have ic := cov_in hz hp hk.wr + have hdl := hO.md.digest_length (hO.md.stateAt s.mem ((inn s₀).setWidth 64)) + have sI : Region.Sub ⟨(inn s₀).setWidth 64, H.N⟩ (inR (H := H.st) s₀) := by + have := in_sub hz (s₀ := s₀) (a := 0) (n := H.N) (by omega); rwa [BitVec.add_zero] at this + have hL : 8 * H.st.W + 16 ≤ 8 * sc := by omega + -- The epilogue, from the state the MAC is written in. + have epi : ∀ t, KR (H := H.st) sc s₀ t → bytesAt t.mem ((op s₀).setWidth 64) H.D = + (hO.md.digest (hO.md.stateAt s.mem ((inn s₀).setWidth 64))).take H.D → + WP isa (.block H.st.restore) t fun s' => abiPreserved s₀ s' ∧ + bytesAt s'.mem ((op s₀).setWidth 64) H.D = + (hO.md.digest (hO.md.stateAt s.mem ((inn s₀).setWidth 64))).take H.D := fun t kt ht => + WP.mono (restore_ok H.st kt.ebp kt.saved (by rw [kt.wr]; exact sR) hL hw) + fun s' ⟨hm, _, _, hg, ho⟩ => ⟨⟨fun r hr => by + by_cases he : r = .esp + · subst he; rw [ho _ (by decide) (by decide), kt.esp] + · exact hg r (callee_saved r hr he), by rw [hm]; exact kt.ret hp⟩, by rw [hm]; exact ht⟩ + by_cases hDN' : H.D < H.N + · simp only [Hash.finOut, hDN', ite_true, List.append_assoc] + refine atBlk_ok fun s₁ e₁ g₁ m₁ rd₁ wr₁ => ?_ + have k₁ : KR (H := H.st) sc s₀ s₁ := kr_write hz hp hk rd₁ wr₁ (fun r h1 _ _ => g₁ r h1) (a := 0) (n := 0) + (by omega) (by rw [m₁]; exact Frame.refl _ _) + have aN : (inn s₀ + BitVec.ofNat 32 H.N).setWidth 64 = (inn s₀).setWidth 64 + BitVec.ofNat 64 H.N := + setWidth_add (by omega) + have tN : (inn s₀ + BitVec.ofNat 32 H.N).toNat = (inn s₀).toNat + H.N := toNat_add_ofNat (by omega) + rw [WP.block_append_iff] + refine WP.mono (hO.out s₁ (by rw [k₁.ebx]; omega) (by rw [e₁, hk.ebx, tN]; omega) ?_ ?_ ?_) + fun s₂ ⟨g₂, rd₂, wr₂, m₂⟩ => ?_ + · rw [k₁.ebx, k₁.rd, k₁.wr] + have := inReg (o := 0) (n := H.N) (cov_in hz hp (s := s₀) rfl) (by omega) (by omega) + rw [BitVec.add_zero] at this + exact InRegions.right' this + · rw [e₁, hk.ebx, aN, k₁.wr]; exact inReg (cov_in hz hp (s := s₀) rfl) (by omega) (by omega) + · rw [k₁.ebx, e₁, hk.ebx, aN]; exact Offset.base_disjoint _ (Nat.le_refl _) (by omega) + rw [e₁, hk.ebx, aN, k₁.ebx, m₁] at m₂ + have f₂ : Frame [⟨(inn s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.N⟩] s₁.mem s₂.mem := by + rw [m₂, m₁]; exact writeBytes_frame _ _ _ (by rw [hdl]; exact Region.contains_self _ _) + have k₂ : KR (H := H.st) sc s₀ s₂ := kr_write hz hp k₁ rd₂ wr₂ (fun r _ h2 h3 => g₂ r h2 h3) (by omega) f₂ + refine copyW_ok (by decide) (by decide) (H.D / 4) _ s₂ _ k₂.ebx k₂.edi (by omega) (by omega) + (fun j hj => by + rw [addr_eq (by omega)]; exact InRegions.right' (inReg (cov_in hz hp k₂.wr) (by omega) (by omega))) + (fun j hj => by + rw [addr_eq (by omega), k₂.wr]; exact ⟨_, pR, Offset.contains_base _ (by omega) (by omega)⟩) ?_ + fun s₃ g₃ rd₃ wr₃ m₃ => ?_ + · rw [hd4, BitVec.add_zero] + exact hp.i_p.sep (by rw [inR_eq hz]; exact Offset.contains_base _ (by omega) (by omega)) + (Region.contains_self _ _) + rw [hd4, BitVec.add_zero] at m₃ + have f₃ : Frame [opR (H := H.st) s₀] s₂.mem s₃.mem := by + rw [m₃]; exact writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact Region.contains_self _ _) + have k₃ : KR (H := H.st) sc s₀ s₃ := k₂.keep rd₃ wr₃ (fun r hr => g₃ r (by revert hr; decide +revert)) f₃ + (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact hp.p_s.symm.sub_left (save_sub hp)) + (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact ⟨_, by simp, fun _ h => h⟩) + refine epi s₃ k₃ ?_ + rw [m₃, bytesAt_writeBytes_self' (bytesAt_length _ _ _) (by omega), m₂, + bytesAt_take _ _ (Nat.le_of_lt hDN'), bytesAt_writeBytes_self' hdl (by omega)] + · have e : H.D = H.N := by omega + simp only [Hash.finOut, hDN', ite_false, List.cons_append] + refine wp_mov fun s₁ u₁ => ?_ + have k₁ : KR (H := H.st) sc s₀ s₁ := kr_write hz hp hk u₁.rd u₁.wr (fun r h1 _ _ => u₁.other r h1) (a := 0) (n := 0) + (by omega) (by rw [u₁.mem]; exact Frame.refl _ _) + rw [WP.block_append_iff] + refine WP.mono (hO.out s₁ (by rw [k₁.ebx]; omega) (by rw [u₁.gpr, hk.edi]; omega) ?_ ?_ ?_) + fun s₂ ⟨g₂, rd₂, wr₂, m₂⟩ => ?_ + · rw [k₁.ebx, k₁.rd, k₁.wr] + have := inReg (o := 0) (n := H.N) (cov_in hz hp (s := s₀) rfl) (by omega) (by omega) + rw [BitVec.add_zero] at this + exact InRegions.right' this + · rw [u₁.gpr, hk.edi, k₁.wr]; exact ⟨_, pR, Memory.contains_base (by omega)⟩ + · rw [k₁.ebx, u₁.gpr, hk.edi]; exact hp.i_p.sub_left sI |>.sub_right (Region.sub_prefix (by omega)) + rw [u₁.gpr, hk.edi, k₁.ebx, u₁.mem] at m₂ + have f₂ : Frame [opR (H := H.st) s₀] s₁.mem s₂.mem := by + rw [m₂, u₁.mem]; exact writeBytes_frame _ _ _ (by rw [hdl]; exact Memory.contains_base (by omega)) + have k₂ : KR (H := H.st) sc s₀ s₂ := k₁.keep rd₂ wr₂ + (fun r hr => g₂ r (by revert hr; decide +revert) (by revert hr; decide +revert)) f₂ + (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact hp.p_s.symm.sub_left (save_sub hp)) + (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact ⟨_, by simp, fun _ h => h⟩) + refine epi s₂ k₂ ?_ + rw [m₂, List.take_of_length_le (by omega), bytesAt_take _ _ (Nat.le_of_eq e) (F := H.N), + bytesAt_writeBytes_self' hdl (by omega), List.take_of_length_le (by omega)] + +theorem correct : WP isa H.hmacFin s₀ fun s' => abiPreserved s₀ s' ∧ (finG hO.hH.SH sc).post s₀ s' := by + have hz := hO.sizes + obtain ⟨hb, hf, hw, hso, hW, hN0, hN, hD0, hDN, hB, hB64, hS, hDF, ni, no, np⟩ := bounds hz hp + have hl := hO.link + have tl := hz.tail_length; have hDL := hz.DL + refine WP.seq (WP.mono (pro_ok hp) fun s₁ ⟨k₁, si₁, f₁⟩ => ?_) + refine WP.seq (WP.seq (WP.mono (fin1Args_ok hO.hH hp k₁) fun t₁ ⟨kt₁, a₁, st₁, m₁⟩ => + finCall_ok hO.hH hp kt₁ a₁ fun s₂ k₂ si₂ f₂ d₂ => ?_)) + refine WP.seq (WP.mono (mid_ok hO hp k₂ (by rw [si₂, st₁, si₁])) fun s₃ ⟨k₃, ax₃, e₃, b₃, p₃, f₃⟩ => ?_) + refine WP.seq (cmpF_ok hO hp k₃ ax₃ fun s₄ k₄ f₄ e₄ => ?_) + refine WP.mono (out_ok hO hp k₄) fun s' ⟨habi, hmac⟩ => ⟨habi, ?_⟩ + -- The functional part. + intro k0 text hk0 hlen hrI hcnt hrO + rw [hO.hH.hB] at hk0 hcnt + have hl0 : (xorPad k0 ipad ++ text).length = H.B + text.length := by + rw [List.length_append, xorPad_length, hk0] + -- The outer state is untouched until it is copied. + have oI : ∀ r ∈ [saveR H.st (scr s₀)], Region.Disjoint (outerR (H := H.st) s₀) r := by + simp only [List.mem_singleton]; rintro r rfl; exact hp.o_s.sub_right (save_sub hp) + have o₂ : ∀ r ∈ [inR (H := H.st) s₀, tR (H := H.st) s₀, calR hO.hH s₀, stkR s₀], + Region.Disjoint (outerR (H := H.st) s₀) r := by + simp only [List.mem_cons, List.not_mem_nil, or_false] + 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.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) + -- The inner digest. + have dig := d₂ _ (m₁ ▸ Hmac.Generic.X86.Init.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]) + rw [← bytesAt_take _ _ hDF] at dig + -- The outer hash value. + have lo : (xorPad k0 opad).length = H.B := by simp [xorPad, hk0] + have so₂ : hO.md.stateAt s₂.mem ((outer s₀).setWidth 64) = hO.md.compressList hO.iv (xorPad k0 opad) 1 := + Md.stateAt_of_repr (by omega) lo (hl.repr _ _ _ rO₂) + have pad₃ : bytesAt s₃.mem ((inn s₀).setWidth 64 + BitVec.ofNat 64 H.N + BitVec.ofNat 64 H.D) (H.B - H.D) = + hO.md.tailPad H.D := by rw [Memory.add_ofNat, p₃, hO.tail] + rw [e₄, e₃, so₂, Md.blockAt_tailPad (by omega) pad₃, b₃, dig] at hmac + show bytesAt s'.mem ((op s₀).setWidth 64) hO.hH.SH.digestBytes = hmacBlockKey hO.hH.SH.H k0 text + rw [hO.hH.hD, hmac, hl.hmac_outer (by rw [hk0]) text] + +end + +end VG.Proof.Pbkdf2.Md.X86.HmacFin diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFinCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFinCT.lean new file mode 100644 index 000000000..7b29f173c --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacFinCT.lean @@ -0,0 +1,213 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.HmacFin + +/-! +# HMAC over a Merkle–Damgård hash function on x86 (32-bit): `finalize`, constant time + +Untrusted: everything here is checked by Lean. 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`). +-/ + +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 + 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 + 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 + 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 + +/-- The public arguments are the same. -/ +structure PubEq (s₀ s₀' : State) : Prop where + esp : s₀.gpr .esp = s₀'.gpr .esp + args : ∀ i < 6, 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.st) sc s₀) (hp' : Pre (H := H.st) sc s₀') (hq : PubEq s₀ s₀') + +/-- The arguments lie outside the writable regions. -/ +theorem args_out {t : State} (h : Pre (H := H.st) sc t) {s : State} (hsp : s.gpr .esp = E t) (hwr : s.wr = t.wr) : + ArgsOut 6 s := by + have e : (⟨(s.gpr .esp).setWidth 64, 4 + 4 * 6⟩ : Region) = ⟨(E t).setWidth 64, 4 + 24⟩ := 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_p h.a_p + · 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.st) sc s₀ s) (h' : KR (H := H.st) sc s₀' s') : + ∀ r ∈ [Reg.esp, .ebp, .ebx, .edi], 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 5 (by decide)] + · rw [h.ebx, h'.ebx, inn, inn, hq.args 0 (by decide)] + · rw [h.edi, h'.edi, op, op, hq.args 4 (by decide)] + +theorem sub_regs {l l' : List Reg} (h : ∀ r ∈ l, r ∈ l') {s s' : State} (hs : ∀ r ∈ l', s.gpr r = s'.gpr r) : + ∀ r ∈ l, s.gpr r = s'.gpr r := fun r hr => hs r (h r hr) + +include hO hc hp hp' hq + +theorem ct : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.hmacFin fun _ _ => True := by + have hH := hO.hH + have e5 : scr s₀' = scr s₀ := (hq.args 5 (by decide)).symm + have e0 : inn s₀' = inn s₀ := (hq.args 0 (by decide)).symm + have eT : tO (H := H.st) s₀' = tO (H := H.st) s₀ := by rw [tO, tO, e5] + have e2 : arg s₀' 2 = arg s₀ 2 := (hq.args 2 (by decide)).symm + have e3 : arg s₀' 3 = arg s₀ 3 := (hq.args 3 (by decide)).symm + -- The prologue. + have pro : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') (.block H.st.finPrologue) + 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₀') := + rel_agree (argTaint [] (4 + 4 * 6)) (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 WP.mono (pro_ok hp) fun _ h => ⟨h.1, h.2.1⟩) + (fun _ e => by subst e; exact WP.mono (pro_ok hp') fun _ h => ⟨h.1, h.2.1⟩) + -- 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)) + 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' ∧ + FinArgs hH s' .ebx (inn s₀) (tO (H := H.st) s₀) (scr s₀) (arg s₀ 2) (arg s₀ 3) ∧ s'.gpr .esi = outer s₀') := + rel_agree (argTaint [.ebp, .ebx, .edi] (4 + 4 * 6)) (fun s s' ⟨k, _⟩ ⟨k', _⟩ => + agree_argTaint (sub_regs (by decide) (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.fin1 + (fun _ ⟨k, si⟩ => WP.mono (fin1Args_ok hH hp k) fun _ ⟨k₁, a, s₁, _⟩ => ⟨k₁, a, s₁.trans si⟩) + (fun _ ⟨k, si⟩ => WP.mono (fin1Args_ok hH hp' k) fun _ ⟨k₁, a, s₁, _⟩ => + ⟨k₁, by rw [← e0, ← eT, ← e5, ← e2, ← e3]; exact a, s₁.trans si⟩) + have c1 : RelCT isa (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' ∧ + FinArgs hH s' .ebx (inn s₀) (tO (H := H.st) s₀) (scr s₀) (arg s₀ 2) (arg s₀ 3) ∧ s'.gpr .esi = outer s₀')) + (.frame (.push (fin5 .ebx)) (.call H.st.finN H.st.finC) (.pop .eax (fin5 .ebx).length)) + 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₀') := + rel_wp (fin_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, si⟩ => finCall_ok hH hp k a fun _ k' si' _ _ => ⟨k', si'.trans si⟩) + (fun _ ⟨k, a, si⟩ => finCall_ok hH hp' k (by rw [e0, eT, e5]; exact a) + fun _ k' si' _ _ => ⟨k', si'.trans si⟩) + -- The outer block. + have mid : 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 H.finMid) + fun s s' => (KR (H := H.st) sc s₀ s ∧ s.gpr .eax = inn s₀ + BitVec.ofNat 32 H.N) ∧ + (KR (H := H.st) sc s₀' s' ∧ s'.gpr .eax = inn s₀' + BitVec.ofNat 32 H.N) := + rel_agree (τr [.esp, .ebp, .ebx, .edi, .esi]) (fun s s' ⟨k, si⟩ ⟨k', si'⟩ => agree_regs fun r hr => by + 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 k k' _ (by simp) + · exact kr_agree hq k k' _ (by simp) + · exact kr_agree hq k k' _ (by simp) + · exact kr_agree hq k k' _ (by simp) + · rw [si, si', outer, outer, hq.args 1 (by decide)]) hc.mid + (fun _ ⟨k, si⟩ => WP.mono (mid_ok hO hp k si) fun _ h => ⟨h.1, h.2.1⟩) + (fun _ ⟨k, si⟩ => WP.mono (mid_ok hO hp' k si) fun _ h => ⟨h.1, h.2.1⟩) + -- The compression. + have hB : 0 < H.B := by have := hO.sizes.B4; omega + have cm : RelCT isa (fun s s' => (KR (H := H.st) sc s₀ s ∧ s.gpr .eax = inn s₀ + BitVec.ofNat 32 H.N) ∧ + (KR (H := H.st) sc s₀' s' ∧ s'.gpr .eax = inn s₀' + BitVec.ofNat 32 H.N)) H.cmp + fun s s' => KR (H := H.st) sc s₀ s ∧ KR (H := H.st) sc s₀' s' := + rel_wp (cmp_rel hO.comp hB (sp := E s₀) fun s s' ⟨⟨k, a⟩, ⟨k', a'⟩⟩ => + ⟨cmpArgs hO.sizes hp k a, by have := cmpArgs hO.sizes hp' k' a'; rwa [e0, e5] at this, k.esp, + by rw [k'.esp, E, E, hq.esp]⟩) + (fun _ ⟨k, a⟩ => cmpF_ok hO hp k a fun _ k' _ _ => k') + (fun _ ⟨k, a⟩ => cmpF_ok hO hp' k a fun _ k' _ _ => k') + -- The MAC, and the end. + obtain ⟨_, ho⟩ := hc.out + have out : RelCT isa (fun s s' => KR (H := H.st) sc s₀ s ∧ KR (H := H.st) sc s₀' s') (.block H.finOut) + fun _ _ => True := + RelCT.taint (A := taint) (τr [.esp, .ebp, .ebx, .edi]) (fun _ _ h => agree_regs (kr_agree hq h.1 h.2)) ho + exact pro.seq ((a1.seq c1).seq (mid.seq (cm.seq out))) + +end VG.Proof.Pbkdf2.Md.X86.HmacFin + +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) + +/-- `finalize` is verified against `finG`, 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 + H.st.F ≤ 8 * sc) (hsat : ∃ s, (finG hO.hH.SH sc).pre s) : + Verified X86.target H.hmacFin (finG 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 hO.hH sc hs hfit) + exact ⟨t, s', he, hg, hpost⟩ + · obtain ⟨h1, h2⟩ := hpub + exact (ct hO hc (pre_of hO.hH sc h₁ hfit) (pre_of hO.hH sc h₂ hfit) ⟨h1, h2⟩ + _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 + +/-- The regions `finalize` reads and writes, of those `finW` gives it. -/ +def narrowRd (S : Nat) (s : State) : List Region := [⟨(arg s 1).setWidth 64, S⟩, ⟨argAddr s 0, 24⟩] +def narrowWr (S D sc : Nat) (s : State) : List Region := + [⟨(arg s 0).setWidth 64, S⟩, ⟨(arg s 4).setWidth 64, D⟩, ⟨(arg s 5).setWidth 64, 8 * sc⟩] + +/-- `finalize` is verified against `finW`, 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 + H.st.F ≤ 8 * sc) (hsat : ∃ s, (finW hO.hH.SH sc).pre s) : + Verified X86.target H.hmacFin (finW hO.hH.SH sc) := by + have pre : ∀ s, (finW hO.hH.SH sc).pre s → (finG hO.hH.SH sc).pre + (s.withRegions (narrowRd hO.hH.SH.stateBytes s) + (narrowWr hO.hH.SH.stateBytes hO.hH.SH.digestBytes sc s)) := by + intro s h + obtain ⟨_, _, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, h21, + h22, h23⟩ := h + simp only [finG, narrowRd, narrowWr, arg_withRegions, argAddr_withRegions, State.withRegions_gpr, + State.withRegions_rd, State.withRegions_wr] + exact ⟨trivial, trivial, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, + h21, h22, h23⟩ + refine Verified.narrowTo (verified hO hc hfit (hsat.elim fun s hs => ⟨_, pre s hs⟩)) + (narrowRd hO.hH.SH.stateBytes) (narrowWr hO.hH.SH.stateBytes hO.hH.SH.digestBytes 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.HmacFin diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean new file mode 100644 index 000000000..9d6994fc1 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean @@ -0,0 +1,291 @@ +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 + +/-! +# HMAC's `finalize` and PBKDF2's `iterate` on x86 (32-bit): the instances + +Untrusted: everything here is checked by Lean. 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. +-/ + +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) + +/-- Memory holding the arguments `0x1000, 0x1400, 0, 0x1800, 0x2000` of +`iterate` at `0x6004`. -/ +def iterMem : Mem := fun a => + if a = 0x6005 then 0x10 else if a = 0x6009 then 0x14 else if a = 0x6011 then 0x18 else + if a = 0x6015 then 0x20 else 0 + +/-- A state satisfying `iterate`'s precondition, with states of `S` bytes, a +digest of `D` bytes and `8 sc` bytes of scratch space, with the arguments +writable. -/ +def iterSat (S D sc : Nat) : State where + gpr r := match r with + | .esp => 0x6000 | _ => 0 + cf := none + zf := none + sf := none + of := none + mem := iterMem + rd := [⟨0x1000, 2 * S⟩, ⟨0x1400, D⟩] + wr := [⟨0x1800, D⟩, ⟨0x2000, 8 * sc⟩, ⟨0x6004, 20⟩] + +theorem iterSat_args (S D sc : Nat) : + arg (iterSat S D sc) 0 = 0x1000 ∧ arg (iterSat S D sc) 1 = 0x1400 ∧ arg (iterSat S D sc) 2 = 0 ∧ + arg (iterSat S D sc) 3 = 0x1800 ∧ arg (iterSat S D sc) 4 = 0x2000 ∧ argAddr (iterSat S D sc) 0 = 0x6004 ∧ + (iterSat S D sc).gpr .esp = 0x6000 := by + have e : ∀ i, arg (iterSat S D sc) i = arg (iterSat 0 0 0) i := fun _ => rfl + have e' : argAddr (iterSat S D sc) 0 = argAddr (iterSat 0 0 0) 0 := rfl + rw [e, e, e, e, e, e'] + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, rfl⟩ <;> decide + +/-- Memory holding the arguments `0x1000, 0x1400, 0, 0, 0x1800, 0x2000` of +`finalize` at `0x6004`. -/ +def finMem : Mem := fun a => + if a = 0x6005 then 0x10 else if a = 0x6009 then 0x14 else if a = 0x6015 then 0x18 else + if a = 0x6019 then 0x20 else 0 + +/-- A state satisfying `finalize`'s precondition, with states of `S` bytes, +a digest of `D` bytes and `8 sc` bytes of scratch space, with the arguments +writable. -/ +def finSat (S D sc : Nat) : State where + gpr r := match r with + | .esp => 0x6000 | _ => 0 + cf := none + zf := none + sf := none + of := none + mem := finMem + rd := [⟨0x1400, S⟩] + wr := [⟨0x1000, S⟩, ⟨0x1800, D⟩, ⟨0x2000, 8 * sc⟩, ⟨0x6004, 24⟩] + +theorem finSat_args (S D sc : Nat) : + arg (finSat S D sc) 0 = 0x1000 ∧ arg (finSat S D sc) 1 = 0x1400 ∧ arg (finSat S D sc) 2 = 0 ∧ + arg (finSat S D sc) 3 = 0 ∧ arg (finSat S D sc) 4 = 0x1800 ∧ arg (finSat S D sc) 5 = 0x2000 ∧ + argAddr (finSat S D sc) 0 = 0x6004 ∧ (finSat S D sc).gpr .esp = 0x6000 := by + have e : ∀ i, arg (finSat S D sc) i = arg (finSat 0 0 0) i := fun _ => rfl + have e' : argAddr (finSat S D sc) 0 = argAddr (finSat 0 0 0) 0 := rfl + rw [e, e, e, e, e, e, e'] + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, rfl⟩ <;> decide + +/-! ## MD5 -/ + +theorem md5_iterChecks : Iterate.Checks md5M where + pro := ⟨_, by taint_decide⟩ + load := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + tail := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem md5_finChecks : HmacFin.Checks md5M where + pro := ⟨_, by taint_decide⟩ + fin1 := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + out := ⟨_, by taint_decide⟩ + +theorem md5_iterImp : (iterW Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.iterateContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 80 16 48 + sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, + Spec.Hmac.md5I, Spec.Hmac.md5S, Spec.Hmac.md5, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 80 16 48 + +theorem md5_finImp : (finW Spec.Hmac.md5S 48).Implies (Spec.Hmac.md5I.finalizeContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 80 16 48 + sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, + Spec.Hmac.md5I, Spec.Hmac.md5S, Spec.Hmac.md5, finW, finG, countF, X86.abi, X86.argSlots, + X86.argVal, X86.argBytes] + [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 80 16 48 + +theorem md5_iterate : Verified X86.target md5M.iterate (Spec.Hmac.md5I.iterateContract X86.abi 48) := + (Iterate.verifiedW md5Ok md5_iterChecks (by decide) md5_iterImp.sat_left).of_implies md5_iterImp + +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 + +/-! ## SHA-1 -/ + +theorem sha1_iterChecks : Iterate.Checks sha1M where + pro := ⟨_, by taint_decide⟩ + load := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + tail := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem sha1_finChecks : HmacFin.Checks sha1M where + pro := ⟨_, by taint_decide⟩ + fin1 := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + out := ⟨_, by taint_decide⟩ + +theorem sha1_iterImp : (iterW Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.iterateContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 84 20 56 + sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, + Spec.Hmac.sha1I, Spec.Hmac.sha1S, Spec.Hmac.sha1, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 84 20 56 + +theorem sha1_finImp : (finW Spec.Hmac.sha1S 56).Implies (Spec.Hmac.sha1I.finalizeContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 84 20 56 + sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, + Spec.Hmac.sha1I, Spec.Hmac.sha1S, Spec.Hmac.sha1, finW, finG, countF, X86.abi, X86.argSlots, + X86.argVal, X86.argBytes] + [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 84 20 56 + +theorem sha1_iterate : Verified X86.target sha1M.iterate (Spec.Hmac.sha1I.iterateContract X86.abi 48) := + (Iterate.verifiedW sha1Ok sha1_iterChecks (by decide) sha1_iterImp.sat_left).of_implies sha1_iterImp + +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 + +/-! ## SHA-384 -/ + +theorem sha384_iterChecks : Iterate.Checks sha384M where + pro := ⟨_, by taint_decide⟩ + load := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + tail := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem sha384_finChecks : HmacFin.Checks sha384M where + pro := ⟨_, by taint_decide⟩ + fin1 := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + out := ⟨_, by taint_decide⟩ + +theorem sha384_iterImp : (iterW Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I.iterateContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 192 48 234 + sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, + Spec.Hmac.sha384I, Spec.Hmac.sha384S, Spec.Hmac.sha384, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 192 48 234 + +theorem sha384_finImp : (finW Spec.Hmac.sha384S 234).Implies (Spec.Hmac.sha384I.finalizeContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 192 48 234 + sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, + Spec.Hmac.sha384I, Spec.Hmac.sha384S, Spec.Hmac.sha384, finW, finG, countF, X86.abi, X86.argSlots, + X86.argVal, X86.argBytes] + [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 192 48 234 + +theorem sha384_iterate : Verified X86.target sha384M.iterate (Spec.Hmac.sha384I.iterateContract X86.abi 48) := + (Iterate.verifiedW sha384Ok sha384_iterChecks (by decide) sha384_iterImp.sat_left).of_implies sha384_iterImp + +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 + +/-! ## SHA-512 -/ + +theorem sha512_iterChecks : Iterate.Checks sha512M' where + pro := ⟨_, by taint_decide⟩ + load := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + tail := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem sha512_finChecks : HmacFin.Checks sha512M' where + pro := ⟨_, by taint_decide⟩ + fin1 := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + out := ⟨_, by taint_decide⟩ + +theorem sha512_iterImp : (iterW Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I.iterateContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 192 64 234 + sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, + Spec.Hmac.sha512I, Spec.Hmac.sha512S, Spec.Hmac.sha512, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 192 64 234 + +theorem sha512_finImp : (finW Spec.Hmac.sha512S 234).Implies (Spec.Hmac.sha512I.finalizeContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 192 64 234 + sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, + Spec.Hmac.sha512I, Spec.Hmac.sha512S, Spec.Hmac.sha512, finW, finG, countF, X86.abi, X86.argSlots, + X86.argVal, X86.argBytes] + [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 192 64 234 + +theorem sha512_iterate : Verified X86.target sha512M'.iterate (Spec.Hmac.sha512I.iterateContract X86.abi 48) := + (Iterate.verifiedW sha512Ok' sha512_iterChecks (by decide) sha512_iterImp.sat_left).of_implies sha512_iterImp + +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 + +/-! ## SHA-512/224 -/ + +theorem sha512_224_iterChecks : Iterate.Checks sha512_224M where + pro := ⟨_, by taint_decide⟩ + load := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + tail := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem sha512_224_finChecks : HmacFin.Checks sha512_224M where + pro := ⟨_, by taint_decide⟩ + fin1 := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + out := ⟨_, by taint_decide⟩ + +theorem sha512_224_iterImp : (iterW Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac.sha512_224I.iterateContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 192 28 234 + sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, + Spec.Hmac.sha512_224I, Spec.Hmac.sha512_224S, Spec.Hmac.sha512_224, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 192 28 234 + +theorem sha512_224_finImp : (finW Spec.Hmac.sha512_224S 234).Implies (Spec.Hmac.sha512_224I.finalizeContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 192 28 234 + sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, + Spec.Hmac.sha512_224I, Spec.Hmac.sha512_224S, Spec.Hmac.sha512_224, finW, finG, countF, X86.abi, X86.argSlots, + X86.argVal, X86.argBytes] + [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 192 28 234 + +theorem sha512_224_iterate : Verified X86.target sha512_224M.iterate (Spec.Hmac.sha512_224I.iterateContract X86.abi 48) := + (Iterate.verifiedW sha512_224Ok sha512_224_iterChecks (by decide) sha512_224_iterImp.sat_left).of_implies sha512_224_iterImp + +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 + +/-! ## SHA-512/256 -/ + +theorem sha512_256_iterChecks : Iterate.Checks sha512_256M where + pro := ⟨_, by taint_decide⟩ + load := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + tail := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem sha512_256_finChecks : HmacFin.Checks sha512_256M where + pro := ⟨_, by taint_decide⟩ + fin1 := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + out := ⟨_, by taint_decide⟩ + +theorem sha512_256_iterImp : (iterW Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac.sha512_256I.iterateContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 192 32 234 + sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, + Spec.Hmac.sha512_256I, Spec.Hmac.sha512_256S, Spec.Hmac.sha512_256, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 192 32 234 + +theorem sha512_256_finImp : (finW Spec.Hmac.sha512_256S 234).Implies (Spec.Hmac.sha512_256I.finalizeContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, a5, e, esp⟩ := finSat_args 192 32 234 + sig_implies [Spec.Hmac.Instance.finalizeContract, Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, + Spec.Hmac.sha512_256I, Spec.Hmac.sha512_256S, Spec.Hmac.sha512_256, finW, finG, countF, X86.abi, X86.argSlots, + X86.argVal, X86.argBytes] + [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 192 32 234 + +theorem sha512_256_iterate : Verified X86.target sha512_256M.iterate (Spec.Hmac.sha512_256I.iterateContract X86.abi 48) := + (Iterate.verifiedW sha512_256Ok sha512_256_iterChecks (by decide) sha512_256_iterImp.sat_left).of_implies sha512_256_iterImp + +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 + +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 new file mode 100644 index 000000000..13f44e85b --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Iterate.lean @@ -0,0 +1,819 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Block + +/-! +# PBKDF2-HMAC's iteration over a Merkle–Damgård hash function on x86 (32-bit): correct + +Untrusted: everything here is checked by Lean. The iteration +(`Impl/Pbkdf2/Md/X86.lean`) is correct for any hash function whose code the +proofs know (`MdOk`): `Md.hmac_step` says that its two compressions per step +compute HMAC. The arguments are on the stack: `scratch`, `key`, `n` and `u` +are loaded first (after our caller's registers are saved in `scratch`), and +`t` in each step. The loop counts the steps left in `edi` down with `sub`, +and branches on its result. +-/ + +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.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 + 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 + sub_offset ofNat_beq_zero sub_ofNat eval_e eval_ne) +open VG.Proof.Hmac.Common (bytesAt_length bytesAt_add bytesAt_writeBytes_sep writeBytes_at bytesAt_getD') +open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil writeBytes_append writeBytes_frame) +open Spec.Sha256 (bytesAt) +open Spec.Hmac (StreamingHash xorPad ipad opad hmacBlockKey) + +section +variable (H : Hash) (sc : Nat) (s₀ : State) + +abbrev E : BitVec 32 := s₀.gpr .esp +abbrev key : BitVec 32 := arg s₀ 0 +abbrev up : BitVec 32 := arg s₀ 1 +abbrev tp : BitVec 32 := arg s₀ 3 +abbrev scr : BitVec 32 := arg s₀ 4 +/-- The number of steps. -/ +abbrev nn : Nat := (arg s₀ 2).toNat +abbrev keyR : Region := ⟨(key s₀).setWidth 64, 2 * H.S⟩ +abbrev uR : Region := ⟨(up s₀).setWidth 64, H.D⟩ +abbrev tR : Region := ⟨(tp s₀).setWidth 64, H.D⟩ +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 +/-- Byte `o` of `scratch`. -/ +abbrev SA (o : Nat) : Addr := (scr s₀).setWidth 64 + BitVec.ofNat 64 o +/-- The hash value being compressed, as `ebx` holds it, and its address; +the block is right after it. -/ +abbrev hv : BitVec 32 := scr s₀ + BitVec.ofNat 32 H.st.buf +/-- The compression function's scratch space. -/ +abbrev cmpR : Region := ⟨(scr s₀).setWidth 64, H.so⟩ + +end + +/-- The precondition, with the sizes of `H`. -/ +structure Pre (H : Hash) (sc : Nat) (s₀ : State) : Prop where + rd : s₀.rd = [keyR H s₀, uR H s₀, argR s₀] + wr : s₀.wr = [tR H s₀, scR sc s₀] + k_t : (keyR H s₀).Disjoint (tR H s₀) + k_s : (keyR H s₀).Disjoint (scR sc s₀) + u_t : (uR H s₀).Disjoint (tR H s₀) + u_s : (uR H s₀).Disjoint (scR sc s₀) + t_s : (tR H s₀).Disjoint (scR sc s₀) + a_t : (argR s₀).Disjoint (tR H s₀) + a_s : (argR s₀).Disjoint (scR sc s₀) + r_t : (retR s₀).Disjoint (tR H s₀) + r_s : (retR s₀).Disjoint (scR sc s₀) + b_k : (stkR s₀).Disjoint (keyR H s₀) + b_u : (stkR s₀).Disjoint (uR H s₀) + b_t : (stkR s₀).Disjoint (tR H s₀) + b_s : (stkR s₀).Disjoint (scR sc s₀) + nk : (key s₀).toNat + 2 * H.S ≤ 2 ^ 32 + nu : (up s₀).toNat + H.D ≤ 2 ^ 32 + nt : (tp s₀).toNat + H.D ≤ 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 + H.N + H.B ≤ 8 * sc + hz : Sizes H + +theorem pre_of {H : Hash} (hH : HashOK H.st) {sc : Nat} {s₀ : State} (h : (iterG hH.SH sc).pre s₀) (hz : Sizes H) + (hfit : H.st.buf + H.N + H.B ≤ 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⟩ := h + have hS := hH.hS + have hD := hH.hD + have e : (⟨(s₀.gpr .esp).setWidth 64 - 48, 48⟩ : Region) = stkR s₀ := by + simp only [stkR, below]; rw [Taint.sub_setWidth h19]; rfl + simp only [hS, hD, e] at * + exact ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, hfit, hz⟩ + +/-! ## The parts of `scratch` -/ + +section +variable {H : Hash} {sc : Nat} {s₀ : State} (hp : Pre H sc s₀) +include hp + +theorem bounds : H.st.buf = 8 * H.st.W + 16 ∧ H.st.buf + H.N + H.B ≤ 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 ∧ 0 < H.D ∧ H.D ≤ H.N ∧ H.B ≤ 128 ∧ 64 ≤ H.B ∧ + H.S = H.N + H.B := + ⟨rfl, hp.fits, hp.nw, hp.hz.so, hp.hz.W, hp.hz.N.1, hp.hz.N.2.1, hp.hz.D.1, hp.hz.D.2.1, hp.hz.B4.2.2, + hp.hz.B4.2.1, hp.hz.S⟩ + +theorem off_sub {o n : Nat} (h : o + n ≤ 8 * sc) : Region.Sub ⟨SA s₀ o, n⟩ (scR sc s₀) := + sub_offset h (by have := hp.nw; omega) + +theorem hv_eq : (hv H s₀).setWidth 64 = SA s₀ H.st.buf := + setWidth_add (by have := bounds hp; omega) + +theorem hv_toNat : (hv H s₀).toNat = (scr s₀).toNat + H.st.buf := + toNat_add_ofNat (by have := bounds hp; omega) + +/-- The hash value and the block. -/ +theorem hvR_sub : Region.Sub ⟨(hv H s₀).setWidth 64, H.N + H.B⟩ (scR sc s₀) := by + rw [hv_eq hp]; obtain ⟨-, hf, -⟩ := bounds hp; exact off_sub hp (by omega) + +theorem cmp_sub : Region.Sub (cmpR H s₀) (scR sc s₀) := by + obtain ⟨hb, hf, -, hso, -⟩ := bounds hp; exact Region.sub_prefix (by omega) + +theorem save_sub : Region.Sub (saveR H.st (scr s₀)) (scR sc s₀) := by + obtain ⟨hb, hf, -⟩ := bounds hp; exact off_sub hp (by omega) + +/-- The parts of `scratch` do not overlap. -/ +theorem part_disj {a m b n : Nat} (h : a + m ≤ b ∨ b + n ≤ a) (ha : a + m ≤ 8 * sc) (hb : b + n ≤ 8 * sc) : + Region.Disjoint ⟨SA s₀ a, m⟩ ⟨SA s₀ b, n⟩ := + VG.Proof.Hmac.Generic.Common.off_disj _ h (by have := hp.nw; omega) (by have := hp.nw; omega) + +theorem hv_cmp : Region.Disjoint ⟨(hv H s₀).setWidth 64, H.N + H.B⟩ (cmpR H s₀) := by + obtain ⟨hb, hf, hw, hso, -⟩ := bounds hp + rw [hv_eq hp]; exact Offset.disjoint_base _ (by omega) (by omega) + +theorem save_hv {n : Nat} (h : n ≤ H.N + H.B) : (saveR H.st (scr s₀)).Disjoint ⟨(hv H s₀).setWidth 64, n⟩ := by + obtain ⟨hb, hf, -⟩ := bounds hp + rw [hv_eq hp]; exact part_disj hp (by omega) (by omega) (by omega) + +theorem save_cmp : (saveR H.st (scr s₀)).Disjoint (cmpR H s₀) := by + obtain ⟨hb, hf, hw, hso, -⟩ := bounds hp + exact Offset.disjoint_base _ (by omega) (by omega) + +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 t_hv {n : Nat} (h : n ≤ H.N + H.B) : Region.Disjoint (tR H s₀) ⟨(hv H s₀).setWidth 64, n⟩ := + hp.t_s.sub_right fun a ha => hvR_sub hp a (Region.sub_prefix h a ha) + +theorem t_blk : Region.Disjoint (tR H s₀) ⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩ := by + obtain ⟨hb, hf, hw, -⟩ := bounds hp + refine hp.t_s.sub_right fun a ha => hvR_sub hp a (Offset.sub_base _ (by omega) a ha) + +end + +/-! ## What the pieces keep -/ + +/-- The regions everything writes: `T`, `scratch` and the stack below `esp`. -/ +abbrev wrs (H : Hash) (sc : Nat) (s₀ : State) : List Region := [tR H s₀, scR sc s₀, stkR s₀] + +/-- The registers and memory kept from the prologue on, with `m` steps left. -/ +structure KR (H : Hash) (sc : Nat) (s₀ : State) (m : Nat) (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₀ + ebx : s.gpr .ebx = hv H s₀ + esi : s.gpr .esi = key s₀ + edi : s.gpr .edi = BitVec.ofNat 32 m + 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 := [.esp, .ebp, .ebx, .esi, .edi] + +theorem kregs_callee : ∀ r ∈ kregs, r ∈ calleeSaved := by decide + +section +variable {H : Hash} {sc : Nat} {s₀ : State} + +theorem KR.keep {m : Nat} {s s' : State} (h : KR H sc s₀ m 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 sc s₀, Region.Sub r r') : KR H sc s₀ m 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.ebx, (hg _ (by simp)).trans h.esi, (hg _ (by simp)).trans h.edi, + h.saved.frame H.st hf hs, h.frame.trans (hf.sub hsub)⟩ + +/-- `KR` after code that writes only `eax`, `ecx` and `edx` and a part of +`scratch` other than where our caller's registers are. -/ +theorem KR.write {m : Nat} {s s' : State} (h : KR H sc s₀ m s) (hrd : s'.rd = s.rd) (hwr : s'.wr = s.wr) + (hg : ∀ r, r ≠ .eax → r ≠ .ecx → r ≠ .edx → s'.gpr r = s.gpr r) {R : Region} (hf : Frame [R] s.mem s'.mem) + (hs : (saveR H.st (scr s₀)).Disjoint R) (hsub : ∃ r' ∈ wrs H sc s₀, Region.Sub R r') : KR H sc s₀ m s' := + h.keep hrd hwr (fun r hr => hg r (by revert hr; decide +revert) (by revert hr; decide +revert) + (by revert hr; decide +revert)) hf (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact hs) + (fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact hsub) + +theorem stk_eq {m : Nat} {s : State} (hk : KR H sc s₀ m s) : stk s = stkR s₀ := by rw [stk, hk.esp] + +end + +section +variable {H : Hash} {sc : Nat} {s₀ : State} (hp : Pre H sc s₀) +include hp + +theorem mem_wr : scR sc s₀ ∈ s₀.wr ∧ tR H s₀ ∈ s₀.wr := by rw [hp.wr]; simp + +theorem argR_in : argR s₀ ∈ s₀.rd ++ s₀.wr := by rw [hp.rd]; simp + +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) (by have := hp.spf; omega)⟩ + +theorem KR.argEq {m : Nat} {s : State} (hk : KR H sc s₀ m 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) hk.frame (by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl) + · exact hp.a_t + · exact hp.a_s + · exact (stk_arg hp).symm) (by omega) + +theorem KR.readArg {m : Nat} {s : State} (hk : KR H sc s₀ m 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 + +theorem KR.ret {m : Nat} {s : State} (hk : KR H sc s₀ m 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) + · exact hp.r_t + · exact hp.r_s + · exact (stk_ret' hp).symm) (by decide) + +/-- `KR` after a call that writes parts of `scratch`. -/ +theorem KR.call {m : Nat} {s s' : State} (h : KR H sc s₀ m s) {ws : List Region} (ha : After s ws s') + (hs : ∀ r ∈ ws, (saveR H.st (scr s₀)).Disjoint r) (hsub : ∀ r ∈ ws, Region.Sub r (scR sc s₀)) : + KR H sc s₀ m s' := by + have f := ha.frame + rw [stk_eq h] at f + refine h.keep ha.rd ha.wr (fun r hr => ha.cs r (kregs_callee r hr)) f (fun r hr => ?_) (fun r hr => ?_) + · rcases List.mem_append.mp hr with hr | hr + · exact hs r hr + · simp only [List.mem_singleton] at hr; subst hr; exact hp.b_s.symm.sub_left (save_sub hp) + · rcases List.mem_append.mp hr with hr | hr + · exact ⟨scR sc s₀, by simp, hsub r hr⟩ + · simp only [List.mem_singleton] at hr; subst hr; exact ⟨stkR s₀, by simp, fun _ h => h⟩ + +/-- The hash value and block are writable. -/ +theorem cov_hv {s : State} (hwr : s.wr = s₀.wr) : Covers [⟨(hv H s₀).setWidth 64, H.N + H.B⟩] s.wr := by + obtain ⟨hb, hf, -⟩ := bounds hp + rw [hv_eq hp, hwr] + exact Covers.of_sub fun r hr => by + simp only [List.mem_singleton] at hr; subst hr + exact ⟨scR sc s₀, (mem_wr hp).1, H.st.buf, rfl, by simp only; omega⟩ + +/-- The arguments of the compression of the block. -/ +theorem cmpArgs {m : Nat} {s : State} (hk : KR H sc s₀ m s) (hax : s.gpr .eax = hv H s₀ + BitVec.ofNat 32 H.N) : + CmpArgs H.N H.B H.so s (hv H s₀) (scr s₀) := by + obtain ⟨hb, hf, hw, hso, -⟩ := bounds hp + have := hv_toNat hp + exact + { ebx := hk.ebx, eax := hax, ebp := hk.ebp, sp48 := by rw [hk.esp]; exact hp.sp48 + cst := cov_hv hp hk.wr + 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₀, (mem_wr hp).1, 0, by simp, by simp only; omega⟩ + st_sc := hv_cmp hp + b_st := by rw [stk_eq hk]; exact hp.b_s.sub_right (hvR_sub hp) + b_sc := by rw [stk_eq hk]; exact hp.b_s.sub_right (cmp_sub hp) + nst := by omega + nsc := by omega } + +/-- The key's bytes are as on entry. -/ +theorem key_bytes {m : Nat} {s : State} (hk : KR H sc s₀ m s) {i : Nat} (hi : i < 2 * H.S) : + s.mem ((key s₀).setWidth 64 + BitVec.ofNat 64 i) = s₀.mem ((key s₀).setWidth 64 + BitVec.ofNat 64 i) := + hk.frame.bytes (R := keyR H s₀) (by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl | rfl) + · exact hp.k_t + · exact hp.k_s + · exact hp.b_k.symm) (by show 2 * H.S ≤ 2 ^ 64; have := hp.nk; omega) hi + +end + +/-! ## The loop invariant -/ + +section +variable {H : Hash} (hO : MdOk H) (s₀ : State) + +/-- A step, as the code computes it, from the key's inner and outer hash values. -/ +abbrev stepM : List Byte → List Byte := + hO.md.step H.D (hO.md.stateAt s₀.mem ((key s₀).setWidth 64)) + (hO.md.stateAt s₀.mem ((key s₀).setWidth 64 + BitVec.ofNat 64 H.S)) + +end + +/-- The loop invariant, with `m` steps left. -/ +structure Inv {H : Hash} (hO : MdOk H) (sc : Nat) (s₀ : State) (m : Nat) (s : State) : Prop + extends KR H sc s₀ m s where + pad : bytesAt s.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 (H.N + H.D)) (H.B - H.D) = H.tailB + le : m ≤ nn s₀ + val : Spec.Pbkdf2.iterate (stepM hO s₀) (nn s₀) (bytesAt s₀.mem ((up s₀).setWidth 64) H.D) + (bytesAt s₀.mem ((tp s₀).setWidth 64) H.D) = + Spec.Pbkdf2.iterate (stepM hO s₀) m (bytesAt s.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.D) + (bytesAt s.mem ((tp s₀).setWidth 64) H.D) + +/-! ## Loading a hash value of the key and compressing the block into it -/ + +section +variable {H : Hash} (hO : MdOk H) {sc : Nat} {s₀ : State} (hp : Pre H sc s₀) +include hp + +/-- The block, after the hash value, is outside what the load and the +compression write. -/ +theorem blk_disj {a n : Nat} (h₁ : H.N ≤ a) (h₂ : a + n ≤ H.N + H.B) : + ∀ r ∈ [(⟨(hv H s₀).setWidth 64, H.N⟩ : Region), cmpR H s₀, stkR s₀], + Region.Disjoint ⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 a, n⟩ r := by + obtain ⟨hb, hf, hw, -⟩ := bounds hp + have := hv_toNat hp + intro r hr + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl | rfl + · exact Offset.disjoint_base _ h₁ (by omega) + · exact (hv_cmp hp).sub_left (Offset.sub_base _ (by omega)) + · exact (hp.b_s.sub_right fun a' ha' => hvR_sub hp a' (Offset.sub_base _ (by omega) a' ha')).symm + +/-- Loading the key's hash value at `key + o` into the hash value being +compressed, and `eax` at the block. -/ +theorem load_ok {o : Nat} (ho : o + H.N ≤ 2 * H.S) {m : Nat} {s : State} (h : KR H sc s₀ m s) + {rest : List Instr} {Q : State → Prop} + (k : ∀ s', KR H sc s₀ m s' → s'.gpr .eax = hv H s₀ + BitVec.ofNat 32 H.N → + Frame [⟨(hv H s₀).setWidth 64, H.N⟩] s.mem s'.mem → + hO.md.stateAt s'.mem ((hv H s₀).setWidth 64) = hO.md.stateAt s₀.mem ((key s₀).setWidth 64 + BitVec.ofNat 64 o) → + WP isa (.block rest) s' Q) : + WP isa (.block (H.loadKey o ++ H.atBlk ++ rest)) s Q := by + obtain ⟨hb, hf, hw, hso, hW, hN0, hN, hD0, hDN, hB, hB64, hS⟩ := bounds hp + have hN4 := hp.hz.N.2.2 + have hn4 : 4 * (H.N / 4) = H.N := by omega + have hvt := hv_toNat hp + have nk := hp.nk + have kc : Covers [keyR H s₀] (s.rd ++ s.wr) := covers_one (by rw [h.rd, hp.rd]; simp) + rw [List.append_assoc] + refine copyW_ok (by decide) (by decide) (H.N / 4) _ s _ h.esi h.ebx (by omega) (by omega) + (fun j hj => by rw [addr_eq (by omega)]; exact inReg kc (by omega) (by omega)) + (fun j hj => by rw [addr_eq (by omega)]; exact inReg (cov_hv hp h.wr) (by omega) (by omega)) ?_ + fun s₁ g₁ rd₁ wr₁ m₁ => ?_ + · rw [hn4] + exact hp.k_s.sep (Offset.contains_base _ (by omega) (by omega)) + (by rw [BitVec.add_zero, hv_eq hp]; exact Offset.contains_base _ (by omega) (by omega)) + rw [hn4, BitVec.add_zero] at m₁ + have f₁ : Frame [⟨(hv H s₀).setWidth 64, H.N⟩] s.mem s₁.mem := by + rw [m₁]; exact writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact Region.contains_self _ _) + refine atBlk_ok fun s₂ e₂ g₂ m₂ rd₂ wr₂ => ?_ + have k₂ : KR H sc s₀ m s₂ := h.write (by rw [rd₂, rd₁]) (by rw [wr₂, wr₁]) + (fun r h1 h2 _ => by rw [g₂ r h1, g₁ r h2]) (m₂ ▸ f₁) (save_hv hp (by omega)) + ⟨scR sc s₀, by simp, fun a ha => hvR_sub hp a (Region.sub_prefix (by omega) a ha)⟩ + refine k s₂ k₂ (by rw [e₂, g₁ _ (by decide), h.ebx]) (m₂ ▸ f₁) ?_ + refine hO.reloc _ _ _ _ fun i hi => ?_ + rw [m₂, m₁, writeBytes_at _ _ _ (by rw [bytesAt_length]; exact hi) (by rw [bytesAt_length]; omega), + bytesAt_getD' _ _ hi, Memory.add_ofNat] + exact key_bytes hp h (by omega) + +/-- The compression of the block into the hash value. -/ +theorem cmpS_ok {m : Nat} {s : State} (h : KR H sc s₀ m s) (hax : s.gpr .eax = hv H s₀ + BitVec.ofNat 32 H.N) + {Q : State → Prop} + (k : ∀ s', KR H sc s₀ m s' → Frame [⟨(hv H s₀).setWidth 64, H.N⟩, cmpR H s₀, stkR s₀] s.mem s'.mem → + hO.md.stateAt s'.mem ((hv H s₀).setWidth 64) = hO.md.compress (hO.md.stateAt s.mem ((hv H s₀).setWidth 64)) + (hO.md.blockAt s.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N)) → Q s') : + WP isa H.cmp s Q := by + obtain ⟨hb, hf, hw, hso, hW, hN0, hN, hD0, hDN, hB, hB64, hS⟩ := bounds hp + refine cmp_ok hO.comp (by omega) (cmpArgs hp h hax) fun s₃ ha e₃ => ?_ + have k₃ : KR H sc s₀ m s₃ := h.call hp ha (by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · exact save_hv hp (by omega) + · exact save_cmp hp) (by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro r (rfl | rfl) + · exact fun a ha => hvR_sub hp a (Region.sub_prefix (by omega) a ha) + · exact cmp_sub hp) + have f := ha.frame + rw [stk_eq h] at f + exact k s₃ k₃ (f.mono (by simp)) e₃ + +theorem lc_ok {o : Nat} (ho : o + H.N ≤ 2 * H.S) {m : Nat} {s : State} (h : KR H sc s₀ m s) + (hpad : bytesAt s.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 (H.N + H.D)) (H.B - H.D) = H.tailB) {c : Prog isa} + {Q : State → Prop} + (k : ∀ s', KR H sc s₀ m s' → Frame [⟨(hv H s₀).setWidth 64, H.N⟩, cmpR H s₀, stkR s₀] s.mem s'.mem → + hO.md.stateAt s'.mem ((hv H s₀).setWidth 64) = hO.md.compress + (hO.md.stateAt s₀.mem ((key s₀).setWidth 64 + BitVec.ofNat 64 o)) + (hO.md.tailBlock H.D (bytesAt s.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.D)) → + bytesAt s'.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 (H.N + H.D)) (H.B - H.D) = H.tailB → + bytesAt s'.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.D = + bytesAt s.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.D → WP isa c s' Q) : + WP isa (.block (H.loadKey o ++ H.atBlk)) s fun s' => WP isa (.seq H.cmp c) s' Q := by + obtain ⟨hb, hf, hw, hso, hW, hN0, hN, hD0, hDN, hB, hB64, hS⟩ := bounds hp + rw [← List.append_nil (H.loadKey o ++ H.atBlk)] + refine load_ok hO hp ho h fun s₂ k₂ ax₂ f₁ st₂ => WP.block_nil (WP.seq (cmpS_ok hO hp k₂ ax₂ fun s₃ k₃ f₂ e₃ => ?_)) + have dB : ∀ {a n : Nat}, H.N ≤ a → a + n ≤ H.N + H.B → + ∀ r ∈ [(⟨(hv H s₀).setWidth 64, H.N⟩ : Region)], Region.Disjoint ⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 a, n⟩ r := + fun h₁ h₂ r hr => blk_disj hp h₁ h₂ r (by simp only [List.mem_singleton] at hr; simp [hr]) + have pad₂ : bytesAt s₂.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N + BitVec.ofNat 64 H.D) (H.B - H.D) = + hO.md.tailPad H.D := by + rw [Memory.add_ofNat, Memory.frame_bytesAt f₁ (dB (by omega) (by omega)) (by omega), hpad, hO.tail] + have u₂ : bytesAt s₂.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.D = + bytesAt s.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.D := + Memory.frame_bytesAt f₁ (dB (by omega) (by omega)) (by omega) + have f₃ : Frame [⟨(hv H s₀).setWidth 64, H.N⟩, cmpR H s₀, stkR s₀] s.mem s₃.mem := + (f₁.mono (by simp)).trans f₂ + refine k s₃ k₃ f₃ ?_ ?_ ?_ + · rw [e₃, st₂, Md.blockAt_tailPad (by omega) pad₂, u₂] + · rw [Memory.frame_bytesAt f₃ (blk_disj hp (by omega) (by omega)) (by omega), hpad] + · exact Memory.frame_bytesAt f₃ (blk_disj hp (by omega) (by omega)) (by omega) + +/-! ## The end of a step: the digest, `T ← T ⊕ U` and the count -/ + +omit hp in +theorem writeW_xor32 (m m' : Mem) (d a b : Addr) : + m.writeW d (m'.readW a 32 ^^^ m'.readW b 32) = + writeBytes m d (Spec.Pbkdf2.xorBytes (bytesAt m' b 4) (bytesAt m' a 4)) := by + simp only [Mem.writeW, Mem.readW] + rw [show (32 : Nat) / 8 = 4 from rfl, BitVec.setWidth_eq, BitVec.setWidth_eq, BitVec.setWidth_eq, + VG.WriteBytes.write_eq_writeBytes] + refine congrArg (writeBytes m d) ?_ + apply List.ext_getElem (by simp [Spec.Pbkdf2.xorBytes, bytesAt]) + intro j h₁ h₂ + simp only [List.length_map, List.length_range] at h₁ + simp only [Spec.Pbkdf2.xorBytes, bytesAt, List.getElem_map, List.getElem_range, List.getElem_zipWith] + rw [BitVec.extractLsb'_xor, Mem.extractLsb'_read _ _ h₁, Mem.extractLsb'_read _ _ h₁, BitVec.xor_comm] + +omit hp in +theorem wp_xorm {is : List Instr} {s : State} {Q : State → Prop} {d : Reg} {m : MemOp} {a : Addr} + (ha : s.ea m = a) (hin : InRegions (s.rd ++ s.wr) a 4) + (k : ∀ s', Upd s s' d (s.gpr d ^^^ s.mem.readW a 32) → WP isa (.block is) s' Q) : + WP isa (.block (.alu .xor d (.mem m) :: is)) s Q := by + refine VG.Proof.Sha256.X86.Stream.WP.cons + (s' := (arithFlags s (s.gpr d ^^^ s.mem.readW a 32) false false).setReg d (s.gpr d ^^^ s.mem.readW a 32)) + ?_ (k _ (Upd.flags _ _ _ _ _ _)) + simp [exec, execAlu, readSrc, State.load32, ha, hin] + +omit hp in +/-- `T ← T ⊕ U` for the first `n` words of `T` at `t` (in `edx`) and `U` at +`x + N` (`x` in `ebx`). -/ +theorem xor_ok {x t : BitVec 32} (hd : Region.Disjoint ⟨t.setWidth 64, H.D⟩ ⟨x.setWidth 64 + BitVec.ofNat 64 H.N, H.D⟩) + (fx : x.toNat + H.N + H.D ≤ 2 ^ 32) (ft : t.toNat + H.D ≤ 2 ^ 32) : + ∀ n, 4 * n ≤ H.D → ∀ (rest : List Instr) (s : State) (Q : State → Prop), s.gpr .ebx = x → s.gpr .edx = t → + (∀ k < n, InRegions (s.rd ++ s.wr) (addr x (H.N + 4 * k)) 4) → + (∀ k < n, InRegions s.wr (addr t (4 * k)) 4) → + (∀ s', (∀ r, r ≠ .ecx → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → + s'.mem = writeBytes s.mem (t.setWidth 64) + (Spec.Pbkdf2.xorBytes (bytesAt s.mem (t.setWidth 64) (4 * n)) + (bytesAt s.mem (x.setWidth 64 + BitVec.ofNat 64 H.N) (4 * n))) → + WP isa (.block rest) s' Q) → + WP isa (.block ((List.range n).flatMap H.xorW ++ rest)) s Q := by + intro n + induction n with + | zero => + intro _ rest s Q _ _ _ _ k + exact k s (fun _ _ => rfl) rfl rfl (by simp [bytesAt, Spec.Pbkdf2.xorBytes, writeBytes_nil]) + | succ n ih => + intro hn rest s Q hbx hdx hin hout k + rw [List.range_succ, List.flatMap_append, List.flatMap_singleton, List.append_assoc] + refine ih (by omega) _ s Q hbx hdx (fun j hj => hin j (by omega)) (fun j hj => hout j (by omega)) + fun s₁ g₁ rd₁ wr₁ m₁ => ?_ + simp only [Hash.xorW, List.cons_append, List.nil_append] + have eU : addr x (H.N + 4 * n) = x.setWidth 64 + BitVec.ofNat 64 H.N + BitVec.ofNat 64 (4 * n) := by + rw [addr_eq (by omega), Memory.add_ofNat] + have eT : addr t (4 * n) = t.setWidth 64 + BitVec.ofNat 64 (4 * n) := addr_eq (by omega) + refine wp_movm (a := addr x (H.N + 4 * n)) (by rw [ea_at, g₁ _ (by decide), hbx]) + (by rw [rd₁, wr₁]; exact hin n (by omega)) fun s₂ u₂ => ?_ + have hw := hout n (by omega) + refine wp_xorm (a := addr t (4 * n)) (by rw [ea_at, u₂.other _ (by decide), g₁ _ (by decide), hdx]) + (by rw [u₂.rd, u₂.wr, rd₁, wr₁]; exact InRegions.right' hw) fun s₃ u₃ => ?_ + refine wp_store (a := addr t (4 * n)) + (by rw [ea_at, u₃.other _ (by decide), u₂.other _ (by decide), g₁ _ (by decide), hdx]) + (by rw [u₃.wr, u₂.wr, wr₁]; exact hw) fun s₄ u₄ => 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 : (Spec.Pbkdf2.xorBytes (bytesAt s.mem (t.setWidth 64) (4 * n)) + (bytesAt s.mem (x.setWidth 64 + BitVec.ofNat 64 H.N) (4 * n))).length = 4 * n := by + rw [Memory.xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length] + rw [u₄.mem, u₃.gpr, u₃.mem, u₂.gpr, u₂.mem, writeW_xor32, m₁, eU, eT, + bytesAt_writeBytes_sep (p := t.setWidth 64 + BitVec.ofNat 64 (4 * n)), + bytesAt_writeBytes_sep (p := x.setWidth 64 + BitVec.ofNat 64 H.N + BitVec.ofNat 64 (4 * n))] + · have e := writeBytes_append s.mem (t.setWidth 64) _ (Spec.Pbkdf2.xorBytes + (bytesAt s.mem (t.setWidth 64 + BitVec.ofNat 64 (4 * n)) 4) + (bytesAt s.mem (x.setWidth 64 + BitVec.ofNat 64 H.N + BitVec.ofNat 64 (4 * n)) 4)) + (by rw [hl, Memory.xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length]; omega) + rw [hl] at e + rw [e, Nat.mul_succ, bytesAt_add, bytesAt_add, Spec.Pbkdf2.xorBytes, Spec.Pbkdf2.xorBytes, + Spec.Pbkdf2.xorBytes, List.zipWith_append (by simp [bytesAt])] + · intro y h₁ h₂ + rw [hl] at h₂ + exact hd y (by simp only [Region.Contains]; omega) (Memory.off_contains h₁ (by omega) (by omega)) + · omega + · intro y h₁ h₂ + rw [hl] at h₂ + exact Memory.sep_after h₁ h₂ (by omega) + · omega + +theorem tail_ok {m : Nat} (hm : 1 ≤ m) (hn : m < 2 ^ 32) {s : State} (h : KR H sc s₀ m s) + (hpad : bytesAt s.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 (H.N + H.D)) (H.B - H.D) = H.tailB) + {Q : State → Prop} + (k : ∀ s', KR H sc s₀ (m - 1) s' → s'.zf = some (decide (m - 1 = 0)) → + Frame [⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩, tR H s₀] s.mem s'.mem → + bytesAt s'.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 (H.N + H.D)) (H.B - H.D) = H.tailB → + bytesAt s'.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.D = + (hO.md.digest (hO.md.stateAt s.mem ((hv H s₀).setWidth 64))).take H.D → + bytesAt s'.mem ((tp s₀).setWidth 64) H.D = Spec.Pbkdf2.xorBytes (bytesAt s.mem ((tp s₀).setWidth 64) H.D) + ((hO.md.digest (hO.md.stateAt s.mem ((hv H s₀).setWidth 64))).take H.D) → Q s') : + WP isa (.block (H.digest ++ H.tStep)) s Q := by + obtain ⟨hb, hf, hw, hso, hW, hN0, hN, hD0, hDN, hB, hB64, hS⟩ := bounds hp + have hD4 := hp.hz.D.2.2 + have hvt := hv_toNat hp + have nt := hp.nt + have hD4' : 4 * (H.D / 4) = H.D := by omega + have sbB : Region.Sub ⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩ (scR sc s₀) := + fun a ha => hvR_sub hp a (Offset.sub_base _ (by omega) a ha) + refine digest_ok hp.hz hO.out h.ebx (by omega) (cov_hv hp h.wr) hpad fun s₁ g₁ rd₁ wr₁ f₁ b₁ p₁ => ?_ + have k₁ : KR H sc s₀ m s₁ := h.write rd₁ wr₁ g₁ f₁ + ((save_hv hp (Nat.le_refl _)).sub_right (Offset.sub_base _ (by omega))) ⟨scR sc s₀, by simp, sbB⟩ + simp only [Hash.tStep, List.cons_append, List.nil_append] + refine wp_movm (a := argAddr s₀ 3) (by rw [ea_at, k₁.esp]; rfl) (argIn hp k₁.rd k₁.wr (by decide)) + fun s₂ u₂ => ?_ + have dx₂ : s₂.gpr .edx = tp s₀ := by rw [u₂.gpr, k₁.readArg hp (by decide)] + have k₂ : KR H sc s₀ m s₂ := k₁.write u₂.rd u₂.wr (fun r _ _ h3 => u₂.other r h3) (R := ⟨0, 0⟩) + (by rw [u₂.mem]; exact Frame.refl _ _) (fun _ _ h => by simp [Region.Contains] at h) + ⟨scR sc s₀, by simp, fun _ h => by simp [Region.Contains] at h⟩ + have hd : Region.Disjoint ⟨(tp s₀).setWidth 64, H.D⟩ ⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.D⟩ := + (t_blk hp).sub_right (Region.sub_prefix (by omega)) + refine xor_ok hd (by omega) nt (H.D / 4) (by omega) _ s₂ _ k₂.ebx dx₂ + (fun j hj => by + rw [addr_eq (by omega)] + exact InRegions.right' (inReg (cov_hv hp k₂.wr) (by omega) (by omega))) + (fun j hj => by + rw [addr_eq (by omega), k₂.wr] + exact ⟨tR H s₀, (mem_wr hp).2, Offset.contains_base _ (by omega) (by omega)⟩) + fun s₃ g₃ rd₃ wr₃ m₃ => ?_ + rw [hD4'] at m₃ + have hxl : (Spec.Pbkdf2.xorBytes (bytesAt s₂.mem ((tp s₀).setWidth 64) H.D) + (bytesAt s₂.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.D)).length = H.D := by + rw [Memory.xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length] + have f₃ : Frame [tR H s₀] s₂.mem s₃.mem := by + rw [m₃]; exact writeBytes_frame _ _ _ (by rw [hxl]; exact Region.contains_self _ _) + have k₃ : KR H sc s₀ m s₃ := k₂.write rd₃ wr₃ (fun r _ h2 _ => g₃ r h2) f₃ + (hp.t_s.sub_right (save_sub hp)).symm ⟨tR H s₀, by simp, fun _ h => h⟩ + refine wp_subi fun s₄ u₄ z₄ => WP.block_nil ?_ + have e₄ : s₃.gpr .edi - 1 = BitVec.ofNat 32 (m - 1) := by + rw [k₃.edi, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat hm] + have k₄ : KR H sc s₀ (m - 1) s₄ := + ⟨by rw [u₄.rd, k₃.rd], by rw [u₄.wr, k₃.wr], by rw [u₄.other _ (by decide), k₃.esp], + by rw [u₄.other _ (by decide), k₃.ebp], by rw [u₄.other _ (by decide), k₃.ebx], + by rw [u₄.other _ (by decide), k₃.esi], by rw [u₄.gpr, e₄], u₄.mem ▸ k₃.saved, u₄.mem ▸ k₃.frame⟩ + have m₂ : s₂.mem = s₁.mem := u₂.mem + have tB : ∀ r ∈ [tR H s₀], Region.Disjoint ⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩ r := by + simp only [List.mem_singleton]; rintro r rfl; exact (t_blk hp).symm + have tB' : ∀ {a n : Nat}, H.N ≤ a → a + n ≤ H.N + H.B → + ∀ r ∈ [tR H s₀], Region.Disjoint ⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 a, n⟩ r := by + intro a n h₁ h₂ r hr + simp only [List.mem_singleton] at hr; subst hr + exact ((t_blk hp).sub_right (Offset.sub _ (by omega) (by omega))).symm + refine k s₄ k₄ (by rw [z₄, e₄, ofNat_beq_zero (by omega)]) ?_ ?_ ?_ ?_ + · rw [u₄.mem]; exact (f₁.mono (by simp)).trans (m₂ ▸ f₃.mono (by simp)) + · rw [u₄.mem, Memory.frame_bytesAt f₃ (tB' (by omega) (by omega)) (by omega), m₂, p₁] + · rw [u₄.mem, Memory.frame_bytesAt f₃ (tB' (Nat.le_refl _) (by omega)) (by omega), m₂, b₁] + · have hT₁ : bytesAt s₁.mem ((tp s₀).setWidth 64) H.D = bytesAt s.mem ((tp s₀).setWidth 64) H.D := + Memory.frame_bytesAt f₁ (fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact t_blk hp) (by omega) + rw [u₄.mem, m₃, bytesAt_writeBytes_self' hxl (by omega), m₂, hT₁, b₁] + +end + +/-! ## A step -/ + +section +variable {H : Hash} (hO : MdOk H) {sc : Nat} {s₀ : State} (hp : Pre H sc s₀) +include hp + +omit hp in +theorem iterate_succ (f : List Byte → List Byte) (n : Nat) (u t : List Byte) : + Spec.Pbkdf2.iterate f (n + 1) u t = Spec.Pbkdf2.iterate f n (f u) (Spec.Pbkdf2.xorBytes t (f u)) := rfl + +theorem body_ok {r : Nat} {s : State} (h : Inv hO sc s₀ (r + 1) s) : + WP isa H.body s fun s' => eval .ne s' = some (r != 0) ∧ Inv hO sc s₀ r s' := by + obtain ⟨hb, hf, hw, hso, hW, hN0, hN, hD0, hDN, hB, hB64, hS⟩ := bounds hp + have hvt := hv_toNat hp + have hlt : r + 1 < 2 ^ 32 := by have := h.le; have := (arg s₀ 2).isLt; simp only [nn] at *; omega + have sbB : Region.Sub ⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩ (scR sc s₀) := + fun a ha => hvR_sub hp a (Offset.sub_base _ (by omega) a ha) + unfold Hash.body + refine WP.seq (lc_ok hO hp (o := 0) (by omega) h.toKR h.pad fun s₂ k₂ f₂ e₂ p₂ u₂ => ?_) + refine WP.seq ?_ + rw [List.append_assoc] + refine digest_ok hp.hz hO.out k₂.ebx (by omega) (cov_hv hp k₂.wr) p₂ fun s₃ g₃ rd₃ wr₃ f₃ b₃ p₃ => ?_ + have k₃ : KR H sc s₀ (r + 1) s₃ := k₂.write rd₃ wr₃ g₃ f₃ + ((save_hv hp (Nat.le_refl _)).sub_right (Offset.sub_base _ (by omega))) ⟨scR sc s₀, by simp, sbB⟩ + refine lc_ok hO hp (o := H.S) (by omega) k₃ p₃ fun s₅ k₅ f₅ e₅ p₅ u₅ => ?_ + refine tail_ok hO hp (m := r + 1) (by omega) hlt k₅ p₅ fun s₈ k₈ z₈ f₈ p₈ b₈ t₈ => ?_ + rw [Nat.add_sub_cancel] at k₈ z₈ + -- `T` is untouched until the end. + have dT : ∀ {rs : List Region}, (∀ q ∈ rs, Region.Sub q (scR sc s₀) ∨ q = stkR s₀) → + ∀ q ∈ rs, Region.Disjoint ⟨(tp s₀).setWidth 64, H.D⟩ q := by + intro rs hrs q hq + rcases hrs q hq with hq | rfl + · exact hp.t_s.sub_right hq + · exact hp.b_t.symm + have sub₁ : ∀ q ∈ [(⟨(hv H s₀).setWidth 64, H.N⟩ : Region), cmpR H s₀, stkR s₀], + Region.Sub q (scR sc s₀) ∨ q = stkR s₀ := by + simp only [List.mem_cons, List.not_mem_nil, or_false] + rintro q (rfl | rfl | rfl) + · exact .inl fun a ha => hvR_sub hp a (Region.sub_prefix (by omega) a ha) + · exact .inl (cmp_sub hp) + · exact .inr rfl + have hT₅ : bytesAt s₅.mem ((tp s₀).setWidth 64) H.D = bytesAt s.mem ((tp s₀).setWidth 64) H.D := by + rw [Memory.frame_bytesAt f₅ (dT sub₁) (by omega), + Memory.frame_bytesAt f₃ (dT (by simp only [List.mem_singleton]; rintro q rfl; exact .inl sbB)) (by omega), + Memory.frame_bytesAt f₂ (dT sub₁) (by omega)] + rw [hT₅, e₅, b₃, e₂, show (key s₀).setWidth 64 + BitVec.ofNat 64 0 = (key s₀).setWidth 64 by simp] at t₈ + rw [e₅, b₃, e₂, show (key s₀).setWidth 64 + BitVec.ofNat 64 0 = (key s₀).setWidth 64 by simp] at b₈ + refine ⟨?_, { k₈ with pad := p₈, le := by have := h.le; omega, val := ?_ }⟩ + · rw [eval_ne, z₈, Option.map_some] + cases r <;> rfl + · rw [h.val, iterate_succ, b₈, t₈]; rfl + +theorem loop_ok {n : Nat} {s : State} (h : Inv hO sc s₀ n s) (hz' : s.zf = some (decide (n = 0))) : + WP isa (.ite .e (.block []) (.loop H.body .ne)) s (Inv hO sc s₀ 0) := by + refine WP.ite (decide (n = 0)) (by show s.zf = _; exact hz') (fun hb => ?_) (fun hb => ?_) + · obtain rfl : n = 0 := by simpa using hb + exact WP.block_nil h + · obtain ⟨m, rfl⟩ : ∃ m, n = m + 1 := ⟨n - 1, by simp at hb; omega⟩ + refine WP.loop (fun m s => Inv hO sc s₀ (m + 1) s) + (fun m s hs' => WP.mono (body_ok hO hp hs') fun s' ⟨he, hi⟩ => ?_) m s h + cases m with + | zero => exact .inl ⟨he, hi⟩ + | succ m => exact .inr ⟨he, m, by omega, hi⟩ + +end + +/-! ## The prologue and the epilogue -/ + +section +variable {H : Hash} (hO : MdOk H) {sc : Nat} {s₀ : State} (hp : Pre H sc s₀) +include hp + +theorem pro_ok : WP isa (.block H.prologue) s₀ fun s => Inv hO sc s₀ (nn s₀) s ∧ s.zf = some (decide (nn s₀ = 0)) := by + obtain ⟨hb, hf, hw, hso, hW, hN0, hN, hD0, hDN, hB, hB64, hS⟩ := bounds hp + obtain ⟨sR, tR'⟩ := mem_wr hp + have hvt := hv_toNat hp + have hD4 := hp.hz.D.2.2 + have hD4' : 4 * (H.D / 4) = H.D := by omega + have tl := hp.hz.tail_length + have nu := hp.nu; have nt := hp.nt + 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 hp) + simp only [Hash.prologue, List.append_assoc, 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 (VG.Proof.Hmac.Generic.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₃ => ?_ + 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₀ 2) (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₂ 2 (by decide)) fun s₅ u₅ => ?_ + refine wp_mov fun s₆ u₆ => wp_addi fun s₇ u₇ => ?_ + refine wp_movm (a := argAddr s₀ 1) (by + rw [ea_at, u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), + u₃.other _ (by decide), e₂ _ (by decide)]; rfl) + (by rw [u₇.rd, u₇.wr, u₆.rd, u₆.wr, u₅.rd, u₅.wr, u₄.rd, u₄.wr, u₃.rd, u₃.wr]; exact i₂ 1 (by decide)) + fun s₈ u₈ => ?_ + have m₈ : s₈.mem = s₂.mem := by rw [u₈.mem, u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem] + have rd₈ : s₈.rd = s₀.rd := by rw [u₈.rd, u₇.rd, u₆.rd, u₅.rd, u₄.rd, u₃.rd, rd₂, u₁.rd] + have wr₈ : s₈.wr = s₀.wr := by rw [u₈.wr, u₇.wr, u₆.wr, u₅.wr, u₄.wr, u₃.wr, wr₂, u₁.wr] + have bp₈ : s₈.gpr .ebp = scr s₀ := by + rw [u₈.other _ (by decide), u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), + u₄.other _ (by decide), u₃.gpr, g₂, u₁.gpr]; rfl + have bx₈ : s₈.gpr .ebx = hv H s₀ := by + rw [u₈.other _ (by decide), u₇.gpr, u₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, g₂, u₁.gpr] + rfl + have si₈ : s₈.gpr .esi = key s₀ := by + rw [u₈.other _ (by decide), u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, + u₃.mem, rA 0 (by decide)] + have di₈ : s₈.gpr .edi = arg s₀ 2 := by + rw [u₈.other _ (by decide), u₇.other _ (by decide), u₆.other _ (by decide), u₅.gpr, u₄.mem, u₃.mem, + rA 2 (by decide)] + have dx₈ : s₈.gpr .edx = up s₀ := by + rw [u₈.gpr, u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem, rA 1 (by decide)] + have sp₈ : s₈.gpr .esp = E s₀ := 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), e₂ _ (by decide)] + have ucov : Covers [uR H s₀] (s₈.rd ++ s₈.wr) := covers_one (by rw [rd₈, hp.rd]; simp) + -- `U` into the block. + refine copyW_ok (by decide) (by decide) (H.D / 4) _ s₈ _ dx₈ bx₈ (by omega) (by omega) + (fun j hj => by + rw [addr_eq (by omega)]; have := inReg (o := 4 * j) (n := 4) ucov (by omega) (by omega) + rwa [show 0 + 4 * j = 4 * j by omega]) + (fun j hj => by rw [addr_eq (by omega)]; exact inReg (cov_hv hp wr₈) (by omega) (by omega)) ?_ + fun s₉ g₉ rd₉ wr₉ m₉ => ?_ + · rw [hD4', BitVec.add_zero] + exact hp.u_s.sep (Region.contains_self _ _) + (by rw [hv_eq hp, Memory.add_ofNat]; exact Offset.contains_base _ (by omega) (by omega)) + rw [hD4', BitVec.add_zero] at m₉ + -- The padding. + refine pad_ok hp.hz (s := s₉) (x := hv H s₀) (by rw [g₉ _ (by decide), bx₈]) (by omega) (cov_hv hp (wr₉.trans wr₈)) + fun s₁₀ g₁₀ rd₁₀ wr₁₀ m₁₀ => ?_ + refine wp_test fun s₁₁ u₁₁ z₁₁ => WP.block_nil ?_ + have m₁₁ : s₁₁.mem = writeBytes (writeBytes s₂.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) + (bytesAt s₂.mem ((up s₀).setWidth 64) H.D)) ((hv H s₀).setWidth 64 + BitVec.ofNat 64 (H.N + H.D)) H.tailB := by + rw [u₁₁.mem, m₁₀, m₉, m₈] + have gr : ∀ r, r ≠ .eax → r ≠ .ecx → r ≠ .edx → s₁₁.gpr r = s₈.gpr r := fun r _ h2 _ => by + rw [u₁₁.gpr, g₁₀ r h2, g₉ r h2] + have fB : Frame [⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩] s₂.mem s₁₁.mem := by + rw [m₁₁] + refine (writeBytes_frame _ _ _ ?_).trans (writeBytes_frame _ _ _ ?_) + · rw [bytesAt_length] + have := Offset.contains_base ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) (d := 0) (n := H.D) (k := H.B) + (by omega) (by omega) + rwa [BitVec.add_zero] at this + · rw [tl, ← Memory.add_ofNat]; exact Offset.contains_base _ (by omega) (by omega) + have sbB : Region.Sub ⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩ (scR sc s₀) := + fun a ha => hvR_sub hp a (Offset.sub_base _ (by omega) a ha) + have dsB : (saveR H.st (scr s₀)).Disjoint ⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩ := + (save_hv hp (Nat.le_refl _)).sub_right (Offset.sub_base _ (by omega)) + have sv : SavedRegs H.st (scr s₀) s₀ s₁₁.mem := + (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)).frame H.st fB (fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact dsB) + have fr : Frame (wrs H sc s₀) s₀.mem s₁₁.mem := + (f₂'.sub fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact ⟨scR sc s₀, by simp, save_sub hp⟩).trans + (fB.sub fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact ⟨scR sc s₀, by simp, sbB⟩) + have edi : s₁₁.gpr .edi = BitVec.ofNat 32 (nn s₀) := by + rw [gr _ (by decide) (by decide) (by decide), di₈, nn, BitVec.ofNat_toNat, BitVec.setWidth_eq] + have dU : Mem.Sep ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.D + ((hv H s₀).setWidth 64 + BitVec.ofNat 64 (H.N + H.D)) H.tailB.length := by + rw [tl, ← Memory.add_ofNat] + have := Offset.sep ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) (d := 0) (n := H.D) (e := H.D) + (k := H.B - H.D) (.inl (by omega)) (by omega) (by omega) + rwa [BitVec.add_zero] at this + refine ⟨⟨⟨by rw [u₁₁.rd, rd₁₀, rd₉, rd₈], by rw [u₁₁.wr, wr₁₀, wr₉, wr₈], + by rw [gr _ (by decide) (by decide) (by decide), sp₈], by rw [gr _ (by decide) (by decide) (by decide), bp₈], + by rw [gr _ (by decide) (by decide) (by decide), bx₈], by rw [gr _ (by decide) (by decide) (by decide), si₈], + edi, sv, fr⟩, ?_, Nat.le_refl _, ?_⟩, ?_⟩ + · rw [m₁₁, ← tl, bytesAt_writeBytes_self' rfl (by omega)] + · -- `U` and `T`. + have hU₂ : bytesAt s₂.mem ((up s₀).setWidth 64) H.D = bytesAt s₀.mem ((up s₀).setWidth 64) H.D := + Memory.frame_bytesAt f₂' (fun r hr => by + simp only [List.mem_singleton] at hr; subst hr; exact hp.u_s.sub_right (save_sub hp)) (by omega) + have hU : bytesAt s₁₁.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N) H.D = + bytesAt s₀.mem ((up s₀).setWidth 64) H.D := by + rw [m₁₁, bytesAt_writeBytes_sep _ _ dU (by omega), bytesAt_writeBytes_self' (bytesAt_length _ _ _) (by omega), + hU₂] + have hT : bytesAt s₁₁.mem ((tp s₀).setWidth 64) H.D = bytesAt s₀.mem ((tp s₀).setWidth 64) H.D := + Memory.frame_bytesAt ((f₂'.mono (rs' := [saveR H.st (scr s₀), ⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩]) + (by simp)).trans (fB.mono (by simp))) (fun r hr => by + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr + rcases hr with rfl | rfl + · exact hp.t_s.sub_right (save_sub hp) + · exact t_blk hp) (by omega) + rw [hU, hT] + · rw [z₁₁, g₁₀ _ (by decide), g₉ _ (by decide), di₈, test_z] + +omit hp in +/-- The final `T` is PBKDF2's, for a key as the contract requires. -/ +theorem post_eq {m : Mem} + (hT : bytesAt m ((tp s₀).setWidth 64) H.D = Spec.Pbkdf2.iterate (stepM hO s₀) (nn s₀) + (bytesAt s₀.mem ((up s₀).setWidth 64) H.D) (bytesAt s₀.mem ((tp s₀).setWidth 64) H.D)) + {k0 : List Byte} (hk : k0.length = hO.hH.SH.H.blockSize) + (hi : hO.hH.SH.Repr s₀.mem ((key s₀).setWidth 64) (xorPad k0 ipad)) + (ho : hO.hH.SH.Repr s₀.mem ((key s₀).setWidth 64 + BitVec.ofNat 64 hO.hH.SH.stateBytes) (xorPad k0 opad)) : + bytesAt m ((tp s₀).setWidth 64) hO.hH.SH.digestBytes = + Spec.Pbkdf2.iterate (hmacBlockKey hO.hH.SH.H k0) (nn s₀) (bytesAt s₀.mem ((up s₀).setWidth 64) hO.hH.SH.digestBytes) + (bytesAt s₀.mem ((tp s₀).setWidth 64) hO.hH.SH.digestBytes) := by + have hl := hO.link + have hB : 0 < H.B := by have := hl.DL; omega + rw [hl.hB] at hk + rw [hl.hS, ← hO.sizes.S] at ho + have li : (xorPad k0 ipad).length = H.B := by simp [xorPad, hk] + have lo : (xorPad k0 opad).length = H.B := by simp [xorPad, hk] + have ei := Md.stateAt_of_repr hB li (hl.repr _ _ _ hi) + have eo := Md.stateAt_of_repr hB lo (hl.repr _ _ _ ho) + rw [hl.hD] + refine hT.trans (Md.iterate_congr (fun u hu => ?_) (fun u => Md.step_length _ hl.DN _ _ u) _ _ _ + (bytesAt_length _ _ _)).symm + rw [Md.hmac_step hl hk hu, ei, eo] + +theorem epilogue_ok {s : State} (h : Inv hO sc s₀ 0 s) : + WP isa (.block H.st.restore) s fun s' => abiPreserved s₀ s' ∧ (iterG hO.hH.SH sc).post s₀ s' := by + obtain ⟨hb, hf, hw, -⟩ := bounds hp + refine WP.mono (restore_ok H.st h.ebp h.saved (by rw [h.wr]; exact (mem_wr hp).1) (by omega) hp.nw) + fun s' ⟨hm, _, _, hg, ho⟩ => ⟨⟨fun r hr => ?_, by rw [hm]; exact h.toKR.ret hp⟩, fun k0 hk hi ho' => ?_⟩ + · by_cases he : r = .esp + · subst he; rw [ho _ (by decide) (by decide), h.esp] + · exact hg r (callee_saved r hr he) + · rw [hm]; exact post_eq hO h.val.symm hk hi ho' + +theorem correct : WP isa H.iterate s₀ fun s' => abiPreserved s₀ s' ∧ (iterG hO.hH.SH sc).post s₀ s' := by + unfold Hash.iterate + refine WP.seq (WP.mono (pro_ok hO hp) fun s₁ ⟨h, hz'⟩ => ?_) + exact WP.seq (WP.mono (loop_ok hO hp h hz') fun s₂ h₂ => epilogue_ok hO hp h₂) + +end + +end VG.Proof.Pbkdf2.Md.X86.Iterate diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/IterateCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/IterateCT.lean new file mode 100644 index 000000000..611e1cf6a --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/IterateCT.lean @@ -0,0 +1,289 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Iterate + +/-! +# PBKDF2-HMAC's iteration over a Merkle–Damgård hash function on x86 (32-bit): constant time + +Untrusted: everything here is checked by Lean. 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`). +-/ + +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.Sha256.X86.Stream (eval_e eval_ne) +open Spec.Sha256 (bytesAt) + +/-- The registers `KR` fixes. -/ +abbrev pubRegs : List Reg := [.esp, .ebp, .ebx, .esi, .edi] + +/-- The taint checks of the pieces of `iterate` between its calls. -/ +structure Checks (H : Hash) : Prop where + pro : ∃ hc, (VG.Taint.check taint (argTaint [] (4 + 4 * 5)) (.block H.prologue) hc).isSome = true + load : ∃ hc, (VG.Taint.check taint (τr pubRegs) (.block (H.loadKey 0 ++ H.atBlk)) hc).isSome = true + mid : ∃ hc, (VG.Taint.check taint (τr pubRegs) (.block (H.digest ++ H.loadKey H.S ++ H.atBlk)) hc).isSome = true + tail : ∃ hc, (VG.Taint.check taint (argTaint [.ebp, .ebx, .esi, .edi] (4 + 4 * 5)) + (.block (H.digest ++ H.tStep)) hc).isSome = true + restore : ∃ hc, (VG.Taint.check taint (τr [.ebp]) (.block H.st.restore) hc).isSome = true + +theorem skip_check : ∃ hc, (VG.Taint.check taint (τr []) (.block []) hc).isSome = true := + ⟨_, by taint_decide⟩ + +/-- 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 + +/-- What the pieces keep, and the padding. -/ +structure KP (H : Hash) (sc : Nat) (s₀ : State) (m : Nat) (s : State) : Prop extends KR H sc s₀ m s where + pad : bytesAt s.mem ((hv H s₀).setWidth 64 + BitVec.ofNat 64 (H.N + H.D)) (H.B - H.D) = H.tailB + +/-! ## Each piece, in one run -/ + +section +variable {H : Hash} (hO : MdOk H) {sc : Nat} {s₀ : State} (hp : Pre H sc s₀) +include hO hp + +theorem b1_ok {m : Nat} {s : State} (h : KP H sc s₀ m s) : + WP isa (.block (H.loadKey 0 ++ H.atBlk)) s fun t => + KP H sc s₀ m t ∧ t.gpr .eax = hv H s₀ + BitVec.ofNat 32 H.N := by + rw [← List.append_nil (H.loadKey 0 ++ H.atBlk)] + have := bounds hp + refine load_ok hO hp (by have := hp.hz.S; omega) h.toKR fun s₂ k₂ ax₂ f₁ _ => WP.block_nil ⟨⟨k₂, ?_⟩, ax₂⟩ + rw [Memory.frame_bytesAt f₁ (fun r hr => blk_disj hp (by omega) (by omega) r (by + simp only [List.mem_singleton] at hr; simp [hr])) (by omega), h.pad] + +theorem c_ok {m : Nat} {s : State} (h : KP H sc s₀ m s) (hax : s.gpr .eax = hv H s₀ + BitVec.ofNat 32 H.N) : + WP isa H.cmp s (KP H sc s₀ m) := by + have := bounds hp + refine cmpS_ok hO hp h.toKR hax fun s₃ k₃ f₃ _ => ⟨k₃, ?_⟩ + rw [Memory.frame_bytesAt f₃ (blk_disj hp (by omega) (by omega)) (by omega), h.pad] + +theorem b2_ok {m : Nat} {s : State} (h : KP H sc s₀ m s) : + WP isa (.block (H.digest ++ H.loadKey H.S ++ H.atBlk)) s fun t => + KP H sc s₀ m t ∧ t.gpr .eax = hv H s₀ + BitVec.ofNat 32 H.N := by + obtain ⟨hb, hf, hw, hso, hW, hN0, hN, hD0, hDN, hB, hB64, hS⟩ := bounds hp + have := hv_toNat hp; have := hp.hz.DL + have sbB : Region.Sub ⟨(hv H s₀).setWidth 64 + BitVec.ofNat 64 H.N, H.B⟩ (scR sc s₀) := + fun a ha => hvR_sub hp a (Offset.sub_base _ (by omega) a ha) + rw [List.append_assoc] + refine digest_ok hp.hz hO.out h.ebx (by omega) (cov_hv hp h.wr) h.pad fun s₃ g₃ rd₃ wr₃ f₃ _ p₃ => ?_ + have k₃ : KR H sc s₀ m s₃ := h.toKR.write rd₃ wr₃ g₃ f₃ + ((save_hv hp (Nat.le_refl _)).sub_right (Offset.sub_base _ (by omega))) ⟨scR sc s₀, by simp, sbB⟩ + rw [← List.append_nil (H.loadKey H.S ++ H.atBlk)] + refine load_ok hO hp (by omega) k₃ fun s₂ k₂ ax₂ f₁ _ => WP.block_nil ⟨⟨k₂, ?_⟩, ax₂⟩ + rw [Memory.frame_bytesAt f₁ (fun r hr => blk_disj hp (by omega) (by omega) r (by + simp only [List.mem_singleton] at hr; simp [hr])) (by omega), p₃] + +theorem b3_ok {m : Nat} (hm : 1 ≤ m) (hn : m < 2 ^ 32) {s : State} (h : KP H sc s₀ m s) : + WP isa (.block (H.digest ++ H.tStep)) s fun t => KP H sc s₀ (m - 1) t ∧ t.zf = some (decide (m - 1 = 0)) := + tail_ok hO hp hm hn h.toKR h.pad fun _ k z _ p _ _ => ⟨⟨k, p⟩, z⟩ + +end + +/-! ## Two runs -/ + +variable {H : Hash} (hO : MdOk H) {sc : Nat} +variable {s₀ s₀' : State} (hp : Pre H sc s₀) (hp' : Pre H sc s₀') (hq : PubEq s₀ s₀') + +theorem PubEq.nn (hq : PubEq s₀ s₀') : nn s₀ = nn s₀' := by + show (arg s₀ 2).toNat = (arg s₀' 2).toNat; rw [hq.args 2 (by decide)] + +theorem eqs (hq : PubEq s₀ s₀') : scr s₀' = scr s₀ ∧ hv H s₀' = hv H s₀ := + ⟨(hq.args 4 (by decide)).symm, by rw [hv, hv, scr, scr, hq.args 4 (by decide)]⟩ + +theorem kr_agree (hq : PubEq s₀ s₀') {m : Nat} {s s' : State} (h : KR H sc s₀ m s) + (h' : KR H sc s₀' m 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 | rfl | rfl + · rw [h.esp, h'.esp, E, E, hq.esp] + · rw [h.ebp, h'.ebp, (eqs (H := H) hq).1] + · rw [h.ebx, h'.ebx, (eqs (H := H) hq).2] + · rw [h.esi, h'.esi, key, key, hq.args 0 (by decide)] + · rw [h.edi, h'.edi] + +/-- The arguments lie outside the writable regions. -/ +theorem args_out {t : State} (h : Pre 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) + · exact Taint.frame_disjoint (by have := h.spf; omega) h.r_t h.a_t + · exact Taint.frame_disjoint (by have := h.spf; omega) h.r_s h.a_s + +include hO hp hp' hq + +/-- A call of the compression function, in both runs. -/ +theorem cmp_rel' {m : Nat} : + RelCT isa (fun s s' => (KP H sc s₀ m s ∧ s.gpr .eax = hv H s₀ + BitVec.ofNat 32 H.N) ∧ + (KP H sc s₀' m s' ∧ s'.gpr .eax = hv H s₀' + BitVec.ofNat 32 H.N)) H.cmp + fun s s' => KP H sc s₀ m s ∧ KP H sc s₀' m s' := by + obtain ⟨e4, ehv⟩ := eqs (H := H) hq + have hB : 0 < H.B := by have := hp.hz.B4; omega + exact rel_wp (cmp_rel hO.comp hB (sp := E s₀) fun s s' ⟨⟨k, a⟩, ⟨k', a'⟩⟩ => + ⟨cmpArgs hp k.toKR a, by have := cmpArgs hp' k'.toKR a'; rwa [e4, ehv] at this, k.esp, + by rw [k'.esp, E, E, hq.esp]⟩) + (fun _ ⟨k, a⟩ => c_ok hO hp k a) (fun _ ⟨k, a⟩ => c_ok hO hp' k a) + +theorem body_rel (hc : Checks H) {m : Nat} (hm : 1 ≤ m) (hn : m < 2 ^ 32) : + RelCT isa (fun s s' => KP H sc s₀ m s ∧ KP H sc s₀' m s') H.body + fun s s' => (KP H sc s₀ (m - 1) s ∧ s.zf = some (decide (m - 1 = 0))) ∧ + (KP H sc s₀' (m - 1) s' ∧ s'.zf = some (decide (m - 1 = 0))) := by + have b1 := rel_agree (F := KP H sc s₀ m) (F' := KP H sc s₀' m) (τr pubRegs) (fun _ _ h h' => agree_regs (kr_agree hq h.toKR h'.toKR)) hc.load + (fun _ h => b1_ok hO hp h) (fun _ h => b1_ok hO hp' h) + have b2 := rel_agree (F := KP H sc s₀ m) (F' := KP H sc s₀' m) (τr pubRegs) (fun _ _ h h' => agree_regs (kr_agree hq h.toKR h'.toKR)) hc.mid + (fun _ h => b2_ok hO hp h) (fun _ h => b2_ok hO hp' h) + have b3 := rel_agree (F := KP H sc s₀ m) (F' := KP H sc s₀' m) (argTaint [.ebp, .ebx, .esi, .edi] (4 + 4 * 5)) (fun s s' k k' => + agree_argTaint (fun r hr => kr_agree hq k.toKR k'.toKR r (by + simp only [List.mem_cons, List.not_mem_nil, or_false] at hr ⊢; tauto)) + (kr_agree hq k.toKR k'.toKR .esp (by simp)) (args_out hp k.esp k.wr) (args_out hp' k'.esp k'.wr) + fun j hj => by rw [k.toKR.argEq hp hj, k'.toKR.argEq hp' hj, hq.args j hj]) hc.tail + (fun _ h => b3_ok hO hp hm hn h) (fun _ h => b3_ok hO hp' hm hn h) + exact b1.seq ((cmp_rel' hO hp hp' hq).seq (b2.seq ((cmp_rel' hO hp hp' hq).seq b3))) + +/-- The loop's invariant in two runs, with `n` steps left. -/ +abbrev LoopInv (n : Nat) (s s' : State) : Prop := + 1 ≤ n ∧ n ≤ nn s₀ ∧ KP H sc s₀ n s ∧ KP H sc s₀' n s' + +theorem step_rel (hc : Checks H) (n : Nat) : + RelCT isa (LoopInv (H := H) (sc := sc) (s₀ := s₀) (s₀' := s₀') n) H.body fun s s' => + isa.eval .ne s = isa.eval .ne s' ∧ + (isa.eval .ne s = some false → KP H sc s₀ 0 s ∧ KP H sc s₀' 0 s') ∧ + (isa.eval .ne s = some true → ∃ m < n, LoopInv (H := H) (sc := sc) (s₀ := s₀) (s₀' := s₀') m s s') := by + have hlt : nn s₀ < 2 ^ 32 := (arg s₀ 2).isLt + by_cases hn : 1 ≤ n ∧ n ≤ nn s₀ + · refine ((body_rel hO hp hp' hq hc hn.1 (by omega)).mono + (P' := LoopInv (H := H) (sc := sc) (s₀ := s₀) (s₀' := s₀') n) (fun _ _ h => ⟨h.2.2.1, h.2.2.2⟩) + fun _ _ h => h).mono (fun _ _ h => h) fun t t' h => ?_ + obtain ⟨⟨i, z⟩, ⟨i', z'⟩⟩ := h + have e : isa.eval .ne t = some (!decide (n - 1 = 0)) := by show eval .ne t = _; rw [eval_ne, z]; rfl + have e' : isa.eval .ne t' = some (!decide (n - 1 = 0)) := by show eval .ne t' = _; rw [eval_ne, z']; rfl + rw [e, e'] + refine ⟨rfl, fun hf => ?_, fun ht => ?_⟩ + · have hl : n - 1 = 0 := by simpa using hf + exact ⟨hl ▸ i, hl ▸ i'⟩ + · have hl : n - 1 ≠ 0 := by simpa using ht + exact ⟨n - 1, by omega, by omega, by omega, i, i'⟩ + · intro _ _ _ _ _ _ h + exact absurd ⟨h.1, h.2.1⟩ hn + +theorem loop_rel (hc : Checks H) : + RelCT isa (fun s s' => (KP H sc s₀ (nn s₀) s ∧ s.zf = some (decide (nn s₀ = 0))) ∧ + (KP H sc s₀' (nn s₀') s' ∧ s'.zf = some (decide (nn s₀' = 0)))) + (.ite .e (.block []) (.loop H.body .ne)) + fun s s' => KP H sc s₀ 0 s ∧ KP H sc s₀' 0 s' := by + have hN := hq.nn + have ev : ∀ {t : State} {k : Nat}, t.zf = some (decide (k = 0)) → isa.eval .e t = some (decide (k = 0)) := + fun h => by show eval .e _ = _; rw [eval_e, h] + refine RelCT.ite (fun s s' h => by rw [ev h.1.2, ev h.2.2, hN]) ?_ ?_ + · by_cases e : nn s₀ = 0 + · have e' : nn s₀' = 0 := hN ▸ e + exact (rel_agree (c := .block []) + (F := fun s => KP H sc s₀ (nn s₀) s ∧ s.zf = some (decide (nn s₀ = 0))) + (F' := fun s => KP H sc s₀' (nn s₀') s ∧ s.zf = some (decide (nn s₀' = 0))) + (G := KP H sc s₀ 0) (G' := KP H sc s₀' 0) (τr []) + (fun s s' h h' => agree_regs (by simp)) skip_check + (fun s h => WP.block_nil (e ▸ h.1)) (fun s h => WP.block_nil (e' ▸ h.1))).mono (fun _ _ h => h.1) + fun _ _ h => h + · intro _ _ _ _ _ _ h + have z := h.2 + rw [ev h.1.1.2] at z + exact absurd (by simpa using z) e + · refine (RelCT.loop (M := isa) (LoopInv (H := H) (sc := sc) (s₀ := s₀) (s₀' := s₀')) + (step_rel hO hp hp' hq hc) (nn s₀)).mono (fun s s' h => ?_) fun _ _ h => h + have z := h.2 + rw [ev h.1.1.2] at z + have e : nn s₀ ≠ 0 := by simpa using z + exact ⟨by omega, Nat.le_refl _, h.1.1.1, hN ▸ h.1.2.1⟩ + +theorem ct (hc : Checks H) : RelCT isa (fun s s' => s = s₀ ∧ s' = s₀') H.iterate fun _ _ => True := by + have hN := hq.nn + have pro := rel_agree (F := fun s => s = s₀) (F' := fun s => s = s₀') + (G := fun s => KP H sc s₀ (nn s₀) s ∧ s.zf = some (decide (nn s₀ = 0))) + (G' := fun s => KP H sc s₀' (nn s₀') s ∧ s.zf = some (decide (nn s₀' = 0))) + (argTaint [] (4 + 4 * 5)) (fun s s' e e' => by + rw [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 rw [e]; exact WP.mono (pro_ok hO hp) fun _ ⟨h, z⟩ => ⟨⟨h.toKR, h.pad⟩, z⟩) + (fun _ e => by rw [e]; exact WP.mono (pro_ok hO hp') fun _ ⟨h, z⟩ => ⟨⟨h.toKR, h.pad⟩, z⟩) + obtain ⟨_, hr⟩ := hc.restore + have restore : RelCT isa (fun s s' => KP H sc s₀ 0 s ∧ KP H sc s₀' 0 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.toKR h.2.toKR .ebp (by simp)) hr + exact pro.seq ((loop_rel hO hp hp' hq hc).seq restore) + +end VG.Proof.Pbkdf2.Md.X86.Iterate + +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) + +/-- `iterate` is verified against `iterG`, 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 + H.N + H.B ≤ 8 * sc) (hsat : ∃ s, (iterG hO.hH.SH sc).pre s) : + Verified X86.target H.iterate (iterG hO.hH.SH sc) := by + refine ⟨fun s hs => correct hO (pre_of hO.hH hs hO.sizes hfit), fun s₁ s₂ t₁ t₂ s₁' s₂' h₁ h₂ hpub e₁ e₂ => ?_, hsat⟩ + obtain ⟨h1, h2⟩ := hpub + exact (ct hO (pre_of hO.hH h₁ hO.sizes hfit) (pre_of hO.hH h₂ hO.sizes hfit) ⟨h1, h2⟩ hc + _ _ _ _ _ _ ⟨rfl, rfl⟩ e₁ e₂).1 + +/-- The regions `iterate` reads and writes, of those `iterW` gives it. -/ +def narrowRd (S D : Nat) (s : State) : List Region := + [⟨(arg s 0).setWidth 64, 2 * S⟩, ⟨(arg s 1).setWidth 64, D⟩, ⟨argAddr s 0, 20⟩] +def narrowWr (D sc : Nat) (s : State) : List Region := + [⟨(arg s 3).setWidth 64, D⟩, ⟨(arg s 4).setWidth 64, 8 * sc⟩] + +/-- `iterate` is verified against `iterW`, 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 + H.N + H.B ≤ 8 * sc) (hsat : ∃ s, (iterW hO.hH.SH sc).pre s) : + Verified X86.target H.iterate (iterW hO.hH.SH sc) := by + have pre : ∀ s, (iterW hO.hH.SH sc).pre s → (iterG hO.hH.SH sc).pre + (s.withRegions (narrowRd hO.hH.SH.stateBytes hO.hH.SH.digestBytes s) (narrowWr hO.hH.SH.digestBytes sc s)) := by + intro s h + obtain ⟨_, _, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20⟩ := h + simp only [iterG, narrowRd, narrowWr, arg_withRegions, argAddr_withRegions, State.withRegions_gpr, + State.withRegions_rd, State.withRegions_wr] + exact ⟨trivial, trivial, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20⟩ + refine Verified.narrowTo (verified hO hc hfit (hsat.elim fun s hs => ⟨_, pre s hs⟩)) + (narrowRd hO.hH.SH.stateBytes hO.hH.SH.digestBytes) (narrowWr hO.hH.SH.digestBytes 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_left _ (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⟩ + · 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⟩ + · 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 + · 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⟩ + +end VG.Proof.Pbkdf2.Md.X86.Iterate diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Lit.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Lit.lean new file mode 100644 index 000000000..be10998a8 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Lit.lean @@ -0,0 +1,30 @@ +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 + +Untrusted: everything here is checked by Lean. `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 registration files' `spSafe` +checks evaluate them. +-/ + +namespace VG.Proof.Pbkdf2.Md.X86 + +materialize_code md5MFinalize := md5M.hmacFin +materialize_code md5MIterate := md5M.iterate +materialize_code sha1MFinalize := sha1M.hmacFin +materialize_code sha1MIterate := sha1M.iterate +materialize_code sha384MFinalize := sha384M.hmacFin +materialize_code sha384MIterate := sha384M.iterate +materialize_code sha512MFinalize := sha512M'.hmacFin +materialize_code sha512MIterate := sha512M'.iterate +materialize_code sha512_224MFinalize := sha512_224M.hmacFin +materialize_code sha512_224MIterate := sha512_224M.iterate +materialize_code sha512_256MFinalize := sha512_256M.hmacFin +materialize_code sha512_256MIterate := sha512_256M.iterate + +end VG.Proof.Pbkdf2.Md.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/MdHmac.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/MdHmac.lean new file mode 100644 index 000000000..5a093a852 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/MdHmac.lean @@ -0,0 +1,54 @@ +import VerifiedGarbage.Proof.Pbkdf2.MdStep +import VerifiedGarbage.Proof.Hmac.Common + +/-! +# HMAC over a Merkle–Damgård hash function: the outer hash as one compression + +Untrusted: everything here is checked by Lean. HMAC's outer hash, of a key's +outer block (`K₀ ⊕ opad`, one block) and an inner digest of `D` bytes, is one +compression, of the hash value of the outer block with the block of the +digest and the padding of a `B + D`-byte message (`Link.hmac_outer`), for any +hash function the streaming proofs describe (`Md`), whatever the target. A +block in memory made of `D` bytes followed by that padding is the padded +block of those bytes (`blockAt_tailPad`). +-/ + +namespace VG.Proof.MdStream.Md + +open VG.Spec.Hmac (StreamingHash xorPad ipad opad hmacBlockKey) +open VG.Spec.Sha256 (bytesAt) + +variable {B N L : Nat} {H : Md B N L} + +/-- The block in memory at `p`, of `D` bytes of message and the padding after +them. -/ +theorem blockAt_tailPad {D : Nat} {m : Mem} {p : Addr} (hD : D ≤ B) + (h : bytesAt m (p + BitVec.ofNat 64 D) (B - D) = H.tailPad D) : + H.blockAt m p = H.tailBlock D (bytesAt m p D) := by + simp only [blockAt, tailBlock] + refine H.parse_congr fun k hk => ?_ + have e := Hmac.Common.bytesAt_add m p D (B - D) + rw [h, show D + (B - D) = B by omega] at e + rw [← e, Hmac.Common.bytesAt_getD' _ _ hk] + +/-- The hash of a block `p` and `D` bytes `x` is one compression, of the hash +value of `p` with the block of `x` and the padding. -/ +theorem Link.hash_outer {S : StreamingHash} {iv : H.HV} {D : Nat} (hl : H.Link S iv D) {p x : List Byte} + (hp : p.length = B) (hx : x.length = D) : + S.H.hash (p ++ x) = (H.digest (H.compress (H.compressList iv p 1) (H.tailBlock D x))).take D := by + rw [hl.hash, Md.hash_block H iv hp hx hl.DL] + +/-- A digest has `D` bytes. -/ +theorem Link.hash_length {S : StreamingHash} {iv : H.HV} {D : Nat} (hl : H.Link S iv D) (x : List Byte) : + (S.H.hash x).length = D := by + rw [hl.hash, List.length_take, Md.hash, H.digest_length]; exact Nat.min_eq_left hl.DN + +/-- HMAC's outer hash, for a key of one block, is one compression of the hash +value of its outer block, with the inner digest padded. -/ +theorem Link.hmac_outer {S : StreamingHash} {iv : H.HV} {D : Nat} (hl : H.Link S iv D) {k0 : List Byte} + (hk : k0.length = B) (text : List Byte) : + hmacBlockKey S.H k0 text = (H.digest (H.compress (H.compressList iv (xorPad k0 opad) 1) + (H.tailBlock D (S.H.hash (xorPad k0 ipad ++ text))))).take D := + hl.hash_outer (by simp [xorPad, hk]) (hl.hash_length _) + +end VG.Proof.MdStream.Md diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/CT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/CT.lean index f8032eaeb..a17263663 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/CT.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/CT.lean @@ -4,7 +4,7 @@ import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.Loop # PBKDF2-HMAC on x86 (32-bit), the whole derivation: constant time Untrusted: everything here is checked by Lean. As for `iterate` -(`Proof/Pbkdf2/Generic/X86/IterateCT.lean`): the pieces of code between the +(`Proof/Pbkdf2/Md/X86/IterateCT.lean`): the pieces of code between the calls are checked by the taint analysis (`Checks`, which the kernel evaluates for each hash function), with the arguments, `esp`, `ebp` and, in the loop over the blocks, `ebx` public (`piece`); the calls are related by diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Instances.lean index f4859c90b..abbfa7975 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Instances.lean @@ -2,13 +2,13 @@ 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.Generic.X86.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances /-! # PBKDF2-HMAC on x86 (32-bit), the whole derivation: the instances Untrusted: everything here is checked by Lean. The generic proof -(`CT.lean`) at each hash function of `Proof/Hmac/Generic/X86/Hashes.lean`: +(`CT.lean`) at each hash function of `Proof/Pbkdf2/Md/X86/Hashes.lean`: the functions it calls are verified by their own registration files, the taint checks are evaluated by the kernel, and a state satisfies the shared contract (`pbkSat`). @@ -48,8 +48,8 @@ def sha1OKF : FnsOK sha1F where Wf := 56 Wt := 56 hi := .of_verified Proof.Hmac.Generic.X86.Instances.sha1_init - hf := .of_verified Proof.Hmac.Generic.X86.Instances.sha1_finalize - it := .of_verified Proof.Pbkdf2.Generic.X86.Instances.sha1 + 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) hfSp := nosp_of (by lit_decide) itSp := nosp_of (by lit_decide) @@ -101,8 +101,8 @@ def md5OKF : FnsOK md5F where Wf := 48 Wt := 48 hi := .of_verified Proof.Hmac.Generic.X86.Instances.md5_init - hf := .of_verified Proof.Hmac.Generic.X86.Instances.md5_finalize - it := .of_verified Proof.Pbkdf2.Generic.X86.Instances.md5 + 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) hfSp := nosp_of (by lit_decide) itSp := nosp_of (by lit_decide) @@ -154,8 +154,8 @@ def sha384OKF : FnsOK sha384F where Wf := 234 Wt := 234 hi := .of_verified Proof.Hmac.Generic.X86.Instances.sha384_init - hf := .of_verified Proof.Hmac.Generic.X86.Instances.sha384_finalize - it := .of_verified Proof.Pbkdf2.Generic.X86.Instances.sha384 + 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) hfSp := nosp_of (by lit_decide) itSp := nosp_of (by lit_decide) @@ -207,8 +207,8 @@ def sha512OKF : FnsOK sha512F where Wf := 234 Wt := 234 hi := .of_verified Proof.Hmac.Generic.X86.Instances.sha512_init - hf := .of_verified Proof.Hmac.Generic.X86.Instances.sha512_finalize - it := .of_verified Proof.Pbkdf2.Generic.X86.Instances.sha512 + 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) hfSp := nosp_of (by lit_decide) itSp := nosp_of (by lit_decide) @@ -260,8 +260,8 @@ def sha512_224OKF : FnsOK sha512_224F where Wf := 234 Wt := 234 hi := .of_verified Proof.Hmac.Generic.X86.Instances.sha512_224_init - hf := .of_verified Proof.Hmac.Generic.X86.Instances.sha512_224_finalize - it := .of_verified Proof.Pbkdf2.Generic.X86.Instances.sha512_224 + 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) hfSp := nosp_of (by lit_decide) itSp := nosp_of (by lit_decide) @@ -313,8 +313,8 @@ def sha512_256OKF : FnsOK sha512_256F where Wf := 234 Wt := 234 hi := .of_verified Proof.Hmac.Generic.X86.Instances.sha512_256_init - hf := .of_verified Proof.Hmac.Generic.X86.Instances.sha512_256_finalize - it := .of_verified Proof.Pbkdf2.Generic.X86.Instances.sha512_256 + 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) hfSp := nosp_of (by lit_decide) itSp := nosp_of (by lit_decide) diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Lit.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Lit.lean index ce38c6fd8..87738bdc3 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Lit.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Lit.lean @@ -1,13 +1,15 @@ import VerifiedGarbage.Proof.Hmac.Generic.X86.Lit +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Lit import VerifiedGarbage.Impl.Pbkdf2.Whole.X86 /-! # PBKDF2-HMAC on x86 (32-bit), the whole derivation: the functions it calls, and its code as literals Untrusted: everything here is checked by Lean. For each hash function of -`Proof/Hmac/Generic/X86/Hashes.lean`, the functions `pbkdf2` calls (`Fns`): -its streaming functions, HMAC's `init` and `finalize` and PBKDF2's -`iterate` for it, by the names they are registered with; and `pbkdf2` as a +`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` as a literal (`materialize_code`, `Proof/Framework/Lit.lean`), which the registration files' `spSafe` checks evaluate. -/ @@ -15,26 +17,26 @@ registration files' `spSafe` checks evaluate. namespace VG.Proof.Pbkdf2.Whole.X86 open VG.Impl.Pbkdf2.Whole.X86 (Fns) -open VG.Proof.Hmac.Generic.X86 +open VG.Proof.Pbkdf2.Md.X86 -/-- The functions `pbkdf2` calls for the hash function `H` of the instance +/-- The functions `pbkdf2` calls for the hash function `M` of the instance `I`, with the working space of `I`'s functions. -/ -def fnsOf (I : Spec.Hmac.Instance) (H : Impl.Hmac.Generic.X86.Hash) : Fns where - H := H +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 := H.init + hiC := M.st.init hfN := I.finalizeApi.name - hfC := H.finalize + hfC := M.hmacFin itN := I.iterateApi.name - itC := Impl.Pbkdf2.Generic.X86.iterate H - -def sha1F : Fns := fnsOf Spec.Hmac.sha1I sha1H -def md5F : Fns := fnsOf Spec.Hmac.md5I md5H -def sha384F : Fns := fnsOf Spec.Hmac.sha384I sha384H -def sha512F : Fns := fnsOf Spec.Hmac.sha512I sha512H' -def sha512_224F : Fns := fnsOf Spec.Hmac.sha512_224I sha512_224H -def sha512_256F : Fns := fnsOf Spec.Hmac.sha512_256I sha512_256H + itC := M.iterate + +def sha1F : Fns := fnsOf Spec.Hmac.sha1I sha1M +def md5F : Fns := fnsOf Spec.Hmac.md5I md5M +def sha384F : Fns := fnsOf Spec.Hmac.sha384I sha384M +def sha512F : Fns := fnsOf Spec.Hmac.sha512I sha512M' +def sha512_224F : Fns := fnsOf Spec.Hmac.sha512_224I sha512_224M +def sha512_256F : Fns := fnsOf Spec.Hmac.sha512_256I sha512_256M materialize_code sha1Pbkdf2 := sha1F.pbkdf2 materialize_code md5Pbkdf2 := md5F.pbkdf2 diff --git a/src/asm/x86/hmac_md5.rs b/src/asm/x86/hmac_md5.rs index 84c8bc86a..5d0599b61 100644 --- a/src/asm/x86/hmac_md5.rs +++ b/src/asm/x86/hmac_md5.rs @@ -162,61 +162,67 @@ pub(crate) unsafe extern "C" fn vg_hmac_md5_finalize(inner: *mut [u8; 80], outer "pop eax", "pop eax", "pop eax", + "mov ecx, DWORD PTR [esi]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+4]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+8]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+12]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [ebp+128]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [ebp+132]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [ebp+136]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [ebp+140]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+32], ecx", "mov ecx, 0", - "20:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebx", - "add eax, ecx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 80", - "jne 20b", - "mov eax, 0", - "mov esi, 64", - "mov ecx, 16", - "mov edx, ebp", - "add edx, 128", - "push ebp", - "push ecx", - "push edx", - "push eax", - "push esi", - "push ebx", - "call {vg_md5_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov eax, 80", + "mov DWORD PTR [ebx+36], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 128", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+60], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, 640", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+76], ecx", + "mov eax, ebx", + "add eax, 16", + "mov ecx, 1", "push ebp", - "push edx", "push ecx", "push eax", "push ebx", - "call {vg_md5_finalize}", - "pop eax", + "call {vg_md5_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "mov ecx, 0", - "21:", - "mov eax, ebp", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+128]", "mov eax, edi", - "add eax, ecx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 16", - "jne 21b", + "mov ecx, DWORD PTR [ebx]", + "mov DWORD PTR [eax], ecx", + "mov ecx, DWORD PTR [ebx+4]", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov DWORD PTR [eax+8], ecx", + "mov ecx, DWORD PTR [ebx+12]", + "mov DWORD PTR [eax+12], ecx", "mov eax, ebp", "mov ebx, DWORD PTR [eax+112]", "mov esi, DWORD PTR [eax+116]", @@ -224,6 +230,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_md5_finalize(inner: *mut [u8; 80], outer "mov ebp, DWORD PTR [eax+124]", "ret", vg_md5_finalize = sym super::md5::vg_md5_finalize, - 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 32d92cd49..8ee30d56b 100644 --- a/src/asm/x86/hmac_sha1.rs +++ b/src/asm/x86/hmac_sha1.rs @@ -162,61 +162,76 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha1_finalize(inner: *mut [u8; 84], oute "pop eax", "pop eax", "pop eax", + "mov ecx, DWORD PTR [esi]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+4]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+8]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+12]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+16]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [ebp+176]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [ebp+180]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [ebp+184]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [ebp+188]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [ebp+192]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+40], ecx", "mov ecx, 0", - "20:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebx", - "add eax, ecx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 84", - "jne 20b", - "mov eax, 0", - "mov esi, 64", - "mov ecx, 20", - "mov edx, ebp", - "add edx, 176", - "push ebp", - "push ecx", - "push edx", - "push eax", - "push esi", - "push ebx", - "call {vg_sha1_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov eax, 84", + "mov DWORD PTR [ebx+44], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 176", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+60], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+76], ecx", + "mov ecx, -1610481664", + "mov DWORD PTR [ebx+80], ecx", + "mov eax, ebx", + "add eax, 20", + "mov ecx, 1", "push ebp", - "push edx", "push ecx", "push eax", "push ebx", - "call {vg_sha1_finalize}", - "pop eax", + "call {vg_sha1_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "mov ecx, 0", - "21:", - "mov eax, ebp", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+176]", "mov eax, edi", - "add eax, ecx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 20", - "jne 21b", + "mov ecx, DWORD PTR [ebx]", + "bswap ecx", + "mov DWORD PTR [eax], ecx", + "mov ecx, DWORD PTR [ebx+4]", + "bswap ecx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "bswap ecx", + "mov DWORD PTR [eax+8], ecx", + "mov ecx, DWORD PTR [ebx+12]", + "bswap ecx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "bswap ecx", + "mov DWORD PTR [eax+16], ecx", "mov eax, ebp", "mov ebx, DWORD PTR [eax+160]", "mov esi, DWORD PTR [eax+164]", @@ -224,6 +239,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha1_finalize(inner: *mut [u8; 84], oute "mov ebp, DWORD PTR [eax+172]", "ret", vg_sha1_finalize = sym super::sha1::vg_sha1_finalize, - 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_sha384.rs b/src/asm/x86/hmac_sha384.rs index ab0e8bf63..515398136 100644 --- a/src/asm/x86/hmac_sha384.rs +++ b/src/asm/x86/hmac_sha384.rs @@ -162,61 +162,188 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha384_finalize(inner: *mut [u8; 192], o "pop eax", "pop eax", "pop eax", + "mov ecx, DWORD PTR [esi]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+4]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+8]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+12]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+16]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [esi+20]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [esi+24]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [esi+28]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [esi+32]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [esi+36]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [esi+40]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [esi+44]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [esi+48]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [esi+52]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [esi+56]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [esi+60]", + "mov DWORD PTR [ebx+60], ecx", + "mov ecx, DWORD PTR [ebp+288]", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, DWORD PTR [ebp+292]", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, DWORD PTR [ebp+296]", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, DWORD PTR [ebp+300]", + "mov DWORD PTR [ebx+76], ecx", + "mov ecx, DWORD PTR [ebp+304]", + "mov DWORD PTR [ebx+80], ecx", + "mov ecx, DWORD PTR [ebp+308]", + "mov DWORD PTR [ebx+84], ecx", + "mov ecx, DWORD PTR [ebp+312]", + "mov DWORD PTR [ebx+88], ecx", + "mov ecx, DWORD PTR [ebp+316]", + "mov DWORD PTR [ebx+92], ecx", + "mov ecx, DWORD PTR [ebp+320]", + "mov DWORD PTR [ebx+96], ecx", + "mov ecx, DWORD PTR [ebp+324]", + "mov DWORD PTR [ebx+100], ecx", + "mov ecx, DWORD PTR [ebp+328]", + "mov DWORD PTR [ebx+104], ecx", + "mov ecx, DWORD PTR [ebp+332]", + "mov DWORD PTR [ebx+108], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+112], ecx", "mov ecx, 0", - "20:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebx", - "add eax, ecx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 192", - "jne 20b", - "mov eax, 0", - "mov esi, 128", - "mov ecx, 48", - "mov edx, ebp", - "add edx, 288", - "push ebp", - "push ecx", - "push edx", - "push eax", - "push esi", - "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov eax, 176", + "mov DWORD PTR [ebx+116], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 288", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+124], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+128], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+132], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+136], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+140], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+144], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+148], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+152], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+156], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+160], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+164], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+168], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+172], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+176], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+180], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+184], ecx", + "mov ecx, -2147155968", + "mov DWORD PTR [ebx+188], ecx", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", - "push edx", "push ecx", "push eax", "push ebx", - "call {vg_sha512_finalize}", - "pop eax", + "call {vg_sha512_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "mov ecx, 0", - "21:", - "mov eax, ebp", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+288]", - "mov eax, edi", - "add eax, ecx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 48", - "jne 21b", + "mov eax, ebx", + "add eax, 64", + "mov ecx, DWORD PTR [ebx]", + "mov edx, DWORD PTR [ebx+4]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax], edx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov edx, DWORD PTR [ebx+12]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+8], edx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "mov edx, DWORD PTR [ebx+20]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+16], edx", + "mov DWORD PTR [eax+20], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "mov edx, DWORD PTR [ebx+28]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+24], edx", + "mov DWORD PTR [eax+28], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "mov edx, DWORD PTR [ebx+36]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+32], edx", + "mov DWORD PTR [eax+36], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "mov edx, DWORD PTR [ebx+44]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+40], edx", + "mov DWORD PTR [eax+44], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "mov edx, DWORD PTR [ebx+52]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+48], edx", + "mov DWORD PTR [eax+52], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "mov edx, DWORD PTR [ebx+60]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+56], edx", + "mov DWORD PTR [eax+60], ecx", + "mov ecx, DWORD PTR [ebx+64]", + "mov DWORD PTR [edi], ecx", + "mov ecx, DWORD PTR [ebx+68]", + "mov DWORD PTR [edi+4], ecx", + "mov ecx, DWORD PTR [ebx+72]", + "mov DWORD PTR [edi+8], ecx", + "mov ecx, DWORD PTR [ebx+76]", + "mov DWORD PTR [edi+12], ecx", + "mov ecx, DWORD PTR [ebx+80]", + "mov DWORD PTR [edi+16], ecx", + "mov ecx, DWORD PTR [ebx+84]", + "mov DWORD PTR [edi+20], ecx", + "mov ecx, DWORD PTR [ebx+88]", + "mov DWORD PTR [edi+24], ecx", + "mov ecx, DWORD PTR [ebx+92]", + "mov DWORD PTR [edi+28], ecx", + "mov ecx, DWORD PTR [ebx+96]", + "mov DWORD PTR [edi+32], ecx", + "mov ecx, DWORD PTR [ebx+100]", + "mov DWORD PTR [edi+36], ecx", + "mov ecx, DWORD PTR [ebx+104]", + "mov DWORD PTR [edi+40], ecx", + "mov ecx, DWORD PTR [ebx+108]", + "mov DWORD PTR [edi+44], ecx", "mov eax, ebp", "mov ebx, DWORD PTR [eax+272]", "mov esi, DWORD PTR [eax+276]", @@ -224,6 +351,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha384_finalize(inner: *mut [u8; 192], o "mov ebp, DWORD PTR [eax+284]", "ret", vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, - 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 c71c23a0e..e361a7459 100644 --- a/src/asm/x86/hmac_sha512.rs +++ b/src/asm/x86/hmac_sha512.rs @@ -162,61 +162,163 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_finalize(inner: *mut [u8; 192], o "pop eax", "pop eax", "pop eax", + "mov ecx, DWORD PTR [esi]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+4]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+8]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+12]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+16]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [esi+20]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [esi+24]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [esi+28]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [esi+32]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [esi+36]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [esi+40]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [esi+44]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [esi+48]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [esi+52]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [esi+56]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [esi+60]", + "mov DWORD PTR [ebx+60], ecx", + "mov ecx, DWORD PTR [ebp+288]", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, DWORD PTR [ebp+292]", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, DWORD PTR [ebp+296]", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, DWORD PTR [ebp+300]", + "mov DWORD PTR [ebx+76], ecx", + "mov ecx, DWORD PTR [ebp+304]", + "mov DWORD PTR [ebx+80], ecx", + "mov ecx, DWORD PTR [ebp+308]", + "mov DWORD PTR [ebx+84], ecx", + "mov ecx, DWORD PTR [ebp+312]", + "mov DWORD PTR [ebx+88], ecx", + "mov ecx, DWORD PTR [ebp+316]", + "mov DWORD PTR [ebx+92], ecx", + "mov ecx, DWORD PTR [ebp+320]", + "mov DWORD PTR [ebx+96], ecx", + "mov ecx, DWORD PTR [ebp+324]", + "mov DWORD PTR [ebx+100], ecx", + "mov ecx, DWORD PTR [ebp+328]", + "mov DWORD PTR [ebx+104], ecx", + "mov ecx, DWORD PTR [ebp+332]", + "mov DWORD PTR [ebx+108], ecx", + "mov ecx, DWORD PTR [ebp+336]", + "mov DWORD PTR [ebx+112], ecx", + "mov ecx, DWORD PTR [ebp+340]", + "mov DWORD PTR [ebx+116], ecx", + "mov ecx, DWORD PTR [ebp+344]", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, DWORD PTR [ebp+348]", + "mov DWORD PTR [ebx+124], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+128], ecx", "mov ecx, 0", - "20:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebx", - "add eax, ecx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 192", - "jne 20b", - "mov eax, 0", - "mov esi, 128", - "mov ecx, 64", - "mov edx, ebp", - "add edx, 288", - "push ebp", - "push ecx", - "push edx", - "push eax", - "push esi", - "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov eax, 192", + "mov DWORD PTR [ebx+132], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 288", + "mov DWORD PTR [ebx+136], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+140], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+144], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+148], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+152], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+156], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+160], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+164], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+168], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+172], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+176], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+180], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+184], ecx", + "mov ecx, 393216", + "mov DWORD PTR [ebx+188], ecx", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", - "push edx", "push ecx", "push eax", "push ebx", - "call {vg_sha512_finalize}", + "call {vg_sha512_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "pop eax", - "mov ecx, 0", - "21:", - "mov eax, ebp", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+288]", "mov eax, edi", - "add eax, ecx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 64", - "jne 21b", + "mov ecx, DWORD PTR [ebx]", + "mov edx, DWORD PTR [ebx+4]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax], edx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov edx, DWORD PTR [ebx+12]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+8], edx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "mov edx, DWORD PTR [ebx+20]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+16], edx", + "mov DWORD PTR [eax+20], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "mov edx, DWORD PTR [ebx+28]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+24], edx", + "mov DWORD PTR [eax+28], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "mov edx, DWORD PTR [ebx+36]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+32], edx", + "mov DWORD PTR [eax+36], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "mov edx, DWORD PTR [ebx+44]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+40], edx", + "mov DWORD PTR [eax+44], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "mov edx, DWORD PTR [ebx+52]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+48], edx", + "mov DWORD PTR [eax+52], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "mov edx, DWORD PTR [ebx+60]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+56], edx", + "mov DWORD PTR [eax+60], ecx", "mov eax, ebp", "mov ebx, DWORD PTR [eax+272]", "mov esi, DWORD PTR [eax+276]", @@ -224,6 +326,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_finalize(inner: *mut [u8; 192], o "mov ebp, DWORD PTR [eax+284]", "ret", vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, - 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 3aa7b158d..66443ae16 100644 --- a/src/asm/x86/hmac_sha512_224.rs +++ b/src/asm/x86/hmac_sha512_224.rs @@ -162,61 +162,178 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_224_finalize(inner: *mut [u8; 192 "pop eax", "pop eax", "pop eax", + "mov ecx, DWORD PTR [esi]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+4]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+8]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+12]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+16]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [esi+20]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [esi+24]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [esi+28]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [esi+32]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [esi+36]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [esi+40]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [esi+44]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [esi+48]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [esi+52]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [esi+56]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [esi+60]", + "mov DWORD PTR [ebx+60], ecx", + "mov ecx, DWORD PTR [ebp+288]", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, DWORD PTR [ebp+292]", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, DWORD PTR [ebp+296]", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, DWORD PTR [ebp+300]", + "mov DWORD PTR [ebx+76], ecx", + "mov ecx, DWORD PTR [ebp+304]", + "mov DWORD PTR [ebx+80], ecx", + "mov ecx, DWORD PTR [ebp+308]", + "mov DWORD PTR [ebx+84], ecx", + "mov ecx, DWORD PTR [ebp+312]", + "mov DWORD PTR [ebx+88], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+92], ecx", "mov ecx, 0", - "20:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebx", - "add eax, ecx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 192", - "jne 20b", - "mov eax, 0", - "mov esi, 128", - "mov ecx, 28", - "mov edx, ebp", - "add edx, 288", - "push ebp", - "push ecx", - "push edx", - "push eax", - "push esi", - "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov eax, 156", + "mov DWORD PTR [ebx+96], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 288", + "mov DWORD PTR [ebx+100], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+104], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+108], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+112], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+116], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+124], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+128], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+132], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+136], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+140], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+144], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+148], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+152], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+156], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+160], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+164], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+168], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+172], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+176], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+180], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+184], ecx", + "mov ecx, -536608768", + "mov DWORD PTR [ebx+188], ecx", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", - "push edx", "push ecx", "push eax", "push ebx", - "call {vg_sha512_finalize}", + "call {vg_sha512_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "pop eax", - "mov ecx, 0", - "21:", - "mov eax, ebp", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+288]", - "mov eax, edi", - "add eax, ecx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 28", - "jne 21b", + "mov eax, ebx", + "add eax, 64", + "mov ecx, DWORD PTR [ebx]", + "mov edx, DWORD PTR [ebx+4]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax], edx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov edx, DWORD PTR [ebx+12]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+8], edx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "mov edx, DWORD PTR [ebx+20]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+16], edx", + "mov DWORD PTR [eax+20], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "mov edx, DWORD PTR [ebx+28]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+24], edx", + "mov DWORD PTR [eax+28], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "mov edx, DWORD PTR [ebx+36]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+32], edx", + "mov DWORD PTR [eax+36], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "mov edx, DWORD PTR [ebx+44]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+40], edx", + "mov DWORD PTR [eax+44], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "mov edx, DWORD PTR [ebx+52]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+48], edx", + "mov DWORD PTR [eax+52], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "mov edx, DWORD PTR [ebx+60]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+56], edx", + "mov DWORD PTR [eax+60], ecx", + "mov ecx, DWORD PTR [ebx+64]", + "mov DWORD PTR [edi], ecx", + "mov ecx, DWORD PTR [ebx+68]", + "mov DWORD PTR [edi+4], ecx", + "mov ecx, DWORD PTR [ebx+72]", + "mov DWORD PTR [edi+8], ecx", + "mov ecx, DWORD PTR [ebx+76]", + "mov DWORD PTR [edi+12], ecx", + "mov ecx, DWORD PTR [ebx+80]", + "mov DWORD PTR [edi+16], ecx", + "mov ecx, DWORD PTR [ebx+84]", + "mov DWORD PTR [edi+20], ecx", + "mov ecx, DWORD PTR [ebx+88]", + "mov DWORD PTR [edi+24], ecx", "mov eax, ebp", "mov ebx, DWORD PTR [eax+272]", "mov esi, DWORD PTR [eax+276]", @@ -224,6 +341,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_224_finalize(inner: *mut [u8; 192 "mov ebp, DWORD PTR [eax+284]", "ret", vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, - 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 609728395..a47854424 100644 --- a/src/asm/x86/hmac_sha512_256.rs +++ b/src/asm/x86/hmac_sha512_256.rs @@ -162,61 +162,180 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_256_finalize(inner: *mut [u8; 192 "pop eax", "pop eax", "pop eax", + "mov ecx, DWORD PTR [esi]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+4]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+8]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+12]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+16]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [esi+20]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [esi+24]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [esi+28]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [esi+32]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [esi+36]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [esi+40]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [esi+44]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [esi+48]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [esi+52]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [esi+56]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [esi+60]", + "mov DWORD PTR [ebx+60], ecx", + "mov ecx, DWORD PTR [ebp+288]", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, DWORD PTR [ebp+292]", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, DWORD PTR [ebp+296]", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, DWORD PTR [ebp+300]", + "mov DWORD PTR [ebx+76], ecx", + "mov ecx, DWORD PTR [ebp+304]", + "mov DWORD PTR [ebx+80], ecx", + "mov ecx, DWORD PTR [ebp+308]", + "mov DWORD PTR [ebx+84], ecx", + "mov ecx, DWORD PTR [ebp+312]", + "mov DWORD PTR [ebx+88], ecx", + "mov ecx, DWORD PTR [ebp+316]", + "mov DWORD PTR [ebx+92], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+96], ecx", "mov ecx, 0", - "20:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebx", - "add eax, ecx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 192", - "jne 20b", - "mov eax, 0", - "mov esi, 128", - "mov ecx, 32", - "mov edx, ebp", - "add edx, 288", - "push ebp", - "push ecx", - "push edx", - "push eax", - "push esi", - "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov eax, 160", + "mov DWORD PTR [ebx+100], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 288", + "mov DWORD PTR [ebx+104], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+108], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+112], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+116], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+124], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+128], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+132], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+136], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+140], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+144], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+148], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+152], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+156], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+160], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+164], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+168], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+172], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+176], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+180], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+184], ecx", + "mov ecx, 327680", + "mov DWORD PTR [ebx+188], ecx", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", - "push edx", "push ecx", "push eax", "push ebx", - "call {vg_sha512_finalize}", + "call {vg_sha512_compress}", "pop eax", "pop eax", "pop eax", "pop eax", - "pop eax", - "mov ecx, 0", - "21:", - "mov eax, ebp", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+288]", - "mov eax, edi", - "add eax, ecx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 32", - "jne 21b", + "mov eax, ebx", + "add eax, 64", + "mov ecx, DWORD PTR [ebx]", + "mov edx, DWORD PTR [ebx+4]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax], edx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov edx, DWORD PTR [ebx+12]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+8], edx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "mov edx, DWORD PTR [ebx+20]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+16], edx", + "mov DWORD PTR [eax+20], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "mov edx, DWORD PTR [ebx+28]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+24], edx", + "mov DWORD PTR [eax+28], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "mov edx, DWORD PTR [ebx+36]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+32], edx", + "mov DWORD PTR [eax+36], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "mov edx, DWORD PTR [ebx+44]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+40], edx", + "mov DWORD PTR [eax+44], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "mov edx, DWORD PTR [ebx+52]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+48], edx", + "mov DWORD PTR [eax+52], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "mov edx, DWORD PTR [ebx+60]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+56], edx", + "mov DWORD PTR [eax+60], ecx", + "mov ecx, DWORD PTR [ebx+64]", + "mov DWORD PTR [edi], ecx", + "mov ecx, DWORD PTR [ebx+68]", + "mov DWORD PTR [edi+4], ecx", + "mov ecx, DWORD PTR [ebx+72]", + "mov DWORD PTR [edi+8], ecx", + "mov ecx, DWORD PTR [ebx+76]", + "mov DWORD PTR [edi+12], ecx", + "mov ecx, DWORD PTR [ebx+80]", + "mov DWORD PTR [edi+16], ecx", + "mov ecx, DWORD PTR [ebx+84]", + "mov DWORD PTR [edi+20], ecx", + "mov ecx, DWORD PTR [ebx+88]", + "mov DWORD PTR [edi+24], ecx", + "mov ecx, DWORD PTR [ebx+92]", + "mov DWORD PTR [edi+28], ecx", "mov eax, ebp", "mov ebx, DWORD PTR [eax+272]", "mov esi, DWORD PTR [eax+276]", @@ -224,6 +343,6 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha512_256_finalize(inner: *mut [u8; 192 "mov ebp, DWORD PTR [eax+284]", "ret", vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, - vg_sha512_update = sym super::sha512::vg_sha512_update, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/x86/pbkdf2_md5.rs b/src/asm/x86/pbkdf2_md5.rs index c6954ceac..89469f659 100644 --- a/src/asm/x86/pbkdf2_md5.rs +++ b/src/asm/x86/pbkdf2_md5.rs @@ -26,147 +26,131 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_md5_iterate(key: *const [u8; 160] "mov DWORD PTR [eax+120], edi", "mov DWORD PTR [eax+124], ebp", "mov ebp, eax", - "mov edi, DWORD PTR [esp+12]", - "mov esi, DWORD PTR [esp+8]", - "mov ecx, 0", - "20:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+224], dl", - "add ecx, 1", - "cmp ecx, 16", - "jne 20b", - "test edi, edi", - "je 21f", - "23:", "mov esi, DWORD PTR [esp+4]", - "mov ecx, 0", - "24:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+128], dl", - "add ecx, 1", - "cmp ecx, 80", - "jne 24b", - "mov ebx, ebp", - "add ebx, 128", - "mov eax, 0", - "mov esi, 64", - "mov ecx, 16", - "mov edx, ebp", - "add edx, 224", - "push ebp", - "push ecx", - "push edx", - "push eax", - "push esi", - "push ebx", - "call {vg_md5_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", + "mov edi, DWORD PTR [esp+12]", "mov ebx, ebp", "add ebx, 128", - "mov eax, 80", + "mov edx, DWORD PTR [esp+8]", + "mov ecx, DWORD PTR [edx]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+32], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 208", - "push ebp", - "push edx", - "push ecx", - "push eax", - "push ebx", - "call {vg_md5_finalize}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov esi, DWORD PTR [esp+4]", + "mov DWORD PTR [ebx+36], ecx", "mov ecx, 0", - "25:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+80]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+128], dl", - "add ecx, 1", - "cmp ecx, 80", - "jne 25b", - "mov ebx, ebp", - "add ebx, 128", - "mov eax, 0", - "mov esi, 64", - "mov ecx, 16", - "mov edx, ebp", - "add edx, 208", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+60], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, 640", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+76], ecx", + "test edi, edi", + "je 20f", + "22:", + "mov ecx, DWORD PTR [esi]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+4]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+8]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+12]", + "mov DWORD PTR [ebx+12], ecx", + "mov eax, ebx", + "add eax, 16", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push esi", "push ebx", - "call {vg_md5_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov ebx, ebp", - "add ebx, 128", - "mov eax, 80", - "mov ecx, 0", - "mov edx, ebp", - "add edx, 224", + "call {vg_md5_compress}", + "pop eax", + "pop eax", + "pop eax", + "pop eax", + "mov eax, ebx", + "add eax, 16", + "mov ecx, DWORD PTR [ebx]", + "mov DWORD PTR [eax], ecx", + "mov ecx, DWORD PTR [ebx+4]", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov DWORD PTR [eax+8], ecx", + "mov ecx, DWORD PTR [ebx+12]", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [esi+80]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+84]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+88]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+92]", + "mov DWORD PTR [ebx+12], ecx", + "mov eax, ebx", + "add eax, 16", + "mov ecx, 1", "push ebp", - "push edx", "push ecx", "push eax", "push ebx", - "call {vg_md5_finalize}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov esi, DWORD PTR [esp+16]", - "mov ecx, 0", - "26:", - "mov eax, ebp", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+224]", - "mov eax, esi", - "add eax, ecx", - "movzx ebx, BYTE PTR [eax]", - "xor edx, ebx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 16", - "jne 26b", + "call {vg_md5_compress}", + "pop eax", + "pop eax", + "pop eax", + "pop eax", + "mov eax, ebx", + "add eax, 16", + "mov ecx, DWORD PTR [ebx]", + "mov DWORD PTR [eax], ecx", + "mov ecx, DWORD PTR [ebx+4]", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov DWORD PTR [eax+8], ecx", + "mov ecx, DWORD PTR [ebx+12]", + "mov DWORD PTR [eax+12], ecx", + "mov edx, DWORD PTR [esp+16]", + "mov ecx, DWORD PTR [ebx+16]", + "xor ecx, DWORD PTR [edx]", + "mov DWORD PTR [edx], ecx", + "mov ecx, DWORD PTR [ebx+20]", + "xor ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [edx+4], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "xor ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [edx+8], ecx", + "mov ecx, DWORD PTR [ebx+28]", + "xor ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [edx+12], ecx", "sub edi, 1", - "jne 23b", - "jmp 22f", + "jne 22b", + "jmp 21f", + "20:", "21:", - "22:", "mov eax, ebp", "mov ebx, DWORD PTR [eax+112]", "mov esi, DWORD PTR [eax+116]", "mov edi, DWORD PTR [eax+120]", "mov ebp, DWORD PTR [eax+124]", "ret", - vg_md5_update = sym super::md5::vg_md5_update, - vg_md5_finalize = sym super::md5::vg_md5_finalize, + vg_md5_compress = sym super::md5::vg_md5_compress, ) } diff --git a/src/asm/x86/pbkdf2_sha1.rs b/src/asm/x86/pbkdf2_sha1.rs index 869579cbc..060be630b 100644 --- a/src/asm/x86/pbkdf2_sha1.rs +++ b/src/asm/x86/pbkdf2_sha1.rs @@ -26,147 +26,152 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha1_iterate(key: *const [u8; 168 "mov DWORD PTR [eax+168], edi", "mov DWORD PTR [eax+172], ebp", "mov ebp, eax", - "mov edi, DWORD PTR [esp+12]", - "mov esi, DWORD PTR [esp+8]", - "mov ecx, 0", - "20:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+280], dl", - "add ecx, 1", - "cmp ecx, 20", - "jne 20b", - "test edi, edi", - "je 21f", - "23:", "mov esi, DWORD PTR [esp+4]", - "mov ecx, 0", - "24:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+176], dl", - "add ecx, 1", - "cmp ecx, 84", - "jne 24b", - "mov ebx, ebp", - "add ebx, 176", - "mov eax, 0", - "mov esi, 64", - "mov ecx, 20", - "mov edx, ebp", - "add edx, 280", - "push ebp", - "push ecx", - "push edx", - "push eax", - "push esi", - "push ebx", - "call {vg_sha1_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", + "mov edi, DWORD PTR [esp+12]", "mov ebx, ebp", "add ebx, 176", - "mov eax, 84", + "mov edx, DWORD PTR [esp+8]", + "mov ecx, DWORD PTR [edx]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [edx+16]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+40], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 260", - "push ebp", - "push edx", - "push ecx", - "push eax", - "push ebx", - "call {vg_sha1_finalize}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov esi, DWORD PTR [esp+4]", + "mov DWORD PTR [ebx+44], ecx", "mov ecx, 0", - "25:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+84]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+176], dl", - "add ecx, 1", - "cmp ecx, 84", - "jne 25b", - "mov ebx, ebp", - "add ebx, 176", - "mov eax, 0", - "mov esi, 64", - "mov ecx, 20", - "mov edx, ebp", - "add edx, 260", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+60], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+76], ecx", + "mov ecx, -1610481664", + "mov DWORD PTR [ebx+80], ecx", + "test edi, edi", + "je 20f", + "22:", + "mov ecx, DWORD PTR [esi]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+4]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+8]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+12]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+16]", + "mov DWORD PTR [ebx+16], ecx", + "mov eax, ebx", + "add eax, 20", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push esi", "push ebx", - "call {vg_sha1_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov ebx, ebp", - "add ebx, 176", - "mov eax, 84", - "mov ecx, 0", - "mov edx, ebp", - "add edx, 280", + "call {vg_sha1_compress}", + "pop eax", + "pop eax", + "pop eax", + "pop eax", + "mov eax, ebx", + "add eax, 20", + "mov ecx, DWORD PTR [ebx]", + "bswap ecx", + "mov DWORD PTR [eax], ecx", + "mov ecx, DWORD PTR [ebx+4]", + "bswap ecx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "bswap ecx", + "mov DWORD PTR [eax+8], ecx", + "mov ecx, DWORD PTR [ebx+12]", + "bswap ecx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "bswap ecx", + "mov DWORD PTR [eax+16], ecx", + "mov ecx, DWORD PTR [esi+84]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+88]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+92]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+96]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+100]", + "mov DWORD PTR [ebx+16], ecx", + "mov eax, ebx", + "add eax, 20", + "mov ecx, 1", "push ebp", - "push edx", "push ecx", "push eax", "push ebx", - "call {vg_sha1_finalize}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov esi, DWORD PTR [esp+16]", - "mov ecx, 0", - "26:", - "mov eax, ebp", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+280]", - "mov eax, esi", - "add eax, ecx", - "movzx ebx, BYTE PTR [eax]", - "xor edx, ebx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 20", - "jne 26b", + "call {vg_sha1_compress}", + "pop eax", + "pop eax", + "pop eax", + "pop eax", + "mov eax, ebx", + "add eax, 20", + "mov ecx, DWORD PTR [ebx]", + "bswap ecx", + "mov DWORD PTR [eax], ecx", + "mov ecx, DWORD PTR [ebx+4]", + "bswap ecx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "bswap ecx", + "mov DWORD PTR [eax+8], ecx", + "mov ecx, DWORD PTR [ebx+12]", + "bswap ecx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "bswap ecx", + "mov DWORD PTR [eax+16], ecx", + "mov edx, DWORD PTR [esp+16]", + "mov ecx, DWORD PTR [ebx+20]", + "xor ecx, DWORD PTR [edx]", + "mov DWORD PTR [edx], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "xor ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [edx+4], ecx", + "mov ecx, DWORD PTR [ebx+28]", + "xor ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [edx+8], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "xor ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [edx+12], ecx", + "mov ecx, DWORD PTR [ebx+36]", + "xor ecx, DWORD PTR [edx+16]", + "mov DWORD PTR [edx+16], ecx", "sub edi, 1", - "jne 23b", - "jmp 22f", + "jne 22b", + "jmp 21f", + "20:", "21:", - "22:", "mov eax, ebp", "mov ebx, DWORD PTR [eax+160]", "mov esi, DWORD PTR [eax+164]", "mov edi, DWORD PTR [eax+168]", "mov ebp, DWORD PTR [eax+172]", "ret", - vg_sha1_update = sym super::sha1::vg_sha1_update, - vg_sha1_finalize = sym super::sha1::vg_sha1_finalize, + vg_sha1_compress = sym super::sha1::vg_sha1_compress, ) } diff --git a/src/asm/x86/pbkdf2_sha384.rs b/src/asm/x86/pbkdf2_sha384.rs index 99154f383..b93aab365 100644 --- a/src/asm/x86/pbkdf2_sha384.rs +++ b/src/asm/x86/pbkdf2_sha384.rs @@ -26,147 +26,331 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha384_iterate(key: *const [u8; 3 "mov DWORD PTR [eax+280], edi", "mov DWORD PTR [eax+284], ebp", "mov ebp, eax", - "mov edi, DWORD PTR [esp+12]", - "mov esi, DWORD PTR [esp+8]", - "mov ecx, 0", - "20:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+544], dl", - "add ecx, 1", - "cmp ecx, 48", - "jne 20b", - "test edi, edi", - "je 21f", - "23:", "mov esi, DWORD PTR [esp+4]", - "mov ecx, 0", - "24:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+288], dl", - "add ecx, 1", - "cmp ecx, 192", - "jne 24b", - "mov ebx, ebp", - "add ebx, 288", - "mov eax, 0", - "mov esi, 128", - "mov ecx, 48", - "mov edx, ebp", - "add edx, 544", - "push ebp", - "push ecx", - "push edx", - "push eax", - "push esi", - "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", + "mov edi, DWORD PTR [esp+12]", "mov ebx, ebp", "add ebx, 288", - "mov eax, 176", + "mov edx, DWORD PTR [esp+8]", + "mov ecx, DWORD PTR [edx]", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [ebx+76], ecx", + "mov ecx, DWORD PTR [edx+16]", + "mov DWORD PTR [ebx+80], ecx", + "mov ecx, DWORD PTR [edx+20]", + "mov DWORD PTR [ebx+84], ecx", + "mov ecx, DWORD PTR [edx+24]", + "mov DWORD PTR [ebx+88], ecx", + "mov ecx, DWORD PTR [edx+28]", + "mov DWORD PTR [ebx+92], ecx", + "mov ecx, DWORD PTR [edx+32]", + "mov DWORD PTR [ebx+96], ecx", + "mov ecx, DWORD PTR [edx+36]", + "mov DWORD PTR [ebx+100], ecx", + "mov ecx, DWORD PTR [edx+40]", + "mov DWORD PTR [ebx+104], ecx", + "mov ecx, DWORD PTR [edx+44]", + "mov DWORD PTR [ebx+108], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+112], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 480", - "push ebp", - "push edx", - "push ecx", - "push eax", - "push ebx", - "call {vg_sha512_finalize}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov esi, DWORD PTR [esp+4]", + "mov DWORD PTR [ebx+116], ecx", "mov ecx, 0", - "25:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+192]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+288], dl", - "add ecx, 1", - "cmp ecx, 192", - "jne 25b", - "mov ebx, ebp", - "add ebx, 288", - "mov eax, 0", - "mov esi, 128", - "mov ecx, 48", - "mov edx, ebp", - "add edx, 480", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+124], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+128], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+132], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+136], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+140], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+144], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+148], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+152], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+156], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+160], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+164], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+168], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+172], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+176], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+180], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+184], ecx", + "mov ecx, -2147155968", + "mov DWORD PTR [ebx+188], ecx", + "test edi, edi", + "je 20f", + "22:", + "mov ecx, DWORD PTR [esi]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+4]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+8]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+12]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+16]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [esi+20]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [esi+24]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [esi+28]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [esi+32]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [esi+36]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [esi+40]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [esi+44]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [esi+48]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [esi+52]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [esi+56]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [esi+60]", + "mov DWORD PTR [ebx+60], ecx", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push esi", "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov ebx, ebp", - "add ebx, 288", - "mov eax, 176", + "call {vg_sha512_compress}", + "pop eax", + "pop eax", + "pop eax", + "pop eax", + "mov eax, ebx", + "add eax, 64", + "mov ecx, DWORD PTR [ebx]", + "mov edx, DWORD PTR [ebx+4]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax], edx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov edx, DWORD PTR [ebx+12]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+8], edx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "mov edx, DWORD PTR [ebx+20]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+16], edx", + "mov DWORD PTR [eax+20], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "mov edx, DWORD PTR [ebx+28]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+24], edx", + "mov DWORD PTR [eax+28], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "mov edx, DWORD PTR [ebx+36]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+32], edx", + "mov DWORD PTR [eax+36], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "mov edx, DWORD PTR [ebx+44]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+40], edx", + "mov DWORD PTR [eax+44], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "mov edx, DWORD PTR [ebx+52]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+48], edx", + "mov DWORD PTR [eax+52], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "mov edx, DWORD PTR [ebx+60]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+56], edx", + "mov DWORD PTR [eax+60], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+112], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 544", + "mov DWORD PTR [ebx+116], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+124], ecx", + "mov ecx, DWORD PTR [esi+192]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+196]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+200]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+204]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+208]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [esi+212]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [esi+216]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [esi+220]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [esi+224]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [esi+228]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [esi+232]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [esi+236]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [esi+240]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [esi+244]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [esi+248]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [esi+252]", + "mov DWORD PTR [ebx+60], ecx", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", - "push edx", "push ecx", "push eax", "push ebx", - "call {vg_sha512_finalize}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov esi, DWORD PTR [esp+16]", + "call {vg_sha512_compress}", + "pop eax", + "pop eax", + "pop eax", + "pop eax", + "mov eax, ebx", + "add eax, 64", + "mov ecx, DWORD PTR [ebx]", + "mov edx, DWORD PTR [ebx+4]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax], edx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov edx, DWORD PTR [ebx+12]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+8], edx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "mov edx, DWORD PTR [ebx+20]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+16], edx", + "mov DWORD PTR [eax+20], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "mov edx, DWORD PTR [ebx+28]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+24], edx", + "mov DWORD PTR [eax+28], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "mov edx, DWORD PTR [ebx+36]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+32], edx", + "mov DWORD PTR [eax+36], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "mov edx, DWORD PTR [ebx+44]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+40], edx", + "mov DWORD PTR [eax+44], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "mov edx, DWORD PTR [ebx+52]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+48], edx", + "mov DWORD PTR [eax+52], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "mov edx, DWORD PTR [ebx+60]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+56], edx", + "mov DWORD PTR [eax+60], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+112], ecx", "mov ecx, 0", - "26:", - "mov eax, ebp", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+544]", - "mov eax, esi", - "add eax, ecx", - "movzx ebx, BYTE PTR [eax]", - "xor edx, ebx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 48", - "jne 26b", + "mov DWORD PTR [ebx+116], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+124], ecx", + "mov edx, DWORD PTR [esp+16]", + "mov ecx, DWORD PTR [ebx+64]", + "xor ecx, DWORD PTR [edx]", + "mov DWORD PTR [edx], ecx", + "mov ecx, DWORD PTR [ebx+68]", + "xor ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [edx+4], ecx", + "mov ecx, DWORD PTR [ebx+72]", + "xor ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [edx+8], ecx", + "mov ecx, DWORD PTR [ebx+76]", + "xor ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [edx+12], ecx", + "mov ecx, DWORD PTR [ebx+80]", + "xor ecx, DWORD PTR [edx+16]", + "mov DWORD PTR [edx+16], ecx", + "mov ecx, DWORD PTR [ebx+84]", + "xor ecx, DWORD PTR [edx+20]", + "mov DWORD PTR [edx+20], ecx", + "mov ecx, DWORD PTR [ebx+88]", + "xor ecx, DWORD PTR [edx+24]", + "mov DWORD PTR [edx+24], ecx", + "mov ecx, DWORD PTR [ebx+92]", + "xor ecx, DWORD PTR [edx+28]", + "mov DWORD PTR [edx+28], ecx", + "mov ecx, DWORD PTR [ebx+96]", + "xor ecx, DWORD PTR [edx+32]", + "mov DWORD PTR [edx+32], ecx", + "mov ecx, DWORD PTR [ebx+100]", + "xor ecx, DWORD PTR [edx+36]", + "mov DWORD PTR [edx+36], ecx", + "mov ecx, DWORD PTR [ebx+104]", + "xor ecx, DWORD PTR [edx+40]", + "mov DWORD PTR [edx+40], ecx", + "mov ecx, DWORD PTR [ebx+108]", + "xor ecx, DWORD PTR [edx+44]", + "mov DWORD PTR [edx+44], ecx", "sub edi, 1", - "jne 23b", - "jmp 22f", + "jne 22b", + "jmp 21f", + "20:", "21:", - "22:", "mov eax, ebp", "mov ebx, DWORD PTR [eax+272]", "mov esi, DWORD PTR [eax+276]", "mov edi, DWORD PTR [eax+280]", "mov ebp, DWORD PTR [eax+284]", "ret", - vg_sha512_update = sym super::sha512::vg_sha512_update, - vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/x86/pbkdf2_sha512.rs b/src/asm/x86/pbkdf2_sha512.rs index c29a75a0f..801075774 100644 --- a/src/asm/x86/pbkdf2_sha512.rs +++ b/src/asm/x86/pbkdf2_sha512.rs @@ -26,147 +26,327 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha512_iterate(key: *const [u8; 3 "mov DWORD PTR [eax+280], edi", "mov DWORD PTR [eax+284], ebp", "mov ebp, eax", - "mov edi, DWORD PTR [esp+12]", - "mov esi, DWORD PTR [esp+8]", - "mov ecx, 0", - "20:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+544], dl", - "add ecx, 1", - "cmp ecx, 64", - "jne 20b", - "test edi, edi", - "je 21f", - "23:", "mov esi, DWORD PTR [esp+4]", - "mov ecx, 0", - "24:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+288], dl", - "add ecx, 1", - "cmp ecx, 192", - "jne 24b", - "mov ebx, ebp", - "add ebx, 288", - "mov eax, 0", - "mov esi, 128", - "mov ecx, 64", - "mov edx, ebp", - "add edx, 544", - "push ebp", - "push ecx", - "push edx", - "push eax", - "push esi", - "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", + "mov edi, DWORD PTR [esp+12]", "mov ebx, ebp", "add ebx, 288", - "mov eax, 192", + "mov edx, DWORD PTR [esp+8]", + "mov ecx, DWORD PTR [edx]", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [ebx+76], ecx", + "mov ecx, DWORD PTR [edx+16]", + "mov DWORD PTR [ebx+80], ecx", + "mov ecx, DWORD PTR [edx+20]", + "mov DWORD PTR [ebx+84], ecx", + "mov ecx, DWORD PTR [edx+24]", + "mov DWORD PTR [ebx+88], ecx", + "mov ecx, DWORD PTR [edx+28]", + "mov DWORD PTR [ebx+92], ecx", + "mov ecx, DWORD PTR [edx+32]", + "mov DWORD PTR [ebx+96], ecx", + "mov ecx, DWORD PTR [edx+36]", + "mov DWORD PTR [ebx+100], ecx", + "mov ecx, DWORD PTR [edx+40]", + "mov DWORD PTR [ebx+104], ecx", + "mov ecx, DWORD PTR [edx+44]", + "mov DWORD PTR [ebx+108], ecx", + "mov ecx, DWORD PTR [edx+48]", + "mov DWORD PTR [ebx+112], ecx", + "mov ecx, DWORD PTR [edx+52]", + "mov DWORD PTR [ebx+116], ecx", + "mov ecx, DWORD PTR [edx+56]", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, DWORD PTR [edx+60]", + "mov DWORD PTR [ebx+124], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+128], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 480", - "push ebp", - "push edx", - "push ecx", - "push eax", - "push ebx", - "call {vg_sha512_finalize}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov esi, DWORD PTR [esp+4]", + "mov DWORD PTR [ebx+132], ecx", "mov ecx, 0", - "25:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+192]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+288], dl", - "add ecx, 1", - "cmp ecx, 192", - "jne 25b", - "mov ebx, ebp", - "add ebx, 288", - "mov eax, 0", - "mov esi, 128", - "mov ecx, 64", - "mov edx, ebp", - "add edx, 480", + "mov DWORD PTR [ebx+136], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+140], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+144], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+148], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+152], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+156], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+160], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+164], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+168], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+172], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+176], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+180], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+184], ecx", + "mov ecx, 393216", + "mov DWORD PTR [ebx+188], ecx", + "test edi, edi", + "je 20f", + "22:", + "mov ecx, DWORD PTR [esi]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+4]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+8]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+12]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+16]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [esi+20]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [esi+24]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [esi+28]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [esi+32]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [esi+36]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [esi+40]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [esi+44]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [esi+48]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [esi+52]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [esi+56]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [esi+60]", + "mov DWORD PTR [ebx+60], ecx", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push esi", "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov ebx, ebp", - "add ebx, 288", - "mov eax, 192", - "mov ecx, 0", - "mov edx, ebp", - "add edx, 544", + "call {vg_sha512_compress}", + "pop eax", + "pop eax", + "pop eax", + "pop eax", + "mov eax, ebx", + "add eax, 64", + "mov ecx, DWORD PTR [ebx]", + "mov edx, DWORD PTR [ebx+4]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax], edx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov edx, DWORD PTR [ebx+12]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+8], edx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "mov edx, DWORD PTR [ebx+20]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+16], edx", + "mov DWORD PTR [eax+20], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "mov edx, DWORD PTR [ebx+28]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+24], edx", + "mov DWORD PTR [eax+28], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "mov edx, DWORD PTR [ebx+36]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+32], edx", + "mov DWORD PTR [eax+36], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "mov edx, DWORD PTR [ebx+44]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+40], edx", + "mov DWORD PTR [eax+44], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "mov edx, DWORD PTR [ebx+52]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+48], edx", + "mov DWORD PTR [eax+52], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "mov edx, DWORD PTR [ebx+60]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+56], edx", + "mov DWORD PTR [eax+60], ecx", + "mov ecx, DWORD PTR [esi+192]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+196]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+200]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+204]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+208]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [esi+212]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [esi+216]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [esi+220]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [esi+224]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [esi+228]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [esi+232]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [esi+236]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [esi+240]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [esi+244]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [esi+248]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [esi+252]", + "mov DWORD PTR [ebx+60], ecx", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", - "push edx", "push ecx", "push eax", "push ebx", - "call {vg_sha512_finalize}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov esi, DWORD PTR [esp+16]", - "mov ecx, 0", - "26:", - "mov eax, ebp", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+544]", - "mov eax, esi", - "add eax, ecx", - "movzx ebx, BYTE PTR [eax]", - "xor edx, ebx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 64", - "jne 26b", + "call {vg_sha512_compress}", + "pop eax", + "pop eax", + "pop eax", + "pop eax", + "mov eax, ebx", + "add eax, 64", + "mov ecx, DWORD PTR [ebx]", + "mov edx, DWORD PTR [ebx+4]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax], edx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov edx, DWORD PTR [ebx+12]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+8], edx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "mov edx, DWORD PTR [ebx+20]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+16], edx", + "mov DWORD PTR [eax+20], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "mov edx, DWORD PTR [ebx+28]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+24], edx", + "mov DWORD PTR [eax+28], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "mov edx, DWORD PTR [ebx+36]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+32], edx", + "mov DWORD PTR [eax+36], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "mov edx, DWORD PTR [ebx+44]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+40], edx", + "mov DWORD PTR [eax+44], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "mov edx, DWORD PTR [ebx+52]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+48], edx", + "mov DWORD PTR [eax+52], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "mov edx, DWORD PTR [ebx+60]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+56], edx", + "mov DWORD PTR [eax+60], ecx", + "mov edx, DWORD PTR [esp+16]", + "mov ecx, DWORD PTR [ebx+64]", + "xor ecx, DWORD PTR [edx]", + "mov DWORD PTR [edx], ecx", + "mov ecx, DWORD PTR [ebx+68]", + "xor ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [edx+4], ecx", + "mov ecx, DWORD PTR [ebx+72]", + "xor ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [edx+8], ecx", + "mov ecx, DWORD PTR [ebx+76]", + "xor ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [edx+12], ecx", + "mov ecx, DWORD PTR [ebx+80]", + "xor ecx, DWORD PTR [edx+16]", + "mov DWORD PTR [edx+16], ecx", + "mov ecx, DWORD PTR [ebx+84]", + "xor ecx, DWORD PTR [edx+20]", + "mov DWORD PTR [edx+20], ecx", + "mov ecx, DWORD PTR [ebx+88]", + "xor ecx, DWORD PTR [edx+24]", + "mov DWORD PTR [edx+24], ecx", + "mov ecx, DWORD PTR [ebx+92]", + "xor ecx, DWORD PTR [edx+28]", + "mov DWORD PTR [edx+28], ecx", + "mov ecx, DWORD PTR [ebx+96]", + "xor ecx, DWORD PTR [edx+32]", + "mov DWORD PTR [edx+32], ecx", + "mov ecx, DWORD PTR [ebx+100]", + "xor ecx, DWORD PTR [edx+36]", + "mov DWORD PTR [edx+36], ecx", + "mov ecx, DWORD PTR [ebx+104]", + "xor ecx, DWORD PTR [edx+40]", + "mov DWORD PTR [edx+40], ecx", + "mov ecx, DWORD PTR [ebx+108]", + "xor ecx, DWORD PTR [edx+44]", + "mov DWORD PTR [edx+44], ecx", + "mov ecx, DWORD PTR [ebx+112]", + "xor ecx, DWORD PTR [edx+48]", + "mov DWORD PTR [edx+48], ecx", + "mov ecx, DWORD PTR [ebx+116]", + "xor ecx, DWORD PTR [edx+52]", + "mov DWORD PTR [edx+52], ecx", + "mov ecx, DWORD PTR [ebx+120]", + "xor ecx, DWORD PTR [edx+56]", + "mov DWORD PTR [edx+56], ecx", + "mov ecx, DWORD PTR [ebx+124]", + "xor ecx, DWORD PTR [edx+60]", + "mov DWORD PTR [edx+60], ecx", "sub edi, 1", - "jne 23b", - "jmp 22f", + "jne 22b", + "jmp 21f", + "20:", "21:", - "22:", "mov eax, ebp", "mov ebx, DWORD PTR [eax+272]", "mov esi, DWORD PTR [eax+276]", "mov edi, DWORD PTR [eax+280]", "mov ebp, DWORD PTR [eax+284]", "ret", - vg_sha512_update = sym super::sha512::vg_sha512_update, - vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/x86/pbkdf2_sha512_224.rs b/src/asm/x86/pbkdf2_sha512_224.rs index 75e521917..2c18d7d16 100644 --- a/src/asm/x86/pbkdf2_sha512_224.rs +++ b/src/asm/x86/pbkdf2_sha512_224.rs @@ -26,147 +26,336 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha512_224_iterate(key: *const [u "mov DWORD PTR [eax+280], edi", "mov DWORD PTR [eax+284], ebp", "mov ebp, eax", - "mov edi, DWORD PTR [esp+12]", - "mov esi, DWORD PTR [esp+8]", - "mov ecx, 0", - "20:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+544], dl", - "add ecx, 1", - "cmp ecx, 28", - "jne 20b", - "test edi, edi", - "je 21f", - "23:", "mov esi, DWORD PTR [esp+4]", - "mov ecx, 0", - "24:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+288], dl", - "add ecx, 1", - "cmp ecx, 192", - "jne 24b", - "mov ebx, ebp", - "add ebx, 288", - "mov eax, 0", - "mov esi, 128", - "mov ecx, 28", - "mov edx, ebp", - "add edx, 544", - "push ebp", - "push ecx", - "push edx", - "push eax", - "push esi", - "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", + "mov edi, DWORD PTR [esp+12]", "mov ebx, ebp", "add ebx, 288", - "mov eax, 156", + "mov edx, DWORD PTR [esp+8]", + "mov ecx, DWORD PTR [edx]", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [ebx+76], ecx", + "mov ecx, DWORD PTR [edx+16]", + "mov DWORD PTR [ebx+80], ecx", + "mov ecx, DWORD PTR [edx+20]", + "mov DWORD PTR [ebx+84], ecx", + "mov ecx, DWORD PTR [edx+24]", + "mov DWORD PTR [ebx+88], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+92], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 480", - "push ebp", - "push edx", - "push ecx", - "push eax", - "push ebx", - "call {vg_sha512_finalize}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov esi, DWORD PTR [esp+4]", + "mov DWORD PTR [ebx+96], ecx", "mov ecx, 0", - "25:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+192]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+288], dl", - "add ecx, 1", - "cmp ecx, 192", - "jne 25b", - "mov ebx, ebp", - "add ebx, 288", - "mov eax, 0", - "mov esi, 128", - "mov ecx, 28", - "mov edx, ebp", - "add edx, 480", + "mov DWORD PTR [ebx+100], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+104], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+108], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+112], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+116], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+124], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+128], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+132], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+136], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+140], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+144], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+148], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+152], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+156], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+160], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+164], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+168], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+172], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+176], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+180], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+184], ecx", + "mov ecx, -536608768", + "mov DWORD PTR [ebx+188], ecx", + "test edi, edi", + "je 20f", + "22:", + "mov ecx, DWORD PTR [esi]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+4]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+8]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+12]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+16]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [esi+20]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [esi+24]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [esi+28]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [esi+32]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [esi+36]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [esi+40]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [esi+44]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [esi+48]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [esi+52]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [esi+56]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [esi+60]", + "mov DWORD PTR [ebx+60], ecx", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push esi", "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov ebx, ebp", - "add ebx, 288", - "mov eax, 156", + "call {vg_sha512_compress}", + "pop eax", + "pop eax", + "pop eax", + "pop eax", + "mov eax, ebx", + "add eax, 64", + "mov ecx, DWORD PTR [ebx]", + "mov edx, DWORD PTR [ebx+4]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax], edx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov edx, DWORD PTR [ebx+12]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+8], edx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "mov edx, DWORD PTR [ebx+20]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+16], edx", + "mov DWORD PTR [eax+20], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "mov edx, DWORD PTR [ebx+28]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+24], edx", + "mov DWORD PTR [eax+28], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "mov edx, DWORD PTR [ebx+36]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+32], edx", + "mov DWORD PTR [eax+36], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "mov edx, DWORD PTR [ebx+44]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+40], edx", + "mov DWORD PTR [eax+44], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "mov edx, DWORD PTR [ebx+52]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+48], edx", + "mov DWORD PTR [eax+52], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "mov edx, DWORD PTR [ebx+60]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+56], edx", + "mov DWORD PTR [eax+60], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+92], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 544", + "mov DWORD PTR [ebx+96], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+100], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+104], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+108], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+112], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+116], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+124], ecx", + "mov ecx, DWORD PTR [esi+192]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+196]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+200]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+204]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+208]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [esi+212]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [esi+216]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [esi+220]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [esi+224]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [esi+228]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [esi+232]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [esi+236]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [esi+240]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [esi+244]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [esi+248]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [esi+252]", + "mov DWORD PTR [ebx+60], ecx", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", - "push edx", "push ecx", "push eax", "push ebx", - "call {vg_sha512_finalize}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov esi, DWORD PTR [esp+16]", + "call {vg_sha512_compress}", + "pop eax", + "pop eax", + "pop eax", + "pop eax", + "mov eax, ebx", + "add eax, 64", + "mov ecx, DWORD PTR [ebx]", + "mov edx, DWORD PTR [ebx+4]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax], edx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov edx, DWORD PTR [ebx+12]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+8], edx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "mov edx, DWORD PTR [ebx+20]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+16], edx", + "mov DWORD PTR [eax+20], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "mov edx, DWORD PTR [ebx+28]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+24], edx", + "mov DWORD PTR [eax+28], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "mov edx, DWORD PTR [ebx+36]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+32], edx", + "mov DWORD PTR [eax+36], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "mov edx, DWORD PTR [ebx+44]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+40], edx", + "mov DWORD PTR [eax+44], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "mov edx, DWORD PTR [ebx+52]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+48], edx", + "mov DWORD PTR [eax+52], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "mov edx, DWORD PTR [ebx+60]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+56], edx", + "mov DWORD PTR [eax+60], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+92], ecx", "mov ecx, 0", - "26:", - "mov eax, ebp", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+544]", - "mov eax, esi", - "add eax, ecx", - "movzx ebx, BYTE PTR [eax]", - "xor edx, ebx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 28", - "jne 26b", + "mov DWORD PTR [ebx+96], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+100], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+104], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+108], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+112], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+116], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+124], ecx", + "mov edx, DWORD PTR [esp+16]", + "mov ecx, DWORD PTR [ebx+64]", + "xor ecx, DWORD PTR [edx]", + "mov DWORD PTR [edx], ecx", + "mov ecx, DWORD PTR [ebx+68]", + "xor ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [edx+4], ecx", + "mov ecx, DWORD PTR [ebx+72]", + "xor ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [edx+8], ecx", + "mov ecx, DWORD PTR [ebx+76]", + "xor ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [edx+12], ecx", + "mov ecx, DWORD PTR [ebx+80]", + "xor ecx, DWORD PTR [edx+16]", + "mov DWORD PTR [edx+16], ecx", + "mov ecx, DWORD PTR [ebx+84]", + "xor ecx, DWORD PTR [edx+20]", + "mov DWORD PTR [edx+20], ecx", + "mov ecx, DWORD PTR [ebx+88]", + "xor ecx, DWORD PTR [edx+24]", + "mov DWORD PTR [edx+24], ecx", "sub edi, 1", - "jne 23b", - "jmp 22f", + "jne 22b", + "jmp 21f", + "20:", "21:", - "22:", "mov eax, ebp", "mov ebx, DWORD PTR [eax+272]", "mov esi, DWORD PTR [eax+276]", "mov edi, DWORD PTR [eax+280]", "mov ebp, DWORD PTR [eax+284]", "ret", - vg_sha512_update = sym super::sha512::vg_sha512_update, - vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } diff --git a/src/asm/x86/pbkdf2_sha512_256.rs b/src/asm/x86/pbkdf2_sha512_256.rs index 8d16eafd7..ff4cf20a8 100644 --- a/src/asm/x86/pbkdf2_sha512_256.rs +++ b/src/asm/x86/pbkdf2_sha512_256.rs @@ -26,147 +26,335 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha512_256_iterate(key: *const [u "mov DWORD PTR [eax+280], edi", "mov DWORD PTR [eax+284], ebp", "mov ebp, eax", - "mov edi, DWORD PTR [esp+12]", - "mov esi, DWORD PTR [esp+8]", - "mov ecx, 0", - "20:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+544], dl", - "add ecx, 1", - "cmp ecx, 32", - "jne 20b", - "test edi, edi", - "je 21f", - "23:", "mov esi, DWORD PTR [esp+4]", - "mov ecx, 0", - "24:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+288], dl", - "add ecx, 1", - "cmp ecx, 192", - "jne 24b", - "mov ebx, ebp", - "add ebx, 288", - "mov eax, 0", - "mov esi, 128", - "mov ecx, 32", - "mov edx, ebp", - "add edx, 544", - "push ebp", - "push ecx", - "push edx", - "push eax", - "push esi", - "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", + "mov edi, DWORD PTR [esp+12]", "mov ebx, ebp", "add ebx, 288", - "mov eax, 160", + "mov edx, DWORD PTR [esp+8]", + "mov ecx, DWORD PTR [edx]", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [ebx+76], ecx", + "mov ecx, DWORD PTR [edx+16]", + "mov DWORD PTR [ebx+80], ecx", + "mov ecx, DWORD PTR [edx+20]", + "mov DWORD PTR [ebx+84], ecx", + "mov ecx, DWORD PTR [edx+24]", + "mov DWORD PTR [ebx+88], ecx", + "mov ecx, DWORD PTR [edx+28]", + "mov DWORD PTR [ebx+92], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+96], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 480", - "push ebp", - "push edx", - "push ecx", - "push eax", - "push ebx", - "call {vg_sha512_finalize}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov esi, DWORD PTR [esp+4]", + "mov DWORD PTR [ebx+100], ecx", "mov ecx, 0", - "25:", - "mov eax, esi", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+192]", - "mov eax, ebp", - "add eax, ecx", - "mov BYTE PTR [eax+288], dl", - "add ecx, 1", - "cmp ecx, 192", - "jne 25b", - "mov ebx, ebp", - "add ebx, 288", - "mov eax, 0", - "mov esi, 128", - "mov ecx, 32", - "mov edx, ebp", - "add edx, 480", + "mov DWORD PTR [ebx+104], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+108], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+112], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+116], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+124], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+128], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+132], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+136], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+140], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+144], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+148], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+152], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+156], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+160], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+164], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+168], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+172], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+176], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+180], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+184], ecx", + "mov ecx, 327680", + "mov DWORD PTR [ebx+188], ecx", + "test edi, edi", + "je 20f", + "22:", + "mov ecx, DWORD PTR [esi]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+4]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+8]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+12]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+16]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [esi+20]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [esi+24]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [esi+28]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [esi+32]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [esi+36]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [esi+40]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [esi+44]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [esi+48]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [esi+52]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [esi+56]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [esi+60]", + "mov DWORD PTR [ebx+60], ecx", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", "push ecx", - "push edx", "push eax", - "push esi", "push ebx", - "call {vg_sha512_update}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov ebx, ebp", - "add ebx, 288", - "mov eax, 160", + "call {vg_sha512_compress}", + "pop eax", + "pop eax", + "pop eax", + "pop eax", + "mov eax, ebx", + "add eax, 64", + "mov ecx, DWORD PTR [ebx]", + "mov edx, DWORD PTR [ebx+4]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax], edx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov edx, DWORD PTR [ebx+12]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+8], edx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "mov edx, DWORD PTR [ebx+20]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+16], edx", + "mov DWORD PTR [eax+20], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "mov edx, DWORD PTR [ebx+28]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+24], edx", + "mov DWORD PTR [eax+28], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "mov edx, DWORD PTR [ebx+36]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+32], edx", + "mov DWORD PTR [eax+36], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "mov edx, DWORD PTR [ebx+44]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+40], edx", + "mov DWORD PTR [eax+44], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "mov edx, DWORD PTR [ebx+52]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+48], edx", + "mov DWORD PTR [eax+52], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "mov edx, DWORD PTR [ebx+60]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+56], edx", + "mov DWORD PTR [eax+60], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+96], ecx", "mov ecx, 0", - "mov edx, ebp", - "add edx, 544", + "mov DWORD PTR [ebx+100], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+104], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+108], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+112], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+116], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+124], ecx", + "mov ecx, DWORD PTR [esi+192]", + "mov DWORD PTR [ebx], ecx", + "mov ecx, DWORD PTR [esi+196]", + "mov DWORD PTR [ebx+4], ecx", + "mov ecx, DWORD PTR [esi+200]", + "mov DWORD PTR [ebx+8], ecx", + "mov ecx, DWORD PTR [esi+204]", + "mov DWORD PTR [ebx+12], ecx", + "mov ecx, DWORD PTR [esi+208]", + "mov DWORD PTR [ebx+16], ecx", + "mov ecx, DWORD PTR [esi+212]", + "mov DWORD PTR [ebx+20], ecx", + "mov ecx, DWORD PTR [esi+216]", + "mov DWORD PTR [ebx+24], ecx", + "mov ecx, DWORD PTR [esi+220]", + "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [esi+224]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [esi+228]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [esi+232]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [esi+236]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [esi+240]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [esi+244]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [esi+248]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [esi+252]", + "mov DWORD PTR [ebx+60], ecx", + "mov eax, ebx", + "add eax, 64", + "mov ecx, 1", "push ebp", - "push edx", "push ecx", "push eax", "push ebx", - "call {vg_sha512_finalize}", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "pop eax", - "mov esi, DWORD PTR [esp+16]", + "call {vg_sha512_compress}", + "pop eax", + "pop eax", + "pop eax", + "pop eax", + "mov eax, ebx", + "add eax, 64", + "mov ecx, DWORD PTR [ebx]", + "mov edx, DWORD PTR [ebx+4]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax], edx", + "mov DWORD PTR [eax+4], ecx", + "mov ecx, DWORD PTR [ebx+8]", + "mov edx, DWORD PTR [ebx+12]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+8], edx", + "mov DWORD PTR [eax+12], ecx", + "mov ecx, DWORD PTR [ebx+16]", + "mov edx, DWORD PTR [ebx+20]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+16], edx", + "mov DWORD PTR [eax+20], ecx", + "mov ecx, DWORD PTR [ebx+24]", + "mov edx, DWORD PTR [ebx+28]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+24], edx", + "mov DWORD PTR [eax+28], ecx", + "mov ecx, DWORD PTR [ebx+32]", + "mov edx, DWORD PTR [ebx+36]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+32], edx", + "mov DWORD PTR [eax+36], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "mov edx, DWORD PTR [ebx+44]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+40], edx", + "mov DWORD PTR [eax+44], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "mov edx, DWORD PTR [ebx+52]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+48], edx", + "mov DWORD PTR [eax+52], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "mov edx, DWORD PTR [ebx+60]", + "bswap edx", + "bswap ecx", + "mov DWORD PTR [eax+56], edx", + "mov DWORD PTR [eax+60], ecx", + "mov ecx, 128", + "mov DWORD PTR [ebx+96], ecx", "mov ecx, 0", - "26:", - "mov eax, ebp", - "add eax, ecx", - "movzx edx, BYTE PTR [eax+544]", - "mov eax, esi", - "add eax, ecx", - "movzx ebx, BYTE PTR [eax]", - "xor edx, ebx", - "mov BYTE PTR [eax], dl", - "add ecx, 1", - "cmp ecx, 32", - "jne 26b", + "mov DWORD PTR [ebx+100], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+104], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+108], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+112], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+116], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+120], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+124], ecx", + "mov edx, DWORD PTR [esp+16]", + "mov ecx, DWORD PTR [ebx+64]", + "xor ecx, DWORD PTR [edx]", + "mov DWORD PTR [edx], ecx", + "mov ecx, DWORD PTR [ebx+68]", + "xor ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [edx+4], ecx", + "mov ecx, DWORD PTR [ebx+72]", + "xor ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [edx+8], ecx", + "mov ecx, DWORD PTR [ebx+76]", + "xor ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [edx+12], ecx", + "mov ecx, DWORD PTR [ebx+80]", + "xor ecx, DWORD PTR [edx+16]", + "mov DWORD PTR [edx+16], ecx", + "mov ecx, DWORD PTR [ebx+84]", + "xor ecx, DWORD PTR [edx+20]", + "mov DWORD PTR [edx+20], ecx", + "mov ecx, DWORD PTR [ebx+88]", + "xor ecx, DWORD PTR [edx+24]", + "mov DWORD PTR [edx+24], ecx", + "mov ecx, DWORD PTR [ebx+92]", + "xor ecx, DWORD PTR [edx+28]", + "mov DWORD PTR [edx+28], ecx", "sub edi, 1", - "jne 23b", - "jmp 22f", + "jne 22b", + "jmp 21f", + "20:", "21:", - "22:", "mov eax, ebp", "mov ebx, DWORD PTR [eax+272]", "mov esi, DWORD PTR [eax+276]", "mov edi, DWORD PTR [eax+280]", "mov ebp, DWORD PTR [eax+284]", "ret", - vg_sha512_update = sym super::sha512::vg_sha512_update, - vg_sha512_finalize = sym super::sha512::vg_sha512_finalize, + vg_sha512_compress = sym super::sha512::vg_sha512_compress, ) } From e27421a93883571ffa1fbf8465e50bfd6bd6d86a Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 2 Oct 2026 08:45:40 +0000 Subject: [PATCH 3/9] HMAC-SHA-256 and PBKDF2-HMAC-SHA-256 on ARMv7 and x86: the generic contracts and code MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit SHA-256 is now one more Merkle–Damgård hash function of the compression-level design (`Impl/Pbkdf2/Md/Arm.lean`, `Impl/Pbkdf2/Md/X86.lean`), with the contracts of `Spec.Hmac.sha256I` (`initApi`, `finalizeApi`, `iterateApi`, `pbkdf2Api`), as every other hash function on every target: * ARMv7: `sha256H` and its `HashOK` (`Proof/Hmac/Generic/Arm/Sha256.lean`), `sha256Md` (`Proof/Pbkdf2/Md/Arm/Sha256.lean`, where SHA-224's file now takes `sha256_comp` from), HMAC's `init` the generic one, and the whole of PBKDF2 rewired onto them (`Proof/Pbkdf2/Whole/Arm/Sha256.lean`). * x86: the backends' code (`Proof/Sha256/X86/Variants/Code.lean`: SHA-256's streaming functions, its Md `Hash` and the whole of PBKDF2's `Fns`, for a backend's compression and streaming functions), proven once for every backend (`Proof/Hmac/Generic/X86/Sha256.lean`, `Proof/Pbkdf2/Md/X86/Sha256.lean`, `Proof/Pbkdf2/Whole/X86/Sha256.lean`; taint checks evaluated once, on the sizes). `Backend` now carries the compression function, the streaming functions (`Sha256Stream`) and the `spSafe`/no-`esp`/stack facts of the code built on them; the fields only the specialized code used are gone. `Generic/Sha256/X86/{Hmac,Pbkdf2}.lean` emit `sha256I`'s init, finalize, iterate and pbkdf2 for each backend (with `_shani` for SHA-NI). Deleted: SHA-256's own 32-bit HMAC and PBKDF2 implementations and proofs (`Impl/Hmac/Arm.lean`, `Impl/Pbkdf2/Arm.lean`, `Impl/Hmac/X86.lean`, `Impl/Hmac/Sha256/X86.lean`, `Impl/Pbkdf2/X86.lean`, `Impl/Pbkdf2/Sha256/X86.lean`, `Proof/Hmac/Arm/`, `Proof/Pbkdf2/Arm/`, `Proof/Hmac/X86/`, `Proof/Hmac/Sha256/X86/`, `Proof/Pbkdf2/X86/`, `Proof/Pbkdf2/Sha256/X86.lean`, `Proof/Pbkdf2/Whole/X86/Sha256Fns.lean`) and what only they used (`Proof/Sha256/X86/Stream/{CompressAt,FinalizeVariant}.lean`, `Proof/Framework/TaintWeaken.lean`). Scrypt's ARM proof gets its own `wp_eor`; `sha256_repr` moves to `Proof/Hmac/Generic/Common.lean`. No change to `TCB/` or `Spec/`: the old SHA-256-specific 32-bit contracts there are now unused, for a later Spec-only PR to delete. Rust: `src/hmac/sha256.rs` uses `streaming_hmac!` on every architecture (the 32-bit `HmacHash` implementation is gone); `src/pbkdf2/sha256.rs` already used `whole_pbkdf2!`. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01RjfTK5YMk2jDsiKRYs2dbn --- .../Artifacts/HmacSha256/Arm.lean | 46 +- .../Artifacts/Pbkdf2Sha256/Arm.lean | 33 +- .../Generic/Sha256/X86/Hmac.lean | 43 +- .../Generic/Sha256/X86/Pbkdf2.lean | 39 +- lean/VerifiedGarbage/Impl/Hmac/Arm.lean | 107 -- .../VerifiedGarbage/Impl/Hmac/Sha256/X86.lean | 48 - lean/VerifiedGarbage/Impl/Hmac/X86.lean | 133 -- lean/VerifiedGarbage/Impl/Pbkdf2/Arm.lean | 91 -- lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean | 2 +- lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean | 4 +- .../Impl/Pbkdf2/Sha256/X86.lean | 20 - lean/VerifiedGarbage/Impl/Pbkdf2/X86.lean | 84 -- .../Proof/Framework/TaintWeaken.lean | 88 -- .../Proof/Hmac/Arm/Common.lean | 150 --- .../Proof/Hmac/Arm/Finalize.lean | 531 -------- lean/VerifiedGarbage/Proof/Hmac/Arm/Init.lean | 899 ------------- lean/VerifiedGarbage/Proof/Hmac/Arm/Lit.lean | 14 - .../Proof/Hmac/Generic/Arm/Hashes.lean | 2 +- .../Proof/Hmac/Generic/Arm/Sha256.lean | 88 ++ .../Proof/Hmac/Generic/Common.lean | 19 +- .../Proof/Hmac/Generic/X86/Hashes.lean | 3 +- .../Proof/Hmac/Generic/X86/Sha256.lean | 115 ++ .../Proof/Hmac/Sha256/X86/Finalize.lean | 303 ----- .../Proof/Hmac/Sha256/X86/Init.lean | 260 ---- .../Proof/Hmac/X86/Finalize.lean | 1127 ----------------- lean/VerifiedGarbage/Proof/Hmac/X86/Init.lean | 902 ------------- lean/VerifiedGarbage/Proof/Hmac/X86/Lit.lean | 15 - .../Proof/Pbkdf2/Arm/Iterate.lean | 1109 ---------------- .../VerifiedGarbage/Proof/Pbkdf2/Arm/Lit.lean | 13 - .../Proof/Pbkdf2/Md/Arm/Instances.lean | 3 +- .../Proof/Pbkdf2/Md/Arm/Sha224.lean | 18 +- .../Proof/Pbkdf2/Md/Arm/Sha256.lean | 87 ++ .../Proof/Pbkdf2/Md/X86/Hashes.lean | 3 +- .../Proof/Pbkdf2/Md/X86/Sha256.lean | 125 ++ .../Proof/Pbkdf2/Sha256/X86.lean | 207 --- .../Proof/Pbkdf2/Whole/Arm/Sha256.lean | 102 +- .../Proof/Pbkdf2/Whole/Common.lean | 18 +- .../Proof/Pbkdf2/Whole/X86/Sha256.lean | 100 +- .../Proof/Pbkdf2/Whole/X86/Sha256Fns.lean | 43 - .../Proof/Pbkdf2/X86/Body.lean | 99 -- .../Proof/Pbkdf2/X86/Common.lean | 437 ------- .../Proof/Pbkdf2/X86/Iterate.lean | 560 -------- .../Proof/Scrypt/Arm/BlockMixVerified.lean | 10 +- .../Proof/Scrypt/Arm/RoMixCT.lean | 1 - .../Proof/Sha256/X86/Stream/Common.lean | 6 +- .../Proof/Sha256/X86/Stream/CompressAt.lean | 108 -- .../Proof/Sha256/X86/Stream/Finalize.lean | 12 +- .../Sha256/X86/Stream/FinalizeVariant.lean | 218 ---- .../Proof/Sha256/X86/Variants/Code.lean | 50 + .../Proof/Sha256/X86/Variants/Interface.lean | 122 +- .../Variants/Sha256/X86/Scalar.lean | 54 +- .../Variants/Sha256/X86/ShaNi.lean | 73 +- src/asm/arm/hmac_sha256.rs | 458 ++----- src/asm/arm/pbkdf2_sha256.rs | 268 ++-- src/asm/x86/hmac_sha256.rs | 728 ++++------- src/asm/x86/pbkdf2_sha256.rs | 370 +++--- src/hmac/sha256.rs | 154 +-- src/pbkdf2/sha256.rs | 4 +- 58 files changed, 1471 insertions(+), 9255 deletions(-) delete mode 100644 lean/VerifiedGarbage/Impl/Hmac/Arm.lean delete mode 100644 lean/VerifiedGarbage/Impl/Hmac/Sha256/X86.lean delete mode 100644 lean/VerifiedGarbage/Impl/Hmac/X86.lean delete mode 100644 lean/VerifiedGarbage/Impl/Pbkdf2/Arm.lean delete mode 100644 lean/VerifiedGarbage/Impl/Pbkdf2/Sha256/X86.lean delete mode 100644 lean/VerifiedGarbage/Impl/Pbkdf2/X86.lean delete mode 100644 lean/VerifiedGarbage/Proof/Framework/TaintWeaken.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Arm/Common.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Arm/Finalize.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Arm/Init.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Arm/Lit.lean create mode 100644 lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha256.lean create mode 100644 lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Sha256.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Sha256/X86/Finalize.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Sha256/X86/Init.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/X86/Finalize.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/X86/Init.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/X86/Lit.lean delete mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Arm/Iterate.lean delete mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Arm/Lit.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha256.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Sha256.lean delete mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Sha256/X86.lean delete mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Sha256Fns.lean delete mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/X86/Body.lean delete mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/X86/Common.lean delete mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/X86/Iterate.lean delete mode 100644 lean/VerifiedGarbage/Proof/Sha256/X86/Stream/CompressAt.lean delete mode 100644 lean/VerifiedGarbage/Proof/Sha256/X86/Stream/FinalizeVariant.lean create mode 100644 lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Code.lean diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean index 2a631d9e2..c28cf7cbd 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean @@ -1,25 +1,45 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Proof.Hmac.Arm.Finalize -import VerifiedGarbage.Proof.Hmac.Arm.Init +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Sha256 -/-! # HMAC-SHA-256 (RFC 2104) on ARMv7 -/ +/-! +# 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`. + +`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. +-/ namespace VG.Artifacts.HmacSha256.Arm +open VG.Proof.Hmac.Generic.Arm + def artifacts : List Artifact := [ - { Spec.Hmac.initSha256Api with + { Spec.Hmac.sha256I.initApi with target := Arm.target - doc := Spec.Hmac.initSha256Api.doc - code := Impl.Hmac.Arm.init - contract := Spec.Hmac.initSha256Contract Arm.abi - verified := Proof.Hmac.Arm.Init.init_verified + doc := Spec.Hmac.sha256I.initApi.doc + code := sha256H.init + contract := Spec.Hmac.sha256I.initContract Arm.abi 16 + ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ + writeArgs := true + stack := 16 + verified := Instances.sha256_init spSafe := Code.all_of_forall (fun _ => rfl) _ }, - { Spec.Hmac.finalizeSha256OutApi with + { Spec.Hmac.sha256I.finalizeApi with target := Arm.target - doc := Spec.Hmac.finalizeSha256OutApi.doc - code := Impl.Hmac.Arm.finalize - contract := Spec.Hmac.finalizeSha256OutContract Arm.abi - verified := Proof.Hmac.Arm.Finalize.finalize_verified + doc := Spec.Hmac.sha256I.finalizeApi.doc + code := Proof.Pbkdf2.Md.Arm.sha256Md.hmacFin + contract := Spec.Hmac.sha256I.finalizeContract Arm.abi 16 + ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ + writeArgs := true + stack := 16 + verified := Proof.Pbkdf2.Md.Arm.Instances.sha256_finalize spSafe := Code.all_of_forall (fun _ => rfl) _ }] end VG.Artifacts.HmacSha256.Arm diff --git a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha256/Arm.lean b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha256/Arm.lean index b24452d9b..42bbd9313 100644 --- a/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha256/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/Pbkdf2Sha256/Arm.lean @@ -1,29 +1,34 @@ import VerifiedGarbage.TCB.Arm.Target -import VerifiedGarbage.Impl.Pbkdf2.Arm -import VerifiedGarbage.Proof.Pbkdf2.Arm.Iterate -import VerifiedGarbage.Proof.Pbkdf2.Arm.Lit import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Sha256 /-! -# PBKDF2-HMAC-SHA-256 (RFC 8018) on 32-bit ARM: the iteration and the whole derivation +# PBKDF2-HMAC-SHA-256 (RFC 8018) on ARMv7: the iteration and the whole derivation + +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/Arm.lean`): each step is two calls of SHA-256's verified +compression function (`vg_sha256_compress`), on blocks laid out once at fixed +offsets in `scratch`. It uses no stack; `stack` is that of the shared +contract, 16 bytes. The whole derivation, `pbkdf2`, is the one for every streaming hash function -(`Impl/Pbkdf2/Whole/Arm.lean`), calling SHA-256's streaming functions, -HMAC-SHA-256's `init` and `finalize` and the iteration above, which use no -stack. Its `stack` is that of the shared contract: 24 bytes (it pushes up to -16). +(`Impl/Pbkdf2/Whole/Arm.lean`), calling the hash function's streaming +functions, HMAC's `init` and `finalize` and the iteration above. `stack` is +that of the shared contract, 24 bytes: `pbkdf2` pushes `update`'s 16 bytes of +stack arguments, or 8 bytes around a call of a function that uses 16. -/ namespace VG.Artifacts.Pbkdf2Sha256.Arm def artifacts : List Artifact := [ - { Spec.Pbkdf2.iterateSha256Api with + { Spec.Hmac.sha256I.iterateApi with target := Arm.target - doc := Spec.Pbkdf2.iterateSha256Api.doc - (notes := ["The function uses no stack: it saves its return address in `scratch`."]) - code := Impl.Pbkdf2.Arm.iterate - contract := Spec.Pbkdf2.iterateSha256Contract Arm.abi - verified := Proof.Pbkdf2.Arm.iterate_verified + doc := Spec.Hmac.sha256I.iterateApi.doc + code := Proof.Pbkdf2.Md.Arm.sha256Md.iterate + contract := Spec.Hmac.sha256I.iterateContract Arm.abi 16 + ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ + writeArgs := true + stack := 16 + verified := Proof.Pbkdf2.Md.Arm.Instances.sha256_iterate spSafe := Code.all_of_forall (fun _ => rfl) _ }, { Spec.Hmac.sha256I.pbkdf2Api with target := Arm.target diff --git a/lean/VerifiedGarbage/Generic/Sha256/X86/Hmac.lean b/lean/VerifiedGarbage/Generic/Sha256/X86/Hmac.lean index f45cd9fb7..dfb33bdff 100644 --- a/lean/VerifiedGarbage/Generic/Sha256/X86/Hmac.lean +++ b/lean/VerifiedGarbage/Generic/Sha256/X86/Hmac.lean @@ -1,29 +1,42 @@ import VerifiedGarbage.TCB.X86.Target import VerifiedGarbage.Proof.Sha256.X86.Variants.Interface -/-! Generic hmac registrations for every x86 SHA-256 backend. -/ +/-! +# 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. +-/ namespace VG.Generic.Sha256.X86.Hmac def artifacts (v : Proof.Sha256.X86.Variants.Backend) : List Artifact := [ - { Spec.Hmac.initSha256Api with - name := Spec.Hmac.initSha256Api.name ++ v.suffix + { Spec.Hmac.sha256I.initApi with + name := Spec.Hmac.sha256I.initApi.name ++ v.suffix target := X86.target - doc := Spec.Hmac.initSha256Api.doc - code := Impl.Hmac.Sha256.X86.init v.cmpN v.cmpC - contract := Spec.Hmac.initSha256Contract X86.abi 20 - stack := 20 - verified := Proof.Hmac.Sha256.X86.Init.verified v.cmp v.cmpSp v.cmpStack v.initCt + doc := Spec.Hmac.sha256I.initApi.doc + code := v.H.init + contract := Spec.Hmac.sha256I.initContract X86.abi 48 + ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.initContract; rfl⟩ + stack := 48 + verified := v.hmacInit spSafe := v.initSp features := v.features }, - { Spec.Hmac.finalizeSha256OutApi with - name := Spec.Hmac.finalizeSha256OutApi.name ++ v.suffix + { Spec.Hmac.sha256I.finalizeApi with + name := Spec.Hmac.sha256I.finalizeApi.name ++ v.suffix target := X86.target - doc := Spec.Hmac.finalizeSha256OutApi.doc - code := Impl.Hmac.Sha256.X86.finalize v.cmpN v.cmpC - contract := Spec.Hmac.finalizeSha256OutContract X86.abi 20 - stack := 20 - verified := Proof.Hmac.Sha256.X86.Finalize.verified v.cmp v.cmpSp v.cmpStack v.finHashSp v.finHashStack v.finCt + doc := Spec.Hmac.sha256I.finalizeApi.doc + code := v.M.hmacFin + contract := Spec.Hmac.sha256I.finalizeContract X86.abi 48 + ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.finalizeContract; rfl⟩ + stack := 48 + verified := v.hmacFin spSafe := v.finSp features := v.features }] diff --git a/lean/VerifiedGarbage/Generic/Sha256/X86/Pbkdf2.lean b/lean/VerifiedGarbage/Generic/Sha256/X86/Pbkdf2.lean index 29c9923c1..2617b6ba4 100644 --- a/lean/VerifiedGarbage/Generic/Sha256/X86/Pbkdf2.lean +++ b/lean/VerifiedGarbage/Generic/Sha256/X86/Pbkdf2.lean @@ -3,32 +3,41 @@ import VerifiedGarbage.Proof.Sha256.X86.Variants.Interface import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.Sha256 /-! -Generic PBKDF2 registrations for every x86 SHA-256 backend: the iteration, -and the whole derivation (`Impl/Pbkdf2/Whole/X86.lean`), which calls the -backend's streaming, HMAC and PBKDF2 functions (`Proof.Pbkdf2.Whole.X86.sha256Fns`). -`stack` is that of the shared contracts: 76 bytes for `pbkdf2`, which pushes -up to 24 bytes of arguments for the functions it calls, and their return -address, and gives them 48. +# PBKDF2-HMAC-SHA-256 (RFC 8018) on x86, for every x86 SHA-256 backend: the iteration and the whole derivation + +The iteration is the one for every Merkle–Damgård hash function +(`Impl/Pbkdf2/Md/X86.lean`): each step is two calls of the backend's +verified compression function, on a block laid out once, word by word, in +`scratch` (`U`, its padding and length), starting from the key's inner and +outer hash values. + +The whole derivation, `pbkdf2`, is the one for every streaming hash function +(`Impl/Pbkdf2/Whole/X86.lean`), calling the backend's streaming functions, +HMAC's `init` and `finalize` and the iteration above, made with the backend. +`stack` is that of the shared contracts: 48 bytes for the iteration, and 76 +for `pbkdf2`, which pushes up to 24 bytes of arguments for the functions it +calls, and their return address, and gives them 48. -/ + namespace VG.Generic.Sha256.X86.Pbkdf2 def artifacts (v : Proof.Sha256.X86.Variants.Backend) : List Artifact := [ - { Spec.Pbkdf2.iterateSha256Api with - name := Spec.Pbkdf2.iterateSha256Api.name ++ v.suffix + { Spec.Hmac.sha256I.iterateApi with + name := Spec.Hmac.sha256I.iterateApi.name ++ v.suffix target := X86.target - doc := Spec.Pbkdf2.iterateSha256Api.doc - code := Impl.Pbkdf2.Sha256.X86.iterate v.cmpN v.cmpC - contract := Spec.Pbkdf2.iterateSha256Contract X86.abi 20 - writeArgs := true - stack := 20 - verified := Proof.Pbkdf2.Sha256.X86.verified v.cmp v.cmpSp v.cmpStack v.iterCt + doc := Spec.Hmac.sha256I.iterateApi.doc + code := v.M.iterate + contract := Spec.Hmac.sha256I.iterateContract X86.abi 48 + ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.iterateContract; rfl⟩ + stack := 48 + verified := v.iterate spSafe := v.iterSp features := v.features }, { Spec.Hmac.sha256I.pbkdf2Api with name := Spec.Hmac.sha256I.pbkdf2Api.name ++ v.suffix target := X86.target doc := Spec.Hmac.sha256I.pbkdf2Api.doc - code := (Proof.Pbkdf2.Whole.X86.sha256FnsOf v).pbkdf2 + code := v.F.pbkdf2 contract := Spec.Hmac.sha256I.pbkdf2Contract X86.abi 76 ofSig := ⟨_, _, _, by unfold Spec.Hmac.Instance.pbkdf2Contract; rfl⟩ stack := 76 diff --git a/lean/VerifiedGarbage/Impl/Hmac/Arm.lean b/lean/VerifiedGarbage/Impl/Hmac/Arm.lean deleted file mode 100644 index 2bd4b4c3e..000000000 --- a/lean/VerifiedGarbage/Impl/Hmac/Arm.lean +++ /dev/null @@ -1,107 +0,0 @@ -import VerifiedGarbage.Impl.Sha256.Arm.Stream - -/-! -# HMAC-SHA-256: 32-bit ARM implementation - -The same algorithm as the generic code of x86-64 and AArch64 -(`VG.Impl.Hmac.Generic.X86_64`, `VG.Impl.Hmac.Generic.AArch64`), for SHA-256 -alone: two SHA-256 streaming states (`inner`, `outer`; see `VG.Spec.Hmac`). - -* `init(inner = r0, outer = r1, key = r2, key_len = r3, scratch = [sp])` - stores `H⁽⁰⁾` in both states, the block `K₀ ⊕ ipad` in the inner buffer - and `K₀ ⊕ opad` in the outer one, and compresses both. -* `finalize(inner = r0, outer = r1, count = r2:r3, out = [sp], - scratch = [sp, #4])` finalizes the inner state (the inlined - `vg_sha256_finalize`, whose stack arguments are ours), writing the inner - digest to `out`; makes the inner state represent `(K₀ ⊕ opad) ‖ digest` - (96 bytes) from the outer hash value and that digest; and finalizes it - again, writing the MAC to `out`. --/ - -namespace VG.Impl.Hmac.Arm - -open VG.Arm -open VG.Impl.Sha256.Arm.Stream (compressAt save restore) - -/-! ## `init` - -As in the streaming SHA-256 `update`, the blocks are compressed by calling -`vg_sha256_compress` (`compressAt`: the block at `r1` into the hash value at -`r0`, with scratch space `r3`), which preserves `r4`–`r11` and never writes -`r0` or `r3`, so our variables live in `r4`–`r9`, and our caller's -`r4`–`r11` and our return address are saved in `scratch[112..148)` -(`Impl.Sha256.Arm.Stream.save`). - -Registers: `r0` = `inner` (then `outer`, for the second compression), `r4` = -`outer`, `r5` = the next key byte, `r6` = key bytes left (then pad bytes -left), `r7` = the byte index, `r8` = `0x36` (`ipad`), `r9` = `0x5c` -(`opad`); `r1`, `r2` and `r12` are temporaries. Byte `r7` of a buffer is -addressed as `[r2, #32]` with `r2 = state + r7`. `scratch` is reloaded from -the stack into `r3` for the compressions. -/ - -/-- `H⁽⁰⁾` into the state at `b`. -/ -def h0 (b : Reg) : List Instr := - (List.range 8).flatMap fun k => - [.movw .r12 (Spec.Sha256.H0[k]!.extractLsb' 0 16), - .movt .r12 (Spec.Sha256.H0[k]!.extractLsb' 16 16), - .str .r12 b (4 * k)] - -/-- The key bytes, XORed with `ipad` into the inner buffer and `opad` into the outer one. -/ -def keyLoop : Prog isa := - .loop (.block [.ldrb .r12 .r5 0, - .dp .eor .r1 .r12 (.reg .r8), .dp .add .r2 .r0 (.reg .r7), .strb .r1 .r2 32, - .dp .eor .r1 .r12 (.reg .r9), .dp .add .r2 .r4 (.reg .r7), .strb .r1 .r2 32, - .dp .add .r5 .r5 (.imm 1), .dp .add .r7 .r7 (.imm 1), .subs .r6 .r6 (.imm 1)]) .ne - -/-- The zero bytes after the key (`r6` of them), XORed likewise. -/ -def padLoop : Prog isa := - .loop (.block [.dp .add .r2 .r0 (.reg .r7), .strb .r8 .r2 32, .dp .add .r2 .r4 (.reg .r7), - .strb .r9 .r2 32, .dp .add .r7 .r7 (.imm 1), .subs .r6 .r6 (.imm 1)]) .ne - -def init : Prog isa := - .seq (.block ([.ldrSp .r12 0] ++ save .r12 ++ [.mov .r4 (.reg .r1), .mov .r5 (.reg .r2), - .mov .r6 (.reg .r3)] ++ h0 .r0 ++ h0 .r4 ++ - [.mov .r8 (.imm 0x36), .mov .r9 (.imm 0x5c), .mov .r7 (.imm 0), .cmp .r6 (.imm 0)])) - (.seq (.ite .eq (.block []) keyLoop) - (.seq (.block [.mov .r6 (.imm 64), .subs .r6 .r6 (.reg .r7)]) - (.seq (.ite .eq (.block []) padLoop) - (.seq (.block [.ldrSp .r3 0, .dp .add .r1 .r0 (.imm 32)]) - (.seq compressAt - (.seq (.block [.mov .r0 (.reg .r4), .dp .add .r1 .r0 (.imm 32)]) - (.seq compressAt - (.block restore)))))))) - -/-! ## `finalize` - -The inlined finalization (which calls `vg_sha256_compress`) never writes -`r0`, saves and restores `r4`–`r11` and `lr` itself, and only writes -`inner`, `out` and `scratch[0..160)`; we use no callee-saved register. -(Calling `vg_sha256_finalize` instead would take a stack frame for its -stack arguments, which the ARMv7 taint analysis does not support yet.) The outer hash value is first copied to -`scratch[160..192)` (with `r2`, the low word of `count`, spilled to -`scratch[192..196)` to free a temporary); after the first finalization, it -and the digest (from `out`) are copied into the inner state, so that it -represents `(K₀ ⊕ opad) ‖ digest`, and `count` is set to 96. -/ - -/-- Copying 32-bit word `k` from `[src + o₁]` to `[dst + o₂]`, through `t`. -/ -def cp (t src dst : Reg) (o₁ o₂ k : Nat) : List Instr := - [.ldr t src (o₁ + 4 * k), .str t dst (o₂ + 4 * k)] - -/-- The outer hash value into `scratch[160..192)`. -/ -def saveOuter : List Instr := - [.ldrSp .r12 4, .str .r2 .r12 192] ++ (List.range 8).flatMap (cp .r2 .r1 .r12 0 160) ++ - [.ldr .r2 .r12 192] - -/-- The outer hash value and the first digest into the inner state, and -`count = 96`. -/ -def loadOuter : List Instr := - [.ldrSp .r1 4, .ldrSp .r12 0] ++ (List.range 8).flatMap (cp .r3 .r1 .r0 160 0) ++ - (List.range 8).flatMap (cp .r3 .r12 .r0 0 32) ++ [.mov .r2 (.imm 96), .mov .r3 (.imm 0)] - -def finalize : Prog isa := - .seq (.block saveOuter) - (.seq Impl.Sha256.Arm.Stream.finalize - (.seq (.block loadOuter) - Impl.Sha256.Arm.Stream.finalize)) - -end VG.Impl.Hmac.Arm diff --git a/lean/VerifiedGarbage/Impl/Hmac/Sha256/X86.lean b/lean/VerifiedGarbage/Impl/Hmac/Sha256/X86.lean deleted file mode 100644 index 9357f2088..000000000 --- a/lean/VerifiedGarbage/Impl/Hmac/Sha256/X86.lean +++ /dev/null @@ -1,48 +0,0 @@ -import VerifiedGarbage.Impl.Hmac.X86 -import VerifiedGarbage.Impl.MdStream.X86 - -/-! SHA-256's efficient x86 HMAC bodies, generic over compression. -/ -namespace VG.Impl.Hmac.Sha256.X86 -open VG.X86 -open VG.Impl.Sha256.X86 (at_) -open VG.Impl.Sha256.X86.Stream (save restore) -open VG.Impl.Hmac.X86 (h0 keyLoop padLoop opadWord bswapWord copyWord padWords) - -def compressBuf (name : String) (code : Prog isa) (b : Reg) : Prog isa := - .seq (.block [.mov .eax (.reg b), .alu .add .eax (.imm 32)]) (Impl.MdStream.X86.compressAt name code b .ebp) - -def init (name : String) (code : Prog isa) : Prog isa := - .seq (.block ([.mov .eax (.mem (at_ .esp 20))] ++ save .eax ++ - [.mov .ebp (.reg .eax), .mov .ebx (.mem (at_ .esp 4)), .mov .esi (.mem (at_ .esp 8))] ++ - h0 .ebx ++ h0 .esi ++ - [.mov .edi (.mem (at_ .esp 12)), .mov .ecx (.mem (at_ .esp 16)), .mov .edx (.reg .ebx), - .alu .add .edx (.imm 32), .alu .test .ecx (.reg .ecx)])) - (.seq (.ite .e (.block []) keyLoop) - (.seq (.block [.mov .eax (.reg .ebx), .alu .add .eax (.imm 96), .mov .ecx (.imm 0x36), - .alu .cmp .edx (.reg .eax)]) - (.seq (.ite .e (.block []) padLoop) - (.seq (.block ((List.range 16).flatMap opadWord)) - (.seq (compressBuf name code .ebx) - (.seq (compressBuf name code .esi) - (.block (.mov .eax (.reg .ebp) :: restore .eax)))))))) - -def finalizeHash (name : String) (code : Prog isa) : Prog isa := - match Impl.MdStream.X86.finalize Impl.Sha256.X86.Stream.params name code with - | .seq a (.seq b (.seq c _)) => .seq a (.seq b c) - | p => p - -def finalize (name : String) (code : Prog isa) : Prog isa := - .seq (.block [.mov .edx (.mem (at_ .esp 24)), .mov .ecx (.mem (at_ .esp 8)), .store (at_ .edx 176) .ecx, - .mov .ecx (.mem (at_ .esp 12)), .store (at_ .esp 8) .ecx, - .mov .ecx (.mem (at_ .esp 16)), .store (at_ .esp 12) .ecx, - .mov .ecx (.mem (at_ .esp 20)), .store (at_ .esp 16) .ecx, .store (at_ .esp 20) .edx]) - (.seq (finalizeHash name code) - -- The inner digest into the inner buffer, and the outer hash value into the inner state. - (.seq (.block ((List.range 8).flatMap (bswapWord .ebx .ebx 0 32) ++ .mov .edx (.mem (at_ .ebp 176)) :: - (List.range 8).flatMap (copyWord .edx .ebx 0 0) ++ padWords ++ - [.mov .eax (.reg .ebx), .alu .add .eax (.imm 32)])) - (.seq (Impl.MdStream.X86.compressAt name code .ebx .ebp) - (.block (.mov .eax (.mem (at_ .ebp 136)) :: (List.range 8).flatMap (bswapWord .ebx .eax 0 0) ++ - .mov .eax (.reg .ebp) :: restore .eax))))) - -end VG.Impl.Hmac.Sha256.X86 diff --git a/lean/VerifiedGarbage/Impl/Hmac/X86.lean b/lean/VerifiedGarbage/Impl/Hmac/X86.lean deleted file mode 100644 index 92191e7af..000000000 --- a/lean/VerifiedGarbage/Impl/Hmac/X86.lean +++ /dev/null @@ -1,133 +0,0 @@ -import VerifiedGarbage.Impl.Sha256.X86.Stream - -/-! -# HMAC-SHA-256: x86 (32-bit) implementation - -Two SHA-256 streaming states (`inner`, `outer`; see `VG.Spec.Hmac`). Every -argument is on the stack (cdecl). - -* `init(inner, outer, key, key_len, scratch)` stores `H⁽⁰⁾` in both states, - the block `K₀ ⊕ ipad` in the inner buffer and `K₀ ⊕ opad` (computed from it - a word at a time, as `(K₀ ⊕ ipad) ⊕ (ipad ⊕ opad)`) in the outer one, and - compresses both, calling `vg_sha256_compress`. -* `finalize(inner, outer, count, out, scratch)` computes the inner hash - value with the code of `vg_sha256_finalize` up to writing the digest, then - the outer hash, of `(K₀ ⊕ opad) ‖ digest`, as one compression of a block - laid out at known offsets, and writes it to `out`. - -The compression function is called as in the streaming functions (with the -20 bytes below `esp` for its frame of arguments and its return address), and -preserves `ebx`, `esi`, `edi`, `ebp`, so our variables live there; our -caller's are saved in `scratch[112..128)`, as in the streaming functions. - -The constant-time analysis follows pointers through memory only while they -are the base address of a writable region, and forgets which words of memory -are public after a store of a secret at an unknown address. So every store -of a key byte goes through a register that is not needed afterwards, and -every pointer needed afterwards is kept in a register. --/ - -namespace VG.Impl.Hmac.X86 - -open VG.X86 -open VG.Impl.Sha256.X86 (at_) -open VG.Impl.Sha256.X86.Stream (compressAt save restore) - -/-! ## `init` - -Registers: `ebx` = `inner`, `esi` = `outer`, `ebp` = `scratch`; in the -loops, `edi` = the next key byte, `edx` = where it goes in the inner buffer, -`ecx` = the key bytes left (then `ipad`), `eax` = the byte (then the end of -the inner buffer). -/ - -/-- `H⁽⁰⁾` into the state at `b`. -/ -def h0 (b : Reg) : List Instr := - (List.range 8).flatMap fun k => [.mov .ecx (.imm Spec.Sha256.H0[k]!), .store (at_ b (4 * k)) .ecx] - -/-- The key bytes, XORed with `ipad`, into the inner 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 - -/-- `ipad` up to the end of the inner buffer. -/ -def padLoop : Prog isa := - .loop (.block [.store8 (at_ .edx 0) .cl, .alu .add .edx (.imm 1), .alu .cmp .edx (.reg .eax)]) .ne - -/-- Word `k` of the outer buffer, from word `k` of the inner one. -/ -def opadWord (k : Nat) : List Instr := - [.mov .eax (.mem (at_ .ebx (32 + 4 * k))), .alu .xor .eax (.imm 0x6a6a6a6a), - .store (at_ .esi (32 + 4 * k)) .eax] - -/-- Compress the buffer of the state at `b` into its hash value. -/ -def compressBuf (b : Reg) : Prog isa := - .seq (.block [.mov .eax (.reg b), .alu .add .eax (.imm 32)]) (compressAt b .ebp) - -def init : Prog isa := - .seq (.block ([.mov .eax (.mem (at_ .esp 20))] ++ save .eax ++ - [.mov .ebp (.reg .eax), .mov .ebx (.mem (at_ .esp 4)), .mov .esi (.mem (at_ .esp 8))] ++ - h0 .ebx ++ h0 .esi ++ - [.mov .edi (.mem (at_ .esp 12)), .mov .ecx (.mem (at_ .esp 16)), .mov .edx (.reg .ebx), - .alu .add .edx (.imm 32), .alu .test .ecx (.reg .ecx)])) - (.seq (.ite .e (.block []) keyLoop) - (.seq (.block [.mov .eax (.reg .ebx), .alu .add .eax (.imm 96), .mov .ecx (.imm 0x36), - .alu .cmp .edx (.reg .eax)]) - (.seq (.ite .e (.block []) padLoop) - (.seq (.block ((List.range 16).flatMap opadWord)) - (.seq (compressBuf .ebx) - (.seq (compressBuf .esi) - (.block (.mov .eax (.reg .ebp) :: restore .eax)))))))) - -/-! ## `finalize` - -`vg_sha256_finalize` (`Impl.Sha256.X86.Stream.finalize`) is used up to -writing the digest (`finalizeHash`), with our arguments rearranged into its -`(state, count lo, count hi, out, scratch)`: it saves our caller's -`ebx, esi, edi, ebp` in `scratch[112..128)` (we have not changed them yet) -and `out` in `scratch[136]`, and leaves the inner hash value in the inner -state, `inner` in `ebx` and `scratch` in `ebp`. The address of `outer` is -kept in `scratch[176]`. - -The outer hash, of the 96 bytes `(K₀ ⊕ opad) ‖ digest`, is then a single -compression of a block laid out at known offsets: the inner state gets the -outer hash value and, in its buffer, the digest (big-endian), `0x80`, zeros -and the length in bits (768, big-endian). Its hash value is the MAC, -written big-endian to `out` last. (The constant-time analysis loses track of -which words in memory are public once the padding of `finalizeHash` is -written at a variable address, but the registers holding `inner` and -`scratch` stay known.) -/ - -/-- `vg_sha256_finalize` up to writing the digest. -/ -def finalizeHash : Prog isa := - match Impl.Sha256.X86.Stream.finalize with - | .seq a (.seq b (.seq c _)) => .seq a (.seq b c) - | p => p - -/-- Word `k` from `[src + o₁]` to `[dst + o₂]`, byte-swapped. -/ -def bswapWord (src dst : Reg) (o₁ o₂ k : Nat) : List Instr := - [.mov .ecx (.mem (at_ src (o₁ + 4 * k))), .bswap .ecx, .store (at_ dst (o₂ + 4 * k)) .ecx] - -/-- Word `k` from `[src + o₁]` to `[dst + o₂]`. -/ -def copyWord (src dst : Reg) (o₁ o₂ k : Nat) : List Instr := - [.mov .ecx (.mem (at_ src (o₁ + 4 * k))), .store (at_ dst (o₂ + 4 * k)) .ecx] - -/-- The rest of the block: `0x80`, zeros, and the length in bits, 768, big-endian. -/ -def padWords : List Instr := - [.mov .ecx (.imm 0x80), .store (at_ .ebx 64) .ecx, .mov .ecx (.imm 0)] ++ - (List.range 6).map (fun k => .store (at_ .ebx (68 + 4 * k)) .ecx) ++ - [.mov .ecx (.imm 0x00030000), .store (at_ .ebx 92) .ecx] - -def finalize : Prog isa := - .seq (.block [.mov .edx (.mem (at_ .esp 24)), .mov .ecx (.mem (at_ .esp 8)), .store (at_ .edx 176) .ecx, - .mov .ecx (.mem (at_ .esp 12)), .store (at_ .esp 8) .ecx, - .mov .ecx (.mem (at_ .esp 16)), .store (at_ .esp 12) .ecx, - .mov .ecx (.mem (at_ .esp 20)), .store (at_ .esp 16) .ecx, .store (at_ .esp 20) .edx]) - (.seq finalizeHash - -- The inner digest into the inner buffer, and the outer hash value into the inner state. - (.seq (.block ((List.range 8).flatMap (bswapWord .ebx .ebx 0 32) ++ .mov .edx (.mem (at_ .ebp 176)) :: - (List.range 8).flatMap (copyWord .edx .ebx 0 0) ++ padWords ++ - [.mov .eax (.reg .ebx), .alu .add .eax (.imm 32)])) - (.seq (compressAt .ebx .ebp) - (.block (.mov .eax (.mem (at_ .ebp 136)) :: (List.range 8).flatMap (bswapWord .ebx .eax 0 0) ++ - .mov .eax (.reg .ebp) :: restore .eax))))) - -end VG.Impl.Hmac.X86 diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Arm.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Arm.lean deleted file mode 100644 index 6fc4c3840..000000000 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Arm.lean +++ /dev/null @@ -1,91 +0,0 @@ -import VerifiedGarbage.Impl.Hmac.Arm - -/-! -# PBKDF2-HMAC-SHA-256's iteration: 32-bit ARM implementation - -`iterate(key = r0, u = r1, n = r2, t = r3, scratch = [sp])` 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 + 96`. - -The same design as on x86-64 and AArch64 (`VG.Impl.Pbkdf2.X86_64`, -`VG.Impl.Pbkdf2.AArch64`): the inner and outer states have each absorbed one -block, so HMAC-SHA-256 of the 32-byte `U` is two compressions (calls of -`vg_sha256_compress`, through the streaming code's `compressAt`), each of one -block that is 32 bytes of message followed by the padding of a 96-byte -message. - -`vg_sha256_compress` saves its callee-saved registers in its scratch space -and restores them, and the taint analysis only tracks memory at known offsets -from the base of a writable region. So the hash value being compressed is -`t` itself (the base of a writable region, in `r0`) and the compression's -scratch space is the start of `scratch` (in `r3`), while `T` is kept in -`scratch` and copied back to `t` at the end. `scratch` holds the -compression's scratch space (`[0..112)`), our caller's `r4`–`r11` and our -return address (`[112..148)`, where the streaming code's `save` and -`restore` keep them), `T` (`[160..192)`) and the block (`[192..256)`: the -32 bytes of message, then the padding, written once). So the function uses -no stack. - -`vg_sha256_compress` never writes `r0` or `r3` and preserves `r4`–`r11`, so -`t` stays in `r0` and `scratch` in `r3`, and our other variables live in -`r4` (`key`) and `r5` (the steps left); `r1` and `r12` are temporaries. --/ - -namespace VG.Impl.Pbkdf2.Arm - -open VG.Arm -open VG.Impl.Sha256.Arm.Stream (save restore compressAt) -open VG.Impl.Hmac.Arm (cp) - -/-- The padding of a 96-byte message, after 32 bytes of it, in `scratch[224..256)`: -`0x80`, zeros, and the length in bits (768), big-endian. -/ -def padding : List Instr := - [.mov .r12 (.imm 0x80), .str .r12 .r3 224, .mov .r12 (.imm 0), .str .r12 .r3 228, - .str .r12 .r3 232, .str .r12 .r3 236, .str .r12 .r3 240, .str .r12 .r3 244, .str .r12 .r3 248, - .mov .r12 (.imm 0x30000), .str .r12 .r3 252] - -/-- The hash value at `[r4 + o]` into `t` (at `r0`). -/ -def load (o : Nat) : List Instr := (List.range 8).flatMap (cp .r12 .r4 .r0 o 0) - -/-- Word `k` of the digest (the hash value's words, big-endian) into the block. -/ -def outW (k : Nat) : List Instr := - [.ldr .r12 .r0 (4 * k), .rev .r12 .r12, .str .r12 .r3 (192 + 4 * k)] - -/-- The digest into the block's first 32 bytes. -/ -def digest : List Instr := (List.range 8).flatMap outW - -/-- `T ← T ⊕ U` for 32-bit word `k`, with `T` in `scratch[160..192)` and `U` -the block's first 32 bytes. -/ -def xorW (k : Nat) : List Instr := - [.ldr .r12 .r3 (160 + 4 * k), .ldr .r1 .r3 (192 + 4 * k), .dp .eor .r12 .r12 (.reg .r1), - .str .r12 .r3 (160 + 4 * k)] - -/-- Pointing `r1` at the block, for `compressAt`. -/ -def atBlock : Instr := .dp .add .r1 .r3 (.imm 192) - -/-- One step. -/ -def body : Prog isa := - .seq (.block (load 0 ++ [atBlock])) - (.seq compressAt - (.seq (.block (digest ++ load 96 ++ [atBlock])) - (.seq compressAt - (.block (digest ++ (List.range 8).flatMap xorW ++ [.subs .r5 .r5 (.imm 1)]))))) - -/-- Saving our caller's registers and our return address, setting up our -registers, and writing `U` and the padding into the block and `T` into -`scratch`. -/ -def prologue : List Instr := - [.ldrSp .r12 0] ++ save .r12 ++ - [.mov .r4 (.reg .r0), .mov .r0 (.reg .r3), .mov .r3 (.reg .r12), .mov .r5 (.reg .r2)] ++ - (List.range 8).flatMap (cp .r12 .r1 .r3 0 192) ++ (List.range 8).flatMap (cp .r12 .r0 .r3 0 160) ++ - padding ++ [.cmp .r5 (.imm 0)] - -/-- `T` back into `t`, and restoring our return address and our caller's registers. -/ -def epilogue : List Instr := (List.range 8).flatMap (cp .r12 .r3 .r0 160 0) ++ restore - -def iterate : Prog isa := - .seq (.block prologue) - (.seq (.ite .eq (.block []) (.loop body .ne)) - (.block epilogue)) - -end VG.Impl.Pbkdf2.Arm diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean index 59d7f0fb2..b2fbef190 100644 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean @@ -7,7 +7,7 @@ import VerifiedGarbage.Impl.MdStream.Arm 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 and the SHA-512 family), calling its compression function directly +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 block size `B`, the digest size `D` and their working space), the size `N` diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean index 7a3658b4c..5b3c06900 100644 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean @@ -6,8 +6,8 @@ import VerifiedGarbage.Impl.MdStream.X86 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: `Impl/MdStream/X86.lean`) or 128 -(the SHA-512 family: `Impl/Sha512/X86/Stream.lean`). A `Hash` is what the +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 diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Sha256/X86.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Sha256/X86.lean deleted file mode 100644 index 1ac84a977..000000000 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Sha256/X86.lean +++ /dev/null @@ -1,20 +0,0 @@ -import VerifiedGarbage.Impl.Pbkdf2.X86 -import VerifiedGarbage.Impl.MdStream.X86 - -/-! PBKDF2-SHA-256's two-compression iteration, generic over compression. -/ -namespace VG.Impl.Pbkdf2.Sha256.X86 -open VG.X86 -open VG.Impl.Pbkdf2.X86 (load atBlock digest xorW prologue epilogue) - -def body (name : String) (code : Prog isa) : Prog isa := - .seq (.block (load 0 ++ atBlock)) - (.seq (Impl.MdStream.X86.compressAt name code .ebx .ebp) - (.seq (.block (digest ++ load 96 ++ atBlock)) - (.seq (Impl.MdStream.X86.compressAt name code .ebx .ebp) - (.block (digest ++ (List.range 8).flatMap xorW ++ [.alu .sub .edi (.imm 1)]))))) - -def iterate (name : String) (code : Prog isa) : Prog isa := - .seq (.block prologue) - (.seq (.ite .e (.block []) (.loop (body name code) .ne)) (.block epilogue)) - -end VG.Impl.Pbkdf2.Sha256.X86 diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/X86.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/X86.lean deleted file mode 100644 index 97f274a46..000000000 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/X86.lean +++ /dev/null @@ -1,84 +0,0 @@ -import VerifiedGarbage.Impl.Hmac.X86 - -/-! -# PBKDF2-HMAC-SHA-256's iteration: x86 (32-bit) implementation - -`iterate(key, u, n, t, scratch)`, every argument on the stack (cdecl), 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 + 96`. - -The same design as on the other targets (`VG.Impl.Pbkdf2.Arm`): the inner -and outer states have each absorbed one block, so HMAC-SHA-256 of the -32-byte `U` is two compressions (calls of `vg_sha256_compress`, through the -streaming code's `compressAt`), each of one block that is 32 bytes of -message followed by the padding of a 96-byte message. - -The hash value being compressed is `t` itself, and `T` is kept in `scratch` -and copied back to `t` at the end. `scratch` holds the compression's scratch -space (`[0..112)`), our caller's `ebx`, `esi`, `edi`, `ebp` -(`[112..128)`, where the streaming code's `save` and `restore` keep them), -`T` (`[160..192)`) and the block (`[192..256)`: the 32 bytes of message, -then the padding, written once). The compression function preserves `ebx`, -`esi`, `edi` and `ebp`, so our variables live there: `ebx` = `t`, `ebp` = -`scratch`, `esi` = `key` and `edi` = the steps left; `eax`, `ecx` and `edx` -are temporaries. Each call uses the 20 bytes below `esp`, for its frame of -arguments and its return address. Every address and branch depends only on -`esp`, the pointers and `n`. --/ - -namespace VG.Impl.Pbkdf2.X86 - -open VG.X86 -open VG.Impl.Sha256.X86 (at_) -open VG.Impl.Sha256.X86.Stream (save restore compressAt) -open VG.Impl.Hmac.X86 (bswapWord copyWord) - -/-- The padding of a 96-byte message, after 32 bytes of it, in `scratch[224..256)`: -`0x80`, zeros, and the length in bits (768), big-endian. -/ -def padding : List Instr := - [.mov .ecx (.imm 0x80), .store (at_ .ebp 224) .ecx, .mov .ecx (.imm 0)] ++ - (List.range 6).map (fun k => .store (at_ .ebp (228 + 4 * k)) .ecx) ++ - [.mov .ecx (.imm 0x00030000), .store (at_ .ebp 252) .ecx] - -/-- The hash value at `[esi + o]` into `t` (at `ebx`). -/ -def load (o : Nat) : List Instr := (List.range 8).flatMap (copyWord .esi .ebx o 0) - -/-- The digest (the hash value's words, big-endian) into the block's first 32 bytes. -/ -def digest : List Instr := (List.range 8).flatMap (bswapWord .ebx .ebp 0 192) - -/-- `T ← T ⊕ U` for 32-bit word `k`, with `T` in `scratch[160..192)` and `U` -the block's first 32 bytes. -/ -def xorW (k : Nat) : List Instr := - [.mov .ecx (.mem (at_ .ebp (160 + 4 * k))), .alu .xor .ecx (.mem (at_ .ebp (192 + 4 * k))), - .store (at_ .ebp (160 + 4 * k)) .ecx] - -/-- Pointing `eax` at the block, for `compressAt`. -/ -def atBlock : List Instr := [.mov .eax (.reg .ebp), .alu .add .eax (.imm 192)] - -/-- One step. -/ -def body : Prog isa := - .seq (.block (load 0 ++ atBlock)) - (.seq (compressAt .ebx .ebp) - (.seq (.block (digest ++ load 96 ++ atBlock)) - (.seq (compressAt .ebx .ebp) - (.block (digest ++ (List.range 8).flatMap xorW ++ [.alu .sub .edi (.imm 1)]))))) - -/-- Saving our caller's registers, setting up ours, and writing `U` and the -padding into the block and `T` into `scratch`. -/ -def prologue : List Instr := - [.mov .eax (.mem (at_ .esp 20))] ++ save .eax ++ - [.mov .ebp (.reg .eax), .mov .esi (.mem (at_ .esp 4)), .mov .edi (.mem (at_ .esp 12)), - .mov .ebx (.mem (at_ .esp 16)), .mov .edx (.mem (at_ .esp 8))] ++ - (List.range 8).flatMap (copyWord .edx .ebp 0 192) ++ (List.range 8).flatMap (copyWord .ebx .ebp 0 160) ++ - padding ++ [.alu .test .edi (.reg .edi)] - -/-- `T` back into `t`, and restoring our caller's registers. -/ -def epilogue : List Instr := - (List.range 8).flatMap (copyWord .ebp .ebx 160 0) ++ .mov .eax (.reg .ebp) :: restore .eax - -def iterate : Prog isa := - .seq (.block prologue) - (.seq (.ite .e (.block []) (.loop body .ne)) - (.block epilogue)) - -end VG.Impl.Pbkdf2.X86 diff --git a/lean/VerifiedGarbage/Proof/Framework/TaintWeaken.lean b/lean/VerifiedGarbage/Proof/Framework/TaintWeaken.lean deleted file mode 100644 index 6330cb1f7..000000000 --- a/lean/VerifiedGarbage/Proof/Framework/TaintWeaken.lean +++ /dev/null @@ -1,88 +0,0 @@ -import VerifiedGarbage.Proof.Framework.Taint - -/-! -# Hints that forget what the rest of the code does not need - -This only computes hints, which `Taint.check` checks. - -`taint_decide_weak w` weakens the taints of a hint computed without `w`: it -can forget facts about memory, but not what the analysis derives from them -afterwards (a register loaded from a forgotten public word is still public -at the next hint), so `check` rejects the hint as soon as that happens. -`taint_decide_weaken w` instead weakens as it analyses: at every point where -the hint records a taint (every `chunk` instructions of a block, between the -parts of a `seq`, and each loop's invariant) the analysis continues from `w` -of it. The kernel's check then evaluates every instruction with the smaller -taints (e.g. without the public memory slots that only the caller's code -reads, inside a callee of thousands of instructions). A `w` that forgets too -much only makes the check fail. --/ - -namespace VG.Taint - -variable {M : ISA} (A : Taint M) (w : A.T → A.T) - -/-- The hints for a block, weakened by `w`: the analysis after every `chunk` -instructions but the last, each continuing from the previous hint. -/ -def chunkHintsW : A.T → List M.Instr → Nat → List A.T - | _, _, 0 => [] - | τ, is, n + 1 => - if is.length ≤ chunk then [] else - match A.checkBlock τ (is.take chunk) with - | some τ' => w τ' :: chunkHintsW (w τ') (is.drop chunk) n - | none => [] - -/-- `hint`, continuing from `w` of every taint it records. -/ -def hintW : A.T → Prog M → Option (A.T × Hint A.T) - | τ, .block is => - let ms := chunkHintsW A w τ is is.length - (A.checkBlock (ms.getLast?.getD τ) (is.drop (chunk * ms.length))).map fun τ' => (τ', .block ms) - | τ, .seq c₁ c₂ => - (hintW τ c₁).bind fun (τ₁, h₁) => (hintW (w τ₁) c₂).map fun (τ₂, h₂) => (τ₂, .seq (w τ₁) h₁ h₂) - | τ, .ite _ t e => - (hintW τ t).bind fun (τ₁, h₁) => (hintW τ e).map fun (τ₂, h₂) => (A.meet τ₁ τ₂, .ite h₁ h₂) - | τ, .loop body c => go c (hintW · body) loopFuel (w τ) - | τ, .call _ body => - (A.call τ).bind fun τ₁ => (hintW τ₁ body).bind fun (τ₂, h) => (A.ret τ₂).map (·, .call h) - | τ, .frame i body j => - (A.push τ i).bind fun τ₁ => (hintW τ₁ body).bind fun (τ₂, h) => (A.pop τ₂ j).map (·, .frame h) -where - go (c : M.Cond) (body : A.T → Option (A.T × Hint A.T)) : - Nat → A.T → Option (A.T × Hint A.T) - | 0, _ => none - | n + 1, σ => (body σ).bind fun (σ', h) => - if A.le σ σ' && A.condPub σ' c then some (σ', .loop σ h) else go c body n (w (A.meet σ σ')) - -/-- The hint for `c` from `τ`, weakened by `w` (any hint, if the analysis fails). -/ -def hintWOf (τ : A.T) (c : Prog M) : Hint A.T := ((hintW A w τ c).map (·.2)).getD (.block []) - -end VG.Taint - -namespace VG - -open Lean Meta Elab Tactic in -/-- Proves `(Taint.check A τ c ?hint).isSome = true` (or any decidable -equation whose left side contains `Taint.check A τ c ?hint`), like -`taint_decide`, with the hint computed by `Taint.hintW A w`: the analysis -forgets, at every point the hint records, what `w : A.T → A.T` forgets. -/ -elab "taint_decide_weaken " wt:term : tactic => do - let g ← getMainGoal - let some (_, lhs, _) := (← instantiateMVars (← g.getType)).eq? - | throwError "taint_decide_weaken: the goal is not an equation about `Taint.check A τ c h`" - let some chk := lhs.find? (·.isAppOfArity ``Taint.check 5) - | throwError "taint_decide_weaken: the goal is not an equation about `Taint.check A τ c h`" - let args := chk.getAppArgs - let (m, a, τ, c, h) := (args[0]!, args[1]!, args[2]!, args[3]!, args[4]!) - unless h.isMVar do throwError "taint_decide_weaken: the hint is already given" - let tT ← whnfD (mkApp2 (mkConst ``Taint.T) m a) - let hty := mkApp (mkConst ``Taint.Hint) tT - let inst ← synthInstance (mkApp (mkConst ``ToExpr [0]) hty) - let wv ← Term.elabTermEnsuringType wt (← mkArrow tT tT) - Term.synthesizeSyntheticMVarsNoPostponing - let hint := mkApp5 (mkConst ``Taint.hintWOf) m a (← instantiateMVars wv) τ c - let hv ← unsafe evalExpr Expr (mkConst ``Expr) (mkApp3 (mkConst ``ToExpr.toExpr [0]) hty inst hint) - h.mvarId!.assign hv - -- The kernel evaluates the literal of any code that has one (`materialize_code`). - evalTactic (← `(tactic| lit_decide)) - -end VG diff --git a/lean/VerifiedGarbage/Proof/Hmac/Arm/Common.lean b/lean/VerifiedGarbage/Proof/Hmac/Arm/Common.lean deleted file mode 100644 index 18bc4c1d9..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Arm/Common.lean +++ /dev/null @@ -1,150 +0,0 @@ -import VerifiedGarbage.Proof.Sha256.Arm.Stream.Md -import VerifiedGarbage.Proof.Sha256.Arm.Stream.Common -import VerifiedGarbage.Proof.Hmac.Common -import VerifiedGarbage.Impl.Hmac.Arm -import VerifiedGarbage.Spec.Hmac -import VerifiedGarbage.Proof.Sha256.Arm.Contract -import VerifiedGarbage.Proof.Hmac.Arm.Lit -import VerifiedGarbage.Proof.Framework.OmegaLit - -/-! -# HMAC-SHA-256 on ARMv7: common lemmas - -Words copied between memory regions; the memory lemmas themselves are -target-independent and shared by every target (`VG.Proof.Hmac.Common`). --/ - -namespace VG.Proof.Hmac - -open Spec.Hmac -open Spec.Sha256 (Repr bytesAt) - -open VG.Arm in -/-- 32-bit ARM contract for `vg_hmac_sha256_init(inner: *mut [u8; 96], outer: -*mut [u8; 96], key: *const u8, key_len: usize, scratch: *mut [u64; 20])`, for a -key of at most 64 bytes (the SHA-256 block size): makes the streaming state at -`inner` represent `K₀ ⊕ ipad` and the one at `outer` represent `K₀ ⊕ opad`, for -the key `K₀` made of the `key_len` bytes at `key`. - -Under AAPCS, `inner`, `outer`, `key` and `key_len` are in `r0`–`r3`, and -`scratch` is the stack argument 0. The code may read that argument (4 bytes -at `sp`) and `key` (`key_len` bytes), and read and write `inner` and `outer` -(96 bytes each) and `scratch` (160 bytes, whose contents on exit are -unspecified). The writable buffers may not overlap each other, the key or -the argument; and nothing may wrap around the end of the (32-bit) address -space. `sp`, the pointers and `key_len` are public; the key is secret. -/ -def initSha256Arm : Contract Arm.isa where - pre s := - let inner : Region := ⟨State.addr (s.gpr .r0), 96⟩ - let outer : Region := ⟨State.addr (s.gpr .r1), 96⟩ - let key : Region := ⟨State.addr (s.gpr .r2), (s.gpr .r3).toNat⟩ - let scratch : Region := ⟨State.addr (stackArg s 0), 160⟩ - let args : Region := ⟨stackArgAddr s 0, 4⟩ - (s.gpr .r3).toNat ≤ 64 ∧ s.rd = [key, args] ∧ s.wr = [inner, outer, scratch] ∧ - inner.Disjoint outer ∧ inner.Disjoint scratch ∧ outer.Disjoint scratch ∧ - key.Disjoint inner ∧ key.Disjoint outer ∧ key.Disjoint scratch ∧ - args.Disjoint inner ∧ args.Disjoint outer ∧ args.Disjoint scratch ∧ - (s.gpr .r0).toNat + 96 ≤ 2 ^ 32 ∧ (s.gpr .r1).toNat + 96 ≤ 2 ^ 32 ∧ - (s.gpr .r2).toNat + (s.gpr .r3).toNat ≤ 2 ^ 32 ∧ (stackArg s 0).toNat + 160 ≤ 2 ^ 32 ∧ - s.sp.toNat + 4 ≤ 2 ^ 32 - post s s' := - let k0 := blockKey sha256 (bytesAt s.mem (State.addr (s.gpr .r2)) (s.gpr .r3).toNat) - Repr s'.mem (State.addr (s.gpr .r0)) (xorPad k0 ipad) ∧ - Repr s'.mem (State.addr (s.gpr .r1)) (xorPad k0 opad) - pub s₁ s₂ := - 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 - -open VG.Arm in -/-- 32-bit ARM contract for `vg_hmac_sha256_finalize(inner: *mut [u8; 96], -outer: *const [u8; 96], count: u64, out: *mut [u8; 32], scratch: *mut [u64; -30])`: if, for a 64-byte key `K₀` and a text, the streaming state at `inner` -represents `(K₀ ⊕ ipad) ‖ text`, of `count` bytes (modulo 2⁶⁴), and the one at -`outer` represents `K₀ ⊕ opad`, writes the HMAC-SHA-256 of the text under `K₀` -to `out`. - -Under AAPCS, `inner` and `outer` are in `r0` and `r1`, `count` in `r2:r3`, -and `out` and `scratch` are the stack arguments 0 and 1. The code may read -those arguments (8 bytes at `sp`) and `outer` (96 bytes), and read and write -`inner` (96 bytes, whose contents on exit are unspecified), `out` (32 bytes) -and `scratch` (240 bytes, whose contents on exit are unspecified). The -writable buffers may not overlap each other, `outer` or the arguments; and -nothing may wrap around the end of the (32-bit) address space. `sp`, the -pointers and `count` are public; the states are secret. -/ -def finalizeSha256Arm : Contract Arm.isa where - pre s := - let inner : Region := ⟨State.addr (s.gpr .r0), 96⟩ - let outer : Region := ⟨State.addr (s.gpr .r1), 96⟩ - let out : Region := ⟨State.addr (stackArg s 0), 32⟩ - let scratch : Region := ⟨State.addr (stackArg s 1), 240⟩ - let args : Region := ⟨stackArgAddr s 0, 8⟩ - s.rd = [outer, args] ∧ s.wr = [inner, out, scratch] ∧ - inner.Disjoint out ∧ inner.Disjoint scratch ∧ out.Disjoint scratch ∧ - outer.Disjoint inner ∧ outer.Disjoint out ∧ outer.Disjoint scratch ∧ - args.Disjoint inner ∧ args.Disjoint out ∧ args.Disjoint scratch ∧ - (s.gpr .r0).toNat + 96 ≤ 2 ^ 32 ∧ (s.gpr .r1).toNat + 96 ≤ 2 ^ 32 ∧ - (stackArg s 0).toNat + 32 ≤ 2 ^ 32 ∧ (stackArg s 1).toNat + 240 ≤ 2 ^ 32 ∧ - s.sp.toNat + 8 ≤ 2 ^ 32 - post s s' := ∀ k0 text, k0.length = 64 → - Repr s.mem (State.addr (s.gpr .r0)) (xorPad k0 ipad ++ text) → - Proof.Sha256.countArm s = BitVec.ofNat 64 (64 + text.length) → - Repr s.mem (State.addr (s.gpr .r1)) (xorPad k0 opad) → - bytesAt s'.mem (State.addr (stackArg s 0)) 32 = hmacBlockKey sha256 k0 text - pub s₁ s₂ := - 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 ∧ stackArg s₁ 1 = stackArg s₂ 1 - -end VG.Proof.Hmac - -namespace VG.Proof.Hmac.Arm -open VG VG.Arm -open VG.Proof.Sha256.Stream (writeBytes writeBytes_nil) -open VG.Proof.Hmac.Common (copy_mem) -open VG.Spec.Sha256 (bytesAt) -open VG.Impl.Hmac.Arm (cp) -open VG.Proof.MdStream.Arm (Upd Mupd wp_ldr wp_str) - -theorem add_off (p : Addr) (o j : Nat) : - p + BitVec.ofNat 64 (o + j) = p + BitVec.ofNat 64 o + BitVec.ofNat 64 j := by - rw [BitVec.ofNat_add, BitVec.add_assoc] - -/-- Copying `n` words from `[src + o₁]` to `[dst + o₂]`, through `t`. -/ -theorem copy_ok {t src dst : Reg} (hs : src ≠ t) (hd : dst ≠ t) (o₁ o₂ : Nat) (n : Nat) - (hb : o₁ + 4 * n ≤ 4096 ∧ o₂ + 4 * n ≤ 4096) : - ∀ (rest : List Instr) (s : State) (Q : State → Prop), - (s.gpr src).toNat + o₁ + 4 * n ≤ 2 ^ 32 → (s.gpr dst).toNat + o₂ + 4 * n ≤ 2 ^ 32 → - (∀ k < n, InRegions (s.rd ++ s.wr) - (State.addr (s.gpr src) + BitVec.ofNat 64 o₁ + BitVec.ofNat 64 (4 * k)) 4) → - (∀ k < n, InRegions s.wr (State.addr (s.gpr dst) + BitVec.ofNat 64 o₂ + BitVec.ofNat 64 (4 * k)) 4) → - Mem.Sep (State.addr (s.gpr src) + BitVec.ofNat 64 o₁) (4 * n) - (State.addr (s.gpr dst) + BitVec.ofNat 64 o₂) (4 * n) → - (∀ s', (∀ r, r ≠ t → 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 (s.gpr dst) + BitVec.ofNat 64 o₂) - (bytesAt s.mem (State.addr (s.gpr src) + BitVec.ofNat 64 o₁) (4 * n)) → - WP isa (.block rest) s' Q) → - WP isa (.block ((List.range n).flatMap (cp t src dst o₁ o₂) ++ rest)) s Q := by - induction n with - | zero => - intro rest s Q _ _ _ _ _ k - exact k s (fun _ _ => rfl) rfl rfl rfl - (by rw [Nat.mul_zero, VG.Proof.Hmac.Common.bytesAt_zero, writeBytes_nil]) - | succ n ih => - intro rest s Q fs fd hin hout hsep k - rw [List.range_succ, List.flatMap_append, List.flatMap_singleton, List.append_assoc] - refine ih ⟨by omega_nat, by omega_nat⟩ _ s Q (by omega_nat) (by omega_nat) (fun j hj => hin j (by omega_nat)) - (fun j hj => hout j (by omega_nat)) (fun x hx hy => hsep x (by omega_nat) (by omega_nat)) - fun s₁ g₁ rd₁ wr₁ sp₁ m₁ => ?_ - simp only [cp, List.cons_append, List.nil_append] - refine wp_ldr (a := State.addr (s.gpr src) + BitVec.ofNat 64 o₁ + BitVec.ofNat 64 (4 * n)) - (by omega_nat) (by rw [g₁ _ hs, addr_add (by omega_nat), add_off]) - (by rw [rd₁, wr₁]; exact hin n (by omega_nat)) fun s₂ u₂ => ?_ - refine wp_str (a := State.addr (s.gpr dst) + BitVec.ofNat 64 o₂ + BitVec.ofNat 64 (4 * n)) - (by omega_nat) (by rw [u₂.other _ hd, g₁ _ hd, addr_add (by omega_nat), add_off]) - (by rw [u₂.wr, wr₁]; exact hout n (by omega_nat)) - fun s₃ u₃ => k s₃ (fun r hr => by rw [u₃.gpr, u₂.other r hr, g₁ r hr]) - (by rw [u₃.rd, u₂.rd, rd₁]) (by rw [u₃.wr, u₂.wr, wr₁]) (by rw [u₃.sp, u₂.sp, sp₁]) ?_ - rw [u₃.mem, u₂.gpr, u₂.mem, m₁, Nat.mul_succ] - exact copy_mem s.mem _ _ n 4 (by rwa [← Nat.mul_succ]) (by omega_nat) - -end VG.Proof.Hmac.Arm diff --git a/lean/VerifiedGarbage/Proof/Hmac/Arm/Finalize.lean b/lean/VerifiedGarbage/Proof/Hmac/Arm/Finalize.lean deleted file mode 100644 index b847728b8..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Arm/Finalize.lean +++ /dev/null @@ -1,531 +0,0 @@ -import VerifiedGarbage.Proof.Hmac.Arm.Common -import VerifiedGarbage.Proof.Framework.Arm.Contract -import VerifiedGarbage.Proof.Framework.Arm.Inline -import VerifiedGarbage.Spec.Hmac.Contract -import VerifiedGarbage.Proof.Framework.Offset -import VerifiedGarbage.Proof.Framework.OmegaLit - -/-! -# HMAC-SHA-256 on ARMv7: `finalize` - -The same structure as the generic x86-64 and AArch64 proofs -(`VG.Proof.Hmac.Generic.X86_64.Finalize`, -`VG.Proof.Hmac.Generic.AArch64.Finalize`). The two SHA-256 finalizations are the -inlined `vg_sha256_finalize` (which calls `vg_sha256_compress`), used as a black -box through its proof, together with the fact that it never writes `r0` -(`WP.inlineCalls`); their stack arguments (`out`, `scratch`) are ours, which -they never write. --/ - -namespace VG.Proof.Hmac.Arm.Finalize - -open VG VG.Arm VG.Impl.Hmac.Arm -open VG.Proof.Hmac.Arm -open VG.Proof.Hmac.Common (writeBytes_at writeBytes_other bytesAt_getD' bytesAt_length - bytesAt_writeBytes_self bytesAt_writeBytes_sep stateAt_eq_of_bytes xorPad_length repr_outer) -open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame) -open VG.Proof.Sha256.Arm (contains_offset) -open VG.Proof.MdStream.Arm (Upd Mupd wp_mov wp_ldr wp_str wp_ldrSp op2_imm frame_bytes sub_offset) -open VG.Spec.Sha256 (bytesAt stateAt Repr) -open VG.Proof.Sha256 (countArm) -open VG.Spec.Hmac (xorPad ipad opad hmacBlockKey sha256) - -/-! ## The precondition -/ - -section -variable (s₀ : State) - -abbrev inn : BitVec 32 := s₀.gpr .r0 -abbrev ou : BitVec 32 := s₀.gpr .r1 -abbrev out : BitVec 32 := stackArg s₀ 0 -abbrev scr : BitVec 32 := stackArg s₀ 1 -abbrev inA : Addr := State.addr (inn s₀) -abbrev ouA : Addr := State.addr (ou s₀) -abbrev outA : Addr := State.addr (out s₀) -abbrev scA : Addr := State.addr (scr s₀) -abbrev inR : Region := ⟨inA s₀, 96⟩ -abbrev ouR : Region := ⟨ouA s₀, 96⟩ -abbrev outR : Region := ⟨outA s₀, 32⟩ -abbrev scR : Region := ⟨scA s₀, 240⟩ -abbrev argR : Region := ⟨stackArgAddr s₀ 0, 8⟩ -/-- Where the inlined finalizations may write. -/ -abbrev finW : List Region := [inR s₀, outR s₀, ⟨scA s₀, 160⟩] - -end - -structure Pre (s₀ : State) : Prop where - rd : s₀.rd = [ouR s₀, argR s₀] - wr : s₀.wr = [inR s₀, outR s₀, scR s₀] - i_o : (inR s₀).Disjoint (outR s₀) - i_s : (inR s₀).Disjoint (scR s₀) - o_s : (outR s₀).Disjoint (scR s₀) - u_i : (ouR s₀).Disjoint (inR s₀) - u_o : (ouR s₀).Disjoint (outR s₀) - u_s : (ouR s₀).Disjoint (scR s₀) - a_i : (argR s₀).Disjoint (inR s₀) - a_o : (argR s₀).Disjoint (outR s₀) - a_s : (argR s₀).Disjoint (scR s₀) - in_fit : (inn s₀).toNat + 96 ≤ 2 ^ 32 - ou_fit : (ou s₀).toNat + 96 ≤ 2 ^ 32 - out_fit : (out s₀).toNat + 32 ≤ 2 ^ 32 - scr_fit : (scr s₀).toNat + 240 ≤ 2 ^ 32 - sp_fit : s₀.sp.toNat + 8 ≤ 2 ^ 32 - -theorem pre_of {s₀ : State} (h : Proof.Hmac.finalizeSha256Arm.pre s₀) : Pre s₀ := by - obtain ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16⟩ := h - exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16⟩ - -/-! ## The stack arguments -/ - -theorem argAddr_eq {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k < 2) : - stackArgAddr s₀ k = stackArgAddr s₀ 0 + BitVec.ofNat 64 (4 * k) := by - have := hp.sp_fit - simp only [stackArgAddr] - rw [addr_add (by omega_nat)] - simp - -theorem arg_in {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k < 2) : - InRegions (s₀.rd ++ s₀.wr) (stackArgAddr s₀ k) 4 := - ⟨argR s₀, by simp [hp.rd], by rw [argAddr_eq hp hk]; exact contains_offset (by omega_nat) (by omega_nat)⟩ - -theorem arg_sub {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k < 2) : - Region.Sub ⟨stackArgAddr s₀ k, 4⟩ (argR s₀) := by - rw [argAddr_eq hp hk]; exact sub_offset (by omega_nat) (by omega_nat) - -/-- The stack arguments are never written. -/ -theorem stackArg_eq {s₀ : State} (hp : Pre s₀) {s : State} (hsp : s.sp = s₀.sp) - (hf : Frame s₀.wr s₀.mem s.mem) {k : Nat} (hk : k < 2) : stackArg s k = stackArg s₀ k := by - have e : stackArgAddr s k = stackArgAddr s₀ k := by simp only [stackArgAddr, hsp] - simp only [stackArg, e] - refine hf.readW (r := ⟨stackArgAddr s₀ k, 4⟩) (Region.contains_self _ _) ?_ (by decide) - intro r hr - simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact hp.a_i.sub_left (arg_sub hp hk) - · exact hp.a_o.sub_left (arg_sub hp hk) - · exact hp.a_s.sub_left (arg_sub hp hk) - -theorem sub160 (s₀ : State) : Region.Sub ⟨scA s₀, 160⟩ (scR s₀) := Region.sub_prefix (by omega_nat) - -theorem finW_sub (s₀ : State) : ∀ r ∈ finW s₀, ∃ r' ∈ [inR s₀, outR s₀, scR s₀], Region.Sub r r' := by - intro r hr - simp only [finW, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact ⟨inR s₀, by simp, fun _ h => h⟩ - · exact ⟨outR s₀, by simp, fun _ h => h⟩ - · exact ⟨scR s₀, by simp, sub160 s₀⟩ - -/-! ## The inlined finalization -/ - -theorem fin_exec : ∀ s, Proof.Sha256.finalizeArm.pre s → ∃ t s', - Exec isa Impl.Sha256.Arm.Stream.finalize s t s' ∧ abiPreserved s s' ∧ - Proof.Sha256.finalizeArm.post s s' := by - exact Proof.Sha256.Arm.Stream.Finalize.finalize_verified.1 - -theorem r0_ok : ∀ i ∈ instrs Impl.Sha256.Arm.Stream.finalize, dstOf i ≠ some .r0 := by - have : ((instrs Impl.Sha256.Arm.Stream.finalize).all fun i => dstOf i != some .r0) = true := by - rw [← Code.allInstrs_eq]; lit_decide - intro i hi - simpa using List.all_eq_true.mp this i hi - -/-- The inlined `vg_sha256_finalize` on the inner state, with our stack -arguments (`out`, and `scratch[0..160)` as its scratch space). -/ -theorem fin_ok {s₀ : State} (hp : Pre s₀) {s : State} (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) - (hsp : s.sp = s₀.sp) (h0 : s.gpr .r0 = inn s₀) (ha0 : stackArg s 0 = out s₀) - (ha1 : stackArg s 1 = scr s₀) {Q : State → Prop} - (hQ : ∀ s', s'.rd = s.rd → s'.wr = s.wr → abiPreserved s s' → Frame (finW s₀) s.mem s'.mem → - s'.gpr .r0 = inn s₀ → - (∀ m, Repr s.mem (inA s₀) m → countArm s = BitVec.ofNat 64 m.length → - bytesAt s'.mem (outA s₀) 32 = Spec.Sha256.hash m) → Q s') : - WP isa Impl.Sha256.Arm.Stream.finalize s Q := by - have e0 : stackArg (s.withRegions [argR s₀] (finW s₀)) 0 = out s₀ := ha0 - have e1 : stackArg (s.withRegions [argR s₀] (finW s₀)) 1 = scr s₀ := ha1 - have ea : stackArgAddr (s.withRegions [argR s₀] (finW s₀)) 0 = stackArgAddr s₀ 0 := by - simp only [stackArgAddr, State.withRegions_sp, hsp] - refine WP.inlineCalls (k := Proof.Sha256.finalizeArm) fin_exec (rd := [argR s₀]) (wr := finW s₀) ?_ ?_ ?_ ?_ - · simp only [Proof.Sha256.finalizeArm, e0, e1, ea, State.withRegions_gpr, State.withRegions_rd, - State.withRegions_wr, State.withRegions_sp, h0, hsp] - have := hp.scr_fit - exact ⟨by first | rfl | trivial, by first | rfl | trivial, hp.i_o, hp.i_s.sub_right (sub160 s₀), hp.o_s.sub_right (sub160 s₀), hp.a_i, hp.a_o, - hp.a_s.sub_right (sub160 s₀), hp.in_fit, hp.out_fit, by omega_nat, hp.sp_fit⟩ - · rw [hrd, hwr, hp.rd, hp.wr] - apply Covers.of_sub - intro r hr - simp only [finW, List.cons_append, List.nil_append, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl - · exact ⟨argR s₀, by simp, 0, by simp, by simp⟩ - · exact ⟨inR s₀, by simp, 0, by simp, by simp⟩ - · exact ⟨outR s₀, by simp, 0, by simp, by simp⟩ - · exact ⟨scR s₀, by simp, 0, by simp, by simp⟩ - · rw [hwr, hp.wr] - apply Covers.of_sub - intro r hr - simp only [finW, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact ⟨inR s₀, by simp, 0, by simp, by simp⟩ - · exact ⟨outR s₀, by simp, 0, by simp, by simp⟩ - · exact ⟨scR s₀, by simp, 0, by simp, by simp⟩ - · intro s' h₁ h₂ h₃ h₄ hg hpost - simp only [Proof.Sha256.finalizeArm, State.withRegions_gpr, State.withRegions_mem, h0, e0] at hpost - exact hQ s' h₁ h₂ h₃ h₄ (by rw [hg _ r0_ok (by decide), h0]) fun m hr hc => hpost Spec.Sha256.H0 m hr hc - -/-! ## Saving the outer hash value -/ - -/-- After the prologue: the outer hash value's bytes are in `scratch[160..192)`. -/ -structure Saved (s₀ s : State) : Prop where - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - sp : s.sp = s₀.sp - gpr : ∀ r, r ≠ .r12 → s.gpr r = s₀.gpr r - frame : Frame [scR s₀] s₀.mem s.mem - outer : ∀ i < 32, s.mem (scA s₀ + BitVec.ofNat 64 160 + BitVec.ofNat 64 i) = s₀.mem (ouA s₀ + BitVec.ofNat 64 i) - -theorem ofNat_zero_add (p : Addr) : p + BitVec.ofNat 64 0 = p := by simp - -theorem prologue_ok {s₀ : State} (hp : Pre s₀) : WP isa (.block saveOuter) s₀ (Saved s₀) := by - have hsc := hp.scr_fit; have hou := hp.ou_fit - unfold saveOuter - simp only [List.cons_append, List.nil_append] - refine wp_ldrSp (a := stackArgAddr s₀ 1) (by decide) rfl (arg_in hp (by decide)) fun s₁ u₁ => ?_ - have h12 : s₁.gpr .r12 = scr s₀ := u₁.gpr - have c192 : (scR s₀).Contains (scA s₀ + BitVec.ofNat 64 192) 4 := contains_offset (by omega_nat) (by omega_nat) - refine wp_str (a := scA s₀ + BitVec.ofNat 64 192) (by decide) (by rw [h12, addr_add (by omega_nat)]) - ⟨scR s₀, by simp [u₁.wr, hp.wr], c192⟩ fun s₂ u₂ => ?_ - have e1 : s₂.gpr .r1 = ou s₀ := by rw [u₂.gpr, u₁.other _ (by decide)] - have e12 : s₂.gpr .r12 = scr s₀ := by rw [u₂.gpr, h12] - have fr₂ : Frame [scR s₀] s₀.mem s₂.mem := by - rw [u₂.mem, u₁.mem]; exact (Frame.refl _ _).writeW (List.mem_singleton_self _) _ c192 - refine copy_ok (t := .r2) (src := .r1) (dst := .r12) (by decide) (by decide) 0 160 8 - ⟨by omega_nat, by omega_nat⟩ _ s₂ _ (by rw [e1]; omega_nat) (by rw [e12]; omega_nat) (fun k hk => ?_) (fun k hk => ?_) ?_ - fun s₃ g₃ rd₃ wr₃ sp₃ m₃ => ?_ - · rw [e1, ofNat_zero_add, u₂.rd, u₂.wr, u₁.rd, u₁.wr] - exact ⟨ouR s₀, by simp [hp.rd], contains_offset (by omega_nat) (by omega_nat)⟩ - · rw [e12, u₂.wr, u₁.wr, ← add_off] - exact ⟨scR s₀, by simp [hp.wr], contains_offset (by omega_nat) (by omega_nat)⟩ - · rw [e1, e12, ofNat_zero_add] - exact hp.u_s.sep (by simp [Region.Contains]) (contains_offset (by omega_nat) (by omega_nat)) - rw [e1, e12, ofNat_zero_add] at m₃ - have h12₃ : s₃.gpr .r12 = scr s₀ := by rw [g₃ _ (by decide), e12] - have c160 : (scR s₀).Contains (scA s₀ + BitVec.ofNat 64 160) 32 := contains_offset (by omega_nat) (by omega_nat) - have fw : Frame [⟨scA s₀ + BitVec.ofNat 64 160, 32⟩] s₂.mem s₃.mem := by - rw [m₃]; exact writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact Region.contains_self _ _) - refine wp_ldr (a := scA s₀ + BitVec.ofNat 64 192) (by decide) (by rw [h12₃, addr_add (by omega_nat)]) - ⟨scR s₀, by simp [rd₃, wr₃, u₂.rd, u₂.wr, u₁.rd, u₁.wr, hp.wr], c192⟩ fun s₄ u₄ => WP.block_nil ?_ - have hb : ∀ i < 32, s₂.mem (ouA s₀ + BitVec.ofNat 64 i) = s₀.mem (ouA s₀ + BitVec.ofNat 64 i) := - fun i hi => frame_bytes fr₂ (R := ouR s₀) (by simpa using hp.u_s) (by simp) (by show i < 96; omega_nat) - refine ⟨by rw [u₄.rd, rd₃, u₂.rd, u₁.rd], by rw [u₄.wr, wr₃, u₂.wr, u₁.wr], - by rw [u₄.sp, sp₃, u₂.sp, u₁.sp], fun r hr => ?_, ?_, fun i hi => ?_⟩ - · by_cases h2 : r = .r2 - · subst h2 - rw [u₄.gpr, fw.readW (r := ⟨scA s₀ + BitVec.ofNat 64 192, 4⟩) (a := scA s₀ + BitVec.ofNat 64 192) - (w := 32) (Region.contains_self _ _) ?_ (by decide), u₂.mem, u₁.other _ (by decide)] - · exact Mem.readW_writeW_self32 _ _ _ - · simp only [List.mem_singleton]; rintro r rfl - off_disj - · rw [u₄.other r h2, g₃ r h2, u₂.gpr, u₁.other r hr] - · rw [u₄.mem] - exact fr₂.trans (fw.sub fun r hr => by - simp only [List.mem_singleton] at hr; subst hr - exact ⟨scR s₀, by simp, sub_offset (by omega_nat) (by omega_nat)⟩) - · rw [u₄.mem, m₃, writeBytes_at _ _ _ (by rw [bytesAt_length]; omega_nat) (by rw [bytesAt_length]; omega_nat), - bytesAt_getD' _ _ hi, hb i hi] - -/-! ## Loading the outer hash value and the inner digest -/ - -/-- After the middle block, from `s`: the inner state holds the hash value from -`scratch[160..192)` and, in its buffer, the digest from `out`. -/ -structure Loaded (s₀ s s' : State) : Prop where - rd : s'.rd = s.rd - wr : s'.wr = s.wr - sp : s'.sp = s.sp - r0 : s'.gpr .r0 = inn s₀ - r2 : s'.gpr .r2 = 96 - r3 : s'.gpr .r3 = 0 - cs : ∀ r ∈ preserved, s'.gpr r = s.gpr r - state : stateAt s'.mem (inA s₀) = stateAt s.mem (scA s₀ + BitVec.ofNat 64 160) - buf : bytesAt s'.mem (inA s₀ + 32) 32 = bytesAt s.mem (outA s₀) 32 - frame : Frame [inR s₀] s.mem s'.mem - -theorem load_ok {s₀ : State} (hp : Pre s₀) {s : State} (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) - (hsp : s.sp = s₀.sp) (h0 : s.gpr .r0 = inn s₀) (ha0 : stackArg s 0 = out s₀) - (ha1 : stackArg s 1 = scr s₀) : WP isa (.block loadOuter) s (Loaded s₀ s) := by - have hsc := hp.scr_fit; have hin := hp.in_fit; have hot := hp.out_fit - unfold loadOuter - simp only [List.cons_append, List.nil_append, List.append_assoc] - have hi1 : InRegions (s.rd ++ s.wr) (stackArgAddr s 1) 4 := by - rw [show stackArgAddr s 1 = stackArgAddr s₀ 1 by simp only [stackArgAddr, hsp], hrd, hwr] - exact arg_in hp (by decide) - have hi0 : InRegions (s.rd ++ s.wr) (stackArgAddr s 0) 4 := by - rw [show stackArgAddr s 0 = stackArgAddr s₀ 0 by simp only [stackArgAddr, hsp], hrd, hwr] - exact arg_in hp (by decide) - refine wp_ldrSp (a := stackArgAddr s 1) (by decide) rfl hi1 fun s₁ u₁ => ?_ - refine wp_ldrSp (a := stackArgAddr s 0) (by decide) (by rw [u₁.sp]; rfl) (by rw [u₁.rd, u₁.wr]; exact hi0) - fun s₂ u₂ => ?_ - have e1 : s₂.gpr .r1 = scr s₀ := by rw [u₂.other _ (by decide), u₁.gpr]; exact ha1 - have e12 : s₂.gpr .r12 = out s₀ := by rw [u₂.gpr, u₁.mem]; exact ha0 - have e0 : s₂.gpr .r0 = inn s₀ := by rw [u₂.other _ (by decide), u₁.other _ (by decide), h0] - have rd₂ : s₂.rd = s₀.rd := by rw [u₂.rd, u₁.rd, hrd] - have wr₂ : s₂.wr = s₀.wr := by rw [u₂.wr, u₁.wr, hwr] - have hm₂ : s₂.mem = s.mem := by rw [u₂.mem, u₁.mem] - have cin : ∀ k < 8, InRegions s₂.wr (inA s₀ + BitVec.ofNat 64 0 + BitVec.ofNat 64 (4 * k)) 4 := - fun k hk => ⟨inR s₀, by simp [wr₂, hp.wr], by rw [← add_off]; exact contains_offset (by omega_nat) (by omega_nat)⟩ - refine copy_ok (t := .r3) (src := .r1) (dst := .r0) (by decide) (by decide) 160 0 8 - ⟨by omega_nat, by omega_nat⟩ _ s₂ _ (by rw [e1]; omega_nat) (by rw [e0]; omega_nat) (fun k hk => ?_) - (fun k hk => by rw [e0]; exact cin k hk) ?_ fun s₃ g₃ rd₃ wr₃ sp₃ m₃ => ?_ - · rw [e1, rd₂, wr₂, ← add_off] - exact ⟨scR s₀, by simp [hp.wr], contains_offset (by omega_nat) (by omega_nat)⟩ - · rw [e1, e0, ofNat_zero_add] - exact hp.i_s.symm.sep (contains_offset (by omega_nat) (by omega_nat)) (by simp [Region.Contains]) - rw [e1, e0, ofNat_zero_add, hm₂] at m₃ - have e12₃ : s₃.gpr .r12 = out s₀ := by rw [g₃ _ (by decide), e12] - have e0₃ : s₃.gpr .r0 = inn s₀ := by rw [g₃ _ (by decide), e0] - refine copy_ok (t := .r3) (src := .r12) (dst := .r0) (by decide) (by decide) 0 32 8 - ⟨by omega_nat, by omega_nat⟩ _ s₃ _ (by rw [e12₃]; omega_nat) (by rw [e0₃]; omega_nat) (fun k hk => ?_) - (fun k hk => ?_) ?_ fun s₄ g₄ rd₄ wr₄ sp₄ m₄ => ?_ - · rw [e12₃, rd₃, wr₃, rd₂, wr₂, ofNat_zero_add] - exact ⟨outR s₀, by simp [hp.wr], contains_offset (by omega_nat) (by omega_nat)⟩ - · rw [e0₃, wr₃, wr₂, ← add_off] - exact ⟨inR s₀, by simp [hp.wr], contains_offset (by omega_nat) (by omega_nat)⟩ - · rw [e12₃, e0₃, ofNat_zero_add] - exact hp.i_o.symm.sep (by simp [Region.Contains]) (contains_offset (by omega_nat) (by omega_nat)) - rw [e12₃, e0₃, ofNat_zero_add] at m₄ - refine wp_mov (op2_imm (by decide)) fun s₅ u₅ => wp_mov (op2_imm (by decide)) fun s₆ u₆ => WP.block_nil ?_ - have c₀ : (inR s₀).Contains (inA s₀) 32 := by simp [Region.Contains] - have hm : s₆.mem = s₄.mem := by rw [u₆.mem, u₅.mem] - have hbuf : bytesAt s₄.mem (inA s₀ + 32) 32 = bytesAt s.mem (outA s₀) 32 := by - rw [m₄, show inA s₀ + 32 = inA s₀ + BitVec.ofNat 64 32 from rfl] - have := bytesAt_writeBytes_self s₃.mem (inA s₀ + BitVec.ofNat 64 32) - (bytesAt s₃.mem (outA s₀) (4 * 8)) (by simp [bytesAt]) - rw [bytesAt_length] at this - rw [this, m₃, bytesAt_writeBytes_sep] - · rw [bytesAt_length] - exact hp.i_o.symm.sep (Region.contains_self _ _) c₀ - · omega_nat - have hst : stateAt s₄.mem (inA s₀) = stateAt s.mem (scA s₀ + BitVec.ofNat 64 160) := by - refine stateAt_eq_of_bytes fun i hi => ?_ - have key : ∀ p : Addr, ¬ (p + BitVec.ofNat 64 i - (p + BitVec.ofNat 64 32)).toNat < 4 * 8 := by - intro p; rw [Offset.lt_iff _ _ (by omega_nat), Mem.sub_ofNat_toNat _ (by omega_nat)]; omega_nat - rw [m₄, writeBytes_other _ _ _ (by rw [bytesAt_length]; exact key _), m₃, - writeBytes_at _ _ _ (by rw [bytesAt_length]; omega_nat) (by rw [bytesAt_length]; omega_nat), - bytesAt_getD' _ _ (by omega_nat)] - have hfr : Frame [inR s₀] s.mem s₄.mem := by - rw [m₄, m₃] - refine (writeBytes_frame (R := inR s₀) _ _ _ ?_).trans (writeBytes_frame (R := inR s₀) _ _ _ ?_) - · rw [bytesAt_length]; exact c₀ - · rw [bytesAt_length]; exact contains_offset (by omega_nat) (by omega_nat) - have k₄ : ∀ r, r ≠ .r1 → r ≠ .r12 → r ≠ .r3 → s₄.gpr r = s.gpr r := fun r a b c => by - rw [g₄ r c, g₃ r c, u₂.other r b, u₁.other r a] - refine ⟨by rw [u₆.rd, u₅.rd, rd₄, rd₃, rd₂, hrd], by rw [u₆.wr, u₅.wr, wr₄, wr₃, wr₂, hwr], - by rw [u₆.sp, u₅.sp, sp₄, sp₃, u₂.sp, u₁.sp], ?_, ?_, u₆.gpr, fun r hr => ?_, - by rw [hm, hst], by rw [hm, hbuf], by rw [hm]; exact hfr⟩ - · rw [u₆.other _ (by decide), u₅.other _ (by decide), k₄ _ (by decide) (by decide) (by decide), h0] - · rw [u₆.other _ (by decide), u₅.gpr] - · have : r ≠ .r1 ∧ r ≠ .r12 ∧ r ≠ .r3 ∧ r ≠ .r2 := by - simp only [preserved, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> decide - rw [u₆.other _ this.2.2.1, u₅.other _ this.2.2.2, k₄ _ this.1 this.2.1 this.2.2.1] - -/-! ## Correctness -/ - -/-- `scratch[160..192)` is not written by the inlined finalizations. -/ -theorem not_finW {s₀ : State} (hp : Pre s₀) {i : Nat} (hi : i < 32) : - ∀ r ∈ finW s₀, ¬ r.Contains (scA s₀ + BitVec.ofNat 64 160 + BitVec.ofNat 64 i) 1 := by - have := hp.scr_fit - have hs : (scR s₀).Contains (scA s₀ + BitVec.ofNat 64 160 + BitVec.ofNat 64 i) 1 := by - rw [← add_off]; exact contains_offset (by omega_nat) (by omega_nat) - intro r hr - simp only [finW, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact fun hc => hp.i_s _ hc hs - · exact fun hc => hp.o_s _ hc hs - · simp only [Region.Contains] - rw [Offset.add_add, Offset.add_sub_cancel_left, BitVec.toNat_ofNat]; omega_nat - -theorem countArm_96 {s : State} (h2 : s.gpr .r2 = 96) (h3 : s.gpr .r3 = 0) : - countArm s = BitVec.ofNat 64 (64 + 32) := by - simp only [countArm, h2, h3]; decide - -theorem correct {s₀ : State} (hp : Pre s₀) : - WP isa finalize s₀ fun s' => abiPreserved s₀ s' ∧ Proof.Hmac.finalizeSha256Arm.post s₀ s' := by - unfold finalize - refine WP.seq (WP.mono (prologue_ok hp) fun s₁ h₁ => ?_) - have fW₁ : Frame s₀.wr s₀.mem s₁.mem := h₁.frame.mono (by simp [hp.wr]) - refine WP.seq (fin_ok hp h₁.rd h₁.wr h₁.sp (h₁.gpr _ (by decide)) (stackArg_eq hp h₁.sp fW₁ (by decide)) - (stackArg_eq hp h₁.sp fW₁ (by decide)) fun s₂ rd₂ wr₂ abi₂ fr₂ r0₂ post₂ => ?_) - have sp₂ : s₂.sp = s₀.sp := abi₂.2.trans h₁.sp - have fW₂ : Frame s₀.wr s₀.mem s₂.mem := fW₁.trans (by rw [hp.wr]; exact fr₂.sub (finW_sub s₀)) - refine WP.seq (WP.mono (load_ok hp (s := s₂) (rd₂.trans h₁.rd) (wr₂.trans h₁.wr) sp₂ r0₂ - (stackArg_eq hp sp₂ fW₂ (by decide)) (stackArg_eq hp sp₂ fW₂ (by decide))) fun s₃ h₃ => ?_) - have sp₃ : s₃.sp = s₀.sp := h₃.sp.trans sp₂ - have fW₃ : Frame s₀.wr s₀.mem s₃.mem := fW₂.trans (h₃.frame.mono (by simp [hp.wr])) - refine fin_ok hp (h₃.rd.trans (rd₂.trans h₁.rd)) (h₃.wr.trans (wr₂.trans h₁.wr)) sp₃ h₃.r0 - (stackArg_eq hp sp₃ fW₃ (by decide)) (stackArg_eq hp sp₃ fW₃ (by decide)) - fun s₄ rd₄ wr₄ abi₄ fr₄ _ post₄ => ⟨⟨fun r hr => ?_, ?_⟩, ?_⟩ - · have : r ≠ .r12 := by - simp only [preserved, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> decide - rw [abi₄.1 r hr, h₃.cs r hr, abi₂.1 r hr, h₁.gpr r this] - · rw [abi₄.2, sp₃] - · intro k0 text hk hin hcnt hout - -- The inner digest. - have hin₁ : Repr s₁.mem (inA s₀) (xorPad k0 ipad ++ text) := - Proof.Sha256.Stream.repr_congr (fun i hi => frame_bytes (R := inR s₀) h₁.frame - (by simpa using hp.i_s) (by simp) hi) hin - have hc₁ : countArm s₁ = BitVec.ofNat 64 (xorPad k0 ipad ++ text).length := by - rw [List.length_append, xorPad_length, hk, ← hcnt] - simp only [countArm, h₁.gpr _ (show Reg.r2 ≠ .r12 by decide), h₁.gpr _ (show Reg.r3 ≠ .r12 by decide)] - have hd := post₂ _ hin₁ hc₁ - -- The outer state. - have hst : stateAt s₃.mem (inA s₀) = Spec.Sha256.compressList Spec.Sha256.H0 (xorPad k0 opad) 1 := by - rw [h₃.state] - have e : stateAt s₂.mem (scA s₀ + BitVec.ofNat 64 160) = stateAt s₀.mem (ouA s₀) := by - refine stateAt_eq_of_bytes fun i hi => ?_ - rw [fr₂ _ (not_finW hp hi), h₁.outer i hi] - rw [e, hout.1, xorPad_length, hk] - have hrepr := repr_outer hk (by rw [bytesAt_length]) hst h₃.buf - have := post₄ _ hrepr (by rw [countArm_96 h₃.r2 h₃.r3, List.length_append, xorPad_length, hk, - bytesAt_length]) - rw [hd] at this - simpa [hmacBlockKey, sha256] using this - -/-! ## `Verified` -/ - -/-- The initial taint: `r0`–`r3` (`inner`, `outer`, `count`) are public, `r0` -points at the inner state, and the 8 bytes of stack arguments are public, -the second one pointing at the scratch space. -/ -def τ₀ : VG.Arm.Taint.T := - { regs := .ofList [.r0, .r1, .r2, .r3], flags := false, lens := [96, 32, 240], bases := [(.r0, 0)], - argLen := 8, argBases := [(4, 2)] } - -theorem wf₀ {s : State} (h : Proof.Hmac.finalizeSha256Arm.pre s) : VG.Arm.Taint.Wf τ₀ s := by - have hp := pre_of h - have hst := hp.in_fit; have ho := hp.out_fit; have hsc := hp.scr_fit; have hs := hp.sp_fit - refine ⟨fun _ => ⟨by simp [hp.wr, τ₀], ?_, ?_⟩, ?_, fun _ => ⟨hs, ?_⟩, ?_⟩ - · simp only [hp.wr, List.pairwise_cons, List.mem_cons, List.not_mem_nil, or_false, forall_eq_or_imp, - forall_eq, List.Pairwise.nil, and_true] - exact ⟨⟨hp.i_o, hp.i_s⟩, hp.o_s, fun _ h => h.elim⟩ - · simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) <;> simp only [Proof.MdStream.Arm.addr_toNat] <;> omega_nat - · intro p hp'; simp only [τ₀, List.mem_singleton] at hp'; subst hp'; simp [VG.Arm.Taint.region, hp.wr] - · have e : (⟨State.addr s.sp, 8⟩ : Region) = argR s := by simp [stackArgAddr] - simp only [τ₀, e, hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact hp.a_i - · exact hp.a_o - · exact hp.a_s - · intro p hp'; simp only [τ₀, List.mem_singleton] at hp'; subst hp' - refine ⟨by decide, ?_⟩ - simp only [VG.Arm.Taint.region, hp.wr] - rfl - -theorem agree₀ {s₁ s₂ : State} (h₁ : Proof.Hmac.finalizeSha256Arm.pre s₁) - (h₂ : Proof.Hmac.finalizeSha256Arm.pre s₂) (hpub : Proof.Hmac.finalizeSha256Arm.pub s₁ s₂) : - VG.Arm.Taint.Agree τ₀ s₁ s₂ := by - obtain ⟨psp, p0, p1, p2, p3, a0, a1⟩ := hpub - have hp₁ := pre_of h₁; have hp₂ := pre_of h₂ - refine ⟨⟨fun r hr => ?_, fun h => nomatch h⟩, fun _ => ?_, wf₀ h₁, wf₀ h₂, - fun _ h => (List.not_mem_nil h).elim, fun _ h => (List.not_mem_nil h).elim, fun _ => psp, fun k hk => ?_⟩ - · simp only [τ₀, RegSet.mem_ofList, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl <;> with_reducible assumption - · rw [hp₁.wr, hp₂.wr]; simp only [inR, outR, scR, inA, outA, scA, inn, out, scr, p0, a0, a1] - · simp only [τ₀] at hk - rw [Proof.MdStream.Arm.argByte_eq hp₁.sp_fit hk, - Proof.MdStream.Arm.argByte_eq hp₂.sp_fit hk, - Mem.readW_byte s₁.mem _ (Nat.mod_lt _ (by omega_nat)), - Mem.readW_byte s₂.mem _ (Nat.mod_lt _ (by omega_nat))] - have : k / 4 = 0 ∨ k / 4 = 1 := by omega_nat - rcases this with h | h <;> rw [h] - · exact congrArg _ a0 - · exact congrArg _ a1 - -/-- A state satisfying the precondition: `inner` at `0x1000`, `outer` at -`0x2000`, `out` at `0x3000` and the scratch space at `0x4000`, passed on the -stack at `0x5000`. -/ -def sat : State where - gpr r := match r with - | .r0 => 0x1000 | .r1 => 0x2000 | _ => 0 - sp := 0x5000 - n := false - z := false - c := false - v := false - mem a := if a = 0x5001 then 0x30 else if a = 0x5005 then 0x40 else 0 - rd := [⟨0x2000, 96⟩, ⟨0x5000, 8⟩] - wr := [⟨0x1000, 96⟩, ⟨0x3000, 32⟩, ⟨0x4000, 240⟩] - -theorem finalize_correct (s : State) (hs : Proof.Hmac.finalizeSha256Arm.pre s) : - ∃ t s', Exec isa finalize s t s' ∧ abiPreserved s s' ∧ Proof.Hmac.finalizeSha256Arm.post s s' := - by - obtain ⟨t, s', he, h⟩ := correct (pre_of hs) - exact ⟨t, s', he, h⟩ - -theorem finalize_ct : ConstantTime isa Proof.Hmac.finalizeSha256Arm.pre - Proof.Hmac.finalizeSha256Arm.pub finalize := by - exact VG.Taint.constantTime (A := taint) τ₀ (fun _ _ h₁ h₂ hp => agree₀ h₁ h₂ hp) - (by taint_decide) - -/-- `finalizeSha256Arm` with the 688 bytes of scratch of the shared contract -(sized for the x86-64 AVX2 compression function), of which the code uses 240. -/ -def finalizeWide : Contract isa := - { Proof.Hmac.finalizeSha256Arm with - pre := fun s => - let inner : Region := ⟨State.addr (s.gpr .r0), 96⟩ - let outer : Region := ⟨State.addr (s.gpr .r1), 96⟩ - let out : Region := ⟨State.addr (stackArg s 0), 32⟩ - let scratch : Region := ⟨State.addr (stackArg s 1), 688⟩ - let args : Region := ⟨stackArgAddr s 0, 8⟩ - s.rd = [outer, args] ∧ s.wr = [inner, out, scratch] ∧ - inner.Disjoint out ∧ inner.Disjoint scratch ∧ out.Disjoint scratch ∧ - outer.Disjoint inner ∧ outer.Disjoint out ∧ outer.Disjoint scratch ∧ - args.Disjoint inner ∧ args.Disjoint out ∧ args.Disjoint scratch ∧ - (s.gpr .r0).toNat + 96 ≤ 2 ^ 32 ∧ (s.gpr .r1).toNat + 96 ≤ 2 ^ 32 ∧ - (stackArg s 0).toNat + 32 ≤ 2 ^ 32 ∧ (stackArg s 1).toNat + 688 ≤ 2 ^ 32 ∧ - s.sp.toNat + 8 ≤ 2 ^ 32 } - -/-- The regions `finalizeSha256Arm` lets the code write. -/ -def narrowWr (s : State) : List Region := - [⟨State.addr (s.gpr .r0), 96⟩, ⟨State.addr (stackArg s 0), 32⟩, ⟨State.addr (stackArg s 1), 240⟩] - -/-- Rewrites the contracts at a narrowed state (`stackArg` does not unfold -cheaply). -/ -local macro "narrow" loc:(Lean.Parser.Tactic.location)? : tactic => - `(tactic| simp only [Proof.Hmac.finalizeSha256Arm, Proof.Sha256.countArm, VG.Proof.Hmac.Arm.Finalize.finalizeWide, - VG.Proof.Hmac.Arm.Finalize.narrowWr, VG.Arm.stackArg_withRegions, VG.Arm.stackArgAddr_withRegions, - VG.Arm.State.withRegions_gpr, VG.Arm.State.withRegions_sp, VG.Arm.State.withRegions_mem, - VG.Arm.State.withRegions_rd, VG.Arm.State.withRegions_wr] $(loc)?) - -theorem finalizeWide_pre (s : State) (h : finalizeWide.pre s) : - Proof.Hmac.finalizeSha256Arm.pre (s.withRegions s.rd (narrowWr s)) := by - obtain ⟨h₁, _, h₃, h₄, h₅, h₆, h₇, h₈, h₉, h₁₀, h₁₁, h₁₂, h₁₃, h₁₄, h₁₅, h₁₆⟩ := h - narrow - exact ⟨h₁, trivial, h₃, h₄.sub_right (Region.sub_of_ble rfl), h₅.sub_right (Region.sub_of_ble rfl), - h₆, h₇, h₈.sub_right (Region.sub_of_ble rfl), h₉, h₁₀, h₁₁.sub_right (Region.sub_of_ble rfl), h₁₂, - h₁₃, h₁₄, Region.end_le_of_ble rfl h₁₅, h₁₆⟩ - -/-- A state satisfying `finalizeWide.pre`. -/ -def wideSat : State := { sat with wr := [⟨0x1000, 96⟩, ⟨0x3000, 32⟩, ⟨0x4000, 688⟩] } - -theorem finalizeWide_implies : - finalizeWide.Implies (Spec.Hmac.finalizeSha256OutContract Arm.abi) := by - sig_implies [Spec.Hmac.finalizeSha256OutContract, Spec.Hmac.finalizeSha256OutSig, finalizeWide, - Proof.Hmac.finalizeSha256Arm, Proof.Sha256.countArm, Arm.abi, Arm.argRegs, Arm.reduceClassify, - Arm.Loc.val, Arm.State.addr] - [wideSat, sat, Arm.stackArg, Arm.stackArgAddr, Mem.readW, Mem.read] using wideSat - -/-- The proof is written against `finalizeSha256Arm`, widened to the shared -contract's scratch. -/ -theorem finalize_verified : - Verified Arm.target Impl.Hmac.Arm.finalize (Spec.Hmac.finalizeSha256OutContract Arm.abi) := - have hsat := finalizeWide_implies.sat_left - (Verified.widen (Verified.of_correct finalize_correct finalize_ct - (.refl (hsat.elim fun s hs => ⟨_, finalizeWide_pre s hs⟩))) - narrowWr finalizeWide_pre - (fun _ h => by - obtain ⟨_, h₂, _⟩ := h - rw [h₂] - exact .cons (Region.prefix_of_ble rfl) (.cons (Region.prefix_of_ble rfl) - (.cons (Region.prefix_of_ble rfl) .nil))) - (fun _ _ _ h => by narrow at h ⊢; exact h) - (fun _ _ _ _ h => by narrow; exact h) hsat).of_implies finalizeWide_implies - -end VG.Proof.Hmac.Arm.Finalize diff --git a/lean/VerifiedGarbage/Proof/Hmac/Arm/Init.lean b/lean/VerifiedGarbage/Proof/Hmac/Arm/Init.lean deleted file mode 100644 index 307c4ed6e..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Arm/Init.lean +++ /dev/null @@ -1,899 +0,0 @@ -import VerifiedGarbage.Proof.Hmac.Arm.Common -import VerifiedGarbage.Proof.Sha256.Arm.Stream.Init -import Mathlib.Tactic.Set -import VerifiedGarbage.Proof.Framework.Arm.Contract -import VerifiedGarbage.Proof.Framework.Arm.Inline -import VerifiedGarbage.Spec.Hmac.Contract -import VerifiedGarbage.Proof.Framework.Offset -import Mathlib.Tactic.ClearExcept -import VerifiedGarbage.Proof.Framework.OmegaLit - -/-! -# HMAC-SHA-256 on ARMv7: `init` - -The same structure as the generic x86-64 and AArch64 proofs -(`VG.Proof.Hmac.Generic.X86_64.Init`, `VG.Proof.Hmac.Generic.AArch64.Init`), -with `inner` in `r0`, `outer` in `r4`, the key pointer in `r5`, the bytes left -in `r6`, the byte index in `r7` and `ipad`, `opad` in `r8`, `r9`. --/ - -namespace VG.Proof.Hmac.Arm.Init - -open VG VG.Arm VG.Impl.Hmac.Arm -open VG.Impl.Sha256.Arm.Stream (save restore compressAt saved) -open VG.Proof.Hmac.Arm (add_off) -open VG.Proof.Hmac.Common (bytesAt_length bytesAt_snoc repr_block writeState stateAt_writeState) -open VG.Proof.Sha256.Stream (writeBytes repr_congr) -open VG.Proof.Sha256.Arm (contains_offset) -open VG.Proof.MdStream.Arm (Upd Mupd Fupd wp_mov wp_add wp_subs wp_cmp wp_ldrb wp_strb wp_ldrSp - wp_str op2_imm op2_reg saveMem frame_bytes sub_offset eval_eq eval_ne ofNat_beq_zero sub_ofNat - sub_beq) -open VG.Proof.Sha256.Arm.Stream (compressAt_ok saveMem_saved saveMem_frame save_ok restore_ok) -open VG.Proof.MdStream.Arm (addr_toNat) -open VG.Spec.Sha256 (bytesAt stateAt Repr H0) -open VG.Spec.Hmac (xorPad ipad opad blockKey sha256) - -/-! ## The precondition -/ - -section -variable (s₀ : State) - -abbrev inn : BitVec 32 := s₀.gpr .r0 -abbrev ou : 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 inA : Addr := State.addr (inn s₀) -abbrev ouA : Addr := State.addr (ou s₀) -abbrev kA : Addr := State.addr (kp s₀) -abbrev scA : Addr := State.addr (scr s₀) -abbrev inR : Region := ⟨inA s₀, 96⟩ -abbrev ouR : Region := ⟨ouA s₀, 96⟩ -abbrev kR : Region := ⟨kA s₀, kl s₀⟩ -abbrev scR : Region := ⟨scA s₀, 160⟩ -abbrev argR : Region := ⟨stackArgAddr s₀ 0, 4⟩ - -/-- The key, padded with zeros to a block. -/ -def K0 : List Byte := bytesAt s₀.mem (kA s₀) (kl s₀) ++ List.replicate (64 - kl s₀) 0 - -/-- The caller's registers are saved in the scratch space. -/ -def Saved (m : Mem) : Prop := - ∀ p ∈ saved, m.readW (scA s₀ + BitVec.ofNat 64 p.2) 32 = s₀.gpr p.1 - -end - -structure Pre (s₀ : State) : Prop where - kl_le : kl s₀ ≤ 64 - rd : s₀.rd = [kR s₀, argR s₀] - wr : s₀.wr = [inR s₀, ouR s₀, scR s₀] - i_o : (inR s₀).Disjoint (ouR s₀) - i_s : (inR s₀).Disjoint (scR s₀) - o_s : (ouR s₀).Disjoint (scR s₀) - k_i : (kR s₀).Disjoint (inR s₀) - k_o : (kR s₀).Disjoint (ouR s₀) - k_s : (kR s₀).Disjoint (scR s₀) - a_i : (argR s₀).Disjoint (inR s₀) - a_o : (argR s₀).Disjoint (ouR s₀) - a_s : (argR s₀).Disjoint (scR s₀) - in_fit : (inn s₀).toNat + 96 ≤ 2 ^ 32 - ou_fit : (ou s₀).toNat + 96 ≤ 2 ^ 32 - k_fit : (kp s₀).toNat + kl s₀ ≤ 2 ^ 32 - scr_fit : (scr s₀).toNat + 160 ≤ 2 ^ 32 - sp_fit : s₀.sp.toNat + 4 ≤ 2 ^ 32 - -theorem pre_of {s₀ : State} (h : Proof.Hmac.initSha256Arm.pre s₀) : Pre s₀ := by - obtain ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16⟩ := h - exact ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16⟩ - -theorem K0_length (s₀ : State) (hp : Pre s₀) : (K0 s₀).length = 64 := by - simp [K0, bytesAt_length]; have := hp.kl_le; omega_nat - -theorem blockKey_eq {s₀ : State} (hp : Pre s₀) : - blockKey sha256 (bytesAt s₀.mem (kA s₀) (kl s₀)) = K0 s₀ := by - have := hp.kl_le - simp [blockKey, sha256, K0, bytesAt_length, show ¬ (64 < kl s₀) by omega_nat] - -theorem arg_in {s₀ : State} (hp : Pre s₀) : InRegions (s₀.rd ++ s₀.wr) (stackArgAddr s₀ 0) 4 := - ⟨argR s₀, by simp [hp.rd], Region.contains_self _ _⟩ - -/-! ## `H⁽⁰⁾` -/ - -open VG.Proof.MdStream.Arm.WP (cons) - -/-- The three instructions storing the 32-bit word `x` at `[b + off]`. -/ -def word (b : Reg) (x : BitVec 32) (off : Nat) : List Instr := - [.movw .r12 (x.extractLsb' 0 16), .movt .r12 (x.extractLsb' 16 16), .str .r12 b off] - -theorem h0_eq (b : Reg) : h0 b = word b H0[0] 0 ++ word b H0[1] 4 ++ word b H0[2] 8 ++ word b H0[3] 12 ++ - word b H0[4] 16 ++ word b H0[5] 20 ++ word b H0[6] 24 ++ word b H0[7] 28 := rfl - -theorem word_ok {b : Reg} (hb : b ≠ .r12) {x : BitVec 32} {off : Nat} (ho : off < 4096) - {rest : List Instr} {s : State} {Q : State → Prop} (hfit : (s.gpr b).toNat + off < 2 ^ 32) - (hout : InRegions s.wr (State.addr (s.gpr b) + BitVec.ofNat 64 off) 4) - (k : ∀ s', (∀ r, r ≠ .r12 → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → s'.sp = s.sp → - s'.mem = s.mem.writeW (State.addr (s.gpr b) + BitVec.ofNat 64 off) x → WP isa (.block rest) s' Q) : - WP isa (.block (word b x off ++ rest)) s Q := by - simp only [word, List.cons_append, List.nil_append] - refine cons rfl (cons rfl ?_) - refine wp_str ho (by simp only [State.setReg, hb, ite_false]; exact addr_add hfit) hout fun s' u => ?_ - refine k s' (fun r hr => by rw [u.gpr]; simp [State.setReg, hr]) u.rd u.wr u.sp ?_ - rw [u.mem] - simp only [State.setReg, ite_true, movw_movt] - -/-- `H⁽⁰⁾` stored at `b`. -/ -theorem h0_ok {b : Reg} (hb : b ≠ .r12) {s : State} {rest : List Instr} {Q : State → Prop} - (hfit : (s.gpr b).toNat + 32 ≤ 2 ^ 32) - (o : ∀ k < 8, InRegions s.wr (State.addr (s.gpr b) + BitVec.ofNat 64 (4 * k)) 4) - (k : ∀ s', (∀ r, r ≠ .r12 → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → s'.sp = s.sp → - s'.mem = writeState s.mem (State.addr (s.gpr b)) H0 → WP isa (.block rest) s' Q) : - WP isa (.block (h0 b ++ rest)) s Q := by - rw [h0_eq] - simp only [List.append_assoc] - refine word_ok hb (by decide) (by omega_nat) (o 0 (by omega_nat)) fun s1 g1 _ wr1 sp1 m1 => ?_ - have k1 : s1.gpr b = s.gpr b := g1 _ hb - refine word_ok hb (by decide) (by rw [k1]; omega_nat) (by rw [wr1, k1]; exact o 1 (by omega_nat)) - fun s2 g2 _ wr2 sp2 m2 => ?_ - have k2 : s2.gpr b = s.gpr b := by rw [g2 _ hb, k1] - have w2 : s2.wr = s.wr := by rw [wr2, wr1] - refine word_ok hb (by decide) (by rw [k2]; omega_nat) (by rw [w2, k2]; exact o 2 (by omega_nat)) - fun s3 g3 _ wr3 sp3 m3 => ?_ - have k3 : s3.gpr b = s.gpr b := by rw [g3 _ hb, k2] - have w3 : s3.wr = s.wr := by rw [wr3, w2] - refine word_ok hb (by decide) (by rw [k3]; omega_nat) (by rw [w3, k3]; exact o 3 (by omega_nat)) - fun s4 g4 _ wr4 sp4 m4 => ?_ - have k4 : s4.gpr b = s.gpr b := by rw [g4 _ hb, k3] - have w4 : s4.wr = s.wr := by rw [wr4, w3] - refine word_ok hb (by decide) (by rw [k4]; omega_nat) (by rw [w4, k4]; exact o 4 (by omega_nat)) - fun s5 g5 _ wr5 sp5 m5 => ?_ - have k5 : s5.gpr b = s.gpr b := by rw [g5 _ hb, k4] - have w5 : s5.wr = s.wr := by rw [wr5, w4] - refine word_ok hb (by decide) (by rw [k5]; omega_nat) (by rw [w5, k5]; exact o 5 (by omega_nat)) - fun s6 g6 _ wr6 sp6 m6 => ?_ - have k6 : s6.gpr b = s.gpr b := by rw [g6 _ hb, k5] - have w6 : s6.wr = s.wr := by rw [wr6, w5] - refine word_ok hb (by decide) (by rw [k6]; omega_nat) (by rw [w6, k6]; exact o 6 (by omega_nat)) - fun s7 g7 _ wr7 sp7 m7 => ?_ - have k7 : s7.gpr b = s.gpr b := by rw [g7 _ hb, k6] - have w7 : s7.wr = s.wr := by rw [wr7, w6] - refine word_ok hb (by decide) (by rw [k7]; omega_nat) (by rw [w7, k7]; exact o 7 (by omega_nat)) - fun s8 g8 rd8 wr8 sp8 m8 => ?_ - rename_i rd1 rd2 rd3 rd4 rd5 rd6 rd7 - refine k s8 (fun r h => by rw [g8 r h, g7 r h, g6 r h, g5 r h, g4 r h, g3 r h, g2 r h, g1 r h]) - (by rw [rd8, rd7, rd6, rd5, rd4, rd3, rd2, rd1]) (by rw [wr8, w7]) - (by rw [sp8, sp7, sp6, sp5, sp4, sp3, sp2, sp1]) ?_ - rw [m8, m7, m6, m5, m4, m3, m2, m1, k7, k6, k5, k4, k3, k2, k1] - rfl - -/-- Writing a hash value stays within its 32 bytes. -/ -theorem writeState_frame (m : Mem) (p : Addr) (v : Spec.Sha256.HashValue) : - Frame [⟨p, 32⟩] m (writeState m p v) := by - have c : ∀ k, k < 8 → (⟨p, 32⟩ : Region).Contains (p + BitVec.ofNat 64 (4 * k)) (32 / 8) := - fun k hk => contains_offset (by omega_nat) (by omega_nat) - simp only [writeState] - refine (((((((((Frame.refl _ _).writeW ?_ _ (c 0 ?_)).writeW ?_ _ (c 1 ?_)).writeW ?_ _ - (c 2 ?_)).writeW ?_ _ (c 3 ?_)).writeW ?_ _ (c 4 ?_)).writeW ?_ _ (c 5 ?_)).writeW ?_ _ - (c 6 ?_)).writeW ?_ _ (c 7 ?_)) <;> simp - -/-! ## The key block -/ - -/-- The memory while building the two buffers: `j` bytes of `K₀ ⊕ ipad` and -`K₀ ⊕ opad` are written. -/ -structure BufMem (s₀ : State) (j : Nat) (m : Mem) : Prop where - stI : stateAt m (inA s₀) = H0 - stO : stateAt m (ouA s₀) = H0 - bufI : bytesAt m (inA s₀ + 32) j = ((K0 s₀).take j).map (· ^^^ ipad) - bufO : bytesAt m (ouA s₀ + 32) j = ((K0 s₀).take j).map (· ^^^ opad) - saved : Saved s₀ m - frame : Frame [inR s₀, ouR s₀, scR s₀] s₀.mem m - -/-- The registers while building the two buffers (`r7` = `j`). -/ -structure Buf (s₀ : State) (j : Nat) (s : State) : Prop where - j_le : j ≤ 64 - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - sp : s.sp = s₀.sp - r0 : s.gpr .r0 = inn s₀ - r4 : s.gpr .r4 = ou s₀ - r7 : s.gpr .r7 = BitVec.ofNat 32 j - r8 : s.gpr .r8 = 0x36 - r9 : s.gpr .r9 = 0x5c - mem : BufMem s₀ j s.mem - -/-- In the key loop: `r5` points at key byte `j`, and `r6` counts the key bytes left. -/ -structure Key (s₀ : State) (j : Nat) (s : State) : Prop extends Buf s₀ j s where - r5 : s.gpr .r5 = kp s₀ + BitVec.ofNat 32 j - r6 : s.gpr .r6 = BitVec.ofNat 32 (kl s₀ - j) - -/-- In the pad loop: `r6` counts the bytes left. -/ -structure Pad (s₀ : State) (j : Nat) (s : State) : Prop extends Buf s₀ j s where - r6 : s.gpr .r6 = BitVec.ofNat 32 (64 - j) - -theorem sub32 (p : Addr) : Region.Sub ⟨p, 32⟩ ⟨p, 96⟩ := Region.sub_prefix (by omega_nat) - -theorem save_sub (s₀ : State) : Region.Sub ⟨scA s₀ + BitVec.ofNat 64 112, 36⟩ (scR s₀) := - sub_offset (by omega_nat) (by omega_nat) - -/-- `Saved` survives a write outside the save area `scratch[112..148)`. -/ -theorem saved_frame {s₀ : State} {m m' : Mem} (h : Saved s₀ m) {rs : List Region} (hf : Frame rs m m') - (hd : ∀ r ∈ rs, Region.Disjoint ⟨scA s₀ + BitVec.ofNat 64 112, 36⟩ r) : Saved s₀ m' := by - intro p hp' - rw [← h p hp'] - refine hf.readW (r := ⟨scA s₀ + BitVec.ofNat 64 p.2, 4⟩) (Region.contains_self _ _) ?_ (by decide) - intro r hr - refine (hd r hr).sub_left ?_ - simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> - exact Offset.sub _ (by decide) (by decide) - -/-- `Saved` survives a write outside the scratch space. -/ -theorem saved_frame' {s₀ : State} {m m' : Mem} (h : Saved s₀ m) {rs : List Region} (hf : Frame rs m m') - (hd : ∀ r ∈ rs, (scR s₀).Disjoint r) : Saved s₀ m' := - saved_frame h hf fun r hr => (hd r hr).sub_left (save_sub s₀) - -theorem beq_zero_toNat (x : BitVec 32) : (x - 0 == 0) = decide (x.toNat = 0) := by - rw [show x - 0 = x by simp] - by_cases h : x.toNat = 0 - · simp [BitVec.eq_of_toNat_eq (show x.toNat = (0 : BitVec 32).toNat from h)] - · simp only [h, decide_false, beq_eq_false_iff_ne, ne_eq] - intro h'; exact h (by rw [h']; rfl) - -theorem prologue_ok {s₀ : State} (hp : Pre s₀) : - WP isa (.block (([.ldrSp .r12 0] : List Instr) ++ save .r12 ++ ([.mov .r4 (.reg .r1), .mov .r5 (.reg .r2), - .mov .r6 (.reg .r3)] : List Instr) ++ h0 .r0 ++ h0 .r4 ++ - ([.mov .r8 (.imm 0x36), .mov .r9 (.imm 0x5c), .mov .r7 (.imm 0), .cmp .r6 (.imm 0)] : List Instr))) s₀ - (fun s => Key s₀ 0 s ∧ s.z = decide (kl s₀ = 0)) := by - have hsc := hp.scr_fit; have hin := hp.in_fit; have hou := hp.ou_fit - simp only [List.append_assoc, List.cons_append, List.nil_append] - refine wp_ldrSp (a := stackArgAddr s₀ 0) (by decide) rfl (arg_in hp) fun s₁ u₁ => ?_ - have h12 : s₁.gpr .r12 = scr s₀ := u₁.gpr - refine save_ok (b := .r12) (by rw [h12]; omega_nat) (fun d hd₁ hd₂ => ⟨scR s₀, by simp [u₁.wr, hp.wr], - by rw [h12]; exact contains_offset (by omega_nat) (by omega_nat)⟩) fun s₂ g₂ rd₂ wr₂ sp₂ m₂ => ?_ - refine wp_mov (op2_reg _ _) fun s₃ u₃ => wp_mov (op2_reg _ _) fun s₄ u₄ => - wp_mov (op2_reg _ _) fun s₅ u₅ => ?_ - have k₅ : ∀ r, r ≠ .r4 → r ≠ .r5 → r ≠ .r6 → r ≠ .r12 → s₅.gpr r = s₀.gpr r := fun r a b c d => by - rw [u₅.other r c, u₄.other r b, u₃.other r a, g₂, u₁.other r d] - have h0₅ : s₅.gpr .r0 = inn s₀ := k₅ _ (by decide) (by decide) (by decide) (by decide) - have h4₅ : s₅.gpr .r4 = ou s₀ := by - rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, g₂, u₁.other _ (by decide)] - have h5₅ : s₅.gpr .r5 = kp s₀ := by - rw [u₅.other _ (by decide), u₄.gpr, u₃.other _ (by decide), g₂, u₁.other _ (by decide)] - have h6₅ : s₅.gpr .r6 = s₀.gpr .r3 := by - rw [u₅.gpr, u₄.other _ (by decide), u₃.other _ (by decide), g₂, u₁.other _ (by decide)] - have m₅ : s₅.mem = saveMem s₀.mem (scA s₀) s₁.gpr saved := by - rw [u₅.mem, u₄.mem, u₃.mem, m₂, u₁.mem, h12] - have rd₅ : s₅.rd = s₀.rd := by rw [u₅.rd, u₄.rd, u₃.rd, rd₂, u₁.rd] - have wr₅ : s₅.wr = s₀.wr := by rw [u₅.wr, u₄.wr, u₃.wr, wr₂, u₁.wr] - have sp₅ : s₅.sp = s₀.sp := by rw [u₅.sp, u₄.sp, u₃.sp, sp₂, u₁.sp] - refine h0_ok (b := .r0) (by decide) (by rw [h0₅]; omega_nat) (fun k hk => ⟨inR s₀, by simp [wr₅, hp.wr], by - rw [h0₅]; exact contains_offset (by omega_nat) (by omega_nat)⟩) fun s₆ g₆ rd₆ wr₆ sp₆ m₆ => ?_ - have h4₆ : s₆.gpr .r4 = ou s₀ := by rw [g₆ _ (by decide), h4₅] - refine h0_ok (b := .r4) (by decide) (by rw [h4₆]; omega_nat) (fun k hk => ⟨ouR s₀, by simp [wr₆, wr₅, hp.wr], by - rw [h4₆]; exact contains_offset (by omega_nat) (by omega_nat)⟩) fun s₇ g₇ rd₇ wr₇ sp₇ m₇ => ?_ - refine wp_mov (op2_imm (by decide)) fun s₈ u₈ => wp_mov (op2_imm (by decide)) fun s₉ u₉ => - wp_mov (op2_imm (by decide)) fun s₁₀ u₁₀ => wp_cmp (op2_imm (by decide)) fun s₁₁ f₁₁ z₁₁ => - WP.block_nil ?_ - have k : ∀ r, r ≠ .r12 → r ≠ .r7 → r ≠ .r8 → r ≠ .r9 → s₁₁.gpr r = s₅.gpr r := fun r a b c d => by - rw [f₁₁.gpr, u₁₀.other r b, u₉.other r d, u₈.other r c, g₇ r a, g₆ r a] - rw [h0₅] at m₆ - rw [h4₆] at m₇ - have hm : s₁₁.mem = writeState (writeState (saveMem s₀.mem (scA s₀) s₁.gpr saved) (inA s₀) H0) (ouA s₀) H0 := by - rw [f₁₁.mem, u₁₀.mem, u₉.mem, u₈.mem, m₇, m₆, m₅] - have fS : Frame [scR s₀] s₀.mem (saveMem s₀.mem (scA s₀) s₁.gpr saved) := - saveMem_frame s₀.mem (scA s₀) s₁.gpr saved fun p hp' => - (VG.Proof.Sha256.Arm.Stream.saved_bound p hp').1 - have fI := writeState_frame (saveMem s₀.mem (scA s₀) s₁.gpr saved) (inA s₀) H0 - have fO := writeState_frame (writeState (saveMem s₀.mem (scA s₀) s₁.gpr saved) (inA s₀) H0) (ouA s₀) H0 - have ds : ∀ p : Addr, ∀ r : Region, r.Disjoint ⟨p, 96⟩ → r.Disjoint ⟨p, 32⟩ := - fun p r h => h.sub_right (sub32 p) - refine ⟨⟨⟨by omega_nat, by rw [f₁₁.rd, u₁₀.rd, u₉.rd, u₈.rd, rd₇, rd₆, rd₅], - by rw [f₁₁.wr, u₁₀.wr, u₉.wr, u₈.wr, wr₇, wr₆, wr₅], by rw [f₁₁.sp, u₁₀.sp, u₉.sp, u₈.sp, sp₇, sp₆, sp₅], - by rw [k _ (by decide) (by decide) (by decide) (by decide), h0₅], - by rw [k _ (by decide) (by decide) (by decide) (by decide), h4₅], - by rw [f₁₁.gpr, u₁₀.gpr]; rfl, - by rw [f₁₁.gpr, u₁₀.other _ (by decide), u₉.other _ (by decide), u₈.gpr], - by rw [f₁₁.gpr, u₁₀.other _ (by decide), u₉.gpr], - ⟨?_, ?_, by simp [bytesAt], by simp [bytesAt], ?_, ?_⟩⟩, ?_, ?_⟩, ?_⟩ - · rw [hm] - refine (Proof.Sha256.Stream.stateAt_congr fun i hi => ?_).trans - (stateAt_writeState (saveMem s₀.mem (scA s₀) s₁.gpr saved) _ _) - exact frame_bytes fO (R := ⟨inA s₀, 32⟩) (by simpa using ds _ _ (hp.i_o.sub_left (sub32 _))) (by simp) hi - · rw [hm, stateAt_writeState] - · rw [hm] - refine saved_frame' (saved_frame' (fun p hp' => ?_) fI ?_) fO ?_ - · rw [saveMem_saved _ _ _ p hp', u₁.other] - simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> decide - all_goals simp only [List.mem_singleton]; rintro r rfl - · exact ds _ _ hp.i_s.symm - · exact ds _ _ hp.o_s.symm - · rw [hm] - refine ((fS.mono ?_).trans (fI.sub ?_)).trans (fO.sub ?_) - · simp - · simp only [List.mem_singleton]; rintro r rfl; exact ⟨inR s₀, by simp, sub32 _⟩ - · simp only [List.mem_singleton]; rintro r rfl; exact ⟨ouR s₀, by simp, sub32 _⟩ - · rw [k _ (by decide) (by decide) (by decide) (by decide), h5₅]; simp - · rw [f₁₁.gpr, u₁₀.other _ (by decide), u₉.other _ (by decide), u₈.other _ (by decide), - g₇ _ (by decide), g₆ _ (by decide), h6₅]; simp - · rw [z₁₁, u₁₀.other _ (by decide), u₉.other _ (by decide), u₈.other _ (by decide), - g₇ _ (by decide), g₆ _ (by decide), h6₅, beq_zero_toNat] - -/-- A byte written right after `j` bytes of a buffer, in both buffers. -/ -theorem buf_write {s₀ : State} (hp : Pre s₀) {j : Nat} {m : Mem} (h : BufMem s₀ j m) (hj : j < 64) : - BufMem s₀ (j + 1) ((m.writeW (inA s₀ + 32 + BitVec.ofNat 64 j) - ((K0 s₀)[j]'(by rw [K0_length s₀ hp]; omega_nat) ^^^ ipad)).writeW - (ouA s₀ + 32 + BitVec.ofNat 64 j) ((K0 s₀)[j]'(by rw [K0_length s₀ hp]; omega_nat) ^^^ opad)) := by - have hl : j < (K0 s₀).length := by rw [K0_length s₀ hp]; omega_nat - set x := (K0 s₀)[j] ^^^ ipad - set y := (K0 s₀)[j] ^^^ opad - let bI : Region := ⟨inA s₀ + 32, 64⟩ - let bO : Region := ⟨ouA s₀ + 32, 64⟩ - have sI : Region.Sub bI (inR s₀) := sub_offset (off := 32) (by omega_nat) (by omega_nat) - have sO : Region.Sub bO (ouR s₀) := sub_offset (off := 32) (by omega_nat) (by omega_nat) - have f₁ : Frame [bI] m (m.writeW (inA s₀ + 32 + BitVec.ofNat 64 j) x) := - (Frame.refl _ _).writeW (List.mem_singleton_self _) x (contains_offset (by omega_nat) (by omega_nat)) - have f₂ : Frame [bO] (m.writeW (inA s₀ + 32 + BitVec.ofNat 64 j) x) - ((m.writeW (inA s₀ + 32 + BitVec.ofNat 64 j) x).writeW (ouA s₀ + 32 + BitVec.ofNat 64 j) y) := - (Frame.refl _ _).writeW (List.mem_singleton_self _) y (contains_offset (by omega_nat) (by omega_nat)) - have F := (f₁.mono (rs' := [bI, bO]) (by simp)).trans (f₂.mono (by simp)) - have dIO : bI.Disjoint bO := (hp.i_o.sub_left sI).sub_right sO - have st : ∀ p : Addr, (∀ r ∈ [bI, bO], Region.Disjoint ⟨p, 32⟩ r) → - stateAt ((m.writeW (inA s₀ + 32 + BitVec.ofNat 64 j) x).writeW (ouA s₀ + 32 + BitVec.ofNat 64 j) y) p = - stateAt m p := - fun p hd => Proof.Sha256.Stream.stateAt_congr fun i hi => frame_bytes F (R := ⟨p, 32⟩) hd (by simp) hi - have self : ∀ q : Addr, Region.Disjoint ⟨q, 32⟩ ⟨q + 32, 64⟩ := fun q => - Offset.base_disjoint q (e := 32) (by omega_nat) (by omega_nat) - refine ⟨?_, ?_, ?_, ?_, saved_frame' h.saved F ?_, h.frame.trans (F.sub ?_)⟩ - · rw [st _ ?_, h.stI] - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact self _ - · exact (hp.i_o.sub_left (sub32 _)).sub_right sO - · rw [st _ ?_, h.stO] - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact (hp.i_o.symm.sub_left (sub32 _)).sub_right sI - · exact self _ - · rw [Proof.Sha256.Stream.bytesAt_congr - (fun i hi => frame_bytes f₂ (R := ⟨inA s₀ + 32, j + 1⟩) ?_ (by simp; omega_nat) hi), - bytesAt_snoc _ _ (by omega_nat), h.bufI, List.take_succ_eq_append_getElem hl, List.map_append] - · rfl - · simp only [List.mem_singleton]; rintro r rfl - exact dIO.sub_left (Region.sub_prefix (by omega_nat)) - · rw [bytesAt_snoc _ _ (by omega_nat), - Proof.Sha256.Stream.bytesAt_congr - (fun i hi => frame_bytes f₁ (R := ⟨ouA s₀ + 32, j⟩) ?_ (by simp; omega_nat) hi), - h.bufO, List.take_succ_eq_append_getElem hl, List.map_append] - · rfl - · simp only [List.mem_singleton]; rintro r rfl - exact dIO.symm.sub_left (Region.sub_prefix (by omega_nat)) - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact hp.i_s.symm.sub_right sI - · exact hp.o_s.symm.sub_right sO - · simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact ⟨inR s₀, by simp, sI⟩ - · exact ⟨ouR s₀, by simp, sO⟩ - -/-! ## The key and pad loops -/ - -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 := - cons (s' := s.setReg d (s.gpr n ^^^ y)) (by simp [exec, ho]) (k _ (Upd.setReg _ _ _)) - -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] - -theorem K0_lt {s₀ : State} {j : Nat} (hj : j < kl s₀) (h : j < (K0 s₀).length) : - (K0 s₀)[j] = s₀.mem (kA s₀ + BitVec.ofNat 64 j) := by - simp only [K0] - rw [List.getElem_append_left (by rw [bytesAt_length]; exact hj)] - simp [bytesAt] - -theorem K0_ge {s₀ : State} {j : Nat} (hj : kl s₀ ≤ j) (h : j < (K0 s₀).length) : (K0 s₀)[j] = 0 := by - simp only [K0] - rw [List.getElem_append_right (by rw [bytesAt_length]; exact hj)] - simp - -/-- Byte `j` of a state's buffer, addressed as `[p + j, #32]`. -/ -theorem buf_addr {p : BitVec 32} (hp : p.toNat + 96 ≤ 2 ^ 32) {j : Nat} (hj : j < 64) : - State.addr (p + BitVec.ofNat 32 j + BitVec.ofNat 32 32) = State.addr p + 32 + BitVec.ofNat 64 j := by - rw [BitVec.add_assoc, ← BitVec.ofNat_add, addr_add (by omega_nat), Nat.add_comm, BitVec.ofNat_add, - ← BitVec.add_assoc] - rfl - -theorem buf_in {s₀ : State} (hp : Pre s₀) {s : State} (hwr : s.wr = s₀.wr) {j : Nat} (hj : j < 64) - {p : Addr} (hpR : p = inA s₀ ∨ p = ouA s₀) : InRegions s.wr (p + 32 + BitVec.ofNat 64 j) 1 := by - refine ⟨⟨p, 96⟩, by rcases hpR with rfl | rfl <;> simp [hwr, hp.wr], ?_⟩ - rw [BitVec.add_assoc, show (32 : Addr) + BitVec.ofNat 64 j = BitVec.ofNat 64 (32 + j) by - rw [BitVec.ofNat_add]; rfl] - exact contains_offset (by omega_nat) (by omega_nat) - -theorem ofNat_succ (j : Nat) : BitVec.ofNat 32 j + 1 = BitVec.ofNat 32 (j + 1) := by - rw [BitVec.ofNat_add]; rfl - -def keyBody : List Instr := - [.ldrb .r12 .r5 0, - .dp .eor .r1 .r12 (.reg .r8), .dp .add .r2 .r0 (.reg .r7), .strb .r1 .r2 32, - .dp .eor .r1 .r12 (.reg .r9), .dp .add .r2 .r4 (.reg .r7), .strb .r1 .r2 32, - .dp .add .r5 .r5 (.imm 1), .dp .add .r7 .r7 (.imm 1), .subs .r6 .r6 (.imm 1)] - -theorem keyLoop_eq : keyLoop = .loop (.block keyBody) .ne := rfl - -theorem key_step {s₀ : State} (hp : Pre s₀) {j : Nat} (hj : j < kl s₀) {s : State} (h : Key s₀ j s) : - WP isa (.block keyBody) s fun s' => Key s₀ (j + 1) s' ∧ s'.z = decide (kl s₀ - (j + 1) = 0) := by - have hkl := hp.kl_le; have hkf := hp.k_fit; have hin := hp.in_fit; have hou := hp.ou_fit - have hl : j < (K0 s₀).length := by rw [K0_length s₀ hp]; omega_nat - have hinr : InRegions (s.rd ++ s.wr) (kA s₀ + BitVec.ofNat 64 j) 1 := - ⟨kR s₀, by simp [h.rd, hp.rd], contains_offset (by omega_nat) (by omega_nat)⟩ - have hbyte : s.mem (kA s₀ + BitVec.ofNat 64 j) = (K0 s₀)[j] := by - rw [K0_lt hj hl] - refine frame_bytes h.mem.frame (R := kR s₀) ?_ (by show kl s₀ ≤ 2 ^ 64; omega_nat) hj - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact hp.k_i - · exact hp.k_o - · exact hp.k_s - unfold keyBody - refine wp_ldrb (a := kA s₀ + BitVec.ofNat 64 j) (by omega_nat) - (by rw [h.r5, BitVec.add_zero, addr_add (by omega_nat)]) hinr - fun s₁ u₁ => ?_ - refine wp_eor (op2_reg _ _) fun s₂ u₂ => wp_add (op2_reg _ _) fun s₃ u₃ => ?_ - refine wp_strb (a := inA s₀ + 32 + BitVec.ofNat 64 j) (by omega_nat) ?_ - (by rw [u₃.wr, u₂.wr, u₁.wr]; exact buf_in hp h.wr (by omega_nat) (.inl rfl)) fun s₄ u₄ => ?_ - · simp (config := {decide := true}) only [u₃.gpr, u₂.other, u₁.other, h.r0, h.r7] - exact buf_addr hin (by omega_nat) - refine wp_eor (op2_reg _ _) fun s₅ u₅ => wp_add (op2_reg _ _) fun s₆ u₆ => ?_ - refine wp_strb (a := ouA s₀ + 32 + BitVec.ofNat 64 j) (by omega_nat) ?_ - (by rw [u₆.wr, u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr]; exact buf_in hp h.wr (by omega_nat) (.inr rfl)) - fun s₇ u₇ => ?_ - · simp (config := {decide := true}) only [u₆.gpr, u₅.other, u₄.gpr, u₃.other, u₂.other, u₁.other, - h.r4, h.r7] - exact buf_addr hou (by omega_nat) - refine wp_add (op2_imm (by decide)) fun s₈ u₈ => wp_add (op2_imm (by decide)) fun s₉ u₉ => - wp_subs (op2_imm (by decide)) fun s₁₀ u₁₀ z₁₀ => WP.block_nil ?_ - have k : ∀ r, r ≠ .r12 → r ≠ .r1 → r ≠ .r2 → r ≠ .r5 → r ≠ .r6 → r ≠ .r7 → s₁₀.gpr r = s.gpr r := - fun r a b c d e f => by - rw [u₁₀.other r e, u₉.other r f, u₈.other r d, u₇.gpr, u₆.other r c, u₅.other r b, u₄.gpr, - u₃.other r c, u₂.other r b, u₁.other r a] - have v₁ : (s₃.gpr .r1).setWidth 8 = (K0 s₀)[j] ^^^ ipad := by - simp (config := {decide := true}) only [u₃.other, u₂.gpr, u₁.gpr, u₁.other, h.r8, xor_byte, hbyte] - rfl - have v₂ : (s₆.gpr .r1).setWidth 8 = (K0 s₀)[j] ^^^ opad := by - simp (config := {decide := true}) only [u₆.other, u₅.gpr, u₄.gpr, u₃.other, u₂.other, u₁.gpr, - u₁.other, h.r9, xor_byte, hbyte] - rfl - have hm : s₁₀.mem = (s.mem.writeW (inA s₀ + 32 + BitVec.ofNat 64 j) ((K0 s₀)[j] ^^^ ipad)).writeW - (ouA s₀ + 32 + BitVec.ofNat 64 j) ((K0 s₀)[j] ^^^ opad) := by - rw [u₁₀.mem, u₉.mem, u₈.mem, u₇.mem, v₂, u₆.mem, u₅.mem, u₄.mem, v₁, u₃.mem, u₂.mem, u₁.mem] - have r6 : s₉.gpr .r6 = BitVec.ofNat 32 (kl s₀ - j) := by - simp (config := {decide := true}) only [u₉.other, u₈.other, u₇.gpr, u₆.other, u₅.other, - u₄.gpr, u₃.other, u₂.other, u₁.other, h.r6] - refine ⟨⟨⟨by omega_nat, by rw [u₁₀.rd, u₉.rd, u₈.rd, u₇.rd, 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, u₄.wr, u₃.wr, u₂.wr, u₁.wr, h.wr], - by rw [u₁₀.sp, u₉.sp, u₈.sp, u₇.sp, u₆.sp, u₅.sp, u₄.sp, u₃.sp, u₂.sp, u₁.sp, h.sp], - by rw [k _ (by decide) (by decide) (by decide) (by decide) (by decide) (by decide), h.r0], - by rw [k _ (by decide) (by decide) (by decide) (by decide) (by decide) (by decide), h.r4], ?_, - by rw [k _ (by decide) (by decide) (by decide) (by decide) (by decide) (by decide), h.r8], - by rw [k _ (by decide) (by decide) (by decide) (by decide) (by decide) (by decide), h.r9], - by rw [hm]; exact buf_write hp h.mem (by omega_nat)⟩, ?_, ?_⟩, ?_⟩ - · simp (config := {decide := true}) only [u₁₀.other, u₉.gpr, u₈.other, u₇.gpr, u₆.other, u₅.other, - u₄.gpr, u₃.other, u₂.other, u₁.other, h.r7] - exact ofNat_succ j - · simp (config := {decide := true}) only [u₁₀.other, u₉.other, u₈.gpr, u₇.gpr, u₆.other, u₅.other, - u₄.gpr, u₃.other, u₂.other, u₁.other, h.r5] - rw [BitVec.add_assoc, ofNat_succ] - · rw [u₁₀.gpr, r6, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat (by omega_nat), Nat.sub_sub] - · rw [z₁₀, r6, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_beq (by omega_nat) (by omega_nat)] - simp only [decide_eq_decide]; omega_nat - -def padBody : List Instr := - [.dp .add .r2 .r0 (.reg .r7), .strb .r8 .r2 32, .dp .add .r2 .r4 (.reg .r7), - .strb .r9 .r2 32, .dp .add .r7 .r7 (.imm 1), .subs .r6 .r6 (.imm 1)] - -theorem padLoop_eq : padLoop = .loop (.block padBody) .ne := rfl - -theorem ipad_byte : (0x36 : BitVec 32).setWidth 8 = (0 : Byte) ^^^ ipad := by decide -theorem opad_byte : (0x5c : BitVec 32).setWidth 8 = (0 : Byte) ^^^ opad := by decide - -theorem pad_step {s₀ : State} (hp : Pre s₀) {j : Nat} (hj : kl s₀ ≤ j) (hj' : j < 64) {s : State} - (h : Pad s₀ j s) : WP isa (.block padBody) s fun s' => Pad s₀ (j + 1) s' ∧ s'.z = decide (64 - (j + 1) = 0) := by - have hin := hp.in_fit; have hou := hp.ou_fit - have hl : j < (K0 s₀).length := by rw [K0_length s₀ hp]; omega_nat - unfold padBody - refine wp_add (op2_reg _ _) fun s₁ u₁ => ?_ - refine wp_strb (a := inA s₀ + 32 + BitVec.ofNat 64 j) (by omega_nat) ?_ - (by rw [u₁.wr]; exact buf_in hp h.wr hj' (.inl rfl)) fun s₂ u₂ => ?_ - · rw [u₁.gpr, h.r0, h.r7]; exact buf_addr hin hj' - refine wp_add (op2_reg _ _) fun s₃ u₃ => ?_ - refine wp_strb (a := ouA s₀ + 32 + BitVec.ofNat 64 j) (by omega_nat) ?_ - (by rw [u₃.wr, u₂.wr, u₁.wr]; exact buf_in hp h.wr hj' (.inr rfl)) fun s₄ u₄ => ?_ - · simp (config := {decide := true}) only [u₃.gpr, u₂.gpr, u₁.other, h.r4, h.r7] - exact buf_addr hou hj' - refine wp_add (op2_imm (by decide)) fun s₅ u₅ => wp_subs (op2_imm (by decide)) fun s₆ u₆ z₆ => - WP.block_nil ?_ - have k : ∀ r, r ≠ .r2 → r ≠ .r6 → r ≠ .r7 → s₆.gpr r = s.gpr r := fun r a b c => by - rw [u₆.other r b, u₅.other r c, u₄.gpr, u₃.other r a, u₂.gpr, u₁.other r a] - have hm : s₆.mem = (s.mem.writeW (inA s₀ + 32 + BitVec.ofNat 64 j) ((K0 s₀)[j] ^^^ ipad)).writeW - (ouA s₀ + 32 + BitVec.ofNat 64 j) ((K0 s₀)[j] ^^^ opad) := by - simp (config := {decide := true}) only [u₆.mem, u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₁.mem, u₃.other, - u₂.gpr, u₁.other, h.r8, h.r9, K0_ge hj hl, ipad_byte, opad_byte] - have r6 : s₅.gpr .r6 = BitVec.ofNat 32 (64 - j) := by - simp (config := {decide := true}) only [u₅.other, u₄.gpr, u₃.other, u₂.gpr, u₁.other, h.r6] - refine ⟨⟨⟨by omega_nat, 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], - by rw [k _ (by decide) (by decide) (by decide), h.r0], - by rw [k _ (by decide) (by decide) (by decide), h.r4], ?_, - by rw [k _ (by decide) (by decide) (by decide), h.r8], - by rw [k _ (by decide) (by decide) (by decide), h.r9], - by rw [hm]; exact buf_write hp h.mem hj'⟩, ?_⟩, ?_⟩ - · simp (config := {decide := true}) only [u₆.other, u₅.gpr, u₄.gpr, u₃.other, u₂.gpr, u₁.other, h.r7] - exact ofNat_succ j - · rw [u₆.gpr, r6, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat (by omega_nat), Nat.sub_sub] - · rw [z₆, r6, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_beq (by omega_nat) (by omega_nat)] - simp only [decide_eq_decide]; omega_nat - -theorem key_loop_ok {s₀ : State} (hp : Pre s₀) {s : State} (h : Key s₀ 0 s) (hk : 0 < kl s₀) : - WP isa keyLoop s (Buf s₀ (kl s₀)) := by - have := hp.kl_le - rw [keyLoop_eq] - refine WP.loop (M := isa) (fun n s => ∃ j, n = kl s₀ - j ∧ j < kl s₀ ∧ Key s₀ j s) ?_ (kl s₀) s - ⟨0, rfl, hk, h⟩ - rintro n s ⟨j, rfl, hj, hb⟩ - refine WP.mono (key_step hp hj hb) fun s' ⟨hb', hz'⟩ => ?_ - have hz : isa.eval .ne s' = some (decide (kl s₀ - (j + 1) ≠ 0)) := by - show VG.Arm.eval .ne s' = _ - rw [eval_ne, hz'] - simp - by_cases hl : kl s₀ - (j + 1) = 0 - · refine .inl ⟨by rw [hz, decide_eq_false fun h => h hl], ?_⟩ - rw [show kl s₀ = j + 1 by omega_nat]; exact hb'.toBuf - · exact .inr ⟨by rw [hz, decide_eq_true hl], _, by omega_nat, j + 1, rfl, by omega_nat, hb'⟩ - -theorem pad_loop_ok {s₀ : State} (hp : Pre s₀) {s : State} (h : Pad s₀ (kl s₀) s) (hk : kl s₀ < 64) : - WP isa padLoop s (Buf s₀ 64) := by - rw [padLoop_eq] - refine WP.loop (M := isa) (fun n s => ∃ j, n = 64 - j ∧ kl s₀ ≤ j ∧ j < 64 ∧ Pad s₀ j s) ?_ - (64 - kl s₀) s ⟨kl s₀, rfl, (Nat.le_refl _), hk, h⟩ - rintro n s ⟨j, rfl, hj, hj', hb⟩ - refine WP.mono (pad_step hp hj hj' hb) fun s' ⟨hb', hz'⟩ => ?_ - have hz : isa.eval .ne s' = some (decide (64 - (j + 1) ≠ 0)) := by - show VG.Arm.eval .ne s' = _ - rw [eval_ne, hz'] - simp - by_cases hl : 64 - (j + 1) = 0 - · refine .inl ⟨by rw [hz, decide_eq_false fun h => h hl], ?_⟩ - rw [show (64 : Nat) = j + 1 by omega_nat]; exact hb'.toBuf - · exact .inr ⟨by rw [hz, decide_eq_true hl], _, by omega_nat, j + 1, rfl, by omega_nat, by omega_nat, hb'⟩ - -/-! ## The two compressions -/ - -theorem add32 {p : BitVec 32} (h : p.toNat + 96 ≤ 2 ^ 32) : - State.addr (p + 32) = State.addr p + 32 ∧ (p + 32).toNat = p.toNat + 32 := by - refine ⟨addr_add (k := 32) (by omega_nat), ?_⟩ - rw [BitVec.toNat_add, show (32 : BitVec 32).toNat = 32 from rfl, Nat.mod_eq_of_lt (by omega_nat)] - -/-- The inlined compression of the block in the buffer of the state at `p` -(the inner or the outer one). -/ -theorem compress_ok {s₀ : State} (hp : Pre s₀) {p : BitVec 32} (hpR : p = inn s₀ ∨ p = ou s₀) {s : State} - (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) (h0 : s.gpr .r0 = p) (h3 : s.gpr .r3 = scr s₀) - (h1 : s.gpr .r1 = p + 32) {Q : State → Prop} - (hQ : ∀ s', s'.rd = s.rd → s'.wr = s.wr → (∀ r ∈ preserved, r ≠ .lr → s'.gpr r = s.gpr r) → - s'.gpr .r0 = p → s'.gpr .r3 = scr s₀ → s'.sp = s.sp → - Frame [⟨State.addr p, 32⟩, ⟨scA s₀, 112⟩] s.mem s'.mem → - stateAt s'.mem (State.addr p) = - Spec.Sha256.compress (stateAt s.mem (State.addr p)) (Spec.Sha256.blockAt s.mem (State.addr p + 32)) → - Q s') : - WP isa compressAt s Q := by - have hs : Region.Disjoint ⟨State.addr p, 96⟩ (scR s₀) ∧ ⟨State.addr p, 96⟩ ∈ s₀.wr ∧ - p.toNat + 96 ≤ 2 ^ 32 := by - rcases hpR with rfl | rfl - · exact ⟨hp.i_s, by simp [hp.wr], hp.in_fit⟩ - · exact ⟨hp.o_s, by simp [hp.wr], hp.ou_fit⟩ - obtain ⟨d, hm, hf⟩ := hs - have hsc := hp.scr_fit - obtain ⟨ea, et⟩ := add32 hf - have e32 : Region.Sub ⟨State.addr p, 32⟩ ⟨State.addr p, 96⟩ := Region.sub_prefix (by omega_nat) - have eb : Region.Sub ⟨State.addr p + 32, 64⟩ ⟨State.addr p, 96⟩ := sub_offset (off := 32) (by omega_nat) (by omega_nat) - have e112 : Region.Sub ⟨scA s₀, 112⟩ (scR s₀) := Region.sub_prefix (by omega_nat) - refine compressAt_ok (st := p) (scr := scr s₀) (src := p + 32) h0 h3 h1 (by omega_nat) (by omega_nat) (by omega_nat) - ((d.sub_left e32).sub_right e112) ?_ (by rw [ea]; exact (d.sub_left eb).sub_right e112) ?_ ?_ - fun s' h₁ h₂ h₃ h₄ h₅ h₆ h₇ h₈ => hQ s' h₁ h₂ h₃ h₄ h₅ h₆ h₇ (by rw [h₈, ea]) - · rw [ea]; exact Offset.disjoint_base _ (d := 32) (by omega_nat) (by omega_nat) - · rw [hrd, hwr, ea] - apply Covers.of_sub - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact ⟨⟨State.addr p, 96⟩, by simp [hm], 32, rfl, by simp⟩ - · exact ⟨⟨State.addr p, 96⟩, by simp [hm], 0, by simp, by simp⟩ - · exact ⟨scR s₀, by simp [hp.wr], 0, by simp, by simp⟩ - · rw [hwr] - apply Covers.of_sub - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact ⟨⟨State.addr p, 96⟩, hm, 0, by simp, by simp⟩ - · exact ⟨scR s₀, by simp [hp.wr], 0, by simp, by simp⟩ - -/-- A state that a write outside it keeps. -/ -theorem state_frame {rs : List Region} {m m' : Mem} (hf : Frame rs m m') {p : Addr} - (hd : ∀ r ∈ rs, Region.Disjoint ⟨p, 96⟩ r) : - stateAt m' p = stateAt m p ∧ bytesAt m' (p + 32) 64 = bytesAt m (p + 32) 64 := by - refine ⟨Proof.Sha256.Stream.stateAt_congr fun i hi => - frame_bytes hf (R := ⟨p, 32⟩) (fun r hr => (hd r hr).sub_left (sub32 p)) (by simp) hi, - Proof.Sha256.Stream.bytesAt_congr fun i hi => - frame_bytes hf (R := ⟨p + 32, 64⟩) - (fun r hr => (hd r hr).sub_left (sub_offset (off := 32) (by omega_nat) (by omega_nat))) (by simp) hi⟩ - -/-! ## Epilogue -/ - -/-- The epilogue's postcondition. -/ -def Post (s₀ s' : State) : Prop := abiPreserved s₀ s' ∧ Proof.Hmac.initSha256Arm.post s₀ s' - -theorem epilogue_ok {s₀ : State} (hp : Pre s₀) {s : State} (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) - (h3 : s.gpr .r3 = scr s₀) (hsp : s.sp = s₀.sp) (hsv : Saved s₀ s.mem) - (hI : Repr s.mem (inA s₀) (xorPad (K0 s₀) ipad)) (hO : Repr s.mem (ouA s₀) (xorPad (K0 s₀) opad)) : - WP isa (.block restore) s (Post s₀) := by - refine restore_ok (scr := scr s₀) h3 hp.scr_fit - (fun d hd₁ hd₂ => ⟨scR s₀, by simp [hrd, hwr, hp.wr], contains_offset (by omega_nat) (by omega_nat)⟩) s₀.gpr - hsv fun s' hs ho hmem _ _ hsp' => ⟨⟨fun r hr => ?_, by rw [hsp', hsp]⟩, ?_⟩ - · simp only [preserved, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl - · exact hs (.r4, 112) (by simp [saved]) - · exact hs (.r5, 116) (by simp [saved]) - · exact hs (.r6, 120) (by simp [saved]) - · exact hs (.r7, 124) (by simp [saved]) - · exact hs (.r8, 128) (by simp [saved]) - · exact hs (.r9, 132) (by simp [saved]) - · exact hs (.r10, 136) (by simp [saved]) - · exact hs (.r11, 140) (by simp [saved]) - · exact hs (.lr, 144) (by simp [saved]) - · simp only [Proof.Hmac.initSha256Arm] - rw [blockKey_eq hp, hmem] - exact ⟨hI, hO⟩ - -/-! ## Correctness -/ - -theorem buf_full {s₀ : State} (hp : Pre s₀) {m : Mem} (h : BufMem s₀ 64 m) : - bytesAt m (inA s₀ + 32) 64 = xorPad (K0 s₀) ipad ∧ bytesAt m (ouA s₀ + 32) 64 = xorPad (K0 s₀) opad := by - rw [h.bufI, h.bufO, List.take_of_length_le (by rw [K0_length s₀ hp])] - exact ⟨rfl, rfl⟩ - -theorem correct {s₀ : State} (hp : Pre s₀) : WP isa init s₀ (Post s₀) := by - have hkl := hp.kl_le - unfold init - refine WP.seq (WP.mono (prologue_ok hp) fun s₁ ⟨h₁, z₁⟩ => ?_) - -- The key. - refine WP.seq (WP.mono (Q := Buf s₀ (kl s₀)) ?_ fun s₂ h₂ => ?_) - · refine WP.ite (decide (kl s₀ = 0)) (by show VG.Arm.eval .eq s₁ = _; rw [eval_eq, z₁]) - (fun hb => WP.block_nil ?_) (fun hb => key_loop_ok hp h₁ ?_) - · simp only [decide_eq_true_eq] at hb; rw [hb]; exact h₁.toBuf - · simp only [decide_eq_false_iff_not] at hb; omega_nat - -- The padding. - refine WP.seq (wp_mov (op2_imm (by decide)) fun s₃ u₃ => wp_subs (op2_reg _ _) fun s₄ u₄ z₄ => - WP.block_nil ?_) - have k₄ : ∀ r, r ≠ .r6 → s₄.gpr r = s₂.gpr r := fun r h => by rw [u₄.other r h, u₃.other r h] - have hP : Pad s₀ (kl s₀) s₄ := by - refine ⟨⟨h₂.j_le, by rw [u₄.rd, u₃.rd, h₂.rd], by rw [u₄.wr, u₃.wr, h₂.wr], - by rw [u₄.sp, u₃.sp, h₂.sp], by rw [k₄ _ (by decide), h₂.r0], by rw [k₄ _ (by decide), h₂.r4], - by rw [k₄ _ (by decide), h₂.r7], by rw [k₄ _ (by decide), h₂.r8], by rw [k₄ _ (by decide), h₂.r9], - by rw [u₄.mem, u₃.mem]; exact h₂.mem⟩, ?_⟩ - rw [u₄.gpr, u₃.gpr, u₃.other _ (by decide), h₂.r7, show (64 : BitVec 32) = BitVec.ofNat 32 64 from rfl, - sub_ofNat hkl] - have hz₄ : s₄.z = decide (64 - kl s₀ = 0) := by - rw [z₄, u₃.gpr, u₃.other _ (by decide), h₂.r7, show (64 : BitVec 32) = BitVec.ofNat 32 64 from rfl, - sub_beq (by omega_nat) (by omega_nat)] - simp only [decide_eq_decide]; omega_nat - refine WP.seq (WP.mono (Q := Buf s₀ 64) ?_ fun s₆ h₆ => ?_) - · refine WP.ite (decide (64 - kl s₀ = 0)) (by show VG.Arm.eval .eq s₄ = _; rw [eval_eq, hz₄]) - (fun hb => WP.block_nil ?_) (fun hb => pad_loop_ok hp hP ?_) - · simp only [decide_eq_true_eq] at hb - exact (show kl s₀ = 64 by omega_nat) ▸ hP.toBuf - · simp only [decide_eq_false_iff_not] at hb; omega_nat - obtain ⟨bI, bO⟩ := buf_full hp h₆.mem - -- The inner block. - refine WP.seq (wp_ldrSp (a := stackArgAddr s₀ 0) (by decide) (by rw [h₆.sp]; rfl) - (by rw [h₆.rd, h₆.wr]; exact arg_in hp) fun s₇ u₇ => wp_add (op2_imm (by decide)) fun s₈ u₈ => - WP.block_nil ?_) - have fW₆ : Frame s₀.wr s₀.mem s₆.mem := by rw [hp.wr]; exact h₆.mem.frame - have hsa : s₆.mem.readW (stackArgAddr s₀ 0) 32 = scr s₀ := by - refine fW₆.readW (r := argR s₀) (Region.contains_self _ _) ?_ (by decide) - intro r hr - simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact hp.a_i - · exact hp.a_o - · exact hp.a_s - have m₈ : s₈.mem = s₆.mem := by rw [u₈.mem, u₇.mem] - refine WP.seq (compress_ok hp (.inl rfl) (by rw [u₈.rd, u₇.rd, h₆.rd]) (by rw [u₈.wr, u₇.wr, h₆.wr]) - (by rw [u₈.other _ (by decide), u₇.other _ (by decide), h₆.r0]) - (by rw [u₈.other _ (by decide), u₇.gpr, hsa]) - (by rw [u₈.gpr, u₇.other _ (by decide), h₆.r0]) fun s₉ rd₉ wr₉ cs₉ r0₉ r3₉ sp₉ fr₉ st₉ => ?_) - have hI₉ : Repr s₉.mem (inA s₀) (xorPad (K0 s₀) ipad) := - repr_block (by rw [m₈]; exact h₆.mem.stI) (by rw [m₈]; exact bI) - (by simp [xorPad, K0_length s₀ hp]) st₉ - have dO : ∀ r ∈ [(⟨inA s₀, 32⟩ : Region), ⟨scA s₀, 112⟩], Region.Disjoint ⟨ouA s₀, 96⟩ r := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact hp.i_o.symm.sub_right (sub32 _) - · exact hp.o_s.sub_right (Region.sub_prefix (by omega_nat)) - obtain ⟨sO₉, bO₉⟩ := state_frame fr₉ dO - have sv₉ : Saved s₀ s₉.mem := by - refine saved_frame (by rw [m₈]; exact h₆.mem.saved) fr₉ ?_ - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact (hp.i_s.symm.sub_left (save_sub s₀)).sub_right (sub32 _) - · exact Offset.disjoint_base _ (d := 112) (by omega_nat) (by omega_nat) - -- The outer block. - refine WP.seq (wp_mov (op2_reg _ _) fun s₁₀ u₁₀ => wp_add (op2_imm (by decide)) fun s₁₁ u₁₁ => - WP.block_nil ?_) - have r4₉ : s₉.gpr .r4 = ou s₀ := by - rw [cs₉ _ (by decide) (by decide), u₈.other _ (by decide), u₇.other _ (by decide), h₆.r4] - have m₁₁ : s₁₁.mem = s₉.mem := by rw [u₁₁.mem, u₁₀.mem] - refine WP.seq (compress_ok hp (.inr rfl) (by rw [u₁₁.rd, u₁₀.rd, rd₉, u₈.rd, u₇.rd, h₆.rd]) - (by rw [u₁₁.wr, u₁₀.wr, wr₉, u₈.wr, u₇.wr, h₆.wr]) - (by rw [u₁₁.other _ (by decide), u₁₀.gpr, r4₉]) - (by rw [u₁₁.other _ (by decide), u₁₀.other _ (by decide), r3₉]) - (by rw [u₁₁.gpr, u₁₀.gpr, r4₉]) - fun s₁₂ rd₁₂ wr₁₂ cs₁₂ r0₁₂ r3₁₂ sp₁₂ fr₁₂ st₁₂ => ?_) - have hO : Repr s₁₂.mem (ouA s₀) (xorPad (K0 s₀) opad) := - repr_block (by rw [m₁₁, sO₉, m₈]; exact h₆.mem.stO) (by rw [m₁₁, bO₉, m₈]; exact bO) - (by simp [xorPad, K0_length s₀ hp]) st₁₂ - have hI : Repr s₁₂.mem (inA s₀) (xorPad (K0 s₀) ipad) := by - refine repr_congr (fun i hi => frame_bytes fr₁₂ (R := inR s₀) ?_ (by simp) hi) (m₁₁ ▸ hI₉) - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact hp.i_o.sub_right (sub32 _) - · exact hp.i_s.sub_right (Region.sub_prefix (by omega_nat)) - refine epilogue_ok hp (by rw [rd₁₂, u₁₁.rd, u₁₀.rd, rd₉, u₈.rd, u₇.rd, h₆.rd]) - (by rw [wr₁₂, u₁₁.wr, u₁₀.wr, wr₉, u₈.wr, u₇.wr, h₆.wr]) r3₁₂ - (by rw [sp₁₂, u₁₁.sp, u₁₀.sp, sp₉, u₈.sp, u₇.sp, h₆.sp]) ?_ hI hO - refine saved_frame (by rw [m₁₁]; exact sv₉) fr₁₂ ?_ - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact (hp.o_s.symm.sub_left (save_sub s₀)).sub_right (sub32 _) - · exact Offset.disjoint_base _ (d := 112) (by omega_nat) (by omega_nat) - -/-! ## `Verified` -/ - -/-- The initial taint: `r0`–`r3` (`inner`, `outer`, `key`, `key_len`) are -public, `r0` and `r1` point at the two states, and the 4 bytes of stack -arguments are public, pointing at the scratch space. -/ -def τ₀ : VG.Arm.Taint.T := - { regs := .ofList [.r0, .r1, .r2, .r3], flags := false, lens := [96, 96, 160], bases := [(.r0, 0), (.r1, 1)], - argLen := 4, argBases := [(0, 2)] } - -theorem wf₀ {s : State} (h : Proof.Hmac.initSha256Arm.pre s) : VG.Arm.Taint.Wf τ₀ s := by - have hp := pre_of h - have hi := hp.in_fit; have ho := hp.ou_fit; have hsc := hp.scr_fit; have hs := hp.sp_fit - refine ⟨fun _ => ⟨by simp [hp.wr, τ₀], ?_, ?_⟩, ?_, fun _ => ⟨hs, ?_⟩, ?_⟩ - · simp only [hp.wr, List.pairwise_cons, List.mem_cons, List.not_mem_nil, or_false, forall_eq_or_imp, - forall_eq, List.Pairwise.nil, and_true] - exact ⟨⟨hp.i_o, hp.i_s⟩, hp.o_s, fun _ h => h.elim⟩ - · simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) <;> simp only [addr_toNat] <;> omega_nat - · intro p hp' - simp only [τ₀, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl <;> simp [VG.Arm.Taint.region, hp.wr] - · have e : (⟨State.addr s.sp, 4⟩ : Region) = argR s := by simp [stackArgAddr] - simp only [τ₀, e, hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact hp.a_i - · exact hp.a_o - · exact hp.a_s - · intro p hp'; simp only [τ₀, List.mem_singleton] at hp'; subst hp' - refine ⟨by decide, ?_⟩ - simp only [VG.Arm.Taint.region, hp.wr] - rfl - -theorem argByte_eq (s : State) (k : Nat) : - VG.Arm.Taint.argByte s k = stackArgAddr s 0 + BitVec.ofNat 64 k := by - simp [VG.Arm.Taint.argByte, stackArgAddr] - -theorem agree₀ {s₁ s₂ : State} (h₁ : Proof.Hmac.initSha256Arm.pre s₁) - (h₂ : Proof.Hmac.initSha256Arm.pre s₂) (hpub : Proof.Hmac.initSha256Arm.pub s₁ s₂) : - VG.Arm.Taint.Agree τ₀ s₁ s₂ := by - obtain ⟨psp, p0, p1, p2, p3, a0⟩ := hpub - have hp₁ := pre_of h₁; have hp₂ := pre_of h₂ - refine ⟨⟨fun r hr => ?_, fun h => nomatch h⟩, fun _ => ?_, wf₀ h₁, wf₀ h₂, - fun _ h => (List.not_mem_nil h).elim, fun _ h => (List.not_mem_nil h).elim, fun _ => psp, fun k hk => ?_⟩ - · simp only [τ₀, RegSet.mem_ofList, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl <;> with_reducible assumption - · rw [hp₁.wr, hp₂.wr]; simp only [inR, ouR, scR, inA, ouA, scA, inn, ou, scr, p0, p1, a0] - · simp only [τ₀] at hk - rw [argByte_eq, argByte_eq, Mem.readW_byte s₁.mem _ hk, - Mem.readW_byte s₂.mem _ hk] - exact congrArg _ a0 - -/-- A state satisfying the precondition (with an empty key): `inner` at -`0x1000`, `outer` at `0x2000` and the scratch space at `0x4000`, passed on -the stack at `0x5000`. -/ -def sat : State where - gpr r := match r with - | .r0 => 0x1000 | .r1 => 0x2000 | .r2 => 0x3000 | _ => 0 - sp := 0x5000 - n := false - z := false - c := false - v := false - mem a := if a = 0x5001 then 0x40 else 0 - rd := [⟨0x3000, 0⟩, ⟨0x5000, 4⟩] - wr := [⟨0x1000, 96⟩, ⟨0x2000, 96⟩, ⟨0x4000, 160⟩] - -theorem init_correct (s : State) (hs : Proof.Hmac.initSha256Arm.pre s) : - ∃ t s', Exec isa init s t s' ∧ abiPreserved s s' ∧ Proof.Hmac.initSha256Arm.post s s' := by - obtain ⟨t, s', he, h⟩ := correct (pre_of hs) - exact ⟨t, s', he, h⟩ - -theorem init_ct : ConstantTime isa Proof.Hmac.initSha256Arm.pre Proof.Hmac.initSha256Arm.pub init := - by - exact VG.Taint.constantTime (A := taint) τ₀ (fun _ _ h₁ h₂ hp => agree₀ h₁ h₂ hp) - (by taint_decide) - -/-- `initSha256Arm` with the 608 bytes of scratch of the shared contract -(sized for the x86-64 AVX2 compression function), of which the code uses 160. -/ -def initWide : Contract isa := - { Proof.Hmac.initSha256Arm with - pre := fun s => - let inner : Region := ⟨State.addr (s.gpr .r0), 96⟩ - let outer : Region := ⟨State.addr (s.gpr .r1), 96⟩ - let key : Region := ⟨State.addr (s.gpr .r2), (s.gpr .r3).toNat⟩ - let scratch : Region := ⟨State.addr (stackArg s 0), 608⟩ - let args : Region := ⟨stackArgAddr s 0, 4⟩ - (s.gpr .r3).toNat ≤ 64 ∧ s.rd = [key, args] ∧ s.wr = [inner, outer, scratch] ∧ - inner.Disjoint outer ∧ inner.Disjoint scratch ∧ outer.Disjoint scratch ∧ - key.Disjoint inner ∧ key.Disjoint outer ∧ key.Disjoint scratch ∧ - args.Disjoint inner ∧ args.Disjoint outer ∧ args.Disjoint scratch ∧ - (s.gpr .r0).toNat + 96 ≤ 2 ^ 32 ∧ (s.gpr .r1).toNat + 96 ≤ 2 ^ 32 ∧ - (s.gpr .r2).toNat + (s.gpr .r3).toNat ≤ 2 ^ 32 ∧ (stackArg s 0).toNat + 608 ≤ 2 ^ 32 ∧ - s.sp.toNat + 4 ≤ 2 ^ 32 } - -/-- The regions `initSha256Arm` lets the code write. -/ -def narrowWr (s : State) : List Region := - [⟨State.addr (s.gpr .r0), 96⟩, ⟨State.addr (s.gpr .r1), 96⟩, ⟨State.addr (stackArg s 0), 160⟩] - -/-- Rewrites the contracts at a narrowed state (`stackArg` does not unfold -cheaply). -/ -local macro "narrow" loc:(Lean.Parser.Tactic.location)? : tactic => - `(tactic| simp only [Proof.Hmac.initSha256Arm, VG.Proof.Hmac.Arm.Init.initWide, VG.Proof.Hmac.Arm.Init.narrowWr, VG.Arm.stackArg_withRegions, VG.Arm.stackArgAddr_withRegions, - VG.Arm.State.withRegions_gpr, VG.Arm.State.withRegions_sp, VG.Arm.State.withRegions_mem, - VG.Arm.State.withRegions_rd, VG.Arm.State.withRegions_wr] $(loc)?) - -theorem initWide_pre (s : State) (h : initWide.pre s) : - Proof.Hmac.initSha256Arm.pre (s.withRegions s.rd (narrowWr s)) := by - obtain ⟨h₁, h₂, _, h₄, h₅, h₆, h₇, h₈, h₉, h₁₀, h₁₁, h₁₂, h₁₃, h₁₄, h₁₅, h₁₆, h₁₇⟩ := h - narrow - exact ⟨h₁, h₂, trivial, h₄, h₅.sub_right (Region.sub_of_ble rfl), - h₆.sub_right (Region.sub_of_ble rfl), h₇, h₈, h₉.sub_right (Region.sub_of_ble rfl), h₁₀, h₁₁, - h₁₂.sub_right (Region.sub_of_ble rfl), h₁₃, h₁₄, h₁₅, Region.end_le_of_ble rfl h₁₆, h₁₇⟩ - -/-- A state satisfying `initWide.pre`. -/ -def wideSat : State := { sat with wr := [⟨0x1000, 96⟩, ⟨0x2000, 96⟩, ⟨0x4000, 608⟩] } - -theorem initWide_implies : initWide.Implies (Spec.Hmac.initSha256Contract Arm.abi) := by - sig_implies [Spec.Hmac.initSha256Contract, Spec.Hmac.initSha256Sig, initWide, - Proof.Hmac.initSha256Arm, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] - [wideSat, sat, Arm.stackArg, Arm.stackArgAddr, Mem.readW, Mem.read] using wideSat - -/-- The proof is written against `initSha256Arm`, widened to the shared -contract's scratch. -/ -theorem init_verified : - Verified Arm.target Impl.Hmac.Arm.init (Spec.Hmac.initSha256Contract Arm.abi) := - have hsat := initWide_implies.sat_left - (Verified.widen (Verified.of_correct init_correct init_ct - (.refl (hsat.elim fun s hs => ⟨_, initWide_pre s hs⟩))) - narrowWr initWide_pre - (fun _ h => by - obtain ⟨_, _, h₃, _⟩ := h - rw [h₃] - exact .cons (Region.prefix_of_ble rfl) (.cons (Region.prefix_of_ble rfl) - (.cons (Region.prefix_of_ble rfl) .nil))) - (fun _ _ _ h => by narrow at h ⊢; exact h) - (fun _ _ _ _ h => by narrow; exact h) hsat).of_implies initWide_implies - -end VG.Proof.Hmac.Arm.Init diff --git a/lean/VerifiedGarbage/Proof/Hmac/Arm/Lit.lean b/lean/VerifiedGarbage/Proof/Hmac/Arm/Lit.lean deleted file mode 100644 index 8410c901b..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Arm/Lit.lean +++ /dev/null @@ -1,14 +0,0 @@ -import VerifiedGarbage.Proof.Framework.Arm.Lit -import VerifiedGarbage.Impl.Hmac.Arm -import VerifiedGarbage.Proof.Sha256.Arm.Lit - -/-! -# HMAC-SHA-256 on Arm: the code as literals --/ - -namespace VG - -materialize_code Impl.Hmac.Arm.init -materialize_code Impl.Hmac.Arm.finalize - -end VG diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hashes.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hashes.lean index 570b40ff5..9d2a22ac4 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hashes.lean +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Hashes.lean @@ -11,7 +11,7 @@ import VerifiedGarbage.Proof.Hmac.Generic.Common x86 (`Proof/Hmac/Generic/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. +value. SHA-256's and SHA-224's are in `Sha256.lean` and `Sha224.lean`. -/ namespace VG.Proof.Hmac.Generic.Arm diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha256.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha256.lean new file mode 100644 index 000000000..85851a51a --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha256.lean @@ -0,0 +1,88 @@ +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/Common.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/Common.lean index 402a1eec2..dce323c24 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/Common.lean +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/Common.lean @@ -9,9 +9,9 @@ import VerifiedGarbage.Proof.Framework.OmegaLit # HMAC over any streaming hash function: lemmas shared by every target Addresses and regions, the bytes `init`'s loops write, and the streaming -states of SHA-1, MD5 and the SHA-512 family moved between addresses, about -memory alone: every target's proof uses them, so they import no target's ISA -or proofs. +states of SHA-256, SHA-1, MD5 and the SHA-512 family moved between +addresses, about memory alone: every target's proof uses them, so they +import no target's ISA or proofs. -/ namespace VG.Proof.Hmac.Generic.Common @@ -227,6 +227,19 @@ theorem bytesAt_reloc {m m' : Mem} {p q : Addr} {n : Nat} have := List.mem_range.mp hi rw [BitVec.add_assoc, BitVec.add_assoc, ← BitVec.ofNat_add, h (o + i) (by omega_nat)] +/-- SHA-256's streaming state depends only on its 96 bytes. -/ +theorem sha256_repr (m m' : Mem) (p q : Addr) (msg : List Byte) + (h : ∀ i < 96, m' (q + BitVec.ofNat 64 i) = m (p + BitVec.ofNat 64 i)) + (hr : Spec.Sha256.Repr m p msg) : Spec.Sha256.Repr m' q msg := by + refine ⟨?_, ?_⟩ + · rw [← hr.1] + apply Vector.ext + intro j hj + simp only [Spec.Sha256.stateAt, Vector.getElem_ofFn] + exact readW_reloc h (by omega_nat) + · rw [← hr.2] + exact bytesAt_reloc h (o := 32) (k := msg.length % 64) (by omega_nat) + theorem sha1_repr (m m' : Mem) (p q : Addr) (msg : List Byte) (h : ∀ i < 84, m' (q + BitVec.ofNat 64 i) = m (p + BitVec.ofNat 64 i)) (hr : Spec.Sha1.Repr m p msg) : Spec.Sha1.Repr m' q msg := by diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hashes.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hashes.lean index c3328d474..8afe36e00 100644 --- a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hashes.lean +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Hashes.lean @@ -17,7 +17,8 @@ the other targets (`Proof/Hmac/Generic/Arm/Hashes.lean`). Their contracts are `update` and `finalize`, which hold from any initial hash value, and whose `finalize` only reads its arguments (`finKr`). Another hash function with streaming functions verified on x86 is one more `HashOK` here, and a -registration file for each of its functions. +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 diff --git a/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Sha256.lean b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Sha256.lean new file mode 100644 index 000000000..12e20eb4a --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Sha256.lean @@ -0,0 +1,115 @@ +import VerifiedGarbage.Proof.Hmac.Generic.X86.Instances +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 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`). +-/ + +namespace VG.Proof.Hmac.Generic.X86 + +open VG.X86 +open VG.Impl.Hmac.Generic.X86 (Hash) +open VG.Proof.Sha256.X86.Variants (hmacHash) + +/-- SHA-256's streaming `update` and `finalize` made with one implementation +of its compression function, named with its suffix (e.g. `_shani`; nothing +for the baseline implementation), verified against their per-target +contracts, which hold from any initial hash value; they keep `esp` and use +at most 20 bytes of stack. -/ +structure Sha256Stream where + suffix : String + upd : Prog isa + fin : Prog isa + updOK : Verified X86.target upd Proof.Sha256.updateX86 + finOK : Verified X86.target fin Proof.Sha256.finalizeX86 + updSp : NoSp upd + finSp : NoSp fin + updSU : stackUse upd ≤ 20 + finSU : stackUse fin ≤ 20 + +/-- SHA-256's streaming functions with `v`'s `update` and `finalize`. -/ +abbrev sha256H (v : Sha256Stream) : Hash := hmacHash v.suffix v.upd v.fin + +theorem sha256_initSp : NoSp Impl.Sha256.X86.Stream.init := nosp_of (by lit_decide) +theorem sha256_initSU : stackUse Impl.Sha256.X86.Stream.init ≤ 20 := by lit_decide + +/-- SHA-256's streaming functions with `v`'s `update` and `finalize`, verified. -/ +def sha256OK (v : Sha256Stream) : HashOK (sha256H v) where + SH := Spec.Hmac.sha256S + Wb := 160 + hS := rfl + hD := rfl + hB := rfl + hDF := show 32 ≤ 32 by decide + hF := show 32 ≤ 64 by decide + hD0 := show 0 < 32 by decide + hS0 := show 0 < 96 by decide + hSB := show 96 ≤ 256 by decide + hB0 := show 0 < 64 by decide + hBB := show 64 ≤ 128 by decide + hWb := show 160 ≤ 8 * 20 by decide + hW := show 20 ≤ 64 by decide + repr := Common.sha256_repr + init := Proof.Sha256.X86.Stream.init_verified + upd := v.updOK.of_implies + { pre := fun _ h => h + post := fun _ _ _ h m hr hc => h Spec.Sha256.H0 m hr hc + pub := fun _ _ _ _ h => h + sat := v.updOK.2.2 } + fin := v.finOK.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 := v.finOK.2.2 } + initSp := sha256_initSp + updSp := v.updSp + finSp := v.finSp + initSU := sha256_initSU + 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 diff --git a/lean/VerifiedGarbage/Proof/Hmac/Sha256/X86/Finalize.lean b/lean/VerifiedGarbage/Proof/Hmac/Sha256/X86/Finalize.lean deleted file mode 100644 index e18b3b848..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Sha256/X86/Finalize.lean +++ /dev/null @@ -1,303 +0,0 @@ -import VerifiedGarbage.Proof.Hmac.X86.Finalize -import VerifiedGarbage.Proof.Sha256.X86.Stream.FinalizeVariant -import VerifiedGarbage.Impl.Hmac.Sha256.X86 - -/-! The efficient SHA-256 HMAC finalizer, proved for any compressor. -/ -namespace VG.Proof.Hmac.Sha256.X86.Finalize -open VG VG.X86 VG.Impl.Hmac.X86 -open VG.Impl.Sha256.X86 (at_) -open VG.Impl.Sha256.X86.Stream (compressAt restore saved) -open VG.Proof.Sha256.X86 (contains_offset) -open VG.Proof.Sha256.X86.Stream -open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame writeBytes_append repr_congr compressList_append - hash_one lenBytes rest) -open VG.Proof.Hmac.X86 -open VG.Proof.Hmac.Common (bytesAt_length) -open VG.Spec.Sha256 (HashValue stateAt blockAt compress parseBlock bytesAt wordBytes Repr) -open VG.Proof.Sha256 (countX86) -open VG.Spec.Hmac (xorPad ipad opad hmacBlockKey sha256) -open VG.Proof.Hmac (countFinalizeX86) - -open VG.Proof.Hmac.X86.Finalize -variable {name : String} {code : Prog isa} - (hv : Verified X86.target code Proof.Sha256.compressX86) - (hnosp : NoSp code) (hstack : stackUse code = 0) - -theorem finalizeHash_eq : Impl.Hmac.Sha256.X86.finalizeHash name code = .seq (.block (([.mov .eax (.mem (at_ .esp 20))] : List Instr) ++ - VG.Impl.Sha256.X86.Stream.save .eax ++ - ([.mov .ebp (.reg .eax), .mov .ebx (.mem (at_ .esp 4)), - .mov .ecx (.mem (at_ .esp 8)), .store (at_ .ebp 128) .ecx, - .mov .ecx (.mem (at_ .esp 12)), .store (at_ .ebp 132) .ecx, - .mov .ecx (.mem (at_ .esp 16)), .store (at_ .ebp 136) .ecx, - .mov .edi (.mem (at_ .esp 8)), .alu .and .edi (.imm 63), - .mov .edx (.reg .ebx), .alu .add .edx (.reg .edi), .mov .ecx (.imm 0x80), - .store8 (at_ .edx 32) .cl, .alu .add .edi (.imm 1), - .mov .esi (.imm 0), .alu .cmp .edi (.imm 57)] : List Instr))) - (.seq (.ite .ae (.block [.mov .esi (.imm 1)]) (.block [])) - (.loop (VG.Impl.MdStream.X86.finalizeBody VG.Impl.Sha256.X86.Stream.params name code) .e)) := rfl - -include hv hnosp hstack - -theorem hash_ok {s : State} (hp : SPre s) : WP isa (Impl.Hmac.Sha256.X86.finalizeHash name code) s (SDone s) := by - rw [finalizeHash_eq, ← VG.Proof.Sha256.X86.Stream.Finalize.seq_assoc] - refine WP.seq (WP.mono (VG.Proof.Sha256.X86.Stream.Finalize.prologue_ok hp) fun s₁ ⟨k, hL⟩ => ?_) - refine WP.loop (M := isa) (fun i s' => ∃ n, VG.Proof.Sha256.X86.Stream.Finalize.LInv s i n s') ?_ k s₁ ⟨_, hL⟩ - rintro i s' ⟨n, hL⟩ - refine WP.mono (VG.Proof.Sha256.X86.Stream.Finalize.body_of hv hnosp hstack hp hL) fun s'' h => ?_ - rcases h with ⟨he, hD⟩ | ⟨he, rfl, hL'⟩ - · exact .inl ⟨he, hD⟩ - · exact .inr ⟨he, 0, by omega_nat, 0, hL'⟩ - -theorem comp_of {s₀ s : State} (hp : Pre s₀) (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) - (hsp : s.gpr .esp = esp₀ s₀) (hebx : s.gpr .ebx = inn s₀) (hebp : s.gpr .ebp = scr s₀) - (heax : s.gpr .eax = inn s₀ + 32) {Q : State → Prop} - (hQ : ∀ s', s'.rd = s.rd → s'.wr = s.wr → (∀ r ∈ calleeSaved, s'.gpr r = s.gpr r) → - Frame [⟨inA s₀, 32⟩, ⟨scA s₀, 112⟩, stkR s₀] s.mem s'.mem → - stateAt s'.mem (inA s₀) = - compress (stateAt s.mem (inA s₀)) (blockAt s.mem (inA s₀ + BitVec.ofNat 64 32)) → Q s') : - WP isa (Impl.MdStream.X86.compressAt name code .ebx .ebp) s Q := by - have fi := hp.in_fit - have fs := hp.scr_fit - have fsp := hp.sp_fit - have hb := blk_eq hp - have s32 : Region.Sub ⟨inA s₀, 32⟩ (inR s₀) := Region.sub_prefix (by omega_nat) - have s112 : Region.Sub ⟨scA s₀, 112⟩ (scR s₀) := Region.sub_prefix (by omega_nat) - have b64 : Region.Sub ⟨(inn s₀ + 32).setWidth 64, 64⟩ (inR s₀) := by rw [hb]; exact sub_offset (by omega_nat) (by omega_nat) - refine compressAt_of hv hnosp hstack (st := inn s₀) (scr := scr s₀) (blk := inn s₀ + 32) (E := esp₀ s₀) - (by decide) (by decide) (by decide) (by decide) hsp hebx hebp heax hp.sp_lo - (by omega_nat) (by rw [show (inn s₀ + 32).toNat = (inn s₀).toNat + 32 by - rw [BitVec.toNat_add]; exact Nat.mod_eq_of_lt (by simp; omega_nat)]; omega_nat) (by omega_nat) - ((hp.in_scr.sub_left s32).sub_right s112) ?_ ((hp.in_scr.sub_left b64).sub_right s112) - (hp.stk_in.sub_right s32) (hp.stk_scr.sub_right s112) (hp.stk_in.sub_right b64) ?_ ?_ ?_ - · rw [hb] - intro a h₁ h₂ - simp only [Region.Contains] at h₁ h₂ - have := sep_off (inA s₀) (d := 32) (e := 0) (n := 64) (k := 32) (by omega_nat) (by omega_nat) (by omega_nat) a - (by omega_nat) (by simp at h₂ ⊢; omega_nat) - exact this - · apply Covers.of_sub - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - subst hr - exact ⟨inR s₀, by simp [hrd, hwr, hp.wr], 32, hb, by simp⟩ - · apply Covers.of_sub - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact ⟨inR s₀, by simp [hwr, hp.wr], 0, by simp, by simp⟩ - · exact ⟨scR s₀, by simp [hwr, hp.wr], 0, by simp, by simp⟩ - · intro s' h₁ h₂ h₃ h₄ h₇ - rw [hb] at h₇ - exact hQ s' h₁ h₂ h₃ h₄ h₇ - -/-! ## Writing the MAC -/ - -variable (hfSp : NoSp (Impl.Hmac.Sha256.X86.finalizeHash name code)) - (hfStack : stackUse (Impl.Hmac.Sha256.X86.finalizeHash name code) = 20) -include hfSp hfStack - -theorem correct {s₀ : State} (hp : Pre s₀) : - WP isa (Impl.Hmac.Sha256.X86.finalize name code) s₀ fun s' => abiPreserved s₀ s' ∧ Proof.Hmac.finalizeSha256X86.post s₀ s' := by - have fi := hp.in_fit - have fs := hp.scr_fit - have fsp := hp.sp_fit - unfold Impl.Hmac.Sha256.X86.finalize - refine WP.seq (WP.mono (pro_ok hp) fun s₁ h₁ => ?_) - have sp₁ : s₁.gpr .esp = esp₀ s₀ := h₁.gpr _ (by decide) (by decide) - have s160 : Region.Sub ⟨scA s₀, 160⟩ (scR s₀) := Region.sub_prefix (by omega_nat) - have a20 : Region.Sub ⟨addr (esp₀ s₀) 4, 20⟩ (argR s₀) := Region.sub_prefix (by omega_nat) - have finSub : ∀ r ∈ finW s₀ ++ [stkR s₀], ∃ r' ∈ allR s₀, Region.Sub r r' := by - intro r hr - simp only [finW, 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 ⟨inR s₀, by simp, fun _ h => h⟩ - · exact ⟨outR s₀, by simp, fun _ h => h⟩ - · exact ⟨scR s₀, by simp, s160⟩ - · exact ⟨argR s₀, by simp, a20⟩ - · exact ⟨stkR s₀, by simp, fun _ h => h⟩ - refine WP.seq (WP.narrowSp (hash_ok hv hnosp hstack (narrow_pre hp h₁)) ?_ ?_ hfSp - (by rw [hfStack, sp₁]; exact hp.sp_lo) fun sD rdD wrD frD hD => ?_) - · rw [h₁.rd, h₁.wr, hp.rd, hp.wr] - apply Covers.of_sub - intro r hr - simp only [List.nil_append, finW, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl - · exact ⟨inR s₀, by simp, 0, by simp, by simp⟩ - · exact ⟨outR s₀, by simp, 0, by simp, by simp⟩ - · exact ⟨scR s₀, by simp, 0, by simp, by simp⟩ - · exact ⟨argR s₀, by simp, 0, by simp, by simp⟩ - · rw [h₁.wr, hp.wr] - apply Covers.of_sub - intro r hr - simp only [finW, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl - · exact ⟨inR s₀, by simp, 0, by simp, by simp⟩ - · exact ⟨outR s₀, by simp, 0, by simp, by simp⟩ - · exact ⟨scR s₀, by simp, 0, by simp, by simp⟩ - · exact ⟨argR s₀, by simp, 0, by simp, by simp⟩ - rw [hfStack, sp₁] at frD - obtain ⟨hC, hHash⟩ := hD - have e3 : VG.Proof.Sha256.X86.Stream.Finalize.out (narrow s₀ s₁) = out s₀ := narrow_arg hp h₁ (by omega_nat) - have e4 : VG.Proof.Sha256.X86.Stream.Finalize.scr (narrow s₀ s₁) = scr s₀ := narrow_arg hp h₁ (by omega_nat) - have outpD : sD.mem.readW (addr (scr s₀) 136) 32 = out s₀ := by - have := hC.outp; rw [e4, e3] at this; exact this - have savedD : ∀ p ∈ saved, sD.mem.readW (addr (scr s₀) p.2) 32 = s₀.gpr p.1 := by - intro p hp' - have := hC.saved p hp' - rw [e4] at this - refine this.trans ?_ - show s₁.gpr p.1 = s₀.gpr p.1 - simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl | rfl <;> exact h₁.gpr _ (by decide) (by decide) - have ebxD : sD.gpr .ebx = inn s₀ := hC.ebx.trans (narrow_arg hp h₁ (i := 0) (by omega_nat)) - have ebpD : sD.gpr .ebp = scr s₀ := hC.ebp.trans (narrow_arg hp h₁ (i := 4) (by omega_nat)) - have spD : sD.gpr .esp = esp₀ s₀ := hC.esp.trans sp₁ - have rdD' : sD.rd = s₀.rd := rdD.trans h₁.rd - have wrD' : sD.wr = s₀.wr := wrD.trans h₁.wr - -- `scratch[176..180)`, where `outer` is, lies outside what `finalizeHash` writes. - have w176 : ∀ r ∈ finW s₀ ++ [stkR s₀], Region.Disjoint ⟨addr (scr s₀) 176, 4⟩ r := by - have hs : Region.Sub ⟨addr (scr s₀) 176, 4⟩ (scR s₀) := hp.scr_sub (by omega_nat) - intro r hr - simp only [finW, 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 (hp.in_scr.symm.sub_left hs) - · exact (hp.out_scr.symm.sub_left hs) - · rw [addr_eq (by omega_nat)]; exact Offset.disjoint_base _ (by omega_nat) (by omega_nat) - · exact (hp.a_scr.symm.sub_left hs).sub_right a20 - · exact hp.stk_scr.symm.sub_left hs - have ouD : sD.mem.readW (addr (scr s₀) 176) 32 = ou s₀ := by - rw [frD.readW (Region.contains_self _ _) w176 (by decide), h₁.mem, proMem_176 hp] - refine WP.seq (WP.mono (mid_ok hp ⟨rdD', wrD', ebxD, ebpD, spD, ouD⟩) fun s₃ h₃ => ?_) - have sp₃ : s₃.gpr .esp = esp₀ s₀ := by rw [h₃.gpr _ (by decide) (by decide) (by decide), spD] - refine WP.seq (comp_of hv hnosp hstack hp h₃.rd h₃.wr sp₃ (by rw [h₃.gpr _ (by decide) (by decide) (by decide), ebxD]) - (by rw [h₃.gpr _ (by decide) (by decide) (by decide), ebpD]) h₃.eax fun s₄ rd₄ wr₄ cs₄ fr₄ st₄ => ?_) - -- Words of the scratch space that neither the middle block nor the compression writes. - have keep : ∀ d, 112 ≤ d → d + 4 ≤ 160 → - s₄.mem.readW (addr (scr s₀) d) 32 = sD.mem.readW (addr (scr s₀) d) 32 := by - intro d h₁ h₂ - have hs : Region.Sub ⟨addr (scr s₀) d, 4⟩ (scR s₀) := hp.scr_sub (by omega_nat) - rw [fr₄.readW (Region.contains_self _ _) ?_ (by decide), h₃.mem, - (midMem_frame sD.mem).readW (Region.contains_self _ _) ?_ (by decide)] - · intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact hp.in_scr.symm.sub_left hs - · exact hp.a_scr.symm.sub_left hs - · intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact (hp.in_scr.symm.sub_left hs).sub_right (Region.sub_prefix (by omega_nat)) - · rw [addr_eq (by omega_nat)]; exact Offset.disjoint_base _ (by omega_nat) (by omega_nat) - · exact hp.stk_scr.symm.sub_left hs - have csD : ∀ r ∈ calleeSaved, s₄.gpr r = sD.gpr r := fun r hr => by - rw [cs₄ r hr, h₃.gpr r ?_ ?_ ?_] <;> - · simp only [calleeSaved, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl <;> decide - refine WP.mono (out_ok hp (rd₄.trans h₃.rd) (wr₄.trans h₃.wr) (by rw [csD _ (by decide), ebxD]) - (by rw [csD _ (by decide), ebpD]) (by rw [csD _ (by decide), spD]) - (by rw [keep 136 (by omega_nat) (by omega_nat)]; exact outpD) - fun p hp' => ?_) fun s' ⟨rd', wr', cs', m'⟩ => ?_ - · have hd : 112 ≤ p.2 ∧ p.2 + 4 ≤ 128 := by - simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl | rfl <;> simp - rw [keep p.2 hd.1 (by omega_nat)] - exact savedD p hp' - -- Everything written is within our regions. - have f1 : Frame (allR s₀) s₀.mem s₁.mem := by rw [h₁.mem]; exact (proMem_frame hp).mono (by simp) - have f2 : Frame (allR s₀) s₁.mem sD.mem := frD.sub finSub - have f3 : Frame (allR s₀) sD.mem s₃.mem := by rw [h₃.mem]; exact (midMem_frame sD.mem).mono (by simp) - have f4 : Frame (allR s₀) s₃.mem s₄.mem := by - refine fr₄.sub fun r hr => ?_ - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact ⟨inR s₀, by simp, Region.sub_prefix (by omega_nat)⟩ - · exact ⟨scR s₀, by simp, Region.sub_prefix (by omega_nat)⟩ - · exact ⟨stkR s₀, by simp, fun _ h => h⟩ - have f5 : Frame (allR s₀) s₄.mem s'.mem := by - rw [m'] - refine (writeBytes_frame (R := outR s₀) _ _ _ ?_).mono (by simp) - rw [beWords_length]; exact contains_offset (by omega_nat) (by omega_nat) - have F : Frame (allR s₀) s₀.mem s'.mem := f1.trans (f2.trans (f3.trans (f4.trans f5))) - refine ⟨⟨cs', F.readW (r := retR s₀) (Region.contains_self _ _) ?_ (by decide)⟩, ?_⟩ - · intro r hr - simp only [allR, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl - exacts [hp.ret_in, hp.ret_out, hp.ret_scr, ret_a hp, ret_stk hp] - intro k0 text hk hin hcnt hout - -- The inner digest. - have e0 : VG.Proof.Sha256.X86.Stream.Finalize.st (narrow s₀ s₁) = inn s₀ := narrow_arg hp h₁ (by omega_nat) - have oD : ∀ r ∈ allR s₀, (ouR s₀).Disjoint r := by - intro r hr - simp only [allR, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl - exacts [hp.o_in, hp.o_out, hp.o_scr, hp.o_a, hp.stk_ou.symm] - have hR₀ : VG.Proof.Sha256.X86.Stream.Finalize.R₀ (narrow s₀ s₁) (xorPad k0 ipad ++ text) := by - refine ⟨?_, ?_⟩ - · show Repr s₁.mem ((VG.Proof.Sha256.X86.Stream.Finalize.st (narrow s₀ s₁)).setWidth 64) _ - rw [e0] - refine repr_congr (fun i hi => ?_) hin - rw [h₁.mem] - refine frame_bytes (proMem_frame hp) (R := inR s₀) (fun r hr => ?_) (by simp) hi - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - exacts [hp.in_scr, hp.a_in.symm] - · show countX86 (narrow s₀ s₁) = _ - simp only [countX86] - rw [narrow_arg hp h₁ (i := 2) (by omega_nat), narrow_arg hp h₁ (i := 1) (by omega_nat)] - simp only [List.getD_cons_succ, List.getD_cons_zero, List.length_append, xorPad_length, hk] - exact hcnt - have hdig : Spec.Sha256.hash (xorPad k0 ipad ++ text) = beWords sD.mem (inn s₀) 0 8 := by - have e0A : VG.Proof.Sha256.X86.Stream.Finalize.stA (narrow s₀ s₁) = inA s₀ := by - show (VG.Proof.Sha256.X86.Stream.Finalize.st (narrow s₀ s₁)).setWidth 64 = _ - rw [e0] - rw [hHash _ hR₀, beWords_stateAt _ (by omega_nat), e0A, State.withRegions_mem] - -- The outer hash value. - have hou : stateAt s₃.mem (inA s₀) = Spec.Sha256.compressList Spec.Sha256.H0 (xorPad k0 opad) 1 := by - rw [h₃.mem, midMem_state, - VG.Proof.Sha256.Stream.stateAt_congr (mem := s₀.mem) fun i hi => - frame_bytes (f1.trans f2) (R := ouR s₀) oD (by simp) (by simp; omega_nat), - hout.1, xorPad_length, hk] - -- The block after it. - have hblk : blockAt s₃.mem (inA s₀ + BitVec.ofNat 64 32) = - parseBlock fun t => (beWords sD.mem (inn s₀) 0 8 ++ padBytes).getD t 0 := by - have hb := midMem_block (s₀ := s₀) sD.mem - rw [← h₃.mem] at hb - exact VG.Proof.Sha256.Stream.parseBlock_congr fun k hk => bytesAt_getD hb (by omega_nat) - -- The MAC. - have hmac : bytesAt s'.mem (outA s₀) 32 = beWords s₄.mem (inn s₀) 0 8 := by - rw [m', show outA s₀ + BitVec.ofNat 64 0 = outA s₀ by simp] - have := VG.Proof.Hmac.Common.bytesAt_writeBytes_self s₄.mem (outA s₀) - (beWords s₄.mem (inn s₀) 0 8) (by rw [beWords_length]; omega_nat) - rw [beWords_length] at this - simpa only [Nat.reduceMul] using this - show bytesAt s'.mem (outA s₀) 32 = _ - rw [hmac, beWords_stateAt _ (by omega_nat), st₄, hou, hblk] - simp only [hmacBlockKey, sha256] - rw [hdig, outer_hash hk (beWords_length _ _ _ _)] - - -local macro "narrow" loc:(Lean.Parser.Tactic.location)? : tactic => - `(tactic| simp only [Proof.Hmac.finalizeSha256X86, Proof.Hmac.countFinalizeX86, - VG.Proof.Hmac.X86.Finalize.finalizeWide, VG.Proof.Hmac.X86.Finalize.narrowWr, VG.X86.arg_withRegions, VG.X86.argAddr_withRegions, - VG.X86.State.withRegions_gpr, VG.X86.State.withRegions_mem, VG.X86.State.withRegions_rd, - VG.X86.State.withRegions_wr] $(loc)?) - -theorem verified - (hct : ConstantTime isa Proof.Hmac.finalizeSha256X86.pre Proof.Hmac.finalizeSha256X86.pub - (Impl.Hmac.Sha256.X86.finalize name code)) : - Verified X86.target (Impl.Hmac.Sha256.X86.finalize name code) (Spec.Hmac.finalizeSha256OutContract X86.abi 20) := - have hsat := finalizeWide_implies.sat_left - (Verified.widen (Verified.of_correct (fun s hs => by - obtain ⟨t, s', he, h⟩ := correct hv hnosp hstack hfSp hfStack (pre_of hs) - exact ⟨t, s', he, h⟩) hct - (.refl (hsat.elim fun s hs => ⟨_, finalizeWide_pre s hs⟩))) - narrowWr finalizeWide_pre - (fun _ h => by - obtain ⟨_, h₂, _⟩ := h - rw [h₂] - exact .cons (Region.prefix_of_ble rfl) (.cons (Region.prefix_of_ble rfl) - (.cons (Region.prefix_of_ble rfl) (.cons (Region.prefix_of_ble rfl) .nil)))) - (fun _ _ _ h => by narrow at h ⊢; exact h) - (fun _ _ _ _ h => by narrow; exact h) hsat).of_implies finalizeWide_implies - -end VG.Proof.Hmac.Sha256.X86.Finalize diff --git a/lean/VerifiedGarbage/Proof/Hmac/Sha256/X86/Init.lean b/lean/VerifiedGarbage/Proof/Hmac/Sha256/X86/Init.lean deleted file mode 100644 index 9cce6df1e..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/Sha256/X86/Init.lean +++ /dev/null @@ -1,260 +0,0 @@ -import VerifiedGarbage.Proof.Hmac.X86.Init -import VerifiedGarbage.Proof.Sha256.X86.Stream.CompressAt -import VerifiedGarbage.Impl.Hmac.Sha256.X86 - -/-! The efficient SHA-256 HMAC initializer, proved for any compressor. -/ -namespace VG.Proof.Hmac.Sha256.X86.Init -open VG VG.X86 VG.Impl.Hmac.X86 -open VG.Impl.Sha256.X86 (at_) -open VG.Impl.Sha256.X86.Stream (compressAt save restore saved) -open VG.Proof.Sha256.X86 (contains_offset) -open VG.Proof.Sha256.X86.Stream -open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame writeBytes_append repr_congr) -open VG.Proof.Hmac.X86 -open VG.Proof.Hmac.Common (bytesAt_length writeState stateAt_writeState) -open VG.Spec.Sha256 (HashValue stateAt blockAt compress bytesAt Repr H0) -open VG.Spec.Hmac (xorPad ipad opad blockKey sha256) - -open VG.Proof.Hmac.X86.Init -variable {name : String} {code : Prog isa} - (hv : Verified X86.target code Proof.Sha256.compressX86) - (hnosp : NoSp code) (hstack : stackUse code = 0) -include hv hnosp hstack - -theorem compBuf_of {s₀ s : State} (hp : Pre s₀) {b : Reg} {x : BitVec 32} (hx : x = inn s₀ ∨ x = ou s₀) - (hb : b = .ebx ∨ b = .esi) (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) (hbx : s.gpr b = x) - (hebp : s.gpr .ebp = scr s₀) (hsp : s.gpr .esp = esp₀ s₀) {Q : State → Prop} - (hQ : ∀ s', s'.rd = s₀.rd → s'.wr = s₀.wr → (∀ r ∈ calleeSaved, s'.gpr r = s.gpr r) → - Frame [⟨x.setWidth 64, 32⟩, ⟨scA s₀, 112⟩, stkR s₀] s.mem s'.mem → - stateAt s'.mem (x.setWidth 64) = - compress (stateAt s.mem (x.setWidth 64)) (blockAt s.mem (x.setWidth 64 + 32)) → Q s') : - WP isa (Impl.Hmac.Sha256.X86.compressBuf name code b) s Q := by - have fs := hp.scr_fit - have fsp := hp.sp_fit - obtain ⟨fx, dS, dK, hm⟩ : x.toNat + 96 ≤ 2 ^ 32 ∧ Region.Disjoint ⟨x.setWidth 64, 96⟩ (scR s₀) ∧ - (stkR s₀).Disjoint ⟨x.setWidth 64, 96⟩ ∧ (⟨x.setWidth 64, 96⟩ : Region) ∈ s₀.wr := by - rcases hx with rfl | rfl - · exact ⟨hp.in_fit, hp.i_s, hp.stk_i, by simp [hp.wr]⟩ - · exact ⟨hp.ou_fit, hp.o_s, hp.stk_o, by simp [hp.wr]⟩ - have hb' : b ≠ .eax := by rcases hb with rfl | rfl <;> decide - unfold Impl.Hmac.Sha256.X86.compressBuf - refine WP.seq (wp_mov fun s₃ u₃ => wp_addi fun s₄ u₄ => WP.block_nil ?_) - have g₄ : ∀ r, r ≠ .eax → s₄.gpr r = s.gpr r := fun r h => by rw [u₄.other r h, u₃.other r h] - have m₄ : s₄.mem = s.mem := by rw [u₄.mem, u₃.mem] - have rd₄ : s₄.rd = s₀.rd := by rw [u₄.rd, u₃.rd, hrd] - have wr₄ : s₄.wr = s₀.wr := by rw [u₄.wr, u₃.wr, hwr] - have eax₄ : s₄.gpr .eax = x + 32 := by rw [u₄.gpr, u₃.gpr, hbx] - have hbA : (x + 32).setWidth 64 = x.setWidth 64 + 32 := addr_eq (x := x) (k := 32) (by omega_nat) - have s32 : Region.Sub ⟨x.setWidth 64, 32⟩ ⟨x.setWidth 64, 96⟩ := sub32 _ - have s112 : Region.Sub ⟨scA s₀, 112⟩ (scR s₀) := Region.sub_prefix (by omega_nat) - have b64 : Region.Sub ⟨(x + 32).setWidth 64, 64⟩ ⟨x.setWidth 64, 96⟩ := by - rw [hbA]; exact sub_offset (off := 32) (by omega_nat) (by omega_nat) - refine compressAt_of hv hnosp hstack (st := x) (scr := scr s₀) (blk := x + 32) (E := esp₀ s₀) - (by rcases hb with rfl | rfl <;> decide) (by decide) (by rcases hb with rfl | rfl <;> decide) (by decide) - (by rw [g₄ _ (by decide), hsp]) (by rw [g₄ _ hb', hbx]) (by rw [g₄ _ (by decide), hebp]) eax₄ hp.sp_lo - (by omega_nat) (by rw [show (x + 32).toNat = x.toNat + 32 by - rw [BitVec.toNat_add]; exact Nat.mod_eq_of_lt (by simp; omega_nat)]; omega_nat) (by omega_nat) - ((dS.sub_left s32).sub_right s112) ?_ ((dS.sub_left b64).sub_right s112) - (dK.sub_right s32) (hp.stk_s.sub_right s112) (dK.sub_right b64) ?_ ?_ ?_ - · rw [hbA]; exact Offset.disjoint_base _ (d := 32) (by omega_nat) (by omega_nat) - · rw [rd₄, wr₄] - apply Covers.of_sub - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - subst hr - exact ⟨_, List.mem_append_right _ hm, 32, hbA, by simp⟩ - · rw [wr₄] - apply Covers.of_sub - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact ⟨_, hm, 0, by simp, by simp⟩ - · exact ⟨scR s₀, by simp [hp.wr], 0, by simp, by simp⟩ - · intro s' h₁ h₂ h₃ h₅ h₇ - rw [m₄] at h₅ h₇ - refine hQ s' (h₁.trans rd₄) (h₂.trans wr₄) (fun r hr => by - rw [h₃ r hr, g₄ r (by - simp only [calleeSaved, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl <;> decide)]) h₅ ?_ - rw [h₇, hbA] - -/-! ## Epilogue -/ - -theorem correct {s₀ : State} (hp : Pre s₀) : - WP isa (Impl.Hmac.Sha256.X86.init name code) s₀ fun s' => abiPreserved s₀ s' ∧ Proof.Hmac.initSha256X86.post s₀ s' := by - have hkl := hp.kl_le - have fi := hp.in_fit - have fo := hp.ou_fit - have fs := hp.scr_fit - unfold Impl.Hmac.Sha256.X86.init - refine WP.seq (WP.mono (prologue_ok hp) fun s₁ ⟨h₁, z₁⟩ => ?_) - -- The key. - refine WP.seq (WP.mono (Q := Buf s₀ (kl s₀)) ?_ fun s₂ h₂ => ?_) - · refine WP.ite (decide (kl s₀ = 0)) (by simp [eval, z₁]) (fun hb => WP.block_nil ?_) - (fun hb => key_loop_ok hp h₁ ?_) - · rw [of_decide_eq_true hb]; exact h₁.toBuf - · have := of_decide_eq_false hb; omega_nat - -- The padding. - refine WP.seq (wp_mov fun s₃ u₃ => wp_addi fun s₄ u₄ => wp_movi fun s₅ u₅ => - wp_cmp fun s₆ f₆ _ z₆ => WP.block_nil ?_) - have k₆ : ∀ r, r ≠ .eax → r ≠ .ecx → s₆.gpr r = s₂.gpr r := fun r h h' => by - rw [f₆.gpr, u₅.other r h', u₄.other r h, u₃.other r h] - have eax₆ : s₆.gpr .eax = inn s₀ + 96 := by - rw [f₆.gpr, u₅.other _ (by decide), u₄.gpr, u₃.gpr, h₂.ebx] - have hP : Pad s₀ (kl s₀) s₆ := - ⟨⟨h₂.j_le, by rw [f₆.rd, u₅.rd, u₄.rd, u₃.rd, h₂.rd], by rw [f₆.wr, u₅.wr, u₄.wr, u₃.wr, h₂.wr], - by rw [k₆ _ (by decide) (by decide), h₂.ebx], by rw [k₆ _ (by decide) (by decide), h₂.esi], - by rw [k₆ _ (by decide) (by decide), h₂.ebp], by rw [k₆ _ (by decide) (by decide), h₂.esp], - by rw [k₆ _ (by decide) (by decide), h₂.edx], by rw [f₆.mem, u₅.mem, u₄.mem, u₃.mem]; exact h₂.mem⟩, - eax₆, by rw [f₆.gpr, u₅.gpr]⟩ - have hz : s₆.zf = some (decide (kl s₀ = 64)) := by - rw [z₆, ← f₆.gpr, k₆ _ (by decide) (by decide), h₂.edx, eax₆, cmp_end _ hkl] - refine WP.seq (WP.mono (Q := Buf s₀ 64) ?_ fun s₇ h₇ => ?_) - · refine WP.ite (decide (kl s₀ = 64)) (by simp [eval, hz]) (fun hb => WP.block_nil ?_) - (fun hb => pad_loop_ok hp hP ?_) - · rw [← of_decide_eq_true hb]; exact hP.toBuf - · have := of_decide_eq_false hb; omega_nat - -- The outer buffer. - have hbufI : bytesAt s₇.mem (inA s₀ + 32) 64 = xorPad (K0 s₀) ipad := by - rw [h₇.mem.buf, List.take_of_length_le (by rw [K0_length s₀ hp])]; rfl - refine WP.seq ?_ - rw [← List.append_nil ((List.range 16).flatMap opadWord)] - refine xorWords_ok 16 [] s₇ _ h₇.ebx h₇.esi (by omega_nat) (by omega_nat) - (fun k hk => ⟨inR s₀, by simp [h₇.rd, h₇.wr, hp.wr], hp.in_in (by omega_nat) (by omega_nat)⟩) - (fun k hk => ⟨ouR s₀, by simp [h₇.wr, hp.wr], hp.ou_in (by omega_nat) (by omega_nat)⟩) - (hp.i_o.sep (contains_offset (by omega_nat) (by omega_nat)) (contains_offset (by omega_nat) (by omega_nat))) - fun s₈ g₈ rd₈ wr₈ m₈ => WP.block_nil ?_ - set ob := (bytesAt s₇.mem (inA s₀ + BitVec.ofNat 64 32) (4 * 16)).map (· ^^^ (0x6a : Byte)) with hob - have hobl : ob.length = 64 := by simp [ob, bytesAt_length] - have hob' : ob = xorPad (K0 s₀) opad := by - rw [hob, show 4 * 16 = 64 from rfl, show inA s₀ + BitVec.ofNat 64 32 = inA s₀ + 32 from rfl, hbufI, - xorPad_6a] - let bO : Region := ⟨ouA s₀ + BitVec.ofNat 64 32, 64⟩ - have sO : Region.Sub bO (ouR s₀) := sub_offset (by omega_nat) (by omega_nat) - have F₈ : Frame [bO] s₇.mem s₈.mem := by - rw [m₈]; exact writeBytes_frame _ _ _ (by rw [hobl]; exact Region.contains_self _ _) - have bOd : ∀ R : Region, R.Disjoint (ouR s₀) → ∀ r ∈ [bO], R.Disjoint r := fun R h r hr => by - simp only [List.mem_singleton] at hr; subst hr; exact h.sub_right sO - have stI₈ : stateAt s₈.mem (inA s₀) = H0 := by - rw [← h₇.mem.stI] - exact Proof.Sha256.Stream.stateAt_congr fun i hi => - frame_bytes F₈ (R := ⟨inA s₀, 32⟩) (bOd _ (hp.i_o.sub_left (sub32 _))) (by simp) hi - have bI₈ : bytesAt s₈.mem (inA s₀ + 32) 64 = xorPad (K0 s₀) ipad := by - rw [← hbufI] - exact Proof.Sha256.Stream.bytesAt_congr fun i hi => - frame_bytes F₈ (R := ⟨inA s₀ + 32, 64⟩) - (bOd _ (hp.i_o.sub_left (sub_offset (off := 32) (by omega_nat) (by omega_nat)))) (by simp) hi - have stO₈ : stateAt s₈.mem (ouA s₀) = H0 := by - rw [← h₇.mem.stO] - refine Proof.Sha256.Stream.stateAt_congr fun i hi => frame_bytes F₈ (R := ⟨ouA s₀, 32⟩) ?_ (by simp) hi - simp only [List.mem_singleton]; rintro r rfl - exact Offset.base_disjoint _ (e := 32) (by omega_nat) (by have := hp.ou_fit; omega_nat) - have bO₈ : bytesAt s₈.mem (ouA s₀ + 32) 64 = xorPad (K0 s₀) opad := by - rw [m₈, ← hob'] - have := VG.Proof.Hmac.Common.bytesAt_writeBytes_self s₇.mem (ouA s₀ + BitVec.ofNat 64 32) ob (by omega_nat) - rw [hobl] at this - exact this - have sv₈ : Saved s₀ s₈.mem := saved_frame h₇.mem.saved F₈ fun d h₁ h₂ r hr => by - simp only [List.mem_singleton] at hr; subst hr; exact save_disj hp (hp.o_s.sub_left sO) d h₁ h₂ - have f₈ : Frame [inR s₀, ouR s₀, scR s₀] s₀.mem s₈.mem := - h₇.mem.frame.trans (F₈.sub fun r hr => by - simp only [List.mem_singleton] at hr; subst hr; exact ⟨ouR s₀, by simp, sO⟩) - -- The inner block. - refine WP.seq (compBuf_of hv hnosp hstack hp (x := inn s₀) (.inl rfl) (b := .ebx) (.inl rfl) (by rw [rd₈, h₇.rd]) - (by rw [wr₈, h₇.wr]) (by rw [g₈ _ (by decide), h₇.ebx]) (by rw [g₈ _ (by decide), h₇.ebp]) - (by rw [g₈ _ (by decide), h₇.esp]) fun s₉ rd₉ wr₉ cs₉ fr₉ st₉ => ?_) - have hI₉ : Repr s₉.mem (inA s₀) (xorPad (K0 s₀) ipad) := - VG.Proof.Hmac.Common.repr_block stI₈ bI₈ (by simp [xorPad, K0_length s₀ hp]) st₉ - have dO : ∀ r ∈ [(⟨inA s₀, 32⟩ : Region), ⟨scA s₀, 112⟩, stkR s₀], Region.Disjoint (ouR s₀) r := by - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact hp.i_o.symm.sub_right (sub32 _) - · exact hp.o_s.sub_right (Region.sub_prefix (by omega_nat)) - · exact hp.stk_o.symm - have stO₉ : stateAt s₉.mem (ouA s₀) = H0 := by - rw [← stO₈] - exact Proof.Sha256.Stream.stateAt_congr fun i hi => - frame_bytes fr₉ (R := ⟨ouA s₀, 32⟩) (fun r hr => (dO r hr).sub_left (sub32 _)) (by simp) hi - have bO₉ : bytesAt s₉.mem (ouA s₀ + 32) 64 = xorPad (K0 s₀) opad := by - rw [← bO₈] - exact Proof.Sha256.Stream.bytesAt_congr fun i hi => - frame_bytes fr₉ (R := ⟨ouA s₀ + 32, 64⟩) - (fun r hr => (dO r hr).sub_left (sub_offset (off := 32) (by omega_nat) (by omega_nat))) (by simp) hi - have sv₉ : Saved s₀ s₉.mem := saved_frame sv₈ fr₉ fun d h₁ h₂ r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact save_disj hp (hp.i_s.sub_left (sub32 _)) d h₁ h₂ - · exact save_disj112 hp d h₁ h₂ - · exact save_disj hp hp.stk_s d h₁ h₂ - have f₉ : Frame (allR s₀) s₀.mem s₉.mem := (f₈.mono (by simp)).trans (fr₉.sub fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact ⟨inR s₀, by simp, sub32 _⟩ - · exact ⟨scR s₀, by simp, Region.sub_prefix (by omega_nat)⟩ - · exact ⟨stkR s₀, by simp, fun _ h => h⟩) - have cs₉' : ∀ r ∈ calleeSaved, s₉.gpr r = s₇.gpr r := fun r hr => by - rw [cs₉ r hr, g₈ r (callee_ne_eax hr)] - -- The outer block. - refine WP.seq (compBuf_of hv hnosp hstack hp (x := ou s₀) (.inr rfl) (b := .esi) (.inr rfl) rd₉ wr₉ - (by rw [cs₉' _ (by decide), h₇.esi]) (by rw [cs₉' _ (by decide), h₇.ebp]) - (by rw [cs₉' _ (by decide), h₇.esp]) fun s₁₀ rd₁₀ wr₁₀ cs₁₀ fr₁₀ st₁₀ => ?_) - have hO : Repr s₁₀.mem (ouA s₀) (xorPad (K0 s₀) opad) := - VG.Proof.Hmac.Common.repr_block stO₉ bO₉ (by simp [xorPad, K0_length s₀ hp]) st₁₀ - have hI : Repr s₁₀.mem (inA s₀) (xorPad (K0 s₀) ipad) := by - refine repr_congr (fun i hi => frame_bytes fr₁₀ (R := inR s₀) ?_ (by simp) hi) hI₉ - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - · exact hp.i_o.sub_right (sub32 _) - · exact hp.i_s.sub_right (Region.sub_prefix (by omega_nat)) - · exact hp.stk_i.symm - have sv₁₀ : Saved s₀ s₁₀.mem := saved_frame sv₉ fr₁₀ fun d h₁ h₂ r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact save_disj hp (hp.o_s.sub_left (sub32 _)) d h₁ h₂ - · exact save_disj112 hp d h₁ h₂ - · exact save_disj hp hp.stk_s d h₁ h₂ - have f₁₀ : Frame (allR s₀) s₀.mem s₁₀.mem := f₉.trans (fr₁₀.sub fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact ⟨ouR s₀, by simp, sub32 _⟩ - · exact ⟨scR s₀, by simp, Region.sub_prefix (by omega_nat)⟩ - · exact ⟨stkR s₀, by simp, fun _ h => h⟩) - have cs₁₀' : ∀ r ∈ calleeSaved, s₁₀.gpr r = s₇.gpr r := fun r hr => by rw [cs₁₀ r hr, cs₉' r hr] - -- Epilogue. - refine WP.mono (epilogue_ok hp rd₁₀ wr₁₀ (by rw [cs₁₀' _ (by decide), h₇.ebp]) - (by rw [cs₁₀' _ (by decide), h₇.esp]) sv₁₀) fun s' ⟨m', cs'⟩ => ⟨⟨cs', ?_⟩, ?_⟩ - · rw [m'] - refine f₁₀.readW (r := retR s₀) (Region.contains_self _ _) ?_ (by decide) - intro r hr - simp only [allR, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl - exacts [hp.ret_i, hp.ret_o, hp.ret_s, ret_a hp, ret_stk hp] - · show Repr s'.mem (inA s₀) (xorPad (blockKey sha256 (bytesAt s₀.mem (kA s₀) (kl s₀))) ipad) ∧ - Repr s'.mem (ouA s₀) (xorPad (blockKey sha256 (bytesAt s₀.mem (kA s₀) (kl s₀))) opad) - rw [blockKey_eq hp, m'] - exact ⟨hI, hO⟩ - -local macro "narrow" loc:(Lean.Parser.Tactic.location)? : tactic => - `(tactic| simp only [Proof.Hmac.initSha256X86, VG.Proof.Hmac.X86.Init.initWide, VG.Proof.Hmac.X86.Init.narrowWr, VG.X86.arg_withRegions, VG.X86.argAddr_withRegions, - VG.X86.State.withRegions_gpr, VG.X86.State.withRegions_mem, VG.X86.State.withRegions_rd, - VG.X86.State.withRegions_wr] $(loc)?) - -theorem verified - (hct : ConstantTime isa Proof.Hmac.initSha256X86.pre Proof.Hmac.initSha256X86.pub - (Impl.Hmac.Sha256.X86.init name code)) : - Verified X86.target (Impl.Hmac.Sha256.X86.init name code) (Spec.Hmac.initSha256Contract X86.abi 20) := - have hsat := initWide_implies.sat_left - (Verified.widen (Verified.of_correct (fun s hs => by - obtain ⟨t, s', he, h⟩ := correct hv hnosp hstack (pre_of hs) - exact ⟨t, s', he, h⟩) hct - (.refl (hsat.elim fun s hs => ⟨_, initWide_pre s hs⟩))) - narrowWr initWide_pre - (fun _ h => by - obtain ⟨_, _, h₃, _⟩ := h - rw [h₃] - exact .cons (Region.prefix_of_ble rfl) (.cons (Region.prefix_of_ble rfl) - (.cons (Region.prefix_of_ble rfl) (.cons (Region.prefix_of_ble rfl) .nil)))) - (fun _ _ _ h => by narrow at h ⊢; exact h) - (fun _ _ _ _ h => by narrow; exact h) hsat).of_implies initWide_implies - -end VG.Proof.Hmac.Sha256.X86.Init diff --git a/lean/VerifiedGarbage/Proof/Hmac/X86/Finalize.lean b/lean/VerifiedGarbage/Proof/Hmac/X86/Finalize.lean deleted file mode 100644 index fa67beb7a..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/X86/Finalize.lean +++ /dev/null @@ -1,1127 +0,0 @@ -import Batteries.Logic -import VerifiedGarbage.Proof.Sha256.X86.Stream.Finalize -import VerifiedGarbage.Proof.Hmac.Common -import VerifiedGarbage.Impl.Hmac.X86 -import VerifiedGarbage.Proof.Hmac.X86.Lit -import VerifiedGarbage.Proof.Framework.X86.CallWith -import VerifiedGarbage.Spec.Hmac -import VerifiedGarbage.Proof.Sha256.X86.Contract -import VerifiedGarbage.Proof.Framework.Contract -import VerifiedGarbage.Spec.Hmac.Contract -import VerifiedGarbage.Proof.Framework.Offset -import VerifiedGarbage.Proof.Framework.TaintWeaken -import VerifiedGarbage.Proof.Framework.OmegaLit - -/-! -# HMAC-SHA-256 on x86 (32-bit): `finalize` - -The compressor-dependent correctness proof is generic in -`Proof/Hmac/Sha256/X86/Finalize.lean`; this module keeps the shared memory, -state and scalar constant-time facts. Lemmas `init` uses too, then `finalize`. --/ - -/-! -## Common lemmas - -Words copied between memory regions, byte-swapped or not. --/ - -namespace VG.Proof.Hmac.X86 - -open VG VG.X86 VG.Impl.Hmac.X86 -open VG.Proof.Sha256.X86.Stream -open VG.Proof.Sha256.Stream (writeBytes writeBytes_append writeBytes_nil) -open VG.Proof.Hmac.Common (writeW_readW bytesAt_add bytesAt_writeBytes_sep) -open VG.Proof.Sha256.X86.Stream.Finalize (writeW_bswap) -open VG.Spec.Sha256 (bytesAt wordBytes) - -/-- The bytes of `n` words at `[x + o]`, each big-endian. -/ -def beWords (m : Mem) (x : BitVec 32) (o n : Nat) : List Byte := - (List.range n).flatMap fun k => wordBytes (m.readW (addr x (o + 4 * k)) 32) - -theorem beWords_length (m : Mem) (x : BitVec 32) (o n : Nat) : (beWords m x o n).length = 4 * n := by - induction n with - | zero => rfl - | succ n ih => - simp only [beWords, List.range_succ, List.flatMap_append, List.flatMap_singleton, List.length_append] at ih ⊢ - rw [ih]; simp [wordBytes]; omega_nat - -theorem beWords_succ (m : Mem) (x : BitVec 32) (o n : Nat) : - beWords m x o (n + 1) = beWords m x o n ++ wordBytes (m.readW (addr x (o + 4 * n)) 32) := by - simp [beWords, List.range_succ, List.flatMap_append] - -/-- A word of `n` words at `[x + o]`, within the 32-bit address space. -/ -theorem addr_word {x : BitVec 32} {o n k : Nat} (h : x.toNat + o + 4 * n ≤ 2 ^ 32) (hk : k < n) : - addr x (o + 4 * k) = x.setWidth 64 + BitVec.ofNat 64 o + BitVec.ofNat 64 (4 * k) := by - rw [addr_eq (by omega_nat), BitVec.add_assoc, ← BitVec.ofNat_add] - -/-- Reading a word outside the bytes written. -/ -theorem readW_writeBytes_sep (m : Mem) {a q : Addr} (xs : List Byte) (h : Mem.Sep a 4 q xs.length) : - (writeBytes m q xs).readW a 32 = m.readW a 32 := by - simp only [Mem.readW] - refine congrArg (BitVec.setWidth 32) ?_ - apply VG.Proof.Hmac.Common.read_congr₂ - intro i hi - simp only [writeBytes] - split - · rename_i hlt - refine (h (a + BitVec.ofNat 64 i) ?_ hlt).elim - rw [Offset.add_sub_cancel_left, BitVec.toNat_ofNat, - Nat.mod_eq_of_lt (by omega_nat)] - omega_nat - · rfl - -/-- Copying `n` words from `[x + o₁]` to `[y + o₂]`, byte-swapped: the bytes -written are the words read, big-endian. -/ -theorem bswapWords_ok {src dst : Reg} (hs : src ≠ .ecx) (hd : dst ≠ .ecx) {x y : BitVec 32} {o₁ o₂ : Nat} - (n : Nat) : ∀ (rest : List Instr) (s : State) (Q : State → Prop), - s.gpr src = x → s.gpr dst = y → x.toNat + o₁ + 4 * n ≤ 2 ^ 32 → y.toNat + o₂ + 4 * n ≤ 2 ^ 32 → - (∀ k < n, InRegions (s.rd ++ s.wr) (addr x (o₁ + 4 * k)) 4) → - (∀ k < n, InRegions s.wr (addr y (o₂ + 4 * k)) 4) → - Mem.Sep (x.setWidth 64 + BitVec.ofNat 64 o₁) (4 * n) (y.setWidth 64 + BitVec.ofNat 64 o₂) (4 * n) → - (∀ s', (∀ r, r ≠ .ecx → 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 o₂) (beWords s.mem x o₁ n) → - WP isa (.block rest) s' Q) → - WP isa (.block ((List.range n).flatMap (bswapWord src dst o₁ o₂) ++ rest)) s Q := by - induction n with - | zero => - intro rest s Q _ _ _ _ _ _ _ k - exact k s (fun _ _ => rfl) rfl rfl (by simp [beWords, 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_nat) (by omega_nat) (fun j hj => hin j (by omega_nat)) (fun j hj => hout j (by omega_nat)) - (fun a ha hb => hsep a (by omega_nat) (by omega_nat)) fun s₁ g₁ rd₁ wr₁ m₁ => ?_ - simp only [bswapWord, List.cons_append, List.nil_append] - refine wp_movm (a := addr x (o₁ + 4 * n)) (by rw [ea_at, g₁ _ hs, hx]) - (by rw [rd₁, wr₁]; exact hin n (by omega_nat)) fun s₂ u₂ => wp_bswap fun s₃ u₃ => ?_ - refine wp_store (a := addr y (o₂ + 4 * n)) (by rw [ea_at, u₃.other _ hd, u₂.other _ hd, g₁ _ hd, hy]) - (by rw [u₃.wr, u₂.wr, wr₁]; exact hout n (by omega_nat)) 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 hrd : s₁.mem.readW (addr x (o₁ + 4 * n)) 32 = s.mem.readW (addr x (o₁ + 4 * n)) 32 := by - rw [m₁, addr_word fx (by omega_nat : n < n + 1)] - simp only [Mem.readW] - refine congrArg (BitVec.setWidth 32) ?_ - apply VG.Proof.Hmac.Common.read_congr₂ - intro i hi - simp only [writeBytes] - split - · rename_i hlt - rw [beWords_length] at hlt - refine (hsep (x.setWidth 64 + BitVec.ofNat 64 o₁ + BitVec.ofNat 64 (4 * n) + BitVec.ofNat 64 i) ?_ - (by omega_nat)).elim - rw [Offset.add_add (x.setWidth 64 + BitVec.ofNat 64 o₁), Offset.add_sub_cancel_left, - BitVec.toNat_ofNat, Nat.mod_eq_of_lt (by omega_nat)] - omega_nat - · rfl - rw [u₄.mem, u₃.gpr, u₂.gpr, u₃.mem, u₂.mem, hrd, writeW_bswap, m₁, addr_word fy (by omega_nat : n < n + 1), - beWords_succ, ← writeBytes_append _ _ _ _ (by simp [beWords_length, wordBytes]; omega_nat), beWords_length] - -/-- Copying `n` words from `[x + o₁]` to `[y + o₂]`. -/ -theorem copyWords_ok {src dst : Reg} (hs : src ≠ .ecx) (hd : dst ≠ .ecx) {x y : BitVec 32} {o₁ o₂ : Nat} - (n : Nat) : ∀ (rest : List Instr) (s : State) (Q : State → Prop), - s.gpr src = x → s.gpr dst = y → x.toNat + o₁ + 4 * n ≤ 2 ^ 32 → y.toNat + o₂ + 4 * n ≤ 2 ^ 32 → - (∀ k < n, InRegions (s.rd ++ s.wr) (addr x (o₁ + 4 * k)) 4) → - (∀ k < n, InRegions s.wr (addr y (o₂ + 4 * k)) 4) → - Mem.Sep (x.setWidth 64 + BitVec.ofNat 64 o₁) (4 * n) (y.setWidth 64 + BitVec.ofNat 64 o₂) (4 * n) → - (∀ s', (∀ r, r ≠ .ecx → 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 o₂) - (bytesAt s.mem (x.setWidth 64 + BitVec.ofNat 64 o₁) (4 * n)) → - WP isa (.block rest) s' Q) → - WP isa (.block ((List.range n).flatMap (copyWord src dst o₁ o₂) ++ 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_nat) (by omega_nat) (fun j hj => hin j (by omega_nat)) (fun j hj => hout j (by omega_nat)) - (fun a ha hb => hsep a (by omega_nat) (by omega_nat)) fun s₁ g₁ rd₁ wr₁ m₁ => ?_ - simp only [copyWord, List.cons_append, List.nil_append] - refine wp_movm (a := addr x (o₁ + 4 * n)) (by rw [ea_at, g₁ _ hs, hx]) - (by rw [rd₁, wr₁]; exact hin n (by omega_nat)) fun s₂ u₂ => ?_ - refine wp_store (a := addr y (o₂ + 4 * n)) (by rw [ea_at, u₂.other _ hd, g₁ _ hd, hy]) - (by rw [u₂.wr, wr₁]; exact hout n (by omega_nat)) fun s₃ u₃ => ?_ - refine k s₃ (fun r hr => by rw [u₃.gpr, u₂.other r hr, g₁ r hr]) - (by rw [u₃.rd, u₂.rd, rd₁]) (by rw [u₃.wr, u₂.wr, wr₁]) ?_ - rw [u₃.mem, u₂.gpr, u₂.mem, addr_word fx (by omega_nat : n < n + 1), addr_word fy (by omega_nat : n < n + 1), m₁] - have := VG.Proof.Hmac.Common.copy_mem s.mem (x.setWidth 64 + BitVec.ofNat 64 o₁) - (y.setWidth 64 + BitVec.ofNat 64 o₂) n 4 (by rw [show 4 * n + 4 = 4 * (n + 1) by omega_nat]; exact hsep) - (by omega_nat) - simp only [Nat.reduceMul] at this - rw [this, show 4 * (n + 1) = 4 * n + 4 by omega_nat] - -end VG.Proof.Hmac.X86 - -/-! -## `finalize` - -The inner hash is the code of -`vg_sha256_finalize` up to writing the digest (`finalizeHash`), run on our -state with its permissions narrowed to those of `vg_sha256_finalize` and -reasoned about with that function's own proof (`WP.narrowSp`); the outer -hash is one compression of a block laid out at known offsets. The -compressions call the compression function, using the 20 bytes below `esp`. --/ - -namespace VG.Proof.Hmac - -open Spec.Hmac -open Spec.Sha256 (Repr bytesAt) - -open VG.X86 in -/-- X86 (32-bit) contract for `vg_hmac_sha256_init(inner: *mut [u8; 96], outer: -*mut [u8; 96], key: *const u8, key_len: usize, scratch: *mut [u64; 20])`, whose -arguments are on the stack (cdecl), for a key of at most 64 bytes (the SHA-256 -block size): makes the streaming state at `inner` represent `K₀ ⊕ ipad` and the -one at `outer` represent `K₀ ⊕ opad`, for the key `K₀` made of the `key_len` -bytes at `key`. - -The code may read `key` (`key_len` bytes), and read and write the arguments -(20 bytes above the return address, whose contents on exit are unspecified), -`inner` and `outer` (96 bytes each) and `scratch` (160 bytes, whose contents -on exit are unspecified). The writable buffers may not overlap each other, -the key, the return address or the 20 bytes of stack below it (where the -code calls the compression function), and nothing may wrap around the end -of the (32-bit) address space. `esp`, the pointers and `key_len` are public; -the key is secret. -/ -def initSha256X86 : Contract X86.isa where - pre s := - let inner : Region := ⟨(arg s 0).setWidth 64, 96⟩ - let outer : Region := ⟨(arg s 1).setWidth 64, 96⟩ - let key : Region := ⟨(arg s 2).setWidth 64, (arg s 3).toNat⟩ - let scratch : Region := ⟨(arg s 4).setWidth 64, 160⟩ - let args : Region := ⟨argAddr s 0, 20⟩ - let ret : Region := ⟨(s.gpr .esp).setWidth 64, 4⟩ - let stack : Region := ⟨(s.gpr .esp).setWidth 64 - 20, 20⟩ - (arg s 3).toNat ≤ 64 ∧ s.rd = [key] ∧ s.wr = [inner, outer, scratch, args] ∧ - inner.Disjoint outer ∧ inner.Disjoint scratch ∧ outer.Disjoint scratch ∧ - args.Disjoint inner ∧ args.Disjoint outer ∧ args.Disjoint scratch ∧ - key.Disjoint inner ∧ key.Disjoint outer ∧ key.Disjoint scratch ∧ key.Disjoint args ∧ - ret.Disjoint inner ∧ ret.Disjoint outer ∧ ret.Disjoint scratch ∧ - stack.Disjoint inner ∧ stack.Disjoint outer ∧ stack.Disjoint scratch ∧ - (arg s 0).toNat + 96 ≤ 2 ^ 32 ∧ (arg s 1).toNat + 96 ≤ 2 ^ 32 ∧ - (arg s 2).toNat + (arg s 3).toNat ≤ 2 ^ 32 ∧ (arg s 4).toNat + 160 ≤ 2 ^ 32 ∧ - 20 ≤ (s.gpr .esp).toNat ∧ (s.gpr .esp).toNat + 24 ≤ 2 ^ 32 - post s s' := - let k0 := blockKey sha256 (bytesAt s.mem ((arg s 2).setWidth 64) (arg s 3).toNat) - Repr s'.mem ((arg s 0).setWidth 64) (xorPad k0 ipad) ∧ - Repr s'.mem ((arg s 1).setWidth 64) (xorPad k0 opad) - pub s₁ s₂ := - s₁.gpr .esp = s₂.gpr .esp ∧ ∀ i < 5, arg s₁ i = arg s₂ i - -open VG.X86 in -/-- The 64-bit `count` argument of `vg_hmac_sha256_finalize`: its arguments -2 (the low word) and 3 (the high word). -/ -def countFinalizeX86 (s : X86.State) : BitVec 64 := arg s 3 ++ arg s 2 - -open VG.X86 in -/-- X86 (32-bit) contract for `vg_hmac_sha256_finalize(inner: *mut [u8; 96], -outer: *const [u8; 96], count: u64, out: *mut [u8; 32], scratch: *mut [u64; -30])`, whose arguments are on the stack (cdecl: `inner`, `outer`, the low and -high words of `count`, `out`, `scratch`): if, for a 64-byte key `K₀` and a text, -the streaming state at `inner` represents `(K₀ ⊕ ipad) ‖ text`, of `count` bytes -(modulo 2⁶⁴), and the one at `outer` represents `K₀ ⊕ opad`, writes the -HMAC-SHA-256 of the text under `K₀` to `out`. - -The code may read `outer` (96 bytes), and read and write the arguments (24 -bytes above the return address, whose contents on exit are unspecified), -`inner` (96 bytes, whose contents on exit are unspecified), `out` (32 bytes) -and `scratch` (240 bytes, whose contents on exit are unspecified). The -writable buffers may not overlap each other, `outer` or the return address; -none of the buffers may overlap the 20 bytes of stack below the return -address (where the code calls the compression function); and nothing may -wrap around the end of the (32-bit) address space. `esp`, the pointers and -`count` are public; the states are secret. -/ -def finalizeSha256X86 : Contract X86.isa where - pre s := - let inner : Region := ⟨(arg s 0).setWidth 64, 96⟩ - let outer : Region := ⟨(arg s 1).setWidth 64, 96⟩ - let out : Region := ⟨(arg s 4).setWidth 64, 32⟩ - let scratch : Region := ⟨(arg s 5).setWidth 64, 240⟩ - let args : Region := ⟨argAddr s 0, 24⟩ - let ret : Region := ⟨(s.gpr .esp).setWidth 64, 4⟩ - let stack : Region := ⟨(s.gpr .esp).setWidth 64 - 20, 20⟩ - s.rd = [outer] ∧ s.wr = [inner, out, scratch, args] ∧ - inner.Disjoint out ∧ inner.Disjoint scratch ∧ out.Disjoint scratch ∧ - args.Disjoint inner ∧ args.Disjoint out ∧ args.Disjoint scratch ∧ - outer.Disjoint inner ∧ outer.Disjoint out ∧ outer.Disjoint scratch ∧ outer.Disjoint args ∧ - ret.Disjoint inner ∧ ret.Disjoint out ∧ ret.Disjoint scratch ∧ - stack.Disjoint inner ∧ stack.Disjoint outer ∧ stack.Disjoint out ∧ stack.Disjoint scratch ∧ - (arg s 0).toNat + 96 ≤ 2 ^ 32 ∧ (arg s 1).toNat + 96 ≤ 2 ^ 32 ∧ - (arg s 4).toNat + 32 ≤ 2 ^ 32 ∧ (arg s 5).toNat + 240 ≤ 2 ^ 32 ∧ - 20 ≤ (s.gpr .esp).toNat ∧ (s.gpr .esp).toNat + 28 ≤ 2 ^ 32 - post s s' := ∀ k0 text, k0.length = 64 → - Repr s.mem ((arg s 0).setWidth 64) (xorPad k0 ipad ++ text) → - countFinalizeX86 s = BitVec.ofNat 64 (64 + text.length) → - Repr s.mem ((arg s 1).setWidth 64) (xorPad k0 opad) → - bytesAt s'.mem ((arg s 4).setWidth 64) 32 = hmacBlockKey sha256 k0 text - pub s₁ s₂ := - s₁.gpr .esp = s₂.gpr .esp ∧ ∀ i < 6, arg s₁ i = arg s₂ i - -end VG.Proof.Hmac - -namespace VG.Proof.Hmac.X86.Finalize - -open VG VG.X86 VG.Impl.Hmac.X86 -open VG.Impl.Sha256.X86 (at_) -open VG.Impl.Sha256.X86.Stream (compressAt restore saved) -open VG.Proof.Sha256.X86 (contains_offset) -open VG.Proof.Sha256.X86.Stream -open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame writeBytes_append repr_congr compressList_append - hash_one lenBytes rest) -open VG.Proof.Hmac.X86 -open VG.Proof.Hmac.Common (bytesAt_length) -open VG.Spec.Sha256 (HashValue stateAt blockAt compress parseBlock bytesAt wordBytes Repr) -open VG.Proof.Sha256 (countX86) -open VG.Spec.Hmac (xorPad ipad opad hmacBlockKey sha256) -open VG.Proof.Hmac (countFinalizeX86) - -/-! ## The precondition -/ - -section -variable (s₀ : State) - -abbrev esp₀ : BitVec 32 := s₀.gpr .esp -abbrev inn : BitVec 32 := arg s₀ 0 -abbrev ou : BitVec 32 := arg s₀ 1 -abbrev out : BitVec 32 := arg s₀ 4 -abbrev scr : BitVec 32 := arg s₀ 5 -abbrev inA : Addr := (inn s₀).setWidth 64 -abbrev ouA : Addr := (ou s₀).setWidth 64 -abbrev outA : Addr := (out s₀).setWidth 64 -abbrev scA : Addr := (scr s₀).setWidth 64 -abbrev inR : Region := ⟨inA s₀, 96⟩ -abbrev ouR : Region := ⟨ouA s₀, 96⟩ -abbrev outR : Region := ⟨outA s₀, 32⟩ -abbrev scR : Region := ⟨scA s₀, 240⟩ -abbrev argR : Region := ⟨addr (esp₀ s₀) 4, 24⟩ -abbrev retR : Region := ⟨(esp₀ s₀).setWidth 64, 4⟩ -abbrev stkR : Region := below (esp₀ s₀) 20 - -/-- The regions `vg_sha256_finalize` gets: its state (our inner state), its -output (ours), the first 160 bytes of our scratch space, and the first 20 -bytes of our arguments. -/ -abbrev finW : List Region := [inR s₀, outR s₀, ⟨scA s₀, 160⟩, ⟨addr (esp₀ s₀) 4, 20⟩] - -end - -structure Pre (s₀ : State) : Prop where - rd : s₀.rd = [ouR s₀] - wr : s₀.wr = [inR s₀, outR s₀, scR s₀, argR s₀] - in_out : (inR s₀).Disjoint (outR s₀) - in_scr : (inR s₀).Disjoint (scR s₀) - out_scr : (outR s₀).Disjoint (scR s₀) - a_in : (argR s₀).Disjoint (inR s₀) - a_out : (argR s₀).Disjoint (outR s₀) - a_scr : (argR s₀).Disjoint (scR s₀) - o_in : (ouR s₀).Disjoint (inR s₀) - o_out : (ouR s₀).Disjoint (outR s₀) - o_scr : (ouR s₀).Disjoint (scR s₀) - o_a : (ouR s₀).Disjoint (argR s₀) - ret_in : (retR s₀).Disjoint (inR s₀) - ret_out : (retR s₀).Disjoint (outR s₀) - ret_scr : (retR s₀).Disjoint (scR s₀) - stk_in : (stkR s₀).Disjoint (inR s₀) - stk_ou : (stkR s₀).Disjoint (ouR s₀) - stk_out : (stkR s₀).Disjoint (outR s₀) - stk_scr : (stkR s₀).Disjoint (scR s₀) - in_fit : (inn s₀).toNat + 96 ≤ 2 ^ 32 - ou_fit : (ou s₀).toNat + 96 ≤ 2 ^ 32 - out_fit : (out s₀).toNat + 32 ≤ 2 ^ 32 - scr_fit : (scr s₀).toNat + 240 ≤ 2 ^ 32 - sp_lo : 20 ≤ (esp₀ s₀).toNat - sp_fit : (esp₀ s₀).toNat + 28 ≤ 2 ^ 32 - -theorem pre_of {s₀ : State} (h : Proof.Hmac.finalizeSha256X86.pre s₀) : Pre s₀ := by - obtain ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, - h21, h22, h23, h24, h25⟩ := h - have e := stk_eq h24 - exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, - by show (below _ _).Disjoint _; rw [e]; exact h16, by show (below _ _).Disjoint _; rw [e]; exact h17, - by show (below _ _).Disjoint _; rw [e]; exact h18, by show (below _ _).Disjoint _; rw [e]; exact h19, - h20, h21, h22, h23, h24, h25⟩ - -namespace Pre -variable {s₀ : State} (hp : Pre s₀) -include hp - -theorem scr_in {d n : Nat} (hd : d + n ≤ 240) (hn : 0 < n) : (scR s₀).Contains (addr (scr s₀) d) n := - contains_addr hd hn hp.scr_fit - -theorem in_in {d n : Nat} (hd : d + n ≤ 96) (hn : 0 < n) : (inR s₀).Contains (addr (inn s₀) d) n := - contains_addr hd hn hp.in_fit - -theorem arg_in {d : Nat} (hd₁ : 4 ≤ d) (hd : d + 4 ≤ 28) : (argR s₀).Contains (addr (esp₀ s₀) d) 4 := by - have := hp.sp_fit - unfold argR - rw [addr_eq (by omega_nat), addr_eq (by omega_nat)] - exact Offset.contains _ hd₁ (by omega_nat) (by omega_nat) - -/-- A word of the scratch space, as a region. -/ -theorem scr_sub {d : Nat} (hd : d + 4 ≤ 240) : Region.Sub ⟨addr (scr s₀) d, 4⟩ (scR s₀) := by - rw [addr_eq (by have := hp.scr_fit; omega_nat)] - exact sub_offset hd (by omega_nat) - -/-- An argument word, as a region. -/ -theorem arg_sub {d : Nat} (hd₁ : 4 ≤ d) (hd : d + 4 ≤ 28) : Region.Sub ⟨addr (esp₀ s₀) d, 4⟩ (argR s₀) := by - have := hp.sp_fit - unfold argR - rw [addr_eq (by omega_nat), addr_eq (by omega_nat)] - exact Offset.sub _ hd₁ (by omega_nat) - -theorem arg_scr_sep {d e : Nat} (hd₁ : 4 ≤ d) (hd : d + 4 ≤ 28) (he : e + 4 ≤ 240) : - Mem.Sep (addr (esp₀ s₀) d) 4 (addr (scr s₀) e) 4 := by - intro x hx hy - exact hp.a_scr x (hp.arg_sub hd₁ hd x (by simp only [Region.Contains]; omega_nat)) - (hp.scr_sub he x (by simp only [Region.Contains]; omega_nat)) - -theorem scr_arg_sep {d e : Nat} (hd₁ : 4 ≤ d) (hd : d + 4 ≤ 28) (he : e + 4 ≤ 240) : - Mem.Sep (addr (scr s₀) e) 4 (addr (esp₀ s₀) d) 4 := by - intro x hx hy - exact hp.a_scr x (hp.arg_sub hd₁ hd x (by simp only [Region.Contains]; omega_nat)) - (hp.scr_sub he x (by simp only [Region.Contains]; omega_nat)) - -end Pre - -theorem ret_a {s₀ : State} (hp : Pre s₀) : (retR s₀).Disjoint (argR s₀) := by - have := hp.sp_fit - unfold retR argR - rw [addr_eq (by omega_nat)] - exact Offset.base_disjoint _ (Nat.le_refl 4) (by omega_nat) - -theorem ret_stk {s₀ : State} (hp : Pre s₀) : (retR s₀).Disjoint (stkR s₀) := by - have := hp.sp_lo - unfold retR stkR below - rw [Taint.sub_setWidth (by omega_nat)] - have h := Offset.disjoint_below_above ((esp₀ s₀).setWidth 64) (m := 20) (a := 0) (l := 4) (by omega_nat) - rw [BitVec.add_zero] at h - exact h.symm - -/-! ## Rearranging the arguments -/ - -/-- Memory after the prologue: `outer` in `scratch[176]`, and the arguments -of `vg_sha256_finalize`. -/ -def proMem (s₀ : State) : Mem := - ((((s₀.mem.writeW (addr (scr s₀) 176) (ou s₀)).writeW (addr (esp₀ s₀) 8) (arg s₀ 2)).writeW - (addr (esp₀ s₀) 12) (arg s₀ 3)).writeW (addr (esp₀ s₀) 16) (out s₀)).writeW (addr (esp₀ s₀) 20) (scr s₀) - -theorem proMem_frame {s₀ : State} (hp : Pre s₀) : Frame [scR s₀, argR s₀] s₀.mem (proMem s₀) := by - simp only [proMem] - exact (((((Frame.refl _ _).writeW (by simp) _ (hp.scr_in (d := 176) (by omega_nat) (by omega_nat))).writeW (by simp) _ - (hp.arg_in (d := 8) (by omega_nat) (by omega_nat))).writeW (by simp) _ (hp.arg_in (d := 12) (by omega_nat) (by omega_nat))).writeW - (by simp) _ (hp.arg_in (d := 16) (by omega_nat) (by omega_nat))).writeW (by simp) _ - (hp.arg_in (d := 20) (by omega_nat) (by omega_nat)) - -/-- Reading an argument word after the prologue. -/ -theorem proMem_arg {s₀ : State} (hp : Pre s₀) (i : Nat) (hi : i < 5) : - (proMem s₀).readW (addr (esp₀ s₀) (4 + 4 * i)) 32 = - [inn s₀, arg s₀ 2, arg s₀ 3, out s₀, scr s₀].getD i 0 := by - have := hp.sp_fit - have w : ∀ (m : Mem) (v : BitVec 32) (d e : Nat), 4 ≤ d → d + 4 ≤ 28 → 4 ≤ e → e + 4 ≤ 28 → - d + 4 ≤ e ∨ e + 4 ≤ d → - (m.writeW (addr (esp₀ s₀) e) v).readW (addr (esp₀ s₀) d) 32 = m.readW (addr (esp₀ s₀) d) 32 := - fun m v d e _ h₂ _ h₄ h => readW_writeW_addr m v (by omega_nat) (by omega_nat) h - have s176 : ∀ d, 4 ≤ d → d + 4 ≤ 28 → - (s₀.mem.writeW (addr (scr s₀) 176) (ou s₀)).readW (addr (esp₀ s₀) d) 32 = s₀.mem.readW (addr (esp₀ s₀) d) 32 := - fun d h₁ h₂ => Mem.readW_writeW_sep (hp.arg_scr_sep h₁ h₂ (by omega_nat)) (by decide) - rcases (by omega_nat : i = 0 ∨ i = 1 ∨ i = 2 ∨ i = 3 ∨ i = 4) with rfl | rfl | rfl | rfl | rfl <;> simp only [proMem, List.getD_cons_zero, List.getD_cons_succ] - · rw [w _ _ 4 20 (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat), - w _ _ 4 16 (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat), - w _ _ 4 12 (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat), - w _ _ 4 8 (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat), s176 4 (by omega_nat) (by omega_nat)]; rfl - · rw [w _ _ 8 20 (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat), - w _ _ 8 16 (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat), - w _ _ 8 12 (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat), Mem.readW_writeW_self32] - · rw [w _ _ 12 20 (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat), - w _ _ 12 16 (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat), Mem.readW_writeW_self32] - · rw [w _ _ 16 20 (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat) (by omega_nat), Mem.readW_writeW_self32] - · rw [Mem.readW_writeW_self32] - -theorem proMem_176 {s₀ : State} (hp : Pre s₀) : (proMem s₀).readW (addr (scr s₀) 176) 32 = ou s₀ := by - simp only [proMem] - rw [Mem.readW_writeW_sep (hp.scr_arg_sep (d := 20) (by omega_nat) (by omega_nat) (by omega_nat)) (by decide), - Mem.readW_writeW_sep (hp.scr_arg_sep (d := 16) (by omega_nat) (by omega_nat) (by omega_nat)) (by decide), - Mem.readW_writeW_sep (hp.scr_arg_sep (d := 12) (by omega_nat) (by omega_nat) (by omega_nat)) (by decide), - Mem.readW_writeW_sep (hp.scr_arg_sep (d := 8) (by omega_nat) (by omega_nat) (by omega_nat)) (by decide), - Mem.readW_writeW_self32] - -/-- After the prologue. -/ -structure Pro (s₀ s : State) : Prop where - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - gpr : ∀ r, r ≠ .ecx → r ≠ .edx → s.gpr r = s₀.gpr r - mem : s.mem = proMem s₀ - -theorem pro_ok {s₀ : State} (hp : Pre s₀) : - WP isa (.block [.mov .edx (.mem (at_ .esp 24)), .mov .ecx (.mem (at_ .esp 8)), .store (at_ .edx 176) .ecx, - .mov .ecx (.mem (at_ .esp 12)), .store (at_ .esp 8) .ecx, - .mov .ecx (.mem (at_ .esp 16)), .store (at_ .esp 12) .ecx, - .mov .ecx (.mem (at_ .esp 20)), .store (at_ .esp 16) .ecx, .store (at_ .esp 20) .edx]) s₀ (Pro s₀) := by - have hsp := hp.sp_fit - have rin : ∀ (s : State), s.rd = s₀.rd → s.wr = s₀.wr → ∀ d, 4 ≤ d → d + 4 ≤ 28 → - InRegions (s.rd ++ s.wr) (addr (esp₀ s₀) d) 4 := - fun s h₁ h₂ d h₃ h₄ => ⟨argR s₀, by simp [h₁, h₂, hp.wr], hp.arg_in h₃ h₄⟩ - have win : ∀ (s : State), s.wr = s₀.wr → ∀ d, 4 ≤ d → d + 4 ≤ 28 → InRegions s.wr (addr (esp₀ s₀) d) 4 := - fun s h₂ d h₃ h₄ => ⟨argR s₀, by simp [h₂, hp.wr], hp.arg_in h₃ h₄⟩ - refine wp_movm (a := addr (esp₀ s₀) 24) (ea_at _ _ _) (rin _ rfl rfl 24 (by omega_nat) (by omega_nat)) fun s₁ u₁ => ?_ - have e₁ : s₁.gpr .edx = scr s₀ := u₁.gpr - have sp₁ : s₁.gpr .esp = esp₀ s₀ := u₁.other _ (by decide) - refine wp_movm (a := addr (esp₀ s₀) 8) (by rw [ea_at, sp₁]) (by rw [u₁.rd, u₁.wr]; exact rin _ rfl rfl 8 (by omega_nat) (by omega_nat)) - fun s₂ u₂ => ?_ - refine wp_store (a := addr (scr s₀) 176) (by rw [ea_at, u₂.other _ (by decide), e₁]) - (by rw [u₂.wr, u₁.wr]; exact ⟨scR s₀, by simp [hp.wr], hp.scr_in (by omega_nat) (by omega_nat)⟩) fun s₃ u₃ => ?_ - have ld : ∀ d, 4 ≤ d → d + 4 ≤ 28 → - (s₀.mem.writeW (addr (scr s₀) 176) (ou s₀)).readW (addr (esp₀ s₀) d) 32 = s₀.mem.readW (addr (esp₀ s₀) d) 32 := - fun d h₁ h₂ => Mem.readW_writeW_sep (hp.arg_scr_sep h₁ h₂ (by omega_nat)) (by decide) - have m₃ : s₃.mem = s₀.mem.writeW (addr (scr s₀) 176) (ou s₀) := by - rw [u₃.mem, u₂.gpr, u₂.mem, u₁.mem]; rfl - have g₃ : ∀ r, r ≠ .ecx → r ≠ .edx → s₃.gpr r = s₀.gpr r := fun r h h' => by - rw [u₃.gpr, u₂.other r h, u₁.other r h'] - have rd₃ : s₃.rd = s₀.rd := by rw [u₃.rd, u₂.rd, u₁.rd] - have wr₃ : s₃.wr = s₀.wr := by rw [u₃.wr, u₂.wr, u₁.wr] - have sp₃ : s₃.gpr .esp = esp₀ s₀ := g₃ _ (by decide) (by decide) - have ed₃ : s₃.gpr .edx = scr s₀ := by rw [u₃.gpr, u₂.other _ (by decide), e₁] - refine wp_movm (a := addr (esp₀ s₀) 12) (by rw [ea_at, sp₃]) (rin _ rd₃ wr₃ 12 (by omega_nat) (by omega_nat)) - fun s₄ u₄ => ?_ - refine wp_store (a := addr (esp₀ s₀) 8) (by rw [ea_at, u₄.other _ (by decide), sp₃]) - (by rw [u₄.wr]; exact win _ wr₃ 8 (by omega_nat) (by omega_nat)) fun s₅ u₅ => ?_ - refine wp_movm (a := addr (esp₀ s₀) 16) (by rw [ea_at, u₅.gpr, u₄.other _ (by decide), sp₃]) - (by rw [u₅.rd, u₅.wr, u₄.rd, u₄.wr]; exact rin _ rd₃ wr₃ 16 (by omega_nat) (by omega_nat)) fun s₆ u₆ => ?_ - refine wp_store (a := addr (esp₀ s₀) 12) (by rw [ea_at, u₆.other _ (by decide), u₅.gpr, u₄.other _ (by decide), sp₃]) - (by rw [u₆.wr, u₅.wr, u₄.wr]; exact win _ wr₃ 12 (by omega_nat) (by omega_nat)) fun s₇ u₇ => ?_ - refine wp_movm (a := addr (esp₀ s₀) 20) - (by rw [ea_at, u₇.gpr, u₆.other _ (by decide), u₅.gpr, u₄.other _ (by decide), sp₃]) - (by rw [u₇.rd, u₇.wr, u₆.rd, u₆.wr, u₅.rd, u₅.wr, u₄.rd, u₄.wr]; exact rin _ rd₃ wr₃ 20 (by omega_nat) (by omega_nat)) - fun s₈ u₈ => ?_ - have g₈ : ∀ r, r ≠ .ecx → s₈.gpr r = s₃.gpr r := fun r h => by - rw [u₈.other r h, u₇.gpr, u₆.other r h, u₅.gpr, u₄.other r h] - refine wp_store (a := addr (esp₀ s₀) 16) (by rw [ea_at, g₈ _ (by decide), sp₃]) - (by rw [u₈.wr, u₇.wr, u₆.wr, u₅.wr, u₄.wr]; exact win _ wr₃ 16 (by omega_nat) (by omega_nat)) fun s₉ u₉ => ?_ - refine wp_store (a := addr (esp₀ s₀) 20) (by rw [ea_at, u₉.gpr, g₈ _ (by decide), sp₃]) - (by rw [u₉.wr, u₈.wr, u₇.wr, u₆.wr, u₅.wr, u₄.wr]; exact win _ wr₃ 20 (by omega_nat) (by omega_nat)) - fun s₁₀ u₁₀ => WP.block_nil ⟨?_, ?_, fun r h h' => ?_, ?_⟩ - · rw [u₁₀.rd, u₉.rd, u₈.rd, u₇.rd, u₆.rd, u₅.rd, u₄.rd, rd₃] - · rw [u₁₀.wr, u₉.wr, u₈.wr, u₇.wr, u₆.wr, u₅.wr, u₄.wr, wr₃] - · rw [u₁₀.gpr, u₉.gpr, g₈ r h, g₃ r h h'] - · -- The values read are the original arguments, unchanged by the earlier stores. - have a : ∀ d, 4 ≤ d → d + 4 ≤ 28 → s₃.mem.readW (addr (esp₀ s₀) d) 32 = s₀.mem.readW (addr (esp₀ s₀) d) 32 := - fun d h₁ h₂ => by rw [m₃, ld d h₁ h₂] - have w : ∀ (m : Mem) (v : BitVec 32) (d e : Nat), d + 4 ≤ 28 → e + 4 ≤ 28 → d + 4 ≤ e ∨ e + 4 ≤ d → - (m.writeW (addr (esp₀ s₀) e) v).readW (addr (esp₀ s₀) d) 32 = m.readW (addr (esp₀ s₀) d) 32 := - fun m v d e h₂ h₄ h => readW_writeW_addr m v (by omega_nat) (by omega_nat) h - have m₅ : s₅.mem = s₃.mem.writeW (addr (esp₀ s₀) 8) (arg s₀ 2) := by - rw [u₅.mem, u₄.gpr, u₄.mem, a 12 (by omega_nat) (by omega_nat)]; rfl - have m₇ : s₇.mem = (s₃.mem.writeW (addr (esp₀ s₀) 8) (arg s₀ 2)).writeW (addr (esp₀ s₀) 12) (arg s₀ 3) := by - rw [u₇.mem, u₆.gpr, u₆.mem, m₅, w _ _ 16 8 (by omega_nat) (by omega_nat) (by omega_nat), a 16 (by omega_nat) (by omega_nat)]; rfl - have m₉ : s₉.mem = s₇.mem.writeW (addr (esp₀ s₀) 16) (out s₀) := by - rw [u₉.mem, u₈.gpr, u₈.mem, m₇, w _ _ 20 12 (by omega_nat) (by omega_nat) (by omega_nat), - w _ _ 20 8 (by omega_nat) (by omega_nat) (by omega_nat), a 20 (by omega_nat) (by omega_nat)]; rfl - rw [u₁₀.mem, m₉, m₇, u₉.gpr, g₈ _ (by decide), ed₃, m₃]; rfl - -/-! ## The inner hash -/ - -abbrev SPre := VG.Proof.Sha256.X86.Stream.Finalize.Pre -abbrev SDone := VG.Proof.Sha256.X86.Stream.Finalize.Done - -theorem finalizeHash_eq : finalizeHash = .seq (.block (([.mov .eax (.mem (at_ .esp 20))] : List Instr) ++ - VG.Impl.Sha256.X86.Stream.save .eax ++ - ([.mov .ebp (.reg .eax), .mov .ebx (.mem (at_ .esp 4)), - .mov .ecx (.mem (at_ .esp 8)), .store (at_ .ebp 128) .ecx, - .mov .ecx (.mem (at_ .esp 12)), .store (at_ .ebp 132) .ecx, - .mov .ecx (.mem (at_ .esp 16)), .store (at_ .ebp 136) .ecx, - .mov .edi (.mem (at_ .esp 8)), .alu .and .edi (.imm 63), - .mov .edx (.reg .ebx), .alu .add .edx (.reg .edi), .mov .ecx (.imm 0x80), - .store8 (at_ .edx 32) .cl, .alu .add .edi (.imm 1), - .mov .esi (.imm 0), .alu .cmp .edi (.imm 57)] : List Instr))) - (.seq (.ite .ae (.block [.mov .esi (.imm 1)]) (.block [])) - (.loop VG.Impl.Sha256.X86.Stream.finalizeBody .e)) := rfl - -theorem finalizeHash_nosp : NoSp finalizeHash := NoSp.of_all (by lit_decide) - -theorem finalizeHash_stack : stackUse finalizeHash = 20 := by lit_decide - -/-- The state after the prologue, with the permissions of `vg_sha256_finalize`. -/ -abbrev narrow (s₀ s : State) : State := s.withRegions [] (finW s₀) - -theorem narrow_arg {s₀ s : State} (hp : Pre s₀) (h : Pro s₀ s) {i : Nat} (hi : i < 5) : - arg (narrow s₀ s) i = [inn s₀, arg s₀ 2, arg s₀ 3, out s₀, scr s₀].getD i 0 := by - have sp : s.gpr .esp = esp₀ s₀ := h.gpr _ (by decide) (by decide) - show s.mem.readW (addr (s.gpr .esp) (4 + 4 * i)) 32 = _ - rw [h.mem, sp]; exact proMem_arg hp i hi - -theorem narrow_pre {s₀ s : State} (hp : Pre s₀) (h : Pro s₀ s) : SPre (narrow s₀ s) := by - have sp : s.gpr .esp = esp₀ s₀ := h.gpr .esp (by decide) (by decide) - have a0 : arg (narrow s₀ s) 0 = inn s₀ := narrow_arg hp h (by omega_nat) - have a3 : arg (narrow s₀ s) 3 = out s₀ := narrow_arg hp h (by omega_nat) - have a4 : arg (narrow s₀ s) 4 = scr s₀ := narrow_arg hp h (by omega_nat) - have s160 : Region.Sub ⟨scA s₀, 160⟩ (scR s₀) := Region.sub_prefix (by omega_nat) - have a20 : Region.Sub ⟨addr (esp₀ s₀) 4, 20⟩ (argR s₀) := Region.sub_prefix (by omega_nat) - have fs := hp.scr_fit - have fsp := hp.sp_fit - refine ⟨rfl, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ - · show finW s₀ = [⟨(arg (narrow s₀ s) 0).setWidth 64, 96⟩, ⟨(arg (narrow s₀ s) 3).setWidth 64, 32⟩, - ⟨(arg (narrow s₀ s) 4).setWidth 64, 160⟩, ⟨addr (s.gpr .esp) 4, 20⟩] - rw [a0, a3, a4, sp] - · show Region.Disjoint ⟨(arg (narrow s₀ s) 0).setWidth 64, 96⟩ ⟨(arg (narrow s₀ s) 3).setWidth 64, 32⟩ - rw [a0, a3]; exact hp.in_out - · show Region.Disjoint ⟨(arg (narrow s₀ s) 0).setWidth 64, 96⟩ ⟨(arg (narrow s₀ s) 4).setWidth 64, 160⟩ - rw [a0, a4]; exact hp.in_scr.sub_right s160 - · show Region.Disjoint ⟨(arg (narrow s₀ s) 3).setWidth 64, 32⟩ ⟨(arg (narrow s₀ s) 4).setWidth 64, 160⟩ - rw [a3, a4]; exact hp.out_scr.sub_right s160 - · show Region.Disjoint ⟨addr (s.gpr .esp) 4, 20⟩ ⟨(arg (narrow s₀ s) 0).setWidth 64, 96⟩ - rw [a0, sp]; exact hp.a_in.sub_left a20 - · show Region.Disjoint ⟨addr (s.gpr .esp) 4, 20⟩ ⟨(arg (narrow s₀ s) 3).setWidth 64, 32⟩ - rw [a3, sp]; exact hp.a_out.sub_left a20 - · show Region.Disjoint ⟨addr (s.gpr .esp) 4, 20⟩ ⟨(arg (narrow s₀ s) 4).setWidth 64, 160⟩ - rw [a4, sp]; exact (hp.a_scr.sub_left a20).sub_right s160 - · show Region.Disjoint ⟨(s.gpr .esp).setWidth 64, 4⟩ ⟨(arg (narrow s₀ s) 0).setWidth 64, 96⟩ - rw [a0, sp]; exact hp.ret_in - · show Region.Disjoint ⟨(s.gpr .esp).setWidth 64, 4⟩ ⟨(arg (narrow s₀ s) 3).setWidth 64, 32⟩ - rw [a3, sp]; exact hp.ret_out - · show Region.Disjoint ⟨(s.gpr .esp).setWidth 64, 4⟩ ⟨(arg (narrow s₀ s) 4).setWidth 64, 160⟩ - rw [a4, sp]; exact hp.ret_scr.sub_right s160 - · show Region.Disjoint (below (s.gpr .esp) 20) ⟨(arg (narrow s₀ s) 0).setWidth 64, 96⟩ - rw [a0, sp]; exact hp.stk_in - · show Region.Disjoint (below (s.gpr .esp) 20) ⟨(arg (narrow s₀ s) 3).setWidth 64, 32⟩ - rw [a3, sp]; exact hp.stk_out - · show Region.Disjoint (below (s.gpr .esp) 20) ⟨(arg (narrow s₀ s) 4).setWidth 64, 160⟩ - rw [a4, sp]; exact hp.stk_scr.sub_right s160 - · show (arg (narrow s₀ s) 0).toNat + 96 ≤ 2 ^ 32 - rw [a0]; exact hp.in_fit - · show (arg (narrow s₀ s) 3).toNat + 32 ≤ 2 ^ 32 - rw [a3]; exact hp.out_fit - · show (arg (narrow s₀ s) 4).toNat + 160 ≤ 2 ^ 32 - rw [a4]; omega_nat - · show 20 ≤ (s.gpr .esp).toNat - rw [sp]; exact hp.sp_lo - · show (s.gpr .esp).toNat + 24 ≤ 2 ^ 32 - rw [sp]; omega_nat - -/-! ## The outer block -/ - -/-- The little-endian bytes of a word. -/ -def le (v : BitVec 32) : List Byte := (List.range 4).map fun j => v.extractLsb' (8 * j) 8 - -theorem writeW_le (m : Mem) (a : Addr) (v : BitVec 32) : m.writeW a v = writeBytes m a (le v) := by - rw [Mem.writeW, VG.Proof.Sha256.Stream.write_eq_writeBytes]; rfl - -/-- The rest of the outer block after the digest: `0x80`, zeros and the length 768, big-endian. -/ -def padBytes : List Byte := le 0x80 ++ le 0 ++ le 0 ++ le 0 ++ le 0 ++ le 0 ++ le 0 ++ le 0x00030000 - -theorem padBytes_eq : padBytes = [0x80] ++ List.replicate 23 0 ++ [0, 0, 0, 0, 0, 0, 3, 0] := by decide - -theorem padWords_eq : padWords = [.mov .ecx (.imm 0x80), .store (at_ .ebx 64) .ecx, .mov .ecx (.imm 0), - .store (at_ .ebx 68) .ecx, .store (at_ .ebx 72) .ecx, .store (at_ .ebx 76) .ecx, .store (at_ .ebx 80) .ecx, - .store (at_ .ebx 84) .ecx, .store (at_ .ebx 88) .ecx, .mov .ecx (.imm 0x00030000), .store (at_ .ebx 92) .ecx] := - rfl - -/-- Memory after the middle block, from `m`: the inner state holds the outer -hash value and, in its buffer, the inner digest and `padBytes`. -/ -def midMem (s₀ : State) (m : Mem) : Mem := - writeBytes (writeBytes (writeBytes m (inA s₀ + BitVec.ofNat 64 32) (beWords m (inn s₀) 0 8)) - (inA s₀ + BitVec.ofNat 64 0) (bytesAt m (ouA s₀ + BitVec.ofNat 64 0) (4 * 8))) - (inA s₀ + BitVec.ofNat 64 64) padBytes - -/-- Consecutive words written after some bytes. -/ -theorem writeW_after (m : Mem) (q : Addr) (xs : List Byte) (v : BitVec 32) {d : Nat} (hd : d = xs.length) - (h : xs.length + 4 < 2 ^ 64) : - (writeBytes m q xs).writeW (q + BitVec.ofNat 64 d) v = writeBytes m q (xs ++ le v) := by - subst hd; rw [writeW_le, writeBytes_append _ _ _ _ (by simp [le]; omega_nat)] - -theorem le_length (v : BitVec 32) : (le v).length = 4 := by simp [le] - -/-- What the middle block needs. -/ -structure MidPre (s₀ s : State) : Prop where - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - ebx : s.gpr .ebx = inn s₀ - ebp : s.gpr .ebp = scr s₀ - esp : s.gpr .esp = esp₀ s₀ - ou : s.mem.readW (addr (scr s₀) 176) 32 = ou s₀ - -/-- After it. -/ -structure Mid (s₀ s s' : State) : Prop where - rd : s'.rd = s₀.rd - wr : s'.wr = s₀.wr - gpr : ∀ r, r ≠ .eax → r ≠ .ecx → r ≠ .edx → s'.gpr r = s.gpr r - eax : s'.gpr .eax = inn s₀ + 32 - mem : s'.mem = midMem s₀ s.mem - -theorem mid_ok {s₀ s : State} (hp : Pre s₀) (h : MidPre s₀ s) : - WP isa (.block ((List.range 8).flatMap (bswapWord .ebx .ebx 0 32) ++ .mov .edx (.mem (at_ .ebp 176)) :: - (List.range 8).flatMap (copyWord .edx .ebx 0 0) ++ padWords ++ - ([.mov .eax (.reg .ebx), .alu .add .eax (.imm 32)] : List Instr))) - s (Mid s₀ s) := by - have fi := hp.in_fit - have fo := hp.ou_fit - have fsp := hp.sp_fit - have inn_in : ∀ d, d + 4 ≤ 96 → InRegions s.wr (addr (inn s₀) d) 4 := - fun d hd => ⟨inR s₀, by simp [h.wr, hp.wr], hp.in_in hd (by omega_nat)⟩ - simp only [List.append_assoc, List.cons_append] - refine bswapWords_ok (by decide) (by decide) 8 _ s _ h.ebx h.ebx (by omega_nat) (by omega_nat) - (fun k hk => by have := inn_in (0 + 4 * k) (by omega_nat); exact ⟨_, List.mem_append_right _ this.choose_spec.1, - this.choose_spec.2⟩) - (fun k hk => inn_in (32 + 4 * k) (by omega_nat)) ?_ fun s₁ g₁ rd₁ wr₁ m₁ => ?_ - · exact Offset.sep _ (Or.inl (by omega_nat)) (by omega_nat) (by omega_nat) - have e₁ : s₁.gpr .ebx = inn s₀ := by rw [g₁ _ (by decide), h.ebx] - have p₁ : s₁.gpr .ebp = scr s₀ := by rw [g₁ _ (by decide), h.ebp] - have sp₁ : s₁.gpr .esp = esp₀ s₀ := by rw [g₁ _ (by decide), h.esp] - have wr₁' : s₁.wr = s₀.wr := wr₁.trans h.wr - have rd₁' : s₁.rd = s₀.rd := rd₁.trans h.rd - have hs : (scR s₀).Contains (addr (scr s₀) 176) 4 := hp.scr_in (by omega_nat) (by omega_nat) - refine wp_movm (a := addr (scr s₀) 176) (by rw [ea_at, p₁]) - ⟨scR s₀, by simp [rd₁', wr₁', hp.wr], hs⟩ fun s₂ u₂ => ?_ - have ou₂ : s₂.gpr .edx = ou s₀ := by - rw [u₂.gpr, m₁, readW_writeBytes_sep _ _ ?_, h.ou] - rw [beWords_length] - exact hp.in_scr.symm.sep hs (contains_offset (by omega_nat) (by omega_nat)) - have rd₂ : s₂.rd = s₀.rd := u₂.rd.trans rd₁' - have wr₂ : s₂.wr = s₀.wr := u₂.wr.trans wr₁' - have e₂ : s₂.gpr .ebx = inn s₀ := by rw [u₂.other _ (by decide), e₁] - refine copyWords_ok (by decide) (by decide) 8 _ s₂ _ ou₂ e₂ (by omega_nat) (by omega_nat) - (fun k hk => ⟨ouR s₀, by simp [rd₂, wr₂, hp.rd], contains_addr (by omega_nat) (by omega_nat) fo⟩) - (fun k hk => by rw [wr₂, ← h.wr]; exact inn_in (0 + 4 * k) (by omega_nat)) - (hp.o_in.sep (contains_offset (by omega_nat) (by omega_nat)) (contains_offset (by omega_nat) (by omega_nat))) - fun s₃ g₃ rd₃ wr₃ m₃ => ?_ - have e₃ : s₃.gpr .ebx = inn s₀ := by rw [g₃ _ (by decide), e₂] - have rd₃' : s₃.rd = s₀.rd := rd₃.trans rd₂ - have wr₃' : s₃.wr = s₀.wr := wr₃.trans wr₂ - -- The padding words. - have padA : ∀ k, k < 8 → addr (inn s₀) (64 + 4 * k) = inA s₀ + BitVec.ofNat 64 64 + BitVec.ofNat 64 (4 * k) := - fun k hk => addr_word (n := 8) (by omega_nat) hk - have pin : ∀ (t : State), t.wr = s₀.wr → ∀ k, k < 8 → - InRegions t.wr (inA s₀ + BitVec.ofNat 64 64 + BitVec.ofNat 64 (4 * k)) 4 := - fun t ht k hk => by rw [← padA k hk, ht, ← h.wr]; exact inn_in (64 + 4 * k) (by omega_nat) - rw [padWords_eq] - simp only [List.cons_append, List.nil_append] - refine wp_movi fun s₄ u₄ => ?_ - refine wp_store (a := inA s₀ + BitVec.ofNat 64 64 + BitVec.ofNat 64 (4 * 0)) - (by rw [ea_at, u₄.other _ (by decide), e₃, ← padA 0 (by omega_nat)]) (by rw [u₄.wr]; exact pin _ wr₃' 0 (by omega_nat)) - fun s₅ u₅ => wp_movi fun s₆ u₆ => ?_ - have x₆ : ∀ r, r ≠ .ecx → s₆.gpr r = s₃.gpr r := fun r h => by rw [u₆.other r h, u₅.gpr, u₄.other r h] - have wr₆ : s₆.wr = s₀.wr := by rw [u₆.wr, u₅.wr, u₄.wr, wr₃'] - have st : ∀ (t : State), t.wr = s₀.wr → (∀ r, r ≠ .ecx → t.gpr r = s₃.gpr r) → ∀ k, k < 8 → - t.ea (at_ .ebx (64 + 4 * k)) = inA s₀ + BitVec.ofNat 64 64 + BitVec.ofNat 64 (4 * k) := - fun t _ ht k hk => by rw [ea_at, ht _ (by decide), e₃, padA k hk] - refine wp_store (st _ wr₆ x₆ 1 (by omega_nat)) (pin _ wr₆ 1 (by omega_nat)) fun s₇ u₇ => ?_ - refine wp_store (st _ (by rw [u₇.wr, wr₆]) (fun r h => by rw [u₇.gpr, x₆ r h]) 2 (by omega_nat)) - (pin _ (by rw [u₇.wr, wr₆]) 2 (by omega_nat)) fun s₈ u₈ => ?_ - refine wp_store (st _ (by rw [u₈.wr, u₇.wr, wr₆]) (fun r h => by rw [u₈.gpr, u₇.gpr, x₆ r h]) 3 (by omega_nat)) - (pin _ (by rw [u₈.wr, u₇.wr, wr₆]) 3 (by omega_nat)) fun s₉ u₉ => ?_ - refine wp_store (st _ (by rw [u₉.wr, u₈.wr, u₇.wr, wr₆]) - (fun r h => by rw [u₉.gpr, u₈.gpr, u₇.gpr, x₆ r h]) 4 (by omega_nat)) - (pin _ (by rw [u₉.wr, u₈.wr, u₇.wr, wr₆]) 4 (by omega_nat)) fun s₁₀ u₁₀ => ?_ - refine wp_store (st _ (by rw [u₁₀.wr, u₉.wr, u₈.wr, u₇.wr, wr₆]) - (fun r h => by rw [u₁₀.gpr, u₉.gpr, u₈.gpr, u₇.gpr, x₆ r h]) 5 (by omega_nat)) - (pin _ (by rw [u₁₀.wr, u₉.wr, u₈.wr, u₇.wr, wr₆]) 5 (by omega_nat)) fun s₁₁ u₁₁ => ?_ - refine wp_store (st _ (by rw [u₁₁.wr, u₁₀.wr, u₉.wr, u₈.wr, u₇.wr, wr₆]) - (fun r h => by rw [u₁₁.gpr, u₁₀.gpr, u₉.gpr, u₈.gpr, u₇.gpr, x₆ r h]) 6 (by omega_nat)) - (pin _ (by rw [u₁₁.wr, u₁₀.wr, u₉.wr, u₈.wr, u₇.wr, wr₆]) 6 (by omega_nat)) fun s₁₂ u₁₂ => ?_ - refine wp_movi fun s₁₃ u₁₃ => ?_ - have x₁₃ : ∀ r, r ≠ .ecx → s₁₃.gpr r = s₃.gpr r := fun r h => by - rw [u₁₃.other r h, u₁₂.gpr, u₁₁.gpr, u₁₀.gpr, u₉.gpr, u₈.gpr, u₇.gpr, x₆ r h] - have wr₁₃ : s₁₃.wr = s₀.wr := by rw [u₁₃.wr, u₁₂.wr, u₁₁.wr, u₁₀.wr, u₉.wr, u₈.wr, u₇.wr, wr₆] - refine wp_store (st _ wr₁₃ x₁₃ 7 (by omega_nat)) (pin _ wr₁₃ 7 (by omega_nat)) fun s₁₄ u₁₄ => ?_ - -- `eax`. - have x₁₄ : ∀ r, r ≠ .ecx → s₁₄.gpr r = s₃.gpr r := fun r h => by rw [u₁₄.gpr, x₁₃ r h] - have wr₁₄ : s₁₄.wr = s₀.wr := by rw [u₁₄.wr, wr₁₃] - have rd₁₄ : s₁₄.rd = s₀.rd := by - rw [u₁₄.rd, u₁₃.rd, u₁₂.rd, u₁₁.rd, u₁₀.rd, u₉.rd, u₈.rd, u₇.rd, u₆.rd, u₅.rd, u₄.rd, rd₃'] - refine wp_mov fun s₁₇ u₁₇ => wp_addi fun s₁₈ u₁₈ => WP.block_nil ⟨?_, ?_, fun r h₁ h₂ h₃ => ?_, ?_, ?_⟩ - · rw [u₁₈.rd, u₁₇.rd, rd₁₄] - · rw [u₁₈.wr, u₁₇.wr, wr₁₄] - · rw [u₁₈.other r h₁, u₁₇.other r h₁, x₁₄ r h₂, g₃ r h₂, u₂.other r h₃, g₁ r h₂] - · rw [u₁₈.gpr, u₁₇.gpr, x₁₄ _ (by decide), e₃] - · have hq : inA s₀ + BitVec.ofNat 64 64 + BitVec.ofNat 64 (4 * 0) = inA s₀ + BitVec.ofNat 64 64 := by simp - have hl : ∀ xs : List Byte, xs.length ≤ 28 → xs.length + 4 < 2 ^ 64 := fun _ h => by omega_nat - rw [u₁₈.mem, u₁₇.mem, - u₁₄.mem, u₁₃.gpr, u₁₃.mem, u₁₂.mem, u₁₁.gpr, u₁₁.mem, u₁₀.gpr, u₁₀.mem, u₉.gpr, u₉.mem, - u₈.gpr, u₈.mem, u₇.gpr, u₇.mem, u₆.gpr, u₆.mem, u₅.mem, u₄.gpr, u₄.mem, hq, writeW_le _ (inA s₀ + BitVec.ofNat 64 64), - writeW_after _ _ _ _ (by simp [le_length]) (hl _ (by simp [le_length])), - writeW_after _ _ _ _ (by simp [le_length]) (hl _ (by simp [le_length])), - writeW_after _ _ _ _ (by simp [le_length]) (hl _ (by simp [le_length])), - writeW_after _ _ _ _ (by simp [le_length]) (hl _ (by simp [le_length])), - writeW_after _ _ _ _ (by simp [le_length]) (hl _ (by simp [le_length])), - writeW_after _ _ _ _ (by simp [le_length]) (hl _ (by simp [le_length])), - writeW_after _ _ _ _ (by simp [le_length]) (hl _ (by simp [le_length])), - m₃, u₂.mem, m₁, VG.Proof.Hmac.Common.bytesAt_writeBytes_sep _ _ ?_ (by omega_nat)] - · rfl - · rw [beWords_length] - exact hp.o_in.sep (contains_offset (by omega_nat) (by omega_nat)) (contains_offset (by omega_nat) (by omega_nat)) - -/-! ## What the middle block leaves -/ - -/-- `List.ofFn` as a map over `List.finRange` (Mathlib's `List.ofFn_eq_map`). -/ -theorem ofFn_eq_map {n : Nat} {α : Type} (f : Fin n → α) : List.ofFn f = (List.finRange n).map f := - List.map_ofFn.symm - -/-- Mathlib's `List.flatMap_congr`. -/ -theorem flatMap_congr {α β : Type} {l : List α} {f g : α → List β} (h : ∀ x ∈ l, f x = g x) : - l.flatMap f = l.flatMap g := by - induction l with - | nil => rfl - | cons a l ih => - rw [List.flatMap_cons, List.flatMap_cons, h a List.mem_cons_self, - ih fun x hx => h x (List.mem_cons_of_mem _ hx)] - -theorem beWords_stateAt (m : Mem) {x : BitVec 32} (hx : x.toNat + 32 ≤ 2 ^ 32) : - beWords m x 0 8 = (stateAt m (x.setWidth 64)).toList.flatMap wordBytes := by - simp only [beWords, stateAt, Vector.toList_ofFn, ofFn_eq_map] - rw [List.flatMap_map, ← List.flatMap_map (f := Fin.val) - (g := fun k => wordBytes (m.readW (x.setWidth 64 + BitVec.ofNat 64 (4 * k)) 32)), - show (List.finRange 8).map Fin.val = List.range 8 from rfl] - refine flatMap_congr fun k hk => ?_ - have hk := List.mem_range.mp hk - rw [Nat.zero_add, addr_eq (by omega_nat)] - -theorem bytesAt_writeW_sep (m : Mem) {p a : Addr} {n : Nat} (v : BitVec 32) (h : Mem.Sep p n a 4) - (hn : n < 2 ^ 64) : bytesAt (m.writeW a v) p n = bytesAt m p n := by - rw [writeW_le]; exact VG.Proof.Hmac.Common.bytesAt_writeBytes_sep _ _ (by rwa [le_length]) hn - -theorem padBytes_length : padBytes.length = 32 := by decide - -theorem sep_off (b : Addr) {d e n k : Nat} (h : d + n ≤ e ∨ e + k ≤ d) (hd : d + n < 2 ^ 32) (he : e + k < 2 ^ 32) : - Mem.Sep (b + BitVec.ofNat 64 d) n (b + BitVec.ofNat 64 e) k := Offset.sep b h (by omega_nat) (by omega_nat) - -section -variable {s₀ : State} (hp : Pre s₀) (m : Mem) -include hp - -omit hp in -theorem midMem_frame : Frame [inR s₀, argR s₀] m (midMem s₀ m) := by - simp only [midMem] - refine (((writeBytes_frame (R := inR s₀) _ _ _ ?_).trans (writeBytes_frame (R := inR s₀) _ _ _ ?_)).trans - (writeBytes_frame (R := inR s₀) _ _ _ ?_)).mono (by simp) - · rw [beWords_length]; exact contains_offset (by omega_nat) (by omega_nat) - · rw [bytesAt_length]; exact contains_offset (by omega_nat) (by omega_nat) - · rw [padBytes_length]; exact contains_offset (by omega_nat) (by omega_nat) - -omit hp in -/-- The inner state holds the outer hash value. -/ -theorem midMem_state : stateAt (midMem s₀ m) (inA s₀) = stateAt m (ouA s₀) := by - have s0_64 : Mem.Sep (inA s₀ + BitVec.ofNat 64 0) 32 (inA s₀ + BitVec.ofNat 64 64) padBytes.length := by - rw [padBytes_length]; exact sep_off _ (by omega_nat) (by omega_nat) (by omega_nat) - have hb : bytesAt (midMem s₀ m) (inA s₀ + BitVec.ofNat 64 0) 32 = bytesAt m (ouA s₀ + BitVec.ofNat 64 0) 32 := by - simp only [midMem] - rw [VG.Proof.Hmac.Common.bytesAt_writeBytes_sep _ _ s0_64 (by omega_nat)] - have := VG.Proof.Hmac.Common.bytesAt_writeBytes_self - (writeBytes m (inA s₀ + BitVec.ofNat 64 32) (beWords m (inn s₀) 0 8)) (inA s₀ + BitVec.ofNat 64 0) - (bytesAt m (ouA s₀ + BitVec.ofNat 64 0) (4 * 8)) (by rw [bytesAt_length]; omega_nat) - rw [bytesAt_length] at this - exact this - refine VG.Proof.Hmac.Common.stateAt_eq_of_bytes fun i hi => ?_ - have h₁ := bytesAt_getD (k := i) hb (by omega_nat) - rw [show inA s₀ + BitVec.ofNat 64 0 = inA s₀ by simp] at h₁ - rw [h₁, VG.Proof.Hmac.Common.bytesAt_getD' _ _ hi, show ouA s₀ + BitVec.ofNat 64 0 = ouA s₀ by simp] - -omit hp in -/-- The block after it: the digest, then `padBytes`. -/ -theorem midMem_block : - bytesAt (midMem s₀ m) (inA s₀ + BitVec.ofNat 64 32) (32 + 32) = beWords m (inn s₀) 0 8 ++ padBytes := by - have s32_64 : Mem.Sep (inA s₀ + BitVec.ofNat 64 32) 32 (inA s₀ + BitVec.ofNat 64 64) padBytes.length := by - rw [padBytes_length]; exact sep_off _ (by omega_nat) (by omega_nat) (by omega_nat) - have s32_0 : Mem.Sep (inA s₀ + BitVec.ofNat 64 32) 32 (inA s₀ + BitVec.ofNat 64 0) - (bytesAt m (ouA s₀ + BitVec.ofNat 64 0) (4 * 8)).length := by - rw [bytesAt_length]; exact sep_off _ (by omega_nat) (by omega_nat) (by omega_nat) - simp only [midMem] - rw [VG.Proof.Hmac.Common.bytesAt_add, - show inA s₀ + BitVec.ofNat 64 32 + BitVec.ofNat 64 32 = inA s₀ + BitVec.ofNat 64 64 by - rw [BitVec.add_assoc, ← BitVec.ofNat_add]] - refine congrArg₂ (· ++ ·) ?_ ?_ - · rw [VG.Proof.Hmac.Common.bytesAt_writeBytes_sep _ _ s32_64 (by omega_nat), - VG.Proof.Hmac.Common.bytesAt_writeBytes_sep _ _ s32_0 (by omega_nat)] - have := VG.Proof.Hmac.Common.bytesAt_writeBytes_self m (inA s₀ + BitVec.ofNat 64 32) (beWords m (inn s₀) 0 8) - (by rw [beWords_length]; omega_nat) - rwa [beWords_length] at this - · have := VG.Proof.Hmac.Common.bytesAt_writeBytes_self - (writeBytes (writeBytes m (inA s₀ + BitVec.ofNat 64 32) (beWords m (inn s₀) 0 8)) (inA s₀ + BitVec.ofNat 64 0) - (bytesAt m (ouA s₀ + BitVec.ofNat 64 0) (4 * 8))) (inA s₀ + BitVec.ofNat 64 64) padBytes - (by rw [padBytes_length]; omega_nat) - rwa [padBytes_length] at this - -end - -/-! ## The outer compression -/ - -theorem blk_eq {s₀ : State} (hp : Pre s₀) : (inn s₀ + 32).setWidth 64 = inA s₀ + BitVec.ofNat 64 32 := by - show addr (inn s₀) 32 = _ - exact addr_eq (by have := hp.in_fit; omega_nat) - -theorem out_ok {s₀ s : State} (hp : Pre s₀) (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) - (hebx : s.gpr .ebx = inn s₀) (hebp : s.gpr .ebp = scr s₀) (hsp : s.gpr .esp = esp₀ s₀) - (hout : s.mem.readW (addr (scr s₀) 136) 32 = out s₀) - (hsv : ∀ p ∈ saved, s.mem.readW (addr (scr s₀) p.2) 32 = s₀.gpr p.1) : - WP isa (.block (.mov .eax (.mem (at_ .ebp 136)) :: (List.range 8).flatMap (bswapWord .ebx .eax 0 0) ++ - .mov .eax (.reg .ebp) :: restore .eax)) s fun s' => - s'.rd = s₀.rd ∧ s'.wr = s₀.wr ∧ (∀ r ∈ calleeSaved, s'.gpr r = s₀.gpr r) ∧ - s'.mem = writeBytes s.mem (outA s₀ + BitVec.ofNat 64 0) (beWords s.mem (inn s₀) 0 8) := by - have fi := hp.in_fit - have fo := hp.out_fit - have sin : ∀ d, d + 4 ≤ 240 → InRegions (s.rd ++ s.wr) (addr (scr s₀) d) 4 := - fun d hd => ⟨scR s₀, by simp [hrd, hwr, hp.wr], hp.scr_in hd (by omega_nat)⟩ - rw [List.cons_append] - refine wp_movm (a := addr (scr s₀) 136) (by rw [ea_at, hebp]) (sin 136 (by omega_nat)) fun s₁ u₁ => ?_ - refine bswapWords_ok (src := .ebx) (dst := .eax) (by decide) (by decide) 8 _ s₁ _ - (by rw [u₁.other _ (by decide), hebx]) (by rw [u₁.gpr, hout]) (by omega_nat) (by omega_nat) - (fun k hk => ⟨inR s₀, by simp [u₁.rd, u₁.wr, hrd, hwr, hp.wr], hp.in_in (by omega_nat) (by omega_nat)⟩) - (fun k hk => ⟨outR s₀, by simp [u₁.wr, hwr, hp.wr], contains_addr (by omega_nat) (by omega_nat) fo⟩) - (hp.in_out.sep (contains_offset (by omega_nat) (by omega_nat)) (contains_offset (by omega_nat) (by omega_nat))) - fun s₂ g₂ rd₂ wr₂ m₂ => ?_ - refine wp_mov fun s₃ u₃ => ?_ - have e₃ : s₃.gpr .eax = scr s₀ := by rw [u₃.gpr, g₂ _ (by decide), u₁.other _ (by decide), hebp] - have m₃ : s₃.mem = writeBytes s.mem (outA s₀ + BitVec.ofNat 64 0) (beWords s.mem (inn s₀) 0 8) := by - rw [u₃.mem, m₂, u₁.mem] - have rd₃ : s₃.rd = s₀.rd := by rw [u₃.rd, rd₂, u₁.rd, hrd] - have wr₃ : s₃.wr = s₀.wr := by rw [u₃.wr, wr₂, u₁.wr, hwr] - -- The saved registers, which the MAC does not overwrite. - have rs : ∀ p ∈ saved, s₃.mem.readW (addr (scr s₀) p.2) 32 = s₀.gpr p.1 := by - intro p hp' - have hd : 112 ≤ p.2 ∧ p.2 + 4 ≤ 128 := by - simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl | rfl <;> simp - rw [m₃, readW_writeBytes_sep _ _ ?_, hsv p hp'] - rw [beWords_length] - exact hp.out_scr.symm.sep (hp.scr_in (by omega_nat) (by omega_nat)) (contains_offset (by omega_nat) (by omega_nat)) - have sin₃ : ∀ d, d + 4 ≤ 240 → InRegions (s₃.rd ++ s₃.wr) (addr (scr s₀) d) 4 := - fun d hd => by rw [rd₃, wr₃, ← hrd, ← hwr]; exact sin d hd - simp only [restore, saved, List.map_cons, List.map_nil] - refine wp_movm (a := addr (scr s₀) 112) (by rw [ea_at, e₃]) (sin₃ 112 (by omega_nat)) fun s₄ u₄ => ?_ - refine wp_movm (a := addr (scr s₀) 116) (by rw [ea_at, u₄.other _ (by decide), e₃]) - (by rw [u₄.rd, u₄.wr]; exact sin₃ 116 (by omega_nat)) fun s₅ u₅ => ?_ - refine wp_movm (a := addr (scr s₀) 120) (by rw [ea_at, u₅.other _ (by decide), u₄.other _ (by decide), e₃]) - (by rw [u₅.rd, u₅.wr, u₄.rd, u₄.wr]; exact sin₃ 120 (by omega_nat)) fun s₆ u₆ => ?_ - refine wp_movm (a := addr (scr s₀) 124) - (by rw [ea_at, u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), e₃]) - (by rw [u₆.rd, u₆.wr, u₅.rd, u₅.wr, u₄.rd, u₄.wr]; exact sin₃ 124 (by omega_nat)) fun s₇ u₇ => WP.block_nil ?_ - have mm : s₇.mem = s₃.mem := by rw [u₇.mem, u₆.mem, u₅.mem, u₄.mem] - refine ⟨by rw [u₇.rd, u₆.rd, u₅.rd, u₄.rd, rd₃], by rw [u₇.wr, u₆.wr, u₅.wr, u₄.wr, wr₃], fun r hr => ?_, - by rw [mm, m₃]⟩ - simp only [calleeSaved, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl - · rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr] - exact rs (.ebx, 112) (by simp [saved]) - · rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.gpr, u₄.mem] - exact rs (.esi, 116) (by simp [saved]) - · rw [u₇.other _ (by decide), u₆.gpr, u₅.mem, u₄.mem] - exact rs (.edi, 120) (by simp [saved]) - · rw [u₇.gpr, u₆.mem, u₅.mem, u₄.mem] - exact rs (.ebp, 124) (by simp [saved]) - · rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), - u₃.other _ (by decide), g₂ _ (by decide), u₁.other _ (by decide), hsp] - -/-! ## Correctness -/ - -/-- Everything we may write. -/ -abbrev allR (s₀ : State) : List Region := [inR s₀, outR s₀, scR s₀, argR s₀, stkR s₀] - -theorem xorPad_length (k : List Byte) (p : Byte) : (xorPad k p).length = k.length := by simp [xorPad] - -/-- The outer hash, of `(K₀ ⊕ opad) ‖ d`, from the outer hash value and the block after it. -/ -theorem outer_hash {k0 d : List Byte} (hk : k0.length = 64) (hd : d.length = 32) : - Spec.Sha256.hash (xorPad k0 opad ++ d) = - (compress (Spec.Sha256.compressList Spec.Sha256.H0 (xorPad k0 opad) 1) - (parseBlock fun t => (d ++ padBytes).getD t 0)).toList.flatMap wordBytes := by - have hl : (xorPad k0 opad ++ d).length = 96 := by simp [xorPad_length, hk, hd] - rw [hash_one (by rw [hl]; omega_nat), hl, compressList_append (by rw [xorPad_length, hk]), - show (96 : Nat) / 64 = 1 from rfl] - refine congrArg (fun b => (compress (Spec.Sha256.compressList Spec.Sha256.H0 (xorPad k0 opad) 1) b).toList.flatMap - wordBytes) (congrArg parseBlock (funext fun t => ?_)) - refine congrArg (fun l : List Byte => l.getD t 0) ?_ - have hr : rest (xorPad k0 opad ++ d) = d := by - simp only [rest, hl, show 64 * (96 / 64) = (xorPad k0 opad).length by rw [xorPad_length, hk]] - exact List.drop_left - have hlb : lenBytes (xorPad k0 opad ++ d) = [0, 0, 0, 0, 0, 0, 3, 0] := by - simp only [lenBytes, hl]; decide - rw [hr, hlb, padBytes_eq] - simp only [List.append_assoc] - -/-! ## Constant time -/ - -/-- The initial taint: `esp + 4` is the base of the (public) arguments, whose -words at offsets 0, 16 and 20 are the base addresses of `inner`, `out` and -`scratch`. -/ -def τ₀ : VG.X86.Taint.T := - { regs := .ofList [.esp], flags := false, lens := [96, 32, 240, 24], bases := [(.esp, 3, 4)], - slots := [(3, 0, 24)], wbases := [(3, 0, 0), (3, 16, 1), (3, 20, 2)], room := 20 } - -theorem argWord_eq {s : State} (hsp : (s.gpr .esp).toNat + 28 ≤ 2 ^ 32) {k : Nat} (hk : k < 24) : - addr (s.gpr .esp) 4 + BitVec.ofNat 64 k = argAddr s (k / 4) + BitVec.ofNat 64 (k % 4) := by - simp only [argAddr] - rw [show (s.gpr .esp + BitVec.ofNat 32 (4 + 4 * (k / 4))).setWidth 64 = addr (s.gpr .esp) (4 + 4 * (k / 4)) - from rfl, addr_eq (by omega_nat), addr_eq (by omega_nat), BitVec.add_assoc, BitVec.add_assoc, - ← BitVec.ofNat_add, ← BitVec.ofNat_add] - congr 2; omega_nat - -theorem wf₀ {s : State} (h : Proof.Hmac.finalizeSha256X86.pre s) : VG.X86.Taint.Wf τ₀ s := by - have hp := pre_of h - have hi := hp.in_fit; have ho := hp.out_fit; have hsc := hp.scr_fit; have hs := hp.sp_fit - have hlo := hp.sp_lo - obtain ⟨-, -, -, -, -, -, -, -, -, -, -, -, -, -, -, k1, -, k2, k3, -⟩ := h - refine VG.X86.Taint.Wf.entryRoom rfl ⟨fun _ => ⟨by simp [hp.wr, τ₀], ?_, ?_⟩, ?_, ?_, - fun h => absurd h (Nat.lt_irrefl 0), fun _ h => (List.not_mem_nil h).elim⟩ fun _ => ⟨hlo, ?_⟩ - · simp only [hp.wr, List.pairwise_cons, List.mem_cons, List.not_mem_nil, or_false, forall_eq_or_imp, - forall_eq, List.Pairwise.nil, and_true] - exact ⟨⟨hp.in_out, hp.in_scr, hp.a_in.symm⟩, ⟨hp.out_scr, hp.a_out.symm⟩, hp.a_scr.symm, fun _ h => h.elim⟩ - · simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl | rfl) - · simp only [addr_toNat]; omega_nat - · simp only [addr_toNat]; omega_nat - · simp only [addr_toNat]; omega_nat - · simp only; rw [addr_eq (by omega_nat), BitVec.toNat_add, addr_toNat, BitVec.toNat_ofNat]; omega_nat - · intro p hp' - simp only [τ₀, List.mem_singleton] at hp' - subst hp' - simp [VG.X86.Taint.region, hp.wr] - · intro p hp' - simp only [τ₀, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl - · refine ⟨by decide, ?_⟩ - simp only [VG.X86.Taint.byteAddr, VG.X86.Taint.region, hp.wr] - show addr (s.mem.readW (addr (esp₀ s) 4 + BitVec.ofNat 64 0) 32) 0 = inA s - simp [addr, inn, arg, argAddr] - · refine ⟨by decide, ?_⟩ - simp only [VG.X86.Taint.byteAddr, VG.X86.Taint.region, hp.wr] - show addr (s.mem.readW (addr (esp₀ s) 4 + BitVec.ofNat 64 16) 32) 0 = outA s - rw [argWord_eq hs (k := 16) (by omega_nat)] - simp [addr, out, arg] - · refine ⟨by decide, ?_⟩ - simp only [VG.X86.Taint.byteAddr, VG.X86.Taint.region, hp.wr] - show addr (s.mem.readW (addr (esp₀ s) 4 + BitVec.ofNat 64 20) 32) 0 = scA s - rw [argWord_eq hs (k := 20) (by omega_nat)] - simp [addr, scr, arg] - · simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl | rfl) - · exact k1 - · exact k2 - · exact k3 - · have := hp.sp_fit - unfold argR - rw [addr_eq (by omega_nat)] - exact Offset.disjoint_below_above _ (m := 20) (a := 4) (l := 24) (by omega_nat) - -theorem agree₀ {s₁ s₂ : State} (h₁ : Proof.Hmac.finalizeSha256X86.pre s₁) (h₂ : Proof.Hmac.finalizeSha256X86.pre s₂) - (hpub : Proof.Hmac.finalizeSha256X86.pub s₁ s₂) : VG.X86.Taint.Agree τ₀ s₁ s₂ := by - obtain ⟨hesp, ha⟩ := hpub - have hp₁ := pre_of h₁; have hp₂ := pre_of h₂ - refine ⟨⟨fun r hr => ?_, fun h => nomatch h⟩, fun _ => ?_, wf₀ h₁, wf₀ h₂, ?_, ?_, - fun h => absurd h (Nat.lt_irrefl 0), fun _ _ h => absurd h (Nat.not_lt_zero _)⟩ - · simp only [τ₀, RegSet.mem_ofList, List.mem_singleton] at hr - subst hr; exact hesp - · rw [hp₁.wr, hp₂.wr] - simp only [inR, outR, scR, argR, inA, outA, scA, inn, out, scr, esp₀, ha 0 (by omega_nat), ha 4 (by omega_nat), - ha 5 (by omega_nat), hesp] - · intro sl hsl - simp only [τ₀, List.mem_singleton] at hsl - subst hsl; decide - · intro sl hsl k _ hk - simp only [τ₀, List.mem_singleton] at hsl - subst hsl - simp only [Nat.zero_add] at hk - simp only [VG.X86.Taint.byteAddr, VG.X86.Taint.region, hp₁.wr, hp₂.wr] - show s₁.mem (addr (esp₀ s₁) 4 + BitVec.ofNat 64 k) = s₂.mem (addr (esp₀ s₂) 4 + BitVec.ofNat 64 k) - rw [argWord_eq hp₁.sp_fit hk, argWord_eq hp₂.sp_fit hk, - Mem.readW_byte s₁.mem _ (Nat.mod_lt _ (by omega_nat)), Mem.readW_byte s₂.mem _ (Nat.mod_lt _ (by omega_nat))] - exact congrArg _ (ha _ (by omega_nat)) - -/-- Memory holding the arguments `0x1000, 0x1100, 0, 0, 0x2000, 0x3000` at `0x4004`. -/ -def satMem : Mem := fun a => - if a = 0x4005 then 0x10 else if a = 0x4009 then 0x11 else if a = 0x4015 then 0x20 else - if a = 0x4019 then 0x30 else 0 - -/-- A state satisfying the precondition. -/ -def sat : State where - gpr r := match r with - | .esp => 0x4000 | _ => 0 - cf := none - zf := none - sf := none - of := none - mem := satMem - rd := [⟨0x1100, 96⟩] - wr := [⟨0x1000, 96⟩, ⟨0x2000, 32⟩, ⟨0x3000, 240⟩, ⟨0x4004, 24⟩] - -/-- What the analysis forgets wherever the hint records a taint -(`taint_decide_weaken`): the public words of `inner` and `out` (data, never -addresses), the count in `scratch[128..136)` (only data too), and the -arguments once `vg_sha256_finalize`'s code has stored `out` at -`scratch[136]` (nothing reads them afterwards); and repeated slots. Inside -the compression function, `k` frames come first among the regions. The -kernel then evaluates the compression function's thousands of instructions -with a third of the public slots. -/ -def forget (τ : VG.X86.Taint.T) : VG.X86.Taint.T := - let k := (τ.stk.filter Option.isSome).length - let args := !τ.slots.any fun (i, o, _) => i == k + 2 && o == 136 - { τ with slots := (τ.slots.filter fun (i, o, _) => - i < k || (i == k + 2 && o != 128 && o != 132) || (i == k + 3 && args)).eraseDups } - -theorem finalize_ct : ConstantTime isa Proof.Hmac.finalizeSha256X86.pre - Proof.Hmac.finalizeSha256X86.pub finalize := - VG.Taint.constantTime (A := taint) τ₀ (fun _ _ h₁ h₂ hp => agree₀ h₁ h₂ hp) - (by taint_decide_weaken forget) - -/-- `finalizeSha256X86` with the 688 bytes of scratch of the shared contract -(sized for the x86-64 AVX2 compression function), of which the code uses 240. -/ -def finalizeWide : Contract isa := - { Proof.Hmac.finalizeSha256X86 with - pre := fun s => - let inner : Region := ⟨(arg s 0).setWidth 64, 96⟩ - let outer : Region := ⟨(arg s 1).setWidth 64, 96⟩ - let out : Region := ⟨(arg s 4).setWidth 64, 32⟩ - let scratch : Region := ⟨(arg s 5).setWidth 64, 688⟩ - let args : Region := ⟨argAddr s 0, 24⟩ - let ret : Region := ⟨(s.gpr .esp).setWidth 64, 4⟩ - let stack : Region := ⟨(s.gpr .esp).setWidth 64 - 20, 20⟩ - s.rd = [outer] ∧ s.wr = [inner, out, scratch, args] ∧ - inner.Disjoint out ∧ inner.Disjoint scratch ∧ out.Disjoint scratch ∧ - args.Disjoint inner ∧ args.Disjoint out ∧ args.Disjoint scratch ∧ - outer.Disjoint inner ∧ outer.Disjoint out ∧ outer.Disjoint scratch ∧ outer.Disjoint args ∧ - ret.Disjoint inner ∧ ret.Disjoint out ∧ ret.Disjoint scratch ∧ - stack.Disjoint inner ∧ stack.Disjoint outer ∧ stack.Disjoint out ∧ stack.Disjoint scratch ∧ - (arg s 0).toNat + 96 ≤ 2 ^ 32 ∧ (arg s 1).toNat + 96 ≤ 2 ^ 32 ∧ - (arg s 4).toNat + 32 ≤ 2 ^ 32 ∧ (arg s 5).toNat + 688 ≤ 2 ^ 32 ∧ - 20 ≤ (s.gpr .esp).toNat ∧ (s.gpr .esp).toNat + 28 ≤ 2 ^ 32 } - -/-- The regions `finalizeSha256X86` lets the code write. -/ -def narrowWr (s : State) : List Region := - [⟨(arg s 0).setWidth 64, 96⟩, ⟨(arg s 4).setWidth 64, 32⟩, ⟨(arg s 5).setWidth 64, 240⟩, - ⟨argAddr s 0, 24⟩] - -/-- Rewrites the contracts at a narrowed state (`arg` does not unfold -cheaply). -/ -local macro "narrow" loc:(Lean.Parser.Tactic.location)? : tactic => - `(tactic| simp only [Proof.Hmac.finalizeSha256X86, Proof.Hmac.countFinalizeX86, - VG.Proof.Hmac.X86.Finalize.finalizeWide, VG.Proof.Hmac.X86.Finalize.narrowWr, VG.X86.arg_withRegions, VG.X86.argAddr_withRegions, - VG.X86.State.withRegions_gpr, VG.X86.State.withRegions_mem, VG.X86.State.withRegions_rd, - VG.X86.State.withRegions_wr] $(loc)?) - -theorem finalizeWide_pre (s : State) (h : finalizeWide.pre s) : - Proof.Hmac.finalizeSha256X86.pre (s.withRegions s.rd (narrowWr s)) := by - obtain ⟨h₁, _, h₃, h₄, h₅, h₆, h₇, h₈, h₉, h₁₀, h₁₁, h₁₂, h₁₃, h₁₄, h₁₅, h₁₆, h₁₇, h₁₈, h₁₉, - h₂₀, h₂₁, h₂₂, h₂₃, h₂₄, h₂₅⟩ := h - narrow - exact ⟨h₁, trivial, h₃, h₄.sub_right (Region.sub_of_ble rfl), h₅.sub_right (Region.sub_of_ble rfl), - h₆, h₇, h₈.sub_right (Region.sub_of_ble rfl), h₉, h₁₀, h₁₁.sub_right (Region.sub_of_ble rfl), h₁₂, - h₁₃, h₁₄, h₁₅.sub_right (Region.sub_of_ble rfl), h₁₆, h₁₇, h₁₈, h₁₉.sub_right (Region.sub_of_ble rfl), - h₂₀, h₂₁, h₂₂, Region.end_le_of_ble rfl h₂₃, h₂₄, h₂₅⟩ - -/-- A state satisfying `finalizeWide.pre`. -/ -def wideSat : State := - { sat with wr := [⟨0x1000, 96⟩, ⟨0x2000, 32⟩, ⟨0x3000, 688⟩, ⟨0x4004, 24⟩] } - -theorem finalizeWide_implies : - finalizeWide.Implies (Spec.Hmac.finalizeSha256OutContract X86.abi 20) := by - have a0 : arg wideSat 0 = 0x1000 := by decide - have a1 : arg wideSat 1 = 0x1100 := by decide - have a4 : arg wideSat 4 = 0x2000 := by decide - have a5 : arg wideSat 5 = 0x3000 := by decide - have e : argAddr wideSat 0 = 0x4004 := by decide - have esp : wideSat.gpr .esp = 0x4000 := rfl - sig_implies [Spec.Hmac.finalizeSha256OutContract, Spec.Hmac.finalizeSha256OutSig, finalizeWide, - Proof.Hmac.finalizeSha256X86, Proof.Hmac.countFinalizeX86, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] - [a0, a1, a4, a5, e, esp] using wideSat - -end VG.Proof.Hmac.X86.Finalize diff --git a/lean/VerifiedGarbage/Proof/Hmac/X86/Init.lean b/lean/VerifiedGarbage/Proof/Hmac/X86/Init.lean deleted file mode 100644 index 1030acd1b..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/X86/Init.lean +++ /dev/null @@ -1,902 +0,0 @@ -import VerifiedGarbage.Proof.Hmac.X86.Finalize -import Mathlib.Tactic.Set -import VerifiedGarbage.Proof.Framework.Contract -import VerifiedGarbage.Proof.Framework.X86.Inline -import VerifiedGarbage.Spec.Hmac.Contract -import VerifiedGarbage.Proof.Framework.OmegaLit - -/-! -# HMAC-SHA-256 on x86 (32-bit): `init` - -The compressor-dependent correctness proof is generic in -`Proof/Hmac/Sha256/X86/Init.lean`; this module keeps the shared memory, state -and scalar constant-time facts. The prologue saves our caller's registers in -`scratch[112..128)` and stores `H⁽⁰⁾` in both states; the key loop and the pad -loop then fill the inner buffer with `K₀ ⊕ ipad` a byte at a time (invariant -`Buf`: `j` bytes written, `edx` at byte `j`), the outer buffer is computed from -it a word at a time (`xorWords_ok`), and each buffer is compressed by calling -the compression function through the generic proof, using the 20 bytes below -`esp`. Each state then represents its block (`Common.repr_block`). --/ - -namespace VG.Proof.Hmac.X86.Init - -open VG VG.X86 VG.Impl.Hmac.X86 -open VG.Impl.Sha256.X86 (at_) -open VG.Impl.Sha256.X86.Stream (compressAt save restore saved) -open VG.Proof.Sha256.X86 (contains_offset) -open VG.Proof.Sha256.X86.Stream -open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame writeBytes_append repr_congr) -open VG.Proof.Hmac.X86 -open VG.Proof.Hmac.Common (bytesAt_length writeState stateAt_writeState) -open VG.Spec.Sha256 (HashValue stateAt blockAt compress bytesAt Repr H0) -open VG.Spec.Hmac (xorPad ipad opad blockKey sha256) - -/-! ## The precondition -/ - -section -variable (s₀ : State) - -abbrev esp₀ : BitVec 32 := s₀.gpr .esp -abbrev inn : BitVec 32 := arg s₀ 0 -abbrev ou : 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 inA : Addr := (inn s₀).setWidth 64 -abbrev ouA : Addr := (ou s₀).setWidth 64 -abbrev kA : Addr := (kp s₀).setWidth 64 -abbrev scA : Addr := (scr s₀).setWidth 64 -abbrev inR : Region := ⟨inA s₀, 96⟩ -abbrev ouR : Region := ⟨ouA s₀, 96⟩ -abbrev kR : Region := ⟨kA s₀, kl s₀⟩ -abbrev scR : Region := ⟨scA s₀, 160⟩ -abbrev argR : Region := ⟨addr (esp₀ s₀) 4, 20⟩ -abbrev retR : Region := ⟨(esp₀ s₀).setWidth 64, 4⟩ -abbrev stkR : Region := below (esp₀ s₀) 20 - -/-- The key, padded with zeros to a block. -/ -def K0 : List Byte := bytesAt s₀.mem (kA s₀) (kl s₀) ++ List.replicate (64 - kl s₀) 0 - -end - -structure Pre (s₀ : State) : Prop where - kl_le : kl s₀ ≤ 64 - rd : s₀.rd = [kR s₀] - wr : s₀.wr = [inR s₀, ouR s₀, scR s₀, argR s₀] - i_o : (inR s₀).Disjoint (ouR s₀) - i_s : (inR s₀).Disjoint (scR s₀) - o_s : (ouR s₀).Disjoint (scR s₀) - a_i : (argR s₀).Disjoint (inR s₀) - a_o : (argR s₀).Disjoint (ouR s₀) - a_s : (argR s₀).Disjoint (scR s₀) - k_i : (kR s₀).Disjoint (inR s₀) - k_o : (kR s₀).Disjoint (ouR s₀) - k_s : (kR s₀).Disjoint (scR s₀) - k_a : (kR s₀).Disjoint (argR s₀) - ret_i : (retR s₀).Disjoint (inR s₀) - ret_o : (retR s₀).Disjoint (ouR s₀) - ret_s : (retR s₀).Disjoint (scR s₀) - stk_i : (stkR s₀).Disjoint (inR s₀) - stk_o : (stkR s₀).Disjoint (ouR s₀) - stk_s : (stkR s₀).Disjoint (scR s₀) - in_fit : (inn s₀).toNat + 96 ≤ 2 ^ 32 - ou_fit : (ou s₀).toNat + 96 ≤ 2 ^ 32 - k_fit : (kp s₀).toNat + kl s₀ ≤ 2 ^ 32 - scr_fit : (scr s₀).toNat + 160 ≤ 2 ^ 32 - sp_lo : 20 ≤ (esp₀ s₀).toNat - sp_fit : (esp₀ s₀).toNat + 24 ≤ 2 ^ 32 - -theorem pre_of {s₀ : State} (h : Proof.Hmac.initSha256X86.pre s₀) : Pre 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 e := stk_eq h23 - exact ⟨h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, - by show (below _ _).Disjoint _; rw [e]; exact h16, by show (below _ _).Disjoint _; rw [e]; exact h17, - by show (below _ _).Disjoint _; rw [e]; exact h18, h19, h20, h21, h22, h23, h24⟩ - -/-! ## Regions and the key -/ - -theorem K0_length (s₀ : State) (hp : Pre s₀) : (K0 s₀).length = 64 := by - simp [K0, bytesAt_length]; have := hp.kl_le; omega_nat - -theorem blockKey_eq {s₀ : State} (hp : Pre s₀) : - blockKey sha256 (bytesAt s₀.mem (kA s₀) (kl s₀)) = K0 s₀ := by - have := hp.kl_le - simp [blockKey, sha256, K0, bytesAt_length, show ¬ (64 < kl s₀) by omega_nat] - -theorem K0_lt {s₀ : State} {j : Nat} (hj : j < kl s₀) (h : j < (K0 s₀).length) : - (K0 s₀)[j] = s₀.mem (kA s₀ + BitVec.ofNat 64 j) := by - simp only [K0] - rw [List.getElem_append_left (by rw [bytesAt_length]; exact hj)] - simp [bytesAt] - -theorem K0_ge {s₀ : State} {j : Nat} (hj : kl s₀ ≤ j) (h : j < (K0 s₀).length) : (K0 s₀)[j] = 0 := by - simp only [K0] - rw [List.getElem_append_right (by rw [bytesAt_length]; exact hj)] - simp - -theorem ret_a {s₀ : State} (hp : Pre s₀) : (retR s₀).Disjoint (argR s₀) := by - have := hp.sp_fit - unfold retR argR - rw [addr_eq (by omega_nat)] - exact Offset.base_disjoint _ (Nat.le_refl 4) (by omega_nat) - -theorem ret_stk {s₀ : State} (hp : Pre s₀) : (retR s₀).Disjoint (stkR s₀) := by - have := hp.sp_lo - unfold retR stkR below - rw [Taint.sub_setWidth (by omega_nat)] - have h := Offset.disjoint_below_above ((esp₀ s₀).setWidth 64) (m := 20) (a := 0) (l := 4) (by omega_nat) - rw [BitVec.add_zero] at h - exact h.symm - -namespace Pre -variable {s₀ : State} (hp : Pre s₀) -include hp - -theorem scr_in {d n : Nat} (hd : d + n ≤ 160) (hn : 0 < n) : (scR s₀).Contains (addr (scr s₀) d) n := - contains_addr hd hn hp.scr_fit - -theorem in_in {d n : Nat} (hd : d + n ≤ 96) (hn : 0 < n) : (inR s₀).Contains (addr (inn s₀) d) n := - contains_addr hd hn hp.in_fit - -theorem ou_in {d n : Nat} (hd : d + n ≤ 96) (hn : 0 < n) : (ouR s₀).Contains (addr (ou s₀) d) n := - contains_addr hd hn hp.ou_fit - -theorem arg_in {d : Nat} (hd₁ : 4 ≤ d) (hd : d + 4 ≤ 24) : (argR s₀).Contains (addr (esp₀ s₀) d) 4 := by - have := hp.sp_fit - unfold argR - rw [addr_eq (by omega_nat), addr_eq (by omega_nat)] - exact Offset.contains _ hd₁ (by omega_nat) (by omega_nat) - -/-- A word of the scratch space, as a region. -/ -theorem scr_sub {d : Nat} (hd : d + 4 ≤ 160) : Region.Sub ⟨addr (scr s₀) d, 4⟩ (scR s₀) := by - rw [addr_eq (by have := hp.scr_fit; omega_nat)] - exact sub_offset hd (by omega_nat) - -/-- An argument word, as a region. -/ -theorem arg_sub {d : Nat} (hd₁ : 4 ≤ d) (hd : d + 4 ≤ 24) : Region.Sub ⟨addr (esp₀ s₀) d, 4⟩ (argR s₀) := by - have := hp.sp_fit - unfold argR - rw [addr_eq (by omega_nat), addr_eq (by omega_nat)] - exact Offset.sub _ hd₁ (by omega_nat) - -/-- The argument words lie outside `inner`, `outer` and `scratch`. -/ -theorem arg_disj {d : Nat} (hd₁ : 4 ≤ d) (hd : d + 4 ≤ 24) : - ∀ r ∈ [inR s₀, ouR s₀, scR s₀], Region.Disjoint ⟨addr (esp₀ s₀) d, 4⟩ r := by - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact hp.a_i.sub_left (hp.arg_sub hd₁ hd) - · exact hp.a_o.sub_left (hp.arg_sub hd₁ hd) - · exact hp.a_s.sub_left (hp.arg_sub hd₁ hd) - -end Pre - -/-! ## The saved registers -/ - -/-- Our caller's `ebx, esi, edi, ebp` in `scratch[112..128)`. -/ -def Saved (s₀ : State) (m : Mem) : Prop := ∀ p ∈ saved, m.readW (addr (scr s₀) p.2) 32 = s₀.gpr p.1 - -theorem saved_off {p : Reg × Nat} (h : p ∈ saved) : 112 ≤ p.2 ∧ p.2 + 4 ≤ 128 := by - simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at h - rcases h with rfl | rfl | rfl | rfl <;> simp - -theorem saved_frame {s₀ : State} {m m' : Mem} (h : Saved s₀ m) {rs : List Region} (hf : Frame rs m m') - (hd : ∀ d, 112 ≤ d → d + 4 ≤ 128 → ∀ r ∈ rs, Region.Disjoint ⟨addr (scr s₀) d, 4⟩ r) : Saved s₀ m' := by - intro p hp' - rw [← h p hp'] - have := saved_off hp' - exact hf.readW (Region.contains_self _ _) (hd p.2 this.1 this.2) (by decide) - -/-- The save area lies outside a region disjoint from `scratch`. -/ -theorem save_disj {s₀ : State} (hp : Pre s₀) {R : Region} (hR : R.Disjoint (scR s₀)) : - ∀ d, 112 ≤ d → d + 4 ≤ 128 → Region.Disjoint ⟨addr (scr s₀) d, 4⟩ R := - fun _ _ hd => hR.symm.sub_left (hp.scr_sub (by omega_nat)) - -/-- And outside the first 112 bytes of `scratch`. -/ -theorem save_disj112 {s₀ : State} (hp : Pre s₀) : - ∀ d, 112 ≤ d → d + 4 ≤ 128 → Region.Disjoint ⟨addr (scr s₀) d, 4⟩ ⟨scA s₀, 112⟩ := by - intro d h₁ h₂ - have := hp.scr_fit - rw [addr_eq (by omega_nat)] - exact Offset.disjoint_base _ h₁ (by omega_nat) - -/-! ## Prologue -/ - -/-- The memory after saving our caller's registers. -/ -def saveMem (s₀ : State) : Mem := - (((s₀.mem.writeW (addr (scr s₀) 112) (s₀.gpr .ebx)).writeW (addr (scr s₀) 116) (s₀.gpr .esi)).writeW - (addr (scr s₀) 120) (s₀.gpr .edi)).writeW (addr (scr s₀) 124) (s₀.gpr .ebp) - -/-- And after storing `H⁽⁰⁾` in both states. -/ -def proMem (s₀ : State) : Mem := - writeState (writeState (saveMem s₀) (inA s₀) H0) (ouA s₀) H0 - -theorem saveMem_frame {s₀ : State} (hp : Pre s₀) : Frame [scR s₀] s₀.mem (saveMem s₀) := by - have c : ∀ d, d + 4 ≤ 160 → (scR s₀).Contains (addr (scr s₀) d) (32 / 8) := fun d hd => hp.scr_in hd (by omega_nat) - simp only [saveMem] - exact ((((Frame.refl _ _).writeW (List.mem_singleton_self _) _ (c 112 (by omega_nat))).writeW - (List.mem_singleton_self _) _ (c 116 (by omega_nat))).writeW (List.mem_singleton_self _) _ - (c 120 (by omega_nat))).writeW (List.mem_singleton_self _) _ (c 124 (by omega_nat)) - -theorem saveMem_saved {s₀ : State} (hp : Pre s₀) : Saved s₀ (saveMem s₀) := by - have hs := hp.scr_fit - have w : ∀ (m : Mem) (v : BitVec 32) (d e : Nat), d + 4 ≤ 160 → e + 4 ≤ 160 → d + 4 ≤ e ∨ e + 4 ≤ d → - (m.writeW (addr (scr s₀) e) v).readW (addr (scr s₀) d) 32 = m.readW (addr (scr s₀) d) 32 := - fun m v d e h₁ h₂ h => readW_writeW_addr m v (by omega_nat) (by omega_nat) h - intro p hp' - simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl | rfl <;> simp only [saveMem] - · rw [w _ _ 112 124 (by omega_nat) (by omega_nat) (by omega_nat), w _ _ 112 120 (by omega_nat) (by omega_nat) (by omega_nat), - w _ _ 112 116 (by omega_nat) (by omega_nat) (by omega_nat), Mem.readW_writeW_self32] - · rw [w _ _ 116 124 (by omega_nat) (by omega_nat) (by omega_nat), w _ _ 116 120 (by omega_nat) (by omega_nat) (by omega_nat), - Mem.readW_writeW_self32] - · rw [w _ _ 120 124 (by omega_nat) (by omega_nat) (by omega_nat), Mem.readW_writeW_self32] - · rw [Mem.readW_writeW_self32] - -/-- Writing a hash value stays within its 32 bytes. -/ -theorem writeState_frame (m : Mem) (p : Addr) (v : HashValue) : - Frame [⟨p, 32⟩] m (writeState m p v) := by - have c : ∀ k, k < 8 → (⟨p, 32⟩ : Region).Contains (p + BitVec.ofNat 64 (4 * k)) (32 / 8) := - fun k hk => contains_offset (by omega_nat) (by omega_nat) - unfold writeState - exact ((((((((Frame.refl _ _).writeW (List.mem_singleton_self _) _ (c 0 (by omega_nat))).writeW - (List.mem_singleton_self _) _ (c 1 (by omega_nat))).writeW (List.mem_singleton_self _) _ - (c 2 (by omega_nat))).writeW (List.mem_singleton_self _) _ (c 3 (by omega_nat))).writeW - (List.mem_singleton_self _) _ (c 4 (by omega_nat))).writeW (List.mem_singleton_self _) _ - (c 5 (by omega_nat))).writeW (List.mem_singleton_self _) _ (c 6 (by omega_nat))).writeW - (List.mem_singleton_self _) _ (c 7 (by omega_nat)) - -theorem sub32 (p : Addr) : Region.Sub ⟨p, 32⟩ ⟨p, 96⟩ := Region.sub_prefix (by omega_nat) - -theorem proMem_frame {s₀ : State} (hp : Pre s₀) : Frame [inR s₀, ouR s₀, scR s₀] s₀.mem (proMem s₀) := by - refine (((saveMem_frame hp).mono (by simp)).trans ((writeState_frame _ _ _).sub ?_)).trans - ((writeState_frame _ _ _).sub ?_) - · simp only [List.mem_singleton]; rintro r rfl; exact ⟨inR s₀, by simp, sub32 _⟩ - · simp only [List.mem_singleton]; rintro r rfl; exact ⟨ouR s₀, by simp, sub32 _⟩ - -theorem proMem_saved {s₀ : State} (hp : Pre s₀) : Saved s₀ (proMem s₀) := by - refine saved_frame (saved_frame (saveMem_saved hp) (writeState_frame _ _ _) ?_) (writeState_frame _ _ _) ?_ - · intro d h₁ h₂ r hr - simp only [List.mem_singleton] at hr; subst hr - exact save_disj hp (hp.i_s.sub_left (sub32 _)) d h₁ h₂ - · intro d h₁ h₂ r hr - simp only [List.mem_singleton] at hr; subst hr - exact save_disj hp (hp.o_s.sub_left (sub32 _)) d h₁ h₂ - -theorem proMem_stI {s₀ : State} (hp : Pre s₀) : stateAt (proMem s₀) (inA s₀) = H0 := by - refine (Proof.Sha256.Stream.stateAt_congr fun i hi => ?_).trans - (stateAt_writeState (saveMem s₀) _ _) - exact frame_bytes (writeState_frame _ _ _) (R := ⟨inA s₀, 32⟩) - (by simpa using (hp.i_o.sub_left (sub32 _)).sub_right (sub32 _)) (by simp) hi - -theorem proMem_stO {s₀ : State} : stateAt (proMem s₀) (ouA s₀) = H0 := - stateAt_writeState _ _ _ - -/-- Reading an argument word from memory that differs only in `inner`, `outer` and `scratch`. -/ -theorem arg_frame {s₀ : State} (hp : Pre s₀) {m : Mem} (hf : Frame [inR s₀, ouR s₀, scR s₀] s₀.mem m) - {d : Nat} (hd₁ : 4 ≤ d) (hd : d + 4 ≤ 24) : - m.readW (addr (esp₀ s₀) d) 32 = s₀.mem.readW (addr (esp₀ s₀) d) 32 := - hf.readW (Region.contains_self _ _) (hp.arg_disj hd₁ hd) (by decide) - -/-- The two instructions storing the word `x` at `[b + 4 * k]`. -/ -def wordB (b : Reg) (x : BitVec 32) (k : Nat) : List Instr := [.mov .ecx (.imm x), .store (at_ b (4 * k)) .ecx] - -theorem h0_eq (b : Reg) : h0 b = wordB b H0[0] 0 ++ wordB b H0[1] 1 ++ wordB b H0[2] 2 ++ wordB b H0[3] 3 ++ - wordB b H0[4] 4 ++ wordB b H0[5] 5 ++ wordB b H0[6] 6 ++ wordB b H0[7] 7 := rfl - -theorem wordB_ok {b : Reg} (hb : b ≠ .ecx) {x : BitVec 32} {k : Nat} {rest : List Instr} {s : State} - {Q : State → Prop} {st : BitVec 32} (hst : s.gpr b = st) (hout : InRegions s.wr (addr st (4 * k)) 4) - (kk : ∀ s', (∀ r, r ≠ .ecx → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → - s'.mem = s.mem.writeW (addr st (4 * k)) x → WP isa (.block rest) s' Q) : - WP isa (.block (wordB b x k ++ rest)) s Q := by - simp only [wordB, List.cons_append, List.nil_append] - refine wp_movi fun s₁ u₁ => wp_store (a := addr st (4 * k)) - (by rw [ea_at, u₁.other _ hb, hst]) (by rw [u₁.wr]; exact hout) fun s₂ u₂ => ?_ - refine kk s₂ (fun r hr => by rw [u₂.gpr, u₁.other r hr]) (by rw [u₂.rd, u₁.rd]) (by rw [u₂.wr, u₁.wr]) ?_ - rw [u₂.mem, u₁.gpr, u₁.mem] - -/-- `H⁽⁰⁾` stored at `[b]`. -/ -theorem h0_ok {b : Reg} (hb : b ≠ .ecx) {st : BitVec 32} (hfit : st.toNat + 32 ≤ 2 ^ 32) {rest : List Instr} - {s : State} {Q : State → Prop} (hst : s.gpr b = st) (hout : ∀ k < 8, InRegions s.wr (addr st (4 * k)) 4) - (kk : ∀ s', (∀ r, r ≠ .ecx → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → - s'.mem = writeState s.mem (st.setWidth 64) H0 → WP isa (.block rest) s' Q) : - WP isa (.block (h0 b ++ rest)) s Q := by - rw [h0_eq] - simp only [List.append_assoc] - refine wordB_ok hb hst (hout 0 (by omega_nat)) fun s₁ g₁ rd₁ wr₁ m₁ => ?_ - refine wordB_ok hb (by rw [g₁ _ hb, hst]) (by rw [wr₁]; exact hout 1 (by omega_nat)) fun s₂ g₂ rd₂ wr₂ m₂ => ?_ - refine wordB_ok hb (by rw [g₂ _ hb, g₁ _ hb, hst]) (by rw [wr₂, wr₁]; exact hout 2 (by omega_nat)) - fun s₃ g₃ rd₃ wr₃ m₃ => ?_ - refine wordB_ok hb (by rw [g₃ _ hb, g₂ _ hb, g₁ _ hb, hst]) (by rw [wr₃, wr₂, wr₁]; exact hout 3 (by omega_nat)) - fun s₄ g₄ rd₄ wr₄ m₄ => ?_ - refine wordB_ok hb (by rw [g₄ _ hb, g₃ _ hb, g₂ _ hb, g₁ _ hb, hst]) - (by rw [wr₄, wr₃, wr₂, wr₁]; exact hout 4 (by omega_nat)) fun s₅ g₅ rd₅ wr₅ m₅ => ?_ - refine wordB_ok hb (by rw [g₅ _ hb, g₄ _ hb, g₃ _ hb, g₂ _ hb, g₁ _ hb, hst]) - (by rw [wr₅, wr₄, wr₃, wr₂, wr₁]; exact hout 5 (by omega_nat)) fun s₆ g₆ rd₆ wr₆ m₆ => ?_ - refine wordB_ok hb (by rw [g₆ _ hb, g₅ _ hb, g₄ _ hb, g₃ _ hb, g₂ _ hb, g₁ _ hb, hst]) - (by rw [wr₆, wr₅, wr₄, wr₃, wr₂, wr₁]; exact hout 6 (by omega_nat)) fun s₇ g₇ rd₇ wr₇ m₇ => ?_ - refine wordB_ok hb (by rw [g₇ _ hb, g₆ _ hb, g₅ _ hb, g₄ _ hb, g₃ _ hb, g₂ _ hb, g₁ _ hb, hst]) - (by rw [wr₇, wr₆, wr₅, wr₄, wr₃, wr₂, wr₁]; exact hout 7 (by omega_nat)) fun s₈ g₈ rd₈ wr₈ m₈ => ?_ - refine kk s₈ (fun r h => by rw [g₈ r h, g₇ r h, g₆ r h, g₅ r h, g₄ r h, g₃ r h, g₂ r h, g₁ r h]) - (by rw [rd₈, rd₇, rd₆, rd₅, rd₄, rd₃, rd₂, rd₁]) (by rw [wr₈, wr₇, wr₆, wr₅, wr₄, wr₃, wr₂, wr₁]) ?_ - have ha : ∀ k, k < 8 → addr st (4 * k) = st.setWidth 64 + BitVec.ofNat 64 (4 * k) := - fun k hk => addr_eq (by omega_nat) - rw [m₈, m₇, m₆, m₅, m₄, m₃, m₂, m₁, ha 0 (by omega_nat), ha 1 (by omega_nat), ha 2 (by omega_nat), - ha 3 (by omega_nat), ha 4 (by omega_nat), ha 5 (by omega_nat), ha 6 (by omega_nat), ha 7 (by omega_nat)] - rfl - -/-! ## The loop invariants -/ - -/-- The memory while building the inner buffer: `j` bytes of `K₀ ⊕ ipad` are written. -/ -structure BufMem (s₀ : State) (j : Nat) (m : Mem) : Prop where - stI : stateAt m (inA s₀) = H0 - stO : stateAt m (ouA s₀) = H0 - buf : bytesAt m (inA s₀ + 32) j = ((K0 s₀).take j).map (· ^^^ ipad) - saved : Saved s₀ m - frame : Frame [inR s₀, ouR s₀, scR s₀] s₀.mem m - -structure Buf (s₀ : State) (j : Nat) (s : State) : Prop where - j_le : j ≤ 64 - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - ebx : s.gpr .ebx = inn s₀ - esi : s.gpr .esi = ou s₀ - ebp : s.gpr .ebp = scr s₀ - esp : s.gpr .esp = esp₀ s₀ - edx : s.gpr .edx = inn s₀ + BitVec.ofNat 32 (32 + j) - mem : BufMem s₀ j s.mem - -/-- In the key loop, `edi` points at key byte `j` and `ecx` counts the bytes left. -/ -structure Key (s₀ : State) (j : Nat) (s : State) : Prop extends Buf s₀ j s where - edi : s.gpr .edi = kp s₀ + BitVec.ofNat 32 j - ecx : s.gpr .ecx = BitVec.ofNat 32 (kl s₀ - j) - -theorem proMem_buf {s₀ : State} (hp : Pre s₀) : BufMem s₀ 0 (proMem s₀) := - ⟨proMem_stI hp, proMem_stO, by simp [bytesAt], proMem_saved hp, proMem_frame hp⟩ - -theorem prologue_ok {s₀ : State} (hp : Pre s₀) : - WP isa (.block (([.mov .eax (.mem (at_ .esp 20))] : List Instr) ++ save .eax ++ - ([.mov .ebp (.reg .eax), .mov .ebx (.mem (at_ .esp 4)), .mov .esi (.mem (at_ .esp 8))] : List Instr) ++ - h0 .ebx ++ h0 .esi ++ - ([.mov .edi (.mem (at_ .esp 12)), .mov .ecx (.mem (at_ .esp 16)), .mov .edx (.reg .ebx), - .alu .add .edx (.imm 32), .alu .test .ecx (.reg .ecx)] : List Instr))) s₀ - fun s => Key s₀ 0 s ∧ s.zf = some (decide (kl s₀ = 0)) := by - have hsp := hp.sp_fit - have rin : ∀ (s : State), s.rd = s₀.rd → s.wr = s₀.wr → ∀ d, 4 ≤ d → d + 4 ≤ 24 → - InRegions (s.rd ++ s.wr) (addr (esp₀ s₀) d) 4 := - fun s h₁ h₂ d h₃ h₄ => ⟨argR s₀, by simp [h₁, h₂, hp.wr], hp.arg_in h₃ h₄⟩ - have sin : ∀ d, d + 4 ≤ 160 → InRegions s₀.wr (addr (scr s₀) d) 4 := - fun d hd => ⟨scR s₀, by simp [hp.wr], hp.scr_in hd (by omega_nat)⟩ - have argSave : ∀ e, 4 ≤ e → e + 4 ≤ 24 → - (saveMem s₀).readW (addr (esp₀ s₀) e) 32 = s₀.mem.readW (addr (esp₀ s₀) e) 32 := - fun e h₁ h₂ => arg_frame hp ((saveMem_frame hp).mono (by simp)) h₁ h₂ - simp only [List.append_assoc, List.cons_append, List.nil_append, save, saved, List.map_cons, List.map_nil] - refine wp_movm (a := addr (esp₀ s₀) 20) (ea_at _ _ _) (rin _ rfl rfl 20 (by omega_nat) (by omega_nat)) fun s₁ u₁ => ?_ - have e₁ : s₁.gpr .eax = scr s₀ := u₁.gpr - refine wp_store (a := addr (scr s₀) 112) (by rw [ea_at, e₁]) (by rw [u₁.wr]; exact sin 112 (by omega_nat)) - fun s₂ u₂ => ?_ - refine wp_store (a := addr (scr s₀) 116) (by rw [ea_at, u₂.gpr, e₁]) (by rw [u₂.wr, u₁.wr]; exact sin 116 (by omega_nat)) - fun s₃ u₃ => ?_ - refine wp_store (a := addr (scr s₀) 120) (by rw [ea_at, u₃.gpr, u₂.gpr, e₁]) - (by rw [u₃.wr, u₂.wr, u₁.wr]; exact sin 120 (by omega_nat)) fun s₄ u₄ => ?_ - refine wp_store (a := addr (scr s₀) 124) (by rw [ea_at, u₄.gpr, u₃.gpr, u₂.gpr, e₁]) - (by rw [u₄.wr, u₃.wr, u₂.wr, u₁.wr]; exact sin 124 (by omega_nat)) fun s₅ u₅ => ?_ - have g₅ : s₅.gpr = s₁.gpr := by rw [u₅.gpr, u₄.gpr, u₃.gpr, u₂.gpr] - have m₅ : s₅.mem = saveMem s₀ := by - rw [u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₄.gpr, u₃.gpr, u₂.gpr, u₁.mem, - u₁.other .ebx (by decide), u₁.other .esi (by decide), u₁.other .edi (by decide), u₁.other .ebp (by decide)] - rfl - have rd₅ : s₅.rd = s₀.rd := by rw [u₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd] - have wr₅ : s₅.wr = s₀.wr := by rw [u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr] - have sp₅ : s₅.gpr .esp = esp₀ s₀ := by rw [g₅, u₁.other _ (by decide)] - refine wp_mov fun s₆ u₆ => ?_ - refine wp_movm (a := addr (esp₀ s₀) 4) (by rw [ea_at, u₆.other _ (by decide), sp₅]) - (rin _ (by rw [u₆.rd, rd₅]) (by rw [u₆.wr, wr₅]) 4 (by omega_nat) (by omega_nat)) fun s₇ u₇ => ?_ - refine wp_movm (a := addr (esp₀ s₀) 8) (by rw [ea_at, u₇.other _ (by decide), u₆.other _ (by decide), sp₅]) - (rin _ (by rw [u₇.rd, u₆.rd, rd₅]) (by rw [u₇.wr, u₆.wr, wr₅]) 8 (by omega_nat) (by omega_nat)) fun s₈ u₈ => ?_ - have ebp₈ : s₈.gpr .ebp = scr s₀ := by - rw [u₈.other _ (by decide), u₇.other _ (by decide), u₆.gpr, g₅, e₁] - have ebx₈ : s₈.gpr .ebx = inn s₀ := by - rw [u₈.other _ (by decide), u₇.gpr, u₆.mem, m₅, argSave 4 (by omega_nat) (by omega_nat)]; rfl - have esi₈ : s₈.gpr .esi = ou s₀ := by - rw [u₈.gpr, u₇.mem, u₆.mem, m₅, argSave 8 (by omega_nat) (by omega_nat)]; rfl - have g₈ : ∀ r, r ≠ .ebx → r ≠ .esi → r ≠ .ebp → s₈.gpr r = s₅.gpr r := fun r h₁ h₂ h₃ => by - rw [u₈.other r h₂, u₇.other r h₁, u₆.other r h₃] - have rd₈ : s₈.rd = s₀.rd := by rw [u₈.rd, u₇.rd, u₆.rd, rd₅] - have wr₈ : s₈.wr = s₀.wr := by rw [u₈.wr, u₇.wr, u₆.wr, wr₅] - have m₈ : s₈.mem = saveMem s₀ := by rw [u₈.mem, u₇.mem, u₆.mem, m₅] - refine h0_ok (by decide) (st := inn s₀) (by have := hp.in_fit; omega_nat) ebx₈ - (fun k hk => ⟨inR s₀, by simp [wr₈, hp.wr], hp.in_in (by omega_nat) (by omega_nat)⟩) fun s₉ g₉ rd₉ wr₉ m₉ => ?_ - refine h0_ok (by decide) (st := ou s₀) (by have := hp.ou_fit; omega_nat) (by rw [g₉ _ (by decide), esi₈]) - (fun k hk => ⟨ouR s₀, by simp [wr₉, wr₈, hp.wr], hp.ou_in (by omega_nat) (by omega_nat)⟩) - fun s₁₀ g₁₀ rd₁₀ wr₁₀ m₁₀ => ?_ - have m₁₀' : s₁₀.mem = proMem s₀ := by rw [m₁₀, m₉, m₈]; rfl - have g₁₀' : ∀ r, r ≠ .ecx → s₁₀.gpr r = s₈.gpr r := fun r h => by rw [g₁₀ r h, g₉ r h] - have rd₁₀' : s₁₀.rd = s₀.rd := by rw [rd₁₀, rd₉, rd₈] - have wr₁₀' : s₁₀.wr = s₀.wr := by rw [wr₁₀, wr₉, wr₈] - have sp₁₀ : s₁₀.gpr .esp = esp₀ s₀ := by - rw [g₁₀' _ (by decide), g₈ _ (by decide) (by decide) (by decide), sp₅] - have argPro : ∀ e, 4 ≤ e → e + 4 ≤ 24 → - (proMem s₀).readW (addr (esp₀ s₀) e) 32 = s₀.mem.readW (addr (esp₀ s₀) e) 32 := - fun e h₁ h₂ => arg_frame hp (proMem_frame hp) h₁ h₂ - refine wp_movm (a := addr (esp₀ s₀) 12) (by rw [ea_at, sp₁₀]) (rin _ rd₁₀' wr₁₀' 12 (by omega_nat) (by omega_nat)) - fun s₁₁ u₁₁ => ?_ - refine wp_movm (a := addr (esp₀ s₀) 16) (by rw [ea_at, u₁₁.other _ (by decide), sp₁₀]) - (rin _ (by rw [u₁₁.rd, rd₁₀']) (by rw [u₁₁.wr, wr₁₀']) 16 (by omega_nat) (by omega_nat)) fun s₁₂ u₁₂ => ?_ - refine wp_mov fun s₁₃ u₁₃ => wp_addi fun s₁₄ u₁₄ => wp_test fun s₁₅ f₁₅ z₁₅ => WP.block_nil ?_ - have g₁₅ : ∀ r, r ≠ .ecx → r ≠ .edi → r ≠ .edx → s₁₅.gpr r = s₈.gpr r := fun r h₁ h₂ h₃ => by - rw [f₁₅.gpr, u₁₄.other r h₃, u₁₃.other r h₃, u₁₂.other r h₁, u₁₁.other r h₂, g₁₀' r h₁] - have ecx₁₅ : s₁₅.gpr .ecx = arg s₀ 3 := by - rw [f₁₅.gpr, u₁₄.other _ (by decide), u₁₃.other _ (by decide), u₁₂.gpr, u₁₁.mem, m₁₀', - argPro 16 (by omega_nat) (by omega_nat)]; rfl - have e3 : arg s₀ 3 = BitVec.ofNat 32 (kl s₀) := by simp - refine ⟨⟨⟨by omega_nat, by rw [f₁₅.rd, u₁₄.rd, u₁₃.rd, u₁₂.rd, u₁₁.rd, rd₁₀'], - by rw [f₁₅.wr, u₁₄.wr, u₁₃.wr, u₁₂.wr, u₁₁.wr, wr₁₀'], - by rw [g₁₅ _ (by decide) (by decide) (by decide), ebx₈], - by rw [g₁₅ _ (by decide) (by decide) (by decide), esi₈], - by rw [g₁₅ _ (by decide) (by decide) (by decide), ebp₈], - by rw [g₁₅ _ (by decide) (by decide) (by decide), g₈ _ (by decide) (by decide) (by decide), sp₅], ?_, - by rw [f₁₅.mem, u₁₄.mem, u₁₃.mem, u₁₂.mem, u₁₁.mem, m₁₀']; exact proMem_buf hp⟩, ?_, ?_⟩, ?_⟩ - · rw [f₁₅.gpr, u₁₄.gpr, u₁₃.gpr, u₁₂.other _ (by decide), u₁₁.other _ (by decide), - g₁₀' _ (by decide), ebx₈] - rfl - · rw [f₁₅.gpr, u₁₄.other _ (by decide), u₁₃.other _ (by decide), u₁₂.other _ (by decide), u₁₁.gpr, - m₁₀', argPro 12 (by omega_nat) (by omega_nat)] - simp; rfl - · rw [ecx₁₅, e3, Nat.sub_zero] - · rw [z₁₅, ← f₁₅.gpr, ecx₁₅, BitVec.and_self, e3, ofNat_beq_zero (by have := (arg s₀ 3).isLt; omega_nat)] - -/-! ## The key and pad loops -/ - -theorem wp_xori {is : List Instr} {s : State} {Q : State → Prop} {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 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] - -/-- Byte `j` of the inner buffer, as the loops address it. -/ -theorem edx_addr {s₀ : State} (hp : Pre s₀) {j : Nat} (hj : j < 64) : - addr (inn s₀ + BitVec.ofNat 32 (32 + j)) 0 = inA s₀ + 32 + BitVec.ofNat 64 j := by - have := hp.in_fit - rw [addr_add_ofNat (by omega_nat), Nat.add_zero, BitVec.ofNat_add, ← BitVec.add_assoc]; rfl - -theorem edx_succ (x : BitVec 32) (j : Nat) : - x + BitVec.ofNat 32 (32 + j) + 1 = x + BitVec.ofNat 32 (32 + (j + 1)) := by - rw [← Nat.add_assoc, ofNat_succ, BitVec.add_assoc] - -theorem cmp_end (x : BitVec 32) {j : Nat} (hj : j ≤ 64) : - (x + BitVec.ofNat 32 (32 + j) - (x + 96) == 0) = decide (j = 64) := by - have e : x + BitVec.ofNat 32 (32 + j) - (x + 96) = BitVec.ofNat 32 (32 + j) - BitVec.ofNat 32 96 := by - rw [Offset.add_sub_add_left]; rfl - rw [e, sub_beq (by omega_nat) (by omega_nat)] - exact decide_eq_decide.mpr ⟨fun h => by omega_nat, fun h => by omega_nat⟩ - -/-- Byte `j` of the inner buffer. -/ -theorem buf_write {s₀ : State} (hp : Pre s₀) {j : Nat} {m : Mem} (h : BufMem s₀ j m) (hj : j < 64) : - BufMem s₀ (j + 1) (m.writeW (inA s₀ + 32 + BitVec.ofNat 64 j) - ((K0 s₀)[j]'(by rw [K0_length s₀ hp]; omega_nat) ^^^ ipad)) := by - have hl : j < (K0 s₀).length := by rw [K0_length s₀ hp]; omega_nat - set x := (K0 s₀)[j] ^^^ ipad - let bI : Region := ⟨inA s₀ + 32, 64⟩ - have sI : Region.Sub bI (inR s₀) := sub_offset (off := 32) (by omega_nat) (by omega_nat) - have F : Frame [bI] m (m.writeW (inA s₀ + 32 + BitVec.ofNat 64 j) x) := - (Frame.refl _ _).writeW (List.mem_singleton_self _) x (contains_offset (by omega_nat) (by omega_nat)) - have st : ∀ p : Addr, Region.Disjoint ⟨p, 32⟩ bI → - stateAt (m.writeW (inA s₀ + 32 + BitVec.ofNat 64 j) x) p = stateAt m p := - fun p hd => Proof.Sha256.Stream.stateAt_congr fun i hi => - frame_bytes F (R := ⟨p, 32⟩) (by simpa using hd) (by simp) hi - have self : Region.Disjoint ⟨inA s₀, 32⟩ bI := Offset.base_disjoint _ (e := 32) (by omega_nat) (by omega_nat) - refine ⟨?_, ?_, ?_, saved_frame h.saved F ?_, h.frame.trans (F.sub ?_)⟩ - · rw [st _ self, h.stI] - · rw [st _ ((hp.i_o.symm.sub_left (sub32 _)).sub_right sI), h.stO] - · rw [VG.Proof.Hmac.Common.bytesAt_snoc _ _ (by omega_nat), h.buf, List.take_succ_eq_append_getElem hl, - List.map_append] - rfl - · intro d h₁ h₂ r hr - simp only [List.mem_singleton] at hr; subst hr - exact save_disj hp (hp.i_s.sub_left sI) d h₁ h₂ - · simp only [List.mem_singleton]; rintro r rfl; exact ⟨inR s₀, by simp, sI⟩ - -def keyBody : List Instr := - [.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)] - -theorem keyLoop_eq : keyLoop = .loop (.block keyBody) .ne := rfl - -theorem in_buf {s₀ : State} (hp : Pre s₀) {j : Nat} (hj : j < 64) {wr : List Region} (hwr : wr = s₀.wr) : - InRegions wr (inA s₀ + 32 + BitVec.ofNat 64 j) 1 := - ⟨inR s₀, by simp [hwr, hp.wr], by - rw [BitVec.add_assoc, show (32 : Addr) + BitVec.ofNat 64 j = BitVec.ofNat 64 (32 + j) by - rw [BitVec.ofNat_add]; rfl] - exact contains_offset (by omega_nat) (by omega_nat)⟩ - -theorem key_step {s₀ : State} (hp : Pre s₀) {j : Nat} (hj : j < kl s₀) {s : State} (h : Key s₀ j s) : - WP isa (.block keyBody) s fun s' => Key s₀ (j + 1) s' ∧ s'.zf = some (decide (j + 1 = kl s₀)) := by - have hkl := hp.kl_le - have fk := hp.k_fit - have hl : j < (K0 s₀).length := by rw [K0_length s₀ hp]; omega_nat - have hin : InRegions (s.rd ++ s.wr) (kA s₀ + BitVec.ofNat 64 j) 1 := - ⟨kR s₀, by simp [h.rd, hp.rd], contains_offset (by omega_nat) (by omega_nat)⟩ - have hbyte : s.mem (kA s₀ + BitVec.ofNat 64 j) = (K0 s₀)[j] := by - rw [K0_lt hj hl] - refine frame_bytes h.mem.frame (R := kR s₀) ?_ (by show kl s₀ ≤ 2 ^ 64; omega_nat) hj - simp only [List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl) - exacts [hp.k_i, hp.k_o, hp.k_s] - unfold keyBody - refine wp_movzx8 (a := kA s₀ + BitVec.ofNat 64 j) - (by rw [ea_at, h.edi, addr_add_ofNat (by omega_nat), Nat.add_zero]) hin fun s₁ u₁ => ?_ - refine wp_xori fun s₂ u₂ => ?_ - refine wp_store8 (a := inA s₀ + 32 + BitVec.ofNat 64 j) - (by rw [ea_at, u₂.other _ (by decide), u₁.other _ (by decide), h.edx, edx_addr hp (by omega_nat)]) - (in_buf hp (by omega_nat) (by rw [u₂.wr, u₁.wr, h.wr])) fun s₃ u₃ => ?_ - refine wp_addi fun s₄ u₄ => wp_addi fun s₅ u₅ => wp_subi fun s₆ u₆ z₆ => WP.block_nil ?_ - have k : ∀ r, r ≠ .eax → r ≠ .edi → r ≠ .edx → r ≠ .ecx → s₆.gpr r = s.gpr r := fun r h1 h2 h3 h4 => by - rw [u₆.other r h4, u₅.other r h3, u₄.other r h2, u₃.gpr, u₂.other r h1, u₁.other r h1] - have v : (s₂.gpr Reg8.al.reg).setWidth 8 = (K0 s₀)[j] ^^^ ipad := by - show (s₂.gpr .eax).setWidth 8 = _ - rw [u₂.gpr, u₁.gpr, xor_byte, hbyte]; rfl - have ecx₅ : s₅.gpr .ecx = BitVec.ofNat 32 (kl s₀ - j) := by - rw [u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, u₂.other _ (by decide), u₁.other _ (by decide), - h.ecx] - refine ⟨⟨⟨by omega_nat, 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 [k _ (by decide) (by decide) (by decide) (by decide), h.ebx], - by rw [k _ (by decide) (by decide) (by decide) (by decide), h.esi], - by rw [k _ (by decide) (by decide) (by decide) (by decide), h.ebp], - by rw [k _ (by decide) (by decide) (by decide) (by decide), h.esp], ?_, ?_⟩, ?_, ?_⟩, ?_⟩ - · rw [u₆.other _ (by decide), u₅.gpr, u₄.other _ (by decide), u₃.gpr, u₂.other _ (by decide), - u₁.other _ (by decide), h.edx, edx_succ] - · rw [u₆.mem, u₅.mem, u₄.mem, u₃.mem, v, u₂.mem, u₁.mem] - exact buf_write hp h.mem (by omega_nat) - · 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] - · rw [u₆.gpr, ecx₅, ofNat_pred (by omega_nat), show kl s₀ - j - 1 = kl s₀ - (j + 1) by omega_nat] - · rw [z₆, ecx₅, ofNat_pred (by omega_nat), ofNat_beq_zero (by omega_nat)] - exact congrArg some (decide_eq_decide.mpr ⟨fun h => by omega_nat, fun h => by omega_nat⟩) - -def padBody : List Instr := [.store8 (at_ .edx 0) .cl, .alu .add .edx (.imm 1), .alu .cmp .edx (.reg .eax)] - -theorem padLoop_eq : padLoop = .loop (.block padBody) .ne := rfl - -/-- In the pad loop, `eax` is the end of the inner buffer and `ecx` is `ipad`. -/ -structure Pad (s₀ : State) (j : Nat) (s : State) : Prop extends Buf s₀ j s where - eax : s.gpr .eax = inn s₀ + 96 - ecx : s.gpr .ecx = 0x36 - -theorem pad_step {s₀ : State} (hp : Pre s₀) {j : Nat} (hj : kl s₀ ≤ j) (hj' : j < 64) {s : State} - (h : Pad s₀ j s) : - WP isa (.block padBody) s fun s' => Pad s₀ (j + 1) s' ∧ s'.zf = some (decide (j + 1 = 64)) := by - have hl : j < (K0 s₀).length := by rw [K0_length s₀ hp]; omega_nat - unfold padBody - refine wp_store8 (a := inA s₀ + 32 + BitVec.ofNat 64 j) (by rw [ea_at, h.edx, edx_addr hp hj']) - (in_buf hp hj' h.wr) fun s₁ u₁ => ?_ - refine wp_addi fun s₂ u₂ => wp_cmp fun s₃ f₃ _ z₃ => WP.block_nil ?_ - have k : ∀ r, r ≠ .edx → s₃.gpr r = s.gpr r := fun r h1 => by - rw [f₃.gpr, u₂.other r h1, u₁.gpr] - have v : (s.gpr Reg8.cl.reg).setWidth 8 = (K0 s₀)[j] ^^^ ipad := by - show (s.gpr .ecx).setWidth 8 = _ - rw [h.ecx, K0_ge hj hl]; rfl - have edx₂ : s₂.gpr .edx = inn s₀ + BitVec.ofNat 32 (32 + (j + 1)) := by - rw [u₂.gpr, u₁.gpr, h.edx, edx_succ] - refine ⟨⟨⟨by omega_nat, by rw [f₃.rd, u₂.rd, u₁.rd, h.rd], by rw [f₃.wr, u₂.wr, u₁.wr, h.wr], - by rw [k _ (by decide), h.ebx], by rw [k _ (by decide), h.esi], by rw [k _ (by decide), h.ebp], - by rw [k _ (by decide), h.esp], by rw [f₃.gpr, edx₂], ?_⟩, - by rw [k _ (by decide), h.eax], by rw [k _ (by decide), h.ecx]⟩, ?_⟩ - · rw [f₃.mem, u₂.mem, u₁.mem, v] - exact buf_write hp h.mem hj' - · rw [z₃, edx₂, u₂.other _ (by decide), u₁.gpr, h.eax, cmp_end _ (by omega_nat)] - -theorem key_loop_ok {s₀ : State} (hp : Pre s₀) {s : State} (h : Key s₀ 0 s) (hk : 0 < kl s₀) : - WP isa keyLoop s (Buf s₀ (kl s₀)) := by - rw [keyLoop_eq] - refine WP.loop (M := isa) (fun n s => ∃ j, n = kl s₀ - j ∧ j < kl s₀ ∧ Key s₀ j s) ?_ (kl s₀) s - ⟨0, rfl, hk, h⟩ - rintro n s ⟨j, rfl, hj, hb⟩ - refine WP.mono (key_step hp hj hb) fun s' ⟨hb', hz⟩ => ?_ - by_cases hl : j + 1 = kl s₀ - · refine .inl ⟨by simp [eval, hz, hl], ?_⟩ - rw [hl] at hb'; exact hb'.toBuf - · exact .inr ⟨by simp [eval, hz, hl], _, by omega_nat, j + 1, rfl, by omega_nat, hb'⟩ - -theorem pad_loop_ok {s₀ : State} (hp : Pre s₀) {s : State} (h : Pad s₀ (kl s₀) s) (hk : kl s₀ < 64) : - WP isa padLoop s (Buf s₀ 64) := by - rw [padLoop_eq] - refine WP.loop (M := isa) (fun n s => ∃ j, n = 64 - j ∧ kl s₀ ≤ j ∧ j < 64 ∧ Pad s₀ j s) ?_ (64 - kl s₀) s - ⟨kl s₀, rfl, (Nat.le_refl _), hk, h⟩ - rintro n s ⟨j, rfl, hj, hj', hb⟩ - refine WP.mono (pad_step hp hj hj' hb) fun s' ⟨hb', hz⟩ => ?_ - by_cases hl : j + 1 = 64 - · refine .inl ⟨by simp [eval, hz, hl], ?_⟩ - rw [hl] at hb'; exact hb'.toBuf - · exact .inr ⟨by simp [eval, hz, hl], _, by omega_nat, j + 1, rfl, by omega_nat, by omega_nat, hb'⟩ - -/-! ## The outer buffer -/ - -/-- A word read from memory, XORed with `0x6a` repeated, is its bytes XORed with `0x6a`. -/ -theorem writeW_xor (m m' : Mem) (d a : Addr) : - m.writeW d (m'.readW a 32 ^^^ 0x6a6a6a6a) = writeBytes m d ((bytesAt m' a 4).map (· ^^^ 0x6a)) := by - rw [Finalize.writeW_le] - congr 1 - simp only [Finalize.le, bytesAt, List.map_map] - refine List.map_congr_left fun j hj => ?_ - have hj := List.mem_range.mp hj - simp only [Function.comp] - rw [BitVec.extractLsb'_xor, Mem.readW_byte m' a hj] - congr 1 - rcases (by omega_nat : j = 0 ∨ j = 1 ∨ j = 2 ∨ j = 3) with rfl | rfl | rfl | rfl <;> rfl - -/-- Bytes `[A + a, A + a + 4)` of a range `[A, A + a + 4)` separate from `[B, B + b)`. -/ -theorem sep_last {A B : Addr} {a b : Nat} (h : Mem.Sep A (a + 4) B b) (ha : a + 4 < 2 ^ 64) : - Mem.Sep (A + BitVec.ofNat 64 a) 4 B b := by - intro z hz hb - refine h z ?_ hb - rw [show z - A = (z - (A + BitVec.ofNat 64 a)) + BitVec.ofNat 64 a by - rw [Offset.sub_add_eq, BitVec.sub_add_cancel], BitVec.toNat_add, - BitVec.toNat_ofNat, Nat.mod_eq_of_lt (a := a) (by omega_nat)] - have := Nat.mod_le ((z - (A + BitVec.ofNat 64 a)).toNat + a) (2 ^ 64) - omega_nat - -/-- The outer buffer, a word at a time: `n` words of the inner buffer, XORed -with `0x6a6a6a6a`. -/ -theorem xorWords_ok {x y : BitVec 32} (n : Nat) : ∀ (rest : List Instr) (s : State) (Q : State → Prop), - s.gpr .ebx = x → s.gpr .esi = y → x.toNat + 32 + 4 * n ≤ 2 ^ 32 → y.toNat + 32 + 4 * n ≤ 2 ^ 32 → - (∀ k < n, InRegions (s.rd ++ s.wr) (addr x (32 + 4 * k)) 4) → - (∀ k < n, InRegions s.wr (addr y (32 + 4 * k)) 4) → - Mem.Sep (x.setWidth 64 + BitVec.ofNat 64 32) (4 * n) (y.setWidth 64 + BitVec.ofNat 64 32) (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 32) - ((bytesAt s.mem (x.setWidth 64 + BitVec.ofNat 64 32) (4 * n)).map (· ^^^ 0x6a)) → - WP isa (.block rest) s' Q) → - WP isa (.block ((List.range n).flatMap opadWord ++ rest)) s Q := by - induction n with - | zero => - intro rest s Q _ _ _ _ _ _ _ k - exact k s (fun _ _ => rfl) rfl rfl (by simp [bytesAt, Proof.Sha256.Stream.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_nat) (by omega_nat) (fun j hj => hin j (by omega_nat)) (fun j hj => hout j (by omega_nat)) - (fun a ha hb => hsep a (by omega_nat) (by omega_nat)) fun s₁ g₁ rd₁ wr₁ m₁ => ?_ - simp only [opadWord, List.cons_append, List.nil_append] - refine wp_movm (a := addr x (32 + 4 * n)) (by rw [ea_at, g₁ _ (by decide), hx]) - (by rw [rd₁, wr₁]; exact hin n (by omega_nat)) fun s₂ u₂ => wp_xori fun s₃ u₃ => ?_ - refine wp_store (a := addr y (32 + 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_nat)) 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₁]) ?_ - set A := x.setWidth 64 + BitVec.ofNat 64 32 - set B := y.setWidth 64 + BitVec.ofNat 64 32 - set xs := (bytesAt s.mem A (4 * n)).map (· ^^^ (0x6a : Byte)) - have hl : xs.length = 4 * n := by simp [xs, bytesAt_length] - have hsep' : Mem.Sep (A + BitVec.ofNat 64 (4 * n)) 4 B xs.length := by - rw [hl] - refine sep_last (fun z h₁ h₂ => hsep z (by omega_nat) (by omega_nat)) (by omega_nat) - have e := writeBytes_append s.mem B xs ((bytesAt s.mem (A + BitVec.ofNat 64 (4 * n)) 4).map (· ^^^ 0x6a)) - (by simp [hl, bytesAt_length]; omega_nat) - rw [hl] at e - rw [u₄.mem, u₃.gpr, u₂.gpr, u₃.mem, u₂.mem, m₁, addr_word fx (by omega_nat : n < n + 1), - addr_word fy (by omega_nat : n < n + 1), readW_writeBytes_sep _ _ hsep', writeW_xor, e, - show 4 * (n + 1) = 4 * n + 4 by omega_nat, VG.Proof.Hmac.Common.bytesAt_add, List.map_append] - -/-- `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 - -/-! ## The compressions -/ - -theorem epilogue_ok {s₀ s : State} (hp : Pre s₀) (hrd : s.rd = s₀.rd) (hwr : s.wr = s₀.wr) - (hebp : s.gpr .ebp = scr s₀) (hsp : s.gpr .esp = esp₀ s₀) (hsv : Saved s₀ s.mem) : - WP isa (.block (.mov .eax (.reg .ebp) :: restore .eax)) s fun s' => - s'.mem = s.mem ∧ ∀ r ∈ calleeSaved, s'.gpr r = s₀.gpr r := by - have sin : ∀ d, d + 4 ≤ 160 → InRegions (s.rd ++ s.wr) (addr (scr s₀) d) 4 := - fun d hd => ⟨scR s₀, by simp [hrd, hwr, hp.wr], hp.scr_in hd (by omega_nat)⟩ - refine wp_mov fun s₃ u₃ => ?_ - have e₃ : s₃.gpr .eax = scr s₀ := by rw [u₃.gpr, hebp] - have sin₃ : ∀ d, d + 4 ≤ 160 → InRegions (s₃.rd ++ s₃.wr) (addr (scr s₀) d) 4 := - fun d hd => by rw [u₃.rd, u₃.wr]; exact sin d hd - have rs : ∀ p ∈ saved, s₃.mem.readW (addr (scr s₀) p.2) 32 = s₀.gpr p.1 := by - intro p hp'; rw [u₃.mem]; exact hsv p hp' - simp only [restore, saved, List.map_cons, List.map_nil] - refine wp_movm (a := addr (scr s₀) 112) (by rw [ea_at, e₃]) (sin₃ 112 (by omega_nat)) fun s₄ u₄ => ?_ - refine wp_movm (a := addr (scr s₀) 116) (by rw [ea_at, u₄.other _ (by decide), e₃]) - (by rw [u₄.rd, u₄.wr]; exact sin₃ 116 (by omega_nat)) fun s₅ u₅ => ?_ - refine wp_movm (a := addr (scr s₀) 120) (by rw [ea_at, u₅.other _ (by decide), u₄.other _ (by decide), e₃]) - (by rw [u₅.rd, u₅.wr, u₄.rd, u₄.wr]; exact sin₃ 120 (by omega_nat)) fun s₆ u₆ => ?_ - refine wp_movm (a := addr (scr s₀) 124) - (by rw [ea_at, u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), e₃]) - (by rw [u₆.rd, u₆.wr, u₅.rd, u₅.wr, u₄.rd, u₄.wr]; exact sin₃ 124 (by omega_nat)) fun s₇ u₇ => WP.block_nil ?_ - refine ⟨by rw [u₇.mem, u₆.mem, u₅.mem, u₄.mem, u₃.mem], fun r hr => ?_⟩ - simp only [calleeSaved, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl - · rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr] - exact rs (.ebx, 112) (by simp [saved]) - · rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.gpr, u₄.mem] - exact rs (.esi, 116) (by simp [saved]) - · rw [u₇.other _ (by decide), u₆.gpr, u₅.mem, u₄.mem] - exact rs (.edi, 120) (by simp [saved]) - · rw [u₇.gpr, u₆.mem, u₅.mem, u₄.mem] - exact rs (.ebp, 124) (by simp [saved]) - · rw [u₇.other _ (by decide), u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), - u₃.other _ (by decide), hsp] - -/-! ## Correctness -/ - -/-- Everything we may write. -/ -abbrev allR (s₀ : State) : List Region := [inR s₀, ouR s₀, scR s₀, argR s₀, stkR s₀] - -theorem callee_ne_eax {r : Reg} (hr : r ∈ calleeSaved) : r ≠ .eax := by - simp only [calleeSaved, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl <;> decide - -/-! ## Constant time -/ - -/-- The initial taint: `esp + 4` is the base of the (public) arguments, whose -words at offsets 0, 4 and 16 are the base addresses of `inner`, `outer` and -`scratch`. -/ -def τ₀ : VG.X86.Taint.T := - { regs := .ofList [.esp], flags := false, lens := [96, 96, 160, 20], bases := [(.esp, 3, 4)], - slots := [(3, 0, 20)], wbases := [(3, 0, 0), (3, 4, 1), (3, 16, 2)], room := 20 } - -theorem wf₀ {s : State} (h : Proof.Hmac.initSha256X86.pre s) : VG.X86.Taint.Wf τ₀ s := by - have hp := pre_of h - have hi := hp.in_fit; have ho := hp.ou_fit; have hsc := hp.scr_fit; have hs := hp.sp_fit - have hlo := hp.sp_lo - obtain ⟨-, -, -, -, -, -, -, -, -, -, -, -, -, -, -, -, k1, k2, k3, -⟩ := h - refine VG.X86.Taint.Wf.entryRoom rfl ⟨fun _ => ⟨by simp [hp.wr, τ₀], ?_, ?_⟩, ?_, ?_, - fun h => absurd h (Nat.lt_irrefl 0), fun _ h => (List.not_mem_nil h).elim⟩ fun _ => ⟨hlo, ?_⟩ - · simp only [hp.wr, List.pairwise_cons, List.mem_cons, List.not_mem_nil, or_false, forall_eq_or_imp, - forall_eq, List.Pairwise.nil, and_true] - exact ⟨⟨hp.i_o, hp.i_s, hp.a_i.symm⟩, ⟨hp.o_s, hp.a_o.symm⟩, hp.a_s.symm, fun _ h => h.elim⟩ - · simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl | rfl) - · simp only [addr_toNat]; omega_nat - · simp only [addr_toNat]; omega_nat - · simp only [addr_toNat]; omega_nat - · simp only; rw [addr_eq (by omega_nat), BitVec.toNat_add, addr_toNat, BitVec.toNat_ofNat]; omega_nat - · intro p hp' - simp only [τ₀, List.mem_singleton] at hp' - subst hp' - simp [VG.X86.Taint.region, hp.wr] - · intro p hp' - simp only [τ₀, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl - · refine ⟨by decide, ?_⟩ - simp only [VG.X86.Taint.byteAddr, VG.X86.Taint.region, hp.wr] - show addr (s.mem.readW (addr (esp₀ s) 4 + BitVec.ofNat 64 0) 32) 0 = inA s - simp [addr, inn, arg, argAddr] - · refine ⟨by decide, ?_⟩ - simp only [VG.X86.Taint.byteAddr, VG.X86.Taint.region, hp.wr] - show addr (s.mem.readW (addr (esp₀ s) 4 + BitVec.ofNat 64 4) 32) 0 = ouA s - rw [VG.Proof.Sha256.X86.Stream.Finalize.argWord_eq hs (k := 4) (by omega_nat)] - simp [addr, ou, arg] - · refine ⟨by decide, ?_⟩ - simp only [VG.X86.Taint.byteAddr, VG.X86.Taint.region, hp.wr] - show addr (s.mem.readW (addr (esp₀ s) 4 + BitVec.ofNat 64 16) 32) 0 = scA s - rw [VG.Proof.Sha256.X86.Stream.Finalize.argWord_eq hs (k := 16) (by omega_nat)] - simp [addr, scr, arg] - · simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl | rfl | rfl) - · exact k1 - · exact k2 - · exact k3 - · have := hp.sp_fit - unfold argR - rw [addr_eq (by omega_nat)] - exact Offset.disjoint_below_above _ (m := 20) (a := 4) (l := 20) (by omega_nat) - -theorem agree₀ {s₁ s₂ : State} (h₁ : Proof.Hmac.initSha256X86.pre s₁) (h₂ : Proof.Hmac.initSha256X86.pre s₂) - (hpub : Proof.Hmac.initSha256X86.pub s₁ s₂) : VG.X86.Taint.Agree τ₀ s₁ s₂ := by - obtain ⟨hesp, ha⟩ := hpub - have hp₁ := pre_of h₁; have hp₂ := pre_of h₂ - refine ⟨⟨fun r hr => ?_, fun h => nomatch h⟩, fun _ => ?_, wf₀ h₁, wf₀ h₂, ?_, ?_, - fun h => absurd h (Nat.lt_irrefl 0), fun _ _ h => absurd h (Nat.not_lt_zero _)⟩ - · simp only [τ₀, RegSet.mem_ofList, List.mem_singleton] at hr - subst hr; exact hesp - · rw [hp₁.wr, hp₂.wr] - simp only [inR, ouR, scR, argR, inA, ouA, scA, inn, ou, scr, esp₀, ha 0 (by omega_nat), ha 1 (by omega_nat), - ha 4 (by omega_nat), hesp] - · intro sl hsl - simp only [τ₀, List.mem_singleton] at hsl - subst hsl; decide - · intro sl hsl k _ hk - simp only [τ₀, List.mem_singleton] at hsl - subst hsl - simp only [Nat.zero_add] at hk - simp only [VG.X86.Taint.byteAddr, VG.X86.Taint.region, hp₁.wr, hp₂.wr] - show s₁.mem (addr (esp₀ s₁) 4 + BitVec.ofNat 64 k) = s₂.mem (addr (esp₀ s₂) 4 + BitVec.ofNat 64 k) - rw [VG.Proof.Sha256.X86.Stream.Finalize.argWord_eq hp₁.sp_fit hk, - VG.Proof.Sha256.X86.Stream.Finalize.argWord_eq hp₂.sp_fit hk, - Mem.readW_byte s₁.mem _ (Nat.mod_lt _ (by omega_nat)), Mem.readW_byte s₂.mem _ (Nat.mod_lt _ (by omega_nat))] - exact congrArg _ (ha _ (by omega_nat)) - -/-- Memory holding the arguments `0x1000, 0x1100, 0x1200, 0, 0x3000` at `0x4004`. -/ -def satMem : Mem := fun a => - if a = 0x4005 then 0x10 else if a = 0x4009 then 0x11 else if a = 0x400D then 0x12 else - if a = 0x4015 then 0x30 else 0 - -/-- A state satisfying the precondition (with an empty key). -/ -def sat : State where - gpr r := match r with - | .esp => 0x4000 | _ => 0 - cf := none - zf := none - sf := none - of := none - mem := satMem - rd := [⟨0x1200, 0⟩] - wr := [⟨0x1000, 96⟩, ⟨0x1100, 96⟩, ⟨0x3000, 160⟩, ⟨0x4004, 20⟩] - -theorem init_ct : ConstantTime isa Proof.Hmac.initSha256X86.pre Proof.Hmac.initSha256X86.pub init := - VG.Taint.constantTime (A := taint) τ₀ (fun _ _ h₁ h₂ hp => agree₀ h₁ h₂ hp) (by taint_decide) - -/-- `initSha256X86` with the 608 bytes of scratch of the shared contract -(sized for the x86-64 AVX2 compression function), of which the code uses 160. -/ -def initWide : Contract isa := - { Proof.Hmac.initSha256X86 with - pre := fun s => - let inner : Region := ⟨(arg s 0).setWidth 64, 96⟩ - let outer : Region := ⟨(arg s 1).setWidth 64, 96⟩ - let key : Region := ⟨(arg s 2).setWidth 64, (arg s 3).toNat⟩ - let scratch : Region := ⟨(arg s 4).setWidth 64, 608⟩ - let args : Region := ⟨argAddr s 0, 20⟩ - let ret : Region := ⟨(s.gpr .esp).setWidth 64, 4⟩ - let stack : Region := ⟨(s.gpr .esp).setWidth 64 - 20, 20⟩ - (arg s 3).toNat ≤ 64 ∧ s.rd = [key] ∧ s.wr = [inner, outer, scratch, args] ∧ - inner.Disjoint outer ∧ inner.Disjoint scratch ∧ outer.Disjoint scratch ∧ - args.Disjoint inner ∧ args.Disjoint outer ∧ args.Disjoint scratch ∧ - key.Disjoint inner ∧ key.Disjoint outer ∧ key.Disjoint scratch ∧ key.Disjoint args ∧ - ret.Disjoint inner ∧ ret.Disjoint outer ∧ ret.Disjoint scratch ∧ - stack.Disjoint inner ∧ stack.Disjoint outer ∧ stack.Disjoint scratch ∧ - (arg s 0).toNat + 96 ≤ 2 ^ 32 ∧ (arg s 1).toNat + 96 ≤ 2 ^ 32 ∧ - (arg s 2).toNat + (arg s 3).toNat ≤ 2 ^ 32 ∧ (arg s 4).toNat + 608 ≤ 2 ^ 32 ∧ - 20 ≤ (s.gpr .esp).toNat ∧ (s.gpr .esp).toNat + 24 ≤ 2 ^ 32 } - -/-- The regions `initSha256X86` lets the code write. -/ -def narrowWr (s : State) : List Region := - [⟨(arg s 0).setWidth 64, 96⟩, ⟨(arg s 1).setWidth 64, 96⟩, ⟨(arg s 4).setWidth 64, 160⟩, - ⟨argAddr s 0, 20⟩] - -/-- Rewrites the contracts at a narrowed state (`arg` does not unfold -cheaply). -/ -local macro "narrow" loc:(Lean.Parser.Tactic.location)? : tactic => - `(tactic| simp only [Proof.Hmac.initSha256X86, VG.Proof.Hmac.X86.Init.initWide, VG.Proof.Hmac.X86.Init.narrowWr, VG.X86.arg_withRegions, VG.X86.argAddr_withRegions, - VG.X86.State.withRegions_gpr, VG.X86.State.withRegions_mem, VG.X86.State.withRegions_rd, - VG.X86.State.withRegions_wr] $(loc)?) - -theorem initWide_pre (s : State) (h : initWide.pre s) : - Proof.Hmac.initSha256X86.pre (s.withRegions s.rd (narrowWr s)) := by - obtain ⟨h₁, h₂, _, h₄, h₅, h₆, h₇, h₈, h₉, h₁₀, h₁₁, h₁₂, h₁₃, h₁₄, h₁₅, h₁₆, h₁₇, h₁₈, h₁₉, - h₂₀, h₂₁, h₂₂, h₂₃, h₂₄, h₂₅⟩ := h - narrow - exact ⟨h₁, h₂, trivial, h₄, h₅.sub_right (Region.sub_of_ble rfl), - h₆.sub_right (Region.sub_of_ble rfl), h₇, h₈, h₉.sub_right (Region.sub_of_ble rfl), h₁₀, h₁₁, - h₁₂.sub_right (Region.sub_of_ble rfl), h₁₃, h₁₄, h₁₅, h₁₆.sub_right (Region.sub_of_ble rfl), h₁₇, - h₁₈, h₁₉.sub_right (Region.sub_of_ble rfl), h₂₀, h₂₁, h₂₂, Region.end_le_of_ble rfl h₂₃, h₂₄, h₂₅⟩ - -/-- A state satisfying `initWide.pre`. -/ -def wideSat : State := - { sat with wr := [⟨0x1000, 96⟩, ⟨0x1100, 96⟩, ⟨0x3000, 608⟩, ⟨0x4004, 20⟩] } - -theorem initWide_implies : initWide.Implies (Spec.Hmac.initSha256Contract X86.abi 20) := by - have a0 : arg wideSat 0 = 0x1000 := by decide - have a1 : arg wideSat 1 = 0x1100 := by decide - have a2 : arg wideSat 2 = 0x1200 := by decide - have a3 : arg wideSat 3 = 0 := by decide - have a4 : arg wideSat 4 = 0x3000 := by decide - have e : argAddr wideSat 0 = 0x4004 := by decide - have esp : wideSat.gpr .esp = 0x4000 := rfl - sig_implies [Spec.Hmac.initSha256Contract, Spec.Hmac.initSha256Sig, initWide, - Proof.Hmac.initSha256X86, X86.abi, X86.argSlots, X86.argVal, X86.argBytes] - [a0, a1, a2, a3, a4, e, esp] using wideSat - -end VG.Proof.Hmac.X86.Init diff --git a/lean/VerifiedGarbage/Proof/Hmac/X86/Lit.lean b/lean/VerifiedGarbage/Proof/Hmac/X86/Lit.lean deleted file mode 100644 index 44a1c9279..000000000 --- a/lean/VerifiedGarbage/Proof/Hmac/X86/Lit.lean +++ /dev/null @@ -1,15 +0,0 @@ -import VerifiedGarbage.Proof.Framework.X86.Lit -import VerifiedGarbage.Impl.Hmac.X86 -import VerifiedGarbage.Proof.Sha256.X86.Lit - -/-! -# HMAC-SHA-256 on X86: the code as literals --/ - -namespace VG - -materialize_code Impl.Hmac.X86.init -materialize_code Impl.Hmac.X86.finalizeHash -materialize_code Impl.Hmac.X86.finalize - -end VG diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Arm/Iterate.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Arm/Iterate.lean deleted file mode 100644 index d03133802..000000000 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Arm/Iterate.lean +++ /dev/null @@ -1,1109 +0,0 @@ -import VerifiedGarbage.Proof.Pbkdf2.Hmac -import VerifiedGarbage.Spec.Pbkdf2 -import VerifiedGarbage.Proof.Sha256.Arm.Contract -import VerifiedGarbage.Proof.Pbkdf2.Memory -import VerifiedGarbage.Proof.Hmac.Arm.Init -import VerifiedGarbage.Impl.Pbkdf2.Arm -import VerifiedGarbage.Proof.Framework.Arm.Contract -import VerifiedGarbage.Proof.Framework.Arm.Inline -import VerifiedGarbage.Spec.Pbkdf2.Contract -import VerifiedGarbage.Proof.Pbkdf2.Arm.Lit - -/-! -# PBKDF2-HMAC-SHA-256's iteration on ARMv7: the parts of a step - -The same structure as the x86-64 and AArch64 proofs -(`Proof/Pbkdf2/X86_64/Iterate.lean`, `VG.Proof.Pbkdf2.AArch64`), with the same -target-independent memory lemmas (`VG.Proof.Pbkdf2.Memory`). Each step is two -calls of `vg_sha256_compress`, used as a black box through its proof -(`compressAt_ok`, from the streaming SHA-256 proof). The hash value being -compressed is `t`, and `T` is kept in `scratch[160..192)`. --/ - -namespace VG.Proof.Pbkdf2 - -open Spec.Hmac (xorPad ipad opad hmacBlockKey sha256) -open Spec.Sha256 (Repr bytesAt) - -open VG.Arm in -/-- 32-bit ARM contract for `vg_pbkdf2_hmac_sha256_iterate(key: *const [u8; -192], u: *const [u8; 32], n: u32, t: *mut [u8; 32], scratch: *mut [u64; 48])`: -if, for a 64-byte key `K₀`, the streaming state at `key` represents `K₀ ⊕ ipad` -and the one at `key + 96` represents `K₀ ⊕ opad`, runs `n` steps `U ← -HMAC-SHA-256 (K₀, U)`, `T ← T ⊕ U` from the `U` at `u` and the `T` at `t`, -leaving the final `T` at `t`. - -Under AAPCS, `key`, `u`, `n` and `t` are in `r0`–`r3`, and `scratch` is the -stack argument 0. The code may read that argument (4 bytes at `sp`), `key` -(192 bytes) and `u` (32 bytes), and read and write `t` (32 bytes) and -`scratch` (384 bytes, whose contents on exit are unspecified). The written -regions may not overlap each other, the read ones or the argument; and -nothing may wrap around the end of the (32-bit) address space. `sp`, the -pointers and `n` are public; the key, `U` and `T` are secret. -/ -def iterateSha256Arm : Contract isa where - pre s := - let key : Region := ⟨State.addr (s.gpr .r0), 192⟩ - let u : Region := ⟨State.addr (s.gpr .r1), 32⟩ - let t : Region := ⟨State.addr (s.gpr .r3), 32⟩ - let scratch : Region := ⟨State.addr (stackArg s 0), 384⟩ - let args : Region := ⟨stackArgAddr s 0, 4⟩ - s.rd = [key, u, args] ∧ s.wr = [t, scratch] ∧ - key.Disjoint t ∧ key.Disjoint scratch ∧ u.Disjoint t ∧ u.Disjoint scratch ∧ t.Disjoint scratch ∧ - args.Disjoint t ∧ args.Disjoint scratch ∧ - (s.gpr .r0).toNat + 192 ≤ 2 ^ 32 ∧ (s.gpr .r1).toNat + 32 ≤ 2 ^ 32 ∧ - (s.gpr .r3).toNat + 32 ≤ 2 ^ 32 ∧ (stackArg s 0).toNat + 384 ≤ 2 ^ 32 ∧ - s.sp.toNat + 4 ≤ 2 ^ 32 - post s s' := ∀ k0, k0.length = 64 → - Repr s.mem (State.addr (s.gpr .r0)) (xorPad k0 ipad) → - Repr s.mem (State.addr (s.gpr .r0) + 96) (xorPad k0 opad) → - bytesAt s'.mem (State.addr (s.gpr .r3)) 32 = - Spec.Pbkdf2.iterate (hmacBlockKey sha256 k0) (s.gpr .r2).toNat - (bytesAt s.mem (State.addr (s.gpr .r1)) 32) (bytesAt s.mem (State.addr (s.gpr .r3)) 32) - pub s₁ s₂ := - 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.Pbkdf2 - -namespace VG.Proof.Pbkdf2.Arm - -open VG VG.Arm VG.Impl.Pbkdf2.Arm -open VG.Impl.Sha256.Arm.Stream (save restore compressAt saved) -open VG.Impl.Hmac.Arm (cp) -open VG.Proof.Sha256.Arm (contains_offset) -open VG.Proof.MdStream.Arm (Upd Mupd wp_add wp_ldr wp_str wp_rev op2_imm op2_reg sub_offset) -open VG.Proof.Sha256.Arm.Stream (compressAt_ok) -open VG.Proof.Sha256.Arm.Stream.Finalize (writeW_rev flat_length) -open VG.Proof.Hmac.Arm (copy_ok add_off) -open VG.Proof.Hmac.Arm.Init (wp_eor) -open VG.Proof.Hmac.Common (bytesAt_length bytesAt_writeBytes_sep bytesAt_add extractLsb'_read) -open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame writeBytes_append writeBytes_nil write_eq_writeBytes) -open VG.Proof.Pbkdf2.Memory (frame_bytesAt contains_base off_contains sep_after xorBytes_length - add_ofNat stateAt_copy) -open VG.Spec.Sha256 (bytesAt stateAt blockAt compress HashValue wordBytes) - -/-! ## The precondition -/ - -section -variable (s₀ : State) - -abbrev key : BitVec 32 := s₀.gpr .r0 -abbrev uP : BitVec 32 := s₀.gpr .r1 -/-- The number of steps. -/ -abbrev nn : Nat := (s₀.gpr .r2).toNat -abbrev tP : BitVec 32 := s₀.gpr .r3 -abbrev scr : BitVec 32 := stackArg s₀ 0 -abbrev kA : Addr := State.addr (key s₀) -abbrev uA : Addr := State.addr (uP s₀) -abbrev tA : Addr := State.addr (tP s₀) -abbrev scA : Addr := State.addr (scr s₀) -abbrev keyR : Region := ⟨kA s₀, 192⟩ -abbrev uR : Region := ⟨uA s₀, 32⟩ -abbrev tR : Region := ⟨tA s₀, 32⟩ -abbrev scR : Region := ⟨scA s₀, 384⟩ -abbrev argR : Region := ⟨stackArgAddr s₀ 0, 4⟩ - -/-- A part of the scratch space. -/ -abbrev sR (o n : Nat) : Region := ⟨scA s₀ + BitVec.ofNat 64 o, n⟩ -/-- `vg_sha256_compress`'s scratch space. -/ -abbrev cmpR : Region := ⟨scA s₀, 112⟩ -/-- `T`. -/ -abbrev TA : Addr := scA s₀ + BitVec.ofNat 64 160 -/-- The block. -/ -abbrev blkA : Addr := scA s₀ + BitVec.ofNat 64 192 - -end - -structure Pre (s₀ : State) : Prop where - rd : s₀.rd = [keyR s₀, uR s₀, argR s₀] - wr : s₀.wr = [tR s₀, scR s₀] - k_t : (keyR s₀).Disjoint (tR s₀) - k_s : (keyR s₀).Disjoint (scR s₀) - u_t : (uR s₀).Disjoint (tR s₀) - u_s : (uR s₀).Disjoint (scR s₀) - t_s : (tR s₀).Disjoint (scR s₀) - a_t : (argR s₀).Disjoint (tR s₀) - a_s : (argR s₀).Disjoint (scR s₀) - key_fit : (key s₀).toNat + 192 ≤ 2 ^ 32 - u_fit : (uP s₀).toNat + 32 ≤ 2 ^ 32 - t_fit : (tP s₀).toNat + 32 ≤ 2 ^ 32 - scr_fit : (scr s₀).toNat + 384 ≤ 2 ^ 32 - sp_fit : s₀.sp.toNat + 4 ≤ 2 ^ 32 - -theorem pre_of {s₀ : State} (h : Proof.Pbkdf2.iterateSha256Arm.pre s₀) : Pre s₀ := by - obtain ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14⟩ := h - exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14⟩ - -/-! ## Regions -/ - -theorem toNat_ofNat_lt {k : Nat} (h : k < 2 ^ 64) : (BitVec.ofNat 64 k).toNat = k := by - rw [BitVec.toNat_ofNat, Nat.mod_eq_of_lt h] - -/-- Two parts of the scratch space at offsets `a` and `b` do not overlap. -/ -theorem scr_disj (s₀ : State) {a m b n : Nat} (h : a + m ≤ b ∨ b + n ≤ a) (ha : a + m ≤ 384) (hb : b + n ≤ 384) : - Region.Disjoint (sR s₀ a m) (sR s₀ b n) := by - intro x h₁ h₂ - simp only [Region.Contains] at h₁ h₂ - have ta : (BitVec.ofNat 64 a).toNat = a := toNat_ofNat_lt (by omega) - have tb : (BitVec.ofNat 64 b).toNat = b := toNat_ofNat_lt (by omega) - bv_omega - -theorem scr_disj0 (s₀ : State) {a m n : Nat} (h : n ≤ a) (ha : a + m ≤ 384) : - Region.Disjoint (sR s₀ a m) ⟨scA s₀, n⟩ := by - have := scr_disj s₀ (a := a) (m := m) (b := 0) (n := n) (by omega) ha (by omega) - simp only [sR] at this - simpa using this - -theorem scr_sub (s₀ : State) {o n : Nat} (h : o + n ≤ 384) : Region.Sub (sR s₀ o n) (scR s₀) := - sub_offset h (by omega) - -theorem cmp_sub (s₀ : State) : Region.Sub (cmpR s₀) (scR s₀) := Region.sub_prefix (by omega) - -theorem ofNat_zero (p : Addr) : p + BitVec.ofNat 64 0 = p := by simp - -section -variable {s₀ : State} (hp : Pre s₀) {s : State} -include hp - -theorem in_scr (hwr : s.wr = s₀.wr) {a n : Nat} (h : a + n ≤ 384) : - InRegions s.wr (scA s₀ + BitVec.ofNat 64 a) n := - ⟨scR s₀, by simp [hwr, hp.wr], contains_offset h (by omega)⟩ - -theorem in_t (hwr : s.wr = s₀.wr) {b n : Nat} (h : b + n ≤ 32) : - InRegions s.wr (tA s₀ + BitVec.ofNat 64 b) n := - ⟨tR s₀, by simp [hwr, hp.wr], contains_offset (by omega) (by omega)⟩ - -theorem in_key (hrd : s.rd = s₀.rd) {a n : Nat} (h : a + n ≤ 192) : - InRegions (s.rd ++ s.wr) (kA s₀ + BitVec.ofNat 64 a) n := - ⟨keyR s₀, by simp [hrd, hp.rd], contains_offset h (by omega)⟩ - -end - -theorem InRegions.right {rd wr : List Region} {a : Addr} {n : Nat} (h : InRegions wr a n) : - InRegions (rd ++ wr) a n := by - obtain ⟨r, hr, hc⟩ := h; exact ⟨r, List.mem_append_right _ hr, hc⟩ - -theorem key_disj {s₀ : State} (hp : Pre s₀) : ∀ r ∈ [tR s₀, scR s₀], Region.Disjoint (keyR s₀) r := by - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact hp.k_t - · exact hp.k_s - -/-- The scratch pointer plus an offset, as an address. -/ -theorem scr_add {s₀ : State} (hp : Pre s₀) {k : Nat} (hk : k < 384) : - State.addr (scr s₀ + BitVec.ofNat 32 k) = scA s₀ + BitVec.ofNat 64 k := by - have := hp.scr_fit - exact addr_add (by omega) - -/-! ## The registers and memory during a step -/ - -/-- The registers the body keeps. -/ -def kept : List Reg := [.r0, .r3, .r4, .r5] - -/-- From `s` to `s'`, only `t` (the hash value being compressed) and the -compression's part of the scratch space changed. -/ -structure Keep (s₀ s s' : State) : Prop where - rd : s'.rd = s.rd - wr : s'.wr = s.wr - sp : s'.sp = s.sp - gpr : ∀ r ∈ kept, s'.gpr r = s.gpr r - frame : Frame [tR s₀, cmpR s₀] s.mem s'.mem - -theorem Keep.trans {s₀ s₁ s₂ s₃ : State} (h₁ : Keep s₀ s₁ s₂) (h₂ : Keep s₀ s₂ s₃) : Keep s₀ s₁ s₃ := - ⟨h₂.rd.trans h₁.rd, h₂.wr.trans h₁.wr, h₂.sp.trans h₁.sp, fun r hr => (h₂.gpr r hr).trans (h₁.gpr r hr), - h₁.frame.trans h₂.frame⟩ - -/-- The registers and memory at the start of each step. -/ -structure Regs (s₀ s : State) : Prop where - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - sp : s.sp = s₀.sp - r0 : s.gpr .r0 = tP s₀ - r3 : s.gpr .r3 = scr s₀ - r4 : s.gpr .r4 = key s₀ - frame : Frame [tR s₀, scR s₀] s₀.mem s.mem - -theorem Regs.keep {s₀ s s' : State} (h : Regs s₀ s) (hk : Keep s₀ s s') : Regs s₀ s' where - rd := hk.rd.trans h.rd - wr := hk.wr.trans h.wr - sp := hk.sp.trans h.sp - r0 := (hk.gpr _ (by simp [kept])).trans h.r0 - r3 := (hk.gpr _ (by simp [kept])).trans h.r3 - r4 := (hk.gpr _ (by simp [kept])).trans h.r4 - frame := h.frame.trans (hk.frame.sub fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact ⟨tR s₀, by simp, fun _ h => h⟩ - · exact ⟨scR s₀, by simp, cmp_sub s₀⟩) - -theorem Regs.write {s₀ s s' : State} (h : Regs s₀ s) (hg : ∀ r ∈ [Reg.r0, .r3, .r4], s'.gpr r = s.gpr r) - (hrd : s'.rd = s.rd) (hwr : s'.wr = s.wr) (hsp : s'.sp = s.sp) {R : Region} (hR : R ∈ [tR s₀, scR s₀]) - (hm : Frame [R] s.mem s'.mem) : Regs s₀ s' where - rd := hrd.trans h.rd - wr := hwr.trans h.wr - sp := hsp.trans h.sp - r0 := (hg _ (by simp)).trans h.r0 - r3 := (hg _ (by simp)).trans h.r3 - r4 := (hg _ (by simp)).trans h.r4 - frame := h.frame.trans (hm.mono (by simpa using hR)) - -/-- The key's bytes are as on entry. -/ -theorem Regs.key_bytes {s₀ s : State} (hp : Pre s₀) (h : Regs s₀ s) {i : Nat} (hi : i < 192) : - s.mem (kA s₀ + BitVec.ofNat 64 i) = s₀.mem (kA s₀ + BitVec.ofNat 64 i) := - h.frame.bytes (R := keyR s₀) (key_disj hp) (by simp) hi - -/-! ## Loading a hash value of the key into `t` -/ - -/-- Loading the hash value at `key + o` into `t`. -/ -theorem load_ok {s₀ : State} (hp : Pre s₀) {s : State} (h : Regs s₀ s) {o : Nat} (ho : o + 32 ≤ 192) - {rest : List Instr} {Q : State → Prop} - (k : ∀ s', Keep s₀ s s' → stateAt s'.mem (tA s₀) = stateAt s₀.mem (kA s₀ + BitVec.ofNat 64 o) → - WP isa (.block rest) s' Q) : - WP isa (.block (load o ++ rest)) s Q := by - have := hp.key_fit; have := hp.t_fit - unfold load - refine copy_ok (t := .r12) (src := .r4) (dst := .r0) (by decide) (by decide) o 0 8 ⟨by omega, by omega⟩ - rest s Q (by rw [h.r4]; omega) (by rw [h.r0]; omega) - (fun j hj => by rw [h.r4, add_ofNat]; exact in_key hp h.rd (by omega)) - (fun j hj => by rw [h.r0, add_ofNat]; exact in_t hp h.wr (by omega)) - ?_ fun s' g' rd' wr' sp' m' => k s' ⟨rd', wr', sp', fun r hr => g' r (by - simp only [kept, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl <;> decide), ?_⟩ ?_ - · rw [h.r4, h.r0] - exact Region.Disjoint.sep hp.k_t (contains_offset (by omega) (by omega)) (contains_offset (by omega) (by omega)) - · rw [m', h.r0] - refine writeBytes_frame _ _ _ (R := tR s₀) ?_ |>.mono (by simp) - rw [bytesAt_length, ofNat_zero]; exact contains_base (Nat.le_refl _) - · rw [m', h.r0, h.r4, ofNat_zero, show 4 * 8 = 32 from rfl, stateAt_copy] - apply Proof.Sha256.Stream.stateAt_congr - intro i hi - rw [add_ofNat] - exact h.key_bytes hp (by omega) - -/-! ## A call of `vg_sha256_compress` on the block -/ - -/-- `r1` at the block. -/ -theorem atBlock_ok {s₀ : State} {s : State} (h : Regs s₀ s) {Q : State → Prop} - (k : ∀ s', Keep s₀ s s' → s'.mem = s.mem → s'.gpr .r1 = scr s₀ + BitVec.ofNat 32 192 → Q s') : - WP isa (.block [atBlock]) s Q := by - refine wp_add (op2_imm (by decide)) fun s' u => WP.block_nil (k s' ⟨u.rd, u.wr, u.sp, fun r hr => u.other r ?_, - by rw [u.mem]; exact Frame.refl _ _⟩ u.mem (by rw [u.gpr, h.r3]; rfl)) - simp only [kept, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl <;> decide - -/-- Compressing the block into the hash value in `t`. -/ -theorem cmp_ok {s₀ : State} (hp : Pre s₀) {s : State} (h : Regs s₀ s) (h1 : s.gpr .r1 = scr s₀ + BitVec.ofNat 32 192) - {Q : State → Prop} - (k : ∀ s', Keep s₀ s s' → - stateAt s'.mem (tA s₀) = compress (stateAt s.mem (tA s₀)) (blockAt s.mem (blkA s₀)) → Q s') : - WP isa compressAt s Q := by - have := hp.scr_fit; have := hp.t_fit - have ea : State.addr (scr s₀ + BitVec.ofNat 32 192) = blkA s₀ := scr_add hp (by omega) - have et : (scr s₀ + BitVec.ofNat 32 192).toNat = (scr s₀).toNat + 192 := by - rw [BitVec.toNat_add, BitVec.toNat_ofNat]; omega - have hsc : scR s₀ ∈ s.wr := by simp [h.wr, hp.wr] - have htr : tR s₀ ∈ s.wr := by simp [h.wr, hp.wr] - refine compressAt_ok (st := tP s₀) (scr := scr s₀) (src := scr s₀ + BitVec.ofNat 32 192) h.r0 h.r3 h1 - (by omega) (by rw [et]; omega) (by omega) (hp.t_s.sub_right (cmp_sub s₀)) - (by rw [ea]; exact (hp.t_s.sub_right (scr_sub s₀ (o := 192) (n := 64) (by omega))).symm) - (by rw [ea]; exact scr_disj0 s₀ (a := 192) (by omega) (by omega)) ?_ ?_ - fun s' hrd hwr hcs hr0 hr3 hsp hf hst => k s' ⟨hrd, hwr, hsp, fun r hr => ?_, hf⟩ (by rw [hst, ea]) - · rw [ea] - 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 - · exact ⟨scR s₀, List.mem_append_right _ hsc, 192, rfl, by simp⟩ - · exact ⟨tR s₀, List.mem_append_right _ htr, 0, by simp, by simp⟩ - · exact ⟨scR s₀, List.mem_append_right _ hsc, 0, by simp, by simp⟩ - · 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 ⟨tR s₀, htr, 0, by simp, by simp⟩ - · exact ⟨scR s₀, hsc, 0, by simp, by simp⟩ - · simp only [kept, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl - · rw [hr0, h.r0] - · rw [hr3, h.r3] - · exact hcs _ (by simp [preserved]) (by decide) - · exact hcs _ (by simp [preserved]) (by decide) - -/-! ## The digest into the block -/ - -/-- The first `n` words of the digest of the hash value at `r0` (`p0`) into -the block at `r3 + 192` (`p3 + 192`). -/ -theorem out_ok {p0 p3 : BitVec 32} (f0 : p0.toNat + 32 ≤ 2 ^ 32) (f3 : p3.toNat + 224 ≤ 2 ^ 32) - (hd : Region.Disjoint ⟨State.addr p0, 32⟩ ⟨State.addr p3 + BitVec.ofNat 64 192, 32⟩) : - ∀ n ≤ 8, ∀ (rest : List Instr) (s : State) (Q : State → Prop), s.gpr .r0 = p0 → s.gpr .r3 = p3 → - (∀ k < 8, InRegions (s.rd ++ s.wr) (State.addr p0 + BitVec.ofNat 64 (4 * k)) 4) → - (∀ k < 8, InRegions s.wr (State.addr p3 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * k)) 4) → - (∀ 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 p3 + BitVec.ofNat 64 192) - (((stateAt s.mem (State.addr p0)).toList.take n).flatMap wordBytes) → - WP isa (.block rest) s' Q) → - WP isa (.block ((List.range n).flatMap outW ++ rest)) s Q := by - intro n - induction n with - | zero => - intro _ rest s Q _ _ _ _ k - exact k s (fun _ _ => rfl) rfl rfl rfl (by simp [writeBytes_nil]) - | succ n ih => - intro hn rest s Q h0 h3 hin hout k - rw [List.range_succ, List.flatMap_append, List.flatMap_singleton, List.append_assoc] - refine ih (by omega) _ s Q h0 h3 hin hout fun s₁ g₁ rd₁ wr₁ sp₁ m₁ => ?_ - have hP := flat_length (stateAt s.mem (State.addr p0)) n (by omega) - simp only [outW, List.cons_append, List.nil_append] - refine wp_ldr (a := State.addr p0 + BitVec.ofNat 64 (4 * n)) (by omega) - (by rw [g₁ _ (by decide), h0, addr_add (by omega)]) - (by rw [rd₁, wr₁]; exact hin n (by omega)) fun s₂ u₂ => ?_ - refine wp_rev fun s₃ u₃ => wp_str (a := State.addr p3 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * n)) - (by omega) (by rw [u₃.other _ (by decide), u₂.other _ (by decide), g₁ _ (by decide), h3, - addr_add (by omega), add_off]) - (by rw [u₃.wr, u₂.wr, wr₁]; exact hout n (by omega)) - fun s₄ g₄ => k s₄ (fun r hr => by rw [g₄.gpr, u₃.other r hr, u₂.other r hr, g₁ r hr]) - (by rw [g₄.rd, u₃.rd, u₂.rd, rd₁]) (by rw [g₄.wr, u₃.wr, u₂.wr, wr₁]) - (by rw [g₄.sp, u₃.sp, u₂.sp, sp₁]) ?_ - have hread : s₁.mem.readW (State.addr p0 + BitVec.ofNat 64 (4 * n)) 32 = - (stateAt s.mem (State.addr p0))[n] := by - rw [m₁, (writeBytes_frame s.mem (State.addr p3 + BitVec.ofNat 64 192) _ - (R := ⟨State.addr p3 + BitVec.ofNat 64 192, 32⟩) (contains_base (by rw [hP]; omega))).readW - (r := ⟨State.addr p0 + BitVec.ofNat 64 (4 * n), 4⟩) (Region.contains_self _ _) ?_ (by decide)] - · simp [stateAt] - · intro r' hr' - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr' - subst hr' - exact hd.sub_left (sub_offset (by omega) (by omega)) - rw [g₄.mem, u₃.mem, u₂.mem, u₃.gpr, u₂.gpr, hread, m₁, writeW_rev, - show State.addr p3 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * n) = State.addr p3 + BitVec.ofNat 64 192 + - BitVec.ofNat 64 (((stateAt s.mem (State.addr p0)).toList.take n).flatMap wordBytes).length by rw [hP]] - rw [writeBytes_append _ _ _ _ (by rw [hP]; simp [wordBytes]; omega), List.take_add_one, - List.getElem?_eq_getElem (by simp; omega), Option.toList_some, List.flatMap_append, - List.flatMap_singleton, Vector.getElem_toList] - -theorem digest_eq (H : HashValue) : (H.toList.take 8).flatMap wordBytes = Pbkdf2.digest H := by - rw [List.take_of_length_le (by simp)]; rfl - -/-- The digest of the hash value in `t` into the block. -/ -theorem digest_ok {s₀ : State} (hp : Pre s₀) {s : State} (h : Regs s₀ s) {rest : List Instr} {Q : State → Prop} - (k : ∀ s', Regs s₀ s' → (∀ r, r ≠ .r12 → s'.gpr r = s.gpr r) → Frame [sR s₀ 192 32] s.mem s'.mem → - s'.mem = writeBytes s.mem (blkA s₀) (Pbkdf2.digest (stateAt s.mem (tA s₀))) → - WP isa (.block rest) s' Q) : - WP isa (.block (Impl.Pbkdf2.Arm.digest ++ rest)) s Q := by - have := hp.scr_fit; have := hp.t_fit - unfold Impl.Pbkdf2.Arm.digest - refine out_ok (p0 := tP s₀) (p3 := scr s₀) (by omega) (by omega) - (hp.t_s.sub_right (scr_sub s₀ (o := 192) (n := 32) (by omega))) 8 (Nat.le_refl _) rest s Q h.r0 h.r3 - (fun j hj => InRegions.right (in_t hp h.wr (by omega))) - (fun j hj => by rw [add_ofNat]; exact in_scr hp h.wr (a := 192 + 4 * j) (by omega)) - fun s' g' rd' wr' sp' m' => ?_ - rw [digest_eq] at m' - have hf : Frame [sR s₀ 192 32] s.mem s'.mem := by - rw [m']; exact writeBytes_frame _ _ _ (contains_base (by rw [Pbkdf2.digest_length])) - exact k s' (h.write (fun r hr => g' r (by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl <;> decide)) rd' wr' sp' (R := scR s₀) (by simp) (hf.sub fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - subst hr; exact ⟨scR s₀, by simp, scr_sub s₀ (by omega)⟩)) g' hf m' - -/-! ## `T ← T ⊕ U` -/ - -theorem writeW_xor32 (m m' : Mem) (d a b : Addr) : - m.writeW d (m'.readW a 32 ^^^ m'.readW b 32) = - writeBytes m d (Spec.Pbkdf2.xorBytes (bytesAt m' a 4) (bytesAt m' b 4)) := by - simp only [Mem.writeW, Mem.readW] - rw [show (32 : Nat) / 8 = 4 from rfl, BitVec.setWidth_eq, BitVec.setWidth_eq, BitVec.setWidth_eq, - write_eq_writeBytes] - congr 1 - apply List.ext_getElem (by simp [Spec.Pbkdf2.xorBytes, bytesAt]) - intro j h₁ h₂ - simp only [List.length_map, List.length_range] at h₁ - simp only [Spec.Pbkdf2.xorBytes, bytesAt, List.getElem_map, List.getElem_range, List.getElem_zipWith] - rw [BitVec.extractLsb'_xor, extractLsb'_read _ _ h₁, extractLsb'_read _ _ h₁] - -/-- `T ← T ⊕ U` for the first `n` words of `T` at `p3 + 160` and `U` at `p3 + 192`. -/ -theorem xor_ok {p3 : BitVec 32} (f3 : p3.toNat + 224 ≤ 2 ^ 32) : - ∀ n ≤ 8, ∀ (rest : List Instr) (s : State) (Q : State → Prop), s.gpr .r3 = p3 → - (∀ k < 8, InRegions (s.rd ++ s.wr) (State.addr p3 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * k)) 4) → - (∀ k < 8, InRegions s.wr (State.addr p3 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * k)) 4) → - (∀ s', (∀ r, r ≠ .r12 → r ≠ .r1 → 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 p3 + BitVec.ofNat 64 160) - (Spec.Pbkdf2.xorBytes (bytesAt s.mem (State.addr p3 + BitVec.ofNat 64 160) (4 * n)) - (bytesAt s.mem (State.addr p3 + BitVec.ofNat 64 192) (4 * n))) → - WP isa (.block rest) s' Q) → - WP isa (.block ((List.range n).flatMap xorW ++ rest)) s Q := by - intro n - induction n with - | zero => - intro _ rest s Q _ _ _ k - exact k s (fun _ _ _ => rfl) rfl rfl rfl (by simp [bytesAt, Spec.Pbkdf2.xorBytes, writeBytes_nil]) - | succ n ih => - intro hn rest s Q h3 hin hout k - rw [List.range_succ, List.flatMap_append, List.flatMap_singleton, List.append_assoc] - refine ih (by omega) _ s Q h3 hin hout fun s₁ g₁ rd₁ wr₁ sp₁ m₁ => ?_ - simp only [xorW, List.cons_append, List.nil_append] - have hw := hout n (by omega) - have e3 : s₁.gpr .r3 = p3 := by rw [g₁ _ (by decide) (by decide), h3] - refine wp_ldr (a := State.addr p3 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * n)) (by omega) - (by rw [e3, addr_add (by omega), add_off]) (by rw [rd₁, wr₁]; exact InRegions.right hw) - fun s₂ u₂ => ?_ - refine wp_ldr (a := State.addr p3 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * n)) (by omega) - (by rw [u₂.other _ (by decide), e3, addr_add (by omega), add_off]) - (by rw [u₂.rd, u₂.wr, rd₁, wr₁]; exact hin n (by omega)) fun s₃ u₃ => ?_ - refine wp_eor (op2_reg _ _) fun s₄ u₄ => ?_ - refine wp_str (a := State.addr p3 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * n)) (by omega) - (by rw [u₄.other _ (by decide), u₃.other _ (by decide), u₂.other _ (by decide), e3, - addr_add (by omega), add_off]) - (by rw [u₄.wr, u₃.wr, u₂.wr, wr₁]; exact hw) - fun s₅ g₅ => k s₅ (fun r h12 h1 => by - rw [g₅.gpr, u₄.other r h12, u₃.other r h1, u₂.other r h12, g₁ r h12 h1]) - (by rw [g₅.rd, u₄.rd, u₃.rd, u₂.rd, rd₁]) (by rw [g₅.wr, u₄.wr, u₃.wr, u₂.wr, wr₁]) - (by rw [g₅.sp, u₄.sp, u₃.sp, u₂.sp, sp₁]) ?_ - have hl : (Spec.Pbkdf2.xorBytes (bytesAt s.mem (State.addr p3 + BitVec.ofNat 64 160) (4 * n)) - (bytesAt s.mem (State.addr p3 + BitVec.ofNat 64 192) (4 * n))).length = 4 * n := by - rw [xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length] - have v : s₄.gpr .r12 = s₁.mem.readW (State.addr p3 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * n)) 32 ^^^ - s₁.mem.readW (State.addr p3 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * n)) 32 := by - rw [u₄.gpr, u₃.other _ (by decide), u₂.gpr, u₃.gpr, u₂.mem] - rw [g₅.mem, u₄.mem, u₃.mem, u₂.mem, v, writeW_xor32, m₁, - bytesAt_writeBytes_sep (p := State.addr p3 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * n)), - bytesAt_writeBytes_sep (p := State.addr p3 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * n))] - · have e := writeBytes_append s.mem (State.addr p3 + BitVec.ofNat 64 160) _ - (Spec.Pbkdf2.xorBytes (bytesAt s.mem (State.addr p3 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * n)) 4) - (bytesAt s.mem (State.addr p3 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * n)) 4)) - (by rw [hl, xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length]; omega) - rw [hl] at e - rw [e, Nat.mul_succ, bytesAt_add, bytesAt_add, Spec.Pbkdf2.xorBytes, Spec.Pbkdf2.xorBytes, - Spec.Pbkdf2.xorBytes, List.zipWith_append (by simp [bytesAt])] - · intro x h₁ h₂ - rw [hl] at h₂ - have := toNat_ofNat_lt (k := 4 * n) (by omega) - have := VG.Proof.MdStream.Arm.addr_toNat p3 - bv_omega - · omega - · intro x h₁ h₂ - rw [hl] at h₂ - exact sep_after h₁ h₂ (by omega) - · omega - -end VG.Proof.Pbkdf2.Arm - -/-! -# PBKDF2-HMAC-SHA-256's iteration on ARMv7: the loop - -One step is HMAC-SHA-256 of `U` as two compressions -(`VG.Proof.Pbkdf2.hmac_step`), then `T ← T ⊕ U`. --/ - -namespace VG.Proof.Pbkdf2.Arm - -open VG VG.Arm VG.Impl.Pbkdf2.Arm -open VG.Impl.Sha256.Arm.Stream (saved) -open VG.Proof.MdStream.Arm (wp_subs op2_imm eval_eq eval_ne ofNat_beq_zero sub_ofNat) -open VG.Proof.Hmac.Common (bytesAt_length bytesAt_writeBytes_self bytesAt_writeBytes_sep) -open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame) -open VG.Proof.Pbkdf2.Memory (frame_bytesAt contains_base blockAt_eq xorBytes_length add_ofNat - digest_self) -open VG.Spec.Sha256 (bytesAt stateAt blockAt compress HashValue) - -section -variable (s₀ : State) - -/-- The key's inner and outer hash values. -/ -abbrev Hi : HashValue := stateAt s₀.mem (kA s₀ + BitVec.ofNat 64 0) -abbrev Ho : HashValue := stateAt s₀.mem (kA s₀ + BitVec.ofNat 64 96) - -/-- A step, as the code computes it. -/ -def stepM (u : List Byte) : List Byte := - Pbkdf2.digest (compress (Ho s₀) (block96 (Pbkdf2.digest (compress (Hi s₀) (block96 u))))) - -/-- Our caller's registers and our return address, saved in the scratch space. -/ -def Saved (m : Mem) : Prop := - ∀ p ∈ saved, m.readW (scA s₀ + BitVec.ofNat 64 p.2) 32 = s₀.gpr p.1 - -/-- What the body writes: `t`, the compression's part of the scratch space, -`T` and the block's first 32 bytes. -/ -abbrev bodyR : List Region := [tR s₀, cmpR s₀, sR s₀ 160 32, sR s₀ 192 32] - -end - -/-- Parts of the scratch space that the body leaves: the saved registers -(`[112..160)`) and the padding (from 224). -/ -theorem body_disj {s₀ : State} (hp : Pre s₀) {o n : Nat} (h₁ : (112 ≤ o ∧ o + n ≤ 160) ∨ 224 ≤ o) - (h₂ : o + n ≤ 384) : ∀ r ∈ bodyR s₀, Region.Disjoint (sR s₀ o n) 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 - · exact (hp.t_s.sub_right (scr_sub s₀ h₂)).symm - · exact scr_disj0 s₀ (by omega) h₂ - · exact scr_disj s₀ (b := 160) (n := 32) (by omega) h₂ (by omega) - · exact scr_disj s₀ (b := 192) (n := 32) (by omega) h₂ (by omega) - -/-- The block's first 32 bytes are neither `t` nor the compression's scratch. -/ -theorem blk_disj {s₀ : State} (hp : Pre s₀) : ∀ r ∈ [tR s₀, cmpR s₀], Region.Disjoint (sR s₀ 192 32) r := by - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact (hp.t_s.sub_right (scr_sub s₀ (by omega))).symm - · exact scr_disj0 s₀ (by omega) (by omega) - -/-- `T` is none of the other parts the body writes. -/ -theorem T_disj {s₀ : State} (hp : Pre s₀) : - ∀ r ∈ [tR s₀, cmpR s₀, sR s₀ 192 32], Region.Disjoint (sR s₀ 160 32) r := by - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact (hp.t_s.sub_right (scr_sub s₀ (by omega))).symm - · exact scr_disj0 s₀ (by omega) (by omega) - · exact scr_disj s₀ (by omega) (by omega) (by omega) - -theorem Saved.frame {s₀ : State} (hp : Pre s₀) {m m' : Mem} (h : Saved s₀ m) (hf : Frame (bodyR s₀) m m') : - Saved s₀ m' := by - intro p hp' - rw [← h p hp'] - simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp' - have hd : 112 ≤ p.2 ∧ p.2 + 4 ≤ 160 := by - rcases hp' with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> simp - exact hf.readW (r := sR s₀ p.2 4) (Region.contains_self _ _) (body_disj hp (.inl hd) (by omega)) (by decide) - -theorem frame_body {s₀ : State} {m m' : Mem} {rs : List Region} (hf : Frame rs m m') (hs : ∀ r ∈ rs, r ∈ bodyR s₀) : - Frame (bodyR s₀) m m' := hf.mono hs - -/-- The loop invariant, with `r` steps left. -/ -structure Inv (s₀ : State) (r : Nat) (s : State) : Prop extends Regs s₀ s where - r5 : s.gpr .r5 = BitVec.ofNat 32 r - saved : Saved s₀ s.mem - pad : bytesAt s.mem (scA s₀ + BitVec.ofNat 64 224) 32 = pad96 - le : r ≤ nn s₀ - val : Spec.Pbkdf2.iterate (stepM s₀) (nn s₀) (bytesAt s₀.mem (uA s₀) 32) (bytesAt s₀.mem (tA s₀) 32) = - Spec.Pbkdf2.iterate (stepM s₀) r (bytesAt s.mem (blkA s₀) 32) (bytesAt s.mem (TA s₀) 32) - -theorem body_ok {s₀ : State} (hp : Pre s₀) {r : Nat} {s : State} (h : Inv s₀ (r + 1) s) : - WP isa body s fun s' => VG.Arm.eval .ne s' = some (r != 0) ∧ Inv s₀ r s' := by - have := hp.scr_fit - unfold body - have hU : ∀ {m : Mem}, Frame [tR s₀, cmpR s₀] s.mem m → bytesAt m (blkA s₀) 32 = bytesAt s.mem (blkA s₀) 32 := - fun hf => frame_bytesAt hf (blk_disj hp) (by omega) - have hpad : ∀ {m : Mem}, Frame (bodyR s₀) s.mem m → bytesAt m (blkA s₀ + 32) 32 = pad96 := by - intro m hf - rw [show blkA s₀ + 32 = scA s₀ + BitVec.ofNat 64 224 by bv_omega, ← h.pad] - exact frame_bytesAt hf (body_disj hp (o := 224) (n := 32) (.inr (Nat.le_refl _)) (by omega)) (by omega) - -- The inner hash. - refine WP.seq ?_ - refine load_ok hp h.toRegs (o := 0) (by omega) fun s₁ k₁ e₁ => ?_ - refine atBlock_ok (h.toRegs.keep k₁) fun s₂ k₂ m₂ x1₂ => ?_ - have h₂ := (h.toRegs.keep k₁).keep k₂ - refine WP.seq (cmp_ok hp h₂ x1₂ fun s₃ k₃ e₃ => ?_) - rw [m₂, e₁, blockAt_eq (hpad (frame_body k₁.frame (by simp))), hU k₁.frame] at e₃ - -- The outer hash. - have h₃ := h₂.keep k₃ - refine WP.seq ?_ - refine digest_ok hp h₃ fun s₄ h₄ g₄ f₄ m₄ => ?_ - refine load_ok hp h₄ (o := 96) (by omega) fun s₅ k₅ e₅ => ?_ - refine atBlock_ok (h₄.keep k₅) fun s₆ k₆ m₆ x1₆ => ?_ - have h₆ := (h₄.keep k₅).keep k₆ - have f₃₄ : Frame (bodyR s₀) s.mem s₄.mem := - (frame_body ((k₁.trans k₂).trans k₃).frame (by simp)).trans (frame_body f₄ (by simp)) - refine WP.seq (cmp_ok hp h₆ x1₆ fun s₇ k₇ e₇ => ?_) - have hX : bytesAt s₅.mem (blkA s₀) 32 = Pbkdf2.digest (stateAt s₃.mem (tA s₀)) := by - rw [frame_bytesAt (p := blkA s₀) (n := 32) k₅.frame (blk_disj hp) (by omega), m₄, digest_self] - rw [m₆, e₅, blockAt_eq (hpad (f₃₄.trans (frame_body k₅.frame (by simp)))), hX, e₃] at e₇ - -- The digest, `T ← T ⊕ U` and the count. - have h₇ := h₆.keep k₇ - refine digest_ok hp h₇ fun s₈ h₈ g₈ f₈ m₈ => ?_ - refine xor_ok (p3 := scr s₀) (by omega) 8 (Nat.le_refl _) _ s₈ _ h₈.r3 - (fun j hj => InRegions.right (by rw [add_ofNat]; exact in_scr hp h₈.wr (a := 192 + 4 * j) (n := 4) (by omega))) - (fun j hj => by rw [add_ofNat]; exact in_scr hp h₈.wr (a := 160 + 4 * j) (n := 4) (by omega)) - fun s₉ g₉ rd₉ wr₉ sp₉ m₉ => ?_ - rw [show 4 * 8 = 32 from rfl] at m₉ - have f₉ : Frame [sR s₀ 160 32] s₈.mem s₉.mem := by - rw [m₉] - exact writeBytes_frame _ _ _ (contains_base (by rw [xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length])) - have h₉ := h₈.write (fun r hr => g₉ r (by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl <;> decide) (by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl <;> decide)) rd₉ wr₉ sp₉ (R := scR s₀) (by simp) - (f₉.sub fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - subst hr; exact ⟨scR s₀, by simp, scr_sub s₀ (by omega)⟩) - refine wp_subs (op2_imm (by decide)) fun s₁₀ u₁₀ z₁₀ => WP.block_nil ?_ - have h₁₀ := h₉.write (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 | rfl <;> decide)) u₁₀.rd u₁₀.wr u₁₀.sp (R := tR s₀) (by simp) - (by rw [u₁₀.mem]; exact Frame.refl _ _) - have x5 : s₉.gpr .r5 = BitVec.ofNat 32 (r + 1) := by - rw [g₉ _ (by decide) (by decide), g₈ _ (by decide), k₇.gpr _ (by simp [kept]), k₆.gpr _ (by simp [kept]), - k₅.gpr _ (by simp [kept]), g₄ _ (by decide), k₃.gpr _ (by simp [kept]), k₂.gpr _ (by simp [kept]), - k₁.gpr _ (by simp [kept]), h.r5] - have hlt : r + 1 < 2 ^ 32 := by have := h.le; have := (s₀.gpr .r2).isLt; simp only [nn] at *; omega - have e₁₀ : s₉.gpr .r5 - 1 = BitVec.ofNat 32 r := by - rw [x5, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat (by omega), Nat.add_sub_cancel] - have fb : Frame (bodyR s₀) s.mem s₁₀.mem := by - rw [u₁₀.mem] - exact f₃₄.trans (frame_body ((k₅.trans k₆).trans k₇).frame (by simp)) |>.trans (frame_body f₈ (by simp)) - |>.trans (frame_body f₉ (by simp)) - have f₈' : Frame [tR s₀, cmpR s₀, sR s₀ 192 32] s.mem s₈.mem := - (((k₁.trans k₂).trans k₃).frame.mono (by simp)) |>.trans (f₄.mono (by simp)) - |>.trans ((((k₅.trans k₆).trans k₇).frame).mono (by simp)) |>.trans (f₈.mono (by simp)) - have hT : bytesAt s₈.mem (TA s₀) 32 = bytesAt s.mem (TA s₀) 32 := - frame_bytesAt f₈' (T_disj hp) (by omega) - have hU₈ : bytesAt s₈.mem (blkA s₀) 32 = stepM s₀ (bytesAt s.mem (blkA s₀) 32) := by - rw [m₈, digest_self, e₇]; rfl - have hsep : Mem.Sep (blkA s₀) 32 (TA s₀) - (Spec.Pbkdf2.xorBytes (bytesAt s₈.mem (TA s₀) 32) (bytesAt s₈.mem (blkA s₀) 32)).length := by - rw [xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length] - exact Region.Disjoint.sep (scr_disj s₀ (a := 192) (m := 32) (b := 160) (n := 32) (by omega) (by omega) - (by omega)) (contains_base (Nat.le_refl _)) (contains_base (Nat.le_refl _)) - have hU₁₀ : bytesAt s₁₀.mem (blkA s₀) 32 = stepM s₀ (bytesAt s.mem (blkA s₀) 32) := by - rw [u₁₀.mem, m₉, bytesAt_writeBytes_sep _ _ hsep (by omega), hU₈] - have hT₁₀ : bytesAt s₁₀.mem (TA s₀) 32 = - Spec.Pbkdf2.xorBytes (bytesAt s.mem (TA s₀) 32) (stepM s₀ (bytesAt s.mem (blkA s₀) 32)) := by - have := bytesAt_writeBytes_self s₈.mem (TA s₀) - (Spec.Pbkdf2.xorBytes (bytesAt s₈.mem (TA s₀) 32) (bytesAt s₈.mem (blkA s₀) 32)) - (by rw [xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length]; omega) - rw [xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length] at this - rw [u₁₀.mem, m₉, this, hT, hU₈] - have hle : r ≤ nn s₀ := by have := h.le; omega - refine ⟨?_, { h₁₀ with r5 := ?_, saved := h.saved.frame hp fb, pad := ?_, le := hle, val := ?_ }⟩ - · rw [eval_ne, z₁₀, e₁₀, ofNat_beq_zero (by omega)] - cases r <;> rfl - · rw [u₁₀.gpr, e₁₀] - · rw [← h.pad] - exact frame_bytesAt fb (body_disj hp (o := 224) (n := 32) (.inr (Nat.le_refl _)) (by omega)) (by omega) - · rw [h.val, hU₁₀, hT₁₀]; rfl - -theorem loop_ok {s₀ : State} (hp : Pre s₀) {n : Nat} {s : State} (h : Inv s₀ n s) (hz : s.z = decide (n = 0)) : - WP isa (.ite .eq (.block []) (.loop body .ne)) s (Inv s₀ 0) := by - refine WP.ite (decide (n = 0)) (by show VG.Arm.eval .eq s = _; rw [eval_eq, hz]) (fun hb => ?_) (fun hb => ?_) - · obtain rfl : n = 0 := by simpa using hb - exact WP.block_nil h - · obtain ⟨m, rfl⟩ : ∃ m, n = m + 1 := ⟨n - 1, by simp at hb; omega⟩ - refine WP.loop (fun m s => Inv s₀ (m + 1) s) (fun m s hs => WP.mono (body_ok hp hs) fun s' ⟨he, hi⟩ => ?_) m s h - cases m with - | zero => exact .inl ⟨he, hi⟩ - | succ m => exact .inr ⟨he, m, by omega, hi⟩ - -end VG.Proof.Pbkdf2.Arm - -/-! -# PBKDF2-HMAC-SHA-256's iteration on ARMv7 - -The prologue, the epilogue, and `Verified`. Constant time is proven by the -taint analysis: `t` (in `r0` around the calls) and the scratch space (in `r3`) -are the bases of the two writable regions, so the registers -`vg_sha256_compress` saves in its scratch space and restores are known to keep -their public values. --/ - -namespace VG.Proof.Pbkdf2.Arm - -open VG VG.Arm VG.Impl.Pbkdf2.Arm -open VG.Impl.Sha256.Arm.Stream (saved restore save) -open VG.Impl.Hmac.Arm (cp) -open VG.Proof.Sha256.Arm (contains_offset) -open VG.Proof.MdStream.Arm (Upd Mupd Fupd wp_mov wp_str wp_ldrSp wp_cmp op2_imm op2_reg saveMem) -open VG.Proof.Sha256.Arm.Stream (save_ok restore_ok saveMem_saved saveMem_frame saved_bound) -open VG.Proof.MdStream.Arm (addr_toNat) -open VG.Proof.Hmac.Arm (copy_ok) -open VG.Proof.Hmac.Arm.Init (beq_zero_toNat) -open VG.Proof.Hmac.Common (bytesAt_length bytesAt_writeBytes_self bytesAt_writeBytes_sep) -open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame writeBytes_nil) -open VG.Proof.Pbkdf2.Memory (frame_bytesAt contains_base writeW_bytes writeBytes_append' iterate_congr - add_ofNat) -open VG.Spec.Sha256 (bytesAt stateAt Repr) -open VG.Spec.Hmac (xorPad ipad opad hmacBlockKey sha256) - -/-! ## The padding -/ - -/-- A word stored right after bytes written before. -/ -theorem writeW_append (m : Mem) (q : Addr) (xs ys : List Byte) (v : BitVec 32) {a : Addr} - (ha : a = q + BitVec.ofNat 64 xs.length) - (hv : ((List.range (32 / 8)).map fun j => (v.setWidth (8 * (32 / 8))).extractLsb' (8 * j) 8) = ys) - (hl : xs.length + ys.length < 2 ^ 64) : - (writeBytes m q xs).writeW a v = writeBytes m q (xs ++ ys) := by - rw [writeW_bytes _ _ v ys hv, writeBytes_append' _ _ _ ha hl] - -/-- A store of `r12` at `[r3, #d]`, within the scratch space. -/ -theorem str_ok {s₀ : State} (hp : Pre s₀) {s : State} (h3 : s.gpr .r3 = scr s₀) (hwr : s.wr = s₀.wr) - {d : Nat} (hd : d + 4 ≤ 384) {rest : List Instr} {Q : State → Prop} - (k : ∀ s', Mupd s s' (s.mem.writeW (scA s₀ + BitVec.ofNat 64 d) (s.gpr .r12)) → WP isa (.block rest) s' Q) : - WP isa (.block (.str .r12 .r3 d :: rest)) s Q := - wp_str (by omega) (by rw [h3]; exact scr_add hp (by omega)) (in_scr hp hwr hd) k - -/-- The padding into `scratch[224..256)`. -/ -theorem padding_ok {s₀ : State} (hp : Pre s₀) {s : State} (h3 : s.gpr .r3 = scr s₀) (hwr : s.wr = s₀.wr) - {rest : List Instr} {Q : State → Prop} - (k : ∀ 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 (scA s₀ + BitVec.ofNat 64 224) pad96 → WP isa (.block rest) s' Q) : - WP isa (.block (padding ++ rest)) s Q := by - simp only [padding, List.cons_append, List.nil_append] - let P := scA s₀ + BitVec.ofNat 64 224 - refine wp_mov (op2_imm (by decide)) fun s₁ u₁ => ?_ - have c₁ : s₁.gpr .r3 = scr s₀ := by rw [u₁.other _ (by decide), h3] - refine str_ok hp c₁ (u₁.wr.trans hwr) (d := 224) (by omega) fun s₂ g₂ => ?_ - refine wp_mov (op2_imm (by decide)) fun s₃ u₃ => ?_ - have c₃ : s₃.gpr .r3 = scr s₀ := by rw [u₃.other _ (by decide), g₂.gpr, c₁] - have w₃ : s₃.wr = s₀.wr := by rw [u₃.wr, g₂.wr, u₁.wr, hwr] - have z₃ : s₃.gpr .r12 = 0 := u₃.gpr - refine str_ok hp c₃ w₃ (d := 228) (by omega) fun s₄ g₄ => ?_ - refine str_ok hp (by rw [g₄.gpr, c₃]) (by rw [g₄.wr, w₃]) (d := 232) (by omega) fun s₅ g₅ => ?_ - refine str_ok hp (by rw [g₅.gpr, g₄.gpr, c₃]) (by rw [g₅.wr, g₄.wr, w₃]) (d := 236) (by omega) fun s₆ g₆ => ?_ - refine str_ok hp (by rw [g₆.gpr, g₅.gpr, g₄.gpr, c₃]) (by rw [g₆.wr, g₅.wr, g₄.wr, w₃]) (d := 240) (by omega) - fun s₇ g₇ => ?_ - refine str_ok hp (by rw [g₇.gpr, g₆.gpr, g₅.gpr, g₄.gpr, c₃]) (by rw [g₇.wr, g₆.wr, g₅.wr, g₄.wr, w₃]) - (d := 244) (by omega) fun s₈ g₈ => ?_ - refine str_ok hp (by rw [g₈.gpr, g₇.gpr, g₆.gpr, g₅.gpr, g₄.gpr, c₃]) - (by rw [g₈.wr, g₇.wr, g₆.wr, g₅.wr, g₄.wr, w₃]) (d := 248) (by omega) fun s₉ g₉ => ?_ - refine wp_mov (op2_imm (by decide)) fun s₁₀ u₁₀ => ?_ - refine str_ok hp (by rw [u₁₀.other _ (by decide), g₉.gpr, g₈.gpr, g₇.gpr, g₆.gpr, g₅.gpr, g₄.gpr, c₃]) - (by rw [u₁₀.wr, g₉.wr, g₈.wr, g₇.wr, g₆.wr, g₅.wr, g₄.wr, w₃]) (d := 252) (by omega) fun s₁₁ g₁₁ => ?_ - have G : ∀ r, r ≠ .r12 → s₁₁.gpr r = s.gpr r := fun r hr => by - rw [g₁₁.gpr, u₁₀.other r hr, g₉.gpr, g₈.gpr, g₇.gpr, g₆.gpr, g₅.gpr, g₄.gpr, u₃.other r hr, g₂.gpr, - u₁.other r hr] - refine k s₁₁ G (by rw [g₁₁.rd, u₁₀.rd, g₉.rd, g₈.rd, g₇.rd, g₆.rd, g₅.rd, g₄.rd, u₃.rd, g₂.rd, u₁.rd]) - (by rw [g₁₁.wr, u₁₀.wr, g₉.wr, g₈.wr, g₇.wr, g₆.wr, g₅.wr, g₄.wr, u₃.wr, g₂.wr, u₁.wr]) - (by rw [g₁₁.sp, u₁₀.sp, g₉.sp, g₈.sp, g₇.sp, g₆.sp, g₅.sp, g₄.sp, u₃.sp, g₂.sp, u₁.sp]) ?_ - have e : ∀ o : Nat, scA s₀ + BitVec.ofNat 64 (224 + o) = P + BitVec.ofNat 64 o := fun o => (add_ofNat _ _ _).symm - have e₂ : s₂.mem = writeBytes s.mem P ([] ++ [0x80, 0, 0, 0]) := by - rw [g₂.mem, u₁.gpr, u₁.mem, ← writeBytes_nil s.mem P] - exact writeW_append _ _ _ _ _ (by simp [P]) (by decide) (by decide) - have e₄ : s₄.mem = writeBytes s.mem P ([0x80, 0, 0, 0] ++ [0, 0, 0, 0]) := by - rw [g₄.mem, z₃, u₃.mem, e₂]; exact writeW_append _ _ _ _ _ (e 4) (by decide) (by decide) - have e₅ : s₅.mem = writeBytes s.mem P ([0x80, 0, 0, 0, 0, 0, 0, 0] ++ [0, 0, 0, 0]) := by - rw [g₅.mem, g₄.gpr, z₃, e₄]; exact writeW_append _ _ _ _ _ (e 8) (by decide) (by decide) - have e₆ : s₆.mem = writeBytes s.mem P ([0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] ++ [0, 0, 0, 0]) := by - rw [g₆.mem, g₅.gpr, g₄.gpr, z₃, e₅]; exact writeW_append _ _ _ _ _ (e 12) (by decide) (by decide) - have e₇ : s₇.mem = writeBytes s.mem P ([0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] ++ [0, 0, 0, 0]) := by - rw [g₇.mem, g₆.gpr, g₅.gpr, g₄.gpr, z₃, e₆]; exact writeW_append _ _ _ _ _ (e 16) (by decide) (by decide) - have e₈ : s₈.mem = writeBytes s.mem P - ([0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] ++ [0, 0, 0, 0]) := by - rw [g₈.mem, g₇.gpr, g₆.gpr, g₅.gpr, g₄.gpr, z₃, e₇] - exact writeW_append _ _ _ _ _ (e 20) (by decide) (by decide) - have e₉ : s₉.mem = writeBytes s.mem P - ([0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] ++ [0, 0, 0, 0]) := by - rw [g₉.mem, g₈.gpr, g₇.gpr, g₆.gpr, g₅.gpr, g₄.gpr, z₃, e₈] - exact writeW_append _ _ _ _ _ (e 24) (by decide) (by decide) - rw [g₁₁.mem, u₁₀.gpr, u₁₀.mem, e₉] - exact writeW_append _ _ _ _ _ (e 28) (by decide) (by decide) - -/-! ## The prologue -/ - -theorem ofNat_toNat32 (x : BitVec 32) : BitVec.ofNat 32 x.toNat = x := by simp - -theorem prologue_ok {s₀ : State} (hp : Pre s₀) : - WP isa (.block prologue) s₀ (fun s => Inv s₀ (nn s₀) s ∧ s.z = decide (nn s₀ = 0)) := by - have := hp.scr_fit; have := hp.t_fit; have := hp.u_fit - unfold prologue - simp only [List.append_assoc, List.cons_append, List.nil_append] - refine wp_ldrSp (a := stackArgAddr s₀ 0) (by decide) rfl ⟨argR s₀, by simp [hp.rd], Region.contains_self _ _⟩ - fun s₁ u₁ => ?_ - have h12 : s₁.gpr .r12 = scr s₀ := u₁.gpr - refine save_ok (b := .r12) (by rw [h12]; omega) (fun d _ hd₂ => by - rw [h12, u₁.wr]; exact in_scr hp rfl (by omega)) fun s₂ g₂ rd₂ wr₂ sp₂ m₂ => ?_ - 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₆ => ?_ - have G : ∀ r, r ≠ .r12 → s₂.gpr r = s₀.gpr r := fun r h => by rw [g₂, u₁.other r h] - have rd₆ : s₆.rd = s₀.rd := by rw [u₆.rd, u₅.rd, u₄.rd, u₃.rd, rd₂, u₁.rd] - have wr₆ : s₆.wr = s₀.wr := by rw [u₆.wr, u₅.wr, u₄.wr, u₃.wr, wr₂, u₁.wr] - have sp₆ : s₆.sp = s₀.sp := by rw [u₆.sp, u₅.sp, u₄.sp, u₃.sp, sp₂, u₁.sp] - have M₆ : s₆.mem = saveMem s₀.mem (scA s₀) s₁.gpr saved := by - rw [u₆.mem, u₅.mem, u₄.mem, u₃.mem, m₂, h12, u₁.mem] - have r0₆ : s₆.gpr .r0 = tP s₀ := by - rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, u₃.other _ (by decide), G _ (by decide)] - have r1₆ : s₆.gpr .r1 = uP s₀ := by - rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), - G _ (by decide)] - have r3₆ : s₆.gpr .r3 = scr s₀ := by - rw [u₆.other _ (by decide), u₅.gpr, u₄.other _ (by decide), u₃.other _ (by decide), g₂, h12] - have r4₆ : s₆.gpr .r4 = key s₀ := by - rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, G _ (by decide)] - have r5₆ : s₆.gpr .r5 = s₀.gpr .r2 := by - rw [u₆.gpr, u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), G _ (by decide)] - have F₆ : Frame [⟨scA s₀, 160⟩] s₀.mem s₆.mem := by - rw [M₆]; exact saveMem_frame _ _ _ saved fun p hp' => (saved_bound p hp').1 - have sc160 : ∀ r ∈ [(⟨scA s₀, 160⟩ : Region)], r ∈ [tR s₀, scR s₀] ∨ Region.Sub r (scR s₀) := - fun r hr => by simp only [List.mem_singleton] at hr; subst hr; exact .inr (Region.sub_prefix (by omega)) - -- `U` into the block. - refine copy_ok (t := .r12) (src := .r1) (dst := .r3) (by decide) (by decide) 0 192 8 ⟨by omega, by omega⟩ _ s₆ _ - (by rw [r1₆]; omega) (by rw [r3₆]; omega) - (fun j hj => by - rw [r1₆, rd₆, wr₆, add_ofNat] - exact ⟨uR s₀, by simp [hp.rd], contains_offset (by omega) (by omega)⟩) - (fun j hj => by rw [r3₆, wr₆, add_ofNat]; exact in_scr hp rfl (by omega)) ?_ - fun s₇ g₇ rd₇ wr₇ sp₇ m₇ => ?_ - · rw [r1₆, r3₆] - exact Region.Disjoint.sep hp.u_s (contains_offset (by omega) (by omega)) (contains_offset (by omega) (by omega)) - -- `T` into the scratch space. - refine copy_ok (t := .r12) (src := .r0) (dst := .r3) (by decide) (by decide) 0 160 8 ⟨by omega, by omega⟩ _ s₇ _ - (by rw [g₇ _ (by decide), r0₆]; omega) (by rw [g₇ _ (by decide), r3₆]; omega) - (fun j hj => by - rw [g₇ _ (by decide), r0₆, rd₇, wr₇, wr₆, add_ofNat] - exact InRegions.right (in_t hp rfl (by omega))) - (fun j hj => by rw [g₇ _ (by decide), r3₆, wr₇, wr₆, add_ofNat]; exact in_scr hp rfl (by omega)) ?_ - fun s₈ g₈ rd₈ wr₈ sp₈ m₈ => ?_ - · rw [g₇ _ (by decide), g₇ _ (by decide), r0₆, r3₆] - exact Region.Disjoint.sep hp.t_s (contains_offset (by omega) (by omega)) (contains_offset (by omega) (by omega)) - refine padding_ok hp (by rw [g₈ _ (by decide), g₇ _ (by decide), r3₆]) (by rw [wr₈, wr₇, wr₆]) - fun s₉ g₉ rd₉ wr₉ sp₉ m₉ => ?_ - refine wp_cmp (op2_imm (by decide)) fun s₁₀ f₁₀ z₁₀ => WP.block_nil ?_ - have G₁₀ : ∀ r, r ≠ .r12 → s₁₀.gpr r = s₆.gpr r := fun r h => by rw [f₁₀.gpr, g₉ r h, g₈ r h, g₇ r h] - simp only [g₇ _ (show Reg.r0 ≠ .r12 by decide), g₇ _ (show Reg.r3 ≠ .r12 by decide), r1₆, r0₆, r3₆, - ofNat_zero] at m₇ m₈ - rw [show 4 * 8 = 32 from rfl] at m₇ m₈ - have hm : s₁₀.mem = writeBytes (writeBytes (writeBytes s₆.mem (blkA s₀) (bytesAt s₆.mem (uA s₀) 32)) - (TA s₀) (bytesAt s₇.mem (tA s₀) 32)) (scA s₀ + BitVec.ofNat 64 224) pad96 := by - rw [f₁₀.mem, m₉, m₈, m₇] - have fU : Frame [sR s₀ 192 32, sR s₀ 160 32, sR s₀ 224 32] s₆.mem s₁₀.mem := by - rw [hm] - exact (((writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact contains_base (Nat.le_refl _))).mono (by simp)).trans - ((writeBytes_frame _ _ _ (R := sR s₀ 160 32) (by rw [bytesAt_length]; exact contains_base (Nat.le_refl _))).mono - (by simp))).trans - ((writeBytes_frame _ _ _ (R := sR s₀ 224 32) (contains_base (by decide))).mono (by simp)) - have F' : Frame [scR s₀] s₀.mem s₁₀.mem := - (F₆.sub fun r hr => by - simp only [List.mem_singleton] at hr; subst hr; exact ⟨scR s₀, by simp, Region.sub_prefix (by omega)⟩).trans - (fU.sub fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl <;> exact ⟨scR s₀, by simp, scr_sub s₀ (by omega)⟩) - have s160 : Region.Sub ⟨scA s₀, 160⟩ (scR s₀) := Region.sub_prefix (by omega) - have hU₆ : bytesAt s₆.mem (uA s₀) 32 = bytesAt s₀.mem (uA s₀) 32 := - frame_bytesAt F₆ (by simpa using hp.u_s.sub_right s160) (by omega) - have hT₇ : bytesAt s₇.mem (tA s₀) 32 = bytesAt s₀.mem (tA s₀) 32 := by - rw [m₇, bytesAt_writeBytes_sep _ _ (Region.Disjoint.sep (hp.t_s.sub_right (scr_sub s₀ (o := 192) (n := 32) - (by omega))) (contains_base (Nat.le_refl _)) (by rw [bytesAt_length]; exact contains_base (Nat.le_refl _))) (by omega)] - exact frame_bytesAt F₆ (by simpa using hp.t_s.sub_right s160) (by omega) - have sep : ∀ {a b : Nat}, a + 32 ≤ b ∨ b + 32 ≤ a → a + 32 ≤ 384 → b + 32 ≤ 384 → ∀ xs : List Byte, - xs.length = 32 → Mem.Sep (scA s₀ + BitVec.ofNat 64 a) 32 (scA s₀ + BitVec.ofNat 64 b) xs.length := - fun h ha hb xs hx => Region.Disjoint.sep (scr_disj s₀ h ha hb) (contains_base (Nat.le_refl _)) - (by rw [hx]; exact contains_base (Nat.le_refl _)) - have hB : bytesAt s₁₀.mem (blkA s₀) 32 = bytesAt s₀.mem (uA s₀) 32 := by - rw [hm, bytesAt_writeBytes_sep _ _ (sep (a := 192) (b := 224) (by omega) (by omega) (by omega) _ rfl) (by omega), - bytesAt_writeBytes_sep _ _ (sep (a := 192) (b := 160) (by omega) (by omega) (by omega) _ (bytesAt_length _ _ _)) - (by omega)] - have := bytesAt_writeBytes_self s₆.mem (blkA s₀) (bytesAt s₆.mem (uA s₀) 32) (by rw [bytesAt_length]; omega) - rw [bytesAt_length] at this - rw [this, hU₆] - have hT : bytesAt s₁₀.mem (TA s₀) 32 = bytesAt s₀.mem (tA s₀) 32 := by - rw [hm, bytesAt_writeBytes_sep _ _ (sep (a := 160) (b := 224) (by omega) (by omega) (by omega) _ rfl) (by omega)] - have := bytesAt_writeBytes_self (writeBytes s₆.mem (blkA s₀) (bytesAt s₆.mem (uA s₀) 32)) (TA s₀) - (bytesAt s₇.mem (tA s₀) 32) (by rw [bytesAt_length]; omega) - rw [bytesAt_length] at this - rw [this, hT₇] - have hS : ∀ p ∈ saved, s₁₀.mem.readW (scA s₀ + BitVec.ofNat 64 p.2) 32 = s₀.gpr p.1 := by - intro p hp' - have hb := saved_bound p hp' - rw [fU.readW (r := sR s₀ p.2 4) (Region.contains_self _ _) ?_ (by decide), M₆, - saveMem_saved _ _ _ p hp', u₁.other] - · simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> decide - · intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl <;> exact scr_disj s₀ (by omega) (by omega) (by omega) - refine ⟨⟨⟨by rw [f₁₀.rd, rd₉, rd₈, rd₇, rd₆], by rw [f₁₀.wr, wr₉, wr₈, wr₇, wr₆], - by rw [f₁₀.sp, sp₉, sp₈, sp₇, sp₆], by rw [G₁₀ _ (by decide), r0₆], by rw [G₁₀ _ (by decide), r3₆], - by rw [G₁₀ _ (by decide), r4₆], F'.mono (by simp)⟩, by rw [G₁₀ _ (by decide), r5₆, ofNat_toNat32], hS, ?_, - (Nat.le_refl _), by rw [hB, hT]⟩, ?_⟩ - · rw [hm] - exact bytesAt_writeBytes_self _ (scA s₀ + BitVec.ofNat 64 224) pad96 (by decide) - · rw [z₁₀, g₉ _ (by decide), g₈ _ (by decide), g₇ _ (by decide), r5₆, beq_zero_toNat] - -/-! ## The epilogue -/ - -/-- The postcondition. -/ -def Post (s₀ s' : State) : Prop := abiPreserved s₀ s' ∧ Proof.Pbkdf2.iterateSha256Arm.post s₀ s' - -/-- With the key's streaming states as the contract requires, a step is HMAC-SHA-256. -/ -theorem stepM_eq {s₀ : State} {k0 : List Byte} (hk : k0.length = 64) - (hi : Repr s₀.mem (kA s₀) (xorPad k0 ipad)) (ho : Repr s₀.mem (kA s₀ + 96) (xorPad k0 opad)) - {u : List Byte} (hu : u.length = 32) : - hmacBlockKey sha256 k0 u = stepM s₀ u := by - have li : (xorPad k0 ipad).length = 64 := by simp [xorPad, hk] - have lo : (xorPad k0 opad).length = 64 := by simp [xorPad, hk] - have ho1 : stateAt s₀.mem (kA s₀ + BitVec.ofNat 64 96) = _ := ho.1 - rw [hmac_step hk hu, stepM, Hi, Ho, ofNat_zero, hi.1, ho1, li, lo] - -theorem epilogue_ok {s₀ : State} (hp : Pre s₀) {s : State} (h : Inv s₀ 0 s) : - WP isa (.block epilogue) s (Post s₀) := by - have := hp.scr_fit; have := hp.t_fit - unfold epilogue - refine copy_ok (t := .r12) (src := .r3) (dst := .r0) (by decide) (by decide) 160 0 8 ⟨by omega, by omega⟩ _ s _ - (by rw [h.r3]; omega) (by rw [h.r0]; omega) - (fun j hj => by rw [h.r3, add_ofNat]; exact InRegions.right (in_scr hp h.wr (by omega))) - (fun j hj => by rw [h.r0, add_ofNat]; exact in_t hp h.wr (by omega)) ?_ fun s₁ g₁ rd₁ wr₁ sp₁ m₁ => ?_ - · rw [h.r3, h.r0] - exact Region.Disjoint.sep hp.t_s.symm (contains_offset (by omega) (by omega)) (contains_offset (by omega) (by omega)) - simp only [h.r3, h.r0, ofNat_zero] at m₁ - rw [show 4 * 8 = 32 from rfl] at m₁ - have fT : Frame [tR s₀] s.mem s₁.mem := by - rw [m₁]; exact writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact contains_base (Nat.le_refl _)) - refine restore_ok (scr := scr s₀) (by rw [g₁ _ (by decide), h.r3]) (by omega) - (fun d _ hd₂ => by rw [rd₁, wr₁]; exact InRegions.right (in_scr hp h.wr (by omega))) s₀.gpr - (fun p hp' => ?_) fun s' hs _ hmem _ _ hsp => ⟨⟨fun r hr => ?_, by rw [hsp, sp₁, h.sp]⟩, fun k0 hk hi ho => ?_⟩ - · rw [← h.saved p hp'] - have hb := saved_bound p hp' - exact fT.readW (r := sR s₀ p.2 4) (Region.contains_self _ _) - (by simpa using (hp.t_s.sub_right (scr_sub s₀ (o := p.2) (n := 4) (by omega))).symm) (by decide) - · simp only [preserved, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl - · exact hs (.r4, 112) (by simp [saved]) - · exact hs (.r5, 116) (by simp [saved]) - · exact hs (.r6, 120) (by simp [saved]) - · exact hs (.r7, 124) (by simp [saved]) - · exact hs (.r8, 128) (by simp [saved]) - · exact hs (.r9, 132) (by simp [saved]) - · exact hs (.r10, 136) (by simp [saved]) - · exact hs (.r11, 140) (by simp [saved]) - · exact hs (.lr, 144) (by simp [saved]) - · have := h.val - simp only [Spec.Pbkdf2.iterate] at this - have e : bytesAt s'.mem (tA s₀) 32 = bytesAt s.mem (TA s₀) 32 := by - have := bytesAt_writeBytes_self s.mem (tA s₀) (bytesAt s.mem (TA s₀) 32) (by rw [bytesAt_length]; omega) - rw [bytesAt_length] at this - rw [hmem, m₁, this] - show bytesAt s'.mem (tA s₀) 32 = _ - rw [e, ← this] - exact (iterate_congr (fun u hu => stepM_eq hk hi ho hu) (fun u => Pbkdf2.digest_length _) _ _ _ - (bytesAt_length _ _ _)).symm - -/-! ## Correctness -/ - -theorem correct {s₀ : State} (hp : Pre s₀) : WP isa iterate s₀ (Post s₀) := by - unfold iterate - refine WP.seq (WP.mono (prologue_ok hp) fun s₁ ⟨h₁, z₁⟩ => ?_) - exact WP.seq (WP.mono (loop_ok hp h₁ z₁) fun s₂ h₂ => epilogue_ok hp h₂) - -/-! ## `Verified` -/ - -/-- The initial taint: `r0`–`r3` (`key`, `u`, `n`, `t`) are public, `r3` -points at `t`, and the 4 bytes of stack arguments are public, pointing at -the scratch space. -/ -def τ₀ : VG.Arm.Taint.T := - { regs := .ofList [.r0, .r1, .r2, .r3], flags := false, lens := [32, 384], bases := [(.r3, 0)], - argLen := 4, argBases := [(0, 1)] } - -theorem wf₀ {s : State} (h : Proof.Pbkdf2.iterateSha256Arm.pre s) : VG.Arm.Taint.Wf τ₀ s := by - have hp := pre_of h - have ht := hp.t_fit; have hsc := hp.scr_fit; have hs := hp.sp_fit - refine ⟨fun _ => ⟨by simp [hp.wr, τ₀], ?_, ?_⟩, ?_, fun _ => ⟨hs, ?_⟩, ?_⟩ - · simp only [hp.wr, List.pairwise_cons, List.mem_cons, List.not_mem_nil, or_false, forall_eq, - List.Pairwise.nil, and_true] - exact ⟨hp.t_s, fun _ h => h.elim⟩ - · simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) <;> simp only [addr_toNat] <;> omega - · intro p hp' - simp only [τ₀, List.mem_singleton] at hp' - subst hp'; simp [VG.Arm.Taint.region, hp.wr] - · have e : (⟨State.addr s.sp, 4⟩ : Region) = argR s := by simp [stackArgAddr] - simp only [τ₀, e, hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact hp.a_t - · exact hp.a_s - · intro p hp'; simp only [τ₀, List.mem_singleton] at hp'; subst hp' - refine ⟨by decide, ?_⟩ - simp only [VG.Arm.Taint.region, hp.wr] - rfl - -theorem argByte_eq (s : State) (k : Nat) : - VG.Arm.Taint.argByte s k = stackArgAddr s 0 + BitVec.ofNat 64 k := by - simp [VG.Arm.Taint.argByte, stackArgAddr] - -theorem agree₀ {s₁ s₂ : State} (h₁ : Proof.Pbkdf2.iterateSha256Arm.pre s₁) - (h₂ : Proof.Pbkdf2.iterateSha256Arm.pre s₂) (hpub : Proof.Pbkdf2.iterateSha256Arm.pub s₁ s₂) : - VG.Arm.Taint.Agree τ₀ s₁ s₂ := by - obtain ⟨psp, p0, p1, p2, p3, a0⟩ := hpub - have hp₁ := pre_of h₁; have hp₂ := pre_of h₂ - refine ⟨⟨fun r hr => ?_, fun h => nomatch h⟩, fun _ => ?_, wf₀ h₁, wf₀ h₂, - fun _ h => (List.not_mem_nil h).elim, fun _ h => (List.not_mem_nil h).elim, fun _ => psp, fun k hk => ?_⟩ - · simp only [τ₀, RegSet.mem_ofList, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl <;> with_reducible assumption - · rw [hp₁.wr, hp₂.wr]; simp only [tR, scR, tA, scA, tP, scr, p3, a0] - · simp only [τ₀] at hk - rw [argByte_eq, argByte_eq, Mem.readW_byte s₁.mem _ hk, Mem.readW_byte s₂.mem _ hk] - exact congrArg _ a0 - -/-- A state satisfying the precondition: `key` at `0x1000`, `u` at `0x2000`, -`t` at `0x3000` and the scratch space at `0x4000`, passed on the stack at -`0x5000`. -/ -def sat : State where - gpr r := match r with - | .r0 => 0x1000 | .r1 => 0x2000 | .r3 => 0x3000 | _ => 0 - sp := 0x5000 - n := false - z := false - c := false - v := false - mem a := if a = 0x5001 then 0x40 else 0 - rd := [⟨0x1000, 192⟩, ⟨0x2000, 32⟩, ⟨0x5000, 4⟩] - wr := [⟨0x3000, 32⟩, ⟨0x4000, 384⟩] - -theorem iterate_correct (s : State) (hs : Proof.Pbkdf2.iterateSha256Arm.pre s) : - ∃ t s', Exec isa iterate s t s' ∧ abiPreserved s s' ∧ Proof.Pbkdf2.iterateSha256Arm.post s s' := - by - obtain ⟨t, s', he, h⟩ := correct (pre_of hs) - exact ⟨t, s', he, h⟩ - -theorem iterate_ct : ConstantTime isa Proof.Pbkdf2.iterateSha256Arm.pre - Proof.Pbkdf2.iterateSha256Arm.pub iterate := by - exact VG.Taint.constantTime (A := taint) τ₀ (fun _ _ h₁ h₂ hp => agree₀ h₁ h₂ hp) - (by taint_decide) - -/-- `iterateSha256Arm` with the 832 bytes of scratch of the shared contract -(sized for the x86-64 AVX2 compression function), of which the code uses 384. -/ -def iterateWide : Contract isa := - { Proof.Pbkdf2.iterateSha256Arm with - pre := fun s => - let key : Region := ⟨State.addr (s.gpr .r0), 192⟩ - let u : Region := ⟨State.addr (s.gpr .r1), 32⟩ - let t : Region := ⟨State.addr (s.gpr .r3), 32⟩ - let scratch : Region := ⟨State.addr (stackArg s 0), 832⟩ - let args : Region := ⟨stackArgAddr s 0, 4⟩ - s.rd = [key, u, args] ∧ s.wr = [t, scratch] ∧ - key.Disjoint t ∧ key.Disjoint scratch ∧ u.Disjoint t ∧ u.Disjoint scratch ∧ - t.Disjoint scratch ∧ args.Disjoint t ∧ args.Disjoint scratch ∧ - (s.gpr .r0).toNat + 192 ≤ 2 ^ 32 ∧ (s.gpr .r1).toNat + 32 ≤ 2 ^ 32 ∧ - (s.gpr .r3).toNat + 32 ≤ 2 ^ 32 ∧ (stackArg s 0).toNat + 832 ≤ 2 ^ 32 ∧ - s.sp.toNat + 4 ≤ 2 ^ 32 } - -/-- The regions `iterateSha256Arm` lets the code write. -/ -def narrowWr (s : State) : List Region := - [⟨State.addr (s.gpr .r3), 32⟩, ⟨State.addr (stackArg s 0), 384⟩] - -/-- Rewrites the contracts at a narrowed state (`stackArg` does not unfold -cheaply). -/ -local macro "narrow" loc:(Lean.Parser.Tactic.location)? : tactic => - `(tactic| simp only [Proof.Pbkdf2.iterateSha256Arm, VG.Proof.Pbkdf2.Arm.iterateWide, VG.Proof.Pbkdf2.Arm.narrowWr, VG.Arm.stackArg_withRegions, VG.Arm.stackArgAddr_withRegions, - VG.Arm.State.withRegions_gpr, VG.Arm.State.withRegions_sp, VG.Arm.State.withRegions_mem, - VG.Arm.State.withRegions_rd, VG.Arm.State.withRegions_wr] $(loc)?) - -theorem iterateWide_pre (s : State) (h : iterateWide.pre s) : - Proof.Pbkdf2.iterateSha256Arm.pre (s.withRegions s.rd (narrowWr s)) := by - obtain ⟨h₁, _, h₃, h₄, h₅, h₆, h₇, h₈, h₉, h₁₀, h₁₁, h₁₂, h₁₃, h₁₄⟩ := h - narrow - exact ⟨h₁, trivial, h₃, h₄.sub_right (Region.sub_of_ble rfl), h₅, - h₆.sub_right (Region.sub_of_ble rfl), h₇.sub_right (Region.sub_of_ble rfl), h₈, - h₉.sub_right (Region.sub_of_ble rfl), h₁₀, h₁₁, h₁₂, Region.end_le_of_ble rfl h₁₃, h₁₄⟩ - -/-- A state satisfying `iterateWide.pre`. -/ -def wideSat : State := { sat with wr := [⟨0x3000, 32⟩, ⟨0x4000, 832⟩] } - -theorem iterateWide_implies : iterateWide.Implies (Spec.Pbkdf2.iterateSha256Contract Arm.abi) := by - sig_implies [Spec.Pbkdf2.iterateSha256Contract, Spec.Pbkdf2.iterateSha256Sig, iterateWide, - Proof.Pbkdf2.iterateSha256Arm, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, - Arm.State.addr] [wideSat, sat, Arm.stackArg, Arm.stackArgAddr, Mem.readW, Mem.read] - using wideSat - -/-- The proof is written against `iterateSha256Arm`, widened to the shared -contract's scratch. -/ -theorem iterate_verified : - Verified Arm.target Impl.Pbkdf2.Arm.iterate (Spec.Pbkdf2.iterateSha256Contract Arm.abi) := - have hsat := iterateWide_implies.sat_left - (Verified.widen (Verified.of_correct iterate_correct iterate_ct - (.refl (hsat.elim fun s hs => ⟨_, iterateWide_pre s hs⟩))) - narrowWr iterateWide_pre - (fun _ h => by - obtain ⟨_, h₂, _⟩ := h - rw [h₂]; exact .cons (Region.prefix_of_ble rfl) (.cons (Region.prefix_of_ble rfl) .nil)) - (fun _ _ _ h => by narrow at h ⊢; exact h) - (fun _ _ _ _ h => by narrow; exact h) hsat).of_implies iterateWide_implies - -end VG.Proof.Pbkdf2.Arm diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Arm/Lit.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Arm/Lit.lean deleted file mode 100644 index fc5280a8b..000000000 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Arm/Lit.lean +++ /dev/null @@ -1,13 +0,0 @@ -import VerifiedGarbage.Proof.Framework.Arm.Lit -import VerifiedGarbage.Impl.Pbkdf2.Arm -import VerifiedGarbage.Proof.Hmac.Arm.Lit - -/-! -# PBKDF2-HMAC-SHA-256 on Arm: the code as literals --/ - -namespace VG - -materialize_code Impl.Pbkdf2.Arm.iterate - -end VG diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean index 4211c576f..462709158 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean @@ -18,7 +18,8 @@ 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-224 is in `Sha224.lean`. +are emitted with. SHA-256 and SHA-224 are in `Sha256.lean` and +`Sha224.lean`. -/ namespace VG.Proof.Pbkdf2.Md.Arm diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean index 6c2f78f9c..b50a9e592 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean @@ -1,18 +1,16 @@ -import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Sha256 import VerifiedGarbage.Proof.Hmac.Generic.Arm.Sha224 -import VerifiedGarbage.Proof.Sha256.Arm.Stream.Md -import VerifiedGarbage.Proof.Sha256.Arm.Lit /-! # 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; 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`). +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 @@ -33,10 +31,6 @@ def sha224Md : Hash where compN := "vg_sha256_compress" compC := Impl.Sha256.Arm.compress -theorem sha256_comp : CompOk Proof.Sha256.md 112 Impl.Sha256.Arm.compress := - ⟨Proof.Sha256.Arm.compress_verified.1, Proof.Sha256.Arm.compress_verified.2.1, by lit_decide, - by rw [← Code.allInstrs_eq]; lit_decide⟩ - def sha224MdOK : HashOK sha224Md where md := Proof.Sha256.md out := OutOk.ofShape Proof.Sha256.Arm.Stream.shape diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha256.lean new file mode 100644 index 000000000..841ce9a1b --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha256.lean @@ -0,0 +1,87 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.Arm.Instances +import VerifiedGarbage.Proof.Hmac.Generic.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 +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 +contracts of `Spec.Hmac.sha256I` (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 (sha256H sha256OK) + +/-- SHA-256: a 32-byte hash value, a big-endian length field and +`vg_sha256_compress`, with 112 bytes of scratch space. -/ +def sha256Md : Hash where + st := sha256H + N := 32 + L := 8 + be := true + so := 112 + out := Impl.Sha256.Arm.Stream.params.out + compN := "vg_sha256_compress" + compC := Impl.Sha256.Arm.compress + +theorem sha256_comp : CompOk Proof.Sha256.md 112 Impl.Sha256.Arm.compress := + ⟨Proof.Sha256.Arm.compress_verified.1, Proof.Sha256.Arm.compress_verified.2.1, by lit_decide, + by rw [← Code.allInstrs_eq]; lit_decide⟩ + +def sha256MdOK : HashOK sha256Md where + md := Proof.Sha256.md + out := OutOk.ofShape Proof.Sha256.Arm.Stream.shape + comp := sha256_comp + reloc m m' p q h := by + apply Vector.ext + intro j hj + simp only [Proof.Sha256.md, Spec.Sha256.stateAt, Vector.getElem_ofFn] + exact Hmac.Generic.Common.readW_reloc (n := 32) h (by omega) + len := by decide + stream := sha256OK + iv := Spec.Sha256.H0 + repr _ _ _ h := h + hash m := by + show Spec.Sha256.hash m = _ + rw [Proof.Sha256.hash_eq] + exact (List.take_of_length_le (Nat.le_of_eq (Proof.Sha256.md.digest_length _))).symm + 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⟩ + +end VG.Proof.Pbkdf2.Md.Arm + +namespace VG.Proof.Pbkdf2.Md.Arm.Instances + +open VG.Arm +open VG.Proof.Pbkdf2.Md.Arm +open VG.Proof.Hmac.Generic.Arm (iterG below) + +theorem sha256_iterChecks : Iterate.Checks sha256Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, + ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha256_finChecks : Fin.Checks sha256Md := + ⟨⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩, ⟨_, by taint_decide⟩⟩ + +theorem sha256_iterImp : (iterG Spec.Hmac.sha256S 104).Implies (Spec.Hmac.sha256I.iterateContract Arm.abi 16) := + iterImp Spec.Hmac.sha256S 104 (by + inst_sat [Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, Spec.Hmac.sha256S, Spec.Hmac.sha256, iterG, + below, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] using iterSat 96 32 104) + +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_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 + +end VG.Proof.Pbkdf2.Md.Arm.Instances diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean index b4c16b53c..d9805474f 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean @@ -13,7 +13,8 @@ compression functions and the code writing their digests proofs know of them (`MdOk`), from their own proofs: the `Md` of the generic streaming proofs (`Proof/Md5/Md.lean` and the others), the digests their code writes (`out512_ok` for the SHA-512 family), and their compression functions' -contracts, which are `cmpK`. +contracts, which are `cmpK`. SHA-256, whose compression function has a +variant for each backend on x86, is in `Sha256.lean`. -/ namespace VG.Proof.Pbkdf2.Md.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Sha256.lean new file mode 100644 index 000000000..8480a8413 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Sha256.lean @@ -0,0 +1,125 @@ +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Instances +import VerifiedGarbage.Proof.Hmac.Generic.X86.Sha256 + +/-! +# HMAC-SHA-256 and PBKDF2-HMAC-SHA-256 over the compression function on x86 (32-bit), for every backend + +SHA-256 as a `Hash` of `Impl/Pbkdf2/Md/X86.lean` with a backend's +compression function and streaming functions +(`Proof.Sha256.X86.Variants.mdHash`), what the proofs know of it (`sha256Ok`): +SHA-256's `Md` (`Proof/Sha256/Md.lean`) from `H0`, the digest its streaming +code writes (`Proof.Sha256.X86.Stream.shape`), and the backend's verified +compression function, whose contract is `cmpK`; and the generic proofs of +HMAC's `finalize` and PBKDF2's iteration (`HmacFinCT.lean`, `IterateCT.lean`) +at it, moved to the shared contracts of `Spec.Hmac.sha256I`. Their taint +checks depend only on the sizes, so they are evaluated once, for every +backend (`sha256Shape`). +-/ + +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.Sha256.X86.Variants (mdHash) + +/-- SHA-256 with the compression function `cmpN`/`cmpC` and the streaming +functions `v` calling it. -/ +abbrev sha256M (v : Sha256Stream) (cmpN : String) (cmpC : Prog isa) : Hash := + mdHash v.suffix cmpN cmpC v.upd v.fin + +/-- `MdOk` for SHA-256, for any backend: its streaming functions `v` and its +verified compression function `cmpC`. -/ +def sha256Ok (v : Sha256Stream) (cmpN : String) {cmpC : Prog isa} (hc : CompOk Proof.Sha256.md 112 cmpC) : + MdOk (sha256M v cmpN cmpC) where + hH := sha256OK v + md := Proof.Sha256.md + iv := Spec.Sha256.H0 + link := ⟨rfl, rfl, rfl, fun _ _ _ h => h, fun m => by + show Spec.Sha256.hash m = _ + 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⟩ + reloc m m' p q h := by + apply Vector.ext + intro j hj + simp only [Proof.Sha256.md, Spec.Sha256.stateAt, Vector.getElem_ofFn] + exact Hmac.Generic.Common.readW_reloc (n := 32) h (by omega) + tail := sha256_tail + out := outOk_of_shape Proof.Sha256.X86.Stream.shape + comp := hc + sizes := sha256_sizes +where + sha256_tail : Proof.Sha256.md.tailPad 32 = (sha256M v cmpN cmpC).tailB := by + show Proof.Sha256.md.tailPad 32 = Impl.Pbkdf2.Md.X86.tail 64 32 8 true + decide + sha256_sizes : Sizes (sha256M v cmpN cmpC) := + ⟨show 64 = 64 ∨ 64 = 128 by decide, show 0 < 32 ∧ 32 ≤ 64 ∧ 32 % 4 = 0 by decide, + show 0 < 32 ∧ 32 ≤ 32 ∧ 32 % 4 = 0 by decide, show 32 + 8 + 4 ≤ 64 by decide, + show 96 = 32 + 64 from rfl, show 112 ≤ 8 * 20 by decide, show 20 ≤ 64 by decide, + show 32 ≤ 32 ∧ 32 ≤ 64 by decide⟩ + +/-- SHA-256's sizes and digest code, without the functions: the code between +the calls depends on nothing else. -/ +def sha256Shape : Hash := mdHash "" "" (.block []) (.block []) (.block []) + +end VG.Proof.Pbkdf2.Md.X86 + +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) + +theorem sha256Shape_iterChecks : Iterate.Checks sha256Shape where + pro := ⟨_, by taint_decide⟩ + load := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + tail := ⟨_, by taint_decide⟩ + restore := ⟨_, by taint_decide⟩ + +theorem sha256Shape_finChecks : HmacFin.Checks sha256Shape where + pro := ⟨_, by taint_decide⟩ + fin1 := ⟨_, by taint_decide⟩ + mid := ⟨_, by taint_decide⟩ + out := ⟨_, by taint_decide⟩ + +theorem sha256_iterChecks (v : Sha256Stream) (cmpN : String) (cmpC : Prog isa) : + Iterate.Checks (sha256M v cmpN cmpC) := + let h := sha256Shape_iterChecks + ⟨h.pro, h.load, h.mid, h.tail, h.restore⟩ + +theorem sha256_finChecks (v : Sha256Stream) (cmpN : String) (cmpC : Prog isa) : + HmacFin.Checks (sha256M v cmpN cmpC) := + let h := sha256Shape_finChecks + ⟨h.pro, h.fin1, h.mid, h.out⟩ + +theorem sha256_iterImp : (iterW Spec.Hmac.sha256S 104).Implies (Spec.Hmac.sha256I.iterateContract X86.abi 48) := by + obtain ⟨a0, a1, a2, a3, a4, e, esp⟩ := iterSat_args 96 32 104 + sig_implies [Spec.Hmac.Instance.iterateContract, Spec.Pbkdf2.iterateContract, Spec.Pbkdf2.iterateSig, + Spec.Hmac.sha256I, Spec.Hmac.sha256S, Spec.Hmac.sha256, iterW, iterG, X86.abi, X86.argSlots, X86.argVal, + X86.argBytes] + [a0, a1, a2, a3, a4, e, esp, iterSat] using iterSat 96 32 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, + Spec.Hmac.sha256I, Spec.Hmac.sha256S, Spec.Hmac.sha256, finW, finG, countF, X86.abi, X86.argSlots, + X86.argVal, X86.argBytes] + [a0, a1, a2, a3, a4, a5, e, esp, finSat] using finSat 96 32 104 + +/-- PBKDF2's iteration for SHA-256 with any backend. -/ +theorem sha256_iterate (v : Sha256Stream) (cmpN : String) {cmpC : Prog isa} + (hc : CompOk Proof.Sha256.md 112 cmpC) : + Verified X86.target (sha256M v cmpN cmpC).iterate (Spec.Hmac.sha256I.iterateContract X86.abi 48) := + (Iterate.verifiedW (sha256Ok v cmpN hc) (sha256_iterChecks v cmpN cmpC) + (show 8 * 20 + 16 + 32 + 64 ≤ 8 * 104 by decide) sha256_iterImp.sat_left).of_implies sha256_iterImp + +/-- HMAC's `finalize` for SHA-256 with any backend. -/ +theorem sha256_finalize (v : Sha256Stream) (cmpN : String) {cmpC : Prog isa} + (hc : CompOk Proof.Sha256.md 112 cmpC) : + Verified X86.target (sha256M v cmpN cmpC).hmacFin (Spec.Hmac.sha256I.finalizeContract X86.abi 48) := + (HmacFin.verifiedW (sha256Ok v cmpN hc) (sha256_finChecks v cmpN cmpC) + (show 8 * 20 + 16 + 32 ≤ 8 * 104 by decide) sha256_finImp.sat_left).of_implies sha256_finImp + +end VG.Proof.Pbkdf2.Md.X86.Instances diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Sha256/X86.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Sha256/X86.lean deleted file mode 100644 index 53a283219..000000000 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Sha256/X86.lean +++ /dev/null @@ -1,207 +0,0 @@ -import VerifiedGarbage.Proof.Pbkdf2.X86.Iterate -import VerifiedGarbage.Proof.Sha256.X86.Stream.CompressAt -import VerifiedGarbage.Impl.Pbkdf2.Sha256.X86 - -/-! PBKDF2-SHA-256's direct-compression loop, proved once for any backend. -/ -namespace VG.Proof.Pbkdf2.Sha256.X86 -open VG VG.X86 -open VG.Proof.Pbkdf2.X86 -open VG.Proof.Sha256.X86.Stream -open VG.Impl.Pbkdf2.X86 (digest) -open VG.Proof.Pbkdf2.Memory (frame_bytesAt blockAt_eq xorBytes_length digest_self add_ofNat contains_base) -open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame) -open VG.Proof.Hmac.Common (bytesAt_writeBytes_self bytesAt_writeBytes_sep bytesAt_length) -open VG.Spec.Sha256 (stateAt compress blockAt bytesAt) -variable {name : String} {code : Prog isa} - (hv : Verified X86.target code Proof.Sha256.compressX86) - (hnosp : NoSp code) (hstack : stackUse code = 0) -include hv hnosp hstack - -theorem cmp_of {s₀ : State} (hp : Pre s₀) {s : State} (h : Regs s₀ s) - (hax : s.gpr .eax = scr s₀ + BitVec.ofNat 32 192) {Q : State → Prop} - (k : ∀ s', Keep s₀ s s' → - stateAt s'.mem (tA s₀) = compress (stateAt s.mem (tA s₀)) (blockAt s.mem (blkA s₀)) → Q s') : - WP isa (Impl.MdStream.X86.compressAt name code .ebx .ebp) s Q := by - have := hp.scr_fit; have := hp.t_fit - have ea : (scr s₀ + BitVec.ofNat 32 192).setWidth 64 = blkA s₀ := addr_off (len := 256) hp.scr_fit (by omega) - have et : (scr s₀ + BitVec.ofNat 32 192).toNat = (scr s₀).toNat + 192 := by - rw [BitVec.toNat_add, BitVec.toNat_ofNat]; omega - have hsc : scR s₀ ∈ s.wr := by simp [h.wr, hp.wr] - have htr : tR s₀ ∈ s.wr := by simp [h.wr, hp.wr] - have b64 : Region.Sub ⟨(scr s₀ + BitVec.ofNat 32 192).setWidth 64, 64⟩ (sR s₀ 192 64) := by - rw [ea]; exact fun _ h => h - refine compressAt_of hv hnosp hstack (st := tP s₀) (scr := scr s₀) (blk := scr s₀ + BitVec.ofNat 32 192) (E := esp₀ s₀) - (by decide) (by decide) (by decide) (by decide) h.esp h.ebx h.ebp hax hp.sp_lo (by omega) - (by rw [et]; omega) (by omega) (hp.t_s.sub_right (cmp_sub s₀)) - ((hp.t_s.sub_right (scr_sub s₀ (o := 192) (n := 64) (by omega))).symm.sub_left b64) - ((scr_disj0 s₀ (a := 192) (m := 64) (by omega) (by omega)).sub_left b64) - hp.stk_t (hp.stk_s.sub_right (cmp_sub s₀)) (hp.stk_s.sub_right fun a ha => scr_sub s₀ (o := 192) (n := 64) (by omega) a (b64 a ha)) ?_ ?_ - fun s' hrd hwr hcs hf hst => k s' ⟨hrd, hwr, fun r hr => hcs r (by - simp only [kept, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl <;> simp [calleeSaved]), hf⟩ (by rw [hst, ea]) - · rw [ea] - refine Covers.of_sub fun r hr => ?_ - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - subst hr - exact ⟨scR s₀, List.mem_append_right _ hsc, 192, rfl, by simp⟩ - · 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 ⟨tR s₀, htr, 0, by simp, by simp⟩ - · exact ⟨scR s₀, hsc, 0, by simp, by simp⟩ - -theorem body_ok {s₀ : State} (hp : Pre s₀) {r : Nat} {s : State} (h : Inv s₀ (r + 1) s) : - WP isa (Impl.Pbkdf2.Sha256.X86.body name code) s fun s' => VG.X86.eval .ne s' = some (r != 0) ∧ Inv s₀ r s' := by - have := hp.scr_fit - unfold Impl.Pbkdf2.Sha256.X86.body - have hU : ∀ {m : Mem}, Frame [tR s₀, cmpR s₀, stkR s₀] s.mem m → - bytesAt m (blkA s₀) 32 = bytesAt s.mem (blkA s₀) 32 := - fun hf => frame_bytesAt hf (blk_disj hp) (by omega) - have hpad : ∀ {m : Mem}, Frame (bodyR s₀) s.mem m → bytesAt m (blkA s₀ + 32) 32 = pad96 := by - intro m hf - rw [show blkA s₀ + 32 = scA s₀ + BitVec.ofNat 64 224 by - change scA s₀ + 192 + 32 = scA s₀ + BitVec.ofNat 64 224 - rw [BitVec.add_assoc]; rfl, ← h.pad] - exact frame_bytesAt hf (body_disj hp (o := 224) (n := 32) (.inr (Nat.le_refl _)) (by omega)) (by omega) - -- The inner hash. - refine WP.seq ?_ - refine load_ok hp h.toRegs (o := 0) (by omega) fun s₁ k₁ e₁ => ?_ - refine atBlock_ok (rest := []) (h.toRegs.keep k₁) fun s₂ k₂ m₂ x₂ => WP.block_nil ?_ - have h₂ := (h.toRegs.keep k₁).keep k₂ - refine WP.seq (cmp_of hv hnosp hstack hp h₂ x₂ fun s₃ k₃ e₃ => ?_) - rw [m₂, e₁, blockAt_eq (hpad (frame_body k₁.frame (by simp))), hU k₁.frame] at e₃ - -- The outer hash. - have h₃ := h₂.keep k₃ - refine WP.seq ?_ - refine digest_ok hp h₃ fun s₄ h₄ g₄ f₄ m₄ => ?_ - refine load_ok hp h₄ (o := 96) (by omega) fun s₅ k₅ e₅ => ?_ - refine atBlock_ok (rest := []) (h₄.keep k₅) fun s₆ k₆ m₆ x₆ => WP.block_nil ?_ - have h₆ := (h₄.keep k₅).keep k₆ - have f₃₄ : Frame (bodyR s₀) s.mem s₄.mem := - (frame_body ((k₁.trans k₂).trans k₃).frame (by simp)).trans (frame_body f₄ (by simp)) - refine WP.seq (cmp_of hv hnosp hstack hp h₆ x₆ fun s₇ k₇ e₇ => ?_) - have hX : bytesAt s₅.mem (blkA s₀) 32 = Pbkdf2.digest (stateAt s₃.mem (tA s₀)) := by - rw [frame_bytesAt (p := blkA s₀) (n := 32) k₅.frame (blk_disj hp) (by omega), m₄, digest_self] - rw [m₆, e₅, blockAt_eq (hpad (f₃₄.trans (frame_body k₅.frame (by simp)))), hX, e₃] at e₇ - -- The digest, `T ← T ⊕ U` and the count. - have h₇ := h₆.keep k₇ - refine digest_ok hp h₇ fun s₈ h₈ g₈ f₈ m₈ => ?_ - refine xor_ok (p := scr s₀) (by omega) 8 (Nat.le_refl _) _ s₈ _ h₈.ebp - (fun j hj => InRegions.right (by rw [add_ofNat]; exact in_scr hp h₈.wr (a := 192 + 4 * j) (n := 4) (by omega))) - (fun j hj => by rw [add_ofNat]; exact in_scr hp h₈.wr (a := 160 + 4 * j) (n := 4) (by omega)) - fun s₉ g₉ rd₉ wr₉ m₉ => ?_ - rw [show 4 * 8 = 32 from rfl] at m₉ - have f₉ : Frame [sR s₀ 160 32] s₈.mem s₉.mem := by - rw [m₉] - exact writeBytes_frame _ _ _ (contains_base (by rw [xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length])) - have h₉ := h₈.write (fun r hr => g₉ r (by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl <;> decide)) rd₉ wr₉ (R := scR s₀) (by simp) - (f₉.sub fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - subst hr; exact ⟨scR s₀, by simp, scr_sub s₀ (by omega)⟩) - refine wp_subi fun s₁₀ u₁₀ z₁₀ => WP.block_nil ?_ - have h₁₀ := h₉.write (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 | rfl | rfl <;> decide)) u₁₀.rd u₁₀.wr (R := tR s₀) (by simp) - (by rw [u₁₀.mem]; exact Frame.refl _ _) - have xedi : s₉.gpr .edi = BitVec.ofNat 32 (r + 1) := by - rw [g₉ _ (by decide), g₈ _ (by decide), k₇.gpr _ (by simp [kept]), k₆.gpr _ (by simp [kept]), - k₅.gpr _ (by simp [kept]), g₄ _ (by decide), k₃.gpr _ (by simp [kept]), k₂.gpr _ (by simp [kept]), - k₁.gpr _ (by simp [kept]), h.edi] - have hlt : r + 1 < 2 ^ 32 := by have := h.le; have := (arg s₀ 2).isLt; simp only [nn] at *; omega - have e₁₀ : s₉.gpr .edi - 1 = BitVec.ofNat 32 r := by - rw [xedi, show (1 : BitVec 32) = BitVec.ofNat 32 1 from rfl, sub_ofNat (by omega), Nat.add_sub_cancel] - have fb : Frame (bodyR s₀) s.mem s₁₀.mem := by - rw [u₁₀.mem] - exact f₃₄.trans (frame_body ((k₅.trans k₆).trans k₇).frame (by simp)) |>.trans (frame_body f₈ (by simp)) - |>.trans (frame_body f₉ (by simp)) - have f₈' : Frame [tR s₀, cmpR s₀, stkR s₀, sR s₀ 192 32] s.mem s₈.mem := - (((k₁.trans k₂).trans k₃).frame.mono (by simp)) |>.trans (f₄.mono (by simp)) - |>.trans ((((k₅.trans k₆).trans k₇).frame).mono (by simp)) |>.trans (f₈.mono (by simp)) - have hT : bytesAt s₈.mem (TA s₀) 32 = bytesAt s.mem (TA s₀) 32 := - frame_bytesAt f₈' (T_disj hp) (by omega) - have hU₈ : bytesAt s₈.mem (blkA s₀) 32 = stepM s₀ (bytesAt s.mem (blkA s₀) 32) := by - rw [m₈, digest_self, e₇]; rfl - have hsep : Mem.Sep (blkA s₀) 32 (TA s₀) - (Spec.Pbkdf2.xorBytes (bytesAt s₈.mem (TA s₀) 32) (bytesAt s₈.mem (blkA s₀) 32)).length := by - rw [xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length] - exact Region.Disjoint.sep (scr_disj s₀ (a := 192) (m := 32) (b := 160) (n := 32) (by omega) (by omega) - (by omega)) (contains_base (Nat.le_refl _)) (contains_base (Nat.le_refl _)) - have hU₁₀ : bytesAt s₁₀.mem (blkA s₀) 32 = stepM s₀ (bytesAt s.mem (blkA s₀) 32) := by - rw [u₁₀.mem, m₉, bytesAt_writeBytes_sep _ _ hsep (by omega), hU₈] - have hT₁₀ : bytesAt s₁₀.mem (TA s₀) 32 = - Spec.Pbkdf2.xorBytes (bytesAt s.mem (TA s₀) 32) (stepM s₀ (bytesAt s.mem (blkA s₀) 32)) := by - have := bytesAt_writeBytes_self s₈.mem (TA s₀) - (Spec.Pbkdf2.xorBytes (bytesAt s₈.mem (TA s₀) 32) (bytesAt s₈.mem (blkA s₀) 32)) - (by rw [xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length]; omega) - rw [xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length] at this - rw [u₁₀.mem, m₉, this, hT, hU₈] - have hle : r ≤ nn s₀ := by have := h.le; omega - refine ⟨?_, { h₁₀ with edi := ?_, saved := h.saved.frame hp fb, pad := ?_, le := hle, val := ?_ }⟩ - · rw [eval_ne, z₁₀, e₁₀, ofNat_beq_zero (by omega)] - cases r <;> rfl - · rw [u₁₀.gpr, e₁₀] - · rw [← h.pad] - exact frame_bytesAt fb (body_disj hp (o := 224) (n := 32) (.inr (Nat.le_refl _)) (by omega)) (by omega) - · rw [h.val, hU₁₀, hT₁₀]; rfl - -theorem loop_ok {s₀ : State} (hp : Pre s₀) {n : Nat} {s : State} (h : Inv s₀ n s) - (hz : s.zf = some (decide (n = 0))) : - WP isa (.ite .e (.block []) (.loop (Impl.Pbkdf2.Sha256.X86.body name code) .ne)) s (Inv s₀ 0) := by - refine WP.ite (decide (n = 0)) (by show s.zf = _; rw [hz]) (fun hb => ?_) (fun hb => ?_) - · obtain rfl : n = 0 := by simpa using hb - exact WP.block_nil h - · obtain ⟨m, rfl⟩ : ∃ m, n = m + 1 := ⟨n - 1, by simp at hb; omega⟩ - refine WP.loop (fun m s => Inv s₀ (m + 1) s) (fun m s hs => WP.mono (body_ok hv hnosp hstack hp hs) fun s' ⟨he, hi⟩ => ?_) m s h - cases m with - | zero => exact .inl ⟨he, hi⟩ - | succ m => exact .inr ⟨he, m, by omega, hi⟩ - -/-- Prologue and epilogue are unchanged; the loop calls this compressor. -/ -theorem correct {s₀ : State} (hp : Pre s₀) : - WP isa (Impl.Pbkdf2.Sha256.X86.iterate name code) s₀ (Post s₀) := by - unfold Impl.Pbkdf2.Sha256.X86.iterate - refine WP.seq (WP.mono (prologue_ok hp) fun s₁ ⟨h₁, z₁⟩ => ?_) - exact WP.seq (WP.mono (loop_ok hv hnosp hstack hp h₁ z₁) fun s₂ h₂ => epilogue_ok hp h₂) - -local macro "narrow" loc:(Lean.Parser.Tactic.location)? : tactic => - `(tactic| simp only [Proof.Pbkdf2.iterateSha256X86, VG.Proof.Pbkdf2.X86.iterateWide, - VG.Proof.Pbkdf2.X86.narrowRd, VG.Proof.Pbkdf2.X86.narrowWr, VG.X86.arg_withRegions, - VG.X86.argAddr_withRegions, VG.X86.State.withRegions_gpr, VG.X86.State.withRegions_mem, - VG.X86.State.withRegions_rd, VG.X86.State.withRegions_wr] $(loc)?) - -theorem verified - (hct : ConstantTime isa Proof.Pbkdf2.iterateSha256X86.pre - Proof.Pbkdf2.iterateSha256X86.pub (Impl.Pbkdf2.Sha256.X86.iterate name code)) : - Verified X86.target (Impl.Pbkdf2.Sha256.X86.iterate name code) (Spec.Pbkdf2.iterateSha256Contract X86.abi 20) := - have hsat := iterateWide_implies.sat_left - (Verified.narrowTo (Verified.of_correct (fun s hs => by - obtain ⟨t, s', he, h⟩ := correct hv hnosp hstack (pre_of hs) - exact ⟨t, s', he, h⟩) hct (.refl ⟨sat, sat_pre⟩)) - narrowRd narrowWr iterateWide_pre - (fun _ h => by - obtain ⟨h₁, h₂, _⟩ := h - rw [h₁, h₂] - 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_left _ (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⟩ - · 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⟩) - (fun _ h => by - obtain ⟨_, h₂, _⟩ := h - rw [h₂] - 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 - · 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⟩) - (fun _ _ _ h => by narrow at h ⊢; exact h) - (fun _ _ _ _ h => by narrow; exact h) hsat).of_implies iterateWide_implies - -end VG.Proof.Pbkdf2.Sha256.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha256.lean index 4f528af51..1725234e7 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha256.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha256.lean @@ -1,105 +1,33 @@ import VerifiedGarbage.Proof.Pbkdf2.Whole.Arm.Instances -import VerifiedGarbage.Proof.Sha256.Arm.Stream.Init -import VerifiedGarbage.Proof.Sha256.Arm.Stream.Md -import VerifiedGarbage.Proof.Hmac.Arm.Init -import VerifiedGarbage.Proof.Hmac.Arm.Finalize -import VerifiedGarbage.Proof.Pbkdf2.Arm.Iterate -import VerifiedGarbage.Spec.Sha256.Contract +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: its streaming functions, verified -for any initial hash value, give `HashOK` at `H0`; its HMAC and PBKDF2 -functions, verified against SHA-256's own contracts with no stack, are moved -to the shared ones with 16 bytes of stack (`pre_0_of_16`, and a weaker -postcondition for HMAC's `finalize`). +The generic proof (`CT.lean`) at SHA-256 +(`Proof/Hmac/Generic/Arm/Sha256.lean`), as for the other hash functions +(`Instances.lean`). -/ namespace VG.Proof.Pbkdf2.Whole.Arm open VG.Arm open VG.Impl.Pbkdf2.Whole.Arm (Fns) -open VG.Proof.Hmac.Generic.Arm (HashOK) +open VG.Proof.Hmac.Generic.Arm (sha256OK) -/-- SHA-256's streaming functions. -/ -def sha256H : Impl.Hmac.Generic.Arm.Hash := ⟨64, 96, 32, 32, 20, Spec.Sha256.initApi.name, - Impl.Sha256.Arm.Stream.init, Spec.Sha256.updateApi.name, Impl.Sha256.Arm.Stream.update, - Spec.Sha256.finalizeApi.name, Impl.Sha256.Arm.Stream.finalize⟩ +def sha256F : Fns := fnsOf Spec.Hmac.sha256I Md.Arm.sha256Md -/-- SHA-256's streaming functions, verified. -/ -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 := Whole.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 - -/-- A contract with 16 bytes of stack asks more than with none. -/ -theorem pre_0_of_16 {sig : Sig} {pre : Curry (sig.words Arm.abi.ptrBits) (Mem → Prop)} - {post : sig.Post Arm.abi.ptrBits} {wa : Bool} {s : State} - (h : (sig.contract Arm.abi pre post wa 16).pre s) : (sig.contract Arm.abi pre post wa 0).pre s := by - simp only [Sig.contract] at h ⊢ - split at h - · exact h.elim - · obtain ⟨wf, rd, wr, pw, _, bnd, p⟩ := h - exact ⟨wf.2, rd, wr, pw, fun r hr => by simp [Arm.abi, stackBelow] at hr, bnd, p⟩ - -/-- The functions `pbkdf2` calls for SHA-256. -/ -def sha256F : Fns where - H := sha256H - W := Spec.Hmac.sha256I.scratch - hiN := Spec.Hmac.initSha256Api.name - hiC := Impl.Hmac.Arm.init - hfN := Spec.Hmac.finalizeSha256OutApi.name - hfC := Impl.Hmac.Arm.finalize - itN := Spec.Pbkdf2.iterateSha256Api.name - itC := Impl.Pbkdf2.Arm.iterate +theorem sha256_checks : Checks sha256F := by + constructor <;> exact ⟨_, by taint_decide⟩ -/-- The functions `pbkdf2` calls for SHA-256, verified. -/ def sha256OKF : FnsOK sha256F where hH := sha256OK - Wi := 76 - Wf := 86 + Wi := 104 + Wf := 104 Wt := 104 - hi := (Sound.of_verified Proof.Hmac.Arm.Init.init_verified).weaken (fun _ h => pre_0_of_16 h) - (fun _ _ _ h => h) (fun _ _ _ _ h => h) - hf := (Sound.of_verified Proof.Hmac.Arm.Finalize.finalize_verified).weaken (fun _ h => pre_0_of_16 h) - (fun s s' _ h => by - sig_post [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.finalizeSha256OutContract, - Spec.Hmac.finalizeSha256OutSig, Spec.Hmac.sha256S, Spec.Hmac.sha256, Arm.abi, Arm.argRegs, - Arm.reduceClassify, Arm.Loc.val] at h ⊢ - intro k0 text hl _ hr hc ho - exact h k0 text hl hr hc ho) (fun _ _ _ _ h => h) - it := (Sound.of_verified Proof.Pbkdf2.Arm.iterate_verified).weaken (fun _ h => pre_0_of_16 h) - (fun _ _ _ h => h) (fun _ _ _ _ h => h) + hi := .of_verified Proof.Hmac.Generic.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 hfSt := by decide +kernel itSt := by decide +kernel @@ -116,15 +44,11 @@ def sha256OKF : FnsOK sha256F where encB4 := by decide encD := by decide -theorem sha256_checks : Checks sha256F := by - constructor <;> exact ⟨_, by taint_decide⟩ - theorem sha256_sat : ∃ s, (Spec.Hmac.sha256I.pbkdf2Contract Arm.abi 24).pre s := by sig_implies_sat [Spec.Hmac.Instance.pbkdf2Contract, Spec.Pbkdf2.pbkdf2Contract, Spec.Pbkdf2.pbkdf2Sig, Spec.Hmac.Instance.pbkdf2Scratch, Spec.Hmac.sha256I, Spec.Hmac.sha256S, Spec.Hmac.sha256, Arm.abi, Arm.argRegs, Arm.reduceClassify, Arm.Loc.val, Arm.State.addr] [pbkSat, pbkMem] using pbkSat 200 -/-- `pbkdf2` for SHA-256, verified. -/ theorem sha256 : Verified Arm.target sha256F.pbkdf2 (Spec.Hmac.sha256I.pbkdf2Contract Arm.abi 24) := verified sha256OKF sha256_checks rfl rfl sha256_sat diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Common.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Common.lean index e94696831..cb0bad161 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Common.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Common.lean @@ -11,8 +11,7 @@ The output is the blocks `T₁ ‖ T₂ ‖ …` (`G`), of which `nb` are needed `k` of them, the first `done k` bytes of the output are written. `INT (i)` is the bytes of a byte-reversed word in memory (`bytes_rev_int`), and two disjoint regions that do not wrap around fit in the address space together -(`len_add_le`). SHA-256's streaming state depends only on its bytes -(`sha256_repr`). +(`len_add_le`). -/ namespace VG.Proof.Pbkdf2.Whole @@ -130,19 +129,4 @@ theorem byteRev32_byteRev32 (x : BitVec 32) : byteRev32 (byteRev32 x) = x := by simp only [show (0 + (i - 24) < 8) by omega, ite_true, BitVec.getLsbD_extractLsb', decide_true, Bool.true_and, show 24 + (0 + (i - 24)) = i by omega] -/-! ## SHA-256's streaming state -/ - -/-- SHA-256's streaming state depends only on its 96 bytes. -/ -theorem sha256_repr (m m' : Mem) (p q : Addr) (msg : List Byte) - (h : ∀ i < 96, m' (q + BitVec.ofNat 64 i) = m (p + BitVec.ofNat 64 i)) - (hr : Spec.Sha256.Repr m p msg) : Spec.Sha256.Repr m' q msg := by - refine ⟨?_, ?_⟩ - · rw [← hr.1] - apply Vector.ext - intro j hj - simp only [Spec.Sha256.stateAt, Vector.getElem_ofFn] - exact Hmac.Generic.Common.readW_reloc h (by omega) - · rw [← hr.2] - exact Hmac.Generic.Common.bytesAt_reloc h (o := 32) (k := msg.length % 64) (by omega) - end VG.Proof.Pbkdf2.Whole diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Sha256.lean index 762398b84..12f34de9a 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Sha256.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Sha256.lean @@ -1,16 +1,15 @@ import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.CT import VerifiedGarbage.Proof.Sha256.X86.Variants.Interface -import VerifiedGarbage.Proof.Hmac.Generic.X86.Hashes /-! # PBKDF2-HMAC-SHA-256 on x86 (32-bit), the whole derivation, for every backend The generic proof (`CT.lean`) at SHA-256, for any backend (`Proof/Sha256/X86/Variants/Interface.lean`): its streaming functions, -verified for any initial hash value, give `HashOK` at `H0`; its HMAC and -PBKDF2 functions, verified against SHA-256's own contracts with 20 bytes of -stack, are moved to the shared ones with 48 (`pre_20_of_48`, and a weaker -postcondition for HMAC's `finalize`). The taint checks depend only on the +HMAC's `init` and `finalize` and PBKDF2's iteration made with the backend, +verified for any backend against the shared contracts +(`Proof.Sha256.X86.Variants.Backend.hmacInit` and the others), as for the +other hash functions (`Instances.lean`). The taint checks depend only on the sizes, so they are evaluated once, for any backend (`sha256Shape`). -/ @@ -18,90 +17,25 @@ namespace VG.Proof.Pbkdf2.Whole.X86 open VG.X86 open VG.Impl.Pbkdf2.Whole.X86 (Fns) -open VG.Proof.Hmac.Generic.X86 (HashOK nosp_of) open VG.Proof.Sha256.X86.Variants (Backend) -/-- The functions `pbkdf2` calls for SHA-256 with the backend `v`. -/ -abbrev sha256FnsOf (v : Backend) : Fns := sha256Fns v.suffix v.cmpN v.cmpC v.updC v.finC - -/-- SHA-256's streaming functions with the backend `v`, verified. -/ -def sha256OK (v : Backend) : HashOK (sha256FnsOf v).H where - SH := Spec.Hmac.sha256S - Wb := 160 - hS := rfl - hD := rfl - hB := rfl - hDF := show 32 ≤ 32 by decide - hF := show 32 ≤ 64 by decide - hD0 := show 0 < 32 by decide - hS0 := show 0 < 96 by decide - hSB := show 96 ≤ 256 by decide - hB0 := show 0 < 64 by decide - hBB := show 64 ≤ 128 by decide - hWb := show 160 ≤ 8 * 20 by decide - hW := show 20 ≤ 64 by decide - repr := Whole.sha256_repr - init := Proof.Sha256.X86.Stream.init_verified - upd := v.upd.of_implies - { pre := fun _ h => h - post := fun _ _ _ h m hr hc => h Spec.Sha256.H0 m hr hc - pub := fun _ _ _ _ h => h - sat := v.upd.2.2 } - fin := v.fin.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 := v.fin.2.2 } - initSp := show NoSp Impl.Sha256.X86.Stream.init from nosp_of (by lit_decide) - updSp := v.updNoSp - finSp := v.finNoSp - initSU := show stackUse Impl.Sha256.X86.Stream.init ≤ 20 by lit_decide - updSU := v.updStack - finSU := v.finStack - -/-- A contract with 48 bytes of stack asks more than with 20. -/ -theorem pre_20_of_48 {sig : Sig} {pre : Curry (sig.words X86.abi.ptrBits) (Mem → Prop)} {post : sig.Post X86.abi.ptrBits} - {wa : Bool} - {s : State} (h : (sig.contract X86.abi pre post wa 48).pre s) : (sig.contract X86.abi pre post wa 20).pre s := by - simp only [Sig.contract] at h ⊢ - split at h - · exact h.elim - · obtain ⟨wf, rd, wr, pw, res, bnd, p⟩ := h - refine ⟨⟨by have := wf.1; omega, wf.2⟩, rd, wr, pw, fun r hr a ha => ?_, bnd, p⟩ - simp only [X86.abi, stackBelow, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact res _ (by simp [X86.abi]) a ha - · exact (res ⟨(s.gpr .esp).setWidth 64 - BitVec.ofNat 64 48, 48⟩ (by simp [X86.abi, stackBelow]) a ha).sub_left - (Taint.below_sub (by decide) (by decide)) - /-- The functions `pbkdf2` calls for SHA-256 with the backend `v`, verified. -/ -def sha256OKF (v : Backend) : FnsOK (sha256FnsOf v) where - hH := sha256OK v - Wi := 76 - Wf := 86 +def sha256OKF (v : Backend) : FnsOK v.F where + hH := Proof.Hmac.Generic.X86.sha256OK v.stream + Wi := 104 + Wf := 104 Wt := 104 - hi := (Sound.of_verified (Proof.Hmac.Sha256.X86.Init.verified v.cmp v.cmpSp v.cmpStack v.initCt)).weaken - (fun _ h => pre_20_of_48 h) (fun _ _ _ h => h) (fun _ _ _ _ h => h) - hf := (Sound.of_verified (Proof.Hmac.Sha256.X86.Finalize.verified v.cmp v.cmpSp v.cmpStack v.finHashSp - v.finHashStack v.finCt)).weaken (fun _ h => pre_20_of_48 h) (fun s s' _ h => by - sig_post [Spec.Hmac.finalizeContract, Spec.Hmac.finalizeSig, Spec.Hmac.finalizeSha256OutContract, - Spec.Hmac.finalizeSha256OutSig, Spec.Hmac.sha256S, Spec.Hmac.sha256, X86.abi, X86.argSlots, X86.argVal, - X86.argBytes] at h ⊢ - intro k0 text hl _ hr hc ho - exact h k0 text hl hr hc ho) (fun _ _ _ _ h => h) - it := (Sound.of_verified (Proof.Pbkdf2.Sha256.X86.verified v.cmp v.cmpSp v.cmpStack v.iterCt)).weaken - (fun _ h => pre_20_of_48 h) (fun _ _ _ h => h) (fun _ _ _ _ h => h) + hi := .of_verified v.hmacInit + hf := .of_verified v.hmacFin + it := .of_verified v.iterate hiSp := v.initNoSp hfSp := v.finalizeNoSp itSp := v.iterNoSp hiSU := v.initStack hfSU := v.finalizeStack itSU := v.iterStack - hWi := show 76 ≤ 104 by decide - hWf := show 86 ≤ 104 by decide + hWi := show 104 ≤ 104 by decide + hWf := show 104 ≤ 104 by decide hWt := show 104 ≤ 104 by decide hWH := show 20 ≤ 104 by decide hW := show 104 ≤ 512 by decide @@ -109,8 +43,8 @@ def sha256OKF (v : Backend) : FnsOK (sha256FnsOf v) where hBS := show 64 ≤ 96 by decide fits := show 20 + 2 * 32 + 32 ≤ 4 * 96 by decide -/-- The sizes of `sha256FnsOf`, which are all the taint checks depend on. -/ -def sha256Shape : Fns := sha256Fns "" "" (.block []) (.block []) (.block []) +/-- The sizes of `Backend.F`, which are all the taint checks depend on. -/ +def sha256Shape : Fns := Proof.Sha256.X86.Variants.fns "" "" (.block []) (.block []) (.block []) theorem sha256Shape_checks : Checks sha256Shape where pro := ⟨_, by taint_decide⟩ @@ -132,7 +66,7 @@ theorem sha256Shape_checks : Checks sha256Shape where tail := ⟨_, by taint_decide⟩ restore := ⟨_, by taint_decide⟩ -theorem sha256_checks (v : Backend) : Checks (sha256FnsOf v) := +theorem sha256_checks (v : Backend) : Checks v.F := let h := sha256Shape_checks ⟨h.pro, h.cmp, h.hk1, h.hk3, h.hk5, h.hk7, h.short, h.su1, h.su3, h.su4, h.init, h.b1, h.b2, h.b4, h.b6, h.b7, h.tail, h.restore⟩ @@ -144,7 +78,7 @@ theorem sha256_sat : ∃ s, (Spec.Hmac.sha256I.pbkdf2Contract X86.abi 76).pre s /-- `pbkdf2` for SHA-256 with the backend `v`, verified. -/ theorem sha256_verified (v : Backend) : - Verified X86.target (sha256FnsOf v).pbkdf2 (Spec.Hmac.sha256I.pbkdf2Contract X86.abi 76) := + Verified X86.target v.F.pbkdf2 (Spec.Hmac.sha256I.pbkdf2Contract X86.abi 76) := verified (sha256OKF v) (sha256_checks v) rfl rfl sha256_sat end VG.Proof.Pbkdf2.Whole.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Sha256Fns.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Sha256Fns.lean deleted file mode 100644 index 00cb5a756..000000000 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Sha256Fns.lean +++ /dev/null @@ -1,43 +0,0 @@ -import VerifiedGarbage.Impl.Pbkdf2.Whole.X86 -import VerifiedGarbage.Impl.Hmac.Sha256.X86 -import VerifiedGarbage.Impl.Pbkdf2.Sha256.X86 -import VerifiedGarbage.Impl.Sha256.X86.Stream -import VerifiedGarbage.Spec.Sha256.Contract -import VerifiedGarbage.Spec.Hmac.Contract -import VerifiedGarbage.Spec.Pbkdf2.Contract -import VerifiedGarbage.Spec.Hmac.Generic - -/-! -# PBKDF2-HMAC-SHA-256 on x86 (32-bit), the whole derivation: the functions it calls - -SHA-256 has backends on x86 (`Proof/Sha256/X86/Variants/Interface.lean`): its -streaming `update` and `finalize`, HMAC's `init` and `finalize` and PBKDF2's -`iterate` call the backend's compression function. The whole derivation -(`Impl/Pbkdf2/Whole/X86.lean`) calls them, by the names the generic -registration files give them (with the backend's suffix). --/ - -namespace VG.Proof.Pbkdf2.Whole.X86 - -open VG.X86 -open VG.Impl.Pbkdf2.Whole.X86 (Fns) - -/-- SHA-256's streaming functions, with the backend's `update` and -`finalize` (`updC`, `finC`) and suffix. -/ -def sha256H (suffix : String) (updC finC : Prog isa) : Impl.Hmac.Generic.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⟩ - -/-- The functions `pbkdf2` calls for SHA-256, with the compression function -`cmpN`/`cmpC` and the streaming `update` and `finalize` calling it. -/ -def sha256Fns (suffix cmpN : String) (cmpC updC finC : Prog isa) : Fns where - H := sha256H suffix updC finC - W := Spec.Hmac.sha256I.scratch - hiN := Spec.Hmac.initSha256Api.name ++ suffix - hiC := Impl.Hmac.Sha256.X86.init cmpN cmpC - hfN := Spec.Hmac.finalizeSha256OutApi.name ++ suffix - hfC := Impl.Hmac.Sha256.X86.finalize cmpN cmpC - itN := Spec.Pbkdf2.iterateSha256Api.name ++ suffix - itC := Impl.Pbkdf2.Sha256.X86.iterate cmpN cmpC - -end VG.Proof.Pbkdf2.Whole.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/X86/Body.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/X86/Body.lean deleted file mode 100644 index 803ed4313..000000000 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/X86/Body.lean +++ /dev/null @@ -1,99 +0,0 @@ -import VerifiedGarbage.Proof.Pbkdf2.X86.Common - -/-! -# PBKDF2-HMAC-SHA-256's iteration on x86 (32-bit): the loop - -One step is HMAC-SHA-256 of `U` as two compressions -(`VG.Proof.Pbkdf2.hmac_step`), then `T ← T ⊕ U`. --/ - -namespace VG.Proof.Pbkdf2.X86 - -open VG VG.X86 VG.Impl.Pbkdf2.X86 -open VG.Impl.Sha256.X86.Stream (saved) -open VG.Proof.Sha256.X86.Stream (wp_subi eval_e eval_ne ofNat_beq_zero sub_ofNat) -open VG.Proof.Hmac.Common (bytesAt_length bytesAt_writeBytes_self bytesAt_writeBytes_sep) -open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame) -open VG.Proof.Pbkdf2.Memory (frame_bytesAt contains_base blockAt_eq xorBytes_length add_ofNat digest_self) -open VG.Spec.Sha256 (bytesAt stateAt blockAt compress HashValue) - -section -variable (s₀ : State) - -/-- The key's inner and outer hash values. -/ -abbrev Hi : HashValue := stateAt s₀.mem (kA s₀ + BitVec.ofNat 64 0) -abbrev Ho : HashValue := stateAt s₀.mem (kA s₀ + BitVec.ofNat 64 96) - -/-- A step, as the code computes it. -/ -def stepM (u : List Byte) : List Byte := - Pbkdf2.digest (compress (Ho s₀) (block96 (Pbkdf2.digest (compress (Hi s₀) (block96 u))))) - -/-- Our caller's registers, saved in the scratch space. -/ -def Saved (m : Mem) : Prop := - ∀ p ∈ saved, m.readW (scA s₀ + BitVec.ofNat 64 p.2) 32 = s₀.gpr p.1 - -/-- What the body writes: `t`, the compression's part of the scratch space, -the stack below `esp`, `T` and the block's first 32 bytes. -/ -abbrev bodyR : List Region := [tR s₀, cmpR s₀, stkR s₀, sR s₀ 160 32, sR s₀ 192 32] - -end - -/-- Parts of the scratch space that the body leaves: the saved registers -(`[112..128)`) and the padding (from 224). -/ -theorem body_disj {s₀ : State} (hp : Pre s₀) {o n : Nat} (h₁ : (112 ≤ o ∧ o + n ≤ 128) ∨ 224 ≤ o) - (h₂ : o + n ≤ 256) : ∀ r ∈ bodyR s₀, Region.Disjoint (sR s₀ o n) 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 (hp.t_s.sub_right (scr_sub s₀ h₂)).symm - · exact scr_disj0 s₀ (by omega) h₂ - · exact (hp.stk_s.sub_right (scr_sub s₀ h₂)).symm - · exact scr_disj s₀ (b := 160) (n := 32) (by omega) h₂ (by omega) - · exact scr_disj s₀ (b := 192) (n := 32) (by omega) h₂ (by omega) - -/-- The block's first 32 bytes are neither `t`, the compression's scratch -nor the stack. -/ -theorem blk_disj {s₀ : State} (hp : Pre s₀) : - ∀ r ∈ [tR s₀, cmpR s₀, stkR s₀], Region.Disjoint (sR s₀ 192 32) r := by - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact (hp.t_s.sub_right (scr_sub s₀ (by omega))).symm - · exact scr_disj0 s₀ (by omega) (by omega) - · exact (hp.stk_s.sub_right (scr_sub s₀ (by omega))).symm - -/-- `T` is none of the other parts the body writes. -/ -theorem T_disj {s₀ : State} (hp : Pre s₀) : - ∀ r ∈ [tR s₀, cmpR s₀, stkR s₀, sR s₀ 192 32], Region.Disjoint (sR s₀ 160 32) 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 - · exact (hp.t_s.sub_right (scr_sub s₀ (by omega))).symm - · exact scr_disj0 s₀ (by omega) (by omega) - · exact (hp.stk_s.sub_right (scr_sub s₀ (by omega))).symm - · exact scr_disj s₀ (by omega) (by omega) (by omega) - -theorem saved_off {p : Reg × Nat} (hp : p ∈ saved) : 112 ≤ p.2 ∧ p.2 + 4 ≤ 128 := by - simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp - rcases hp with rfl | rfl | rfl | rfl <;> simp - -theorem Saved.frame {s₀ : State} (hp : Pre s₀) {m m' : Mem} (h : Saved s₀ m) (hf : Frame (bodyR s₀) m m') : - Saved s₀ m' := by - intro p hp' - rw [← h p hp'] - have hd := saved_off hp' - exact hf.readW (r := sR s₀ p.2 4) (Region.contains_self _ _) (body_disj hp (.inl hd) (by omega)) (by decide) - -theorem frame_body {s₀ : State} {m m' : Mem} {rs : List Region} (hf : Frame rs m m') (hs : ∀ r ∈ rs, r ∈ bodyR s₀) : - Frame (bodyR s₀) m m' := hf.mono hs - -/-- The loop invariant, with `r` steps left. -/ -structure Inv (s₀ : State) (r : Nat) (s : State) : Prop extends Regs s₀ s where - edi : s.gpr .edi = BitVec.ofNat 32 r - saved : Saved s₀ s.mem - pad : bytesAt s.mem (scA s₀ + BitVec.ofNat 64 224) 32 = pad96 - le : r ≤ nn s₀ - val : Spec.Pbkdf2.iterate (stepM s₀) (nn s₀) (bytesAt s₀.mem (uA s₀) 32) (bytesAt s₀.mem (tA s₀) 32) = - Spec.Pbkdf2.iterate (stepM s₀) r (bytesAt s.mem (blkA s₀) 32) (bytesAt s.mem (TA s₀) 32) - -end VG.Proof.Pbkdf2.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/X86/Common.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/X86/Common.lean deleted file mode 100644 index c74040493..000000000 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/X86/Common.lean +++ /dev/null @@ -1,437 +0,0 @@ -import VerifiedGarbage.Proof.Pbkdf2.Hmac -import VerifiedGarbage.Spec.Pbkdf2 -import VerifiedGarbage.Proof.Pbkdf2.Memory -import VerifiedGarbage.Proof.Hmac.X86.Finalize -import VerifiedGarbage.Impl.Pbkdf2.X86 - -/-! -# PBKDF2-HMAC-SHA-256's iteration on x86 (32-bit): the parts of a step - -The same structure as the ARMv7 proof (`VG.Proof.Pbkdf2.Arm`), with the same -target-independent memory lemmas (`VG.Proof.Pbkdf2.Memory`). Each step is two -calls of the selected compression backend, used as a black box through the -generic proof in `Proof/Pbkdf2/Sha256/X86.lean`, each using the 20 bytes below -`esp`. The hash value being compressed is `t`, and `T` is kept in -`scratch[160..192)`. --/ - -namespace VG.Proof.Pbkdf2 - -open Spec.Hmac (xorPad ipad opad hmacBlockKey sha256) -open Spec.Sha256 (Repr bytesAt) - -open VG.X86 in -/-- X86 (32-bit) contract for `vg_pbkdf2_hmac_sha256_iterate(key: *const [u8; -192], u: *const [u8; 32], n: u32, t: *mut [u8; 32], scratch: *mut [u64; 32])`, -whose arguments are on the stack (cdecl): if, for a 64-byte key `K₀`, the -streaming state at `key` represents `K₀ ⊕ ipad` and the one at `key + 96` -represents `K₀ ⊕ opad`, runs `n` steps `U ← HMAC-SHA-256 (K₀, U)`, `T ← T ⊕ U` -from the `U` at `u` and the `T` at `t`, leaving the final `T` at `t`. - -The code may read the arguments (20 bytes above the return address), `key` -(192 bytes) and `u` (32 bytes), and read and write `t` (32 bytes) and -`scratch` (256 bytes, whose contents on exit are unspecified). The written -regions may not overlap each other, the read ones or the return address; -none of the buffers may overlap the 20 bytes of stack below the return -address (where the code calls the compression function); and nothing may -wrap around the end of the (32-bit) address space. `esp`, the pointers and -`n` are public; the key, `U` and `T` are secret. -/ -def iterateSha256X86 : Contract X86.isa where - pre s := - let key : Region := ⟨(arg s 0).setWidth 64, 192⟩ - let u : Region := ⟨(arg s 1).setWidth 64, 32⟩ - let t : Region := ⟨(arg s 3).setWidth 64, 32⟩ - let scratch : Region := ⟨(arg s 4).setWidth 64, 256⟩ - let args : Region := ⟨argAddr s 0, 20⟩ - let ret : Region := ⟨(s.gpr .esp).setWidth 64, 4⟩ - let stack : Region := ⟨(s.gpr .esp).setWidth 64 - 20, 20⟩ - s.rd = [key, u, args] ∧ s.wr = [t, scratch] ∧ - key.Disjoint t ∧ key.Disjoint scratch ∧ u.Disjoint t ∧ u.Disjoint scratch ∧ t.Disjoint scratch ∧ - args.Disjoint t ∧ args.Disjoint scratch ∧ ret.Disjoint t ∧ ret.Disjoint scratch ∧ - stack.Disjoint key ∧ stack.Disjoint u ∧ stack.Disjoint t ∧ stack.Disjoint scratch ∧ - (arg s 0).toNat + 192 ≤ 2 ^ 32 ∧ (arg s 1).toNat + 32 ≤ 2 ^ 32 ∧ - (arg s 3).toNat + 32 ≤ 2 ^ 32 ∧ (arg s 4).toNat + 256 ≤ 2 ^ 32 ∧ - 20 ≤ (s.gpr .esp).toNat ∧ (s.gpr .esp).toNat + 24 ≤ 2 ^ 32 - post s s' := ∀ k0, k0.length = 64 → - Repr s.mem ((arg s 0).setWidth 64) (xorPad k0 ipad) → - Repr s.mem ((arg s 0).setWidth 64 + 96) (xorPad k0 opad) → - bytesAt s'.mem ((arg s 3).setWidth 64) 32 = - Spec.Pbkdf2.iterate (hmacBlockKey sha256 k0) (arg s 2).toNat - (bytesAt s.mem ((arg s 1).setWidth 64) 32) (bytesAt s.mem ((arg s 3).setWidth 64) 32) - pub s₁ s₂ := s₁.gpr .esp = s₂.gpr .esp ∧ ∀ i < 5, arg s₁ i = arg s₂ i - -end VG.Proof.Pbkdf2 - -namespace VG.Proof.Pbkdf2.X86 - -open VG VG.X86 VG.Impl.Pbkdf2.X86 -open VG.Impl.Sha256.X86 (at_) -open VG.Impl.Sha256.X86.Stream (compressAt saved) -open VG.Impl.Hmac.X86 (bswapWord copyWord) -open VG.Proof.Sha256.X86 (contains_offset) -open VG.Proof.Sha256.X86.Stream (Upd Mupd Fupd wp_mov wp_movi wp_movm wp_store wp_addi ea_at sub_offset - addr_toNat stk_eq) -open VG.Proof.Hmac.X86 (copyWords_ok bswapWords_ok) -open VG.Proof.Hmac.X86.Finalize (beWords_stateAt) -open VG.Proof.Hmac.Common (bytesAt_length bytesAt_writeBytes_sep bytesAt_add extractLsb'_read) -open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame writeBytes_append writeBytes_nil write_eq_writeBytes) -open VG.Proof.Pbkdf2.Memory (frame_bytesAt contains_base sep_after xorBytes_length add_ofNat - stateAt_copy) -open VG.Spec.Sha256 (bytesAt stateAt blockAt compress HashValue wordBytes) - -/-! ## The precondition -/ - -section -variable (s₀ : State) - -abbrev esp₀ : BitVec 32 := s₀.gpr .esp -abbrev key : BitVec 32 := arg s₀ 0 -abbrev uP : BitVec 32 := arg s₀ 1 -/-- The number of steps. -/ -abbrev nn : Nat := (arg s₀ 2).toNat -abbrev tP : BitVec 32 := arg s₀ 3 -abbrev scr : BitVec 32 := arg s₀ 4 -abbrev kA : Addr := (key s₀).setWidth 64 -abbrev uA : Addr := (uP s₀).setWidth 64 -abbrev tA : Addr := (tP s₀).setWidth 64 -abbrev scA : Addr := (scr s₀).setWidth 64 -abbrev keyR : Region := ⟨kA s₀, 192⟩ -abbrev uR : Region := ⟨uA s₀, 32⟩ -abbrev tR : Region := ⟨tA s₀, 32⟩ -abbrev scR : Region := ⟨scA s₀, 256⟩ -abbrev argR : Region := ⟨addr (esp₀ s₀) 4, 20⟩ -abbrev retR : Region := ⟨(esp₀ s₀).setWidth 64, 4⟩ -abbrev stkR : Region := below (esp₀ s₀) 20 - -/-- A part of the scratch space. -/ -abbrev sR (o n : Nat) : Region := ⟨scA s₀ + BitVec.ofNat 64 o, n⟩ -/-- `vg_sha256_compress`'s scratch space. -/ -abbrev cmpR : Region := ⟨scA s₀, 112⟩ -/-- `T`. -/ -abbrev TA : Addr := scA s₀ + BitVec.ofNat 64 160 -/-- The block. -/ -abbrev blkA : Addr := scA s₀ + BitVec.ofNat 64 192 - -end - -structure Pre (s₀ : State) : Prop where - rd : s₀.rd = [keyR s₀, uR s₀, argR s₀] - wr : s₀.wr = [tR s₀, scR s₀] - k_t : (keyR s₀).Disjoint (tR s₀) - k_s : (keyR s₀).Disjoint (scR s₀) - u_t : (uR s₀).Disjoint (tR s₀) - u_s : (uR s₀).Disjoint (scR s₀) - t_s : (tR s₀).Disjoint (scR s₀) - a_t : (argR s₀).Disjoint (tR s₀) - a_s : (argR s₀).Disjoint (scR s₀) - ret_t : (retR s₀).Disjoint (tR s₀) - ret_s : (retR s₀).Disjoint (scR s₀) - stk_k : (stkR s₀).Disjoint (keyR s₀) - stk_u : (stkR s₀).Disjoint (uR s₀) - stk_t : (stkR s₀).Disjoint (tR s₀) - stk_s : (stkR s₀).Disjoint (scR s₀) - key_fit : (key s₀).toNat + 192 ≤ 2 ^ 32 - u_fit : (uP s₀).toNat + 32 ≤ 2 ^ 32 - t_fit : (tP s₀).toNat + 32 ≤ 2 ^ 32 - scr_fit : (scr s₀).toNat + 256 ≤ 2 ^ 32 - sp_lo : 20 ≤ (esp₀ s₀).toNat - sp_fit : (esp₀ s₀).toNat + 24 ≤ 2 ^ 32 - -theorem pre_of {s₀ : State} (h : Proof.Pbkdf2.iterateSha256X86.pre s₀) : Pre s₀ := by - obtain ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15, h16, h17, h18, h19, h20, - h21⟩ := h - have e := stk_eq h20 - exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, - by show (below _ _).Disjoint _; rw [e]; exact h12, by show (below _ _).Disjoint _; rw [e]; exact h13, - by show (below _ _).Disjoint _; rw [e]; exact h14, by show (below _ _).Disjoint _; rw [e]; exact h15, - h16, h17, h18, h19, h20, h21⟩ - -/-! ## Regions -/ - -theorem toNat_ofNat_lt {k : Nat} (h : k < 2 ^ 64) : (BitVec.ofNat 64 k).toNat = k := by - rw [BitVec.toNat_ofNat, Nat.mod_eq_of_lt h] - -/-- Two parts of the scratch space at offsets `a` and `b` do not overlap. -/ -theorem scr_disj (s₀ : State) {a m b n : Nat} (h : a + m ≤ b ∨ b + n ≤ a) (ha : a + m ≤ 256) (hb : b + n ≤ 256) : - Region.Disjoint (sR s₀ a m) (sR s₀ b n) := by - intro x h₁ h₂ - simp only [Region.Contains] at h₁ h₂ - have ta : (BitVec.ofNat 64 a).toNat = a := toNat_ofNat_lt (by omega) - have tb : (BitVec.ofNat 64 b).toNat = b := toNat_ofNat_lt (by omega) - bv_omega - -theorem scr_disj0 (s₀ : State) {a m n : Nat} (h : n ≤ a) (ha : a + m ≤ 256) : - Region.Disjoint (sR s₀ a m) ⟨scA s₀, n⟩ := by - have := scr_disj s₀ (a := a) (m := m) (b := 0) (n := n) (by omega) ha (by omega) - simp only [sR] at this - simpa using this - -theorem scr_sub (s₀ : State) {o n : Nat} (h : o + n ≤ 256) : Region.Sub (sR s₀ o n) (scR s₀) := - sub_offset h (by omega) - -theorem cmp_sub (s₀ : State) : Region.Sub (cmpR s₀) (scR s₀) := Region.sub_prefix (by omega) - -theorem ofNat_zero (p : Addr) : p + BitVec.ofNat 64 0 = p := by simp - -/-- `[x + d]`, as an address, for `x` a pointer to a region of `len ≥ d` bytes. -/ -theorem addr_off {x : BitVec 32} {d len : Nat} (hx : x.toNat + len ≤ 2 ^ 32) (hd : d < len) : - addr x d = x.setWidth 64 + BitVec.ofNat 64 d := addr_eq (by omega) - -section -variable {s₀ : State} (hp : Pre s₀) {s : State} -include hp - -theorem in_scr (hwr : s.wr = s₀.wr) {a n : Nat} (h : a + n ≤ 256) : - InRegions s.wr (scA s₀ + BitVec.ofNat 64 a) n := - ⟨scR s₀, by simp [hwr, hp.wr], contains_offset h (by omega)⟩ - -theorem in_t (hwr : s.wr = s₀.wr) {b n : Nat} (h : b + n ≤ 32) : - InRegions s.wr (tA s₀ + BitVec.ofNat 64 b) n := - ⟨tR s₀, by simp [hwr, hp.wr], contains_offset (by omega) (by omega)⟩ - -theorem in_key (hrd : s.rd = s₀.rd) {a n : Nat} (h : a + n ≤ 192) : - InRegions (s.rd ++ s.wr) (kA s₀ + BitVec.ofNat 64 a) n := - ⟨keyR s₀, by simp [hrd, hp.rd], contains_offset h (by omega)⟩ - -theorem in_u (hrd : s.rd = s₀.rd) {a n : Nat} (h : a + n ≤ 32) : - InRegions (s.rd ++ s.wr) (uA s₀ + BitVec.ofNat 64 a) n := - ⟨uR s₀, by simp [hrd, hp.rd], contains_offset h (by omega)⟩ - -end - -theorem InRegions.right {rd wr : List Region} {a : Addr} {n : Nat} (h : InRegions wr a n) : - InRegions (rd ++ wr) a n := by - obtain ⟨r, hr, hc⟩ := h; exact ⟨r, List.mem_append_right _ hr, hc⟩ - -theorem key_disj {s₀ : State} (hp : Pre s₀) : - ∀ r ∈ [tR s₀, scR s₀, stkR s₀], Region.Disjoint (keyR s₀) r := by - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact hp.k_t - · exact hp.k_s - · exact hp.stk_k.symm - -/-! ## The registers and memory during a step -/ - -/-- The registers the body keeps. -/ -def kept : List Reg := [.ebx, .ebp, .esi, .edi, .esp] - -/-- From `s` to `s'`, only `t` (the hash value being compressed), the -compression's part of the scratch space and the stack below `esp` changed. -/ -structure Keep (s₀ s s' : State) : Prop where - rd : s'.rd = s.rd - wr : s'.wr = s.wr - gpr : ∀ r ∈ kept, s'.gpr r = s.gpr r - frame : Frame [tR s₀, cmpR s₀, stkR s₀] s.mem s'.mem - -theorem Keep.trans {s₀ s₁ s₂ s₃ : State} (h₁ : Keep s₀ s₁ s₂) (h₂ : Keep s₀ s₂ s₃) : Keep s₀ s₁ s₃ := - ⟨h₂.rd.trans h₁.rd, h₂.wr.trans h₁.wr, fun r hr => (h₂.gpr r hr).trans (h₁.gpr r hr), - h₁.frame.trans h₂.frame⟩ - -/-- The registers and memory at the start of each step. -/ -structure Regs (s₀ s : State) : Prop where - rd : s.rd = s₀.rd - wr : s.wr = s₀.wr - esp : s.gpr .esp = esp₀ s₀ - ebx : s.gpr .ebx = tP s₀ - ebp : s.gpr .ebp = scr s₀ - esi : s.gpr .esi = key s₀ - frame : Frame [tR s₀, scR s₀, stkR s₀] s₀.mem s.mem - -theorem Regs.keep {s₀ s s' : State} (h : Regs s₀ s) (hk : Keep s₀ s s') : Regs s₀ s' where - rd := hk.rd.trans h.rd - wr := hk.wr.trans h.wr - esp := (hk.gpr _ (by simp [kept])).trans h.esp - ebx := (hk.gpr _ (by simp [kept])).trans h.ebx - ebp := (hk.gpr _ (by simp [kept])).trans h.ebp - esi := (hk.gpr _ (by simp [kept])).trans h.esi - frame := h.frame.trans (hk.frame.sub fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact ⟨tR s₀, by simp, fun _ h => h⟩ - · exact ⟨scR s₀, by simp, cmp_sub s₀⟩ - · exact ⟨stkR s₀, by simp, fun _ h => h⟩) - -theorem Regs.write {s₀ s s' : State} (h : Regs s₀ s) (hg : ∀ r ∈ [Reg.ebx, .ebp, .esi, .esp], s'.gpr r = s.gpr r) - (hrd : s'.rd = s.rd) (hwr : s'.wr = s.wr) {R : Region} (hR : R ∈ [tR s₀, scR s₀]) - (hm : Frame [R] s.mem s'.mem) : Regs s₀ s' where - rd := hrd.trans h.rd - wr := hwr.trans h.wr - esp := (hg _ (by simp)).trans h.esp - ebx := (hg _ (by simp)).trans h.ebx - ebp := (hg _ (by simp)).trans h.ebp - esi := (hg _ (by simp)).trans h.esi - frame := h.frame.trans (hm.mono (by simp at hR ⊢; rcases hR with rfl | rfl <;> simp)) - -/-- The key's bytes are as on entry. -/ -theorem Regs.key_bytes {s₀ s : State} (hp : Pre s₀) (h : Regs s₀ s) {i : Nat} (hi : i < 192) : - s.mem (kA s₀ + BitVec.ofNat 64 i) = s₀.mem (kA s₀ + BitVec.ofNat 64 i) := - h.frame.bytes (R := keyR s₀) (key_disj hp) (by simp) hi - -/-! ## Loading a hash value of the key into `t` -/ - -/-- Loading the hash value at `key + o` into `t`. -/ -theorem load_ok {s₀ : State} (hp : Pre s₀) {s : State} (h : Regs s₀ s) {o : Nat} (ho : o + 32 ≤ 192) - {rest : List Instr} {Q : State → Prop} - (k : ∀ s', Keep s₀ s s' → stateAt s'.mem (tA s₀) = stateAt s₀.mem (kA s₀ + BitVec.ofNat 64 o) → - WP isa (.block rest) s' Q) : - WP isa (.block (load o ++ rest)) s Q := by - have := hp.key_fit; have := hp.t_fit - unfold load - refine copyWords_ok (src := .esi) (dst := .ebx) (by decide) (by decide) (o₁ := o) (o₂ := 0) 8 - rest s Q h.esi h.ebx (by omega) (by omega) - (fun j hj => by rw [addr_off (len := 192) hp.key_fit (by omega)]; exact in_key hp h.rd (by omega)) - (fun j hj => by rw [addr_off (len := 32) hp.t_fit (by omega)]; exact in_t hp h.wr (by omega)) - ?_ fun s' g' rd' wr' m' => k s' ⟨rd', wr', fun r hr => g' r (by - simp only [kept, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl <;> decide), ?_⟩ ?_ - · exact Region.Disjoint.sep hp.k_t (contains_offset (by omega) (by omega)) - (contains_offset (by omega) (by omega)) - · rw [m'] - refine writeBytes_frame _ _ _ (R := tR s₀) ?_ |>.mono (by simp) - rw [bytesAt_length, ofNat_zero]; exact contains_base (Nat.le_refl _) - · rw [m', ofNat_zero, show 4 * 8 = 32 from rfl, stateAt_copy] - apply Proof.Sha256.Stream.stateAt_congr - intro i hi - rw [add_ofNat] - exact h.key_bytes hp (by omega) - -/-! ## A call of `vg_sha256_compress` on the block -/ - -/-- `eax` at the block. -/ -theorem atBlock_ok {s₀ : State} {s : State} (h : Regs s₀ s) {rest : List Instr} {Q : State → Prop} - (k : ∀ s', Keep s₀ s s' → s'.mem = s.mem → s'.gpr .eax = scr s₀ + BitVec.ofNat 32 192 → - WP isa (.block rest) s' Q) : - WP isa (.block (atBlock ++ rest)) s Q := by - have ne : ∀ r ∈ kept, r ≠ .eax := by - intro r hr - simp only [kept, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl <;> decide - refine wp_mov fun s₁ u₁ => wp_addi fun s₂ u₂ => k s₂ ⟨by rw [u₂.rd, u₁.rd], by rw [u₂.wr, u₁.wr], - fun r hr => by rw [u₂.other r (ne r hr), u₁.other r (ne r hr)], by rw [u₂.mem, u₁.mem]; exact Frame.refl _ _⟩ - (by rw [u₂.mem, u₁.mem]) (by rw [u₂.gpr, u₁.gpr, h.ebp]; rfl) - -/-! ## The digest into the block -/ - -/-- The digest of the hash value in `t` into the block. -/ -theorem digest_ok {s₀ : State} (hp : Pre s₀) {s : State} (h : Regs s₀ s) {rest : List Instr} {Q : State → Prop} - (k : ∀ s', Regs s₀ s' → (∀ r, r ≠ .ecx → s'.gpr r = s.gpr r) → Frame [sR s₀ 192 32] s.mem s'.mem → - s'.mem = writeBytes s.mem (blkA s₀) (Pbkdf2.digest (stateAt s.mem (tA s₀))) → - WP isa (.block rest) s' Q) : - WP isa (.block (Impl.Pbkdf2.X86.digest ++ rest)) s Q := by - have := hp.scr_fit; have := hp.t_fit - unfold Impl.Pbkdf2.X86.digest - refine bswapWords_ok (src := .ebx) (dst := .ebp) (by decide) (by decide) (o₁ := 0) (o₂ := 192) 8 rest s Q - h.ebx h.ebp (by omega) (by omega) - (fun j hj => by rw [addr_off (len := 32) hp.t_fit (by omega)]; exact InRegions.right (in_t hp h.wr (by omega))) - (fun j hj => by rw [addr_off (len := 256) hp.scr_fit (by omega)]; exact in_scr hp h.wr (by omega)) - (Region.Disjoint.sep (hp.t_s.sub_right (scr_sub s₀ (o := 192) (n := 32) (by omega))) - (by rw [ofNat_zero]; exact contains_base (Nat.le_refl _)) (contains_base (Nat.le_refl _))) - fun s' g' rd' wr' m' => ?_ - rw [beWords_stateAt _ hp.t_fit] at m' - change s'.mem = writeBytes s.mem (blkA s₀) (Pbkdf2.digest (stateAt s.mem (tA s₀))) at m' - have hf : Frame [sR s₀ 192 32] s.mem s'.mem := by - rw [m']; exact writeBytes_frame _ _ _ (contains_base (by rw [Pbkdf2.digest_length])) - exact k s' (h.write (fun r hr => g' r (by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl <;> decide)) rd' wr' (R := scR s₀) (by simp) (hf.sub fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - subst hr; exact ⟨scR s₀, by simp, scr_sub s₀ (by omega)⟩)) g' hf m' - -/-! ## `T ← T ⊕ U` -/ - -/-- `xor d, [m]` -/ -theorem wp_xorm {is : List Instr} {s : State} {Q : State → Prop} {d : Reg} {m : MemOp} {a : Addr} - (ha : s.ea m = a) (hin : InRegions (s.rd ++ s.wr) a 4) - (k : ∀ s', Upd s s' d (s.gpr d ^^^ s.mem.readW a 32) → WP isa (.block is) s' Q) : - WP isa (.block (.alu .xor d (.mem m) :: is)) s Q := by - refine VG.Proof.Sha256.X86.Stream.WP.cons - (s' := (arithFlags s (s.gpr d ^^^ s.mem.readW a 32) false false).setReg d (s.gpr d ^^^ s.mem.readW a 32)) - ?_ (k _ (Upd.flags _ _ _ _ _ _)) - simp [exec, execAlu, readSrc, State.load32, ha, hin] - -theorem writeW_xor32 (m m' : Mem) (d a b : Addr) : - m.writeW d (m'.readW a 32 ^^^ m'.readW b 32) = - writeBytes m d (Spec.Pbkdf2.xorBytes (bytesAt m' a 4) (bytesAt m' b 4)) := by - simp only [Mem.writeW, Mem.readW] - rw [show (32 : Nat) / 8 = 4 from rfl, BitVec.setWidth_eq, BitVec.setWidth_eq, BitVec.setWidth_eq, - write_eq_writeBytes] - congr 1 - apply List.ext_getElem (by simp [Spec.Pbkdf2.xorBytes, bytesAt]) - intro j h₁ h₂ - simp only [List.length_map, List.length_range] at h₁ - simp only [Spec.Pbkdf2.xorBytes, bytesAt, List.getElem_map, List.getElem_range, List.getElem_zipWith] - rw [BitVec.extractLsb'_xor, extractLsb'_read _ _ h₁, extractLsb'_read _ _ h₁] - -theorem add_off (a : Addr) (o j : Nat) : - a + BitVec.ofNat 64 (o + j) = a + BitVec.ofNat 64 o + BitVec.ofNat 64 j := (add_ofNat a o j).symm - -/-- `T ← T ⊕ U` for the first `n` words of `T` at `p + 160` and `U` at `p + 192`. -/ -theorem xor_ok {p : BitVec 32} (fp : p.toNat + 224 ≤ 2 ^ 32) : - ∀ n ≤ 8, ∀ (rest : List Instr) (s : State) (Q : State → Prop), s.gpr .ebp = p → - (∀ k < 8, InRegions (s.rd ++ s.wr) (p.setWidth 64 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * k)) 4) → - (∀ k < 8, InRegions s.wr (p.setWidth 64 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * k)) 4) → - (∀ s', (∀ r, r ≠ .ecx → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → - s'.mem = writeBytes s.mem (p.setWidth 64 + BitVec.ofNat 64 160) - (Spec.Pbkdf2.xorBytes (bytesAt s.mem (p.setWidth 64 + BitVec.ofNat 64 160) (4 * n)) - (bytesAt s.mem (p.setWidth 64 + BitVec.ofNat 64 192) (4 * n))) → - WP isa (.block rest) s' Q) → - WP isa (.block ((List.range n).flatMap xorW ++ rest)) s Q := by - intro n - induction n with - | zero => - intro _ rest s Q _ _ _ k - exact k s (fun _ _ => rfl) rfl rfl (by simp [bytesAt, Spec.Pbkdf2.xorBytes, writeBytes_nil]) - | succ n ih => - intro hn rest s Q hb hin hout k - rw [List.range_succ, List.flatMap_append, List.flatMap_singleton, List.append_assoc] - refine ih (by omega) _ s Q hb hin hout fun s₁ g₁ rd₁ wr₁ m₁ => ?_ - simp only [xorW, List.cons_append, List.nil_append] - have hw := hout n (by omega) - have eb : s₁.gpr .ebp = p := by rw [g₁ _ (by decide), hb] - have eT : addr p (160 + 4 * n) = p.setWidth 64 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * n) := by - rw [addr_eq (by omega), add_off] - have eU : addr p (192 + 4 * n) = p.setWidth 64 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * n) := by - rw [addr_eq (by omega), add_off] - refine wp_movm (a := p.setWidth 64 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * n)) - (by rw [ea_at, eb, eT]) (by rw [rd₁, wr₁]; exact InRegions.right hw) fun s₂ u₂ => ?_ - refine wp_xorm (a := p.setWidth 64 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * n)) - (by rw [ea_at, u₂.other _ (by decide), eb, eU]) - (by rw [u₂.rd, u₂.wr, rd₁, wr₁]; exact hin n (by omega)) fun s₃ u₃ => ?_ - refine wp_store (a := p.setWidth 64 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * n)) - (by rw [ea_at, u₃.other _ (by decide), u₂.other _ (by decide), eb, eT]) - (by rw [u₃.wr, u₂.wr, wr₁]; exact hw) - fun s₄ g₄ => k s₄ (fun r hr => by - rw [g₄.gpr, u₃.other r hr, u₂.other r hr, g₁ r hr]) - (by rw [g₄.rd, u₃.rd, u₂.rd, rd₁]) (by rw [g₄.wr, u₃.wr, u₂.wr, wr₁]) ?_ - have hl : (Spec.Pbkdf2.xorBytes (bytesAt s.mem (p.setWidth 64 + BitVec.ofNat 64 160) (4 * n)) - (bytesAt s.mem (p.setWidth 64 + BitVec.ofNat 64 192) (4 * n))).length = 4 * n := by - rw [xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length] - have v : s₃.gpr .ecx = - s₁.mem.readW (p.setWidth 64 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * n)) 32 ^^^ - s₁.mem.readW (p.setWidth 64 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * n)) 32 := by - rw [u₃.gpr, u₂.gpr, u₂.mem] - have hpT := addr_toNat p - rw [g₄.mem, u₃.mem, u₂.mem, v, writeW_xor32, m₁, - bytesAt_writeBytes_sep (p := p.setWidth 64 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * n)), - bytesAt_writeBytes_sep (p := p.setWidth 64 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * n))] - · have e := writeBytes_append s.mem (p.setWidth 64 + BitVec.ofNat 64 160) _ - (Spec.Pbkdf2.xorBytes - (bytesAt s.mem (p.setWidth 64 + BitVec.ofNat 64 160 + BitVec.ofNat 64 (4 * n)) 4) - (bytesAt s.mem (p.setWidth 64 + BitVec.ofNat 64 192 + BitVec.ofNat 64 (4 * n)) 4)) - (by rw [hl, xorBytes_length _ _ (by simp [bytesAt]), bytesAt_length]; omega) - rw [hl] at e - rw [e, Nat.mul_succ, bytesAt_add, bytesAt_add, Spec.Pbkdf2.xorBytes, Spec.Pbkdf2.xorBytes, - Spec.Pbkdf2.xorBytes, List.zipWith_append (by simp [bytesAt])] - · intro x h₁ h₂ - rw [hl] at h₂ - have := toNat_ofNat_lt (k := 4 * n) (by omega) - bv_omega - · omega - · intro x h₁ h₂ - rw [hl] at h₂ - exact sep_after h₁ h₂ (by omega) - · omega - -end VG.Proof.Pbkdf2.X86 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/X86/Iterate.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/X86/Iterate.lean deleted file mode 100644 index 8bccb8571..000000000 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/X86/Iterate.lean +++ /dev/null @@ -1,560 +0,0 @@ -import VerifiedGarbage.Proof.Pbkdf2.X86.Body -import VerifiedGarbage.Proof.Framework.Contract -import VerifiedGarbage.Proof.Framework.X86.Inline -import VerifiedGarbage.Spec.Pbkdf2.Contract - -/-! -# PBKDF2-HMAC-SHA-256's iteration on x86 (32-bit) - -The compressor-dependent correctness proof is generic in -`Proof/Pbkdf2/Sha256/X86.lean`; this module keeps the shared prologue, epilogue, -contract and scalar constant-time facts. Constant time is proven by the taint -analysis: the argument words holding `t` and `scratch` are the bases of the two -writable regions, and the code keeps them in `ebx` and `ebp` across the calls, -so the registers `vg_sha256_compress` saves in its scratch space and restores -are known to keep their public values. The proof is written against a contract -under which the code only reads its arguments (which it does), and moved to the -shared contract with `Verified.narrowTo`. --/ - -namespace VG.Proof.Pbkdf2.X86 - -open VG VG.X86 VG.Impl.Pbkdf2.X86 -open VG.Impl.Sha256.X86 (at_) -open VG.Impl.Sha256.X86.Stream (saved save restore) -open VG.Impl.Hmac.X86 (copyWord) -open VG.Proof.Sha256.X86 (contains_offset) -open VG.Proof.Sha256.X86.Stream (Upd Mupd Fupd wp_mov wp_movi wp_movm wp_store wp_test ea_at addr_toNat - readW_writeW_addr ofNat_beq_zero) -open VG.Proof.Hmac.X86 (copyWords_ok) -open VG.Proof.Hmac.Common (bytesAt_length bytesAt_writeBytes_self bytesAt_writeBytes_sep) -open VG.Proof.Sha256.Stream (writeBytes writeBytes_frame writeBytes_nil) -open VG.Proof.Pbkdf2.Memory (frame_bytesAt contains_base writeW_bytes writeBytes_append' iterate_congr - add_ofNat) -open VG.Spec.Sha256 (bytesAt stateAt Repr) -open VG.Spec.Hmac (xorPad ipad opad hmacBlockKey sha256) - -/-! ## Arguments and the return address -/ - -theorem arg_sub {s₀ : State} (hp : Pre s₀) {d : Nat} (hd₁ : 4 ≤ d) (hd : d + 4 ≤ 24) : - Region.Sub ⟨addr (esp₀ s₀) d, 4⟩ (argR s₀) := by - have := hp.sp_fit - intro a ha - simp only [Region.Contains] at ha ⊢ - rw [addr_eq (by omega)] at ha - rw [addr_eq (by omega)] - generalize (esp₀ s₀).setWidth 64 = b at * - bv_omega - -theorem arg_in {s₀ : State} (hp : Pre s₀) {d : Nat} (hd₁ : 4 ≤ d) (hd : d + 4 ≤ 24) : - (argR s₀).Contains (addr (esp₀ s₀) d) 4 := by - have := hp.sp_fit - simp only [Region.Contains] - rw [addr_eq (by omega), addr_eq (by omega), - show (esp₀ s₀).setWidth 64 + BitVec.ofNat 64 d - ((esp₀ s₀).setWidth 64 + BitVec.ofNat 64 4) = - BitVec.ofNat 64 (d - 4) by - rw [show d = (d - 4) + 4 by omega, BitVec.ofNat_add]; bv_omega, - BitVec.toNat_ofNat, Nat.mod_eq_of_lt (by omega)] - omega - -theorem ret_stk {s₀ : State} (hp : Pre s₀) : (retR s₀).Disjoint (stkR s₀) := by - have := hp.sp_fit; have := hp.sp_lo - intro a h₁ h₂ - simp only [Region.Contains] at h₁ h₂ - rw [Taint.sub_setWidth (by omega)] at h₂ - have hE : ((esp₀ s₀).setWidth 64).toNat = (esp₀ s₀).toNat := addr_toNat _ - generalize (esp₀ s₀).setWidth 64 = b at * - bv_omega - -/-! ## Saving our caller's registers -/ - -/-- The memory after saving our caller's registers. -/ -def saveMem (s₀ : State) : Mem := - (((s₀.mem.writeW (addr (scr s₀) 112) (s₀.gpr .ebx)).writeW (addr (scr s₀) 116) (s₀.gpr .esi)).writeW - (addr (scr s₀) 120) (s₀.gpr .edi)).writeW (addr (scr s₀) 124) (s₀.gpr .ebp) - -theorem saveMem_frame {s₀ : State} (hp : Pre s₀) : Frame [scR s₀] s₀.mem (saveMem s₀) := by - have c : ∀ d, d + 4 ≤ 256 → (scR s₀).Contains (addr (scr s₀) d) (32 / 8) := fun d hd => by - rw [addr_off (len := 256) hp.scr_fit (by omega)]; exact contains_offset hd (by omega) - simp only [saveMem] - exact ((((Frame.refl _ _).writeW (List.mem_singleton_self _) _ (c 112 (by omega))).writeW - (List.mem_singleton_self _) _ (c 116 (by omega))).writeW (List.mem_singleton_self _) _ - (c 120 (by omega))).writeW (List.mem_singleton_self _) _ (c 124 (by omega)) - -theorem saveMem_saved {s₀ : State} (hp : Pre s₀) : Saved s₀ (saveMem s₀) := by - have hs := hp.scr_fit - have w : ∀ (m : Mem) (v : BitVec 32) (d e : Nat), d + 4 ≤ 256 → e + 4 ≤ 256 → d + 4 ≤ e ∨ e + 4 ≤ d → - (m.writeW (addr (scr s₀) e) v).readW (addr (scr s₀) d) 32 = m.readW (addr (scr s₀) d) 32 := - fun m v d e h₁ h₂ h => readW_writeW_addr m v (by omega) (by omega) h - intro p hp' - have ha : scA s₀ + BitVec.ofNat 64 p.2 = addr (scr s₀) p.2 := by - have := saved_off hp' - exact (addr_off (len := 256) hp.scr_fit (by omega)).symm - rw [ha] - simp only [saved, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl | rfl <;> simp only [saveMem] - · rw [w _ _ 112 124 (by omega) (by omega) (by omega), w _ _ 112 120 (by omega) (by omega) (by omega), - w _ _ 112 116 (by omega) (by omega) (by omega), Mem.readW_writeW_self32] - · rw [w _ _ 116 124 (by omega) (by omega) (by omega), w _ _ 116 120 (by omega) (by omega) (by omega), - Mem.readW_writeW_self32] - · rw [w _ _ 120 124 (by omega) (by omega) (by omega), Mem.readW_writeW_self32] - · rw [Mem.readW_writeW_self32] - -/-! ## The padding -/ - -/-- A word stored right after bytes written before. -/ -theorem writeW_append (m : Mem) (q : Addr) (xs ys : List Byte) (v : BitVec 32) {a : Addr} - (ha : a = q + BitVec.ofNat 64 xs.length) - (hv : ((List.range (32 / 8)).map fun j => (v.setWidth (8 * (32 / 8))).extractLsb' (8 * j) 8) = ys) - (hl : xs.length + ys.length < 2 ^ 64) : - (writeBytes m q xs).writeW a v = writeBytes m q (xs ++ ys) := by - rw [writeW_bytes _ _ v ys hv, writeBytes_append' _ _ _ ha hl] - -theorem padding_eq : padding = [.mov .ecx (.imm 0x80), .store (at_ .ebp 224) .ecx, .mov .ecx (.imm 0), - .store (at_ .ebp 228) .ecx, .store (at_ .ebp 232) .ecx, .store (at_ .ebp 236) .ecx, - .store (at_ .ebp 240) .ecx, .store (at_ .ebp 244) .ecx, .store (at_ .ebp 248) .ecx, - .mov .ecx (.imm 0x00030000), .store (at_ .ebp 252) .ecx] := rfl - -/-- A store of `ecx` at `[ebp + d]`, within the scratch space. -/ -theorem st_ok {s₀ : State} (hp : Pre s₀) {s : State} (hb : s.gpr .ebp = scr s₀) (hwr : s.wr = s₀.wr) - {d : Nat} (hd : d + 4 ≤ 256) {rest : List Instr} {Q : State → Prop} - (k : ∀ s', Mupd s s' (s.mem.writeW (scA s₀ + BitVec.ofNat 64 d) (s.gpr .ecx)) → WP isa (.block rest) s' Q) : - WP isa (.block (.store (at_ .ebp d) .ecx :: rest)) s Q := - wp_store (by rw [ea_at, hb]; exact addr_off (len := 256) hp.scr_fit (by omega)) (in_scr hp hwr hd) k - -/-- The padding into `scratch[224..256)`. -/ -theorem padding_ok {s₀ : State} (hp : Pre s₀) {s : State} (hb : s.gpr .ebp = scr s₀) (hwr : s.wr = s₀.wr) - {rest : List Instr} {Q : State → Prop} - (k : ∀ s', (∀ r, r ≠ .ecx → s'.gpr r = s.gpr r) → s'.rd = s.rd → s'.wr = s.wr → - s'.mem = writeBytes s.mem (scA s₀ + BitVec.ofNat 64 224) pad96 → WP isa (.block rest) s' Q) : - WP isa (.block (padding ++ rest)) s Q := by - simp only [padding_eq, List.cons_append, List.nil_append] - let P := scA s₀ + BitVec.ofNat 64 224 - refine wp_movi fun s₁ u₁ => ?_ - have c₁ : s₁.gpr .ebp = scr s₀ := by rw [u₁.other _ (by decide), hb] - refine st_ok hp c₁ (u₁.wr.trans hwr) (d := 224) (by omega) fun s₂ g₂ => ?_ - refine wp_movi fun s₃ u₃ => ?_ - have c₃ : s₃.gpr .ebp = scr s₀ := by rw [u₃.other _ (by decide), g₂.gpr, c₁] - have w₃ : s₃.wr = s₀.wr := by rw [u₃.wr, g₂.wr, u₁.wr, hwr] - have z₃ : s₃.gpr .ecx = 0 := u₃.gpr - refine st_ok hp c₃ w₃ (d := 228) (by omega) fun s₄ g₄ => ?_ - refine st_ok hp (by rw [g₄.gpr, c₃]) (by rw [g₄.wr, w₃]) (d := 232) (by omega) fun s₅ g₅ => ?_ - refine st_ok hp (by rw [g₅.gpr, g₄.gpr, c₃]) (by rw [g₅.wr, g₄.wr, w₃]) (d := 236) (by omega) fun s₆ g₆ => ?_ - refine st_ok hp (by rw [g₆.gpr, g₅.gpr, g₄.gpr, c₃]) (by rw [g₆.wr, g₅.wr, g₄.wr, w₃]) (d := 240) (by omega) - fun s₇ g₇ => ?_ - refine st_ok hp (by rw [g₇.gpr, g₆.gpr, g₅.gpr, g₄.gpr, c₃]) (by rw [g₇.wr, g₆.wr, g₅.wr, g₄.wr, w₃]) - (d := 244) (by omega) fun s₈ g₈ => ?_ - refine st_ok hp (by rw [g₈.gpr, g₇.gpr, g₆.gpr, g₅.gpr, g₄.gpr, c₃]) - (by rw [g₈.wr, g₇.wr, g₆.wr, g₅.wr, g₄.wr, w₃]) (d := 248) (by omega) fun s₉ g₉ => ?_ - refine wp_movi fun s₁₀ u₁₀ => ?_ - refine st_ok hp (by rw [u₁₀.other _ (by decide), g₉.gpr, g₈.gpr, g₇.gpr, g₆.gpr, g₅.gpr, g₄.gpr, c₃]) - (by rw [u₁₀.wr, g₉.wr, g₈.wr, g₇.wr, g₆.wr, g₅.wr, g₄.wr, w₃]) (d := 252) (by omega) fun s₁₁ g₁₁ => ?_ - have G : ∀ r, r ≠ .ecx → s₁₁.gpr r = s.gpr r := fun r hr => by - rw [g₁₁.gpr, u₁₀.other r hr, g₉.gpr, g₈.gpr, g₇.gpr, g₆.gpr, g₅.gpr, g₄.gpr, u₃.other r hr, g₂.gpr, - u₁.other r hr] - refine k s₁₁ G (by rw [g₁₁.rd, u₁₀.rd, g₉.rd, g₈.rd, g₇.rd, g₆.rd, g₅.rd, g₄.rd, u₃.rd, g₂.rd, u₁.rd]) - (by rw [g₁₁.wr, u₁₀.wr, g₉.wr, g₈.wr, g₇.wr, g₆.wr, g₅.wr, g₄.wr, u₃.wr, g₂.wr, u₁.wr]) ?_ - have e : ∀ o : Nat, scA s₀ + BitVec.ofNat 64 (224 + o) = P + BitVec.ofNat 64 o := fun o => (add_ofNat _ _ _).symm - have e₂ : s₂.mem = writeBytes s.mem P ([] ++ [0x80, 0, 0, 0]) := by - rw [g₂.mem, u₁.gpr, u₁.mem, ← writeBytes_nil s.mem P] - exact writeW_append _ _ _ _ _ (by simp [P]) (by decide) (by decide) - have e₄ : s₄.mem = writeBytes s.mem P ([0x80, 0, 0, 0] ++ [0, 0, 0, 0]) := by - rw [g₄.mem, z₃, u₃.mem, e₂]; exact writeW_append _ _ _ _ _ (e 4) (by decide) (by decide) - have e₅ : s₅.mem = writeBytes s.mem P ([0x80, 0, 0, 0, 0, 0, 0, 0] ++ [0, 0, 0, 0]) := by - rw [g₅.mem, g₄.gpr, z₃, e₄]; exact writeW_append _ _ _ _ _ (e 8) (by decide) (by decide) - have e₆ : s₆.mem = writeBytes s.mem P ([0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] ++ [0, 0, 0, 0]) := by - rw [g₆.mem, g₅.gpr, g₄.gpr, z₃, e₅]; exact writeW_append _ _ _ _ _ (e 12) (by decide) (by decide) - have e₇ : s₇.mem = writeBytes s.mem P ([0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] ++ [0, 0, 0, 0]) := by - rw [g₇.mem, g₆.gpr, g₅.gpr, g₄.gpr, z₃, e₆]; exact writeW_append _ _ _ _ _ (e 16) (by decide) (by decide) - have e₈ : s₈.mem = writeBytes s.mem P - ([0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] ++ [0, 0, 0, 0]) := by - rw [g₈.mem, g₇.gpr, g₆.gpr, g₅.gpr, g₄.gpr, z₃, e₇] - exact writeW_append _ _ _ _ _ (e 20) (by decide) (by decide) - have e₉ : s₉.mem = writeBytes s.mem P - ([0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] ++ [0, 0, 0, 0]) := by - rw [g₉.mem, g₈.gpr, g₇.gpr, g₆.gpr, g₅.gpr, g₄.gpr, z₃, e₈] - exact writeW_append _ _ _ _ _ (e 24) (by decide) (by decide) - rw [g₁₁.mem, u₁₀.gpr, u₁₀.mem, e₉] - exact writeW_append _ _ _ _ _ (e 28) (by decide) (by decide) - -/-! ## The prologue -/ - -theorem prologue_ok {s₀ : State} (hp : Pre s₀) : - WP isa (.block prologue) s₀ (fun s => Inv s₀ (nn s₀) s ∧ s.zf = some (decide (nn s₀ = 0))) := by - have := hp.scr_fit; have := hp.t_fit; have := hp.u_fit; have := hp.sp_fit - unfold prologue - simp only [save, saved, List.map_cons, List.map_nil, List.append_assoc, List.cons_append, List.nil_append] - have rin : ∀ (s : State), s.rd = s₀.rd → ∀ d, 4 ≤ d → d + 4 ≤ 24 → - InRegions (s.rd ++ s.wr) (addr (esp₀ s₀) d) 4 := - fun s h₁ d h₃ h₄ => ⟨argR s₀, by simp [h₁, hp.rd], arg_in hp h₃ h₄⟩ - have sin : ∀ (s : State), s.wr = s₀.wr → ∀ d, d + 4 ≤ 256 → InRegions s.wr (addr (scr s₀) d) 4 := - fun s h d hd => by rw [addr_off (len := 256) hp.scr_fit (by omega)]; exact in_scr hp h hd - -- Save our caller's registers. - refine wp_movm (a := addr (esp₀ s₀) 20) (ea_at _ _ _) (rin _ rfl 20 (by omega) (by omega)) fun s₁ u₁ => ?_ - have e₁ : s₁.gpr .eax = scr s₀ := u₁.gpr - refine wp_store (a := addr (scr s₀) 112) (by rw [ea_at, e₁]) (by rw [u₁.wr]; exact sin _ rfl 112 (by omega)) - fun s₂ u₂ => ?_ - refine wp_store (a := addr (scr s₀) 116) (by rw [ea_at, u₂.gpr, e₁]) - (by rw [u₂.wr, u₁.wr]; exact sin _ rfl 116 (by omega)) fun s₃ u₃ => ?_ - refine wp_store (a := addr (scr s₀) 120) (by rw [ea_at, u₃.gpr, u₂.gpr, e₁]) - (by rw [u₃.wr, u₂.wr, u₁.wr]; exact sin _ rfl 120 (by omega)) fun s₄ u₄ => ?_ - refine wp_store (a := addr (scr s₀) 124) (by rw [ea_at, u₄.gpr, u₃.gpr, u₂.gpr, e₁]) - (by rw [u₄.wr, u₃.wr, u₂.wr, u₁.wr]; exact sin _ rfl 124 (by omega)) fun s₅ u₅ => ?_ - have g₅ : s₅.gpr = s₁.gpr := by rw [u₅.gpr, u₄.gpr, u₃.gpr, u₂.gpr] - have m₅ : s₅.mem = saveMem s₀ := by - rw [u₅.mem, u₄.mem, u₃.mem, u₂.mem, u₄.gpr, u₃.gpr, u₂.gpr, u₁.mem, - u₁.other .ebx (by decide), u₁.other .esi (by decide), u₁.other .edi (by decide), u₁.other .ebp (by decide)] - rfl - have rd₅ : s₅.rd = s₀.rd := by rw [u₅.rd, u₄.rd, u₃.rd, u₂.rd, u₁.rd] - have wr₅ : s₅.wr = s₀.wr := by rw [u₅.wr, u₄.wr, u₃.wr, u₂.wr, u₁.wr] - have sp₅ : s₅.gpr .esp = esp₀ s₀ := by rw [g₅, u₁.other _ (by decide)] - -- The arguments, which the saves did not change. - have ld : ∀ e, 4 ≤ e → e + 4 ≤ 24 → - (saveMem s₀).readW (addr (esp₀ s₀) e) 32 = s₀.mem.readW (addr (esp₀ s₀) e) 32 := - fun e h₁ h₂ => (saveMem_frame hp).readW (Region.contains_self _ _) - (by simpa using hp.a_s.sub_left (arg_sub hp h₁ h₂)) (by decide) - refine wp_mov fun s₆ u₆ => ?_ - refine wp_movm (a := addr (esp₀ s₀) 4) (by rw [ea_at, u₆.other _ (by decide), sp₅]) - (by rw [u₆.rd, u₆.wr]; exact rin _ rd₅ 4 (by omega) (by omega)) fun s₇ u₇ => ?_ - refine wp_movm (a := addr (esp₀ s₀) 12) (by rw [ea_at, u₇.other _ (by decide), u₆.other _ (by decide), sp₅]) - (by rw [u₇.rd, u₇.wr, u₆.rd, u₆.wr]; exact rin _ rd₅ 12 (by omega) (by omega)) fun s₈ u₈ => ?_ - refine wp_movm (a := addr (esp₀ s₀) 16) - (by rw [ea_at, u₈.other _ (by decide), u₇.other _ (by decide), u₆.other _ (by decide), sp₅]) - (by rw [u₈.rd, u₈.wr, u₇.rd, u₇.wr, u₆.rd, u₆.wr]; exact rin _ rd₅ 16 (by omega) (by omega)) - fun s₉ u₉ => ?_ - refine wp_movm (a := addr (esp₀ s₀) 8) - (by rw [ea_at, u₉.other _ (by decide), u₈.other _ (by decide), u₇.other _ (by decide), u₆.other _ (by decide), - sp₅]) - (by rw [u₉.rd, u₉.wr, u₈.rd, u₈.wr, u₇.rd, u₇.wr, u₆.rd, u₆.wr]; exact rin _ rd₅ 8 (by omega) (by omega)) - fun s₁₀ u₁₀ => ?_ - have m₁₀ : s₁₀.mem = saveMem s₀ := by rw [u₁₀.mem, u₉.mem, u₈.mem, u₇.mem, u₆.mem, m₅] - have rd₁₀ : s₁₀.rd = s₀.rd := by rw [u₁₀.rd, u₉.rd, u₈.rd, u₇.rd, u₆.rd, rd₅] - have wr₁₀ : s₁₀.wr = s₀.wr := by rw [u₁₀.wr, u₉.wr, u₈.wr, u₇.wr, u₆.wr, wr₅] - have esp₁₀ : s₁₀.gpr .esp = esp₀ s₀ := by - rw [u₁₀.other _ (by decide), u₉.other _ (by decide), u₈.other _ (by decide), u₇.other _ (by decide), - u₆.other _ (by decide), sp₅] - have ebp₁₀ : s₁₀.gpr .ebp = scr s₀ := by - rw [u₁₀.other _ (by decide), u₉.other _ (by decide), u₈.other _ (by decide), u₇.other _ (by decide), u₆.gpr, - g₅, e₁] - have esi₁₀ : s₁₀.gpr .esi = key s₀ := by - rw [u₁₀.other _ (by decide), u₉.other _ (by decide), u₈.other _ (by decide), u₇.gpr, u₆.mem, m₅, - ld 4 (by omega) (by omega)]; rfl - have edi₁₀ : s₁₀.gpr .edi = arg s₀ 2 := by - rw [u₁₀.other _ (by decide), u₉.other _ (by decide), u₈.gpr, u₇.mem, u₆.mem, m₅, - ld 12 (by omega) (by omega)]; rfl - have ebx₁₀ : s₁₀.gpr .ebx = tP s₀ := by - rw [u₁₀.other _ (by decide), u₉.gpr, u₈.mem, u₇.mem, u₆.mem, m₅, ld 16 (by omega) (by omega)]; rfl - have edx₁₀ : s₁₀.gpr .edx = uP s₀ := by - rw [u₁₀.gpr, u₉.mem, u₈.mem, u₇.mem, u₆.mem, m₅, ld 8 (by omega) (by omega)]; rfl - -- `U` into the block. - refine copyWords_ok (src := .edx) (dst := .ebp) (by decide) (by decide) (o₁ := 0) (o₂ := 192) 8 _ s₁₀ _ - edx₁₀ ebp₁₀ (by omega) (by omega) - (fun j hj => by - rw [addr_off (d := 0 + 4 * j) (len := 32) hp.u_fit (by omega)]; exact in_u hp rd₁₀ (by omega)) - (fun j hj => by rw [addr_off (d := 192 + 4 * j) (len := 256) hp.scr_fit (by omega)]; exact in_scr hp wr₁₀ (by omega)) - (Region.Disjoint.sep hp.u_s (contains_offset (by omega) (by omega)) (contains_offset (by omega) (by omega))) - fun s₁₁ g₁₁ rd₁₁ wr₁₁ m₁₁ => ?_ - -- `T` into the scratch space. - refine copyWords_ok (src := .ebx) (dst := .ebp) (by decide) (by decide) (o₁ := 0) (o₂ := 160) 8 _ s₁₁ _ - (by rw [g₁₁ _ (by decide), ebx₁₀]) (by rw [g₁₁ _ (by decide), ebp₁₀]) (by omega) (by omega) - (fun j hj => by - rw [addr_off (d := 0 + 4 * j) (len := 32) hp.t_fit (by omega), wr₁₁]; exact InRegions.right (in_t hp wr₁₀ (by omega))) - (fun j hj => by rw [addr_off (d := 160 + 4 * j) (len := 256) hp.scr_fit (by omega), wr₁₁]; exact in_scr hp wr₁₀ (by omega)) - (Region.Disjoint.sep hp.t_s (contains_offset (by omega) (by omega)) (contains_offset (by omega) (by omega))) - fun s₁₂ g₁₂ rd₁₂ wr₁₂ m₁₂ => ?_ - refine padding_ok hp (by rw [g₁₂ _ (by decide), g₁₁ _ (by decide), ebp₁₀]) (by rw [wr₁₂, wr₁₁, wr₁₀]) - fun s₁₃ g₁₃ rd₁₃ wr₁₃ m₁₃ => ?_ - refine wp_test fun s₁₄ f₁₄ z₁₄ => WP.block_nil ?_ - have G : ∀ r, r ≠ .ecx → s₁₄.gpr r = s₁₀.gpr r := fun r h => by rw [f₁₄.gpr, g₁₃ r h, g₁₂ r h, g₁₁ r h] - simp only [BitVec.add_zero, Nat.reduceMul] at m₁₁ m₁₂ - have hm : s₁₄.mem = writeBytes (writeBytes (writeBytes s₁₀.mem (blkA s₀) (bytesAt s₁₀.mem (uA s₀) 32)) - (TA s₀) (bytesAt s₁₁.mem (tA s₀) 32)) (scA s₀ + BitVec.ofNat 64 224) pad96 := by - rw [f₁₄.mem, m₁₃, m₁₂, m₁₁] - have fU : Frame [sR s₀ 192 32, sR s₀ 160 32, sR s₀ 224 32] s₁₀.mem s₁₄.mem := by - rw [hm] - exact (((writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact contains_base (Nat.le_refl _))).mono - (by simp)).trans - ((writeBytes_frame _ _ _ (R := sR s₀ 160 32) (by rw [bytesAt_length]; exact contains_base (Nat.le_refl _))).mono - (by simp))).trans - ((writeBytes_frame _ _ _ (R := sR s₀ 224 32) (contains_base (by decide))).mono (by simp)) - have F₁₀ : Frame [scR s₀] s₀.mem s₁₀.mem := by rw [m₁₀]; exact saveMem_frame hp - have F' : Frame [scR s₀] s₀.mem s₁₄.mem := - F₁₀.trans (fU.sub fun r hr => by - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl <;> exact ⟨scR s₀, by simp, scr_sub s₀ (by omega)⟩) - have hU₁₀ : bytesAt s₁₀.mem (uA s₀) 32 = bytesAt s₀.mem (uA s₀) 32 := - frame_bytesAt F₁₀ (by simpa using hp.u_s) (by omega) - have hT₁₁ : bytesAt s₁₁.mem (tA s₀) 32 = bytesAt s₀.mem (tA s₀) 32 := by - rw [m₁₁, bytesAt_writeBytes_sep _ _ (Region.Disjoint.sep (hp.t_s.sub_right (scr_sub s₀ (o := 192) (n := 32) - (by omega))) (contains_base (Nat.le_refl _)) (by rw [bytesAt_length]; exact contains_base (Nat.le_refl _))) - (by omega)] - exact frame_bytesAt F₁₀ (by simpa using hp.t_s) (by omega) - have sep : ∀ {a b : Nat}, a + 32 ≤ b ∨ b + 32 ≤ a → a + 32 ≤ 256 → b + 32 ≤ 256 → ∀ xs : List Byte, - xs.length = 32 → Mem.Sep (scA s₀ + BitVec.ofNat 64 a) 32 (scA s₀ + BitVec.ofNat 64 b) xs.length := - fun h ha hb xs hx => Region.Disjoint.sep (scr_disj s₀ h ha hb) (contains_base (Nat.le_refl _)) - (by rw [hx]; exact contains_base (Nat.le_refl _)) - have hB : bytesAt s₁₄.mem (blkA s₀) 32 = bytesAt s₀.mem (uA s₀) 32 := by - rw [hm, bytesAt_writeBytes_sep _ _ (sep (a := 192) (b := 224) (by omega) (by omega) (by omega) _ rfl) (by omega), - bytesAt_writeBytes_sep _ _ (sep (a := 192) (b := 160) (by omega) (by omega) (by omega) _ - (bytesAt_length _ _ _)) (by omega)] - have := bytesAt_writeBytes_self s₁₀.mem (blkA s₀) (bytesAt s₁₀.mem (uA s₀) 32) (by rw [bytesAt_length]; omega) - rw [bytesAt_length] at this - rw [this, hU₁₀] - have hT : bytesAt s₁₄.mem (TA s₀) 32 = bytesAt s₀.mem (tA s₀) 32 := by - rw [hm, bytesAt_writeBytes_sep _ _ (sep (a := 160) (b := 224) (by omega) (by omega) (by omega) _ rfl) (by omega)] - have := bytesAt_writeBytes_self (writeBytes s₁₀.mem (blkA s₀) (bytesAt s₁₀.mem (uA s₀) 32)) (TA s₀) - (bytesAt s₁₁.mem (tA s₀) 32) (by rw [bytesAt_length]; omega) - rw [bytesAt_length] at this - rw [this, hT₁₁] - have hS : Saved s₀ s₁₄.mem := by - intro p hp' - have hb := saved_off hp' - rw [fU.readW (r := sR s₀ p.2 4) (Region.contains_self _ _) ?_ (by decide), m₁₀] - · exact saveMem_saved hp p hp' - · intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl <;> exact scr_disj s₀ (by omega) (by omega) (by omega) - have hn : arg s₀ 2 = BitVec.ofNat 32 (nn s₀) := by simp [nn] - refine ⟨⟨⟨by rw [f₁₄.rd, rd₁₃, rd₁₂, rd₁₁, rd₁₀], by rw [f₁₄.wr, wr₁₃, wr₁₂, wr₁₁, wr₁₀], - by rw [G _ (by decide), esp₁₀], by rw [G _ (by decide), ebx₁₀], by rw [G _ (by decide), ebp₁₀], - by rw [G _ (by decide), esi₁₀], F'.mono (by simp)⟩, by rw [G _ (by decide), edi₁₀, hn], hS, ?_, - (Nat.le_refl _), by rw [hB, hT]⟩, ?_⟩ - · rw [hm] - exact bytesAt_writeBytes_self _ (scA s₀ + BitVec.ofNat 64 224) pad96 (by decide) - · rw [z₁₄, ← f₁₄.gpr, G _ (by decide), edi₁₀, BitVec.and_self, hn, - ofNat_beq_zero (by have := (arg s₀ 2).isLt; simp only [nn]; omega)] - -/-! ## The epilogue -/ - -/-- The postcondition. -/ -def Post (s₀ s' : State) : Prop := abiPreserved s₀ s' ∧ Proof.Pbkdf2.iterateSha256X86.post s₀ s' - -/-- With the key's streaming states as the contract requires, a step is HMAC-SHA-256. -/ -theorem stepM_eq {s₀ : State} {k0 : List Byte} (hk : k0.length = 64) - (hi : Repr s₀.mem (kA s₀) (xorPad k0 ipad)) (ho : Repr s₀.mem (kA s₀ + 96) (xorPad k0 opad)) - {u : List Byte} (hu : u.length = 32) : - hmacBlockKey sha256 k0 u = stepM s₀ u := by - have li : (xorPad k0 ipad).length = 64 := by simp [xorPad, hk] - have lo : (xorPad k0 opad).length = 64 := by simp [xorPad, hk] - have ho1 : stateAt s₀.mem (kA s₀ + BitVec.ofNat 64 96) = _ := ho.1 - rw [hmac_step hk hu, stepM, Hi, Ho, ofNat_zero, hi.1, ho1, li, lo] - -theorem epilogue_ok {s₀ : State} (hp : Pre s₀) {s : State} (h : Inv s₀ 0 s) : - WP isa (.block epilogue) s (Post s₀) := by - have := hp.scr_fit; have := hp.t_fit - unfold epilogue - refine copyWords_ok (src := .ebp) (dst := .ebx) (by decide) (by decide) (o₁ := 160) (o₂ := 0) 8 _ s _ - h.ebp h.ebx (by omega) (by omega) - (fun j hj => by - rw [addr_off (d := 160 + 4 * j) (len := 256) hp.scr_fit (by omega)]; exact InRegions.right (in_scr hp h.wr (by omega))) - (fun j hj => by rw [addr_off (d := 0 + 4 * j) (len := 32) hp.t_fit (by omega)]; exact in_t hp h.wr (by omega)) - (Region.Disjoint.sep hp.t_s.symm (contains_offset (by omega) (by omega)) (contains_offset (by omega) (by omega))) - fun s₁ g₁ rd₁ wr₁ m₁ => ?_ - simp only [BitVec.add_zero, Nat.reduceMul] at m₁ - have fT : Frame [tR s₀] s.mem s₁.mem := by - rw [m₁]; exact writeBytes_frame _ _ _ (by rw [bytesAt_length]; exact contains_base (Nat.le_refl _)) - have sv : ∀ p ∈ saved, s₁.mem.readW (addr (scr s₀) p.2) 32 = s₀.gpr p.1 := by - intro p hp' - have hb := saved_off hp' - rw [← h.saved p hp', addr_off (len := 256) hp.scr_fit (by omega)] - exact fT.readW (r := sR s₀ p.2 4) (Region.contains_self _ _) - (by simpa using (hp.t_s.sub_right (scr_sub s₀ (o := p.2) (n := 4) (by omega))).symm) (by decide) - have rin : ∀ d, d + 4 ≤ 256 → InRegions (s₁.rd ++ s₁.wr) (addr (scr s₀) d) 4 := fun d hd => by - rw [rd₁, wr₁, addr_off (len := 256) hp.scr_fit (by omega)]; exact InRegions.right (in_scr hp h.wr hd) - simp only [restore, saved, List.map_cons, List.map_nil] - refine wp_mov fun s₂ u₂ => ?_ - have e₂ : s₂.gpr .eax = scr s₀ := by rw [u₂.gpr, g₁ _ (by decide), h.ebp] - refine wp_movm (a := addr (scr s₀) 112) (by rw [ea_at, e₂]) (by rw [u₂.rd, u₂.wr]; exact rin 112 (by omega)) - fun s₃ u₃ => ?_ - refine wp_movm (a := addr (scr s₀) 116) (by rw [ea_at, u₃.other _ (by decide), e₂]) - (by rw [u₃.rd, u₃.wr, u₂.rd, u₂.wr]; exact rin 116 (by omega)) fun s₄ u₄ => ?_ - refine wp_movm (a := addr (scr s₀) 120) (by rw [ea_at, u₄.other _ (by decide), u₃.other _ (by decide), e₂]) - (by rw [u₄.rd, u₄.wr, u₃.rd, u₃.wr, u₂.rd, u₂.wr]; exact rin 120 (by omega)) fun s₅ u₅ => ?_ - refine wp_movm (a := addr (scr s₀) 124) - (by rw [ea_at, u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), e₂]) - (by rw [u₅.rd, u₅.wr, u₄.rd, u₄.wr, u₃.rd, u₃.wr, u₂.rd, u₂.wr]; exact rin 124 (by omega)) - fun s₆ u₆ => WP.block_nil ?_ - have hm₆ : s₆.mem = s₁.mem := by rw [u₆.mem, u₅.mem, u₄.mem, u₃.mem, u₂.mem] - refine ⟨⟨fun r hr => ?_, ?_⟩, fun k0 hk hi ho => ?_⟩ - · simp only [calleeSaved, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl - · rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.gpr, u₂.mem] - exact sv (.ebx, 112) (by simp [saved]) - · rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.gpr, u₃.mem, u₂.mem] - exact sv (.esi, 116) (by simp [saved]) - · rw [u₆.other _ (by decide), u₅.gpr, u₄.mem, u₃.mem, u₂.mem] - exact sv (.edi, 120) (by simp [saved]) - · rw [u₆.gpr, u₅.mem, u₄.mem, u₃.mem, u₂.mem] - exact sv (.ebp, 124) (by simp [saved]) - · rw [u₆.other _ (by decide), u₅.other _ (by decide), u₄.other _ (by decide), u₃.other _ (by decide), - u₂.other _ (by decide), g₁ _ (by decide), h.esp] - · rw [hm₆] - refine (h.frame.trans (fT.mono (by simp))).readW (r := retR s₀) (Region.contains_self _ _) ?_ (by decide) - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - exacts [hp.ret_t, hp.ret_s, ret_stk hp] - · have := h.val - simp only [Spec.Pbkdf2.iterate] at this - have e : bytesAt s₆.mem (tA s₀) 32 = bytesAt s.mem (TA s₀) 32 := by - have := bytesAt_writeBytes_self s.mem (tA s₀) (bytesAt s.mem (TA s₀) 32) (by rw [bytesAt_length]; omega) - rw [bytesAt_length] at this - rw [hm₆, m₁, this] - show bytesAt s₆.mem (tA s₀) 32 = _ - rw [e, ← this] - exact (iterate_congr (fun u hu => stepM_eq hk hi ho hu) (fun u => Pbkdf2.digest_length _) _ _ _ - (bytesAt_length _ _ _)).symm - -/-! ## Correctness -/ - -/-! ## Constant time -/ - -/-- The initial taint: the stack arguments are public, the words holding `t` -and `scratch` are the base addresses of the writable regions, and the 20 -bytes below `esp` are outside them. -/ -def τ₀ : VG.X86.Taint.T := - { regs := .ofList [.esp], flags := false, lens := [32, 256], argLen := 24, - argBases := [(16, 0), (20, 1)], room := 20 } - -theorem wf₀ {s : State} (h : Proof.Pbkdf2.iterateSha256X86.pre s) : VG.X86.Taint.Wf τ₀ s := by - have hp := pre_of h - have ht := hp.t_fit; have hsc := hp.scr_fit; have hs := hp.sp_fit - have hlo := hp.sp_lo - obtain ⟨-, -, -, -, -, -, -, -, -, -, -, -, -, k1, k2, -⟩ := h - refine VG.X86.Taint.Wf.entryRoom rfl ⟨fun _ => ⟨by simp [hp.wr, τ₀], ?_, ?_⟩, - fun _ h => (List.not_mem_nil h).elim, fun _ h => (List.not_mem_nil h).elim, - fun _ => ⟨hs, ?_⟩, ?_⟩ fun _ => ⟨hlo, ?_⟩ - · simp only [hp.wr, List.pairwise_cons, List.mem_cons, List.not_mem_nil, or_false, forall_eq, - List.Pairwise.nil, and_true] - exact ⟨hp.t_s, fun _ h => h.elim⟩ - · simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) <;> simp only [BitVec.toNat_setWidth] <;> omega - · simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - · exact VG.X86.Taint.frame_disjoint (n := 20) (by omega) hp.ret_t hp.a_t - · exact VG.X86.Taint.frame_disjoint (n := 20) (by omega) hp.ret_s hp.a_s - · intro p hp' - simp only [τ₀, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl <;> refine ⟨by decide, ?_⟩ <;> - simp [VG.X86.Taint.region, hp.wr, addr, arg, argAddr] - · simp only [hp.wr, List.mem_cons, List.not_mem_nil, or_false] - rintro r (rfl | rfl) - exacts [k1, k2] - -theorem agree₀ {s₁ s₂ : State} (h₁ : Proof.Pbkdf2.iterateSha256X86.pre s₁) - (h₂ : Proof.Pbkdf2.iterateSha256X86.pre s₂) (hpub : Proof.Pbkdf2.iterateSha256X86.pub s₁ s₂) : - VG.X86.Taint.Agree τ₀ s₁ s₂ := by - obtain ⟨hesp, ha⟩ := hpub - have hp₁ := pre_of h₁; have hp₂ := pre_of h₂ - refine ⟨⟨fun r hr => ?_, fun h => nomatch h⟩, fun _ => ?_, wf₀ h₁, wf₀ h₂, - fun _ h => (List.not_mem_nil h).elim, fun _ h => (List.not_mem_nil h).elim, fun _ => hesp, - fun k h4 hk => ?_⟩ - · simp only [τ₀, RegSet.mem_ofList, List.mem_singleton] at hr - subst hr; exact hesp - · rw [hp₁.wr, hp₂.wr] - simp only [tR, scR, tA, scA, tP, scr, ha 3 (by omega), ha 4 (by omega)] - · simp only [τ₀] at hk - rw [show VG.X86.Taint.depth τ₀.stk = 0 from rfl, Nat.zero_add] - have f₁ : (s₁.gpr .esp).toNat + 24 ≤ 2 ^ 32 := hp₁.sp_fit - have f₂ : (s₂.gpr .esp).toNat + 24 ≤ 2 ^ 32 := hp₂.sp_fit - rw [VG.X86.Taint.argByte_eq f₁ h4 hk, VG.X86.Taint.argByte_eq f₂ h4 hk, - Mem.readW_byte s₁.mem _ (Nat.mod_lt _ (by omega)), Mem.readW_byte s₂.mem _ (Nat.mod_lt _ (by omega))] - exact congrArg _ (ha _ (by omega)) - -/-- Memory holding the arguments `0x1000, 0x2000, 0, 0x3000, 0x5000` at `0x4004`. -/ -def satMem : Mem := fun a => - if a = 0x4005 then 0x10 else if a = 0x4009 then 0x20 else if a = 0x4011 then 0x30 else - if a = 0x4015 then 0x50 else 0 - -/-- A state satisfying the precondition. -/ -def sat : State where - gpr r := match r with - | .esp => 0x4000 | _ => 0 - cf := none - zf := none - sf := none - of := none - mem := satMem - rd := [⟨0x1000, 192⟩, ⟨0x2000, 32⟩, ⟨0x4004, 20⟩] - wr := [⟨0x3000, 32⟩, ⟨0x5000, 256⟩] - -theorem sat_pre : Proof.Pbkdf2.iterateSha256X86.pre sat := by - have a0 : arg sat 0 = 0x1000 := by decide - have a1 : arg sat 1 = 0x2000 := by decide - have a3 : arg sat 3 = 0x3000 := by decide - have a4 : arg sat 4 = 0x5000 := by decide - have e : argAddr sat 0 = 0x4004 := by decide - simp only [Proof.Pbkdf2.iterateSha256X86, a0, a1, a3, a4, e] - refine ⟨rfl, rfl, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, by decide, by decide, by decide, - by decide, by decide, by decide⟩ <;> - · intro a h₁ h₂ - simp only [Region.Contains, sat] at h₁ h₂ - bv_omega - -theorem iterate_ct : ConstantTime isa Proof.Pbkdf2.iterateSha256X86.pre - Proof.Pbkdf2.iterateSha256X86.pub iterate := - VG.Taint.constantTime (A := taint) τ₀ (fun _ _ h₁ h₂ hp => agree₀ h₁ h₂ hp) (by taint_decide) - -/-! ## The shared contract -/ - -/-- `iterateSha256X86` with the 832 bytes of scratch of the shared contract -(sized for the x86-64 AVX2 compression function), of which the code uses -256, and its arguments writable, as the shared contract lets them be. -/ -def iterateWide : Contract isa := - { Proof.Pbkdf2.iterateSha256X86 with - pre := fun s => - let key : Region := ⟨(arg s 0).setWidth 64, 192⟩ - let u : Region := ⟨(arg s 1).setWidth 64, 32⟩ - let t : Region := ⟨(arg s 3).setWidth 64, 32⟩ - let scratch : Region := ⟨(arg s 4).setWidth 64, 832⟩ - let args : Region := ⟨argAddr s 0, 20⟩ - let ret : Region := ⟨(s.gpr .esp).setWidth 64, 4⟩ - let stack : Region := ⟨(s.gpr .esp).setWidth 64 - 20, 20⟩ - s.rd = [key, u] ∧ s.wr = [t, scratch, args] ∧ - key.Disjoint t ∧ key.Disjoint scratch ∧ u.Disjoint t ∧ u.Disjoint scratch ∧ t.Disjoint scratch ∧ - args.Disjoint t ∧ args.Disjoint scratch ∧ ret.Disjoint t ∧ ret.Disjoint scratch ∧ - stack.Disjoint key ∧ stack.Disjoint u ∧ stack.Disjoint t ∧ stack.Disjoint scratch ∧ - (arg s 0).toNat + 192 ≤ 2 ^ 32 ∧ (arg s 1).toNat + 32 ≤ 2 ^ 32 ∧ - (arg s 3).toNat + 32 ≤ 2 ^ 32 ∧ (arg s 4).toNat + 832 ≤ 2 ^ 32 ∧ - 20 ≤ (s.gpr .esp).toNat ∧ (s.gpr .esp).toNat + 24 ≤ 2 ^ 32 } - -/-- The regions `iterateSha256X86` lets the code read and write. -/ -def narrowRd (s : State) : List Region := - [⟨(arg s 0).setWidth 64, 192⟩, ⟨(arg s 1).setWidth 64, 32⟩, ⟨argAddr s 0, 20⟩] -def narrowWr (s : State) : List Region := [⟨(arg s 3).setWidth 64, 32⟩, ⟨(arg s 4).setWidth 64, 256⟩] - -/-- Rewrites the contracts at a narrowed state (`arg` does not unfold -cheaply). -/ -local macro "narrow" loc:(Lean.Parser.Tactic.location)? : tactic => - `(tactic| simp only [Proof.Pbkdf2.iterateSha256X86, VG.Proof.Pbkdf2.X86.iterateWide, - VG.Proof.Pbkdf2.X86.narrowRd, VG.Proof.Pbkdf2.X86.narrowWr, VG.X86.arg_withRegions, - VG.X86.argAddr_withRegions, VG.X86.State.withRegions_gpr, VG.X86.State.withRegions_mem, - VG.X86.State.withRegions_rd, VG.X86.State.withRegions_wr] $(loc)?) - -theorem iterateWide_pre (s : State) (h : iterateWide.pre s) : - Proof.Pbkdf2.iterateSha256X86.pre (s.withRegions (narrowRd s) (narrowWr s)) := by - obtain ⟨_, _, h₃, h₄, h₅, h₆, h₇, h₈, h₉, h₁₀, h₁₁, h₁₂, h₁₃, h₁₄, h₁₅, h₁₆, h₁₇, h₁₈, h₁₉, h₂₀, - h₂₁⟩ := h - narrow - exact ⟨trivial, trivial, h₃, h₄.sub_right (Region.sub_of_ble rfl), h₅, h₆.sub_right (Region.sub_of_ble rfl), - h₇.sub_right (Region.sub_of_ble rfl), h₈, h₉.sub_right (Region.sub_of_ble rfl), h₁₀, - h₁₁.sub_right (Region.sub_of_ble rfl), h₁₂, h₁₃, h₁₄, h₁₅.sub_right (Region.sub_of_ble rfl), h₁₆, h₁₇, - h₁₈, Region.end_le_of_ble rfl h₁₉, h₂₀, h₂₁⟩ - -/-- A state satisfying `iterateWide.pre`. -/ -def wideSat : State := - { sat with rd := [⟨0x1000, 192⟩, ⟨0x2000, 32⟩], wr := [⟨0x3000, 32⟩, ⟨0x5000, 832⟩, ⟨0x4004, 20⟩] } - -theorem iterateWide_implies : iterateWide.Implies (Spec.Pbkdf2.iterateSha256Contract X86.abi 20) := by - have a0 : arg wideSat 0 = 0x1000 := by decide - have a1 : arg wideSat 1 = 0x2000 := by decide - have a2 : arg wideSat 2 = 0 := by decide - have a3 : arg wideSat 3 = 0x3000 := by decide - have a4 : arg wideSat 4 = 0x5000 := by decide - have e : argAddr wideSat 0 = 0x4004 := by decide - have esp : wideSat.gpr .esp = 0x4000 := rfl - sig_implies [Spec.Pbkdf2.iterateSha256Contract, Spec.Pbkdf2.iterateSha256Sig, iterateWide, - Proof.Pbkdf2.iterateSha256X86, X86.abi, X86.argSlots, X86.argVal, X86.argBytes] - [a0, a1, a2, a3, a4, e, esp] using wideSat - -end VG.Proof.Pbkdf2.X86 diff --git a/lean/VerifiedGarbage/Proof/Scrypt/Arm/BlockMixVerified.lean b/lean/VerifiedGarbage/Proof/Scrypt/Arm/BlockMixVerified.lean index 933b8186a..41b4f0b76 100644 --- a/lean/VerifiedGarbage/Proof/Scrypt/Arm/BlockMixVerified.lean +++ b/lean/VerifiedGarbage/Proof/Scrypt/Arm/BlockMixVerified.lean @@ -4,7 +4,8 @@ import VerifiedGarbage.Spec.Scrypt.Contract import VerifiedGarbage.TCB.Arm.Target import VerifiedGarbage.Proof.Scrypt.Memory import VerifiedGarbage.Proof.Framework.Range -import VerifiedGarbage.Proof.Hmac.Arm.Init +import VerifiedGarbage.Proof.MdStream.Arm.Common +import VerifiedGarbage.Proof.Hmac.Common import VerifiedGarbage.Impl.Scrypt.Arm.Salsa import VerifiedGarbage.Proof.Framework.Arm.Contract import VerifiedGarbage.Proof.Framework.Arm.RelCT @@ -105,9 +106,13 @@ open VG VG.Arm VG.Impl.Scrypt.Arm open VG.Spec.Scrypt (Word) open VG.Proof.Scrypt open VG.Proof.MdStream.Arm (Upd Mupd wp_ldr wp_str wp_add op2_reg) -open VG.Proof.Hmac.Arm.Init (wp_eor) open VG.Proof.Scrypt.Memory (contains_off) +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 := + MdStream.Arm.WP.cons (s' := s.setReg d (s.gpr n ^^^ y)) (by simp [exec, ho]) (k _ (Upd.setReg _ _ _)) + /-! ## The precondition -/ section @@ -463,7 +468,6 @@ open VG.Spec.Scrypt (bytesAt) open VG.Spec.Pbkdf2 (xorBytes) open VG.Proof.Sha256.Stream (writeBytes writeBytes_append writeBytes_nil writeBytes_frame) open VG.Proof.MdStream.Arm (Upd Mupd wp_ldr wp_str op2_reg saveMem) -open VG.Proof.Hmac.Arm.Init (wp_eor) open VG.Proof.Scrypt.Memory (sub_off xorBytes_length bytesAt_length bytesAt_add bytesAt_writeBytes_sep) diff --git a/lean/VerifiedGarbage/Proof/Scrypt/Arm/RoMixCT.lean b/lean/VerifiedGarbage/Proof/Scrypt/Arm/RoMixCT.lean index 46bc99288..e0565a841 100644 --- a/lean/VerifiedGarbage/Proof/Scrypt/Arm/RoMixCT.lean +++ b/lean/VerifiedGarbage/Proof/Scrypt/Arm/RoMixCT.lean @@ -335,7 +335,6 @@ open VG.Spec.Pbkdf2 (xorBytes) open VG.Proof.Sha256.Stream (writeBytes writeBytes_append writeBytes_nil) open VG.Proof.MdStream.Arm (Upd Mupd Fupd wp_mov wp_add wp_and wp_subs wp_cmp wp_ldr wp_str op2_reg op2_imm op2_lsr eval_ne ofNat_beq_zero sub_beq) -open VG.Proof.Hmac.Arm.Init (wp_eor) open VG.Proof.Scrypt.Memory (sub_off bytesAt_add bytesAt_length bytesAt_writeBytes_sep xorBytes_length) diff --git a/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/Common.lean b/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/Common.lean index 6706eb385..3e6394dec 100644 --- a/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/Common.lean +++ b/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/Common.lean @@ -10,10 +10,8 @@ import VerifiedGarbage.Proof.Framework.Offset /-! # Streaming SHA-256 on x86 (32-bit): common lemmas -The compressor-dependent correctness proof is generic in -`Proof/Sha256/X86/Stream/CompressAt.lean`; this module keeps the shared memory, -state and scalar constant-time facts. Per-instruction WP rules that expose only -what changes, the call of the compression function (`compressAt`), and +Memory, state and constant-time facts shared by the x86 proofs that +import it. Per-instruction WP rules that expose only what changes, and arithmetic on 32-bit values. -/ diff --git a/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/CompressAt.lean b/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/CompressAt.lean deleted file mode 100644 index 7734252ec..000000000 --- a/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/CompressAt.lean +++ /dev/null @@ -1,108 +0,0 @@ -import VerifiedGarbage.Proof.Sha256.X86.Stream.Common -import VerifiedGarbage.Impl.MdStream.X86 -import VerifiedGarbage.Proof.Framework.X86.RegUpd - -/-! The framed single-block compression proof, independent of backend. -/ -namespace VG.Proof.Sha256.X86.Stream -open VG.X86 -open VG.X86.RegUpd -open VG.Spec.Sha256 (stateAt compress blockAt) -variable {name : String} {code : Prog isa} - (hv : Verified X86.target code Proof.Sha256.compressX86) - (hnosp : NoSp code) (hstack : stackUse code = 0) -include hv hnosp hstack - -theorem compressAt_of {sr cr : Reg} (hsr : sr ≠ .esp) (hcr : cr ≠ .esp) (hsr' : sr ≠ .ecx) - (hcr' : cr ≠ .ecx) {s : State} {st scr blk E : BitVec 32} - (hesp : s.gpr .esp = E) (hS : s.gpr sr = st) (hC : s.gpr cr = scr) (heax : s.gpr .eax = blk) - (hE : 20 ≤ E.toNat) (f₀ : st.toNat + 32 ≤ 2 ^ 32) (f₁ : blk.toNat + 64 ≤ 2 ^ 32) - (f₃ : scr.toNat + 112 ≤ 2 ^ 32) - (d₁ : Region.Disjoint ⟨st.setWidth 64, 32⟩ ⟨scr.setWidth 64, 112⟩) - (d₂ : Region.Disjoint ⟨blk.setWidth 64, 64⟩ ⟨st.setWidth 64, 32⟩) - (d₃ : Region.Disjoint ⟨blk.setWidth 64, 64⟩ ⟨scr.setWidth 64, 112⟩) - (dS : Region.Disjoint (below E 20) ⟨st.setWidth 64, 32⟩) - (dC : Region.Disjoint (below E 20) ⟨scr.setWidth 64, 112⟩) - (dB : Region.Disjoint (below E 20) ⟨blk.setWidth 64, 64⟩) - (hc : Covers [⟨blk.setWidth 64, 64⟩] (s.rd ++ s.wr)) - (hw : Covers [⟨st.setWidth 64, 32⟩, ⟨scr.setWidth 64, 112⟩] s.wr) - {Q : State → Prop} - (hQ : ∀ s', s'.rd = s.rd → s'.wr = s.wr → (∀ r ∈ calleeSaved, s'.gpr r = s.gpr r) → - Frame [⟨st.setWidth 64, 32⟩, ⟨scr.setWidth 64, 112⟩, below E 20] s.mem s'.mem → - stateAt s'.mem (st.setWidth 64) = - compress (stateAt s.mem (st.setWidth 64)) (blockAt s.mem (blk.setWidth 64)) → Q s') : - WP isa (Impl.MdStream.X86.compressAt name code sr cr) s Q := by - unfold Impl.MdStream.X86.compressAt Impl.MdStream.X86.compressWith - refine WP.seq (WP.cons (s' := s.setReg .ecx 1) rfl (WP.block_nil ?_)) - set s₁ := s.setReg .ecx 1 with hs₁ - have g₁ : ∀ r, r ≠ .ecx → s₁.gpr r = s.gpr r := fun r h => by rw [hs₁, gpr_setReg_of_ne s 1 h] - have fit : 4 * [cr, Reg.ecx, .eax, sr].length + 4 ≤ (s₁.gpr .esp).toNat := by - rw [g₁ _ (by decide), hesp]; simp only [List.length_cons, List.length_nil]; omega - have hrs : Reg.esp ∉ [cr, Reg.ecx, .eax, sr] := by simp [Ne.symm hsr, Ne.symm hcr] - set sE := (pushed [cr, Reg.ecx, .eax, sr] s₁).callEntry with hsE - have a0 : arg sE 0 = st := by rw [hsE, callEntry_arg fit hrs (by simp)]; simp [g₁ _ hsr', hS] - have a1 : arg sE 1 = blk := by rw [hsE, callEntry_arg fit hrs (by simp)]; simp [g₁ Reg.eax (by decide), heax] - have a2 : arg sE 2 = 1 := by rw [hsE, callEntry_arg fit hrs (by simp)]; change s₁.gpr .ecx = 1; rw [hs₁, gpr_setReg_self] - have a3 : arg sE 3 = scr := by rw [hsE, callEntry_arg fit hrs (by simp)]; simp [g₁ _ hcr', hC] - have eA : argAddr sE 0 = (E - BitVec.ofNat 32 16).setWidth 64 := by - rw [hsE, callEntry_argAddr0, g₁ _ (by decide), hesp]; rfl - have eSp : sE.gpr .esp = E - BitVec.ofNat 32 20 := by - rw [hsE, callEntry_esp', g₁ _ (by decide), hesp]; rfl - have b16 : Region.Sub (below E 16) (below E 20) := below_sub (by omega) hE - have r4 : Region.Sub ⟨(E - BitVec.ofNat 32 20).setWidth 64, 4⟩ (below E 20) := by - have := below_inner (sp := E) (a := 4) (b := 20) (k := 16) (by omega) hE - rw [show E - BitVec.ofNat 32 20 = E - BitVec.ofNat 32 16 - BitVec.ofNat 32 4 by - rw [← VG.Offset.sub_add_eq]; rfl] - exact this - have hesp₁ : s₁.gpr .esp = E := by rw [g₁ _ (by decide), hesp] - refine WP.callWith (k := Proof.Sha256.compressX86) hv.1 hnosp (by simp) hrs - (by rw [hstack, hesp₁]; simp only [List.length_cons, List.length_nil]; omega) - (rd := [⟨blk.setWidth 64, 64 * (1 : BitVec 32).toNat⟩, ⟨argAddr sE 0, 16⟩]) - (wr := [⟨st.setWidth 64, 32⟩, ⟨scr.setWidth 64, 112⟩]) - ⟨?_, ?_, ?_⟩ fun s' rd' wr' cs' f' ⟨s₂, m₂, post⟩ => ?_ - · rw [← hsE] - simp only [Proof.Sha256.compressX86, State.withRegions_rd, State.withRegions_wr, State.withRegions_gpr, - arg_withRegions, argAddr_withRegions, a0, a1, a2, a3, eA, eSp] - refine ⟨trivial, trivial, d₁, d₂, d₃, dS.sub_left b16, dC.sub_left b16, - dS.sub_left r4, dC.sub_left r4, f₀, by simpa using f₁, f₃, ?_⟩ - rw [sub_toNat hE]; have := E.isLt; omega - · rw [hesp₁] - intro a n ⟨r, hr, hcn⟩ - simp only [List.cons_append, List.nil_append, List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl - · obtain ⟨r', hr', hc'⟩ := hc a n ⟨_, List.mem_singleton_self _, by simpa using hcn⟩ - exact InRegions_append_cons.mpr (.inr ⟨r', hr', hc'⟩) - · refine InRegions_append_cons.mpr (.inl ?_) - rw [eA] at hcn - simp only [Region.Contains] at hcn ⊢ - simpa using hcn - · obtain ⟨r', hr', hc'⟩ := hw a n ⟨_, by simp, hcn⟩ - exact InRegions_append_cons.mpr (.inr ⟨r', List.mem_append_right _ hr', hc'⟩) - · obtain ⟨r', hr', hc'⟩ := hw a n ⟨_, by simp, hcn⟩ - exact InRegions_append_cons.mpr (.inr ⟨r', List.mem_append_right _ hr', hc'⟩) - · rw [hesp₁] - intro a n ⟨r, hr, hcn⟩ - obtain ⟨r', hr', hc'⟩ := hw a n ⟨r, hr, hcn⟩ - exact ⟨r', List.mem_cons_of_mem _ hr', hc'⟩ - · rw [hstack, hesp₁] at f' - have hsE' : Frame [below E 20] s.mem sE.mem := by - have := callEntry_frame fit hrs - rw [hesp₁] at this; exact this - rw [← hsE] at post - simp only [Proof.Sha256.compressX86, arg_withRegions, State.withRegions_mem, a0, a1, a2, m₂, - show (1 : BitVec 32).toNat = 1 from rfl, compressBlocks_one] at post - rw [hs₁] at f' - refine hQ s' rd' wr' (fun r hr => ?_) (by - change Frame [⟨st.setWidth 64, 32⟩, ⟨scr.setWidth 64, 112⟩, below E 20] s.mem s'.mem at f' - exact f') ?_ - · rw [cs' r hr, g₁ r (by simp [calleeSaved] at hr; rcases hr with rfl | rfl | rfl | rfl | rfl <;> decide)] - · have e₁ : stateAt sE.mem (st.setWidth 64) = stateAt s.mem (st.setWidth 64) := - Proof.Sha256.Stream.stateAt_congr fun i hi => - hsE'.bytes (R := ⟨st.setWidth 64, 32⟩) (by simpa using dS.symm) (by simp) hi - have e₂ : blockAt sE.mem (blk.setWidth 64) = blockAt s.mem (blk.setWidth 64) := by - simp only [blockAt] - exact Proof.Sha256.Stream.parseBlock_congr fun k hk => - hsE'.bytes (R := ⟨blk.setWidth 64, 64⟩) (by simpa using dB.symm) (by simp) hk - rw [post, e₁, e₂] - - -end VG.Proof.Sha256.X86.Stream diff --git a/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/Finalize.lean b/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/Finalize.lean index eca124a49..51c7163da 100644 --- a/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/Finalize.lean +++ b/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/Finalize.lean @@ -4,13 +4,11 @@ import VerifiedGarbage.Proof.Sha256.X86.Contract /-! # Streaming SHA-256 on x86 (32-bit): the loop of `finalize` -The compressor-dependent correctness proof is generic in -`Proof/Sha256/X86/Stream/FinalizeVariant.lean`. This module keeps the shared -memory, state, prologue and scalar constant-time facts used by the generic -proof, HMAC-SHA256 and SHA-512 on x86. The state is in `ebx`, scratch in `ebp`, -buffered bytes in `edi`, and the padding-loop flag in `esi`; count and output -are in `scratch[128..140)`. Each compression call uses the 20 bytes below -`esp`. +The memory, state, prologue and constant-time facts that SHA-512's +`finalize` on x86 shares (`Proof/Sha512/X86/Stream/Finalize.lean`). The state +is in `ebx`, scratch in `ebp`, buffered bytes in `edi`, and the padding-loop +flag in `esi`; count and output are in `scratch[128..140)`. Each compression +call uses the 20 bytes below `esp`. -/ namespace VG.Proof.Sha256.X86.Stream.Finalize diff --git a/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/FinalizeVariant.lean b/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/FinalizeVariant.lean deleted file mode 100644 index 4e17873e1..000000000 --- a/lean/VerifiedGarbage/Proof/Sha256/X86/Stream/FinalizeVariant.lean +++ /dev/null @@ -1,218 +0,0 @@ -import VerifiedGarbage.Proof.Sha256.X86.Stream.Finalize -import VerifiedGarbage.Proof.Sha256.X86.Stream.CompressAt - -/-! SHA-256's padding loop, independent of compression backend. -/ -namespace VG.Proof.Sha256.X86.Stream.Finalize -open VG VG.X86 -open VG.Proof.Sha256.X86.Stream -open VG.Proof.Sha256.Stream -open VG.Spec.Sha256 (stateAt blockAt compress bytesAt HashValue wordBytes parseBlock) -variable {name : String} {code : Prog isa} - (hv : Verified X86.target code Proof.Sha256.compressX86) - (hnosp : NoSp code) (hstack : stackUse code = 0) -include hv hnosp hstack - -theorem compress_buf_of {s₀ : State} (hp : Pre s₀) {s : State} (hC : Common s₀ s) - (heax : s.gpr .eax = st s₀ + BitVec.ofNat 32 32) {Q : State → Prop} - (hQ : ∀ s', Common s₀ s' → (∀ r ∈ calleeSaved, s'.gpr r = s.gpr r) → - stateAt s'.mem (stA s₀) = compress (stateAt s.mem (stA s₀)) (blockAt s.mem (stA s₀ + 32)) → Q s') : - WP isa (Impl.MdStream.X86.compressAt name code .ebx .ebp) s Q := by - have hst := hp.st_fit; have hsc := hp.scr_fit; have hsp := hp.sp_fit - have e32 : Region.Sub ⟨stA s₀, 32⟩ (stR s₀) := Region.sub_prefix (by omega) - have e112 : Region.Sub ⟨scA s₀, 112⟩ (scR s₀) := Region.sub_prefix (by omega) - have hb : (st s₀ + BitVec.ofNat 32 32).setWidth 64 = stA s₀ + BitVec.ofNat 64 32 := addr_eq (by omega) - have eb : Region.Sub ⟨(st s₀ + BitVec.ofNat 32 32).setWidth 64, 64⟩ (stR s₀) := by - rw [hb]; exact sub_offset (by omega) (by omega) - refine compressAt_of hv hnosp hstack (st := st s₀) (scr := scr s₀) (blk := st s₀ + BitVec.ofNat 32 32) (E := esp₀ s₀) - (by decide) (by decide) (by decide) (by decide) hC.esp hC.ebx hC.ebp heax hp.sp_lo (by omega) - (by rw [BitVec.toNat_add, toNat_ofNat_lt (by omega), Nat.mod_eq_of_lt (by omega)]; omega) (by omega) - ((hp.st_scr.sub_left e32).sub_right e112) ?_ ((hp.st_scr.sub_left eb).sub_right e112) - (hp.stk_st.sub_right e32) (hp.stk_scr.sub_right e112) (hp.stk_st.sub_right eb) ?_ ?_ ?_ - · rw [hb]; exact Offset.disjoint_base _ (Nat.le_refl _) (by omega) - · rw [hC.rd, hC.wr, hp.rd, hp.wr] - apply Covers.of_sub - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - subst hr - exact ⟨stR s₀, by simp, 32, hb, by simp⟩ - · rw [hC.wr, hp.wr] - apply Covers.of_sub - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl - · exact ⟨stR s₀, by simp, 0, by simp, by simp⟩ - · exact ⟨scR s₀, by simp, 0, by simp, by simp⟩ - · intro s' hrd hwr hcs hf hstate - have cs : ∀ r ∈ calleeSaved, s'.gpr r = s.gpr r := hcs - have word : ∀ d, 112 ≤ d → d + 4 ≤ 160 → - s'.mem.readW (addr (scr s₀) d) 32 = s.mem.readW (addr (scr s₀) d) 32 := by - intro d h₁ h₂ - refine hf.readW (r := ⟨addr (scr s₀) d, 4⟩) (Region.contains_self _ _) ?_ (by decide) - intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact (hp.st_scr.symm.sub_left (hp.scr_sub h₂)).sub_right e32 - · rw [addr_eq (by omega)]; exact Offset.disjoint_base _ (by omega) (by omega) - · exact hp.stk_scr.symm.sub_left (hp.scr_sub h₂) - refine hQ s' ⟨hrd.trans hC.rd, hwr.trans hC.wr, by rw [cs _ (by decide)]; exact hC.ebx, - by rw [cs _ (by decide)]; exact hC.ebp, by rw [cs _ (by decide)]; exact hC.esp, - hC.frame.trans (hf.sub ?_), fun p hp' => ?_, by rw [word 128 (by omega) (by omega)]; exact hC.lo, - by rw [word 132 (by omega) (by omega)]; exact hC.hi, by rw [word 136 (by omega) (by omega)]; exact hC.outp⟩ - hcs (by rw [hstate, show (st s₀ + BitVec.ofNat 32 32).setWidth 64 = stA s₀ + 32 from hb]) - · intro r hr - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl - · exact ⟨stR s₀, by simp, e32⟩ - · exact ⟨scR s₀, by simp, e112⟩ - · exact ⟨stkR s₀, by simp, fun _ h => h⟩ - · have hd : 112 ≤ p.2 ∧ p.2 + 4 ≤ 128 := by - simp only [VG.Impl.Sha256.X86.Stream.saved, List.mem_cons, List.not_mem_nil, or_false] at hp' - rcases hp' with rfl | rfl | rfl | rfl <;> simp - rw [word p.2 hd.1 (by omega)] - exact hC.saved p hp' - -theorem body_of {s₀ : State} (hp : Pre s₀) {k n : Nat} {s : State} (h : LInv s₀ k n s) : - WP isa (Impl.MdStream.X86.finalizeBody Impl.Sha256.X86.Stream.params name code) s (Step s₀ k) := by - have hk := h.k_le; have hn := h.n_le; have hst := hp.st_fit - have hC := h.toCommon - unfold Impl.MdStream.X86.finalizeBody - change WP isa _ _ _ - -- `eax := 64` or `56`: the end of the zeros. - refine WP.seq (wp_movi fun s₁ u₁ => wp_test fun s₂ f₂ z₂ => WP.block_nil ?_) - have hz₂ : s₂.zf = some (decide (k = 0)) := by - rw [z₂, u₁.other _ (by decide), h.esi, BitVec.and_self, ofNat_beq_zero (by omega)] - refine WP.seq (WP.mono (Q := fun (s₃ : State) => s₃.gpr .eax = BitVec.ofNat 32 (56 + 8 * k) ∧ - (∀ r, r ≠ .eax → s₃.gpr r = s.gpr r) ∧ s₃.mem = s.mem ∧ s₃.rd = s.rd ∧ s₃.wr = s.wr) ?_ - fun s₃ ⟨heax₃, g₃, m₃, rd₃, wr₃⟩ => ?_) - · refine WP.ite (decide (k = 0)) (by show s₂.zf = _; rw [hz₂]) (fun hb => ?_) (fun hb => ?_) - · simp only [decide_eq_true_eq] at hb; subst hb - refine wp_movi fun s₃ u₃ => WP.block_nil ⟨by rw [u₃.gpr]; rfl, fun r hr => ?_, ?_, ?_, ?_⟩ - · rw [u₃.other r hr, f₂.gpr, u₁.other r hr] - · rw [u₃.mem, f₂.mem, u₁.mem] - · rw [u₃.rd, f₂.rd, u₁.rd] - · rw [u₃.wr, f₂.wr, u₁.wr] - · simp only [decide_eq_false_iff_not] at hb - refine WP.block_nil ⟨by rw [f₂.gpr, u₁.gpr, show k = 1 by omega]; rfl, fun r hr => ?_, ?_, ?_, ?_⟩ - · rw [f₂.gpr, u₁.other r hr] - · rw [f₂.mem, u₁.mem] - · rw [f₂.rd, u₁.rd] - · rw [f₂.wr, u₁.wr] - -- `ecx := 0; eax -= edi`: zero the rest of the buffer, up to `lim`. - have hC₃ : Common s₀ s₃ := hC.of_gpr (fun r hr => g₃ r (regs3 hr).1) m₃ rd₃ wr₃ - refine WP.seq (wp_movi fun s₄ u₄ => wp_sub fun s₅ u₅ z₅ => WP.block_nil ?_) - have hC₄ : Common s₀ s₄ := hC₃.of_gpr (fun r hr => u₄.other r (regs3 hr).2.1) u₄.mem u₄.rd u₄.wr - have hecx₄ : s₄.gpr .ecx = 0 := u₄.gpr - have hedi₄ : s₄.gpr .edi = BitVec.ofNat 32 n := by rw [u₄.other _ (by decide), g₃ _ (by decide), h.edi] - have heax₅ : s₅.gpr .eax = BitVec.ofNat 32 (56 + 8 * k - n) := by - rw [u₅.gpr, u₄.other _ (by decide), heax₃, hedi₄, sub_ofNat (a := 56 + 8 * k) (b := n) (by omega)] - have hZ : Zero s₀ s₄ n (56 + 8 * k) 0 s₅ := by - refine ⟨Nat.zero_le _, fun r hr => u₅.other r ?_, u₅.rd, u₅.wr, - by rw [u₅.other _ (by decide), hedi₄, Nat.add_zero], by rw [heax₅, Nat.sub_zero], - by rw [u₅.mem, List.replicate_zero, writeBytes_nil]⟩ - simp only [List.mem_cons, List.not_mem_nil, or_false] at hr - rcases hr with rfl | rfl | rfl | rfl | rfl <;> decide - have hz₅ : s₅.zf = some (decide (56 + 8 * k - n = 0)) := by - rw [z₅, ← u₅.gpr, heax₅, ofNat_beq_zero (by omega)] - refine WP.seq (WP.mono (zero_ok hp hC₄ hecx₄ (by omega) hn hZ hz₅) fun s₆ hZ₆ => ?_) - have hm₄ : s₄.mem = s.mem := by rw [u₄.mem, m₃] - have hf₆ : Frame [stR s₀] s₄.mem s₆.mem := by - rw [hZ₆.mem]; exact buf_frame _ (by simp only [List.length_replicate]; omega) - obtain ⟨hfr₆, hsv₆, hlo₆, hhi₆, hout₆⟩ := hC₄.frame_keep hp (hf₆.mono (by simp)) - have hC₆ : Common s₀ s₆ := ⟨hZ₆.rd.trans hC₄.rd, hZ₆.wr.trans hC₄.wr, by rw [hZ₆.keep _ (by simp), hC₄.ebx], - by rw [hZ₆.keep _ (by simp), hC₄.ebp], by rw [hZ₆.keep _ (by simp), hC₄.esp], hfr₆, hsv₆, hlo₆, hhi₆, hout₆⟩ - have hst₆ : stateAt s₆.mem (stA s₀) = stateAt s.mem (stA s₀) := by - rw [hZ₆.mem, hm₄] - apply stateAt_congr - intro i hi - rw [st_add] - exact writeBytes_before _ _ _ (by omega) (by simp only [List.length_replicate]; omega) - have hby₆ : bytesAt s₆.mem (stA s₀ + 32) (56 + 8 * k) = - bytesAt s.mem (stA s₀ + 32) n ++ List.replicate (56 + 8 * k - n) 0 := by - rw [hZ₆.mem, hm₄, ← bytesAt_writeBytes _ _ _ _ (by simp only [List.length_replicate]; omega)] - congr 1; simp only [List.length_replicate]; omega - have hesi₆ : s₆.gpr .esi = BitVec.ofNat 32 k := by - rw [hZ₆.keep _ (by simp), u₄.other _ (by decide), g₃ _ (by decide), h.esi] - -- In the last block, the length. - refine WP.seq (wp_test fun s₇ f₇ z₇ => WP.block_nil ?_) - have hC₇ : Common s₀ s₇ := hC₆.of_gpr (fun r _ => by rw [f₇.gpr]) f₇.mem f₇.rd f₇.wr - have hz₇ : s₇.zf = some (decide (k = 0)) := by - rw [z₇, hesi₆, BitVec.and_self, ofNat_beq_zero (by omega)] - have hesi₇ : s₇.gpr .esi = BitVec.ofNat 32 k := by rw [f₇.gpr, hesi₆] - refine WP.seq (WP.mono (Q := fun (s₈ : State) => Common s₀ s₈ ∧ s₈.gpr .esi = BitVec.ofNat 32 k ∧ - stateAt s₈.mem (stA s₀) = stateAt s.mem (stA s₀) ∧ - ∀ m, R₀ s₀ m → bytesAt s₈.mem (stA s₀ + 32) 64 = bytesAt s.mem (stA s₀ + 32) n ++ - (if k = 1 then List.replicate (64 - n) 0 else List.replicate (56 - n) 0 ++ lenBytes m)) ?_ - fun s₈ ⟨hC₈, hesi₈, hst₈, hby₈⟩ => ?_) - · refine WP.ite (decide (k = 0)) (by show s₇.zf = _; rw [hz₇]) (fun hb => ?_) (fun hb => ?_) - · simp only [decide_eq_true_eq] at hb; subst hb - refine WP.mono (len_ok hp hC₇) fun s₈ ⟨g₈, rd₈, wr₈, m₈⟩ => ?_ - have hfL : Frame [stR s₀] s₇.mem s₈.mem := by - rw [m₈]; exact buf_frame _ (by simp [lenL, wordBytes]) - obtain ⟨hfr, hsv, hlo, hhi, hout⟩ := hC₇.frame_keep hp (hfL.mono (by simp)) - refine ⟨⟨rd₈.trans hC₇.rd, wr₈.trans hC₇.wr, by rw [g₈ _ (by decide) (by decide) (by decide), hC₇.ebx], - by rw [g₈ _ (by decide) (by decide) (by decide), hC₇.ebp], - by rw [g₈ _ (by decide) (by decide) (by decide), hC₇.esp], hfr, hsv, hlo, hhi, hout⟩, - by rw [g₈ _ (by decide) (by decide) (by decide), hesi₇], ?_, fun m hm => ?_⟩ - · rw [m₈, ← hst₆, ← f₇.mem] - apply stateAt_congr - intro i hi - rw [st_add] - exact writeBytes_before _ _ _ (by omega) (by simp [lenL, wordBytes]) - · simp only [show ¬ ((0 : Nat) = 1) by decide, ite_false] - have e := bytesAt_writeBytes s₇.mem (stA s₀ + 32) 56 (lenL s₀) (by simp [lenL, wordBytes]) - simp only [lenL, List.length_append, show ∀ w, (wordBytes w).length = 4 from fun _ => rfl] at e - rw [m₈, e, f₇.mem, hby₆, ← lenBytes_halves _ _ m hm.2] - simp [List.append_assoc] - · simp only [decide_eq_false_iff_not] at hb - have hk1 : k = 1 := by omega - subst hk1 - refine WP.block_nil ⟨hC₇, hesi₇, by rw [f₇.mem, hst₆], fun m _ => ?_⟩ - rw [f₇.mem, hby₆]; simp - -- Compress the block. - refine WP.seq (WP.mono (args_ok hC₈) fun s₉ ⟨hC₉, g₉, heax₉, hf₉⟩ => ?_) - refine WP.seq (compress_buf_of hv hnosp hstack hp hC₉ heax₉ fun s₁₀ hC₁₀ cs₁₀ hst₁₀ => ?_) - have hesi₁₀ : s₁₀.gpr .esi = BitVec.ofNat 32 k := by - rw [cs₁₀ _ (by decide), g₉ _ (by decide), hesi₈] - have hbyte : ∀ i, i < 96 → s₉.mem (stA s₀ + BitVec.ofNat 64 i) = s₈.mem (stA s₀ + BitVec.ofNat 64 i) := - fun i hi => frame_bytes hf₉ (R := stR s₀) (by simpa using hp.a_st.symm) (by simp) hi - have hblk : ∀ m, R₀ s₀ m → blockAt s₉.mem (stA s₀ + 32) = parseBlock fun t => - (bytesAt s.mem (stA s₀ + 32) n ++ - (if k = 1 then List.replicate (64 - n) 0 else List.replicate (56 - n) 0 ++ lenBytes m)).getD t 0 := by - intro m hm - apply parseBlock_congr - intro t ht - rw [show stA s₀ + 32 + BitVec.ofNat 64 t = stA s₀ + BitVec.ofNat 64 (32 + t) by - simp only [BitVec.ofNat_add]; rw [BitVec.add_assoc]; rfl, hbyte _ (by omega), - ← show stA s₀ + 32 + BitVec.ofNat 64 t = stA s₀ + BitVec.ofNat 64 (32 + t) by - simp only [BitVec.ofNat_add]; rw [BitVec.add_assoc]; rfl] - exact bytesAt_getD (hby₈ m hm) ht - have hst₉ : stateAt s₉.mem (stA s₀) = stateAt s₈.mem (stA s₀) := - stateAt_congr fun i hi => hbyte i (by omega) - -- Next block, if any. - refine wp_movi fun s₁₁ u₁₁ => wp_subi fun s₁₂ u₁₂ z₁₂ => WP.block_nil ?_ - have hC₁₂ : Common s₀ s₁₂ := hC₁₀.of_gpr (fun r hr => by - rw [u₁₂.other r (regs3 hr).2.2.2.2, u₁₁.other r (regs3 hr).2.2.2.1]) (by rw [u₁₂.mem, u₁₁.mem]) - (by rw [u₁₂.rd, u₁₁.rd]) (by rw [u₁₂.wr, u₁₁.wr]) - have hz : s₁₂.zf = some (decide (k = 1)) := by - rw [z₁₂, u₁₁.other _ (by decide), hesi₁₀, lit32 1, sub_beq (a := k) (b := 1) (by omega) (by omega)] - have hst : ∀ m, R₀ s₀ m → stateAt s₁₂.mem (stA s₀) = compress (stateAt s.mem (stA s₀)) (parseBlock fun t => - (bytesAt s.mem (stA s₀ + 32) n ++ - (if k = 1 then List.replicate (64 - n) 0 else List.replicate (56 - n) 0 ++ lenBytes m)).getD t 0) := by - intro m hm - rw [u₁₂.mem, u₁₁.mem, hst₁₀, hst₉, hst₈, hblk m hm] - by_cases hk1 : k = 1 - · subst hk1 - refine .inr ⟨by show s₁₂.zf = _; rw [hz]; rfl, rfl, ⟨hC₁₂, by omega, by omega, ?_, ?_, fun m hm => ?_⟩⟩ - · rw [u₁₂.other _ (by decide), u₁₁.gpr]; rfl - · rw [u₁₂.gpr, u₁₁.other _ (by decide), hesi₁₀]; rfl - · rw [h.hash m hm] - simp only [ite_true, show ¬ (0 = 1) by decide, ite_false, Fin1, Fin0, hst m hm] - simp [bytesAt] - · have hk0 : k = 0 := by omega - subst hk0 - refine .inl ⟨by show s₁₂.zf = _; rw [hz]; rfl, hC₁₂, fun m hm => ?_⟩ - rw [h.hash m hm, hst m hm] - simp only [show ¬ (0 = 1) by decide, ite_false, Fin0, List.append_assoc] - - -end VG.Proof.Sha256.X86.Stream.Finalize diff --git a/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Code.lean b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Code.lean new file mode 100644 index 000000000..a7324fcc4 --- /dev/null +++ b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Code.lean @@ -0,0 +1,50 @@ +import VerifiedGarbage.Impl.Pbkdf2.Md.X86 +import VerifiedGarbage.Impl.Pbkdf2.Whole.X86 +import VerifiedGarbage.Impl.Sha256.X86.Stream +import VerifiedGarbage.Spec.Sha256.Contract +import VerifiedGarbage.Spec.Pbkdf2.Generic + +/-! +# SHA-256 backends on x86: the code built on them + +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 +`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 +registration files give them (with the backend's suffix). +-/ + +namespace VG.Proof.Sha256.X86.Variants + +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 := + ⟨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⟩ + +/-- SHA-256 as a Merkle–Damgård hash function, with a backend's compression +function `cmpN`/`cmpC` and the streaming functions calling it: a 32-byte hash +value, a big-endian 8-byte length field, and 112 bytes of scratch space for +the compression function. -/ +def mdHash (suffix cmpN : String) (cmpC updC finC : Prog isa) : Impl.Pbkdf2.Md.X86.Hash := + ⟨hmacHash suffix updC finC, 32, 8, true, 112, cmpN, cmpC, Impl.Sha256.X86.Stream.params.out⟩ + +/-- The functions the whole of PBKDF2 calls for SHA-256 with a backend. -/ +def fns (suffix cmpN : String) (cmpC updC finC : Prog isa) : Impl.Pbkdf2.Whole.X86.Fns where + H := hmacHash suffix updC finC + W := Spec.Hmac.sha256I.scratch + hiN := Spec.Hmac.sha256I.initApi.name ++ suffix + hiC := (hmacHash suffix updC finC).init + hfN := Spec.Hmac.sha256I.finalizeApi.name ++ suffix + hfC := (mdHash suffix cmpN cmpC updC finC).hmacFin + itN := Spec.Hmac.sha256I.iterateApi.name ++ suffix + itC := (mdHash suffix cmpN cmpC updC finC).iterate + +end VG.Proof.Sha256.X86.Variants diff --git a/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Interface.lean b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Interface.lean index dedc8b80d..db9c71716 100644 --- a/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Interface.lean +++ b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Interface.lean @@ -1,21 +1,34 @@ -import VerifiedGarbage.Proof.Hmac.Sha256.X86.Init -import VerifiedGarbage.Proof.Hmac.Sha256.X86.Finalize -import VerifiedGarbage.Proof.Pbkdf2.Sha256.X86 +import VerifiedGarbage.Proof.Pbkdf2.Md.X86.Sha256 import VerifiedGarbage.Proof.Sha256.X86.Stream.Variant import VerifiedGarbage.TCB.Artifact -import VerifiedGarbage.Proof.Pbkdf2.Whole.X86.Sha256Fns /-! # SHA-256 backends on x86 -A backend is registered once. The emitter applies every generic construction -to it, so adding compression acceleration also emits the corresponding SHA, -HMAC, and PBKDF2 callers (PBKDF2's whole derivation among them, which calls -the streaming, HMAC and PBKDF2 functions made with the backend). +A backend is one implementation of SHA-256's compression function on x86: a +variant of the interface `Sha256` on x86 (`Variants/Sha256/X86/`). Each +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`, +`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 +that call it. What the kernel checks of each backend's code (that it keeps +`esp`, and the stack it uses) is evaluated on its literals. -/ namespace VG.Proof.Sha256.X86.Variants open VG.X86 +open VG.Proof.Hmac.Generic.X86 (Sha256Stream sha256H) +open VG.Proof.Pbkdf2.Md.X86 (sha256M) structure StreamFn where api : Api @@ -28,45 +41,74 @@ structure StreamFn where ofApi : api.contracts.elim True fun f => contract = f X86.abi stack spSafe : code.all (fun i => !isa.writesSp i) = true +/-- The functions the whole of PBKDF2 calls, with the compression function +`cmpN`/`cmpC` and the streaming functions `s`. -/ +abbrev pbkdf2Fns (s : Sha256Stream) (cmpN : String) (cmpC : Prog isa) : Impl.Pbkdf2.Whole.X86.Fns := + fns s.suffix cmpN cmpC s.upd s.fin + structure Backend where + /-- The compression function, verified: it keeps `esp`, and calls nothing + that uses the stack. -/ cmpN : String cmpC : Prog isa cmp : Verified X86.target cmpC Proof.Sha256.compressX86 cmpSp : NoSp cmpC cmpStack : stackUse cmpC = 0 - initCt : ConstantTime isa Proof.Hmac.initSha256X86.pre Proof.Hmac.initSha256X86.pub - (Impl.Hmac.Sha256.X86.init cmpN cmpC) - finCt : ConstantTime isa Proof.Hmac.finalizeSha256X86.pre Proof.Hmac.finalizeSha256X86.pub - (Impl.Hmac.Sha256.X86.finalize cmpN cmpC) - finHashSp : NoSp (Impl.Hmac.Sha256.X86.finalizeHash cmpN cmpC) - finHashStack : stackUse (Impl.Hmac.Sha256.X86.finalizeHash cmpN cmpC) = 20 - iterCt : ConstantTime isa Proof.Pbkdf2.iterateSha256X86.pre - Proof.Pbkdf2.iterateSha256X86.pub (Impl.Pbkdf2.Sha256.X86.iterate cmpN cmpC) - suffix : String + /-- SHA-256's streaming `update` and `finalize` made with it, verified, and + the suffix of the names of the functions emitted for it (e.g. `_shani`; + nothing for the baseline implementation). -/ + stream : Sha256Stream + /-- The CPU features its compression function requires, which the + functions built on it require too. -/ features : List String + /-- Its own functions: the compression function and the streaming + functions made with it. -/ functions : List StreamFn - initSp : (Impl.Hmac.Sha256.X86.init cmpN cmpC).all (fun i => !isa.writesSp i) = true - finSp : (Impl.Hmac.Sha256.X86.finalize cmpN cmpC).all (fun i => !isa.writesSp i) = true - iterSp : (Impl.Pbkdf2.Sha256.X86.iterate cmpN cmpC).all (fun i => !isa.writesSp i) = true - /-- The streaming `update` and `finalize` calling `cmpC` (as in - `functions`), which PBKDF2's whole derivation calls, verified. -/ - updC : Prog isa - upd : Verified X86.target updC Proof.Sha256.updateX86 - updNoSp : NoSp updC - updStack : stackUse updC ≤ 20 - finC : Prog isa - fin : Verified X86.target finC Proof.Sha256.finalizeX86 - finNoSp : NoSp finC - finStack : stackUse finC ≤ 20 - /-- What PBKDF2's whole derivation needs of the functions it calls: they - keep `esp`, and use at most 48 bytes of stack. -/ - initNoSp : NoSp (Impl.Hmac.Sha256.X86.init cmpN cmpC) - initStack : stackUse (Impl.Hmac.Sha256.X86.init cmpN cmpC) ≤ 48 - finalizeNoSp : NoSp (Impl.Hmac.Sha256.X86.finalize cmpN cmpC) - finalizeStack : stackUse (Impl.Hmac.Sha256.X86.finalize cmpN cmpC) ≤ 48 - iterNoSp : NoSp (Impl.Pbkdf2.Sha256.X86.iterate cmpN cmpC) - iterStack : stackUse (Impl.Pbkdf2.Sha256.X86.iterate cmpN cmpC) ≤ 48 - pbkdf2Sp : (Proof.Pbkdf2.Whole.X86.sha256Fns suffix cmpN cmpC updC finC).pbkdf2.all - (fun i => !isa.writesSp i) = true + /-- No instruction of the functions built on it writes `esp` (the + artifacts' `spSafe`). -/ + initSp : (sha256H stream).init.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 + finalizeNoSp : NoSp (sha256M stream cmpN cmpC).hmacFin + finalizeStack : stackUse (sha256M stream cmpN cmpC).hmacFin ≤ 48 + iterNoSp : NoSp (sha256M stream cmpN cmpC).iterate + iterStack : stackUse (sha256M stream cmpN cmpC).iterate ≤ 48 + +namespace Backend + +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 + +/-- The functions the whole of PBKDF2 calls. -/ +abbrev F : Impl.Pbkdf2.Whole.X86.Fns := pbkdf2Fns v.stream v.cmpN v.cmpC + +/-- The compression function, as HMAC's `finalize` and PBKDF2's iteration +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 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 + +theorem iterate : Verified X86.target v.M.iterate (Spec.Hmac.sha256I.iterateContract X86.abi 48) := + Proof.Pbkdf2.Md.X86.Instances.sha256_iterate v.stream v.cmpN v.comp + +end Backend end VG.Proof.Sha256.X86.Variants diff --git a/lean/VerifiedGarbage/Variants/Sha256/X86/Scalar.lean b/lean/VerifiedGarbage/Variants/Sha256/X86/Scalar.lean index 55a18b188..460aba75b 100644 --- a/lean/VerifiedGarbage/Variants/Sha256/X86/Scalar.lean +++ b/lean/VerifiedGarbage/Variants/Sha256/X86/Scalar.lean @@ -1,23 +1,36 @@ import VerifiedGarbage.Proof.Sha256.X86.Variants.Interface import VerifiedGarbage.Proof.Framework.X86.Lit -/-! Scalar SHA-256 is one backend; its generic callers are emitted with it. -/ +/-! +# SHA-256 on x86: the scalar compression function + +A variant of `Sha256` on x86 (see `TCB/Emit.lean`): `vg_sha256_compress`, in +the baseline ISA, and the streaming `update` and `finalize` made with it, +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.Md.X86 (sha256M) +open VG.Proof.Sha256.X86.Variants (pbkdf2Fns) -materialize_code sha256HInit := Impl.Hmac.Sha256.X86.init "vg_sha256_compress" Impl.Sha256.X86.compress -materialize_code sha256HFinalize := Impl.Hmac.Sha256.X86.finalize "vg_sha256_compress" Impl.Sha256.X86.compress -materialize_code sha256HIterate := Impl.Pbkdf2.Sha256.X86.iterate "vg_sha256_compress" Impl.Sha256.X86.compress -materialize_code sha256HPbkdf2 := (Proof.Pbkdf2.Whole.X86.sha256Fns "" "vg_sha256_compress" Impl.Sha256.X86.compress - Impl.Sha256.X86.Stream.update Impl.Sha256.X86.Stream.finalize).pbkdf2 +/-- The streaming functions made with the scalar compression function. -/ +def stream : Sha256Stream where + suffix := "" + upd := Impl.Sha256.X86.Stream.update + fin := Impl.Sha256.X86.Stream.finalize + updOK := Proof.Sha256.X86.Stream.Update.update_verified + finOK := Proof.Sha256.X86.Stream.Finalize.finalize_verified + updSp := NoSp.of_all (by lit_decide) + finSp := NoSp.of_all (by lit_decide) + updSU := by lit_decide + finSU := by lit_decide -/-- Generic registration preserves every scalar construction instruction. -/ -theorem scalar_code_unchanged : - Impl.Hmac.Sha256.X86.init "vg_sha256_compress" Impl.Sha256.X86.compress = Impl.Hmac.X86.init ∧ - Impl.Hmac.Sha256.X86.finalize "vg_sha256_compress" Impl.Sha256.X86.compress = Impl.Hmac.X86.finalize ∧ - Impl.Pbkdf2.Sha256.X86.iterate "vg_sha256_compress" Impl.Sha256.X86.compress = Impl.Pbkdf2.X86.iterate := - ⟨rfl, rfl, rfl⟩ +materialize_code sha256HInit := (sha256H stream).init +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 def variant : Proof.Sha256.X86.Variants.Backend where cmpN := "vg_sha256_compress" @@ -25,12 +38,7 @@ def variant : Proof.Sha256.X86.Variants.Backend where cmp := Proof.Sha256.X86.compress_verified cmpSp := NoSp.of_all (by lit_decide) cmpStack := by lit_decide - initCt := Proof.Hmac.X86.Init.init_ct - finCt := Proof.Hmac.X86.Finalize.finalize_ct - finHashSp := Proof.Hmac.X86.Finalize.finalizeHash_nosp - finHashStack := Proof.Hmac.X86.Finalize.finalizeHash_stack - iterCt := Proof.Pbkdf2.X86.iterate_ct - suffix := "" + stream := stream features := [] functions := [ { api := Spec.Sha256.compressApi @@ -59,20 +67,12 @@ def variant : Proof.Sha256.X86.Variants.Backend where initSp := Code.all_of_allInstrs (by lit_decide) finSp := Code.all_of_allInstrs (by lit_decide) iterSp := Code.all_of_allInstrs (by lit_decide) - updC := Impl.Sha256.X86.Stream.update - upd := Proof.Sha256.X86.Stream.Update.update_verified - updNoSp := NoSp.of_all (by lit_decide) - updStack := by lit_decide - finC := Impl.Sha256.X86.Stream.finalize - fin := Proof.Sha256.X86.Stream.Finalize.finalize_verified - finNoSp := NoSp.of_all (by lit_decide) - finStack := by lit_decide + pbkdf2Sp := Code.all_of_allInstrs (by lit_decide) initNoSp := NoSp.of_all (by lit_decide) initStack := by lit_decide finalizeNoSp := NoSp.of_all (by lit_decide) finalizeStack := by lit_decide iterNoSp := NoSp.of_all (by lit_decide) iterStack := by lit_decide - pbkdf2Sp := Code.all_of_allInstrs (by lit_decide) end VG.Variants.Sha256.X86.Scalar diff --git a/lean/VerifiedGarbage/Variants/Sha256/X86/ShaNi.lean b/lean/VerifiedGarbage/Variants/Sha256/X86/ShaNi.lean index e264bbe7a..9fb0249c8 100644 --- a/lean/VerifiedGarbage/Variants/Sha256/X86/ShaNi.lean +++ b/lean/VerifiedGarbage/Variants/Sha256/X86/ShaNi.lean @@ -1,13 +1,22 @@ import VerifiedGarbage.Proof.Sha256.X86.Variants.Interface import VerifiedGarbage.Proof.Sha256.X86.ShaNi.Verified -/-! SHA-NI compression and all generic SHA-256 constructions on x86 (PBKDF2's whole -derivation among them). -/ +/-! +# SHA-256 on x86 with the SHA extensions + +A variant of `Sha256` on x86 (see `TCB/Emit.lean`): `vg_sha256_compress_shani`, +which needs the SHA extensions and SSSE3, and the streaming `update` and +`finalize` made with it, which HMAC's and PBKDF2's functions call +(`Generic/Sha256/X86/`). +-/ namespace VG.Variants.Sha256.X86.ShaNi 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.Md.X86 (sha256M) +open VG.Proof.Sha256.X86.Variants (pbkdf2Fns) abbrev cmpN := "vg_sha256_compress_shani" abbrev cmpC := Impl.Sha256.X86.ShaNi.compress @@ -16,17 +25,6 @@ abbrev sha256Update := Impl.MdStream.X86.update params cmpN cmpC materialize_code sha256Update abbrev sha256Finalize := Impl.MdStream.X86.finalize params cmpN cmpC materialize_code sha256Finalize -abbrev sha256HInit := Impl.Hmac.Sha256.X86.init cmpN cmpC -materialize_code sha256HInit -abbrev sha256HFinalize := Impl.Hmac.Sha256.X86.finalize cmpN cmpC -materialize_code sha256HFinalize -abbrev sha256HFinalizeHash := Impl.Hmac.Sha256.X86.finalizeHash cmpN cmpC -materialize_code sha256HFinalizeHash -abbrev sha256HIterate := Impl.Pbkdf2.Sha256.X86.iterate cmpN cmpC -materialize_code sha256HIterate -abbrev sha256HPbkdf2 := - (Proof.Pbkdf2.Whole.X86.sha256Fns "_shani" cmpN cmpC sha256Update sha256Finalize).pbkdf2 -materialize_code sha256HPbkdf2 theorem callee : CalleeOk (P := params) md cmpC := ⟨Proof.Sha256.X86.ShaNi.compress_verified.1, Proof.Sha256.X86.ShaNi.compress_nosp, @@ -42,21 +40,6 @@ theorem finalize_ct : ConstantTime isa (finK (P := params) md 160).pre VG.Taint.constantTime (A := sseTaint) (Proof.MdStream.X86.Finalize.τ₀ params 160) (fun _ _ h₁ h₂ hp => Proof.MdStream.X86.Finalize.agree₀ dims h₁ h₂ hp) (by taint_decide) -theorem init_ct : ConstantTime isa Proof.Hmac.initSha256X86.pre Proof.Hmac.initSha256X86.pub sha256HInit := - VG.Taint.constantTime (A := sseTaint) Proof.Hmac.X86.Init.τ₀ - (fun _ _ h₁ h₂ hp => Proof.Hmac.X86.Init.agree₀ h₁ h₂ hp) (by taint_decide) - -theorem hfinalize_ct : ConstantTime isa Proof.Hmac.finalizeSha256X86.pre - Proof.Hmac.finalizeSha256X86.pub sha256HFinalize := - VG.Taint.constantTime (A := sseTaint) Proof.Hmac.X86.Finalize.τ₀ - (fun _ _ h₁ h₂ hp => Proof.Hmac.X86.Finalize.agree₀ h₁ h₂ hp) - (by taint_decide_weaken Proof.Hmac.X86.Finalize.forget) - -theorem iterate_ct : ConstantTime isa Proof.Pbkdf2.iterateSha256X86.pre - Proof.Pbkdf2.iterateSha256X86.pub sha256HIterate := - VG.Taint.constantTime (A := sseTaint) Proof.Pbkdf2.X86.τ₀ - (fun _ _ h₁ h₂ hp => Proof.Pbkdf2.X86.agree₀ h₁ h₂ hp) (by taint_decide) - theorem compress_shared : Verified X86.target cmpC (Spec.Sha256.compressContract X86.abi) := (Proof.Sha256.X86.Shared.compressWide_of Proof.Sha256.X86.ShaNi.compress_verified Proof.Sha256.X86.Shared.compressWide_implies.sat_left).of_implies @@ -72,18 +55,30 @@ theorem finalize_shared : Verified X86.target sha256Finalize (Spec.Sha256.finali Proof.Sha256.X86.Shared.finalizeWide_implies.sat_left).of_implies Proof.Sha256.X86.Shared.finalizeWide_implies +/-- The streaming functions made with the SHA-NI compression function. -/ +def stream : Sha256Stream where + suffix := "_shani" + upd := sha256Update + fin := sha256Finalize + updOK := Proof.Sha256.X86.Stream.update_of callee update_ct + finOK := Proof.Sha256.X86.Stream.finalize_of callee finalize_ct + updSp := NoSp.of_all (by lit_decide) + finSp := NoSp.of_all (by lit_decide) + updSU := by lit_decide + finSU := by lit_decide + +materialize_code sha256HInit := (sha256H stream).init +materialize_code sha256HFinalize := (sha256M stream cmpN cmpC).hmacFin +materialize_code sha256HIterate := (sha256M stream cmpN cmpC).iterate +materialize_code sha256HPbkdf2 := (pbkdf2Fns stream cmpN cmpC).pbkdf2 + def variant : Proof.Sha256.X86.Variants.Backend where cmpN := cmpN cmpC := cmpC cmp := Proof.Sha256.X86.ShaNi.compress_verified cmpSp := Proof.Sha256.X86.ShaNi.compress_nosp cmpStack := Proof.Sha256.X86.ShaNi.compress_stack - initCt := init_ct - finCt := hfinalize_ct - finHashSp := NoSp.of_all (by lit_decide) - finHashStack := by lit_decide - iterCt := iterate_ct - suffix := "_shani" + stream := stream features := ["sha", "ssse3"] functions := [ { api := Spec.Sha256.compressApi @@ -112,20 +107,12 @@ def variant : Proof.Sha256.X86.Variants.Backend where initSp := Code.all_of_allInstrs (by lit_decide) finSp := Code.all_of_allInstrs (by lit_decide) iterSp := Code.all_of_allInstrs (by lit_decide) - updC := sha256Update - upd := Proof.Sha256.X86.Stream.update_of callee update_ct - updNoSp := NoSp.of_all (by lit_decide) - updStack := by lit_decide - finC := sha256Finalize - fin := Proof.Sha256.X86.Stream.finalize_of callee finalize_ct - finNoSp := NoSp.of_all (by lit_decide) - finStack := by lit_decide + pbkdf2Sp := Code.all_of_allInstrs (by lit_decide) initNoSp := NoSp.of_all (by lit_decide) initStack := by lit_decide finalizeNoSp := NoSp.of_all (by lit_decide) finalizeStack := by lit_decide iterNoSp := NoSp.of_all (by lit_decide) iterStack := by lit_decide - pbkdf2Sp := Code.all_of_allInstrs (by lit_decide) end VG.Variants.Sha256.X86.ShaNi diff --git a/src/asm/arm/hmac_sha256.rs b/src/asm/arm/hmac_sha256.rs index aaf32645a..ed5431eb0 100644 --- a/src/asm/arm/hmac_sha256.rs +++ b/src/asm/arm/hmac_sha256.rs @@ -4,361 +4,182 @@ /// Starts an HMAC-SHA-256 computation with a key of at most 64 bytes: makes the SHA-256 streaming state `*inner` represent `K₀ ⊕ ipad` and `*outer` represent `K₀ ⊕ opad`, where `K₀` is the `key_len` bytes at `key` padded with zeros to 64 bytes (FIPS 198-1). The text is then absorbed with `vg_sha256_update` on `*inner` (its `count` starting at 64), and the MAC computed with `vg_hmac_sha256_finalize`. /// -/// Contract: `VG.Spec.Hmac.initSha256Contract`. Constant time: only the pointers and `key_len` may affect timing, not the key. +/// Contract: `VG.Spec.Hmac.Instance.initContract` of `VG.Spec.Hmac.sha256I`. Constant time: only the pointers and `key_len` may affect timing, not the key. /// /// # Safety /// /// * `inner` must be valid for reads and writes of 96 bytes. /// * `outer` must be valid for reads and writes of 96 bytes. /// * `key` must be valid for reads of `key_len` bytes. -/// * `scratch` must be valid for reads and writes of 608 bytes. +/// * `scratch` must be valid for reads and writes of 832 bytes. /// * `key_len` must be at most 64. /// * The contents of `scratch` on return are unspecified. /// * `inner`, `outer` and `scratch` must not overlap each other, `key` or the arguments on the stack (distinct Rust objects never do). -/// * None of `inner`, `outer`, `key` and `scratch` may wrap around the end of the address space (no Rust object does). +/// * None of `inner`, `outer`, `key` and `scratch` may overlap the 16 bytes of stack below the stack pointer, or wrap around the end of the address space (no Rust object does). #[unsafe(naked)] -pub(crate) unsafe extern "C" fn vg_hmac_sha256_init(inner: *mut [u8; 96], outer: *mut [u8; 96], key: *const u8, key_len: usize, scratch: *mut [u64; 76]) { +pub(crate) unsafe extern "C" fn vg_hmac_sha256_init(inner: *mut [u8; 96], outer: *mut [u8; 96], key: *const u8, key_len: usize, scratch: *mut [u64; 104]) { core::arch::naked_asm!( "ldr r12, [sp, #0]", - "str r4, [r12, #112]", - "str r5, [r12, #116]", - "str r6, [r12, #120]", - "str r7, [r12, #124]", - "str r8, [r12, #128]", - "str r9, [r12, #132]", - "str r10, [r12, #136]", - "str r11, [r12, #140]", - "str lr, [r12, #144]", - "mov r4, r1", - "mov r5, r2", - "mov r6, r3", - "movw r12, #58983", - "movt r12, #27145", - "str r12, [r0, #0]", - "movw r12, #44677", - "movt r12, #47975", - "str r12, [r0, #4]", - "movw r12, #62322", - "movt r12, #15470", - "str r12, [r0, #8]", - "movw r12, #62778", - "movt r12, #42319", - "str r12, [r0, #12]", - "movw r12, #21119", - "movt r12, #20750", - "str r12, [r0, #16]", - "movw r12, #26764", - "movt r12, #39685", - "str r12, [r0, #20]", - "movw r12, #55723", - "movt r12, #8067", - "str r12, [r0, #24]", - "movw r12, #52505", - "movt r12, #23520", - "str r12, [r0, #28]", - "movw r12, #58983", - "movt r12, #27145", - "str r12, [r4, #0]", - "movw r12, #44677", - "movt r12, #47975", - "str r12, [r4, #4]", - "movw r12, #62322", - "movt r12, #15470", - "str r12, [r4, #8]", - "movw r12, #62778", - "movt r12, #42319", - "str r12, [r4, #12]", - "movw r12, #21119", - "movt r12, #20750", - "str r12, [r4, #16]", - "movw r12, #26764", - "movt r12, #39685", - "str r12, [r4, #20]", - "movw r12, #55723", - "movt r12, #8067", - "str r12, [r4, #24]", - "movw r12, #52505", - "movt r12, #23520", - "str r12, [r4, #28]", - "mov r8, #54", - "mov r9, #92", - "mov r7, #0", - "cmp r6, #0", + "str r4, [r12, #160]", + "str r5, [r12, #164]", + "str r6, [r12, #168]", + "str r7, [r12, #172]", + "str r8, [r12, #176]", + "str r9, [r12, #180]", + "str r10, [r12, #184]", + "str lr, [r12, #188]", + "str r11, [r12, #192]", + "mov r4, r0", + "mov r5, r1", + "mov r6, r2", + "mov r11, r12", + "mov r8, #0", + "mov r9, r3", + "cmp r9, #0", "beq 20f", "22:", - "ldrb r12, [r5, #0]", - "eor r1, r12, r8", - "add r2, r0, r7", - "strb r1, [r2, #32]", - "eor r1, r12, r9", - "add r2, r4, r7", - "strb r1, [r2, #32]", - "add r5, r5, #1", - "add r7, r7, #1", - "subs r6, r6, #1", + "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]", + "add r8, r8, #1", + "subs r9, r9, #1", "bne 22b", "b 21f", "20:", "21:", - "mov r6, #64", - "subs r6, r6, r7", + "movw r9, #64", + "subs r9, r9, r8", "beq 23f", "25:", - "add r2, r0, r7", - "strb r8, [r2, #32]", - "add r2, r4, r7", - "strb r9, [r2, #32]", - "add r7, r7, #1", - "subs r6, r6, #1", + "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:", - "ldr r3, [sp, #0]", - "add r1, r0, #32", - "mov r2, #1", - "bl {vg_sha256_compress}", "mov r0, r4", - "add r1, r0, #32", - "mov r2, #1", - "bl {vg_sha256_compress}", - "ldr r4, [r3, #112]", - "ldr r5, [r3, #116]", - "ldr r6, [r3, #120]", - "ldr r7, [r3, #124]", - "ldr r8, [r3, #128]", - "ldr r9, [r3, #132]", - "ldr r10, [r3, #136]", - "ldr r11, [r3, #140]", - "ldr lr, [r3, #144]", + "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}", + "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", + "ldr r4, [r11, #160]", + "ldr r5, [r11, #164]", + "ldr r6, [r11, #168]", + "ldr r7, [r11, #172]", + "ldr r8, [r11, #176]", + "ldr r9, [r11, #180]", + "ldr r10, [r11, #184]", + "ldr lr, [r11, #188]", + "ldr r11, [r11, #192]", "bx lr", - vg_sha256_compress = sym super::sha256::vg_sha256_compress, + vg_sha256_init = sym super::sha256::vg_sha256_init, + vg_sha256_update = sym super::sha256::vg_sha256_update, ) } -/// Finishes an HMAC-SHA-256 computation: if, for a 64-byte key `K₀` and a text, the SHA-256 streaming state `*inner` represents `(K₀ ⊕ ipad) ‖ text`, of `count` bytes (modulo 2⁶⁴), and `*outer` represents `K₀ ⊕ opad`, writes the HMAC-SHA-256 of the text under `K₀` to `*out`. +/// Finishes an HMAC-SHA-256 computation: if, for a 64-byte key `K₀` and a text of fewer than 2⁶⁴ − 64 bytes, the SHA-256 streaming state `*inner` represents `(K₀ ⊕ ipad) ‖ text`, of `count` bytes, and `*outer` represents `K₀ ⊕ opad`, writes the HMAC-SHA-256 of the text under `K₀` (32 bytes) to `*out`. /// -/// Contract: `VG.Spec.Hmac.finalizeSha256OutContract`. Constant time: only the pointers and `count` may affect timing, not the states. +/// Contract: `VG.Spec.Hmac.Instance.finalizeContract` of `VG.Spec.Hmac.sha256I`. Constant time: only the pointers and `count` may affect timing, not the states. /// /// # Safety /// /// * `inner` must be valid for reads and writes of 96 bytes. /// * `outer` must be valid for reads of 96 bytes. /// * `out` must be valid for reads and writes of 32 bytes. -/// * `scratch` must be valid for reads and writes of 688 bytes. +/// * `scratch` must be valid for reads and writes of 832 bytes. /// * The contents of `inner` on return are unspecified. /// * The contents of `scratch` on return are unspecified. /// * `inner`, `out` and `scratch` must not overlap each other, `outer` or the arguments on the stack (distinct Rust objects never do). -/// * None of `inner`, `outer`, `out` and `scratch` may wrap around the end of the address space (no Rust object does). +/// * None of `inner`, `outer`, `out` and `scratch` may overlap the 16 bytes of stack below the stack pointer, or wrap around the end of the address space (no Rust object does). #[unsafe(naked)] -pub(crate) unsafe extern "C" fn vg_hmac_sha256_finalize(inner: *mut [u8; 96], outer: *const [u8; 96], count: u64, out: *mut [u8; 32], scratch: *mut [u64; 86]) { +pub(crate) unsafe extern "C" fn vg_hmac_sha256_finalize(inner: *mut [u8; 96], outer: *const [u8; 96], count: u64, out: *mut [u8; 32], scratch: *mut [u64; 104]) { core::arch::naked_asm!( "ldr r12, [sp, #4]", - "str r2, [r12, #192]", - "ldr r2, [r1, #0]", - "str r2, [r12, #160]", - "ldr r2, [r1, #4]", - "str r2, [r12, #164]", - "ldr r2, [r1, #8]", - "str r2, [r12, #168]", - "ldr r2, [r1, #12]", - "str r2, [r12, #172]", - "ldr r2, [r1, #16]", - "str r2, [r12, #176]", - "ldr r2, [r1, #20]", - "str r2, [r12, #180]", - "ldr r2, [r1, #24]", - "str r2, [r12, #184]", - "ldr r2, [r1, #28]", - "str r2, [r12, #188]", - "ldr r2, [r12, #192]", - "ldr r12, [sp, #4]", - "str r4, [r12, #112]", - "str r5, [r12, #116]", - "str r6, [r12, #120]", - "str r7, [r12, #124]", - "str r8, [r12, #128]", - "str r9, [r12, #132]", - "str r10, [r12, #136]", - "str r11, [r12, #140]", - "str lr, [r12, #144]", - "mov r4, r2", - "mov r5, r3", - "mov r3, r12", - "ldr r6, [sp, #0]", - "and r7, r4, #63", - "mov r12, #128", - "add r1, r0, r7", - "strb r12, [r1, #32]", - "add r7, r7, #1", - "add r8, r7, #7", - "lsr r8, r8, #6", - "20:", - "mov r9, #64", - "cmp r8, #0", - "beq 21f", - "b 22f", - "21:", - "mov r9, #56", - "22:", - "mov r12, #0", - "subs r9, r9, r7", - "beq 23f", - "25:", - "add r1, r0, r7", - "strb r12, [r1, #32]", - "add r7, r7, #1", - "subs r9, r9, #1", - "bne 25b", - "b 24f", - "23:", - "24:", - "cmp r8, #0", - "beq 26f", - "b 27f", - "26:", - "lsl r9, r5, #3", - "orr r9, r9, r4, lsr #29", - "rev r9, r9", - "str r9, [r0, #88]", - "lsl r9, r4, #3", - "rev r9, r9", - "str r9, [r0, #92]", - "27:", - "add r1, r0, #32", - "mov r2, #1", - "bl {vg_sha256_compress}", - "mov r7, #0", - "subs r8, r8, #1", - "beq 20b", - "ldr r9, [r0, #0]", - "rev r9, r9", - "str r9, [r6, #0]", - "ldr r9, [r0, #4]", - "rev r9, r9", - "str r9, [r6, #4]", - "ldr r9, [r0, #8]", - "rev r9, r9", - "str r9, [r6, #8]", - "ldr r9, [r0, #12]", - "rev r9, r9", - "str r9, [r6, #12]", - "ldr r9, [r0, #16]", - "rev r9, r9", - "str r9, [r6, #16]", - "ldr r9, [r0, #20]", - "rev r9, r9", - "str r9, [r6, #20]", - "ldr r9, [r0, #24]", - "rev r9, r9", - "str r9, [r6, #24]", - "ldr r9, [r0, #28]", - "rev r9, r9", - "str r9, [r6, #28]", - "ldr r4, [r3, #112]", - "ldr r5, [r3, #116]", - "ldr r6, [r3, #120]", - "ldr r7, [r3, #124]", - "ldr r8, [r3, #128]", - "ldr r9, [r3, #132]", - "ldr r10, [r3, #136]", - "ldr r11, [r3, #140]", - "ldr lr, [r3, #144]", - "ldr r1, [sp, #4]", - "ldr r12, [sp, #0]", - "ldr r3, [r1, #160]", - "str r3, [r0, #0]", - "ldr r3, [r1, #164]", - "str r3, [r0, #4]", - "ldr r3, [r1, #168]", - "str r3, [r0, #8]", - "ldr r3, [r1, #172]", - "str r3, [r0, #12]", - "ldr r3, [r1, #176]", - "str r3, [r0, #16]", - "ldr r3, [r1, #180]", - "str r3, [r0, #20]", - "ldr r3, [r1, #184]", - "str r3, [r0, #24]", - "ldr r3, [r1, #188]", - "str r3, [r0, #28]", - "ldr r3, [r12, #0]", - "str r3, [r0, #32]", - "ldr r3, [r12, #4]", - "str r3, [r0, #36]", - "ldr r3, [r12, #8]", - "str r3, [r0, #40]", - "ldr r3, [r12, #12]", - "str r3, [r0, #44]", - "ldr r3, [r12, #16]", - "str r3, [r0, #48]", - "ldr r3, [r12, #20]", - "str r3, [r0, #52]", - "ldr r3, [r12, #24]", - "str r3, [r0, #56]", - "ldr r3, [r12, #28]", - "str r3, [r0, #60]", - "mov r2, #96", - "mov r3, #0", - "ldr r12, [sp, #4]", - "str r4, [r12, #112]", - "str r5, [r12, #116]", - "str r6, [r12, #120]", - "str r7, [r12, #124]", - "str r8, [r12, #128]", - "str r9, [r12, #132]", - "str r10, [r12, #136]", - "str r11, [r12, #140]", - "str lr, [r12, #144]", - "mov r4, r2", - "mov r5, r3", - "mov r3, r12", - "ldr r6, [sp, #0]", - "and r7, r4, #63", + "str r4, [r12, #160]", + "str r5, [r12, #164]", + "str r6, [r12, #168]", + "str r7, [r12, #172]", + "str r8, [r12, #176]", + "str r9, [r12, #180]", + "str r10, [r12, #184]", + "str lr, [r12, #188]", + "str r11, [r12, #192]", + "mov r5, r1", + "ldr r7, [sp, #0]", + "mov r11, r12", + "movw r12, #228", + "add r1, r11, r12", + "mov r12, r11", + "push {{r1, r12}}", + "bl {vg_sha256_finalize}", + "ldr r1, [sp], #8", + "mov r3, r11", + "movw r12, #196", + "add r0, r11, r12", + "movw r12, #228", + "add r6, r11, r12", + "ldr r12, [r5, #0]", + "str r12, [r0, #0]", + "ldr r12, [r5, #4]", + "str r12, [r0, #4]", + "ldr r12, [r5, #8]", + "str r12, [r0, #8]", + "ldr r12, [r5, #12]", + "str r12, [r0, #12]", + "ldr r12, [r5, #16]", + "str r12, [r0, #16]", + "ldr r12, [r5, #20]", + "str r12, [r0, #20]", + "ldr r12, [r5, #24]", + "str r12, [r0, #24]", + "ldr r12, [r5, #28]", + "str r12, [r0, #28]", "mov r12, #128", - "add r1, r0, r7", - "strb r12, [r1, #32]", - "add r7, r7, #1", - "add r8, r7, #7", - "lsr r8, r8, #6", - "28:", - "mov r9, #64", - "cmp r8, #0", - "beq 29f", - "b 210f", - "29:", - "mov r9, #56", - "210:", + "str r12, [r6, #32]", "mov r12, #0", - "subs r9, r9, r7", - "beq 211f", - "213:", - "add r1, r0, r7", - "strb r12, [r1, #32]", - "add r7, r7, #1", - "subs r9, r9, #1", - "bne 213b", - "b 212f", - "211:", - "212:", - "cmp r8, #0", - "beq 214f", - "b 215f", - "214:", - "lsl r9, r5, #3", - "orr r9, r9, r4, lsr #29", - "rev r9, r9", - "str r9, [r0, #88]", - "lsl r9, r4, #3", - "rev r9, r9", - "str r9, [r0, #92]", - "215:", - "add r1, r0, #32", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #56]", + "movw r12, #0", + "movt r12, #3", + "str r12, [r6, #60]", + "mov r1, r6", "mov r2, #1", "bl {vg_sha256_compress}", - "mov r7, #0", - "subs r8, r8, #1", - "beq 28b", + "mov r6, r7", "ldr r9, [r0, #0]", "rev r9, r9", "str r9, [r6, #0]", @@ -383,16 +204,17 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha256_finalize(inner: *mut [u8; 96], ou "ldr r9, [r0, #28]", "rev r9, r9", "str r9, [r6, #28]", - "ldr r4, [r3, #112]", - "ldr r5, [r3, #116]", - "ldr r6, [r3, #120]", - "ldr r7, [r3, #124]", - "ldr r8, [r3, #128]", - "ldr r9, [r3, #132]", - "ldr r10, [r3, #136]", - "ldr r11, [r3, #140]", - "ldr lr, [r3, #144]", + "ldr r4, [r11, #160]", + "ldr r5, [r11, #164]", + "ldr r6, [r11, #168]", + "ldr r7, [r11, #172]", + "ldr r8, [r11, #176]", + "ldr r9, [r11, #180]", + "ldr r10, [r11, #184]", + "ldr lr, [r11, #188]", + "ldr r11, [r11, #192]", "bx lr", + vg_sha256_finalize = sym super::sha256::vg_sha256_finalize, vg_sha256_compress = sym super::sha256::vg_sha256_compress, ) } diff --git a/src/asm/arm/pbkdf2_sha256.rs b/src/asm/arm/pbkdf2_sha256.rs index cc0aa2ca9..832c6050b 100644 --- a/src/asm/arm/pbkdf2_sha256.rs +++ b/src/asm/arm/pbkdf2_sha256.rs @@ -4,9 +4,7 @@ /// Runs `n` steps of PBKDF2-HMAC-SHA-256's iteration: if, for a 64-byte key `K₀`, the SHA-256 streaming state in bytes 0 to 95 of `*key` represents `K₀ ⊕ ipad` and the one in bytes 96 to 191 represents `K₀ ⊕ opad` (as `vg_hmac_sha256_init` leaves them), repeats `U ← HMAC-SHA-256 (K₀, U)`, `T ← T ⊕ U` `n` times, from `U = *u` and `T = *t`, and leaves the final `T` in `*t` (RFC 8018, step 3 of `F`). /// -/// Contract: `VG.Spec.Pbkdf2.iterateSha256Contract`. Constant time: only the pointers and `n` may affect timing, not the key, `U` or `T`. -/// -/// The function uses no stack: it saves its return address in `scratch`. +/// Contract: `VG.Spec.Hmac.Instance.iterateContract` of `VG.Spec.Hmac.sha256I`. Constant time: only the pointers and `n` may affect timing, not the key, `U` or `T`. /// /// # Safety /// @@ -16,67 +14,59 @@ /// * `scratch` must be valid for reads and writes of 832 bytes. /// * The contents of `scratch` on return are unspecified. /// * `t` and `scratch` must not overlap each other, `key`, `u` or the arguments on the stack (distinct Rust objects never do). -/// * None of `key`, `u`, `t` and `scratch` may wrap around the end of the address space (no Rust object does). +/// * None of `key`, `u`, `t` and `scratch` may overlap the 16 bytes of stack below the stack pointer, or wrap around the end of the address space (no Rust object does). #[unsafe(naked)] pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate(key: *const [u8; 192], u: *const [u8; 32], n: u32, t: *mut [u8; 32], scratch: *mut [u64; 104]) { core::arch::naked_asm!( "ldr r12, [sp, #0]", - "str r4, [r12, #112]", - "str r5, [r12, #116]", - "str r6, [r12, #120]", - "str r7, [r12, #124]", - "str r8, [r12, #128]", - "str r9, [r12, #132]", - "str r10, [r12, #136]", - "str r11, [r12, #140]", - "str lr, [r12, #144]", - "mov r4, r0", - "mov r0, r3", + "str r4, [r12, #160]", + "str r5, [r12, #164]", + "str r6, [r12, #168]", + "str r7, [r12, #172]", + "str r8, [r12, #176]", + "str r9, [r12, #180]", + "str r10, [r12, #184]", + "str lr, [r12, #188]", + "str r11, [r12, #192]", + "mov r11, r12", + "mov r7, r3", "mov r3, r12", + "mov r4, r0", "mov r5, r2", + "movw r12, #196", + "add r0, r11, r12", + "movw r12, #228", + "add r6, r11, r12", "ldr r12, [r1, #0]", - "str r12, [r3, #192]", + "str r12, [r6, #0]", "ldr r12, [r1, #4]", - "str r12, [r3, #196]", + "str r12, [r6, #4]", "ldr r12, [r1, #8]", - "str r12, [r3, #200]", + "str r12, [r6, #8]", "ldr r12, [r1, #12]", - "str r12, [r3, #204]", + "str r12, [r6, #12]", "ldr r12, [r1, #16]", - "str r12, [r3, #208]", + "str r12, [r6, #16]", "ldr r12, [r1, #20]", - "str r12, [r3, #212]", + "str r12, [r6, #20]", "ldr r12, [r1, #24]", - "str r12, [r3, #216]", + "str r12, [r6, #24]", "ldr r12, [r1, #28]", - "str r12, [r3, #220]", - "ldr r12, [r0, #0]", - "str r12, [r3, #160]", - "ldr r12, [r0, #4]", - "str r12, [r3, #164]", - "ldr r12, [r0, #8]", - "str r12, [r3, #168]", - "ldr r12, [r0, #12]", - "str r12, [r3, #172]", - "ldr r12, [r0, #16]", - "str r12, [r3, #176]", - "ldr r12, [r0, #20]", - "str r12, [r3, #180]", - "ldr r12, [r0, #24]", - "str r12, [r3, #184]", - "ldr r12, [r0, #28]", - "str r12, [r3, #188]", + "str r12, [r6, #28]", "mov r12, #128", - "str r12, [r3, #224]", + "str r12, [r6, #32]", "mov r12, #0", - "str r12, [r3, #228]", - "str r12, [r3, #232]", - "str r12, [r3, #236]", - "str r12, [r3, #240]", - "str r12, [r3, #244]", - "str r12, [r3, #248]", - "mov r12, #196608", - "str r12, [r3, #252]", + "str r12, [r6, #36]", + "str r12, [r6, #40]", + "str r12, [r6, #44]", + "str r12, [r6, #48]", + "str r12, [r6, #52]", + "movw r12, #0", + "movt r12, #0", + "str r12, [r6, #56]", + "movw r12, #0", + "movt r12, #3", + "str r12, [r6, #60]", "cmp r5, #0", "beq 20f", "22:", @@ -96,33 +86,33 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate(key: *const [u8; 1 "str r12, [r0, #24]", "ldr r12, [r4, #28]", "str r12, [r0, #28]", - "add r1, r3, #192", + "mov r1, r6", "mov r2, #1", "bl {vg_sha256_compress}", - "ldr r12, [r0, #0]", - "rev r12, r12", - "str r12, [r3, #192]", - "ldr r12, [r0, #4]", - "rev r12, r12", - "str r12, [r3, #196]", - "ldr r12, [r0, #8]", - "rev r12, r12", - "str r12, [r3, #200]", - "ldr r12, [r0, #12]", - "rev r12, r12", - "str r12, [r3, #204]", - "ldr r12, [r0, #16]", - "rev r12, r12", - "str r12, [r3, #208]", - "ldr r12, [r0, #20]", - "rev r12, r12", - "str r12, [r3, #212]", - "ldr r12, [r0, #24]", - "rev r12, r12", - "str r12, [r3, #216]", - "ldr r12, [r0, #28]", - "rev r12, r12", - "str r12, [r3, #220]", + "ldr r9, [r0, #0]", + "rev r9, r9", + "str r9, [r6, #0]", + "ldr r9, [r0, #4]", + "rev r9, r9", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "rev r9, r9", + "str r9, [r6, #8]", + "ldr r9, [r0, #12]", + "rev r9, r9", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "rev r9, r9", + "str r9, [r6, #16]", + "ldr r9, [r0, #20]", + "rev r9, r9", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "rev r9, r9", + "str r9, [r6, #24]", + "ldr r9, [r0, #28]", + "rev r9, r9", + "str r9, [r6, #28]", "ldr r12, [r4, #96]", "str r12, [r0, #0]", "ldr r12, [r4, #100]", @@ -139,95 +129,79 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate(key: *const [u8; 1 "str r12, [r0, #24]", "ldr r12, [r4, #124]", "str r12, [r0, #28]", - "add r1, r3, #192", + "mov r1, r6", "mov r2, #1", "bl {vg_sha256_compress}", - "ldr r12, [r0, #0]", - "rev r12, r12", - "str r12, [r3, #192]", - "ldr r12, [r0, #4]", - "rev r12, r12", - "str r12, [r3, #196]", - "ldr r12, [r0, #8]", - "rev r12, r12", - "str r12, [r3, #200]", - "ldr r12, [r0, #12]", - "rev r12, r12", - "str r12, [r3, #204]", - "ldr r12, [r0, #16]", - "rev r12, r12", - "str r12, [r3, #208]", - "ldr r12, [r0, #20]", - "rev r12, r12", - "str r12, [r3, #212]", - "ldr r12, [r0, #24]", - "rev r12, r12", - "str r12, [r3, #216]", - "ldr r12, [r0, #28]", - "rev r12, r12", - "str r12, [r3, #220]", - "ldr r12, [r3, #160]", - "ldr r1, [r3, #192]", + "ldr r9, [r0, #0]", + "rev r9, r9", + "str r9, [r6, #0]", + "ldr r9, [r0, #4]", + "rev r9, r9", + "str r9, [r6, #4]", + "ldr r9, [r0, #8]", + "rev r9, r9", + "str r9, [r6, #8]", + "ldr r9, [r0, #12]", + "rev r9, r9", + "str r9, [r6, #12]", + "ldr r9, [r0, #16]", + "rev r9, r9", + "str r9, [r6, #16]", + "ldr r9, [r0, #20]", + "rev r9, r9", + "str r9, [r6, #20]", + "ldr r9, [r0, #24]", + "rev r9, r9", + "str r9, [r6, #24]", + "ldr r9, [r0, #28]", + "rev r9, r9", + "str r9, [r6, #28]", + "ldr r12, [r6, #0]", + "ldr r1, [r7, #0]", "eor r12, r12, r1", - "str r12, [r3, #160]", - "ldr r12, [r3, #164]", - "ldr r1, [r3, #196]", + "str r12, [r7, #0]", + "ldr r12, [r6, #4]", + "ldr r1, [r7, #4]", "eor r12, r12, r1", - "str r12, [r3, #164]", - "ldr r12, [r3, #168]", - "ldr r1, [r3, #200]", + "str r12, [r7, #4]", + "ldr r12, [r6, #8]", + "ldr r1, [r7, #8]", "eor r12, r12, r1", - "str r12, [r3, #168]", - "ldr r12, [r3, #172]", - "ldr r1, [r3, #204]", + "str r12, [r7, #8]", + "ldr r12, [r6, #12]", + "ldr r1, [r7, #12]", "eor r12, r12, r1", - "str r12, [r3, #172]", - "ldr r12, [r3, #176]", - "ldr r1, [r3, #208]", + "str r12, [r7, #12]", + "ldr r12, [r6, #16]", + "ldr r1, [r7, #16]", "eor r12, r12, r1", - "str r12, [r3, #176]", - "ldr r12, [r3, #180]", - "ldr r1, [r3, #212]", + "str r12, [r7, #16]", + "ldr r12, [r6, #20]", + "ldr r1, [r7, #20]", "eor r12, r12, r1", - "str r12, [r3, #180]", - "ldr r12, [r3, #184]", - "ldr r1, [r3, #216]", + "str r12, [r7, #20]", + "ldr r12, [r6, #24]", + "ldr r1, [r7, #24]", "eor r12, r12, r1", - "str r12, [r3, #184]", - "ldr r12, [r3, #188]", - "ldr r1, [r3, #220]", + "str r12, [r7, #24]", + "ldr r12, [r6, #28]", + "ldr r1, [r7, #28]", "eor r12, r12, r1", - "str r12, [r3, #188]", + "str r12, [r7, #28]", "subs r5, r5, #1", "bne 22b", "b 21f", "20:", "21:", - "ldr r12, [r3, #160]", - "str r12, [r0, #0]", - "ldr r12, [r3, #164]", - "str r12, [r0, #4]", - "ldr r12, [r3, #168]", - "str r12, [r0, #8]", - "ldr r12, [r3, #172]", - "str r12, [r0, #12]", - "ldr r12, [r3, #176]", - "str r12, [r0, #16]", - "ldr r12, [r3, #180]", - "str r12, [r0, #20]", - "ldr r12, [r3, #184]", - "str r12, [r0, #24]", - "ldr r12, [r3, #188]", - "str r12, [r0, #28]", - "ldr r4, [r3, #112]", - "ldr r5, [r3, #116]", - "ldr r6, [r3, #120]", - "ldr r7, [r3, #124]", - "ldr r8, [r3, #128]", - "ldr r9, [r3, #132]", - "ldr r10, [r3, #136]", - "ldr r11, [r3, #140]", - "ldr lr, [r3, #144]", + "ldr r4, [r11, #160]", + "ldr r5, [r11, #164]", + "ldr r6, [r11, #168]", + "ldr r7, [r11, #172]", + "ldr r8, [r11, #176]", + "ldr r9, [r11, #180]", + "ldr r10, [r11, #184]", + "ldr lr, [r11, #188]", + "ldr r11, [r11, #192]", "bx lr", vg_sha256_compress = sym super::sha256::vg_sha256_compress, ) diff --git a/src/asm/x86/hmac_sha256.rs b/src/asm/x86/hmac_sha256.rs index 1db307c14..5e6355734 100644 --- a/src/asm/x86/hmac_sha256.rs +++ b/src/asm/x86/hmac_sha256.rs @@ -4,7 +4,7 @@ /// Starts an HMAC-SHA-256 computation with a key of at most 64 bytes: makes the SHA-256 streaming state `*inner` represent `K₀ ⊕ ipad` and `*outer` represent `K₀ ⊕ opad`, where `K₀` is the `key_len` bytes at `key` padded with zeros to 64 bytes (FIPS 198-1). The text is then absorbed with `vg_sha256_update` on `*inner` (its `count` starting at 64), and the MAC computed with `vg_hmac_sha256_finalize`. /// -/// Contract: `VG.Spec.Hmac.initSha256Contract`. Constant time: only the pointers and `key_len` may affect timing, not the key. +/// Contract: `VG.Spec.Hmac.Instance.initContract` of `VG.Spec.Hmac.sha256I`. Constant time: only the pointers and `key_len` may affect timing, not the key. /// /// The function may overwrite the arguments on the stack, as the calling convention lets it. /// @@ -13,169 +13,115 @@ /// * `inner` must be valid for reads and writes of 96 bytes. /// * `outer` must be valid for reads and writes of 96 bytes. /// * `key` must be valid for reads of `key_len` bytes. -/// * `scratch` must be valid for reads and writes of 608 bytes. +/// * `scratch` must be valid for reads and writes of 832 bytes. /// * `key_len` must be at most 64. /// * The contents of `scratch` on return are unspecified. /// * `inner`, `outer` and `scratch` must not overlap each other or `key` (distinct Rust objects never do). -/// * None of `inner`, `outer`, `key` and `scratch` may overlap the arguments on the stack, overlap the return address on the stack or the 20 bytes of stack below it, or wrap around the end of the address space (no Rust object does). +/// * None of `inner`, `outer`, `key` and `scratch` may overlap the arguments on the stack, overlap the return address on the stack or the 48 bytes of stack below it, or wrap around the end of the address space (no Rust object does). #[unsafe(naked)] -pub(crate) unsafe extern "C" fn vg_hmac_sha256_init(inner: *mut [u8; 96], outer: *mut [u8; 96], key: *const u8, key_len: usize, scratch: *mut [u64; 76]) { +pub(crate) unsafe extern "C" fn vg_hmac_sha256_init(inner: *mut [u8; 96], outer: *mut [u8; 96], key: *const u8, key_len: usize, scratch: *mut [u64; 104]) { core::arch::naked_asm!( "mov eax, DWORD PTR [esp+20]", - "mov DWORD PTR [eax+112], ebx", - "mov DWORD PTR [eax+116], esi", - "mov DWORD PTR [eax+120], edi", - "mov DWORD PTR [eax+124], ebp", + "mov DWORD PTR [eax+160], ebx", + "mov DWORD PTR [eax+164], esi", + "mov DWORD PTR [eax+168], edi", + "mov DWORD PTR [eax+172], ebp", "mov ebp, eax", - "mov ebx, DWORD PTR [esp+4]", - "mov esi, DWORD PTR [esp+8]", - "mov ecx, 1779033703", - "mov DWORD PTR [ebx], ecx", - "mov ecx, -1150833019", - "mov DWORD PTR [ebx+4], ecx", - "mov ecx, 1013904242", - "mov DWORD PTR [ebx+8], ecx", - "mov ecx, -1521486534", - "mov DWORD PTR [ebx+12], ecx", - "mov ecx, 1359893119", - "mov DWORD PTR [ebx+16], ecx", - "mov ecx, -1694144372", - "mov DWORD PTR [ebx+20], ecx", - "mov ecx, 528734635", - "mov DWORD PTR [ebx+24], ecx", - "mov ecx, 1541459225", - "mov DWORD PTR [ebx+28], ecx", - "mov ecx, 1779033703", - "mov DWORD PTR [esi], ecx", - "mov ecx, -1150833019", - "mov DWORD PTR [esi+4], ecx", - "mov ecx, 1013904242", - "mov DWORD PTR [esi+8], ecx", - "mov ecx, -1521486534", - "mov DWORD PTR [esi+12], ecx", - "mov ecx, 1359893119", - "mov DWORD PTR [esi+16], ecx", - "mov ecx, -1694144372", - "mov DWORD PTR [esi+20], ecx", - "mov ecx, 528734635", - "mov DWORD PTR [esi+24], ecx", - "mov ecx, 1541459225", - "mov DWORD PTR [esi+28], ecx", - "mov edi, DWORD PTR [esp+12]", - "mov ecx, DWORD PTR [esp+16]", - "mov edx, ebx", - "add edx, 32", - "test ecx, ecx", + "mov esi, DWORD PTR [esp+12]", + "mov edi, DWORD PTR [esp+16]", + "mov ebx, 0", + "test edi, edi", "je 20f", "22:", - "movzx eax, BYTE PTR [edi]", + "mov eax, esi", + "add eax, ebx", + "movzx eax, BYTE PTR [eax]", + "mov ecx, eax", "xor eax, 54", - "mov BYTE PTR [edx], al", - "add edi, 1", - "add edx, 1", - "sub ecx, 1", + "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", "jne 22b", "jmp 21f", "20:", "21:", - "mov eax, ebx", - "add eax, 96", - "mov ecx, 54", - "cmp edx, eax", + "mov eax, 54", + "mov ecx, 92", + "cmp ebx, 64", "je 23f", "25:", - "mov BYTE PTR [edx], cl", - "add edx, 1", - "cmp edx, eax", + "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 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", + "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", "push ebp", "push ecx", + "push edx", "push eax", + "push edi", "push ebx", - "call {vg_sha256_compress}", + "call {vg_sha256_update}", "pop eax", "pop eax", "pop eax", "pop eax", - "mov eax, esi", - "add eax, 32", - "mov ecx, 1", + "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", "push ebp", "push ecx", + "push edx", "push eax", + "push edi", "push esi", - "call {vg_sha256_compress}", + "call {vg_sha256_update}", + "pop eax", + "pop eax", "pop eax", "pop eax", "pop eax", "pop eax", "mov eax, ebp", - "mov ebx, DWORD PTR [eax+112]", - "mov esi, DWORD PTR [eax+116]", - "mov edi, DWORD PTR [eax+120]", - "mov ebp, DWORD PTR [eax+124]", + "mov ebx, DWORD PTR [eax+160]", + "mov esi, DWORD PTR [eax+164]", + "mov edi, DWORD PTR [eax+168]", + "mov ebp, DWORD PTR [eax+172]", "ret", - vg_sha256_compress = sym super::sha256::vg_sha256_compress, + vg_sha256_init = sym super::sha256::vg_sha256_init, + vg_sha256_update = sym super::sha256::vg_sha256_update, ) } -/// Finishes an HMAC-SHA-256 computation: if, for a 64-byte key `K₀` and a text, the SHA-256 streaming state `*inner` represents `(K₀ ⊕ ipad) ‖ text`, of `count` bytes (modulo 2⁶⁴), and `*outer` represents `K₀ ⊕ opad`, writes the HMAC-SHA-256 of the text under `K₀` to `*out`. +/// Finishes an HMAC-SHA-256 computation: if, for a 64-byte key `K₀` and a text of fewer than 2⁶⁴ − 64 bytes, the SHA-256 streaming state `*inner` represents `(K₀ ⊕ ipad) ‖ text`, of `count` bytes, and `*outer` represents `K₀ ⊕ opad`, writes the HMAC-SHA-256 of the text under `K₀` (32 bytes) to `*out`. /// -/// Contract: `VG.Spec.Hmac.finalizeSha256OutContract`. Constant time: only the pointers and `count` may affect timing, not the states. +/// Contract: `VG.Spec.Hmac.Instance.finalizeContract` of `VG.Spec.Hmac.sha256I`. Constant time: only the pointers and `count` may affect timing, not the states. /// /// The function may overwrite the arguments on the stack, as the calling convention lets it. /// @@ -184,156 +130,83 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha256_init(inner: *mut [u8; 96], outer: /// * `inner` must be valid for reads and writes of 96 bytes. /// * `outer` must be valid for reads of 96 bytes. /// * `out` must be valid for reads and writes of 32 bytes. -/// * `scratch` must be valid for reads and writes of 688 bytes. +/// * `scratch` must be valid for reads and writes of 832 bytes. /// * The contents of `inner` on return are unspecified. /// * The contents of `scratch` on return are unspecified. /// * `inner`, `out` and `scratch` must not overlap each other or `outer` (distinct Rust objects never do). -/// * None of `inner`, `outer`, `out` and `scratch` may overlap the arguments on the stack, overlap the return address on the stack or the 20 bytes of stack below it, or wrap around the end of the address space (no Rust object does). +/// * None of `inner`, `outer`, `out` and `scratch` may overlap the arguments on the stack, overlap the return address on the stack or the 48 bytes of stack below it, or wrap around the end of the address space (no Rust object does). #[unsafe(naked)] -pub(crate) unsafe extern "C" fn vg_hmac_sha256_finalize(inner: *mut [u8; 96], outer: *const [u8; 96], count: u64, out: *mut [u8; 32], scratch: *mut [u64; 86]) { +pub(crate) unsafe extern "C" fn vg_hmac_sha256_finalize(inner: *mut [u8; 96], outer: *const [u8; 96], count: u64, out: *mut [u8; 32], scratch: *mut [u64; 104]) { core::arch::naked_asm!( - "mov edx, DWORD PTR [esp+24]", - "mov ecx, DWORD PTR [esp+8]", - "mov DWORD PTR [edx+176], ecx", - "mov ecx, DWORD PTR [esp+12]", - "mov DWORD PTR [esp+8], ecx", - "mov ecx, DWORD PTR [esp+16]", - "mov DWORD PTR [esp+12], ecx", - "mov ecx, DWORD PTR [esp+20]", - "mov DWORD PTR [esp+16], ecx", - "mov DWORD PTR [esp+20], edx", - "mov eax, DWORD PTR [esp+20]", - "mov DWORD PTR [eax+112], ebx", - "mov DWORD PTR [eax+116], esi", - "mov DWORD PTR [eax+120], edi", - "mov DWORD PTR [eax+124], ebp", + "mov eax, DWORD PTR [esp+24]", + "mov DWORD PTR [eax+160], ebx", + "mov DWORD PTR [eax+164], esi", + "mov DWORD PTR [eax+168], edi", + "mov DWORD PTR [eax+172], ebp", "mov ebp, eax", "mov ebx, DWORD PTR [esp+4]", - "mov ecx, DWORD PTR [esp+8]", - "mov DWORD PTR [ebp+128], ecx", - "mov ecx, DWORD PTR [esp+12]", - "mov DWORD PTR [ebp+132], ecx", + "mov esi, DWORD PTR [esp+8]", + "mov edi, DWORD PTR [esp+20]", + "mov eax, DWORD PTR [esp+12]", "mov ecx, DWORD PTR [esp+16]", - "mov DWORD PTR [ebp+136], ecx", - "mov edi, DWORD PTR [esp+8]", - "and edi, 63", - "mov edx, ebx", - "add edx, edi", - "mov ecx, 128", - "mov BYTE PTR [edx+32], cl", - "add edi, 1", - "mov esi, 0", - "cmp edi, 57", - "jae 20f", - "jmp 21f", - "20:", - "mov esi, 1", - "21:", - "22:", - "mov eax, 64", - "test esi, esi", - "je 23f", - "jmp 24f", - "23:", - "mov eax, 56", - "24:", - "mov ecx, 0", - "sub eax, edi", - "je 25f", - "27:", - "mov edx, ebx", - "add edx, edi", - "mov BYTE PTR [edx+32], cl", - "add edi, 1", - "sub eax, 1", - "jne 27b", - "jmp 26f", - "25:", - "26:", - "test esi, esi", - "je 28f", - "jmp 29f", - "28:", - "mov eax, DWORD PTR [ebp+128]", - "mov ecx, DWORD PTR [ebp+132]", - "add ecx, ecx", - "add ecx, ecx", - "add ecx, ecx", - "mov edx, eax", - "shr edx, 29", - "or ecx, edx", - "add eax, eax", - "add eax, eax", - "add eax, eax", - "bswap ecx", - "mov DWORD PTR [ebx+88], ecx", - "bswap eax", - "mov DWORD PTR [ebx+92], eax", - "29:", - "mov eax, ebx", - "add eax, 32", - "mov ecx, 1", + "mov edx, ebp", + "add edx, 176", "push ebp", + "push edx", "push ecx", "push eax", "push ebx", - "call {vg_sha256_compress}", + "call {vg_sha256_finalize}", "pop eax", "pop eax", "pop eax", "pop eax", - "mov edi, 0", - "sub esi, 1", - "je 22b", - "mov ecx, DWORD PTR [ebx]", - "bswap ecx", - "mov DWORD PTR [ebx+32], ecx", - "mov ecx, DWORD PTR [ebx+4]", - "bswap ecx", - "mov DWORD PTR [ebx+36], ecx", - "mov ecx, DWORD PTR [ebx+8]", - "bswap ecx", - "mov DWORD PTR [ebx+40], ecx", - "mov ecx, DWORD PTR [ebx+12]", - "bswap ecx", - "mov DWORD PTR [ebx+44], ecx", - "mov ecx, DWORD PTR [ebx+16]", - "bswap ecx", - "mov DWORD PTR [ebx+48], ecx", - "mov ecx, DWORD PTR [ebx+20]", - "bswap ecx", - "mov DWORD PTR [ebx+52], ecx", - "mov ecx, DWORD PTR [ebx+24]", - "bswap ecx", - "mov DWORD PTR [ebx+56], ecx", - "mov ecx, DWORD PTR [ebx+28]", - "bswap ecx", - "mov DWORD PTR [ebx+60], ecx", - "mov edx, DWORD PTR [ebp+176]", - "mov ecx, DWORD PTR [edx]", + "pop eax", + "mov ecx, DWORD PTR [esi]", "mov DWORD PTR [ebx], ecx", - "mov ecx, DWORD PTR [edx+4]", + "mov ecx, DWORD PTR [esi+4]", "mov DWORD PTR [ebx+4], ecx", - "mov ecx, DWORD PTR [edx+8]", + "mov ecx, DWORD PTR [esi+8]", "mov DWORD PTR [ebx+8], ecx", - "mov ecx, DWORD PTR [edx+12]", + "mov ecx, DWORD PTR [esi+12]", "mov DWORD PTR [ebx+12], ecx", - "mov ecx, DWORD PTR [edx+16]", + "mov ecx, DWORD PTR [esi+16]", "mov DWORD PTR [ebx+16], ecx", - "mov ecx, DWORD PTR [edx+20]", + "mov ecx, DWORD PTR [esi+20]", "mov DWORD PTR [ebx+20], ecx", - "mov ecx, DWORD PTR [edx+24]", + "mov ecx, DWORD PTR [esi+24]", "mov DWORD PTR [ebx+24], ecx", - "mov ecx, DWORD PTR [edx+28]", + "mov ecx, DWORD PTR [esi+28]", "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [ebp+176]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [ebp+180]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [ebp+184]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [ebp+188]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [ebp+192]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [ebp+196]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [ebp+200]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [ebp+204]", + "mov DWORD PTR [ebx+60], ecx", "mov ecx, 128", "mov DWORD PTR [ebx+64], ecx", "mov ecx, 0", "mov DWORD PTR [ebx+68], ecx", + "mov ecx, 0", "mov DWORD PTR [ebx+72], ecx", + "mov ecx, 0", "mov DWORD PTR [ebx+76], ecx", + "mov ecx, 0", "mov DWORD PTR [ebx+80], ecx", + "mov ecx, 0", "mov DWORD PTR [ebx+84], ecx", + "mov ecx, 0", "mov DWORD PTR [ebx+88], ecx", "mov ecx, 196608", "mov DWORD PTR [ebx+92], ecx", @@ -349,7 +222,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha256_finalize(inner: *mut [u8; 96], ou "pop eax", "pop eax", "pop eax", - "mov eax, DWORD PTR [ebp+136]", + "mov eax, edi", "mov ecx, DWORD PTR [ebx]", "bswap ecx", "mov DWORD PTR [eax], ecx", @@ -375,11 +248,12 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha256_finalize(inner: *mut [u8; 96], ou "bswap ecx", "mov DWORD PTR [eax+28], ecx", "mov eax, ebp", - "mov ebx, DWORD PTR [eax+112]", - "mov esi, DWORD PTR [eax+116]", - "mov edi, DWORD PTR [eax+120]", - "mov ebp, DWORD PTR [eax+124]", + "mov ebx, DWORD PTR [eax+160]", + "mov esi, DWORD PTR [eax+164]", + "mov edi, DWORD PTR [eax+168]", + "mov ebp, DWORD PTR [eax+172]", "ret", + vg_sha256_finalize = sym super::sha256::vg_sha256_finalize, vg_sha256_compress = sym super::sha256::vg_sha256_compress, ) } @@ -389,7 +263,7 @@ pub(crate) const VG_HMAC_SHA256_INIT_SHANI_FEATURES: &[&str] = &["sha", "ssse3"] /// Starts an HMAC-SHA-256 computation with a key of at most 64 bytes: makes the SHA-256 streaming state `*inner` represent `K₀ ⊕ ipad` and `*outer` represent `K₀ ⊕ opad`, where `K₀` is the `key_len` bytes at `key` padded with zeros to 64 bytes (FIPS 198-1). The text is then absorbed with `vg_sha256_update` on `*inner` (its `count` starting at 64), and the MAC computed with `vg_hmac_sha256_finalize`. /// -/// Contract: `VG.Spec.Hmac.initSha256Contract`. Constant time: only the pointers and `key_len` may affect timing, not the key. +/// Contract: `VG.Spec.Hmac.Instance.initContract` of `VG.Spec.Hmac.sha256I`. Constant time: only the pointers and `key_len` may affect timing, not the key. /// /// The function may overwrite the arguments on the stack, as the calling convention lets it. /// @@ -398,173 +272,119 @@ pub(crate) const VG_HMAC_SHA256_INIT_SHANI_FEATURES: &[&str] = &["sha", "ssse3"] /// * `inner` must be valid for reads and writes of 96 bytes. /// * `outer` must be valid for reads and writes of 96 bytes. /// * `key` must be valid for reads of `key_len` bytes. -/// * `scratch` must be valid for reads and writes of 608 bytes. +/// * `scratch` must be valid for reads and writes of 832 bytes. /// * `key_len` must be at most 64. /// * The contents of `scratch` on return are unspecified. /// * `inner`, `outer` and `scratch` must not overlap each other or `key` (distinct Rust objects never do). -/// * None of `inner`, `outer`, `key` and `scratch` may overlap the arguments on the stack, overlap the return address on the stack or the 20 bytes of stack below it, or wrap around the end of the address space (no Rust object does). +/// * None of `inner`, `outer`, `key` and `scratch` may overlap the arguments on the stack, overlap the return address on the stack or the 48 bytes of stack below it, or wrap around the end of the address space (no Rust object does). /// * The CPU must support the `sha` and `ssse3` target features. #[unsafe(naked)] -pub(crate) unsafe extern "C" fn vg_hmac_sha256_init_shani(inner: *mut [u8; 96], outer: *mut [u8; 96], key: *const u8, key_len: usize, scratch: *mut [u64; 76]) { +pub(crate) unsafe extern "C" fn vg_hmac_sha256_init_shani(inner: *mut [u8; 96], outer: *mut [u8; 96], key: *const u8, key_len: usize, scratch: *mut [u64; 104]) { core::arch::naked_asm!( "mov eax, DWORD PTR [esp+20]", - "mov DWORD PTR [eax+112], ebx", - "mov DWORD PTR [eax+116], esi", - "mov DWORD PTR [eax+120], edi", - "mov DWORD PTR [eax+124], ebp", + "mov DWORD PTR [eax+160], ebx", + "mov DWORD PTR [eax+164], esi", + "mov DWORD PTR [eax+168], edi", + "mov DWORD PTR [eax+172], ebp", "mov ebp, eax", - "mov ebx, DWORD PTR [esp+4]", - "mov esi, DWORD PTR [esp+8]", - "mov ecx, 1779033703", - "mov DWORD PTR [ebx], ecx", - "mov ecx, -1150833019", - "mov DWORD PTR [ebx+4], ecx", - "mov ecx, 1013904242", - "mov DWORD PTR [ebx+8], ecx", - "mov ecx, -1521486534", - "mov DWORD PTR [ebx+12], ecx", - "mov ecx, 1359893119", - "mov DWORD PTR [ebx+16], ecx", - "mov ecx, -1694144372", - "mov DWORD PTR [ebx+20], ecx", - "mov ecx, 528734635", - "mov DWORD PTR [ebx+24], ecx", - "mov ecx, 1541459225", - "mov DWORD PTR [ebx+28], ecx", - "mov ecx, 1779033703", - "mov DWORD PTR [esi], ecx", - "mov ecx, -1150833019", - "mov DWORD PTR [esi+4], ecx", - "mov ecx, 1013904242", - "mov DWORD PTR [esi+8], ecx", - "mov ecx, -1521486534", - "mov DWORD PTR [esi+12], ecx", - "mov ecx, 1359893119", - "mov DWORD PTR [esi+16], ecx", - "mov ecx, -1694144372", - "mov DWORD PTR [esi+20], ecx", - "mov ecx, 528734635", - "mov DWORD PTR [esi+24], ecx", - "mov ecx, 1541459225", - "mov DWORD PTR [esi+28], ecx", - "mov edi, DWORD PTR [esp+12]", - "mov ecx, DWORD PTR [esp+16]", - "mov edx, ebx", - "add edx, 32", - "test ecx, ecx", + "mov esi, DWORD PTR [esp+12]", + "mov edi, DWORD PTR [esp+16]", + "mov ebx, 0", + "test edi, edi", "je 20f", "22:", - "movzx eax, BYTE PTR [edi]", + "mov eax, esi", + "add eax, ebx", + "movzx eax, BYTE PTR [eax]", + "mov ecx, eax", "xor eax, 54", - "mov BYTE PTR [edx], al", - "add edi, 1", - "add edx, 1", - "sub ecx, 1", + "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", "jne 22b", "jmp 21f", "20:", "21:", - "mov eax, ebx", - "add eax, 96", - "mov ecx, 54", - "cmp edx, eax", + "mov eax, 54", + "mov ecx, 92", + "cmp ebx, 64", "je 23f", "25:", - "mov BYTE PTR [edx], cl", - "add edx, 1", - "cmp edx, eax", + "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 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", + "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", "push ebp", "push ecx", + "push edx", "push eax", + "push edi", "push ebx", - "call {vg_sha256_compress_shani}", + "call {vg_sha256_update_shani}", "pop eax", "pop eax", "pop eax", "pop eax", - "mov eax, esi", - "add eax, 32", - "mov ecx, 1", + "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", "push ebp", "push ecx", + "push edx", "push eax", + "push edi", "push esi", - "call {vg_sha256_compress_shani}", + "call {vg_sha256_update_shani}", + "pop eax", + "pop eax", "pop eax", "pop eax", "pop eax", "pop eax", "mov eax, ebp", - "mov ebx, DWORD PTR [eax+112]", - "mov esi, DWORD PTR [eax+116]", - "mov edi, DWORD PTR [eax+120]", - "mov ebp, DWORD PTR [eax+124]", + "mov ebx, DWORD PTR [eax+160]", + "mov esi, DWORD PTR [eax+164]", + "mov edi, DWORD PTR [eax+168]", + "mov ebp, DWORD PTR [eax+172]", "ret", - vg_sha256_compress_shani = sym super::sha256::vg_sha256_compress_shani, + vg_sha256_init = sym super::sha256::vg_sha256_init, + vg_sha256_update_shani = sym super::sha256::vg_sha256_update_shani, ) } /// The CPU features `vg_hmac_sha256_finalize_shani` requires (`Artifact.features`). pub(crate) const VG_HMAC_SHA256_FINALIZE_SHANI_FEATURES: &[&str] = &["sha", "ssse3"]; -/// Finishes an HMAC-SHA-256 computation: if, for a 64-byte key `K₀` and a text, the SHA-256 streaming state `*inner` represents `(K₀ ⊕ ipad) ‖ text`, of `count` bytes (modulo 2⁶⁴), and `*outer` represents `K₀ ⊕ opad`, writes the HMAC-SHA-256 of the text under `K₀` to `*out`. +/// Finishes an HMAC-SHA-256 computation: if, for a 64-byte key `K₀` and a text of fewer than 2⁶⁴ − 64 bytes, the SHA-256 streaming state `*inner` represents `(K₀ ⊕ ipad) ‖ text`, of `count` bytes, and `*outer` represents `K₀ ⊕ opad`, writes the HMAC-SHA-256 of the text under `K₀` (32 bytes) to `*out`. /// -/// Contract: `VG.Spec.Hmac.finalizeSha256OutContract`. Constant time: only the pointers and `count` may affect timing, not the states. +/// Contract: `VG.Spec.Hmac.Instance.finalizeContract` of `VG.Spec.Hmac.sha256I`. Constant time: only the pointers and `count` may affect timing, not the states. /// /// The function may overwrite the arguments on the stack, as the calling convention lets it. /// @@ -573,157 +393,84 @@ pub(crate) const VG_HMAC_SHA256_FINALIZE_SHANI_FEATURES: &[&str] = &["sha", "sss /// * `inner` must be valid for reads and writes of 96 bytes. /// * `outer` must be valid for reads of 96 bytes. /// * `out` must be valid for reads and writes of 32 bytes. -/// * `scratch` must be valid for reads and writes of 688 bytes. +/// * `scratch` must be valid for reads and writes of 832 bytes. /// * The contents of `inner` on return are unspecified. /// * The contents of `scratch` on return are unspecified. /// * `inner`, `out` and `scratch` must not overlap each other or `outer` (distinct Rust objects never do). -/// * None of `inner`, `outer`, `out` and `scratch` may overlap the arguments on the stack, overlap the return address on the stack or the 20 bytes of stack below it, or wrap around the end of the address space (no Rust object does). +/// * None of `inner`, `outer`, `out` and `scratch` may overlap the arguments on the stack, overlap the return address on the stack or the 48 bytes of stack below it, or wrap around the end of the address space (no Rust object does). /// * The CPU must support the `sha` and `ssse3` target features. #[unsafe(naked)] -pub(crate) unsafe extern "C" fn vg_hmac_sha256_finalize_shani(inner: *mut [u8; 96], outer: *const [u8; 96], count: u64, out: *mut [u8; 32], scratch: *mut [u64; 86]) { +pub(crate) unsafe extern "C" fn vg_hmac_sha256_finalize_shani(inner: *mut [u8; 96], outer: *const [u8; 96], count: u64, out: *mut [u8; 32], scratch: *mut [u64; 104]) { core::arch::naked_asm!( - "mov edx, DWORD PTR [esp+24]", - "mov ecx, DWORD PTR [esp+8]", - "mov DWORD PTR [edx+176], ecx", - "mov ecx, DWORD PTR [esp+12]", - "mov DWORD PTR [esp+8], ecx", - "mov ecx, DWORD PTR [esp+16]", - "mov DWORD PTR [esp+12], ecx", - "mov ecx, DWORD PTR [esp+20]", - "mov DWORD PTR [esp+16], ecx", - "mov DWORD PTR [esp+20], edx", - "mov eax, DWORD PTR [esp+20]", - "mov DWORD PTR [eax+112], ebx", - "mov DWORD PTR [eax+116], esi", - "mov DWORD PTR [eax+120], edi", - "mov DWORD PTR [eax+124], ebp", + "mov eax, DWORD PTR [esp+24]", + "mov DWORD PTR [eax+160], ebx", + "mov DWORD PTR [eax+164], esi", + "mov DWORD PTR [eax+168], edi", + "mov DWORD PTR [eax+172], ebp", "mov ebp, eax", "mov ebx, DWORD PTR [esp+4]", - "mov ecx, DWORD PTR [esp+8]", - "mov DWORD PTR [ebp+128], ecx", - "mov ecx, DWORD PTR [esp+12]", - "mov DWORD PTR [ebp+132], ecx", + "mov esi, DWORD PTR [esp+8]", + "mov edi, DWORD PTR [esp+20]", + "mov eax, DWORD PTR [esp+12]", "mov ecx, DWORD PTR [esp+16]", - "mov DWORD PTR [ebp+136], ecx", - "mov edi, DWORD PTR [esp+8]", - "and edi, 63", - "mov edx, ebx", - "add edx, edi", - "mov ecx, 128", - "mov BYTE PTR [edx+32], cl", - "add edi, 1", - "mov esi, 0", - "cmp edi, 57", - "jae 20f", - "jmp 21f", - "20:", - "mov esi, 1", - "21:", - "22:", - "mov eax, 64", - "test esi, esi", - "je 23f", - "jmp 24f", - "23:", - "mov eax, 56", - "24:", - "mov ecx, 0", - "sub eax, edi", - "je 25f", - "27:", - "mov edx, ebx", - "add edx, edi", - "mov BYTE PTR [edx+32], cl", - "add edi, 1", - "sub eax, 1", - "jne 27b", - "jmp 26f", - "25:", - "26:", - "test esi, esi", - "je 28f", - "jmp 29f", - "28:", - "mov eax, DWORD PTR [ebp+128]", - "mov ecx, DWORD PTR [ebp+132]", - "add ecx, ecx", - "add ecx, ecx", - "add ecx, ecx", - "mov edx, eax", - "shr edx, 29", - "or ecx, edx", - "add eax, eax", - "add eax, eax", - "add eax, eax", - "bswap ecx", - "mov DWORD PTR [ebx+88], ecx", - "bswap eax", - "mov DWORD PTR [ebx+92], eax", - "29:", - "mov eax, ebx", - "add eax, 32", - "mov ecx, 1", + "mov edx, ebp", + "add edx, 176", "push ebp", + "push edx", "push ecx", "push eax", "push ebx", - "call {vg_sha256_compress_shani}", + "call {vg_sha256_finalize_shani}", "pop eax", "pop eax", "pop eax", "pop eax", - "mov edi, 0", - "sub esi, 1", - "je 22b", - "mov ecx, DWORD PTR [ebx]", - "bswap ecx", - "mov DWORD PTR [ebx+32], ecx", - "mov ecx, DWORD PTR [ebx+4]", - "bswap ecx", - "mov DWORD PTR [ebx+36], ecx", - "mov ecx, DWORD PTR [ebx+8]", - "bswap ecx", - "mov DWORD PTR [ebx+40], ecx", - "mov ecx, DWORD PTR [ebx+12]", - "bswap ecx", - "mov DWORD PTR [ebx+44], ecx", - "mov ecx, DWORD PTR [ebx+16]", - "bswap ecx", - "mov DWORD PTR [ebx+48], ecx", - "mov ecx, DWORD PTR [ebx+20]", - "bswap ecx", - "mov DWORD PTR [ebx+52], ecx", - "mov ecx, DWORD PTR [ebx+24]", - "bswap ecx", - "mov DWORD PTR [ebx+56], ecx", - "mov ecx, DWORD PTR [ebx+28]", - "bswap ecx", - "mov DWORD PTR [ebx+60], ecx", - "mov edx, DWORD PTR [ebp+176]", - "mov ecx, DWORD PTR [edx]", + "pop eax", + "mov ecx, DWORD PTR [esi]", "mov DWORD PTR [ebx], ecx", - "mov ecx, DWORD PTR [edx+4]", + "mov ecx, DWORD PTR [esi+4]", "mov DWORD PTR [ebx+4], ecx", - "mov ecx, DWORD PTR [edx+8]", + "mov ecx, DWORD PTR [esi+8]", "mov DWORD PTR [ebx+8], ecx", - "mov ecx, DWORD PTR [edx+12]", + "mov ecx, DWORD PTR [esi+12]", "mov DWORD PTR [ebx+12], ecx", - "mov ecx, DWORD PTR [edx+16]", + "mov ecx, DWORD PTR [esi+16]", "mov DWORD PTR [ebx+16], ecx", - "mov ecx, DWORD PTR [edx+20]", + "mov ecx, DWORD PTR [esi+20]", "mov DWORD PTR [ebx+20], ecx", - "mov ecx, DWORD PTR [edx+24]", + "mov ecx, DWORD PTR [esi+24]", "mov DWORD PTR [ebx+24], ecx", - "mov ecx, DWORD PTR [edx+28]", + "mov ecx, DWORD PTR [esi+28]", "mov DWORD PTR [ebx+28], ecx", + "mov ecx, DWORD PTR [ebp+176]", + "mov DWORD PTR [ebx+32], ecx", + "mov ecx, DWORD PTR [ebp+180]", + "mov DWORD PTR [ebx+36], ecx", + "mov ecx, DWORD PTR [ebp+184]", + "mov DWORD PTR [ebx+40], ecx", + "mov ecx, DWORD PTR [ebp+188]", + "mov DWORD PTR [ebx+44], ecx", + "mov ecx, DWORD PTR [ebp+192]", + "mov DWORD PTR [ebx+48], ecx", + "mov ecx, DWORD PTR [ebp+196]", + "mov DWORD PTR [ebx+52], ecx", + "mov ecx, DWORD PTR [ebp+200]", + "mov DWORD PTR [ebx+56], ecx", + "mov ecx, DWORD PTR [ebp+204]", + "mov DWORD PTR [ebx+60], ecx", "mov ecx, 128", "mov DWORD PTR [ebx+64], ecx", "mov ecx, 0", "mov DWORD PTR [ebx+68], ecx", + "mov ecx, 0", "mov DWORD PTR [ebx+72], ecx", + "mov ecx, 0", "mov DWORD PTR [ebx+76], ecx", + "mov ecx, 0", "mov DWORD PTR [ebx+80], ecx", + "mov ecx, 0", "mov DWORD PTR [ebx+84], ecx", + "mov ecx, 0", "mov DWORD PTR [ebx+88], ecx", "mov ecx, 196608", "mov DWORD PTR [ebx+92], ecx", @@ -739,7 +486,7 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha256_finalize_shani(inner: *mut [u8; 9 "pop eax", "pop eax", "pop eax", - "mov eax, DWORD PTR [ebp+136]", + "mov eax, edi", "mov ecx, DWORD PTR [ebx]", "bswap ecx", "mov DWORD PTR [eax], ecx", @@ -765,11 +512,12 @@ pub(crate) unsafe extern "C" fn vg_hmac_sha256_finalize_shani(inner: *mut [u8; 9 "bswap ecx", "mov DWORD PTR [eax+28], ecx", "mov eax, ebp", - "mov ebx, DWORD PTR [eax+112]", - "mov esi, DWORD PTR [eax+116]", - "mov edi, DWORD PTR [eax+120]", - "mov ebp, DWORD PTR [eax+124]", + "mov ebx, DWORD PTR [eax+160]", + "mov esi, DWORD PTR [eax+164]", + "mov edi, DWORD PTR [eax+168]", + "mov ebp, DWORD PTR [eax+172]", "ret", + vg_sha256_finalize_shani = sym super::sha256::vg_sha256_finalize_shani, vg_sha256_compress_shani = sym super::sha256::vg_sha256_compress_shani, ) } diff --git a/src/asm/x86/pbkdf2_sha256.rs b/src/asm/x86/pbkdf2_sha256.rs index e464a9ec9..9be5be8ca 100644 --- a/src/asm/x86/pbkdf2_sha256.rs +++ b/src/asm/x86/pbkdf2_sha256.rs @@ -4,7 +4,7 @@ /// Runs `n` steps of PBKDF2-HMAC-SHA-256's iteration: if, for a 64-byte key `K₀`, the SHA-256 streaming state in bytes 0 to 95 of `*key` represents `K₀ ⊕ ipad` and the one in bytes 96 to 191 represents `K₀ ⊕ opad` (as `vg_hmac_sha256_init` leaves them), repeats `U ← HMAC-SHA-256 (K₀, U)`, `T ← T ⊕ U` `n` times, from `U = *u` and `T = *t`, and leaves the final `T` in `*t` (RFC 8018, step 3 of `F`). /// -/// Contract: `VG.Spec.Pbkdf2.iterateSha256Contract`. Constant time: only the pointers and `n` may affect timing, not the key, `U` or `T`. +/// Contract: `VG.Spec.Hmac.Instance.iterateContract` of `VG.Spec.Hmac.sha256I`. Constant time: only the pointers and `n` may affect timing, not the key, `U` or `T`. /// /// The function may overwrite the arguments on the stack, as the calling convention lets it. /// @@ -16,63 +16,53 @@ /// * `scratch` must be valid for reads and writes of 832 bytes. /// * The contents of `scratch` on return are unspecified. /// * `t` and `scratch` must not overlap each other, `key` or `u` (distinct Rust objects never do). -/// * None of `key`, `u`, `t` and `scratch` may overlap the arguments on the stack, overlap the return address on the stack or the 20 bytes of stack below it, or wrap around the end of the address space (no Rust object does). +/// * None of `key`, `u`, `t` and `scratch` may overlap the arguments on the stack, overlap the return address on the stack or the 48 bytes of stack below it, or wrap around the end of the address space (no Rust object does). #[unsafe(naked)] pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate(key: *const [u8; 192], u: *const [u8; 32], n: u32, t: *mut [u8; 32], scratch: *mut [u64; 104]) { core::arch::naked_asm!( "mov eax, DWORD PTR [esp+20]", - "mov DWORD PTR [eax+112], ebx", - "mov DWORD PTR [eax+116], esi", - "mov DWORD PTR [eax+120], edi", - "mov DWORD PTR [eax+124], ebp", + "mov DWORD PTR [eax+160], ebx", + "mov DWORD PTR [eax+164], esi", + "mov DWORD PTR [eax+168], edi", + "mov DWORD PTR [eax+172], ebp", "mov ebp, eax", "mov esi, DWORD PTR [esp+4]", "mov edi, DWORD PTR [esp+12]", - "mov ebx, DWORD PTR [esp+16]", + "mov ebx, ebp", + "add ebx, 176", "mov edx, DWORD PTR [esp+8]", "mov ecx, DWORD PTR [edx]", - "mov DWORD PTR [ebp+192], ecx", + "mov DWORD PTR [ebx+32], ecx", "mov ecx, DWORD PTR [edx+4]", - "mov DWORD PTR [ebp+196], ecx", + "mov DWORD PTR [ebx+36], ecx", "mov ecx, DWORD PTR [edx+8]", - "mov DWORD PTR [ebp+200], ecx", + "mov DWORD PTR [ebx+40], ecx", "mov ecx, DWORD PTR [edx+12]", - "mov DWORD PTR [ebp+204], ecx", + "mov DWORD PTR [ebx+44], ecx", "mov ecx, DWORD PTR [edx+16]", - "mov DWORD PTR [ebp+208], ecx", + "mov DWORD PTR [ebx+48], ecx", "mov ecx, DWORD PTR [edx+20]", - "mov DWORD PTR [ebp+212], ecx", + "mov DWORD PTR [ebx+52], ecx", "mov ecx, DWORD PTR [edx+24]", - "mov DWORD PTR [ebp+216], ecx", + "mov DWORD PTR [ebx+56], ecx", "mov ecx, DWORD PTR [edx+28]", - "mov DWORD PTR [ebp+220], ecx", - "mov ecx, DWORD PTR [ebx]", - "mov DWORD PTR [ebp+160], ecx", - "mov ecx, DWORD PTR [ebx+4]", - "mov DWORD PTR [ebp+164], ecx", - "mov ecx, DWORD PTR [ebx+8]", - "mov DWORD PTR [ebp+168], ecx", - "mov ecx, DWORD PTR [ebx+12]", - "mov DWORD PTR [ebp+172], ecx", - "mov ecx, DWORD PTR [ebx+16]", - "mov DWORD PTR [ebp+176], ecx", - "mov ecx, DWORD PTR [ebx+20]", - "mov DWORD PTR [ebp+180], ecx", - "mov ecx, DWORD PTR [ebx+24]", - "mov DWORD PTR [ebp+184], ecx", - "mov ecx, DWORD PTR [ebx+28]", - "mov DWORD PTR [ebp+188], ecx", + "mov DWORD PTR [ebx+60], ecx", "mov ecx, 128", - "mov DWORD PTR [ebp+224], ecx", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+76], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+80], ecx", "mov ecx, 0", - "mov DWORD PTR [ebp+228], ecx", - "mov DWORD PTR [ebp+232], ecx", - "mov DWORD PTR [ebp+236], ecx", - "mov DWORD PTR [ebp+240], ecx", - "mov DWORD PTR [ebp+244], ecx", - "mov DWORD PTR [ebp+248], ecx", + "mov DWORD PTR [ebx+84], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+88], ecx", "mov ecx, 196608", - "mov DWORD PTR [ebp+252], ecx", + "mov DWORD PTR [ebx+92], ecx", "test edi, edi", "je 20f", "22:", @@ -92,8 +82,8 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate(key: *const [u8; 1 "mov DWORD PTR [ebx+24], ecx", "mov ecx, DWORD PTR [esi+28]", "mov DWORD PTR [ebx+28], ecx", - "mov eax, ebp", - "add eax, 192", + "mov eax, ebx", + "add eax, 32", "mov ecx, 1", "push ebp", "push ecx", @@ -104,30 +94,32 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate(key: *const [u8; 1 "pop eax", "pop eax", "pop eax", + "mov eax, ebx", + "add eax, 32", "mov ecx, DWORD PTR [ebx]", "bswap ecx", - "mov DWORD PTR [ebp+192], ecx", + "mov DWORD PTR [eax], ecx", "mov ecx, DWORD PTR [ebx+4]", "bswap ecx", - "mov DWORD PTR [ebp+196], ecx", + "mov DWORD PTR [eax+4], ecx", "mov ecx, DWORD PTR [ebx+8]", "bswap ecx", - "mov DWORD PTR [ebp+200], ecx", + "mov DWORD PTR [eax+8], ecx", "mov ecx, DWORD PTR [ebx+12]", "bswap ecx", - "mov DWORD PTR [ebp+204], ecx", + "mov DWORD PTR [eax+12], ecx", "mov ecx, DWORD PTR [ebx+16]", "bswap ecx", - "mov DWORD PTR [ebp+208], ecx", + "mov DWORD PTR [eax+16], ecx", "mov ecx, DWORD PTR [ebx+20]", "bswap ecx", - "mov DWORD PTR [ebp+212], ecx", + "mov DWORD PTR [eax+20], ecx", "mov ecx, DWORD PTR [ebx+24]", "bswap ecx", - "mov DWORD PTR [ebp+216], ecx", + "mov DWORD PTR [eax+24], ecx", "mov ecx, DWORD PTR [ebx+28]", "bswap ecx", - "mov DWORD PTR [ebp+220], ecx", + "mov DWORD PTR [eax+28], ecx", "mov ecx, DWORD PTR [esi+96]", "mov DWORD PTR [ebx], ecx", "mov ecx, DWORD PTR [esi+100]", @@ -144,8 +136,8 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate(key: *const [u8; 1 "mov DWORD PTR [ebx+24], ecx", "mov ecx, DWORD PTR [esi+124]", "mov DWORD PTR [ebx+28], ecx", - "mov eax, ebp", - "add eax, 192", + "mov eax, ebx", + "add eax, 32", "mov ecx, 1", "push ebp", "push ecx", @@ -156,80 +148,67 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate(key: *const [u8; 1 "pop eax", "pop eax", "pop eax", + "mov eax, ebx", + "add eax, 32", "mov ecx, DWORD PTR [ebx]", "bswap ecx", - "mov DWORD PTR [ebp+192], ecx", + "mov DWORD PTR [eax], ecx", "mov ecx, DWORD PTR [ebx+4]", "bswap ecx", - "mov DWORD PTR [ebp+196], ecx", + "mov DWORD PTR [eax+4], ecx", "mov ecx, DWORD PTR [ebx+8]", "bswap ecx", - "mov DWORD PTR [ebp+200], ecx", + "mov DWORD PTR [eax+8], ecx", "mov ecx, DWORD PTR [ebx+12]", "bswap ecx", - "mov DWORD PTR [ebp+204], ecx", + "mov DWORD PTR [eax+12], ecx", "mov ecx, DWORD PTR [ebx+16]", "bswap ecx", - "mov DWORD PTR [ebp+208], ecx", + "mov DWORD PTR [eax+16], ecx", "mov ecx, DWORD PTR [ebx+20]", "bswap ecx", - "mov DWORD PTR [ebp+212], ecx", + "mov DWORD PTR [eax+20], ecx", "mov ecx, DWORD PTR [ebx+24]", "bswap ecx", - "mov DWORD PTR [ebp+216], ecx", + "mov DWORD PTR [eax+24], ecx", "mov ecx, DWORD PTR [ebx+28]", "bswap ecx", - "mov DWORD PTR [ebp+220], ecx", - "mov ecx, DWORD PTR [ebp+160]", - "xor ecx, DWORD PTR [ebp+192]", - "mov DWORD PTR [ebp+160], ecx", - "mov ecx, DWORD PTR [ebp+164]", - "xor ecx, DWORD PTR [ebp+196]", - "mov DWORD PTR [ebp+164], ecx", - "mov ecx, DWORD PTR [ebp+168]", - "xor ecx, DWORD PTR [ebp+200]", - "mov DWORD PTR [ebp+168], ecx", - "mov ecx, DWORD PTR [ebp+172]", - "xor ecx, DWORD PTR [ebp+204]", - "mov DWORD PTR [ebp+172], ecx", - "mov ecx, DWORD PTR [ebp+176]", - "xor ecx, DWORD PTR [ebp+208]", - "mov DWORD PTR [ebp+176], ecx", - "mov ecx, DWORD PTR [ebp+180]", - "xor ecx, DWORD PTR [ebp+212]", - "mov DWORD PTR [ebp+180], ecx", - "mov ecx, DWORD PTR [ebp+184]", - "xor ecx, DWORD PTR [ebp+216]", - "mov DWORD PTR [ebp+184], ecx", - "mov ecx, DWORD PTR [ebp+188]", - "xor ecx, DWORD PTR [ebp+220]", - "mov DWORD PTR [ebp+188], ecx", + "mov DWORD PTR [eax+28], ecx", + "mov edx, DWORD PTR [esp+16]", + "mov ecx, DWORD PTR [ebx+32]", + "xor ecx, DWORD PTR [edx]", + "mov DWORD PTR [edx], ecx", + "mov ecx, DWORD PTR [ebx+36]", + "xor ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [edx+4], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "xor ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [edx+8], ecx", + "mov ecx, DWORD PTR [ebx+44]", + "xor ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [edx+12], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "xor ecx, DWORD PTR [edx+16]", + "mov DWORD PTR [edx+16], ecx", + "mov ecx, DWORD PTR [ebx+52]", + "xor ecx, DWORD PTR [edx+20]", + "mov DWORD PTR [edx+20], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "xor ecx, DWORD PTR [edx+24]", + "mov DWORD PTR [edx+24], ecx", + "mov ecx, DWORD PTR [ebx+60]", + "xor ecx, DWORD PTR [edx+28]", + "mov DWORD PTR [edx+28], ecx", "sub edi, 1", "jne 22b", "jmp 21f", "20:", "21:", - "mov ecx, DWORD PTR [ebp+160]", - "mov DWORD PTR [ebx], ecx", - "mov ecx, DWORD PTR [ebp+164]", - "mov DWORD PTR [ebx+4], ecx", - "mov ecx, DWORD PTR [ebp+168]", - "mov DWORD PTR [ebx+8], ecx", - "mov ecx, DWORD PTR [ebp+172]", - "mov DWORD PTR [ebx+12], ecx", - "mov ecx, DWORD PTR [ebp+176]", - "mov DWORD PTR [ebx+16], ecx", - "mov ecx, DWORD PTR [ebp+180]", - "mov DWORD PTR [ebx+20], ecx", - "mov ecx, DWORD PTR [ebp+184]", - "mov DWORD PTR [ebx+24], ecx", - "mov ecx, DWORD PTR [ebp+188]", - "mov DWORD PTR [ebx+28], ecx", "mov eax, ebp", - "mov ebx, DWORD PTR [eax+112]", - "mov esi, DWORD PTR [eax+116]", - "mov edi, DWORD PTR [eax+120]", - "mov ebp, DWORD PTR [eax+124]", + "mov ebx, DWORD PTR [eax+160]", + "mov esi, DWORD PTR [eax+164]", + "mov edi, DWORD PTR [eax+168]", + "mov ebp, DWORD PTR [eax+172]", "ret", vg_sha256_compress = sym super::sha256::vg_sha256_compress, ) @@ -498,7 +477,7 @@ pub(crate) const VG_PBKDF2_HMAC_SHA256_ITERATE_SHANI_FEATURES: &[&str] = &["sha" /// Runs `n` steps of PBKDF2-HMAC-SHA-256's iteration: if, for a 64-byte key `K₀`, the SHA-256 streaming state in bytes 0 to 95 of `*key` represents `K₀ ⊕ ipad` and the one in bytes 96 to 191 represents `K₀ ⊕ opad` (as `vg_hmac_sha256_init` leaves them), repeats `U ← HMAC-SHA-256 (K₀, U)`, `T ← T ⊕ U` `n` times, from `U = *u` and `T = *t`, and leaves the final `T` in `*t` (RFC 8018, step 3 of `F`). /// -/// Contract: `VG.Spec.Pbkdf2.iterateSha256Contract`. Constant time: only the pointers and `n` may affect timing, not the key, `U` or `T`. +/// Contract: `VG.Spec.Hmac.Instance.iterateContract` of `VG.Spec.Hmac.sha256I`. Constant time: only the pointers and `n` may affect timing, not the key, `U` or `T`. /// /// The function may overwrite the arguments on the stack, as the calling convention lets it. /// @@ -510,64 +489,54 @@ pub(crate) const VG_PBKDF2_HMAC_SHA256_ITERATE_SHANI_FEATURES: &[&str] = &["sha" /// * `scratch` must be valid for reads and writes of 832 bytes. /// * The contents of `scratch` on return are unspecified. /// * `t` and `scratch` must not overlap each other, `key` or `u` (distinct Rust objects never do). -/// * None of `key`, `u`, `t` and `scratch` may overlap the arguments on the stack, overlap the return address on the stack or the 20 bytes of stack below it, or wrap around the end of the address space (no Rust object does). +/// * None of `key`, `u`, `t` and `scratch` may overlap the arguments on the stack, overlap the return address on the stack or the 48 bytes of stack below it, or wrap around the end of the address space (no Rust object does). /// * The CPU must support the `sha` and `ssse3` target features. #[unsafe(naked)] pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate_shani(key: *const [u8; 192], u: *const [u8; 32], n: u32, t: *mut [u8; 32], scratch: *mut [u64; 104]) { core::arch::naked_asm!( "mov eax, DWORD PTR [esp+20]", - "mov DWORD PTR [eax+112], ebx", - "mov DWORD PTR [eax+116], esi", - "mov DWORD PTR [eax+120], edi", - "mov DWORD PTR [eax+124], ebp", + "mov DWORD PTR [eax+160], ebx", + "mov DWORD PTR [eax+164], esi", + "mov DWORD PTR [eax+168], edi", + "mov DWORD PTR [eax+172], ebp", "mov ebp, eax", "mov esi, DWORD PTR [esp+4]", "mov edi, DWORD PTR [esp+12]", - "mov ebx, DWORD PTR [esp+16]", + "mov ebx, ebp", + "add ebx, 176", "mov edx, DWORD PTR [esp+8]", "mov ecx, DWORD PTR [edx]", - "mov DWORD PTR [ebp+192], ecx", + "mov DWORD PTR [ebx+32], ecx", "mov ecx, DWORD PTR [edx+4]", - "mov DWORD PTR [ebp+196], ecx", + "mov DWORD PTR [ebx+36], ecx", "mov ecx, DWORD PTR [edx+8]", - "mov DWORD PTR [ebp+200], ecx", + "mov DWORD PTR [ebx+40], ecx", "mov ecx, DWORD PTR [edx+12]", - "mov DWORD PTR [ebp+204], ecx", + "mov DWORD PTR [ebx+44], ecx", "mov ecx, DWORD PTR [edx+16]", - "mov DWORD PTR [ebp+208], ecx", + "mov DWORD PTR [ebx+48], ecx", "mov ecx, DWORD PTR [edx+20]", - "mov DWORD PTR [ebp+212], ecx", + "mov DWORD PTR [ebx+52], ecx", "mov ecx, DWORD PTR [edx+24]", - "mov DWORD PTR [ebp+216], ecx", + "mov DWORD PTR [ebx+56], ecx", "mov ecx, DWORD PTR [edx+28]", - "mov DWORD PTR [ebp+220], ecx", - "mov ecx, DWORD PTR [ebx]", - "mov DWORD PTR [ebp+160], ecx", - "mov ecx, DWORD PTR [ebx+4]", - "mov DWORD PTR [ebp+164], ecx", - "mov ecx, DWORD PTR [ebx+8]", - "mov DWORD PTR [ebp+168], ecx", - "mov ecx, DWORD PTR [ebx+12]", - "mov DWORD PTR [ebp+172], ecx", - "mov ecx, DWORD PTR [ebx+16]", - "mov DWORD PTR [ebp+176], ecx", - "mov ecx, DWORD PTR [ebx+20]", - "mov DWORD PTR [ebp+180], ecx", - "mov ecx, DWORD PTR [ebx+24]", - "mov DWORD PTR [ebp+184], ecx", - "mov ecx, DWORD PTR [ebx+28]", - "mov DWORD PTR [ebp+188], ecx", + "mov DWORD PTR [ebx+60], ecx", "mov ecx, 128", - "mov DWORD PTR [ebp+224], ecx", + "mov DWORD PTR [ebx+64], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+68], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+72], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+76], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+80], ecx", "mov ecx, 0", - "mov DWORD PTR [ebp+228], ecx", - "mov DWORD PTR [ebp+232], ecx", - "mov DWORD PTR [ebp+236], ecx", - "mov DWORD PTR [ebp+240], ecx", - "mov DWORD PTR [ebp+244], ecx", - "mov DWORD PTR [ebp+248], ecx", + "mov DWORD PTR [ebx+84], ecx", + "mov ecx, 0", + "mov DWORD PTR [ebx+88], ecx", "mov ecx, 196608", - "mov DWORD PTR [ebp+252], ecx", + "mov DWORD PTR [ebx+92], ecx", "test edi, edi", "je 20f", "22:", @@ -587,8 +556,8 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate_shani(key: *const "mov DWORD PTR [ebx+24], ecx", "mov ecx, DWORD PTR [esi+28]", "mov DWORD PTR [ebx+28], ecx", - "mov eax, ebp", - "add eax, 192", + "mov eax, ebx", + "add eax, 32", "mov ecx, 1", "push ebp", "push ecx", @@ -599,30 +568,32 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate_shani(key: *const "pop eax", "pop eax", "pop eax", + "mov eax, ebx", + "add eax, 32", "mov ecx, DWORD PTR [ebx]", "bswap ecx", - "mov DWORD PTR [ebp+192], ecx", + "mov DWORD PTR [eax], ecx", "mov ecx, DWORD PTR [ebx+4]", "bswap ecx", - "mov DWORD PTR [ebp+196], ecx", + "mov DWORD PTR [eax+4], ecx", "mov ecx, DWORD PTR [ebx+8]", "bswap ecx", - "mov DWORD PTR [ebp+200], ecx", + "mov DWORD PTR [eax+8], ecx", "mov ecx, DWORD PTR [ebx+12]", "bswap ecx", - "mov DWORD PTR [ebp+204], ecx", + "mov DWORD PTR [eax+12], ecx", "mov ecx, DWORD PTR [ebx+16]", "bswap ecx", - "mov DWORD PTR [ebp+208], ecx", + "mov DWORD PTR [eax+16], ecx", "mov ecx, DWORD PTR [ebx+20]", "bswap ecx", - "mov DWORD PTR [ebp+212], ecx", + "mov DWORD PTR [eax+20], ecx", "mov ecx, DWORD PTR [ebx+24]", "bswap ecx", - "mov DWORD PTR [ebp+216], ecx", + "mov DWORD PTR [eax+24], ecx", "mov ecx, DWORD PTR [ebx+28]", "bswap ecx", - "mov DWORD PTR [ebp+220], ecx", + "mov DWORD PTR [eax+28], ecx", "mov ecx, DWORD PTR [esi+96]", "mov DWORD PTR [ebx], ecx", "mov ecx, DWORD PTR [esi+100]", @@ -639,8 +610,8 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate_shani(key: *const "mov DWORD PTR [ebx+24], ecx", "mov ecx, DWORD PTR [esi+124]", "mov DWORD PTR [ebx+28], ecx", - "mov eax, ebp", - "add eax, 192", + "mov eax, ebx", + "add eax, 32", "mov ecx, 1", "push ebp", "push ecx", @@ -651,80 +622,67 @@ pub(crate) unsafe extern "C" fn vg_pbkdf2_hmac_sha256_iterate_shani(key: *const "pop eax", "pop eax", "pop eax", + "mov eax, ebx", + "add eax, 32", "mov ecx, DWORD PTR [ebx]", "bswap ecx", - "mov DWORD PTR [ebp+192], ecx", + "mov DWORD PTR [eax], ecx", "mov ecx, DWORD PTR [ebx+4]", "bswap ecx", - "mov DWORD PTR [ebp+196], ecx", + "mov DWORD PTR [eax+4], ecx", "mov ecx, DWORD PTR [ebx+8]", "bswap ecx", - "mov DWORD PTR [ebp+200], ecx", + "mov DWORD PTR [eax+8], ecx", "mov ecx, DWORD PTR [ebx+12]", "bswap ecx", - "mov DWORD PTR [ebp+204], ecx", + "mov DWORD PTR [eax+12], ecx", "mov ecx, DWORD PTR [ebx+16]", "bswap ecx", - "mov DWORD PTR [ebp+208], ecx", + "mov DWORD PTR [eax+16], ecx", "mov ecx, DWORD PTR [ebx+20]", "bswap ecx", - "mov DWORD PTR [ebp+212], ecx", + "mov DWORD PTR [eax+20], ecx", "mov ecx, DWORD PTR [ebx+24]", "bswap ecx", - "mov DWORD PTR [ebp+216], ecx", + "mov DWORD PTR [eax+24], ecx", "mov ecx, DWORD PTR [ebx+28]", "bswap ecx", - "mov DWORD PTR [ebp+220], ecx", - "mov ecx, DWORD PTR [ebp+160]", - "xor ecx, DWORD PTR [ebp+192]", - "mov DWORD PTR [ebp+160], ecx", - "mov ecx, DWORD PTR [ebp+164]", - "xor ecx, DWORD PTR [ebp+196]", - "mov DWORD PTR [ebp+164], ecx", - "mov ecx, DWORD PTR [ebp+168]", - "xor ecx, DWORD PTR [ebp+200]", - "mov DWORD PTR [ebp+168], ecx", - "mov ecx, DWORD PTR [ebp+172]", - "xor ecx, DWORD PTR [ebp+204]", - "mov DWORD PTR [ebp+172], ecx", - "mov ecx, DWORD PTR [ebp+176]", - "xor ecx, DWORD PTR [ebp+208]", - "mov DWORD PTR [ebp+176], ecx", - "mov ecx, DWORD PTR [ebp+180]", - "xor ecx, DWORD PTR [ebp+212]", - "mov DWORD PTR [ebp+180], ecx", - "mov ecx, DWORD PTR [ebp+184]", - "xor ecx, DWORD PTR [ebp+216]", - "mov DWORD PTR [ebp+184], ecx", - "mov ecx, DWORD PTR [ebp+188]", - "xor ecx, DWORD PTR [ebp+220]", - "mov DWORD PTR [ebp+188], ecx", + "mov DWORD PTR [eax+28], ecx", + "mov edx, DWORD PTR [esp+16]", + "mov ecx, DWORD PTR [ebx+32]", + "xor ecx, DWORD PTR [edx]", + "mov DWORD PTR [edx], ecx", + "mov ecx, DWORD PTR [ebx+36]", + "xor ecx, DWORD PTR [edx+4]", + "mov DWORD PTR [edx+4], ecx", + "mov ecx, DWORD PTR [ebx+40]", + "xor ecx, DWORD PTR [edx+8]", + "mov DWORD PTR [edx+8], ecx", + "mov ecx, DWORD PTR [ebx+44]", + "xor ecx, DWORD PTR [edx+12]", + "mov DWORD PTR [edx+12], ecx", + "mov ecx, DWORD PTR [ebx+48]", + "xor ecx, DWORD PTR [edx+16]", + "mov DWORD PTR [edx+16], ecx", + "mov ecx, DWORD PTR [ebx+52]", + "xor ecx, DWORD PTR [edx+20]", + "mov DWORD PTR [edx+20], ecx", + "mov ecx, DWORD PTR [ebx+56]", + "xor ecx, DWORD PTR [edx+24]", + "mov DWORD PTR [edx+24], ecx", + "mov ecx, DWORD PTR [ebx+60]", + "xor ecx, DWORD PTR [edx+28]", + "mov DWORD PTR [edx+28], ecx", "sub edi, 1", "jne 22b", "jmp 21f", "20:", "21:", - "mov ecx, DWORD PTR [ebp+160]", - "mov DWORD PTR [ebx], ecx", - "mov ecx, DWORD PTR [ebp+164]", - "mov DWORD PTR [ebx+4], ecx", - "mov ecx, DWORD PTR [ebp+168]", - "mov DWORD PTR [ebx+8], ecx", - "mov ecx, DWORD PTR [ebp+172]", - "mov DWORD PTR [ebx+12], ecx", - "mov ecx, DWORD PTR [ebp+176]", - "mov DWORD PTR [ebx+16], ecx", - "mov ecx, DWORD PTR [ebp+180]", - "mov DWORD PTR [ebx+20], ecx", - "mov ecx, DWORD PTR [ebp+184]", - "mov DWORD PTR [ebx+24], ecx", - "mov ecx, DWORD PTR [ebp+188]", - "mov DWORD PTR [ebx+28], ecx", "mov eax, ebp", - "mov ebx, DWORD PTR [eax+112]", - "mov esi, DWORD PTR [eax+116]", - "mov edi, DWORD PTR [eax+120]", - "mov ebp, DWORD PTR [eax+124]", + "mov ebx, DWORD PTR [eax+160]", + "mov esi, DWORD PTR [eax+164]", + "mov edi, DWORD PTR [eax+168]", + "mov ebp, DWORD PTR [eax+172]", "ret", vg_sha256_compress_shani = sym super::sha256::vg_sha256_compress_shani, ) diff --git a/src/hmac/sha256.rs b/src/hmac/sha256.rs index 546a20927..fa89a1909 100644 --- a/src/hmac/sha256.rs +++ b/src/hmac/sha256.rs @@ -1,20 +1,18 @@ //! HMAC-SHA-256: `vg_hmac_sha256_init`, `vg_sha256_update` and -//! `vg_hmac_sha256_finalize` compute `H((K₀ ⊕ opad) ‖ H((K₀ ⊕ ipad) ‖ text))` -//! (`VG.Spec.Hmac.hmacBlockKey`), keeping the two SHA-256 streaming states. +//! `vg_hmac_sha256_finalize` (contracts `VG.Spec.Hmac.Instance.initContract` +//! of `VG.Spec.Hmac.sha256I`, `VG.Spec.Sha256.updateContract` and +//! `VG.Spec.Hmac.Instance.finalizeContract`) compute `H((K₀ ⊕ opad) ‖ H((K₀ ⊕ +//! ipad) ‖ text))` (`VG.Spec.Hmac.hmacBlockKey`), keeping the two SHA-256 +//! streaming states. `init` and `finalize` are the one HMAC implementation +//! for every Merkle–Damgård hash function, calling SHA-256's verified +//! functions. //! -//! On x86-64 and AArch64, `init` and `finalize` (contracts -//! `VG.Spec.Hmac.Instance.initContract` and `finalizeContract` of -//! `VG.Spec.Hmac.sha256I`) are the one HMAC implementation for every -//! streaming hash function, calling SHA-256's verified functions. On x86-64, -//! they follow the implementation of SHA-256 that `Sha256` runs on this CPU: -//! e.g. `vg_hmac_sha256_init_shani` and `vg_hmac_sha256_finalize_shani`, the -//! same verified code calling `vg_sha256_update_shani` and -//! `vg_sha256_finalize_shani`, or the `_avx2` ones. On AArch64, the `_sha2` -//! variants use the SHA-256 instructions through the same generic code. -//! -//! On ARMv7 and x86, their contracts are `VG.Spec.Hmac.initSha256Contract` -//! and `VG.Spec.Hmac.finalizeSha256OutContract`, with -//! `VG.Spec.Sha256.updateContract`. +//! They follow the implementation of SHA-256 that `Sha256` runs on this CPU: +//! on x86-64 and x86, e.g. `vg_hmac_sha256_init_shani` and +//! `vg_hmac_sha256_finalize_shani`, the same verified code calling SHA-256's +//! `_shani` functions, with the same contracts, or on x86-64 the `_avx2` +//! ones. On AArch64, the `_sha2` variants use the SHA-256 instructions +//! through the same generic code. #![cfg(any( target_arch = "x86_64", @@ -23,12 +21,9 @@ target_arch = "x86" ))] -#[cfg(any(target_arch = "arm", target_arch = "x86"))] -use super::{HmacHash, sealed}; #[cfg(target_arch = "x86_64")] use crate::arch::hmac_sha256::{ - VG_HMAC_SHA256_FINALIZE_AVX2_FEATURES, VG_HMAC_SHA256_FINALIZE_SHANI_FEATURES, - VG_HMAC_SHA256_INIT_AVX2_FEATURES, VG_HMAC_SHA256_INIT_SHANI_FEATURES, + VG_HMAC_SHA256_FINALIZE_AVX2_FEATURES, VG_HMAC_SHA256_INIT_AVX2_FEATURES, vg_hmac_sha256_finalize_avx2, vg_hmac_sha256_init_avx2, }; #[cfg(target_arch = "aarch64")] @@ -36,19 +31,21 @@ use crate::arch::hmac_sha256::{ VG_HMAC_SHA256_FINALIZE_SHA2_FEATURES, VG_HMAC_SHA256_INIT_SHA2_FEATURES, vg_hmac_sha256_finalize_sha2, vg_hmac_sha256_init_sha2, }; -use crate::arch::hmac_sha256::{vg_hmac_sha256_finalize, vg_hmac_sha256_init}; #[cfg(any(target_arch = "x86", target_arch = "x86_64"))] -use crate::arch::hmac_sha256::{vg_hmac_sha256_finalize_shani, vg_hmac_sha256_init_shani}; +use crate::arch::hmac_sha256::{ + VG_HMAC_SHA256_FINALIZE_SHANI_FEATURES, VG_HMAC_SHA256_INIT_SHANI_FEATURES, + vg_hmac_sha256_finalize_shani, vg_hmac_sha256_init_shani, +}; +use crate::arch::hmac_sha256::{vg_hmac_sha256_finalize, vg_hmac_sha256_init}; use crate::hashes::sha256::{Sha256, Sha256Backend}; -#[cfg(any(target_arch = "x86_64", target_arch = "aarch64"))] super::streaming_hmac!( Sha256 (Sha256Backend) { Scalar => (vg_hmac_sha256_init, vg_hmac_sha256_finalize), #[cfg(target_arch = "aarch64")] Sha2 if [VG_HMAC_SHA256_INIT_SHA2_FEATURES, VG_HMAC_SHA256_FINALIZE_SHA2_FEATURES] => (vg_hmac_sha256_init_sha2, vg_hmac_sha256_finalize_sha2), - #[cfg(target_arch = "x86_64")] + #[cfg(any(target_arch = "x86", target_arch = "x86_64"))] ShaNi if [VG_HMAC_SHA256_INIT_SHANI_FEATURES, VG_HMAC_SHA256_FINALIZE_SHANI_FEATURES] => (vg_hmac_sha256_init_shani, vg_hmac_sha256_finalize_shani), #[cfg(target_arch = "x86_64")] @@ -59,114 +56,3 @@ super::streaming_hmac!( scratch: 104, output: 32, ); - -/// An HMAC-SHA-256 computation: the SHA-256 streaming states for the inner -/// hash, which represents `(K₀ ⊕ ipad) ‖ text`, and the outer one, which -/// represents `K₀ ⊕ opad`, and the length of the inner message. -#[cfg(any(target_arch = "arm", target_arch = "x86"))] -#[doc(hidden)] -#[derive(Clone)] -pub struct Sha256HmacState { - inner: [u8; 96], - outer: [u8; 96], - /// The length of `(K₀ ⊕ ipad) ‖ text`, in bytes (modulo 2⁶⁴). - count: u64, - /// The implementation of `vg_sha256_update` this CPU runs. - backend: Sha256Backend, -} - -#[cfg(any(target_arch = "arm", target_arch = "x86"))] -impl Drop for Sha256HmacState { - /// Wipes the streaming states, which represent the key. - fn drop(&mut self) { - crate::zeroize::zeroize(&mut self.inner); - crate::zeroize::zeroize(&mut self.outer); - } -} - -#[cfg(any(target_arch = "arm", target_arch = "x86"))] -impl sealed::Sealed for Sha256 {} - -#[cfg(any(target_arch = "arm", target_arch = "x86"))] -impl HmacHash for Sha256 { - type State = Sha256HmacState; - - fn hmac_init(key: &[u8]) -> Sha256HmacState { - assert!(key.len() <= Self::BLOCK_SIZE); - let mut state = Sha256HmacState { - inner: [0; 96], - outer: [0; 96], - count: Self::BLOCK_SIZE as u64, - backend: Sha256Backend::select(crate::cpu::detected()), - }; - let mut scratch = [0u64; 76]; - // SAFETY: `key.len()` is at most 64; `state.inner` and `state.outer` - // are valid for reads and writes of 96 bytes, `key` for reads of - // `key.len()` bytes and `scratch` for reads and writes of 608 bytes; - // they are distinct objects, so they do not overlap each other or the - // call's stack frame, nor wrap around the address space. - let init = match state.backend { - Sha256Backend::Scalar => vg_hmac_sha256_init, - #[cfg(target_arch = "x86")] - Sha256Backend::ShaNi => vg_hmac_sha256_init_shani, - }; - unsafe { - init( - &mut state.inner, - &mut state.outer, - key.as_ptr(), - key.len(), - &mut scratch, - ) - }; - state - } - - fn hmac_update(state: &mut Sha256HmacState, data: &[u8]) { - let mut scratch = [0u64; 76]; - // SAFETY: `state.inner` is valid for reads and writes of 96 bytes, - // `data` for reads of `data.len()` bytes and `scratch` for reads and - // writes of 608 bytes; they are distinct objects, so they do not - // overlap each other or the call's stack frame, nor wrap around the - // address space. `state.count` is the length of the message - // `state.inner` represents, modulo 2⁶⁴. `state.backend` was - // selected for this CPU's features. - unsafe { - state.backend.update( - &mut state.inner, - state.count, - data.as_ptr(), - data.len(), - &mut scratch, - ) - }; - state.count = state.count.wrapping_add(data.len() as u64); - } - - fn hmac_finalize(mut state: Sha256HmacState) -> [u8; 32] { - let mut mac = [0u8; 32]; - let mut scratch = [0u64; 86]; - // SAFETY: `state.inner` is valid for reads and writes of 96 bytes, - // `state.outer` for reads of 96 bytes, `mac` for writes of 32 bytes - // and `scratch` for reads and writes of 688 bytes; they are distinct - // objects, so they do not overlap each other or the call's stack - // frame, nor wrap around the address space. `state.inner` represents - // `(K₀ ⊕ ipad) ‖ text`, of `state.count` bytes, and `state.outer` - // represents `K₀ ⊕ opad`. - let finalize = match state.backend { - Sha256Backend::Scalar => vg_hmac_sha256_finalize, - #[cfg(target_arch = "x86")] - Sha256Backend::ShaNi => vg_hmac_sha256_finalize_shani, - }; - unsafe { - finalize( - &mut state.inner, - &state.outer, - state.count, - &mut mac, - &mut scratch, - ) - }; - mac - } -} diff --git a/src/pbkdf2/sha256.rs b/src/pbkdf2/sha256.rs index 0906fcdbb..c89356762 100644 --- a/src/pbkdf2/sha256.rs +++ b/src/pbkdf2/sha256.rs @@ -14,7 +14,9 @@ //! On ARMv7 and x86, the whole derivation is the one for every streaming hash //! function, calling SHA-256's verified streaming functions, HMAC-SHA-256's //! `init` and `finalize` and `vg_pbkdf2_hmac_sha256_iterate` (contract -//! `VG.Spec.Pbkdf2.iterateSha256Contract`). +//! `VG.Spec.Hmac.Instance.iterateContract`), the one PBKDF2 iteration for +//! every Merkle–Damgård hash function: each step is two calls of SHA-256's +//! verified compression function. #![cfg(any( target_arch = "x86_64", From c0f03b38306b18eefb8715133f9cdf545a194766 Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 2 Oct 2026 08:45:41 +0000 Subject: [PATCH 4/9] HMAC over streaming hash functions: init and finalize the states in place `streaming_hmac!`'s `init` wrote the two streaming states into locals, moved them into the computation and wiped the locals; `finalize` copied the inner state out, finalized the copy and wiped it. They now work on the computation's own states (`state_mut`, replacing `state`), which its drop wipes: no copies, and 288 fewer bytes to wipe per MAC (on i686, about 450 fewer instructions per HMAC-SHA-256 MAC of a short message). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01RjfTK5YMk2jDsiKRYs2dbn --- src/hashes/mod.rs | 8 ++++---- src/hmac/mod.rs | 49 ++++++++++++++++++++++++----------------------- 2 files changed, 29 insertions(+), 28 deletions(-) diff --git a/src/hashes/mod.rs b/src/hashes/mod.rs index 163bcf0c4..9e62945b7 100644 --- a/src/hashes/mod.rs +++ b/src/hashes/mod.rs @@ -286,12 +286,12 @@ macro_rules! streaming_hash { self.backend } - /// The streaming state and the length of the message it - /// represents. + /// The streaming state, in place, and the length of the message + /// it represents. #[cfg(any(target_arch = "x86_64", target_arch = "aarch64", target_arch = "arm", target_arch = "x86"))] #[allow(dead_code)] - pub(crate) fn state(&self) -> ([u8; $state], u64) { - (self.state, self.length) + pub(crate) fn state_mut(&mut self) -> (&mut [u8; $state], u64) { + (&mut self.state, self.length) } } diff --git a/src/hmac/mod.rs b/src/hmac/mod.rs index be9d84ad5..f2ff1ddec 100644 --- a/src/hmac/mod.rs +++ b/src/hmac/mod.rs @@ -188,32 +188,32 @@ macro_rules! streaming_hmac { $backend::$base => $init, $($(#[$attr])* $backend::$variant => $vinit,)* }; - let mut inner = [0; $state]; - let mut outer = [0; $state]; + // The states are written in place, where they are wiped when + // the computation is dropped. Once `init` has run, the inner + // one represents `K₀ ⊕ ipad`, of a block. + let mut state = super::StreamingHmacState { + inner: $hash::from_state([0; $state], Self::BLOCK_SIZE as u64, backend), + outer: [0; $state], + }; + let (inner, _) = state.inner.state_mut(); let mut scratch = [0u64; $scratch]; - // SAFETY: `key.len()` is at most a block; `inner` and `outer` - // are valid for reads and writes of a streaming state, `key` - // for reads of `key.len()` bytes and `scratch` for reads and - // writes of its size; they are distinct objects, so they do - // not overlap each other or the call's stack frame, nor wrap - // around the address space. `init` needs no CPU feature that - // `backend` was not selected for (`tests::backend_features`). + // SAFETY: `key.len()` is at most a block; `inner` and + // `state.outer` are valid for reads and writes of a streaming + // state, `key` for reads of `key.len()` bytes and `scratch` + // for reads and writes of its size; they are distinct objects + // or fields, so they do not overlap each other or the call's + // stack frame, nor wrap around the address space. `init` + // needs no CPU feature that `backend` was not selected for + // (`tests::backend_features`). unsafe { init( - &mut inner, - &mut outer, + inner, + &mut state.outer, key.as_ptr(), key.len(), &mut scratch, ) }; - // `inner` now represents `K₀ ⊕ ipad`, of a block. - let state = super::StreamingHmacState { - inner: $hash::from_state(inner, Self::BLOCK_SIZE as u64, backend), - outer, - }; - $crate::zeroize::zeroize(&mut inner); - $crate::zeroize::zeroize(&mut outer); state } @@ -221,27 +221,28 @@ macro_rules! streaming_hmac { state.inner.update(data); } - fn hmac_finalize(state: Self::State) -> [u8; $output] { + fn hmac_finalize(mut state: Self::State) -> [u8; $output] { let finalize = match state.inner.backend() { $backend::$base => $finalize, $($(#[$attr])* $backend::$variant => $vfinalize,)* }; - let (mut inner, count) = state.inner.state(); + // The inner state is finalized in place, and wiped with the + // computation. + let (inner, count) = state.inner.state_mut(); let mut mac = [0; $output]; let mut scratch = [0u64; $scratch]; // SAFETY: `inner` is valid for reads and writes of a streaming // state, `state.outer` for reads of one, `mac` for writes of // a digest and `scratch` for reads and writes of its size; - // they are distinct objects, so they do not overlap each - // other or the call's stack frame, nor wrap around the + // they are distinct objects or fields, so they do not overlap + // each other or the call's stack frame, nor wrap around the // address space. `inner` represents `(K₀ ⊕ ipad) ‖ text`, of // `count` bytes (which the hash's `update` keeps below 2⁶⁴, // so the text is shorter than 2⁶⁴ − B bytes), and // `state.outer` represents `K₀ ⊕ opad`. `finalize` needs no // CPU feature that the hash's implementation was not selected // for (`tests::backend_features`). - unsafe { finalize(&mut inner, &state.outer, count, &mut mac, &mut scratch) }; - $crate::zeroize::zeroize(&mut inner); + unsafe { finalize(inner, &state.outer, count, &mut mac, &mut scratch) }; mac } } From a5ac8bc2812da67a05516b9bcc9105d8419d7a8b Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 2 Oct 2026 09:48:13 +0000 Subject: [PATCH 5/9] HMAC init over the compression function on ARMv7 and x86 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit HMAC's init, for every Merkle–Damgård hash on ARMv7 and 32-bit x86 (MD5, SHA-1, SHA-224 on ARMv7, SHA-256 and its SHA-NI variant on x86, and the SHA-384/512 family), now writes K₀ ⊕ ipad into the inner state's buffer with word stores of 0x36363636 and a byte loop over the key alone, derives K₀ ⊕ opad into the outer state's buffer word by word (XOR with 0x6a6a6a6a), sets each state's hash value with the streaming init, and compresses each block with one direct call of the compression function, instead of the streaming update. It is proven once for any Md hash against initContract, at the same stacks (Proof/Pbkdf2/MdInit.lean, Proof/Pbkdf2/Md/{Arm,X86}/HmacInit{,CT}.lean), and the whole PBKDF2 calls it. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01RjfTK5YMk2jDsiKRYs2dbn --- .../Artifacts/HmacMd5/Arm.lean | 4 +- .../Artifacts/HmacMd5/X86.lean | 4 +- .../Artifacts/HmacSha1/Arm.lean | 4 +- .../Artifacts/HmacSha1/X86.lean | 4 +- .../Artifacts/HmacSha224/Arm.lean | 4 +- .../Artifacts/HmacSha256/Arm.lean | 4 +- .../Artifacts/HmacSha384/Arm.lean | 4 +- .../Artifacts/HmacSha384/X86.lean | 4 +- .../Artifacts/HmacSha512/Arm.lean | 4 +- .../Artifacts/HmacSha512/X86.lean | 4 +- .../Artifacts/HmacSha512_224/Arm.lean | 4 +- .../Artifacts/HmacSha512_224/X86.lean | 4 +- .../Artifacts/HmacSha512_256/Arm.lean | 4 +- .../Artifacts/HmacSha512_256/X86.lean | 4 +- .../Generic/Sha256/X86/Hmac.lean | 2 +- lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean | 58 +- lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean | 53 ++ .../Proof/Pbkdf2/Md/Arm/Hash.lean | 5 +- .../Proof/Pbkdf2/Md/Arm/HmacInit.lean | 764 ++++++++++++++++ .../Proof/Pbkdf2/Md/Arm/HmacInitCT.lean | 196 +++++ .../Proof/Pbkdf2/Md/Arm/Instances.lean | 200 ++++- .../Proof/Pbkdf2/Md/Arm/Sha224.lean | 26 +- .../Proof/Pbkdf2/Md/Arm/Sha256.lean | 26 +- .../Proof/Pbkdf2/Md/X86/Block.lean | 5 +- .../Proof/Pbkdf2/Md/X86/Hashes.lean | 3 + .../Proof/Pbkdf2/Md/X86/HmacInit.lean | 818 ++++++++++++++++++ .../Proof/Pbkdf2/Md/X86/HmacInitCT.lean | 215 +++++ .../Proof/Pbkdf2/Md/X86/Instances.lean | 131 ++- .../Proof/Pbkdf2/Md/X86/Lit.lean | 12 +- .../Proof/Pbkdf2/Md/X86/Sha256.lean | 36 +- lean/VerifiedGarbage/Proof/Pbkdf2/MdInit.lean | 122 +++ .../Proof/Pbkdf2/Whole/Arm/Instances.lean | 15 +- .../Proof/Pbkdf2/Whole/Arm/Sha224.lean | 2 +- .../Proof/Pbkdf2/Whole/Arm/Sha256.lean | 2 +- .../Proof/Pbkdf2/Whole/X86/Instances.lean | 13 +- .../Proof/Pbkdf2/Whole/X86/Lit.lean | 8 +- .../Proof/Sha256/X86/Variants/Code.lean | 2 +- .../Proof/Sha256/X86/Variants/Interface.lean | 29 +- .../Variants/Sha256/X86/Scalar.lean | 4 +- .../Variants/Sha256/X86/ShaNi.lean | 4 +- src/asm/arm/hmac_md5.rs | 139 +-- src/asm/arm/hmac_sha1.rs | 139 +-- src/asm/arm/hmac_sha224.rs | 139 +-- src/asm/arm/hmac_sha256.rs | 139 +-- src/asm/arm/hmac_sha384.rs | 203 +++-- src/asm/arm/hmac_sha512.rs | 203 +++-- src/asm/arm/hmac_sha512_224.rs | 203 +++-- src/asm/arm/hmac_sha512_256.rs | 203 +++-- src/asm/x86/hmac_md5.rs | 154 ++-- src/asm/x86/hmac_sha1.rs | 154 ++-- src/asm/x86/hmac_sha256.rs | 308 ++++--- src/asm/x86/hmac_sha384.rs | 218 +++-- src/asm/x86/hmac_sha512.rs | 218 +++-- src/asm/x86/hmac_sha512_224.rs | 218 +++-- src/asm/x86/hmac_sha512_256.rs | 218 +++-- 55 files changed, 4685 insertions(+), 978 deletions(-) create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInit.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInitCT.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInit.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInitCT.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/MdInit.lean diff --git a/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean index f7683b981..e3d9c1af9 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean @@ -24,11 +24,11 @@ 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..c9ba35293 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean @@ -23,11 +23,11 @@ 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..2c25bb5b9 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean @@ -24,11 +24,11 @@ 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..5058f9b76 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean @@ -23,11 +23,11 @@ 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..7cfe294dd 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean @@ -24,12 +24,12 @@ 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..65e1b04d9 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean @@ -24,12 +24,12 @@ 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..b929ed1db 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean @@ -24,11 +24,11 @@ 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..b7a7d4fd1 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean @@ -23,11 +23,11 @@ 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..af3b3d448 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean @@ -24,11 +24,11 @@ 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..6ee3f0e99 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean @@ -23,11 +23,11 @@ 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..e20e6943b 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean @@ -24,11 +24,11 @@ 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..089b7f5b9 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean @@ -23,11 +23,11 @@ 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..408a02775 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean @@ -24,11 +24,11 @@ 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..0052bf50d 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean @@ -23,11 +23,11 @@ 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/Generic/Sha256/X86/Hmac.lean b/lean/VerifiedGarbage/Generic/Sha256/X86/Hmac.lean index dfb33bdff..33cf3ee9a 100644 --- a/lean/VerifiedGarbage/Generic/Sha256/X86/Hmac.lean +++ b/lean/VerifiedGarbage/Generic/Sha256/X86/Hmac.lean @@ -21,7 +21,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..51169859d 100644 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean @@ -140,10 +140,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..5259b4186 100644 --- a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean +++ b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean @@ -164,6 +164,59 @@ 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`): diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Hash.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Hash.lean index e2a5e850c..78ba9289d 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Hash.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Hash.lean @@ -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`). -/ @@ -60,6 +62,7 @@ structure HashOK (H : Hash) where /-- 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/HmacInit.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInit.lean new file mode 100644 index 000000000..18af8c8f6 --- /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/Hmac/Generic/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.Hmac.Generic.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.Hmac.Generic.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.Hmac.Generic.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.Hmac.Generic.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.Hmac.Generic.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..440939608 --- /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/Hmac/Generic/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.Hmac.Generic.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.Hmac.Generic.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..5e9222dae 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.Hmac.Generic.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 @@ -15,8 +18,8 @@ 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 +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`. @@ -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] @@ -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.Hmac.Generic.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/Sha224.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean index b50a9e592..6263ebb88 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha224.lean @@ -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.Hmac.Generic.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..04ed3e939 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha256.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha256.lean @@ -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.Hmac.Generic.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/X86/Block.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Block.lean index cc48950c2..a6b523326 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Block.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Block.lean @@ -523,7 +523,9 @@ 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 @@ -531,6 +533,7 @@ structure MdOk (H : Hash) where 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..faa9c4b8f 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean @@ -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 @@ -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/HmacInit.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInit.lean new file mode 100644 index 000000000..bd2792606 --- /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.Hmac.Generic.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.Hmac.Generic.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.Hmac.Generic.X86 (at_) +open VG.Proof.Pbkdf2.Md.X86 +open VG.Proof.MdStream (Md) +open VG.Proof.Hmac.Generic.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.Hmac.Generic.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.Hmac.Generic.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..5bf8e87fb --- /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.Hmac.Generic.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.Hmac.Generic.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..9e1ff8df9 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean @@ -2,11 +2,12 @@ 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 +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 @@ -17,7 +18,7 @@ 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.Hmac.Generic.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/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..f29ad79ac 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Sha256.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Sha256.lean @@ -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.Hmac.Generic.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.Hmac.Generic.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/Whole/Arm/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean index 84a4039a6..745ea9145 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean @@ -1,6 +1,5 @@ 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 /-! @@ -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/Sha224.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha224.lean index 1752fd4d7..7b6abe602 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha224.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha224.lean @@ -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..9b5220f93 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha256.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha256.lean @@ -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/X86/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Instances.lean index 52baf63fc..fcfdbd9f5 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 /-! @@ -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/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/Sha256/X86/Variants/Code.lean b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Code.lean index a7324fcc4..2a3785cbf 100644 --- a/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Code.lean +++ b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Code.lean @@ -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..02b446a03 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.Hmac.Generic.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..d2ce301ac 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.Hmac.Generic.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..a68ff9bb3 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.Hmac.Generic.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, ) } From cc1d0b216049e6175355c6c8b79df8211df963a6 Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 2 Oct 2026 09:48:19 +0000 Subject: [PATCH 6/9] HMAC: leave the scratch of init and finalize uninitialized The scratch the streaming HMAC passes to init and finalize is only working space, whose contents the contracts do not depend on, as for AES-GCM and CMAC. Zeroing it (832 bytes for SHA-256) cost more than the new init saved: a short-message HMAC-SHA-256 MAC on i686 took 15790 instructions, against 15758 on main; it now takes 15329. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01RjfTK5YMk2jDsiKRYs2dbn --- src/hmac/mod.rs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/hmac/mod.rs b/src/hmac/mod.rs index f2ff1ddec..1b55c0d10 100644 --- a/src/hmac/mod.rs +++ b/src/hmac/mod.rs @@ -196,7 +196,7 @@ macro_rules! streaming_hmac { outer: [0; $state], }; let (inner, _) = state.inner.state_mut(); - let mut scratch = [0u64; $scratch]; + let mut scratch = core::mem::MaybeUninit::<[u64; $scratch]>::uninit(); // SAFETY: `key.len()` is at most a block; `inner` and // `state.outer` are valid for reads and writes of a streaming // state, `key` for reads of `key.len()` bytes and `scratch` @@ -204,14 +204,16 @@ macro_rules! streaming_hmac { // or fields, so they do not overlap each other or the call's // stack frame, nor wrap around the address space. `init` // needs no CPU feature that `backend` was not selected for - // (`tests::backend_features`). + // (`tests::backend_features`). `scratch` is uninitialized: it + // is only working space, and the contract's result does not + // depend on what it holds. unsafe { init( inner, &mut state.outer, key.as_ptr(), key.len(), - &mut scratch, + scratch.as_mut_ptr(), ) }; state @@ -230,7 +232,7 @@ macro_rules! streaming_hmac { // computation. let (inner, count) = state.inner.state_mut(); let mut mac = [0; $output]; - let mut scratch = [0u64; $scratch]; + let mut scratch = core::mem::MaybeUninit::<[u64; $scratch]>::uninit(); // SAFETY: `inner` is valid for reads and writes of a streaming // state, `state.outer` for reads of one, `mac` for writes of // a digest and `scratch` for reads and writes of its size; @@ -241,8 +243,10 @@ macro_rules! streaming_hmac { // so the text is shorter than 2⁶⁴ − B bytes), and // `state.outer` represents `K₀ ⊕ opad`. `finalize` needs no // CPU feature that the hash's implementation was not selected - // for (`tests::backend_features`). - unsafe { finalize(inner, &state.outer, count, &mut mac, &mut scratch) }; + // for (`tests::backend_features`). `scratch` is + // uninitialized: it is only working space, and the contract's + // result does not depend on what it holds. + unsafe { finalize(inner, &state.outer, count, &mut mac, scratch.as_mut_ptr()) }; mac } } From 4a9ef66524a5621a10849b0fc293eb216af9c4c3 Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 2 Oct 2026 10:31:19 +0000 Subject: [PATCH 7/9] HMAC on ARMv7 and x86: drop the streaming-level init, move its helpers The streaming-level HMAC init (Impl/Hmac/Generic/{Arm,X86}.lean: its key and pad loops, callUpd, init; and its proofs: Init's correctness, InitCT, Instances, Lit, and the init instances of Sha224/Sha256) is no longer used by any artifact, so it is deleted. What HMAC's finalize, PBKDF2's iterate and the whole PBKDF2 still use of it (the Hash record, callInit, callFin, the saved registers, copy and the xor loop, the contracts and HashOK, the hash functions' instances) moves next to the Md code, as Impl/Pbkdf2/Stream/{Arm,X86}.lean and Proof/Pbkdf2/Stream/{Arm,X86}/ (Init.lean becomes Common.lean), in the namespaces VG.Impl.Pbkdf2.Stream.* and VG.Proof.Pbkdf2.Stream.*. The module and registration-file docs describe the new init. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01RjfTK5YMk2jDsiKRYs2dbn --- .../Artifacts/HmacMd5/Arm.lean | 21 +- .../Artifacts/HmacMd5/X86.lean | 21 +- .../Artifacts/HmacSha1/Arm.lean | 21 +- .../Artifacts/HmacSha1/X86.lean | 21 +- .../Artifacts/HmacSha224/Arm.lean | 21 +- .../Artifacts/HmacSha256/Arm.lean | 21 +- .../Artifacts/HmacSha384/Arm.lean | 21 +- .../Artifacts/HmacSha384/X86.lean | 21 +- .../Artifacts/HmacSha512/Arm.lean | 21 +- .../Artifacts/HmacSha512/X86.lean | 21 +- .../Artifacts/HmacSha512_224/Arm.lean | 21 +- .../Artifacts/HmacSha512_224/X86.lean | 21 +- .../Artifacts/HmacSha512_256/Arm.lean | 21 +- .../Artifacts/HmacSha512_256/X86.lean | 21 +- .../Artifacts/Pbkdf2Md5/X86.lean | 2 +- .../Artifacts/Pbkdf2Sha1/X86.lean | 2 +- .../Artifacts/Pbkdf2Sha384/X86.lean | 2 +- .../Artifacts/Pbkdf2Sha512/X86.lean | 2 +- .../Artifacts/Pbkdf2Sha512_224/X86.lean | 2 +- .../Artifacts/Pbkdf2Sha512_256/X86.lean | 2 +- .../Generic/Sha256/X86/Hmac.lean | 18 +- lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean | 52 +- lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean | 64 +- .../{Hmac/Generic => Pbkdf2/Stream}/Arm.lean | 79 +- .../{Hmac/Generic => Pbkdf2/Stream}/X86.lean | 80 +- .../Impl/Pbkdf2/Whole/Arm.lean | 6 +- .../Impl/Pbkdf2/Whole/X86.lean | 6 +- .../Proof/Blake2/Arm/Stream/Call.lean | 2 +- .../Proof/Hmac/Generic/Arm/Init.lean | 1164 -------------- .../Proof/Hmac/Generic/Arm/Instances.lean | 373 ----- .../Proof/Hmac/Generic/Arm/Sha256.lean | 88 -- .../Proof/Hmac/Generic/X86/Init.lean | 1339 ----------------- .../Proof/Hmac/Generic/X86/InitCT.lean | 218 --- .../Proof/Hmac/Generic/X86/Instances.lean | 161 -- .../Proof/Hmac/Generic/X86/Lit.lean | 23 - .../Proof/Pbkdf2/Md/Arm/Hash.lean | 4 +- .../Proof/Pbkdf2/Md/Arm/HmacFin.lean | 18 +- .../Proof/Pbkdf2/Md/Arm/HmacFinCT.lean | 10 +- .../Proof/Pbkdf2/Md/Arm/HmacInit.lean | 12 +- .../Proof/Pbkdf2/Md/Arm/HmacInitCT.lean | 6 +- .../Proof/Pbkdf2/Md/Arm/Instances.lean | 26 +- .../Proof/Pbkdf2/Md/Arm/Iterate.lean | 8 +- .../Proof/Pbkdf2/Md/Arm/IterateCT.lean | 2 +- .../Proof/Pbkdf2/Md/Arm/Sha224.lean | 20 +- .../Proof/Pbkdf2/Md/Arm/Sha256.lean | 10 +- .../Proof/Pbkdf2/Md/Arm/Words.lean | 2 +- .../Proof/Pbkdf2/Md/X86/Block.lean | 10 +- .../Proof/Pbkdf2/Md/X86/Hashes.lean | 8 +- .../Proof/Pbkdf2/Md/X86/HmacFin.lean | 28 +- .../Proof/Pbkdf2/Md/X86/HmacFinCT.lean | 26 +- .../Proof/Pbkdf2/Md/X86/HmacInit.lean | 12 +- .../Proof/Pbkdf2/Md/X86/HmacInitCT.lean | 4 +- .../Proof/Pbkdf2/Md/X86/Instances.lean | 12 +- .../Proof/Pbkdf2/Md/X86/Iterate.lean | 6 +- .../Proof/Pbkdf2/Md/X86/IterateCT.lean | 17 +- .../Proof/Pbkdf2/Md/X86/Sha256.lean | 8 +- .../Proof/Pbkdf2/Stream/Arm/Common.lean | 464 ++++++ .../Generic => Pbkdf2/Stream}/Arm/Hash.lean | 12 +- .../Generic => Pbkdf2/Stream}/Arm/Hashes.lean | 10 +- .../Generic => Pbkdf2/Stream}/Arm/Sha224.lean | 43 +- .../Proof/Pbkdf2/Stream/Arm/Sha256.lean | 56 + .../Proof/Pbkdf2/Stream/X86/Common.lean | 526 +++++++ .../Stream}/X86/Contract.lean | 6 +- .../Stream}/X86/Finalize.lean | 23 +- .../Generic => Pbkdf2/Stream}/X86/Hash.lean | 12 +- .../Generic => Pbkdf2/Stream}/X86/Hashes.lean | 10 +- .../Generic => Pbkdf2/Stream}/X86/Sha256.lean | 49 +- .../Proof/Pbkdf2/Whole/Arm/Block.lean | 4 +- .../Proof/Pbkdf2/Whole/Arm/CT.lean | 4 +- .../Proof/Pbkdf2/Whole/Arm/Calls.lean | 12 +- .../Proof/Pbkdf2/Whole/Arm/Common.lean | 12 +- .../Proof/Pbkdf2/Whole/Arm/Instances.lean | 4 +- .../Proof/Pbkdf2/Whole/Arm/Key.lean | 22 +- .../Proof/Pbkdf2/Whole/Arm/Loop.lean | 12 +- .../Proof/Pbkdf2/Whole/Arm/Setup.lean | 8 +- .../Proof/Pbkdf2/Whole/Arm/Sha224.lean | 4 +- .../Proof/Pbkdf2/Whole/Arm/Sha256.lean | 4 +- .../Proof/Pbkdf2/Whole/Arm/Upd.lean | 8 +- .../Proof/Pbkdf2/Whole/X86/Block.lean | 10 +- .../Proof/Pbkdf2/Whole/X86/CT.lean | 14 +- .../Proof/Pbkdf2/Whole/X86/Calls.lean | 6 +- .../Proof/Pbkdf2/Whole/X86/Common.lean | 22 +- .../Proof/Pbkdf2/Whole/X86/Instances.lean | 2 +- .../Proof/Pbkdf2/Whole/X86/Key.lean | 28 +- .../Proof/Pbkdf2/Whole/X86/Loop.lean | 14 +- .../Proof/Pbkdf2/Whole/X86/Setup.lean | 12 +- .../Proof/Pbkdf2/Whole/X86/Sha256.lean | 2 +- .../Proof/Sha256/X86/Variants/Code.lean | 8 +- .../Proof/Sha256/X86/Variants/Interface.lean | 2 +- .../Variants/Sha256/X86/Scalar.lean | 2 +- .../Variants/Sha256/X86/ShaNi.lean | 2 +- 91 files changed, 1584 insertions(+), 4073 deletions(-) rename lean/VerifiedGarbage/Impl/{Hmac/Generic => Pbkdf2/Stream}/Arm.lean (51%) rename lean/VerifiedGarbage/Impl/{Hmac/Generic => Pbkdf2/Stream}/X86.lean (52%) delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Init.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Instances.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Generic/Arm/Sha256.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Init.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Generic/X86/InitCT.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Instances.lean delete mode 100644 lean/VerifiedGarbage/Proof/Hmac/Generic/X86/Lit.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Common.lean rename lean/VerifiedGarbage/Proof/{Hmac/Generic => Pbkdf2/Stream}/Arm/Hash.lean (99%) rename lean/VerifiedGarbage/Proof/{Hmac/Generic => Pbkdf2/Stream}/Arm/Hashes.lean (96%) rename lean/VerifiedGarbage/Proof/{Hmac/Generic => Pbkdf2/Stream}/Arm/Sha224.lean (56%) create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Stream/Arm/Sha256.lean create mode 100644 lean/VerifiedGarbage/Proof/Pbkdf2/Stream/X86/Common.lean rename lean/VerifiedGarbage/Proof/{Hmac/Generic => Pbkdf2/Stream}/X86/Contract.lean (99%) rename lean/VerifiedGarbage/Proof/{Hmac/Generic => Pbkdf2/Stream}/X86/Finalize.lean (95%) rename lean/VerifiedGarbage/Proof/{Hmac/Generic => Pbkdf2/Stream}/X86/Hash.lean (99%) rename lean/VerifiedGarbage/Proof/{Hmac/Generic => Pbkdf2/Stream}/X86/Hashes.lean (97%) rename lean/VerifiedGarbage/Proof/{Hmac/Generic => Pbkdf2/Stream}/X86/Sha256.lean (57%) diff --git a/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean index e3d9c1af9..e0b0e3e4c 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacMd5/Arm.lean @@ -4,22 +4,21 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean index c9ba35293..50b9ec3e4 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacMd5/X86.lean @@ -1,24 +1,23 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean index 2c25bb5b9..dd5a9c1e6 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha1/Arm.lean @@ -4,22 +4,21 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean index 5058f9b76..aada4a68f 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha1/X86.lean @@ -1,24 +1,23 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean index 7cfe294dd..e06e0debf 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha224/Arm.lean @@ -4,22 +4,21 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean index 65e1b04d9..a5adadd77 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha256/Arm.lean @@ -4,22 +4,21 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean index b929ed1db..193ce0a9a 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha384/Arm.lean @@ -4,22 +4,21 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean index b7a7d4fd1..ded83686c 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha384/X86.lean @@ -1,24 +1,23 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean index af3b3d448..0f32dd71e 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512/Arm.lean @@ -4,22 +4,21 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean index 6ee3f0e99..2850c8f1e 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512/X86.lean @@ -1,24 +1,23 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean index e20e6943b..d60706e3a 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/Arm.lean @@ -4,22 +4,21 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean index 089b7f5b9..f7bddf4f6 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_224/X86.lean @@ -1,24 +1,23 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean index 408a02775..c0647cc78 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/Arm.lean @@ -4,22 +4,21 @@ 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 diff --git a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean index 0052bf50d..bb0cda1d3 100644 --- a/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean +++ b/lean/VerifiedGarbage/Artifacts/HmacSha512_256/X86.lean @@ -1,24 +1,23 @@ 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 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 33cf3ee9a..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 diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/Arm.lean index 51169859d..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. -/ diff --git a/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean b/lean/VerifiedGarbage/Impl/Pbkdf2/Md/X86.lean index 5259b4186..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. -/ @@ -219,7 +229,7 @@ def hmacInit : Prog isa := /-! ## 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`. -/ @@ -235,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/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 78ba9289d..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 @@ -58,7 +58,7 @@ 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 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 index 18af8c8f6..75f2bccec 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInit.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInit.lean @@ -12,7 +12,7 @@ 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/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 @@ -21,7 +21,7 @@ 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.Hmac.Generic.Arm (count_loop addr3 left_z left_val) +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) @@ -152,9 +152,9 @@ theorem key_step (H : Hash) {s : State} {kp p : BitVec 32} {kl : Nat} (hkp : kp. 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.Hmac.Generic.Arm.ofNat_succ32], + 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.Hmac.Generic.Arm.ofNat_succ32], + 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) @@ -186,7 +186,7 @@ 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.Hmac.Generic.Arm (initG below SavedRegs saveR savedRegs preserved_saved After below_eq covers_one +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) @@ -435,7 +435,7 @@ theorem callInit_ok (hH : HashOK H) {s : State} (hk : KR H sc s₀ s) {st : Reg} 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.Hmac.Generic.Arm.Hash.callInit + 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) diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInitCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInitCT.lean index 440939608..04fddc30e 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInitCT.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/HmacInitCT.lean @@ -8,7 +8,7 @@ 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/Hmac/Generic/Arm/Hash.lean`), and those of the +proof (`init_rel`, `Proof/Pbkdf2/Stream/Arm/Hash.lean`), and those of the compression function by its own (`compressBlock_rel`). -/ @@ -17,7 +17,7 @@ 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.Hmac.Generic.Arm (initG init_rel covers_one) +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`. -/ @@ -101,7 +101,7 @@ theorem callInit_rel (hc : Checks H) {st : Reg} {p : BitVec 32} ⟨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.Hmac.Generic.Arm.Hash.callInit + 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 _ _ => diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean index 5e9222dae..a1bfc37dc 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Instances.lean @@ -2,7 +2,7 @@ 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.Hashes +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 @@ -15,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 `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`. +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 -/ @@ -63,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 @@ -136,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)) : @@ -184,7 +184,7 @@ namespace VG.Proof.Pbkdf2.Md.Arm.Instances open VG.Arm open VG.Proof.Pbkdf2.Md.Arm -open VG.Proof.Hmac.Generic.Arm (initG finG iterG below count) +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`, 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 6263ebb88..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. -/ @@ -55,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 (initG finG iterG below count) +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⟩, diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/Arm/Sha256.lean index 04ed3e939..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. -/ @@ -64,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 (initG finG iterG below count) +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⟩, 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 a6b523326..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) @@ -529,7 +529,7 @@ 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 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Hashes.lean index faa9c4b8f..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 -/ @@ -218,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)) : 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 index bd2792606..03c86c97d 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInit.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInit.lean @@ -16,11 +16,11 @@ value (`cmpI_ok`, `cmpO_ok`): each state then represents its block namespace VG.Proof.Pbkdf2.Md.X86 open VG.X86 -open VG.Impl.Hmac.Generic.X86 (at_) +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.Hmac.Generic.X86 (ea_at wp_xori count_loop) +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) @@ -177,10 +177,10 @@ namespace VG.Proof.Pbkdf2.Md.X86.HmacInit open VG.X86 open VG.Impl.Pbkdf2.Md.X86 (Hash) -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 initG SavedRegs saveR savedRegs save_ok restore_ok callee_saved ea_at stk +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) @@ -450,7 +450,7 @@ theorem KR.call {s s' : State} (hk : KR (H := H) sc s₀ s) {rs : List Region} ( /-- 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.Hmac.Generic.X86.InitArgs (H := H.st) s st p := by + 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 @@ -587,7 +587,7 @@ theorem fill_ok {s : State} (hk : KR (H := H) sc s₀ s) (hbx : s.gpr .ebx = inn 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.Hmac.Generic.X86.test_z] + · 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. -/ diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInitCT.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInitCT.lean index 5bf8e87fb..469589b95 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInitCT.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/HmacInitCT.lean @@ -16,7 +16,7 @@ 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.Hmac.Generic.X86 (initG initW argTaint ArgsOut agree_argTaint rel_agree rel_wp init_rel) +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 @@ -152,7 +152,7 @@ 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.Hmac.Generic.X86 (initG initW) +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. -/ diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean index 9e1ff8df9..070e707c3 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Instances.lean @@ -7,18 +7,18 @@ import VerifiedGarbage.Proof.Pbkdf2.Md.X86.HmacInitCT /-! # HMAC's `init` and `finalize` and PBKDF2's `iterate` on x86 (32-bit): the instances -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. +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 (initW initG 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`. -/ 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/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Md/X86/Sha256.lean index f29ad79ac..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 @@ -70,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 initW initG 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⟩ @@ -147,7 +147,7 @@ namespace VG.Proof.Pbkdf2.Md.X86.Instances open VG.X86 open VG.Proof.Pbkdf2.Md.X86 -open VG.Proof.Hmac.Generic.X86 (Sha256Stream) +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} 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 745ea9145..09f5c9587 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Instances.lean @@ -6,7 +6,7 @@ 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`). @@ -17,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 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 7b6abe602..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 diff --git a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha256.lean b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/Arm/Sha256.lean index 9b5220f93..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 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 fcfdbd9f5..746a50c75 100644 --- a/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Instances.lean +++ b/lean/VerifiedGarbage/Proof/Pbkdf2/Whole/X86/Instances.lean @@ -16,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 -/ 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/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/Sha256/X86/Variants/Code.lean b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Code.lean index 2a3785cbf..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⟩ diff --git a/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Interface.lean b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Interface.lean index 02b446a03..7d6bcff37 100644 --- a/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Interface.lean +++ b/lean/VerifiedGarbage/Proof/Sha256/X86/Variants/Interface.lean @@ -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) +open VG.Proof.Pbkdf2.Stream.X86 (Sha256Stream) open VG.Proof.Pbkdf2.Md.X86 (sha256M) structure StreamFn where diff --git a/lean/VerifiedGarbage/Variants/Sha256/X86/Scalar.lean b/lean/VerifiedGarbage/Variants/Sha256/X86/Scalar.lean index d2ce301ac..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) +open VG.Proof.Pbkdf2.Stream.X86 (Sha256Stream) open VG.Proof.Pbkdf2.Md.X86 (sha256M) open VG.Proof.Sha256.X86.Variants (pbkdf2Fns) diff --git a/lean/VerifiedGarbage/Variants/Sha256/X86/ShaNi.lean b/lean/VerifiedGarbage/Variants/Sha256/X86/ShaNi.lean index a68ff9bb3..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) +open VG.Proof.Pbkdf2.Stream.X86 (Sha256Stream) open VG.Proof.Pbkdf2.Md.X86 (sha256M) open VG.Proof.Sha256.X86.Variants (pbkdf2Fns) From 1e295515870ca3083de0adc571c05f6130dfd89f Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 2 Oct 2026 10:39:35 +0000 Subject: [PATCH 8/9] scrypt on ARMv7 and x86: follow the moved HMAC helpers and SHA-256's backends origin/main's scrypt (#573) calls the whole PBKDF2-HMAC-SHA256 through names this branch moved or replaced: the streaming-level helpers are now in VG.Impl.Pbkdf2.Stream.*, SHA-256's HashOK on ARMv7 is Proof.Pbkdf2.Stream.Arm.sha256OK, and on x86 a backend's PBKDF2 is Backend.F (with its streaming functions' stack bounds in Backend.stream). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01RjfTK5YMk2jDsiKRYs2dbn --- lean/VerifiedGarbage/Impl/Scrypt/X86/Scrypt.lean | 4 ++-- .../VerifiedGarbage/Proof/Scrypt/Arm/Whole/Calls.lean | 2 +- .../Proof/Scrypt/Arm/Whole/Verified.lean | 8 ++++---- .../Proof/Scrypt/X86/Whole/Verified.lean | 11 ++++++----- 4 files changed, 13 insertions(+), 12 deletions(-) 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/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 c5e287bd0..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.Pbkdf2.Whole.Arm.sha256OK.initNF Proof.Pbkdf2.Whole.Arm.sha256OK.updNF - Proof.Pbkdf2.Whole.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 115967976..dd4ff278f 100644 --- a/lean/VerifiedGarbage/Proof/Scrypt/X86/Whole/Verified.lean +++ b/lean/VerifiedGarbage/Proof/Scrypt/X86/Whole/Verified.lean @@ -17,7 +17,7 @@ calling the `vg_pbkdf2_hmac_sha256` made with any SHA-256 backend namespace VG.Proof.Scrypt.X86.Whole open VG VG.X86 VG.Impl.Scrypt.X86 -open VG.Proof.Pbkdf2.Whole.X86 (argVal32 setWidth32_64 toNat_setWidth64 setWidth_inj32 sha256FnsOf) +open VG.Proof.Pbkdf2.Whole.X86 (argVal32 setWidth32_64 toNat_setWidth64 setWidth_inj32) open VG.Proof.Sha256.X86.Variants (Backend) /-- Memory holding the arguments `0x1000, 0, 0x1100, 0, 1, 0x3000, 1, 0x4000, 2, 0x5000, 17, 0x6000, 1` @@ -115,18 +115,19 @@ theorem nosp_of_all {c : Prog isa} (h : c.all (fun i => !isa.writesSp i) = true) variable (v : Backend) /-- PBKDF2-HMAC-SHA256 made with `v`. -/ -abbrev pbkOf : Prog isa := (sha256FnsOf v).pbkdf2 +abbrev pbkOf : Prog isa := v.F.pbkdf2 /-- Its name. -/ abbrev pbkName : String := Spec.Hmac.sha256I.pbkdf2Api.name ++ v.suffix theorem pbk_stack : stackUse (pbkOf v) ≤ 76 := by - have := v.updStack; have := v.finStack; have := v.initStack; have := v.finalizeStack; have := v.iterStack + have := v.stream.updSU; have := v.stream.finSU; have := v.initStack; have := v.finalizeStack; have := v.iterStack 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, Proof.Pbkdf2.Whole.X86.sha256Fns, Proof.Pbkdf2.Whole.X86.sha256H, + 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 From 76939e2d2b4eb4f74e0a835bd2c7bea1adb1d0fb Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 2 Oct 2026 12:38:18 +0000 Subject: [PATCH 9/9] scrypt on ARMv7 and x86: follow SHA-256's moved HMAC/PBKDF2 instances main's scrypt (#573) calls the whole PBKDF2-HMAC-SHA256 through names this branch replaced: SHA-256's HashOK on ARMv7 is Proof.Hmac.Generic.Arm.sha256OK, and on x86 a backend's PBKDF2 is Backend.F, with its streaming functions' stack bounds in Backend.stream. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01RjfTK5YMk2jDsiKRYs2dbn --- .../VerifiedGarbage/Proof/Scrypt/Arm/Whole/Verified.lean | 4 ++-- .../VerifiedGarbage/Proof/Scrypt/X86/Whole/Verified.lean | 9 +++++---- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/lean/VerifiedGarbage/Proof/Scrypt/Arm/Whole/Verified.lean b/lean/VerifiedGarbage/Proof/Scrypt/Arm/Whole/Verified.lean index c5e287bd0..38e320800 100644 --- a/lean/VerifiedGarbage/Proof/Scrypt/Arm/Whole/Verified.lean +++ b/lean/VerifiedGarbage/Proof/Scrypt/Arm/Whole/Verified.lean @@ -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.Pbkdf2.Whole.Arm.sha256OK.initNF Proof.Pbkdf2.Whole.Arm.sha256OK.updNF - Proof.Pbkdf2.Whole.Arm.sha256OK.finNF Proof.Pbkdf2.Whole.Arm.sha256OKF.hiSt + 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 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 115967976..be8b085b5 100644 --- a/lean/VerifiedGarbage/Proof/Scrypt/X86/Whole/Verified.lean +++ b/lean/VerifiedGarbage/Proof/Scrypt/X86/Whole/Verified.lean @@ -17,7 +17,7 @@ calling the `vg_pbkdf2_hmac_sha256` made with any SHA-256 backend namespace VG.Proof.Scrypt.X86.Whole open VG VG.X86 VG.Impl.Scrypt.X86 -open VG.Proof.Pbkdf2.Whole.X86 (argVal32 setWidth32_64 toNat_setWidth64 setWidth_inj32 sha256FnsOf) +open VG.Proof.Pbkdf2.Whole.X86 (argVal32 setWidth32_64 toNat_setWidth64 setWidth_inj32) open VG.Proof.Sha256.X86.Variants (Backend) /-- Memory holding the arguments `0x1000, 0, 0x1100, 0, 1, 0x3000, 1, 0x4000, 2, 0x5000, 17, 0x6000, 1` @@ -115,18 +115,19 @@ theorem nosp_of_all {c : Prog isa} (h : c.all (fun i => !isa.writesSp i) = true) variable (v : Backend) /-- PBKDF2-HMAC-SHA256 made with `v`. -/ -abbrev pbkOf : Prog isa := (sha256FnsOf v).pbkdf2 +abbrev pbkOf : Prog isa := v.F.pbkdf2 /-- Its name. -/ abbrev pbkName : String := Spec.Hmac.sha256I.pbkdf2Api.name ++ v.suffix theorem pbk_stack : stackUse (pbkOf v) ≤ 76 := by - have := v.updStack; have := v.finStack; have := v.initStack; have := v.finalizeStack; have := v.iterStack + have := v.stream.updSU; have := v.stream.finSU; have := v.initStack; have := v.finalizeStack; have := v.iterStack 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, Proof.Pbkdf2.Whole.X86.sha256Fns, Proof.Pbkdf2.Whole.X86.sha256H, + Impl.Hmac.Generic.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