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:
parent
dce0781391
commit
a3b714ddd9
28 changed files with 73 additions and 64 deletions
|
@ -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
|
||||||
|
|
|
@ -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,
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
-
|
-
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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 $
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
8
Creds.hs
8
Creds.hs
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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,
|
||||||
|
|
|
@ -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 =
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
10
Test.hs
|
@ -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
|
||||||
|
|
|
@ -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. -}
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue