diff options
| -rw-r--r-- | stdlib/doc-syms.tl | 1 | ||||
| -rw-r--r-- | stream.c | 23 | ||||
| -rw-r--r-- | sysif.c | 20 | ||||
| -rw-r--r-- | sysif.h | 3 | ||||
| -rw-r--r-- | tests/018/process.tl | 14 | ||||
| -rw-r--r-- | txr.1 | 39 |
6 files changed, 95 insertions, 5 deletions
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 9cc7068e..b51932ba 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -14,6 +14,7 @@ ("*args*" "N-03DEE18A") ("*args-eff*" "N-03DEE18A") ("*args-full*" "N-03DEE18A") + ("*child-env*" "N-01BB2097") ("*doc-url*" "N-0003D10B") ("*filters*" "N-00E6A902") ("*gensym-counter*" "N-0387B1B1") @@ -4516,8 +4516,12 @@ static val open_subprocess(val name, val mode_str, val args, val fun) if (fun) funcall(fun); - if (argv) + if (argv) { + val ch_env = child_env; + if (ch_env != t) + replace_env(ch_env); execvp(argv[0], argv); + } _exit(errno); } else { int whichfd; @@ -4747,6 +4751,7 @@ static val run(val command, val args) val iter; int i, nargs, status = 0; struct save_fds sfds; + volatile val save_env, ch_env = child_env; args = default_null_arg(args); nargs = c_num(length(args), self) + 1; @@ -4762,23 +4767,32 @@ static val run(val command, val args) if (nargs < 0 || nargs == INT_MAX) uw_throwf(error_s, lit("~a: argument list overflow"), self, nao); + if (ch_env != t) { + save_env = env(); + replace_env(ch_env, nil); + } + wargv = coerce(const wchar_t **, chk_xalloc(nargs + 1, sizeof *wargv, self)); for (i = 0, iter = cons(command, args); iter; i++, iter = cdr(iter)) wargv[i] = c_str(car(iter), self); wargv[i] = 0; + if (status == 0) { #if HAVE_WSPAWN - status = _wspawnvp(_P_WAIT, c_str(command, self), wargv); + status = _wspawnvp(_P_WAIT, c_str(command, self), wargv); #else - status = w_spawnvp(_P_WAIT, c_str(command, self), nargs, wargv); + status = w_spawnvp(_P_WAIT, c_str(command, self), nargs, wargv); #endif + } free(strip_qual(wchar_t **, wargv)); gc_hint(args); uw_unwind { + if (ch_env != t) + replace_env(save_env, nil); fds_restore(&sfds); } @@ -4833,7 +4847,10 @@ static val run(val name, val args) } if (pid == 0) { + val ch_env = child_env; fds_clobber(&sfds, FDS_IN | FDS_OUT | FDS_ERR); + if (ch_env != t) + replace_env(ch_env); execvp(argv[0], argv); _exit(errno); } else { @@ -128,6 +128,8 @@ val atime_s, mtime_s, ctime_s; val atime_nsec_s, mtime_nsec_s, ctime_nsec_s; val path_s, dir_s, dirent_s; +val child_env_s; + #if HAVE_PWUID || HAVE_GRGID val passwd_s; #endif @@ -1173,7 +1175,9 @@ val exec_wrap(val file, val args_opt) self, nao), convert(char **, 0)), coerce(char **, chk_xalloc(nargs + 1, sizeof *argv, self))); val iter; - int i; + val ch_env = child_env; + val save_env = nil; + int res, i; for (i = 0, iter = cons(file, args); iter; i++, iter = cdr(iter)) { val arg = car(iter); @@ -1181,7 +1185,17 @@ val exec_wrap(val file, val args_opt) } argv[i] = 0; - if (execvp(argv[0], argv) < 0) + if (ch_env != t) { + save_env = env(); + replace_env(ch_env); + } + + res = execvp(argv[0], argv); + + if (ch_env != t) + replace_env(save_env); + + if (res < 0) uw_ethrowf(process_error_s, lit("~s ~a: ~d/~s"), self, file, num(errno), errno_to_str(errno), nao); uw_throwf(process_error_s, lit("~s ~a returned"), self, file, nao); @@ -2588,6 +2602,7 @@ void sysif_init(void) len_s = intern(lit("len"), user_package); pid_s = intern(lit("pid"), user_package); #endif + child_env_s = intern(lit("*child-env*"), user_package); dir_cls = cobj_register(dir_s); @@ -2989,6 +3004,7 @@ void sysif_init(void) reg_fun(intern(lit("setenv"), user_package), func_n3o(setenv_wrap, 2)); reg_fun(intern(lit("unsetenv"), user_package), func_n1(unsetenv_wrap)); #endif + reg_var(child_env_s, t); #if HAVE_GETEUID reg_fun(intern(lit("getuid"), user_package), func_n0(getuid_wrap)); @@ -36,6 +36,9 @@ extern val atime_s, mtime_s, ctime_s; extern val atime_nsec_s, mtime_nsec_s, ctime_nsec_s; extern val path_s; +extern val child_env_s; +#define child_env (deref(lookup_var_l(nil, child_env_s))) + val errno_to_file_error(int err); val env(void); val replace_env(val env_list); diff --git a/tests/018/process.tl b/tests/018/process.tl index 07ecfb64..a1970738 100644 --- a/tests/018/process.tl +++ b/tests/018/process.tl @@ -25,3 +25,17 @@ (mtest (fcmd (let ((*stdout* *stdnull*)) (sh "echo foo"))) "" (fcmd (let ((*stderr* *stdout*)) (sh "echo foo 1>&2"))) "foo\n"))) + +(mtest + (let ((*child-env* '("a=b"))) + (get-lines (open-process "/usr/bin/env" "r"))) + ("a=b") + (let ((*child-env* nil)) + (get-lines (open-process "/usr/bin/env" "r"))) + nil) + +(test + (fcmd + (let ((*child-env* '("a=b"))) + (run "/usr/bin/env"))) + "a=b\n") @@ -66094,6 +66094,45 @@ the original environment can be restored by passing that retained list to .codn replace-env . +.coNP Special variable @ *child-env* +.desc +The +.code *child-env* +variable specifies the list of command line variables established for programs +executed via the functions +.codn exec , +.codn run , +.codn sh , +.code open-command +and +.codn open-process . + +The initial top-level value of this variable is the symbol +.code t +which indicates that +.code *child-env* +is to be ignored, such that the executed program +inherits the current set of environment variables. + +If +.code *child-env* +has any other value, it must be a possibly empty list of environment +variables, in the same format as what is returned by +.code env +function and accepted by +.codn replace-env . +That value completely specifies the environment that executed programs +shall receive. + +.TP* Example: + +.verb + (let ((*child-env* '("a=b"))) + ;; /usr/bin/env sees only "a" environment variable + (get-lines (open-process "/usr/bin/env" "r"))) + -> ("a=b") +.brev + .SS* Command-Line-Option Processing \*(TL provides a support for recognizing, extracting and validating |