diff options
Diffstat (limited to 'Command')
| -rw-r--r-- | Command/Get.hs | 20 | ||||
| -rw-r--r-- | Command/Move.hs | 3 | ||||
| -rw-r--r-- | Command/ReKey.hs | 2 | ||||
| -rw-r--r-- | Command/RecvKey.hs | 52 | ||||
| -rw-r--r-- | Command/Reinject.hs | 28 | ||||
| -rw-r--r-- | Command/SetKey.hs | 2 | ||||
| -rw-r--r-- | Command/Sync.hs | 4 | ||||
| -rw-r--r-- | Command/TestRemote.hs | 6 | ||||
| -rw-r--r-- | Command/TransferKey.hs | 3 | ||||
| -rw-r--r-- | Command/TransferKeys.hs | 3 |
10 files changed, 39 insertions, 84 deletions
diff --git a/Command/Get.hs b/Command/Get.hs index 324ff2752..58fbefed2 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -68,17 +68,16 @@ start' expensivecheck from key afile = stopUnless (not <$> inAnnex key) $ next a perform :: Key -> AssociatedFile -> CommandPerform -perform key afile = stopUnless (getViaTmp key $ getKeyFile key afile) $ +perform key afile = stopUnless (getKey key afile) $ next $ return True -- no cleanup needed {- Try to find a copy of the file in one of the remotes, - and copy it to here. -} -getKeyFile :: Key -> AssociatedFile -> FilePath -> Annex Bool -getKeyFile key afile dest = getKeyFile' key afile dest - =<< Remote.keyPossibilities key +getKey :: Key -> AssociatedFile -> Annex Bool +getKey key afile = getKey' key afile =<< Remote.keyPossibilities key -getKeyFile' :: Key -> AssociatedFile -> FilePath -> [Remote] -> Annex Bool -getKeyFile' key afile dest = dispatch +getKey' :: Key -> AssociatedFile -> [Remote] -> Annex Bool +getKey' key afile = dispatch where dispatch [] = do showNote "not available" @@ -102,6 +101,9 @@ getKeyFile' key afile dest = dispatch | Remote.hasKeyCheap r = either (const False) id <$> Remote.hasKey r key | otherwise = return True - docopy r = download (Remote.uuid r) key afile noRetry noObserver $ \p -> do - showAction $ "from " ++ Remote.name r - Remote.retrieveKeyFile r key afile dest p + docopy r witness = getViaTmp (RemoteVerify r) key $ \dest -> + download (Remote.uuid r) key afile noRetry noObserver + (\p -> do + showAction $ "from " ++ Remote.name r + Remote.retrieveKeyFile r key afile dest p + ) witness diff --git a/Command/Move.hs b/Command/Move.hs index d95bce6ab..a83ea04dd 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -166,7 +166,8 @@ fromPerform src move key afile = ifM (inAnnex key) go = notifyTransfer Download afile $ download (Remote.uuid src) key afile noRetry noObserver $ \p -> do showAction $ "from " ++ Remote.name src - getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p + getViaTmp (RemoteVerify src) key $ \t -> + Remote.retrieveKeyFile src key afile t p dispatch _ False = stop -- failed dispatch False True = next $ return True -- copy complete dispatch True True = do -- finish moving diff --git a/Command/ReKey.hs b/Command/ReKey.hs index e38ce3c50..9084814fa 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -52,7 +52,7 @@ perform file oldkey newkey = do {- Make a hard link to the old key content (when supported), - to avoid wasting disk space. -} linkKey :: Key -> Key -> Annex Bool -linkKey oldkey newkey = getViaTmp' newkey $ \tmp -> do +linkKey oldkey newkey = getViaTmp' DefaultVerify newkey $ \tmp -> do src <- calcRepo $ gitAnnexLocation oldkey liftIO $ ifM (doesFileExist tmp) ( return True diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index 7477bb879..3a8747534 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -16,9 +16,6 @@ import Utility.Rsync import Logs.Transfer import Command.SendKey (fieldTransfer) import qualified CmdLine.GitAnnexShell.Fields as Fields -import qualified Types.Key -import qualified Types.Backend -import qualified Backend cmd :: Command cmd = noCommit $ command "recvkey" SectionPlumbing @@ -29,8 +26,12 @@ seek :: CmdParams -> CommandSeek seek = withKeys start start :: Key -> CommandStart -start key = fieldTransfer Download key $ \_p -> - ifM (getViaTmp key go) +start key = fieldTransfer Download key $ \_p -> do + -- Always verify content when a direct mode repo is sending a file, + -- as the file could change while being transferred. + fromdirect <- isJust <$> Fields.getField Fields.direct + let verify = if fromdirect then AlwaysVerify else DefaultVerify + ifM (getViaTmp verify key go) ( do -- forcibly quit after receiving one key, -- and shutdown cleanly @@ -42,43 +43,4 @@ start key = fieldTransfer Download key $ \_p -> go tmp = do opts <- filterRsyncSafeOptions . maybe [] words <$> getField "RsyncOptions" - ok <- liftIO $ rsyncServerReceive (map Param opts) tmp - - -- The file could have been received with permissions that - -- do not allow reading it, so this is done before the - -- directcheck. - freezeContent tmp - - if ok - then ifM (isJust <$> Fields.getField Fields.direct) - ( directcheck tmp - , return True - ) - else return False - {- If the sending repository uses direct mode, the file - - it sends could be modified as it's sending it. So check - - that the right size file was received, and that the key/value - - Backend is happy with it. -} - directcheck tmp = do - oksize <- case Types.Key.keySize key of - Nothing -> return True - Just size -> do - size' <- liftIO $ getFileSize tmp - return $ size == size' - if oksize - then case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of - Nothing -> do - warning "recvkey: received key from direct mode repository using unknown backend; cannot check; discarding" - return False - Just backend -> maybe (return True) runverify - (Types.Backend.verifyKeyContent backend) - else do - warning "recvkey: received key with wrong size; discarding" - return False - where - runverify check = ifM (check key tmp) - ( return True - , do - warning "recvkey: received key from direct mode repository seems to have changed as it was transferred; discarding" - return False - ) + liftIO $ rsyncServerReceive (map Param opts) tmp diff --git a/Command/Reinject.hs b/Command/Reinject.hs index 76e1420ff..90ddc1c2a 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -11,8 +11,6 @@ import Common.Annex import Command import Logs.Location import Annex.Content -import qualified Command.Fsck -import qualified Backend cmd :: Command cmd = command "reinject" SectionUtility @@ -36,29 +34,19 @@ start (src:dest:[]) start _ = error "specify a src file and a dest file" perform :: FilePath -> FilePath -> Key -> CommandPerform -perform src dest key = do - {- Check the content before accepting it. -} - v <- Backend.getBackend dest key - case v of - Nothing -> stop - Just backend -> - ifM (Command.Fsck.checkKeySizeOr reject key src - <&&> Command.Fsck.checkBackendOr reject backend key src) - ( do - unlessM move $ error "mv failed!" - next $ cleanup key - , error "not reinjecting" - ) +perform src _dest key = ifM move + ( next $ cleanup key + , error "failed" + ) where - -- the file might be on a different filesystem, + -- The file might be on a different filesystem, -- so moveFile is used rather than simply calling - -- moveToObjectDir; disk space is also - -- checked this way. - move = getViaTmp key $ \tmp -> + -- moveToObjectDir; disk space is also checked this way, + -- and the file's content is verified to match the key. + move = getViaTmp DefaultVerify key $ \tmp -> liftIO $ catchBoolIO $ do moveFile src tmp return True - reject = const $ return "wrong file?" cleanup :: Key -> CommandCleanup cleanup key = do diff --git a/Command/SetKey.hs b/Command/SetKey.hs index d8216a0b4..319229482 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -35,7 +35,7 @@ perform file key = do -- the file might be on a different filesystem, so moveFile is used -- rather than simply calling moveAnnex; disk space is also -- checked this way. - ok <- getViaTmp key $ \dest -> + ok <- getViaTmp DefaultVerify key $ \dest -> if dest /= file then liftIO $ catchBoolIO $ do moveFile file dest diff --git a/Command/Sync.hs b/Command/Sync.hs index 19a984300..964b45dc2 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -37,7 +37,7 @@ import qualified Remote.Git import Config import Annex.Wanted import Annex.Content -import Command.Get (getKeyFile') +import Command.Get (getKey') import qualified Command.Move import Logs.Location import Annex.Drop @@ -476,7 +476,7 @@ syncFile ebloom rs af k = do ) get have = includeCommandAction $ do showStart' "get" k af - next $ next $ getViaTmp k $ \dest -> getKeyFile' k af dest have + next $ next $ getKey' k af have wantput r | Remote.readonly r || remoteAnnexReadOnly (Remote.gitconfig r) = return False diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index fbe83f2db..e4a9eb829 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -159,7 +159,7 @@ test st r k = Just b -> case verifyKeyContent b of Nothing -> return True Just verifier -> verifier k (key2file k) - get = getViaTmp k $ \dest -> + get = getViaTmp (RemoteVerify r) k $ \dest -> Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate store = Remote.storeKey r k Nothing nullMeterUpdate remove = Remote.removeKey r k @@ -173,10 +173,10 @@ testUnavailable st r k = , check (`notElem` [Right True, Right False]) "checkPresent" $ Remote.checkPresent r k , check (== Right False) "retrieveKeyFile" $ - getViaTmp k $ \dest -> + getViaTmp (RemoteVerify r) k $ \dest -> Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate , check (== Right False) "retrieveKeyFileCheap" $ - getViaTmp k $ \dest -> + getViaTmp (RemoteVerify r) k $ \dest -> Remote.retrieveKeyFileCheap r k Nothing dest ] where diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 04dbc1799..56c9ec675 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -61,7 +61,8 @@ toPerform key file remote = go Upload file $ fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform fromPerform key file remote = go Upload file $ download (uuid remote) key file forwardRetry noObserver $ \p -> - getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p + getViaTmp (RemoteVerify remote) key $ + \t -> Remote.retrieveKeyFile remote key file t p go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform go direction file a = notifyTransfer direction file a >>= liftIO . exitBool diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index 67f201024..4fb0d9069 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -43,7 +43,8 @@ start = do return ok | otherwise = notifyTransfer direction file $ download (Remote.uuid remote) key file forwardRetry observer $ \p -> - getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p + getViaTmp (RemoteVerify remote) key $ \t -> + Remote.retrieveKeyFile remote key file t p observer False t tinfo = recordFailedTransfer t tinfo observer True _ _ = noop |