From e250f6f11f9f18210fbae8cded7edb9cc0939845 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 14 Nov 2012 19:32:27 -0400
Subject: [PATCH 01/12] factor out Creds

---
 Assistant/WebApp/Configurators/S3.hs |   2 +-
 Assistant/XMPP/Client.hs             |  25 ++----
 Creds.hs                             | 129 +++++++++++++++++++++++++++
 Remote/S3.hs                         | 105 ++++------------------
 Types/Remote.hs                      |   3 +-
 5 files changed, 157 insertions(+), 107 deletions(-)
 create mode 100644 Creds.hs

diff --git a/Assistant/WebApp/Configurators/S3.hs b/Assistant/WebApp/Configurators/S3.hs
index 42355ea4d7..8df47f1717 100644
--- a/Assistant/WebApp/Configurators/S3.hs
+++ b/Assistant/WebApp/Configurators/S3.hs
@@ -116,7 +116,7 @@ getEnableS3R uuid = s3Configurator $ do
 makeS3Remote :: S3Creds -> String -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
 makeS3Remote (S3Creds ak sk) name setup config = do
 	remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0
-	liftIO $ S3.s3SetCredsEnv ( T.unpack ak, T.unpack sk)
+	liftIO $ S3.s3SetCredsEnv (T.unpack ak, T.unpack sk)
 	r <- liftAssistant $ liftAnnex $ addRemote $ do
 		makeSpecialRemote name S3.remote config
 		return remotename
diff --git a/Assistant/XMPP/Client.hs b/Assistant/XMPP/Client.hs
index 8ab0c28579..c2a86cb411 100644
--- a/Assistant/XMPP/Client.hs
+++ b/Assistant/XMPP/Client.hs
@@ -8,8 +8,8 @@
 module Assistant.XMPP.Client where
 
 import Assistant.Common
-import Utility.FileMode
 import Utility.SRV
+import Creds
 
 import Network.Protocol.XMPP
 import Network
@@ -63,23 +63,12 @@ runClientError :: Server -> JID -> T.Text -> T.Text -> XMPP a -> IO a
 runClientError s j u p x = either (error . show) return =<< runClient s j u p x
 
 getXMPPCreds :: Annex (Maybe XMPPCreds)
-getXMPPCreds = do
-	f <- xmppCredsFile
-	s <- liftIO $ catchMaybeIO $ readFile f
-	return $ readish =<< s
+getXMPPCreds = parse <$> readCacheCreds xmppCredsFile
+  where
+	parse s = readish =<< s
 
 setXMPPCreds :: XMPPCreds -> Annex ()
-setXMPPCreds creds = do
-	f <- xmppCredsFile
-	liftIO $ do
-		createDirectoryIfMissing True (parentDir f)
-		h <- openFile f WriteMode
-		modifyFileMode f $ removeModes
-			[groupReadMode, otherReadMode]
-		hPutStr h (show creds)
-		hClose h	
+setXMPPCreds creds = writeCacheCreds (show creds) xmppCredsFile
 
-xmppCredsFile :: Annex FilePath
-xmppCredsFile = do
-	dir <- fromRepo gitAnnexCredsDir
-	return $ dir </> "xmpp"
+xmppCredsFile :: FilePath
+xmppCredsFile = "xmpp"
diff --git a/Creds.hs b/Creds.hs
new file mode 100644
index 0000000000..b907073f5d
--- /dev/null
+++ b/Creds.hs
@@ -0,0 +1,129 @@
+{- Credentials storage
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Creds where
+
+import Common.Annex
+import Annex.Perms
+import Utility.FileMode
+import Crypto
+import Types.Remote (RemoteConfig, RemoteConfigKey)
+import Remote.Helper.Encryptable (remoteCipher, isTrustedCipher)
+
+import System.Environment
+import System.Posix.Env (setEnv)
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.Map as M
+import Utility.Base64
+
+type Creds = String -- can be any data
+type CredPair = (String, String) -- login, password
+
+{- A CredPair can be stored in a file, or in the environment, or perhaps
+ - in a remote's configuration. -}
+data CredPairStorage = CredPairStorage
+	{ credPairFile :: FilePath
+	, credPairEnvironment :: (String, String)
+	, credPairRemoteKey :: Maybe RemoteConfigKey
+	}
+
+{- Stores creds in a remote's configuration, if the remote is encrypted
+ - with a GPG key. Otherwise, caches them locally. -}
+setRemoteCredPair :: RemoteConfig -> CredPairStorage -> Annex RemoteConfig
+setRemoteCredPair c storage = go =<< getRemoteCredPair c storage
+  where
+	go (Just creds) = do
+		mcipher <- remoteCipher c
+		case (mcipher, credPairRemoteKey storage) of
+			(Just cipher, Just key) | isTrustedCipher c -> do
+				s <- liftIO $ withEncryptedContent cipher
+					(return $ L.pack $ encodeCredPair creds)
+					(return . L.unpack)
+				return $ M.insert key (toB64 s) c
+			_ -> do
+				writeCacheCredPair creds storage
+				return c
+	go Nothing = return c
+
+{- Gets a remote's credpair, from the environment if set, otherwise
+ - from the cache in gitAnnexCredsDir, or failing that, from the encrypted
+ - value in RemoteConfig. -}
+getRemoteCredPair :: RemoteConfig -> CredPairStorage -> Annex (Maybe CredPair)
+getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv
+  where
+	fromenv = liftIO $ getEnvCredPair storage
+	fromcache = maybe fromconfig (return . Just) =<< readCacheCredPair storage
+	fromconfig = case credPairRemoteKey storage of
+		Just key -> do
+			mcipher <- remoteCipher c
+			case (M.lookup key c, mcipher) of
+				(Just enccreds, Just cipher) -> do
+					creds <- liftIO $ decrypt enccreds cipher
+					case decodeCredPair creds of
+						Just credpair -> do
+							writeCacheCredPair credpair storage 
+							return $ Just credpair
+						_ -> do error $ "bad " ++ key
+				_ -> return Nothing
+		Nothing -> return Nothing
+	decrypt enccreds cipher = withDecryptedContent cipher
+		(return $ L.pack $ fromB64 enccreds)
+		(return . L.unpack)
+
+{- Gets a CredPair from the environment. -}
+getEnvCredPair :: CredPairStorage -> IO (Maybe CredPair)
+getEnvCredPair storage = liftM2 (,)
+	<$> get uenv
+	<*> get penv
+  where
+	(uenv, penv) = credPairEnvironment storage
+	get = catchMaybeIO . getEnv
+
+{- Stores a CredPair in the environment. -}
+setEnvCredPair :: CredPair -> CredPairStorage -> IO ()
+setEnvCredPair (l, p) storage = do
+	set uenv l
+	set penv p
+  where
+	(uenv, penv) = credPairEnvironment storage
+	set var val = setEnv var val True
+
+writeCacheCredPair :: CredPair -> CredPairStorage -> Annex ()
+writeCacheCredPair credpair storage =
+	writeCacheCreds (encodeCredPair credpair) (credPairFile storage)
+
+{- Stores the creds in a file inside gitAnnexCredsDir that only the user
+ - can read. -}
+writeCacheCreds :: Creds -> FilePath -> Annex ()
+writeCacheCreds creds file = do
+	d <- fromRepo gitAnnexCredsDir
+	createAnnexDirectory d
+	liftIO $ do
+		let f = d </> file
+		h <- openFile f WriteMode
+		modifyFileMode f $ removeModes
+			[groupReadMode, otherReadMode]
+		hPutStr h creds
+		hClose h
+
+readCacheCredPair :: CredPairStorage -> Annex (Maybe CredPair)
+readCacheCredPair storage = maybe Nothing decodeCredPair
+	<$> readCacheCreds (credPairFile storage)
+
+readCacheCreds :: FilePath -> Annex (Maybe Creds)
+readCacheCreds file = do
+	d <- fromRepo gitAnnexCredsDir
+	let f = d </> file
+	liftIO $ catchMaybeIO $ readFile f
+
+encodeCredPair :: CredPair -> Creds
+encodeCredPair (l, p) = unlines [l, p]
+
+decodeCredPair :: Creds -> Maybe CredPair
+decodeCredPair creds = case lines creds of
+	l:p:[] -> Just (l, p)
+	_ -> Nothing
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 0c9d523b84..b05de6ad41 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -14,8 +14,6 @@ import Network.AWS.AWSResult
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.Map as M
 import Data.Char
-import System.Environment
-import System.Posix.Env (setEnv)
 
 import Common.Annex
 import Types.Remote
@@ -25,10 +23,8 @@ import Config
 import Remote.Helper.Special
 import Remote.Helper.Encryptable
 import Crypto
+import Creds
 import Annex.Content
-import Utility.Base64
-import Annex.Perms
-import Utility.FileMode
 
 remote :: RemoteType
 remote = RemoteType {
@@ -87,7 +83,7 @@ s3Setup u c = handlehost $ M.lookup "host" c
 
 	use fullconfig = do
 		gitConfigSpecialRemote u fullconfig "s3" "true"
-		s3SetCreds fullconfig u
+		setRemoteCredPair fullconfig (s3Creds u)
 
 	defaulthost = do
 		c' <- encryptionSetup c
@@ -257,93 +253,28 @@ s3ConnectionRequired c u =
 	maybe (error "Cannot connect to S3") return =<< s3Connection c u
 
 s3Connection :: RemoteConfig -> UUID -> Annex (Maybe AWSConnection)
-s3Connection c u = do
-	creds <- s3GetCreds c u
-	case creds of
-		Just (ak, sk) -> return $ Just $ AWSConnection host port ak sk
-		_ -> do
-			warning $ "Set both " ++ s3AccessKey ++ " and " ++ s3SecretKey  ++ " to use S3"
-			return Nothing
+s3Connection c u = go =<< getRemoteCredPair c creds
   where
+	go Nothing = do
+		warning $ "Set both " ++ s3AccessKey ++ " and " ++ s3SecretKey  ++ " to use S3"
+		return Nothing
+	go (Just (ak, sk)) = return $ Just $ AWSConnection host port ak sk
+
+	creds = s3Creds u
+	(s3AccessKey, s3SecretKey) = credPairEnvironment creds
+
 	host = fromJust $ M.lookup "host" c
 	port = let s = fromJust $ M.lookup "port" c in
 		case reads s of
 		[(p, _)] -> p
 		_ -> error $ "bad S3 port value: " ++ s
 
-{- S3 creds come from the environment if set, otherwise from the cache
- - in gitAnnexCredsDir, or failing that, might be stored encrypted in
- - the remote's config. -}
-s3GetCreds :: RemoteConfig -> UUID -> Annex (Maybe (String, String))
-s3GetCreds c u = maybe fromcache (return . Just) =<< liftIO getenv
-  where
-	getenv = liftM2 (,)
-		<$> get s3AccessKey
-		<*> get s3SecretKey
-	  where
-		get = catchMaybeIO . getEnv
-	fromcache = do
-		d <- fromRepo gitAnnexCredsDir
-		let f = d </> fromUUID u
-		v <- liftIO $ catchMaybeIO $ readFile f
-		case lines <$> v of
-			Just (ak:sk:[]) -> return $ Just (ak, sk)
-			_ -> fromconfig
-	fromconfig = do
-		mcipher <- remoteCipher c
-		case (M.lookup "s3creds" c, mcipher) of
-			(Just s3creds, Just cipher) -> do
-				creds <- liftIO $ decrypt s3creds cipher
-				case creds of
-					[ak, sk] -> do
-						s3CacheCreds (ak, sk) u
-						return $ Just (ak, sk)
-					_ -> do error "bad s3creds"		
-			_ -> return Nothing
-	decrypt s3creds cipher = lines 
-		<$> withDecryptedContent cipher
-			(return $ L.pack $ fromB64 s3creds)
-			(return . L.unpack)
+s3Creds :: UUID -> CredPairStorage
+s3Creds u = CredPairStorage
+	{ credPairFile = fromUUID u
+	, credPairEnvironment = ("AWS_ACCESS_KEY_ID", "AWS_SECRET_ACCESS_KEY")
+	, credPairRemoteKey = Just "s3creds"
+	}
 
-{- Stores S3 creds encrypted in the remote's config if possible to do so
- - securely, and otherwise locally in gitAnnexCredsDir. -}
-s3SetCreds :: RemoteConfig -> UUID -> Annex RemoteConfig
-s3SetCreds c u = do
-	creds <- s3GetCreds c u
-	case creds of
-		Just (ak, sk) -> do
-			mcipher <- remoteCipher c
-			case mcipher of
-				Just cipher | isTrustedCipher c -> do
-					s <- liftIO $ withEncryptedContent cipher
-						(return $ L.pack $ unlines [ak, sk])
-						(return . L.unpack)
-					return $ M.insert "s3creds" (toB64 s) c
-				_ -> do
-					s3CacheCreds (ak, sk) u
-					return c
-		_ -> return c
-
-{- The S3 creds are cached in gitAnnexCredsDir. -}
-s3CacheCreds :: (String, String) -> UUID -> Annex ()
-s3CacheCreds (ak, sk) u = do
-	d <- fromRepo gitAnnexCredsDir
-	createAnnexDirectory d
-	liftIO $ do
-		let f = d </> fromUUID u
-		h <- openFile f WriteMode
-		modifyFileMode f $ removeModes
-			[groupReadMode, otherReadMode]
-		hPutStr h $ unlines [ak, sk]
-		hClose h
-
-{- Sets the S3 creds in the environment. -}
 s3SetCredsEnv :: (String, String) -> IO ()
-s3SetCredsEnv (ak, sk) = do
-	setEnv s3AccessKey ak True
-	setEnv s3SecretKey sk True
-
-s3AccessKey :: String
-s3AccessKey = "AWS_ACCESS_KEY_ID"
-s3SecretKey :: String
-s3SecretKey = "AWS_SECRET_ACCESS_KEY"
+s3SetCredsEnv creds = setEnvCredPair creds $ s3Creds undefined
diff --git a/Types/Remote.hs b/Types/Remote.hs
index d31d9a78fd..572240de05 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -16,7 +16,8 @@ import qualified Git
 import Types.Key
 import Types.UUID
 
-type RemoteConfig = M.Map String String
+type RemoteConfigKey = String
+type RemoteConfig = M.Map RemoteConfigKey String
 
 {- There are different types of remotes. -}
 data RemoteTypeA a = RemoteType {

From 0cba0cb2dd007181a089c791509c8c7df971d7c8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 14 Nov 2012 20:25:00 -0400
Subject: [PATCH 02/12] skeltal webdav special remote

Doesn't actually store anything yet, but initremote works and tests the
server.
---
 Makefile                        |   2 +-
 Remote/List.hs                  |   6 ++
 Remote/WebDAV.hs                | 157 ++++++++++++++++++++++++++++++++
 debian/control                  |   1 +
 doc/install/fromscratch.mdwn    |   1 +
 doc/special_remotes/webdav.mdwn |  36 ++++++++
 git-annex.cabal                 |   7 ++
 7 files changed, 209 insertions(+), 1 deletion(-)
 create mode 100644 Remote/WebDAV.hs
 create mode 100644 doc/special_remotes/webdav.mdwn

diff --git a/Makefile b/Makefile
index a98949e088..7a75598972 100644
--- a/Makefile
+++ b/Makefile
@@ -7,7 +7,7 @@ BASEFLAGS=-Wall -outputdir $(GIT_ANNEX_TMP_BUILD_DIR) -IUtility
 #
 # If you're using an old version of yesod, enable -DWITH_OLD_YESOD
 # Or with an old version of the uri library, enable -DWITH_OLD_URI
-FEATURES?=$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBAPP -DWITH_PAIRING -DWITH_XMPP -DWITH_DNS
+FEATURES?=$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBDAV -DWITH_WEBAPP -DWITH_PAIRING -DWITH_XMPP -DWITH_DNS
 
 bins=git-annex
 mans=git-annex.1 git-annex-shell.1
diff --git a/Remote/List.hs b/Remote/List.hs
index ea1d61ce3d..a25533bb19 100644
--- a/Remote/List.hs
+++ b/Remote/List.hs
@@ -29,6 +29,9 @@ import qualified Remote.Bup
 import qualified Remote.Directory
 import qualified Remote.Rsync
 import qualified Remote.Web
+#ifdef WITH_WEBDAV
+import qualified Remote.WebDAV
+#endif
 import qualified Remote.Hook
 
 remoteTypes :: [RemoteType]
@@ -41,6 +44,9 @@ remoteTypes =
 	, Remote.Directory.remote
 	, Remote.Rsync.remote
 	, Remote.Web.remote
+#ifdef WITH_WEBDAV
+	, Remote.WebDAV.remote
+#endif
 	, Remote.Hook.remote
 	]
 
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
new file mode 100644
index 0000000000..e110113514
--- /dev/null
+++ b/Remote/WebDAV.hs
@@ -0,0 +1,157 @@
+{- WebDAV remotes.
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Remote.WebDAV (remote) where
+
+import Network.Protocol.HTTP.DAV
+import qualified Data.Map as M
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy.Char8 as L8
+import qualified Text.XML as XML
+import Data.Default
+
+import Common.Annex
+import Types.Remote
+import qualified Git
+import Config
+import Remote.Helper.Special
+import Remote.Helper.Encryptable
+import Crypto
+import Creds
+import Annex.Content
+
+remote :: RemoteType
+remote = RemoteType {
+	typename = "webdav",
+	enumerate = findSpecialRemotes "webdav",
+	generate = gen,
+	setup = webdavSetup
+}
+
+gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
+gen r u c = do
+	cst <- remoteCost r expensiveRemoteCost
+	return $ gen' r u c cst
+gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote
+gen' r u c cst =
+	encryptableRemote c
+		(storeEncrypted this)
+		(retrieveEncrypted this)
+		this
+  where
+	this = Remote {
+		uuid = u,
+		cost = cst,
+		name = Git.repoDescribe r,
+ 		storeKey = store this,
+		retrieveKeyFile = retrieve this,
+		retrieveKeyFileCheap = retrieveCheap this,
+		removeKey = remove this,
+		hasKey = checkPresent this,
+		hasKeyCheap = False,
+		whereisKey = Nothing,
+		config = c,
+		repo = r,
+		localpath = Nothing,
+		readonly = False,
+		remotetype = remote
+	}
+
+webdavSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
+webdavSetup u c = do
+	let url = fromMaybe (error "Specify url=") $
+		M.lookup "url" c
+	c' <- encryptionSetup c
+	creds <- getCreds c' u
+	testDav url creds
+	gitConfigSpecialRemote u c' "webdav" "true"
+	setRemoteCredPair c (davCreds u)
+
+store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
+store r k _f _p = davAction r False $ \creds -> do
+	error "TODO"
+
+storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+storeEncrypted r (cipher, enck) k _p = davAction r False $ \creds -> do
+	error "TODO"
+
+retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieve r k _f d = davAction r False $ \creds -> do
+	error "TODO"
+
+retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
+retrieveCheap _ _ _ = return False
+
+retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
+retrieveEncrypted r (cipher, enck) _ f = davAction r False $ \creds -> do
+	error "TODO"
+
+remove :: Remote -> Key -> Annex Bool
+remove r k = davAction r False $ \creds -> do
+	error "TODO"
+
+checkPresent :: Remote -> Key -> Annex (Either String Bool)
+checkPresent r k = davAction r noconn $ \creds -> do
+	showAction $ "checking " ++ name r
+	error "TODO"
+  where
+	noconn = Left $ error $ name r ++ " not configured"
+
+davAction :: Remote -> a -> (CredPair -> Annex a) -> Annex a
+davAction r unconfigured action = case config r of
+	Nothing -> return unconfigured
+	Just c -> maybe (return unconfigured) action =<< getCreds c (uuid r)
+
+davUrl :: String -> FilePath -> String
+davUrl baseurl file = baseurl </> file
+
+{- Test if a WebDAV store is usable, by writing to a test file, and then
+ - deleting the file. Exits with an error if not. -}
+testDav :: String -> Maybe CredPair -> Annex ()
+testDav baseurl Nothing = error "Need to configure webdav username and password."
+testDav baseurl (Just (u, p)) = do
+	showSideAction "testing WebDAV server"
+	liftIO $ do
+		putContentAndProps testurl username password
+			(dummyProps, (contentType, L.empty))
+		-- TODO delete testurl
+  where
+	username = B8.pack u
+	password = B8.pack p
+	testurl = davUrl baseurl "git-annex-test"
+
+{- Content-Type to use for files uploaded to WebDAV. -}
+contentType :: Maybe B8.ByteString
+contentType = Just $ B8.pack "application/octet-stream"
+
+{- The DAV library requires that properties be specified when storing a file.
+ - 
+ - Also, it has a bug where if no properties are present, it generates an
+ - invalid XML document, that will make putContentAndProps fail.
+ - 
+ - We don't really need to store any properties, so this is an
+ - XML document that stores a single dummy property. -}
+dummyProps :: XML.Document
+dummyProps = XML.parseLBS_ def $ L8.pack
+	"<D:multistatus xmlns:D=\"DAV:\"><D:response><D:propstat><D:prop><D:gitannex></D:gitannex></D:prop></D:propstat></D:response></D:multistatus>"
+
+getCreds :: RemoteConfig -> UUID -> Annex (Maybe CredPair)
+getCreds c u = maybe missing (return . Just) =<< getRemoteCredPair c creds
+  where
+	creds = davCreds u
+	(loginvar, passwordvar) = credPairEnvironment creds
+	missing = do
+		warning $ "Set both " ++ loginvar ++ " and " ++ passwordvar ++ " to use webdav"
+		return Nothing
+
+davCreds :: UUID -> CredPairStorage
+davCreds u = CredPairStorage
+        { credPairFile = fromUUID u
+        , credPairEnvironment = ("WEBDAV_USERNAME", "WEBDAV_PASSWORD")
+        , credPairRemoteKey = Just "davcreds"
+        }
diff --git a/debian/control b/debian/control
index a7ffe7f891..a80dca3cbb 100644
--- a/debian/control
+++ b/debian/control
@@ -12,6 +12,7 @@ Build-Depends:
 	libghc-http-dev,
 	libghc-utf8-string-dev,
 	libghc-hs3-dev (>= 0.5.6),
+	libghc-dav-dev,
 	libghc-testpack-dev,
 	libghc-quickcheck2-dev,
 	libghc-monad-control-dev (>= 0.3),
diff --git a/doc/install/fromscratch.mdwn b/doc/install/fromscratch.mdwn
index 000bc8451b..49dd1302e3 100644
--- a/doc/install/fromscratch.mdwn
+++ b/doc/install/fromscratch.mdwn
@@ -18,6 +18,7 @@ quite a lot.
   * [bloomfilter](http://hackage.haskell.org/package/bloomfilter)
   * [edit-distance](http://hackage.haskell.org/package/edit-distance)
   * [hS3](http://hackage.haskell.org/package/hS3) (optional)
+  * [DAV](http://hackage.haskell.org/package/DAV) (optional)
   * [SafeSemaphore](http://hackage.haskell.org/package/SafeSemaphore)
 * Optional haskell stuff, used by the [[assistant]] and its webapp (edit Makefile to disable)
   * [stm](http://hackage.haskell.org/package/stm)
diff --git a/doc/special_remotes/webdav.mdwn b/doc/special_remotes/webdav.mdwn
new file mode 100644
index 0000000000..5cc5c55d9d
--- /dev/null
+++ b/doc/special_remotes/webdav.mdwn
@@ -0,0 +1,36 @@
+This special remote type stores file contents in a WebDAV server.
+
+## configuration
+
+The environment variables `WEBDAV_USERNAME` and `WEBDAV_PASSWORD` are used
+to supply login credentials. When encryption is enabled, they are stored in
+encrypted form by `git annex initremote`. Without encryption, they are
+stored in a file only you can read inside the local git repository. So you
+do not need to keep the environment variables set after the initial
+initalization of the remote.
+
+A number of parameters can be passed to `git annex initremote` to configure
+the webdav remote.
+
+* `encryption` - Required. Either "none" to disable encryption
+  (not recommended),
+  or a value that can be looked up (using gpg -k) to find a gpg encryption
+  key that will be given access to the remote. Note that additional gpg
+  keys can be given access to a remote by rerunning initremote with
+  the new key id. See [[encryption]].
+
+* `url` - Required. The URL to the WebDAV directory where files will be
+  stored. This directory must already exist. Use of a https URL is strongly
+  encouraged, since HTTP basic authentication is used.
+
+* `chunksize` - Avoid storing files larger than the specified size in
+  WebDAV. For use when the WebDAV server has file size
+  limitations. The default is to never chunk files.  
+  The value can use specified using any commonly used units.
+  Example: `chunksize=100 megabytes`  
+  Note that enabling chunking on an existing remote with non-chunked
+  files is not recommended.
+
+Setup example:
+
+	# WEBDAV_USERNAME=joey@kitenet.net WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://www.box.com/dav/ encryption=joey@kitenet.net
diff --git a/git-annex.cabal b/git-annex.cabal
index e993343ca8..afbb475133 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -28,6 +28,9 @@ Description:
 Flag S3
   Description: Enable S3 support
 
+Flag WebDAV
+  Description: Enable WebDAV support
+
 Flag Inotify
   Description: Enable inotify support
 
@@ -69,6 +72,10 @@ Executable git-annex
     Build-Depends: hS3
     CPP-Options: -DWITH_S3
 
+  if flag(WebDAV)
+    Build-Depends: DAV
+    CPP-Options: -DWITH_WebDAV
+
   if flag(Assistant) && ! os(windows) && ! os(solaris)
     Build-Depends: stm >= 2.3
     CPP-Options: -DWITH_ASSISTANT

From 3c039d329c3305401d17cc080bac7b257be8b037 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 15 Nov 2012 13:46:16 -0400
Subject: [PATCH 03/12] update to dav 0.1, and basic uploading is working!

---
 Assistant/NetMessager.hs |  1 -
 Remote/S3.hs             |  4 +--
 Remote/WebDAV.hs         | 73 +++++++++++++++++++++++++++-------------
 debian/control           |  2 +-
 git-annex.cabal          |  2 +-
 5 files changed, 53 insertions(+), 29 deletions(-)

diff --git a/Assistant/NetMessager.hs b/Assistant/NetMessager.hs
index 05dfd05a34..2191e06f2f 100644
--- a/Assistant/NetMessager.hs
+++ b/Assistant/NetMessager.hs
@@ -9,7 +9,6 @@ module Assistant.NetMessager where
 
 import Assistant.Common
 import Assistant.Types.NetMessager
-import qualified Git
 
 import Control.Concurrent
 import Control.Concurrent.STM
diff --git a/Remote/S3.hs b/Remote/S3.hs
index b05de6ad41..67a64e4646 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -112,8 +112,8 @@ s3Setup u c = handlehost $ M.lookup "host" c
 
 store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store r k _f _p = s3Action r False $ \(conn, bucket) -> do
-	dest <- inRepo $ gitAnnexLocation k
-	res <- liftIO $ storeHelper (conn, bucket) r k dest
+	src <- inRepo $ gitAnnexLocation k
+	res <- liftIO $ storeHelper (conn, bucket) r k src
 	s3Bool res
 
 storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index e110113514..9d6efb51ed 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -9,11 +9,10 @@ module Remote.WebDAV (remote) where
 
 import Network.Protocol.HTTP.DAV
 import qualified Data.Map as M
-import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteString.UTF8 as B8
 import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Lazy.Char8 as L8
+import qualified Data.Text as T
 import qualified Text.XML as XML
-import Data.Default
 
 import Common.Annex
 import Types.Remote
@@ -25,6 +24,10 @@ import Crypto
 import Creds
 import Annex.Content
 
+type DavUrl = String
+type DavUser = B8.ByteString
+type DavPass = B8.ByteString
+
 remote :: RemoteType
 remote = RemoteType {
 	typename = "webdav",
@@ -73,8 +76,14 @@ webdavSetup u c = do
 	setRemoteCredPair c (davCreds u)
 
 store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-store r k _f _p = davAction r False $ \creds -> do
-	error "TODO"
+store r k _f _p = do
+	f <- inRepo $ gitAnnexLocation k
+	davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $ do
+		content <- L.readFile f
+		let url = Prelude.head $ davLocations baseurl k
+		putContentAndProps url user pass
+			(noProps, (contentType, content))
+		return True
 
 storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 storeEncrypted r (cipher, enck) k _p = davAction r False $ \creds -> do
@@ -98,17 +107,37 @@ remove r k = davAction r False $ \creds -> do
 checkPresent :: Remote -> Key -> Annex (Either String Bool)
 checkPresent r k = davAction r noconn $ \creds -> do
 	showAction $ "checking " ++ name r
-	error "TODO"
+	return $ Right False
+	--error "TODO"
   where
 	noconn = Left $ error $ name r ++ " not configured"
 
-davAction :: Remote -> a -> (CredPair -> Annex a) -> Annex a
+davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a
 davAction r unconfigured action = case config r of
 	Nothing -> return unconfigured
-	Just c -> maybe (return unconfigured) action =<< getCreds c (uuid r)
+	Just c -> do
+		mcreds <- getCreds c (uuid r)
+		case (mcreds, M.lookup "url" c) of
+			(Just (user, pass), Just url) ->
+				action (url, toDavUser user, toDavPass pass)
+			_ -> return unconfigured
 
-davUrl :: String -> FilePath -> String
-davUrl baseurl file = baseurl </> file
+toDavUser :: String -> DavUser
+toDavUser = B8.fromString
+
+toDavPass :: String -> DavPass
+toDavPass = B8.fromString
+
+{- All possibile locations to try to access a given Key.
+ -
+ - This is intentially the same as the directory special remote uses, to
+ - allow interoperability. -}
+davLocations :: DavUrl -> Key -> [DavUrl]
+davLocations baseurl k = map (davUrl baseurl) (keyPaths k)
+
+{- FIXME: Replacing / with _ to avoid needing collections. -}
+davUrl :: DavUrl -> FilePath -> DavUrl
+davUrl baseurl file = baseurl </> replace "/" "_" file
 
 {- Test if a WebDAV store is usable, by writing to a test file, and then
  - deleting the file. Exits with an error if not. -}
@@ -118,27 +147,23 @@ testDav baseurl (Just (u, p)) = do
 	showSideAction "testing WebDAV server"
 	liftIO $ do
 		putContentAndProps testurl username password
-			(dummyProps, (contentType, L.empty))
-		-- TODO delete testurl
+			(noProps, (contentType, L.empty))
+		deleteContent testurl username password
   where
-	username = B8.pack u
-	password = B8.pack p
+	username = toDavUser u
+	password = toDavPass p
 	testurl = davUrl baseurl "git-annex-test"
 
 {- Content-Type to use for files uploaded to WebDAV. -}
 contentType :: Maybe B8.ByteString
-contentType = Just $ B8.pack "application/octet-stream"
+contentType = Just $ B8.fromString "application/octet-stream"
 
 {- The DAV library requires that properties be specified when storing a file.
- - 
- - Also, it has a bug where if no properties are present, it generates an
- - invalid XML document, that will make putContentAndProps fail.
- - 
- - We don't really need to store any properties, so this is an
- - XML document that stores a single dummy property. -}
-dummyProps :: XML.Document
-dummyProps = XML.parseLBS_ def $ L8.pack
-	"<D:multistatus xmlns:D=\"DAV:\"><D:response><D:propstat><D:prop><D:gitannex></D:gitannex></D:prop></D:propstat></D:response></D:multistatus>"
+ - This just omits any real properties. -}
+noProps :: XML.Document
+noProps = XML.Document (XML.Prologue [] Nothing []) root []
+  where
+    root = XML.Element (XML.Name (T.pack "propertyupdate") Nothing Nothing) [] []
 
 getCreds :: RemoteConfig -> UUID -> Annex (Maybe CredPair)
 getCreds c u = maybe missing (return . Just) =<< getRemoteCredPair c creds
diff --git a/debian/control b/debian/control
index a80dca3cbb..74d9c0c6a1 100644
--- a/debian/control
+++ b/debian/control
@@ -12,7 +12,7 @@ Build-Depends:
 	libghc-http-dev,
 	libghc-utf8-string-dev,
 	libghc-hs3-dev (>= 0.5.6),
-	libghc-dav-dev,
+	libghc-dav-dev (>= 0.1),
 	libghc-testpack-dev,
 	libghc-quickcheck2-dev,
 	libghc-monad-control-dev (>= 0.3),
diff --git a/git-annex.cabal b/git-annex.cabal
index afbb475133..8db659fbf3 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -73,7 +73,7 @@ Executable git-annex
     CPP-Options: -DWITH_S3
 
   if flag(WebDAV)
-    Build-Depends: DAV
+    Build-Depends: DAV (>= 0.1)
     CPP-Options: -DWITH_WebDAV
 
   if flag(Assistant) && ! os(windows) && ! os(solaris)

From 16840ee7996b41e264b9ba2c6fb6d6acaa32d694 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 15 Nov 2012 15:42:07 -0400
Subject: [PATCH 04/12] document webdav config

---
 doc/git-annex.mdwn | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 842139c2b2..474a6a09b6 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -885,6 +885,11 @@ Here are all the supported configuration settings.
   Used to identify Amazon S3 special remotes.
   Normally this is automaticaly set up by `git annex initremote`.
 
+* `remote.<name>.webdav`
+
+  Used to identify webdav special remotes.
+  Normally this is automaticaly set up by `git annex initremote`.
+
 * `remote.<name>.annex-xmppaddress`
 
   Used to identify the XMPP address of a Jabber buddy.

From a4b86c63d62ace214cb065097557d70079de1fb4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 16 Nov 2012 00:09:22 -0400
Subject: [PATCH 05/12] webdav is fully working in non-enctypted mode

---
 Remote/WebDAV.hs                | 121 ++++++++++++++++++++++++++------
 debian/control                  |   2 +-
 doc/special_remotes/webdav.mdwn |   5 +-
 git-annex.cabal                 |   2 +-
 4 files changed, 105 insertions(+), 25 deletions(-)

diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 9d6efb51ed..3747e81794 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module Remote.WebDAV (remote) where
 
 import Network.Protocol.HTTP.DAV
@@ -13,6 +15,10 @@ import qualified Data.ByteString.UTF8 as B8
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Text as T
 import qualified Text.XML as XML
+import Network.URI (normalizePathSegments)
+import qualified Control.Exception as E
+import Network.HTTP.Conduit (HttpException(..))
+import Network.HTTP.Types
 
 import Common.Annex
 import Types.Remote
@@ -22,7 +28,6 @@ import Remote.Helper.Special
 import Remote.Helper.Encryptable
 import Crypto
 import Creds
-import Annex.Content
 
 type DavUrl = String
 type DavUser = B8.ByteString
@@ -78,20 +83,29 @@ webdavSetup u c = do
 store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store r k _f _p = do
 	f <- inRepo $ gitAnnexLocation k
-	davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $ do
-		content <- L.readFile f
+	davAction r False $ \(baseurl, user, pass) -> liftIO $ do
 		let url = Prelude.head $ davLocations baseurl k
-		putContentAndProps url user pass
-			(noProps, (contentType, content))
-		return True
+		davMkdir (urlParent url) user pass
+		b <- L.readFile f
+		v <- catchMaybeHttp $ putContentAndProps url user pass
+			(noProps, (contentType, b))
+		return $ isJust v
 
 storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted r (cipher, enck) k _p = davAction r False $ \creds -> do
+storeEncrypted r (cipher, enck) k _p = davAction r False $ \creds -> liftIO $ do
 	error "TODO"
 
 retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieve r k _f d = davAction r False $ \creds -> do
-	error "TODO"
+retrieve r k _f d = davAction r False $ liftIO . go
+  where
+	go (baseurl, user, pass) = get $ davLocations baseurl k
+	  where
+		get [] = return False
+		get (u:urls) = maybe (get urls) save
+			=<< catchMaybeHttp (getPropsAndContent u user pass)
+		save (_, (_, b)) = do
+			L.writeFile d b
+			return True
 
 retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
@@ -101,16 +115,41 @@ retrieveEncrypted r (cipher, enck) _ f = davAction r False $ \creds -> do
 	error "TODO"
 
 remove :: Remote -> Key -> Annex Bool
-remove r k = davAction r False $ \creds -> do
-	error "TODO"
+remove r k = davAction r False $ liftIO . go
+  where
+	go (baseurl, user, pass) = delone $ davLocations baseurl k
+	  where
+		delone [] = return False
+		delone (u:urls) = maybe (delone urls) (const $ return True)
+			=<< catchMaybeHttp (deletedir u)
+
+		{- Rather than deleting first the file, and then its
+		 - immediate parent directory (to clean up), delete the
+		 - parent directory, along with all its contents in a
+		 - single recursive DAV call.
+		 - 
+		 - The file is the only thing we keep in there, and this
+		 - is faster. -}
+		deletedir u = deleteContent (urlParent u) user pass
 
 checkPresent :: Remote -> Key -> Annex (Either String Bool)
-checkPresent r k = davAction r noconn $ \creds -> do
-	showAction $ "checking " ++ name r
-	return $ Right False
-	--error "TODO"
+checkPresent r k = davAction r noconn go
   where
 	noconn = Left $ error $ name r ++ " not configured"
+	go (baseurl, user, pass) = do
+		showAction $ "checking " ++ name r
+		liftIO $ check $ davLocations baseurl k	
+	  where
+		check [] = return $ Right False
+		check (u:urls) = do
+			v <- catchHttp $ getProps u user pass
+			case v of
+				Right _ -> return $ Right True
+				Left (Left (StatusCodeException status _))
+					| statusCode status == statusCode notFound404 -> check urls
+					| otherwise -> return $ Left $ show $ statusMessage status
+				Left (Left httpexception) -> return $ Left $ show httpexception
+				Left (Right ioexception) -> return $ Left $ show ioexception
 
 davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a
 davAction r unconfigured action = case config r of
@@ -135,9 +174,48 @@ toDavPass = B8.fromString
 davLocations :: DavUrl -> Key -> [DavUrl]
 davLocations baseurl k = map (davUrl baseurl) (keyPaths k)
 
-{- FIXME: Replacing / with _ to avoid needing collections. -}
 davUrl :: DavUrl -> FilePath -> DavUrl
-davUrl baseurl file = baseurl </> replace "/" "_" file
+davUrl baseurl file = baseurl </> file
+
+{- Creates a directory in WebDAV, if not already present; also creating
+ - any missing parent directories. -}
+davMkdir :: DavUrl -> DavUser -> DavPass -> IO ()
+davMkdir url user pass = go url
+  where
+	make u = makeCollection u user pass
+
+	go u = do
+		r <- E.try (make u) :: IO (Either E.SomeException Bool)
+		case r of
+			{- Parent directory is missing. Recurse to create
+			 - it, and try once more to create the directory. -}
+			Right False -> do
+				go (urlParent u)
+				void $ make u
+			{- Directory created successfully -}
+			Right True -> return ()
+			{- Directory already exists, or some other error
+			 - occurred. In the latter case, whatever wanted
+			 - to use this directory will fail. -}
+			Left _ -> return ()
+
+{- Catches HTTP and IO exceptions. -}
+catchMaybeHttp :: IO a -> IO (Maybe a)
+catchMaybeHttp a = (Just <$> a) `E.catches`
+	[ E.Handler $ \(_e :: HttpException) -> return Nothing
+	, E.Handler $ \(_e :: E.IOException) -> return Nothing
+	]
+
+{- Catches HTTP and IO exceptions -}
+catchHttp :: IO a -> IO (Either (Either HttpException E.IOException) a)
+catchHttp a = (Right <$> a) `E.catches`
+	[ E.Handler $ \(e :: HttpException) -> return $ Left $ Left e
+	, E.Handler $ \(e :: E.IOException) -> return $ Left $ Right e
+	]
+
+urlParent :: DavUrl -> DavUrl
+urlParent url = reverse $ dropWhile (== '/') $ reverse $
+	normalizePathSegments (url ++ "/..")
 
 {- Test if a WebDAV store is usable, by writing to a test file, and then
  - deleting the file. Exits with an error if not. -}
@@ -146,12 +224,13 @@ testDav baseurl Nothing = error "Need to configure webdav username and password.
 testDav baseurl (Just (u, p)) = do
 	showSideAction "testing WebDAV server"
 	liftIO $ do
-		putContentAndProps testurl username password
+		davMkdir baseurl user pass
+		putContentAndProps testurl user pass
 			(noProps, (contentType, L.empty))
-		deleteContent testurl username password
+		deleteContent testurl user pass
   where
-	username = toDavUser u
-	password = toDavPass p
+	user = toDavUser u
+	pass = toDavPass p
 	testurl = davUrl baseurl "git-annex-test"
 
 {- Content-Type to use for files uploaded to WebDAV. -}
diff --git a/debian/control b/debian/control
index 74d9c0c6a1..d3840463d5 100644
--- a/debian/control
+++ b/debian/control
@@ -12,7 +12,7 @@ Build-Depends:
 	libghc-http-dev,
 	libghc-utf8-string-dev,
 	libghc-hs3-dev (>= 0.5.6),
-	libghc-dav-dev (>= 0.1),
+	libghc-dav-dev (>= 0.2),
 	libghc-testpack-dev,
 	libghc-quickcheck2-dev,
 	libghc-monad-control-dev (>= 0.3),
diff --git a/doc/special_remotes/webdav.mdwn b/doc/special_remotes/webdav.mdwn
index 5cc5c55d9d..c5b53dc4b2 100644
--- a/doc/special_remotes/webdav.mdwn
+++ b/doc/special_remotes/webdav.mdwn
@@ -20,7 +20,8 @@ the webdav remote.
   the new key id. See [[encryption]].
 
 * `url` - Required. The URL to the WebDAV directory where files will be
-  stored. This directory must already exist. Use of a https URL is strongly
+  stored. This can be a subdirectory of a larger WebDAV repository, and will
+  be created as needed. Use of a https URL is strongly
   encouraged, since HTTP basic authentication is used.
 
 * `chunksize` - Avoid storing files larger than the specified size in
@@ -33,4 +34,4 @@ the webdav remote.
 
 Setup example:
 
-	# WEBDAV_USERNAME=joey@kitenet.net WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://www.box.com/dav/ encryption=joey@kitenet.net
+	# WEBDAV_USERNAME=joey@kitenet.net WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://www.box.com/dav/git-annex encryption=joey@kitenet.net
diff --git a/git-annex.cabal b/git-annex.cabal
index 8db659fbf3..c72a6c0bd0 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -73,7 +73,7 @@ Executable git-annex
     CPP-Options: -DWITH_S3
 
   if flag(WebDAV)
-    Build-Depends: DAV (>= 0.1)
+    Build-Depends: DAV (>= 0.2), http-conduit
     CPP-Options: -DWITH_WebDAV
 
   if flag(Assistant) && ! os(windows) && ! os(solaris)

From bb28c6114a893c14f434d09b72e9e32198023dc1 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 16 Nov 2012 00:42:33 -0400
Subject: [PATCH 06/12] drop webdav compatability with the directory special
 remote etc

The benefit of using a compatable directory structure does not outweigh the
cost in complexity of handling the multiple locations content can be stored
in directory special remotes. And this also allows doing away with the parent
directories, which can't be made unwritable in DAV, so have no benefit
there. This will save 2 http calls per file store.

But, kept the directory hashing, just in case.
---
 Locations.hs                                  |  1 +
 Remote/WebDAV.hs                              | 82 +++++++------------
 doc/special_remotes/webdav.mdwn               |  4 +-
 .../using_box.com_as_a_special_remote.mdwn    | 15 +++-
 4 files changed, 47 insertions(+), 55 deletions(-)

diff --git a/Locations.hs b/Locations.hs
index 3a7c89ea7a..6213385bdf 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -11,6 +11,7 @@ module Locations (
 	keyPaths,
 	gitAnnexLocation,
 	annexLocations,
+	annexLocation,
 	gitAnnexDir,
 	gitAnnexObjectDir,
 	gitAnnexTmpDir,
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 3747e81794..b7a355c1f0 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -81,15 +81,14 @@ webdavSetup u c = do
 	setRemoteCredPair c (davCreds u)
 
 store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-store r k _f _p = do
+store r k _f _p = davAction r False $ \(baseurl, user, pass) -> do
+	let url = davLocation baseurl k
+	liftIO $ davMkdir (urlParent url) user pass
 	f <- inRepo $ gitAnnexLocation k
-	davAction r False $ \(baseurl, user, pass) -> liftIO $ do
-		let url = Prelude.head $ davLocations baseurl k
-		davMkdir (urlParent url) user pass
-		b <- L.readFile f
-		v <- catchMaybeHttp $ putContentAndProps url user pass
-			(noProps, (contentType, b))
-		return $ isJust v
+	b <- liftIO $ L.readFile f
+	v <- liftIO $ catchMaybeHttp $ putContentAndProps url user pass
+		(noProps, (contentType, b))
+	return $ isJust v
 
 storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 storeEncrypted r (cipher, enck) k _p = davAction r False $ \creds -> liftIO $ do
@@ -98,14 +97,13 @@ storeEncrypted r (cipher, enck) k _p = davAction r False $ \creds -> liftIO $ do
 retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
 retrieve r k _f d = davAction r False $ liftIO . go
   where
-	go (baseurl, user, pass) = get $ davLocations baseurl k
-	  where
-		get [] = return False
-		get (u:urls) = maybe (get urls) save
-			=<< catchMaybeHttp (getPropsAndContent u user pass)
-		save (_, (_, b)) = do
-			L.writeFile d b
-			return True
+	go (baseurl, user, pass) = do
+		let url = davLocation baseurl k
+		maybe (return False) save
+			=<< catchMaybeHttp (getPropsAndContent url user pass)
+	save (_, (_, b)) = do
+		L.writeFile d b
+		return True
 
 retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
@@ -117,39 +115,24 @@ retrieveEncrypted r (cipher, enck) _ f = davAction r False $ \creds -> do
 remove :: Remote -> Key -> Annex Bool
 remove r k = davAction r False $ liftIO . go
   where
-	go (baseurl, user, pass) = delone $ davLocations baseurl k
-	  where
-		delone [] = return False
-		delone (u:urls) = maybe (delone urls) (const $ return True)
-			=<< catchMaybeHttp (deletedir u)
-
-		{- Rather than deleting first the file, and then its
-		 - immediate parent directory (to clean up), delete the
-		 - parent directory, along with all its contents in a
-		 - single recursive DAV call.
-		 - 
-		 - The file is the only thing we keep in there, and this
-		 - is faster. -}
-		deletedir u = deleteContent (urlParent u) user pass
+	go (baseurl, user, pass) = do
+		let url = davLocation baseurl k
+		isJust <$> catchMaybeHttp (deleteContent url user pass)
 
 checkPresent :: Remote -> Key -> Annex (Either String Bool)
-checkPresent r k = davAction r noconn go
+checkPresent r k = davAction r noconn $ \(baseurl, user, pass) -> do
+	showAction $ "checking " ++ name r
+	let url = davLocation baseurl k	
+	v <- liftIO $ catchHttp $ getProps url user pass
+	case v of
+		Right _ -> return $ Right True
+		Left (Left (StatusCodeException status _))
+			| statusCode status == statusCode notFound404 -> return $ Right False
+			| otherwise -> return $ Left $ show $ statusMessage status
+		Left (Left httpexception) -> return $ Left $ show httpexception
+		Left (Right ioexception) -> return $ Left $ show ioexception
   where
 	noconn = Left $ error $ name r ++ " not configured"
-	go (baseurl, user, pass) = do
-		showAction $ "checking " ++ name r
-		liftIO $ check $ davLocations baseurl k	
-	  where
-		check [] = return $ Right False
-		check (u:urls) = do
-			v <- catchHttp $ getProps u user pass
-			case v of
-				Right _ -> return $ Right True
-				Left (Left (StatusCodeException status _))
-					| statusCode status == statusCode notFound404 -> check urls
-					| otherwise -> return $ Left $ show $ statusMessage status
-				Left (Left httpexception) -> return $ Left $ show httpexception
-				Left (Right ioexception) -> return $ Left $ show ioexception
 
 davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a
 davAction r unconfigured action = case config r of
@@ -167,12 +150,9 @@ toDavUser = B8.fromString
 toDavPass :: String -> DavPass
 toDavPass = B8.fromString
 
-{- All possibile locations to try to access a given Key.
- -
- - This is intentially the same as the directory special remote uses, to
- - allow interoperability. -}
-davLocations :: DavUrl -> Key -> [DavUrl]
-davLocations baseurl k = map (davUrl baseurl) (keyPaths k)
+{- The location to use to store a Key. -}
+davLocation :: DavUrl -> Key -> DavUrl
+davLocation baseurl k = davUrl baseurl $ hashDirLower k </> keyFile k
 
 davUrl :: DavUrl -> FilePath -> DavUrl
 davUrl baseurl file = baseurl </> file
diff --git a/doc/special_remotes/webdav.mdwn b/doc/special_remotes/webdav.mdwn
index c5b53dc4b2..8421dd5f45 100644
--- a/doc/special_remotes/webdav.mdwn
+++ b/doc/special_remotes/webdav.mdwn
@@ -28,10 +28,10 @@ the webdav remote.
   WebDAV. For use when the WebDAV server has file size
   limitations. The default is to never chunk files.  
   The value can use specified using any commonly used units.
-  Example: `chunksize=100 megabytes`  
+  Example: `chunksize=75 megabytes`  
   Note that enabling chunking on an existing remote with non-chunked
   files is not recommended.
 
 Setup example:
 
-	# WEBDAV_USERNAME=joey@kitenet.net WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://www.box.com/dav/git-annex encryption=joey@kitenet.net
+	# WEBDAV_USERNAME=joey@kitenet.net WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://www.box.com/dav/git-annex chunksize=75mb encryption=joey@kitenet.net
diff --git a/doc/tips/using_box.com_as_a_special_remote.mdwn b/doc/tips/using_box.com_as_a_special_remote.mdwn
index cafbc033c4..6616d0a1e2 100644
--- a/doc/tips/using_box.com_as_a_special_remote.mdwn
+++ b/doc/tips/using_box.com_as_a_special_remote.mdwn
@@ -2,8 +2,19 @@
 for providing 50 gb of free storage if you sign up with its Android client.
 (Or a few gb free otherwise.)
 
-With a little setup, git-annex can use Box as a
-[[special remote|special_remotes]]. 
+git-annex can use Box as a [[special remote|special_remotes]].
+Recent versions of git-annex make this very easy to set up:
+
+	WEBDAV_USERNAME=you@example.com WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://www.box.com/dav/git-annex chunksize=75mb encryption=you@example.com
+
+Note the use of chunksize; Box has a 100 mb maximum file size, and this
+breaks up large files into chunks before that limit is reached.
+
+# old davfs2 method
+
+This method is deprecated, but still documented here just in case.
+Note that the files stored using this method cannot reliably be retreived
+using the webdav special remote.
 
 ## davfs2 setup
 

From 0f782bd0284060b630a8f180fbd7f5043131f1f3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 16 Nov 2012 13:32:18 -0400
Subject: [PATCH 07/12] encrypted webdav working

---
 Remote/S3.hs     |  2 +-
 Remote/WebDAV.hs | 40 ++++++++++++++++++++++++----------------
 2 files changed, 25 insertions(+), 17 deletions(-)

diff --git a/Remote/S3.hs b/Remote/S3.hs
index 67a64e4646..f7dbf813c1 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -122,7 +122,7 @@ storeEncrypted r (cipher, enck) k _p = s3Action r False $ \(conn, bucket) ->
 	-- (An alternative would be chunking to to a constant size.)
 	withTmp enck $ \tmp -> do
 		f <- inRepo $ gitAnnexLocation k
-		liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
+		liftIO $ withEncryptedContent cipher (L.readFile f) $ L.writeFile tmp
 		res <- liftIO $ storeHelper (conn, bucket) r enck tmp
 		s3Bool res
 
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index b7a355c1f0..5c7f13d7e4 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -78,39 +78,47 @@ webdavSetup u c = do
 	creds <- getCreds c' u
 	testDav url creds
 	gitConfigSpecialRemote u c' "webdav" "true"
-	setRemoteCredPair c (davCreds u)
+	setRemoteCredPair c' (davCreds u)
 
 store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store r k _f _p = davAction r False $ \(baseurl, user, pass) -> do
 	let url = davLocation baseurl k
-	liftIO $ davMkdir (urlParent url) user pass
 	f <- inRepo $ gitAnnexLocation k
 	b <- liftIO $ L.readFile f
+	liftIO $ davMkdir (urlParent url) user pass
 	v <- liftIO $ catchMaybeHttp $ putContentAndProps url user pass
 		(noProps, (contentType, b))
 	return $ isJust v
 
 storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted r (cipher, enck) k _p = davAction r False $ \creds -> liftIO $ do
-	error "TODO"
+storeEncrypted r (cipher, enck) k _p = davAction r False $ \(baseurl, user, pass) -> do
+	f <- inRepo $ gitAnnexLocation k
+	let url = davLocation baseurl enck
+	liftIO $ davMkdir (urlParent url) user pass
+	v <- liftIO $ withEncryptedContent cipher (L.readFile f) $ \b ->
+		catchMaybeHttp $ putContentAndProps url user pass
+			(noProps, (contentType, b))
+	return $ isJust v
 
 retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieve r k _f d = davAction r False $ liftIO . go
-  where
-	go (baseurl, user, pass) = do
-		let url = davLocation baseurl k
-		maybe (return False) save
-			=<< catchMaybeHttp (getPropsAndContent url user pass)
-	save (_, (_, b)) = do
-		L.writeFile d b
-		return True
+retrieve r k _f d = retrieve' r k (L.writeFile d)
 
 retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
 
 retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
-retrieveEncrypted r (cipher, enck) _ f = davAction r False $ \creds -> do
-	error "TODO"
+retrieveEncrypted r (cipher, enck) _ d = retrieve' r enck $ \b -> do
+	withDecryptedContent cipher (return b) (L.writeFile d)
+
+retrieve' :: Remote -> Key -> (L.ByteString -> IO ()) -> Annex Bool
+retrieve' r k saver = davAction r False $ \(baseurl, user, pass) -> liftIO $ do
+	let url = davLocation baseurl k
+	maybe (return False) save
+		=<< catchMaybeHttp (getPropsAndContent url user pass)
+  where
+	save (_, (_, b)) = do
+		saver b
+		return True
 
 remove :: Remote -> Key -> Annex Bool
 remove r k = davAction r False $ liftIO . go
@@ -200,7 +208,6 @@ urlParent url = reverse $ dropWhile (== '/') $ reverse $
 {- Test if a WebDAV store is usable, by writing to a test file, and then
  - deleting the file. Exits with an error if not. -}
 testDav :: String -> Maybe CredPair -> Annex ()
-testDav baseurl Nothing = error "Need to configure webdav username and password."
 testDav baseurl (Just (u, p)) = do
 	showSideAction "testing WebDAV server"
 	liftIO $ do
@@ -212,6 +219,7 @@ testDav baseurl (Just (u, p)) = do
 	user = toDavUser u
 	pass = toDavPass p
 	testurl = davUrl baseurl "git-annex-test"
+testDav _ Nothing = error "Need to configure webdav username and password."
 
 {- Content-Type to use for files uploaded to WebDAV. -}
 contentType :: Maybe B8.ByteString

From 154a832223f9b3497a716914bc921236eab82d9c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 16 Nov 2012 14:04:46 -0400
Subject: [PATCH 08/12] note that webdav needs upload progress bars

---
 doc/design/assistant/progressbars.mdwn | 1 +
 1 file changed, 1 insertion(+)

diff --git a/doc/design/assistant/progressbars.mdwn b/doc/design/assistant/progressbars.mdwn
index 61e19ba1ee..6228cb7f84 100644
--- a/doc/design/assistant/progressbars.mdwn
+++ b/doc/design/assistant/progressbars.mdwn
@@ -23,6 +23,7 @@ the MeterUpdate callback as the upload progresses.
 * rsync: **done**
 * directory: **done**
 * web: Not applicable; does not upload 
+* webdav: TODO
 * S3: TODO
 * bup: TODO
 * hook: Would require the hook interface to somehow do this, which seems

From 92d5d81c2c4e12b406e03faee2c77ddec8711c15 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 16 Nov 2012 17:58:08 -0400
Subject: [PATCH 09/12] generic chunked content helper

However, directory still uses its optimzed chunked file writer, as it uses
less memory than the generic one in the helper.
---
 Remote/Directory.hs      |  76 ++++++------------------
 Remote/Helper/Chunked.hs | 121 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 137 insertions(+), 60 deletions(-)
 create mode 100644 Remote/Helper/Chunked.hs

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 006638a2f2..6bf725379c 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -19,8 +19,8 @@ import Config
 import Utility.FileMode
 import Remote.Helper.Special
 import Remote.Helper.Encryptable
+import Remote.Helper.Chunked
 import Crypto
-import Utility.DataUnits
 import Data.Int
 import Annex.Content
 
@@ -58,19 +58,6 @@ gen r u c = do
 			remotetype = remote
 		}
 
-type ChunkSize = Maybe Int64
-
-chunkSize :: Maybe RemoteConfig -> ChunkSize
-chunkSize Nothing = Nothing
-chunkSize (Just m) =
-	case M.lookup "chunksize" m of
-		Nothing -> Nothing
-		Just v -> case readSize dataUnits v of
-			Nothing -> error "bad chunksize"
-			Just size
-				| size <= 0 -> error "bad chunksize"
-				| otherwise -> Just $ fromInteger size
-
 directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig
 directorySetup u c = do
 	-- verify configuration is sane
@@ -89,14 +76,6 @@ directorySetup u c = do
 locations :: FilePath -> Key -> [FilePath]
 locations d k = map (d </>) (keyPaths k)
 
-{- An infinite stream of chunks to use for a given file. -}
-chunkStream :: FilePath -> [FilePath]
-chunkStream f = map (\n -> f ++ ".chunk" ++ show n) [1 :: Integer ..]
-
-{- A file that records the number of chunks used. -}
-chunkCount :: FilePath -> FilePath
-chunkCount f = f ++ ".chunkcount"
-
 withCheckedFiles :: (FilePath -> IO Bool) -> ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool
 withCheckedFiles _ _ [] _ _ = return False
 withCheckedFiles check Nothing d k a = go $ locations d k
@@ -107,18 +86,14 @@ withCheckedFiles check (Just _) d k a = go $ locations d k
   where
 	go [] = return False
 	go (f:fs) = do
-		let chunkcount = chunkCount f
+		let chunkcount = f ++ chunkCount
 		ifM (check chunkcount)
 			( do
-				count <- readcount chunkcount
-				let chunks = take count $ chunkStream f
+				chunks <- getChunks f <$> readFile chunkcount
 				ifM (all id <$> mapM check chunks)
 					( a chunks , return False )
 			, go fs
 			)
-	readcount f = fromMaybe (error $ "cannot parse " ++ f)
-		. (readish :: String -> Maybe Int)
-		<$> readFile f
 
 withStoredFiles :: ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool
 withStoredFiles = withCheckedFiles doesFileExist
@@ -203,45 +178,26 @@ meteredWriteFile' meterupdate dest startstate feeder =
 		meterupdate $ toInteger $ S.length c
 		feed state cs h
 
-{- Generates a list of destinations to write to in order to store a key.
- - When chunksize is specified, this list will be a list of chunks.
- - The action should store the file, and return a list of the destinations
- - it stored it to, or [] on error.
- - The stored files are only put into their final place once storage is
- - complete.
- -}
 storeHelper :: FilePath -> ChunkSize -> Key -> ([FilePath] -> IO [FilePath]) -> Annex Bool
-storeHelper d chunksize key a = prep <&&> check <&&> go
+storeHelper d chunksize key storer = check <&&> go
   where
-	desttemplate = Prelude.head $ locations d key
-	dir = parentDir desttemplate
-	tmpdests = case chunksize of
-		Nothing -> [desttemplate ++ tmpprefix]
-		Just _ -> map (++ tmpprefix) (chunkStream desttemplate)
-	tmpprefix = ".tmp"
-	detmpprefix f = take (length f - tmpprefixlen) f
-	tmpprefixlen = length tmpprefix
-	prep = liftIO $ catchBoolIO $ do
-		createDirectoryIfMissing True dir
-		allowWrite dir
-		return True
+	basedest = Prelude.head $ locations d key
+	dir = parentDir basedest
 	{- The size is not exactly known when encrypting the key;
 	 - this assumes that at least the size of the key is
 	 - needed as free space. -}
 	check = checkDiskSpace (Just dir) key 0
 	go = liftIO $ catchBoolIO $ do
-		stored <- a tmpdests
-		forM_ stored $ \f -> do
-			let dest = detmpprefix f
-			renameFile f dest
-			preventWrite dest
-		when (chunksize /= Nothing) $ do
-			let chunkcount = chunkCount desttemplate
-			_ <- tryIO $ allowWrite chunkcount
-			writeFile chunkcount (show $ length stored)
-			preventWrite chunkcount
-		preventWrite dir
-		return (not $ null stored)
+		createDirectoryIfMissing True dir
+		allowWrite dir
+		preventWrite dir `after` storeChunks basedest chunksize storer recorder finalizer
+	finalizer f dest = do
+		renameFile f dest
+		preventWrite dest
+	recorder f s = do
+		void $ tryIO $ allowWrite f
+		writeFile f s
+		preventWrite f
 
 retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> Annex Bool
 retrieve d chunksize k _ f = metered Nothing k $ \meterupdate ->
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
new file mode 100644
index 0000000000..59117eaca3
--- /dev/null
+++ b/Remote/Helper/Chunked.hs
@@ -0,0 +1,121 @@
+{- git-annex chunked remotes
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Remote.Helper.Chunked where
+
+import Common.Annex
+import Utility.DataUnits
+import Types.Remote
+
+import qualified Data.Map as M
+import qualified Data.ByteString.Lazy as L
+import Data.Int
+import qualified Control.Exception as E
+
+type ChunkSize = Maybe Int64
+
+{- Gets a remote's configured chunk size. -}
+chunkSize :: Maybe RemoteConfig -> ChunkSize
+chunkSize Nothing = Nothing
+chunkSize (Just m) =
+	case M.lookup "chunksize" m of
+		Nothing -> Nothing
+		Just v -> case readSize dataUnits v of
+			Nothing -> error "bad chunksize"
+			Just size
+				| size <= 0 -> error "bad chunksize"
+				| otherwise -> Just $ fromInteger size
+
+{- This is an extension that's added to the usual file (or whatever)
+ - where the remote stores a key. -}
+type ChunkExt = String
+
+{- A record of the number of chunks used.
+ -
+ - While this can be guessed at based on the size of the key, encryption
+ - makes that larger. Also, using this helps deal with changes to chunksize
+ - over the life of a remote.
+ -}
+chunkCount :: ChunkExt
+chunkCount = ".chunkcount"
+
+{- Parses the String from the chunkCount file, and returns the files that
+ - are used to store the chunks. -}
+getChunks :: FilePath -> String -> [FilePath]
+getChunks basedest chunkcount = take count $ map (basedest ++) chunkStream
+  where
+	count = fromMaybe 0 $ readish chunkcount
+
+{- An infinite stream of extensions to use for chunks. -}
+chunkStream :: [ChunkExt]
+chunkStream = map (\n -> ".chunk" ++ show n) [1 :: Integer ..]
+
+{- Given the base destination to use to store a value,
+ - generates a stream of temporary destinations (just one when not chunking)
+ - and passes it to an action, which should chunk and store the data,
+ - and return the destinations it stored to, or [] on error.
+ -
+ - Then calles the finalizer to rename the temporary destinations into
+ - their final places (and do any other cleanup), and writes the chunk count
+ - (if chunking)
+ -}
+storeChunks :: FilePath -> ChunkSize -> ([FilePath] -> IO [FilePath]) -> (FilePath -> String -> IO ()) -> (FilePath -> FilePath -> IO ()) -> IO Bool
+storeChunks basedest chunksize storer recorder finalizer =
+	either (const $ return False) return
+		=<< (E.try go :: IO (Either E.SomeException Bool))
+  where
+	go = do
+		stored <- storer tmpdests
+		forM_ stored $ \d -> do
+			let dest = detmpprefix d
+			finalizer d dest
+		when (chunksize /= Nothing) $ do
+			let chunkcount = basedest ++ chunkCount
+			recorder chunkcount (show $ length stored)
+		return (not $ null stored)
+
+	tmpprefix = ".tmp"
+	detmpprefix f = take (length f - tmpprefixlen) f
+	tmpprefixlen = length tmpprefix
+	tmpdests
+		| chunksize == Nothing = [basedest ++ tmpprefix]
+		| otherwise = map (++ tmpprefix) $ map (basedest ++) chunkStream
+
+{- Given a list of destinations to use, chunks the data according to the
+ - ChunkSize, and runs the storer action to store each chunk. Returns
+ - the destinations where data was stored, or [] on error.
+ -
+ - This buffers each chunk in memory.
+ - More optimal versions of this can be written, that rely
+ - on L.toChunks to split the lazy bytestring into chunks (typically
+ - smaller than the ChunkSize), and eg, write those chunks to a Handle.
+ - But this is the best that can be done with the storer interface that
+ - writes a whole L.ByteString at a time.
+ -}
+storeChunked :: ChunkSize -> [FilePath] -> (FilePath -> L.ByteString -> IO ()) -> L.ByteString -> IO [FilePath]
+storeChunked chunksize dests storer content =
+	either (const $ return []) return
+		=<< (E.try (go chunksize dests) :: IO (Either E.SomeException [FilePath]))
+  where
+	go _ [] = return [] -- no dests!?
+
+	go Nothing (d:_) = do
+		storer d content
+		return [d]
+
+	go (Just sz) _
+		-- always write a chunk, even if the data is 0 bytes
+		| L.null content = go Nothing dests
+		| otherwise = storechunks sz [] dests content
+		
+	storechunks _ _ [] _ = return [] -- ran out of dests
+	storechunks sz useddests (d:ds) b
+		| L.null b = return $ reverse useddests
+		| otherwise = do
+			let (chunk, b') = L.splitAt sz b
+			storer d chunk
+			storechunks sz (d:useddests) ds b'

From a1869ad66236bcd311c2b91b833a003b04de7d6f Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 16 Nov 2012 17:58:58 -0400
Subject: [PATCH 10/12] webdav now supports sending chunked content

Not yet getting it though.
---
 Remote/WebDAV.hs | 38 +++++++++++++++++++++++---------------
 1 file changed, 23 insertions(+), 15 deletions(-)

diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 5c7f13d7e4..5af209ba83 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -12,6 +12,7 @@ module Remote.WebDAV (remote) where
 import Network.Protocol.HTTP.DAV
 import qualified Data.Map as M
 import qualified Data.ByteString.UTF8 as B8
+import qualified Data.ByteString.Lazy.UTF8 as L8
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Text as T
 import qualified Text.XML as XML
@@ -26,6 +27,7 @@ import qualified Git
 import Config
 import Remote.Helper.Special
 import Remote.Helper.Encryptable
+import Remote.Helper.Chunked
 import Crypto
 import Creds
 
@@ -84,34 +86,40 @@ store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store r k _f _p = davAction r False $ \(baseurl, user, pass) -> do
 	let url = davLocation baseurl k
 	f <- inRepo $ gitAnnexLocation k
-	b <- liftIO $ L.readFile f
-	liftIO $ davMkdir (urlParent url) user pass
-	v <- liftIO $ catchMaybeHttp $ putContentAndProps url user pass
-		(noProps, (contentType, b))
-	return $ isJust v
+	liftIO $ storeHelper r url user pass =<< L.readFile f
 
 storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 storeEncrypted r (cipher, enck) k _p = davAction r False $ \(baseurl, user, pass) -> do
-	f <- inRepo $ gitAnnexLocation k
 	let url = davLocation baseurl enck
-	liftIO $ davMkdir (urlParent url) user pass
-	v <- liftIO $ withEncryptedContent cipher (L.readFile f) $ \b ->
-		catchMaybeHttp $ putContentAndProps url user pass
-			(noProps, (contentType, b))
-	return $ isJust v
+	f <- inRepo $ gitAnnexLocation k
+	liftIO $ withEncryptedContent cipher (L.readFile f) $
+		storeHelper r url user pass
+
+storeHelper :: Remote -> DavUrl -> DavUser -> DavPass -> L.ByteString -> IO Bool
+storeHelper r urlbase user pass b = catchBoolIO $ do
+	davMkdir (urlParent urlbase) user pass
+	storeChunks urlbase chunksize storer recorder finalizer
+  where
+	chunksize = chunkSize $ config r
+	storer urls = storeChunked chunksize urls storehttp b
+	recorder url s = storehttp url (L8.fromString s)
+	finalizer srcurl desturl = 
+		moveContent srcurl (B8.fromString desturl) user pass
+	storehttp url v = putContentAndProps url user pass
+		(noProps, (contentType, v))
 
 retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieve r k _f d = retrieve' r k (L.writeFile d)
+retrieve r k _f d = retrieveHelper r k (L.writeFile d)
 
 retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
 
 retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
-retrieveEncrypted r (cipher, enck) _ d = retrieve' r enck $ \b -> do
+retrieveEncrypted r (cipher, enck) _ d = retrieveHelper r enck $ \b -> do
 	withDecryptedContent cipher (return b) (L.writeFile d)
 
-retrieve' :: Remote -> Key -> (L.ByteString -> IO ()) -> Annex Bool
-retrieve' r k saver = davAction r False $ \(baseurl, user, pass) -> liftIO $ do
+retrieveHelper :: Remote -> Key -> (L.ByteString -> IO ()) -> Annex Bool
+retrieveHelper r k saver = davAction r False $ \(baseurl, user, pass) -> liftIO $ do
 	let url = davLocation baseurl k
 	maybe (return False) save
 		=<< catchMaybeHttp (getPropsAndContent url user pass)

From 0b3126a30b2bd61d1a294feacc3324d578464505 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 16 Nov 2012 18:09:28 -0400
Subject: [PATCH 11/12] back to standard directory layout for webdav remotes

This allows deleting all chunks for a file with a single http command,
so it's a win after all.

However, does not look in the mixed case hash directories, which were
in the past used by the directory, etc remotes.
---
 Remote/WebDAV.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 5af209ba83..c1e2212950 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -129,11 +129,11 @@ retrieveHelper r k saver = davAction r False $ \(baseurl, user, pass) -> liftIO
 		return True
 
 remove :: Remote -> Key -> Annex Bool
-remove r k = davAction r False $ liftIO . go
-  where
-	go (baseurl, user, pass) = do
-		let url = davLocation baseurl k
-		isJust <$> catchMaybeHttp (deleteContent url user pass)
+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 = urlParent $ davLocation baseurl k
+	isJust <$> catchMaybeHttp (deleteContent url user pass)
 
 checkPresent :: Remote -> Key -> Annex (Either String Bool)
 checkPresent r k = davAction r noconn $ \(baseurl, user, pass) -> do
@@ -168,7 +168,7 @@ toDavPass = B8.fromString
 
 {- The location to use to store a Key. -}
 davLocation :: DavUrl -> Key -> DavUrl
-davLocation baseurl k = davUrl baseurl $ hashDirLower k </> keyFile k
+davLocation baseurl k = davUrl baseurl $ annexLocation k hashDirLower
 
 davUrl :: DavUrl -> FilePath -> DavUrl
 davUrl baseurl file = baseurl </> file

From 1fe76b57d6e11284be914e95297cd21aa7b08bfb Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 16 Nov 2012 23:16:18 -0400
Subject: [PATCH 12/12] webdav now checks presence of and receives chunked
 content

Note that receiving encrypted chunked content currently involves buffering.
(So does doing so with the directory special remote.)
---
 Remote/Directory.hs      |  27 +--------
 Remote/Helper/Chunked.hs |  28 +++++++++-
 Remote/WebDAV.hs         | 115 ++++++++++++++++++++++++++++++---------
 3 files changed, 117 insertions(+), 53 deletions(-)

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 6bf725379c..794a8c468b 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -89,7 +89,7 @@ withCheckedFiles check (Just _) d k a = go $ locations d k
 		let chunkcount = f ++ chunkCount
 		ifM (check chunkcount)
 			( do
-				chunks <- getChunks f <$> readFile chunkcount
+				chunks <- listChunks f <$> readFile chunkcount
 				ifM (all id <$> mapM check chunks)
 					( a chunks , return False )
 			, go fs
@@ -155,29 +155,6 @@ storeSplit' meterupdate chunksize (d:dests) bs c = do
 				feed (sz - s) ls h
 			else return (l:ls)
 
-{- Write a L.ByteString to a file, updating a progress meter
- - after each chunk of the L.ByteString, typically every 64 kb or so. -}
-meteredWriteFile :: MeterUpdate -> FilePath -> L.ByteString -> IO ()
-meteredWriteFile meterupdate dest b =
-	meteredWriteFile' meterupdate dest (L.toChunks b) feeder
-  where
-	feeder chunks = return ([], chunks)
-
-{- Writes a series of S.ByteString chunks to a file, updating a progress
- - meter after each chunk. The feeder is called to get more chunks. -}
-meteredWriteFile' :: MeterUpdate -> FilePath -> s -> (s -> IO (s, [S.ByteString])) -> IO ()
-meteredWriteFile' meterupdate dest startstate feeder =
-	E.bracket (openFile dest WriteMode) hClose (feed startstate [])
-  where
-	feed state [] h = do
-		(state', cs) <- feeder state
-		unless (null cs) $
-			feed state' cs h
-	feed state (c:cs) h = do
-		S.hPut h c
-		meterupdate $ toInteger $ S.length c
-		feed state cs h
-
 storeHelper :: FilePath -> ChunkSize -> Key -> ([FilePath] -> IO [FilePath]) -> Annex Bool
 storeHelper d chunksize key storer = check <&&> go
   where
@@ -203,7 +180,7 @@ retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> Annex
 retrieve d chunksize k _ f = metered Nothing k $ \meterupdate ->
 	liftIO $ withStoredFiles chunksize d k $ \files ->
 		catchBoolIO $ do
-			meteredWriteFile' meterupdate f files feeder
+			meteredWriteFileChunks meterupdate f files feeder
 			return True
   where
 	feeder [] = return ([], [])
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index 59117eaca3..dd6e3eb0db 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -13,6 +13,7 @@ import Types.Remote
 
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString as S
 import Data.Int
 import qualified Control.Exception as E
 
@@ -45,8 +46,8 @@ chunkCount = ".chunkcount"
 
 {- Parses the String from the chunkCount file, and returns the files that
  - are used to store the chunks. -}
-getChunks :: FilePath -> String -> [FilePath]
-getChunks basedest chunkcount = take count $ map (basedest ++) chunkStream
+listChunks :: FilePath -> String -> [FilePath]
+listChunks basedest chunkcount = take count $ map (basedest ++) chunkStream
   where
 	count = fromMaybe 0 $ readish chunkcount
 
@@ -119,3 +120,26 @@ storeChunked chunksize dests storer content =
 			let (chunk, b') = L.splitAt sz b
 			storer d chunk
 			storechunks sz (d:useddests) ds b'
+
+{- Write a L.ByteString to a file, updating a progress meter
+ - after each chunk of the L.ByteString, typically every 64 kb or so. -}
+meteredWriteFile :: MeterUpdate -> FilePath -> L.ByteString -> IO ()
+meteredWriteFile meterupdate dest b =
+	meteredWriteFileChunks meterupdate dest (L.toChunks b) feeder
+  where
+	feeder chunks = return ([], chunks)
+
+{- Writes a series of S.ByteString chunks to a file, updating a progress
+ - meter after each chunk. The feeder is called to get more chunks. -}
+meteredWriteFileChunks :: MeterUpdate -> FilePath -> s -> (s -> IO (s, [S.ByteString])) -> IO ()
+meteredWriteFileChunks meterupdate dest startstate feeder =
+	E.bracket (openFile dest WriteMode) hClose (feed startstate [])
+  where
+	feed state [] h = do
+		(state', cs) <- feeder state
+		unless (null cs) $
+			feed state' cs h
+	feed state (c:cs) h = do
+		S.hPut h c
+		meterupdate $ toInteger $ S.length c
+		feed state cs h
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index c1e2212950..b69d51f23e 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -20,6 +20,7 @@ import Network.URI (normalizePathSegments)
 import qualified Control.Exception as E
 import Network.HTTP.Conduit (HttpException(..))
 import Network.HTTP.Types
+import System.IO.Error
 
 import Common.Annex
 import Types.Remote
@@ -108,25 +109,45 @@ storeHelper r urlbase user pass b = catchBoolIO $ do
 	storehttp url v = putContentAndProps url user pass
 		(noProps, (contentType, v))
 
-retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
-retrieve r k _f d = retrieveHelper r k (L.writeFile d)
-
 retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
 
-retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
-retrieveEncrypted r (cipher, enck) _ d = retrieveHelper r enck $ \b -> do
-	withDecryptedContent cipher (return b) (L.writeFile d)
-
-retrieveHelper :: Remote -> Key -> (L.ByteString -> IO ()) -> Annex Bool
-retrieveHelper r k saver = davAction r False $ \(baseurl, user, pass) -> liftIO $ do
-	let url = davLocation baseurl k
-	maybe (return False) save
-		=<< catchMaybeHttp (getPropsAndContent url user pass)
+retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieve r k _f d = metered Nothing k $ \meterupdate ->
+	davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $
+		withStoredFiles r k baseurl user pass onerr $ \urls -> do
+			meteredWriteFileChunks meterupdate d urls $
+				feeder user pass
+			return True
   where
-	save (_, (_, b)) = do
-		saver b
-		return True
+	onerr _ = return False
+
+	feeder _ _ [] = return ([], [])
+	feeder user pass (url:urls) = do
+		mb <- davGetUrlContent url user pass
+		case mb of
+			Nothing -> throwDownloadFailed
+			Just b -> return (urls, L.toChunks b)
+
+throwDownloadFailed :: IO a
+throwDownloadFailed = ioError $ mkIOError userErrorType "download failed" Nothing Nothing
+
+retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
+retrieveEncrypted r (cipher, enck) k d = metered Nothing k $ \meterupdate ->
+	davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $
+		withStoredFiles r enck baseurl user pass onerr $ \urls -> do
+			withDecryptedContent cipher (L.concat <$> feeder user pass urls []) $
+				meteredWriteFile meterupdate d
+			return True
+  where
+	onerr _ = return False
+
+	feeder _ _ [] c = return $ reverse c
+	feeder user pass (url:urls) c = do
+		mb <- davGetUrlContent url user pass
+		case mb of
+			Nothing -> throwDownloadFailed
+			Just b -> feeder user pass urls (b:c)
 
 remove :: Remote -> Key -> Annex Bool
 remove r k = davAction r False $ \(baseurl, user, pass) -> liftIO $ do
@@ -136,20 +157,48 @@ remove r k = davAction r False $ \(baseurl, user, pass) -> liftIO $ do
 	isJust <$> catchMaybeHttp (deleteContent url user pass)
 
 checkPresent :: Remote -> Key -> Annex (Either String Bool)
-checkPresent r k = davAction r noconn $ \(baseurl, user, pass) -> do
-	showAction $ "checking " ++ name r
-	let url = davLocation baseurl k	
-	v <- liftIO $ catchHttp $ getProps url user pass
-	case v of
-		Right _ -> return $ Right True
-		Left (Left (StatusCodeException status _))
-			| statusCode status == statusCode notFound404 -> return $ Right False
-			| otherwise -> return $ Left $ show $ statusMessage status
-		Left (Left httpexception) -> return $ Left $ show httpexception
-		Left (Right ioexception) -> return $ Left $ show ioexception
+checkPresent r k = davAction r noconn go
   where
 	noconn = Left $ error $ name r ++ " not configured"
 
+	go (baseurl, user, pass) = do
+		showAction $ "checking " ++ name r
+		liftIO $ withStoredFiles r k baseurl user pass onerr check
+	  where
+		check [] = return $ Right True
+		check (url:urls) = do
+			v <- davUrlExists url user pass
+			if v == Right True
+				then check urls
+				else return v
+
+		{- Failed to read the chunkcount file; see if it's missing,
+		 - or if there's a problem accessing it,
+		 - or perhaps this was an intermittent error. -}
+		onerr url = do
+			v <- davUrlExists url user pass
+			if v == Right True
+				then return $ Left $ "failed to read " ++ url
+				else return v
+
+withStoredFiles
+	:: Remote
+	-> Key
+	-> DavUrl
+	-> DavUser
+	-> DavPass
+	-> (DavUrl -> IO a)
+	-> ([DavUrl] -> IO a)
+	-> IO a
+withStoredFiles r k baseurl user pass onerr a
+	| isJust $ chunkSize $ config r = do
+		let chunkcount = url ++ chunkCount
+		maybe (onerr chunkcount) (a . listChunks url . L8.toString)
+			=<< davGetUrlContent chunkcount user pass
+	| otherwise = a [url]
+  where
+	url = davLocation baseurl k
+
 davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a
 davAction r unconfigured action = case config r of
 	Nothing -> return unconfigured
@@ -173,6 +222,20 @@ davLocation baseurl k = davUrl baseurl $ annexLocation k hashDirLower
 davUrl :: DavUrl -> FilePath -> DavUrl
 davUrl baseurl file = baseurl </> file
 
+davUrlExists :: DavUrl -> DavUser -> DavPass -> IO (Either String Bool)
+davUrlExists url user pass = decode <$> catchHttp (getProps url user pass)
+  where
+	decode (Right _) = Right True
+	decode (Left (Left (StatusCodeException status _)))
+		| statusCode status == statusCode notFound404 = Right False
+		| otherwise = Left $ show $ statusMessage status
+	decode (Left (Left httpexception)) = Left $ show httpexception
+	decode (Left (Right ioexception)) = Left $ show ioexception
+
+davGetUrlContent :: DavUrl -> DavUser -> DavPass -> IO  (Maybe L.ByteString)
+davGetUrlContent url user pass = fmap (snd . snd) <$>
+	catchMaybeHttp (getPropsAndContent url user pass)
+
 {- Creates a directory in WebDAV, if not already present; also creating
  - any missing parent directories. -}
 davMkdir :: DavUrl -> DavUser -> DavPass -> IO ()