aboutsummaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-09-03 14:36:00 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-09-03 14:36:00 -0400
commit4e7315d991fb208ba77aba514ddf5f53a65f928b (patch)
treeccc37dc5661bb66baa5192038666dccc4eade77e /Command
parentf180e741eda5ac16558e481c1e85faec647f8f07 (diff)
parent2afb4de6c02a4515f8b1bf6e24a32cbde7eae5a8 (diff)
Merge branch 'forget'
Conflicts: debian/changelog
Diffstat (limited to 'Command')
-rw-r--r--Command/Forget.hs52
-rw-r--r--Command/Log.hs4
-rw-r--r--Command/Sync.hs42
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
, ":"