From e29878e7ae9c9cbaf8fa50a0a69e7fd9477db820 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 18 Apr 2013 06:46:12 -0600 Subject: [PATCH] racket/system: make `system', etc., set PWD by default That is, make `system' behave like a shell. --- collects/racket/system.rkt | 81 ++++++++++++------- .../scribblings/reference/subprocess.scrbl | 44 +++++++--- collects/tests/racket/subprocess.rktl | 23 +++++- doc/release-notes/racket/HISTORY.txt | 2 + 4 files changed, 107 insertions(+), 43 deletions(-) diff --git a/collects/racket/system.rkt b/collects/racket/system.rkt index ab51a0f5dc..9de72fed99 100644 --- a/collects/racket/system.rkt +++ b/collects/racket/system.rkt @@ -82,15 +82,28 @@ (unless (or (string-no-nuls? str) (bytes-no-nuls? str)) (raise-argument-error who "(or/c string-no-nuls? bytes-no-nuls?)" str))) +(define (set-pwd-default?) + (or (eq? 'unix (system-type)) + (eq? 'macosx (system-type)))) + +(define (call-with-pwd f) + (parameterize ([current-environment-variables + (environment-variables-copy + (current-environment-variables))]) + (putenv "PWD" (path->string (current-directory))) + (f))) + ;; Old-style functions: ---------------------------------------- -(define (do-process*/ports who cout cin cerr exe . args) - (let-values ([(subp out in err) (apply subprocess - (if-stream-out who cout) - (if-stream-in who cin) - (if-stream-out who cerr #t) - (check-exe who exe) - (check-args who args))] +(define (do-process*/ports who set-pwd? cout cin cerr exe . args) + (let-values ([(subp out in err) ((if set-pwd? call-with-pwd (lambda (f) (f))) + (lambda () + (apply subprocess + (if-stream-out who cout) + (if-stream-in who cin) + (if-stream-out who cerr #t) + (check-exe who exe) + (check-args who args))))] [(it-ready) (make-semaphore)]) (let ([so (streamify-out cout out)] [si (streamify-in cin in (lambda (ok?) @@ -138,32 +151,40 @@ (aport se) control))))) -(define (process*/ports cout cin cerr exe . args) - (apply do-process*/ports 'process*/ports cout cin cerr exe args)) +(define (process*/ports cout cin cerr exe + #:set-pwd? [set-pwd? (set-pwd-default?)] + . args) + (apply do-process*/ports 'process*/ports set-pwd? cout cin cerr exe args)) -(define (process/ports out in err str) - (apply do-process*/ports 'process/ports out in err (shell-path/args 'process/ports str))) +(define (process/ports out in err str + #:set-pwd? [set-pwd? (set-pwd-default?)]) + (apply do-process*/ports 'process/ports set-pwd? out in err (shell-path/args 'process/ports str))) -(define (process* exe . args) - (apply do-process*/ports 'process* #f #f #f exe args)) +(define (process* exe + #:set-pwd? [set-pwd? (set-pwd-default?)] + . args) + (apply do-process*/ports 'process* set-pwd? #f #f #f exe args)) -(define (process str) +(define (process str + #:set-pwd? [set-pwd? (set-pwd-default?)]) (check-command 'process str) - (apply do-process*/ports 'process #f #f #f (shell-path/args 'process str))) + (apply do-process*/ports 'process set-pwd? #f #f #f (shell-path/args 'process str))) ;; Note: these always use current ports -(define (do-system*/exit-code who exe . args) +(define (do-system*/exit-code who set-pwd? exe . args) (let ([cout (current-output-port)] [cin (current-input-port)] [cerr (current-error-port)] [it-ready (make-semaphore)]) (let-values ([(subp out in err) - (apply subprocess - (if-stream-out who cout) - (if-stream-in who cin) - (if-stream-out who cerr #t) - (check-exe who exe) - (check-args who args))]) + ((if set-pwd? call-with-pwd (lambda (f) (f))) + (lambda () + (apply subprocess + (if-stream-out who cout) + (if-stream-in who cin) + (if-stream-out who cerr #t) + (check-exe who exe) + (check-args who args))))]) (let ([ot (streamify-out cout out)] [it (streamify-in cin in (lambda (ok?) (if ok? @@ -183,16 +204,16 @@ (when in (close-output-port in))) (subprocess-status subp)))) -(define (system*/exit-code exe . args) - (apply do-system*/exit-code 'system*/exit-code exe args)) +(define (system*/exit-code exe #:set-pwd? [set-pwd? (set-pwd-default?)] . args) + (apply do-system*/exit-code 'system*/exit-code set-pwd? exe args)) -(define (system* exe . args) - (zero? (apply do-system*/exit-code 'system* exe args))) +(define (system* exe #:set-pwd? [set-pwd? (set-pwd-default?)] . args) + (zero? (apply do-system*/exit-code 'system* set-pwd? exe args))) -(define (system str) +(define (system str #:set-pwd? [set-pwd? (set-pwd-default?)]) (check-command 'system str) - (zero? (apply do-system*/exit-code 'system (shell-path/args 'system str)))) + (zero? (apply do-system*/exit-code 'system set-pwd? (shell-path/args 'system str)))) -(define (system/exit-code str) +(define (system/exit-code str #:set-pwd? [set-pwd? (set-pwd-default?)]) (check-command 'system/exit-code str) - (apply do-system*/exit-code 'system/exit-code (shell-path/args 'system/exit-code str))) + (apply do-system*/exit-code 'system/exit-code set-pwd? (shell-path/args 'system/exit-code str))) diff --git a/collects/scribblings/reference/subprocess.scrbl b/collects/scribblings/reference/subprocess.scrbl index c5c15a5382..bdce247f02 100644 --- a/collects/scribblings/reference/subprocess.scrbl +++ b/collects/scribblings/reference/subprocess.scrbl @@ -324,7 +324,9 @@ real process ID).} @note-lib[racket/system] -@defproc[(system [command (or/c string-no-nuls? bytes-no-nuls?)]) boolean?]{ +@defproc[(system [command (or/c string-no-nuls? bytes-no-nuls?)] + [#:set-pwd? set-pwd? any/c (member (system-type) '(unix macosx))]) + boolean?]{ Executes a Unix, Mac OS X, or Windows shell command synchronously (i.e., the call to @racket[system] does not return until the @@ -332,6 +334,10 @@ subprocess has ended). The @racket[command] argument is a string or byte string containing no nul characters. If the command succeeds, the return value is @racket[#t], @racket[#f] otherwise. +If @racket[set-pwd?] is true, then the @envvar{PWD} environment +variable is set to the value of @racket[(current-directory)] when +starting the shell process. + See also @racket[current-subprocess-custodian-mode] and @racket[subprocess-group-enabled], which affect the subprocess used to implement @racket[system]. @@ -349,9 +355,11 @@ function: @defproc*[([(system* [command path-string?] - [arg (or/c path? string-no-nuls? bytes-no-nuls?)] ...) + [arg (or/c path? string-no-nuls? bytes-no-nuls?)] ... + [#:set-pwd? set-pwd? any/c (member (system-type) '(unix macosx))]) boolean?] - [(system* [command path-string?] [exact 'exact] [arg string?]) + [(system* [command path-string?] [exact 'exact] [arg string?] + [#:set-pwd? set-pwd? any/c (member (system-type) '(unix macosx))]) boolean?])]{ Like @racket[system], except that @racket[command] is a filename that @@ -367,7 +375,8 @@ On Windows, the first argument after @racket[command] can be line. See @racket[subprocess] for details.} -@defproc[(system/exit-code [command (or/c string-no-nuls? bytes-no-nuls?)]) +@defproc[(system/exit-code [command (or/c string-no-nuls? bytes-no-nuls?)] + [#:set-pwd? set-pwd? any/c (member (system-type) '(unix macosx))]) byte?]{ Like @racket[system], except that the result is the exit code returned @@ -375,17 +384,20 @@ by the subprocess. A @racket[0] result normally indicates success.} @defproc*[([(system*/exit-code [command path-string?] - [arg (or/c path? string-no-nuls? bytes-no-nuls?)] ...) + [arg (or/c path? string-no-nuls? bytes-no-nuls?)] ... + [#:set-pwd? set-pwd? any/c (member (system-type) '(unix macosx))]) byte?] [(system*/exit-code [command path-string?] - [exact 'exact] [arg string?]) + [exact 'exact] [arg string?] + [#:set-pwd? set-pwd? any/c (member (system-type) '(unix macosx))]) byte?])]{ Like @racket[system*], but returns the exit code like @racket[system/exit-code].} -@defproc[(process [command (or/c string-no-nuls? bytes-no-nuls?)]) +@defproc[(process [command (or/c string-no-nuls? bytes-no-nuls?)] + [#:set-pwd? set-pwd? any/c (member (system-type) '(unix macosx))]) (list input-port? output-port? exact-nonnegative-integer? @@ -446,6 +458,9 @@ values: be explicitly closed with @racket[close-input-port] or @racket[close-output-port]. +If @racket[set-pwd?] is true, then @envvar{PWD} is set in the same way +as @racket[system]. + See also @racket[current-subprocess-custodian-mode] and @racket[subprocess-group-enabled], which affect the subprocess used to implement @racket[process]. In particular, the @racket['interrupt] and @@ -455,9 +470,11 @@ of a single process.} @defproc*[([(process* [command path-string?] - [arg (or/c path? string-no-nuls? bytes-no-nuls?)] ...) + [arg (or/c path? string-no-nuls? bytes-no-nuls?)] ... + [#:set-pwd? set-pwd? any/c (member (system-type) '(unix macosx))]) list?] - [(process* [command path-string?] [exact 'exact] [arg string?]) + [(process* [command path-string?] [exact 'exact] [arg string?] + [#:set-pwd? set-pwd? any/c (member (system-type) '(unix macosx))]) list?])]{ Like @racket[process], except that @racket[command] is a filename that @@ -469,7 +486,8 @@ replaced with @racket['exact].} @defproc[(process/ports [out (or/c #f output-port?)] [in (or/c #f input-port?)] [error-out (or/c #f output-port? 'stdout)] - [command (or/c path? string-no-nuls? bytes-no-nuls?)]) + [command (or/c path? string-no-nuls? bytes-no-nuls?)] + [#:set-pwd? set-pwd? any/c (member (system-type) '(unix macosx))]) list?]{ Like @racket[process], except that @racket[out] is used for the @@ -487,14 +505,16 @@ returned list is @racket[#f].} [error-out (or/c #f output-port? 'stdout)] [command path-string?] [arg (or/c path? string-no-nuls? bytes-no-nuls?)] - ...) + ... + [#:set-pwd? set-pwd? any/c (member (system-type) '(unix macosx))]) list?] [(process*/ports [out (or/c #f output-port?)] [in (or/c #f input-port?)] [error-out (or/c #f output-port? 'stdout)] [command path-string?] [exact 'exact] - [arg string?]) + [arg string?] + [#:set-pwd? set-pwd? any/c (member (system-type) '(unix macosx))]) list?])]{ Like @racket[process*], but with the port handling of diff --git a/collects/tests/racket/subprocess.rktl b/collects/tests/racket/subprocess.rktl index 3452a0c456..00f8c41e28 100644 --- a/collects/tests/racket/subprocess.rktl +++ b/collects/tests/racket/subprocess.rktl @@ -1,7 +1,8 @@ (load-relative "testing.rktl") -(require mzlib/process) +(require racket/system + racket/file) (Section 'subprocess) @@ -474,6 +475,26 @@ (system* self "-e" "(getenv \"Hola\")")) (test "\"hi, there\"\n" get-output-string out)) +;; Check setting of PWD and initializing `current-directory' from +;; PWD, when it involves a soft link: +(when (member (system-type) '(unix macosx)) + (let ([dir (make-temporary-file "sub~a" 'directory)]) + (make-directory (build-path dir "a")) + (make-file-or-directory-link "a" (build-path dir "b")) + (current-directory (build-path dir "b")) + + (define o (open-output-bytes)) + (parameterize ([current-output-port o]) + (system* self "-e" "(current-directory)")) + (test (format "~s\n" (path->directory-path (build-path dir "b"))) get-output-string o) + + (define o2 (open-output-bytes)) + (parameterize ([current-output-port o2]) + (system* self "-e" "(current-directory)" #:set-pwd? #f)) + (test (format "~s\n" (path->directory-path (normalize-path (build-path dir "a")))) get-output-string o2) + + (delete-directory/files dir))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (for ([f (list tmpfile tmpfile2)] #:when (file-exists? f)) (delete-file f)) diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 0e126dfa2f..d0432d6fdc 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -1,6 +1,8 @@ Version 5.3.4.3 Added make-environment-variables Changed initialization of current-directory to use PWD +racket/system: add a #:set-pwd? argument to system, etc., which + makes them set PWD by default net/url: add support for HTTP/1.1 connections Version 5.3.4.2