diff options
Diffstat (limited to 'src/Network/URI/Fetch.hs')
| -rw-r--r-- | src/Network/URI/Fetch.hs | 39 |
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 "" -> [] |