diff options
Diffstat (limited to 'Annex')
-rwxr-xr-x | Annex/Branch.hs | 14 | ||||
-rwxr-xr-x | Annex/Content.hs | 15 | ||||
-rwxr-xr-x[-rw-r--r--] | Annex/Content/Direct.hs | 2 | ||||
-rwxr-xr-x[-rw-r--r--] | Annex/Direct.hs | 2 | ||||
-rwxr-xr-x | Annex/Environment.hs | 10 | ||||
-rwxr-xr-x[-rw-r--r--] | Annex/Journal.hs | 22 | ||||
-rwxr-xr-x[-rw-r--r--] | Annex/Link.hs | 2 | ||||
-rwxr-xr-x[-rw-r--r--] | Annex/LockPool.hs | 9 | ||||
-rwxr-xr-x[-rw-r--r--] | Annex/Perms.hs | 1 | ||||
-rwxr-xr-x | Annex/Ssh.hs | 10 | ||||
-rw-r--r-- | Annex/Version.hs | 6 |
11 files changed, 80 insertions, 13 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 3788358f2..8c3fb41f6 100755 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -24,8 +24,10 @@ module Annex.Branch ( ) where import qualified Data.ByteString.Lazy.Char8 as L -#ifndef mingw32_HOST_OS -import System.Posix.Env +#ifdef __ANDROID__ +import System.Posix.Env (getEnv) +#else +import System.Environment (getEnvironment) #endif import Common.Annex @@ -290,12 +292,14 @@ withIndex' bootstrapping a = do f <- fromRepo gitAnnexIndex g <- gitRepo #ifdef __ANDROID__ - {- Work around for weird getEnvironment breakage on Android. See + {- This should not be necessary on Android, but there is some + - weird getEnvironment breakage. See - https://github.com/neurocyte/ghc-android/issues/7 - - Instead, use getEnv to get some key environment variables that + - Use getEnv to get some key environment variables that - git expects to have. -} let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME" - let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k + let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> + catchMaybeIO (getEnv k) e <- liftIO $ catMaybes <$> forM keyenv getEnvPair #else e <- liftIO getEnvironment diff --git a/Annex/Content.hs b/Annex/Content.hs index ad04bdba1..5ec3c1b3f 100755 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Annex.Content ( inAnnex, inAnnexSafe, @@ -31,6 +33,7 @@ module Annex.Content ( ) where import System.IO.Unsafe (unsafeInterleaveIO) +import System.PosixCompat.Files import Common.Annex import Logs.Location @@ -84,14 +87,22 @@ inAnnexSafe = inAnnex' (fromMaybe False) (Just False) go where go f = liftIO $ openforlock f >>= check openforlock f = catchMaybeIO $ +#ifndef __WINDOWS__ openFd f ReadOnly Nothing defaultFileFlags +#else + return () +#endif check Nothing = return is_missing check (Just h) = do +#ifndef __WINDOWS__ v <- getLock h (ReadLock, AbsoluteSeek, 0, 0) closeFd h return $ case v of Just _ -> is_locked Nothing -> is_unlocked +#else + return is_unlocked +#endif is_locked = Nothing is_unlocked = Just True is_missing = Just False @@ -100,6 +111,9 @@ inAnnexSafe = inAnnex' (fromMaybe False) (Just False) go - it. (If the content is not present, no locking is done.) -} lockContent :: Key -> Annex a -> Annex a lockContent key a = do +#ifdef __WINDOWS__ + a +#else file <- calcRepo $ gitAnnexLocation key bracketIO (openforlock file >>= lock) unlock a where @@ -121,6 +135,7 @@ lockContent key a = do Right _ -> return $ Just fd unlock Nothing = noop unlock (Just l) = closeFd l +#endif {- Runs an action, passing it a temporary filename to get, - and if the action succeeds, moves the temp file into diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index 54befdf73..1aa3c9105 100644..100755 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -33,6 +33,8 @@ import Utility.TempFile import Logs.Location import Utility.InodeCache +import System.PosixCompat.Files + {- Absolute FilePaths of Files in the tree that are associated with a key. -} associatedFiles :: Key -> Annex [FilePath] associatedFiles key = do diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 596c90994..5d679eee6 100644..100755 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -27,6 +27,8 @@ import Utility.InodeCache import Utility.CopyFile import Annex.Perms +import System.PosixCompat.Files + {- Uses git ls-files to find files that need to be committed, and stages - them into the index. Returns True if some changes were staged. -} stageDirect :: Annex Bool diff --git a/Annex/Environment.hs b/Annex/Environment.hs index fef6989ee..fd757ee2c 100755 --- a/Annex/Environment.hs +++ b/Annex/Environment.hs @@ -10,10 +10,12 @@ module Annex.Environment where import Common.Annex +#ifndef __WINDOWS__ import Utility.UserInfo +#endif import qualified Git.Config -#ifndef mingw32_HOST_OS +#ifndef __WINDOWS__ import System.Posix.Env #endif import Network.BSD @@ -28,7 +30,10 @@ checkEnvironment = do liftIO checkEnvironmentIO checkEnvironmentIO :: IO () -checkEnvironmentIO = do +checkEnvironmentIO = +#ifdef __WINDOWS__ + noop +#else whenM (null <$> myUserGecos) $ do username <- myUserName ensureEnv "GIT_AUTHOR_NAME" username @@ -42,3 +47,4 @@ checkEnvironmentIO = do -- in runshell instead. ensureEnv _ _ = noop #endif +#endif diff --git a/Annex/Journal.hs b/Annex/Journal.hs index 2df5294ee..f86d03cf6 100644..100755 --- a/Annex/Journal.hs +++ b/Annex/Journal.hs @@ -9,6 +9,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Annex.Journal where import System.IO.Binary @@ -77,13 +79,23 @@ fileJournal = replace "//" "_" . replace "_" "/" - contention with other git-annex processes. -} lockJournal :: Annex a -> Annex a lockJournal a = do - file <- fromRepo gitAnnexJournalLock - createAnnexDirectory $ takeDirectory file + lockfile <- fromRepo gitAnnexJournalLock + createAnnexDirectory $ takeDirectory lockfile mode <- annexFileMode - bracketIO (lock file mode) unlock a + bracketIO (lock lockfile mode) unlock a where - lock file mode = do - l <- noUmask mode $ createFile file mode + lock lockfile mode = do +#ifndef __WINDOWS__ + l <- noUmask mode $ createFile lockfile mode waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0) return l +#else + writeFile lockfile "" + return lockfile +#endif +#ifndef __WINDOWS__ unlock = closeFd +#else + unlock = removeFile +#endif + diff --git a/Annex/Link.hs b/Annex/Link.hs index 931836d31..0a72f75ca 100644..100755 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -19,6 +19,8 @@ import qualified Git.UpdateIndex import qualified Annex.Queue import Git.Types +import System.PosixCompat.Files + type LinkTarget = String {- Checks if a file is a link to a key. -} diff --git a/Annex/LockPool.hs b/Annex/LockPool.hs index 45fc55b3c..d8bc08485 100644..100755 --- a/Annex/LockPool.hs +++ b/Annex/LockPool.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Annex.LockPool where import qualified Data.Map as M @@ -20,17 +22,24 @@ lockFile file = go =<< fromPool file where go (Just _) = noop -- already locked go Nothing = do +#ifndef __WINDOWS__ mode <- annexFileMode fd <- liftIO $ noUmask mode $ openFd file ReadOnly (Just mode) defaultFileFlags liftIO $ waitToSetLock fd (ReadLock, AbsoluteSeek, 0, 0) +#else + liftIO $ writeFile file "" + let fd = 0 +#endif changePool $ M.insert file fd unlockFile :: FilePath -> Annex () unlockFile file = maybe noop go =<< fromPool file where go fd = do +#ifndef __WINDOWS__ liftIO $ closeFd fd +#endif changePool $ M.delete file getPool :: Annex (M.Map FilePath Fd) diff --git a/Annex/Perms.hs b/Annex/Perms.hs index f5925b741..de01ae0f8 100644..100755 --- a/Annex/Perms.hs +++ b/Annex/Perms.hs @@ -22,6 +22,7 @@ import qualified Annex import Config import System.Posix.Types +import System.PosixCompat.Files withShared :: (SharedRepository -> Annex a) -> Annex a withShared a = maybe startup a =<< Annex.getState Annex.shared diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 1846fd342..56109774b 100755 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -14,7 +14,7 @@ module Annex.Ssh ( ) where import qualified Data.Map as M -#ifndef mingw32_HOST_OS +#ifndef __WINDOWS__ import System.Posix.Env #endif @@ -78,7 +78,11 @@ sshCacheDir ) | otherwise = return Nothing where +#ifndef __WINDOWS__ gettmpdir = liftIO $ getEnv "GIT_ANNEX_TMP_DIR" +#else + gettmpdir = return Nothing +#endif usetmpdir tmpdir = liftIO $ catchMaybeIO $ do createDirectoryIfMissing True tmpdir return tmpdir @@ -97,6 +101,7 @@ sshCleanup = go =<< sshCacheDir liftIO (catchDefaultIO [] $ dirContents dir) forM_ sockets cleanup cleanup socketfile = do +#ifndef __WINDOWS__ -- Drop any shared lock we have, and take an -- exclusive lock, without blocking. If the lock -- succeeds, nothing is using this ssh, and it can @@ -112,6 +117,9 @@ sshCleanup = go =<< sshCacheDir Left _ -> noop Right _ -> stopssh socketfile liftIO $ closeFd fd +#else + stopssh socketfile +#endif stopssh socketfile = do let (host, port) = socket2hostport socketfile (_, params) <- sshInfo (host, port) diff --git a/Annex/Version.hs b/Annex/Version.hs index 31c6501be..7859707d3 100644 --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Annex.Version where import Common.Annex @@ -23,7 +25,11 @@ supportedVersions :: [Version] supportedVersions = [defaultVersion, directModeVersion] upgradableVersions :: [Version] +#ifndef __WINDOWS__ upgradableVersions = ["0", "1", "2"] +#else +upgradableVersions = ["2"] +#endif versionField :: ConfigKey versionField = annexConfig "version" |