module Debian.Apt.Index
( update
, Fetcher
, CheckSums(..)
, Compression(..)
, FileTuple
, Size
, controlFromIndex
, controlFromIndex'
, findContentsFiles
, findIndexes
, indexesInRelease
, tupleFromFilePath
) where
import Control.Monad
import qualified Codec.Compression.GZip as GZip
import qualified Codec.Compression.BZip as BZip
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Function
import Data.List
import qualified Data.Map as M
import Data.Time
import Debian.Apt.Methods
import Debian.Control (formatControl)
import Debian.Control.ByteString
import Debian.Control.Common
import Debian.Release
import Debian.Sources
import Debian.URI
import System.Directory
import System.FilePath ((</>))
import System.Posix.Files
import System.Unix.FilePath
import qualified System.Unix.Misc as Misc
import Text.ParserCombinators.Parsec.Error
data Compression
= BZ2 | GZ | Uncompressed
deriving (Read, Show, Eq, Ord, Enum, Bounded)
data CheckSums
= CheckSums { md5sum :: Maybe String
, sha1 :: Maybe String
, sha256 :: Maybe String
}
deriving (Read, Show, Eq)
type Fetcher =
URI ->
FilePath ->
Maybe UTCTime ->
IO Bool
update :: Fetcher
-> FilePath
-> String
-> [DebSource]
-> IO [Maybe (FilePath, Compression)]
update fetcher basePath arch sourcesList =
mapM (uncurry $ fetchIndex fetcher) (map (\(uri, fp, _) -> (uri, (basePath </> fp))) (concatMap (indexURIs arch) sourcesList))
fetchIndex :: Fetcher
-> URI
-> FilePath
-> IO (Maybe (FilePath, Compression))
fetchIndex fetcher uri localPath =
do let localPath' = localPath ++ ".bz2"
res <- fetcher (uri { uriPath = (uriPath uri) ++ ".bz2" }) localPath' Nothing
return Nothing
if res
then return $ Just (localPath', BZ2)
else do let localPath' = localPath ++ ".gz"
lm <- getLastModified localPath'
res <- fetcher (uri { uriPath = (uriPath uri) ++ ".gz" }) localPath' lm
if res
then return $ Just (localPath', GZ)
else do lm <- getLastModified localPath
res <- fetcher (uri { uriPath = (uriPath uri) }) localPath lm
if res
then return (Just (localPath, Uncompressed))
else return Nothing
indexURIs :: String
-> DebSource
-> [(URI, FilePath, DebSource)]
indexURIs arch debSource =
map (\ section -> let (uri, fp) = calcPath (sourceType debSource) arch baseURI release section
in (uri,fp, debSource { sourceDist = (Right (release, [section])) }) ) sections
where
baseURI = sourceUri debSource
(release, sections) =
either (error $ "indexURIs: support not implemented for exact path: " ++ show debSource) id (sourceDist debSource)
calcPath :: SourceType
-> String
-> URI
-> ReleaseName
-> Section
-> (URI, [Char])
calcPath srcType arch baseURI release section =
let indexPath = case srcType of
DebSrc -> "source/Sources"
Deb -> "binary-" ++ arch </> "Packages"
path = (uriPath baseURI) </> "dists" </> (releaseName' release) </> sectionName' section </> indexPath
in (baseURI { uriPath = path }, addPrefix . escapePath $ path)
where
addPrefix s = prefix scheme user' pass' reg port ++ s
prefix "http:" (Just user) Nothing (Just host) port = user ++ host ++ port
prefix "http:" _ _ (Just host) port = host ++ port
prefix "ftp:" _ _ (Just host) _ = host
prefix "file:" Nothing Nothing Nothing "" = ""
prefix "ssh:" (Just user) Nothing (Just host) port = user ++ host ++ port
prefix "ssh:" _ _ (Just host) port = host ++ port
prefix _ _ _ _ _ = error ("calcPath: unsupported uri: " ++ uriToString' baseURI)
user' = maybeOfString user
pass' = maybeOfString pass
(user, pass) = break (== ':') userpass
userpass = maybe "" uriUserInfo auth
reg = maybeOfString $ maybe "" uriRegName auth
port = maybe "" uriPort auth
scheme = uriScheme baseURI
auth = uriAuthority baseURI
escapePath :: String -> String
escapePath s = intercalate "_" $ wordsBy (== '/') s
maybeOfString :: String -> Maybe String
maybeOfString "" = Nothing
maybeOfString s = Just s
wordsBy :: Eq a => (a -> Bool) -> [a] -> [[a]]
wordsBy p s =
case (break p s) of
(s, []) -> [s]
(h, t) -> h : wordsBy p (drop 1 t)
controlFromIndex :: Compression -> FilePath -> L.ByteString -> Either ParseError (Control' B.ByteString)
controlFromIndex GZ path s = parseControl path . B.concat . L.toChunks . GZip.decompress $ s
controlFromIndex BZ2 path s = parseControl path . B.concat . L.toChunks . BZip.decompress $ s
controlFromIndex Uncompressed path s = parseControl path . B.concat . L.toChunks $ s
controlFromIndex' :: Compression -> FilePath -> IO (Either ParseError (Control' B.ByteString))
controlFromIndex' compression path = L.readFile path >>= return . controlFromIndex compression path
type Size = Integer
type FileTuple = (CheckSums, Size, FilePath)
groupIndexes :: [FileTuple] -> [(FilePath, [(FileTuple, Compression)])]
groupIndexes indexFiles =
M.toList $ M.fromListWith combine $ map makeKV indexFiles
where
makeKV fileTuple@(_,_,fp) =
let (name, compressionMethod) = uncompressedName fp
in
(name, [(fileTuple, compressionMethod)])
combine = (\x y -> sortBy (compare `on` snd) (x ++ y))
filterExists :: FilePath -> (FilePath, [(FileTuple, Compression)]) -> IO (FilePath, [(FileTuple, Compression)])
filterExists distDir (fp, alternatives) =
do e <- filterM ( \((_,_,fp),_) -> fileExist (distDir </> fp)) alternatives
return (fp, e)
findIndexes :: FilePath -> String -> [FileTuple] -> IO [(FileTuple, Compression)]
findIndexes distDir iType controlFiles =
let indexes = groupIndexes controlFiles
in
do indexes' <- mapM (filterExists distDir) (filter (isType iType) indexes)
return $ map (head . snd) (filter (not . null . snd) indexes')
where
isType iType (fp, _) = iType `isSuffixOf` fp
uncompressedName :: FilePath -> (FilePath, Compression)
uncompressedName fp
| isSuffixOf ".gz" fp = (reverse . (drop 3) . reverse $ fp, GZ)
| isSuffixOf ".bz2" fp = (reverse . (drop 4) . reverse $ fp, BZ2)
| otherwise = (fp, Uncompressed)
indexesInRelease :: (FilePath -> Bool)
-> Control
-> [(CheckSums, Integer, FilePath)]
indexesInRelease filterp (Control [p]) =
let md5sums =
case md5sumField p of
(Just md5) -> md5
Nothing -> error $ "Did not find MD5Sum field."
in
filter (\(_,_,fp) -> filterp fp) $ map (makeTuple . B.words) $ filter (not . B.null) (B.lines md5sums)
where
makeTuple :: [B.ByteString] -> (CheckSums, Integer, FilePath)
makeTuple [md5sum, size, fp] = (CheckSums { md5sum = Just (B.unpack md5sum), sha1 = Nothing, sha256 = Nothing }, read (B.unpack size), B.unpack fp)
makeTuple x = error $ "Invalid line in release file: " ++ show x
indexesInRelease _ x = error $ "Invalid release file: " ++ B.unpack (B.concat (formatControl x))
tupleFromFilePath :: FilePath -> FilePath -> IO (Maybe FileTuple)
tupleFromFilePath basePath fp =
do e <- fileExist (basePath </> fp)
if not e
then return Nothing
else do size <- getFileStatus (basePath </> fp) >>= return . fromIntegral . fileSize
md5 <- Misc.md5sum (basePath </> fp)
return $ Just (CheckSums { md5sum = Just md5, sha1 = Nothing, sha256 = Nothing }, size, fp)
findContentsFiles :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
findContentsFiles filterP distDir =
do files <- getDirectoryContents distDir
return $ filter filterP $ filter (isPrefixOf "Contents-" . baseName) files