summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-11-16 13:32:18 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-11-16 13:57:32 -0400
commit3f68674646a758d346d7955248debea702748cf2 (patch)
tree9a8540e498840eaddf257c4ed626cb7767814c40 /Remote
parent99c4c837efc778ee792bacb53632261da1dfa99a (diff)
encrypted webdav working
Diffstat (limited to 'Remote')
-rw-r--r--Remote/S3.hs2
-rw-r--r--Remote/WebDAV.hs40
2 files changed, 25 insertions, 17 deletions
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 67a64e464..f7dbf813c 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 b7a355c1f..5c7f13d7e 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