98 lines
2.9 KiB
Haskell
98 lines
2.9 KiB
Haskell
{- Url downloading.
|
|
-
|
|
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Utility.Url (
|
|
URLString,
|
|
check,
|
|
exists,
|
|
download,
|
|
get
|
|
) where
|
|
|
|
import Common
|
|
import Network.URI
|
|
import Utility.CopyFile
|
|
|
|
type URLString = String
|
|
|
|
type Headers = [String]
|
|
|
|
{- Checks that an url exists and could be successfully downloaded,
|
|
- also checking that its size, if available, matches a specified size. -}
|
|
check :: URLString -> Headers -> Maybe Integer -> IO Bool
|
|
check url headers expected_size = handle <$> exists url headers
|
|
where
|
|
handle (False, _) = False
|
|
handle (True, Nothing) = True
|
|
handle (True, s) = expected_size == s
|
|
|
|
{- Checks that an url exists and could be successfully downloaded,
|
|
- also returning its size if available. -}
|
|
exists :: URLString -> Headers -> IO (Bool, Maybe Integer)
|
|
exists url headers = case parseURI url of
|
|
Just u
|
|
| uriScheme u == "file:" -> do
|
|
s <- catchMaybeIO $ getFileStatus (uriPath u)
|
|
case s of
|
|
Just stat -> return (True, Just $ fromIntegral $ fileSize stat)
|
|
Nothing -> dne
|
|
| otherwise -> do
|
|
output <- readProcess "curl" curlparams
|
|
case lastMaybe (lines output) of
|
|
Just ('2':_:_) -> return (True, extractsize output)
|
|
_ -> dne
|
|
Nothing -> dne
|
|
where
|
|
dne = return (False, Nothing)
|
|
|
|
curlparams =
|
|
[ "-s"
|
|
, "--head"
|
|
, "-L"
|
|
, url
|
|
, "-w", "%{http_code}"
|
|
] ++ concatMap (\h -> ["-H", h]) headers
|
|
|
|
extractsize s = case lastMaybe $ filter ("Content-Length:" `isPrefixOf`) (lines s) of
|
|
Just l -> case lastMaybe $ words l of
|
|
Just sz -> readish sz
|
|
_ -> Nothing
|
|
_ -> Nothing
|
|
|
|
{- Used to download large files, such as the contents of keys.
|
|
-
|
|
- Uses wget or curl program for its progress bar. (Wget has a better one,
|
|
- so is preferred.) Which program to use is determined at run time; it
|
|
- would not be appropriate to test at configure time and build support
|
|
- for only one in.
|
|
-
|
|
- For file:// urls, neither program works well, so we just copy.
|
|
-}
|
|
download :: URLString -> Headers -> [CommandParam] -> FilePath -> IO Bool
|
|
download url headers options file
|
|
| "file://" `isPrefixOf` url =
|
|
let f = drop (length "file://") url
|
|
in copyFileExternal f file
|
|
| otherwise = ifM (inPath "wget") (wget , curl)
|
|
where
|
|
headerparams = map (\h -> Param $ "--header=" ++ h) headers
|
|
wget = go "wget" $ headerparams ++ [Params "-c -O"]
|
|
{- Uses the -# progress display, because the normal
|
|
- one is very confusing when resuming, showing
|
|
- the remainder to download as the whole file,
|
|
- and not indicating how much percent was
|
|
- downloaded before the resume. -}
|
|
curl = go "curl" $ headerparams ++ [Params "-L -C - -# -o"]
|
|
go cmd opts = boolSystem cmd $
|
|
options++opts++[File file, File url]
|
|
|
|
{- Downloads a small file. -}
|
|
get :: URLString -> Headers -> IO String
|
|
get url headers = readProcess "curl" $
|
|
["-s", "-L", url] ++ concatMap (\h -> ["-H", h]) headers
|