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