Skip to content
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.

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

[WIP] Use the directory package to create new-install symlinks #5684

Closed
wants to merge 7 commits into from
Closed
Show file tree
Hide file tree
Changes from 1 commit
Commits
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
59 changes: 14 additions & 45 deletions cabal-install/Distribution/Client/InstallSymlink.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,36 +17,6 @@ module Distribution.Client.InstallSymlink (
symlinkBinary,
) where

#ifdef mingw32_HOST_OS

import Distribution.Package (PackageIdentifier)
import Distribution.Types.UnqualComponentName
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.Types (BuildOutcomes)
import Distribution.Client.Setup (InstallFlags)
import Distribution.Simple.Setup (ConfigFlags)
import Distribution.Simple.Compiler
import Distribution.System

data OverwritePolicy = NeverOverwrite | AlwaysOverwrite
deriving (Show, Eq)

symlinkBinaries :: Platform -> Compiler
-> OverwritePolicy
-> ConfigFlags
-> InstallFlags
-> InstallPlan
-> BuildOutcomes
-> IO [(PackageIdentifier, UnqualComponentName, FilePath)]
symlinkBinaries _ _ _ _ _ _ _ = return []

symlinkBinary :: OverwritePolicy
-> FilePath -> FilePath -> UnqualComponentName -> String
-> IO Bool
symlinkBinary _ _ _ _ _ = fail "Symlinking feature not available on Windows"

#else

import Distribution.Client.Types
( ConfiguredPackage(..), BuildOutcomes )
import Distribution.Client.Setup
Expand All @@ -67,23 +37,23 @@ import Distribution.PackageDescription
( PackageDescription )
import Distribution.PackageDescription.Configuration
( finalizePD )
import Distribution.Simple.BuildPaths
( exeExtension )
import Distribution.Simple.Setup
( ConfigFlags(..), fromFlag, fromFlagOrDefault, flagToMaybe )
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.Compiler
( Compiler, compilerInfo, CompilerInfo(..) )
import Distribution.System
( Platform )
( Platform, buildPlatform )
import Distribution.Text
( display )

import System.Posix.Files
( getSymbolicLinkStatus, isSymbolicLink, createSymbolicLink
, removeLink )
import System.Directory
( canonicalizePath )
( createFileLink, pathIsSymbolicLink
, canonicalizePath, removeFile, pathIsSymbolicLink )
import System.FilePath
( (</>), splitPath, joinPath, isAbsolute )
( (<.>), (</>), splitPath, joinPath, isAbsolute )

import Prelude hiding (ioError)
import System.IO.Error
Expand Down Expand Up @@ -216,7 +186,7 @@ symlinkBinary ::
-- propagate as exceptions.
symlinkBinary overwritePolicy publicBindir privateBindir publicName privateName = do
ok <- targetOkToOverwrite (publicBindir </> publicName')
(privateBindir </> privateName)
(privateBindir </> privateName')
case ok of
NotExists -> mkLink >> return True
OkToOverwrite -> rmLink >> mkLink >> return True
Expand All @@ -225,11 +195,12 @@ symlinkBinary overwritePolicy publicBindir privateBindir publicName privateName
NeverOverwrite -> return False
AlwaysOverwrite -> rmLink >> mkLink >> return True
where
publicName' = display publicName
publicName' = display publicName <.> exeExtension buildPlatform
privateName' = privateName <.> exeExtension buildPlatform
relativeBindir = makeRelative publicBindir privateBindir
mkLink = createSymbolicLink (relativeBindir </> privateName)
(publicBindir </> publicName')
rmLink = removeLink (publicBindir </> publicName')
mkLink = createFileLink (relativeBindir </> privateName')
(publicBindir </> publicName')
rmLink = removeFile (publicBindir </> publicName')

-- | Check a file path of a symlink that we would like to create to see if it
-- is OK. For it to be OK to overwrite it must either not already exist yet or
Expand All @@ -241,8 +212,8 @@ targetOkToOverwrite :: FilePath -- ^ The file path of the symlink to the private
-- Use 'canonicalizePath' to make this.
-> IO SymlinkStatus
targetOkToOverwrite symlink target = handleNotExist $ do
status <- getSymbolicLinkStatus symlink
if not (isSymbolicLink status)
isLink <- pathIsSymbolicLink symlink
if not isLink
then return NotOurFile
else do target' <- canonicalizePath symlink
-- This relies on canonicalizePath handling symlinks
Expand Down Expand Up @@ -276,5 +247,3 @@ makeRelative a b = assert (isAbsolute a && isAbsolute b) $
commonLen = length $ takeWhile id $ zipWith (==) as bs
in joinPath $ [ ".." | _ <- drop commonLen as ]
++ drop commonLen bs

#endif
2 changes: 1 addition & 1 deletion cabal-install/cabal-install.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -307,7 +307,7 @@ executable cabal
containers >= 0.5 && < 0.7,
cryptohash-sha256 >= 0.11 && < 0.12,
deepseq >= 1.3 && < 1.5,
directory >= 1.2.2.0 && < 1.4,
directory >= 1.3.3.0 && < 1.4,
Copy link
Member

@hvr hvr Nov 13, 2018

Choose a reason for hiding this comment

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

That's a fairly recent directory version (it only started getting bundled w/ GHC 8.6); can we make this conditional on if os(windows)?

Copy link
Author

Choose a reason for hiding this comment

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

I don't understand the problem. Are you worried about the stability of recent versions of directory?

This change uses the createFileLink function, which was added in directory-1.3.1.0, so the lower bound will need to be raised anyways. Is 1.3.1.0 an acceptable lower bound? One potential downside is that the behaviour of new-install on Windows will differ depending on which version of directory was used to compile cabal-install.

Copy link
Collaborator

Choose a reason for hiding this comment

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

I think the concern is mostly support, does directory-1.3.1.0 support the same versions of GHC that cabal supports, if not it can't be unconditionally used.

This change uses the createFileLink function, which was added in directory-1.3.1.0, so the lower bound will need to be raised anyways. Is 1.3.1.0 an acceptable lower bound? One potential downside is that the behaviour of new-install on Windows will differ depending on which version of directory was used to compile cabal-install

This is quite normal, and just means the distro needs to be built with an up-to-date compiler/cabal. Long filenames support is another thing that already depends on which version of GHC is used.

Copy link
Member

Choose a reason for hiding this comment

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

Well, we have all those *.Compat.* modules for a reason... ;-)

See

So I'd strongly suggest to try to follow the prior-art from those compat modules to avoid requiring such a bleeding edge directory version

echo >= 0.1.3 && < 0.2,
edit-distance >= 0.2.2 && < 0.3,
filepath >= 1.3 && < 1.5,
Expand Down
2 changes: 1 addition & 1 deletion cabal-install/cabal-install.cabal.pp
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@
containers >= 0.5 && < 0.7,
cryptohash-sha256 >= 0.11 && < 0.12,
deepseq >= 1.3 && < 1.5,
directory >= 1.2.2.0 && < 1.4,
directory >= 1.3.3.0 && < 1.4,
echo >= 0.1.3 && < 0.2,
edit-distance >= 0.2.2 && < 0.3,
filepath >= 1.3 && < 1.5,
Expand Down