+4 -1

.depend

reviewed

··· 10611 10611 testsuite/tools/harness.cmo : \ 10612 10612 otherlibs/unix/unix.cmi \ 10613 10613 utils/config.cmi \ 10614 10614 + bytecomp/byterntm.cmi \ 10614 10615 testsuite/tools/harness.cmi 10615 10616 testsuite/tools/harness.cmx : \ 10616 10617 otherlibs/unix/unix.cmx \ 10617 10618 utils/config.cmx \ 10619 10619 + bytecomp/byterntm.cmx \ 10618 10620 testsuite/tools/harness.cmi 10619 10619 - testsuite/tools/harness.cmi : 10621 10621 + testsuite/tools/harness.cmi : \ 10622 10622 + bytecomp/byterntm.cmi 10620 10623 testsuite/tools/lexcmm.cmo : \ 10621 10624 testsuite/tools/parsecmm.cmi \ 10622 10625 utils/misc.cmi \

+4 -1

Changes

reviewed

··· 358 358 - #14245: New option -launch-method for ocamlc allows the method used by a 359 359 tendered bytecode executable to locate the interpreter to be given explicitly. 360 360 In particular, it makes it easier to specify the use of the executable 361 361 - launcher on Unix. 361 361 + launcher on Unix. New option -runtime-search extends the bytecode executable 362 362 + header to be able to search for the runtime interpreter in the directory 363 363 + containing the executable and in PATH rather than relying on a single 364 364 + hard-coded path. 362 365 (David Allsopp, review by Damien Doligez and Samuel Hym) 363 366 364 367 - #14190: `ocaml -e` now also processes `-init` (previously it was ignored).

+7

Makefile.common

reviewed

··· 347 347 BYTECODE_LAUNCHER_FLAGS = \ 348 348 -launch-method $(call QUOTE_SINGLE,$(LAUNCH_METHOD) $(BINDIR)) 349 349 350 350 + # Historically, the native Windows ports are assumed to be finding ocamlrun 351 351 + # using a PATH search. Since boot/ocamlc has no notion of the target, Windows 352 352 + # requires -runtime-search to be passed explicitly. 353 353 + ifeq "$(UNIX_OR_WIN32)" "win32" 354 354 + BYTECODE_LAUNCHER_FLAGS += -runtime-search enable 355 355 + endif 356 356 + 350 357 # $(BOOTSTRAPPED) will be non-empty after the compiler has been bootstrapped, as 351 358 # the -launch-method string will appear in it. 352 359 BOOTSTRAPPED := \

+105 -15

bytecomp/bytelink.ml

reviewed

··· 331 331 remove_file output_file; 332 332 result 333 333 334 334 + (* Writes the shell script version of the bytecode launcher to outchan *) 335 335 + let write_sh_launcher outchan bin_sh bindir search runtime = 336 336 + let open struct type tag = DFE | F | FE end in 337 337 + let l tag fmt = 338 338 + let output s = 339 339 + match tag, search with 340 340 + | DFE, _ 341 341 + | F, Config.Fallback 342 342 + | FE, (Config.Fallback | Config.Enable) -> 343 343 + output_string outchan (String.trim s); 344 344 + output_char outchan '\n' 345 345 + | _ -> 346 346 + () 347 347 + in 348 348 + Printf.ksprintf output fmt 349 349 + in 350 350 + let runtime = Filename.quote runtime in 351 351 + let bin = Filename.quote (Filename.concat bindir "") in 352 352 + let exec = 353 353 + if search = Config.Disable then 354 354 + runtime 355 355 + else 356 356 + {|"$c"|} 357 357 + in 358 358 + let release = 359 359 + Printf.sprintf "%d.%d" Sys.ocaml_release.major Sys.ocaml_release.minor 360 360 + in 361 361 + (* Each of the three search modes requires a slightly different shell script. 362 362 + However, these shell scripts do have one very useful property: the script 363 363 + for Fallback adds lines to the script for Enable which adds lines to the 364 364 + script for Disable, but none of them change lines (apart from a trivial 365 365 + tweak to the exec line for the Disable script). 366 366 + The lines below are laid out to reflect this, with the tag letters 367 367 + D(isable), F(allback) and E(nable) for the lines in each script. If a line 368 368 + is emitted, it is first passed to String.trim, which allows indentation and 369 369 + a column-based layout to be used. 370 370 + 371 371 + The Disable script just needs to exec the runtime. The two searching modes 372 372 + do a few more calculations and will ultimately exec the contents of $c 373 373 + (which is why exec_arg above is set to the literal string {v "$c" v}). 374 374 + 375 375 + In the script itself: 376 376 + - $r is the name of the runtime ('ocamlrun', 'ocamlrund', etc.) 377 377 + - $d is calculated in the script as $(dirname "$0") - i.e. the directory 378 378 + containing the bytecode executable itself 379 379 + - $c will ultimately be the runtime to exec. If it is empty, then the 380 380 + script displays an error message. For Fallback, $c will be the first 381 381 + runtime to try (i.e. the runtime in bindir), and the bindir passed must 382 382 + end with a separator (which is ensured by Filename.concat above) 383 383 + 384 384 + The script tries up to three options: 385 385 + - exec $c, if it exists (prefer the runtime in bindir) 386 386 + - exec $d/$r, if it exists (prefer a runtime in the same directory 387 387 + as the bytecode executable) 388 388 + - otherwise try $(command -v "$r") (search PATH for the runtime) 389 389 + 390 390 + If the script fails to find an interpreter, $c will always be empty 391 391 + (since [command -v] will have returned an empty string) and an 392 392 + error message can be displayed. *) 393 393 + l DFE {|#!%s |} bin_sh; 394 394 + l FE {|r=%s |} runtime; 395 395 + l F {|c=%s"$r" |} bin; 396 396 + l F {|if ! test -f "$c"; then |}; 397 397 + l FE {| d="$(dirname "$0" 2>/dev/null)" |}; 398 398 + l FE {| test -z "$d" || d="${d%%/}/" |}; 399 399 + l FE {| c="$(command -v "$d$r")" |}; 400 400 + l FE {| test -n "$c" || c="$(command -v "$r")" |}; 401 401 + l F {|fi |}; 402 402 + l FE {|if test -z "$c"; then |}; 403 403 + l FE {| echo 'This program requires an OCaml %s interpreter'>&2|} release; 404 404 + l FE {| echo "$r not found either alongside $0 or in \$PATH">&2|}; 405 405 + l FE {|else |}; 406 406 + l DFE {| exec %s "$0" "$@" |} exec; 407 407 + l FE {|fi |}; 408 408 + l FE {|exit 126 |} 409 409 + 334 410 (* Writes the executable header to outchan and writes the RNTM section, if 335 411 needed. Returns a toc_writer (i.e. Bytesections.init_record is always 336 412 called) *) 337 413 338 414 let write_header outchan = 339 339 - let runtime = 415 415 + let runtime, search = 340 416 if String.length !Clflags.use_runtime > 0 then 341 417 (* Do not use BUILD_PATH_PREFIX_MAP mapping for this. *) 342 418 let runtime = !Clflags.use_runtime in 343 419 if Filename.is_relative runtime then 344 344 - Filename.concat (Sys.getcwd ()) runtime 420 420 + Filename.concat (Sys.getcwd ()) runtime, Config.Disable 345 421 else 346 346 - runtime 422 422 + runtime, Config.Disable 347 423 else 348 424 let runtime = "ocamlrun" ^ !Clflags.runtime_variant in 349 349 - (* Historically, the native Windows ports are assumed to be finding 350 350 - ocamlrun using a PATH search. *) 351 351 - if Sys.win32 then 352 352 - runtime 353 353 - else 354 354 - Filename.concat !Clflags.target_bindir runtime 425 425 + let runtime = 426 426 + if !Clflags.search_method = Config.Disable then 427 427 + Filename.concat !Clflags.target_bindir runtime 428 428 + else 429 429 + runtime 430 430 + in 431 431 + runtime, !Clflags.search_method 355 432 in 356 433 (* Determine which method will be used for launching the executable: 357 434 Executable: concatenate the bytecode image to the executable stub ··· 362 439 | Config.Executable -> 363 440 Executable 364 441 | Config.Shebang sh -> 365 365 - if invalid_for_shebang_line runtime then 442 442 + if search <> Config.Disable || invalid_for_shebang_line runtime then 366 443 let sh = 367 444 match sh with 368 445 | Some sh -> sh ··· 390 467 (* Write the header *) 391 468 match launcher with 392 469 | Shebang_runtime -> 470 470 + assert (search = Config.Disable); 393 471 (* Use the runtime directly *) 394 472 Printf.fprintf outchan "#!%s\n" runtime; 395 473 Bytesections.init_record outchan 396 474 | Shebang_bin_sh bin_sh -> 397 397 - (* exec the runtime using sh *) 398 398 - Printf.fprintf outchan "\ 399 399 - #!%s\n\ 400 400 - exec %s \"$0\" \"$@\"\n" bin_sh (Filename.quote runtime); 475 475 + (* Use the shebang launcher *) 476 476 + write_sh_launcher outchan bin_sh bindir search runtime; 401 477 Bytesections.init_record outchan 402 478 | Executable -> 403 479 (* Use the executable stub launcher *) ··· 413 489 write_exe_launcher data; 414 490 (* The runtime name needs recording in RNTM *) 415 491 let toc_writer = Bytesections.init_record outchan in 416 416 - Printf.fprintf outchan "%s\000" runtime; 492 492 + (* stdlib/header.c determines which mode is needed based on whether the 493 493 + RNTM section contains an embedded NUL character. For Disable, the path 494 494 + is written verbatim (no extra NUL), otherwise the directory separator 495 495 + just before the basename is effectively turned into a NUL (for Enable, 496 496 + there is no dirname, so the string "begins" with a NUL character). *) 497 497 + if search = Disable then 498 498 + output_string outchan runtime 499 499 + else begin 500 500 + if search = Fallback then 501 501 + (* Ensure bindir does _not_ end up with a separator *) 502 502 + output_string outchan 503 503 + (Filename.(dirname (concat bindir current_dir_name))); 504 504 + output_char outchan '\000'; 505 505 + output_string outchan runtime 506 506 + end; 417 507 Bytesections.record toc_writer RNTM; 418 508 toc_writer 419 509

+12 -1

bytecomp/byterntm.mli

reviewed

··· 15 15 (** Parser for RNTM in bytecode executables. Parses both the RNTM section and 16 16 the shebang launcher produced by {!Bytelink}. *) 17 17 18 18 - val read_runtime : Bytesections.section_table -> in_channel -> string option 18 18 + (** Search methods used by a tendered bytecode image to find a runtime. *) 19 19 + type search_method = 20 20 + | Disable of string 21 21 + (** Check fixed location only *) 22 22 + | Fallback of string 23 23 + (** Check given location first then fallback to searching for the 24 24 + interpreter *) 25 25 + | Enable 26 26 + (** Always search for the interpreter *) 27 27 + 28 28 + val read_runtime : 29 29 + Bytesections.section_table -> in_channel -> (string * search_method) option 19 30 (** Returns the runtime used by this tendered/standalone image. If the runtime 20 31 used cannot be parsed, or the image was linked using -without-runtime, then 21 32 [None] is returned. *)

+68 -13

bytecomp/byterntm.mll

reviewed

··· 12 12 (* *) 13 13 (**************************************************************************) 14 14 15 15 + { 16 16 + type search_method = 17 17 + | Disable of string 18 18 + | Fallback of string 19 19 + | Enable 20 20 + 21 21 + (* First word of the current line being analysed - [exec ...], [r=...], or 22 22 + [c=...] *) 23 23 + type state = Exec | R | C of string 24 24 + } 25 25 + 15 26 rule analyze = parse 16 16 - (* RNTM section or shebang directly to the runtime *) 17 17 - | "#!" ([^ ' ' '\n']+ as runtime) '\n' 18 18 - | ([^ '\000']+ as runtime) '\000' eof 19 19 - { Some runtime } 27 27 + (* RNTM section for -runtime-search absolute or shebang directly to the 28 28 + runtime *) 29 29 + | "#!" ([^ ' ' '\n']* as dir) ('/' as sep) ([^ '/' ' ' '\n']+ as runtime) '\n' 30 30 + | ([^ '\000']* as dir) (['/' '\\' '\000'] as sep) (* Directory portion *) 31 31 + ([^ '\\' '/' '\000']+ as runtime) eof (* Runtime portion *) 32 32 + { if sep = '\000' then 33 33 + if dir = "" then 34 34 + Some (runtime, Enable) 35 35 + else 36 36 + Some (runtime, Fallback (Filename.concat dir "")) 37 37 + else 38 38 + Some (runtime, Disable (dir ^ String.make 1 sep)) } 39 39 + 40 40 + (* Legacy RNTM (remove after bootstrap) *) 41 41 + | (([^ '\000']* ['/' '\\']) as dir) 42 42 + ([^ '\\' '/' '\000']+ as runtime) '\000' eof 43 43 + { if dir = "" then 44 44 + Some (runtime, Enable) 45 45 + else 46 46 + Some (runtime, Disable dir) } 20 47 21 48 (* Shell script launcher (if it matches, this always matches more than the above 22 49 regexp) *) 23 23 - | "#!" [^ ' ' '\n']+ "/sh\nexec '" 24 24 - { analyze_sh_launcher (Buffer.create 1024) lexbuf } 50 50 + | "#!" [^ ' ' '\n']+ "/sh\n" (("exec '" | "r='") as next) 51 51 + { let state = if next.[0] = 'r' then R else Exec in 52 52 + analyze_sh_launcher state (Buffer.create 1024) lexbuf } 25 53 26 54 | _ | eof 27 55 { None } 28 56 29 29 - and analyze_sh_launcher b = parse 30 30 - (* An embedded single quote in the filename passed to exec *) 57 57 + and analyze_sh_launcher state b = parse 58 58 + (* An embedded single quote *) 31 59 | "'\\''" 32 32 - { analyze_sh_launcher (Buffer.add_char b '\''; b) lexbuf } 60 60 + { analyze_sh_launcher state (Buffer.add_char b '\''; b) lexbuf } 33 61 34 34 - | [^ '\'']+ as s 35 35 - { analyze_sh_launcher (Buffer.add_string b s; b) lexbuf } 62 62 + | [^ '\'' ]+ as s 63 63 + { analyze_sh_launcher state (Buffer.add_string b s; b) lexbuf } 36 64 37 37 - (* End of the filename parsed; return the entire string *) 65 65 + (* exec line for -runtime-search disable *) 38 66 | "' \"$0\" \"$@\"\n" 39 39 - { Some (Buffer.contents b) } 67 67 + { if state = Exec then 68 68 + let name = Buffer.contents b in 69 69 + let runtime = Filename.basename name in 70 70 + let dir = 71 71 + String.sub name 0 (String.length name - String.length runtime) 72 72 + in 73 73 + Some (runtime, Disable dir) 74 74 + else 75 75 + None } 76 76 + 77 77 + (* r= line for -runtime-search {fallback,enable} *) 78 78 + | "'\n" ("c='" as c)? 79 79 + { if state = R then 80 80 + let runtime = Buffer.contents b in 81 81 + if c = None then 82 82 + Some (runtime, Enable) 83 83 + else 84 84 + analyze_sh_launcher (C runtime) (Buffer.clear b; b) lexbuf 85 85 + else 86 86 + None } 87 87 + 88 88 + (* c= line for -runtime-search fallback *) 89 89 + | "'\"$r\"\n" 90 90 + { match state with 91 91 + | C runtime -> 92 92 + Some (runtime, Fallback (Buffer.contents b)) 93 93 + | _ -> 94 94 + None } 40 95 41 96 | _ | eof 42 97 { None }

+9

configure

reviewed

··· 19916 19916 fi 19917 19917 19918 19918 19919 19919 + ## strlcpy 19920 19920 + ac_fn_c_check_func "$LINENO" "strlcpy" "ac_cv_func_strlcpy" 19921 19921 + if test "x$ac_cv_func_strlcpy" = xyes 19922 19922 + then : 19923 19923 + printf "%s\n" "#define HAS_STRLCPY 1" >>confdefs.h 19924 19924 + 19925 19925 + fi 19926 19926 + 19927 19927 + 19919 19928 ## secure_getenv and __secure_getenv 19920 19929 19921 19930 saved_CPPFLAGS="$CPPFLAGS"

+3

configure.ac

reviewed

··· 1949 1949 ## times 1950 1950 AC_CHECK_FUNC([times], [AC_DEFINE([HAS_TIMES], [1])]) 1951 1951 1952 1952 + ## strlcpy 1953 1953 + AC_CHECK_FUNC([strlcpy], [AC_DEFINE([HAS_STRLCPY], [1])]) 1954 1954 + 1952 1955 ## secure_getenv and __secure_getenv 1953 1956 1954 1957 saved_CPPFLAGS="$CPPFLAGS"

+22

driver/main_args.ml

reviewed

··· 532 532 \ /path/interpreter - use #!, or the given sh-compatible \n\ 533 533 \ interpreter if the interpreter path cannot be used" 534 534 535 535 + let mk_search_method f = 536 536 + "-runtime-search", Arg.Symbol (["disable"; "fallback"; "enable"], f), 537 537 + Printf.sprintf 538 538 + " Control the way the bytecode header searches for the interpreter\n\ 539 539 + \ The following settings are supported:\n\ 540 540 + \ disable use a fixed absolute path to the interpreter\n\ 541 541 + \ fallback search for interpreter only if not found at the absolute \ 542 542 + path\n\ 543 543 + \ enable always search for the interpreter\n\ 544 544 + \ The default setting is 'disable'." 545 545 + 535 546 let mk_use_runtime f = 536 547 "-use-runtime", Arg.String f, 537 548 "<file> Generate bytecode for the given runtime system" ··· 951 962 val _vmthread : unit -> unit 952 963 val _use_runtime : string -> unit 953 964 val _launch_method : string -> unit 965 965 + val _search_method : string -> unit 954 966 val _output_complete_exe : unit -> unit 955 967 956 968 val _dinstr : unit -> unit ··· 1149 1161 mk_use_runtime F._use_runtime; 1150 1162 mk_use_runtime_2 F._use_runtime; 1151 1163 mk_launch_method F._launch_method; 1164 1164 + mk_search_method F._search_method; 1152 1165 mk_v F._v; 1153 1166 mk_verbose F._verbose; 1154 1167 mk_version F._version; ··· 2019 2032 | _ -> 2020 2033 Compenv.fatal 2021 2034 "-launch-method: expect sh, exe or an absolute path for <method>" 2035 2035 + let _search_method = function 2036 2036 + | "disable" -> 2037 2037 + search_method := Config.Disable 2038 2038 + | "fallback" -> 2039 2039 + search_method := Config.Fallback 2040 2040 + | "enable" -> 2041 2041 + search_method := Config.Enable 2042 2042 + | _ -> 2043 2043 + assert false 2022 2044 let _v () = Compenv.print_version_and_library "compiler" 2023 2045 let _vmthread () = Compenv.fatal vmthread_removed_message 2024 2046 end

+1

driver/main_args.mli

reviewed

··· 166 166 val _vmthread : unit -> unit 167 167 val _use_runtime : string -> unit 168 168 val _launch_method : string -> unit 169 169 + val _search_method : string -> unit 169 170 val _output_complete_exe : unit -> unit 170 171 171 172 val _dinstr : unit -> unit

+19

man/ocamlc.1

reviewed

··· 671 671 Do no allow arbitrary recursive types during type-checking. 672 672 This is the default. 673 673 .TP 674 674 + .BI \-runtime\-search " method" 675 675 + Controls whether the header used by normal bytecode executables is permitted to 676 676 + search for the interpreter, or requires it to be at a fixed location. 677 677 + The following methods are supported: 678 678 + 679 679 + .B disable 680 680 + A fixed absolute path to the interpreter is used, and the executable will not 681 681 + launch if the interpreter is not found at this location. 682 682 + 683 683 + .B fallback 684 684 + A fixed absolute path to the interpreter is used, but if the executable cannot 685 685 + find the interpreter at this location then it will search first in the directory 686 686 + containing the executable and then in PATH. 687 687 + 688 688 + .B enable 689 689 + The executable searches for the interpreter first in the directory containing 690 690 + the executable and then in PATH. No absolute path to the interpreter is 691 691 + recorded. 692 692 + .TP 674 693 .BI \-runtime\-variant " suffix" 675 694 Add 676 695 .I suffix

+17

manual/src/cmds/unified-options.etex

reviewed

··· 685 685 are supported. \notop{Note that once you have created an interface using this 686 686 flag, you must use it again for all dependencies.} 687 687 688 688 + \comp{% 689 689 + \item["-runtime-search" \var{method}] 690 690 + Controls whether the header used by normal bytecode executables is permitted to 691 691 + search for the interpreter, or requires it to be at a fixed location. 692 692 + The following methods are supported: 693 693 + \begin{description} 694 694 + \item["disable"] A fixed absolute path to the interpreter is used, and the 695 695 + executable will not launch if the interpreter is not found at this location. 696 696 + \item["fallback"] A fixed absolute path to the interpreter is used, but if the 697 697 + executable cannot find the interpreter at this location then it will search 698 698 + first in the directory containing the executable and then in "PATH". 699 699 + \item["enable"] The executable searches for the interpreter first in the 700 700 + directory containing the executable and then in "PATH". No absolute path to 701 701 + the interpreter is recorded. 702 702 + \end{description} 703 703 + }%comp 704 704 + 688 705 \notop{% 689 706 \item["-runtime-variant" \var{suffix}] 690 707 Add the \var{suffix} string to the name of the runtime library used by

+2

runtime/caml/s.h.in

reviewed

··· 72 72 73 73 #undef HAS_TIMES 74 74 75 75 + #undef HAS_STRLCPY 76 76 + 75 77 #undef HAS_SECURE_GETENV 76 78 77 79 #undef HAS___SECURE_GETENV

+190 -27

stdlib/header.c

reviewed

··· 22 22 #define NORETURN _Noreturn 23 23 #endif 24 24 25 25 + #include <errno.h> 26 26 + 25 27 #ifdef _WIN32 26 28 27 29 #define STRICT 28 30 #define WIN32_LEAN_AND_MEAN 29 31 #include <windows.h> 30 32 33 33 + typedef wchar_t char_os; 34 34 + typedef wchar_t * argv_t; 35 35 + #define T(x) L ## x 36 36 + #define Is_separator(c) (c == '\\' || c == '/') 37 37 + #define Directory_separator_character T('\\') 38 38 + #define ITOL(i) L ## #i 39 39 + #define ITOT(i) ITOL(i) 40 40 + #define PATH_NAME L"%Path%" 41 41 + 31 42 #if WINDOWS_UNICODE 32 43 #define CP CP_UTF8 44 44 + /* The characters in RNTM will be converted from UTF-8 to UTF-16. Parasitically, 45 45 + there could be 4 bytes in RNTM for every wchar_t in the actual value. */ 46 46 + #define RNTM_ENCODING_LENGTH 4 33 47 #else 34 48 #define CP CP_ACP 35 49 #endif ··· 45 59 46 60 typedef HANDLE file_descriptor; 47 61 62 62 + #define unsafe_copy(dst, src, dstsize) lstrcpy(dst, src) 63 63 + 48 64 static int read(HANDLE h, LPVOID buffer, DWORD buffer_size) 49 65 { 50 66 DWORD nread = 0; ··· 60 76 return FALSE; 61 77 } 62 78 63 63 - static void exec_file(wchar_t *file, wchar_t *cmdline) 79 79 + static int exec_file(wchar_t *file, wchar_t *cmdline) 64 80 { 65 81 wchar_t truename[MAX_PATH]; 66 82 STARTUPINFO stinfo; ··· 87 103 GetExitCodeProcess(procinfo.hProcess, &retcode); 88 104 CloseHandle(procinfo.hProcess); 89 105 ExitProcess(retcode); 106 106 + } else { 107 107 + return ENOEXEC; 90 108 } 109 109 + } else { 110 110 + return ENOENT; 91 111 } 92 112 } 93 113 ··· 121 141 122 142 #else 123 143 144 144 + #include "caml/s.h" 145 145 + 124 146 #include <stdio.h> 125 147 #include <stdlib.h> 126 148 #include <string.h> 127 149 #include <unistd.h> 128 150 #include <fcntl.h> 129 151 #include <limits.h> 152 152 + #ifdef HAS_LIBGEN_H 153 153 + #include <libgen.h> 154 154 + #endif 130 155 #include <sys/types.h> 131 156 #include <sys/stat.h> 132 157 ··· 137 162 138 163 typedef int file_descriptor; 139 164 165 165 + typedef char char_os; 166 166 + typedef char ** argv_t; 167 167 + #define T(x) x 168 168 + #define Is_separator(c) (c == '/') 169 169 + #define Directory_separator_character '/' 170 170 + #define ITOL(x) #x 171 171 + #define ITOT(x) ITOL(x) 172 172 + #define PATH_NAME "$PATH" 173 173 + 174 174 + #ifdef HAS_STRLCPY 175 175 + /* The macro is named unsafe_copy because although it requires a dstsize 176 176 + argument which _may_ be passed to strlcpy, there are platforms where the 177 177 + underlying operation is unsafe and will ignore dstsize. */ 178 178 + #define unsafe_copy strlcpy 179 179 + #else 180 180 + #define unsafe_copy(dst, src, dstsize) strcpy(dst, src) 181 181 + #endif 182 182 + 140 183 #ifndef __CYGWIN__ 141 184 142 185 /* Normal Unix search path function */ ··· 229 272 exit(2); 230 273 } 231 274 232 232 - static void exec_file(const char *file, char * const argv[]) 275 275 + static int exec_file(const char *file, char * const argv[]) 233 276 { 234 234 - execvp(file, argv); 277 277 + return (execvp(file, argv) == -1 ? errno : 0); 235 278 } 236 279 237 280 #endif /* defined(_WIN32) */ 238 281 282 282 + #include "caml/version.h" 283 283 + #define SHORT_VERSION ITOT(OCAML_VERSION_MAJOR) T(".") ITOT(OCAML_VERSION_MINOR) 284 284 + 239 285 #define CAML_INTERNALS 240 286 #include "caml/exec.h" 241 287 ··· 246 292 ((uint32_t) p[2] << 8) | p[3]; 247 293 } 248 294 249 249 - static char * read_runtime_path(file_descriptor fd) 295 295 + #ifndef RNTM_ENCODING_LENGTH 296 296 + #define RNTM_ENCODING_LENGTH 1 297 297 + #endif 298 298 + 299 299 + static char * read_runtime_path(file_descriptor fd, uint32_t *rntm_strlen) 250 300 { 251 301 char buffer[TRAILER_SIZE]; 252 252 - static char runtime_path[PATH_MAX]; 302 302 + static char runtime_path[PATH_MAX * RNTM_ENCODING_LENGTH]; 253 303 int num_sections; 254 254 - uint32_t path_size; 255 304 long ofs; 256 305 257 306 if (lseek(fd, -TRAILER_SIZE, SEEK_END) == -1) return NULL; ··· 259 308 num_sections = read_size(buffer); 260 309 ofs = TRAILER_SIZE + num_sections * 8; 261 310 if (lseek(fd, -ofs, SEEK_END) == -1) return NULL; 262 262 - path_size = 0; 311 311 + *rntm_strlen = 0; 263 312 for (int i = 0; i < num_sections; i++) { 264 313 if (read(fd, buffer, 8) < 8) return NULL; 265 314 if (buffer[0] == 'R' && buffer[1] == 'N' && 266 315 buffer[2] == 'T' && buffer[3] == 'M') { 267 267 - path_size = read_size(buffer + 4); 268 268 - ofs += path_size; 269 269 - } else if (path_size > 0) 316 316 + *rntm_strlen = read_size(buffer + 4); 317 317 + ofs += *rntm_strlen; 318 318 + } else if (*rntm_strlen > 0) 270 319 ofs += read_size(buffer + 4); 271 320 } 272 272 - if (path_size == 0) return NULL; 273 273 - if (path_size >= PATH_MAX) return NULL; 321 321 + if (*rntm_strlen == 0) return NULL; 322 322 + /* The last character of runtime_path must be '\0', so RNTM must be strictly 323 323 + less than PATH_MAX */ 324 324 + if (*rntm_strlen >= PATH_MAX * RNTM_ENCODING_LENGTH) return NULL; 274 325 if (lseek(fd, -ofs, SEEK_END) == -1) return NULL; 275 275 - if (read(fd, runtime_path, path_size) != path_size) return NULL; 326 326 + if (read(fd, runtime_path, *rntm_strlen) != *rntm_strlen) return NULL; 327 327 + 276 328 return runtime_path; 277 329 } 278 330 331 331 + /* rntm points to a buffer containing rntm_bsz characters consisting of the 332 332 + decoded content of the RNTM section (which may include NUL characters) and an 333 333 + additional NUL "terminator". 334 334 + RNTM is either <runtime>[\0] or [<runtime-dirname>]\0<runtime-basename> 335 335 + Decode rntm and search for a runtime (using argv0_dirname if non-NULL and 336 336 + required) and exec the first runtime found passing argv. */ 337 337 + NORETURN void search_and_exec_runtime(char_os *rntm, uint32_t rntm_bsz, 338 338 + argv_t argv, char_os *argv0_dirname) 339 339 + { 340 340 + /* rntm_end points to the NUL "terminator" of rntm (_not_ the last character 341 341 + of the RNTM section */ 342 342 + const char_os *rntm_end = rntm + (rntm_bsz - 1); 343 343 + 344 344 + char_os *rntm_bindir_end = rntm; 345 345 + 346 346 + /* Scan for the first NUL character in rntm (there is always one) */ 347 347 + while (*rntm_bindir_end != 0) 348 348 + rntm_bindir_end++; 349 349 + 350 350 + /* The first character of rntm is NUL for Enable mode */ 351 351 + if (*rntm != 0) { 352 352 + /* boot/ocamlc writes a NUL-terminated string to RNTM. In this case, 353 353 + rntm_bindir_end points to that NUL (which will have been included in the 354 354 + length of RNTM recorded in the bytecode image) and immediately following 355 355 + it is the extra NUL character required by this function. 356 356 + Interpret this as Disable. For Windows, where the RNTM written by 357 357 + boot/ocamlc will have just been "ocamlrun\0", this maintains the required 358 358 + Enable behaviour! This can be removed after a bootstrap. */ 359 359 + if (rntm_bindir_end + 1 == rntm_end) 360 360 + rntm_bindir_end++; 361 361 + /* For Disable mode, there is no NUL in RNTM, so rntm_bindir_end points to 362 362 + the terminator pointed to by rntm_end. For Fallback, there is a NUL in 363 363 + the middle of the RNTM "string", which rntm_bindir_end points at. Change 364 364 + that to a directory separator, so that rntm now points to a 365 365 + NUL-terminated full path we can attempt to exec. */ 366 366 + if (rntm_bindir_end != rntm_end) 367 367 + *rntm_bindir_end = Directory_separator_character; 368 368 + int status = exec_file(rntm, argv); 369 369 + /* exec failed. For Disable mode, there's nothing else to be tried. For 370 370 + Fallback, if the failure was for any other reason than ENOENT then there 371 371 + is also nothing else to be tried. */ 372 372 + if (rntm_bindir_end == rntm_end || status != ENOENT) 373 373 + exit_with_error(T("Cannot exec "), rntm, NULL); 374 374 + } 375 375 + 376 376 + /* Shift rntm to point to <runtime-basename> */ 377 377 + rntm = rntm_bindir_end + 1; 378 378 + if (rntm < rntm_end) { 379 379 + /* Searching takes place first in the directory containing this executable, 380 380 + if it's known. */ 381 381 + if (argv0_dirname != NULL) { 382 382 + char_os root[PATH_MAX]; 383 383 + unsafe_copy(root, argv0_dirname, PATH_MAX); 384 384 + 385 385 + /* Ensure root ends with a directory separator. root_basename points to 386 386 + the character at which to place <runtime-basename> */ 387 387 + char_os *root_basename = root; 388 388 + while (*root_basename != 0) 389 389 + root_basename++; 390 390 + if (root_basename > root && !Is_separator(*(root_basename - 1))) 391 391 + *root_basename++ = Directory_separator_character; 392 392 + 393 393 + /* If there isn't enough space to copy rntm to root then simply skip this 394 394 + check (e.g. an executable called b.exe in a very long directory name). 395 395 + (root_basename - root) is strlen_os(root) and likewise 396 396 + (rntm_end - rntm) is strlen_os(rntm). */ 397 397 + if ((rntm_end - rntm) <= PATH_MAX - (root_basename - root) - 1) { 398 398 + unsafe_copy(root_basename, rntm, PATH_MAX - (root_basename - root)); 399 399 + if (exec_file(root, argv) != ENOENT) 400 400 + exit_with_error(T("Cannot exec "), root, NULL); 401 401 + } 402 402 + } 403 403 + 404 404 + /* Otherwise, search in PATH */ 405 405 + if (exec_file(rntm, argv) != ENOENT) 406 406 + exit_with_error(T("Cannot exec "), rntm, NULL); 407 407 + } 408 408 + 409 409 + /* If we get here, we've failed... */ 410 410 + exit_with_error(T("This program requires OCaml ") SHORT_VERSION T("\n") 411 411 + T("Interpreter ("), (rntm_bindir_end + 1), 412 412 + T(") not found alongside the program or in " PATH_NAME)); 413 413 + } 414 414 + 279 415 #ifdef _WIN32 280 416 281 417 NORETURN void __cdecl wmainCRTStartup(void) 282 418 { 419 419 + wchar_t module[MAX_PATH]; 283 420 wchar_t truename[MAX_PATH]; 421 421 + uint32_t rntm_strlen = 0, rntm_bsz = 0; 284 422 char *runtime_path; 285 285 - wchar_t wruntime_path[MAX_PATH]; 423 423 + wchar_t wruntime_path[MAX_PATH], *dirname; 286 424 HANDLE h; 287 425 288 288 - if (GetModuleFileName(NULL, truename, sizeof(truename)/sizeof(wchar_t)) == 0) 426 426 + if (GetModuleFileName(NULL, module, sizeof(module)/sizeof(wchar_t)) == 0) 289 427 exit_with_error(L"Out of memory", NULL, NULL); 290 428 291 291 - h = CreateFile(truename, GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE, 429 429 + h = CreateFile(module, GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE, 292 430 NULL, OPEN_EXISTING, 0, NULL); 293 293 - if (h == INVALID_HANDLE_VALUE || 294 294 - (runtime_path = read_runtime_path(h)) == NULL || 295 295 - !MultiByteToWideChar(CP, 0, runtime_path, -1, wruntime_path, 296 296 - sizeof(wruntime_path)/sizeof(wchar_t))) 431 431 + 432 432 + 433 433 + /* read_runtime_path returns the actual size of RNTM, but the buffer returned 434 434 + is guaranteed to have a null character following the final character of 435 435 + RNTM. */ 436 436 + if (h == INVALID_HANDLE_VALUE 437 437 + || (runtime_path = read_runtime_path(h, &rntm_strlen)) == NULL 438 438 + || (rntm_bsz = 439 439 + MultiByteToWideChar(CP, 0, runtime_path, rntm_strlen + 1, 440 440 + wruntime_path, 441 441 + sizeof(wruntime_path)/sizeof(wchar_t))) == 0 442 442 + || GetFullPathName(module, sizeof(truename)/sizeof(wchar_t), truename, 443 443 + &dirname) >= sizeof(truename)/sizeof(wchar_t)) 297 444 exit_with_error(NULL, truename, 298 445 L" not found or is not a bytecode executable file"); 299 446 CloseHandle(h); 300 300 - exec_file(wruntime_path, GetCommandLine()); 301 447 302 302 - exit_with_error(L"Cannot exec ", wruntime_path, NULL); 448 448 + if (dirname) { 449 449 + /* GetFullPathName leaves dirname pointing to the first character of the 450 450 + basename, so setting that to NUL means the string pointed to by truename 451 451 + is the dirname of the currently running executable with a trailing 452 452 + separator (although search_and_exec_runtime will check that anyway) */ 453 453 + *dirname = 0; 454 454 + dirname = truename; 455 455 + } 456 456 + 457 457 + search_and_exec_runtime(wruntime_path, rntm_bsz, GetCommandLine(), dirname); 303 458 } 304 459 305 460 #else 306 461 307 462 int main(int argc, char *argv[]) 308 463 { 309 309 - char *truename, *runtime_path; 464 464 + char *truename, *runtime_path, *argv0_dirname; 465 465 + uint32_t rntm_strlen = 0; 310 466 int fd; 311 467 312 468 truename = searchpath(argv[0]); 313 469 fd = open(truename, O_RDONLY | O_BINARY); 314 314 - if (fd == -1 || (runtime_path = read_runtime_path(fd)) == NULL) 470 470 + if (fd == -1 || (runtime_path = read_runtime_path(fd, &rntm_strlen)) == NULL) 315 471 exit_with_error(NULL, truename, 316 472 " not found or is not a bytecode executable file"); 317 473 close(fd); 318 474 475 475 + #ifdef HAS_LIBGEN_H 476 476 + argv0_dirname = dirname(strdup(truename)); 477 477 + #else 478 478 + argv0_dirname = NULL; 479 479 + #endif 480 480 + 319 481 argv[0] = truename; 320 320 - exec_file(runtime_path, argv); 321 321 - 322 322 - exit_with_error("Cannot exec ", runtime_path, NULL); 482 482 + /* read_runtime_path returns the actual size of RNTM, but the buffer returned 483 483 + is guaranteed to have a null character following the final character of 484 484 + RNTM. */ 485 485 + search_and_exec_runtime(runtime_path, rntm_strlen + 1, argv, argv0_dirname); 323 486 } 324 487 325 488 #endif /* defined(_WIN32) */

+3 -3

testsuite/tools/cmdline.ml

reviewed

··· 160 160 let has_ocamlnat has_ocamlnat () = config := {!config with has_ocamlnat} in 161 161 let has_ocamlopt has_ocamlopt () = config := {!config with has_ocamlopt} in 162 162 let parse_search = function 163 163 - | "enable" -> true 164 164 - | "always" -> false 163 163 + | "fallback" -> true 164 164 + | "enable" -> false 165 165 | _ -> 166 166 raise (Arg.Bad 167 167 - "--with-runtime-search: argument should be either enable or always") 167 167 + "--with-runtime-search: argument should be either fallback or enable") 168 168 in 169 169 let has_runtime_search arg = 170 170 let has_runtime_search = Option.map parse_search arg in

+2 -2

testsuite/tools/environment.ml

reviewed

··· 84 84 | Bytesections.{name = Name.DLLS; len} when len > 0 -> true 85 85 | _ -> false 86 86 in 87 87 - let tendered runtime = 87 87 + let tendered (runtime, search) = 88 88 let header = if start = "#!" then Header_shebang else Header_exe in 89 89 let dlls = List.exists is_DLLS sections in 90 90 - Tendered {header; dlls; runtime} 90 90 + Tendered {header; dlls; runtime; search} 91 91 in 92 92 Option.fold ~none:Custom ~some:tendered (Byterntm.read_runtime toc ic)) 93 93 with End_of_file | Bytesections.Bad_magic_number ->

+4 -1

testsuite/tools/harness.ml

reviewed

··· 16 16 type launch_mode = Header_exe | Header_shebang 17 17 18 18 type executable = 19 19 - | Tendered of {header: launch_mode; dlls: bool; runtime: string} 19 19 + | Tendered of {header: launch_mode; 20 20 + dlls: bool; 21 21 + runtime: string; 22 22 + search: Byterntm.search_method} 20 23 | Custom 21 24 | Vanilla 22 25

+4 -1

testsuite/tools/harness.mli

reviewed

··· 23 23 24 24 (** Kinds of executable *) 25 25 type executable = 26 26 - | Tendered of {header: launch_mode; dlls: bool; runtime: string} 26 26 + | Tendered of {header: launch_mode; 27 27 + dlls: bool; 28 28 + runtime: string; 29 29 + search: Byterntm.search_method} 27 30 (** Tendered bytecode image. Executable uses the given mechanism to locate 28 31 a suitable runtime to execute the image. [dlls] is [true] if the 29 32 bytecode image requires additional C libraries to be loaded. [runtime]

+26 -6

testsuite/tools/testBytecodeBinaries.ml

reviewed

··· 83 83 program 84 84 else 85 85 failed, "compiled with -custom" 86 86 - | Tendered {runtime; header; _} -> 87 87 - let expected_runtime = 86 86 + | Tendered {runtime; header; search; _} -> 87 87 + let reported_runtime = 88 88 + match search with 89 89 + | Disable dir -> 90 90 + dir ^ runtime 91 91 + | Fallback dir -> 92 92 + Printf.sprintf "[%s/]%s" dir runtime 93 93 + | Enable -> 94 94 + runtime 95 95 + in 96 96 + let expected_search = 88 97 if Sys.win32 then 89 89 - "ocamlrun" 98 98 + Byterntm.Enable 90 99 else 91 91 - ocamlrun 100 100 + Byterntm.Disable 101 101 + (Filename.concat (Environment.bindir env) "") 92 102 in 93 103 let expected_launch_mode = 94 104 if Config.shebangscripts then ··· 96 106 else 97 107 Header_exe 98 108 in 109 109 + let pp_search f = function 110 110 + | Byterntm.Disable _ -> 111 111 + Format.pp_print_string f "disable" 112 112 + | Byterntm.Fallback _ -> 113 113 + Format.pp_print_string f "fallback" 114 114 + | Byterntm.Enable -> 115 115 + Format.pp_print_string f "enable" 116 116 + in 99 117 let pp_launch f = function 100 118 | Header_shebang -> Format.pp_print_string f "shebang" 101 119 | Header_exe -> Format.pp_print_string f "executable" ··· 110 128 in 111 129 let failed = 112 130 failed 113 113 - |> check expected_runtime runtime 131 131 + |> check expected_search search 132 132 + "search mechanism" pp_search 133 133 + |> check "ocamlrun" runtime 114 134 "runtime" Format.pp_print_string 115 135 |> check expected_launch_mode header 116 136 "launch mode" pp_launch 117 137 in 118 118 - failed, runtime 138 138 + failed, reported_runtime 119 139 in 120 140 Printf.printf " Runtime: %s\n Output: %s\n" runtime output; 121 141 if Sys.win32 && Filename.extension binary = ".exe" then begin

+8 -2

tools/objinfo.ml

reviewed

··· 292 292 p_title title; 293 293 List.iter print l 294 294 295 295 - let p_runtime = 296 296 - printf "Runtime:\n\t%s\n" 295 295 + let p_runtime (runtime, search) = 296 296 + let runtime = 297 297 + match search with 298 298 + | Byterntm.Enable -> runtime 299 299 + | Byterntm.Disable dir -> dir ^ runtime 300 300 + | Byterntm.Fallback dir -> Printf.sprintf "[%s]%s" dir runtime 301 301 + in 302 302 + printf "Runtime:\n\t%s\n" runtime 297 303 298 304 let dump_byte ic = 299 305 let toc = Bytesections.read_toc ic in

+29 -7

tools/ocamlsize

reviewed

··· 19 19 open(FILE, $f) || die("Cannot open $f"); 20 20 read(FILE, $header, 2); 21 21 if ($header eq '#!') { 22 22 - $path = <FILE>; 22 22 + chomp($path = <FILE>); 23 23 if ($path =~ m/\/sh$/) { 24 24 - # exec form of the shebang header 25 25 - $path = <FILE>; 24 24 + # shell-script form of the shebang header 25 25 + chomp($path = <FILE>); 26 26 + # exec form - used for -runtime-search absolute when the path to the 27 27 + # runtime isn't valid as a #! line. 26 28 if ($path =~ s/^exec '(.*)' "\$0" "\$@\"$/$1/ > 0) { 27 29 $path =~ s/'\\''/'/g; 30 30 + # Both -runtime-search fallback and -runtime-search enable define a 31 31 + # variable r with the name of the runtime (see bytecomp/bytelink.ml) 32 32 + } elsif ($path =~ s/^r='(.*)'$/$1/ > 0) { 33 33 + $path =~ s/'\\''/'/g; 34 34 + chomp($dir = <FILE>); 35 35 + # In -runtime-search fallback, there will also be a path to the 36 36 + # runtime defined the variable c. 37 37 + if ($dir =~ s/^c='(.*)'"\$r"$/$1/ > 0) { 38 38 + $dir =~ s/'\\''/'/g; 39 39 + $path = "[$dir]$path"; 40 40 + } 28 41 } else { 29 42 undef $path; 30 43 } ··· 45 58 } 46 59 print $f, ":\n" if ($#ARGV > 0); 47 60 if (not defined $path) { 48 48 - $path = 49 49 - $length{'RNTM'} > 0 ? 50 50 - substr(&read_section('RNTM'), 0, -1) : 51 51 - "(custom runtime)"; 61 61 + if ($length{'RNTM'} > 0) { 62 62 + $path = &read_section('RNTM'); 63 63 + # RNTM is "\0ocamlrun" for -runtime-search enable 64 64 + if ($path !~ s/^\0//) { 65 65 + # RNTM is "/path/to/ocamlrun" for -runtime-search disable and 66 66 + # "/path/to\0ocamlrun" for -runtime-search fallback. Transform the 67 67 + # embedded "\0" into a directory separator and display the directory 68 68 + # in square brackets (as above for the sh-case) 69 69 + $path =~ s/^([^\/\\]*)([\\\/])([^\0]*)\0(.*)$/[$1$2$3$2]$4/ 70 70 + } 71 71 + } else { 72 72 + $path = '(custom runtime)'; 73 73 + } 52 74 }; 53 75 printf ("\tcode: %-7d data: %-7d symbols: %-7d debug: %-7d\n", 54 76 $length{'CODE'}, $length{'DATA'},

+7

utils/clflags.ml

reviewed

··· 91 91 ref Config.target_bindir 92 92 and launch_method = 93 93 ref Config.launch_method 94 94 + and search_method = (* -search-method ... *) 95 95 + if Config.target_win32 then 96 96 + (* Historically, the native Windows ports are assumed to be finding ocamlrun 97 97 + using a PATH search. *) 98 98 + ref Config.Enable 99 99 + else 100 100 + ref Config.Disable 94 101 and plugin = ref false (* -plugin ... *) 95 102 and principal = ref false (* -principal *) 96 103 and real_paths = ref true (* -short-paths *)

+1

utils/clflags.mli

reviewed

··· 116 116 val use_runtime : string ref 117 117 val target_bindir : string ref 118 118 val launch_method : Config.launch_method ref 119 119 + val search_method : Config.search_method ref 119 120 val plugin : bool ref 120 121 val principal : bool ref 121 122 val print_variance : bool ref

+1

utils/config.common.ml.in

reviewed

··· 70 70 let naked_pointers = false 71 71 72 72 type launch_method = Executable | Shebang of string option 73 73 + type search_method = Disable | Fallback | Enable 73 74 74 75 let launch_method = 75 76 match launch_method with

+12

utils/config.mli

reviewed

··· 379 379 380 380 @since 5.5 *) 381 381 382 382 + (** Mechanisms used by tendered bytecode executables to locate the interpreter 383 383 + 384 384 + @since 5.5 *) 385 385 + type search_method = 386 386 + | Disable 387 387 + (** Interpreter searching disabled - check fixed absolute location only *) 388 388 + | Fallback 389 389 + (** Check fixed absolute location first, but fall back to a search if that 390 390 + fails *) 391 391 + | Enable 392 392 + (** Always search for the interpreter *) 393 393 + 382 394 val shebangscripts : bool 383 395 (** Whether the target supports shebang scripts 384 396