more OsPath conversion
Sponsored-by: Leon Schuermann
This commit is contained in:
Joey Hess
parent
54f0710fd2
commit
4dc904bbad
8 changed files with 69 additions and 66 deletions
|
|
@ -39,7 +39,6 @@ import Control.DeepSeq
|
|||
import qualified Data.Map as M
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified System.FilePath.ByteString as P
|
||||
|
||||
newtype BorgRepo = BorgRepo { locBorgRepo :: String }
|
||||
|
||||
|
|
@ -156,18 +155,17 @@ borgArchive (BorgRepo r) n = r ++ "::" ++ decodeBS n
|
|||
|
||||
absBorgRepo :: BorgRepo -> IO BorgRepo
|
||||
absBorgRepo r@(BorgRepo p)
|
||||
| borgLocal r = BorgRepo . fromRawFilePath
|
||||
<$> absPath (toRawFilePath p)
|
||||
| borgLocal r = BorgRepo . fromOsPath <$> absPath (toOsPath p)
|
||||
| otherwise = return r
|
||||
|
||||
borgRepoLocalPath :: BorgRepo -> Maybe FilePath
|
||||
borgRepoLocalPath :: BorgRepo -> Maybe OsPath
|
||||
borgRepoLocalPath r@(BorgRepo p)
|
||||
| borgLocal r = Just p
|
||||
| borgLocal r = Just (toOsPath p)
|
||||
| otherwise = Nothing
|
||||
|
||||
checkAvailability :: BorgRepo -> Annex Availability
|
||||
checkAvailability borgrepo@(BorgRepo r) =
|
||||
checkPathAvailability (borgLocal borgrepo) r
|
||||
checkPathAvailability (borgLocal borgrepo) (toOsPath r)
|
||||
|
||||
listImportableContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))
|
||||
listImportableContentsM u borgrepo c = prompt $ do
|
||||
|
|
@ -218,7 +216,7 @@ listImportableContentsM u borgrepo c = prompt $ do
|
|||
parsefilelist archivename (bsz:f:extra:rest) = case readMaybe (fromRawFilePath bsz) of
|
||||
Nothing -> parsefilelist archivename rest
|
||||
Just sz ->
|
||||
let loc = genImportLocation f
|
||||
let loc = genImportLocation (toOsPath f)
|
||||
-- borg list reports hard links as 0 byte files,
|
||||
-- with the extra field set to " link to ".
|
||||
-- When the annex object is a hard link to
|
||||
|
|
@ -235,7 +233,7 @@ listImportableContentsM u borgrepo c = prompt $ do
|
|||
-- importable keys, so avoids needing to buffer all
|
||||
-- the rest of the files in memory.
|
||||
in case ThirdPartyPopulated.importKey' loc reqsz of
|
||||
Just k -> (loc, (borgContentIdentifier, retsz k))
|
||||
Just k -> (fromOsPath loc, (borgContentIdentifier, retsz k))
|
||||
: parsefilelist archivename rest
|
||||
Nothing -> parsefilelist archivename rest
|
||||
parsefilelist _ _ = []
|
||||
|
|
@ -270,7 +268,7 @@ listImportableContentsM u borgrepo c = prompt $ do
|
|||
borgContentIdentifier :: ContentIdentifier
|
||||
borgContentIdentifier = ContentIdentifier mempty
|
||||
|
||||
-- Convert a path file a borg archive to a path that can be used as an
|
||||
-- Convert a path from a borg archive to a path that can be used as an
|
||||
-- ImportLocation. The archive name gets used as a subdirectory,
|
||||
-- which this path is inside.
|
||||
--
|
||||
|
|
@ -279,18 +277,19 @@ borgContentIdentifier = ContentIdentifier mempty
|
|||
--
|
||||
-- This scheme also relies on the fact that paths in a borg archive are
|
||||
-- always relative, not absolute.
|
||||
genImportLocation :: RawFilePath -> RawFilePath
|
||||
genImportLocation :: OsPath -> OsPath
|
||||
genImportLocation = fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation
|
||||
|
||||
genImportChunkSubDir :: BorgArchiveName -> ImportChunkSubDir
|
||||
genImportChunkSubDir = ImportChunkSubDir . fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation
|
||||
genImportChunkSubDir = ImportChunkSubDir . fromImportLocation
|
||||
. ThirdPartyPopulated.mkThirdPartyImportLocation . toOsPath
|
||||
|
||||
extractImportLocation :: ImportLocation -> (BorgArchiveName, RawFilePath)
|
||||
extractImportLocation loc = go $ P.splitDirectories $
|
||||
extractImportLocation :: ImportLocation -> (BorgArchiveName, OsPath)
|
||||
extractImportLocation loc = go $ splitDirectories $
|
||||
ThirdPartyPopulated.fromThirdPartyImportLocation loc
|
||||
where
|
||||
go (archivename:rest) = (archivename, P.joinPath rest)
|
||||
go _ = giveup $ "Unable to parse import location " ++ fromRawFilePath (fromImportLocation loc)
|
||||
go (archivename:rest) = (fromOsPath archivename, joinPath rest)
|
||||
go _ = giveup $ "Unable to parse import location " ++ fromOsPath (fromImportLocation loc)
|
||||
|
||||
-- Since the ImportLocation starts with the archive name, a list of all
|
||||
-- archive names we've already imported can be found by just listing the
|
||||
|
|
@ -305,7 +304,7 @@ getImported u = M.unions <$> (mapM go . exportedTreeishes =<< getExport u)
|
|||
|
||||
mk ti
|
||||
| toTreeItemType (LsTree.mode ti) == Just TreeSubtree = Just
|
||||
( getTopFilePath (LsTree.file ti)
|
||||
( fromOsPath (getTopFilePath (LsTree.file ti))
|
||||
, getcontents (LsTree.sha ti)
|
||||
)
|
||||
| otherwise = Nothing
|
||||
|
|
@ -316,9 +315,9 @@ getImported u = M.unions <$> (mapM go . exportedTreeishes =<< getExport u)
|
|||
mkcontents ti = do
|
||||
let f = ThirdPartyPopulated.fromThirdPartyImportLocation $
|
||||
mkImportLocation $ getTopFilePath $ LsTree.file ti
|
||||
k <- fileKey (P.takeFileName f)
|
||||
k <- fileKey (takeFileName f)
|
||||
return
|
||||
( genImportLocation f
|
||||
( fromOsPath (genImportLocation f)
|
||||
,
|
||||
( borgContentIdentifier
|
||||
-- defaulting to 0 size is ok, this size
|
||||
|
|
@ -341,7 +340,7 @@ checkPresentExportWithContentIdentifierM borgrepo _ loc _ = prompt $ liftIO $ do
|
|||
, Param "--format"
|
||||
, Param "1"
|
||||
, Param (borgArchive borgrepo archivename)
|
||||
, File (fromRawFilePath archivefile)
|
||||
, File (fromOsPath archivefile)
|
||||
]
|
||||
-- borg list exits nonzero with an error message if an archive
|
||||
-- no longer exists. But, the user can delete archives at any
|
||||
|
|
@ -377,7 +376,7 @@ checkPresentExportWithContentIdentifierM borgrepo _ loc _ = prompt $ liftIO $ do
|
|||
, giveup $ "Unable to access borg repository " ++ locBorgRepo borgrepo
|
||||
)
|
||||
|
||||
retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> [ContentIdentifier] -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
|
||||
retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> [ContentIdentifier] -> OsPath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
|
||||
retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do
|
||||
showOutput
|
||||
case gk of
|
||||
|
|
@ -387,7 +386,7 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do
|
|||
return (k, UnVerified)
|
||||
Left k -> do
|
||||
v <- verifyKeyContentIncrementally DefaultVerify k
|
||||
(\iv -> tailVerify iv (toRawFilePath dest) go)
|
||||
(\iv -> tailVerify iv dest go)
|
||||
return (k, v)
|
||||
where
|
||||
go = prompt $ withOtherTmp $ \othertmp -> liftIO $ do
|
||||
|
|
@ -406,14 +405,14 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do
|
|||
, Param "--noacls"
|
||||
, Param "--nobsdflags"
|
||||
, Param (borgArchive absborgrepo archivename)
|
||||
, File (fromRawFilePath archivefile)
|
||||
, File (fromOsPath archivefile)
|
||||
]
|
||||
(Nothing, Nothing, Nothing, pid) <- createProcess $ p
|
||||
{ cwd = Just (fromRawFilePath othertmp) }
|
||||
{ cwd = Just (fromOsPath othertmp) }
|
||||
forceSuccessProcess p pid
|
||||
-- Filepaths in borg archives are relative, so it's ok to
|
||||
-- combine with </>
|
||||
moveFile (othertmp P.</> archivefile) (toRawFilePath dest)
|
||||
removeDirectoryRecursive (fromRawFilePath othertmp)
|
||||
moveFile (othertmp </> archivefile) dest
|
||||
removeDirectoryRecursive othertmp
|
||||
|
||||
(archivename, archivefile) = extractImportLocation loc
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue