@@ -7,7 +7,7 @@ module Docker.Client.Utils where
77
88import qualified Codec.Archive.Tar as Tar
99import qualified Codec.Compression.GZip as GZip
10−import Control.Monad (filterM)
10+import Control.Monad (filterM, liftM, unless)
1111import Control.Monad.IO.Class
1212import qualified Data.ByteString.Lazy as BS
1313import Data.Monoid ((<>))
@@ -16,15 +16,21 @@ import qualified Data.Text.IO as TIO
1616import qualified Data.UUID as UUID
1717import qualified Data.UUID.V4 as UUID
1818import System.Directory (doesDirectoryExist, doesFileExist,
19− findFile, getTemporaryDirectory)
19+ getTemporaryDirectory)
2020import System.FilePath (isAbsolute, makeRelative, (</>))
21−import System.FilePath.Find (always, find)
21+import System.FilePath.Find (FilterPredicate,
22+ RecursionPredicate, always,
23+ fileName, find, (==?))
2224import System.FilePath.GlobPattern ((~~))
23−import System.IO.Error (ioError, tryIOError)
25+import System.IO.Error (tryIOError)
2426-- import System.IO.Temp (withSystemTempDirectory)
2527--
2628import Docker.Client.Http
2729
30+type File = FilePath
31+data DirTree = DirTree [File] [DirTree]
32+
33+
2834newtype ExclusionPattern = ExclusionPattern T.Text deriving (Eq, Show)
2935newtype InclusionPattern = InclusionPattern T.Text deriving (Eq, Show)
3036
@@ -41,51 +47,20 @@ makeBuildContext base = liftIO $ tryIOError (makeBuildContext' base) >>= \res ->
4147
4248makeBuildContext' :: forall m. MonadIO m => BuildContextRootDir -> m FilePath
4349makeBuildContext' (BuildContextRootDir base) = do
44− uuid <- liftIO $ UUID.nextRandom
50+ uuid <- liftIO UUID.nextRandom
4551 fs <- liftIO $ getBuildContext $ BuildContextRootDir base
4652 let relFs = map (makeRelative base) fs
47− tmpDir <- liftIO $ getTemporaryDirectory
48− let tmpF = tmpDir </> ("docker.context-" <> (UUID.toString uuid) <> ".tar.gz")
53+ tmpDir <- liftIO getTemporaryDirectory
54+ let tmpF = tmpDir </> "docker.context-" <> UUID.toString uuid <> ".tar.gz"
4955 liftIO $ BS.writeFile tmpF . GZip.compress . Tar.write =<< Tar.pack base relFs
5056 return tmpF
5157
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−
6158parseDockerIgnoreFile :: T.Text -> DockerIgnore
6259parseDockerIgnoreFile c = DockerIgnore{ exclusionPatterns=parseExclusions
6360 , inclusionPatterns=parseInclusions}
6461 where lines = filter (not . T.isPrefixOf "#") (T.lines c) -- Ignore comments
65− parseExclusions = map ExclusionPattern $ filter (not . T.isPrefixOf "!") lines
66− parseInclusions = map InclusionPattern $ filter (T.isPrefixOf "!") 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
62+ parseExclusions = map ExclusionPattern $ filter (\l -> not (T.isPrefixOf "!" l) && (l /= "")) lines
63+ parseInclusions = map (InclusionPattern . T.drop 1) $ filter (\l -> T.isPrefixOf "!" l && (l /= "")) lines
8964
9065getBuildContext :: BuildContextRootDir -> IO [FilePath]
9166getBuildContext (BuildContextRootDir base) = do
@@ -93,11 +68,64 @@ getBuildContext (BuildContextRootDir base) = do
9368 -- a file
9469 exists <- doesDirectoryExist base
9570 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
9779 -- This will traverse the directory recursively
98− fs <- find always always base
99− -- Filter out empty dirs
80+ fs <- find (shouldRecurse dockerignore) (shouldInclude dockerignore) base
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.
10085 fs' <- filterM doesFileExist fs
10186 -- For some reason base is in there as well and we don't need that
10287 return $ filter (not . (==) base) fs'
10388
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+