From 123334881a82a75f52171a911ba38fb7ffb0afb1 Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Tue, 2 Apr 2019 01:29:27 +0200 Subject: [PATCH] Harden ocamltest against errors in scripts and hooks --- ocamltest/.depend | 33 +++++++++++++++-------------- ocamltest/Makefile | 2 +- ocamltest/actions_helpers.ml | 29 +++++++++++++++++++------ ocamltest/environments.ml | 41 ++++++++++-------------------------- ocamltest/tsl_lexer.mli | 2 ++ ocamltest/tsl_lexer.mll | 14 +++++++++++- 6 files changed, 67 insertions(+), 54 deletions(-) diff --git a/ocamltest/.depend b/ocamltest/.depend index 23023bef9..e730c76ae 100644 --- a/ocamltest/.depend +++ b/ocamltest/.depend @@ -1,22 +1,21 @@ run_unix.$(O): run_unix.c run.h ../runtime/caml/misc.h \ - ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \ - run_common.h + ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \ + run_common.h run_stubs.$(O): run_stubs.c run.h ../runtime/caml/misc.h \ - ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \ - ../runtime/caml/mlvalues.h ../runtime/caml/misc.h \ - ../runtime/caml/memory.h ../runtime/caml/gc.h ../runtime/caml/mlvalues.h \ - ../runtime/caml/major_gc.h ../runtime/caml/freelist.h \ - ../runtime/caml/minor_gc.h ../runtime/caml/address_class.h \ - ../runtime/caml/io.h ../runtime/caml/osdeps.h ../runtime/caml/memory.h + ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \ + ../runtime/caml/mlvalues.h ../runtime/caml/memory.h \ + ../runtime/caml/gc.h ../runtime/caml/major_gc.h \ + ../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \ + ../runtime/caml/address_class.h ../runtime/caml/io.h \ + ../runtime/caml/osdeps.h ocamltest_stdlib_stubs.$(O): ocamltest_stdlib_stubs.c \ - ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \ - ../runtime/caml/mlvalues.h ../runtime/caml/config.h \ - ../runtime/caml/misc.h ../runtime/caml/memory.h ../runtime/caml/gc.h \ - ../runtime/caml/mlvalues.h ../runtime/caml/major_gc.h \ - ../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \ - ../runtime/caml/address_class.h ../runtime/caml/alloc.h \ - ../runtime/caml/signals.h ../runtime/caml/osdeps.h \ - ../runtime/caml/memory.h + ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \ + ../runtime/caml/mlvalues.h ../runtime/caml/misc.h \ + ../runtime/caml/memory.h ../runtime/caml/gc.h \ + ../runtime/caml/major_gc.h ../runtime/caml/freelist.h \ + ../runtime/caml/minor_gc.h ../runtime/caml/address_class.h \ + ../runtime/caml/alloc.h ../runtime/caml/signals.h \ + ../runtime/caml/osdeps.h actions.cmo : \ result.cmi \ environments.cmi \ @@ -83,10 +82,12 @@ builtin_variables.cmi : \ variables.cmi environments.cmo : \ variables.cmi \ + tsl_lexer.cmi \ ocamltest_stdlib.cmi \ environments.cmi environments.cmx : \ variables.cmx \ + tsl_lexer.cmx \ ocamltest_stdlib.cmx \ environments.cmi environments.cmi : \ diff --git a/ocamltest/Makefile b/ocamltest/Makefile index 64e8a3a00..1c0067aa5 100644 --- a/ocamltest/Makefile +++ b/ocamltest/Makefile @@ -96,13 +96,13 @@ core := \ run_command.mli run_command.ml \ filecompare.mli filecompare.ml \ variables.mli variables.ml \ - environments.mli environments.ml \ result.mli result.ml \ actions.mli actions.ml \ tests.mli tests.ml \ tsl_ast.mli tsl_ast.ml \ tsl_parser.mly \ tsl_lexer.mli tsl_lexer.mll \ + environments.mli environments.ml \ tsl_semantics.mli tsl_semantics.ml \ builtin_variables.mli builtin_variables.ml \ actions_helpers.mli actions_helpers.ml \ diff --git a/ocamltest/actions_helpers.ml b/ocamltest/actions_helpers.ml index 2c5c62081..210b2f256 100644 --- a/ocamltest/actions_helpers.ml +++ b/ocamltest/actions_helpers.ml @@ -205,9 +205,17 @@ let run_script log env = log scriptenv in let final_value = if Result.is_pass result then begin - let modifiers = Environments.modifiers_of_file response_file in - let modified_env = Environments.apply_modifiers newenv modifiers in - (result, modified_env) + match Environments.modifiers_of_file response_file with + | modifiers -> + let modified_env = Environments.apply_modifiers newenv modifiers in + (result, modified_env) + | exception Failure reason -> + (Result.fail_with_reason reason, newenv) + | exception Variables.No_such_variable name -> + let reason = + Printf.sprintf "error in script response: unknown variable %s" name + in + (Result.fail_with_reason reason, newenv) end else begin let reason = String.trim (Sys.string_of_file response_file) in let newresult = { result with Result.reason = Some reason } in @@ -240,9 +248,18 @@ let run_hook hook_name log input_env = } in let exit_status = run settings in let final_value = match exit_status with | 0 -> - let modifiers = Environments.modifiers_of_file response_file in - let modified_env = Environments.apply_modifiers hookenv modifiers in - (Result.pass, modified_env) + begin match Environments.modifiers_of_file response_file with + | modifiers -> + let modified_env = Environments.apply_modifiers hookenv modifiers in + (Result.pass, modified_env) + | exception Failure reason -> + (Result.fail_with_reason reason, hookenv) + | exception Variables.No_such_variable name -> + let reason = + Printf.sprintf "error in script response: unknown variable %s" name + in + (Result.fail_with_reason reason, hookenv) + end | _ -> Printf.fprintf log "Hook returned %d" exit_status; let reason = String.trim (Sys.string_of_file response_file) in diff --git a/ocamltest/environments.ml b/ocamltest/environments.ml index 17338682c..cac5e21ff 100644 --- a/ocamltest/environments.ml +++ b/ocamltest/environments.ml @@ -144,36 +144,17 @@ and apply_modifiers environment modifiers = List.fold_left apply_modifier environment modifiers let modifier_of_string str = - let invalid_argument = (Invalid_argument "modifier_of_string") in - if str="" then raise invalid_argument else begin - let l = String.length str in - if str.[0] = '-' then begin - let variable_name = String.sub str 1 (l-1) in - match Variables.find_variable variable_name with - | None -> raise (Variables.No_such_variable variable_name) - | Some variable -> Remove variable - end else begin match String.index_opt str '=' with - | None -> raise invalid_argument - | Some pos_eq -> if pos_eq <= 0 then raise invalid_argument else - let (append, varname_length) = - (match String.index_opt str '+' with - | None -> (false, pos_eq) - | Some pos_plus -> - if pos_plus = pos_eq-1 - then (true, pos_plus) - else raise invalid_argument) in - let variable_name = String.sub str 0 varname_length in - match Variables.find_variable variable_name with - | None -> raise (Variables.No_such_variable variable_name) - | Some variable -> - if pos_eq >= l-2 || str.[pos_eq+1]<>'"' || str.[l-1]<>'"' - then raise invalid_argument - else let value_length = l - pos_eq - 3 in - let value = String.sub str (pos_eq+2) value_length in - if append then Append (variable, value) - else Add (variable, value) - end - end + let lexbuf = Lexing.from_string str in + let variable_name, result = Tsl_lexer.modifier lexbuf in + let variable = + match Variables.find_variable variable_name with + | None -> raise (Variables.No_such_variable variable_name) + | Some variable -> variable + in + match result with + | `Remove -> Remove variable + | `Add value -> Add (variable, value) + | `Append value -> Append (variable, value) let modifiers_of_file filename = let ic = open_in filename in diff --git a/ocamltest/tsl_lexer.mli b/ocamltest/tsl_lexer.mli index a92ad67b9..b25e9f856 100644 --- a/ocamltest/tsl_lexer.mli +++ b/ocamltest/tsl_lexer.mli @@ -16,3 +16,5 @@ (* Interface to the Tsl_lexer module *) val token : Lexing.lexbuf -> Tsl_parser.token +val modifier : + Lexing.lexbuf -> string * [`Remove | `Add of string | `Append of string] diff --git a/ocamltest/tsl_lexer.mll b/ocamltest/tsl_lexer.mll index 0d9845df7..90a308364 100644 --- a/ocamltest/tsl_lexer.mll +++ b/ocamltest/tsl_lexer.mll @@ -13,7 +13,8 @@ (* *) (**************************************************************************) -(* Lexer definitions for the Tests Specification Language *) +(* Lexer definitions for the Tests Specification Language and for + response files *) { open Tsl_parser @@ -114,3 +115,14 @@ and comment = parse { comment lexbuf } + +(* Parse one line of a response file (for scripts and hooks) *) +and modifier = parse + | '-' (identchar* as variable) + { variable, `Remove } + | (identchar* as variable) "=\"" (_* as str) '"' + { variable, `Add str } + | (identchar* as variable) "+=\"" (_* as str) '"' + { variable, `Append str } + | _ + { failwith "syntax error in script response file" }