diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index af82cc3a57..3b35283c27 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -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. diff --git a/Annex/Content.hs b/Annex/Content.hs index 63e0122a92..a8bcd1666a 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -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 diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index e71b391cde..3fa601347f 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -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 diff --git a/Annex/Init.hs b/Annex/Init.hs index f92368c0c5..518af110e7 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -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. diff --git a/Annex/InodeSentinal.hs b/Annex/InodeSentinal.hs index c47603d184..1e841c633e 100644 --- a/Annex/InodeSentinal.hs +++ b/Annex/InodeSentinal.hs @@ -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 diff --git a/Annex/Locations.hs b/Annex/Locations.hs index 99ba18d542..482d2688ab 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -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 diff --git a/Annex/View.hs b/Annex/View.hs index ca11341dad..0648436c10 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -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 diff --git a/Assistant/Install.hs b/Assistant/Install.hs index 3b64526515..eecb891980 100644 --- a/Assistant/Install.hs +++ b/Assistant/Install.hs @@ -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.)" diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 21b4e2c9f6..191f814000 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -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 diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 9c367e0623..28c04dfc48 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -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 diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index 61c9847cc1..661ab95d1d 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -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) diff --git a/Command/Fix.hs b/Command/Fix.hs index 73401e726f..1b3cab9554 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -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 diff --git a/Command/Fsck.hs b/Command/Fsck.hs index fb0a3376da..067300162f 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -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 diff --git a/Command/Lock.hs b/Command/Lock.hs index 3f8672c08e..e7af74ca9f 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -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 diff --git a/Command/P2P.hs b/Command/P2P.hs index f503878aaa..d3eca898e1 100644 --- a/Command/P2P.hs +++ b/Command/P2P.hs @@ -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 diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 3054eb26af..4f325f4d87 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -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 diff --git a/Command/Repair.hs b/Command/Repair.hs index eed3fcb03b..343648851c 100644 --- a/Command/Repair.hs +++ b/Command/Repair.hs @@ -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" diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 1931c43412..0b383dd9b1 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -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 ) diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 5f15549690..3f648ec8a0 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -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. diff --git a/Database/ContentIdentifier.hs b/Database/ContentIdentifier.hs index 10f97172ac..0508a386e1 100644 --- a/Database/ContentIdentifier.hs +++ b/Database/ContentIdentifier.hs @@ -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 $ diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs index cf6a7c0d83..5280c872f6 100644 --- a/Remote/BitTorrent.hs +++ b/Remote/BitTorrent.hs @@ -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 $ diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 2deaa33edf..5c20894ee3 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -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 diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs index d89853b0af..3415037994 100644 --- a/Remote/Directory/LegacyChunked.hs +++ b/Remote/Directory/LegacyChunked.hs @@ -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 -> diff --git a/Remote/Git.hs b/Remote/Git.hs index d25ab6325b..97fee8cb92 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -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] diff --git a/Test.hs b/Test.hs index 42139831c6..66f504e072 100644 --- a/Test.hs +++ b/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" diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index cfc302e851..64a21e7f71 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -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) diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index 4bbec201a9..e6d0da4dee 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -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