From ac5c7e9c2b2d8f6850234544f3d1aa643fae1a16 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 09:08:27 +0700 Subject: [PATCH] A --sanitize flag, and the attribute without which it measures nothing ASan is an LLVM pass but instruments only functions carrying sanitize_address, which clang's C frontend adds and nothing adds to IR written by hand. Passing -fsanitize=address to the clang run over the .ll therefore instruments flan_rt.c and not one instruction of Flan: an out-of-bounds read of a defvar array, built --no-bounds-checks, printed its garbage and exited 0. With Emit naming an attribute group on every define, the same program reports global-buffer-overflow in flan.main. UBSan has no such lever. Its checks are branches the C frontend emits to __ubsan_handle_*, not a pass, so -fsanitize=undefined covers the runtime and nothing else; (<< 1 32) still goes unremarked. Recorded where it will be read rather than discovered again. The flag does not force -O0 the way --debug does -- the UB worth finding is what the optimiser does with it -- and it does pull in -g, since a report with no line costs more than the build. compile_c's cache key now digests the same cflags list the command line uses, because an unsanitized flan_rt.o served out of the cache links fine and reports nothing. --- bin/main.ml | 23 ++++++++++++++---- lib/build.ml | 66 ++++++++++++++++++++++++++++++++++++++++++++++------ lib/emit.ml | 35 ++++++++++++++++++++++------ 3 files changed, 105 insertions(+), 19 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 22d1794..8cd61ec 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -72,7 +72,14 @@ let dev_flag = "--dev" stop it and read it". See [Build.opts]. *) let debug_flag = "--debug" -let flags = [ no_checks_flag; dev_flag; debug_flag ] +(* ASan and UBSan over the whole program, the runtime's C and the Flan alike. + Its own flag for the same reason --debug is: it answers "is this program + touching memory it does not own", which is neither of the other two + questions. It does not imply -O0 — see [Build.opts], which also records + what each of the two sanitizers actually reaches. *) +let sanitize_flag = "--sanitize" + +let flags = [ no_checks_flag; dev_flag; debug_flag; sanitize_flag ] (* [--target=wasm32-wasi], the one cross target. Unlike the flags above it carries a value, so it is matched by prefix and stripped from the residual @@ -153,6 +160,10 @@ let () = let checks = not (List.mem no_checks_flag args) in let dev = List.mem dev_flag args in let debug = List.mem debug_flag args in + (* --sanitize changes the IR — every [define] names the attribute group + ASan's pass selects on — so [emit] has to honour it or what this prints + is not what a sanitized build compiles. *) + let sanitize = List.mem sanitize_flag args in let files = List.filter (fun a -> not (is_flag a)) args in List.iter (fun path -> @@ -160,13 +171,14 @@ let () = let l = load path in let pnames = if debug then param_names l else [] in Flan.Check.program l.decls - |> Flan.Emit.program ~checks ~dev ~debug ~pnames + |> Flan.Emit.program ~checks ~dev ~debug ~pnames ~sanitize |> print_string)) files | _ :: "build" :: path :: rest -> let checks = not (List.mem no_checks_flag rest) in let dev = List.mem dev_flag rest in let debug = List.mem debug_flag rest in + let sanitize = List.mem sanitize_flag rest in let target = target_of rest in let out = match List.filter (fun a -> not (is_flag a)) rest with @@ -181,7 +193,7 @@ let () = | _ -> prerr_endline "usage: flan build [-o out] [--no-bounds-checks] \ - [--dev] [--debug] [--target=wasm32-wasi]"; + [--dev] [--debug] [--sanitize] [--target=wasm32-wasi]"; exit 2 in with_errors path (fun () -> @@ -193,7 +205,8 @@ let () = raylib and still be buildable for wasm32. *) let p, csrcs, lflags = Flan.Reach.link ~dev l p in ignore (Flan.Build.executable - ~opts:{ Flan.Build.default with checks; dev; debug; target } + ~opts:{ Flan.Build.default with checks; dev; debug; sanitize; + target } ~csrcs ~lflags ~pnames:(if debug then param_names l else []) p ~out)) (* The daemon an editor talks to: one session, the program it belongs to @@ -272,7 +285,7 @@ let () = prerr_endline "usage: flan (read|parse|check|emit|shim) ...\n\ \ flan build [-o out] [--no-bounds-checks] [--dev] \ - [--debug] [--target=wasm32-wasi]\n\ + [--debug] [--sanitize] [--target=wasm32-wasi]\n\ \ flan run [args...]\n\ \ flan reload [-o out.so]\n\ \ flan dev [-s socket]"; diff --git a/lib/build.ml b/lib/build.ml index 48df980..4886c31 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -72,6 +72,28 @@ type opts = { mechanism is a [llvm.dbg.declare] on an alloca and mem2reg deletes the alloca. *) debug : bool; + (* AddressSanitizer and UndefinedBehaviorSanitizer over the whole program: + the runtime's C, the generated shim, and — via [Emit]'s + [sanitize_address] attribute — the Flan code itself. + + Its own axis and not a mode of [debug]. It deliberately does *not* force + -O0: the UB worth finding (a shift past the width folding to nothing, a + float cast that only traps once it is a real cvttss2si) is what the + optimiser does with it, so the sweep is worth running at -O2 and at -O0 + and any divergence between the two is itself the finding. It does pull in + -g, because a report without a line number costs more to read than the + build costs to make. + + What reaches what, measured rather than assumed: + - ASan instruments Flan functions only because [Emit] attributes them; + globals get their redzone from the module pass either way. + - UBSan instruments the C only. Its checks come out of clang's C + frontend, and there is no attribute that asks a pass for them, so + hand-written IR gets none. See [Emit]'s [sanitize] comment. + - signed-integer-overflow is excluded because wrapping is what this + language's arithmetic means; without the exclusion every program + trips on its first [+]. Nothing else is excluded. *) + sanitize : bool; } (* Checks are deliberately independent of [opt]: the acceptance table runs the @@ -80,7 +102,24 @@ type opts = { checks. Dropping them is a release decision, not an optimisation one. *) let default = { target = None; opt = "-O2"; keep = false; checks = true; dev = false; - debug = false } + debug = false; sanitize = false } + +(* The flags that are neither [opt] nor the target, spelled once so that the + compile command and the object-cache key cannot disagree. They did before: + -g was written out at the command and again at the key, and a flag that + appears in one and not the other is the silent failure — an unsanitized + [flan_rt.o] served out of the cache to a sanitized build links fine and + reports nothing. *) +let cflags opts = + (if opts.debug then [ "-g" ] else []) + @ (if opts.sanitize then + (* -g here and not via [debug]: a sanitizer report with no file and no + line is most of the work still to do. *) + [ "-fsanitize=address,undefined"; + "-fno-sanitize=signed-integer-overflow"; + "-fno-omit-frame-pointer" ] + @ (if opts.debug then [] else [ "-g" ]) + else []) (* ── wasm32, which needs more than a triple ────────────────────────── The native target is whatever clang was built for, so [--target=] alone is @@ -278,7 +317,7 @@ let compile_c ~opts ?tflags ~src ~name () = (Digest.string (String.concat "\000" [ name; src; Lazy.force clang_stamp; opts.opt; - (if opts.debug then "-g" else ""); + String.concat " " (cflags opts); String.concat " " tflags ])) in let obj = Filename.concat (cachedir ()) (key ^ ".o") in @@ -292,7 +331,7 @@ let compile_c ~opts ?tflags ~src ~name () = let cmd = String.concat " " ([ Filename.quote clang; opts.opt ] - @ (if opts.debug then [ "-g" ] else []) + @ cflags opts @ [ "-c" ] @ tflags @ [ Filename.quote c; "-o"; Filename.quote tmp ]) in @@ -327,14 +366,23 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = []) "wasm32: --debug is native only — the DWARF member offsets are computed \ for the host's layout, and wasm32's 32-bit pointer moves every one of \ them"; + (* There is no wasm32 sanitizer runtime to link against: clang accepts + -fsanitize=address for the triple and the link fails on + __asan_report_load4. Refused by name rather than met at the linker. *) + if wasm_target opts && opts.sanitize then + failwith + "wasm32: --sanitize is native only — there is no libclang_rt.asan for \ + wasm32-wasi to link against"; (* -O0 is not a choice a debug build offers: [llvm.dbg.declare] describes an - alloca, and at -O2 mem2reg deletes the alloca. *) + alloca, and at -O2 mem2reg deletes the alloca. [sanitize] deliberately + does not do this: see [opts]. *) let opts = if opts.debug then { opts with opt = "-O0" } else opts in let tflags = target_flags opts in let dir = workdir () in let ll = Filename.concat dir (Filename.basename out ^ ".ll") in write ll - (Emit.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug ~pnames p); + (Emit.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug ~pnames + ~sanitize:opts.sanitize p); (* [flan_dev.c] is compiled into every build, not only a dev one. Nothing in a release build calls into it — the compiler only emits a registry lookup for a name the host was not built with, which cannot arise without cells — @@ -368,8 +416,12 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = []) String.concat " " ([ Filename.quote clang; opts.opt; "-Wno-override-module" ] (* -g at the link so clang does not strip, and keeps the object files' - debug sections; the .ll carries its own. *) - @ (if opts.debug then [ "-g" ] else []) + debug sections; the .ll carries its own. The sanitizer flags have to + be here too — they are what pulls in libclang_rt.asan and the UBSan + runtime, and they are also what makes clang run the ASan pass over + the .ll, which is the only place the Flan half of the program gets + instrumented at all. *) + @ cflags opts @ (if opts.dev then [ "-rdynamic" ] else []) @ tflags @ [ Filename.quote ll ] diff --git a/lib/emit.ml b/lib/emit.ml index cd1aa80..44f2dd7 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -193,9 +193,26 @@ type m = { down because every emitter that can produce an instruction has to be able to hang a location on it. *) dbg : dbg option; + (* True in a sanitized build, and the whole of what ASan needs from us. + AddressSanitizer is an LLVM *pass*, but it instruments only functions + carrying the [sanitize_address] attribute — which clang's C frontend adds + and nothing adds to IR written by hand. Passing -fsanitize=address to the + clang run over this .ll therefore instruments the runtime's C and not one + instruction of Flan; measured, not assumed (see NEXT.md). So every + [define] here names attribute group #0 and [finish] writes it out. + + There is no equivalent for UndefinedBehaviorSanitizer: its checks are + emitted by the C frontend as branches to __ubsan_handle_*, and no + attribute asks a pass to produce them. UBSan over this .ll covers the C + and nothing else. *) + sanitize : bool; mutable nstr : int; } +(* The attribute group every emitted function names, empty unless sanitizing. + Spelled once so the [define] sites and [finish] cannot disagree. *) +let attrs m = if m.sanitize then " #0" else "" + let field_ty m sn i = let s = Hashtbl.find m.structs sn in (List.nth s.Tast.fields i).Tast.fty @@ -1472,8 +1489,8 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = end end; Buffer.add_string m.out - (Printf.sprintf "\ndefine %s%s%s {\nentry:\n%s%s}\n" - (if hidden then "hidden " else "") (signature ~named:true fn) + (Printf.sprintf "\ndefine %s%s%s%s {\nentry:\n%s%s}\n" + (if hidden then "hidden " else "") (signature ~named:true fn) (attrs m) (match dsub with None -> "" | Some n -> Printf.sprintf " !dbg !%d" n) (Buffer.contents f.allocas) (Buffer.contents f.b)) @@ -1557,7 +1574,9 @@ declare void @flan_slice_fail(ptr, i64, i64, i64, i64) noreturn cold the i32 status are each optional (plan.org, Milestone-2 primitives). *) let emit_main m (fn : Tast.fn) = let b = Buffer.create 256 in - Buffer.add_string b "\ndefine i32 @main(i32 %argc, ptr %argv) {\nentry:\n"; + Buffer.add_string b + (Printf.sprintf "\ndefine i32 @main(i32 %%argc, ptr %%argv)%s {\nentry:\n" + (attrs m)); Buffer.add_string b " call void @flan_rt_init(i32 %argc, ptr %argv)\n"; (* The program's own end of the transfer channel. Nothing can be transferring when [main] returns: a restart is found by name on the restart stack, and @@ -1616,12 +1635,13 @@ let new_dbg (p : Tast.program) = file); d -let new_module ~checks ~dev ~known ?(debug = false) (p : Tast.program) = +let new_module ~checks ~dev ~known ?(debug = false) ?(sanitize = false) + (p : Tast.program) = let m = { out = Buffer.create 8192; strs = Buffer.create 512; structs = Hashtbl.create 16; globals = Hashtbl.create 16; externs = Hashtbl.create 32; - checks; dev; known; nstr = 0; + checks; dev; known; nstr = 0; sanitize; dbg = (if debug then Some (new_dbg p) else None); } in List.iter (fun (s : Tast.structure) -> Hashtbl.replace m.structs s.Tast.sname s) @@ -1676,13 +1696,14 @@ let dmodule d = let finish m = header ^ Buffer.contents m.strs ^ "\n" ^ Buffer.contents m.out + ^ (if m.sanitize then "\nattributes #0 = { sanitize_address }\n" else "") ^ (match m.dbg with None -> "" | Some d -> dmodule d) (* [checks] is on by default: a dev build traps on an out-of-bounds [at] or [slice], a release build is told to drop them. *) let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = []) - (p : Tast.program) : string = - let m = new_module ~checks ~dev ~known:(fun _ -> true) ~debug p in + ?(sanitize = false) (p : Tast.program) : string = + let m = new_module ~checks ~dev ~known:(fun _ -> true) ~debug ~sanitize p in (* One cell per function, initialised to the function this build compiled. Nothing has been redefined yet, so a dev build starts out behaving exactly like a release one — the indirection is the only difference. *)