fix build with unix-2.8.0
Changed the parameters to openFd. So needed to add a small wrapper library to keep supporting older versions as well.
This commit is contained in:
parent
4ef16f53ed
commit
68c9b08faf
12 changed files with 51 additions and 16 deletions
|
@ -75,15 +75,15 @@ reconnectRemotes rs = void $ do
|
|||
| Git.repoIsLocal r = True
|
||||
| Git.repoIsLocalUnknown r = True
|
||||
| otherwise = False
|
||||
sync currentbranch@(Just _, _) = do
|
||||
syncbranch currentbranch@(Just _, _) = do
|
||||
(failedpull, diverged) <- manualPull currentbranch =<< gitremotes
|
||||
now <- liftIO getCurrentTime
|
||||
failedpush <- pushToRemotes' now =<< gitremotes
|
||||
return (nub $ failedpull ++ failedpush, diverged)
|
||||
{- No local branch exists yet, but we can try pulling. -}
|
||||
sync (Nothing, _) = manualPull (Nothing, Nothing) =<< gitremotes
|
||||
syncbranch (Nothing, _) = manualPull (Nothing, Nothing) =<< gitremotes
|
||||
go = do
|
||||
(failed, diverged) <- sync =<< liftAnnex getCurrentBranch
|
||||
(failed, diverged) <- syncbranch =<< liftAnnex getCurrentBranch
|
||||
addScanRemotes diverged =<<
|
||||
filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) rs
|
||||
return failed
|
||||
|
|
|
@ -35,6 +35,7 @@ git-annex (10.20230627) UNRELEASED; urgency=medium
|
|||
Anything still relying on that, eg via cabal v1-install will need to
|
||||
change to using make install-home.a
|
||||
* git-annex.cabal: Support building with unix-compat 0.7
|
||||
* Support building with unix-2.8.0.
|
||||
|
||||
-- Joey Hess <id@joeyh.name> Mon, 26 Jun 2023 13:10:40 -0400
|
||||
|
||||
|
|
|
@ -14,6 +14,7 @@ import RemoteDaemon.Core
|
|||
import Utility.Daemon
|
||||
#ifndef mingw32_HOST_OS
|
||||
import Annex.Path
|
||||
import Utility.OpenFd
|
||||
#endif
|
||||
|
||||
cmd :: Command
|
||||
|
@ -30,7 +31,7 @@ run o
|
|||
#ifndef mingw32_HOST_OS
|
||||
git_annex <- liftIO programPath
|
||||
ps <- gitAnnexDaemonizeParams
|
||||
let logfd = openFd "/dev/null" ReadOnly Nothing defaultFileFlags
|
||||
let logfd = openFdWithMode (toRawFilePath "/dev/null") ReadOnly Nothing defaultFileFlags
|
||||
liftIO $ daemonize git_annex ps logfd Nothing False runNonInteractive
|
||||
#else
|
||||
liftIO $ foreground Nothing runNonInteractive
|
||||
|
|
|
@ -12,6 +12,7 @@ module Git.LockFile where
|
|||
import Common
|
||||
|
||||
#ifndef mingw32_HOST_OS
|
||||
import Utility.OpenFd
|
||||
import System.Posix.Types
|
||||
import System.Posix.IO
|
||||
#else
|
||||
|
@ -51,7 +52,7 @@ openLock' :: FilePath -> IO LockHandle
|
|||
openLock' lck = do
|
||||
#ifndef mingw32_HOST_OS
|
||||
-- On unix, git simply uses O_EXCL
|
||||
h <- openFd lck ReadWrite (Just 0O666)
|
||||
h <- openFdWithMode (toRawFilePath lck) ReadWrite (Just 0O666)
|
||||
(defaultFileFlags { exclusive = True })
|
||||
setFdOption h CloseOnExec True
|
||||
#else
|
||||
|
|
|
@ -50,6 +50,9 @@ import Utility.InodeCache
|
|||
import Utility.FileMode
|
||||
import Utility.Directory.Create
|
||||
import qualified Utility.RawFilePath as R
|
||||
#ifndef mingw32_HOST_OS
|
||||
import Utility.OpenFd
|
||||
#endif
|
||||
|
||||
remote :: RemoteType
|
||||
remote = specialRemoteType $ RemoteType
|
||||
|
@ -469,7 +472,7 @@ retrieveExportWithContentIdentifierM ii dir cow loc cids dest gk p =
|
|||
#ifndef mingw32_HOST_OS
|
||||
let open = do
|
||||
-- Need a duplicate fd for the post check.
|
||||
fd <- openFd f' ReadOnly Nothing defaultFileFlags
|
||||
fd <- openFdWithMode f ReadOnly Nothing defaultFileFlags
|
||||
dupfd <- dup fd
|
||||
h <- fdToHandle fd
|
||||
return (h, dupfd)
|
||||
|
|
|
@ -21,6 +21,7 @@ import Utility.PID
|
|||
#ifndef mingw32_HOST_OS
|
||||
import Utility.LogFile
|
||||
import Utility.Env
|
||||
import Utility.OpenFd
|
||||
#else
|
||||
import System.Win32.Process (terminateProcessById)
|
||||
import Utility.LockFile
|
||||
|
@ -49,7 +50,7 @@ daemonize cmd params openlogfd pidfile changedirectory a = do
|
|||
maybe noop lockPidFile pidfile
|
||||
a
|
||||
_ -> do
|
||||
nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
|
||||
nullfd <- openFdWithMode (toRawFilePath "/dev/null") ReadOnly Nothing defaultFileFlags
|
||||
redir nullfd stdInput
|
||||
redirLog =<< openlogfd
|
||||
environ <- getEnvironment
|
||||
|
@ -95,9 +96,9 @@ foreground pidfile a = do
|
|||
lockPidFile :: FilePath -> IO ()
|
||||
lockPidFile pidfile = do
|
||||
#ifndef mingw32_HOST_OS
|
||||
fd <- openFd pidfile ReadWrite (Just stdFileMode) defaultFileFlags
|
||||
fd <- openFdWithMode (toRawFilePath pidfile) ReadWrite (Just stdFileMode) defaultFileFlags
|
||||
locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
|
||||
fd' <- openFd newfile ReadWrite (Just stdFileMode) defaultFileFlags
|
||||
fd' <- openFdWithMode (toRawFilePath newfile) ReadWrite (Just stdFileMode) defaultFileFlags
|
||||
{ trunc = True }
|
||||
locked' <- catchMaybeIO $ setLock fd' (WriteLock, AbsoluteSeek, 0, 0)
|
||||
case (locked, locked') of
|
||||
|
@ -132,7 +133,7 @@ checkDaemon :: FilePath -> IO (Maybe PID)
|
|||
checkDaemon pidfile = bracket setup cleanup go
|
||||
where
|
||||
setup = catchMaybeIO $
|
||||
openFd pidfile ReadOnly (Just stdFileMode) defaultFileFlags
|
||||
openFdWithMode (toRawFilePath pidfile) ReadOnly (Just stdFileMode) defaultFileFlags
|
||||
cleanup (Just fd) = closeFd fd
|
||||
cleanup Nothing = return ()
|
||||
go (Just fd) = catchDefaultIO Nothing $ do
|
||||
|
|
|
@ -19,6 +19,7 @@ module Utility.DirWatcher.Kqueue (
|
|||
|
||||
import Common
|
||||
import Utility.DirWatcher.Types
|
||||
import Utility.OpenFd
|
||||
|
||||
import System.Posix.Types
|
||||
import Foreign.C.Types
|
||||
|
@ -110,7 +111,7 @@ scanRecursive topdir prune = M.fromList <$> walk [] [topdir]
|
|||
Nothing -> walk c rest
|
||||
Just info -> do
|
||||
mfd <- catchMaybeIO $
|
||||
Posix.openFd dir Posix.ReadOnly Nothing Posix.defaultFileFlags
|
||||
openFdWithMode (toRawFilePath dir) Posix.ReadOnly Nothing Posix.defaultFileFlags
|
||||
case mfd of
|
||||
Nothing -> walk c rest
|
||||
Just fd -> do
|
||||
|
|
|
@ -30,6 +30,7 @@ import Utility.Directory
|
|||
import Utility.Monad
|
||||
import Utility.Path.AbsRel
|
||||
import Utility.FileMode
|
||||
import Utility.OpenFd
|
||||
import Utility.LockFile.LockStatus
|
||||
import Utility.ThreadScheduler
|
||||
import Utility.Hash
|
||||
|
@ -204,7 +205,7 @@ linkToLock (Just _) src dest = do
|
|||
)
|
||||
Left _ -> catchMaybeIO $ do
|
||||
let setup = do
|
||||
fd <- openFd dest WriteOnly
|
||||
fd <- openFdWithMode dest WriteOnly
|
||||
(Just $ combineModes readModes)
|
||||
(defaultFileFlags {exclusive = True})
|
||||
fdToHandle fd
|
||||
|
|
|
@ -24,6 +24,7 @@ import Utility.Exception
|
|||
import Utility.Applicative
|
||||
import Utility.FileMode
|
||||
import Utility.LockFile.LockStatus
|
||||
import Utility.OpenFd
|
||||
|
||||
import System.IO
|
||||
import System.Posix.Types
|
||||
|
@ -75,7 +76,7 @@ tryLock lockreq mode lockfile = uninterruptibleMask_ $ do
|
|||
openLockFile :: LockRequest -> Maybe ModeSetter -> LockFile -> IO Fd
|
||||
openLockFile lockreq filemode lockfile = do
|
||||
l <- applyModeSetter filemode lockfile $ \filemode' ->
|
||||
openFd lockfile openfor filemode' defaultFileFlags
|
||||
openFdWithMode lockfile openfor filemode' defaultFileFlags
|
||||
setFdOption l CloseOnExec True
|
||||
return l
|
||||
where
|
||||
|
|
25
Utility/OpenFd.hs
Normal file
25
Utility/OpenFd.hs
Normal file
|
@ -0,0 +1,25 @@
|
|||
{- openFd wrapper to support old versions of unix package.
|
||||
-
|
||||
- Copyright 2023 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
||||
|
||||
module Utility.OpenFd (
|
||||
openFdWithMode,
|
||||
) where
|
||||
|
||||
import System.Posix.IO.ByteString
|
||||
import System.Posix.Types
|
||||
import System.FilePath.ByteString (RawFilePath)
|
||||
|
||||
openFdWithMode :: RawFilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
|
||||
#if MIN_VERSION_unix(2,8,0)
|
||||
openFdWithMode f openmode filemode flags =
|
||||
openFd f openmode (flags { creat = filemode })
|
||||
#else
|
||||
openFdWithMode = openFd
|
||||
#endif
|
|
@ -55,7 +55,6 @@ import Utility.Hash (IncrementalVerifier(..))
|
|||
|
||||
import Network.URI
|
||||
import Network.HTTP.Types
|
||||
import qualified Network.Connection as NC
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.UTF8 as B8
|
||||
|
@ -745,8 +744,8 @@ curlRestrictedParams r u defport ps = case uriAuthority u of
|
|||
case partitionEithers (map checkrestriction addrs) of
|
||||
((e:_es), []) -> throwIO e
|
||||
(_, as)
|
||||
| null as -> throwIO $
|
||||
NC.HostNotResolved hostname
|
||||
| null as -> giveup $
|
||||
"cannot resolve host " ++ hostname
|
||||
| otherwise -> return $
|
||||
(limitresolve p) as ++ ps
|
||||
checkrestriction addr = maybe (Right addr) Left $
|
||||
|
|
|
@ -1132,6 +1132,7 @@ Executable git-annex
|
|||
Utility.MoveFile
|
||||
Utility.Network
|
||||
Utility.NotificationBroadcaster
|
||||
Utility.OpenFd
|
||||
Utility.OptParse
|
||||
Utility.OSX
|
||||
Utility.PID
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue