This commit is contained in:
Joey Hess 2011-04-16 21:41:14 -04:00
parent 98e3817466
commit 991efddfa1
2 changed files with 86 additions and 65 deletions

View file

@ -42,17 +42,20 @@ gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
gen r u c = do
dir <- getConfig r "directory" (error "missing directory")
cst <- remoteCost r cheapRemoteCost
return $ Remote {
uuid = u,
cost = cst,
name = Git.repoDescribe r,
storeKey = storeKeyEncrypted c $ store dir,
retrieveKeyFile = retrieveKeyFileEncrypted c $ retrieve dir,
removeKey = removeKeyEncrypted c $ remove dir,
hasKey = hasKeyEncrypted c $ checkPresent dir,
hasKeyCheap = True,
config = Nothing
}
return $ encryptedRemote c
(storeEncrypted dir)
(retrieveEncrypted dir)
Remote {
uuid = u,
cost = cst,
name = Git.repoDescribe r,
storeKey = store dir,
retrieveKeyFile = retrieve dir,
removeKey = remove dir,
hasKey = checkPresent dir,
hasKeyCheap = True,
config = Nothing
}
directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig
directorySetup u c = do
@ -74,43 +77,47 @@ dirKey d k = d </> hashDirMixed k </> f </> f
where
f = keyFile k
store :: FilePath -> Key -> Maybe (Cipher, Key) -> Annex Bool
store d k c = do
store :: FilePath -> Key -> Annex Bool
store d k = do
g <- Annex.gitRepo
let src = gitAnnexLocation g k
liftIO $ catch (copy src) (const $ return False)
where
copy src = case c of
Just (cipher, enckey) -> do
content <- L.readFile src
let dest = dirKey d enckey
prep dest
withEncryptedContent cipher content $ \s -> do
L.writeFile dest s
cleanup True dest
_ -> do
let dest = dirKey d k
prep dest
ok <- copyFile src dest
cleanup ok dest
prep dest = liftIO $ do
let dir = parentDir dest
createDirectoryIfMissing True dir
allowWrite dir
cleanup ok dest = do
when ok $ do
let dir = parentDir dest
preventWrite dest
preventWrite dir
return ok
let src = gitAnnexLocation g k
let dest = dirKey d k
liftIO $ catch (storeHelper dest $ copyFile src dest) (const $ return False)
retrieve :: FilePath -> Key -> FilePath -> Maybe (Cipher, Key) -> Annex Bool
retrieve d k f Nothing = liftIO $ copyFile (dirKey d k) f
retrieve d k f (Just (cipher, enckey)) =
liftIO $ flip catch (const $ return False) $ do
content <- L.readFile (dirKey d enckey)
withDecryptedContent cipher content $ L.writeFile f
return True
storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted d (cipher, enck) k = do
g <- Annex.gitRepo
let src = gitAnnexLocation g k
let dest = dirKey d enck
liftIO $ catch (storeHelper dest $ encrypt src dest) (const $ return False)
where
encrypt src dest = do
content <- L.readFile src
withEncryptedContent cipher content $ L.writeFile dest
return True
storeHelper :: FilePath -> IO Bool -> IO Bool
storeHelper dest a = do
let dir = parentDir dest
createDirectoryIfMissing True dir
allowWrite dir
ok <- a
when ok $ do
preventWrite dest
preventWrite dir
return ok
retrieve :: FilePath -> Key -> FilePath -> Annex Bool
retrieve d k f = liftIO $ copyFile (dirKey d k) f
retrieveEncrypted :: FilePath -> (Cipher, Key) -> FilePath -> Annex Bool
retrieveEncrypted d (cipher, enck) f =
liftIO $ catch decrypt (const $ return False)
where
decrypt = do
content <- L.readFile (dirKey d enck)
withDecryptedContent cipher content $ L.writeFile f
return True
remove :: FilePath -> Key -> Annex Bool
remove d k = liftIO $ catch del (const $ return False)