suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

better process helper, quote characters that might cause problems with shell quotes

Browse Source 
svn: r8455
This commit is contained in:
Eli Barzilay 2008-01-29 02:05:40 +00:00
parent 1547458786
commit c2c950a2b9
1 changed files with 30 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
collects/net/sendurl.ss
View File

@ -67,22 +67,28 @@
;; send-url : str [bool] -> void ;; send-url : str [bool] -> void
(define (send-url url-str [separate-window? separate-by-default?]) (define (send-url url-str [separate-window? separate-by-default?])
(define stype (force systype)) (define stype (force systype))
(cond [(not (string? url-str)) (unless (string? url-str)
(error 'send-url "expected a string, got ~e" url-str)] (error 'send-url "expected a string, got ~e" url-str))
[(procedure? (external-browser)) ((external-browser) url-str)] (let ([url-str
[else (case stype ;; quote characters that will not work well in shell quotes
[(macosx) (send-url/mac url-str)] (regexp-replace*
[(windows) (send-url/win url-str)] #rx"[\"'`$\\]" url-str
[(unix) (send-url/unix url-str separate-window?)] (lambda (m)
[else (error 'send-url (string-append "%" (number->string (char->integer (string-ref m 0))
"don't know how to open URL on platform: ~s" 16))))])
stype)])]) (if (procedure? (external-browser))
((external-browser) url-str)
(case stype
[(macosx) (send-url/mac url-str)]
[(windows) (send-url/win url-str)]
[(unix) (send-url/unix url-str separate-window?)]
[else (error 'send-url
"don't know how to open URL on platform: ~s" stype)])))
(void)) (void))
(define osascript (delay (find-executable-path "osascript" #f))) (define osascript (delay (find-executable-path "osascript" #f)))
(define (send-url/mac url-str) (define (send-url/mac url-str)
(browser-process* (force osascript) "-e" (browser-run (force osascript) "-e" (format "open location \"~a\"" url-str)))
(format "open location \"~a\"" url-str)))
(define (send-url/win url-str) (define (send-url/win url-str)
(define (simple) (define (simple)
@ -98,7 +104,7 @@
(close-input-port (cadddr p)) (close-input-port (cadddr p))
(let ([m (regexp-match #rx"^htmlfile=(.*)" s)]) (let ([m (regexp-match #rx"^htmlfile=(.*)" s)])
(if m (if m
(browser-process (string-append (cadr m) " " url-str)) (browser-run #:shell #t (string-append (cadr m) " " url-str))
;; give up and use simple mode ;; give up and use simple mode
(simple))))) (simple)))))
;; simple case: no fragment ;; simple case: no fragment
@ -119,8 +125,8 @@
(define exe (define exe
(cond [(assq browser (force existing-unix-browsers->exes)) => cdr] (cond [(assq browser (force existing-unix-browsers->exes)) => cdr]
[else #f])) [else #f]))
(define (simple) (browser-process* exe url-str)) (define (simple) (browser-run exe url-str))
(define (w/arg a) (browser-process* exe a url-str)) (define (w/arg a) (browser-run exe a url-str))
(define (try-remote) (define (try-remote)
(or (system* exe "-remote" (or (system* exe "-remote"
(format "openURL(~a)" (format "openURL(~a)"
@ -132,8 +138,8 @@
[(not browser) [(not browser)
(error 'send-url "Couldn't find a browser to open URL: ~e" url-str)] (error 'send-url "Couldn't find a browser to open URL: ~e" url-str)]
[(custom-browser? browser) [(custom-browser? browser)
(let ([cmd (string-append (car browser) url-str (cdr browser))]) (browser-run #:shell #t
(browser-process cmd))] (string-append (car browser) url-str (cdr browser)))]
;; if it's a known browser, then it must be an existing one at this point ;; if it's a known browser, then it must be an existing one at this point
[(not exe) (error 'send-url "internal error")] [(not exe) (error 'send-url "internal error")]
;; if it's gone throw an error (refiltering will break assumptions of ;; if it's gone throw an error (refiltering will break assumptions of
@ -152,28 +158,20 @@
[(mozilla seamonkey netscape) (try-remote)] [(mozilla seamonkey netscape) (try-remote)]
[(opera) [(opera)
;; opera starts a new browser automatically ;; opera starts a new browser automatically
(browser-process* (browser-run exe "-remote"
exe "-remote" (format "openURL(~a~a)" (format "openURL(~a~a)"
url-str (if separate-window? ",new-window" "")))] url-str (if separate-window? ",new-window" "")))]
[else (error 'send-url "internal error")])])) [else (error 'send-url "internal error")])]))
;; Process helpers ;; Process helper
(define (browser-run #:shell? [shell? #f] . args)
;; run-browser : process-proc list-of-strings -> void
(define (run-browser process*/ports args)
(define-values (stdout stdin pid stderr control) (define-values (stdout stdin pid stderr control)
(apply values (apply process*/ports (apply values (apply (if shell? process/ports process*/ports)
(open-output-nowhere) #f (current-error-port) (open-output-nowhere) #f (current-error-port)
args))) args)))
(close-output-port stdin) (close-output-port stdin)
(thread (lambda () (thread (lambda ()
(control 'wait) (control 'wait)
(when (eq? 'done-error (control 'status)) (when (eq? 'done-error (control 'status))
(error 'run-browser "process execute failed: ~e" args)))) (error 'browser-run "process execute failed: ~e" args))))
(void)) (void))
(define (browser-process* . args)
(run-browser process*/ports args))
(define (browser-process . args)
(run-browser process/ports args))