Make getenv thread-safe

Author: ruricolist

flags.lisp

@@ -1,27 +1,28 @@
 (defpackage :kiln/flags
   (:use :cl :serapeum :alexandria)
+  (:import-from :kiln/os :getenv :getenvp)
   (:export
-   :+kiln-debug+
-   :+kiln-heap-size+
-   :+kiln-lisp+
-   :+kiln-no-print-version+
-   :+kiln-stack-size+
-   :+kiln-path-systems+
-   :+kiln-poiu+
-   :+kiln-quicklisp+
-   :+kiln-target-file+
-   :+kiln-target-package+
-   :+kiln-target-system+
-   :+kiln-tolerant+
-   :*flags*
-   :dbg?
-   :dbg
-   :set-flags
-   :portable?
-   :repl-on-error?
-   :exit-code
-   :backtrace?
-   :with-debug-output))
+    :+kiln-debug+
+    :+kiln-heap-size+
+    :+kiln-lisp+
+    :+kiln-no-print-version+
+    :+kiln-stack-size+
+    :+kiln-path-systems+
+    :+kiln-poiu+
+    :+kiln-quicklisp+
+    :+kiln-target-file+
+    :+kiln-target-package+
+    :+kiln-target-system+
+    :+kiln-tolerant+
+    :*flags*
+    :dbg?
+    :dbg
+    :set-flags
+    :portable?
+    :repl-on-error?
+    :exit-code
+    :backtrace?
+    :with-debug-output))
 (in-package :kiln/flags)
 
 (defvar *flags* nil)
@@ -51,15 +52,15 @@
                             (mapcar (op (drop-prefix "--" _))
                                     value))))
   (when (memq :debug *flags*)
-    (setf (uiop:getenv "KILN_DEBUG") "1"))
+    (setf (getenv "KILN_DEBUG") "1"))
   *flags*)
 
 (defun portable? ()
   (memq :portable *flags*))
 
 (defun dbg? ()
   (or (memq :debug *flags*)
-      (uiop:getenvp "KILN_DEBUG")))
+      (getenvp "KILN_DEBUG")))
 
 (defun call/debug-output (fn)
   (let ((*standard-output*

os.lisp

@@ -13,8 +13,6 @@
    :uiop
    :file-exists-p
    :directory-exists-p
-   :getenv
-   :getenvp
    :hostname)
   (:shadow
    ;; TODO Remove when Quicklisp updates
@@ -60,6 +58,21 @@
 (defun (setf getcwd) (dir)
   (chdir dir))
 
+(def env-lock (bt:make-lock))
+
+(defun getenv (name)
+  (bt:with-lock-held (env-lock)
+    (uiop:getenv name)))
+
+(defun getenvp (name)
+  (let ((name (getenv name)))
+    (and (not (emptyp name))
+         name)))
+
+(defun (setf getenv) (value name)
+  (bt:with-lock-held (env-lock)
+    (setf (uiop:getenv name) value)))
+
 (defun call/save-directory (fn)
   (let ((start-dir (uiop:getcwd)))
     (unwind-protect