Skip to content

Commit

Permalink
Fix passing environment variables.
Browse files Browse the repository at this point in the history
  • Loading branch information
orivej committed Jun 4, 2015
1 parent 8ad9f5a commit 4114fc9
Show file tree
Hide file tree
Showing 5 changed files with 43 additions and 27 deletions.
2 changes: 1 addition & 1 deletion src/cmucl.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@
environment)))
(setf (getf rest :env)
(if replace-environment-p
(append env '((:PATH . "")))
env
(append env ext:*environment-list*))))
(remf rest :replace-environment-p)
(remf rest :environment)
Expand Down
2 changes: 1 addition & 1 deletion src/openmcl.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@
(defmethod run
(program args &rest rest &key replace-environment-p &allow-other-keys)
(when replace-environment-p
(setf args (append (list "-i" program "PATH=''") args))
(setf args (append (list "-i" program) args))
(setf program "env"))
(process-status (apply #'ccl:run-program
program (stringify-args args) :wait t
Expand Down
4 changes: 2 additions & 2 deletions src/sbcl.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -11,10 +11,10 @@
(warn "No environment control in SBCL on Windows.")
(remf rest :environment))
#-win32
(let ((env (reformat-environment environment)))
(let ((env (environment-list environment)))
(setf (getf rest :environment)
(if replace-environment-p
(append env '("PATH=''"))
env
(append env (sb-ext:posix-environ)))))
(remf rest :replace-environment-p)
rest)
Expand Down
21 changes: 10 additions & 11 deletions src/utilities.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -8,31 +8,30 @@
(defun stringify-args (args)
(mapcar (lambda (arg)
(typecase arg
(string arg)
(sequence (coerce arg 'string))
((or symbol character) (string arg))
(number (format nil "~a" arg))
(number (princ-to-string arg))
(pathname (namestring arg))))
args))

(defun reformat-environment (environment)
"SBCL accepts vars as either (\"FOO=meh\" ...) or ((:foo . \"meh\")
...), but not ((\"FOO\" . \"meh\") ...), so we build up the first
kind (since the second kind is potentially lossy)."
;; FIXME: probably need to escape single-quotes and backslashes
(mapcar (lambda (var) (format nil "~a='~a'" (car var) (cdr var)))
(defun environment-list (environment)
"Convert ENVIRONMENT alist to a POSIX environment list."
(mapcar (lambda (var) (format nil "~a=~a" (car var) (cdr var)))
environment))

(defun embed-environment (program args environment replace-environment-p)
(if (or environment replace-environment-p)
(values "env"
(append (when replace-environment-p (list "-i" "PATH=''"))
(reformat-environment environment)
(append (when replace-environment-p (list "-i"))
(environment-list environment)
(cons program args)))
(values program args)))

(defun make-shell-string (program args environment replace-environment-p)
(format nil "~:[~;env -i PATH=''~] ~{~a ~}~a~{ ~s~}"
;; FIXME Perform shell escaping (assuming shell is BASH?)
(format nil "~:[~;env -i~] ~{~a ~}~a~{ ~s~}"
replace-environment-p
(reformat-environment environment)
(environment-list environment)
program
(stringify-args args)))
41 changes: 29 additions & 12 deletions tests/tests.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -8,15 +8,6 @@

(in-suite tests)

;;; FIXME: should probably signal a condition if program isn't found
;;; ... but can't guarantee that 71 isn't returned by the program
;;; itself ...
(test should-have-access-to-shell-builtins
(multiple-value-bind (status code)
(external-program:run "cd" '())
(is (eq :exited status))
(is (= 0 code))))

(test should-discover-programs-in-path
(multiple-value-bind (status code)
(external-program:run "which" '("ls"))
Expand Down Expand Up @@ -58,7 +49,33 @@
(is (/= 0 code))))

(test empty-env-should-erase-all
(multiple-value-bind (status code)
(external-program:run "ls" '(".") :replace-environment-p t)
(let* (status
code
(output
(with-output-to-string (out)
(multiple-value-setq (status code)
#-(or clisp ecl)
(external-program:run "/usr/bin/env" nil :output out :environment nil :replace-environment-p t)
#+(or clisp ecl)
(external-program:run "/usr/bin/env" nil :environment nil :replace-environment-p t)))))
(is (eq :exited status))
(is (/= 0 code))))
(is (= 0 code))
#-(or clisp ecl)
(is-false (search "=" output))))

#-(or clisp ecl)
(test environment-vars-should-be-set
(let* ((environment '(("external program test var" . "test val")))
status
code
(output
(with-output-to-string (out)
(multiple-value-setq (status code)
#-(or clisp ecl)
(external-program:run "env" nil :output out :environment environment)
#+(or clisp ecl)
(external-program:run "env" nil :environment environment)))))
(is (eq :exited status))
(is (= 0 code))
#-(or clisp ecl)
(is-true (search "external program test var=test val" output))))

0 comments on commit 4114fc9

Please sign in to comment.