encrypted webdav working

This commit is contained in:
Joey Hess 2012-11-16 13:32:18 -04:00
parent bb28c6114a
commit 0f782bd028
2 changed files with 25 additions and 17 deletions

View file

@ -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.) -- (An alternative would be chunking to to a constant size.)
withTmp enck $ \tmp -> do withTmp enck $ \tmp -> do
f <- inRepo $ gitAnnexLocation k 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 res <- liftIO $ storeHelper (conn, bucket) r enck tmp
s3Bool res s3Bool res

View file

@ -78,39 +78,47 @@ webdavSetup u c = do
creds <- getCreds c' u creds <- getCreds c' u
testDav url creds testDav url creds
gitConfigSpecialRemote u c' "webdav" "true" gitConfigSpecialRemote u c' "webdav" "true"
setRemoteCredPair c (davCreds u) setRemoteCredPair c' (davCreds u)
store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
store r k _f _p = davAction r False $ \(baseurl, user, pass) -> do store r k _f _p = davAction r False $ \(baseurl, user, pass) -> do
let url = davLocation baseurl k let url = davLocation baseurl k
liftIO $ davMkdir (urlParent url) user pass
f <- inRepo $ gitAnnexLocation k f <- inRepo $ gitAnnexLocation k
b <- liftIO $ L.readFile f b <- liftIO $ L.readFile f
liftIO $ davMkdir (urlParent url) user pass
v <- liftIO $ catchMaybeHttp $ putContentAndProps url user pass v <- liftIO $ catchMaybeHttp $ putContentAndProps url user pass
(noProps, (contentType, b)) (noProps, (contentType, b))
return $ isJust v return $ isJust v
storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
storeEncrypted r (cipher, enck) k _p = davAction r False $ \creds -> liftIO $ do storeEncrypted r (cipher, enck) k _p = davAction r False $ \(baseurl, user, pass) -> do
error "TODO" 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 :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
retrieve r k _f d = davAction r False $ liftIO . go retrieve r k _f d = retrieve' r k (L.writeFile d)
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
retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
retrieveCheap _ _ _ = return False retrieveCheap _ _ _ = return False
retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
retrieveEncrypted r (cipher, enck) _ f = davAction r False $ \creds -> do retrieveEncrypted r (cipher, enck) _ d = retrieve' r enck $ \b -> do
error "TODO" 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 :: Remote -> Key -> Annex Bool
remove r k = davAction r False $ liftIO . go 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 {- Test if a WebDAV store is usable, by writing to a test file, and then
- deleting the file. Exits with an error if not. -} - deleting the file. Exits with an error if not. -}
testDav :: String -> Maybe CredPair -> Annex () testDav :: String -> Maybe CredPair -> Annex ()
testDav baseurl Nothing = error "Need to configure webdav username and password."
testDav baseurl (Just (u, p)) = do testDav baseurl (Just (u, p)) = do
showSideAction "testing WebDAV server" showSideAction "testing WebDAV server"
liftIO $ do liftIO $ do
@ -212,6 +219,7 @@ testDav baseurl (Just (u, p)) = do
user = toDavUser u user = toDavUser u
pass = toDavPass p pass = toDavPass p
testurl = davUrl baseurl "git-annex-test" 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. -} {- Content-Type to use for files uploaded to WebDAV. -}
contentType :: Maybe B8.ByteString contentType :: Maybe B8.ByteString