diff options
-rw-r--r-- | Command/Copy.hs | 12 | ||||
-rw-r--r-- | Command/Fsck.hs | 40 | ||||
-rw-r--r-- | Command/Get.hs | 50 | ||||
-rw-r--r-- | Command/Move.hs | 72 | ||||
-rw-r--r-- | Command/TransferKey.hs | 2 | ||||
-rw-r--r-- | GitAnnex/Options.hs | 4 | ||||
-rw-r--r-- | Seek.hs | 20 | ||||
-rw-r--r-- | debian/changelog | 5 | ||||
-rw-r--r-- | doc/bare_repositories.mdwn | 5 | ||||
-rw-r--r-- | doc/git-annex.mdwn | 8 | ||||
-rw-r--r-- | doc/todo/add_-all_option.mdwn | 4 | ||||
-rw-r--r-- | doc/todo/wishlist:_support_copy_--from__61__x_--to__61__y.mdwn | 10 |
12 files changed, 155 insertions, 77 deletions
diff --git a/Command/Copy.hs b/Command/Copy.hs index 75b91c85c..979eead65 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -14,13 +14,16 @@ import qualified Remote import Annex.Wanted def :: [Command] -def = [withOptions Command.Move.options $ command "copy" paramPaths seek +def = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek SectionCommon "copy content of files to/from another repository"] seek :: [CommandSeek] -seek = [withField Command.Move.toOption Remote.byNameWithUUID $ \to -> - withField Command.Move.fromOption Remote.byNameWithUUID $ \from -> - withFilesInGit $ whenAnnexed $ start to from] +seek = + [ withField Command.Move.toOption Remote.byNameWithUUID $ \to -> + withField Command.Move.fromOption Remote.byNameWithUUID $ \from -> + withAll (Command.Move.startAll to from False) $ + withFilesInGit $ whenAnnexed $ start to from + ] {- A copy is just a move that does not delete the source file. - However, --auto mode avoids unnecessary copies, and avoids getting or @@ -33,4 +36,3 @@ start to from file (key, backend) = stopUnless shouldCopy $ check = case to of Nothing -> wantGet False (Just file) Just r -> wantSend False (Just file) (Remote.uuid r) - diff --git a/Command/Fsck.hs b/Command/Fsck.hs index ce1a28989..dd2d81ecf 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -33,6 +33,7 @@ import qualified Option import Types.Key import Utility.HumanTime import Git.FilePath +import GitAnnex.Options #ifndef __WINDOWS__ import System.Posix.Process (getProcessID) @@ -45,7 +46,7 @@ import System.Posix.Types (EpochTime) import System.Locale def :: [Command] -def = [withOptions options $ command "fsck" paramPaths seek +def = [withOptions fsckOptions $ command "fsck" paramPaths seek SectionMaintenance "check for problems"] fromOption :: Option @@ -61,9 +62,10 @@ incrementalScheduleOption :: Option incrementalScheduleOption = Option.field [] "incremental-schedule" paramTime "schedule incremental fscking" -options :: [Option] -options = - [ fromOption +fsckOptions :: [Option] +fsckOptions = + [ allOption + , fromOption , startIncrementalOption , moreIncrementalOption , incrementalScheduleOption @@ -72,8 +74,9 @@ options = seek :: [CommandSeek] seek = [ withField fromOption Remote.byNameWithUUID $ \from -> - withIncremental $ \i -> withFilesInGit $ whenAnnexed $ start from i - , withIncremental $ \i -> withBarePresentKeys $ startBare i + withIncremental $ \i -> + withAll (startAll i) $ + withFilesInGit $ whenAnnexed $ start from i ] withIncremental :: (Incremental -> CommandSeek) -> CommandSeek @@ -170,26 +173,15 @@ performRemote key file backend numcopies remote = ) dummymeter _ = noop -{- To fsck a bare repository, fsck each key in the location log. -} -withBarePresentKeys :: (Key -> CommandStart) -> CommandSeek -withBarePresentKeys a params = isBareRepo >>= go - where - go False = return [] - go True = do - unless (null params) $ - error "fsck should be run without parameters in a bare repository" - map a <$> loggedKeys - -startBare :: Incremental -> Key -> CommandStart -startBare inc key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of +startAll :: Incremental -> Key -> CommandStart +startAll inc key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of Nothing -> stop - Just backend -> runFsck inc (key2file key) key $ performBare key backend + Just backend -> runFsck inc (key2file key) key $ performAll key backend -{- Note that numcopies cannot be checked in a bare repository, because - - getting the numcopies value requires a working copy with .gitattributes - - files. -} -performBare :: Key -> Backend -> Annex Bool -performBare key backend = check +{- Note that numcopies cannot be checked in --all mode, since we do not + - have associated filenames to look up in the .gitattributes file. -} +performAll :: Key -> Backend -> Annex Bool +performAll key backend = check [ verifyLocationLog key (key2file key) , checkKeySize key , checkBackend backend key Nothing diff --git a/Command/Get.hs b/Command/Get.hs index 5b6fdecfa..56dbe415f 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess <joey@kitenet.net> + - Copyright 2010, 2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -14,37 +14,53 @@ import Annex.Content import qualified Command.Move import Logs.Transfer import Annex.Wanted +import GitAnnex.Options +import Types.Key +import Types.Remote def :: [Command] -def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek +def = [withOptions getOptions $ command "get" paramPaths seek SectionCommon "make content of annexed files available"] +getOptions :: [Option] +getOptions = [allOption, Command.Move.fromOption] + seek :: [CommandSeek] -seek = [withField Command.Move.fromOption Remote.byNameWithUUID $ \from -> - withFilesInGit $ whenAnnexed $ start from] +seek = + [ withField Command.Move.fromOption Remote.byNameWithUUID $ \from -> + withAll (startAll from) $ + withFilesInGit $ whenAnnexed $ start from + ] start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart -start from file (key, _) = stopUnless (not <$> inAnnex key) $ - stopUnless (checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just file))) $ do +start from file (key, _) = start' expensivecheck from key (Just file) + where + expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just file)) + +startAll :: Maybe Remote -> Key -> CommandStart +startAll from key = start' (return True) from key Nothing + +start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart +start' expensivecheck from key afile = stopUnless (not <$> inAnnex key) $ + stopUnless expensivecheck $ case from of - Nothing -> go $ perform key file + Nothing -> go $ perform key afile Just src -> - -- get --from = copy --from stopUnless (Command.Move.fromOk src key) $ - go $ Command.Move.fromPerform src False key file + go $ Command.Move.fromPerform src False key afile where - go a = do - showStart "get" file + go a = do + showStart "get" (fromMaybe (key2file key) afile) next a -perform :: Key -> FilePath -> CommandPerform -perform key file = stopUnless (getViaTmp key $ getKeyFile key file) $ +perform :: Key -> AssociatedFile -> CommandPerform +perform key afile = stopUnless (getViaTmp key $ getKeyFile 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 -> FilePath -> FilePath -> Annex Bool -getKeyFile key file dest = dispatch =<< Remote.keyPossibilities key +getKeyFile :: Key -> AssociatedFile -> FilePath -> Annex Bool +getKeyFile key afile dest = dispatch =<< Remote.keyPossibilities key where dispatch [] = do showNote "not available" @@ -69,7 +85,7 @@ getKeyFile key file dest = dispatch =<< Remote.keyPossibilities key either (const False) id <$> Remote.hasKey r key | otherwise = return True docopy r continue = do - ok <- download (Remote.uuid r) key (Just file) noRetry $ \p -> do + ok <- download (Remote.uuid r) key afile noRetry $ \p -> do showAction $ "from " ++ Remote.name r - Remote.retrieveKeyFile r key (Just file) dest p + Remote.retrieveKeyFile r key afile dest p if ok then return ok else continue diff --git a/Command/Move.hs b/Command/Move.hs index ec0e68bb7..3f91f1bd9 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -17,9 +17,12 @@ import Annex.UUID import qualified Option import Logs.Presence import Logs.Transfer +import GitAnnex.Options +import Types.Key +import Types.Remote def :: [Command] -def = [withOptions options $ command "move" paramPaths seek +def = [withOptions moveOptions $ command "move" paramPaths seek SectionCommon "move content of files to/from another repository"] fromOption :: Option @@ -28,29 +31,40 @@ fromOption = Option.field ['f'] "from" paramRemote "source remote" toOption :: Option toOption = Option.field ['t'] "to" paramRemote "destination remote" -options :: [Option] -options = [fromOption, toOption] +moveOptions :: [Option] +moveOptions = [allOption, fromOption, toOption] seek :: [CommandSeek] -seek = [withField toOption Remote.byNameWithUUID $ \to -> - withField fromOption Remote.byNameWithUUID $ \from -> - withFilesInGit $ whenAnnexed $ start to from True] +seek = + [ withField toOption Remote.byNameWithUUID $ \to -> + withField fromOption Remote.byNameWithUUID $ \from -> + withAll (startAll to from True) $ + withFilesInGit $ whenAnnexed $ start to from True + ] start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart -start to from move file (key, _) = do +start to from move file (key, _) = start' to from move (Just file) key + +startAll :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart +startAll to from move key = start' to from move Nothing key + +start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart +start' to from move afile key = do noAuto case (from, to) of (Nothing, Nothing) -> error "specify either --from or --to" - (Nothing, Just dest) -> toStart dest move file key - (Just src, Nothing) -> fromStart src move file key + (Nothing, Just dest) -> toStart dest move afile key + (Just src, Nothing) -> fromStart src move afile key (_ , _) -> error "only one of --from or --to can be specified" where noAuto = when move $ whenM (Annex.getState Annex.auto) $ error "--auto is not supported for move" -showMoveAction :: Bool -> FilePath -> Annex () -showMoveAction True file = showStart "move" file -showMoveAction False file = showStart "copy" file +showMoveAction :: Bool -> Key -> AssociatedFile -> Annex () +showMoveAction True _ (Just file) = showStart "move" file +showMoveAction False _ (Just file) = showStart "copy" file +showMoveAction True key Nothing = showStart "move" (key2file key) +showMoveAction False key Nothing = showStart "copy" (key2file key) {- Moves (or copies) the content of an annexed file to a remote. - @@ -61,17 +75,17 @@ showMoveAction False file = showStart "copy" file - A file's content can be moved even if there are insufficient copies to - allow it to be dropped. -} -toStart :: Remote -> Bool -> FilePath -> Key -> CommandStart -toStart dest move file key = do +toStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart +toStart dest move afile key = do u <- getUUID ishere <- inAnnex key if not ishere || u == Remote.uuid dest then stop -- not here, so nothing to do else do - showMoveAction move file - next $ toPerform dest move key file -toPerform :: Remote -> Bool -> Key -> FilePath -> CommandPerform -toPerform dest move key file = moveLock move key $ do + showMoveAction move key afile + next $ toPerform dest move key afile +toPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform +toPerform dest move key afile = moveLock move key $ do -- Checking the remote is expensive, so not done in the start step. -- In fast mode, location tracking is assumed to be correct, -- and an explicit check is not done, when copying. When moving, @@ -87,8 +101,8 @@ toPerform dest move key file = moveLock move key $ do stop Right False -> do showAction $ "to " ++ Remote.name dest - ok <- upload (Remote.uuid dest) key (Just file) noRetry $ - Remote.storeKey dest key (Just file) + ok <- upload (Remote.uuid dest) key afile noRetry $ + Remote.storeKey dest key afile if ok then do Remote.logStatus dest key InfoPresent @@ -117,14 +131,14 @@ toPerform dest move key file = moveLock move key $ do - If the current repository already has the content, it is still removed - from the remote. -} -fromStart :: Remote -> Bool -> FilePath -> Key -> CommandStart -fromStart src move file key +fromStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart +fromStart src move afile key | move = go | otherwise = stopUnless (not <$> inAnnex key) go where go = stopUnless (fromOk src key) $ do - showMoveAction move file - next $ fromPerform src move key file + showMoveAction move key afile + next $ fromPerform src move key afile fromOk :: Remote -> Key -> Annex Bool fromOk src key @@ -137,16 +151,16 @@ fromOk src key remotes <- Remote.keyPossibilities key return $ u /= Remote.uuid src && elem src remotes -fromPerform :: Remote -> Bool -> Key -> FilePath -> CommandPerform -fromPerform src move key file = moveLock move key $ +fromPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform +fromPerform src move key afile = moveLock move key $ ifM (inAnnex key) ( handle move True , handle move =<< go ) where - go = download (Remote.uuid src) key (Just file) noRetry $ \p -> do + go = download (Remote.uuid src) key afile noRetry $ \p -> do showAction $ "from " ++ Remote.name src - getViaTmp key $ \t -> Remote.retrieveKeyFile src key (Just file) t p + getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p handle _ False = stop -- failed handle False True = next $ return True -- copy complete handle True True = do -- finish moving diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 13790dd50..849cbc12b 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -24,7 +24,7 @@ def = [withOptions options $ "transfers a key from or to a remote"] options :: [Option] -options = fileOption : Command.Move.options +options = [fileOption, Command.Move.fromOption, Command.Move.toOption] fileOption :: Option fileOption = Option.field [] "file" paramFile "the associated file" diff --git a/GitAnnex/Options.hs b/GitAnnex/Options.hs index 7710c2ff2..350e54513 100644 --- a/GitAnnex/Options.hs +++ b/GitAnnex/Options.hs @@ -58,3 +58,7 @@ options = Option.common ++ setgitconfig v = Annex.changeGitRepo =<< inRepo (Git.Config.store v) trustArg t = ReqArg (Remote.forceTrust t) paramRemote + +allOption :: Option +allOption = Option ['A'] ["all"] (NoArg (Annex.setFlag "all")) + "operate on all versions of all files" @@ -4,7 +4,7 @@ - the values a user passes to a command, and prepare actions operating - on them. - - - Copyright 2010-2012 Joey Hess <joey@kitenet.net> + - Copyright 2010-2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -24,6 +24,7 @@ import qualified Git.LsFiles as LsFiles import qualified Limit import qualified Option import Config +import Logs.Location seekHelper :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> [FilePath] -> Annex [FilePath] seekHelper a params = do @@ -121,6 +122,23 @@ withNothing :: CommandStart -> CommandSeek withNothing a [] = return [a] withNothing _ _ = error "This command takes no parameters." +{- If --all is specified, or in a bare repo, runs an action on all + - known keys. Otherwise, fall back to a regular CommandSeek action on + - whatever params were passed. -} +withAll :: (Key -> CommandStart) -> CommandSeek -> CommandSeek +withAll allop fallbackop params = go =<< (Annex.getFlag "all" <||> isbare) + where + go False = fallbackop params + go True = do + whenM (Annex.getState Annex.auto) $ + ifM isbare + ( error "Cannot use --auto in a bare repository." + , error "Cannot use --auto with --all." + ) + unless (null params) $ + error "Cannot mix --all with file names." + map allop <$> loggedKeys + isbare = fromRepo Git.repoIsLocalBare prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart] prepFiltered a fs = do diff --git a/debian/changelog b/debian/changelog index 7a3f647dc..e2ce91adc 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,5 +1,10 @@ git-annex (4.20130628) UNRELEASED; urgency=low + * --all: New switch that makes git-annex operate on all data stored + in the git annex, including old versions of files. Supported by + fsck, get, move, copy. + * get, move, copy: Can now be run in a bare repository, + like fsck already could. --all is enabled automatically in this case. * webapp: Fix ssh setup with nonstandard port, broken in last release. -- Joey Hess <joeyh@debian.org> Tue, 02 Jul 2013 15:40:55 -0400 diff --git a/doc/bare_repositories.mdwn b/doc/bare_repositories.mdwn index dde74c60a..86652792b 100644 --- a/doc/bare_repositories.mdwn +++ b/doc/bare_repositories.mdwn @@ -18,6 +18,11 @@ as non-bare repositories. Except for these caveats: branches that have been pushed to the bare repository. So use it with care.. * Commands that need a work tree, like `git annex add` won't work in a bare repository, of course. +* However, you can (with recent versions of git-annex) run `git annex copy`, + `git annex get`, and `git annex move` in a bare repository. These behave + as if the `--all` option were used, and just operate on every single + version of every single file that is present in the git repository + history. *** diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 7d77d8b71..012b7595c 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -602,6 +602,14 @@ subdirectories). will only do so when needed to help satisfy the setting of annex.numcopies, and preferred content configuration. +* --all + + Operate on all data that has been stored in the git annex, + including old versions of files. This is the default behavior when + running git-annex in a bare repository; in a non-bare repository the + normal behavior is to only operate on specified files in the working + tree. + * --quiet Avoid the default verbose display of what is done; only show errors diff --git a/doc/todo/add_-all_option.mdwn b/doc/todo/add_-all_option.mdwn index 351d2573e..2f25759c2 100644 --- a/doc/todo/add_-all_option.mdwn +++ b/doc/todo/add_-all_option.mdwn @@ -16,3 +16,7 @@ grubbing thru history to find where/when the key used to exist). So particular problem for `drop` and for `--auto`. --[[Joey]] + +> [[done]]. The .gitattributes problem was solved simply by not +> supporting `drop --all`. `--auto` also cannot be mixed with --all for +> similar reasons. --[[Joey]] diff --git a/doc/todo/wishlist:_support_copy_--from__61__x_--to__61__y.mdwn b/doc/todo/wishlist:_support_copy_--from__61__x_--to__61__y.mdwn index 2edf7d714..b4f966abb 100644 --- a/doc/todo/wishlist:_support_copy_--from__61__x_--to__61__y.mdwn +++ b/doc/todo/wishlist:_support_copy_--from__61__x_--to__61__y.mdwn @@ -17,3 +17,13 @@ But my new drive doesn't have a copy of any of the files I dropped from my deskt on my desktop, and then my new drive would have a copy of everything, and my desktop drive would still have plenty of space (ie the files I'd dropped to make space would still not be stored on the desktop). The git repos on these external drives are both bare (as in ``git init --bare``) because they are used only for backups. Thus I operate on them only as remotes from my main (desktop) repo. + +> I have now implemented the --all option, and it's the default when +> running `git annex get` inside a bare repo. +> +> So, the solution is to `cd` to the repository on old-external-drive, +> and `git remote add newdrive /path/to/new/drive/repo`. Then run `git +> annex copy --all --to newdrive` and it'll move everything. +> +> Calling this [[done]] unless there are other use cases where the double +> copy method is really needed? --[[Joey]] |