~ chicken-core (chicken-5) 83010488d7649aafc577344182dd518015ac6fdf


commit 83010488d7649aafc577344182dd518015ac6fdf
Author:     Kooda <kooda@upyum.com>
AuthorDate: Wed Mar 1 12:10:00 2017 +0100
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Fri Mar 10 15:36:40 2017 +1300

    Make process procedures in the posix module accept alists for environments.
    
    Previously, environments were passed as a list of strings in the form "name=value",
    which seemed inconsistent with the get-environment-variables which hands out an alist.
    
    This fixes #1270.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/manual/Unit posix b/manual/Unit posix
index 6097ab3b..93e107b6 100644
--- a/manual/Unit posix	
+++ b/manual/Unit posix	
@@ -641,15 +641,15 @@ Get or set the process group ID of the process specified by {{PID}}.
 
 ==== process-execute
 
-<procedure>(process-execute PATHNAME [ARGUMENT-LIST [ENVIRONMENT-LIST]])</procedure>
+<procedure>(process-execute PATHNAME [ARGUMENT-LIST [ENVIRONMENT-ALIST]])</procedure>
 
 Replaces the running process with a new process image from the program
 stored at {{PATHNAME}}, using the C library function {{execvp(3)}}.
 If the optional argument {{ARGUMENT-LIST}} is given, then it should
 contain a list of strings which are passed as arguments to the subprocess.
-If the optional argument {{ENVIRONMENT-LIST}} is supplied, then the library
+If the optional argument {{ENVIRONMENT-ALIST}} is supplied, then the library
 function {{execve(2)}} is used, and the environment passed in
-{{ENVIRONMENT-LIST}} (which should be of the form {{("<NAME>=<VALUE>" ...)}}
+{{ENVIRONMENT-ALIST}} (which should be of the form {{(("<NAME>" . "<VALUE>") ...)}})
 is given to the invoked process. Note that {{execvp(3)}} respects the
 current setting of the {{PATH}} environment variable while {{execve(3)}} does not.
 
@@ -708,7 +708,7 @@ are suspended as well.
 ==== process
 
 <procedure>(process COMMANDLINE)</procedure><br>
-<procedure>(process COMMAND ARGUMENT-LIST [ENVIRONMENT-LIST])</procedure>
+<procedure>(process COMMAND ARGUMENT-LIST [ENVIRONMENT-ALIST])</procedure>
 
 Creates a subprocess and returns three values: an input port from
 which data written by the sub-process can be read, an output port from
@@ -724,7 +724,7 @@ its standard error into a separate port).
 * The single parameter version passes the string {{COMMANDLINE}} to the host-system's shell that
 is invoked as a subprocess.
 * The multiple parameter version directly invokes the {{COMMAND}} as a subprocess. The {{ARGUMENT-LIST}}
-is directly passed, as is {{ENVIRONMENT-LIST}}.
+is directly passed, as is {{ENVIRONMENT-ALIST}}.
 
 Not using the shell may be preferrable for security reasons.
 
diff --git a/posix-common.scm b/posix-common.scm
index f8fe27fa..d12edeba 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -741,6 +741,16 @@ EOF
       (and-let* ((s (pointer-vector-ref buffer-array i)))
 	(free s)))))
 
+;; Environments are represented as string->string association lists
+(define (check-environment-list lst loc)
+  (##sys#check-list lst loc)
+  (for-each
+   (lambda (p)
+     (##sys#check-pair p loc)
+     (##sys#check-string (car p) loc)
+     (##sys#check-string (cdr p) loc))
+   lst))
+
 (define call-with-exec-args
   (let ((pathname-strip-directory pathname-strip-directory)
 	(nop (lambda (x) x)))
@@ -758,6 +768,10 @@ EOF
 
 	  ;; Envlist is never converted, so we always use nop here
 	  (when envlist
-	    (set! envbuf (list->c-string-buffer envlist nop loc)))
+	    (check-environment-list envlist loc)
+	    (set! envbuf
+	      (list->c-string-buffer
+	       (map (lambda (p) (string-append (car p) "=" (cdr p))) envlist)
+	       nop loc)))
 
 	  (proc (##sys#make-c-string filename loc) argbuf envbuf))))))
diff --git a/posixunix.scm b/posixunix.scm
index dee77c37..40b5b757 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1582,8 +1582,8 @@ EOF
                 (begin
                   (set! args (##sys#shell-command-arguments cmd))
                   (set! cmd (##sys#shell-command)) ) )
-            (when env (chkstrlst env))
-            (##sys#call-with-values 
+	    (when env (check-environment-list env loc))
+	    (##sys#call-with-values
 	     (lambda () (##sys#process loc cmd args env #t #t err?))
 	     k)))))
   (set! process
diff --git a/posixwin.scm b/posixwin.scm
index 7a10a707..02fc62f2 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -1262,7 +1262,7 @@ EOF
 		(set! exactf #t)
 		(set! args (##sys#shell-command-arguments cmd))
 		(set! cmd (##sys#shell-command)) ) )
-	    (when env (chkstrlst env))
+	    (when env (check-environment-list env loc))
 	    (receive [in out pid err] (##sys#process loc cmd args env #t #t err? exactf)
 	      (if err?
 		(values in out pid err)
diff --git a/types.db b/types.db
index b32a36dd..ea181e9f 100644
--- a/types.db
+++ b/types.db
@@ -2016,11 +2016,11 @@
 (chicken.posix#perm/ixusr fixnum)
 (chicken.posix#pipe/buf fixnum)
 (chicken.posix#port->fileno (#(procedure #:clean #:enforce) chicken.posix#port->fileno (port) fixnum))
-(chicken.posix#process (#(procedure #:clean #:enforce) chicken.posix#process (string #!optional (list-of string) (list-of string)) input-port output-port fixnum))
-(chicken.posix#process* (#(procedure #:clean #:enforce) chicken.posix#process* (string #!optional (list-of string) (list-of string)) input-port output-port fixnum *))
+(chicken.posix#process (#(procedure #:clean #:enforce) chicken.posix#process (string #!optional (list-of string) (list-of (pair string string))) input-port output-port fixnum))
+(chicken.posix#process* (#(procedure #:clean #:enforce) chicken.posix#process* (string #!optional (list-of string) (list-of (pair string string))) input-port output-port fixnum *))
 
 (chicken.posix#process-execute
- (#(procedure #:clean #:enforce) chicken.posix#process-execute (string #!optional (list-of string) (list-of string)) noreturn))
+ (#(procedure #:clean #:enforce) chicken.posix#process-execute (string #!optional (list-of string) (list-of (pair string string))) noreturn))
 
 (chicken.posix#process-fork (#(procedure #:enforce) chicken.posix#process-fork (#!optional (or (procedure () . *) false) *) fixnum))
 
Trap