add ExportTree table to export db

New table needed to look up what filenames are used in the currently
exported tree, for reasons explained in export.mdwn.

Also, added smart constructors for ExportLocation and ExportDirectory to
make sure they contain filepaths with the right direction slashes.

And some code refactoring.

This commit was sponsored by Francois Marier on Patreon.
This commit is contained in:
Joey Hess 2017-09-18 13:57:25 -04:00
parent 486902389d
commit b03d77c211
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
13 changed files with 247 additions and 93 deletions

View file

@ -274,14 +274,14 @@ renameExportM d _k oldloc newloc = liftIO $ catchBoolIO $ do
dest = exportPath d newloc
exportPath :: FilePath -> ExportLocation -> FilePath
exportPath d (ExportLocation loc) = d </> loc
exportPath d loc = d </> fromExportLocation loc
{- Removes the ExportLocation directory and its parents, so long as
- they're empty, up to but not including the topdir. -}
removeExportLocation :: FilePath -> ExportLocation -> IO ()
removeExportLocation topdir (ExportLocation loc) = go (Just loc) (Right ())
removeExportLocation topdir loc = go (Just $ fromExportLocation loc) (Right ())
where
go _ (Left _e) = return ()
go Nothing _ = return ()
go (Just loc') _ = go (upFrom loc')
=<< tryIO (removeDirectory $ exportPath topdir (ExportLocation loc'))
=<< tryIO (removeDirectory $ exportPath topdir (mkExportLocation loc'))

View file

@ -358,9 +358,9 @@ instance Proto.Serializable URI where
deserialize = parseURI
instance Proto.Serializable ExportLocation where
serialize (ExportLocation loc) = loc
deserialize = Just . ExportLocation
serialize = fromExportLocation
deserialize = Just . mkExportLocation
instance Proto.Serializable ExportDirectory where
serialize (ExportDirectory loc) = loc
deserialize = Just . ExportDirectory
serialize = fromExportDirectory
deserialize = Just . mkExportDirectory

View file

@ -93,7 +93,7 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
-- Storing a key on an export would need a way to
-- look up the file(s) that the currently exported
-- tree uses for a key; there's not currently an
-- inexpensive way to do that (getExportLocation
-- inexpensive way to do that (getExportedLocation
-- only finds files that have been stored on the
-- export already).
{ storeKey = \_ _ _ -> do
@ -105,7 +105,7 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
, retrieveKeyFile = \k _af dest p -> unVerified $
if maybe False (isJust . verifyKeyContent) (maybeLookupBackendVariety (keyVariety k))
then do
locs <- liftIO $ getExportLocation db k
locs <- liftIO $ getExportedLocation db k
case locs of
[] -> do
warning "unknown export location"
@ -136,7 +136,7 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
, checkPresent = \k -> do
ea <- exportActions r
anyM (checkPresentExport ea k)
=<< liftIO (getExportLocation db k)
=<< liftIO (getExportedLocation db k)
, mkUnavailable = return Nothing
, getInfo = do
is <- getInfo r
@ -155,10 +155,10 @@ removeEmptyDirectories ea db loc ks
ok <- allM (go removeexportdirectory)
(reverse (exportDirectories loc))
unless ok $ liftIO $ do
-- Add back to export database, so this is
-- tried again next time.
-- Add location back to export database,
-- so this is tried again next time.
forM_ ks $ \k ->
addExportLocation db k loc
addExportedLocation db k loc
flushDbQueue db
return ok
where

View file

@ -615,7 +615,7 @@ getBucketObject c = munge . key2file
_ -> getFilePrefix c ++ s
getBucketExportLocation :: RemoteConfig -> ExportLocation -> FilePath
getBucketExportLocation c (ExportLocation loc) = getFilePrefix c ++ loc
getBucketExportLocation c loc = getFilePrefix c ++ fromExportLocation loc
{- Internet Archive documentation limits filenames to a subset of ascii.
- While other characters seem to work now, this entity encodes everything

View file

@ -204,8 +204,8 @@ removeExportDav mh _k loc = runExport mh $ \_dav ->
removeHelper (exportLocation loc)
removeExportDirectoryDav :: Maybe DavHandle -> ExportDirectory -> Annex Bool
removeExportDirectoryDav mh (ExportDirectory dir) = runExport mh $ \_dav ->
safely (inLocation dir delContentM)
removeExportDirectoryDav mh dir = runExport mh $ \_dav ->
safely (inLocation (fromExportDirectory dir) delContentM)
>>= maybe (return False) (const $ return True)
renameExportDav :: Maybe DavHandle -> Key -> ExportLocation -> ExportLocation -> Annex Bool

View file

@ -47,7 +47,7 @@ keyLocation :: Key -> DavLocation
keyLocation k = keyDir k ++ keyFile k
exportLocation :: ExportLocation -> DavLocation
exportLocation (ExportLocation f) = f
exportLocation = fromExportLocation
{- Where we store temporary data for a key as it's being uploaded. -}
keyTmpLocation :: Key -> DavLocation