From 6acd6b551eab542ff8833ad87460d03d2ebdcf41 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Tue, 16 Apr 2013 11:40:16 +0200 Subject: [PATCH] Add a DIRECTORY keyword argument to function RUN-PROGRAM. The implementation uses chdir(2) on Unices, the lpCurrentDirectory argument to CreateProcessW on Windows. Closes: lp#791800 --- NEWS | 2 ++ src/code/run-program.lisp | 35 ++++++++++++++++++++--------------- src/code/warm-mswin.lisp | 4 ++-- src/runtime/run-program.c | 40 ++++++++++++++++++++++++++++++---------- tests/run-program.impure.lisp | 14 ++++++++++++++ 5 files changed, 68 insertions(+), 27 deletions(-) diff --git a/NEWS b/NEWS index 881e5b3..6f1a5b9 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,7 @@ ;;;; -*- coding: utf-8; fill-column: 78 -*- changes relative to sbcl-1.1.6 + * enhancement: RUN-PROGRAM supports a :DIRECTORY keyword argument to + optionally set the working directory of the spawned process (lp#791800) * bug fix: :allocation slot option works for condition slots (lp#1049404) * bug fix: redefining conditions does not lead to multiple evaluations of diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index bec0abe..92a270b 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -555,7 +555,8 @@ status slot." (search sb-alien:int) (envp (* sb-alien:c-string)) (pty-name sb-alien:c-string) - (wait sb-alien:int)) + (wait sb-alien:int) + (pwd sb-alien:c-string)) ;;; FIXME: There shouldn't be two semiredundant versions of the ;;; documentation. Since this is a public extension function, the @@ -617,7 +618,8 @@ status slot." (error :output) (if-error-exists :error) status-hook - (external-format :default)) + (external-format :default) + (directory nil directory-p)) #+sb-doc #.(concatenate 'string @@ -809,23 +811,26 @@ Users Manual for details about the PROCESS structure."#-win32" (with-args-vec (args-vec simple-args) (with-no-with (#+win32 (environment-vec)) (with-environment-vec (environment-vec) - (setq child - #+win32 - (sb-win32::mswin-spawn - progname - (with-output-to-string (argv) - (dolist (arg simple-args) - (write-string arg argv) - (write-char #\Space argv))) - stdin stdout stderr - search nil wait) - #-win32 - (without-gcing + (let ((pwd-string + (and directory-p (native-namestring directory)))) + (setq child + #+win32 + (sb-win32::mswin-spawn + progname + (with-output-to-string (argv) + (dolist (arg simple-args) + (write-string arg argv) + (write-char #\Space argv))) + stdin stdout stderr + search nil wait pwd-string) + #-win32 + (without-gcing (spawn progname args-vec stdin stdout stderr (if search 1 0) environment-vec pty-name - (if wait 1 0)))) + (if wait 1 0) + pwd-string)))) (unless (minusp child) (setf proc (apply diff --git a/src/code/warm-mswin.lisp b/src/code/warm-mswin.lisp index 5a973ff..9bf586b 100644 --- a/src/code/warm-mswin.lisp +++ b/src/code/warm-mswin.lisp @@ -67,7 +67,7 @@ (define-alien-routine ("GetExitCodeThread" get-exit-code-thread) int (handle handle) (exit-code dword :out)) -(defun mswin-spawn (program argv stdin stdout stderr searchp envp waitp) +(defun mswin-spawn (program argv stdin stdout stderr searchp envp waitp pwd) (declare (ignorable envp)) (let ((std-handles (multiple-value-list (get-std-handles))) (inheritp nil)) @@ -93,7 +93,7 @@ (if (create-process (if searchp nil program) argv nil nil - inheritp 0 nil nil + inheritp 0 nil pwd (alien-sap startup-info) (alien-sap process-information)) (let ((child (slot process-information 'process-handle))) diff --git a/src/runtime/run-program.c b/src/runtime/run-program.c index ef9c51c..16eb74b 100644 --- a/src/runtime/run-program.c +++ b/src/runtime/run-program.c @@ -100,12 +100,15 @@ set_pty(char *pty_name) extern char **environ; int spawn(char *program, char *argv[], int sin, int sout, int serr, - int search, char *envp[], char *pty_name, int wait) + int search, char *envp[], char *pty_name, int wait, char *pwd) { pid_t pid; int fd; int channel[2]; sigset_t sset; + int fail; + + fail = 0; channel[0] = -1; channel[1] = -1; @@ -193,16 +196,25 @@ int spawn(char *program, char *argv[], int sin, int sout, int serr, if (fd != channel[1]) close(fd); #endif - if (envp) { - environ = envp; + /* Change working directory. */ + if (pwd) { + if (chdir(pwd) < 0) { + fail = 1; + } + } + + if (!fail) { + if (envp) { + environ = envp; + } + /* Exec the program. */ + if (search) + execvp(program, argv); + else + execv(program, argv); } - /* Exec the program. */ - if (search) - execvp(program, argv); - else - execv(program, argv); - /* When exec fails and channel is available, send the errno value. */ + /* When exec or chdir fails and channel is available, send the errno value. */ if (-1 != channel[1]) { int our_errno = errno; int bytes = sizeof(int); @@ -254,7 +266,8 @@ HANDLE spawn ( int search, char *envp, char *ptyname, - int wait + int wait, + char *pwd ) { int stdout_backup, stdin_backup, stderr_backup, wait_mode; @@ -291,6 +304,13 @@ HANDLE spawn ( wait_mode = P_WAIT; } + /* Change working directory if supplied. */ + if ( pwd ) { + if ( chdir ( pwd ) < 0) { + goto error_exit; + } + } + /* Spawn process given on the command line*/ if (search) hProcess = (HANDLE) spawnvp ( wait_mode, program, (char* const* )argv ); diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp index 6b6673a..dd92b80 100644 --- a/tests/run-program.impure.lisp +++ b/tests/run-program.impure.lisp @@ -322,3 +322,17 @@ (assert (null (sb-ext:run-program "/bin/cat" '() :output #.(or *compile-file-truename* *load-truename*) :if-output-exists nil))))) + + +(with-test (:name (:run-program :set-directory)) + (let* ((directory #-win32 "/" + #+win32 "c:\\") + (pwd (sb-ext:run-program #-win32 "/bin/sh" + #-win32 '("-c" "pwd") + #+win32 "c:/windows/system32/cmd.exe" + #+win32 '("/c" "cd") + :output :stream + :directory directory))) + (unwind-protect + (assert (string= (read-line (sb-ext:process-output pwd)) directory)) + (sb-ext:process-close pwd)))) -- 1.8.2.1