finished this stage of the RawFilePath conversion
This commit was sponsored by Denis Dzyubenko on Patreon.
This commit is contained in:
parent
2c8cf06e75
commit
1db49497e0
27 changed files with 100 additions and 93 deletions
|
@ -296,7 +296,7 @@ preventCommits = bracket setup cleanup
|
|||
where
|
||||
setup = do
|
||||
lck <- fromRepo $ indexFileLock . indexFile
|
||||
liftIO $ Git.LockFile.openLock lck
|
||||
liftIO $ Git.LockFile.openLock (fromRawFilePath lck)
|
||||
cleanup = liftIO . Git.LockFile.closeLock
|
||||
|
||||
{- Commits a given adjusted tree, with the provided parent ref.
|
||||
|
|
|
@ -225,11 +225,9 @@ lockContentForRemoval key fallback a = lockContentUsing lock key fallback $
|
|||
{- Since content files are stored with the write bit disabled, have
|
||||
- to fiddle with permissions to open for an exclusive lock. -}
|
||||
lock contentfile Nothing = bracket_
|
||||
(thawContent contentfile')
|
||||
(freezeContent contentfile')
|
||||
(thawContent contentfile)
|
||||
(freezeContent contentfile)
|
||||
(tryLockExclusive Nothing contentfile)
|
||||
where
|
||||
contentfile' = fromRawFilePath contentfile
|
||||
lock _ (Just lockfile) = posixLocker tryLockExclusive lockfile
|
||||
#else
|
||||
lock = winLocker lockExclusive
|
||||
|
@ -435,16 +433,14 @@ shouldVerify (RemoteVerify r) =
|
|||
checkDiskSpaceToGet :: Key -> a -> Annex a -> Annex a
|
||||
checkDiskSpaceToGet key unabletoget getkey = do
|
||||
tmp <- fromRepo (gitAnnexTmpObjectLocation key)
|
||||
let tmp' = fromRawFilePath tmp
|
||||
|
||||
e <- liftIO $ doesFileExist tmp'
|
||||
e <- liftIO $ doesFileExist (fromRawFilePath tmp)
|
||||
alreadythere <- liftIO $ if e
|
||||
then getFileSize tmp
|
||||
else return 0
|
||||
ifM (checkDiskSpace Nothing key alreadythere True)
|
||||
( do
|
||||
-- The tmp file may not have been left writable
|
||||
when e $ thawContent tmp'
|
||||
when e $ thawContent tmp
|
||||
getkey
|
||||
, return unabletoget
|
||||
)
|
||||
|
@ -505,7 +501,7 @@ moveAnnex key src = ifM (checkSecureHashes' key)
|
|||
storeobject dest = ifM (liftIO $ R.doesPathExist dest)
|
||||
( alreadyhave
|
||||
, modifyContent dest $ do
|
||||
freezeContent (fromRawFilePath src)
|
||||
freezeContent src
|
||||
liftIO $ moveFile
|
||||
(fromRawFilePath src)
|
||||
(fromRawFilePath dest)
|
||||
|
@ -581,11 +577,9 @@ linkAnnex fromto key src (Just srcic) dest destmode =
|
|||
Nothing -> failed
|
||||
Just r -> do
|
||||
case fromto of
|
||||
From -> thawContent $
|
||||
fromRawFilePath dest
|
||||
From -> thawContent dest
|
||||
To -> case r of
|
||||
Copied -> freezeContent $
|
||||
fromRawFilePath dest
|
||||
Copied -> freezeContent dest
|
||||
Linked -> noop
|
||||
checksrcunchanged
|
||||
where
|
||||
|
@ -691,7 +685,7 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file ->
|
|||
-- If it was a hard link to the annex object,
|
||||
-- that object might have been frozen as part of the
|
||||
-- removal process, so thaw it.
|
||||
, void $ tryIO $ thawContent $ fromRawFilePath file
|
||||
, void $ tryIO $ thawContent file
|
||||
)
|
||||
|
||||
{- Check if a file contains the unmodified content of the key.
|
||||
|
@ -764,7 +758,7 @@ listKeys keyloc = do
|
|||
-}
|
||||
s <- Annex.getState id
|
||||
depth <- gitAnnexLocationDepth <$> Annex.getGitConfig
|
||||
liftIO $ walk s depth dir
|
||||
liftIO $ walk s depth (fromRawFilePath dir)
|
||||
where
|
||||
walk s depth dir = do
|
||||
contents <- catchDefaultIO [] (dirContents dir)
|
||||
|
@ -829,7 +823,7 @@ preseedTmp key file = go =<< inAnnex key
|
|||
go False = return False
|
||||
go True = do
|
||||
ok <- copy
|
||||
when ok $ thawContent file
|
||||
when ok $ thawContent (toRawFilePath file)
|
||||
return ok
|
||||
copy = ifM (liftIO $ doesFileExist file)
|
||||
( return True
|
||||
|
@ -912,7 +906,7 @@ withTmpWorkDir key action = do
|
|||
let obj' = fromRawFilePath obj
|
||||
unlessM (liftIO $ doesFileExist obj') $ do
|
||||
liftIO $ writeFile obj' ""
|
||||
setAnnexFilePerm obj'
|
||||
setAnnexFilePerm obj
|
||||
let tmpdir = gitAnnexTmpWorkDir obj
|
||||
createAnnexDirectory tmpdir
|
||||
res <- action tmpdir
|
||||
|
|
|
@ -107,7 +107,7 @@ lockDown' cfg file = tryIO $ ifM crippledFileSystem
|
|||
|
||||
withhardlink tmpdir = do
|
||||
when (lockingFile cfg) $
|
||||
freezeContent file
|
||||
freezeContent file'
|
||||
withTSDelta $ \delta -> liftIO $ do
|
||||
(tmpfile, h) <- openTempFile (fromRawFilePath tmpdir) $
|
||||
relatedTemplate $ "ingest-" ++ takeFileName file
|
||||
|
@ -181,7 +181,7 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage =
|
|||
populateAssociatedFiles key source restage
|
||||
success key mcache s
|
||||
Right False -> giveup "failed to add content to annex"
|
||||
Left e -> restoreFile (fromRawFilePath $ keyFilename source) key e
|
||||
Left e -> restoreFile (keyFilename source) key e
|
||||
|
||||
gounlocked key (Just cache) s = do
|
||||
-- Remove temp directory hard link first because
|
||||
|
@ -259,21 +259,21 @@ cleanOldKeys file newkey = do
|
|||
|
||||
{- On error, put the file back so it doesn't seem to have vanished.
|
||||
- This can be called before or after the symlink is in place. -}
|
||||
restoreFile :: FilePath -> Key -> SomeException -> Annex a
|
||||
restoreFile :: RawFilePath -> Key -> SomeException -> Annex a
|
||||
restoreFile file key e = do
|
||||
whenM (inAnnex key) $ do
|
||||
liftIO $ removeWhenExistsWith removeLink file
|
||||
liftIO $ removeWhenExistsWith R.removeLink file
|
||||
-- The key could be used by other files too, so leave the
|
||||
-- content in the annex, and make a copy back to the file.
|
||||
obj <- fromRawFilePath <$> calcRepo (gitAnnexLocation key)
|
||||
unlessM (liftIO $ copyFileExternal CopyTimeStamps obj file) $
|
||||
warning $ "Unable to restore content of " ++ file ++ "; it should be located in " ++ obj
|
||||
unlessM (liftIO $ copyFileExternal CopyTimeStamps obj (fromRawFilePath file)) $
|
||||
warning $ "Unable to restore content of " ++ fromRawFilePath file ++ "; it should be located in " ++ obj
|
||||
thawContent file
|
||||
throwM e
|
||||
|
||||
{- Creates the symlink to the annexed content, returns the link target. -}
|
||||
makeLink :: RawFilePath -> Key -> Maybe InodeCache -> Annex LinkTarget
|
||||
makeLink file key mcache = flip catchNonAsync (restoreFile file' key) $ do
|
||||
makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do
|
||||
l <- calcRepo $ gitAnnexLink file key
|
||||
replaceWorkTreeFile file' $ makeAnnexLink l . toRawFilePath
|
||||
|
||||
|
|
|
@ -204,7 +204,7 @@ probeCrippledFileSystem' tmp = do
|
|||
let f = fromRawFilePath (tmp P.</> "gaprobe")
|
||||
writeFile f ""
|
||||
r <- probe f
|
||||
void $ tryIO $ allowWrite f
|
||||
void $ tryIO $ allowWrite (toRawFilePath f)
|
||||
removeFile f
|
||||
return r
|
||||
where
|
||||
|
@ -213,7 +213,7 @@ probeCrippledFileSystem' tmp = do
|
|||
removeWhenExistsWith removeLink f2
|
||||
createSymbolicLink f f2
|
||||
removeWhenExistsWith removeLink f2
|
||||
preventWrite f
|
||||
preventWrite (toRawFilePath f)
|
||||
-- Should be unable to write to the file, unless
|
||||
-- running as root, but some crippled
|
||||
-- filesystems ignore write bit removals.
|
||||
|
|
|
@ -84,7 +84,8 @@ createInodeSentinalFile evenwithobjects =
|
|||
alreadyexists = liftIO. sentinalFileExists =<< annexSentinalFile
|
||||
hasobjects
|
||||
| evenwithobjects = pure False
|
||||
| otherwise = liftIO . doesDirectoryExist =<< fromRepo gitAnnexObjectDir
|
||||
| otherwise = liftIO . doesDirectoryExist . fromRawFilePath
|
||||
=<< fromRepo gitAnnexObjectDir
|
||||
|
||||
annexSentinalFile :: Annex SentinalFile
|
||||
annexSentinalFile = do
|
||||
|
|
|
@ -263,9 +263,9 @@ gitAnnexDir :: Git.Repo -> RawFilePath
|
|||
gitAnnexDir r = P.addTrailingPathSeparator $ Git.localGitDir r P.</> annexDir
|
||||
|
||||
{- The part of the annex directory where file contents are stored. -}
|
||||
gitAnnexObjectDir :: Git.Repo -> FilePath
|
||||
gitAnnexObjectDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ Git.localGitDir r P.</> objectDir'
|
||||
gitAnnexObjectDir :: Git.Repo -> RawFilePath
|
||||
gitAnnexObjectDir r = P.addTrailingPathSeparator $
|
||||
Git.localGitDir r P.</> objectDir'
|
||||
|
||||
{- .git/annex/tmp/ is used for temp files for key's contents -}
|
||||
gitAnnexTmpObjectDir :: Git.Repo -> RawFilePath
|
||||
|
|
|
@ -33,6 +33,7 @@ import Logs.View
|
|||
import Utility.Glob
|
||||
import Types.Command
|
||||
import CmdLine.Action
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.ByteString as B
|
||||
|
@ -353,7 +354,7 @@ applyView' :: MkViewedFile -> (FilePath -> MetaData) -> View -> Annex Git.Branch
|
|||
applyView' mkviewedfile getfilemetadata view = do
|
||||
top <- fromRepo Git.repoPath
|
||||
(l, clean) <- inRepo $ Git.LsFiles.inRepoDetails [] [top]
|
||||
liftIO . removeWhenExistsWith removeLink =<< fromRepo gitAnnexViewIndex
|
||||
liftIO . removeWhenExistsWith R.removeLink =<< fromRepo gitAnnexViewIndex
|
||||
viewg <- withViewIndex gitRepo
|
||||
withUpdateIndex viewg $ \uh -> do
|
||||
forM_ l $ \(f, sha, mode) -> do
|
||||
|
|
|
@ -103,7 +103,8 @@ installWrapper file content = do
|
|||
when (curr /= content) $ do
|
||||
createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath file)))
|
||||
viaTmp writeFile file content
|
||||
modifyFileMode file $ addModes [ownerExecuteMode]
|
||||
modifyFileMode (toRawFilePath file) $
|
||||
addModes [ownerExecuteMode]
|
||||
|
||||
installFileManagerHooks :: FilePath -> IO ()
|
||||
#ifdef linux_HOST_OS
|
||||
|
@ -132,7 +133,7 @@ installFileManagerHooks program = unlessM osAndroid $ do
|
|||
scriptname action = "git-annex " ++ action
|
||||
installscript f c = whenM (safetoinstallscript f) $ do
|
||||
writeFile f c
|
||||
modifyFileMode f $ addModes [ownerExecuteMode]
|
||||
modifyFileMode (toRawFilePath f) $ addModes [ownerExecuteMode]
|
||||
safetoinstallscript f = catchDefaultIO True $
|
||||
elem autoaddedcomment . lines <$> readFileStrict f
|
||||
autoaddedcomment = "# " ++ autoaddedmsg ++ " (To disable, chmod 600 this file.)"
|
||||
|
|
|
@ -42,6 +42,7 @@ import Types.Transfer
|
|||
import Annex.Path
|
||||
import Annex.Tmp
|
||||
import qualified Annex
|
||||
import qualified Utility.RawFilePath as R
|
||||
#ifdef WITH_WEBAPP
|
||||
import Assistant.WebApp.Types
|
||||
#endif
|
||||
|
@ -66,7 +67,7 @@ sanityCheckerStartupThread startupdelay = namedThreadUnchecked "SanityCheckerSta
|
|||
ifM (not <$> liftAnnex (inRepo checkIndexFast))
|
||||
( do
|
||||
notice ["corrupt index file found at startup; removing and restaging"]
|
||||
liftAnnex $ inRepo $ removeWhenExistsWith removeLink . indexFile
|
||||
liftAnnex $ inRepo $ removeWhenExistsWith R.removeLink . indexFile
|
||||
{- Normally the startup scan avoids re-staging files,
|
||||
- but with the index deleted, everything needs to be
|
||||
- restaged. -}
|
||||
|
@ -80,7 +81,7 @@ sanityCheckerStartupThread startupdelay = namedThreadUnchecked "SanityCheckerSta
|
|||
- will be automatically regenerated. -}
|
||||
unlessM (liftAnnex $ Annex.Branch.withIndex $ inRepo $ Git.Repair.checkIndexFast) $ do
|
||||
notice ["corrupt annex/index file found at startup; removing"]
|
||||
liftAnnex $ liftIO . removeWhenExistsWith removeLink =<< fromRepo gitAnnexIndex
|
||||
liftAnnex $ liftIO . removeWhenExistsWith R.removeLink =<< fromRepo gitAnnexIndex
|
||||
|
||||
{- Fix up ssh remotes set up by past versions of the assistant. -}
|
||||
liftIO $ fixUpSshRemotes
|
||||
|
|
|
@ -93,7 +93,7 @@ webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost
|
|||
urlfile <- getAnnex' $ fromRepo gitAnnexUrlFile
|
||||
go tlssettings addr webapp
|
||||
(fromRawFilePath htmlshim)
|
||||
(Just (fromRawFilePath urlfile))
|
||||
(Just urlfile)
|
||||
where
|
||||
-- The webapp thread does not wait for the startupSanityCheckThread
|
||||
-- to finish, so that the user interface remains responsive while
|
||||
|
|
|
@ -391,7 +391,7 @@ sshAuthTranscript sshinput opts sshhost cmd input = case inputAuthMethod sshinpu
|
|||
Nothing -> go [passwordprompts 0] Nothing
|
||||
Just pass -> withTmpFile "ssh" $ \passfile h -> do
|
||||
hClose h
|
||||
writeFileProtected passfile pass
|
||||
writeFileProtected (toRawFilePath passfile) pass
|
||||
environ <- getEnvironment
|
||||
let environ' = addEntries
|
||||
[ ("SSH_ASKPASS", program)
|
||||
|
|
|
@ -72,12 +72,12 @@ start fixwhat si file key = do
|
|||
breakHardLink :: RawFilePath -> Key -> RawFilePath -> CommandPerform
|
||||
breakHardLink file key obj = do
|
||||
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
|
||||
let tmp' = toRawFilePath tmp
|
||||
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
|
||||
let obj' = fromRawFilePath obj
|
||||
unlessM (checkedCopyFile key obj' tmp mode) $
|
||||
unlessM (checkedCopyFile key obj tmp' mode) $
|
||||
error "unable to break hard link"
|
||||
thawContent tmp
|
||||
modifyContent obj $ freezeContent obj'
|
||||
thawContent tmp'
|
||||
modifyContent obj $ freezeContent obj
|
||||
Database.Keys.storeInodeCaches key [file]
|
||||
next $ return True
|
||||
|
||||
|
|
|
@ -183,7 +183,7 @@ performRemote key afile backend numcopies remote =
|
|||
let cleanup = liftIO $ catchIO (R.removeLink tmp) (const noop)
|
||||
cleanup
|
||||
cleanup `after` a tmp
|
||||
getfile tmp = ifM (checkDiskSpace (Just (fromRawFilePath (P.takeDirectory tmp))) key 0 True)
|
||||
getfile tmp = ifM (checkDiskSpace (Just (P.takeDirectory tmp)) key 0 True)
|
||||
( ifM (getcheap tmp)
|
||||
( return (Just True)
|
||||
, ifM (Annex.getState Annex.fast)
|
||||
|
@ -251,9 +251,9 @@ verifyLocationLog key keystatus ai = do
|
|||
- in a permission fixup here too. -}
|
||||
when present $ do
|
||||
void $ tryIO $ case keystatus of
|
||||
KeyUnlockedThin -> thawContent (fromRawFilePath obj)
|
||||
KeyLockedThin -> thawContent (fromRawFilePath obj)
|
||||
_ -> freezeContent (fromRawFilePath obj)
|
||||
KeyUnlockedThin -> thawContent obj
|
||||
KeyLockedThin -> thawContent obj
|
||||
_ -> freezeContent obj
|
||||
unlessM (isContentWritePermOk obj) $
|
||||
warning $ "** Unable to set correct write mode for " ++ fromRawFilePath obj ++ " ; perhaps you don't own that file"
|
||||
whenM (liftIO $ R.doesPathExist $ parentDir obj) $
|
||||
|
@ -346,13 +346,14 @@ verifyWorkTree key file = do
|
|||
Just k | k == key -> whenM (inAnnex key) $ do
|
||||
showNote "fixing worktree content"
|
||||
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
|
||||
let tmp' = toRawFilePath tmp
|
||||
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
|
||||
ifM (annexThin <$> Annex.getGitConfig)
|
||||
( void $ linkFromAnnex key (toRawFilePath tmp) mode
|
||||
( void $ linkFromAnnex key tmp' mode
|
||||
, do
|
||||
obj <- fromRawFilePath <$> calcRepo (gitAnnexLocation key)
|
||||
void $ checkedCopyFile key obj tmp mode
|
||||
thawContent tmp
|
||||
obj <- calcRepo (gitAnnexLocation key)
|
||||
void $ checkedCopyFile key obj tmp' mode
|
||||
thawContent tmp'
|
||||
)
|
||||
Database.Keys.storeInodeCaches key [file]
|
||||
_ -> return ()
|
||||
|
@ -586,17 +587,16 @@ recordFsckTime inc key = withFsckDb inc $ \h -> liftIO $ FsckDb.addDb h key
|
|||
recordStartTime :: UUID -> Annex ()
|
||||
recordStartTime u = do
|
||||
f <- fromRepo (gitAnnexFsckState u)
|
||||
let f' = fromRawFilePath f
|
||||
createAnnexDirectory $ parentDir f
|
||||
liftIO $ removeWhenExistsWith R.removeLink f
|
||||
liftIO $ withFile f' WriteMode $ \h -> do
|
||||
liftIO $ withFile (fromRawFilePath f) WriteMode $ \h -> do
|
||||
#ifndef mingw32_HOST_OS
|
||||
t <- modificationTime <$> R.getFileStatus f
|
||||
#else
|
||||
t <- getPOSIXTime
|
||||
#endif
|
||||
hPutStr h $ showTime $ realToFrac t
|
||||
setAnnexFilePerm f'
|
||||
setAnnexFilePerm f
|
||||
where
|
||||
showTime :: POSIXTime -> String
|
||||
showTime = show
|
||||
|
|
|
@ -70,16 +70,15 @@ perform file key = do
|
|||
, repopulate obj
|
||||
)
|
||||
whenM (liftIO $ R.doesPathExist obj) $
|
||||
freezeContent $ fromRawFilePath obj
|
||||
freezeContent obj
|
||||
|
||||
-- It's ok if the file is hard linked to obj, but if some other
|
||||
-- associated file is, we need to break that link to lock down obj.
|
||||
breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (R.getFileStatus obj)) $ do
|
||||
mfc <- withTSDelta (liftIO . genInodeCache file)
|
||||
unlessM (sameInodeCache obj (maybeToList mfc)) $ do
|
||||
let obj' = fromRawFilePath obj
|
||||
modifyContent obj $ replaceGitAnnexDirFile obj' $ \tmp -> do
|
||||
unlessM (checkedCopyFile key obj' tmp Nothing) $
|
||||
modifyContent obj $ replaceGitAnnexDirFile (fromRawFilePath obj) $ \tmp -> do
|
||||
unlessM (checkedCopyFile key obj (toRawFilePath tmp) Nothing) $
|
||||
giveup "unable to lock file"
|
||||
Database.Keys.storeInodeCaches key [obj]
|
||||
|
||||
|
@ -92,7 +91,7 @@ perform file key = do
|
|||
liftIO $ removeWhenExistsWith R.removeLink obj
|
||||
case mfile of
|
||||
Just unmodified ->
|
||||
unlessM (checkedCopyFile key (fromRawFilePath unmodified) (fromRawFilePath obj) Nothing)
|
||||
unlessM (checkedCopyFile key unmodified obj Nothing)
|
||||
lostcontent
|
||||
Nothing -> lostcontent
|
||||
|
||||
|
|
|
@ -220,11 +220,11 @@ wormholePairing remotename ouraddrs ui = do
|
|||
-- to read them. So, set up a temp directory that only
|
||||
-- we can read.
|
||||
withTmpDir "pair" $ \tmp -> do
|
||||
liftIO $ void $ tryIO $ modifyFileMode tmp $
|
||||
liftIO $ void $ tryIO $ modifyFileMode (toRawFilePath tmp) $
|
||||
removeModes otherGroupModes
|
||||
let sendf = tmp </> "send"
|
||||
let recvf = tmp </> "recv"
|
||||
liftIO $ writeFileProtected sendf $
|
||||
liftIO $ writeFileProtected (toRawFilePath sendf) $
|
||||
serializePairData ourpairdata
|
||||
|
||||
observer <- liftIO Wormhole.mkCodeObserver
|
||||
|
|
|
@ -96,15 +96,16 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
|
|||
, do
|
||||
{- The file being rekeyed is itself an unlocked file; if
|
||||
- it's hard linked to the old key, that link must be broken. -}
|
||||
oldobj <- fromRawFilePath <$> calcRepo (gitAnnexLocation oldkey)
|
||||
oldobj <- calcRepo (gitAnnexLocation oldkey)
|
||||
v <- tryNonAsync $ do
|
||||
st <- liftIO $ R.getFileStatus file
|
||||
when (linkCount st > 1) $ do
|
||||
freezeContent oldobj
|
||||
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
|
||||
unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $
|
||||
let tmp' = toRawFilePath tmp
|
||||
unlessM (checkedCopyFile oldkey oldobj tmp' Nothing) $
|
||||
error "can't lock old key"
|
||||
thawContent tmp
|
||||
thawContent tmp'
|
||||
ic <- withTSDelta (liftIO . genInodeCache file)
|
||||
case v of
|
||||
Left e -> do
|
||||
|
|
|
@ -14,6 +14,7 @@ import qualified Annex.Branch
|
|||
import qualified Git.Ref
|
||||
import Git.Types
|
||||
import Annex.Version
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
cmd :: Command
|
||||
cmd = noCommit $ dontCheck repoExists $
|
||||
|
@ -75,7 +76,7 @@ repairAnnexBranch modifiedbranches
|
|||
Annex.Branch.forceCommit "committing index after git repository repair"
|
||||
liftIO $ putStrLn "Successfully recovered the git-annex branch using .git/annex/index"
|
||||
nukeindex = do
|
||||
inRepo $ removeWhenExistsWith removeLink . gitAnnexIndex
|
||||
inRepo $ removeWhenExistsWith R.removeLink . gitAnnexIndex
|
||||
liftIO $ putStrLn "Had to delete the .git/annex/index file as it was corrupt."
|
||||
missingbranch = liftIO $ putStrLn "Since the git-annex branch is not up-to-date anymore. It would be a very good idea to run: git annex fsck --fast"
|
||||
|
||||
|
|
|
@ -14,6 +14,7 @@ import qualified Git.Command
|
|||
import Utility.CopyFile
|
||||
import qualified Database.Keys
|
||||
import Git.FilePath
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
cmd :: Command
|
||||
cmd = withGlobalOptions [annexedMatchingOptions] $
|
||||
|
@ -54,7 +55,7 @@ perform file key = do
|
|||
cleanup :: RawFilePath -> Key -> CommandCleanup
|
||||
cleanup file key = do
|
||||
Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file)
|
||||
src <- fromRawFilePath <$> calcRepo (gitAnnexLocation key)
|
||||
src <- calcRepo (gitAnnexLocation key)
|
||||
ifM (Annex.getState Annex.fast)
|
||||
( do
|
||||
-- Only make a hard link if the annexed file does not
|
||||
|
@ -62,19 +63,21 @@ cleanup file key = do
|
|||
-- This avoids unannexing (and uninit) ending up
|
||||
-- hard linking files together, which would be
|
||||
-- surprising.
|
||||
s <- liftIO $ getFileStatus src
|
||||
s <- liftIO $ R.getFileStatus src
|
||||
if linkCount s > 1
|
||||
then copyfrom src
|
||||
else hardlinkfrom src
|
||||
, copyfrom src
|
||||
)
|
||||
where
|
||||
file' = fromRawFilePath file
|
||||
copyfrom src =
|
||||
thawContent file' `after` liftIO (copyFileExternal CopyAllMetaData src file')
|
||||
thawContent file `after` liftIO
|
||||
(copyFileExternal CopyAllMetaData
|
||||
(fromRawFilePath src)
|
||||
(fromRawFilePath file))
|
||||
hardlinkfrom src =
|
||||
-- creating a hard link could fall; fall back to copying
|
||||
ifM (liftIO $ catchBoolIO $ createLink src file' >> return True)
|
||||
ifM (liftIO $ catchBoolIO $ R.createLink src file >> return True)
|
||||
( return True
|
||||
, copyfrom src
|
||||
)
|
||||
|
|
|
@ -73,7 +73,7 @@ finish = do
|
|||
then liftIO $ removeDirectoryRecursive annexdir
|
||||
else giveup $ unlines
|
||||
[ "Not fully uninitialized"
|
||||
, "Some annexed data is still left in " ++ annexobjectdir
|
||||
, "Some annexed data is still left in " ++ fromRawFilePath annexobjectdir
|
||||
, "This may include deleted files, or old versions of modified files."
|
||||
, ""
|
||||
, "If you don't care about preserving the data, just delete the"
|
||||
|
@ -108,7 +108,7 @@ prepareRemoveAnnexDir annexdir = do
|
|||
prepareRemoveAnnexDir' :: FilePath -> IO ()
|
||||
prepareRemoveAnnexDir' annexdir =
|
||||
dirTreeRecursiveSkipping (const False) annexdir
|
||||
>>= mapM_ (void . tryIO . allowWrite)
|
||||
>>= mapM_ (void . tryIO . allowWrite . toRawFilePath)
|
||||
|
||||
{- Keys that were moved out of the annex have a hard link still in the
|
||||
- annex, with > 1 link count, and those can be removed.
|
||||
|
|
|
@ -76,7 +76,7 @@ AnnexBranch
|
|||
-}
|
||||
openDb :: Annex ContentIdentifierHandle
|
||||
openDb = do
|
||||
dbdir <- fromRawFilePath <$> fromRepo gitAnnexContentIdentifierDbDir
|
||||
dbdir <- fromRepo gitAnnexContentIdentifierDbDir
|
||||
let db = dbdir P.</> "db"
|
||||
unlessM (liftIO $ R.doesPathExist db) $ do
|
||||
initDb db $ void $
|
||||
|
|
|
@ -208,7 +208,7 @@ downloadTorrentFile u = do
|
|||
else withOtherTmp $ \othertmp -> do
|
||||
withTmpFileIn (fromRawFilePath othertmp) "torrent" $ \f h -> do
|
||||
liftIO $ hClose h
|
||||
resetAnnexFilePerm f
|
||||
resetAnnexFilePerm (toRawFilePath f)
|
||||
ok <- Url.withUrlOptions $
|
||||
Url.download nullMeterUpdate u f
|
||||
when ok $
|
||||
|
|
|
@ -166,18 +166,18 @@ storeDir d k = P.addTrailingPathSeparator $
|
|||
- store the key. Note that the unencrypted key size is checked. -}
|
||||
storeKeyM :: RawFilePath -> ChunkConfig -> Storer
|
||||
storeKeyM d chunkconfig k c m =
|
||||
ifM (checkDiskSpaceDirectory (fromRawFilePath d) k)
|
||||
ifM (checkDiskSpaceDirectory d k)
|
||||
( byteStorer (store d chunkconfig) k c m
|
||||
, giveup "Not enough free disk space."
|
||||
)
|
||||
|
||||
checkDiskSpaceDirectory :: FilePath -> Key -> Annex Bool
|
||||
checkDiskSpaceDirectory :: RawFilePath -> Key -> Annex Bool
|
||||
checkDiskSpaceDirectory d k = do
|
||||
annexdir <- fromRepo gitAnnexObjectDir
|
||||
samefilesystem <- liftIO $ catchDefaultIO False $
|
||||
(\a b -> deviceID a == deviceID b)
|
||||
<$> getFileStatus d
|
||||
<*> getFileStatus annexdir
|
||||
<$> R.getFileStatus d
|
||||
<*> R.getFileStatus annexdir
|
||||
checkDiskSpace (Just d) k 0 samefilesystem
|
||||
|
||||
store :: RawFilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex ()
|
||||
|
@ -212,8 +212,8 @@ finalizeStoreGeneric d tmp dest = do
|
|||
renameDirectory (fromRawFilePath tmp) dest'
|
||||
-- may fail on some filesystems
|
||||
void $ tryIO $ do
|
||||
mapM_ preventWrite =<< dirContents dest'
|
||||
preventWrite dest'
|
||||
mapM_ (preventWrite . toRawFilePath) =<< dirContents dest'
|
||||
preventWrite dest
|
||||
where
|
||||
dest' = fromRawFilePath dest
|
||||
|
||||
|
@ -254,7 +254,7 @@ removeKeyM d k = liftIO $ removeDirGeneric
|
|||
-}
|
||||
removeDirGeneric :: FilePath -> FilePath -> IO ()
|
||||
removeDirGeneric topdir dir = do
|
||||
void $ tryIO $ allowWrite dir
|
||||
void $ tryIO $ allowWrite (toRawFilePath dir)
|
||||
#ifdef mingw32_HOST_OS
|
||||
{- Windows needs the files inside the directory to be writable
|
||||
- before it can delete them. -}
|
||||
|
@ -454,11 +454,12 @@ storeExportWithContentIdentifierM :: RawFilePath -> FilePath -> Key -> ExportLoc
|
|||
storeExportWithContentIdentifierM dir src _k loc overwritablecids p = do
|
||||
liftIO $ createDirectoryUnder dir (toRawFilePath destdir)
|
||||
withTmpFileIn destdir template $ \tmpf tmph -> do
|
||||
let tmpf' = toRawFilePath tmpf
|
||||
liftIO $ withMeteredFile src p (L.hPut tmph)
|
||||
liftIO $ hFlush tmph
|
||||
liftIO $ hClose tmph
|
||||
resetAnnexFilePerm tmpf
|
||||
liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier (toRawFilePath tmpf) >>= \case
|
||||
resetAnnexFilePerm tmpf'
|
||||
liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier tmpf' >>= \case
|
||||
Nothing -> giveup "unable to generate content identifier"
|
||||
Just newcid -> do
|
||||
checkExportContent dir loc
|
||||
|
|
|
@ -82,9 +82,10 @@ storeHelper repotop finalizer key storer tmpdir destdir = do
|
|||
Legacy.storeChunks key tmpdir destdir storer recorder (legacyFinalizer finalizer)
|
||||
where
|
||||
recorder f s = do
|
||||
void $ tryIO $ allowWrite f
|
||||
let f' = toRawFilePath f
|
||||
void $ tryIO $ allowWrite f'
|
||||
writeFile f s
|
||||
void $ tryIO $ preventWrite f
|
||||
void $ tryIO $ preventWrite f'
|
||||
|
||||
store :: FilePath -> ChunkSize -> (RawFilePath -> RawFilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO ()
|
||||
store repotop chunksize finalizer k b p = storeHelper repotop finalizer k $ \dests ->
|
||||
|
|
|
@ -820,7 +820,7 @@ rsyncOrCopyFile st rsyncparams src dest p =
|
|||
State _ _ (CopyCoWTried v) _ _ -> v
|
||||
dorsync = do
|
||||
-- dest may already exist, so make sure rsync can write to it
|
||||
void $ liftIO $ tryIO $ allowWrite dest
|
||||
void $ liftIO $ tryIO $ allowWrite (toRawFilePath dest)
|
||||
oh <- mkOutputHandlerQuiet
|
||||
Ssh.rsyncHelper oh (Just p) $
|
||||
rsyncparams ++ [File src, File dest]
|
||||
|
|
2
Test.hs
2
Test.hs
|
@ -868,7 +868,7 @@ test_fsck_basic = intmpclonerepo $ do
|
|||
where
|
||||
corrupt f = do
|
||||
git_annex "get" [f] @? "get of file failed"
|
||||
Utility.FileMode.allowWrite f
|
||||
Utility.FileMode.allowWrite (toRawFilePath f)
|
||||
writecontent f (changedcontent f)
|
||||
ifM (hasUnlockedFiles <$> getTestMode)
|
||||
( git_annex "fsck" [] @? "fsck failed on unlocked file with changed file content"
|
||||
|
|
|
@ -13,6 +13,7 @@ import Data.Default
|
|||
import Data.ByteString.Builder
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified System.FilePath.ByteString as P
|
||||
|
||||
import Annex.Common
|
||||
import Annex.Content
|
||||
|
@ -74,12 +75,13 @@ moveContent = do
|
|||
forM_ files move
|
||||
where
|
||||
move f = do
|
||||
let k = fileKey1 (takeFileName f)
|
||||
let d = fromRawFilePath $ parentDir $ toRawFilePath f
|
||||
let f' = toRawFilePath f
|
||||
let k = fileKey1 (fromRawFilePath (P.takeFileName f'))
|
||||
let d = parentDir f'
|
||||
liftIO $ allowWrite d
|
||||
liftIO $ allowWrite f
|
||||
_ <- moveAnnex k (toRawFilePath f)
|
||||
liftIO $ removeDirectory d
|
||||
liftIO $ allowWrite f'
|
||||
_ <- moveAnnex k f'
|
||||
liftIO $ removeDirectory (fromRawFilePath d)
|
||||
|
||||
updateSymlinks :: Annex ()
|
||||
updateSymlinks = do
|
||||
|
@ -215,7 +217,8 @@ lookupKey1 file = do
|
|||
" (unknown backend " ++ bname ++ ")"
|
||||
|
||||
getKeyFilesPresent1 :: Annex [FilePath]
|
||||
getKeyFilesPresent1 = getKeyFilesPresent1' =<< fromRepo gitAnnexObjectDir
|
||||
getKeyFilesPresent1 = getKeyFilesPresent1' . fromRawFilePath
|
||||
=<< fromRepo gitAnnexObjectDir
|
||||
getKeyFilesPresent1' :: FilePath -> Annex [FilePath]
|
||||
getKeyFilesPresent1' dir =
|
||||
ifM (liftIO $ doesDirectoryExist dir)
|
||||
|
|
|
@ -190,7 +190,7 @@ insertAuthToken extractAuthToken predicate webapp root pathbits params =
|
|||
- to avoid exposing the secret token when launching the web browser. -}
|
||||
writeHtmlShim :: String -> String -> FilePath -> IO ()
|
||||
writeHtmlShim title url file =
|
||||
viaTmp writeFileProtected (toRawFilePath file) $ genHtmlShim title url
|
||||
viaTmp (writeFileProtected . toRawFilePath) file $ genHtmlShim title url
|
||||
|
||||
genHtmlShim :: String -> String -> String
|
||||
genHtmlShim title url = unlines
|
||||
|
|
Loading…
Reference in a new issue