summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Remote/Helper/Encryptable.hs38
-rw-r--r--Remote/Helper/Special.hs4
-rw-r--r--Remote/WebDAV.hs130
-rw-r--r--debian/changelog2
-rw-r--r--doc/special_remotes/webdav.mdwn2
5 files changed, 54 insertions, 122 deletions
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index c364a69e7..dd032ce33 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -14,9 +14,7 @@ import Types.Remote
import Crypto
import Types.Crypto
import qualified Annex
-import Config.Cost
import Utility.Base64
-import Utility.Metered
{- Encryption setup for a remote. The user must specify whether to use
- an encryption key, or not encrypt. An encrypted cipher is created, or is
@@ -70,42 +68,6 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
-- remotes (while being backward-compatible).
[ "keyid", "keyid+", "keyid-", "highRandomQuality" ]
-{- Modifies a Remote to support encryption. -}
--- TODO: deprecated
-encryptableRemote
- :: RemoteConfig
- -> ((Cipher, Key) -> Key -> MeterUpdate -> Annex Bool)
- -> ((Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool)
- -> Remote
- -> Remote
-encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r = r
- { storeKey = \k f p -> cip k >>= maybe
- (storeKey r k f p)
- (\v -> storeKeyEncrypted v k p)
- , retrieveKeyFile = \k f d p -> cip k >>= maybe
- (retrieveKeyFile r k f d p)
- (\v -> retrieveKeyFileEncrypted v k d p)
- , retrieveKeyFileCheap = \k d -> cip k >>= maybe
- (retrieveKeyFileCheap r k d)
- (\_ -> return False)
- , removeKey = \k -> cip k >>= maybe
- (removeKey r k)
- (\(_, enckey) -> removeKey r enckey)
- , checkPresent = \k -> cip k >>= maybe
- (checkPresent r k)
- (\(_, enckey) -> checkPresent r enckey)
- , cost = maybe
- (cost r)
- (const $ cost r + encryptedRemoteCostAdj)
- (extractCipher c)
- }
- where
- cip k = do
- v <- cipherKey c
- return $ case v of
- Nothing -> Nothing
- Just (cipher, enck) -> Just (cipher, enck k)
-
{- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
- state. -}
remoteCipher :: RemoteConfig -> Annex (Maybe Cipher)
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index f8428aff7..fc0e11d2f 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -39,7 +39,7 @@ import Crypto
import Config.Cost
import Utility.Metered
import Remote.Helper.Chunked as X
-import Remote.Helper.Encryptable as X hiding (encryptableRemote)
+import Remote.Helper.Encryptable as X
import Remote.Helper.Messages
import Annex.Content
import Annex.Exception
@@ -119,7 +119,7 @@ byteRetriever :: (Key -> (L.ByteString -> Annex Bool) -> Annex Bool) -> Retrieve
byteRetriever a k _m callback = a k (callback . ByteContent)
{- The base Remote that is provided to specialRemote needs to have
- - storeKey, retreiveKeyFile, removeKey, and checkPresent methods,
+ - storeKey, retrieveKeyFile, removeKey, and checkPresent methods,
- but they are never actually used (since specialRemote replaces them).
- Here are some dummy ones.
-}
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index f0bcac10e..6679242e5 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -27,12 +27,9 @@ import qualified Git
import Config
import Config.Cost
import Remote.Helper.Special
-import Remote.Helper.Encryptable
import qualified Remote.Helper.Chunked.Legacy as Legacy
-import Crypto
import Creds
import Utility.Metered
-import Annex.Content
import Annex.UUID
import Remote.WebDAV.DavUrl
@@ -50,20 +47,22 @@ remote = RemoteType {
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
where
- new cst = Just $ encryptableRemote c
- (storeEncrypted this)
- (retrieveEncrypted this)
+ new cst = Just $ specialRemote c
+ (prepareStore this chunkconfig)
+ (prepareRetrieve this chunkconfig)
+ (prepareRemove this)
+ (prepareCheckPresent this chunkconfig)
this
where
this = Remote {
uuid = u,
cost = cst,
name = Git.repoDescribe r,
- storeKey = store this,
- retrieveKeyFile = retrieve this,
- retrieveKeyFileCheap = retrieveCheap this,
- removeKey = remove this,
- checkPresent = checkKey this,
+ storeKey = storeKeyDummy,
+ retrieveKeyFile = retreiveKeyFileDummy,
+ retrieveKeyFileCheap = retrieveCheap,
+ removeKey = removeKeyDummy,
+ checkPresent = checkPresentDummy,
checkPresentCheap = False,
whereisKey = Nothing,
remoteFsck = Nothing,
@@ -76,6 +75,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
availability = GloballyAvailable,
remotetype = remote
}
+ chunkconfig = getChunkConfig c
webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
webdavSetup mu mcreds c = do
@@ -89,95 +89,67 @@ webdavSetup mu mcreds c = do
c'' <- setRemoteCredPair c' (davCreds u) creds
return (c'', u)
-store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-store r k _f p = metered (Just p) k $ \meterupdate ->
- davAction r False $ \(baseurl, user, pass) ->
- sendAnnex k (void $ remove r k) $ \src ->
- liftIO $ withMeteredFile src meterupdate $
- storeHelper r k baseurl user pass
-
-storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted r (cipher, enck) k p = metered (Just p) k $ \meterupdate ->
- davAction r False $ \(baseurl, user, pass) ->
- sendAnnex k (void $ remove r enck) $ \src ->
- liftIO $ encrypt (getGpgEncParams r) cipher
- (streamMeteredFile src meterupdate) $
- readBytes $ storeHelper r enck baseurl user pass
-
-storeHelper :: Remote -> Key -> DavUrl -> DavUser -> DavPass -> L.ByteString -> IO Bool
-storeHelper r k baseurl user pass b = catchBoolIO $ do
+prepareStore :: Remote -> ChunkConfig -> Preparer Storer
+prepareStore r chunkconfig = simplyPrepare $ fileStorer $ \k f p ->
+ davAction r False $ \(baseurl, user, pass) -> liftIO $
+ withMeteredFile f p $
+ storeHelper chunkconfig k baseurl user pass
+
+storeHelper :: ChunkConfig -> Key -> DavUrl -> DavUser -> DavPass -> L.ByteString -> IO Bool
+storeHelper chunkconfig k baseurl user pass b = do
mkdirRecursiveDAV tmpurl user pass
case chunkconfig of
- NoChunks -> flip catchNonAsync (\e -> warningIO (show e) >> return False) $ do
- storehttp tmpurl b
- finalizer tmpurl keyurl
- return True
- UnpaddedChunks _ -> error "TODO: storeHelper with UnpaddedChunks"
LegacyChunks chunksize -> do
let storer urls = Legacy.storeChunked chunksize urls storehttp b
let recorder url s = storehttp url (L8.fromString s)
Legacy.storeChunks k tmpurl keyurl storer recorder finalizer
-
+ _ -> do
+ storehttp tmpurl b
+ finalizer tmpurl keyurl
+ return True
where
tmpurl = tmpLocation baseurl k
keyurl = davLocation baseurl k
- chunkconfig = getChunkConfig $ config r
finalizer srcurl desturl = do
void $ tryNonAsync (deleteDAV desturl user pass)
mkdirRecursiveDAV (urlParent desturl) user pass
moveDAV srcurl desturl user pass
storehttp url = putDAV url user pass
-retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
-retrieveCheap _ _ _ = return False
+retrieveCheap :: Key -> FilePath -> Annex Bool
+retrieveCheap _ _ = return False
-retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
-retrieve r k _f d p = metered (Just p) k $ \meterupdate ->
- davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $
- withStoredFiles r k baseurl user pass onerr $ \urls -> do
- Legacy.meteredWriteFileChunks meterupdate d urls $ \url -> do
+prepareRetrieve :: Remote -> ChunkConfig -> Preparer Retriever
+prepareRetrieve r chunkconfig = simplyPrepare $ fileRetriever $ \d k p ->
+ davAction r onerr $ \(baseurl, user, pass) -> liftIO $
+ withStoredFiles chunkconfig k baseurl user pass onerr $ \urls -> do
+ Legacy.meteredWriteFileChunks p d urls $ \url -> do
mb <- getDAV url user pass
case mb of
- Nothing -> throwIO "download failed"
+ Nothing -> onerr
Just b -> return b
- return True
- where
- onerr _ = return False
-
-retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
-retrieveEncrypted r (cipher, enck) k d p = metered (Just p) k $ \meterupdate ->
- davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $
- withStoredFiles r enck baseurl user pass onerr $ \urls -> do
- decrypt cipher (feeder user pass urls) $
- readBytes $ meteredWriteFile meterupdate d
- return True
where
- onerr _ = return False
-
- feeder _ _ [] _ = noop
- feeder user pass (url:urls) h = do
- mb <- getDAV url user pass
- case mb of
- Nothing -> throwIO "download failed"
- Just b -> do
- L.hPut h b
- feeder user pass urls h
-
-remove :: Remote -> Key -> Annex Bool
-remove r k = davAction r False $ \(baseurl, user, pass) -> liftIO $ do
- -- Delete the key's whole directory, including any chunked
- -- files, etc, in a single action.
- let url = davLocation baseurl k
- isJust . eitherToMaybe <$> tryNonAsync (deleteDAV url user pass)
-
-checkKey :: Remote -> Key -> Annex Bool
-checkKey r k = davAction r noconn (either error id <$$> go)
+ onerr = error "download failed"
+
+prepareRemove :: Remote -> Preparer Remover
+prepareRemove r = simplyPrepare $ \k ->
+ davAction r False $ \(baseurl, user, pass) -> liftIO $ do
+ -- Delete the key's whole directory, including any
+ -- legacy chunked files, etc, in a single action.
+ let url = davLocation baseurl k
+ isJust . eitherToMaybe <$> tryNonAsync (deleteDAV url user pass)
+
+prepareCheckPresent :: Remote -> ChunkConfig -> Preparer CheckPresent
+prepareCheckPresent r chunkconfig = simplyPrepare $ checkKey r chunkconfig
+
+checkKey :: Remote -> ChunkConfig -> Key -> Annex Bool
+checkKey r chunkconfig k = davAction r noconn (either error id <$$> go)
where
noconn = error $ name r ++ " not configured"
go (baseurl, user, pass) = do
showAction $ "checking " ++ name r
- liftIO $ withStoredFiles r k baseurl user pass onerr check
+ liftIO $ withStoredFiles chunkconfig k baseurl user pass onerr check
where
check [] = return $ Right True
check (url:urls) = do
@@ -196,7 +168,7 @@ checkKey r k = davAction r noconn (either error id <$$> go)
else v
withStoredFiles
- :: Remote
+ :: ChunkConfig
-> Key
-> DavUrl
-> DavUser
@@ -204,9 +176,7 @@ withStoredFiles
-> (DavUrl -> IO a)
-> ([DavUrl] -> IO a)
-> IO a
-withStoredFiles r k baseurl user pass onerr a = case chunkconfig of
- NoChunks -> a [keyurl]
- UnpaddedChunks _ -> error "TODO: withStoredFiles with UnpaddedChunks"
+withStoredFiles chunkconfig k baseurl user pass onerr a = case chunkconfig of
LegacyChunks _ -> do
let chunkcount = keyurl ++ Legacy.chunkCount
v <- getDAV chunkcount user pass
@@ -217,9 +187,9 @@ withStoredFiles r k baseurl user pass onerr a = case chunkconfig of
if null chunks
then onerr chunkcount
else a chunks
+ _ -> a [keyurl]
where
keyurl = davLocation baseurl k ++ keyFile k
- chunkconfig = getChunkConfig $ config r
davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a
davAction r unconfigured action = do
diff --git a/debian/changelog b/debian/changelog
index 8da5b87bb..6d13c9637 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,7 +1,7 @@
git-annex (5.20140718) UNRELEASED; urgency=medium
* New chunk= option to chunk files stored in special remotes.
- Supported by: directory, S3, gcrypt, rsync, and all external
+ Supported by: directory, S3, webdav, gcrypt, rsync, and all external
and hook special remotes.
* Partially transferred files are automatically resumed when using
chunked remotes!
diff --git a/doc/special_remotes/webdav.mdwn b/doc/special_remotes/webdav.mdwn
index 64eed5d0b..6b5f5b122 100644
--- a/doc/special_remotes/webdav.mdwn
+++ b/doc/special_remotes/webdav.mdwn
@@ -37,4 +37,4 @@ the webdav remote.
Setup example:
- # WEBDAV_USERNAME=joey@kitenet.net WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://dav.box.com/dav/git-annex chunksize=75mb keyid=joey@kitenet.net
+ # WEBDAV_USERNAME=joey@kitenet.net WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://dav.box.com/dav/git-annex chunk=10mb keyid=joey@kitenet.net
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-29 05:09:36 +0000