diff --git a/.gitignore b/.gitignore index 0ffedcf24..466edf57b 100644 --- a/.gitignore +++ b/.gitignore @@ -118,6 +118,7 @@ _build /ocamltest/ocamltest /ocamltest/ocamltest.opt /ocamltest/ocamltest_config.ml +/ocamltest/ocamltest_unix.ml /ocamltest/tsl_lexer.ml /ocamltest/tsl_parser.ml /ocamltest/tsl_parser.mli diff --git a/Makefile b/Makefile index 5834f965d..aa7634bd9 100644 --- a/Makefile +++ b/Makefile @@ -867,7 +867,7 @@ ocamldoc.opt: ocamlc.opt ocamlyacc ocamllex $(MAKE) -C ocamldoc opt.opt # OCamltest -ocamltest: ocamlc ocamlyacc ocamllex +ocamltest: ocamlc ocamlyacc ocamllex otherlibraries $(MAKE) -C ocamltest all ocamltest.opt: ocamlc.opt ocamlyacc ocamllex diff --git a/ocamltest/.depend b/ocamltest/.depend index 1ef3922a8..83262d556 100644 --- a/ocamltest/.depend +++ b/ocamltest/.depend @@ -346,12 +346,20 @@ ocamltest_config.cmx : \ ocamltest_config.cmi ocamltest_config.cmi : ocamltest_stdlib.cmo : \ + ocamltest_unix.cmi \ ocamltest_config.cmi \ ocamltest_stdlib.cmi ocamltest_stdlib.cmx : \ + ocamltest_unix.cmx \ ocamltest_config.cmx \ ocamltest_stdlib.cmi -ocamltest_stdlib.cmi : +ocamltest_stdlib.cmi : \ + ocamltest_unix.cmi +ocamltest_unix.cmo : \ + ocamltest_unix.cmi +ocamltest_unix.cmx : \ + ocamltest_unix.cmi +ocamltest_unix.cmi : options.cmo : \ variables.cmi \ tests.cmi \ diff --git a/ocamltest/Makefile b/ocamltest/Makefile index c803bb7ae..ec1ac4cbd 100644 --- a/ocamltest/Makefile +++ b/ocamltest/Makefile @@ -33,8 +33,16 @@ else endif ifeq "$(filter $(UNIXLIB),$(OTHERLIBRARIES))" "" + ocamltest_unix := dummy + unix_name := + unix_path := unix := None + unix_include := else + ocamltest_unix := real + unix_name := unix + unix_path := $(ROOTDIR)/otherlibs/$(UNIXLIB) + unix_include := -I $(unix_path) $(EMPTY) ifeq "$(UNIX_OR_WIN32)" "win32" unix := Some false else @@ -97,8 +105,8 @@ endif core := \ $(run_source) run_stubs.c \ - ocamltest_stdlib_stubs.c \ ocamltest_config.mli ocamltest_config.ml.in \ + ocamltest_unix.mli ocamltest_unix.ml \ ocamltest_stdlib.mli ocamltest_stdlib.ml \ run_command.mli run_command.ml \ filecompare.mli filecompare.ml \ @@ -166,6 +174,7 @@ parsers := $(filter %.mly,$(sources)) config_files := $(filter %.ml.in,$(sources)) dependencies_generated_prereqs := \ + ocamltest_unix.ml \ $(config_files:.ml.in=.ml) \ $(lexers:.mll=.ml) \ $(parsers:.mly=.mli) $(parsers:.mly=.ml) @@ -185,9 +194,9 @@ flags := -g -nostdlib $(include_directories) \ -strict-sequence -safe-string -strict-formats \ -w +a-4-9-41-42-44-45-48 -warn-error A -ocamlc := $(BEST_OCAMLC) $(flags) +ocamlc = $(BEST_OCAMLC) $(flags) -ocamlopt := $(BEST_OCAMLOPT) $(flags) +ocamlopt = $(BEST_OCAMLOPT) $(flags) ocamldep := $(BEST_OCAMLDEP) depflags := -slash @@ -210,26 +219,29 @@ opt.opt: allopt compdeps_names=ocamlcommon ocamlbytecomp compdeps_paths=$(addprefix $(ROOTDIR)/compilerlibs/,$(compdeps_names)) -compdeps_byte=$(addsuffix .cma,$(compdeps_paths)) -compdeps_opt=$(addsuffix .cmxa,$(compdeps_paths)) +deps_paths=$(compdeps_paths) $(addprefix $(unix_path)/,$(unix_name)) +deps_byte=$(addsuffix .cma,$(deps_paths)) +deps_opt=$(addsuffix .cmxa,$(deps_paths)) $(eval $(call PROGRAM_SYNONYM,ocamltest)) -ocamltest$(EXE): $(compdeps_byte) $(bytecode_modules) - $(ocamlc_cmd) -custom -o $@ $^ +ocamltest_unix.%: flags+=$(unix_include) -opaque -%.cmo: %.ml $(compdeps_byte) +ocamltest$(EXE): $(deps_byte) $(bytecode_modules) + $(ocamlc_cmd) $(unix_include)-custom -o $@ $^ + +%.cmo: %.ml $(deps_byte) $(ocamlc) -c $< $(eval $(call PROGRAM_SYNONYM,ocamltest.opt)) -ocamltest.opt$(EXE): $(compdeps_opt) $(native_modules) - $(ocamlopt_cmd) -o $@ $^ +ocamltest.opt$(EXE): $(deps_opt) $(native_modules) + $(ocamlopt_cmd) $(unix_include)-o $@ $^ -%.cmx: %.ml $(compdeps_opt) +%.cmx: %.ml $(deps_opt) $(ocamlopt) -c $< -%.cmi: %.mli $(compdeps_byte) +%.cmi: %.mli $(deps_byte) $(ocamlc) -c $< %.ml %.mli: %.mly @@ -238,6 +250,10 @@ ocamltest.opt$(EXE): $(compdeps_opt) $(native_modules) %.ml: %.mll $(ocamllex) $(OCAMLLEX_FLAGS) $< +ocamltest_unix.ml: ocamltest_unix_$(ocamltest_unix).ml + echo '# 1 "$^"' > $@ + cat $^ >> $@ + ocamltest_config.ml: ocamltest_config.ml.in Makefile ../Makefile.config sed $(call SUBST,AFL_INSTRUMENT) \ $(call SUBST,RUNTIMEI) \ diff --git a/ocamltest/builtin_actions.ml b/ocamltest/builtin_actions.ml index 2965b52bc..4baf788be 100644 --- a/ocamltest/builtin_actions.ml +++ b/ocamltest/builtin_actions.ml @@ -195,7 +195,7 @@ let naked_pointers = make let has_symlink = make "has_symlink" - (Actions_helpers.pass_or_skip (Sys.has_symlink () ) + (Actions_helpers.pass_or_skip (Unix.has_symlink () ) "symlinks available" "symlinks not available") diff --git a/ocamltest/ocamltest_stdlib.ml b/ocamltest/ocamltest_stdlib.ml index 1b8dd8abd..a95dd3dc5 100644 --- a/ocamltest/ocamltest_stdlib.ml +++ b/ocamltest/ocamltest_stdlib.ml @@ -15,6 +15,8 @@ (* A few extensions to OCaml's standard library *) +module Unix = Ocamltest_unix + (* Pervaisive *) let input_line_opt ic = @@ -165,8 +167,6 @@ module Sys = struct let force_remove file = if file_exists file then remove file - external has_symlink : unit -> bool = "caml_has_symlink" - let with_chdir path f = let oldcwd = Sys.getcwd () in Sys.chdir path; diff --git a/ocamltest/ocamltest_stdlib.mli b/ocamltest/ocamltest_stdlib.mli index 3a75aa21d..8ab88d663 100644 --- a/ocamltest/ocamltest_stdlib.mli +++ b/ocamltest/ocamltest_stdlib.mli @@ -54,10 +54,13 @@ module Sys : sig val copy_chan : in_channel -> out_channel -> unit val copy_file : string -> string -> unit val force_remove : string -> unit - val has_symlink : unit -> bool val with_chdir : string -> (unit -> 'a) -> 'a val getenv_with_default_value : string -> string -> string val safe_getenv : string -> string val with_input_file : ?bin:bool -> string -> (in_channel -> 'a) -> 'a val with_output_file : ?bin:bool -> string -> (out_channel -> 'a) -> 'a end + +module Unix : sig + include module type of Ocamltest_unix +end diff --git a/ocamltest/ocamltest_stdlib_stubs.c b/ocamltest/ocamltest_stdlib_stubs.c deleted file mode 100644 index 405c8247d..000000000 --- a/ocamltest/ocamltest_stdlib_stubs.c +++ /dev/null @@ -1,151 +0,0 @@ -/**************************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Sebastien Hinderer, projet Gallium, INRIA Paris */ -/* */ -/* Copyright 2018 Institut National de Recherche en Informatique et */ -/* en Automatique. */ -/* */ -/* All rights reserved. This file is distributed under the terms of */ -/* the GNU Lesser General Public License version 2.1, with the */ -/* special exception on linking described in the file LICENSE. */ -/* */ -/**************************************************************************/ - -/* Stubs for ocamltest's standard library */ - -#include -#include - -#include -#include -#include -#include -/* -#include -*/ -#include -#include - - -#ifdef _WIN32 - -/* - * Windows Vista functions enabled - */ -#undef _WIN32_WINNT -#define _WIN32_WINNT 0x0600 - -#include -#include -#include -#include - -// Developer Mode allows the creation of symlinks without elevation - see -// https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-createsymboliclinkw -static BOOL IsDeveloperModeEnabled() -{ - HKEY hKey; - LSTATUS status; - DWORD developerModeRegistryValue, dwordSize = sizeof(DWORD); - - status = RegOpenKeyExW( - HKEY_LOCAL_MACHINE, - L"SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\AppModelUnlock", - 0, - KEY_READ | KEY_WOW64_64KEY, - &hKey - ); - if (status != ERROR_SUCCESS) { - return FALSE; - } - - status = RegQueryValueExW( - hKey, - L"AllowDevelopmentWithoutDevLicense", - NULL, - NULL, - (LPBYTE)&developerModeRegistryValue, - &dwordSize - ); - RegCloseKey(hKey); - if (status != ERROR_SUCCESS) { - return FALSE; - } - return developerModeRegistryValue != 0; -} - -#define luid_eq(l, r) (l.LowPart == r.LowPart && l.HighPart == r.HighPart) - -CAMLprim value caml_has_symlink(value unit) -{ - CAMLparam1(unit); - HANDLE hProcess = GetCurrentProcess(); - BOOL result = FALSE; - - if (IsDeveloperModeEnabled()) { - CAMLreturn(Val_true); - } - - if (OpenProcessToken(hProcess, TOKEN_READ, &hProcess)) { - LUID seCreateSymbolicLinkPrivilege; - - if (LookupPrivilegeValue(NULL, - SE_CREATE_SYMBOLIC_LINK_NAME, - &seCreateSymbolicLinkPrivilege)) { - DWORD length; - - if (!GetTokenInformation(hProcess, TokenPrivileges, NULL, 0, &length)) { - if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) { - TOKEN_PRIVILEGES* privileges = - (TOKEN_PRIVILEGES*)caml_stat_alloc(length); - if (GetTokenInformation(hProcess, - TokenPrivileges, - privileges, - length, - &length)) { - DWORD count = privileges->PrivilegeCount; - - if (count) { - LUID_AND_ATTRIBUTES* privs = privileges->Privileges; - while (count-- && - !(result = luid_eq(privs->Luid, - seCreateSymbolicLinkPrivilege))) - privs++; - } - } - - caml_stat_free(privileges); - } - } - } - - CloseHandle(hProcess); - } - - CAMLreturn(Val_bool(result)); -} - - -#else /* _WIN32 */ - -#ifdef HAS_SYMLINK - -CAMLprim value caml_has_symlink(value unit) -{ - CAMLparam0(); - CAMLreturn(Val_true); -} - -#else /* HAS_SYMLINK */ - -CAMLprim value caml_has_symlink(value unit) -{ - CAMLparam0(); - CAMLreturn(Val_false); -} - -#endif - -#endif /* _WIN32 */ diff --git a/ocamltest/ocamltest_unix.mli b/ocamltest/ocamltest_unix.mli new file mode 100644 index 000000000..ed952213f --- /dev/null +++ b/ocamltest/ocamltest_unix.mli @@ -0,0 +1,18 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* David Allsopp, OCaml Labs, Cambridge. *) +(* *) +(* Copyright 2020 David Allsopp Ltd. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Functions imported from Unix. They are explicitly here to remove the + temptation to use the Unix module directly in ocamltest. *) + +val has_symlink : unit -> bool diff --git a/ocamltest/ocamltest_unix_dummy.ml b/ocamltest/ocamltest_unix_dummy.ml new file mode 100644 index 000000000..1a079cf7b --- /dev/null +++ b/ocamltest/ocamltest_unix_dummy.ml @@ -0,0 +1,16 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* David Allsopp, OCaml Labs, Cambridge. *) +(* *) +(* Copyright 2020 David Allsopp Ltd. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Dummy implementations for when the Unix library isn't built *) +let has_symlink () = false diff --git a/ocamltest/ocamltest_unix_real.ml b/ocamltest/ocamltest_unix_real.ml new file mode 100644 index 000000000..68cfbb2e0 --- /dev/null +++ b/ocamltest/ocamltest_unix_real.ml @@ -0,0 +1,17 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* David Allsopp, OCaml Labs, Cambridge. *) +(* *) +(* Copyright 2020 David Allsopp Ltd. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* It's tempting just to have include Unix, but the binary is then quite a bit + bigger. *) +let has_symlink = Unix.has_symlink