Joseph Ferano
3df49184a7
--dev --sanitize had been unbuildable for as long as a dev build has armed the registry from a constructor, and nobody knew because no alias built it: test_sanitize built the corpus twice and neither time --dev, test_dev builds --dev and never with a sanitizer. A configuration nothing builds can be broken for a month, and that one was. af71459 fixed it; this is what keeps it fixed. dev_sweep, in the alias that already exists rather than a new one -- five names to remember was already four too many, and this is the same question @sanitize is for. Seven programs built --dev twice, plain and sanitized, run standalone with no daemon: a sanitizer report fails, and so does any divergence from the unsanitized dev run. Standalone is what makes it nearly free, and it works because a dev build is not a dev session. The cells, the marker and the constructor are in the executable either way, and a program that never calls agent/start runs to its own end. That is why the list is mostly ordinary programs built the other way: dev-noagent is the only one of sixteen dev-*.flan that does not import the agent, and the rest stop in the break loop waiting for an editor, which is test_dev.ml's business against a real daemon. The three dyn programs are not interchangeable and the difference is the collector. dyn-vec allocates and never collects -- flan_dyn.c has a one-megabyte floor and dyn-vec does not reach it -- so what it says is that the registry and the allocator agree. dyn-map and p13-dyn-collect are the only two programs anywhere past that floor, so they are the only two under which a mark and a sweep run; without them a collection had still never happened in a dev build under ASan. dev_segv is beside the sweep rather than in it, because the program that faults cannot be compared against an unsanitized run: that build's handler prints its line and parks in the break loop, so the plain half would hang, and the two are supposed to differ. ASan is meant to own the fault -- flan_dev_crash_enable checks a weak __asan_init and stands down -- so the case asserts ASan's report and the absence of the handler's line. At -O0, because at -O2 the write through a bytes-view of a literal does not fault at all and both builds print the string unchanged. That yield had never run in any build anywhere; it was behind a link that did not happen. Checked both ways rather than asserted: eight failures with the constructor naming declarations again, clean with it fixed. Twenty-six seconds of the alias's 2m30 warm, and nothing added to dune test. Two aliases were also green only because dune test runs first. @sanitize never listed the package directories pkg-diamond.flan imports, and @page never listed sand.flan, which quotes.sh reaches through sand-headless.flan; from a cold tree the first died before its first sanitized build, and @page sits inside @checks where CI hides the same thing. Both listed now. @valgrind, @x86, @js and @cells were checked and are complete. What it still does not reach is in FIX.org: a program driven by a real flan dev daemon under ASan, which wants a --sanitize the CLI does not have and a way through Dev.serve. --x86 --sanitize is refused by Build by name, so there is no second backend to track here.
590 lines
31 KiB
OCaml
590 lines
31 KiB
OCaml
(* The corpus a second time, under AddressSanitizer and
|
|
UndefinedBehaviorSanitizer.
|
|
|
|
Not part of [dune test] and deliberately so: a sanitized build of one
|
|
program is a 1.8MB statically linked binary and takes ten to twenty seconds
|
|
to produce, so the sweep is minutes where the whole existing suite is
|
|
seconds. It has its own alias.
|
|
|
|
dune build --root . @sanitize
|
|
|
|
What this can and cannot see is written down in [Build.opts] and in
|
|
[Emit]'s [sanitize] comment, and it is not symmetric:
|
|
|
|
- ASan reaches Flan code, but only because [Emit] puts [sanitize_address]
|
|
on every function it defines; the attribute is what the pass selects on
|
|
and hand-written IR has none by default. The positive control for that is
|
|
[oob], below, which must report.
|
|
- UBSan reaches the runtime's C and nothing else. Its checks are branches
|
|
clang's *frontend* emits, and no attribute asks an LLVM pass to produce
|
|
them, so the shift-past-the-width and float-cast questions this sweep was
|
|
partly meant to answer are not answerable this way. [shift] records that
|
|
as a test rather than as a paragraph: it is a program with unambiguous
|
|
shift UB in it, and it is expected *not* to be caught.
|
|
|
|
The check is two-sided. A marker in the sanitized run's output is a
|
|
failure, and so is any divergence from the unsanitized run — same output,
|
|
same exit status. The second half is not redundant: UBSan recovers by
|
|
default, so a program can trip a check, carry on with a different value and
|
|
still exit 0, and several of these programs exit nonzero by design, so
|
|
"exit status 0" is not available as a pass condition. *)
|
|
|
|
open Flan
|
|
|
|
(* The watchdog first: a hang is the one failure mode that reports
|
|
nothing at all. See watchdog.ml. *)
|
|
let () = Watchdog.arm ~seconds:3600 "test_sanitize"
|
|
|
|
let failures = Test_support.failures
|
|
let fail fmt = Test_support.fail fmt
|
|
let scratch = Test_support.scratch
|
|
|
|
(* Leaks are off. Every allocation in the runtime is allocate-once-never-free
|
|
by design — [rt_args] says so in its own comment — so LeakSanitizer here
|
|
produces a suppression list and no information. Set in the environment
|
|
rather than baked in, so a session asking the leak question can ask it.
|
|
[print_stacktrace] is what turns a UBSan report from a source line into
|
|
something with a caller in it, and it is off by default. *)
|
|
let env =
|
|
"ASAN_OPTIONS=${ASAN_OPTIONS:-detect_leaks=0} \
|
|
UBSAN_OPTIONS=${UBSAN_OPTIONS:-print_stacktrace=1} "
|
|
|
|
let run exe args =
|
|
let out = Filename.concat scratch "flan-sanitize.out" in
|
|
let cmd =
|
|
Printf.sprintf "%s%s %s > %s 2>&1" env (Filename.quote exe)
|
|
(String.concat " " (List.map Filename.quote args))
|
|
(Filename.quote out)
|
|
in
|
|
let code = Sys.command cmd in
|
|
let text = In_channel.with_open_bin out In_channel.input_all in
|
|
(try Sys.remove out with Sys_error _ -> ());
|
|
(code, text)
|
|
|
|
let compile ?(dev = false) ~sanitize ~checks path =
|
|
let exe =
|
|
Filename.concat scratch
|
|
(Printf.sprintf "flan-san-%s%s-%s"
|
|
(if sanitize then "s" else "p")
|
|
(if dev then "d" else "")
|
|
(Filename.remove_extension (Filename.basename path)))
|
|
in
|
|
let p, csrcs, lflags = Test_support.linked ~dev path in
|
|
ignore
|
|
(Build.executable
|
|
~opts:{ Build.default with checks; sanitize; dev } ~csrcs ~lflags p
|
|
~out:exe);
|
|
exe
|
|
|
|
let contains = Test_support.contains
|
|
|
|
(* What a report looks like, whichever sanitizer wrote it. *)
|
|
let markers =
|
|
[ "ERROR: AddressSanitizer"; "runtime error:"; "ERROR: LeakSanitizer";
|
|
"SUMMARY: UndefinedBehaviorSanitizer" ]
|
|
|
|
let reported text = List.exists (contains text) markers
|
|
|
|
(* The corpus. Excluded, with the reason, rather than quietly absent:
|
|
|
|
- raylib-*, and the windowed examples, because raylib and libm are not
|
|
instrumented and every report through them would be about somebody
|
|
else's code.
|
|
- break.flan and agent.flan, which stop in the break loop and wait for an
|
|
editor to connect. They are covered by test_agent against a real daemon.
|
|
- the dev-* and reload-* programs, which need a host process or a dlopen
|
|
harness. The reload path is half-covered at best in any case: a
|
|
redefinition module is built by llc and ld, not by clang, so nothing
|
|
instruments it — one more thing this sweep does not prove.
|
|
- nth-gone, pkg-hidden-main, pkg-two-aliases, pkg-two-mains, pkg-cycle,
|
|
which are negative cases and are expected not to compile.
|
|
|
|
calc-me is here and is not in test/programs: it is the one string parser in
|
|
the corpus, which makes it the likeliest to push [scratch] or [escaped]
|
|
anywhere near their bounds. *)
|
|
let corpus =
|
|
[ (* bounds.flan selects its case from argv, and every case but 0 is one
|
|
that traps. Argument 0 is the in-bounds path — the last index of a
|
|
fixed array, a slice ending exactly at len, an empty slice at len —
|
|
which is the one the sweep has something to say about. The trapping
|
|
cases are where the ASan-without-bounds-checks question lives and they
|
|
are run separately; see [unchecked_controls]. Running this program with
|
|
*no* argument reads args[1] of a one-element argv, which is a bug in
|
|
the harness rather than in anything under test. *)
|
|
"programs/bounds.flan", [ "0" ];
|
|
"programs/arena-value.flan", [];
|
|
(* Here for what it would catch rather than for what it prints: the three
|
|
number conversions render into a frame slot the checker allocates per
|
|
call site, and a slot that ended up as a reclaimed temporary instead
|
|
would be a stack-use-after-scope — which is exactly what ASan sees and
|
|
an output comparison does not. *)
|
|
"programs/two-numbers.flan", [];
|
|
"programs/bytes2.flan", [];
|
|
(* (bytes s) allocates a copy now rather than reinterpreting the string,
|
|
which is the one change in that lane this tool can see: the copy is a
|
|
block from an allocator, it is written through immediately, and the
|
|
last case takes its block from an arena that is then freed and
|
|
destroyed. A copy one byte short, or a write landing after the block,
|
|
is a heap overflow here and a correct-looking program everywhere
|
|
else. *)
|
|
"programs/bytes-copy.flan", [];
|
|
"programs/cleanup.flan", [];
|
|
"programs/conditions.flan", [];
|
|
"programs/debug.flan", [];
|
|
"programs/debug-permuted.flan", [];
|
|
"programs/destructure.flan", [];
|
|
"programs/edn.flan", [];
|
|
(* The copy edn/read makes of every string: the document is read out of a
|
|
(Vec u8) that is then overwritten in place, so a reader still holding
|
|
views is reading a buffer it does not own and ASan is what says so. *)
|
|
"programs/edn-read.flan", [];
|
|
"programs/enum-compare.flan", [];
|
|
"programs/error.flan", [];
|
|
(* Makes and removes its own tree, so the two runs of the sweep see the
|
|
same directory; the new C here is three more path buffers, which is
|
|
exactly what this tool is for. *)
|
|
"programs/files.flan", [];
|
|
(* The unwinding handler, and here for the frames rather than for the heap:
|
|
every path it takes leaves a function through the transfer exit, where
|
|
a handler frame or a restart frame left on its stack is a pointer into
|
|
an alloca that has gone. An output comparison cannot see that until
|
|
something later calls through it; ASan sees it at the store. The
|
|
with-allocator case is the one that reaches the heap — the region it
|
|
rebound is released after the unwind has carried a value out of it. *)
|
|
"programs/handler-case.flan", [];
|
|
(* The same transfer exit, asked about the defers rather than the frames.
|
|
The bug this program was written for was a defer running over a binding
|
|
the form that would have written it had transferred out of, and the
|
|
cleanup was a free: the second run of that path frees a pointer nobody
|
|
stored. ASan is the regression guard and not the detector — an
|
|
uninitialised stack slot is not its bug class, and it reported nothing
|
|
on the broken binary; what named it was valgrind, and test_valgrind.ml
|
|
runs this program for that reason. *)
|
|
"programs/init-conditions.flan", [];
|
|
(* The JSON reader, which is the corpus's densest allocator: every string
|
|
in the document is a (Vec u8) grown a byte at a time and then handed
|
|
out as a view of its own block, and the block is never freed because
|
|
the view IS the answer. ASan is what says the view still points at the
|
|
block after the growth that moved it. *)
|
|
"programs/json.flan", [];
|
|
"programs/machine.flan", [];
|
|
"programs/math.flan", [];
|
|
"programs/math3.flan", [];
|
|
"programs/pkg-diamond.flan", [];
|
|
"programs/pkg-return.flan", [];
|
|
"programs/pkg-shared.flan", [];
|
|
"programs/pkg-unused.flan", [];
|
|
"programs/printers.flan", [];
|
|
"programs/println.flan", [];
|
|
"programs/restarts.flan", [];
|
|
(* The dyn programs, which reach flan_dyn.c from Flan rather than from the
|
|
hand-written C below — and the difference is the whole reason they are
|
|
here. [dyn_sweep] checks the collector against roots dyn_ops.c pushes
|
|
by hand; these check it against the roots the *compiler* emits, which
|
|
is the half no C test can reach. A root the emitter forgot is a live
|
|
object swept, and that is a use-after-free with the collector's own
|
|
hands on it.
|
|
[dyn-vec] is the one that builds objects of three kinds; [dyn-defer]
|
|
is the one whose roots come off on a transfer's path out rather than a
|
|
return's, which is where a pop written on one path only would show.
|
|
[p13] and [dyn-map] are the programs that allocate past flan_dyn.c's
|
|
one-megabyte floor, so they are where a mark and a sweep
|
|
actually run — everything else in this list agrees with ASan by never
|
|
collecting at all. [dyn-map] is also the one whose live set is a map,
|
|
so its keys and values are what the marker has to trace to be right,
|
|
and the interned keywords are what the sweep has to leave alone. *)
|
|
"programs/dyn-vec.flan", [];
|
|
"programs/dyn-defer.flan", [];
|
|
(* The per-type descriptors' own program, and the one in this list whose
|
|
roots are aggregates rather than dyn words: a struct with a dyn field
|
|
in a frame slot, in a global, in the temporary a by-value return lands
|
|
in, and as a condition's payload across a handler transfer. It runs
|
|
past the one-megabyte floor like [p13], so a mark and a sweep really
|
|
happen, and what a wrong descriptor offset looks like is a read of a
|
|
freed object — which is exactly what ASan is here to see and what no
|
|
amount of reading the offsets can. *)
|
|
"programs/dyn-struct.flan", [];
|
|
"programs/dyn-map.flan", [];
|
|
(* Classes, M2 queue item 6. A class instance is a map with one more word
|
|
in its header, so what this adds over [dyn-map] is that word: it is
|
|
written by a constructor, read by class-of, compared by equality and
|
|
printed by both renderers, and it is the one field in an object that
|
|
the marker deliberately does not trace — an interned keyword entry is
|
|
immortal and is not a collector object. If that reasoning is wrong,
|
|
50000 instances past the one-megabyte floor is where ASan says so. *)
|
|
"programs/dyn-class.flan", [];
|
|
(* nil <-> None at (Option T), M2 queue item 4: an Option's tag is read
|
|
with a raw [Field] the surface language never writes (check.ml's
|
|
[box_option]/[unbox_option], the same access Render's structural
|
|
printer uses), so this is where a wrong tag offset or a wrong
|
|
direction of the comparison shows up as a read past the struct rather
|
|
than as a wrong answer. Both trap, by design — [nil-option] on a bare
|
|
T meeting a dyn nil, [some-nil] on (Some nil) built from a value the
|
|
checker could not see was nil — and the two-sided check above is what
|
|
ASan's build being asked to trap the same way the plain build does. *)
|
|
"programs/nil-option.flan", [];
|
|
"programs/some-nil.flan", [];
|
|
(* M2 item 3: a typed container's view. Mode 0, the survey — the modes
|
|
that trap are exercised as C refusals in test_dyn.ml's [refuseview:*]
|
|
instead, the same split [bounds.flan]'s "0" argument makes above. A
|
|
view's storage is a plain array or a Vec's own malloc block, neither
|
|
one this collector allocates, so there is nothing here for ASan to
|
|
catch that the runtime tests above did not already exercise directly
|
|
— this row is about the *compiler* lane: the address the checker
|
|
hands the runtime at the crossing, and whether a push through the
|
|
view that grows and moves the Vec leaves anything for ASan's
|
|
use-after-free detection to find. *)
|
|
"programs/dyn-view.flan", [ "0" ];
|
|
"../spike/x86/p13-dyn-collect.flan", [];
|
|
"programs/sand-headless.flan", [];
|
|
"programs/signedness.flan", [];
|
|
"programs/slices.flan", [];
|
|
"programs/string-of-bytes.flan", [];
|
|
"programs/text.flan", [];
|
|
(* The clock and getenv. getenv hands back a slice viewing the process
|
|
environment and never a copy, so a report here would be the one that
|
|
matters. *)
|
|
"programs/time.flan", [];
|
|
"programs/unit-main.flan", [];
|
|
"programs/utf8.flan", [];
|
|
"programs/values.flan", [];
|
|
"programs/virtual-controls-headless.flan", [];
|
|
"../calc-me.flan", [ "1 + 2 * (3 - 0.5) / 2" ] ]
|
|
|
|
let sweep ~checks label =
|
|
List.iter
|
|
(fun (path, args) ->
|
|
match compile ~sanitize:false ~checks path with
|
|
| exception Failure m -> fail "%s %s: unsanitized build: %s" label path m
|
|
| plain ->
|
|
(match compile ~sanitize:true ~checks path with
|
|
| exception Failure m -> fail "%s %s: sanitized build: %s" label path m
|
|
| san ->
|
|
let c1, t1 = run plain args in
|
|
let c2, t2 = run san args in
|
|
if reported t2 then
|
|
fail "%s %s: sanitizer report\n%s" label path t2
|
|
else if c1 <> c2 || t1 <> t2 then
|
|
fail "%s %s: diverged from the unsanitized run\n \
|
|
plain (exit %d): %S\n sanitized (exit %d): %S"
|
|
label path c1 t1 c2 t2;
|
|
(try Sys.remove plain with Sys_error _ -> ());
|
|
(try Sys.remove san with Sys_error _ -> ())))
|
|
corpus
|
|
|
|
(* The dyn runtime, under the same two sanitizers, driven from C. There are
|
|
Flan programs that reach flan_dyn.c now and three of them are in [corpus]
|
|
above — this used to say there were none — but they are a different
|
|
question and not a replacement for this one. They exercise the roots the
|
|
*compiler* emits, over the handful of operations a program happens to
|
|
write; this exercises every entry point in the header, with the roots
|
|
pushed by hand so that the runtime can be wrong on its own. The thing to
|
|
build is test/dyn_ops.c against programs/dyn-host.flan — the same pair
|
|
test_dyn.ml builds, with [sanitize] on.
|
|
|
|
This is the case the sweep is most likely to have something to say about.
|
|
Every other program in the corpus allocates and never frees, which is a
|
|
policy ASan can only agree with; this one frees, and a mark-sweep collector
|
|
is precisely a machine for freeing something that is still reachable. A
|
|
use-after-free here is what a wrong marker looks like from the outside, and
|
|
it is invisible to the assertions in test_dyn.ml — the freed bytes are
|
|
usually still the bytes that were there.
|
|
|
|
The leak question is not asked, for the reason [env] gives: leaks are off
|
|
across this file because the runtime's allocations are allocate-once by
|
|
design. It would be the wrong question here anyway — the temporaries ring
|
|
holds the last sixty-four objects alive on purpose and at exit, and every
|
|
one of them would be reported.
|
|
|
|
Only the modes that return are run. The refusals end in [_exit(134)], which
|
|
skips ASan's exit-time checks entirely, so running them would prove nothing
|
|
the checked build has not already proved. *)
|
|
let dyn_sweep () =
|
|
let exe = Filename.concat scratch "flan-san-dyn" in
|
|
let path = "programs/dyn-host.flan" in
|
|
let p, csrcs, lflags = Test_support.linked path in
|
|
match
|
|
Build.executable
|
|
~opts:{ Build.default with Build.sanitize = true }
|
|
~csrcs:(csrcs @ [ "dyn_ops.c" ]) ~lflags p ~out:exe
|
|
with
|
|
| exception Failure m -> fail "dyn: sanitized build: %s" m
|
|
| _ ->
|
|
List.iter
|
|
(fun mode ->
|
|
let code, text = run exe [ mode ] in
|
|
if reported text then fail "dyn %s: sanitizer report\n%s" mode text
|
|
else if code <> 0 then
|
|
fail "dyn %s: exit %d under the sanitizers\n%s" mode code text)
|
|
(* [classes] is in here for the reason this whole function is: it is
|
|
the one mode that *frees* an object's entry block while the object
|
|
stays live and reachable. A migration swaps an instance's storage
|
|
for a differently-sized one, and its last two thousand instances do
|
|
it with the collector running around them, so a marker that read
|
|
the old block, or a [len] that outlived the block it described,
|
|
is a use-after-free here and nothing anywhere else. *)
|
|
[ "ops"; "gc"; "unrooted"; "desc"; "nested"; "sharing"; "park";
|
|
"classes" ];
|
|
(try Sys.remove exe with Sys_error _ -> ())
|
|
|
|
(* A third sweep, over a handful of the same programs built [--dev].
|
|
|
|
Why this exists at all. [--dev --sanitize] could not compile a single
|
|
program, at any optimisation level, and had not been able to for as long
|
|
as a dev build has armed the allocation registry from a constructor:
|
|
clang 20's AddressSanitizer module pass segfaults on a module whose
|
|
[llvm.global_ctors] names a function the module only declares, and ours
|
|
was a runtime C function. The fix is in [Emit] and its comment says what
|
|
the shape has to be. What this is, is the reason nobody knew — no alias
|
|
built the combination. [corpus] above is built twice, and both times
|
|
without [--dev]; [test_dev.ml] builds [--dev] and never with a sanitizer.
|
|
A configuration nothing builds is a configuration that can be broken for a
|
|
month, and this one was.
|
|
|
|
Standalone and with no daemon, which is what makes it nearly free. A dev
|
|
build is not a dev *session*: the cells, the ABI marker and the
|
|
constructor are in the executable either way, and a program that does not
|
|
call [agent/start] runs to its own end and exits. That is why the list is
|
|
mostly ordinary programs built the other way rather than the [dev-*]
|
|
ones — every [dev-*] program but one imports the agent and stops in the
|
|
break loop waiting for an editor, and those are test_dev.ml's against a
|
|
real daemon.
|
|
|
|
So what it checks is narrower than the corpus sweep and is deliberately
|
|
the half that was broken: that the combination *builds*, and that the
|
|
program it builds still prints what the unsanitized dev build printed and
|
|
exits the same way. The crash was at compile time, so the build is the
|
|
part that carries the weight; the run is what says the constructor the fix
|
|
introduced actually calls both of the things it replaced.
|
|
|
|
Not covered, and worth naming rather than leaving to be discovered the way
|
|
this bug was: a program driven by [flan dev] under ASan. The daemon builds
|
|
its host through its own path and the CLI has no [--sanitize] to pass it,
|
|
so that one wants a flag and a way through [Dev.serve]. See FIX.org. The
|
|
faulting dev build, which was on that list too, is covered now — see
|
|
[dev_segv] below. *)
|
|
let dev_corpus =
|
|
[ (* The only [dev-*] program with no agent import: it prints and returns.
|
|
Here because it is the one program in the tree written for a dev
|
|
build that a sweep can run on its own. *)
|
|
"programs/dev-noagent.flan";
|
|
(* Ordinary programs, built the way the dev loop builds them. A dev build
|
|
puts every function behind a cell and routes every call through it, so
|
|
these say the indirection still computes what the direct call did —
|
|
under ASan, which is the part the corpus sweep cannot say. *)
|
|
"programs/println.flan";
|
|
"programs/values.flan";
|
|
"programs/text.flan";
|
|
(* And the ones that allocate, because a dev build's registry notes every
|
|
block and a dyn program is the one that frees. [dyn-vec] builds objects
|
|
of three kinds and never collects — flan_dyn.c has a one-megabyte floor
|
|
and nothing here reaches it — so on its own it says the registry and
|
|
the allocator agree, which is worth having and is not the collector.
|
|
[p13] and [dyn-map] are the two programs anywhere that allocate past
|
|
that floor, so they are the only ones under which a mark and a sweep
|
|
actually run, and until they were in this list a collection had never
|
|
happened in a dev build under ASan at all. *)
|
|
"programs/dyn-vec.flan";
|
|
"programs/dyn-map.flan";
|
|
"../spike/x86/p13-dyn-collect.flan" ]
|
|
|
|
let dev_sweep () =
|
|
List.iter
|
|
(fun path ->
|
|
match compile ~dev:true ~sanitize:false ~checks:true path with
|
|
| exception Failure m -> fail "dev %s: unsanitized dev build: %s" path m
|
|
| plain ->
|
|
(match compile ~dev:true ~sanitize:true ~checks:true path with
|
|
| exception Failure m ->
|
|
fail "dev %s: --dev --sanitize did not build: %s" path m
|
|
| san ->
|
|
let c1, t1 = run plain [] in
|
|
let c2, t2 = run san [] in
|
|
if reported t2 then fail "dev %s: sanitizer report\n%s" path t2
|
|
else if c1 <> c2 || t1 <> t2 then
|
|
fail "dev %s: diverged from the unsanitized dev run\n \
|
|
plain (exit %d): %S\n sanitized (exit %d): %S"
|
|
path c1 t1 c2 t2;
|
|
(try Sys.remove san with Sys_error _ -> ()));
|
|
(try Sys.remove plain with Sys_error _ -> ()))
|
|
dev_corpus
|
|
|
|
(* And the one dev program that faults, which is its own case rather than a
|
|
line in [dev_corpus] for two reasons.
|
|
|
|
It cannot be compared against an unsanitized run. A dev build's SIGSEGV
|
|
handler prints its line and then parks in the break loop waiting for an
|
|
editor, so the plain half of the pair would hang rather than answer, and
|
|
the two are *supposed* to differ here: [flan_dev_crash_enable] checks a
|
|
weak [__asan_init] and declines to install the handler when ASan is in the
|
|
process, on the grounds that two owners of SIGSEGV is one too many. So the
|
|
sanitized run must produce ASan's report and must NOT produce the
|
|
handler's line, and that is the assertion.
|
|
|
|
And it has to be built at -O0. At the sweep's -O2 the write through a
|
|
bytes-view of a string literal does not fault at all — measured, both
|
|
builds print the unmodified string — so a case that is about what happens
|
|
on a fault has to be compiled where the fault happens. Same family as the
|
|
-O0/-O2 split [unchecked_controls] records for bounds.flan.
|
|
|
|
This is the line the emitter fix unblocked: until [llvm.global_ctors]
|
|
stopped naming a declaration, no [--dev --sanitize] build linked, so the
|
|
yield had never run in any build anywhere. *)
|
|
let dev_segv () =
|
|
let path = "programs/dev-segv.flan" in
|
|
match
|
|
(let p, csrcs, lflags = Test_support.linked ~dev:true path in
|
|
let exe = Filename.concat scratch "flan-san-sd-dev-segv" in
|
|
ignore
|
|
(Build.executable
|
|
~opts:{ Build.default with Build.dev = true; sanitize = true;
|
|
opt = "-O0" }
|
|
~csrcs ~lflags p ~out:exe);
|
|
exe)
|
|
with
|
|
| exception Failure m -> fail "dev-segv: --dev --sanitize -O0 build: %s" m
|
|
| exe ->
|
|
let _, text = run exe [] in
|
|
if not (reported text) then
|
|
fail "dev-segv: no sanitizer report. ASan is meant to own the fault \
|
|
here — check the weak [__asan_init] in flan_dev_crash_enable\n%s"
|
|
text
|
|
else if contains text "flan: SIGSEGV" then
|
|
fail "dev-segv: the Flan handler reported as well as ASan. Both of them \
|
|
own SIGSEGV now, which is what the [__asan_init] check exists to \
|
|
prevent\n%s" text;
|
|
(try Sys.remove exe with Sys_error _ -> ())
|
|
|
|
(* The positive controls, which are the only evidence that a clean sweep means
|
|
anything. Both are written here rather than kept in test/programs because
|
|
neither is a program anybody should build: one reads off the end of an
|
|
array and the other shifts an i32 by 32. *)
|
|
let control ~expect_report ?(args = []) ~why name src =
|
|
let path = Filename.concat scratch (name ^ ".flan") in
|
|
Out_channel.with_open_bin path (fun ch -> Out_channel.output_string ch src);
|
|
let exe = compile ~sanitize:true ~checks:false path in
|
|
let _, text = run exe args in
|
|
(match expect_report, reported text with
|
|
| true, false -> fail "control %s: nothing reported. %s\n%s" name why text
|
|
| false, true -> fail "control %s: reported. %s\n%s" name why text
|
|
| _ -> ());
|
|
(try Sys.remove exe with Sys_error _ -> ());
|
|
(try Sys.remove path with Sys_error _ -> ())
|
|
|
|
(* The variant the checked build cannot ask for: with Flan's own bounds checks
|
|
off, is ASan enough on its own? bounds.flan is the program to ask it with —
|
|
every one of its selectors is a deliberate out-of-bounds access, and in a
|
|
checked build every one of them traps.
|
|
|
|
The answer is no, and it is worth having the shape of the no. [reports]
|
|
holds the cases ASan catches; the rest are listed with why it does not, and
|
|
they are printed rather than asserted, because a future LLVM that folds
|
|
differently would change them and that is information, not a regression.
|
|
|
|
[9] is the one that is not about ASan at all: at -O2 the access never
|
|
happens. The index is out of bounds on an [inbounds] getelementptr into a
|
|
string constant, so the whole load folds to zero and the program prints a
|
|
wrong answer instead of touching a redzone. At -O0, with the load still in
|
|
the program, ASan reports it. That divergence is why [--sanitize] does not
|
|
force -O0 the way [--debug] does — the optimiser is half of what is being
|
|
measured. *)
|
|
let unchecked_controls () =
|
|
let reports = [ "3"; "7"; "4" ] in
|
|
let silent =
|
|
[ "-1", "a negative index into a global. Not a property of the access: \
|
|
ASan lays a global out as {data, redzone}, so an underflow is \
|
|
caught when something redzoned precedes it and not when nothing \
|
|
does — measured both ways, and here nothing does. Whether \
|
|
reading before an array is seen at all is therefore up to what \
|
|
the linker put in front of it";
|
|
"9", "at -O2 the load is folded away — an out-of-bounds inbounds GEP \
|
|
into a string constant is poison, so nothing is read and a wrong \
|
|
value is printed. Reported at -O0.";
|
|
"2", "a reversed slice (lo 2, hi 1), which this build traps on before \
|
|
anything is read. It is in this list rather than out of it \
|
|
because it used to be here for the opposite reason: the length \
|
|
came out negative, nothing was read, and ASan had nothing to \
|
|
see, which made a slice with a negative length reaching user \
|
|
code a checker question and not a sanitizer one. The checker \
|
|
answered it — lo <= hi is a representation invariant and no \
|
|
longer sits behind --no-bounds-checks — so ASan is still silent \
|
|
here and now for a better reason. The trap itself is asserted in \
|
|
test_acceptance.ml" ]
|
|
in
|
|
match compile ~sanitize:true ~checks:false "programs/bounds.flan" with
|
|
| exception Failure m -> fail "unchecked bounds.flan: build: %s" m
|
|
| exe ->
|
|
List.iter
|
|
(fun a ->
|
|
let _, t = run exe [ a ] in
|
|
if not (reported t) then
|
|
fail "unchecked bounds.flan %s: nothing reported, and this is the \
|
|
case that says ASan sees an unchecked build at all\n%s" a t)
|
|
reports;
|
|
List.iter
|
|
(fun (a, why) ->
|
|
let _, t = run exe [ a ] in
|
|
if reported t then
|
|
Printf.printf
|
|
"note unchecked bounds.flan %s now reports; it did not, on the \
|
|
grounds that %s\n" a why
|
|
else
|
|
Printf.printf "note unchecked bounds.flan %s: silent — %s\n" a why)
|
|
silent;
|
|
(try Sys.remove exe with Sys_error _ -> ())
|
|
|
|
let () =
|
|
match Sys.command "command -v clang > /dev/null 2>&1" with
|
|
| 0 ->
|
|
(* A read one past the end of a four-element global. Index 5 and not 9,
|
|
and the difference is worth knowing: ASan registers this array as
|
|
"16 bytes in a 32-byte slot", so the poisoned redzone is bytes 16..31.
|
|
Index 5 is byte 20 and is caught; index 9 is byte 36, past the
|
|
registration entirely, and is silent. Overrunning a small object by
|
|
enough lands back in ordinary memory. *)
|
|
control ~expect_report:true "flan-san-ctl-oob"
|
|
~why:"This sweep is not instrumenting Flan code at all — check that \
|
|
Emit still puts every define in the sanitize_address attribute \
|
|
group, without which -fsanitize=address covers the runtime's C \
|
|
and nothing else."
|
|
"(defonce arr [4 i32])\n\
|
|
(defn main [] i32\n\
|
|
\ (set (at arr 0) 1)\n\
|
|
\ (let [i 5] (print (at arr i)) (println \"\"))\n\
|
|
\ 0)\n";
|
|
(* Shift by the full width of the type: undefined in C, poison in LLVM,
|
|
and invisible to UBSan here because nothing emitted a check for it. If
|
|
this ever starts reporting, the note above is stale. *)
|
|
control ~expect_report:false "flan-san-ctl-shift"
|
|
~why:"UBSan has started seeing Flan code, which contradicts what this \
|
|
file and Build.opts both say it reaches. Good news; rewrite them."
|
|
"(defn main [] i32\n\
|
|
\ (let [x 1] (let [n 32] (print (<< x n)) (println \"\")))\n\
|
|
\ 0)\n";
|
|
(* A regression case, and the one defect this exercise found: a slice's
|
|
length is signed, (slice s 2 1) is -1, and flan_bytes_to_i64 cast that
|
|
to size_t before comparing it against its buffer — so the memcpy copied
|
|
63 bytes out of whatever the slice pointed at. Every other (ptr, len)
|
|
entry point in the runtime already guarded the negative case; these two
|
|
were the exceptions. A checked build traps on the reversed slice long
|
|
before this, which is why it needs an unchecked build to show. *)
|
|
control ~expect_report:false ~args:[ "2" ] "flan-san-ctl-negslice"
|
|
~why:"flan_bytes_to_i64 or flan_bytes_to_f64 is reading off the end of \
|
|
a negative-length slice again — see clamp_len in flan_rt.c."
|
|
"(defn main [args [string]] i32\n\
|
|
\ (let [s (bytes-view \"42\")\n\
|
|
\ n (i32 (bytes->i64 (bytes-view (at args 1))))]\n\
|
|
\ (print (bytes->i64 (slice s n 1)))\n\
|
|
\ (println \"\"))\n\
|
|
\ 0)\n";
|
|
sweep ~checks:true "checked";
|
|
dyn_sweep ();
|
|
dev_sweep ();
|
|
dev_segv ();
|
|
unchecked_controls ();
|
|
if !failures = 0 then print_endline "sanitizer sweep: clean"
|
|
else Printf.printf "%d sanitizer failure(s)\n" !failures;
|
|
exit (if !failures = 0 then 0 else 1)
|
|
| _ ->
|
|
print_endline "no clang on PATH; sanitizer sweep skipped"
|