Fix darwin binaries after copying

This commit is contained in:
Julian Ospald 2022-05-13 11:58:01 +02:00
parent 48aee1e76c
commit db4e411dfd
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
5 changed files with 25 additions and 49 deletions

View File

@ -359,7 +359,8 @@ installUnpackedGHC path inst ver forceInstall
lift $ logInfo $ "Merging file tree from \"" <> T.pack tmpInstallDest <> "\" to \"" <> T.pack (fromInstallDir inst) <> "\""
fs <- mergeFileTreeAll (tmpInstallDest </> dropDrive (fromInstallDir inst))
(fromInstallDir inst)
(\f t -> liftIO $ install f t (not forceInstall))
(\f t -> liftIO (install f t (not forceInstall)))
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromInstallDir inst)
case inst of
IsolateDirResolved _ -> pure ()
_ -> recordInstalledFiles fs GHC (mkTVer ver)
@ -659,6 +660,7 @@ installHLSUnpacked :: ( MonadMask m
, MonadCatch m
, MonadIO m
, MonadResource m
, HasPlatformReq env
)
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
-> InstallDirResolved -- ^ Path to install to
@ -666,12 +668,14 @@ installHLSUnpacked :: ( MonadMask m
-> Bool
-> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m ()
installHLSUnpacked path inst ver forceInstall = do
PlatformRequest { .. } <- lift getPlatformReq
lift $ logInfo "Installing HLS"
tmpInstallDest <- lift withGHCupTmpDir
lEM $ make ["DESTDIR=" <> tmpInstallDest, "PREFIX=" <> fromInstallDir inst, "install"] (Just path)
fs <- mergeFileTreeAll (tmpInstallDest </> dropDrive (fromInstallDir inst))
(fromInstallDir inst)
(\f t -> liftIO $ install f t (not forceInstall))
(\f t -> liftIO (install f t (not forceInstall)))
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromInstallDir inst)
case inst of
IsolateDirResolved _ -> pure ()
_ -> recordInstalledFiles fs HLS (mkTVer ver)

View File

@ -1033,6 +1033,8 @@ darwinNotarization Darwin path = exec
darwinNotarization _ _ = pure $ Right ()
getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
getChangeLog dls tool (Left v') =
preview (ix tool % ix v' % viChangeLog % _Just) dls

View File

@ -1,5 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiWayIf #-}
{-|
Module : GHCup.Utils.File.Posix
@ -418,41 +420,25 @@ copyFile :: FilePath -- ^ source file
-> IO ()
copyFile from to fail' = do
bracket
(do
fd <- openFd' from SPI.ReadOnly [FD.oNofollow] Nothing
handle' <- SPI.fdToHandle fd
pure (fd, handle')
)
(\(_, handle') -> hClose handle')
(openFdHandle from SPI.ReadOnly [FD.oNofollow] Nothing)
(hClose . snd)
$ \(fromFd, fH) -> do
sourceFileMode <- fileMode
<$> getFdStatus fromFd
let dflags =
[ FD.oNofollow
, case fail' of
True -> FD.oExcl
False -> FD.oTrunc
]
bracketeer
(do
fd <- openFd' to SPI.WriteOnly dflags $ Just sourceFileMode
handle' <- SPI.fdToHandle fd
pure (fd, handle')
)
(\(_, handle') -> hClose handle')
(\(_, handle') -> do
hClose handle'
case fail' of
-- if we created the file and copying failed, it's
-- safe to clean up
True -> PF.removeLink to
False -> pure ()
)
sourceFileMode <- fileMode <$> getFdStatus fromFd
let dflags = [ FD.oNofollow
, if fail' then FD.oExcl else FD.oTrunc
]
bracket
(openFdHandle to SPI.WriteOnly dflags $ Just sourceFileMode)
(hClose . snd)
$ \(_, tH) -> do
hSetBinaryMode fH True
hSetBinaryMode tH True
streamlyCopy (fH, tH)
where
openFdHandle fp omode flags fM = do
fd <- openFd' fp omode flags fM
handle' <- SPI.fdToHandle fd
pure (fd, handle')
streamlyCopy (fH, tH) =
S.fold (FH.writeChunks tH) $ IFH.toChunksWithBufferOf (256 * 1024) fH
@ -563,3 +549,4 @@ install from to fail' = do
decide fs | PF.isRegularFile fs = copyFile from to fail'
| PF.isSymbolicLink fs = recreateSymlink from to fail'
| otherwise = ioError $ mkIOError illegalOperationErrorType "install: not a regular file or symlink" Nothing (Just from)

View File

@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-|
Module : GHCup.Utils.File.Windows

View File

@ -759,21 +759,3 @@ breakOn :: Eq a => [a] -> [a] -> ([a], [a])
breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack)
breakOn _ [] = ([], [])
breakOn needle (x:xs) = first (x:) $ breakOn needle xs
-- |Like `bracket`, but allows to have different clean-up
-- actions depending on whether the in-between computation
-- has raised an exception or not.
bracketeer :: IO a -- ^ computation to run first
-> (a -> IO b) -- ^ computation to run last, when
-- no exception was raised
-> (a -> IO b) -- ^ computation to run last,
-- when an exception was raised
-> (a -> IO c) -- ^ computation to run in-between
-> IO c
bracketeer before after afterEx thing =
mask $ \restore -> do
a <- before
r <- restore (thing a) `onException` afterEx a
_ <- after a
return r