net-lib/net/sendurl.rkt: overhaul and simplify; support xdg-open on Unix
Unix: Cut down all-unix-browsers: add xdg-open, which is standard and can launch applications for files instead of a browser, like the macOS and Windows equivalents; remove defunct browsers galeon, camino, skipstone, htmlview, and the rare dillo. Make opera use try-remote, which is identical to the code it was using. xdg-open cannot handle queries or fragments in URLs, so for this case factor out send-url/trampoline from send-url/win and use it. macOS: Remove try-to-find-macosx-users-browsers, and use “open” instead of “osascript”; “open” uses the user’s configured browser. As before, it is still possible to specify a particular browser. Windows: Shorten and simplify the justification of the trampoline, which is mostly out of date, though the trick is still needed.
This commit is contained in:
Reuben Thomas
Matthew Flatt
parent
e4d43fa0dc
commit
0680a2e2ee
|
|
@ -20,16 +20,8 @@ manner. For some platforms and configurations, the
|
|||
@racket[separate-window?] parameter determines if the browser creates
|
||||
a new window to display the URL or not.
|
||||
|
||||
On Windows, @racket[send-url] normally uses @racket[shell-execute]
|
||||
to launch a browser. (If the URL appears to contain a fragment, it may
|
||||
use an intermediate redirecting file due to a bug in IE7.)
|
||||
|
||||
On Mac OS, @racket[send-url] calls @racket[send-url/mac].
|
||||
|
||||
On Unix, @racket[send-url] uses a user-preference, or when none is
|
||||
set, it will look for a known browser. See the description of
|
||||
@racket[external-browser] for details.
|
||||
|
||||
If @racket[escape?] is true, then @racket[str] is escaped (by UTF-8
|
||||
encoding followed by ``%'' encoding) to avoid dangerous shell
|
||||
characters: single quotes, double quotes, backquotes, dollar signs,
|
||||
|
|
@ -37,7 +29,7 @@ backslashes, non-ASCII characters, and non-graphic characters. Note
|
|||
that escaping does not affect already-encoded characters in
|
||||
@racket[str].
|
||||
|
||||
On all platforms, @racket[external-browser] parameter can be set to a
|
||||
On all platforms, the @racket[external-browser] parameter can be set to a
|
||||
procedure to override the above behavior --- the procedure will be
|
||||
called with the @racket[url] string.}
|
||||
|
||||
|
|
@ -83,20 +75,9 @@ above.}
|
|||
|
||||
The optional @racket[browser] argument, if present, should be the name
|
||||
of a browser installed on the system. For example,
|
||||
@racketblock[(send-url/mac "http://www.google.com/" #:browser "Firefox")]
|
||||
@racketblock[(send-url/mac "https://www.google.com/" #:browser "Firefox")]
|
||||
would open the url in Firefox, even if that's not the default browser.
|
||||
Passing @racket[#f] means to use the default browser.
|
||||
|
||||
This function looks in
|
||||
@filepath{com.apple.launchservices.secure.plist} in the
|
||||
user's home directory for a @tt{LSHandlerURLScheme} key for
|
||||
either @tt{http} or @tt{https} and then, looks for a
|
||||
@tt{LSHandlerRoleAll} key that is one of a list of known
|
||||
browsers. If it finds such a browser, it uses the
|
||||
AppleScript command @tt{tell
|
||||
application ... to open location} to send the url to the
|
||||
browser. Otherwise, it uses just @tt{open location} to send
|
||||
the url to the browser.
|
||||
}
|
||||
|
||||
@defparam[external-browser cmd browser-preference?]{
|
||||
|
|
@ -104,16 +85,16 @@ above.}
|
|||
A parameter that can hold a procedure to override how a browser is
|
||||
started, or @racket[#f] to use the default platform-dependent command.
|
||||
|
||||
On Unix, the command that is used depends on the
|
||||
@racket['external-browser] preference. If the preference is unset,
|
||||
@racket[send-url] uses the first of the browsers from
|
||||
@racket[unix-browser-list] for which the executable is found.
|
||||
Otherwise, the preference should hold a symbol indicating a known
|
||||
browser (from the @racket[unix-browser-list]), or it a pair of a prefix
|
||||
and a suffix string that are concatenated around the @racket[url] string
|
||||
to make up a shell command to run. In addition, the
|
||||
@racket[external-browser] paremeter can be set to one of these values,
|
||||
and @racket[send-url] will use it instead of the preference value.
|
||||
On Unix, the command that is used depends on the @racket['external-browser]
|
||||
preference. It's recommended not to use this preference, but to rely on
|
||||
@tt{xdg-open}. If the preference is unset, @racket[send-url] uses the first
|
||||
of the browsers from @racket[unix-browser-list] for which the executable is
|
||||
found. Otherwise, the preference should hold a symbol indicating a known
|
||||
browser (from the @racket[unix-browser-list]), or it a pair of a prefix and
|
||||
a suffix string that are concatenated around the @racket[url] string to make
|
||||
up a shell command to run. In addition, the @racket[external-browser]
|
||||
paremeter can be set to one of these values, and @racket[send-url] will use
|
||||
it instead of the preference value.
|
||||
|
||||
Note that the URL is encoded to make it work inside shell double-quotes:
|
||||
URLs can still hold characters like @litchar{#}, @litchar{?}, and
|
||||
|
|
@ -136,4 +117,3 @@ A list of symbols representing Unix executable names that may be tried
|
|||
in order by @racket[send-url]. The @racket[send-url] function
|
||||
internally includes information on how to launch each executable with
|
||||
a URL.}
|
||||
|
||||
|
|
|
|||
|
|
@ -14,26 +14,18 @@
|
|||
#:pre (equal? (system-type) 'macosx)
|
||||
void?)]))
|
||||
|
||||
(define separate-by-default?
|
||||
;; internal configuration, 'browser-default lets some browsers decide
|
||||
(delay (get-preference 'new-browser-for-urls
|
||||
(lambda () 'browser-default)
|
||||
#:timeout-lock-there (lambda (path) 'browser-default))))
|
||||
;; Will we open a new browser window (where possible) by default?
|
||||
(define separate-by-default? #t)
|
||||
|
||||
;; all possible unix browsers, filtered later to just existing executables
|
||||
;; order matters: the default will be the first of these that is found
|
||||
(define all-unix-browsers
|
||||
'(;; default browser launchers
|
||||
'(;; general purpose launchers
|
||||
xdg-open
|
||||
;; default browser launchers
|
||||
sensible-browser x-www-browser
|
||||
;; common browsers
|
||||
firefox chromium-browser google-chrome galeon opera mozilla konqueror seamonkey epiphany
|
||||
;; known browsers
|
||||
camino skipstone
|
||||
;; broken browsers (broken in that they won't work with plt-help)
|
||||
;; this is a configurable thing that is deprecated
|
||||
htmlview
|
||||
;; dillo does not have javascript
|
||||
dillo
|
||||
firefox chromium-browser google-chrome opera seamonkey epiphany
|
||||
))
|
||||
|
||||
;; : any -> bool
|
||||
|
|
@ -68,6 +60,9 @@
|
|||
(define (browser-preference? x)
|
||||
(or (not x) (memq x unix-browser-list) (custom-browser? x) (procedure? x)))
|
||||
|
||||
(define (url-contains-query-or-fragment url)
|
||||
(regexp-match? #rx"[#?]" url))
|
||||
|
||||
(define (%escape str)
|
||||
(apply string-append
|
||||
(map (lambda (b)
|
||||
|
|
@ -89,9 +84,9 @@
|
|||
(if (procedure? (external-browser))
|
||||
((external-browser) url-str)
|
||||
(case (system-type)
|
||||
['macosx (send-url/mac url-str)]
|
||||
['windows (send-url/win url-str)]
|
||||
['unix (send-url/unix url-str (force separate-window?))]
|
||||
[(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" (system-type))])))
|
||||
(void))
|
||||
|
|
@ -115,7 +110,7 @@
|
|||
[path (if query (string-append path "?" (escape-url query)) path)]
|
||||
[path (if fragment (string-append path "#" (escape-url fragment))
|
||||
path)])
|
||||
(send-url path (force separate-window?) #:escape? #f)))
|
||||
(send-url path separate-window? #:escape? #f)))
|
||||
|
||||
;; See the documentation for the `delete-at' argument
|
||||
;; separate-window? is never used
|
||||
|
|
@ -146,72 +141,14 @@
|
|||
(when delete-at (thread (lambda () (sleep delete-at) (delete-file temp))))
|
||||
(send-url/file temp)))
|
||||
|
||||
(define osascript (delay/sync (find-executable-path "osascript" #f)))
|
||||
(define (send-url/mac url #:browser [_browser #f])
|
||||
(define browser
|
||||
(or _browser
|
||||
(try-to-find-macosx-users-browser)))
|
||||
(browser-run (force osascript) "-e"
|
||||
(define open-program (delay/sync (find-executable-path "open" #f)))
|
||||
(define (send-url/mac url #:browser [browser #f])
|
||||
(let ([browser-command (force open-program)])
|
||||
(if browser
|
||||
(format "tell application \"~a\" to open location \"~a\" activate"
|
||||
browser url)
|
||||
(format "open location \"~a\"" url))))
|
||||
(browser-run browser-command "-a" browser url)
|
||||
(browser-run browser-command url))))
|
||||
|
||||
(define (try-to-find-macosx-users-browser)
|
||||
(define default-browser (hash-ref known-uri->macosx-browser-app "com.apple.safari"))
|
||||
(let/ec k
|
||||
(define (fail fmt . more)
|
||||
(log-warning (string-append
|
||||
"tried to find user's browser choice, but: "
|
||||
(apply format fmt more)))
|
||||
(k default-browser))
|
||||
(define plist-file
|
||||
(build-path (find-system-path 'home-dir)
|
||||
"Library" "Preferences"
|
||||
"com.apple.LaunchServices"
|
||||
"com.apple.launchservices.secure.plist"))
|
||||
(unless (file-exists? plist-file) (fail "didn't find plist file"))
|
||||
(define plutil (find-executable-path "plutil" #f))
|
||||
(unless plutil (fail "didn't find plutil"))
|
||||
(define-values (in out) (make-pipe))
|
||||
(thread
|
||||
(λ ()
|
||||
(define-values (_1 _2 _3 _4 proc)
|
||||
(apply
|
||||
values
|
||||
(process*/ports
|
||||
out
|
||||
(open-input-string "")
|
||||
(current-error-port)
|
||||
plutil
|
||||
"-convert" "json"
|
||||
"-o" "-"
|
||||
plist-file)))
|
||||
(proc 'wait)
|
||||
(close-output-port out)))
|
||||
(define json
|
||||
(with-handlers ([exn:fail? (λ (exn) (fail (exn-message exn)))])
|
||||
(read-json in)))
|
||||
(define handlers (hash-ref json 'LSHandlers (λ () (fail "didn't find LSHandlers key in json"))))
|
||||
(unless ((listof hash?) handlers) (fail "confusing LSHandlers ~s" handlers))
|
||||
(define uri
|
||||
(for/or ([table (in-list (hash-ref json 'LSHandlers))]
|
||||
#:when
|
||||
(member (hash-ref table 'LSHandlerURLScheme #f) '("http" "https")))
|
||||
(hash-ref table 'LSHandlerRoleAll #f)))
|
||||
(cond
|
||||
[uri (hash-ref known-uri->macosx-browser-app uri #f)]
|
||||
[else
|
||||
;; no preference set
|
||||
default-browser])))
|
||||
|
||||
(define known-uri->macosx-browser-app
|
||||
(hash "com.google.chrome" "Google Chrome"
|
||||
"com.apple.safari" "Safari"
|
||||
"org.mozilla.firefox" "Firefox"
|
||||
"com.operasoftware.opera" "Opera"))
|
||||
|
||||
(define (send-url/unix url separate-window?)
|
||||
(define (send-url/unix url [separate-window? separate-by-default?])
|
||||
;; in cases where a browser was uninstalled, we might get a preference that
|
||||
;; is no longer valid, this will turn it back to #f
|
||||
(define (try pref)
|
||||
|
|
@ -228,8 +165,12 @@
|
|||
[else #f]))
|
||||
(define (simple) (browser-run exe url))
|
||||
(define (w/arg a) (browser-run exe a url))
|
||||
(define (trampoline)
|
||||
(if (url-contains-query-or-fragment url)
|
||||
(send-url/trampoline url separate-window?)
|
||||
(browser-run exe url)))
|
||||
(define (try-remote)
|
||||
(or (system* exe "-remote" (format "openURL(~a~a)" url
|
||||
(or (browser-run exe "-remote" (format "openURL(~a~a)" url
|
||||
(if separate-window? ",new-window" "")))
|
||||
(simple)))
|
||||
(cond
|
||||
|
|
@ -246,48 +187,35 @@
|
|||
;; finally, deal with the actual browser process
|
||||
[else
|
||||
(case browser
|
||||
[(sensible-browser x-www-browser firefox konqueror dillo htmlview google-chrome chromium-browser)
|
||||
[(xdg-open) (trampoline)]
|
||||
[(sensible-browser x-www-browser firefox konqueror google-chrome chromium-browser)
|
||||
(simple)]
|
||||
;; don't really know how to run these
|
||||
[(camino skipstone) (simple)]
|
||||
[(galeon) (if (eq? 'browser-default separate-window?)
|
||||
(simple) (w/arg (if separate-window? "-w" "-x")))]
|
||||
[(epiphany) (if separate-window? (w/arg "--new-window") (simple))]
|
||||
[(mozilla seamonkey) (try-remote)]
|
||||
[(opera)
|
||||
;; opera starts a new browser automatically
|
||||
(browser-run exe "-remote"
|
||||
(format "openURL(~a~a)"
|
||||
url (if separate-window? ",new-window" "")))]
|
||||
[(seamonkey opera) (try-remote)]
|
||||
[else (error 'send-url "internal error")])]))
|
||||
|
||||
;; Windows has a bug when using `shell-execute' or when running `iexplore.exe'
|
||||
;; directly -- it silently drops the fragment and query from URLs that have
|
||||
;; them. This is described at
|
||||
;; http://support.microsoft.com/default.aspx/kb/942172
|
||||
;; It seems that the IE7 problem happens either way (`shell-execute' or running
|
||||
;; directly) -- but it also happens with firefox when using `shell-execute'.
|
||||
;; One possible solution is to run `ftype http' to find the default browser
|
||||
;; command, and if it uses `iexplore.exe' then change it to `explorer.exe', and
|
||||
;; run the resulting command directly. This is described at
|
||||
;; http://www.tutorials-win.com/IE/Lauching-HTML/
|
||||
;; But this still fails on Vista, since the problem there is that launching a
|
||||
;; browser with a file:// URL makes it start a more priviliged process, and
|
||||
;; doing that drops the fragment again. So the solution that the code below
|
||||
;; implements is to write and use (via `send-url/contents') a trampoline html
|
||||
;; that redirects to the actual file and fragment.
|
||||
|
||||
;; Windows can directly launch URLs, but silently drops the fragment and
|
||||
;; query from file URLs that have them, so use send-url/trampoline in that
|
||||
;; case.
|
||||
(define (send-url/win url)
|
||||
(if (not (regexp-match? #rx"[#?]" url))
|
||||
(if (not (url-contains-query-or-fragment url))
|
||||
(shell-execute #f url "" (current-directory) 'SW_SHOWNORMAL)
|
||||
(send-url/trampoline url)))
|
||||
|
||||
;; Write and use (via `send-url/contents') a trampoline html that redirects
|
||||
;; to the actual file and fragment, for launchers that can't cope with query
|
||||
;; and fragment part of the URL.
|
||||
(define (send-url/trampoline url [separate-window? separate-by-default?])
|
||||
(send-url/contents
|
||||
(string-append
|
||||
"<html><head><meta http-equiv=\"refresh\" content=\"0;URL="url"\"></head>"
|
||||
"<body>Please go <a href=\""url"\">here</a>.</body></html>")
|
||||
separate-window?
|
||||
;; starting the browser may take a while, don't remove the file
|
||||
;; immediately (this means that when used via plt-help, these files are
|
||||
;; never removed by a timer)
|
||||
#:delete-at 15)))
|
||||
#:delete-at 15))
|
||||
|
||||
;; Process helper
|
||||
(define (browser-run #:shell [shell? #f] . args)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user