diff options
author | Joey Hess <joey@kitenet.net> | 2013-09-03 14:36:00 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-09-03 14:36:00 -0400 |
commit | 4e7315d991fb208ba77aba514ddf5f53a65f928b (patch) | |
tree | ccc37dc5661bb66baa5192038666dccc4eade77e /Command | |
parent | f180e741eda5ac16558e481c1e85faec647f8f07 (diff) | |
parent | 2afb4de6c02a4515f8b1bf6e24a32cbde7eae5a8 (diff) |
Merge branch 'forget'
Conflicts:
debian/changelog
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Forget.hs | 52 | ||||
-rw-r--r-- | Command/Log.hs | 4 | ||||
-rw-r--r-- | Command/Sync.hs | 42 |
3 files changed, 83 insertions, 15 deletions
diff --git a/Command/Forget.hs b/Command/Forget.hs new file mode 100644 index 000000000..d216ae3ca --- /dev/null +++ b/Command/Forget.hs @@ -0,0 +1,52 @@ +{- git-annex command + - + - Copyright 2013 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Forget where + +import Common.Annex +import Command +import qualified Annex.Branch as Branch +import Logs.Transitions +import qualified Annex +import qualified Option + +import Data.Time.Clock.POSIX + +def :: [Command] +def = [withOptions forgetOptions $ command "forget" paramNothing seek + SectionMaintenance "prune git-annex branch history"] + +forgetOptions :: [Option] +forgetOptions = [dropDeadOption] + +dropDeadOption :: Option +dropDeadOption = Option.flag [] "drop-dead" "drop references to dead repositories" + +seek :: [CommandSeek] +seek = [withFlag dropDeadOption $ \dropdead -> + withNothing $ start dropdead] + +start :: Bool -> CommandStart +start dropdead = do + showStart "forget" "git-annex" + now <- liftIO getPOSIXTime + let basets = addTransition now ForgetGitHistory noTransitions + let ts = if dropdead + then addTransition now ForgetDeadRemotes basets + else basets + next $ perform ts =<< Annex.getState Annex.force + +perform :: Transitions -> Bool -> CommandPerform +perform ts True = do + recordTransitions Branch.change ts + -- get branch committed before contining with the transition + Branch.update + void $ Branch.performTransitions ts True + next $ return True +perform _ False = do + showLongNote "To forget git-annex branch history, you must specify --force. This deletes metadata!" + stop diff --git a/Command/Log.hs b/Command/Log.hs index 2d4819f7f..f3a5becb8 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -17,7 +17,7 @@ import Data.Char import Common.Annex import Command -import qualified Logs.Location +import Logs import qualified Logs.Presence import Annex.CatFile import qualified Annex.Branch @@ -135,7 +135,7 @@ getLog :: Key -> [CommandParam] -> Annex [String] getLog key os = do top <- fromRepo Git.repoPath p <- liftIO $ relPathCwdToFile top - let logfile = p </> Logs.Location.logFile key + let logfile = p </> locationLogFile key inRepo $ pipeNullSplitZombie $ [ Params "log -z --pretty=format:%ct --raw --abbrev=40" , Param "--remove-empty" diff --git a/Command/Sync.hs b/Command/Sync.hs index 551c2fa69..567e3146b 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -167,29 +167,45 @@ pushRemote remote branch = go =<< needpush showOutput inRepo $ pushBranch remote branch -{- If the remote is a bare git repository, it's best to push the branch - - directly to it. On the other hand, if it's not bare, pushing to the - - checked out branch will fail, and this is why we use the syncBranch. +{- Pushes a regular branch like master to a remote. Also pushes the git-annex + - branch. + - + - If the remote is a bare git repository, it's best to push the regular + - branch directly to it, so that cloning/pulling will get it. + - On the other hand, if it's not bare, pushing to the checked out branch + - will fail, and this is why we push to its syncBranch. - - Git offers no way to tell if a remote is bare or not, so both methods - are tried. - - The direct push is likely to spew an ugly error message, so stderr is - - elided. Since progress is output to stderr too, the sync push is done - - first, and actually sends the data. Then the direct push is tried, - - with stderr discarded, to update the branch ref on the remote. + - elided. Since git progress display goes to stderr too, the sync push + - is done first, and actually sends the data. Then the direct push is + - tried, with stderr discarded, to update the branch ref on the remote. + - + - The sync push forces the update of the remote synced/git-annex branch. + - This is necessary if a transition has rewritten the git-annex branch. + - Normally any changes to the git-annex branch get pulled and merged before + - this push, so this forcing is unlikely to overwrite new data pushed + - in from another repository that is also syncing. + - + - But overwriting of data on synced/git-annex can happen, in a race. + - The only difference caused by using a forced push in that case is that + - the last repository to push wins the race, rather than the first to push. -} pushBranch :: Remote -> Git.Ref -> Git.Repo -> IO Bool -pushBranch remote branch g = tryIO directpush `after` syncpush +pushBranch remote branch g = tryIO (directpush g) `after` syncpush g where - syncpush = Git.Command.runBool (pushparams (refspec branch)) g - directpush = Git.Command.runQuiet (pushparams (show $ Git.Ref.base branch)) g - pushparams b = + syncpush = Git.Command.runBool $ pushparams + [ Git.Branch.forcePush $ refspec Annex.Branch.name + , refspec branch + ] + directpush = Git.Command.runQuiet $ pushparams + [show $ Git.Ref.base branch] + pushparams branches = [ Param "push" , Param $ Remote.name remote - , Param $ refspec Annex.Branch.name - , Param b - ] + ] ++ map Param branches refspec b = concat [ show $ Git.Ref.base b , ":" |