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:
Joey Hess 2023-08-01 18:41:27 -04:00
parent 4ef16f53ed
commit 68c9b08faf
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
12 changed files with 51 additions and 16 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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
View 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

View file

@ -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 $

View file

@ -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