diff options
| -rw-r--r-- | Annex.hs | 2 | ||||
| -rw-r--r-- | Annex/Drop.hs | 5 | ||||
| -rw-r--r-- | Command/Drop.hs | 38 | ||||
| -rw-r--r-- | Command/DropUnused.hs | 17 | ||||
| -rw-r--r-- | Command/Fsck.hs | 11 | ||||
| -rw-r--r-- | Command/Mirror.hs | 19 | ||||
| -rw-r--r-- | Command/NumCopies.hs | 4 | ||||
| -rw-r--r-- | GitAnnex/Options.hs | 2 | ||||
| -rw-r--r-- | Logs/NumCopies.hs | 80 | ||||
| -rw-r--r-- | Types/GitConfig.hs | 5 |
10 files changed, 105 insertions, 78 deletions
@@ -96,6 +96,7 @@ data AnnexState = AnnexState , checkignorehandle :: Maybe (Maybe CheckIgnoreHandle) , forcebackend :: Maybe String , globalnumcopies :: Maybe NumCopies + , forcenumcopies :: Maybe NumCopies , limit :: Matcher (MatchInfo -> Annex Bool) , uuidmap :: Maybe UUIDMap , preferredcontentmap :: Maybe PreferredContentMap @@ -131,6 +132,7 @@ newState c r = AnnexState , checkignorehandle = Nothing , forcebackend = Nothing , globalnumcopies = Nothing + , forcenumcopies = Nothing , limit = Left [] , uuidmap = Nothing , preferredcontentmap = Nothing diff --git a/Annex/Drop.hs b/Annex/Drop.hs index afd6303b0..8cab7b065 100644 --- a/Annex/Drop.hs +++ b/Annex/Drop.hs @@ -60,8 +60,7 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runn where getcopies fs = do (untrusted, have) <- trustPartition UnTrusted locs - numcopies <- maximum - <$> mapM (getNumCopies <=< getFileNumCopies) fs + numcopies <- maximum <$> mapM getFileNumCopies fs return (NumCopies (length have), numcopies, S.fromList untrusted) {- Check that we have enough copies still to drop the content. @@ -88,7 +87,7 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runn checkdrop fs n@(have, numcopies, _untrusted) u a = ifM (allM (wantDrop True u . Just) fs) - ( ifM (safely $ runner $ a (Just numcopies)) + ( ifM (safely $ runner $ a numcopies) ( do liftIO $ debugM "drop" $ unwords [ "dropped" diff --git a/Command/Drop.hs b/Command/Drop.hs index 9609cf830..8f7e1aae9 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -43,17 +43,17 @@ start from file (key, _) = checkDropAuto from file key $ \numcopies -> then startLocal (Just file) numcopies key Nothing else startRemote (Just file) numcopies key remote -startLocal :: AssociatedFile -> Maybe NumCopies -> Key -> Maybe Remote -> CommandStart +startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do showStart "drop" (fromMaybe (key2file key) afile) next $ performLocal key numcopies knownpresentremote -startRemote :: AssociatedFile -> Maybe NumCopies -> Key -> Remote -> CommandStart +startRemote :: AssociatedFile -> NumCopies -> Key -> Remote -> CommandStart startRemote afile numcopies key remote = do showStart ("drop " ++ Remote.name remote) (fromMaybe (key2file key) afile) next $ performRemote key numcopies remote -performLocal :: Key -> Maybe NumCopies -> Maybe Remote -> CommandPerform +performLocal :: Key -> NumCopies -> Maybe Remote -> CommandPerform performLocal key numcopies knownpresentremote = lockContent key $ do (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key let trusteduuids' = case knownpresentremote of @@ -65,7 +65,7 @@ performLocal key numcopies knownpresentremote = lockContent key $ do removeAnnex key next $ cleanupLocal key -performRemote :: Key -> Maybe NumCopies -> Remote -> CommandPerform +performRemote :: Key -> NumCopies -> Remote -> CommandPerform performRemote key numcopies remote = lockContent key $ do -- Filter the remote it's being dropped from out of the lists of -- places assumed to have the key, and places to check. @@ -98,14 +98,12 @@ cleanupRemote key remote ok = do {- Checks specified remotes to verify that enough copies of a key exist to - allow it to be safely removed (with no data loss). Can be provided with - some locations where the key is known/assumed to be present. -} -canDropKey :: Key -> Maybe NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool -canDropKey key numcopiesM have check skip = do +canDropKey :: Key -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool +canDropKey key numcopies have check skip = do force <- Annex.getState Annex.force - if force || numcopiesM == Just (NumCopies 0) + if force || numcopies == NumCopies 0 then return True - else do - need <- getNumCopies numcopiesM - findCopies key need skip have check + else findCopies key numcopies skip have check findCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool findCopies key need skip = helper [] [] @@ -142,22 +140,18 @@ notEnoughCopies key need have skip bad = do hint = showLongNote "(Use --force to override this check, or adjust numcopies.)" {- In auto mode, only runs the action if there are enough - - copies on other semitrusted repositories. - - - - Passes any numcopies attribute of the file on to the action as an - - optimisation. -} -checkDropAuto :: Maybe Remote -> FilePath -> Key -> (Maybe NumCopies -> CommandStart) -> CommandStart + - copies on other semitrusted repositories. -} +checkDropAuto :: Maybe Remote -> FilePath -> Key -> (NumCopies -> CommandStart) -> CommandStart checkDropAuto mremote file key a = do - numcopiesattr <- getFileNumCopies file - Annex.getState Annex.auto >>= auto numcopiesattr + numcopies <- getFileNumCopies file + Annex.getState Annex.auto >>= auto numcopies where - auto numcopiesattr False = a numcopiesattr - auto numcopiesattr True = do - needed <- getNumCopies numcopiesattr + auto numcopies False = a numcopies + auto numcopies True = do locs <- Remote.keyLocations key uuid <- getUUID let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote locs' <- trustExclude UnTrusted $ filter (/= remoteuuid) locs - if NumCopies (length locs') >= needed - then a numcopiesattr + if NumCopies (length locs') >= numcopies + then a numcopies else stop diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 5d7c5c1d2..043ddfe00 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -15,6 +15,7 @@ import qualified Remote import qualified Git import qualified Option import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) +import Logs.NumCopies def :: [Command] def = [withOptions [Command.Drop.fromOption] $ @@ -22,18 +23,20 @@ def = [withOptions [Command.Drop.fromOption] $ seek SectionMaintenance "drop unused file content"] seek :: CommandSeek -seek = withUnusedMaps start +seek ps = do + numcopies <- getNumCopies + withUnusedMaps (start numcopies) ps -start :: UnusedMaps -> Int -> CommandStart -start = startUnused "dropunused" perform (performOther gitAnnexBadLocation) (performOther gitAnnexTmpLocation) +start :: NumCopies -> UnusedMaps -> Int -> CommandStart +start numcopies = startUnused "dropunused" (perform numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpLocation) -perform :: Key -> CommandPerform -perform key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< from +perform :: NumCopies -> Key -> CommandPerform +perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< from where dropremote r = do showAction $ "from " ++ Remote.name r - Command.Drop.performRemote key Nothing r - droplocal = Command.Drop.performLocal key Nothing Nothing + Command.Drop.performRemote key numcopies r + droplocal = Command.Drop.performLocal key numcopies Nothing from = Annex.getField $ Option.name Command.Drop.fromOption performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 839ab1d71..598025189 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -119,7 +119,7 @@ start from inc file (key, backend) = do where go = runFsck inc file key -perform :: Key -> FilePath -> Backend -> Maybe NumCopies -> Annex Bool +perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool perform key file backend numcopies = check -- order matters [ fixLink key file @@ -133,7 +133,7 @@ perform key file backend numcopies = check {- To fsck a remote, the content is retrieved to a tmp file, - and checked locally. -} -performRemote :: Key -> FilePath -> Backend -> Maybe NumCopies -> Remote -> Annex Bool +performRemote :: Key -> FilePath -> Backend -> NumCopies -> Remote -> Annex Bool performRemote key file backend numcopies remote = dispatch =<< Remote.hasKey remote key where @@ -369,15 +369,14 @@ checkBackendOr' bad backend key file postcheck = , return True ) -checkKeyNumCopies :: Key -> FilePath -> Maybe NumCopies -> Annex Bool +checkKeyNumCopies :: Key -> FilePath -> NumCopies -> Annex Bool checkKeyNumCopies key file numcopies = do - needed <- getNumCopies numcopies (untrustedlocations, safelocations) <- trustPartition UnTrusted =<< Remote.keyLocations key let present = NumCopies (length safelocations) - if present < needed + if present < numcopies then do ppuuids <- Remote.prettyPrintUUIDs "untrusted" untrustedlocations - warning $ missingNote file present needed ppuuids + warning $ missingNote file present numcopies ppuuids return False else return True diff --git a/Command/Mirror.hs b/Command/Mirror.hs index e5ce33ec0..fb06ed2b4 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -28,17 +28,15 @@ seek ps = do to <- getOptionField toOption Remote.byNameWithUUID from <- getOptionField fromOption Remote.byNameWithUUID withKeyOptions - (startKey Nothing to from Nothing) + (startKey to from Nothing) (withFilesInGit $ whenAnnexed $ start to from) ps start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart -start to from file (key, _backend) = do - numcopies <- getFileNumCopies file - startKey numcopies to from (Just file) key +start to from file (key, _backend) = startKey to from (Just file) key -startKey :: Maybe NumCopies -> Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart -startKey numcopies to from afile key = do +startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart +startKey to from afile key = do noAuto case (from, to) of (Nothing, Nothing) -> error "specify either --from or --to" @@ -50,7 +48,9 @@ startKey numcopies to from afile key = do error "--auto is not supported for mirror" mirrorto r = ifM (inAnnex key) ( Command.Move.toStart r False afile key - , Command.Drop.startRemote afile numcopies key r + , do + numcopies <- getnumcopies + Command.Drop.startRemote afile numcopies key r ) mirrorfrom r = do haskey <- Remote.hasKey r key @@ -58,6 +58,9 @@ startKey numcopies to from afile key = do Left _ -> stop Right True -> Command.Get.start' (return True) Nothing key afile Right False -> ifM (inAnnex key) - ( Command.Drop.startLocal afile numcopies key Nothing + ( do + numcopies <- getnumcopies + Command.Drop.startLocal afile numcopies key Nothing , stop ) + getnumcopies = maybe getNumCopies getFileNumCopies afile diff --git a/Command/NumCopies.hs b/Command/NumCopies.hs index 51bde2e68..cc322bcbd 100644 --- a/Command/NumCopies.hs +++ b/Command/NumCopies.hs @@ -42,10 +42,10 @@ startGet = next $ next $ do Just n -> liftIO $ putStrLn $ show $ fromNumCopies n Nothing -> do liftIO $ putStrLn $ "global numcopies is not set" - old <- annexNumCopies <$> Annex.getGitConfig + old <- deprecatedNumCopies case old of Nothing -> liftIO $ putStrLn "(default is 1)" - Just n -> liftIO $ putStrLn $ "(deprecated git config annex.numcopies is set to " ++ show n ++ " locally)" + Just n -> liftIO $ putStrLn $ "(deprecated git config annex.numcopies is set to " ++ show (fromNumCopies n) ++ " locally)" return True startSet :: Int -> CommandStart diff --git a/GitAnnex/Options.hs b/GitAnnex/Options.hs index 063ca995b..10fcc0073 100644 --- a/GitAnnex/Options.hs +++ b/GitAnnex/Options.hs @@ -66,7 +66,7 @@ options = Option.common ++ where trustArg t = ReqArg (Remote.forceTrust t) paramRemote setnumcopies v = maybe noop - (\n -> Annex.changeState $ \s -> s { Annex.globalnumcopies = Just $ NumCopies n }) + (\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n }) (readish v) setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v } setgitconfig v = inRepo (Git.Config.store v) diff --git a/Logs/NumCopies.hs b/Logs/NumCopies.hs index 2fd6f75f8..8f1a09301 100644 --- a/Logs/NumCopies.hs +++ b/Logs/NumCopies.hs @@ -13,9 +13,11 @@ module Logs.NumCopies ( getGlobalNumCopies, globalNumCopiesLoad, getFileNumCopies, - numCopiesCheck, + getGlobalFileNumCopies, getNumCopies, + numCopiesCheck, deprecatedNumCopies, + defaultNumCopies ) where import Common.Annex @@ -34,7 +36,7 @@ instance SingleValueSerializable NumCopies where setGlobalNumCopies :: NumCopies -> Annex () setGlobalNumCopies = setLog numcopiesLog -{- Cached for speed. -} +{- Value configured in the numcopies log. Cached for speed. -} getGlobalNumCopies :: Annex (Maybe NumCopies) getGlobalNumCopies = maybe globalNumCopiesLoad (return . Just) =<< Annex.getState Annex.globalnumcopies @@ -45,33 +47,57 @@ globalNumCopiesLoad = do Annex.changeState $ \s -> s { Annex.globalnumcopies = v } return v -{- Numcopies value for a file, from .gitattributes or global, - - but not the deprecated git config. -} -getFileNumCopies :: FilePath -> Annex (Maybe NumCopies) -getFileNumCopies file = do - global <- getGlobalNumCopies - case global of - Just n -> return $ Just n - Nothing -> (NumCopies <$$> readish) - <$> checkAttr "annex.numcopies" file - -deprecatedNumCopies :: Annex NumCopies -deprecatedNumCopies = NumCopies . fromMaybe 1 . annexNumCopies - <$> Annex.getGitConfig - -{- Checks if numcopies are satisfied by running a comparison +defaultNumCopies :: NumCopies +defaultNumCopies = NumCopies 1 + +fromSources :: [Annex (Maybe NumCopies)] -> Annex NumCopies +fromSources = fromMaybe defaultNumCopies <$$> getM id + +{- The git config annex.numcopies is deprecated. -} +deprecatedNumCopies :: Annex (Maybe NumCopies) +deprecatedNumCopies = annexNumCopies <$> Annex.getGitConfig + +{- Value forced on the command line by --numcopies. -} +getForcedNumCopies :: Annex (Maybe NumCopies) +getForcedNumCopies = Annex.getState Annex.forcenumcopies + +{- Numcopies value from any of the non-.gitattributes configuration + - sources. -} +getNumCopies :: Annex NumCopies +getNumCopies = fromSources + [ getForcedNumCopies + , getGlobalNumCopies + , deprecatedNumCopies + ] + +{- Numcopies value for a file, from any configuration source, including the + - deprecated git config. -} +getFileNumCopies :: FilePath -> Annex NumCopies +getFileNumCopies f = fromSources + [ getForcedNumCopies + , getFileNumCopies' f + , deprecatedNumCopies + ] + +{- This is the globally visible numcopies value for a file. So it does + - not include local configuration in the git config or command line + - options. -} +getGlobalFileNumCopies :: FilePath -> Annex NumCopies +getGlobalFileNumCopies f = fromSources + [ getFileNumCopies' f + ] + +getFileNumCopies' :: FilePath -> Annex (Maybe NumCopies) +getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr + where + getattr = (NumCopies <$$> readish) + <$> checkAttr "annex.numcopies" file + +{- Checks if numcopies are satisfied for a file by running a comparison - between the number of (not untrusted) copies that are - - belived to exist, and the configured value. - - - - Includes the deprecated annex.numcopies git config if - - nothing else specifies a numcopies value. -} + - belived to exist, and the configured value. -} numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v numCopiesCheck file key vs = do - numcopiesattr <- getFileNumCopies file - NumCopies needed <- getNumCopies numcopiesattr + NumCopies needed <- getFileNumCopies file have <- trustExclude UnTrusted =<< Remote.keyLocations key return $ length have `vs` needed - -getNumCopies :: Maybe NumCopies -> Annex NumCopies -getNumCopies (Just v) = return v -getNumCopies Nothing = deprecatedNumCopies diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 5cd09dbde..af516d27a 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -19,12 +19,13 @@ import Utility.DataUnits import Config.Cost import Types.Distribution import Types.Availability +import Types.NumCopies {- Main git-annex settings. Each setting corresponds to a git-config key - such as annex.foo -} data GitConfig = GitConfig { annexVersion :: Maybe String - , annexNumCopies :: Maybe Int + , annexNumCopies :: Maybe NumCopies , annexDiskReserve :: Integer , annexDirect :: Bool , annexBackends :: [String] @@ -52,7 +53,7 @@ data GitConfig = GitConfig extractGitConfig :: Git.Repo -> GitConfig extractGitConfig r = GitConfig { annexVersion = notempty $ getmaybe (annex "version") - , annexNumCopies = getmayberead (annex "numcopies") + , annexNumCopies = NumCopies <$> getmayberead (annex "numcopies") , annexDiskReserve = fromMaybe onemegabyte $ readSize dataUnits =<< getmaybe (annex "diskreserve") , annexDirect = getbool (annex "direct") False |