module Debian.URI
( module Network.URI
, URIString
, uriToString'
, fileFromURI
, fileFromURIStrict
, dirFromURI
) where
import Control.Exception (SomeException, try)
import qualified Data.ByteString.Lazy.Char8 as L
import Data.ByteString.UTF8 as B
import qualified Data.ByteString as B
import Data.Maybe (catMaybes)
import Network.URI
import System.Directory (getDirectoryContents)
import System.Process.ByteString (readProcessWithExitCode)
import Text.Regex (mkRegex, matchRegex)
uriToString' :: URI -> String
uriToString' uri = uriToString id uri ""
type URIString = String
fileFromURI :: URI -> IO (Either SomeException L.ByteString)
fileFromURI uri = fileFromURIStrict uri >>= either (return . Left) (return . Right . L.fromChunks . (: []))
fileFromURIStrict :: URI -> IO (Either SomeException B.ByteString)
fileFromURIStrict uri = try $
case (uriScheme uri, uriAuthority uri) of
("file:", Nothing) -> B.readFile (uriPath uri)
("ssh:", Just auth) -> do
let cmd = "ssh"
args = [uriUserInfo auth ++ uriRegName auth ++ uriPort auth, "cat", uriPath uri]
(_code, out, _err) <- readProcessWithExitCode cmd args B.empty
return out
_ -> do
let cmd = "curl"
args = ["-s", "-g", uriToString' uri]
(_code, out, _err) <- readProcessWithExitCode cmd args B.empty
return out
webServerDirectoryContents :: B.ByteString -> [String]
webServerDirectoryContents text =
catMaybes . map (second . matchRegex re) . Prelude.lines . B.toString $ text
where
re = mkRegex "( <A HREF|<a href)=\"([^/][^\"]*)/\""
second (Just [_, b]) = Just b
second _ = Nothing
dirFromURI :: URI -> IO (Either SomeException [String])
dirFromURI uri = try $
case (uriScheme uri, uriAuthority uri) of
("file:", Nothing) -> getDirectoryContents (uriPath uri)
("ssh:", Just auth) ->
do let cmd = "ssh"
args = [uriUserInfo auth ++ uriRegName auth ++ uriPort auth, "ls", "-1", uriPath uri]
(_code, out, _err) <- readProcessWithExitCode cmd args B.empty
return . Prelude.lines . B.toString $ out
_ ->
do let cmd = "curl"
args = ["-s", "-g", uriToString' uri]
(_code, out, _err) <- readProcessWithExitCode cmd args B.empty
return . webServerDirectoryContents $ out