mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

local gcrypt fully working!

Browse source
This commit is contained in:
Joey Hess 2013-09-08 13:00:48 -04:00
parent c56f71ab71
commit 9477a07cbf
1 changed files with 29 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

36
Remote/GCrypt.hs
View file

@ -8,6 +8,7 @@
module Remote.GCrypt (remote, gen) where module Remote.GCrypt (remote, gen) where
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.ByteString.Lazy as L
import Common.Annex import Common.Annex
import Types.Remote import Types.Remote
@ -66,7 +67,7 @@ gen' r u c gc = new <$> remoteCost gc defcst
, storeKey = \_ _ _ -> noCrypto , storeKey = \_ _ _ -> noCrypto
, retrieveKeyFile = \_ _ _ _ -> noCrypto , retrieveKeyFile = \_ _ _ _ -> noCrypto
, retrieveKeyFileCheap = \_ _ -> return False , retrieveKeyFileCheap = \_ _ -> return False
, removeKey = remove , removeKey = remove this
, hasKey = checkPresent this , hasKey = checkPresent this
, hasKeyCheap = repoCheap r , hasKeyCheap = repoCheap r
, whereisKey = Nothing , whereisKey = Nothing
@ -82,6 +83,9 @@ gen' r u c gc = new <$> remoteCost gc defcst
noCrypto :: Annex a noCrypto :: Annex a
noCrypto = error "cannot use gcrypt remote without encryption enabled" noCrypto = error "cannot use gcrypt remote without encryption enabled"
unsupportedUrl :: Annex a
unsupportedUrl = error "using non-ssh remote repo url with gcrypt is not supported"
gCryptSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) gCryptSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
gCryptSetup mu c = go $ M.lookup "gitrepo" c gCryptSetup mu c = go $ M.lookup "gitrepo" c
where where
@ -134,8 +138,8 @@ store r (cipher, enck) k p
createDirectoryIfMissing True $ parentDir dest createDirectoryIfMissing True $ parentDir dest
readBytes (meteredWriteFile meterupdate dest) h readBytes (meteredWriteFile meterupdate dest) h
return True return True
| Git.repoIsSsh (repo r) = sendwith $ \h -> undefined | Git.repoIsSsh (repo r) = sendwith $ \meterupdate h -> undefined
| otherwise = error "storing on non-ssh remote repo not supported" | otherwise = unsupportedUrl
where where
dest = gCryptLocation r enck dest = gCryptLocation r enck
sendwith a = metered (Just p) k $ \meterupdate -> sendwith a = metered (Just p) k $ \meterupdate ->
@ -144,10 +148,28 @@ store r (cipher, enck) k p
encrypt (getGpgEncParams r) cipher (feedFile src) (a meterupdate) encrypt (getGpgEncParams r) cipher (feedFile src) (a meterupdate)
retrieve :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool retrieve :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
retrieve r (cipher, enck) k d p = undefined retrieve r (cipher, enck) k d p
| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do
retrievewith $ L.readFile src
return True
| Git.repoIsSsh (repo r) = undefined
| otherwise = unsupportedUrl
where
src = gCryptLocation r enck
retrievewith a = metered (Just p) k $ \meterupdate -> liftIO $
a >>= \b ->
decrypt cipher (feedBytes b)
(readBytes $ meteredWriteFile meterupdate d)
remove :: Key -> Annex Bool remove :: Remote -> Key -> Annex Bool
remove k = undefined remove r k
| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do
liftIO $ removeDirectoryRecursive (parentDir dest)
return True
| Git.repoIsSsh (repo r) = undefined
| otherwise = unsupportedUrl
where
dest = gCryptLocation r k
checkPresent :: Remote -> Key -> Annex (Either String Bool) checkPresent :: Remote -> Key -> Annex (Either String Bool)
checkPresent r k checkPresent r k
@ -156,7 +178,7 @@ checkPresent r k
liftIO $ catchDefaultIO unknown $ liftIO $ catchDefaultIO unknown $
Right <$> doesFileExist (gCryptLocation r k) Right <$> doesFileExist (gCryptLocation r k)
| Git.repoIsSsh (repo r) = undefined | Git.repoIsSsh (repo r) = undefined
| otherwise = error "storing on non-ssh remote repo not supported" | otherwise = unsupportedUrl
where where
unknown = Left $ "unable to check " ++ Git.repoDescribe (repo r) ++ show (repo r) unknown = Left $ "unable to check " ++ Git.repoDescribe (repo r) ++ show (repo r)