summaryrefslogtreecommitdiff
path: root/Remote/Ddar.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Remote/Ddar.hs')
-rw-r--r--Remote/Ddar.hs100
1 files changed, 33 insertions, 67 deletions
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index 7218226e8..beeb4d7cc 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -8,11 +8,9 @@
module Remote.Ddar (remote) where
-import Control.Exception
-import qualified Data.ByteString.Lazy as L
import qualified Data.Map as M
+import qualified Data.ByteString.Lazy as L
import System.IO.Error
-import System.Process
import Data.String.Utils
import Common.Annex
@@ -23,12 +21,8 @@ import qualified Git
import Config
import Config.Cost
import Remote.Helper.Special
-import Remote.Helper.Encryptable
-import Crypto
-import Annex.Content
import Annex.Ssh
import Annex.UUID
-import Utility.Metered
type DdarRepo = String
@@ -46,17 +40,23 @@ gen r u c gc = do
if ddarLocal ddarrepo
then nearlyCheapRemoteCost
else expensiveRemoteCost
-
- let new = Remote
+ return $ Just $ specialRemote' specialcfg c
+ (simplyPrepare $ store ddarrepo)
+ (simplyPrepare $ retrieve ddarrepo)
+ (simplyPrepare $ remove ddarrepo)
+ (simplyPrepare $ checkKey ddarrepo)
+ (this cst)
+ where
+ this cst = Remote
{ uuid = u
, cost = cst
, name = Git.repoDescribe r
- , storeKey = store ddarrepo
- , retrieveKeyFile = retrieve ddarrepo
+ , storeKey = storeKeyDummy
+ , retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap
- , removeKey = remove ddarrepo
- , hasKey = checkPresent ddarrepo
- , hasKeyCheap = ddarLocal ddarrepo
+ , removeKey = removeKeyDummy
+ , checkPresent = checkPresentDummy
+ , checkPresentCheap = ddarLocal ddarrepo
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
@@ -70,12 +70,11 @@ gen r u c gc = do
, availability = if ddarLocal ddarrepo then LocallyAvailable else GloballyAvailable
, readonly = False
}
- return $ Just $ encryptableRemote c
- (storeEncrypted new ddarrepo)
- (retrieveEncrypted ddarrepo)
- new
- where
ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc
+ specialcfg = (specialRemoteCfg c)
+ -- chunking would not improve ddar
+ { chunkConfig = NoChunks
+ }
ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
ddarSetup mu _ c = do
@@ -92,17 +91,8 @@ ddarSetup mu _ c = do
return (c', u)
-pipeDdar :: [CommandParam] -> Maybe Handle -> Maybe Handle -> IO Bool
-pipeDdar params inh outh = do
- p <- runProcess "ddar" (toCommand params)
- Nothing Nothing inh outh Nothing
- ok <- waitForProcess p
- case ok of
- ExitSuccess -> return True
- _ -> return False
-
-store :: DdarRepo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-store ddarrepo k _f _p = sendAnnex k (void $ remove ddarrepo k) $ \src -> do
+store :: DdarRepo -> Storer
+store ddarrepo = fileStorer $ \k src _p -> do
let params =
[ Param "c"
, Param "-N"
@@ -112,21 +102,6 @@ store ddarrepo k _f _p = sendAnnex k (void $ remove ddarrepo k) $ \src -> do
]
liftIO $ boolSystem "ddar" params
-storeEncrypted :: Remote -> DdarRepo -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted r ddarrepo (cipher, enck) k _p =
- sendAnnex k (void $ remove ddarrepo k) $ \src ->
- liftIO $ catchBoolIO $
- encrypt (getGpgEncParams r) cipher (feedFile src) $ \h ->
- pipeDdar params (Just h) Nothing
- where
- params =
- [ Param "c"
- , Param "-N"
- , Param $ key2file enck
- , Param ddarrepo
- , Param "-"
- ]
-
{- Convert remote DdarRepo to host and path on remote end -}
splitRemoteDdarRepo :: DdarRepo -> (String, String)
splitRemoteDdarRepo ddarrepo =
@@ -155,28 +130,18 @@ ddarExtractRemoteCall :: DdarRepo -> Key -> Annex (String, [CommandParam])
ddarExtractRemoteCall ddarrepo k =
ddarRemoteCall ddarrepo 'x' [Param "--force-stdout", Param $ key2file k]
-retrieve :: DdarRepo -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
-retrieve ddarrepo k _f d _p = do
+retrieve :: DdarRepo -> Retriever
+retrieve ddarrepo = byteRetriever $ \k sink -> do
(cmd, params) <- ddarExtractRemoteCall ddarrepo k
- liftIO $ catchBoolIO $ withFile d WriteMode $ \h -> do
- let p = (proc cmd $ toCommand params){ std_out = UseHandle h }
- (_, _, _, pid) <- Common.Annex.createProcess p
- forceSuccessProcess p pid
- return True
+ let p = (proc cmd $ toCommand params) { std_out = CreatePipe }
+ (_, Just h, _, pid) <- liftIO $ createProcess p
+ liftIO (hClose h >> forceSuccessProcess p pid)
+ `after` (sink =<< liftIO (L.hGetContents h))
retrieveCheap :: Key -> FilePath -> Annex Bool
retrieveCheap _ _ = return False
-retrieveEncrypted :: DdarRepo -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
-retrieveEncrypted ddarrepo (cipher, enck) _ f _p = do
- (cmd, params) <- ddarExtractRemoteCall ddarrepo enck
- let p = proc cmd $ toCommand params
- liftIO $ catchBoolIO $ withHandle StdoutHandle createProcessSuccess p $ \h -> do
- decrypt cipher (\toh -> L.hPut toh =<< L.hGetContents h) $
- readBytes $ L.writeFile f
- return True
-
-remove :: DdarRepo -> Key -> Annex Bool
+remove :: DdarRepo -> Remover
remove ddarrepo key = do
(cmd, params) <- ddarRemoteCall ddarrepo 'd' [Param $ key2file key]
liftIO $ boolSystem cmd params
@@ -217,13 +182,14 @@ inDdarManifest ddarrepo k = do
where
k' = key2file k
-checkPresent :: DdarRepo -> Key -> Annex (Either String Bool)
-checkPresent ddarrepo key = do
+checkKey :: DdarRepo -> CheckPresent
+checkKey ddarrepo key = do
directoryExists <- ddarDirectoryExists ddarrepo
case directoryExists of
- Left e -> return $ Left e
- Right True -> inDdarManifest ddarrepo key
- Right False -> return $ Right False
+ Left e -> error e
+ Right True -> either error return
+ =<< inDdarManifest ddarrepo key
+ Right False -> return False
ddarLocal :: DdarRepo -> Bool
ddarLocal = notElem ':'