Docker: don't set user when Docker is remote (#194)

ChangeLog.md

@@ -27,7 +27,9 @@ Other enhancements:
 * New experimental `stack query` command [#1087](https://github.com/commercialhaskell/stack/issues/1087)
 * By default, stack no longer rebuilds a package due to GHC options changes. This behavior can be tweaked with the `rebuild-ghc-options` setting. [#1089](https://github.com/commercialhaskell/stack/issues/1089)
 * By default, ghc-options are applied to all local packages, not just targets. This behavior can be tweaked with the `apply-ghc-options` setting. [#1089](https://github.com/commercialhaskell/stack/issues/1089)
-* Download or override location of stack executable to re-run in Docker container [#974](https://github.com/commercialhaskell/stack/issues/974)
+* Docker: download or override location of stack executable to re-run in container [#974](https://github.com/commercialhaskell/stack/issues/974)
+* Docker: when Docker Engine is remote, don't run containerized processes as host's UID/GID [#194](https://github.com/commercialhaskell/stack/issues/194)
+* Docker: `set-user` option to enable/disable running containerized processes as host's UID/GID [#194](https://github.com/commercialhaskell/stack/issues/194)
 
 Bug fixes:
 

doc/docker_integration.md

@@ -197,6 +197,12 @@ otherwise noted.
       #   /path/to/stack: path on the host's local filesystem
       stack-exe: host
 
+      # If true (the default when using the local Docker Engine), run processes
+      # in the Docker container as the same UID/GID as the host.  The ensures
+      # that files written by the container are owned by you on the host.
+      # When the Docker Engine is remote (accessed by tcp), defaults to false.
+      set-user: true
+
 Image Repositories
 -------------------------------------------------------------------------------
 

src/Stack/Config/Docker.hs

@@ -53,6 +53,7 @@ dockerOptsFromMonoid mproject stackRoot DockerOptsMonoid{..} = do
         dockerRunArgs = dockerMonoidRunArgs
         dockerMount = dockerMonoidMount
         dockerEnv = dockerMonoidEnv
+        dockerSetUser = dockerMonoidSetUser
     dockerDatabasePath <-
         case dockerMonoidDatabasePath of
             Nothing -> return $ stackRoot </> $(mkRelFile "docker.db")

src/Stack/Docker.hs

@@ -197,19 +197,27 @@ runContainerAndExit modConfig
      let docker = configDocker config
      envOverride <- getEnvOverride (configPlatform config)
      checkDockerVersion envOverride
-     uidOut <- readProcessStdout Nothing envOverride "id" ["-u"]
-     gidOut <- readProcessStdout Nothing envOverride "id" ["-g"]
      (dockerHost,dockerCertPath,bamboo,jenkins) <-
        liftIO ((,,,) <$> lookupEnv "DOCKER_HOST"
                      <*> lookupEnv "DOCKER_CERT_PATH"
                      <*> lookupEnv "bamboo_buildKey"
                      <*> lookupEnv "JENKINS_HOME")
+     let isRemoteDocker = maybe False (isPrefixOf "tcp://") dockerHost
+     userEnvVars <-
+         if fromMaybe (not isRemoteDocker) (dockerSetUser docker)
+             then do
+                 uidOut <- readProcessStdout Nothing envOverride "id" ["-u"]
+                 gidOut <- readProcessStdout Nothing envOverride "id" ["-g"]
+                 return
+                     [ "-e","WORK_UID=" ++ dropWhileEnd isSpace (decodeUtf8 uidOut)
+                     , "-e","WORK_GID=" ++ dropWhileEnd isSpace (decodeUtf8 gidOut) ]
+             else return []
      isStdoutTerminal <- asks getTerminal
      (isStdinTerminal,isStderrTerminal) <-
        liftIO ((,) <$> hIsTerminalDevice stdin
                    <*> hIsTerminalDevice stderr)
      pwd <- getWorkingDir
-     when (maybe False (isPrefixOf "tcp://") dockerHost &&
+     when (isRemoteDocker &&
            maybe False (isInfixOf "boot2docker") dockerCertPath)
           ($logWarn "Warning: Using boot2docker is NOT supported, and not likely to perform well.")
      let image = dockerImage docker
@@ -224,9 +232,7 @@ runContainerAndExit modConfig
                   Just ii2 -> return ii2
                   Nothing -> throwM (InspectFailedException image)
          | otherwise -> throwM (NotPulledException image)
-     let uid = dropWhileEnd isSpace (decodeUtf8 uidOut)
-         gid = dropWhileEnd isSpace (decodeUtf8 gidOut)
-         imageEnvVars = map (break (== '=')) (icEnv (iiConfig imageInfo))
+     let imageEnvVars = map (break (== '=')) (icEnv (iiConfig imageInfo))
          sandboxID = fromMaybe "default" (lookupImageEnv sandboxIDEnvVar imageEnvVars)
      sandboxIDDir <- parseRelDir (sandboxID ++ "/")
      let stackRoot = configStackRoot config
@@ -241,6 +247,7 @@ runContainerAndExit modConfig
                   isStdoutTerminal &&
                   isStderrTerminal
          keepStdinOpen = not (dockerDetach docker) &&
+                         -- Workaround for https://github.com/docker/docker/issues/12319
                          (isTerm || (isNothing bamboo && isNothing jenkins))
      liftIO
        (do updateDockerImageLastUsed config
@@ -257,8 +264,6 @@ runContainerAndExit modConfig
           ,"--net=host"
           ,"-e",inContainerEnvVar ++ "=1"
           ,"-e",stackRootEnvVar ++ "=" ++ toFPNoTrailingSep stackRoot
-          ,"-e","WORK_UID=" ++ uid
-          ,"-e","WORK_GID=" ++ gid
           ,"-e","WORK_WD=" ++ toFPNoTrailingSep pwd
           ,"-e","WORK_HOME=" ++ toFPNoTrailingSep sandboxRepoDir
           ,"-e","WORK_ROOT=" ++ toFPNoTrailingSep projectRoot
@@ -268,6 +273,7 @@ runContainerAndExit modConfig
           ,"-v",toFPNoTrailingSep sandboxHomeDir ++ ":" ++ toFPNoTrailingSep sandboxRepoDir
           ,"-v",toFPNoTrailingSep stackRoot ++ ":" ++
                 toFPNoTrailingSep (sandboxRepoDir </> $(mkRelDir ("." ++ stackProgName ++ "/")))]
+         ,userEnvVars
          ,concatMap (\(k,v) -> ["-e", k ++ "=" ++ v]) envVars
          ,concatMap sandboxSubdirArg sandboxSubdirs
          ,concatMap mountArg (dockerMount docker)

src/Stack/Options.hs

@@ -360,6 +360,9 @@ dockerOptsParser showOptions =
              help (concat [ "Location of "
                           , stackProgName
                           , " executable used in container" ])))
+    <*> maybeBoolFlags (dockerOptName dockerSetUserArgName)
+                       "setting user in container to match host"
+                       hide
   where
     dockerOptName optName = dockerCmdName ++ "-" ++ T.unpack optName
     maybeStrOption = optional . option str

src/Stack/Types/Docker.hs

@@ -44,6 +44,8 @@ data DockerOpts = DockerOpts
     -- ^ Location of image usage database.
   ,dockerStackExe :: !DockerStackExe
     -- ^ Location of container-compatible stack executable
+  ,dockerSetUser :: !(Maybe Bool)
+   -- ^ Set in-container user to match host's
   }
   deriving (Show)
 
@@ -82,6 +84,8 @@ data DockerOptsMonoid = DockerOptsMonoid
     -- ^ Location of image usage database.
   ,dockerMonoidStackExe :: !(Maybe String)
     -- ^ Location of container-compatible stack executable
+  ,dockerMonoidSetUser :: !(Maybe Bool)
+   -- ^ Set in-container user to match host's
   }
   deriving (Show)
 
@@ -105,6 +109,7 @@ instance FromJSON (DockerOptsMonoid, [JSONWarning]) where
               dockerMonoidEnv              <- o ..:? dockerEnvArgName ..!= []
               dockerMonoidDatabasePath     <- o ..:? dockerDatabasePathArgName
               dockerMonoidStackExe         <- o ..:? dockerStackExeArgName
+              dockerMonoidSetUser          <- o ..:? dockerSetUserArgName
               return DockerOptsMonoid{..})
 
 -- | Left-biased combine Docker options
@@ -125,6 +130,7 @@ instance Monoid DockerOptsMonoid where
     ,dockerMonoidEnv              = []
     ,dockerMonoidDatabasePath     = Nothing
     ,dockerMonoidStackExe         = Nothing
+    ,dockerMonoidSetUser          = Nothing
     }
   mappend l r = DockerOptsMonoid
     {dockerMonoidExists           = dockerMonoidExists l <|> dockerMonoidExists r
@@ -142,6 +148,7 @@ instance Monoid DockerOptsMonoid where
     ,dockerMonoidEnv              = dockerMonoidEnv r <> dockerMonoidEnv l
     ,dockerMonoidDatabasePath     = dockerMonoidDatabasePath l <|> dockerMonoidDatabasePath r
     ,dockerMonoidStackExe         = dockerMonoidStackExe l <|> dockerMonoidStackExe r
+    ,dockerMonoidSetUser          = dockerMonoidSetUser l <|> dockerMonoidSetUser r
     }
 
 -- | Where to get the `stack` executable to run in Docker containers
@@ -258,3 +265,7 @@ dockerStackExeHostVal = "host"
 -- | Value for @--docker-stack-exe=image@
 dockerStackExeImageVal :: String
 dockerStackExeImageVal = "image"
+
+-- | Docker @set-user@ argument name
+dockerSetUserArgName :: Text
+dockerSetUserArgName = "set-user"