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 qualified Data.ByteString as B
import Data.Maybe (catMaybes)
import Network.URI
import System.Directory (getDirectoryContents)
import System.Unix.Process (collectStdout)
import System.Unix.Progress (lazyCommandSF, quieter)
import Text.Regex (mkRegex, matchRegex)
uriToString' :: URI -> String
uriToString' uri = uriToString id uri ""
instance Ord URI where
compare a b = compare (uriToString' a) (uriToString' b)
type URIString = String
fileFromURI :: URI -> IO (Either SomeException L.ByteString)
fileFromURI uri =
case (uriScheme uri, uriAuthority uri) of
("file:", Nothing) -> try (L.readFile (uriPath uri))
("ssh:", Just auth) -> try (lazyCommandSF ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++ " cat " ++ show (uriPath uri)) L.empty >>=
return . fst . collectStdout)
_ -> try (lazyCommandSF ("curl -s -g '" ++ uriToString' uri ++ "'") L.empty >>=
return . fst . collectStdout)
fileFromURIStrict :: URI -> IO (Either SomeException B.ByteString)
fileFromURIStrict uri =
case (uriScheme uri, uriAuthority uri) of
("file:", Nothing) -> try (B.readFile (uriPath uri))
("ssh:", Just auth) -> try (lazyCommandSF ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++ " cat " ++ show (uriPath uri)) L.empty >>=
return . B.concat . L.toChunks . fst . collectStdout)
_ -> try (lazyCommandSF ("curl -s -g '" ++ uriToString' uri ++ "'") L.empty >>=
return . B.concat . L.toChunks . fst . collectStdout)
webServerDirectoryContents :: L.ByteString -> [String]
webServerDirectoryContents text =
catMaybes . map (second . matchRegex re) . lines . L.unpack $ text
where
re = mkRegex "( <A HREF|<a href)=\"([^/][^\"]*)/\""
second (Just [_, b]) = Just b
second _ = Nothing
dirFromURI :: URI -> IO (Either SomeException [String])
dirFromURI uri =
case (uriScheme uri, uriAuthority uri) of
("file:", Nothing) -> try (getDirectoryContents (uriPath uri))
("ssh:", Just auth) -> try (lazyCommandSF ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++ " ls -1 " ++ uriPath uri) L.empty >>=
return . lines . L.unpack . fst . collectStdout)
_ -> try (lazyCommandSF ("curl -s -g '" ++ uriToString' uri ++ "/'") L.empty >>= return . webServerDirectoryContents . fst . collectStdout)