Merge branch 'forget'

Conflicts:
	debian/changelog
This commit is contained in:
Joey Hess 2013-09-03 14:36:00 -04:00
commit db83cc82d6
26 changed files with 685 additions and 214 deletions

52
Command/Forget.hs Normal file
View file

@ -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

View file

@ -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"

View file

@ -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
, ":"