racket/system: make `system', etc., set PWD by default
That is, make `system' behave like a shell.
This commit is contained in:
Matthew Flatt
parent
4cc29194d1
commit
e29878e7ae
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user