[Chicken-hackers] [PATCH] Make process procedures in the posix module accept alists for environments.

[Kooda]

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
---
 manual/Unit posix | 10 +++++-----
 posix-common.scm  | 15 ++++++++++++++-
 posixunix.scm     |  2 +-
 posixwin.scm      |  2 +-
 types.db          |  6 +++---
 5 files changed, 24 insertions(+), 11 deletions(-)

diff --git a/manual/Unit posix b/manual/Unit posix
index a79894e8..448b4ad7 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..f3d444c9 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,9 @@ EOF
 
          ;; Envlist is never converted, so we always use nop here
          (when envlist
-           (set! envbuf (list->c-string-buffer envlist nop 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 fa794f99..b6333525 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1580,7 +1580,7 @@ EOF
                 (begin
                   (set! args (##sys#shell-command-arguments cmd))
                   (set! cmd (##sys#shell-command)) ) )
-            (when env (chkstrlst env))
+            (when env (check-environment-list env loc))
             (##sys#call-with-values 
             (lambda () (##sys#process loc cmd args env #t #t err?))
             k)))))
diff --git a/posixwin.scm b/posixwin.scm
index 7d3021da..343b03d1 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -1261,7 +1261,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 edd0c42a..1da17d1c 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))
 
-- 
2.11.1