module Linspire.Debian.SourcesList
(DebSource(DebSource),
SourceType(Deb, DebSrc),
parseSourceLine,
parseSourcesList,
quoteWords,
archFiles)
where
import Data.List
import Network.URI
data SourceType
= Deb | DebSrc
deriving Eq
instance Show SourceType where
show Deb = "deb"
show DebSrc = "deb-src"
data DebSource
= DebSource
{ sourceType :: SourceType
, sourceUri :: URI
, sourceDist :: Either String (String, [String])
}
deriving Eq
instance Show DebSource where
show (DebSource thetype theuri thedist) =
(show thetype) ++" "++ (uriToString id theuri " ") ++
case thedist of
Left exactPath -> escape exactPath
Right (dist, sections) ->
(escape dist) ++ " " ++ concat (intersperse " " (map escape sections))
where escape = escapeURIString isAllowedInURI
quoteWords :: String -> [String]
quoteWords [] = []
quoteWords s = quoteWords' Nothing (dropWhile (==' ') s)
where
quoteWords' :: Maybe Char -> String -> [String]
quoteWords' Nothing [] = []
quoteWords' Nothing str =
case break (flip elem " [\"") str of
([],[]) -> []
(w, []) -> [w]
(w, (' ':rest)) -> w : (quoteWords' Nothing (dropWhile (==' ') rest))
(w, ('"':rest)) ->
case break (== '"') rest of
(w',('"':rst)) ->
case quoteWords' Nothing rst of
[] -> [w ++ w']
(w'':ws) -> ((w ++ w' ++ w''): ws)
(_,[]) -> error ("quoteWords: missing \" in the string: " ++ s)
(w, ('[':rst)) ->
case break (== ']') rst of
(w',(']':rsts)) ->
case quoteWords' Nothing rsts of
[] -> [w ++ "[" ++ w' ++ "]"]
(w'':ws) -> ((w ++ "[" ++ w' ++ "]" ++ w''): ws)
(_,[]) -> error ("quoteWords: missing ] in the string: " ++ s)
stripLine :: String -> String
stripLine = takeWhile (/= '#') . dropWhile (== ' ')
sourceLines :: String -> [String]
sourceLines = filter (not . null) . map stripLine . lines
parseSourceLine :: String -> DebSource
parseSourceLine str =
case quoteWords str of
(theTypeStr : theUriStr : theDistStr : sectionStrs) ->
let theType = case unEscapeString theTypeStr of
"deb" -> Deb
"deb-src" -> DebSrc
o -> error ("parseSourceLine: invalid type " ++ o ++ " in line:\n" ++ str)
theUri = case parseURI theUriStr of
Nothing -> error ("parseSourceLine: invalid uri " ++ theUriStr ++ " in the line:\n" ++ str)
Just u -> u
theDist = unEscapeString theDistStr
in
case last theDist of
'/' -> if null sectionStrs
then DebSource { sourceType = theType, sourceUri = theUri, sourceDist = Left theDist }
else error ("parseSourceLine: Dist is an exact path, so sections are not allowed on the line:\n" ++ str)
_ -> if null sectionStrs
then error ("parseSourceLine: Dist is not an exact path, so at least one section is required on the line:\n" ++ str)
else DebSource { sourceType = theType, sourceUri = theUri, sourceDist = Right (theDist, map unEscapeString sectionStrs) }
_ -> error ("parseSourceLine: invalid line in sources.list:\n" ++ str)
parseSourcesList :: String -> [DebSource]
parseSourcesList = map parseSourceLine . sourceLines
archFiles :: FilePath -> Maybe String -> DebSource -> [FilePath]
archFiles root (Just arch) deb@(DebSource Deb _ _) =
map (++ ("_binary-" ++ arch ++ "_Packages")) (archFiles' root deb)
archFiles root Nothing deb@(DebSource DebSrc _ _) =
map (++ "_source_Sources") (archFiles' root deb)
archFiles _ _ _ = []
archFiles' :: FilePath -> DebSource -> [FilePath]
archFiles' root deb =
let uri = sourceUri deb
distro = sourceDist deb in
let schme = uriScheme uri
auth = uriAuthority uri
pth = uriPath uri in
let userpass = maybe "" uriUserInfo auth
reg = maybeOfString $ maybe "" uriRegName auth
port = maybe "" uriPort auth in
let (user, pass) = break (== ':') userpass in
let user' = maybeOfString user
pass' = maybeOfString pass in
let uriText = prefix schme user' pass' reg port pth in
either (\ exact -> [root ++ (escapeURIString (/= '@') ("/var/lib/apt/lists/" ++ uriText ++ escape exact))])
(\ (dist, sections) ->
map (\ section -> root ++ (escapeURIString (/= '@')
("/var/lib/apt/lists/" ++
uriText ++
"_dists_" ++ escape dist ++ "_" ++
escape section)))
sections)
distro
where
prefix "http:" (Just user) Nothing (Just host) port pth =
user ++ host ++ port ++ escape pth
prefix "http:" _ _ (Just host) port pth =
host ++ port ++ escape pth
prefix "ftp:" _ _ (Just host) _ pth =
host ++ escape pth
prefix "file:" Nothing Nothing Nothing "" pth =
escape pth
prefix "ssh:" (Just user) Nothing (Just host) port pth =
user ++ host ++ port ++ escape pth
prefix "ssh" _ _ (Just host) port pth =
host ++ port ++ escape pth
prefix _ _ _ _ _ _ = error ("invalid DebSource: " ++ show deb)
maybeOfString "" = Nothing
maybeOfString s = Just s
escape s = consperse "_" (wordsBy (== '/') s)
consperse :: [a] -> [[a]] -> [a]
consperse sep items = concat (intersperse sep items)
wordsBy :: Eq a => (a -> Bool) -> [a] -> [[a]]
wordsBy p s =
case (break p s) of
(t, []) -> [t]
(h, t) -> h : wordsBy p (drop 1 t)