Guard the whole embed read, not only the open
On Linux open_in_bin on a directory succeeds and in_channel_length answers a number; the read is where EISDIR arrives. Guarding only the open turned (embed "assets") — someone who meant embed-dir — into an uncaught OCaml exception out of the checker, which is the one way a user could make the compiler crash rather than refuse. It now says it is a directory and names the form that embeds one. Same class, same function family: read_embed_dir tested is_directory before file_exists, and Sys.is_directory raises on a path that does not resolve, so a dangling symlink inside an embedded directory crashed before the existence test ran. The conjuncts are swapped. slurp.flan gets its dev build, and the compiler-emitted use-value gets the same unarmed-restart assertion the hand-written one has. It is the first clause the compiler emits with a parameter — alloc_guard's retry takes none — so it is worth saying it rides emit.ml's existing path rather than sitting beside it. flan_file_read loses its declare: nothing Flan emits calls it, only flan_slurp_into does, from C. That takes the edit to emit.ml down to four declare lines and a comment.
This commit is contained in:
parent
9ab247badf
commit
2a5632bca1
13
BUILT.md
13
BUILT.md
@ -1570,6 +1570,19 @@ and the loop re-attempts against the new path. Everything is inside that loop, s
|
|||||||
re-measures it and re-allocates for *its* size; the `Vec` is freed at the top of each turn, which is why a retry does
|
re-measures it and re-allocates for *its* size; the `Vec` is freed at the top of each turn, which is why a retry does
|
||||||
not leak, and freeing a `Vec` that never allocated is a no-op.
|
not leak, and freeing a `Vec` that never allocated is a no-op.
|
||||||
|
|
||||||
|
**The two forms resolve paths by opposite rules, and it is worth saying in one place.** An `embed` path is resolved at
|
||||||
|
*compile* time relative to the file the form is written in. A `slurp` or `barf` path is resolved at *run* time by the
|
||||||
|
host, against the process's working directory — these are ordinary values, and one can arrive from `argv` or from a
|
||||||
|
`use-value` restart. `test/programs/slurp.flan` reads `"programs/assets/a.txt"` only because the suite runs from
|
||||||
|
`_build/default/test`. Two forms in one section with opposite rules is exactly where someone gets bitten.
|
||||||
|
|
||||||
|
**The break loop can be offered this restart and cannot fill it in.** That is not new behaviour, only a new way to
|
||||||
|
reach it: a break loop chooses a restart by position and has nothing to supply a parameter with, and emit.ml already
|
||||||
|
emits a `flan_restart_unarmed` guard on every clause that takes one, so taking it refuses with the reason rather than
|
||||||
|
running the clause on a zeroed buffer. `slurp`'s `use-value` is simply the first such clause the *compiler* emits —
|
||||||
|
`alloc_guard`'s `retry` takes no parameters — and it rides the same path a hand-written one does. The acceptance suite
|
||||||
|
asserts the guard is on the emitted IR for both.
|
||||||
|
|
||||||
**On the web, `barf` signals — every time, with the path in the condition.** This is the decision worth restating,
|
**On the web, `barf` signals — every time, with the path in the condition.** This is the decision worth restating,
|
||||||
because two more obvious answers are both wrong here. A **build-time refusal** is unusable: Flan has *no conditional
|
because two more obvious answers are both wrong here. A **build-time refusal** is unusable: Flan has *no conditional
|
||||||
compilation*, nothing in `parse.ml` or `check.ml` reads the target, so "isolate this to desktop" is not expressible in
|
compilation*, nothing in `parse.ml` or `check.ml` reads the target, so "isolate this to desktop" is not expressible in
|
||||||
|
|||||||
36
lib/check.ml
36
lib/check.ml
@ -389,14 +389,29 @@ let embed_path loc (p : Ast.expr) =
|
|||||||
"an embedded path must be a literal string — the bytes are read at \
|
"an embedded path must be a literal string — the bytes are read at \
|
||||||
compile time, so there is nothing here to compute it from"
|
compile time, so there is nothing here to compute it from"
|
||||||
|
|
||||||
|
(* The whole read is guarded, not only the open. On Linux [open_in_bin] on a
|
||||||
|
*directory* succeeds and [in_channel_length] answers a number; the read is
|
||||||
|
where EISDIR arrives. Guarding only the open therefore turned (embed "dir")
|
||||||
|
— someone who meant embed-dir — into an uncaught OCaml exception out of the
|
||||||
|
checker, which is the one way a user can make the compiler crash rather than
|
||||||
|
refuse. *)
|
||||||
let read_embed_file path loc =
|
let read_embed_file path loc =
|
||||||
match open_in_bin path with
|
match
|
||||||
| exception Sys_error msg -> Loc.fail loc "cannot embed %s: %s" path msg
|
let ch = open_in_bin path in
|
||||||
| ch ->
|
Fun.protect ~finally:(fun () -> close_in_noerr ch)
|
||||||
let n = in_channel_length ch in
|
(fun () -> really_input_string ch (in_channel_length ch))
|
||||||
let s = really_input_string ch n in
|
with
|
||||||
close_in ch;
|
| s -> s
|
||||||
s
|
| exception Sys_error msg ->
|
||||||
|
if Sys.file_exists path && (try Sys.is_directory path with Sys_error _ -> false)
|
||||||
|
then
|
||||||
|
Loc.fail loc
|
||||||
|
"cannot embed %s: it is a directory — (embed-dir \"...\") embeds one \
|
||||||
|
of those, as a [n EmbedFile]"
|
||||||
|
path
|
||||||
|
else Loc.fail loc "cannot embed %s: %s" path msg
|
||||||
|
| exception End_of_file ->
|
||||||
|
Loc.fail loc "cannot embed %s: it changed size while being read" path
|
||||||
|
|
||||||
(* Non-recursive, files only, sorted by name — the three things Odin's
|
(* Non-recursive, files only, sorted by name — the three things Odin's
|
||||||
#load_directory settles, and the sort is the one that matters most here:
|
#load_directory settles, and the sort is the one that matters most here:
|
||||||
@ -408,11 +423,16 @@ let read_embed_dir path loc =
|
|||||||
| exception Sys_error msg -> Loc.fail loc "cannot embed %s: %s" path msg
|
| exception Sys_error msg -> Loc.fail loc "cannot embed %s: %s" path msg
|
||||||
| a -> Array.to_list a
|
| a -> Array.to_list a
|
||||||
in
|
in
|
||||||
|
(* [Sys.is_directory] *raises* on a path that does not resolve, so the
|
||||||
|
existence test has to come first: a dangling symlink in an embedded
|
||||||
|
directory would otherwise crash the compiler before it was ever asked
|
||||||
|
about. Non-recursive and files only, which is Odin's rule too. *)
|
||||||
let files =
|
let files =
|
||||||
List.filter
|
List.filter
|
||||||
(fun n ->
|
(fun n ->
|
||||||
let full = Filename.concat path n in
|
let full = Filename.concat path n in
|
||||||
(not (Sys.is_directory full)) && Sys.file_exists full)
|
Sys.file_exists full
|
||||||
|
&& not (try Sys.is_directory full with Sys_error _ -> true))
|
||||||
names
|
names
|
||||||
in
|
in
|
||||||
List.map
|
List.map
|
||||||
|
|||||||
@ -1819,11 +1819,11 @@ declare i64 @flan_vec_len(ptr, ptr, i64)
|
|||||||
declare ptr @flan_vec_at(ptr, i32, i64, ptr, i64)
|
declare ptr @flan_vec_at(ptr, i32, i64, ptr, i64)
|
||||||
declare void @flan_vec_as_slice(ptr, ptr, i32, i32, i64, ptr, i64)
|
declare void @flan_vec_as_slice(ptr, ptr, i32, i32, i64, ptr, i64)
|
||||||
declare void @flan_vec_free(ptr, i64, i64, ptr, i64)
|
declare void @flan_vec_free(ptr, i64, i64, ptr, i64)
|
||||||
; The filesystem. Three host calls plus one reason reader, and flan_slurp_into
|
; The filesystem. flan_file_read is not here: nothing Flan emits calls it —
|
||||||
; is runtime glue rather than a fourth — see flan_rt.c for why the widening
|
; only flan_slurp_into does, from C — and flan_slurp_into is runtime glue
|
||||||
; stops here. `embed` needs none of these: it is a compile-time constant.
|
; rather than a fourth host call. See flan_rt.c for why the widening stops
|
||||||
|
; here. `embed` needs none of these: it is a compile-time constant.
|
||||||
declare i8 @flan_file_size(ptr, i64, ptr)
|
declare i8 @flan_file_size(ptr, i64, ptr)
|
||||||
declare i8 @flan_file_read(ptr, i64, ptr, i64, ptr)
|
|
||||||
declare i8 @flan_file_write(ptr, i64, ptr, i64)
|
declare i8 @flan_file_write(ptr, i64, ptr, i64)
|
||||||
declare i64 @flan_file_fail_reason()
|
declare i64 @flan_file_fail_reason()
|
||||||
declare i8 @flan_slurp_into(ptr, ptr, i64)
|
declare i8 @flan_slurp_into(ptr, ptr, i64)
|
||||||
|
|||||||
@ -373,6 +373,14 @@ let () =
|
|||||||
refuses_src "an embedded file that does not exist"
|
refuses_src "an embedded file that does not exist"
|
||||||
"(defn main [] i32 (len (embed \"no-such-asset.bin\")))"
|
"(defn main [] i32 (len (embed \"no-such-asset.bin\")))"
|
||||||
"cannot embed";
|
"cannot embed";
|
||||||
|
(* A directory where a file was meant. On Linux open_in_bin on a directory
|
||||||
|
succeeds and the *read* is where EISDIR arrives, so this was an uncaught
|
||||||
|
exception out of the checker until the whole read was guarded - the one
|
||||||
|
way a user could make the compiler crash rather than refuse. *)
|
||||||
|
refuses_src "embed given a directory"
|
||||||
|
"(defn main [] i32 (len (embed \"programs/assets\")))"
|
||||||
|
"it is a directory";
|
||||||
|
|
||||||
(* One extra argument, and `string` is the only thing it can be. Two
|
(* One extra argument, and `string` is the only thing it can be. Two
|
||||||
spellings, not one form that changes type with its context. *)
|
spellings, not one form that changes type with its context. *)
|
||||||
refuses_src "embed asked for a type it cannot read a file as"
|
refuses_src "embed asked for a type it cannot read a file as"
|
||||||
@ -506,6 +514,24 @@ let () =
|
|||||||
clean ();
|
clean ();
|
||||||
outputs ~opt:"-O0" "slurp and barf, -O0" "programs/slurp.flan" slurp_out;
|
outputs ~opt:"-O0" "slurp and barf, -O0" "programs/slurp.flan" slurp_out;
|
||||||
clean ();
|
clean ();
|
||||||
|
outputs ~dev:true "slurp and barf, dev" "programs/slurp.flan" slurp_out;
|
||||||
|
clean ();
|
||||||
|
|
||||||
|
(* slurp's use-value is the first restart clause the *compiler* emits with
|
||||||
|
a parameter - alloc_guard's retry takes none - so the guard against the
|
||||||
|
break loop taking it with nothing to fill the parameter in with is worth
|
||||||
|
asserting here too. It is the same emit.ml path a hand-written typed
|
||||||
|
clause goes through (the restarts.flan case above), and this says the
|
||||||
|
compiler-emitted one is on it rather than beside it. *)
|
||||||
|
let p =
|
||||||
|
Reader.read_file "programs/slurp.flan" |> Parse.program |> Check.program
|
||||||
|
in
|
||||||
|
if not (contains (Emit.program p) "call void @flan_restart_unarmed(") then begin
|
||||||
|
incr failures;
|
||||||
|
print_endline
|
||||||
|
"FAIL the compiler-emitted use-value has no guard against being taken \
|
||||||
|
without an argument"
|
||||||
|
end;
|
||||||
|
|
||||||
(* The desktop half of the one program whose behaviour differs by target.
|
(* The desktop half of the one program whose behaviour differs by target.
|
||||||
test_web.ml builds this same text for the browser and asserts the other
|
test_web.ml builds this same text for the browser and asserts the other
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user