summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAdrian Cochrane <adrian@openwork.nz>2020-12-07 20:40:00 +1300
committerAdrian Cochrane <adrian@openwork.nz>2020-12-07 20:40:00 +1300
commit70b80f77ae0e662b690f2829073e086eed7c7b8a (patch)
treea6d45383f4117b3ffd1cf415f68980ed8d932b77
parentf0682c08ec3a471967be4923c7b2b873830ec679 (diff)
downloadhurl-70b80f77ae0e662b690f2829073e086eed7c7b8a.tar.gz
hurl-70b80f77ae0e662b690f2829073e086eed7c7b8a.tar.bz2
hurl-70b80f77ae0e662b690f2829073e086eed7c7b8a.zip
Support executable extensions.
-rw-r--r--src/Network/URI/Fetch.hs31
1 files changed, 29 insertions, 2 deletions
diff --git a/src/Network/URI/Fetch.hs b/src/Network/URI/Fetch.hs
index 58bd6ae..12fea99 100644
--- a/src/Network/URI/Fetch.hs
+++ b/src/Network/URI/Fetch.hs
@@ -23,6 +23,9 @@ import Control.Concurrent.Async (forConcurrently)
-- for about: URIs & port parsing, all standard lib
import Data.Maybe (fromMaybe, listToMaybe)
import Text.Read (readMaybe)
+-- for executable extensions, all standard lib
+import Data.Char (isSpace)
+import System.Exit (ExitCode(..))
-- for saveDownload
import System.Directory
@@ -192,6 +195,32 @@ 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
+ 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)
+ where
+ split p s = case dropWhile p s of
+ "" -> []
+ s' -> let (w, s'') = break p s' in w : split p s''
+ strip = dropWhile isSpace . dropWhileEnd isSpace
+ isSuccess ExitSuccess = True
+ isSuccess _ = False
+
fetchURL' session mimes uri@(URI {uriScheme = "about:", uriPath = ""}) =
fetchURL' session mimes $ uri {uriPath = "version"}
fetchURL' Session {aboutPages = pages} _ url@URI {uriScheme = "about:", uriPath = path} =
@@ -362,8 +391,6 @@ writeLog out session = do
-- Utils
-#ifdef WITH_DATA_URI
breakOn c (a:as) | c == a = ([], as)
| otherwise = let (x, y) = breakOn c as in (a:x, y)
breakOn _ [] = ([], [])
-#endif