convert WebDAV to new special remote interface, adding new-style chunking support

Reusing http connection when operating on chunks is not done yet,
I had to submit some patches to DAV to support that. However, this is no
slower than old-style chunking was.

Note that it's a fileRetriever and a fileStorer, despite DAV using
bytestrings that would allow streaming. As a result, upload/download of
encrypted files is made a bit more expensive, since it spools them to temp
files. This was needed to get the progress meters to work.

There are probably ways to avoid that.. But it turns out that the current
DAV interface buffers the whole file content in memory, and I have
sent in a patch to DAV to improve its interfaces. Using the new interfaces,
it's certainly going to need to be a fileStorer, in order to read the file
size from the file (getting the size of a bytestring would destroy
laziness). It should be possible to use the new interface to make it be a
byteRetriever, so I'll change that when I get to it.

This commit was sponsored by Andreas Olsson.

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)

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.
  -}

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
+	new cst = Just $ specialRemote c
-		(storeEncrypted this)
+		(prepareStore this chunkconfig)
-		(retrieveEncrypted this)
+		(prepareRetrieve this chunkconfig)
+		(prepareRemove this)
+		(prepareCheckPresent this chunkconfig)
 		this
 	  where
 		this = Remote {
 			uuid = u,
 			cost = cst,
 			name = Git.repoDescribe r,
-			storeKey = store this,
+			storeKey = storeKeyDummy,
-			retrieveKeyFile = retrieve this,
+			retrieveKeyFile = retreiveKeyFileDummy,
-			retrieveKeyFileCheap = retrieveCheap this,
+			retrieveKeyFileCheap = retrieveCheap,
-			removeKey = remove this,
+			removeKey = removeKeyDummy,
-			checkPresent = checkKey this,
+			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
+prepareStore :: Remote -> ChunkConfig -> Preparer Storer
-store r k _f p = metered (Just p) k $ \meterupdate ->
+prepareStore r chunkconfig = simplyPrepare $ fileStorer $ \k f p ->
-	davAction r False $ \(baseurl, user, pass) -> 
+	davAction r False $ \(baseurl, user, pass) -> liftIO $
-		sendAnnex k (void $ remove r k) $ \src ->
+		withMeteredFile f p $
-			liftIO $ withMeteredFile src meterupdate $
+			storeHelper chunkconfig k baseurl user pass
-				storeHelper r k baseurl user pass
 
-storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+storeHelper :: ChunkConfig -> Key -> DavUrl -> DavUser -> DavPass -> L.ByteString -> IO Bool
-storeEncrypted r (cipher, enck) k p = metered (Just p) k $ \meterupdate ->
+storeHelper chunkconfig k baseurl user pass b = do
-	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
 	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 :: Key -> FilePath -> Annex Bool
-retrieveCheap _ _ _ = return False
+retrieveCheap _ _ = return False
 
-retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+prepareRetrieve :: Remote -> ChunkConfig -> Preparer Retriever
-retrieve r k _f d p = metered (Just p) k $ \meterupdate ->
+prepareRetrieve r chunkconfig = simplyPrepare $ fileRetriever $ \d k p ->
-	davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $
+	davAction r onerr $ \(baseurl, user, pass) -> liftIO $
-		withStoredFiles r k baseurl user pass onerr $ \urls -> do
+		withStoredFiles chunkconfig k baseurl user pass onerr $ \urls -> do
-			Legacy.meteredWriteFileChunks meterupdate d urls $ \url -> 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
+	onerr = error "download failed"
 
-retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
+prepareRemove :: Remote -> Preparer Remover
-retrieveEncrypted r (cipher, enck) k d p = metered (Just p) k $ \meterupdate ->
+prepareRemove r = simplyPrepare $ \k ->
-	davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $
+	davAction r False $ \(baseurl, user, pass) -> liftIO $ do
-		withStoredFiles r enck baseurl user pass onerr $ \urls -> do
+		-- Delete the key's whole directory, including any
-			decrypt cipher (feeder user pass urls) $
+		-- legacy chunked files, etc, in a single action.
-				readBytes $ meteredWriteFile meterupdate d
+		let url = davLocation baseurl k
-			return True
+		isJust . eitherToMaybe <$> tryNonAsync (deleteDAV url user pass)
-  where
-	onerr _ = return False
 
-	feeder _ _ [] _ = noop
+prepareCheckPresent :: Remote -> ChunkConfig -> Preparer CheckPresent
-	feeder user pass (url:urls) h = do
+prepareCheckPresent r chunkconfig = simplyPrepare $ checkKey r chunkconfig
-		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
+checkKey :: Remote -> ChunkConfig -> Key -> Annex Bool
-remove r k = davAction r False $ \(baseurl, user, pass) -> liftIO $ do
+checkKey r chunkconfig k = davAction r noconn (either error id <$$> go)
-	-- 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)
   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
+withStoredFiles chunkconfig k baseurl user pass onerr a = case chunkconfig of
-	NoChunks -> a [keyurl]
-	UnpaddedChunks _ -> error "TODO: withStoredFiles with UnpaddedChunks"
 	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

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!

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