module Debian.Repo.Types ( EnvRoot(..) , EnvPath(..) , outsidePath , appendPath , rootEnvPath -- * Repository , PackageVersion(..) , PkgVersion(..) , Repo(..) , libraryCompatibilityLevel , compatibilityFile , Repository(..) , LocalRepository(..) , Layout(..) -- * Release , ReleaseName(..) , parseReleaseName , ReleaseInfo(..) , Arch(..) , archName , Section(..) , SubSection(..) , sectionNameOfSubSection , sectionName , sectionName' , parseSection , parseSection' , Release(..) , releaseName' , releaseName , releaseComponents , releaseArchitectures -- * Each line of the sources.list represents a slice of a repository , SourceType(..) , DebSource(..) , SliceName(..) , Slice(..) , SliceList(..) , NamedSliceList(..) -- * Package, Source and Binary Debs , PackageIndex(..) , PackageIndexLocal , PackageID(..) , BinaryPackage(..) , SourcePackage(..) , SourceFileSpec(..) , PackageIDLocal , BinaryPackageLocal , SourcePackageLocal -- * Cached OS Image , AptCache(..) , AptBuildCache(..) , AptImage(..) ) where import qualified Debian.Control.ByteString as B import qualified Debian.Relation as B import Debian.URI import Debian.Version import Control.Exception (throw) import qualified Data.ByteString.Lazy.Char8 as L import Data.Char import Data.List import Data.Maybe import Network.URI import System.FilePath (()) import System.Posix.Types import System.Unix.Process -- |The root directory of an OS image. data EnvRoot = EnvRoot { rootPath :: FilePath } deriving (Ord, Eq, Read, Show) -- |A directory inside of an OS image. data EnvPath = EnvPath { envRoot :: EnvRoot , envPath :: FilePath } deriving (Ord, Eq, Read, Show) outsidePath :: EnvPath -> FilePath outsidePath path = rootPath (envRoot path) ++ envPath path appendPath :: FilePath -> EnvPath -> EnvPath appendPath suff path = path { envPath = envPath path ++ suff } rootEnvPath :: FilePath -> EnvPath rootEnvPath s = EnvPath { envRoot = EnvRoot "", envPath = s } --------------------- REPOSITORY ----------------------- -- | The Repository type reprents any instance of the Repo class, so -- it might be local or remote. --data Repository = forall a. (Repo a) => Repository a data Repository = LocalRepo LocalRepository | VerifiedRepo URIString [ReleaseInfo] | UnverifiedRepo URIString deriving (Read, Show) instance Ord Repository where compare a b = compare (repoURI a) (repoURI b) instance Eq Repository where a == b = compare a b == EQ data LocalRepository = LocalRepository { repoRoot :: EnvPath , repoLayout :: (Maybe Layout) , repoReleaseInfoLocal :: [ReleaseInfo] } deriving (Read, Show, Ord, Eq) -- |The possible file arrangements for a repository. An empty -- repository does not yet have either of these attributes. data Layout = Flat | Pool deriving (Eq, Ord, Read, Show) instance Repo Repository where repoURI (LocalRepo (LocalRepository path _ _)) = fromJust . parseURI $ "file://" ++ envPath path repoURI (VerifiedRepo uri _) = fromJust (parseURI uri) repoURI (UnverifiedRepo uri) = fromJust (parseURI uri) {- repoURI (Repository a) = repoURI a repositoryCompatibilityLevel (Repository a) = repositoryCompatibilityLevel a repoReleaseInfo (Repository a) = repoReleaseInfo a -} repoReleaseInfo (LocalRepo (LocalRepository _ _ info)) = info repoReleaseInfo (VerifiedRepo _ info) = info repoReleaseInfo (UnverifiedRepo _uri) = error "No release info for unverified repository" instance Repo LocalRepository where repoURI (LocalRepository path _ _) = fromJust . parseURI $ "file://" ++ envPath path repoReleaseInfo (LocalRepository _ _ info) = info class (Ord t, Eq t) => Repo t where repoURI :: t -> URI repositoryCompatibilityLevel :: t -> IO (Maybe Int) repositoryCompatibilityLevel r = fileFromURI uri' >>= either throw (return . parse . L.unpack) where uri' = uri {uriPath = uriPath uri compatibilityFile} uri = repoURI r {- lazyCommand cmd L.empty >>= return . collectOutput >>= test cmd where cmd = "curl -s -g '" ++ uriToString id (repoURI r) "" compatibilityFile ++ "'" test _ (out, _err, [ExitSuccess]) = return (parse (L.unpack out)) test cmd (_, _, _) = error $ "*** FAILURE: " ++ cmd -} parse :: String -> Maybe Int parse text = case takeWhile isDigit text of "" -> Nothing s -> Just . read $ s -- | This method returns a list of all the release in the -- repository. This can be used to identify all of the files -- in the repository that are not garbage. repoReleaseInfo :: t -> [ReleaseInfo] checkCompatibility :: t -> IO () checkCompatibility repo = do level <- repositoryCompatibilityLevel repo case level of Nothing -> return () Just n | n >= libraryCompatibilityLevel -> return () Just n -> error ("Compatibility error: repository level " ++ show n ++ " < library level " ++ show libraryCompatibilityLevel ++ ", please upgrade.") -- |The name of the file which holds the repository's compatibility -- level. compatibilityFile :: FilePath compatibilityFile = "repository-compat" -- | The compatibility level of this library and any applications -- which use it. It is an error if we try to use a repository whose -- compatibility level is higher than this, a newer version of the -- library must be used. This value was increased from 1 to 2 due -- to a new version number tagging policy. libraryCompatibilityLevel :: Int libraryCompatibilityLevel = 2 class (Eq a, Ord a) => PackageVersion a where pkgName :: a -> B.PkgName pkgVersion :: a -> DebianVersion -- |This is an old type which is still used to interface with the -- Debian.Relation module. data PkgVersion = PkgVersion { getName :: B.PkgName , getVersion :: DebianVersion } deriving (Eq, Ord) instance PackageVersion PkgVersion where pkgName = getName pkgVersion = getVersion instance Show PkgVersion where show v = getName v ++ "=" ++ show (getVersion v) -------------------- RELEASE -------------------- -- |A distribution (aka release) name. This type is expected to refer -- to a subdirectory of the dists directory which is at the top level -- of a repository. data ReleaseName = ReleaseName { relName :: String } deriving (Eq, Ord, Read, Show) parseReleaseName :: String -> ReleaseName parseReleaseName name = ReleaseName {relName = unEscapeString name} releaseName' :: ReleaseName -> String releaseName' (ReleaseName {relName = s}) = escapeURIString isAllowedInURI s -- FIXME: The lists here should be sets so that == and compare work properly. data ReleaseInfo = ReleaseInfo { releaseInfoName :: ReleaseName , releaseInfoAliases :: [ReleaseName] , releaseInfoArchitectures :: [Arch] , releaseInfoComponents :: [Section] } deriving (Eq, Ord, Read, Show) -- |The types of architecture that a package can have, either Source -- or some type of binary architecture. data Arch = Source | Binary String deriving (Read, Show, Eq, Ord) archName :: Arch -> String archName Source = "source" archName (Binary arch) = arch -- |A section of a repository such as main, contrib, non-free, -- restricted. The indexes for a section are located below the -- distribution directory. newtype Section = Section String deriving (Read, Show, Eq, Ord) -- |A package's subsection is only evident in its control information, -- packages from different subsections all reside in the same index. data SubSection = SubSection { section :: Section, subSectionName :: String } deriving (Read, {-Show,-} Eq, Ord) sectionName :: SubSection -> String sectionName (SubSection (Section "main") y) = y sectionName (SubSection x y) = sectionName' x ++ "/" ++ y sectionName' :: Section -> String sectionName' (Section s) = escapeURIString isAllowedInURI s sectionNameOfSubSection :: SubSection -> String sectionNameOfSubSection = sectionName' . section -- |Parse the value that appears in the @Section@ field of a .changes file. -- (Does this need to be unesacped?) parseSection section = case span (/= '/') section of (x, "") -> SubSection (Section "main") x ("main", y) -> SubSection (Section "main") y (x, y) -> SubSection (Section x) (tail y) parseSection' name = Section (unEscapeString name) data Release = Release { releaseRepo :: Repository , releaseInfo :: ReleaseInfo } deriving (Eq, Ord, Show) releaseName :: Release -> ReleaseName releaseName = releaseInfoName . releaseInfo --releaseAliases :: Release -> [ReleaseName] --releaseAliases = releaseInfoAliases . releaseInfo releaseComponents :: Release -> [Section] releaseComponents = releaseInfoComponents . releaseInfo releaseArchitectures :: Release -> [Arch] releaseArchitectures = releaseInfoArchitectures . releaseInfo ----------------- SLICES (SOURCES.LIST ENTRIES) --------------- data SourceType = Deb | DebSrc deriving (Eq, Ord) data DebSource = DebSource { sourceType :: SourceType , sourceUri :: URI , sourceDist :: Either String (ReleaseName, [Section]) } deriving (Eq, Ord) instance Show SourceType where show Deb = "deb" show DebSrc = "deb-src" instance Show DebSource where show (DebSource thetype theuri thedist) = (show thetype) ++ " "++ uriToString id theuri " " ++ (case thedist of Left exactPath -> escape exactPath Right (dist, sections) -> releaseName' dist ++ " " ++ intercalate " " (map sectionName' sections)) where escape = escapeURIString isAllowedInURI -- |This is a name given to a combination of parts of one or more -- releases that can be specified by a sources.list file. data SliceName = SliceName { sliceName :: String } deriving (Eq, Ord) data Slice = Slice { sliceRepo :: Repository , sliceSource :: DebSource } deriving (Eq, Ord) data SliceList = SliceList {slices :: [Slice]} deriving (Eq, Ord) data NamedSliceList = NamedSliceList { sliceList :: SliceList , sliceListName :: SliceName } deriving (Eq, Ord) instance Show Slice where show = show . sliceSource instance Show SliceList where show = concat . map ((++ "\n") . show) . slices ---------------- PACKAGES AND PACKAGE INDEXES ------------- -- |The PackageIndex type represents a file containing control -- information about debian packages, either source or binary. -- Though the control information for a binary package does not -- specify an architecture, the architecture here is that of -- the environment where the package information is cached. data PackageIndex = PackageIndex { packageIndexRelease :: Release , packageIndexComponent :: Section , packageIndexArch :: Arch } deriving (Eq, Ord, Show) type PackageIndexLocal = PackageIndex instance Show BinaryPackage where show p = packageName (packageID p) ++ "-" ++ show (packageVersion (packageID p)) -- | The 'PackageID' type fully identifies a package by name, version, -- and a 'PackageIndex' which identifies the package's release, -- component and architecture. data PackageID = PackageID { packageIndex :: PackageIndex , packageName :: String , packageVersion :: DebianVersion } deriving (Eq, Ord, Show) -- | The 'BinaryPackage' type adds to the 'PackageID' type the control -- information obtained from the package index. data BinaryPackage = BinaryPackage { packageID :: PackageID , packageInfo :: B.Paragraph , pDepends :: B.Relations , pPreDepends :: B.Relations , pConflicts ::B.Relations , pReplaces :: B.Relations , pProvides :: B.Relations } instance Ord BinaryPackage where compare a b = compare (packageID a) (packageID b) instance Eq BinaryPackage where a == b = (packageID a) == (packageID b) data SourcePackage = SourcePackage { sourcePackageID :: PackageID , sourceParagraph :: B.Paragraph , sourceDirectory :: String , sourcePackageFiles :: [SourceFileSpec] } data SourceFileSpec = SourceFileSpec { sourceFileMD5sum :: String , sourceFileSize :: FileOffset , sourceFileName :: FilePath } type PackageIDLocal = PackageID type BinaryPackageLocal = BinaryPackage type SourcePackageLocal = SourcePackage ---------------------- CACHED OS IMAGE --------------------- class (Ord t, Eq t, Show t) => AptCache t where globalCacheDir :: t -> FilePath -- | The directory you might chroot to. rootDir :: t -> EnvRoot -- | The sources.list without the local repository aptBaseSliceList :: t -> SliceList -- | The build architecture aptArch :: t -> Arch -- | Return the all source packages in this AptCache. aptSourcePackages :: t -> [SourcePackage] -- | Return the all binary packages for the architecture of this AptCache. aptBinaryPackages :: t -> [BinaryPackage] -- | Name of release aptReleaseName :: t -> ReleaseName class AptCache t => AptBuildCache t where -- | The sources.list aptSliceList :: t -> SliceList data AptImage = AptImage { aptGlobalCacheDir :: FilePath , aptImageRoot :: EnvRoot , aptImageArch :: Arch , aptImageSliceList :: SliceList , aptImageReleaseName :: ReleaseName , aptImageSourcePackages :: [SourcePackage] , aptImageBinaryPackages :: [BinaryPackage] }