Changeset 7308

Timestamp:

Sep 26, 2007, 7:14:02 PM (12 years ago)

Author:

wws

Message:

run-program and run-external-process take an additional "env" parameter,
a list of pairs. For each pair the environment variable (string (car pair)) is set
to (cdr pair) in the external program's environment before it is exec'd.

File:

• trunk/ccl/level-1/linux-files.lisp (modified) (4 diffs)

trunk/ccl/level-1/linux-files.lisp

@@ -839 +839 @@
                    (setq terminated t)))))))))
       
-(defun run-external-process (proc in-fd out-fd error-fd)
+(defun run-external-process (proc in-fd out-fd error-fd &optional env)
+  ;; type-check the env variable
+  (dolist (pair env)
+    (destructuring-bind (var . val) pair
+      (assert (typep var '(or string symbol character)))
+      (assert (typep val 'string)))) 
   (call-with-string-vector
    #'(lambda (argv)
@@ -846 +851 @@
          (cond ((zerop child-pid)
                 ;; Running in the child; do an exec
+                (dolist (pair env)
+                  (setenv (string (car pair)) (cdr pair)))
                 (without-interrupts
                  (exec-with-io-redirection
@@ -863 +870 @@
                             output (if-output-exists :error)
                             (error :output) (if-error-exists :error)
-                            status-hook (element-type 'character))
+                            status-hook (element-type 'character)
+                            env)
   "Invoke an external program as an OS subprocess of lisp."
   (declare (ignore pty))
@@ -912 +920 @@
             (format nil "Monitor thread for external process ~a" args)
                     
-            #'run-external-process proc in-fd out-fd error-fd)
+            #'run-external-process proc in-fd out-fd error-fd env)
            (wait-on-semaphore (external-process-signal proc))
            )