summaryrefslogtreecommitdiff
path: root/Annex
diff options
context:
space:
mode:
Diffstat (limited to 'Annex')
-rw-r--r--Annex/Branch.hs10
-rw-r--r--Annex/CatFile.hs3
-rw-r--r--Annex/Content.hs15
-rw-r--r--Annex/Content/Direct.hs4
-rw-r--r--Annex/Environment.hs11
-rw-r--r--Annex/Journal.hs32
-rw-r--r--Annex/Link.hs32
-rw-r--r--Annex/LockPool.hs9
-rw-r--r--Annex/Ssh.hs7
-rw-r--r--Annex/Version.hs6
10 files changed, 94 insertions, 35 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index 021cd3926..9a89a65c3 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -24,7 +24,6 @@ module Annex.Branch (
) where
import qualified Data.ByteString.Lazy.Char8 as L
-import System.Posix.Env
import Common.Annex
import Annex.BranchState
@@ -41,6 +40,7 @@ import Git.FilePath
import Annex.CatFile
import Annex.Perms
import qualified Annex
+import Utility.Env
{- Name of the branch that is used to store git-annex's information. -}
name :: Git.Ref
@@ -288,12 +288,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/CatFile.hs b/Annex/CatFile.hs
index 9de6f9856..71b8985a3 100644
--- a/Annex/CatFile.hs
+++ b/Annex/CatFile.hs
@@ -22,6 +22,7 @@ import qualified Git
import qualified Git.CatFile
import qualified Annex
import Git.Types
+import Git.FilePath
catFile :: Git.Branch -> FilePath -> Annex L.ByteString
catFile branch file = do
@@ -56,7 +57,7 @@ catFileHandle = do
{- From the Sha or Ref of a symlink back to the key. -}
catKey :: Ref -> Annex (Maybe Key)
catKey ref = do
- l <- encodeW8 . L.unpack <$> catObject ref
+ l <- fromInternalGitPath . encodeW8 . L.unpack <$> catObject ref
return $ if isLinkToAnnex l
then fileKey $ takeFileName l
else Nothing
diff --git a/Annex/Content.hs b/Annex/Content.hs
index ad04bdba1..5ec3c1b3f 100644
--- 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..b885b5e5b 100644
--- a/Annex/Content/Direct.hs
+++ b/Annex/Content/Direct.hs
@@ -29,7 +29,7 @@ import Common.Annex
import qualified Annex
import Annex.Perms
import qualified Git
-import Utility.TempFile
+import Utility.Tmp
import Logs.Location
import Utility.InodeCache
@@ -110,7 +110,7 @@ goodContent key file = sameInodeCache file =<< recordedInodeCache key
recordedInodeCache :: Key -> Annex [InodeCache]
recordedInodeCache key = withInodeCacheFile key $ \f ->
liftIO $ catchDefaultIO [] $
- mapMaybe readInodeCache . lines <$> readFile f
+ mapMaybe readInodeCache . lines <$> readFileStrict f
{- Caches an inode for a file.
-
diff --git a/Annex/Environment.hs b/Annex/Environment.hs
index 472fc934a..33569386e 100644
--- a/Annex/Environment.hs
+++ b/Annex/Environment.hs
@@ -10,11 +10,10 @@
module Annex.Environment where
import Common.Annex
+import Utility.Env
import Utility.UserInfo
import qualified Git.Config
-import System.Posix.Env
-
{- Checks that the system's environment allows git to function.
- Git requires a GECOS username, or suitable git configuration, or
- environment variables. -}
@@ -25,7 +24,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
@@ -33,9 +35,10 @@ checkEnvironmentIO = do
where
#ifndef __ANDROID__
-- existing environment is not overwritten
- ensureEnv var val = setEnv var val False
+ ensureEnv var val = void $ setEnv var val False
#else
-- Environment setting is broken on Android, so this is dealt with
-- in runshell instead.
ensureEnv _ _ = noop
#endif
+#endif
diff --git a/Annex/Journal.hs b/Annex/Journal.hs
index 2df5294ee..e68591ce2 100644
--- 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
@@ -64,26 +66,38 @@ journalDirty = not . null <$> getJournalFiles
journalFile :: FilePath -> Git.Repo -> FilePath
journalFile file repo = gitAnnexJournalDir repo </> concatMap mangle file
where
- mangle '/' = "_"
- mangle '_' = "__"
- mangle c = [c]
+ mangle c
+ | c == pathSeparator = "_"
+ | c == '_' = "__"
+ | otherwise = [c]
{- Converts a journal file (relative to the journal dir) back to the
- filename on the branch. -}
fileJournal :: FilePath -> FilePath
-fileJournal = replace "//" "_" . replace "_" "/"
+fileJournal = replace [pathSeparator, pathSeparator] "_" .
+ replace "_" [pathSeparator]
{- Runs an action that modifies the journal, using locking to avoid
- 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..b41e6d101 100644
--- a/Annex/Link.hs
+++ b/Annex/Link.hs
@@ -18,6 +18,7 @@ import qualified Git.HashObject
import qualified Git.UpdateIndex
import qualified Annex.Queue
import Git.Types
+import Git.FilePath
type LinkTarget = String
@@ -27,25 +28,27 @@ isAnnexLink file = maybe Nothing (fileKey . takeFileName) <$> getAnnexLinkTarget
{- Gets the link target of a symlink.
-
- - On a filesystem that does not support symlinks, get the link
- - target by looking inside the file. (Only return at first 8k of the file,
- - more than enough for any symlink target.)
+ - On a filesystem that does not support symlinks, fall back to getting the
+ - link target by looking inside the file. (Only return at first 8k of the
+ - file, more than enough for any symlink target.)
-
- Returns Nothing if the file is not a symlink, or not a link to annex
- content.
-}
getAnnexLinkTarget :: FilePath -> Annex (Maybe LinkTarget)
-getAnnexLinkTarget file = do
- v <- ifM (coreSymlinks <$> Annex.getGitConfig)
- ( liftIO $ catchMaybeIO $ readSymbolicLink file
- , liftIO $ catchMaybeIO $ readfilestart file
- )
- case v of
- Nothing -> return Nothing
- Just l
- | isLinkToAnnex l -> return v
- | otherwise -> return Nothing
+getAnnexLinkTarget file =
+ check readSymbolicLink $
+ check readfilestart $
+ return Nothing
where
+ check getlinktarget fallback = do
+ v <- liftIO $ catchMaybeIO $ getlinktarget file
+ case v of
+ Just l
+ | isLinkToAnnex (fromInternalGitPath l) -> return v
+ | otherwise -> return Nothing
+ Nothing -> fallback
+
readfilestart f = do
h <- openFile f ReadMode
fileEncoding h
@@ -74,7 +77,8 @@ addAnnexLink linktarget file = do
{- Injects a symlink target into git, returning its Sha. -}
hashSymlink :: LinkTarget -> Annex Sha
-hashSymlink linktarget = inRepo $ Git.HashObject.hashObject BlobObject linktarget
+hashSymlink linktarget = inRepo $ Git.HashObject.hashObject BlobObject $
+ toInternalGitPath linktarget
{- Stages a symlink to the annex, using a Sha of its target. -}
stageSymlink :: FilePath -> Sha -> Annex ()
diff --git a/Annex/LockPool.hs b/Annex/LockPool.hs
index 45fc55b3c..d8bc08485 100644
--- 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/Ssh.hs b/Annex/Ssh.hs
index cf92bd248..940cbb5a7 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -10,11 +10,11 @@
module Annex.Ssh (
sshCachingOptions,
sshCleanup,
+ sshCacheDir,
sshReadPort,
) where
import qualified Data.Map as M
-import System.Posix.Env
import Common.Annex
import Annex.LockPool
@@ -22,6 +22,7 @@ import Annex.Perms
import qualified Build.SysConfig as SysConfig
import qualified Annex
import Config
+import Utility.Env
{- Generates parameters to ssh to a given host (or user@host) on a given
- port, with connection caching. -}
@@ -95,6 +96,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
@@ -110,6 +112,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"
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-01 17:52:29 +0000