finish fixing removeLink on windows

9cb250f7be got the ones in RawFilePath,
but there were others that used the one from unix-compat, which fails at
runtime on windows. To avoid this,
import System.PosixCompat.Files hiding removeLink

This commit was sponsored by Ethan Aubin.
This commit is contained in:
Joey Hess 2020-11-24 12:38:12 -04:00
parent dce0781391
commit a3b714ddd9
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
28 changed files with 73 additions and 64 deletions

View file

@ -34,11 +34,11 @@ import qualified Database.Keys
import Annex.InodeSentinal import Annex.InodeSentinal
import Utility.InodeCache import Utility.InodeCache
import Utility.FileMode import Utility.FileMode
import qualified Utility.RawFilePath as R
import qualified Data.Set as S import qualified Data.Set as S
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Utility.RawFilePath as R
{- Merges from a branch into the current branch (which may not exist yet), {- Merges from a branch into the current branch (which may not exist yet),
- with automatic merge conflict resolution. - with automatic merge conflict resolution.
@ -176,7 +176,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
-- files, so delete here. -- files, so delete here.
unless inoverlay $ unless inoverlay $
unless (islocked LsFiles.valUs) $ unless (islocked LsFiles.valUs) $
liftIO $ removeWhenExistsWith removeLink file liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath file)
| otherwise -> do | otherwise -> do
-- Only resolve using symlink when both -- Only resolve using symlink when both
-- were locked, otherwise use unlocked -- were locked, otherwise use unlocked
@ -309,7 +309,7 @@ cleanConflictCruft resolvedks resolvedfs unstagedmap = do
<$> mapM Database.Keys.getInodeCaches resolvedks <$> mapM Database.Keys.getInodeCaches resolvedks
forM_ (M.toList unstagedmap) $ \(i, f) -> forM_ (M.toList unstagedmap) $ \(i, f) ->
whenM (matchesresolved is i f) $ whenM (matchesresolved is i f) $
liftIO $ removeWhenExistsWith removeLink f liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
where where
fs = S.fromList resolvedfs fs = S.fromList resolvedfs
ks = S.fromList resolvedks ks = S.fromList resolvedks

View file

@ -535,7 +535,7 @@ stageJournal jl commitindex = withIndex $ withOtherTmp $ \tmpdir -> do
stagedfs <- lines <$> hGetContents jlogh stagedfs <- lines <$> hGetContents jlogh
mapM_ (removeFile . (dir </>)) stagedfs mapM_ (removeFile . (dir </>)) stagedfs
hClose jlogh hClose jlogh
removeWhenExistsWith removeLink jlogf removeWhenExistsWith (R.removeLink) (toRawFilePath jlogf)
openjlog tmpdir = liftIO $ openTempFile tmpdir "jlog" openjlog tmpdir = liftIO $ openTempFile tmpdir "jlog"
{- This is run after the refs have been merged into the index, {- This is run after the refs have been merged into the index,

View file

@ -18,7 +18,6 @@ import Utility.DataUnits
import Utility.CopyFile import Utility.CopyFile
import qualified Utility.RawFilePath as R import qualified Utility.RawFilePath as R
import System.PosixCompat.Files
import qualified System.FilePath.ByteString as P import qualified System.FilePath.ByteString as P
{- Runs the secure erase command if set, otherwise does nothing. {- Runs the secure erase command if set, otherwise does nothing.
@ -75,8 +74,9 @@ checkedCopyFile key src dest destmode = catchBoolIO $
=<< liftIO (R.getFileStatus src) =<< liftIO (R.getFileStatus src)
checkedCopyFile' :: Key -> RawFilePath -> RawFilePath -> Maybe FileMode -> FileStatus -> Annex Bool checkedCopyFile' :: Key -> RawFilePath -> RawFilePath -> Maybe FileMode -> FileStatus -> Annex Bool
checkedCopyFile' key src dest destmode s = catchBoolIO $ checkedCopyFile' key src dest destmode s = catchBoolIO $ do
ifM (checkDiskSpace' (fromIntegral $ fileSize s) (Just $ P.takeDirectory dest) key 0 True) sz <- liftIO $ getFileSize' src s
ifM (checkDiskSpace' sz (Just $ P.takeDirectory dest) key 0 True)
( liftIO $ ( liftIO $
copyFileExternal CopyAllMetaData (fromRawFilePath src) (fromRawFilePath dest) copyFileExternal CopyAllMetaData (fromRawFilePath src) (fromRawFilePath dest)
<&&> preserveGitMode dest destmode <&&> preserveGitMode dest destmode

View file

@ -9,12 +9,6 @@
module Annex.Content.PointerFile where module Annex.Content.PointerFile where
#if ! defined(mingw32_HOST_OS)
import System.Posix.Files
#else
import System.PosixCompat.Files
#endif
import Annex.Common import Annex.Common
import Annex.Perms import Annex.Perms
import Annex.Link import Annex.Link
@ -22,10 +16,11 @@ import Annex.ReplaceFile
import Annex.InodeSentinal import Annex.InodeSentinal
import Annex.Content.LowLevel import Annex.Content.LowLevel
import Utility.InodeCache import Utility.InodeCache
import qualified Utility.RawFilePath as R
#if ! defined(mingw32_HOST_OS) #if ! defined(mingw32_HOST_OS)
import Utility.Touch import Utility.Touch
import System.Posix.Files (modificationTimeHiRes)
#endif #endif
import qualified Utility.RawFilePath as R
{- Populates a pointer file with the content of a key. {- Populates a pointer file with the content of a key.
- -

View file

@ -49,9 +49,9 @@ import Git.FilePath
import Annex.InodeSentinal import Annex.InodeSentinal
import Annex.AdjustedBranch import Annex.AdjustedBranch
import Annex.FileMatcher import Annex.FileMatcher
import qualified Utility.RawFilePath as R
import Control.Exception (IOException) import Control.Exception (IOException)
import qualified Utility.RawFilePath as R
data LockedDown = LockedDown data LockedDown = LockedDown
{ lockDownConfig :: LockDownConfig { lockDownConfig :: LockDownConfig
@ -113,7 +113,7 @@ lockDown' cfg file = tryIO $ ifM crippledFileSystem
(tmpfile, h) <- openTempFile (fromRawFilePath tmpdir) $ (tmpfile, h) <- openTempFile (fromRawFilePath tmpdir) $
relatedTemplate $ "ingest-" ++ takeFileName file relatedTemplate $ "ingest-" ++ takeFileName file
hClose h hClose h
removeWhenExistsWith removeLink tmpfile removeWhenExistsWith R.removeLink (toRawFilePath tmpfile)
withhardlink' delta tmpfile withhardlink' delta tmpfile
`catchIO` const (nohardlink' delta) `catchIO` const (nohardlink' delta)

View file

@ -49,8 +49,8 @@ import Annex.InodeSentinal
import Upgrade import Upgrade
import Annex.Tmp import Annex.Tmp
import Utility.UserInfo import Utility.UserInfo
#ifndef mingw32_HOST_OS
import qualified Utility.RawFilePath as R import qualified Utility.RawFilePath as R
#ifndef mingw32_HOST_OS
import Utility.ThreadScheduler import Utility.ThreadScheduler
import Annex.Perms import Annex.Perms
import Utility.FileMode import Utility.FileMode
@ -212,9 +212,9 @@ probeCrippledFileSystem' tmp = do
where where
probe f = catchDefaultIO (True, []) $ do probe f = catchDefaultIO (True, []) $ do
let f2 = f ++ "2" let f2 = f ++ "2"
removeWhenExistsWith removeLink f2 removeWhenExistsWith R.removeLink (toRawFilePath f2)
createSymbolicLink f f2 createSymbolicLink f f2
removeWhenExistsWith removeLink f2 removeWhenExistsWith R.removeLink (toRawFilePath f2)
preventWrite (toRawFilePath f) preventWrite (toRawFilePath f)
-- Should be unable to write to the file, unless -- Should be unable to write to the file, unless
-- running as root, but some crippled -- running as root, but some crippled

View file

@ -337,7 +337,7 @@ forceStopSsh socketfile = withNullHandle $ \nullh -> do
} }
void $ liftIO $ catchMaybeIO $ withCreateProcess p $ \_ _ _ pid -> void $ liftIO $ catchMaybeIO $ withCreateProcess p $ \_ _ _ pid ->
forceSuccessProcess p pid forceSuccessProcess p pid
liftIO $ removeWhenExistsWith removeLink socketfile liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath socketfile)
{- This needs to be as short as possible, due to limitations on the length {- This needs to be as short as possible, due to limitations on the length
- of the path to a socket file. At the same time, it needs to be unique - of the path to a socket file. At the same time, it needs to be unique

View file

@ -12,6 +12,7 @@ import qualified Annex
import Annex.LockFile import Annex.LockFile
import Annex.Perms import Annex.Perms
import Types.CleanupActions import Types.CleanupActions
import qualified Utility.RawFilePath as R
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
@ -67,5 +68,5 @@ cleanupOtherTmp = do
let oldenough = now - (60 * 60 * 24 * 7) let oldenough = now - (60 * 60 * 24 * 7)
catchMaybeIO (modificationTime <$> getSymbolicLinkStatus f) >>= \case catchMaybeIO (modificationTime <$> getSymbolicLinkStatus f) >>= \case
Just mtime | realToFrac mtime <= oldenough -> Just mtime | realToFrac mtime <= oldenough ->
void $ tryIO $ removeWhenExistsWith removeLink f void $ tryIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
_ -> return () _ -> return ()

View file

@ -30,6 +30,7 @@ import qualified Data.Text as T
#endif #endif
import qualified Utility.Lsof as Lsof import qualified Utility.Lsof as Lsof
import Utility.ThreadScheduler import Utility.ThreadScheduler
import qualified Utility.RawFilePath as R
import Control.Concurrent.Async import Control.Concurrent.Async
@ -149,7 +150,7 @@ repairStaleLocks lockfiles = go =<< getsizes
waitforit "to check stale git lock file" waitforit "to check stale git lock file"
l' <- getsizes l' <- getsizes
if l' == l if l' == l
then liftIO $ mapM_ (removeWhenExistsWith removeLink . fst) l then liftIO $ mapM_ (removeWhenExistsWith R.removeLink . toRawFilePath . fst) l
else go l' else go l'
, do , do
waitforit "for git lock file writer" waitforit "for git lock file writer"

View file

@ -41,6 +41,7 @@ import qualified BuildInfo
import qualified Utility.Url as Url import qualified Utility.Url as Url
import qualified Annex.Url as Url hiding (download) import qualified Annex.Url as Url hiding (download)
import Utility.Tuple import Utility.Tuple
import qualified Utility.RawFilePath as R
import Data.Either import Data.Either
import qualified Data.Map as M import qualified Data.Map as M
@ -220,7 +221,7 @@ upgradeToDistribution newdir cleanup distributionfile = do
error $ "did not find " ++ dir ++ " in " ++ distributionfile error $ "did not find " ++ dir ++ " in " ++ distributionfile
makeorigsymlink olddir = do makeorigsymlink olddir = do
let origdir = fromRawFilePath (parentDir (toRawFilePath olddir)) </> installBase let origdir = fromRawFilePath (parentDir (toRawFilePath olddir)) </> installBase
removeWhenExistsWith removeLink origdir removeWhenExistsWith R.removeLink (toRawFilePath origdir)
createSymbolicLink newdir origdir createSymbolicLink newdir origdir
{- Finds where the old version was installed. -} {- Finds where the old version was installed. -}
@ -278,8 +279,8 @@ installBase = "git-annex." ++
deleteFromManifest :: FilePath -> IO () deleteFromManifest :: FilePath -> IO ()
deleteFromManifest dir = do deleteFromManifest dir = do
fs <- map (dir </>) . lines <$> catchDefaultIO "" (readFile manifest) fs <- map (dir </>) . lines <$> catchDefaultIO "" (readFile manifest)
mapM_ (removeWhenExistsWith removeLink) fs mapM_ (removeWhenExistsWith R.removeLink . toRawFilePath) fs
removeWhenExistsWith removeLink manifest removeWhenExistsWith R.removeLink (toRawFilePath manifest)
removeEmptyRecursive dir removeEmptyRecursive dir
where where
manifest = dir </> "git-annex.MANIFEST" manifest = dir </> "git-annex.MANIFEST"

View file

@ -17,6 +17,7 @@ import Annex.Perms
import Utility.ThreadScheduler import Utility.ThreadScheduler
import Utility.DiskFree import Utility.DiskFree
import Git.Types (fromConfigKey) import Git.Types (fromConfigKey)
import qualified Utility.RawFilePath as R
import Data.Time.Clock import Data.Time.Clock
import System.Random (getStdRandom, random, randomR) import System.Random (getStdRandom, random, randomR)
@ -178,7 +179,7 @@ runFuzzAction (FuzzAdd (FuzzFile f)) = do
n <- liftIO (getStdRandom random :: IO Int) n <- liftIO (getStdRandom random :: IO Int)
liftIO $ writeFile f $ show n ++ "\n" liftIO $ writeFile f $ show n ++ "\n"
runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $ runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $
removeWhenExistsWith removeLink f removeWhenExistsWith R.removeLink (toRawFilePath f)
runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $ runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $
rename src dest rename src dest
runFuzzAction (FuzzDeleteDir (FuzzDir d)) = liftIO $ runFuzzAction (FuzzDeleteDir (FuzzDir d)) = liftIO $

View file

@ -27,6 +27,7 @@ import Utility.Hash
import Utility.Tmp import Utility.Tmp
import Utility.Tmp.Dir import Utility.Tmp.Dir
import Utility.Process.Transcript import Utility.Process.Transcript
import qualified Utility.RawFilePath as R
import Data.Char import Data.Char
import qualified Data.ByteString.Lazy.UTF8 as B8 import qualified Data.ByteString.Lazy.UTF8 as B8
@ -84,7 +85,7 @@ genAddress = starting "gen-address" (ActionItemOther Nothing) (SeekInput []) $ d
KeyContainer s -> liftIO $ genkey (Param s) KeyContainer s -> liftIO $ genkey (Param s)
KeyFile f -> do KeyFile f -> do
createAnnexDirectory (toRawFilePath (takeDirectory f)) createAnnexDirectory (toRawFilePath (takeDirectory f))
liftIO $ removeWhenExistsWith removeLink f liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
liftIO $ protectedOutput $ genkey (File f) liftIO $ protectedOutput $ genkey (File f)
case (ok, parseFingerprint s) of case (ok, parseFingerprint s) of
(False, _) -> giveup $ "uftp_keymgt failed: " ++ s (False, _) -> giveup $ "uftp_keymgt failed: " ++ s
@ -210,7 +211,7 @@ storeReceived f = do
case deserializeKey (takeFileName f) of case deserializeKey (takeFileName f) of
Nothing -> do Nothing -> do
warning $ "Received a file " ++ f ++ " that is not a git-annex key. Deleting this file." warning $ "Received a file " ++ f ++ " that is not a git-annex key. Deleting this file."
liftIO $ removeWhenExistsWith removeLink f liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
Just k -> void $ Just k -> void $
getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $ getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $
liftIO $ catchBoolIO $ do liftIO $ catchBoolIO $ do

View file

@ -24,6 +24,7 @@ import Utility.AuthToken
import Utility.Tmp.Dir import Utility.Tmp.Dir
import Utility.FileMode import Utility.FileMode
import Utility.ThreadScheduler import Utility.ThreadScheduler
import qualified Utility.RawFilePath as R
import qualified Utility.MagicWormhole as Wormhole import qualified Utility.MagicWormhole as Wormhole
import Control.Concurrent.Async import Control.Concurrent.Async
@ -256,7 +257,7 @@ wormholePairing remotename ouraddrs ui = do
Wormhole.sendFile sendf observer wormholeparams Wormhole.sendFile sendf observer wormholeparams
`concurrently` `concurrently`
Wormhole.receiveFile recvf producer wormholeparams Wormhole.receiveFile recvf producer wormholeparams
liftIO $ removeWhenExistsWith removeLink sendf liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath sendf)
if sendres /= True if sendres /= True
then return SendFailed then return SendFailed
else if recvres /= True else if recvres /= True

View file

@ -32,6 +32,7 @@ import Types.ScheduledActivity
import Types.NumCopies import Types.NumCopies
import Remote import Remote
import Git.Types (fromConfigKey, fromConfigValue) import Git.Types (fromConfigKey, fromConfigValue)
import qualified Utility.RawFilePath as R
cmd :: Command cmd :: Command
cmd = command "vicfg" SectionSetup "edit configuration in git-annex branch" cmd = command "vicfg" SectionSetup "edit configuration in git-annex branch"
@ -58,7 +59,7 @@ vicfg curcfg f = do
unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $ unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $
giveup $ vi ++ " exited nonzero; aborting" giveup $ vi ++ " exited nonzero; aborting"
r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f) r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f)
liftIO $ removeWhenExistsWith removeLink f liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
case r of case r of
Left s -> do Left s -> do
liftIO $ writeFile f s liftIO $ writeFile f s

View file

@ -13,7 +13,7 @@ import Data.Default as X
import System.FilePath as X import System.FilePath as X
import System.IO as X hiding (FilePath) import System.IO as X hiding (FilePath)
import System.Exit as X import System.Exit as X
import System.PosixCompat.Files as X hiding (fileSize) import System.PosixCompat.Files as X hiding (fileSize, removeLink)
import Utility.Misc as X import Utility.Misc as X
import Utility.Exception as X import Utility.Exception as X

View file

@ -32,12 +32,13 @@ import Crypto
import Types.ProposedAccepted import Types.ProposedAccepted
import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher) import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher)
import Utility.Env (getEnv) import Utility.Env (getEnv)
import Utility.Base64
import qualified Utility.RawFilePath as R
import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Char8 as S
import qualified Data.Map as M import qualified Data.Map as M
import qualified System.FilePath.ByteString as P import qualified System.FilePath.ByteString as P
import Utility.Base64
{- A CredPair can be stored in a file, or in the environment, or {- A CredPair can be stored in a file, or in the environment, or
- in a remote's configuration. -} - in a remote's configuration. -}
@ -211,9 +212,8 @@ decodeCredPair creds = case lines creds of
removeCreds :: FilePath -> Annex () removeCreds :: FilePath -> Annex ()
removeCreds file = do removeCreds file = do
d <- fromRawFilePath <$> fromRepo gitAnnexCredsDir d <- fromRepo gitAnnexCredsDir
let f = d </> file liftIO $ removeWhenExistsWith R.removeLink (d P.</> toRawFilePath file)
liftIO $ removeWhenExistsWith removeLink f
includeCredsInfo :: ParsedRemoteConfig -> CredPairStorage -> [(String, String)] -> Annex [(String, String)] includeCredsInfo :: ParsedRemoteConfig -> CredPairStorage -> [(String, String)] -> Annex [(String, String)]
includeCredsInfo pc@(ParsedRemoteConfig cm _) storage info = do includeCredsInfo pc@(ParsedRemoteConfig cm _) storage info = do

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
{-# LANGUAGE OverloadedStrings #-}
module Git.Repair ( module Git.Repair (
runRepair, runRepair,
runRepairOf, runRepairOf,
@ -243,11 +245,12 @@ getAllRefs' refdir = do
explodePackedRefsFile :: Repo -> IO () explodePackedRefsFile :: Repo -> IO ()
explodePackedRefsFile r = do explodePackedRefsFile r = do
let f = packedRefsFile r let f = packedRefsFile r
let f' = toRawFilePath f
whenM (doesFileExist f) $ do whenM (doesFileExist f) $ do
rs <- mapMaybe parsePacked . lines rs <- mapMaybe parsePacked . lines
<$> catchDefaultIO "" (safeReadFile f) <$> catchDefaultIO "" (safeReadFile f')
forM_ rs makeref forM_ rs makeref
removeWhenExistsWith removeLink f removeWhenExistsWith R.removeLink f'
where where
makeref (sha, ref) = do makeref (sha, ref) = do
let gitd = localGitDir r let gitd = localGitDir r
@ -444,13 +447,13 @@ displayList items header
preRepair :: Repo -> IO () preRepair :: Repo -> IO ()
preRepair g = do preRepair g = do
unlessM (validhead <$> catchDefaultIO "" (safeReadFile headfile)) $ do unlessM (validhead <$> catchDefaultIO "" (safeReadFile headfile)) $ do
removeWhenExistsWith removeLink headfile removeWhenExistsWith R.removeLink headfile
writeFile headfile "ref: refs/heads/master" writeFile (fromRawFilePath headfile) "ref: refs/heads/master"
explodePackedRefsFile g explodePackedRefsFile g
unless (repoIsLocalBare g) $ unless (repoIsLocalBare g) $
void $ tryIO $ allowWrite $ indexFile g void $ tryIO $ allowWrite $ indexFile g
where where
headfile = fromRawFilePath (localGitDir g) </> "HEAD" headfile = localGitDir g P.</> "HEAD"
validhead s = "ref: refs/" `isPrefixOf` s validhead s = "ref: refs/" `isPrefixOf` s
|| isJust (extractSha (encodeBS' s)) || isJust (extractSha (encodeBS' s))
@ -616,7 +619,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do
successfulRepair :: (Bool, [Branch]) -> Bool successfulRepair :: (Bool, [Branch]) -> Bool
successfulRepair = fst successfulRepair = fst
safeReadFile :: FilePath -> IO String safeReadFile :: RawFilePath -> IO String
safeReadFile f = do safeReadFile f = do
allowRead (toRawFilePath f) allowRead f
readFileStrict f readFileStrict (fromRawFilePath f)

View file

@ -37,6 +37,7 @@ import Utility.Tor
import Utility.FileMode import Utility.FileMode
import Types.UUID import Types.UUID
import Annex.ChangedRefs import Annex.ChangedRefs
import qualified Utility.RawFilePath as R
import Control.Monad.Free import Control.Monad.Free
import Control.Monad.IO.Class import Control.Monad.IO.Class
@ -124,7 +125,7 @@ closeConnection conn = do
-- the callback. -- the callback.
serveUnixSocket :: FilePath -> (Handle -> IO ()) -> IO () serveUnixSocket :: FilePath -> (Handle -> IO ()) -> IO ()
serveUnixSocket unixsocket serveconn = do serveUnixSocket unixsocket serveconn = do
removeWhenExistsWith removeLink unixsocket removeWhenExistsWith R.removeLink (toRawFilePath unixsocket)
soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol
S.bind soc (S.SockAddrUnix unixsocket) S.bind soc (S.SockAddrUnix unixsocket)
-- Allow everyone to read and write to the socket, -- Allow everyone to read and write to the socket,

View file

@ -301,10 +301,10 @@ retrieveExportM d _k loc dest p =
removeExportM :: RawFilePath -> Key -> ExportLocation -> Annex () removeExportM :: RawFilePath -> Key -> ExportLocation -> Annex ()
removeExportM d _k loc = liftIO $ do removeExportM d _k loc = liftIO $ do
removeWhenExistsWith removeLink src removeWhenExistsWith R.removeLink src
removeExportLocation d loc removeExportLocation d loc
where where
src = fromRawFilePath $ exportPath d loc src = exportPath d loc
checkPresentExportM :: RawFilePath -> Key -> ExportLocation -> Annex Bool checkPresentExportM :: RawFilePath -> Key -> ExportLocation -> Annex Bool
checkPresentExportM d _k loc = checkPresentExportM d _k loc =

View file

@ -22,6 +22,7 @@ import qualified Remote.Helper.Chunked.Legacy as Legacy
import Annex.Tmp import Annex.Tmp
import Utility.Metered import Utility.Metered
import Utility.Directory.Create import Utility.Directory.Create
import qualified Utility.RawFilePath as R
withCheckedFiles :: (FilePath -> IO Bool) -> FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool withCheckedFiles :: (FilePath -> IO Bool) -> FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool
withCheckedFiles _ [] _locations _ _ = return False withCheckedFiles _ [] _locations _ _ = return False
@ -98,15 +99,15 @@ store repotop chunksize finalizer k b p = storeHelper repotop finalizer k $ \des
retrieve :: (RawFilePath -> Key -> [RawFilePath]) -> RawFilePath -> Retriever retrieve :: (RawFilePath -> Key -> [RawFilePath]) -> RawFilePath -> Retriever
retrieve locations d basek p c = withOtherTmp $ \tmpdir -> do retrieve locations d basek p c = withOtherTmp $ \tmpdir -> do
showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow." showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow."
let tmp = fromRawFilePath $ let tmp = tmpdir P.</> keyFile basek <> ".directorylegacy.tmp"
tmpdir P.</> keyFile basek <> ".directorylegacy.tmp" let tmp' = fromRawFilePath tmp
let go = \k sink -> do let go = \k sink -> do
liftIO $ void $ withStoredFiles (fromRawFilePath d) (legacyLocations locations) k $ \fs -> do liftIO $ void $ withStoredFiles (fromRawFilePath d) (legacyLocations locations) k $ \fs -> do
forM_ fs $ forM_ fs $
S.appendFile tmp <=< S.readFile S.appendFile tmp' <=< S.readFile
return True return True
b <- liftIO $ L.readFile tmp b <- liftIO $ L.readFile tmp'
liftIO $ removeWhenExistsWith removeLink tmp liftIO $ removeWhenExistsWith R.removeLink tmp
sink b sink b
byteRetriever go basek p c byteRetriever go basek p c

View file

@ -51,6 +51,7 @@ import Messages.Progress
import qualified Git import qualified Git
import qualified Git.Construct import qualified Git.Construct
import Git.Types import Git.Types
import qualified Utility.RawFilePath as R
import qualified Data.ByteString as S import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
@ -284,10 +285,10 @@ sink dest enc c mh mp content = case (enc, mh, content) of
withBytes content $ \b -> withBytes content $ \b ->
decrypt cmd c cipher (feedBytes b) $ decrypt cmd c cipher (feedBytes b) $
readBytes write readBytes write
liftIO $ removeWhenExistsWith removeLink f liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
(Nothing, _, FileContent f) -> do (Nothing, _, FileContent f) -> do
withBytes content write withBytes content write
liftIO $ removeWhenExistsWith removeLink f liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
(Nothing, _, ByteContent b) -> write b (Nothing, _, ByteContent b) -> write b
where where
write b = case mh of write b = case mh of

10
Test.hs
View file

@ -412,7 +412,7 @@ test_ignore_deleted_files :: Assertion
test_ignore_deleted_files = intmpclonerepo $ do test_ignore_deleted_files = intmpclonerepo $ do
git_annex "get" [annexedfile] @? "get failed" git_annex "get" [annexedfile] @? "get failed"
git_annex_expectoutput "find" [] [annexedfile] git_annex_expectoutput "find" [] [annexedfile]
removeWhenExistsWith removeLink annexedfile removeWhenExistsWith R.removeLink (toRawFilePath annexedfile)
-- A file that has been deleted, but the deletion not staged, -- A file that has been deleted, but the deletion not staged,
-- is a special case; make sure git-annex skips these. -- is a special case; make sure git-annex skips these.
git_annex_expectoutput "find" [] [] git_annex_expectoutput "find" [] []
@ -1332,7 +1332,7 @@ test_remove_conflict_resolution = do
@? "unlock conflictor failed" @? "unlock conflictor failed"
writecontent conflictor "newconflictor" writecontent conflictor "newconflictor"
indir r1 $ indir r1 $
removeWhenExistsWith removeLink conflictor removeWhenExistsWith R.removeLink (toRawFilePath conflictor)
let l = if inr1 then [r1, r2, r1] else [r2, r1, r2] let l = if inr1 then [r1, r2, r1] else [r2, r1, r2]
forM_ l $ \r -> indir r $ forM_ l $ \r -> indir r $
git_annex "sync" [] @? "sync failed" git_annex "sync" [] @? "sync failed"
@ -1861,7 +1861,7 @@ test_export_import = intmpclonerepo $ do
git_annex "merge" ["foo/" ++ origbranch] @? "git annex merge failed" git_annex "merge" ["foo/" ++ origbranch] @? "git annex merge failed"
annexed_present_imported "import" annexed_present_imported "import"
removeWhenExistsWith removeLink "import" removeWhenExistsWith R.removeLink (toRawFilePath "import")
writecontent "import" (content "newimport1") writecontent "import" (content "newimport1")
git_annex "add" ["import"] @? "add of import failed" git_annex "add" ["import"] @? "add of import failed"
commitchanges commitchanges
@ -1870,7 +1870,7 @@ test_export_import = intmpclonerepo $ do
-- verify that export refuses to overwrite modified file -- verify that export refuses to overwrite modified file
writedir "import" (content "newimport2") writedir "import" (content "newimport2")
removeWhenExistsWith removeLink "import" removeWhenExistsWith R.removeLink (toRawFilePath "import")
writecontent "import" (content "newimport3") writecontent "import" (content "newimport3")
git_annex "add" ["import"] @? "add of import failed" git_annex "add" ["import"] @? "add of import failed"
commitchanges commitchanges
@ -1880,7 +1880,7 @@ test_export_import = intmpclonerepo $ do
-- resolving import conflict -- resolving import conflict
git_annex "import" [origbranch, "--from", "foo"] @? "import from dir failed" git_annex "import" [origbranch, "--from", "foo"] @? "import from dir failed"
not <$> boolSystem "git" [Param "merge", Param "foo/master", Param "-mmerge"] @? "git merge of conflict failed to exit nonzero" not <$> boolSystem "git" [Param "merge", Param "foo/master", Param "-mmerge"] @? "git merge of conflict failed to exit nonzero"
removeWhenExistsWith removeLink "import" removeWhenExistsWith R.removeLink (toRawFilePath "import")
writecontent "import" (content "newimport3") writecontent "import" (content "newimport3")
git_annex "add" ["import"] @? "add of import failed" git_annex "add" ["import"] @? "add of import failed"
commitchanges commitchanges

View file

@ -32,6 +32,7 @@ import Git.Ref
import Utility.InodeCache import Utility.InodeCache
import Utility.DottedVersion import Utility.DottedVersion
import Annex.AdjustedBranch import Annex.AdjustedBranch
import qualified Utility.RawFilePath as R
import qualified Data.ByteString as S import qualified Data.ByteString as S
@ -156,7 +157,7 @@ upgradeDirectWorkTree = do
) )
writepointer f k = liftIO $ do writepointer f k = liftIO $ do
removeWhenExistsWith removeLink f removeWhenExistsWith R.removeLink (toRawFilePath f)
S.writeFile f (formatPointer k) S.writeFile f (formatPointer k)
{- Remove all direct mode bookkeeping files. -} {- Remove all direct mode bookkeeping files. -}

View file

@ -16,7 +16,7 @@ module Utility.Directory (
import Control.Monad import Control.Monad
import System.FilePath import System.FilePath
import System.PosixCompat.Files import System.PosixCompat.Files hiding (removeLink)
import Control.Applicative import Control.Applicative
import System.IO.Unsafe (unsafeInterleaveIO) import System.IO.Unsafe (unsafeInterleaveIO)
import Data.Maybe import Data.Maybe

View file

@ -16,7 +16,7 @@ module Utility.FileMode (
import System.IO import System.IO
import Control.Monad import Control.Monad
import System.PosixCompat.Types import System.PosixCompat.Types
import System.PosixCompat.Files import System.PosixCompat.Files hiding (removeLink)
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Foreign (complement) import Foreign (complement)
import Control.Monad.Catch import Control.Monad.Catch

View file

@ -14,7 +14,7 @@ module Utility.FileSize (
getFileSize', getFileSize',
) where ) where
import System.PosixCompat.Files import System.PosixCompat.Files hiding (removeLink)
import qualified Utility.RawFilePath as R import qualified Utility.RawFilePath as R
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
import Control.Exception (bracket) import Control.Exception (bracket)

View file

@ -15,7 +15,7 @@ module Utility.MoveFile (
import Control.Monad import Control.Monad
import System.FilePath import System.FilePath
import System.PosixCompat.Files import System.PosixCompat.Files hiding (removeLink)
import System.IO.Error import System.IO.Error
import Prelude import Prelude

View file

@ -20,7 +20,7 @@ import System.IO
import System.FilePath import System.FilePath
import System.Directory import System.Directory
import Control.Monad.IO.Class import Control.Monad.IO.Class
import System.PosixCompat.Files import System.PosixCompat.Files hiding (removeLink)
import Utility.Exception import Utility.Exception
import Utility.FileSystemEncoding import Utility.FileSystemEncoding