21b4b9f · docker-hs · git.iko.soy

git.iko.soy/docker-hs

on master help sign in

Cleans up the context building process

21b4b9fDeni Bertovic10 years ago

src/Docker/Client/Api.hs−2

compare with master

unifiedsplit

@@ -26,11 +26,9 @@ import Control.Monad.IO.Class

26import Control.Monad.Reader (ask, lift)

27import Data.Aeson (FromJSON, eitherDecode')

28import qualified Data.ByteString.Lazy as BSL

29−import qualified Data.Text as T

30import qualified Data.Text as Text

29import qualified Data.Text as Text

31import Network.HTTP.Client (responseBody, responseStatus)

30import Network.HTTP.Client (responseBody, responseStatus)

32import Network.HTTP.Types (StdMethod (..))

31import Network.HTTP.Types (StdMethod (..))

33−import System.IO.Error (tryIOError)

35import Docker.Client.Http

33import Docker.Client.Http

36import Docker.Client.Types

34import Docker.Client.Types

src/Docker/Client/Utils.hs+71−43

@@ -7,7 +7,7 @@ module Docker.Client.Utils where

8import qualified Codec.Archive.Tar as Tar

9import qualified Codec.Compression.GZip as GZip

10−import Control.Monad (filterM)

10+import Control.Monad (filterM, liftM, unless)

11import Control.Monad.IO.Class

12import qualified Data.ByteString.Lazy as BS

13import Data.Monoid ((<>))

@@ -16,15 +16,21 @@ import qualified Data.Text.IO as TIO

16import qualified Data.UUID as UUID

17import qualified Data.UUID.V4 as UUID

18import System.Directory (doesDirectoryExist, doesFileExist,

19− findFile, getTemporaryDirectory)

19+ getTemporaryDirectory)

20import System.FilePath (isAbsolute, makeRelative, (</>))

21−import System.FilePath.Find (always, find)

21+import System.FilePath.Find (FilterPredicate,

22+ RecursionPredicate, always,

23+ fileName, find, (==?))

22import System.FilePath.GlobPattern ((~~))

24import System.FilePath.GlobPattern ((~~))

23−import System.IO.Error (ioError, tryIOError)

25+import System.IO.Error (tryIOError)

24-- import System.IO.Temp (withSystemTempDirectory)

26-- import System.IO.Temp (withSystemTempDirectory)

25--

27--

26import Docker.Client.Http

28import Docker.Client.Http

30+type File = FilePath

31+data DirTree = DirTree [File] [DirTree]

32+

33+

28newtype ExclusionPattern = ExclusionPattern T.Text deriving (Eq, Show)

34newtype ExclusionPattern = ExclusionPattern T.Text deriving (Eq, Show)

29newtype InclusionPattern = InclusionPattern T.Text deriving (Eq, Show)

35newtype InclusionPattern = InclusionPattern T.Text deriving (Eq, Show)

@@ -41,51 +47,20 @@ makeBuildContext base = liftIO $ tryIOError (makeBuildContext' base) >>= \res ->

42makeBuildContext' :: forall m. MonadIO m => BuildContextRootDir -> m FilePath

48makeBuildContext' :: forall m. MonadIO m => BuildContextRootDir -> m FilePath

43makeBuildContext' (BuildContextRootDir base) = do

49makeBuildContext' (BuildContextRootDir base) = do

44− uuid <- liftIO $ UUID.nextRandom

50+ uuid <- liftIO UUID.nextRandom

45 fs <- liftIO $ getBuildContext $ BuildContextRootDir base

51 fs <- liftIO $ getBuildContext $ BuildContextRootDir base

46 let relFs = map (makeRelative base) fs

52 let relFs = map (makeRelative base) fs

47− tmpDir <- liftIO $ getTemporaryDirectory

53+ tmpDir <- liftIO getTemporaryDirectory

48− let tmpF = tmpDir </> ("docker.context-" <> (UUID.toString uuid) <> ".tar.gz")

54+ let tmpF = tmpDir </> "docker.context-" <> UUID.toString uuid <> ".tar.gz"

49 liftIO $ BS.writeFile tmpF . GZip.compress . Tar.write =<< Tar.pack base relFs

55 liftIO $ BS.writeFile tmpF . GZip.compress . Tar.write =<< Tar.pack base relFs

50 return tmpF

56 return tmpF

52−filterIfDockerIgnoreFile :: BuildContextRootDir -> [FilePath] -> IO [FilePath]

53−filterIfDockerIgnoreFile base fs = do

54− di <- findFile fs ".dockerignore"

55− case di of

56− Nothing -> return fs

57− Just f -> do

58− c <- TIO.readFile f

59− return $ filterFiles base fs (parseDockerIgnoreFile c)

60−

61parseDockerIgnoreFile :: T.Text -> DockerIgnore

58parseDockerIgnoreFile :: T.Text -> DockerIgnore

62parseDockerIgnoreFile c = DockerIgnore{ exclusionPatterns=parseExclusions

59parseDockerIgnoreFile c = DockerIgnore{ exclusionPatterns=parseExclusions

63 , inclusionPatterns=parseInclusions}

60 , inclusionPatterns=parseInclusions}

64 where lines = filter (not . T.isPrefixOf "#") (T.lines c) -- Ignore comments

61 where lines = filter (not . T.isPrefixOf "#") (T.lines c) -- Ignore comments

65− parseExclusions = map ExclusionPattern $ filter (not . T.isPrefixOf "!") lines

62+ parseExclusions = map ExclusionPattern $ filter (\l -> not (T.isPrefixOf "!" l) && (l /= "")) lines

66− parseInclusions = map InclusionPattern $ filter (T.isPrefixOf "!") lines

63+ parseInclusions = map (InclusionPattern . T.drop 1) $ filter (\l -> T.isPrefixOf "!" l && (l /= "")) lines

67−

68−filterFiles :: BuildContextRootDir -> [FilePath] -> DockerIgnore -> [FilePath]

69−filterFiles (BuildContextRootDir base) fs d = filter ft relativePaths

70− where excls :: [ExclusionPattern]

71− excls = exclusionPatterns d

72− incls :: [InclusionPattern]

73− incls = map (\(InclusionPattern p) -> InclusionPattern $ T.tail p) (inclusionPatterns d)

74− ft :: FilePath -> Bool

75− ft f = case (exclusionCheck f, inclusionCheck f) of

76− -- If it's in any of the exclusion patterns but also

77− -- in any of the inclusion patterns then laeave it

78− (True, True) -> True

79− (True, False) -> False

80− (False, True) -> True

81− (False, False) -> True

82− normalizeFileName f = T.unpack $ last $ T.split (== '/') f

83− exclusionCheck :: FilePath -> Bool

84− exclusionCheck f = any id (map (\(ExclusionPattern p) -> (normalizeFileName $ T.pack f) ~~ (T.unpack p)) excls)

85− inclusionCheck :: FilePath -> Bool

86− inclusionCheck f = any id (map (\(InclusionPattern p) -> (normalizeFileName $ T.pack f) ~~ (T.unpack p)) incls)

87− relativePaths :: [FilePath]

88− relativePaths = map (makeRelative base) fs

90getBuildContext :: BuildContextRootDir -> IO [FilePath]

65getBuildContext :: BuildContextRootDir -> IO [FilePath]

91getBuildContext (BuildContextRootDir base) = do

66getBuildContext (BuildContextRootDir base) = do

@@ -93,11 +68,64 @@ getBuildContext (BuildContextRootDir base) = do

93 -- a file

68 -- a file

94 exists <- doesDirectoryExist base

69 exists <- doesDirectoryExist base

95 let abs = isAbsolute base

70 let abs = isAbsolute base

96− if (exists && abs) then return () else fail "Path to context needs to be a directory that: exists, is readable, and is an absolute path."

71+ unless (exists && abs) $ fail "Path to context needs to be a directory that: exists, is readable, and is an absolute path."

72+ di <- find always (fileName ==? ".dockerignore") base

73+ dockerignore <- case di of

74+ [] -> return $ DockerIgnore [] []

75+ -- This should not return more than one result though

76+ (x:_) -> do

77+ c <- TIO.readFile x

78+ return $ parseDockerIgnoreFile c

97 -- This will traverse the directory recursively

79 -- This will traverse the directory recursively

98− fs <- find always always base

80+ fs <- find (shouldRecurse dockerignore) (shouldInclude dockerignore) base

99− -- Filter out empty dirs

81+ -- fs is a list of directories *and* files in those directories. So

82+ -- an example result would look like ["/tmp/project/files",

83+ -- "/tmp/project/files/file1.txt"] and we want just the individual

84+ -- files otherwise tar duplicates them when making the archive.

100 fs' <- filterM doesFileExist fs

85 fs' <- filterM doesFileExist fs

101 -- For some reason base is in there as well and we don't need that

86 -- For some reason base is in there as well and we don't need that

102 return $ filter (not . (==) base) fs'

87 return $ filter (not . (==) base) fs'

103

89+shouldInclude :: DockerIgnore -> FilterPredicate

90+shouldInclude d = check `liftM` fileName

91+ where check f = dockerIgnoreDecision (exclusionCheck f (exclusionPatterns d), inclusionCheck f (inclusionPatterns d))

92+

93+shouldRecurse :: DockerIgnore -> RecursionPredicate

94+shouldRecurse d = check `liftM` fileName

95+ where check f = dockerIgnoreDecision (exclusionCheck f (exclusionPatterns d), inclusionCheck f (inclusionPatterns d))

96+

97+-- TODO: We don't handle precedence rules. For instance a dockerignore file

98+-- like this:

99+--

100+-- *.md

101+-- !README*.md

102+-- README-secret.md

103+--

104+-- Should result in no markdown files being included in the context except README files other

105+-- than README-secret.md. FIXME: OUR implementation would in fact include

106+-- README-secret.md as well!!!

107+--

108+-- Whereas this:

109+--

110+-- *.md

111+-- README-secret.md

112+-- !README*.md

113+--

114+-- Should result in all of the README files being included. The middle line has no effect

115+-- because !README*.md matches README-secret.md and comes last. Our

116+-- implementation will result in the same thing.

117+dockerIgnoreDecision :: (Bool, Bool) -> Bool

118+dockerIgnoreDecision p = case p of

119+ -- If it's in any of the exclusion patterns but also

120+ -- in any of the inclusion patterns then laeave it

121+ (True, True) -> True

122+ (True, False) -> False

123+ (False, True) -> True

124+ (False, False) -> True

125+

126+exclusionCheck :: FilePath -> [ExclusionPattern] -> Bool

127+exclusionCheck f ps = any id (map (\(ExclusionPattern p) -> f ~~ T.unpack p) ps)

128+

129+inclusionCheck :: FilePath -> [InclusionPattern] -> Bool

130+inclusionCheck f ps = any id (map (\(InclusionPattern p) -> f ~~ T.unpack p) ps)

131+