summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-01-20 13:23:11 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-01-20 13:23:11 -0400
commit61dbad505d648f13394018c31ce2d718c175007e (patch)
tree96f087d5ec3e3eab6cf45b5a7d49cfb2b0dfa7f7 /Remote
parente96726caa31fd76413b450790860611f71d13915 (diff)
fsck --from remote --fast
Avoids expensive file transfers, at the expense of checking file size and/or contents. Required some reworking of the remote code.
Diffstat (limited to 'Remote')
-rw-r--r--Remote/Bup.hs8
-rw-r--r--Remote/Directory.hs12
-rw-r--r--Remote/Git.hs25
-rw-r--r--Remote/Helper/Encryptable.hs8
-rw-r--r--Remote/Hook.hs8
-rw-r--r--Remote/Rsync.hs26
-rw-r--r--Remote/S3.hs8
-rw-r--r--Remote/Web.hs8
8 files changed, 70 insertions, 33 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 9a20d9e60..7329167da 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -50,6 +50,7 @@ gen r u c = do
name = Git.repoDescribe r,
storeKey = store r buprepo,
retrieveKeyFile = retrieve buprepo,
+ retrieveKeyFileCheap = retrieveCheap buprepo,
removeKey = remove,
hasKey = checkPresent r bupr',
hasKeyCheap = bupLocal buprepo,
@@ -118,13 +119,16 @@ storeEncrypted r buprepo (cipher, enck) k = do
withEncryptedHandle cipher (L.readFile src) $ \h ->
pipeBup params (Just h) Nothing
-retrieve :: BupRepo -> Key -> Bool -> FilePath -> Annex Bool
-retrieve buprepo k _ f = do
+retrieve :: BupRepo -> Key -> FilePath -> Annex Bool
+retrieve buprepo k f = do
let params = bupParams "join" buprepo [Param $ show k]
liftIO $ catchBoolIO $ do
tofile <- openFile f WriteMode
pipeBup params Nothing (Just tofile)
+retrieveCheap :: BupRepo -> Key -> FilePath -> Annex Bool
+retrieveCheap _ _ _ = return False
+
retrieveEncrypted :: BupRepo -> (Cipher, Key) -> FilePath -> Annex Bool
retrieveEncrypted buprepo (cipher, enck) f = do
let params = bupParams "join" buprepo [Param $ show enck]
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 5cdb89f33..52f426340 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -41,6 +41,7 @@ gen r u c = do
name = Git.repoDescribe r,
storeKey = store dir,
retrieveKeyFile = retrieve dir,
+ retrieveKeyFileCheap = retrieveCheap dir,
removeKey = remove dir,
hasKey = checkPresent dir,
hasKeyCheap = True,
@@ -109,11 +110,12 @@ storeHelper d key a = do
preventWrite dir
return ok
-retrieve :: FilePath -> Key -> Bool -> FilePath -> Annex Bool
-retrieve d k tmp f = liftIO $ withStoredFile d k $ \file ->
- if tmp
- then catchBoolIO $ createSymbolicLink file f >> return True
- else copyFileExternal file f
+retrieve :: FilePath -> Key -> FilePath -> Annex Bool
+retrieve d k f = liftIO $ withStoredFile d k $ \file -> copyFileExternal file f
+
+retrieveCheap :: FilePath -> Key -> FilePath -> Annex Bool
+retrieveCheap d k f = liftIO $ withStoredFile d k $ \file ->
+ catchBoolIO $ createSymbolicLink file f >> return True
retrieveEncrypted :: FilePath -> (Cipher, Key) -> FilePath -> Annex Bool
retrieveEncrypted d (cipher, enck) f =
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 2196292cd..efe182961 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -75,6 +75,7 @@ gen r u _ = do
name = Git.repoDescribe r',
storeKey = copyToRemote r',
retrieveKeyFile = copyFromRemote r',
+ retrieveKeyFileCheap = copyFromRemoteCheap r',
removeKey = dropKey r',
hasKey = inAnnex r',
hasKeyCheap = cheap,
@@ -198,20 +199,28 @@ dropKey r key
]
{- Tries to copy a key's content from a remote's annex to a file. -}
-copyFromRemote :: Git.Repo -> Key -> Bool -> FilePath -> Annex Bool
-copyFromRemote r key tmp file
+copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
+copyFromRemote r key file
| not $ Git.repoIsUrl r = do
params <- rsyncParams r
loc <- liftIO $ gitAnnexLocation key r
- if tmp
- then liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
- else rsyncOrCopyFile params loc file
- | Git.repoIsSsh r = do
- when tmp $ Annex.Content.preseedTmp key file
- rsyncHelper =<< rsyncParamsRemote r True key file
+ rsyncOrCopyFile params loc file
+ | Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file
| Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) file
| otherwise = error "copying from non-ssh, non-http repo not supported"
+copyFromRemoteCheap :: Git.Repo -> Key -> FilePath -> Annex Bool
+copyFromRemoteCheap r key file
+ | not $ Git.repoIsUrl r = do
+ loc <- liftIO $ gitAnnexLocation key r
+ liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
+ | Git.repoIsSsh r = do
+ ok <- Annex.Content.preseedTmp key file
+ if ok
+ then copyFromRemote r key file
+ else return False
+ | otherwise = return False
+
{- Tries to copy a key's content to a remote's annex. -}
copyToRemote :: Git.Repo -> Key -> Annex Bool
copyToRemote r key
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index ad99c3092..0569cb555 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -47,6 +47,7 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
r {
storeKey = store,
retrieveKeyFile = retrieve,
+ retrieveKeyFileCheap = retrieveCheap,
removeKey = withkey $ removeKey r,
hasKey = withkey $ hasKey r,
cost = cost r + encryptedRemoteCostAdj
@@ -55,9 +56,12 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
store k = cip k >>= maybe
(storeKey r k)
(`storeKeyEncrypted` k)
- retrieve k t f = cip k >>= maybe
- (retrieveKeyFile r k t f)
+ retrieve k f = cip k >>= maybe
+ (retrieveKeyFile r k f)
(`retrieveKeyFileEncrypted` f)
+ retrieveCheap k f = cip k >>= maybe
+ (retrieveKeyFileCheap r k f)
+ (\_ -> return False)
withkey a k = cip k >>= maybe (a k) (a . snd)
cip = cipherKey c
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 88124133a..a08c4011e 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -41,6 +41,7 @@ gen r u c = do
name = Git.repoDescribe r,
storeKey = store hooktype,
retrieveKeyFile = retrieve hooktype,
+ retrieveKeyFileCheap = retrieveCheap hooktype,
removeKey = remove hooktype,
hasKey = checkPresent r hooktype,
hasKeyCheap = False,
@@ -106,8 +107,11 @@ storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do
liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
runHook h "store" enck (Just tmp) $ return True
-retrieve :: String -> Key -> Bool -> FilePath -> Annex Bool
-retrieve h k _ f = runHook h "retrieve" k (Just f) $ return True
+retrieve :: String -> Key -> FilePath -> Annex Bool
+retrieve h k f = runHook h "retrieve" k (Just f) $ return True
+
+retrieveCheap :: String -> Key -> FilePath -> Annex Bool
+retrieveCheap _ _ _ = return False
retrieveEncrypted :: String -> (Cipher, Key) -> FilePath -> Annex Bool
retrieveEncrypted h (cipher, enck) f = withTmp enck $ \tmp ->
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index a1722fe17..8de6ba6a7 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -48,6 +48,7 @@ gen r u c = do
name = Git.repoDescribe r,
storeKey = store o,
retrieveKeyFile = retrieve o,
+ retrieveKeyFileCheap = retrieveCheap o,
removeKey = remove o,
hasKey = checkPresent r o,
hasKeyCheap = False,
@@ -102,19 +103,24 @@ storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
rsyncSend o enck tmp
-retrieve :: RsyncOpts -> Key -> Bool -> FilePath -> Annex Bool
-retrieve o k tmp f = untilTrue (rsyncUrls o k) $ \u -> do
- when tmp $ preseedTmp k f
- rsyncRemote o
- -- use inplace when retrieving to support resuming
- [ Param "--inplace"
- , Param u
- , Param f
- ]
+retrieve :: RsyncOpts -> Key -> FilePath -> Annex Bool
+retrieve o k f = untilTrue (rsyncUrls o k) $ \u -> rsyncRemote o
+ -- use inplace when retrieving to support resuming
+ [ Param "--inplace"
+ , Param u
+ , Param f
+ ]
+
+retrieveCheap :: RsyncOpts -> Key -> FilePath -> Annex Bool
+retrieveCheap o k f = do
+ ok <- preseedTmp k f
+ if ok
+ then retrieve o k f
+ else return False
retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> FilePath -> Annex Bool
retrieveEncrypted o (cipher, enck) f = withTmp enck $ \tmp -> do
- res <- retrieve o enck False tmp
+ res <- retrieve o enck tmp
if res
then liftIO $ catchBoolIO $ do
withDecryptedContent cipher (L.readFile tmp) $ L.writeFile f
diff --git a/Remote/S3.hs b/Remote/S3.hs
index b87944824..1d23b7d6f 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -53,6 +53,7 @@ gen' r u c cst =
name = Git.repoDescribe r,
storeKey = store this,
retrieveKeyFile = retrieve this,
+ retrieveKeyFileCheap = retrieveCheap this,
removeKey = remove this,
hasKey = checkPresent this,
hasKeyCheap = False,
@@ -149,8 +150,8 @@ storeHelper (conn, bucket) r k file = do
xheaders = filter isxheader $ M.assocs $ fromJust $ config r
isxheader (h, _) = "x-amz-" `isPrefixOf` h
-retrieve :: Remote -> Key -> Bool -> FilePath -> Annex Bool
-retrieve r k _ f = s3Action r False $ \(conn, bucket) -> do
+retrieve :: Remote -> Key -> FilePath -> Annex Bool
+retrieve r k f = s3Action r False $ \(conn, bucket) -> do
res <- liftIO $ getObject conn $ bucketKey r bucket k
case res of
Right o -> do
@@ -158,6 +159,9 @@ retrieve r k _ f = s3Action r False $ \(conn, bucket) -> do
return True
Left e -> s3Warning e
+retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
+retrieveCheap _ _ _ = return False
+
retrieveEncrypted :: Remote -> (Cipher, Key) -> FilePath -> Annex Bool
retrieveEncrypted r (cipher, enck) f = s3Action r False $ \(conn, bucket) -> do
res <- liftIO $ getObject conn $ bucketKey r bucket enck
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 6db3429eb..49c3f43f3 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -40,6 +40,7 @@ gen r _ _ =
name = Git.repoDescribe r,
storeKey = uploadKey,
retrieveKeyFile = downloadKey,
+ retrieveKeyFileCheap = downloadKeyCheap,
removeKey = dropKey,
hasKey = checkKey,
hasKeyCheap = False,
@@ -48,8 +49,8 @@ gen r _ _ =
remotetype = remote
}
-downloadKey :: Key -> Bool -> FilePath -> Annex Bool
-downloadKey key _ file = get =<< getUrls key
+downloadKey :: Key -> FilePath -> Annex Bool
+downloadKey key file = get =<< getUrls key
where
get [] = do
warning "no known url"
@@ -58,6 +59,9 @@ downloadKey key _ file = get =<< getUrls key
showOutput -- make way for download progress bar
downloadUrl urls file
+downloadKeyCheap :: Key -> FilePath -> Annex Bool
+downloadKeyCheap _ _ = return False
+
uploadKey :: Key -> Annex Bool
uploadKey _ = do
warning "upload to web not supported"