Docker: pass supplemantary groups and umask into container

Author: borsboom

ChangeLog.md

@@ -14,6 +14,7 @@ Other enhancements:
   [docs](http://docs.haskellstack.org/en/latest/yaml_configuration.html#image)
 - Specify which executables to include in images for `stack image container`
   [docs](http://docs.haskellstack.org/en/latest/yaml_configuration.html#image)
+- Docker: pass supplemantary groups and umask into container
 
 Bug fixes:
 

src/Stack/Docker.hs

@@ -72,6 +72,7 @@ import           System.IO (stderr,stdin,stdout,hIsTerminalDevice)
 import           System.IO.Error (isDoesNotExistError)
 import           System.IO.Unsafe (unsafePerformIO)
 import qualified System.PosixCompat.User as User
+import qualified System.PosixCompat.Files as Files
 import           System.Process.PagerEditor (editByteString)
 import           System.Process.Read
 import           System.Process.Run
@@ -82,6 +83,7 @@ import           Text.Printf (printf)
 import           Control.Concurrent (threadDelay)
 import           Control.Monad.Trans.Control (liftBaseWith)
 import           System.Posix.Signals
+import qualified System.Posix.User as PosixUser
 #endif
 
 -- | If Docker is enabled, re-runs the currently running OS command in a Docker container.
@@ -104,10 +106,16 @@ reexecWithOptionalContainer mprojectRoot =
   where
     getCmdArgs docker envOverride imageInfo isRemoteDocker = do
         config <- asks getConfig
-        deUidGid <-
+        deUser <-
             if fromMaybe (not isRemoteDocker) (dockerSetUser docker)
-                then liftIO $ Just <$>
-                  ((,) <$> User.getEffectiveUserID <*> User.getEffectiveGroupID)
+                then liftIO $ do
+                  duUid <- User.getEffectiveUserID
+                  duGid <- User.getEffectiveGroupID
+                  duGroups <- User.getGroups
+                  duUmask <- Files.setFileCreationMask 0o022
+                  -- Only way to get old umask seems to be to change it, so set it back afterward
+                  _ <- Files.setFileCreationMask duUmask
+                  return (Just DockerUser{..})
                 else return Nothing
         args <-
             fmap
@@ -713,10 +721,10 @@ entrypoint config@Config{..} DockerEntrypoint{..} =
       estackUserEntry0 <- liftIO $ tryJust (guard . isDoesNotExistError) $
         User.getUserEntryForName stackUserName
       -- Switch UID/GID if needed, and update user's home directory
-      case deUidGid of
+      case deUser of
         Nothing -> return ()
-        Just (0,_) -> return ()
-        Just (uid,gid) -> updateOrCreateStackUser envOverride estackUserEntry0 homeDir uid gid
+        Just (DockerUser 0 _ _ _) -> return ()
+        Just du -> updateOrCreateStackUser envOverride estackUserEntry0 homeDir du
       case estackUserEntry0 of
         Left _ -> return ()
         Right ue -> do
@@ -751,35 +759,45 @@ entrypoint config@Config{..} DockerEntrypoint{..} =
                     copyFile srcIndex destIndex
     return True
   where
-    updateOrCreateStackUser envOverride estackUserEntry homeDir uid gid = do
+    updateOrCreateStackUser envOverride estackUserEntry homeDir DockerUser{..} = do
       case estackUserEntry of
         Left _ -> do
           -- If no 'stack' user in image, create one with correct UID/GID and home directory
           readProcessNull Nothing envOverride "groupadd"
             ["-o"
-            ,"--gid",show gid
+            ,"--gid",show duGid
             ,stackUserName]
           readProcessNull Nothing envOverride "useradd"
             ["-oN"
-            ,"--uid",show uid
-            ,"--gid",show gid
+            ,"--uid",show duUid
+            ,"--gid",show duGid
             ,"--home",toFilePathNoTrailingSep homeDir
             ,stackUserName]
         Right _ -> do
-          -- If there is already a 'stack' user in thr image, adjust its UID/GID and home directory
+          -- If there is already a 'stack' user in the image, adjust its UID/GID and home directory
           readProcessNull Nothing envOverride "usermod"
             ["-o"
-            ,"--uid",show uid
+            ,"--uid",show duUid
             ,"--home",toFilePathNoTrailingSep homeDir
             ,stackUserName]
           readProcessNull Nothing envOverride "groupmod"
             ["-o"
-            ,"--gid",show gid
+            ,"--gid",show duGid
             ,stackUserName]
+      forM_ duGroups $ \gid -> do
+        readProcessNull Nothing envOverride "groupadd"
+          ["-o"
+          ,"--gid",show gid
+          ,"group" ++ show gid]
       -- 'setuid' to the wanted UID and GID
       liftIO $ do
-        User.setGroupID gid
-        User.setUserID uid
+        User.setGroupID duGid
+#ifndef WINDOWS
+        PosixUser.setGroups duGroups
+#endif
+        User.setUserID duUid
+        _ <- Files.setFileCreationMask duUmask
+        return ()
     stackUserName = "stack"::String
 
 -- | MVar used to ensure the Docker entrypoint is performed exactly once

src/Stack/Types/Config.hs

@@ -119,6 +119,7 @@ module Stack.Types.Config
   ,SetupInfoLocation(..)
   -- ** Docker entrypoint
   ,DockerEntrypoint(..)
+  ,DockerUser(..)
   ) where
 
 import           Control.Applicative
@@ -169,7 +170,7 @@ import           Stack.Types.PackageIndex
 import           Stack.Types.PackageName
 import           Stack.Types.TemplateName
 import           Stack.Types.Version
-import           System.PosixCompat.Types (UserID, GroupID)
+import           System.PosixCompat.Types (UserID, GroupID, FileMode)
 import           System.Process.Read (EnvOverride)
 #ifdef mingw32_HOST_OS
 import qualified Crypto.Hash.SHA1 as SHA1
@@ -1613,6 +1614,14 @@ explicitSetupDeps name = do
 
 -- | Data passed into Docker container for the Docker entrypoint's use
 data DockerEntrypoint = DockerEntrypoint
-    { deUidGid :: !(Maybe (UserID, GroupID))
-      -- ^ UID/GID of host user, if we wish to perform UID/GID switch in container
+    { deUser :: !(Maybe DockerUser)
+      -- ^ UID/GID/etc of host user, if we wish to perform UID/GID switch in container
+    } deriving (Read,Show)
+
+-- | Docker host user info
+data DockerUser = DockerUser
+    { duUid :: UserID -- ^ uid
+    , duGid :: GroupID -- ^ gid
+    , duGroups :: [GroupID] -- ^ Supplemantal groups
+    , duUmask :: FileMode -- ^ File creation mask }
     } deriving (Read,Show)