From 6215a0f5f5c326c3ce952e333c2d68dd7c7fed6a Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 25 Sep 2021 13:09:01 -0700
Subject: New function: replace-env.

Using this new function together with env, it's now possible
to save the set of environment variables, clobber it to a
specified set (possibly empty) and then restore it.

Useful for improved security in running child processes.

* lib.[ch] (chk_substrdup_utf8): New function.

* sysif.c (replace_env): New function.
(sysif_init): Register replace-env intrinsic.

* sysif.h (replace_env): Declared.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.
---
 lib.c              | 15 +++++++++++++++
 lib.h              |  1 +
 stdlib/doc-syms.tl |  1 +
 sysif.c            | 35 +++++++++++++++++++++++++++++++++++
 sysif.h            |  1 +
 txr.1              | 45 +++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 98 insertions(+)

diff --git a/lib.c b/lib.c
index 534013eb..cf2d6cf8 100644
--- a/lib.c
+++ b/lib.c
@@ -4293,6 +4293,21 @@ char *chk_strdup_utf8(const char *str)
   return copy;
 }
 
+char *chk_substrdup_utf8(const char *str, size_t off, size_t len)
+{
+  size_t size = strlen(str) + 1, nchar;
+  char *copy;
+  if (off >= size - 1)
+    return chk_strdup_utf8("");
+  if (off + len < off)
+    uw_throw(error_s, lit("string size overflow"));
+  nchar = min(size - off, len + 1);
+  copy = coerce(char *, chk_malloc(nchar));
+  memcpy(copy, str, nchar - 1);
+  copy[nchar - 1] = 0;
+  return copy;
+}
+
 unsigned char *chk_strdup_8bit(const wchar_t *str)
 {
   size_t nchar = wcslen(str) + 1, i;
diff --git a/lib.h b/lib.h
index f5b5ed42..25cfc6d1 100644
--- a/lib.h
+++ b/lib.h
@@ -735,6 +735,7 @@ wchar_t *chk_wrealloc(wchar_t *, size_t nwchar);
 wchar_t *chk_strdup(const wchar_t *str);
 wchar_t *chk_substrdup(const wchar_t *str, size_t off, size_t len);
 char *chk_strdup_utf8(const char *str);
+char *chk_substrdup_utf8(const char *str, size_t off, size_t len);
 unsigned char *chk_strdup_8bit(const wchar_t *str);
 mem_t *chk_copy_obj(mem_t *orig, size_t size);
 mem_t *chk_xalloc(ucnum m, ucnum n, val self);
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index c9fcf582..9cc7068e 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -1584,6 +1584,7 @@
       ("repeat" "D-006A")
       ("replace" "N-035991E1")
       ("replace-buf" "N-01C59E4E")
+      ("replace-env" "N-03C59E3B")
       ("replace-list" "N-03E43DA2")
       ("replace-str" "N-02059F0A")
       ("replace-struct" "N-01A8343B")
diff --git a/sysif.c b/sysif.c
index 2c8bc6b0..d1fefdce 100644
--- a/sysif.c
+++ b/sysif.c
@@ -336,6 +336,40 @@ val env(void)
   }
 }
 
+val replace_env(val env_list)
+{
+#if HAVE_ENVIRON && HAVE_SETENV
+  val self = lit("replace-env");
+  extern char **environ;
+  val iter;
+  static char *empty_env[1];
+
+  environ = empty_env;
+
+  for (iter = env_list; iter; iter = cdr(iter)) {
+    const wchar_t *pair = c_str(car(iter), self);
+    char *pair8 = utf8_dup_to(pair);
+    char *eq = strchr(pair8, '=');
+    int res;
+    if (eq != 0) {
+      char *name = chk_substrdup_utf8(pair8, 0, eq - pair8);
+      res = setenv(name, eq + 1, 1);
+      free(name);
+    } else {
+      res = setenv(pair8, "", 1);
+    }
+    free(pair8);
+    if (res < 0)
+      uw_ethrowf(system_error_s, lit("~a: setenv failed: ~d/~s"),
+                 self, num(errno), errno_to_str(errno), nao);
+  }
+
+  return env_list;
+#else
+  uw_throwf(error_s, lit("environ mechanism not available"), nao);
+#endif
+}
+
 static val get_env_hash(void)
 {
   if (env_hash) {
@@ -2703,6 +2737,7 @@ void sysif_init(void)
 #endif
 
   reg_fun(intern(lit("env"), user_package), func_n0(env));
+  reg_fun(intern(lit("replace-env"), user_package), func_n1(replace_env));
   reg_fun(intern(lit("env-hash"), user_package), func_n0(get_env_hash));
 
 #if HAVE_DAEMON
diff --git a/sysif.h b/sysif.h
index 1001368d..6dc150e2 100644
--- a/sysif.h
+++ b/sysif.h
@@ -38,6 +38,7 @@ extern val path_s;
 
 val errno_to_file_error(int err);
 val env(void);
+val replace_env(val env_list);
 val getenv_wrap(val name);
 val errno_to_str(int err);
 val at_exit_call(val func);
diff --git a/txr.1 b/txr.1
index a48a881c..dc8b6cf0 100644
--- a/txr.1
+++ b/txr.1
@@ -66049,6 +66049,51 @@ The
 function accesses the underlying environment and updates the hash
 table with the name-value pair which is retrieved.
 
+.coNP Function @ replace-env
+.synb
+.mets (replace-env << env-list )
+.syne
+.desc
+The
+.code replace-env
+function replaces the environment with the environment variables specified in
+.metn env-list .
+The argument is a list of character strings, in the same format
+as the list returned by the
+.code env
+function: each element of the list describes an environment variable
+as a single character string in which the name is separated by the
+value by the
+.code =
+character. As a special concession, if this character is missing, the
+.code replace-env
+function treats that entry as being a name with an empty value.
+
+The
+.code replace-env
+first empties the existing environment, rendering it devoid of environment
+variables. Then it installs the entries specified in
+.metn env-list .
+
+The return value is
+.metn env-list .
+
+Note:
+.code replace-env
+may be used to specify an exact environment to child programs executed
+by functions like
+.codn open-process ,
+.code sh
+or
+.codn run .
+
+Note: the previous environment may be saved by calling
+.code env
+and retaining the returned list. Then after modifying the environment,
+the original environment can be restored by passing that retained
+list to
+.codn replace-env .
+
 .SS* Command-Line-Option Processing
 
 \*(TL provides a support for recognizing, extracting and validating
-- 
cgit v1.2.3