>From 353e83d8402c6289f5c6c2390955acf1204dd62b Mon Sep 17 00:00:00 2001
From: Kooda
Date: Wed, 1 Mar 2017 12:10:00 +0100
Subject: [PATCH] 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
---
manual/Unit posix | 10 +++++-----
posix-common.scm | 16 +++++++++++++++-
posixunix.scm | 2 +-
posixwin.scm | 2 +-
types.db | 6 +++---
5 files changed, 25 insertions(+), 11 deletions(-)
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
-(process-execute PATHNAME [ARGUMENT-LIST [ENVIRONMENT-LIST]])
+(process-execute PATHNAME [ARGUMENT-LIST [ENVIRONMENT-ALIST]])
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 {{("=" ...)}}
+{{ENVIRONMENT-ALIST}} (which should be of the form {{(("" . "") ...)}})
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
(process COMMANDLINE)
-(process COMMAND ARGUMENT-LIST [ENVIRONMENT-LIST])
+(process COMMAND ARGUMENT-LIST [ENVIRONMENT-ALIST])
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..b9d68c60 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..03340e12 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1582,7 +1582,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 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))
--
2.11.1