summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
Diffstat (limited to 'Remote')
-rw-r--r--Remote/BitTorrent.hs5
-rw-r--r--Remote/Bup.hs5
-rw-r--r--Remote/Ddar.hs5
-rw-r--r--Remote/Directory.hs74
-rw-r--r--Remote/External.hs5
-rw-r--r--Remote/GCrypt.hs5
-rw-r--r--Remote/Git.hs5
-rw-r--r--Remote/Glacier.hs5
-rw-r--r--Remote/Hook.hs5
-rw-r--r--Remote/P2P.hs5
-rw-r--r--Remote/Rsync.hs5
-rw-r--r--Remote/S3.hs5
-rw-r--r--Remote/Tahoe.hs5
-rw-r--r--Remote/Web.hs5
-rw-r--r--Remote/WebDAV.hs5
15 files changed, 133 insertions, 11 deletions
diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs
index 2f29f5baa..887a0898e 100644
--- a/Remote/BitTorrent.hs
+++ b/Remote/BitTorrent.hs
@@ -61,6 +61,11 @@ gen r _ c gc =
, lockContent = Nothing
, checkPresent = checkKey
, checkPresentCheap = False
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 3a2d67bc8..aad8e6bba 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -61,6 +61,11 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = bupLocal buprepo
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index 2f8c3b345..1da3ff412 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -60,6 +60,11 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = ddarLocal ddarrepo
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 2452c42e2..a371a1951 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -1,6 +1,6 @@
{- A "remote" that is just a filesystem directory.
-
- - Copyright 2011-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -58,6 +58,11 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = True
+ , storeExport = Just $ storeExportDirectory dir
+ , retrieveExport = Just $ retrieveExportDirectory dir
+ , removeExport = Just $ removeExportDirectory dir
+ , checkPresentExport = Just $ checkPresentExportDirectory dir
+ , renameExport = Just $ renameExportDirectory dir
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
@@ -119,16 +124,18 @@ tmpDir d k = addTrailingPathSeparator $ d </> "tmp" </> 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. -}
prepareStore :: FilePath -> ChunkConfig -> Preparer Storer
-prepareStore d chunkconfig = checkPrepare checker
+prepareStore d chunkconfig = checkPrepare (checkDiskSpaceDirectory d)
(byteStorer $ store d chunkconfig)
where
- checker k = do
- annexdir <- fromRepo gitAnnexObjectDir
- samefilesystem <- liftIO $ catchDefaultIO False $
- (\a b -> deviceID a == deviceID b)
- <$> getFileStatus d
- <*> getFileStatus annexdir
- checkDiskSpace (Just d) k 0 samefilesystem
+
+checkDiskSpaceDirectory :: FilePath -> Key -> Annex Bool
+checkDiskSpaceDirectory d k = do
+ annexdir <- fromRepo gitAnnexObjectDir
+ samefilesystem <- liftIO $ catchDefaultIO False $
+ (\a b -> deviceID a == deviceID b)
+ <$> getFileStatus d
+ <*> getFileStatus annexdir
+ checkDiskSpace (Just d) k 0 samefilesystem
store :: FilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex Bool
store d chunkconfig k b p = liftIO $ do
@@ -211,11 +218,56 @@ removeDirGeneric topdir dir = do
checkKey :: FilePath -> ChunkConfig -> CheckPresent
checkKey d (LegacyChunks _) k = Legacy.checkKey d locations k
-checkKey d _ k = liftIO $
- ifM (anyM doesFileExist (locations d k))
+checkKey d _ k = checkPresentGeneric d (locations d k)
+
+checkPresentGeneric :: FilePath -> [FilePath] -> Annex Bool
+checkPresentGeneric d ps = liftIO $
+ ifM (anyM doesFileExist ps)
( return True
, ifM (doesDirectoryExist d)
( return False
, giveup $ "directory " ++ d ++ " is not accessible"
)
)
+
+exportPath :: FilePath -> ExportLocation -> FilePath
+exportPath d (ExportLocation loc) = d </> loc
+
+storeExportDirectory :: FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
+storeExportDirectory d k loc p = sendAnnex k rollback send
+ where
+ dest = exportPath d loc
+ send src = liftIO $ catchBoolIO $ do
+ createDirectoryIfMissing True dest
+ withMeteredFile src p (L.writeFile dest)
+ return True
+ rollback = liftIO $ nukeFile dest
+
+retrieveExportDirectory :: FilePath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
+retrieveExportDirectory d _k loc dest p = unVerified $ liftIO $ catchBoolIO $ do
+ withMeteredFile src p (L.writeFile dest)
+ return True
+ where
+ src = exportPath d loc
+
+removeExportDirectory :: FilePath -> Key -> ExportLocation -> Annex Bool
+removeExportDirectory d _k loc = liftIO $ do
+ nukeFile src
+ void $ tryIO $ removeDirectory $ takeDirectory src
+ return True
+ where
+ src = exportPath d loc
+
+checkPresentExportDirectory :: FilePath -> Key -> ExportLocation -> Annex Bool
+checkPresentExportDirectory d _k loc =
+ checkPresentGeneric d [exportPath d loc]
+
+renameExportDirectory :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex Bool
+renameExportDirectory d _k oldloc newloc = liftIO $ catchBoolIO $ do
+ createDirectoryIfMissing True dest
+ renameFile src dest
+ void $ tryIO $ removeDirectory $ takeDirectory src
+ return True
+ where
+ src = exportPath d oldloc
+ dest = exportPath d newloc
diff --git a/Remote/External.hs b/Remote/External.hs
index 32b95e9bb..dd62c1539 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -85,6 +85,11 @@ gen r u c gc
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = towhereis
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 2ccc47ad8..95b7ae287 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -114,6 +114,11 @@ gen' r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = repoCheap r
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Git.hs b/Remote/Git.hs
index b48b48b52..020cd1c61 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -157,6 +157,11 @@ gen r u c gc
, lockContent = Just (lockKey new)
, checkPresent = inAnnex new
, checkPresentCheap = repoCheap r
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Nothing
, remoteFsck = if Git.repoIsUrl r
then Nothing
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index c2f9bcf12..be65cecb7 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -57,6 +57,11 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 0ebbf9139..2a9874242 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -51,6 +51,11 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/P2P.hs b/Remote/P2P.hs
index 118262b3c..d77ac89d8 100644
--- a/Remote/P2P.hs
+++ b/Remote/P2P.hs
@@ -57,6 +57,11 @@ chainGen addr r u c gc = do
, lockContent = Just (lock u addr connpool)
, checkPresent = checkpresent u addr connpool
, checkPresentCheap = False
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 4fc55d725..d40d23bae 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -73,6 +73,11 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/S3.hs b/Remote/S3.hs
index c05831b0b..ce6776595 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -84,6 +84,11 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Just (getWebUrls info)
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index e4686f2f2..cf65634b0 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -75,6 +75,11 @@ gen r u c gc = do
, lockContent = Nothing
, checkPresent = checkKey u hdl
, checkPresentCheap = False
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Just (getWhereisKey u)
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/Web.hs b/Remote/Web.hs
index be2f265e0..4d55389ec 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -50,6 +50,11 @@ gen r _ c gc =
, lockContent = Nothing
, checkPresent = checkKey
, checkPresentCheap = False
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 2c4d24c35..9230a027d 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -68,6 +68,11 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
, lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
+ , storeExport = Nothing
+ , retrieveExport = Nothing
+ , removeExport = Nothing
+ , checkPresentExport = Nothing
+ , renameExport = Nothing
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-30 04:24:36 +0000