Skip to content

Support docker integration on Windows #5315

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 6 commits into from
Closed

Support docker integration on Windows #5315

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
c66cda8
Fix --docker for Windows. Fix #2421.
gdziadkiewicz Jun 7, 2020
2a4b586
Fix --docker with STACK_YAML for Windows.
gdziadkiewicz Jun 9, 2020
16c34d2
Fix PATH env var for the Docker image on Windows.
gdziadkiewicz Jun 21, 2020
cee88ff
Add ChangeLog entry for Docker on Windows fix.
gdziadkiewicz Jul 19, 2020
e10ca8a
Replace bool usage and fix mountArg path.
gdziadkiewicz Aug 8, 2020
6af7918
Use fresh name for path.
gdziadkiewicz Aug 8, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion ChangeLog.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ Behavior changes:
Other enhancements:

Bug fixes:

* Fix Docker integration on Windows. See [#2421](https://github.com/commercialhaskell/stack/issues/2421)

## v2.5.1

Expand Down
50 changes: 32 additions & 18 deletions src/Stack/Docker.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -78,7 +78,7 @@ getCmdArgs
getCmdArgs docker imageInfo isRemoteDocker = do
config <- view configL
deUser <-
if fromMaybe (not isRemoteDocker) (dockerSetUser docker)
if fromMaybe (not isRemoteDocker) (dockerSetUser docker) && not osIsWindows
then liftIO $ do
duUid <- User.getEffectiveUserID
duGid <- User.getEffectiveGroupID
Expand Down Expand Up @@ -229,10 +229,14 @@ runContainerAndExit = do
when (isNothing mpath) $ do
logWarn "The Docker image does not set the PATH env var"
logWarn "This will likely fail, see https://github.com/commercialhaskell/stack/issues/2742"
newPathEnv <- either throwM return $ augmentPath
[ hostBinDir
, toFilePath (sandboxHomeDir </> relDirDotLocal </> relDirBin)]
mpath
let adjustPathSeparator | osIsWindows = T.replace ";" ":"
| otherwise = id
newPathEnv <- either throwM return $
adjustPathSeparator <$>
augmentPath
[ hostBinDir
, toLinuxStylePath $ toFilePath (sandboxHomeDir </> relDirDotLocal </> relDirBin)]
mpath
(cmnd,args,envVars,extraMount) <- getCmdArgs docker imageInfo isRemoteDocker
pwd <- getCurrentDir
liftIO $ mapM_ ensureDir [sandboxHomeDir, stackRoot]
Expand All @@ -244,7 +248,7 @@ runContainerAndExit = do
liftIO
(Files.fileExist
(toFilePathNoTrailingSep (sandboxHomeDir </> sshRelDir)))
when (sshDirExists && not sshSandboxDirExists)
when (sshDirExists && not sshSandboxDirExists && not osIsWindows)
(liftIO
(Files.createSymbolicLink
(toFilePathNoTrailingSep sshDir)
Expand All @@ -254,16 +258,16 @@ runContainerAndExit = do
(concat
[["create"
,"-e",inContainerEnvVar ++ "=1"
,"-e",stackRootEnvVar ++ "=" ++ toFilePathNoTrailingSep stackRoot
,"-e",stackRootEnvVar ++ "=" ++ toLinuxStylePath (toFilePathNoTrailingSep stackRoot)
,"-e",platformVariantEnvVar ++ "=dk" ++ platformVariant
,"-e","HOME=" ++ toFilePathNoTrailingSep sandboxHomeDir
,"-e","HOME=" ++ toLinuxStylePath (toFilePathNoTrailingSep sandboxHomeDir)
,"-e","PATH=" ++ T.unpack newPathEnv
,"-e","PWD=" ++ toFilePathNoTrailingSep pwd
,"-v",toFilePathNoTrailingSep homeDir ++ ":" ++ toFilePathNoTrailingSep homeDir ++ mountSuffix
,"-v",toFilePathNoTrailingSep stackRoot ++ ":" ++ toFilePathNoTrailingSep stackRoot ++ mountSuffix
,"-v",toFilePathNoTrailingSep projectRoot ++ ":" ++ toFilePathNoTrailingSep projectRoot ++ mountSuffix
,"-v",toFilePathNoTrailingSep sandboxHomeDir ++ ":" ++ toFilePathNoTrailingSep sandboxHomeDir ++ mountSuffix
,"-w",toFilePathNoTrailingSep pwd]
,"-e","PWD=" ++ toLinuxStylePath (toFilePathNoTrailingSep pwd)
,"-v",toFilePathNoTrailingSep homeDir ++ ":" ++ toLinuxStylePath (toFilePathNoTrailingSep homeDir ++ mountSuffix)
,"-v",toFilePathNoTrailingSep stackRoot ++ ":" ++ toLinuxStylePath (toFilePathNoTrailingSep stackRoot ++ mountSuffix)
,"-v",toFilePathNoTrailingSep projectRoot ++ ":" ++ toLinuxStylePath (toFilePathNoTrailingSep projectRoot ++ mountSuffix)
,"-v",toFilePathNoTrailingSep sandboxHomeDir ++ ":" ++ toLinuxStylePath (toFilePathNoTrailingSep sandboxHomeDir ++ mountSuffix)
,"-w",toLinuxStylePath (toFilePathNoTrailingSep pwd)]
,case dockerNetwork docker of
Nothing -> ["--net=host"]
Just name -> ["--net=" ++ name]
Expand All @@ -278,8 +282,8 @@ runContainerAndExit = do
,case mstackYaml of
Nothing -> []
Just stackYaml ->
["-e","STACK_YAML=" ++ stackYaml
,"-v",stackYaml++ ":" ++ stackYaml ++ ":ro"]
["-e","STACK_YAML=" ++ toLinuxStylePath stackYaml
,"-v",stackYaml ++ ":" ++ toLinuxStylePath stackYaml ++ ":ro"]
-- Disable the deprecated entrypoint in FP Complete-generated images
,["--entrypoint=/usr/bin/env"
| isJust (lookupImageEnv oldSandboxIdEnvVar imageEnvVars) &&
Expand All @@ -295,7 +299,7 @@ runContainerAndExit = do
,["-i" | keepStdinOpen]
,dockerRunArgs docker
,[image]
,[cmnd]
,[toLinuxStylePath cmnd]
,args])
-- MSS 2018-08-30 can the CPP below be removed entirely, and instead exec the
-- `docker` process so that it can handle the signals directly?
Expand Down Expand Up @@ -338,8 +342,18 @@ runContainerAndExit = do
Just ('=':val) -> Just val
_ -> Nothing
mountArg mountSuffix (Mount host container) =
["-v",host ++ ":" ++ container ++ mountSuffix]
["-v",host ++ ":" ++ toLinuxStylePath (container ++ mountSuffix)]
sshRelDir = relDirDotSsh
toLinuxStylePath s | osIsWindows =
T.pack s
& T.replace ":\\" "/"
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This doesn't look right, it would convert c:\\foo into c/foo, for instance

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I will double check and then fix or try to convince you that this is the right thing to do.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Together with & addStartingSlashIfMissing (line 352) C:\\foo becomes /c/foo which is a legal and working thing. Maybe I could share some output from how this is working on my Windows machine to convince you that the folder sharing feature is working as expected?

As legal and working does not imply right I'm ready to discuss alternatives. I could mount/share the folders in /mnt/ (for our example /mnt/c/foo). What do you think about it?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I honestly can't figure out how all of that is supposed to work out correctly. As it stands now, this seems like it's trying to slyly address a bunch of edge cases, and I'm not convinced it's handling them correctly. It would be better to start off with what the expected behavior is for these edge cases, such as "c:\foo\bar" or relative paths like "foo\bar". It seems to me like these two cases are now in conflict.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You are right - it may be only working thanks to the fact that all paths happened to be absolute in my scenario. I will add explicit handling for absolute/relative paths and try to remove this hacky/sly smell around this change.

& T.replace "\\" "/"
& T.unpack
& addStartingSlashIfMissing
| otherwise = s
where
addStartingSlashIfMissing path@('/':_) = path
addStartingSlashIfMissing path = '/':path

-- | Inspect Docker image or container.
inspect :: (HasProcessContext env, HasLogFunc env)
Expand Down