From cfd7bafca91acef9d4b29d84e846a0bfe73796e8 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 30 Oct 2019 16:04:51 +0900 Subject: [PATCH 1/2] [stdune] add scanf module This is a slightly safer version that only catches 2 exceptions that scanf throws Signed-off-by: Rudi Grinberg --- src/dune/build.ml | 8 +++++++- src/dune/context.ml | 5 +++-- src/dune/dune_load.ml | 4 ++-- src/dune_lang/syntax.ml | 5 +++-- src/ocaml-config/ocaml_config.ml | 16 +++++++++++----- src/stdune/caml/dune_caml.ml | 1 + src/stdune/scanf.ml | 12 ++++++++++++ src/stdune/scanf.mli | 16 ++++++++++++++++ src/stdune/stdune.ml | 1 + 9 files changed, 56 insertions(+), 12 deletions(-) create mode 100644 src/stdune/scanf.ml create mode 100644 src/stdune/scanf.mli diff --git a/src/dune/build.ml b/src/dune/build.ml index 7510f5ed079..4a2be900185 100644 --- a/src/dune/build.ml +++ b/src/dune/build.ml @@ -118,7 +118,13 @@ let contents p = Contents p let lines_of p = Lines_of p -let strings p = Map ((fun l -> List.map l ~f:Scanf.unescaped), lines_of p) +let strings p = + let f x = + match Scanf.unescaped x with + | Error () -> Code_error.raise "Build.strings" [] + | Ok s -> s + in + Map ((fun l -> List.map l ~f), lines_of p) let read_sexp p = let+ s = contents p in diff --git a/src/dune/context.ml b/src/dune/context.ml index 22ab1a984e0..49d3821df46 100644 --- a/src/dune/context.ml +++ b/src/dune/context.ml @@ -626,8 +626,9 @@ let opam_version = let+ version = Process.run_capture_line Strict ~env opam [ "--version" ] in - try Scanf.sscanf version "%d.%d.%d" (fun a b c -> (a, b, c)) - with _ -> + match Scanf.sscanf version "%d.%d.%d" (fun a b c -> (a, b, c)) with + | Ok s -> s + | Error () -> User_error.raise [ Pp.textf "`%s config --version' returned invalid output:" (Path.to_string_maybe_quoted opam) diff --git a/src/dune/dune_load.ml b/src/dune/dune_load.ml index 70729297e07..b325d3971cd 100644 --- a/src/dune/dune_load.ml +++ b/src/dune/dune_load.ml @@ -55,8 +55,8 @@ module Dune_files = struct let check_no_requires path str = List.iteri (String.split str ~on:'\n') ~f:(fun n line -> match Scanf.sscanf line "#require %S" (fun x -> x) with - | exception _ -> () - | (_ : string) -> + | Error () -> () + | Ok (_ : string) -> let loc : Loc.t = let start : Lexing.position = { pos_fname = Path.to_string path diff --git a/src/dune_lang/syntax.ml b/src/dune_lang/syntax.ml index 1a515230f5e..600be43d8f6 100644 --- a/src/dune_lang/syntax.ml +++ b/src/dune_lang/syntax.ml @@ -32,8 +32,9 @@ module Version = struct raw >>| function | Atom (loc, A s) -> ( - try Scanf.sscanf s "%u.%u" (fun a b -> (a, b)) - with _ -> + match Scanf.sscanf s "%u.%u" (fun a b -> (a, b)) with + | Ok s -> s + | Error () -> User_error.raise ~loc [ Pp.text "Atom of the form NNN.NNN expected" ] ) | sexp -> User_error.raise ~loc:(Ast.loc sexp) [ Pp.text "Atom expected" ] diff --git a/src/ocaml-config/ocaml_config.ml b/src/ocaml-config/ocaml_config.ml index 536a739b4f2..ea86867b71a 100644 --- a/src/ocaml-config/ocaml_config.ml +++ b/src/ocaml-config/ocaml_config.ml @@ -377,7 +377,15 @@ let make vars = in let version_string = get vars "version" in let version = - Scanf.sscanf version_string "%u.%u.%u" (fun a b c -> (a, b, c)) + match + Scanf.sscanf version_string "%u.%u.%u" (fun a b c -> (a, b, c)) + with + | Ok t -> t + | Error () -> + User_error.raise + [ Pp.textf "Unable to parse ocamlc -config version: %s" + version_string + ] in let os_type = get vars "os_type" in let standard_library_default = get vars "standard_library_default" in @@ -512,7 +520,5 @@ let make vars = | exception Vars.E (origin, msg) -> Error (origin, msg) let is_dev_version t = - try - Scanf.sscanf t.version_string "%u.%u.%u+dev" (fun _ _ _ -> ()); - true - with _ -> false + Scanf.sscanf t.version_string "%u.%u.%u+dev" (fun _ _ _ -> ()) + |> Result.is_ok diff --git a/src/stdune/caml/dune_caml.ml b/src/stdune/caml/dune_caml.ml index 5692b37287a..4f822abeddc 100644 --- a/src/stdune/caml/dune_caml.ml +++ b/src/stdune/caml/dune_caml.ml @@ -12,3 +12,4 @@ module ListLabels = ListLabels module List = List module MoreLabels = MoreLabels module ArrayLabels = ArrayLabels +module Scanf = Scanf diff --git a/src/stdune/scanf.ml b/src/stdune/scanf.ml new file mode 100644 index 00000000000..edca00fcb10 --- /dev/null +++ b/src/stdune/scanf.ml @@ -0,0 +1,12 @@ +module Scanf = Dune_caml.Scanf + +let unescaped x = + match Scanf.unescaped x with + | exception Scanf.Scan_failure _ -> Error () + | x -> Ok x + +exception E +let sscanf x fmt f = + match Scanf.ksscanf x (fun _ _ -> raise_notrace E) fmt f with + | exception E -> Error () + | x -> Ok x diff --git a/src/stdune/scanf.mli b/src/stdune/scanf.mli new file mode 100644 index 00000000000..91d55ec6fde --- /dev/null +++ b/src/stdune/scanf.mli @@ -0,0 +1,16 @@ +(** Safe version of Scanf from the stdlib. Does not raise parsing errors + errors. *) + +val unescaped : string -> (string, unit) Result.t + +val sscanf : + string + -> ( 'a + , Dune_caml.Scanf.Scanning.in_channel + , 'b + , 'c -> 'd + , 'a -> 'e + , 'e ) + format6 + -> 'c + -> ('d, unit) result diff --git a/src/stdune/stdune.ml b/src/stdune/stdune.ml index cc25e9c53aa..75b0597e32e 100644 --- a/src/stdune/stdune.ml +++ b/src/stdune/stdune.ml @@ -58,6 +58,7 @@ module User_error = User_error module User_message = User_message module User_warning = User_warning module Lexbuf = Lexbuf +module Scanf = Scanf (* Pervasives is deprecated in 4.08 in favor of Stdlib, however we are currently compatible with OCaml >= 4.02 so for now we simply disable the From 38f6bdde748007fd5a94ef0f785e47593404a4d3 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 30 Oct 2019 22:59:49 +0900 Subject: [PATCH 2/2] Make Build.strings raise user error Signed-off-by: Rudi Grinberg --- src/dune/build.ml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/dune/build.ml b/src/dune/build.ml index 4a2be900185..f267d0ccf16 100644 --- a/src/dune/build.ml +++ b/src/dune/build.ml @@ -121,7 +121,13 @@ let lines_of p = Lines_of p let strings p = let f x = match Scanf.unescaped x with - | Error () -> Code_error.raise "Build.strings" [] + | Error () -> + User_error.raise + [ Pp.textf "Unable to parse %s" (Path.to_string_maybe_quoted p) + ; Pp.textf + "This file must be a list of lines escaped using OCaml's \ + conventions" + ] | Ok s -> s in Map ((fun l -> List.map l ~f), lines_of p)