1.0.33.21: safe SB-POSIX:PUTENV

 Reported by Fare Rideau: POSIX putenv() puts the actual string it is
 passed into environ, which is definitely wrong for any lisp string.

 Since we don't want to leak memory either, implement our own putenv()
 on top of setenv() -- and the other way around on Windows which
 doesn't have setenv().

 Messed up is what this is -- to keep a semblance of sanity add
 test-cases.

diff --git a/NEWS b/NEWS
index 9f0485b..f322498 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,9 @@ changes relative to sbcl-1.0.33:
        has been improved.
     ** there is now an implementation of the ucs-4 external format.
     ** the utf-16 and utf-32 external formats are supported.
+  * bug fix: SB-POSIX wrapper for putenv no longer tries to put lisp strings
+    in the environment. setenv() and unsetenv() are also provided. (reported by
+    Fare Rideau; launchpad bug lp#460455)
   * bug fix: #p"\\\\" can now be read without error on Win32.  (reported by
     Willem Broekema; launchpad bug lp#489698).
   * bug fix: some minor code rearrangements to reenable warning-free building

diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index b680ce2..c09968a 100644 (file)
--- a/contrib/sb-posix/interface.lisp
+++ b/contrib/sb-posix/interface.lisp
@@ -736,7 +736,38 @@
     (declare (type (alien (* char)) r))
     (unless (null-alien r)
       (cast r c-string))))
-(define-call "putenv" int minusp (string c-string))
+#-win32
+(progn
+  (define-call "setenv" int minusp (name c-string) (value c-string) (overwrite int))
+  (define-call "unsetenv" int minusp (name c-string))
+  (export 'putenv :sb-posix)
+  (defun putenv (string)
+    (declare (string string))
+    ;; We don't want to call actual putenv: the string passed to putenv ends
+    ;; up in environ, and we any string we allocate GC might move.
+    ;;
+    ;; This makes our wrapper nonconformant if you squit hard enough, but
+    ;; users who care about that should really be calling putenv() directly in
+    ;; order to be able to manage memory sanely.
+    (let ((p (position #\= string))
+          (n (length string)))
+      (if p
+          (if (= p n)
+              (unsetenv (subseq string 0 p))
+              (setenv (subseq string 0 p) (subseq string (1+ p)) 1))
+          (error "Invalid argument to putenv: ~S" string)))))
+#+win32
+(progn
+  ;; Windows doesn't define a POSIX setenv, but happily their _putenv is sane.
+  (define-call* "putenv" int minusp (string c-string))
+  (defun setenv (name value overwrite)
+    (declare (string name value))
+    (if (and (zerop overwrite) (sb-posix:getenv name))
+        0
+        (putenv (concatenate 'string name "=" value))))
+  (defun unsetenv (name)
+    (declare (string name))
+    (putenv (concatenate 'string name "="))))
 
 ;;; syslog
 #-win32

diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp
index 69a00a7..300b322 100644 (file)
--- a/contrib/sb-posix/posix-tests.lisp
+++ b/contrib/sb-posix/posix-tests.lisp
@@ -823,3 +823,31 @@
                (values (integerp fd) (pathname-name pathname))
             (delete-file temp)))))
   t "mkstemp-1")
+
+(deftest envstuff
+    (let ((name1 "ASLIFJLSDKFJKAHGSDKLJH")
+          (name2 "KJHFKLJDSHIUYHBSDNFCBH"))
+      (values (sb-posix:getenv name1)
+              (sb-posix:getenv name1)
+              (progn
+                (sb-posix:putenv (concatenate 'string name1 "=name1,test1"))
+                (sb-ext:gc :full t)
+                (sb-posix:getenv name1))
+              (progn
+                (sb-posix:setenv name1 "name1,test2" 0)
+                (sb-ext:gc :full t)
+                (sb-posix:getenv name1))
+              (progn
+                (sb-posix:setenv name2 "name2,test1" 0)
+                (sb-ext:gc :full t)
+                (sb-posix:getenv name2))
+              (progn
+                (sb-posix:setenv name2 "name2,test2" 1)
+                (sb-ext:gc :full t)
+                (sb-posix:getenv name2))))
+  nil
+  nil
+  "name1,test1"
+  "name1,test1"
+  "name2,test1"
+  "name2,test2")

diff --git a/version.lisp-expr b/version.lisp-expr
index 77ae1d3..c2944e2 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.33.20"
+"1.0.33.21"