From fac84630825fdb3780fcd7891fb50e637eb3f910 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 7 Mar 2021 05:03:50 -0700 Subject: [PATCH] cs: fix `raco exe` for OpenBSD The repair involvea adding a `-E` flag to Racket for use by the wrap executable that `raco exe` created, because OpenBSD (intentionally) does not have a way to access the executable file of the current process. Closes #3717 --- .../scribblings/reference/startup.scrbl | 8 +++++++- racket/src/bc/cmdline.inc | 11 ++++++++-- racket/src/cs/c/main.c | 8 +++++++- racket/src/cs/main.sps | 20 +++++++++++++------ racket/src/cs/main/help.ss | 3 ++- racket/src/start/ustart.c | 11 ++++++++-- 6 files changed, 48 insertions(+), 13 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/startup.scrbl b/pkgs/racket-doc/scribblings/reference/startup.scrbl index ced0441712..dbba5e786c 100644 --- a/pkgs/racket-doc/scribblings/reference/startup.scrbl +++ b/pkgs/racket-doc/scribblings/reference/startup.scrbl @@ -333,6 +333,11 @@ flags: by @racket[(find-system-path 'run-file)] to @nonterm{file}.} + @item{@FlagFirst{E} @nonterm{file} or @DFlagFirst{exe} + @nonterm{file} : sets the name of the executable as reported + by @racket[(find-system-path 'exec-file)] to + @nonterm{file}.} + @item{@FlagFirst{J} @nonterm{name} or @DFlagFirst{wm-class} @nonterm{name} : GRacket, Unix only; sets the @tt{WM_CLASS} program class to @nonterm{name} (while the @tt{WM_CLASS} @@ -467,7 +472,8 @@ Extra arguments following the last option are available from the @history[#:changed "6.90.0.17" @elem{Added @Flag{O}/@DFlag{stdout}.} #:changed "7.1.0.5" @elem{Added @Flag{M}/@DFlag{compile-any}.} - #:changed "7.8.0.6" @elem{Added @Flag{Z}.}] + #:changed "7.8.0.6" @elem{Added @Flag{Z}.} + #:changed "8.0.0.10" @elem{Added @Flag{E}.}] @; ---------------------------------------------------------------------- diff --git a/racket/src/bc/cmdline.inc b/racket/src/bc/cmdline.inc index 8632a10479..b08b4e5a24 100644 --- a/racket/src/bc/cmdline.inc +++ b/racket/src/bc/cmdline.inc @@ -768,6 +768,8 @@ static int run_from_cmd_line(int argc, char *_argv[], argv[0] = "-m"; else if (!strcmp("--name", argv[0])) argv[0] = "-N"; + else if (!strcmp("--exec", argv[0])) + argv[0] = "-E"; else if (!strcmp("--no-compiled", argv[0])) argv[0] = "-c"; else if (!strcmp("--no-lib", argv[0])) @@ -1017,6 +1019,7 @@ static int run_from_cmd_line(int argc, char *_argv[], eval_kind[num_enl++] = mzcmd_EMBEDDED; break; case 'N': + case 'E': if (argc < 2) { PRINTF("%s: missing name after %s switch\n", prog, @@ -1025,13 +1028,16 @@ static int run_from_cmd_line(int argc, char *_argv[], } argv++; --argc; - sprog = argv[0]; - if (!*sprog) { + if (!*(argv[0])) { PRINTF("%s: empty path after %s switch\n", prog, real_switch); goto show_need_help; } + if (*str == 'N') + sprog = argv[0]; + else + prog = argv[0]; was_config_flag = 1; break; case 'q': @@ -1439,6 +1445,7 @@ static int run_from_cmd_line(int argc, char *_argv[], " -R , --compiled : Set compiled-file search roots to \n" " -C, --cross : Cross-build mode; save current collects and config as host\n" " -N , --name : Sets `(find-system-path 'run-file)' to \n" + " -E , --exec : Sets `(find-system-path 'exec-file)' to \n" # ifdef CMDLINE_STDIO_FLAG " -J , ---wm-class : Set WM_CLASS class to (Unix)\n" # endif diff --git a/racket/src/cs/c/main.c b/racket/src/cs/c/main.c index fcca0dcf0d..de5e564c91 100644 --- a/racket/src/cs/c/main.c +++ b/racket/src/cs/c/main.c @@ -172,7 +172,7 @@ static char *get_self_path(char *exec_file) # undef USE_GENERIC_GET_SELF_PATH #endif -#if defined(__FreeBSD__) +#if defined(__FreeBSD__) || defined(__NetBSD__) # include # include static char *get_self_path(char *exec_file) @@ -183,9 +183,15 @@ static char *get_self_path(char *exec_file) int r; mib[0] = CTL_KERN; +#if defined(__NetBSD__) + mib[1] = KERN_PROC_ARGS; + mib[2] = getpid(); + mib[3] = KERN_PROC_PATHNAME; +#else mib[1] = KERN_PROC; mib[2] = KERN_PROC_PATHNAME; mib[3] = -1; +#endif r = sysctl(mib, 4, NULL, &len, NULL, 0); if (r < 0) { diff --git a/racket/src/cs/main.sps b/racket/src/cs/main.sps index d4f75b1104..8230fef269 100644 --- a/racket/src/cs/main.sps +++ b/racket/src/cs/main.sps @@ -277,8 +277,8 @@ [else (values (car args) (append (reverse accum) (cdr args)))]))) - (define (check-path-arg what flag within-flag) - (when (equal? what "") + (define (check-path-arg path what flag within-flag) + (when (equal? path "") (startup-error "empty ~a after ~a switch" what (or within-flag flag)))) (define (raise-bad-switch arg within-arg) @@ -363,6 +363,7 @@ (let-values ([(file-name rest-args) (next-arg "file name" arg within-arg args)]) (add-namespace-require-load! `(file ,file-name) file-name) (no-init! saw) + (check-path-arg file-name "file name" arg within-arg) (set-run-file! (string->path file-name)) (flags-loop (cons "--" rest-args) (see saw 'non-config 'lib)))] [("-f" "--load") @@ -374,6 +375,7 @@ (let-values ([(file-name rest-args) (next-arg "file name" arg within-arg args)]) (set! loads (cons (lambda () (load file-name)) loads)) + (check-path-arg file-name "file name" arg within-arg) (set-run-file! (string->path file-name)) (flags-loop (cons "--" rest-args) (see saw 'non-config)))] [("-e" "--eval") @@ -458,18 +460,18 @@ (cond [(equal? collects-path "") (set! init-collects-dir 'disable)] - [else - (check-path-arg "collects path" arg within-arg) + [else + (check-path-arg collects-path "collects path" arg within-arg) (set! init-collects-dir (path->complete-path (->path (find-original-bytes collects-path))))]) (loop rest-args))] [("-S" "--search") (let-values ([(collects-path rest-args) (next-arg "path" arg within-arg args)]) - (check-path-arg "collects path" collects-path within-arg) + (check-path-arg collects-path "collects path" collects-path within-arg) (set! rev-collects-post-extra (cons (->path (find-original-bytes collects-path)) rev-collects-post-extra)) (loop rest-args))] [("-G" "--config") (let-values ([(config-path rest-args) (next-arg "config path" arg within-arg args)]) - (check-path-arg "config path" config-path within-arg) + (check-path-arg config-path "config path" config-path within-arg) (set! init-config-dir (path->complete-path (->path (find-original-bytes config-path)))) (loop rest-args))] [("-C" "--cross") @@ -506,8 +508,14 @@ (loop rest-args))] [("-N" "--name") (let-values ([(name rest-args) (next-arg "name" arg within-arg args)]) + (check-path-arg name "name" arg within-arg) (set-run-file! (string->path name)) (loop rest-args))] + [("-E" "--exec") + (let-values ([(name rest-args) (next-arg "name" arg within-arg args)]) + (check-path-arg name "name" arg within-arg) + (set-exec-file! (string->path name)) + (loop rest-args))] [("-J") (cond [gracket? diff --git a/racket/src/cs/main/help.ss b/racket/src/cs/main/help.ss index 5faceffa30..20c3101c92 100644 --- a/racket/src/cs/main/help.ss +++ b/racket/src/cs/main/help.ss @@ -51,7 +51,8 @@ " -U, --no-user-path : Ignore user-specific collects, etc.\n" " -R , --compiled : Set compiled-file search roots to \n" " -C, --cross : Cross-build mode; save current collects and config as host\n" - " -N , --name : Sets `(find-system-path 'run-file)' to \n")) + " -N , --name : Sets `(find-system-path 'run-file)' to \n" + " -E , --exec : Sets `(find-system-path 'exec-file)' to \n")) (when gracket? (#%printf " -J , ---wm-class : Set WM_CLASS class to (Unix)\n")) diff --git a/racket/src/start/ustart.c b/racket/src/start/ustart.c index 24c480bf4b..07c2aa363f 100644 --- a/racket/src/start/ustart.c +++ b/racket/src/start/ustart.c @@ -456,7 +456,7 @@ int main(int argc, char **argv) } data = (char *)malloc(end - prog_end); - new_argv = (char **)malloc((count + argc + (2 * collcount) + 10) * sizeof(char*)); + new_argv = (char **)malloc((count + argc + (2 * collcount) + 12) * sizeof(char*)); fd = open(me, O_RDONLY, 0); lseek(fd, prog_end, SEEK_SET); @@ -495,11 +495,18 @@ int main(int argc, char **argv) putenv(dll_path); } - new_argv[0] = me; + new_argv[0] = exe_path; argpos = 1; inpos = 1; + /* Add -E flag; we can't just put `me` in `argv[0]`, because some + OSes (well, just OpenBSD) cannot find the executable path of a + process, and the actual executable may be needed to find embedded + boot images. */ + new_argv[argpos++] = "-E"; + new_argv[argpos++] = me; + /* Keep all X11 flags to the front: */ if (x11) { int n;