summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAdrian Cochrane <adrian@openwork.nz>2021-01-07 19:20:18 +1300
committerAdrian Cochrane <adrian@openwork.nz>2021-01-07 19:20:18 +1300
commit04cb2efa35fc1b761dbf5d8d19c0160c82f9dc8b (patch)
tree79d44e73751010c1306197ba0b7f47f21e55ac1f
parentcdc252ef0c0155c55282ca43b7b855d4120336e2 (diff)
downloadhurl-04cb2efa35fc1b761dbf5d8d19c0160c82f9dc8b.tar.gz
hurl-04cb2efa35fc1b761dbf5d8d19c0160c82f9dc8b.tar.bz2
hurl-04cb2efa35fc1b761dbf5d8d19c0160c82f9dc8b.zip
Load executable extensions from more directories.
-rw-r--r--src/Network/URI/Fetch.hs39
1 files changed, 22 insertions, 17 deletions
diff --git a/src/Network/URI/Fetch.hs b/src/Network/URI/Fetch.hs
index 2910d19..9645e97 100644
--- a/src/Network/URI/Fetch.hs
+++ b/src/Network/URI/Fetch.hs
@@ -206,24 +206,29 @@ fetchURL' session mimes uri
| Just uri' <- applyRewriter (rewriter session) uri = fetchURL' session mimes uri'
#endif
-fetchURL' session mimes uri@(URI {uriScheme = "ext:", uriAuthority = Nothing,
- uriPath = path, uriQuery = query}) = do
+fetchURL' session@Session { appName = appname, locale = l } mimes
+ uri@(URI "ext:" Nothing path query _) = do
dir <- getXdgDirectory XdgData "nz.geek.adrian.hurl"
- let program = dir </> "bin" </> path
- let args = case query of {
- '?':rest -> split (== '&') rest;
- _ -> []
- }
- (exitcode, stdout, stderr) <- readProcessWithExitCode program args ""
- let response = if isSuccess exitcode then stdout else stderr
- let (header, body) = breakOn '\n' response
- case strip header of
- 'm':'i':'m':'e':mimetype -> return (uri, strip mimetype, Left $ Txt.pack body)
- 'u':'r':'l':header' | Just uri' <- parseURIReference $ strip header' ->
- fetchURL' (session {redirectCount = redirectCount session - 1}) mimes $
- relativeTo uri' uri
- _ | isSuccess exitcode -> return (uri, "text/html", Left $ Txt.pack response)
- _ -> return (uri, mimeERR, Left $ Txt.pack response)
+ sysdirs <- getXdgDirectoryList XdgDataDirs
+ let dirs = concat [[dir' </> appname, dir'] | dir' <- dir : sysdirs]
+ programs <- findExecutablesInDirectories dirs ("bin" </> path)
+ case programs of
+ [] -> return (uri, mimeERR, Left $ Txt.pack $ trans l $ ReadFailed "404")
+ program:_ -> do
+ let args = case query of {
+ '?':rest -> split (== '&') rest;
+ _ -> []
+ }
+ (exitcode, stdout, stderr) <- readProcessWithExitCode program args ""
+ let response = if isSuccess exitcode then stdout else stderr
+ let (header, body) = breakOn '\n' response
+ case strip header of
+ 'm':'i':'m':'e':mimetype -> return (uri, strip mimetype, Left $ Txt.pack body)
+ 'u':'r':'l':header' | Just uri' <- parseURIReference $ strip header' ->
+ fetchURL' (session {redirectCount = redirectCount session - 1}) mimes $
+ relativeTo uri' uri
+ _ | isSuccess exitcode -> return (uri, "text/html", Left $ Txt.pack response)
+ _ -> return (uri, mimeERR, Left $ Txt.pack response)
where
split p s = case dropWhile p s of
"" -> []