diff options
author | Joey Hess <joey@kitenet.net> | 2011-04-16 21:41:14 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-04-16 21:41:14 -0400 |
commit | 991efddfa1333839885c9bc5490ff79d7dfc046c (patch) | |
tree | 6fa246e1014ac9bf1d40bac7e99bb99c98b59d29 /Remote/Directory.hs | |
parent | 98e3817466130209d88d5061be9a590cdd609e78 (diff) |
refactor
Diffstat (limited to 'Remote/Directory.hs')
-rw-r--r-- | Remote/Directory.hs | 97 |
1 files changed, 52 insertions, 45 deletions
diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 5ea0a1e6b..2d31d12b2 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -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) + let src = gitAnnexLocation g k + let dest = dirKey d k + liftIO $ catch (storeHelper dest $ copyFile src dest) (const $ return False) + +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 - 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 + encrypt src dest = do + content <- L.readFile src + withEncryptedContent cipher content $ L.writeFile dest + return True -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 +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) |