From bba998e96d5cc702ca47b1cfec8b7f522384a106 Mon Sep 17 00:00:00 2001 From: 4Luke4 <39967126+4Luke4@users.noreply.github.com> Date: Sat, 25 Jul 2026 20:44:22 +0200 Subject: [PATCH 1/2] Add FILE_SHA256 predicate --- Depends | 2 +- README-WeiDU-Changes.txt | 1 + src/sha256.ml | 185 ++++++++++++++++++ src/toldlexer.in | 1 + src/toldparser.mly | 2 + src/tp.ml | 1 + src/tphelp.ml | 1 + src/tppe.ml | 11 ++ src/trealparserin.in | 1 + .../lib/data/file_sha256.txt | 1 + .../lib/tests/file_sha256.tpa | 46 +++++ 11 files changed, 251 insertions(+), 1 deletion(-) mode change 100755 => 100644 Depends mode change 100755 => 100644 README-WeiDU-Changes.txt create mode 100644 src/sha256.ml mode change 100755 => 100644 src/toldlexer.in mode change 100755 => 100644 src/toldparser.mly mode change 100755 => 100644 src/tp.ml mode change 100755 => 100644 src/tphelp.ml mode change 100755 => 100644 src/tppe.ml mode change 100755 => 100644 src/trealparserin.in create mode 100644 test/tp2/tp2_regression_tests/lib/data/file_sha256.txt create mode 100644 test/tp2/tp2_regression_tests/lib/tests/file_sha256.tpa diff --git a/Depends b/Depends old mode 100755 new mode 100644 index 7f05b768..572f66cc --- a/Depends +++ b/Depends @@ -9,7 +9,7 @@ WEIDU_BASE_MODULES := batList batteriesInit myhashtbl hashtblinit \ dlg dc \ refactorbaf refactorbafparser refactorbaflexer refactordparser refactordlexer \ bafparser baflexer \ - myxdiff diff sav mos tp dparser dlexer sql json \ + myxdiff diff sav mos sha256 tp dparser dlexer sql json \ smutil useract lexerint parsetables arraystack objpool glr lrparse \ automate kit tpstate tphelp trealparser tlexer toldparser toldlexer tparser \ parsewrappers mymarshal tppe tpuninstall tppatch tpaction tpwork \ diff --git a/README-WeiDU-Changes.txt b/README-WeiDU-Changes.txt old mode 100755 new mode 100644 index 977a75b0..639c4232 --- a/README-WeiDU-Changes.txt +++ b/README-WeiDU-Changes.txt @@ -1,4 +1,5 @@ Version 251: + * Add FILE_SHA256 for cryptographically reliable file checksum verification. * CREATE called within CREATE works as expected. * CREATE sets SOURCE_* and DEST_* variables. * Auto-update does not fail if the filename of the newest WeiDU diff --git a/src/sha256.ml b/src/sha256.ml new file mode 100644 index 00000000..82985ab9 --- /dev/null +++ b/src/sha256.ml @@ -0,0 +1,185 @@ +(* + * Streaming SHA-256 implementation used by FILE_SHA256. + * + * This module is self-contained so WeiDU does not acquire a runtime dependency + * on platform-specific checksum executables or external OCaml packages. + *) + +let round_constants = [| + 0x428a2f98l; 0x71374491l; 0xb5c0fbcfl; 0xe9b5dba5l; + 0x3956c25bl; 0x59f111f1l; 0x923f82a4l; 0xab1c5ed5l; + 0xd807aa98l; 0x12835b01l; 0x243185bel; 0x550c7dc3l; + 0x72be5d74l; 0x80deb1fel; 0x9bdc06a7l; 0xc19bf174l; + 0xe49b69c1l; 0xefbe4786l; 0x0fc19dc6l; 0x240ca1ccl; + 0x2de92c6fl; 0x4a7484aal; 0x5cb0a9dcl; 0x76f988dal; + 0x983e5152l; 0xa831c66dl; 0xb00327c8l; 0xbf597fc7l; + 0xc6e00bf3l; 0xd5a79147l; 0x06ca6351l; 0x14292967l; + 0x27b70a85l; 0x2e1b2138l; 0x4d2c6dfcl; 0x53380d13l; + 0x650a7354l; 0x766a0abbl; 0x81c2c92el; 0x92722c85l; + 0xa2bfe8a1l; 0xa81a664bl; 0xc24b8b70l; 0xc76c51a3l; + 0xd192e819l; 0xd6990624l; 0xf40e3585l; 0x106aa070l; + 0x19a4c116l; 0x1e376c08l; 0x2748774cl; 0x34b0bcb5l; + 0x391c0cb3l; 0x4ed8aa4al; 0x5b9cca4fl; 0x682e6ff3l; + 0x748f82eel; 0x78a5636fl; 0x84c87814l; 0x8cc70208l; + 0x90befffal; 0xa4506cebl; 0xbef9a3f7l; 0xc67178f2l; +|] + +type context = { + state : int32 array; + schedule : int32 array; + block : Bytes.t; + mutable block_length : int; + mutable total_length : int64; +} + +let create () = { + state = [| + 0x6a09e667l; 0xbb67ae85l; 0x3c6ef372l; 0xa54ff53al; + 0x510e527fl; 0x9b05688cl; 0x1f83d9abl; 0x5be0cd19l; + |]; + schedule = Array.make 64 0l; + block = Bytes.make 64 '\000'; + block_length = 0; + total_length = 0L; +} + +let rotate_right value amount = + Int32.logor + (Int32.shift_right_logical value amount) + (Int32.shift_left value (32 - amount)) + +let xor3 a b c = Int32.logxor a (Int32.logxor b c) + +let add4 a b c d = + Int32.add (Int32.add a b) (Int32.add c d) + +let byte block offset = + Int32.of_int (Char.code (Bytes.get block offset)) + +let load_word block offset = + Int32.logor + (Int32.shift_left (byte block offset) 24) + (Int32.logor + (Int32.shift_left (byte block (offset + 1)) 16) + (Int32.logor + (Int32.shift_left (byte block (offset + 2)) 8) + (byte block (offset + 3)))) + +let process_block context block offset = + let w = context.schedule in + for index = 0 to 15 do + w.(index) <- load_word block (offset + (index * 4)) + done; + for index = 16 to 63 do + let x = w.(index - 15) in + let y = w.(index - 2) in + let sigma0 = xor3 (rotate_right x 7) (rotate_right x 18) + (Int32.shift_right_logical x 3) in + let sigma1 = xor3 (rotate_right y 17) (rotate_right y 19) + (Int32.shift_right_logical y 10) in + w.(index) <- add4 w.(index - 16) sigma0 w.(index - 7) sigma1 + done; + + let a = ref context.state.(0) in + let b = ref context.state.(1) in + let c = ref context.state.(2) in + let d = ref context.state.(3) in + let e = ref context.state.(4) in + let f = ref context.state.(5) in + let g = ref context.state.(6) in + let h = ref context.state.(7) in + + for index = 0 to 63 do + let sum1 = xor3 (rotate_right !e 6) (rotate_right !e 11) + (rotate_right !e 25) in + let choose = Int32.logxor + (Int32.logand !e !f) + (Int32.logand (Int32.lognot !e) !g) in + let temporary1 = add4 !h sum1 choose + (Int32.add round_constants.(index) w.(index)) in + let sum0 = xor3 (rotate_right !a 2) (rotate_right !a 13) + (rotate_right !a 22) in + let majority = xor3 + (Int32.logand !a !b) + (Int32.logand !a !c) + (Int32.logand !b !c) in + let temporary2 = Int32.add sum0 majority in + + h := !g; + g := !f; + f := !e; + e := Int32.add !d temporary1; + d := !c; + c := !b; + b := !a; + a := Int32.add temporary1 temporary2 + done; + + context.state.(0) <- Int32.add context.state.(0) !a; + context.state.(1) <- Int32.add context.state.(1) !b; + context.state.(2) <- Int32.add context.state.(2) !c; + context.state.(3) <- Int32.add context.state.(3) !d; + context.state.(4) <- Int32.add context.state.(4) !e; + context.state.(5) <- Int32.add context.state.(5) !f; + context.state.(6) <- Int32.add context.state.(6) !g; + context.state.(7) <- Int32.add context.state.(7) !h + +let update context input offset length = + if offset < 0 || length < 0 || offset > Bytes.length input - length then + invalid_arg "Sha256.update"; + context.total_length <- Int64.add context.total_length (Int64.of_int length); + let rec copy input_offset remaining = + if remaining > 0 then begin + let available = 64 - context.block_length in + let copied = min available remaining in + Bytes.blit input input_offset context.block context.block_length copied; + context.block_length <- context.block_length + copied; + if context.block_length = 64 then begin + process_block context context.block 0; + context.block_length <- 0 + end; + copy (input_offset + copied) (remaining - copied) + end + in + copy offset length + +let finish context = + let padded_length = if context.block_length < 56 then 64 else 128 in + let padded = Bytes.make padded_length '\000' in + Bytes.blit context.block 0 padded 0 context.block_length; + Bytes.set padded context.block_length (Char.chr 0x80); + + let bit_length = Int64.mul context.total_length 8L in + for index = 0 to 7 do + let shift = (7 - index) * 8 in + let value = Int64.to_int + (Int64.logand (Int64.shift_right_logical bit_length shift) 0xffL) in + Bytes.set padded (padded_length - 8 + index) (Char.chr value) + done; + + for index = 0 to (padded_length / 64) - 1 do + process_block context padded (index * 64) + done; + + Array.fold_left + (fun result value -> result ^ Printf.sprintf "%08lx" value) + "" context.state + +let file filename = + let channel = open_in_bin filename in + let context = create () in + let buffer = Bytes.create 65536 in + try + let rec read () = + let length = input channel buffer 0 (Bytes.length buffer) in + if length <> 0 then begin + update context buffer 0 length; + read () + end + in + read (); + close_in channel; + finish context + with error -> + close_in_noerr channel; + raise error diff --git a/src/toldlexer.in b/src/toldlexer.in old mode 100755 new mode 100644 index a9ed548b..2b417053 --- a/src/toldlexer.in +++ b/src/toldlexer.in @@ -269,6 +269,7 @@ let _ = List.iter (* predicates *) ("FILE_EXISTS", FILE_EXISTS ) ; ("FILE_MD5", FILE_MD5 ) ; + ("FILE_SHA256", FILE_SHA256 ) ; ("FILE_EXISTS_IN_GAME", FILE_EXISTS_IN_GAME ) ; ("FILE_SIZE", FILE_SIZE ) ; ("FILE_CONTAINS", FILE_CONTAINS ) ; diff --git a/src/toldparser.mly b/src/toldparser.mly old mode 100755 new mode 100644 index f252edf0..30690d8e --- a/src/toldparser.mly +++ b/src/toldparser.mly @@ -110,6 +110,7 @@ open Load %token FILE_CONTAINS_EVALUATED %token FILE_IS_IN_COMPRESSED_BIF %token FILE_MD5 + %token FILE_SHA256 %token FILE_EXISTS %token FILE_EXISTS_IN_GAME %token FILE_SIZE @@ -712,6 +713,7 @@ optional_evaluate : | FILE_EXISTS patch_STRING_right { Tp.Pred_File_Exists($2) } | FILE_IS_IN_COMPRESSED_BIF patch_STRING_right { Tp.Pred_File_Is_In_Compressed_Bif($2) } | FILE_MD5 patch_STRING_right patch_STRING_right { Tp.Pred_File_MD5($2,$3) } +| FILE_SHA256 patch_STRING_right patch_STRING_right { Tp.Pred_File_SHA256($2,$3) } | FILE_EXISTS_IN_GAME patch_STRING_right { Tp.Pred_File_Exists_In_Game($2) } | FILE_SIZE patch_STRING_right STRING { Tp.Pred_File_Size($2,my_int_of_string $3) } | FILE_CONTAINS patch_STRING_right patch_STRING_right { Tp.Pred_File_Contains($2,$3) } diff --git a/src/tp.ml b/src/tp.ml old mode 100755 new mode 100644 index 0474cf5d..39331328 --- a/src/tp.ml +++ b/src/tp.ml @@ -563,6 +563,7 @@ and tp_patchexp = | PE_DefinedAsInlined of tp_pe_string | Pred_File_MD5 of tp_pe_string * tp_pe_string + | Pred_File_SHA256 of tp_pe_string * tp_pe_string | Pred_File_Exists of tp_pe_string | Pred_Directory_Exists of tp_pe_string | Pred_File_Is_In_Compressed_Bif of tp_pe_string diff --git a/src/tphelp.ml b/src/tphelp.ml old mode 100755 new mode 100644 index bd4e2cbb..76c2c122 --- a/src/tphelp.ml +++ b/src/tphelp.ml @@ -11,6 +11,7 @@ open Tp let rec pe_to_str pe = "(" ^ (match pe with | Pred_File_MD5(s,_) -> Printf.sprintf "FILE_MD5 %s" (pe_str_str s) +| Pred_File_SHA256(s,_) -> Printf.sprintf "FILE_SHA256 %s" (pe_str_str s) | Pred_File_Exists(s) -> Printf.sprintf "FILE_EXISTS %s" (pe_str_str s) | Pred_Directory_Exists(d) -> Printf.sprintf "DIRECTORY_EXISTS %s" (pe_str_str d) | Pred_File_Exists_In_Game(s) -> Printf.sprintf "FILE_EXISTS_IN_GAME %s" diff --git a/src/tppe.ml b/src/tppe.ml old mode 100755 new mode 100644 index 7a1a4c0e..8acc1e40 --- a/src/tppe.ml +++ b/src/tppe.ml @@ -287,6 +287,17 @@ let rec eval_pe buff game p = false end) + | Pred_File_SHA256(f,s) -> if_true ( + let f = eval_pe_str f in + let s = eval_pe_str s in + if file_exists f then begin + let hex = Sha256.file f in + log_only "File [%s] has SHA-256 checksum [%s]\n" f hex ; + (String.uppercase_ascii hex) = (String.uppercase_ascii s) + end else begin + false + end) + | Pred_File_Exists(f) -> if_true ( let f = eval_pe_str f in let filename = (Var.get_string f) in diff --git a/src/trealparserin.in b/src/trealparserin.in old mode 100755 new mode 100644 index 1070b44b..7162a0a6 --- a/src/trealparserin.in +++ b/src/trealparserin.in @@ -1028,6 +1028,7 @@ nonterm (Tp.tp_patchexp) Patch_Exp { -> FILE_IS_IN_COMPRESSED_BIF e1:Patch_String_Right [ Tp.Pred_File_Is_In_Compressed_Bif e1 ] -> FILE_MD5 e1:Patch_String_Right e2:Patch_String_Right [ Tp.Pred_File_MD5(e1,e2) ] + -> FILE_SHA256 e1:Patch_String_Right e2:Patch_String_Right [ Tp.Pred_File_SHA256(e1,e2) ] -> FILE_EXISTS_IN_GAME e1:Patch_String_Right [ Tp.Pred_File_Exists_In_Game e1 ] -> FILE_SIZE e1:Patch_String_Right e2:STRING [ Tp.Pred_File_Size(e1,my_int_of_string e2) ] -> SIZE_OF_FILE e1:Patch_String_Right [ Tp.PE_SizeOfFile(e1) ] diff --git a/test/tp2/tp2_regression_tests/lib/data/file_sha256.txt b/test/tp2/tp2_regression_tests/lib/data/file_sha256.txt new file mode 100644 index 00000000..f2ba8f84 --- /dev/null +++ b/test/tp2/tp2_regression_tests/lib/data/file_sha256.txt @@ -0,0 +1 @@ +abc \ No newline at end of file diff --git a/test/tp2/tp2_regression_tests/lib/tests/file_sha256.tpa b/test/tp2/tp2_regression_tests/lib/tests/file_sha256.tpa new file mode 100644 index 00000000..20af0f1a --- /dev/null +++ b/test/tp2/tp2_regression_tests/lib/tests/file_sha256.tpa @@ -0,0 +1,46 @@ +DEFINE_ACTION_FUNCTION run + RET + success + message +BEGIN + OUTER_SPRINT message "test_file_sha256" + PRINT "%message%" + ACTION_TRY + LAF test_file_sha256 END + OUTER_SET success = 1 + WITH + DEFAULT + OUTER_SET success = 0 + OUTER_SPRINT message "tests failed in file_sha256: %ERROR_MESSAGE%" + END +END + +DEFINE_ACTION_FUNCTION test_file_sha256 BEGIN + ACTION_IF NOT FILE_SHA256 + ~tp2_regression_tests/lib/data/file_sha256.txt~ + ~ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad~ + BEGIN + FAIL "FILE_SHA256 rejected the correct lowercase digest" + END + + ACTION_IF NOT FILE_SHA256 + ~tp2_regression_tests/lib/data/file_sha256.txt~ + ~BA7816BF8F01CFEA414140DE5DAE2223B00361A396177A9CB410FF61F20015AD~ + BEGIN + FAIL "FILE_SHA256 rejected the correct uppercase digest" + END + + ACTION_IF FILE_SHA256 + ~tp2_regression_tests/lib/data/file_sha256.txt~ + ~0000000000000000000000000000000000000000000000000000000000000000~ + BEGIN + FAIL "FILE_SHA256 accepted an incorrect digest" + END + + ACTION_IF FILE_SHA256 + ~tp2_regression_tests/lib/data/file_sha256-missing.txt~ + ~ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad~ + BEGIN + FAIL "FILE_SHA256 accepted a missing file" + END +END From cec27fb54a5875664559a654f1167f077bdb6574 Mon Sep 17 00:00:00 2001 From: 4Luke4 <39967126+4Luke4@users.noreply.github.com> Date: Sat, 25 Jul 2026 22:16:20 +0200 Subject: [PATCH 2/2] Document FILE_SHA256 predicate --- doc/base.tex | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) mode change 100755 => 100644 doc/base.tex diff --git a/doc/base.tex b/doc/base.tex old mode 100755 new mode 100644 index 34b89ade..7fa4508e --- a/doc/base.tex +++ b/doc/base.tex @@ -5885,10 +5885,16 @@ \section{Module Packaging: \DEFINE{TP2} Files} manner. Evaluates to 0 for a file that does not exist but has been \ttref{ALLOW_MISSING}'d.\\ or & \DEFINE{FILE_MD5} fileName md5sum & Evaluates to 1 if the file exists -and has the given MD5 checksum. Evaluates to 0 otherwise. Two different -files are exceptionally unlikely to have the same MD5 checksum. In any -event, the discovered checksum is printed to the log. If the file does not +and has the given MD5 checksum. Evaluates to 0 otherwise. The discovered +checksum is printed to the log. MD5 is cryptographically unreliable and +must not be used when collision resistance matters; mod authors are encouraged +to use \ttref{FILE_SHA256} for new checksum comparisons. If the file does not exist, it evaluates to 0. \\ +or & \DEFINE{FILE_SHA256} fileName sha256sum & Evaluates to 1 if the file +exists and has the given SHA-256 checksum. Evaluates to 0 otherwise. The +discovered checksum is printed to the log. SHA-256 is the recommended +predicate for cryptographically reliable file checksum comparisons. If the +file does not exist, it evaluates to 0. \\ or & \DEFINE{FILE_IS_IN_COMPRESSED_BIFF} fileName & Evaluates to 1 if the file is stored in a compressed biff (ignoring copies in the override). Evaluates to 0 otherwise (the file is not in a biff, or it is in an uncompressed biff).