debian 3.64.1 → 3.65
raw patch · 8 files changed
+51/−59 lines, 8 filesdep +pretty-classdep +process-extras
Dependencies added: pretty-class, process-extras
Files
- Debian/Apt/Index.hs +2/−1
- Debian/Control/String.hs +10/−9
- Debian/Deb.hs +4/−3
- Debian/Sources.hs +8/−6
- Debian/URI.hs +12/−28
- Debian/Util/FakeChanges.hs +7/−7
- Test/SourcesList.hs +5/−4
- debian.cabal +3/−1
Debian/Apt/Index.hs view
@@ -39,6 +39,7 @@ import System.FilePath (takeBaseName) --import qualified System.Unix.Misc as Misc import Text.ParserCombinators.Parsec.Error+import Text.PrettyPrint.Class (pretty) -- |Package indexes on the server are uncompressed or compressed with@@ -121,7 +122,7 @@ where baseURI = sourceUri debSource (release, sections) =- either (error $ "indexURIs: support not implemented for exact path: " ++ show debSource) id (sourceDist debSource)+ either (error $ "indexURIs: support not implemented for exact path: " ++ show (pretty debSource)) id (sourceDist debSource) -- |return a tuple for the section -- - the URI to the uncompressed index file
Debian/Control/String.hs view
@@ -29,17 +29,18 @@ import Text.ParserCombinators.Parsec import System.IO import Debian.Control.Common---- |This may have bad performance issues -instance Show (Control' String) where- show (Control paragraph) = intercalate "\n" (map show paragraph)+import Text.PrettyPrint.Class (Pretty(pretty))+import Text.PrettyPrint.HughesPJ (text, vcat, ($$)) -instance Show (Paragraph' String) where- show (Paragraph fields) = unlines (map show fields)+-- |This may have bad performance issues (why?)+instance Pretty (Control' String) where+ pretty (Control paragraphs) = vcat (map (\ p -> pretty p $$ text "") paragraphs)+instance Pretty (Paragraph' String) where+ pretty (Paragraph fields) = vcat (map pretty fields) -instance Show (Field' String) where- show (Field (name,value)) = name ++":"++ value- show (Comment text) = text+instance Pretty (Field' String) where+ pretty (Field (name,value)) = text $ name ++":"++ value+ pretty (Comment s) = text s type Field = Field' String type Control = Control' String
Debian/Deb.hs view
@@ -6,18 +6,19 @@ import Data.ByteString.Lazy (empty) import Debian.Control.Common import System.Exit (ExitCode(..))+import System.Process (CmdSpec(RawCommand))+import System.Process.Read (readProcessWithExitCode) import System.Unix.Directory (withTemporaryDirectory, withWorkingDirectory) import System.Unix.FilePath (realpath)-import System.Unix.Process (readProcessWithExitCode) fields :: (ControlFunctions a) => FilePath -> IO (Control' a) fields debFP = withTemporaryDirectory ("fields.XXXXXX") $ \tmpdir -> do debFP <- realpath debFP withWorkingDirectory tmpdir $- do (res, out, err) <- readProcessWithExitCode "ar" ["x",debFP,"control.tar.gz"] id empty+ do (res, out, err) <- readProcessWithExitCode "ar" ["x",debFP,"control.tar.gz"] empty when (res /= ExitSuccess) (error $ "Dpkg.fields: " ++ show out ++ "\n" ++ show err ++ "\n" ++ show res)- (res, out, err) <- readProcessWithExitCode "tar" ["xzf", "control.tar.gz", "./control"] id empty+ (res, out, err) <- readProcessWithExitCode "tar" ["xzf", "control.tar.gz", "./control"] empty when (res /= ExitSuccess) (error $ "Dpkg.fields: " ++ show out ++ "\n" ++ show err ++ "\n" ++ show res) c <- parseControlFromFile "control" case c of
Debian/Sources.hs view
@@ -4,6 +4,8 @@ import Data.List (intercalate) import Debian.Release import Debian.URI+import Text.PrettyPrint.HughesPJ (text)+import Text.PrettyPrint.Class (Pretty(pretty)) data SourceType = Deb | DebSrc@@ -16,13 +18,13 @@ , sourceDist :: Either String (ReleaseName, [Section]) } deriving (Eq, Ord) -instance Show SourceType where- show Deb = "deb"- show DebSrc = "deb-src"+instance Pretty SourceType where+ pretty Deb = text "deb"+ pretty DebSrc = text "deb-src" -instance Show DebSource where- show (DebSource thetype theuri thedist) =- (show thetype) ++ " "++ uriToString id theuri " " +++instance Pretty DebSource where+ pretty (DebSource thetype theuri thedist) = text $+ (show (pretty thetype)) ++ " "++ uriToString id theuri " " ++ (case thedist of Left exactPath -> escape exactPath Right (dist, sections) ->
Debian/URI.hs view
@@ -10,13 +10,12 @@ import Control.Exception (SomeException, try) import qualified Data.ByteString.Lazy.Char8 as L+import Data.ByteString.UTF8 as B import qualified Data.ByteString as B import Data.Maybe (catMaybes) import Network.URI import System.Directory (getDirectoryContents)-import System.Exit (ExitCode(..))-import System.Process (showCommandForUser)-import System.Unix.Process (readProcessWithExitCode)+import System.Process.Read (readProcessWithExitCode) -- import System.Unix.LazyProcess (collectStdout) -- import System.Unix.Progress (lazyCommandF) import Text.Regex (mkRegex, matchRegex)@@ -28,22 +27,7 @@ type URIString = String fileFromURI :: URI -> IO (Either SomeException L.ByteString)-fileFromURI uri = try $- case (uriScheme uri, uriAuthority uri) of- ("file:", Nothing) -> L.readFile (uriPath uri)- -- ("ssh:", Just auth) -> cmdOutput ("ssh " ++ uriUserInfo auth ++ uriRegName auth ++ uriPort auth ++ " cat " ++ show (uriPath uri))- ("ssh:", Just auth) ->- do let cmd = "ssh"- args = [uriUserInfo auth ++ uriRegName auth ++ uriPort auth, "cat", uriPath uri]- (code, out, _err) <- readProcessWithExitCode cmd args id L.empty- case code of- ExitFailure _ -> error (showCommandForUser cmd args ++ " -> " ++ show code)- _ -> return out- _ ->- do let cmd = "curl"- args = ["-s", "-g", uriToString' uri]- (_code, out, _err) <- readProcessWithExitCode cmd args id L.empty- return out+fileFromURI uri = fileFromURIStrict uri >>= either (return . Left) (return . Right . L.fromChunks . (: [])) fileFromURIStrict :: URI -> IO (Either SomeException B.ByteString) fileFromURIStrict uri = try $@@ -53,21 +37,21 @@ ("ssh:", Just auth) -> do let cmd = "ssh" args = [uriUserInfo auth ++ uriRegName auth ++ uriPort auth, "cat", uriPath uri]- (_code, out, _err) <- readProcessWithExitCode cmd args id L.empty- return . B.concat . L.toChunks $ out+ (_code, out, _err) <- readProcessWithExitCode cmd args B.empty+ return out _ -> do let cmd = "curl" args = ["-s", "-g", uriToString' uri]- (_code, out, _err) <- readProcessWithExitCode cmd args id L.empty- return . B.concat . L.toChunks $ out+ (_code, out, _err) <- readProcessWithExitCode cmd args B.empty+ return out -- | Parse the text returned when a directory is listed by a web -- server. This is currently only known to work with Apache. -- NOTE: there is a second copy of this function in -- Extra:Extra.Net. Please update both locations if you make changes.-webServerDirectoryContents :: L.ByteString -> [String]+webServerDirectoryContents :: B.ByteString -> [String] webServerDirectoryContents text =- catMaybes . map (second . matchRegex re) . lines . L.unpack $ text+ catMaybes . map (second . matchRegex re) . Prelude.lines . B.toString $ text where re = mkRegex "( <A HREF|<a href)=\"([^/][^\"]*)/\"" second (Just [_, b]) = Just b@@ -81,10 +65,10 @@ ("ssh:", Just auth) -> do let cmd = "ssh" args = [uriUserInfo auth ++ uriRegName auth ++ uriPort auth, "ls", "-1", uriPath uri]- (_code, out, _err) <- readProcessWithExitCode cmd args id L.empty- return . lines . L.unpack $ out+ (_code, out, _err) <- readProcessWithExitCode cmd args B.empty+ return . Prelude.lines . B.toString $ out _ -> do let cmd = "curl" args = ["-s", "-g", uriToString' uri]- (_code, out, _err) <- readProcessWithExitCode cmd args id L.empty+ (_code, out, _err) <- readProcessWithExitCode cmd args B.empty return . webServerDirectoryContents $ out
Debian/Util/FakeChanges.hs view
@@ -19,6 +19,7 @@ import Text.Regex.TDFA import Prelude hiding (catch, concat, foldr, all, mapM) import Network.BSD+import Text.PrettyPrint.Class (pretty) import Debian.Control import qualified Debian.Deb as Deb@@ -42,8 +43,7 @@ , tar :: Maybe FilePath , diff :: Maybe FilePath }- deriving Show- + fakeChanges :: [FilePath] -> IO (FilePath, String) fakeChanges fps = do files <- loadFiles fps@@ -78,7 +78,7 @@ )) , ("Files", "\n" ++ unlines fileLines) ]- return $ (concat [ source, "_", version, "_", binArch, ".changes"], show changes)+ return $ (concat [ source, "_", version, "_", binArch, ".changes"], show (pretty changes)) -- let (invalid, binaries) = unzipEithers $ map debNameSplit debs {- when (not . null $ invalid) (throwDyn [MalformedDebFilename invalid])@@ -102,9 +102,9 @@ | otherwise = case fieldValue "Version" (snd . fromJust $ dsc files) of (Just v) -> v- Nothing -> error $ show (dsc files) ++ " does not have a Version field :("- + Nothing -> error $ "show (dsc files)" ++ " does not have a Version field :(" + getSource :: Files -> String getSource files = let dscSource =@@ -223,13 +223,13 @@ case res of (Left e) -> error $ "Error parsing " ++ dsc ++ "\n" ++ show e (Right (Control [p])) -> return (dsc, p)- (Right c) -> error $ dsc ++ " did not have exactly one paragraph: " ++ show c+ (Right c) -> error $ dsc ++ " did not have exactly one paragraph: " ++ show (pretty c) loadDeb :: FilePath -> IO (FilePath, Paragraph) loadDeb deb = do res <- Deb.fields deb case res of (Control [p]) -> return (deb, p)- _ -> error $ deb ++ " did not have exactly one paragraph: " ++ show res+ _ -> error $ deb ++ " did not have exactly one paragraph: " ++ show (pretty res) getUploader :: IO String
Test/SourcesList.hs view
@@ -1,6 +1,7 @@ module Test.SourcesList where import Test.HUnit+import Text.PrettyPrint.Class (pretty) import Debian.Sources --import Data.Maybe@@ -21,7 +22,7 @@ testSourcesList :: Test testSourcesList =- test [ assertEqual "valid sources.list" validSourcesListExpected (unlines . map show . parseSourcesList $ validSourcesListStr) ]+ test [ assertEqual "valid sources.list" validSourcesListExpected (unlines . map (show . pretty) . parseSourcesList $ validSourcesListStr) ] where validSourcesListStr = unlines $ [ " # A comment only line "@@ -44,16 +45,16 @@ testSourcesListParse :: Test testSourcesListParse =- test [ assertEqual "" text (concat . map (++ "\n") . map show . parseSourcesList $ text) ]+ test [ assertEqual "" gutsy (concat . map (++ "\n") . map (show . pretty) . parseSourcesList $ gutsy) ] where- text = (concat ["deb http://us.archive.ubuntu.com/ubuntu/ gutsy main restricted universe multiverse\n",+ gutsy = concat ["deb http://us.archive.ubuntu.com/ubuntu/ gutsy main restricted universe multiverse\n", "deb-src http://us.archive.ubuntu.com/ubuntu/ gutsy main restricted universe multiverse\n", "deb http://us.archive.ubuntu.com/ubuntu/ gutsy-updates main restricted universe multiverse\n", "deb-src http://us.archive.ubuntu.com/ubuntu/ gutsy-updates main restricted universe multiverse\n", "deb http://us.archive.ubuntu.com/ubuntu/ gutsy-backports main restricted universe multiverse\n", "deb-src http://us.archive.ubuntu.com/ubuntu/ gutsy-backports main restricted universe multiverse\n", "deb http://security.ubuntu.com/ubuntu/ gutsy-security main restricted universe multiverse\n",- "deb-src http://security.ubuntu.com/ubuntu/ gutsy-security main restricted universe multiverse\n"])+ "deb-src http://security.ubuntu.com/ubuntu/ gutsy-security main restricted universe multiverse\n"] sourcesListTests :: [Test] sourcesListTests =
debian.cabal view
@@ -1,5 +1,5 @@ Name: debian-Version: 3.64.1+Version: 3.65 License: BSD3 License-File: debian/copyright Author: David Fox <dsf@seereason.com>, Jeremy Shaw <jeremy@seereason.com>, Clifford Beshers <beshers@seereason.com>@@ -34,7 +34,9 @@ old-locale, parsec >= 2 && <4, pretty,+ pretty-class, process,+ process-extras >= 0.4, pureMD5, regex-compat, regex-tdfa,