finished this stage of the RawFilePath conversion

This commit was sponsored by Denis Dzyubenko on Patreon.
This commit is contained in:
Joey Hess 2020-11-06 14:10:58 -04:00
parent 2c8cf06e75
commit 1db49497e0
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
27 changed files with 100 additions and 93 deletions

View file

@ -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.

View file

@ -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

View file

@ -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

View file

@ -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.

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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.)"

View 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

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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"

View file

@ -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
)

View file

@ -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.

View file

@ -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 $

View file

@ -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 $

View file

@ -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

View file

@ -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 ->

View file

@ -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]

View file

@ -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"

View file

@ -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)

View file

@ -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