module Debian.Repo.AptImage
( prepareAptEnv
, updateAptEnv
, aptGetSource
) where
import Debian.Shell
import Debian.Repo.Cache
import Debian.Repo.Changes
import Debian.Repo.Package
import Debian.Repo.IO
import Debian.Repo.Slice
import Debian.Repo.SourceTree
import Debian.Repo.Types
import Debian.Relation
import Debian.Version
import Control.Exception
import Control.Monad.State (get, put)
import Control.Monad.Trans
import Extra.CIO
import Data.List
import Data.Maybe
import Extra.Files
import Extra.List
import System.Unix.Directory
import System.Unix.Process
import System.Cmd
import System.Directory
instance Show AptImage where
show apt = "AptImage " ++ relName (aptImageReleaseName apt)
instance AptCache AptImage where
globalCacheDir = aptGlobalCacheDir
rootDir = aptImageRoot
aptArch = aptImageArch
aptBaseSliceList = aptImageSliceList
aptSourcePackages = aptImageSourcePackages
aptBinaryPackages = aptImageBinaryPackages
aptReleaseName = aptImageReleaseName
instance Ord AptImage where
compare a b = compare (aptImageReleaseName a) (aptImageReleaseName b)
instance Eq AptImage where
a == b = compare a b == EQ
prepareAptEnv :: CIO m
=> FilePath
-> SourcesChangedAction
-> NamedSliceList
-> AptIOT m AptImage
prepareAptEnv cacheDir sourcesChangedAction sources =
get >>= return . lookupAptImage (sliceListName sources) >>=
maybe (prepareAptEnv' cacheDir sourcesChangedAction sources) return
prepareAptEnv' :: CIO m => FilePath -> SourcesChangedAction -> NamedSliceList -> AptIOT m AptImage
prepareAptEnv' cacheDir sourcesChangedAction sources =
do let root = rootPath (cacheRootDir cacheDir (ReleaseName (sliceName (sliceListName sources))))
io $ createDirectoryIfMissing True (root ++ "/var/lib/apt/lists/partial")
io $ createDirectoryIfMissing True (root ++ "/var/lib/apt/lists/partial")
io $ createDirectoryIfMissing True (root ++ "/var/cache/apt/archives/partial")
io $ createDirectoryIfMissing True (root ++ "/var/lib/dpkg")
io $ createDirectoryIfMissing True (root ++ "/etc/apt")
io $ writeFileIfMissing True (root ++ "/var/lib/dpkg/status") ""
io $ writeFileIfMissing True (root ++ "/var/lib/dpkg/diversions") ""
let sourceListText = show (sliceList sources)
io $ replaceFile (root ++ "/etc/apt/sources.list") sourceListText
arch <- io $ buildArchOfRoot
let os = AptImage { aptGlobalCacheDir = cacheDir
, aptImageRoot = EnvRoot root
, aptImageArch = arch
, aptImageReleaseName = ReleaseName . sliceName . sliceListName $ sources
, aptImageSliceList = sliceList sources
, aptImageSourcePackages = []
, aptImageBinaryPackages = [] }
os' <- updateCacheSources sourcesChangedAction os >>= updateAptEnv
get >>= put . insertAptImage (sliceListName sources) os'
return os'
updateAptEnv :: CIO m => AptImage -> AptIOT m AptImage
updateAptEnv os =
do
io $ system ("apt-get" ++ aptOpts os ++ " update >/dev/null 2>&1")
sourcePackages <- getSourcePackages os >>= return . sortBy cmp
binaryPackages <- getBinaryPackages os
return $ os { aptImageSourcePackages = sourcePackages
, aptImageBinaryPackages = binaryPackages }
where
cmp p1 p2 =
compare v2 v1
where
v1 = packageVersion . sourcePackageID $ p1
v2 = packageVersion . sourcePackageID $ p2
getSourcePackages :: CIO m => AptImage -> AptIOT m [SourcePackage]
getSourcePackages os =
mapM (sourcePackagesOfIndex' os) indexes >>= return . concat
where
indexes = concat . map (sliceIndexes os) . slices . sourceSlices . aptImageSliceList $ os
getBinaryPackages :: CIO m => AptImage -> AptIOT m [BinaryPackage]
getBinaryPackages os =
mapM (binaryPackagesOfIndex' os) indexes >>= return . concat
where
indexes = concat . map (sliceIndexes os) . slices . binarySlices . aptImageSliceList $ os
aptGetSource :: (AptCache t, CIO m)
=> FilePath
-> t
-> PkgName
-> Maybe DebianVersion
-> m DebianBuildTree
aptGetSource dir os package version =
do liftIO $ createDirectoryIfMissing True dir
ready <- findDebianBuildTrees dir
let newest = listToMaybe . map (packageVersion . sourcePackageID) . filter ((== package) . packageName . sourcePackageID) . aptSourcePackages $ os
let version' = maybe newest Just version
case (version', ready) of
(Nothing, _) ->
error ("No available versions of " ++ package ++ " in " ++ rootPath (rootDir os))
(Just requested, [tree])
| requested == (logVersion . entry $ tree) ->
return tree
(Just requested, []) ->
do runAptGet os dir "source" [(package, Just requested)]
trees <- findDebianBuildTrees dir
case trees of
[tree] -> return tree
_ -> error "apt-get source failed"
(Just requested, _) ->
do
liftIO $ removeRecursiveSafely dir
vBOL 0
vEPutStr 0 $ "Retrieving APT source for " ++ package
runAptGet os dir "source" [(package, Just requested)]
trees <- findDebianBuildTrees dir
case trees of
[tree] -> return tree
_ -> error "apt-get source failed"
runAptGet :: (AptCache t, CIO m) => t -> FilePath -> String -> [(PkgName, Maybe DebianVersion)] -> m (Either String [Output])
runAptGet os dir command packages =
mkdir >>= aptget
where
mkdir = liftIO . try . createDirectoryIfMissing True $ dir
aptget (Left e) = return . Left . show $ e
aptget (Right _) = runTaskAndTest (SimpleTask 0 cmd)
cmd = (consperse " " ("cd" : dir : "&&" : "apt-get" : aptOpts os : command : map formatPackage packages))
formatPackage (name, Nothing) = name
formatPackage (name, Just version) = name ++ "=" ++ show version
aptOpts :: AptCache t => t -> String
aptOpts os =
(" -o=Dir::State::status=" ++ root ++ "/var/lib/dpkg/status" ++
" -o=Dir::State::Lists=" ++ root ++ "/var/lib/apt/lists" ++
" -o=Dir::Cache::Archives=" ++ root ++ "/var/cache/apt/archives" ++
" -o=Dir::Etc::SourceList=" ++ root ++ "/etc/apt/sources.list")
where root = rootPath . rootDir $ os