diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 99ea5a1025..5fcd9aedaf 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -5,6 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Remote.Directory ( @@ -15,6 +16,7 @@ module Remote.Directory ( import qualified Data.ByteString.Lazy as L import qualified Data.Map as M +import qualified System.FilePath.ByteString as P import Data.Default import Annex.Common @@ -25,7 +27,6 @@ import qualified Git import Config.Cost import Config import Annex.SpecialRemote.Config -import Utility.FileMode import Remote.Helper.Special import Remote.Helper.ExportImport import Types.Import @@ -35,10 +36,13 @@ import Annex.Perms import Annex.UUID import Backend import Types.KeySource +import Types.ProposedAccepted import Utility.Metered import Utility.Tmp import Utility.InodeCache -import Types.ProposedAccepted +import Utility.FileMode +import Utility.Directory.Create +import qualified Utility.RawFilePath as R remote :: RemoteType remote = specialRemoteType $ RemoteType @@ -106,20 +110,21 @@ gen r u rc gc rs = do , config = c , getRepo = return r , gitconfig = gc - , localpath = Just dir + , localpath = Just dir' , readonly = False , appendonly = False , availability = LocallyAvailable , remotetype = remote , mkUnavailable = gen r u rc (gc { remoteAnnexDirectory = Just "/dev/null" }) rs - , getInfo = return [("directory", dir)] + , getInfo = return [("directory", dir')] , claimUrl = Nothing , checkUrl = Nothing , remoteStateHandle = rs } where - dir = fromMaybe (giveup "missing directory") $ remoteAnnexDirectory gc + dir = toRawFilePath dir' + dir' = fromMaybe (giveup "missing directory") (remoteAnnexDirectory gc) directorySetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) directorySetup _ mu _ c gc = do @@ -127,7 +132,7 @@ directorySetup _ mu _ c gc = do -- verify configuration is sane let dir = maybe (giveup "Specify directory=") fromProposedAccepted $ M.lookup directoryField c - absdir <- liftIO $ absPath dir + absdir <- liftIO $ fromRawFilePath <$> absPath (toRawFilePath dir) liftIO $ unlessM (doesDirectoryExist absdir) $ giveup $ "Directory does not exist: " ++ absdir (c', _encsetup) <- encryptionSetup c gc @@ -140,27 +145,28 @@ directorySetup _ mu _ c gc = do {- Locations to try to access a given Key in the directory. - We try more than one since we used to write to different hash - directories. -} -locations :: FilePath -> Key -> [FilePath] -locations d k = map (\f -> d fromRawFilePath f) (keyPaths k) +locations :: RawFilePath -> Key -> [RawFilePath] +locations d k = map (d P.) (keyPaths k) {- Returns the location off a Key in the directory. If the key is - present, returns the location that is actually used, otherwise - returns the first, default location. -} -getLocation :: FilePath -> Key -> IO FilePath +getLocation :: RawFilePath -> Key -> IO RawFilePath getLocation d k = do let locs = locations d k - fromMaybe (Prelude.head locs) <$> firstM doesFileExist locs + fromMaybe (Prelude.head locs) + <$> firstM (doesFileExist . fromRawFilePath) locs {- Directory where the file(s) for a key are stored. -} -storeDir :: FilePath -> Key -> FilePath -storeDir d k = addTrailingPathSeparator $ - d fromRawFilePath (hashDirLower def k) fromRawFilePath (keyFile k) +storeDir :: RawFilePath -> Key -> RawFilePath +storeDir d k = P.addTrailingPathSeparator $ + d P. hashDirLower def k P. keyFile k {- Check if there is enough free disk space in the remote's directory to - store the key. Note that the unencrypted key size is checked. -} -storeKeyM :: FilePath -> ChunkConfig -> Storer +storeKeyM :: RawFilePath -> ChunkConfig -> Storer storeKeyM d chunkconfig k c m = - ifM (checkDiskSpaceDirectory d k) + ifM (checkDiskSpaceDirectory (fromRawFilePath d) k) ( byteStorer (store d chunkconfig) k c m , giveup "Not enough free disk space." ) @@ -174,47 +180,55 @@ checkDiskSpaceDirectory d k = do <*> getFileStatus annexdir checkDiskSpace (Just d) k 0 samefilesystem -store :: FilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex () +store :: RawFilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex () store d chunkconfig k b p = liftIO $ do void $ tryIO $ createDirectoryUnder d tmpdir case chunkconfig of LegacyChunks chunksize -> - Legacy.store d chunksize (finalizeStoreGeneric d) k b p tmpdir destdir + Legacy.store + (fromRawFilePath d) + chunksize + (finalizeStoreGeneric d) + k b p + (fromRawFilePath tmpdir) + (fromRawFilePath destdir) _ -> do - let tmpf = tmpdir kf - meteredWriteFile p tmpf b + let tmpf = tmpdir P. kf + meteredWriteFile p (fromRawFilePath tmpf) b finalizeStoreGeneric d tmpdir destdir where - tmpdir = addTrailingPathSeparator $ d "tmp" kf - kf = fromRawFilePath (keyFile k) + tmpdir = P.addTrailingPathSeparator $ d P. "tmp" P. kf + kf = keyFile k destdir = storeDir d k {- Passed a temp directory that contains the files that should be placed - in the dest directory, moves it into place. Anything already existing - in the dest directory will be deleted. File permissions will be locked - down. -} -finalizeStoreGeneric :: FilePath -> FilePath -> FilePath -> IO () +finalizeStoreGeneric :: RawFilePath -> RawFilePath -> RawFilePath -> IO () finalizeStoreGeneric d tmp dest = do - removeDirGeneric d dest + removeDirGeneric (fromRawFilePath d) dest' createDirectoryUnder d (parentDir dest) - renameDirectory tmp dest + renameDirectory (fromRawFilePath tmp) dest' -- may fail on some filesystems void $ tryIO $ do - mapM_ preventWrite =<< dirContents dest - preventWrite dest + mapM_ preventWrite =<< dirContents dest' + preventWrite dest' + where + dest' = fromRawFilePath dest -retrieveKeyFileM :: FilePath -> ChunkConfig -> Retriever +retrieveKeyFileM :: RawFilePath -> ChunkConfig -> Retriever retrieveKeyFileM d (LegacyChunks _) = Legacy.retrieve locations d retrieveKeyFileM d _ = byteRetriever $ \k sink -> - sink =<< liftIO (L.readFile =<< getLocation d k) + sink =<< liftIO (L.readFile . fromRawFilePath =<< getLocation d k) -retrieveKeyFileCheapM :: FilePath -> ChunkConfig -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ()) +retrieveKeyFileCheapM :: RawFilePath -> ChunkConfig -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ()) -- no cheap retrieval possible for chunks retrieveKeyFileCheapM _ (UnpaddedChunks _) = Nothing retrieveKeyFileCheapM _ (LegacyChunks _) = Nothing #ifndef mingw32_HOST_OS retrieveKeyFileCheapM d NoChunks = Just $ \k _af f -> liftIO $ do - file <- absPath =<< getLocation d k + file <- fromRawFilePath <$> (absPath =<< getLocation d k) ifM (doesFileExist file) ( createSymbolicLink file f , giveup "content file not present in remote" @@ -223,8 +237,10 @@ retrieveKeyFileCheapM d NoChunks = Just $ \k _af f -> liftIO $ do retrieveKeyFileCheapM _ _ = Nothing #endif -removeKeyM :: FilePath -> Remover -removeKeyM d k = liftIO $ removeDirGeneric d (storeDir d k) +removeKeyM :: RawFilePath -> Remover +removeKeyM d k = liftIO $ removeDirGeneric + (fromRawFilePath d) + (fromRawFilePath (storeDir d k)) {- Removes the directory, which must be located under the topdir. - @@ -250,76 +266,79 @@ removeDirGeneric topdir dir = do unlessM (doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir)) $ throwM e -checkPresentM :: FilePath -> ChunkConfig -> CheckPresent +checkPresentM :: RawFilePath -> ChunkConfig -> CheckPresent checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations k checkPresentM d _ k = checkPresentGeneric d (locations d k) -checkPresentGeneric :: FilePath -> [FilePath] -> Annex Bool +checkPresentGeneric :: RawFilePath -> [RawFilePath] -> Annex Bool checkPresentGeneric d ps = checkPresentGeneric' d $ - liftIO $ anyM doesFileExist ps + liftIO $ anyM (doesFileExist . fromRawFilePath) ps -checkPresentGeneric' :: FilePath -> Annex Bool -> Annex Bool +checkPresentGeneric' :: RawFilePath -> Annex Bool -> Annex Bool checkPresentGeneric' d check = ifM check ( return True - , ifM (liftIO $ doesDirectoryExist d) + , ifM (liftIO $ doesDirectoryExist (fromRawFilePath d)) ( return False - , giveup $ "directory " ++ d ++ " is not accessible" + , giveup $ "directory " ++ fromRawFilePath d ++ " is not accessible" ) ) -storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex () +storeExportM :: RawFilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex () storeExportM d src _k loc p = liftIO $ do - createDirectoryUnder d (takeDirectory dest) + createDirectoryUnder d (P.takeDirectory dest) -- Write via temp file so that checkPresentGeneric will not -- see it until it's fully stored. - viaTmp (\tmp () -> withMeteredFile src p (L.writeFile tmp)) dest () + viaTmp go (fromRawFilePath dest) () where dest = exportPath d loc + go tmp () = withMeteredFile src p (L.writeFile tmp) -retrieveExportM :: FilePath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex () +retrieveExportM :: RawFilePath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex () retrieveExportM d _k loc dest p = liftIO $ withMeteredFile src p (L.writeFile dest) where - src = exportPath d loc + src = fromRawFilePath $ exportPath d loc -removeExportM :: FilePath -> Key -> ExportLocation -> Annex () +removeExportM :: RawFilePath -> Key -> ExportLocation -> Annex () removeExportM d _k loc = liftIO $ do removeWhenExistsWith removeLink src removeExportLocation d loc where - src = exportPath d loc + src = fromRawFilePath $ exportPath d loc -checkPresentExportM :: FilePath -> Key -> ExportLocation -> Annex Bool +checkPresentExportM :: RawFilePath -> Key -> ExportLocation -> Annex Bool checkPresentExportM d _k loc = checkPresentGeneric d [exportPath d loc] -renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ()) +renameExportM :: RawFilePath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ()) renameExportM d _k oldloc newloc = liftIO $ do - createDirectoryUnder d (takeDirectory dest) - renameFile src dest + createDirectoryUnder d (P.takeDirectory dest) + renameFile (fromRawFilePath src) (fromRawFilePath dest) removeExportLocation d oldloc return (Just ()) where src = exportPath d oldloc dest = exportPath d newloc -exportPath :: FilePath -> ExportLocation -> FilePath -exportPath d loc = d fromRawFilePath (fromExportLocation loc) +exportPath :: RawFilePath -> ExportLocation -> RawFilePath +exportPath d loc = d P. fromExportLocation loc {- Removes the ExportLocation's parent directory and its parents, so long as - they're empty, up to but not including the topdir. -} -removeExportLocation :: FilePath -> ExportLocation -> IO () +removeExportLocation :: RawFilePath -> ExportLocation -> IO () removeExportLocation topdir loc = - go (Just $ takeDirectory $ fromRawFilePath $ fromExportLocation loc) (Right ()) + go (Just $ P.takeDirectory $ fromExportLocation loc) (Right ()) where go _ (Left _e) = return () go Nothing _ = return () - go (Just loc') _ = go (upFrom loc') - =<< tryIO (removeDirectory $ exportPath topdir (mkExportLocation (toRawFilePath loc'))) + go (Just loc') _ = + let p = fromRawFilePath $ exportPath topdir $ + mkExportLocation loc' + in go (upFrom loc') =<< tryIO (removeDirectory p) -listImportableContentsM :: FilePath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize))) +listImportableContentsM :: RawFilePath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize))) listImportableContentsM dir = catchMaybeIO $ liftIO $ do - l <- dirContentsRecursive dir + l <- dirContentsRecursive (fromRawFilePath dir) l' <- mapM go l return $ ImportableContents (catMaybes l') [] where @@ -328,7 +347,7 @@ listImportableContentsM dir = catchMaybeIO $ liftIO $ do mkContentIdentifier f st >>= \case Nothing -> return Nothing Just cid -> do - relf <- toRawFilePath <$> relPathDirToFile dir f + relf <- relPathDirToFile dir (toRawFilePath f) sz <- getFileSize' f st return $ Just (mkImportLocation relf, (cid, sz)) @@ -350,33 +369,35 @@ guardSameContentIdentifiers cont old new | new == Just old = cont | otherwise = giveup "file content has changed" -importKeyM :: FilePath -> ExportLocation -> ContentIdentifier -> MeterUpdate -> Annex Key +importKeyM :: RawFilePath -> ExportLocation -> ContentIdentifier -> MeterUpdate -> Annex Key importKeyM dir loc cid p = do - backend <- chooseBackend (fromRawFilePath f) + backend <- chooseBackend f k <- fst <$> genKey ks p backend - currcid <- liftIO $ mkContentIdentifier absf =<< getFileStatus absf + currcid <- liftIO $ mkContentIdentifier (fromRawFilePath absf) + =<< R.getFileStatus absf guardSameContentIdentifiers (return k) cid currcid where f = fromExportLocation loc - absf = dir fromRawFilePath f + absf = dir P. f ks = KeySource { keyFilename = f - , contentLocation = toRawFilePath absf + , contentLocation = absf , inodeCache = Nothing } -retrieveExportWithContentIdentifierM :: FilePath -> ExportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key +retrieveExportWithContentIdentifierM :: RawFilePath -> ExportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key retrieveExportWithContentIdentifierM dir loc cid dest mkkey p = precheck $ docopy postcheck where f = exportPath dir loc + f' = fromRawFilePath f docopy cont = do #ifndef mingw32_HOST_OS let open = do -- Need a duplicate fd for the post check, since -- hGetContentsMetered closes its handle. - fd <- openFd f ReadOnly Nothing defaultFileFlags + fd <- openFd f' ReadOnly Nothing defaultFileFlags dupfd <- dup fd h <- fdToHandle fd return (h, dupfd) @@ -385,7 +406,7 @@ retrieveExportWithContentIdentifierM dir loc cid dest mkkey p = closeFd dupfd bracketIO open close $ \(h, dupfd) -> do #else - let open = openBinaryFile f ReadMode + let open = openBinaryFile f' ReadMode let close = hClose bracketIO open close $ \h -> do #endif @@ -400,8 +421,8 @@ retrieveExportWithContentIdentifierM dir loc cid dest mkkey p = -- Check before copy, to avoid expensive copy of wrong file -- content. precheck cont = guardSameContentIdentifiers cont cid - =<< liftIO . mkContentIdentifier f - =<< liftIO (getFileStatus f) + =<< liftIO . mkContentIdentifier f' + =<< liftIO (R.getFileStatus f) -- Check after copy, in case the file was changed while it was -- being copied. @@ -421,7 +442,7 @@ retrieveExportWithContentIdentifierM dir loc cid dest mkkey p = #else postcheck cont = do #endif - currcid <- liftIO $ mkContentIdentifier f + currcid <- liftIO $ mkContentIdentifier f' #ifndef mingw32_HOST_OS =<< getFdStatus fd #else @@ -429,9 +450,9 @@ retrieveExportWithContentIdentifierM dir loc cid dest mkkey p = #endif guardSameContentIdentifiers cont cid currcid -storeExportWithContentIdentifierM :: FilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier +storeExportWithContentIdentifierM :: RawFilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier storeExportWithContentIdentifierM dir src _k loc overwritablecids p = do - liftIO $ createDirectoryUnder dir destdir + liftIO $ createDirectoryUnder dir (toRawFilePath destdir) withTmpFileIn destdir template $ \tmpf tmph -> do liftIO $ withMeteredFile src p (L.hPut tmph) liftIO $ hFlush tmph @@ -446,17 +467,17 @@ storeExportWithContentIdentifierM dir src _k loc overwritablecids p = do (const $ liftIO $ rename tmpf dest) return newcid where - dest = exportPath dir loc + dest = fromRawFilePath $ exportPath dir loc (destdir, base) = splitFileName dest template = relatedTemplate (base ++ ".tmp") -removeExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex () +removeExportWithContentIdentifierM :: RawFilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex () removeExportWithContentIdentifierM dir k loc removeablecids = checkExportContent dir loc removeablecids (giveup "unsafe to remove modified file") $ \case DoesNotExist -> return () KnownContentIdentifier -> removeExportM dir k loc -checkPresentExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool +checkPresentExportWithContentIdentifierM :: RawFilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool checkPresentExportWithContentIdentifierM dir _k loc knowncids = checkPresentGeneric' dir $ checkExportContent dir loc knowncids (return False) $ \case @@ -480,12 +501,12 @@ data CheckResult = DoesNotExist | KnownContentIdentifier -- -- So, it suffices to check if the destination file's current -- content is known, and immediately run the callback. -checkExportContent :: FilePath -> ExportLocation -> [ContentIdentifier] -> Annex a -> (CheckResult -> Annex a) -> Annex a +checkExportContent :: RawFilePath -> ExportLocation -> [ContentIdentifier] -> Annex a -> (CheckResult -> Annex a) -> Annex a checkExportContent dir loc knowncids unsafe callback = - tryWhenExists (liftIO $ getFileStatus dest) >>= \case + tryWhenExists (liftIO $ R.getFileStatus dest) >>= \case Just destst | not (isRegularFile destst) -> unsafe - | otherwise -> catchDefaultIO Nothing (liftIO $ mkContentIdentifier dest destst) >>= \case + | otherwise -> catchDefaultIO Nothing (liftIO $ mkContentIdentifier (fromRawFilePath dest) destst) >>= \case Just destcid | destcid `elem` knowncids -> callback KnownContentIdentifier -- dest exists with other content diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs index 61b3e2d17e..d89853b0af 100644 --- a/Remote/Directory/LegacyChunked.hs +++ b/Remote/Directory/LegacyChunked.hs @@ -7,10 +7,13 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Remote.Directory.LegacyChunked where import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S +import qualified System.FilePath.ByteString as P import Annex.Common import Utility.FileMode @@ -18,6 +21,7 @@ import Remote.Helper.Special import qualified Remote.Helper.Chunked.Legacy as Legacy import Annex.Tmp import Utility.Metered +import Utility.Directory.Create withCheckedFiles :: (FilePath -> IO Bool) -> FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool withCheckedFiles _ [] _locations _ _ = return False @@ -70,17 +74,19 @@ storeLegacyChunked' meterupdate chunksize (d:dests) bs c = do feed bytes' (sz - s) ls h else return (l:ls) -storeHelper :: FilePath -> (FilePath -> FilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO () +storeHelper :: FilePath -> (RawFilePath -> RawFilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO () storeHelper repotop finalizer key storer tmpdir destdir = do - void $ liftIO $ tryIO $ createDirectoryUnder repotop tmpdir - Legacy.storeChunks key tmpdir destdir storer recorder finalizer + void $ liftIO $ tryIO $ createDirectoryUnder + (toRawFilePath repotop) + (toRawFilePath tmpdir) + Legacy.storeChunks key tmpdir destdir storer recorder (legacyFinalizer finalizer) where recorder f s = do void $ tryIO $ allowWrite f writeFile f s void $ tryIO $ preventWrite f -store :: FilePath -> ChunkSize -> (FilePath -> FilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO () +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 -> storeLegacyChunked p chunksize dests b @@ -88,12 +94,13 @@ store repotop chunksize finalizer k b p = storeHelper repotop finalizer k $ \des - Done very innefficiently, by writing to a temp file. - :/ This is legacy code.. -} -retrieve :: (FilePath -> Key -> [FilePath]) -> FilePath -> Retriever +retrieve :: (RawFilePath -> Key -> [RawFilePath]) -> RawFilePath -> Retriever retrieve locations d basek p c = withOtherTmp $ \tmpdir -> do showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow." - let tmp = tmpdir fromRawFilePath (keyFile basek) ++ ".directorylegacy.tmp" + let tmp = fromRawFilePath $ + tmpdir P. keyFile basek <> ".directorylegacy.tmp" let go = \k sink -> do - liftIO $ void $ withStoredFiles d locations k $ \fs -> do + liftIO $ void $ withStoredFiles (fromRawFilePath d) (legacyLocations locations) k $ \fs -> do forM_ fs $ S.appendFile tmp <=< S.readFile return True @@ -102,7 +109,15 @@ retrieve locations d basek p c = withOtherTmp $ \tmpdir -> do sink b byteRetriever go basek p c -checkKey :: FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> Annex Bool -checkKey d locations k = liftIO $ withStoredFiles d locations k $ - -- withStoredFiles checked that it exists - const $ return True +checkKey :: RawFilePath -> (RawFilePath -> Key -> [RawFilePath]) -> Key -> Annex Bool +checkKey d locations k = liftIO $ + withStoredFiles (fromRawFilePath d) (legacyLocations locations) k $ + -- withStoredFiles checked that it exists + const $ return True + +legacyFinalizer :: (RawFilePath -> RawFilePath -> IO ()) -> (FilePath -> FilePath -> IO ()) +legacyFinalizer f = \a b -> f (toRawFilePath a) (toRawFilePath b) + +legacyLocations :: (RawFilePath -> Key -> [RawFilePath]) -> (FilePath -> Key -> [FilePath]) +legacyLocations locations = \f k -> + map fromRawFilePath $ locations (toRawFilePath f) k diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 28ec2ee66c..6226a2b644 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -224,7 +224,7 @@ storeGeneric o meterupdate basedest populatedest = storeGeneric' :: RsyncOpts -> MeterUpdate -> FilePath -> (FilePath -> Annex Bool) -> Annex Bool storeGeneric' o meterupdate basedest populatedest = withRsyncScratchDir $ \tmp -> do let dest = tmp basedest - createAnnexDirectory (parentDir dest) + createAnnexDirectory (parentDir (toRawFilePath dest)) ok <- populatedest dest ps <- sendParams if ok @@ -250,7 +250,7 @@ remove o k = removeGeneric o includes where includes = concatMap use dirHashes use h = let dir = fromRawFilePath (h def k) in - [ parentDir dir + [ fromRawFilePath (parentDir (toRawFilePath dir)) , dir -- match content directory and anything in it , dir fromRawFilePath (keyFile k) "***" @@ -314,7 +314,8 @@ checkPresentExportM o _k loc = checkPresentGeneric o [rsyncurl] removeExportM :: RsyncOpts -> Key -> ExportLocation -> Annex () removeExportM o _k loc = - removeGeneric o $ includes $ fromRawFilePath $ fromExportLocation loc + removeGeneric o $ map fromRawFilePath $ + includes $ fromExportLocation loc where includes f = f : case upFrom f of Nothing -> [] @@ -325,9 +326,9 @@ removeExportDirectoryM o ed = removeGeneric o (allbelow d : includes d) where d = fromRawFilePath $ fromExportDirectory ed allbelow f = f "***" - includes f = f : case upFrom f of + includes f = f : case upFrom (toRawFilePath f) of Nothing -> [] - Just f' -> includes f' + Just f' -> includes (fromRawFilePath f') renameExportM :: RsyncOpts -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ()) renameExportM _ _ _ _ = return Nothing diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs index 9e57e68a68..72df4c70e8 100644 --- a/Remote/Tahoe.hs +++ b/Remote/Tahoe.hs @@ -190,7 +190,8 @@ tahoeConfigure configdir furl mscs = do createClient :: TahoeConfigDir -> IntroducerFurl -> IO Bool createClient configdir furl = do - createDirectoryIfMissing True (parentDir configdir) + createDirectoryIfMissing True $ + fromRawFilePath $ parentDir $ toRawFilePath configdir boolTahoe configdir "create-client" [ Param "--nickname", Param "git-annex" , Param "--introducer", Param furl