summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-03-31 19:05:47 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-03-31 19:05:47 -0400
commit7cd0ba73996b2ed092f8ee7cb62d0edf9f8f3f1b (patch)
tree6a23e810b4b3d8a3a4198a25190e0a8b3ce58c62
parent4dfa6059e42995eb050f58656fc32f9ee5d3ef16 (diff)
parentdc6d60cb3cbeed45e0651818f762445812f84e7a (diff)
Merge branch 'adjustedbranch'
-rw-r--r--Annex.hs2
-rw-r--r--Annex/AdjustedBranch.hs419
-rw-r--r--Annex/Direct.hs6
-rw-r--r--Annex/Ingest.hs24
-rw-r--r--Annex/Init.hs12
-rw-r--r--Annex/Version.hs3
-rw-r--r--Assistant/Sync.hs25
-rw-r--r--Assistant/Threads/Committer.hs2
-rw-r--r--Assistant/Threads/Merger.hs16
-rw-r--r--Assistant/Threads/XMPPClient.hs4
-rw-r--r--Assistant/XMPP/Git.hs9
-rw-r--r--CmdLine/GitAnnex.hs2
-rw-r--r--Command/Adjust.hs41
-rw-r--r--Command/Merge.hs5
-rw-r--r--Command/Sync.hs129
-rw-r--r--Command/Upgrade.hs4
-rw-r--r--Git/Branch.hs37
-rw-r--r--Git/CatFile.hs8
-rw-r--r--Git/DiffTree.hs43
-rw-r--r--Git/FilePath.hs2
-rw-r--r--Git/LockFile.hs78
-rw-r--r--Git/Ref.hs7
-rw-r--r--Git/Tree.hs182
-rw-r--r--Git/Types.hs1
-rw-r--r--debian/changelog4
-rw-r--r--doc/design/adjusted_branches.mdwn208
-rw-r--r--doc/git-annex-adjust.mdwn50
-rw-r--r--doc/git-annex-direct.mdwn4
-rw-r--r--doc/git-annex.mdwn7
-rw-r--r--doc/tips/unlocked_files.mdwn8
-rw-r--r--doc/todo/smudge.mdwn6
31 files changed, 1085 insertions, 263 deletions
diff --git a/Annex.hs b/Annex.hs
index fe6802776..5ab2b748d 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -136,6 +136,7 @@ data AnnexState = AnnexState
, workers :: [Either AnnexState (Async AnnexState)]
, concurrentjobs :: Maybe Int
, keysdbhandle :: Maybe Keys.DbHandle
+ , cachedcurrentbranch :: Maybe Git.Branch
}
newState :: GitConfig -> Git.Repo -> AnnexState
@@ -182,6 +183,7 @@ newState c r = AnnexState
, workers = []
, concurrentjobs = Nothing
, keysdbhandle = Nothing
+ , cachedcurrentbranch = Nothing
}
{- Makes an Annex state object for the specified git repo.
diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs
new file mode 100644
index 000000000..c757eae1d
--- /dev/null
+++ b/Annex/AdjustedBranch.hs
@@ -0,0 +1,419 @@
+{- adjusted branch
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.AdjustedBranch (
+ Adjustment(..),
+ OrigBranch,
+ AdjBranch,
+ originalToAdjusted,
+ adjustedToOriginal,
+ fromAdjustedBranch,
+ getAdjustment,
+ enterAdjustedBranch,
+ adjustToCrippledFileSystem,
+ updateAdjustedBranch,
+ propigateAdjustedCommits,
+) where
+
+import Annex.Common
+import qualified Annex
+import Git
+import Git.Types
+import qualified Git.Branch
+import qualified Git.Ref
+import qualified Git.Command
+import qualified Git.Tree
+import qualified Git.DiffTree
+import Git.Tree (TreeItem(..))
+import Git.Sha
+import Git.Env
+import Git.Index
+import Git.FilePath
+import qualified Git.LockFile
+import Annex.CatFile
+import Annex.Link
+import Annex.AutoMerge
+import Annex.Content
+import qualified Database.Keys
+
+import qualified Data.Map as M
+
+data Adjustment
+ = UnlockAdjustment
+ | LockAdjustment
+ | HideMissingAdjustment
+ | ShowMissingAdjustment
+ deriving (Show, Eq)
+
+reverseAdjustment :: Adjustment -> Adjustment
+reverseAdjustment UnlockAdjustment = LockAdjustment
+reverseAdjustment LockAdjustment = UnlockAdjustment
+reverseAdjustment HideMissingAdjustment = ShowMissingAdjustment
+reverseAdjustment ShowMissingAdjustment = HideMissingAdjustment
+
+{- How to perform various adjustments to a TreeItem. -}
+adjustTreeItem :: Adjustment -> TreeItem -> Annex (Maybe TreeItem)
+adjustTreeItem UnlockAdjustment ti@(TreeItem f m s)
+ | toBlobType m == Just SymlinkBlob = do
+ mk <- catKey s
+ case mk of
+ Just k -> do
+ Database.Keys.addAssociatedFile k f
+ Just . TreeItem f (fromBlobType FileBlob)
+ <$> hashPointerFile k
+ Nothing -> return (Just ti)
+ | otherwise = return (Just ti)
+adjustTreeItem LockAdjustment ti@(TreeItem f m s)
+ | toBlobType m /= Just SymlinkBlob = do
+ mk <- catKey s
+ case mk of
+ Just k -> do
+ absf <- inRepo $ \r -> absPath $
+ fromTopFilePath f r
+ linktarget <- calcRepo $ gitAnnexLink absf k
+ Just . TreeItem f (fromBlobType SymlinkBlob)
+ <$> hashSymlink linktarget
+ Nothing -> return (Just ti)
+ | otherwise = return (Just ti)
+adjustTreeItem HideMissingAdjustment ti@(TreeItem _ _ s) = do
+ mk <- catKey s
+ case mk of
+ Just k -> ifM (inAnnex k)
+ ( return (Just ti)
+ , return Nothing
+ )
+ Nothing -> return (Just ti)
+adjustTreeItem ShowMissingAdjustment ti = return (Just ti)
+
+type OrigBranch = Branch
+type AdjBranch = Branch
+
+adjustedBranchPrefix :: String
+adjustedBranchPrefix = "refs/heads/adjusted/"
+
+serialize :: Adjustment -> String
+serialize UnlockAdjustment = "unlocked"
+serialize LockAdjustment = "locked"
+serialize HideMissingAdjustment = "present"
+serialize ShowMissingAdjustment = "showmissing"
+
+deserialize :: String -> Maybe Adjustment
+deserialize "unlocked" = Just UnlockAdjustment
+deserialize "locked" = Just UnlockAdjustment
+deserialize "present" = Just HideMissingAdjustment
+deserialize _ = Nothing
+
+originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch
+originalToAdjusted orig adj = Ref $
+ adjustedBranchPrefix ++ base ++ '(' : serialize adj ++ ")"
+ where
+ base = fromRef (Git.Ref.basename orig)
+
+adjustedToOriginal :: AdjBranch -> Maybe (Adjustment, OrigBranch)
+adjustedToOriginal b
+ | adjustedBranchPrefix `isPrefixOf` bs = do
+ let (base, as) = separate (== '(') (drop prefixlen bs)
+ adj <- deserialize (takeWhile (/= ')') as)
+ Just (adj, Git.Ref.under "refs/heads" (Ref base))
+ | otherwise = Nothing
+ where
+ bs = fromRef b
+ prefixlen = length adjustedBranchPrefix
+
+getAdjustment :: Branch -> Maybe Adjustment
+getAdjustment = fmap fst . adjustedToOriginal
+
+fromAdjustedBranch :: Branch -> OrigBranch
+fromAdjustedBranch b = maybe b snd (adjustedToOriginal b)
+
+originalBranch :: Annex (Maybe OrigBranch)
+originalBranch = fmap fromAdjustedBranch <$> inRepo Git.Branch.current
+
+{- Enter an adjusted version of current branch (or, if already in an
+ - adjusted version of a branch, changes the adjustment of the original
+ - branch).
+ -
+ - Can fail, if no branch is checked out, or perhaps if staged changes
+ - conflict with the adjusted branch.
+ -}
+enterAdjustedBranch :: Adjustment -> Annex ()
+enterAdjustedBranch adj = go =<< originalBranch
+ where
+ go (Just origbranch) = do
+ adjbranch <- preventCommits $ const $
+ adjustBranch adj origbranch
+ inRepo $ Git.Command.run
+ [ Param "checkout"
+ , Param $ fromRef $ Git.Ref.base $ adjbranch
+ ]
+ go Nothing = error "not on any branch!"
+
+adjustToCrippledFileSystem :: Annex ()
+adjustToCrippledFileSystem = do
+ warning "Entering an adjusted branch where files are unlocked as this filesystem does not support locked files."
+ whenM (isNothing <$> originalBranch) $
+ void $ inRepo $ Git.Branch.commitCommand Git.Branch.AutomaticCommit
+ [ Param "--quiet"
+ , Param "--allow-empty"
+ , Param "-m"
+ , Param "commit before entering adjusted unlocked branch"
+ ]
+ enterAdjustedBranch UnlockAdjustment
+
+adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch
+adjustBranch adj origbranch = do
+ sha <- adjust adj origbranch
+ inRepo $ Git.Branch.update "entering adjusted branch" adjbranch sha
+ return adjbranch
+ where
+ adjbranch = originalToAdjusted origbranch adj
+
+adjust :: Adjustment -> Ref -> Annex Sha
+adjust adj orig = do
+ treesha <- adjustTree adj orig
+ commitAdjustedTree treesha orig
+
+adjustTree :: Adjustment -> Ref -> Annex Sha
+adjustTree adj orig = do
+ let toadj = adjustTreeItem adj
+ treesha <- Git.Tree.adjustTree toadj [] [] orig =<< Annex.gitRepo
+ return treesha
+
+type CommitsPrevented = Git.LockFile.LockHandle
+
+{- Locks git's index file, preventing git from making a commit, merge,
+ - or otherwise changing the HEAD ref while the action is run.
+ -
+ - Throws an IO exception if the index file is already locked.
+ -}
+preventCommits :: (CommitsPrevented -> Annex a) -> Annex a
+preventCommits = bracket setup cleanup
+ where
+ setup = do
+ lck <- fromRepo indexFileLock
+ liftIO $ Git.LockFile.openLock lck
+ cleanup = liftIO . Git.LockFile.closeLock
+
+{- Commits a given adjusted tree, with the provided parent ref.
+ -
+ - This should always yield the same value, even if performed in different
+ - clones of a repo, at different times. The commit message and other
+ - metadata is based on the parent.
+ -}
+commitAdjustedTree :: Sha -> Ref -> Annex Sha
+commitAdjustedTree treesha parent = commitAdjustedTree' treesha parent [parent]
+
+commitAdjustedTree' :: Sha -> Ref -> [Ref] -> Annex Sha
+commitAdjustedTree' treesha basis parents = go =<< catCommit basis
+ where
+ go Nothing = inRepo mkcommit
+ go (Just basiscommit) = inRepo $ commitWithMetaData
+ (commitAuthorMetaData basiscommit)
+ (commitCommitterMetaData basiscommit)
+ mkcommit
+ mkcommit = Git.Branch.commitTree Git.Branch.AutomaticCommit
+ adjustedBranchCommitMessage parents treesha
+
+adjustedBranchCommitMessage :: String
+adjustedBranchCommitMessage = "git-annex adjusted branch"
+
+{- Update the currently checked out adjusted branch, merging the provided
+ - branch into it. -}
+updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool
+updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
+ join $ preventCommits $ \commitsprevented -> go commitsprevented =<< (,)
+ <$> inRepo (Git.Ref.sha tomerge)
+ <*> inRepo Git.Branch.current
+ where
+ go commitsprevented (Just mergesha, Just currbranch) =
+ ifM (inRepo $ Git.Branch.changed currbranch mergesha)
+ ( do
+ void $ propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented
+ adjustedtomerge <- adjust adj mergesha
+ ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge)
+ ( return $
+ -- Run after commit lock is dropped.
+ ifM (autoMergeFrom adjustedtomerge (Just currbranch) commitmode)
+ ( preventCommits $ \_ ->
+ recommit currbranch mergesha =<< catCommit currbranch
+ , return False
+ )
+ , nochangestomerge
+ )
+ , nochangestomerge
+ )
+ go _ _ = return $ return False
+ nochangestomerge = return $ return True
+
+ {- A merge commit has been made on the adjusted branch.
+ - Now, re-do it, removing the old version of the adjusted branch
+ - from its history.
+ -
+ - There are two possible scenarios; either some commits
+ - were made on top of the adjusted branch's adjusting commit,
+ - or not. Those commits have already been propigated to the
+ - orig branch, so we can just check if there are commits in the
+ - orig branch that are not present in tomerge.
+ -}
+ recommit currbranch mergedsha (Just mergecommit) =
+ ifM (inRepo $ Git.Branch.changed tomerge origbranch)
+ ( remerge currbranch mergedsha mergecommit
+ =<< inRepo (Git.Ref.sha origbranch)
+ , fastforward currbranch mergedsha mergecommit
+ )
+ recommit _ _ Nothing = return False
+
+ {- Fast-forward scenario. The mergecommit is changed to a non-merge
+ - commit, with its parent being the mergedsha.
+ - The orig branch can simply be pointed at the mergedsha.
+ -}
+ fastforward currbranch mergedsha mergecommit = do
+ commitsha <- commitAdjustedTree (commitTree mergecommit) mergedsha
+ inRepo $ Git.Branch.update "fast-forward update of adjusted branch" currbranch commitsha
+ inRepo $ Git.Branch.update "updating original branch" origbranch mergedsha
+ return True
+
+ {- True merge scenario. -}
+ remerge currbranch mergedsha mergecommit (Just origsha) = do
+ -- Update origbranch by reverse adjusting the mergecommit,
+ -- yielding a merge between orig and tomerge.
+ treesha <- reverseAdjustedTree origsha adj
+ -- get 1-parent commit because
+ -- reverseAdjustedTree does not support merges
+ =<< commitAdjustedTree (commitTree mergecommit) origsha
+ revadjcommit <- inRepo $
+ Git.Branch.commitTree Git.Branch.AutomaticCommit
+ ("Merge branch " ++ fromRef tomerge) [origsha, mergedsha] treesha
+ inRepo $ Git.Branch.update "updating original branch" origbranch revadjcommit
+ -- Update currbranch, reusing mergedsha, but making its
+ -- parent be the updated origbranch.
+ adjcommit <- commitAdjustedTree' (commitTree mergecommit) revadjcommit [revadjcommit]
+ inRepo $ Git.Branch.update rebaseOnTopMsg currbranch adjcommit
+ return True
+ remerge _ _ _ Nothing = return False
+
+{- Check for any commits present on the adjusted branch that have not yet
+ - been propigated to the orig branch, and propigate them.
+ -
+ - After propigating the commits back to the orig banch,
+ - rebase the adjusted branch on top of the updated orig branch.
+ -}
+propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex ()
+propigateAdjustedCommits origbranch (adj, currbranch) =
+ preventCommits $ \commitsprevented -> do
+ join $ propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented
+
+{- Returns action which will rebase the adjusted branch on top of the
+ - updated orig branch. -}
+propigateAdjustedCommits'
+ :: OrigBranch
+ -> (Adjustment, AdjBranch)
+ -> CommitsPrevented
+ -> Annex (Annex ())
+propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do
+ ov <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads" origbranch)
+ case ov of
+ Just origsha -> do
+ cv <- catCommit currbranch
+ case cv of
+ Just currcommit -> do
+ v <- newcommits >>= go origsha False
+ case v of
+ Left e -> do
+ warning e
+ return $ return ()
+ Right newparent -> return $
+ rebase currcommit newparent
+ Nothing -> return $ return ()
+ Nothing -> return $ return ()
+ where
+ newcommits = inRepo $ Git.Branch.changedCommits origbranch currbranch
+ -- Get commits oldest first, so they can be processed
+ -- in order made.
+ [Param "--reverse"]
+ go parent _ [] = do
+ inRepo $ Git.Branch.update "updating adjusted branch" origbranch parent
+ return (Right parent)
+ go parent pastadjcommit (sha:l) = do
+ mc <- catCommit sha
+ case mc of
+ Just c
+ | commitMessage c == adjustedBranchCommitMessage ->
+ go parent True l
+ | pastadjcommit -> do
+ v <- reverseAdjustedCommit parent adj (sha, c) origbranch
+ case v of
+ Left e -> return (Left e)
+ Right commit -> go commit pastadjcommit l
+ _ -> go parent pastadjcommit l
+ rebase currcommit newparent = do
+ -- Reuse the current adjusted tree,
+ -- and reparent it on top of the new
+ -- version of the origbranch.
+ commitAdjustedTree (commitTree currcommit) newparent
+ >>= inRepo . Git.Branch.update rebaseOnTopMsg currbranch
+
+rebaseOnTopMsg :: String
+rebaseOnTopMsg = "rebasing adjusted branch on top of updated original branch"
+
+{- Reverses an adjusted commit, and commit with provided commitparent,
+ - yielding a commit sha.
+ -
+ - Adjusts the tree of the commitparent, changing only the files that the
+ - commit changed, and reverse adjusting those changes.
+ -
+ - The commit message, and the author and committer metadata are
+ - copied over from the basiscommit. However, any gpg signature
+ - will be lost, and any other headers are not copied either. -}
+reverseAdjustedCommit :: Sha -> Adjustment -> (Sha, Commit) -> OrigBranch -> Annex (Either String Sha)
+reverseAdjustedCommit commitparent adj (csha, basiscommit) origbranch
+ | length (commitParent basiscommit) > 1 = return $
+ Left $ "unable to propigate merge commit " ++ show csha ++ " back to " ++ show origbranch
+ | otherwise = do
+ treesha <- reverseAdjustedTree commitparent adj csha
+ revadjcommit <- inRepo $ commitWithMetaData
+ (commitAuthorMetaData basiscommit)
+ (commitCommitterMetaData basiscommit) $
+ Git.Branch.commitTree Git.Branch.AutomaticCommit
+ (commitMessage basiscommit) [commitparent] treesha
+ return (Right revadjcommit)
+
+{- Adjusts the tree of the basis, changing only the files that the
+ - commit changed, and reverse adjusting those changes.
+ -
+ - commitDiff does not support merge commits, so the csha must not be a
+ - merge commit. -}
+reverseAdjustedTree :: Sha -> Adjustment -> Sha -> Annex Sha
+reverseAdjustedTree basis adj csha = do
+ (diff, cleanup) <- inRepo (Git.DiffTree.commitDiff csha)
+ let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff
+ let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti == nullSha) others
+ adds' <- catMaybes <$>
+ mapM (adjustTreeItem reverseadj) (map diffTreeToTreeItem adds)
+ treesha <- Git.Tree.adjustTree
+ (propchanges changes)
+ adds'
+ (map Git.DiffTree.file removes)
+ basis
+ =<< Annex.gitRepo
+ void $ liftIO cleanup
+ return treesha
+ where
+ reverseadj = reverseAdjustment adj
+ propchanges changes ti@(TreeItem f _ _) =
+ case M.lookup f m of
+ Nothing -> return (Just ti) -- not changed
+ Just change -> adjustTreeItem reverseadj change
+ where
+ m = M.fromList $ map (\i@(TreeItem f' _ _) -> (f', i)) $
+ map diffTreeToTreeItem changes
+
+diffTreeToTreeItem :: Git.DiffTree.DiffTreeItem -> TreeItem
+diffTreeToTreeItem dti = TreeItem
+ (Git.DiffTree.file dti)
+ (Git.DiffTree.dstmode dti)
+ (Git.DiffTree.dstsha dti)
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index e85d8f447..d16692226 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -225,7 +225,7 @@ mergeDirectCommit allowff old branch commitmode = do
let merge_msg = d </> "MERGE_MSG"
let merge_mode = d </> "MERGE_MODE"
ifM (pure allowff <&&> canff)
- ( inRepo $ Git.Branch.update Git.Ref.headRef branch -- fast forward
+ ( inRepo $ Git.Branch.update "merge" Git.Ref.headRef branch -- fast forward
, do
msg <- liftIO $
catchDefaultIO ("merge " ++ fromRef branch) $
@@ -462,7 +462,7 @@ switchHEAD = maybe noop switch =<< inRepo Git.Branch.currentUnsafe
where
switch orighead = do
let newhead = directBranch orighead
- maybe noop (inRepo . Git.Branch.update newhead)
+ maybe noop (inRepo . Git.Branch.update "entering direct mode" newhead)
=<< inRepo (Git.Ref.sha orighead)
inRepo $ Git.Branch.checkout newhead
@@ -475,7 +475,7 @@ switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe
case v of
Just headsha
| orighead /= currhead -> do
- inRepo $ Git.Branch.update orighead headsha
+ inRepo $ Git.Branch.update "leaving direct mode" orighead headsha
inRepo $ Git.Branch.checkout orighead
inRepo $ Git.Branch.delete currhead
_ -> inRepo $ Git.Branch.checkout orighead
diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs
index b80f0e1e0..1bf1db146 100644
--- a/Annex/Ingest.hs
+++ b/Annex/Ingest.hs
@@ -35,6 +35,8 @@ import Logs.Location
import qualified Annex
import qualified Annex.Queue
import qualified Database.Keys
+import qualified Git
+import qualified Git.Branch
import Config
import Utility.InodeCache
import Annex.ReplaceFile
@@ -43,6 +45,7 @@ import Utility.CopyFile
import Utility.Touch
import Git.FilePath
import Annex.InodeSentinal
+import Annex.AdjustedBranch
import Control.Exception (IOException)
@@ -309,15 +312,32 @@ forceParams = ifM (Annex.getState Annex.force)
)
{- Whether a file should be added unlocked or not. Default is to not,
- - unless symlinks are not supported. annex.addunlocked can override that. -}
+ - unless symlinks are not supported. annex.addunlocked can override that.
+ - Also, when in an adjusted unlocked branch, always add files unlocked.
+ -}
addUnlocked :: Annex Bool
addUnlocked = isDirect <||>
(versionSupportsUnlockedPointers <&&>
((not . coreSymlinks <$> Annex.getGitConfig) <||>
- (annexAddUnlocked <$> Annex.getGitConfig)
+ (annexAddUnlocked <$> Annex.getGitConfig) <||>
+ (maybe False (\b -> getAdjustment b == Just UnlockAdjustment) <$> cachedCurrentBranch)
)
)
+cachedCurrentBranch :: Annex (Maybe Git.Branch)
+cachedCurrentBranch = maybe cache (return . Just)
+ =<< Annex.getState Annex.cachedcurrentbranch
+ where
+ cache :: Annex (Maybe Git.Branch)
+ cache = do
+ mb <- inRepo Git.Branch.currentUnsafe
+ case mb of
+ Nothing -> return Nothing
+ Just b -> do
+ Annex.changeState $ \s ->
+ s { Annex.cachedcurrentbranch = Just b }
+ return (Just b)
+
{- Adds a file to the work tree for the key, and stages it in the index.
- The content of the key may be provided in a temp file, which will be
- moved into place. -}
diff --git a/Annex/Init.hs b/Annex/Init.hs
index 7501d9b8f..99f8ece2c 100644
--- a/Annex/Init.hs
+++ b/Annex/Init.hs
@@ -33,6 +33,7 @@ import Annex.UUID
import Annex.Link
import Config
import Annex.Direct
+import Annex.AdjustedBranch
import Annex.Environment
import Annex.Hook
import Annex.InodeSentinal
@@ -92,10 +93,13 @@ initialize' mversion = do
whenM versionSupportsUnlockedPointers $ do
configureSmudgeFilter
Database.Keys.scanAssociatedFiles
- ifM (crippledFileSystem <&&> (not <$> isBare) <&&> (not <$> versionSupportsUnlockedPointers))
- ( do
- enableDirectMode
- setDirect True
+ ifM (crippledFileSystem <&&> (not <$> isBare))
+ ( ifM versionSupportsUnlockedPointers
+ ( adjustToCrippledFileSystem
+ , do
+ enableDirectMode
+ setDirect True
+ )
-- Handle case where this repo was cloned from a
-- direct mode repo
, unlessM isBare
diff --git a/Annex/Version.hs b/Annex/Version.hs
index f294f8cd3..b5f038c0d 100644
--- a/Annex/Version.hs
+++ b/Annex/Version.hs
@@ -52,6 +52,9 @@ versionSupportsUnlockedPointers = go <$> getVersion
go (Just "6") = True
go _ = False
+versionSupportsAdjustedBranch :: Annex Bool
+versionSupportsAdjustedBranch = versionSupportsUnlockedPointers
+
setVersion :: Version -> Annex ()
setVersion = setConfig versionField
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index 7a9ea6a86..ebdead00d 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -19,7 +19,6 @@ import Assistant.RemoteControl
import qualified Command.Sync
import Utility.Parallel
import qualified Git
-import qualified Git.Branch
import qualified Git.Command
import qualified Git.Ref
import qualified Remote
@@ -79,16 +78,16 @@ reconnectRemotes notifypushes rs = void $ do
| Git.repoIsLocal r = True
| Git.repoIsLocalUnknown r = True
| otherwise = False
- sync (Just branch) = do
- (failedpull, diverged) <- manualPull (Just branch) gitremotes
+ sync currentbranch@(Just _, _) = do
+ (failedpull, diverged) <- manualPull currentbranch gitremotes
now <- liftIO getCurrentTime
failedpush <- pushToRemotes' now notifypushes gitremotes
return (nub $ failedpull ++ failedpush, diverged)
{- No local branch exists yet, but we can try pulling. -}
- sync Nothing = manualPull Nothing gitremotes
+ sync (Nothing, _) = manualPull (Nothing, Nothing) gitremotes
go = do
(failed, diverged) <- sync
- =<< liftAnnex (inRepo Git.Branch.current)
+ =<< liftAnnex (join Command.Sync.getCurrBranch)
addScanRemotes diverged $
filter (not . remoteAnnexIgnore . Remote.gitconfig)
nonxmppremotes
@@ -133,7 +132,7 @@ pushToRemotes' now notifypushes remotes = do
Annex.Branch.commit "update"
(,,)
<$> gitRepo
- <*> inRepo Git.Branch.current
+ <*> join Command.Sync.getCurrBranch
<*> getUUID
let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
ret <- go True branch g u normalremotes
@@ -145,9 +144,9 @@ pushToRemotes' now notifypushes remotes = do
Pushing (getXMPPClientID r) (CanPush u shas)
return ret
where
- go _ Nothing _ _ _ = return [] -- no branch, so nothing to do
+ go _ (Nothing, _) _ _ _ = return [] -- no branch, so nothing to do
go _ _ _ _ [] = return [] -- no remotes, so nothing to do
- go shouldretry (Just branch) g u rs = do
+ go shouldretry currbranch@(Just branch, _) g u rs = do
debug ["pushing to", show rs]
(succeeded, failed) <- parallelPush g rs (push branch)
updatemap succeeded []
@@ -158,7 +157,7 @@ pushToRemotes' now notifypushes remotes = do
map Remote.uuid succeeded
return failed
else if shouldretry
- then retry branch g u failed
+ then retry currbranch g u failed
else fallback branch g u failed
updatemap succeeded failed = changeFailedPushMap $ \m ->
@@ -166,10 +165,10 @@ pushToRemotes' now notifypushes remotes = do
M.difference m (makemap succeeded)
makemap l = M.fromList $ zip l (repeat now)
- retry branch g u rs = do
+ retry currbranch g u rs = do
debug ["trying manual pull to resolve failed pushes"]
- void $ manualPull (Just branch) rs
- go False (Just branch) g u rs
+ void $ manualPull currbranch rs
+ go False currbranch g u rs
fallback branch g u rs = do
debug ["fallback pushing to", show rs]
@@ -227,7 +226,7 @@ syncAction rs a
- XMPP remotes. However, those pushes will run asynchronously, so their
- results are not included in the return data.
-}
-manualPull :: Maybe Git.Ref -> [Remote] -> Assistant ([Remote], Bool)
+manualPull :: Command.Sync.CurrBranch -> [Remote] -> Assistant ([Remote], Bool)
manualPull currentbranch remotes = do
g <- liftAnnex gitRepo
let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index be4a0a255..070699cb2 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -227,7 +227,7 @@ commitStaged msg = do
Right _ -> do
ok <- Command.Sync.commitStaged Git.Branch.AutomaticCommit msg
when ok $
- Command.Sync.updateSyncBranch =<< inRepo Git.Branch.current
+ Command.Sync.updateSyncBranch =<< join Command.Sync.getCurrBranch
return ok
{- OSX needs a short delay after a file is added before locking it down,
diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs
index f1a64925d..35d02322d 100644
--- a/Assistant/Threads/Merger.hs
+++ b/Assistant/Threads/Merger.hs
@@ -17,7 +17,7 @@ import Utility.DirWatcher.Types
import qualified Annex.Branch
import qualified Git
import qualified Git.Branch
-import Annex.AutoMerge
+import qualified Command.Sync
import Annex.TaggedPush
import Remote (remoteFromUUID)
@@ -72,19 +72,21 @@ onChange file
unlessM handleDesynced $
queueDeferredDownloads "retrying deferred download" Later
| "/synced/" `isInfixOf` file =
- mergecurrent =<< liftAnnex (inRepo Git.Branch.current)
+ mergecurrent =<< liftAnnex (join Command.Sync.getCurrBranch)
| otherwise = noop
where
changedbranch = fileToBranch file
- mergecurrent (Just current)
- | equivBranches changedbranch current =
- whenM (liftAnnex $ inRepo $ Git.Branch.changed current changedbranch) $ do
+ mergecurrent currbranch@(Just b, _)
+ | equivBranches changedbranch b =
+ whenM (liftAnnex $ inRepo $ Git.Branch.changed b changedbranch) $ do
debug
[ "merging", Git.fromRef changedbranch
- , "into", Git.fromRef current
+ , "into", Git.fromRef b
]
- void $ liftAnnex $ autoMergeFrom changedbranch (Just current) Git.Branch.AutomaticCommit
+ void $ liftAnnex $ Command.Sync.merge
+ currbranch Git.Branch.AutomaticCommit
+ changedbranch
mergecurrent _ = noop
handleDesynced = case fromTaggedBranch changedbranch of
diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs
index da29c4ae4..2b68ecbe1 100644
--- a/Assistant/Threads/XMPPClient.hs
+++ b/Assistant/Threads/XMPPClient.hs
@@ -25,6 +25,7 @@ import Assistant.Pairing
import Assistant.XMPP.Git
import Annex.UUID
import Logs.UUID
+import qualified Command.Sync
import Network.Protocol.XMPP
import Control.Concurrent
@@ -33,7 +34,6 @@ import Control.Concurrent.STM (atomically)
import qualified Data.Text as T
import qualified Data.Set as S
import qualified Data.Map as M
-import qualified Git.Branch
import Data.Time.Clock
import Control.Concurrent.Async
@@ -306,7 +306,7 @@ pull [] = noop
pull us = do
rs <- filter matching . syncGitRemotes <$> getDaemonStatus
debug $ "push notification for" : map (fromUUID . Remote.uuid ) rs
- pullone rs =<< liftAnnex (inRepo Git.Branch.current)
+ pullone rs =<< liftAnnex (join Command.Sync.getCurrBranch)
where
matching r = Remote.uuid r `S.member` s
s = S.fromList us
diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs
index 2841a1cf8..612e0f2c5 100644
--- a/Assistant/XMPP/Git.hs
+++ b/Assistant/XMPP/Git.hs
@@ -27,7 +27,6 @@ import Annex.TaggedPush
import Annex.CatFile
import Config
import Git
-import qualified Git.Branch
import qualified Types.Remote as Remote
import qualified Remote as Remote
import Remote.List
@@ -292,16 +291,15 @@ xmppRemotes cid theiruuid = case baseJID <$> parseJID cid of
{- Returns the ClientID that it pushed to. -}
runPush :: (Remote -> Assistant ()) -> NetMessage -> Assistant (Maybe ClientID)
runPush checkcloudrepos (Pushing cid (PushRequest theiruuid)) =
- go =<< liftAnnex (inRepo Git.Branch.current)
+ go =<< liftAnnex (join Command.Sync.getCurrBranch)
where
- go Nothing = return Nothing
- go (Just branch) = do
+ go (Just branch, _) = do
rs <- xmppRemotes cid theiruuid
liftAnnex $ Annex.Branch.commit "update"
(g, u) <- liftAnnex $ (,)
<$> gitRepo
<*> getUUID
- liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) g
+ liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) branch g
selfjid <- ((T.unpack <$>) . xmppClientID) <$> getDaemonStatus
if null rs
then return Nothing
@@ -311,6 +309,7 @@ runPush checkcloudrepos (Pushing cid (PushRequest theiruuid)) =
xmppPush cid (taggedPush u selfjid branch r)
checkcloudrepos r
return $ Just cid
+ go _ = return Nothing
runPush checkcloudrepos (Pushing cid (StartingPush theiruuid)) = do
rs <- xmppRemotes cid theiruuid
if null rs
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index 71a69e861..b8c97a30a 100644
--- a/CmdLine/GitAnnex.hs
+++ b/CmdLine/GitAnnex.hs
@@ -38,6 +38,7 @@ import qualified Command.SetPresentKey
import qualified Command.ReadPresentKey
import qualified Command.CheckPresentKey
import qualified Command.ReKey
+import qualified Command.Adjust
import qualified Command.MetaData
import qualified Command.View
import qualified Command.VAdd
@@ -174,6 +175,7 @@ cmds testoptparser testrunner =
, Command.ReadPresentKey.cmd
, Command.CheckPresentKey.cmd
, Command.ReKey.cmd
+ , Command.Adjust.cmd
, Command.MetaData.cmd
, Command.View.cmd
, Command.VAdd.cmd
diff --git a/Command/Adjust.hs b/Command/Adjust.hs
new file mode 100644
index 000000000..e2850a361
--- /dev/null
+++ b/Command/Adjust.hs
@@ -0,0 +1,41 @@
+{- git-annex command
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Adjust where
+
+import Command
+import Annex.AdjustedBranch
+import Annex.Version
+
+cmd :: Command
+cmd = notBareRepo $ notDirect $ noDaemonRunning $
+ command "adjust" SectionSetup "enter adjusted branch"
+ paramNothing (seek <$$> optParser)
+
+optParser :: CmdParamsDesc -> Parser Adjustment
+optParser _ =
+ flag' UnlockAdjustment
+ ( long "unlock"
+ <> help "unlock annexed files"
+ )
+ {- Not ready yet
+ <|> flag' HideMissingAdjustment
+ ( long "hide-missing"
+ <> help "omit annexed files whose content is not present"
+ )
+ -}
+
+seek :: Adjustment -> CommandSeek
+seek = commandAction . start
+
+start :: Adjustment -> CommandStart
+start adj = do
+ unlessM versionSupportsAdjustedBranch $
+ error "Adjusted branches are only supported in v6 or newer repositories."
+ showStart "adjust" ""
+ enterAdjustedBranch adj
+ next $ next $ return True
diff --git a/Command/Merge.hs b/Command/Merge.hs
index 6ea8a68b1..908f3c1aa 100644
--- a/Command/Merge.hs
+++ b/Command/Merge.hs
@@ -9,8 +9,7 @@ module Command.Merge where
import Command
import qualified Annex.Branch
-import qualified Git.Branch
-import Command.Sync (prepMerge, mergeLocal)
+import Command.Sync (prepMerge, mergeLocal, getCurrBranch)
cmd :: Command
cmd = command "merge" SectionMaintenance
@@ -34,4 +33,4 @@ mergeBranch = do
mergeSynced :: CommandStart
mergeSynced = do
prepMerge
- mergeLocal =<< inRepo Git.Branch.current
+ mergeLocal =<< join getCurrBranch
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 456821b89..135f8b42d 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -1,13 +1,16 @@
{- git-annex command
-
- Copyright 2011 Joachim Breitner <mail@joachim-breitner.de>
- - Copyright 2011-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Sync (
cmd,
+ CurrBranch,
+ getCurrBranch,
+ merge,
prepMerge,
mergeLocal,
mergeRemote,
@@ -43,6 +46,7 @@ import Annex.Drop
import Annex.UUID
import Logs.UUID
import Annex.AutoMerge
+import Annex.AdjustedBranch
import Annex.Ssh
import Annex.BloomFilter
import Utility.Bloom
@@ -95,20 +99,7 @@ seek :: SyncOptions -> CommandSeek
seek o = allowConcurrentOutput $ do
prepMerge
- -- There may not be a branch checked out until after the commit,
- -- or perhaps after it gets merged from the remote, or perhaps
- -- never.
- -- So only look it up once it's needed, and once there is a
- -- branch, cache it.
- mvar <- liftIO newEmptyMVar
- let getbranch = ifM (liftIO $ isEmptyMVar mvar)
- ( do
- branch <- inRepo Git.Branch.current
- when (isJust branch) $
- liftIO $ putMVar mvar branch
- return branch
- , liftIO $ readMVar mvar
- )
+ getbranch <- getCurrBranch
let withbranch a = a =<< getbranch
remotes <- syncRemotes (syncWith o)
@@ -140,14 +131,49 @@ seek o = allowConcurrentOutput $ do
-- Pushes to remotes can run concurrently.
mapM_ (commandAction . withbranch . pushRemote o) gitremotes
+type CurrBranch = (Maybe Git.Branch, Maybe Adjustment)
+
+{- There may not be a branch checked out until after the commit,
+ - or perhaps after it gets merged from the remote, or perhaps
+ - never.
+ -
+ - So only look it up once it's needed, and once there is a
+ - branch, cache it.
+ -
+ - When on an adjusted branch, gets the original branch, and the adjustment.
+ -}
+getCurrBranch :: Annex (Annex CurrBranch)
+getCurrBranch = do
+ mvar <- liftIO newEmptyMVar
+ return $ ifM (liftIO $ isEmptyMVar mvar)
+ ( do
+ currbranch <- inRepo Git.Branch.current
+ case currbranch of
+ Nothing -> return (Nothing, Nothing)
+ Just b -> do
+ let v = case adjustedToOriginal b of
+ Nothing -> (Just b, Nothing)
+ Just (adj, origbranch) ->
+ (Just origbranch, Just adj)
+ liftIO $ putMVar mvar v
+ return v
+ , liftIO $ readMVar mvar
+ )
+
{- Merging may delete the current directory, so go to the top
- of the repo. This also means that sync always acts on all files in the
- repository, not just on a subdirectory. -}
prepMerge :: Annex ()
prepMerge = Annex.changeDirectory =<< fromRepo Git.repoPath
-syncBranch :: Git.Ref -> Git.Ref
-syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch
+merge :: CurrBranch -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool
+merge (Just b, Just adj) commitmode tomerge =
+ updateAdjustedBranch tomerge (b, adj) commitmode
+merge (b, _) commitmode tomerge =
+ autoMergeFrom tomerge b commitmode
+
+syncBranch :: Git.Branch -> Git.Branch
+syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch . fromAdjustedBranch
remoteBranch :: Remote -> Git.Ref -> Git.Ref
remoteBranch remote = Git.Ref.underBase $ "refs/remotes/" ++ Remote.name remote
@@ -216,50 +242,58 @@ commitStaged commitmode commitmessage = do
void $ inRepo $ Git.Branch.commit commitmode False commitmessage branch parents
return True
-mergeLocal :: Maybe Git.Ref -> CommandStart
-mergeLocal Nothing = stop
-mergeLocal (Just branch) = go =<< needmerge
+mergeLocal :: CurrBranch -> CommandStart
+mergeLocal currbranch@(Just branch, madj) = go =<< needmerge
where
syncbranch = syncBranch branch
needmerge = ifM isBareRepo
( return False
, ifM (inRepo $ Git.Ref.exists syncbranch)
- ( inRepo $ Git.Branch.changed branch syncbranch
+ ( inRepo $ Git.Branch.changed branch' syncbranch
, return False
)
)
go False = stop
go True = do
showStart "merge" $ Git.Ref.describe syncbranch
- next $ next $ autoMergeFrom syncbranch (Just branch) Git.Branch.ManualCommit
+ next $ next $ merge currbranch Git.Branch.ManualCommit syncbranch
+ branch' = maybe branch (originalToAdjusted branch) madj
+mergeLocal (Nothing, _) = stop
-pushLocal :: Maybe Git.Ref -> CommandStart
+pushLocal :: CurrBranch -> CommandStart
pushLocal b = do
updateSyncBranch b
stop
-updateSyncBranch :: Maybe Git.Ref -> Annex ()
-updateSyncBranch Nothing = noop
-updateSyncBranch (Just branch) = do
+updateSyncBranch :: CurrBranch -> Annex ()
+updateSyncBranch (Nothing, _) = noop
+updateSyncBranch (Just branch, madj) = do
+ -- When in an adjusted branch, propigate any changes made to it
+ -- back to the original branch.
+ case madj of
+ Just adj -> propigateAdjustedCommits branch
+ (adj, originalToAdjusted branch adj)
+ Nothing -> return ()
-- Update the sync branch to match the new state of the branch
- inRepo $ updateBranch $ syncBranch branch
+ inRepo $ updateBranch (syncBranch branch) branch
-- In direct mode, we're operating on some special direct mode
- -- branch, rather than the intended branch, so update the indended
+ -- branch, rather than the intended branch, so update the intended
-- branch.
whenM isDirect $
- inRepo $ updateBranch $ fromDirectBranch branch
+ inRepo $ updateBranch (fromDirectBranch branch) branch
-updateBranch :: Git.Ref -> Git.Repo -> IO ()
-updateBranch syncbranch g =
+updateBranch :: Git.Branch -> Git.Branch -> Git.Repo -> IO ()
+updateBranch syncbranch updateto g =
unlessM go $ error $ "failed to update " ++ Git.fromRef syncbranch
where
go = Git.Command.runBool
[ Param "branch"
, Param "-f"
, Param $ Git.fromRef $ Git.Ref.base syncbranch
+ , Param $ Git.fromRef $ updateto
] g
-pullRemote :: SyncOptions -> Remote -> Maybe Git.Ref -> CommandStart
+pullRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart
pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do
showStart "pull" (Remote.name remote)
next $ do
@@ -276,26 +310,27 @@ pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do
- were committed (or pushed changes, if this is a bare remote),
- while the synced/master may have changes that some
- other remote synced to this remote. So, merge them both. -}
-mergeRemote :: Remote -> Maybe Git.Ref -> CommandCleanup
-mergeRemote remote b = ifM isBareRepo
+mergeRemote :: Remote -> CurrBranch -> CommandCleanup
+mergeRemote remote currbranch = ifM isBareRepo
( return True
- , case b of
- Nothing -> do
+ , case currbranch of
+ (Nothing, _) -> do
branch <- inRepo Git.Branch.currentUnsafe
- and <$> mapM (merge Nothing) (branchlist branch)
- Just thisbranch -> do
- inRepo $ updateBranch $ syncBranch thisbranch
- and <$> (mapM (merge (Just thisbranch)) =<< tomerge (branchlist b))
+ mergelisted (pure (branchlist branch))
+ (Just branch, _) -> do
+ inRepo $ updateBranch (syncBranch branch) branch
+ mergelisted (tomerge (branchlist (Just branch)))
)
where
- merge thisbranch br = autoMergeFrom (remoteBranch remote br) thisbranch Git.Branch.ManualCommit
+ mergelisted getlist = and <$>
+ (mapM (merge currbranch Git.Branch.ManualCommit . remoteBranch remote) =<< getlist)
tomerge = filterM (changed remote)
branchlist Nothing = []
branchlist (Just branch) = [branch, syncBranch branch]
-pushRemote :: SyncOptions -> Remote -> Maybe Git.Ref -> CommandStart
-pushRemote _o _remote Nothing = stop
-pushRemote o remote (Just branch) = stopUnless (pure (pushOption o) <&&> needpush) $ do
+pushRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart
+pushRemote _o _remote (Nothing, _) = stop
+pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> needpush) $ do
showStart "push" (Remote.name remote)
next $ next $ do
showOutput
@@ -339,16 +374,16 @@ pushRemote o remote (Just branch) = stopUnless (pure (pushOption o) <&&> needpus
- The sync push will fail to overwrite if receive.denyNonFastforwards is
- set on the remote.
-}
-pushBranch :: Remote -> Git.Ref -> Git.Repo -> IO Bool
+pushBranch :: Remote -> Git.Branch -> Git.Repo -> IO Bool
pushBranch remote branch g = tryIO (directpush g) `after` syncpush g
where
syncpush = Git.Command.runBool $ pushparams
[ Git.Branch.forcePush $ refspec Annex.Branch.name
- , refspec branch
+ , refspec $ fromAdjustedBranch branch
]
directpush = Git.Command.runQuiet $ pushparams
[ Git.fromRef $ Git.Ref.base $ Annex.Branch.name
- , Git.fromRef $ Git.Ref.base $ fromDirectBranch branch
+ , Git.fromRef $ Git.Ref.base $ fromDirectBranch $ fromAdjustedBranch branch
]
pushparams branches =
[ Param "push"
diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs
index 432250a1a..223be581d 100644
--- a/Command/Upgrade.hs
+++ b/Command/Upgrade.hs
@@ -9,6 +9,8 @@ module Command.Upgrade where
import Command
import Upgrade
+import Annex.Version
+import Annex.Init
cmd :: Command
cmd = dontCheck repoExists $ -- because an old version may not seem to exist
@@ -22,5 +24,7 @@ seek = withNothing start
start :: CommandStart
start = do
showStart "upgrade" "."
+ whenM (isNothing <$> getVersion) $ do
+ initialize Nothing Nothing
r <- upgrade False
next $ next $ return r
diff --git a/Git/Branch.hs b/Git/Branch.hs
index ff209d44d..6258939cb 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -48,15 +48,25 @@ currentUnsafe r = parse . firstLine
changed :: Branch -> Branch -> Repo -> IO Bool
changed origbranch newbranch repo
| origbranch == newbranch = return False
- | otherwise = not . null <$> diffs
+ | otherwise = not . null
+ <$> changed' origbranch newbranch [Param "-n1"] repo
where
- diffs = pipeReadStrict
+
+changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO String
+changed' origbranch newbranch extraps repo = pipeReadStrict ps repo
+ where
+ ps =
[ Param "log"
, Param (fromRef origbranch ++ ".." ++ fromRef newbranch)
- , Param "-n1"
, Param "--pretty=%H"
- ] repo
-
+ ] ++ extraps
+
+{- Lists commits that are in the second branch and not in the first branch. -}
+changedCommits :: Branch -> Branch -> [CommandParam] -> Repo -> IO [Sha]
+changedCommits origbranch newbranch extraps repo =
+ catMaybes . map extractSha . lines
+ <$> changed' origbranch newbranch extraps repo
+
{- Check if it's possible to fast-forward from the old
- ref to the new ref.
-
@@ -90,7 +100,7 @@ fastForward branch (first:rest) repo =
where
no_ff = return False
do_ff to = do
- update branch to repo
+ update' branch to repo
return True
findbest c [] = return $ Just c
findbest c (r:rs)
@@ -145,7 +155,7 @@ commit commitmode allowempty message branch parentrefs repo = do
ifM (cancommit tree)
( do
sha <- commitTree commitmode message parentrefs tree repo
- update branch sha repo
+ update' branch sha repo
return $ Just sha
, return Nothing
)
@@ -175,8 +185,17 @@ forcePush :: String -> String
forcePush b = "+" ++ b
{- Updates a branch (or other ref) to a new Sha. -}
-update :: Branch -> Sha -> Repo -> IO ()
-update branch sha = run
+update :: String -> Branch -> Sha -> Repo -> IO ()
+update message branch sha = run
+ [ Param "update-ref"
+ , Param "-m"
+ , Param message
+ , Param $ fromRef branch
+ , Param $ fromRef sha
+ ]
+
+update' :: Branch -> Sha -> Repo -> IO ()
+update' branch sha = run
[ Param "update-ref"
, Param $ fromRef branch
, Param $ fromRef sha
diff --git a/Git/CatFile.hs b/Git/CatFile.hs
index 455f192a0..dc96730ab 100644
--- a/Git/CatFile.hs
+++ b/Git/CatFile.hs
@@ -125,15 +125,17 @@ catCommit h commitref = go <$> catObjectDetails h commitref
parseCommit :: L.ByteString -> Maybe Commit
parseCommit b = Commit
<$> (extractSha . L8.unpack =<< field "tree")
+ <*> Just (maybe [] (mapMaybe (extractSha . L8.unpack)) (fields "parent"))
<*> (parsemetadata <$> field "author")
<*> (parsemetadata <$> field "committer")
<*> Just (L8.unpack $ L.intercalate (L.singleton nl) message)
where
- field n = M.lookup (fromString n) fields
- fields = M.fromList ((map breakfield) header)
+ field n = headMaybe =<< fields n
+ fields n = M.lookup (fromString n) fieldmap
+ fieldmap = M.fromListWith (++) ((map breakfield) header)
breakfield l =
let (k, sp_v) = L.break (== sp) l
- in (k, L.drop 1 sp_v)
+ in (k, [L.drop 1 sp_v])
(header, message) = separate L.null ls
ls = L.split nl b
diff --git a/Git/DiffTree.hs b/Git/DiffTree.hs
index 838114872..645d18d35 100644
--- a/Git/DiffTree.hs
+++ b/Git/DiffTree.hs
@@ -14,6 +14,7 @@ module Git.DiffTree (
diffWorkTree,
diffFiles,
diffLog,
+ commitDiff,
) where
import Numeric
@@ -72,16 +73,23 @@ diffFiles :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
diffFiles = getdiff (Param "diff-files")
{- Runs git log in --raw mode to get the changes that were made in
- - a particular commit. The output format is adjusted to be the same
- - as diff-tree --raw._-}
+ - a particular commit to particular files. The output format
+ - is adjusted to be the same as diff-tree --raw._-}
diffLog :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
diffLog params = getdiff (Param "log")
(Param "-n1" : Param "--abbrev=40" : Param "--pretty=format:" : params)
+{- Uses git show to get the changes made by a commit.
+ -
+ - Does not support merge commits, and will fail on them. -}
+commitDiff :: Sha -> Repo -> IO ([DiffTreeItem], IO Bool)
+commitDiff ref = getdiff (Param "show")
+ [ Param "--abbrev=40", Param "--pretty=", Param "--raw", Param (fromRef ref) ]
+
getdiff :: CommandParam -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
getdiff command params repo = do
(diff, cleanup) <- pipeNullSplit ps repo
- return (parseDiffRaw diff, cleanup)
+ return (fromMaybe (error $ "git " ++ show (toCommand ps) ++ " parse failed") (parseDiffRaw diff), cleanup)
where
ps =
command :
@@ -92,23 +100,24 @@ getdiff command params repo = do
params
{- Parses --raw output used by diff-tree and git-log. -}
-parseDiffRaw :: [String] -> [DiffTreeItem]
+parseDiffRaw :: [String] -> Maybe [DiffTreeItem]
parseDiffRaw l = go l []
where
- go [] c = c
- go (info:f:rest) c = go rest (mk info f : c)
- go (s:[]) _ = error $ "diff-tree parse error " ++ s
-
- mk info f = DiffTreeItem
- { srcmode = readmode srcm
- , dstmode = readmode dstm
- , srcsha = fromMaybe (error "bad srcsha") $ extractSha ssha
- , dstsha = fromMaybe (error "bad dstsha") $ extractSha dsha
- , status = s
- , file = asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f
- }
+ go [] c = Just c
+ go (info:f:rest) c = case mk info f of
+ Nothing -> Nothing
+ Just i -> go rest (i:c)
+ go (_:[]) _ = Nothing
+
+ mk info f = DiffTreeItem
+ <$> readmode srcm
+ <*> readmode dstm
+ <*> extractSha ssha
+ <*> extractSha dsha
+ <*> pure s
+ <*> pure (asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f)
where
- readmode = fst . Prelude.head . readOct
+ readmode = fst <$$> headMaybe . readOct
-- info = :<srcmode> SP <dstmode> SP <srcsha> SP <dstsha> SP <status>
-- All fields are fixed, so we can pull them out of
diff --git a/Git/FilePath.hs b/Git/FilePath.hs
index 5af74c067..db576fc8e 100644
--- a/Git/FilePath.hs
+++ b/Git/FilePath.hs
@@ -31,7 +31,7 @@ import qualified System.FilePath.Posix
{- A FilePath, relative to the top of the git repository. -}
newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath }
- deriving (Show, Eq)
+ deriving (Show, Eq, Ord)
{- Path to a TopFilePath, within the provided git repo. -}
fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath
diff --git a/Git/LockFile.hs b/Git/LockFile.hs
new file mode 100644
index 000000000..a7a144114
--- /dev/null
+++ b/Git/LockFile.hs
@@ -0,0 +1,78 @@
+{- git lock files
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Git.LockFile where
+
+import Common
+
+#ifndef mingw32_HOST_OS
+import System.Posix.Types
+#else
+import System.Win32.Types
+import System.Win32.File
+#endif
+
+#ifndef mingw32_HOST_OS
+data LockHandle = LockHandle FilePath Fd
+#else
+data LockHandle = LockHandle FilePath HANDLE
+#endif
+
+{- Uses the same exclusive locking that git does.
+ - Throws an IO exception if the file is already locked.
+ -
+ - Note that git's locking method suffers from the problem that
+ - a dangling lock can be left if a process is terminated at the wrong
+ - time.
+ -}
+openLock :: FilePath -> IO LockHandle
+openLock lck = openLock' lck `catchNonAsync` lckerr
+ where
+ lckerr e = do
+ -- Same error message displayed by git.
+ whenM (doesFileExist lck) $
+ hPutStrLn stderr $ unlines
+ [ "fatal: Unable to create '" ++ lck ++ "': " ++ show e
+ , ""
+ , "If no other git process is currently running, this probably means a"
+ , "git process crashed in this repository earlier. Make sure no other git"
+ , "process is running and remove the file manually to continue."
+ ]
+ throwM e
+
+openLock' :: FilePath -> IO LockHandle
+openLock' lck = do
+#ifndef mingw32_HOST_OS
+ -- On unix, git simply uses O_EXCL
+ h <- openFd lck ReadWrite (Just 0O666)
+ (defaultFileFlags { exclusive = True })
+ setFdOption h CloseOnExec True
+#else
+ -- It's not entirely clear how git manages locking on Windows,
+ -- since it's buried in the portability layer, and different
+ -- versions of git for windows use different portability layers.
+ -- But, we can be fairly sure that holding the lock file open on
+ -- windows is enough to prevent another process from opening it.
+ --
+ -- So, all that's needed is a way to open the file, that fails
+ -- if the file already exists. Using CreateFile with CREATE_NEW
+ -- accomplishes that.
+ h <- createFile lck gENERIC_WRITE fILE_SHARE_NONE Nothing
+ cREATE_NEW fILE_ATTRIBUTE_NORMAL Nothing
+#endif
+ return (LockHandle lck h)
+
+closeLock :: LockHandle -> IO ()
+closeLock (LockHandle lck h) = do
+#ifndef mingw32_HOST_OS
+ closeFd h
+#else
+ closeHandle h
+#endif
+ removeFile lck
diff --git a/Git/Ref.hs b/Git/Ref.hs
index 6bc47d5ed..7f21b0ab8 100644
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -31,11 +31,14 @@ base = Ref . remove "refs/heads/" . remove "refs/remotes/" . fromRef
| prefix `isPrefixOf` s = drop (length prefix) s
| otherwise = s
+{- Gets the basename of any qualified ref. -}
+basename :: Ref -> Ref
+basename = Ref . reverse . takeWhile (/= '/') . reverse . fromRef
+
{- Given a directory and any ref, takes the basename of the ref and puts
- it under the directory. -}
under :: String -> Ref -> Ref
-under dir r = Ref $ dir ++ "/" ++
- (reverse $ takeWhile (/= '/') $ reverse $ fromRef r)
+under dir r = Ref $ dir ++ "/" ++ fromRef (basename r)
{- Given a directory such as "refs/remotes/origin", and a ref such as
- refs/heads/master, yields a version of that ref under the directory,
diff --git a/Git/Tree.hs b/Git/Tree.hs
index 5cc72ec8a..ea48a1f12 100644
--- a/Git/Tree.hs
+++ b/Git/Tree.hs
@@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-}
module Git.Tree (
Tree(..),
@@ -28,6 +28,8 @@ import qualified Utility.CoProcess as CoProcess
import Numeric
import System.Posix.Types
import Control.Monad.IO.Class
+import qualified Data.Set as S
+import qualified Data.Map as M
newtype Tree = Tree [TreeContent]
deriving (Show)
@@ -38,7 +40,7 @@ data TreeContent
| RecordedSubTree TopFilePath Sha [TreeContent]
-- A subtree that has not yet been recorded in git.
| NewSubTree TopFilePath [TreeContent]
- deriving (Show)
+ deriving (Show, Eq, Ord)
{- Gets the Tree for a Ref. -}
getTree :: Ref -> Repo -> IO Tree
@@ -107,74 +109,154 @@ mkTreeOutput fm ot s f = concat
]
data TreeItem = TreeItem TopFilePath FileMode Sha
- deriving (Eq)
+ deriving (Show, Eq)
+
+treeItemToTreeContent :: TreeItem -> TreeContent
+treeItemToTreeContent (TreeItem f m s) = TreeBlob f m s
+
+treeItemsToTree :: [TreeItem] -> Tree
+treeItemsToTree = go M.empty
+ where
+ go m [] = Tree $ filter (notElem '/' . gitPath) (M.elems m)
+ go m (i:is)
+ | '/' `notElem` p =
+ go (M.insert p (treeItemToTreeContent i) m) is
+ | otherwise = case M.lookup idir m of
+ Just (NewSubTree d l) ->
+ go (addsubtree idir m (NewSubTree d (c:l))) is
+ _ ->
+ go (addsubtree idir m (NewSubTree (asTopFilePath idir) [c])) is
+ where
+ p = gitPath i
+ idir = takeDirectory p
+ c = treeItemToTreeContent i
+
+ addsubtree d m t
+ | elem '/' d =
+ let m' = M.insert d t m
+ in case M.lookup parent m' of
+ Just (NewSubTree d' l) ->
+ let l' = filter (\ti -> gitPath ti /= d) l
+ in addsubtree parent m' (NewSubTree d' (t:l'))
+ _ -> addsubtree parent m' (NewSubTree (asTopFilePath parent) [t])
+ | otherwise = M.insert d t m
+ where
+ parent = takeDirectory d
{- Applies an adjustment to items in a tree.
-
- - While less flexible than using getTree and recordTree, this avoids
- - buffering the whole tree in memory.
+ - While less flexible than using getTree and recordTree,
+ - this avoids buffering the whole tree in memory.
-}
-adjustTree :: (MonadIO m, MonadMask m) => (TreeItem -> m (Maybe TreeItem)) -> Ref -> Repo -> m Sha
-adjustTree adjust r repo = withMkTreeHandle repo $ \h -> do
- (l, cleanup) <- liftIO $ lsTreeWithObjects r repo
- (l', _, _) <- go h False [] topTree l
- sha <- liftIO $ mkTree h l'
- void $ liftIO cleanup
- return sha
+adjustTree
+ :: (MonadIO m, MonadMask m)
+ => (TreeItem -> m (Maybe TreeItem))
+ -- ^ Adjust an item in the tree. Nothing deletes the item.
+ -- Cannot move the item to a different tree.
+ -> [TreeItem]
+ -- ^ New items to add to the tree.
+ -> [TopFilePath]
+ -- ^ Files to remove from the tree.
+ -> Ref
+ -> Repo
+ -> m Sha
+adjustTree adjusttreeitem addtreeitems removefiles r repo =
+ withMkTreeHandle repo $ \h -> do
+ (l, cleanup) <- liftIO $ lsTreeWithObjects r repo
+ (l', _, _) <- go h False [] inTopTree l
+ l'' <- adjustlist h inTopTree (const True) l'
+ sha <- liftIO $ mkTree h l''
+ void $ liftIO cleanup
+ return sha
where
go _ wasmodified c _ [] = return (c, wasmodified, [])
go h wasmodified c intree (i:is)
- | intree i =
- case readObjectType (LsTree.typeobj i) of
- Just BlobObject -> do
- let ti = TreeItem (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
- v <- adjust ti
- case v of
- Nothing -> go h True c intree is
- Just ti'@(TreeItem f m s) ->
- let !modified = wasmodified || ti' /= ti
- blob = TreeBlob f m s
- in go h modified (blob:c) intree is
- Just TreeObject -> do
- (sl, modified, is') <- go h False [] (subTree i) is
- subtree <- if modified
- then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl
- else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) []
- let !modified' = modified || wasmodified
- go h modified' (subtree : c) intree is'
- _ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
+ | intree i = case readObjectType (LsTree.typeobj i) of
+ Just BlobObject -> do
+ let ti = TreeItem (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
+ v <- adjusttreeitem ti
+ case v of
+ Nothing -> go h True c intree is
+ Just ti'@(TreeItem f m s) ->
+ let !modified = wasmodified || ti' /= ti
+ blob = TreeBlob f m s
+ in go h modified (blob:c) intree is
+ Just TreeObject -> do
+ (sl, modified, is') <- go h False [] (beneathSubTree i) is
+ sl' <- adjustlist h (inTree i) (beneathSubTree i) sl
+ subtree <- if modified || sl' /= sl
+ then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl'
+ else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) []
+ let !modified' = modified || wasmodified
+ go h modified' (subtree : c) intree is'
+ _ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
| otherwise = return (c, wasmodified, i:is)
+ adjustlist h ishere underhere l = do
+ let (addhere, rest) = partition ishere addtreeitems
+ let l' = filter (not . removed) $
+ map treeItemToTreeContent addhere ++ l
+ let inl i = any (\t -> beneathSubTree t i) l'
+ let (Tree addunderhere) = treeItemsToTree $
+ filter (\i -> underhere i && not (inl i)) rest
+ addunderhere' <- liftIO $ mapM (recordSubTree h) addunderhere
+ return (addunderhere'++l')
+
+ removeset = S.fromList removefiles
+ removed (TreeBlob f _ _) = S.member f removeset
+ removed _ = False
+
{- Assumes the list is ordered, with tree objects coming right before their
- contents. -}
extractTree :: [LsTree.TreeItem] -> Either String Tree
-extractTree l = case go [] topTree l of
+extractTree l = case go [] inTopTree l of
Right (t, []) -> Right (Tree t)
Right _ -> parseerr "unexpected tree form"
Left e -> parseerr e
where
go t _ [] = Right (t, [])
go t intree (i:is)
- | intree i =
- case readObjectType (LsTree.typeobj i) of
- Just BlobObject ->
- let b = TreeBlob (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
- in go (b:t) intree is
- Just TreeObject -> case go [] (subTree i) is of
- Right (subtree, is') ->
- let st = RecordedSubTree (LsTree.file i) (LsTree.sha i) subtree
- in go (st:t) intree is'
- Left e -> Left e
- _ -> parseerr ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
+ | intree i = case readObjectType (LsTree.typeobj i) of
+ Just BlobObject ->
+ let b = TreeBlob (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
+ in go (b:t) intree is
+ Just TreeObject -> case go [] (beneathSubTree i) is of
+ Right (subtree, is') ->
+ let st = RecordedSubTree (LsTree.file i) (LsTree.sha i) subtree
+ in go (st:t) intree is'
+ Left e -> Left e
+ _ -> parseerr ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
| otherwise = Right (t, i:is)
parseerr = Left
-type InTree = LsTree.TreeItem -> Bool
+class GitPath t where
+ gitPath :: t -> FilePath
-topTree :: InTree
-topTree = notElem '/' . getTopFilePath . LsTree.file
+instance GitPath FilePath where
+ gitPath = id
-subTree :: LsTree.TreeItem -> InTree
-subTree t =
- let prefix = getTopFilePath (LsTree.file t) ++ "/"
- in (\i -> prefix `isPrefixOf` getTopFilePath (LsTree.file i))
+instance GitPath TopFilePath where
+ gitPath = getTopFilePath
+
+instance GitPath TreeItem where
+ gitPath (TreeItem f _ _) = gitPath f
+
+instance GitPath LsTree.TreeItem where
+ gitPath = gitPath . LsTree.file
+
+instance GitPath TreeContent where
+ gitPath (TreeBlob f _ _) = gitPath f
+ gitPath (RecordedSubTree f _ _) = gitPath f
+ gitPath (NewSubTree f _) = gitPath f
+
+inTopTree :: GitPath t => t -> Bool
+inTopTree = inTree "."
+
+inTree :: (GitPath t, GitPath f) => t -> f -> Bool
+inTree t f = gitPath t == takeDirectory (gitPath f)
+
+beneathSubTree :: (GitPath t, GitPath f) => t -> f -> Bool
+beneathSubTree t f = prefix `isPrefixOf` gitPath f
+ where
+ tp = gitPath t
+ prefix = if null tp then tp else tp ++ "/"
diff --git a/Git/Types.hs b/Git/Types.hs
index 4fa49be5c..44135738d 100644
--- a/Git/Types.hs
+++ b/Git/Types.hs
@@ -105,6 +105,7 @@ fromBlobType SymlinkBlob = 0o120000
data Commit = Commit
{ commitTree :: Sha
+ , commitParent :: [Sha]
, commitAuthorMetaData :: CommitMetaData
, commitCommitterMetaData :: CommitMetaData
, commitMessage :: String
diff --git a/debian/changelog b/debian/changelog
index f4542b7dd..53b894627 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,5 +1,9 @@
git-annex (6.20160319) UNRELEASED; urgency=medium
+ * adjust --unlock: Enters an adjusted branch in which all annexed files
+ are unlocked. The v6 equivilant of direct mode, but much cleaner!
+ * init --version=6: Automatically enter the adjusted unlocked branch
+ when filesystem doesn't support symlinks.
* ddar remote: fix ssh calls
Thanks, Robie Basak
* log: Display time with time zone.
diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn
index f79a7f1ab..a4fd40650 100644
--- a/doc/design/adjusted_branches.mdwn
+++ b/doc/design/adjusted_branches.mdwn
@@ -62,12 +62,9 @@ it, so C does not remain in the adjusted branch history either. This will
make other checkouts that are in the same adjusted branch end up with the
same B' commit when they pull B.
-It might be useful to have a post-commit hook that generates B and B'
-and updates the branches. And/or `git-annex sync` could do it.
-
There may be multiple commits made to the adjusted branch before any get
applied back to the original branch. This is handled by reverse filtering
-one at a time and rebasing the others on top.
+commits one at a time and rebasing the others on top.
master adjusted/master
A
@@ -112,10 +109,10 @@ beginning the merge. There may be staged changes, or changes in the work tree.
First filter the new commit:
- origin/master adjusted/master
- A
- |--------------->A'
- | |
+ origin/master adjusted/master master
+ A A
+ |--------------->A' |
+ | | |
| |
B
|
@@ -123,10 +120,10 @@ First filter the new commit:
Then, merge that into adjusted/master:
- origin/master adjusted/master
- A
- |--------------->A'
- | |
+ origin/master adjusted/master master
+ A A
+ |--------------->A' |
+ | | |
| |
B |
| |
@@ -139,20 +136,30 @@ conflict should only affect the work tree/index, so can be resolved without
making a commit, but B'' may end up being made to resolve a merge
conflict.)
-Once the merge is done, we have a commit B'' on adjusted/master. To finish,
-adjust that commit so it does not have adjusted/master as its parent.
+Once the merge is done, we have a merge commit B'' on adjusted/master.
+To finish, redo that commit so it does not have A' as its parent.
- origin/master adjusted/master
- A
- |--------------->A'
- | |
+ origin/master adjusted/master master
+ A A
+ |--------------->A' |
+ | | |
| |
B
|
|--------------->B''
| |
-Finally, update master to point to B''.
+Finally, update master, by reverse filtering B''.
+
+ origin/master adjusted/master master
+ A A
+ |--------------->A' |
+ | | |
+ | | |
+ B |
+ | |
+ |--------------->B'' - - - - - - -> B
+ | |
Notice how similar this is to the commit graph. So, "fast-forward"
merging the same B commit from origin/master will lead to an identical
@@ -172,48 +179,90 @@ between the adjusted work tree and pulled changes. A post-merge hook would
be needed to re-adjust the work tree, and there would be a window where eg,
not present files would appear in the work tree.]
+## another merge scenario
+
+Another merge scenario is when there's a new commit C on adjusted/master,
+and also a new commit B on origin/master.
+
+Start by adjusting B':
+
+ origin/master adjusted/master master
+ A A
+ |--------------->A' |
+ | | |
+ | C'
+ B
+ |
+ |---------->B'
+
+Then, merge B' into adjusted/master:
+
+ origin/master adjusted/master master
+ A A
+ |--------------->A' |
+ | | |
+ | C'
+ B |
+ | |
+ |----------->B'->M'
+
+Here M' is the correct tree, but it has A' as its grandparent,
+which is the adjusted branch commit, so needs to be dropped in order to
+get a commit that can be put on master.
+
+We don't want to lose commit C', but it's an adjusted
+commit, so needs to be de-adjusted.
+
+ origin/master adjusted/master master
+ A A
+ |--------------->A' |
+ | | |
+ | C'- - - - - - - - > C
+ B |
+ | |
+ |----------->B'->M'
+ |
+
+Now, we generate a merge commit, between B and C, with known result M'
+(so no actual merging done here).
+
+ origin/master adjusted/master master
+ A A
+ |--------------->A' |
+ | | |
+ | C'- - - - - - - - > C
+ B |
+ | |
+ |--------------->M'<-----------------|
+ |
+
+Finally, update master, by reverse filtering M'. The resulting commit
+on master will also be a merge between B and C.
+
## annex object add/remove
When objects are added/removed from the annex, the associated file has to
be looked up, and the filter applied to it. So, dropping a file with the
missing file filter would cause it to be removed from the adjusted branch,
and receiving a file's content would cause it to appear in the adjusted
-branch.
+branch. TODO
These changes would need to be committed to the adjusted branch, otherwise
`git diff` would show them.
[WORKTREE: Simply adjust the work tree (and index) per the filter.]
-## reverse filtering
-
-Reversing filter #1 would mean only converting pointer files to
-symlinks when the file was originally a symlink. This is problimatic when a
-file is renamed. Would it be ok, if foo is renamed to bar and bar is
-committed, for it to be committed as an unlocked file, even if foo was
-originally locked? Probably.
+## reverse filtering commits
-Reversing filter #2 would mean not deleting removed files whose content was
-not present. When the commit includes deletion of files that were removed
-due to their content not being present, those deletions are not propigated.
-When the user deletes an unlocked file, the content is still
-present in annex, so reversing the filter should propigate the file
-deletion.
+A user's commits on the adjusted branch have to be reverse filtered
+to get changes to apply to the master branch.
-What if an object was sent to the annex (or removed from the annex)
-after the commit and before the reverse filtering? This would cause the
-reverse filter to draw the wrong conclusion. Maybe look at a list of what
-objects were not present when applying the filter, and use that to decide
-which to not delete when reversing it?
+This reversal of one filter can be done as just another filter.
+Since only files touched by the commit will be reverse filtered, it doesn't
+need to reverse all changes made by the original filter.
-So, a reverse filter may need some state that was collected when running
-the filter forwards, in order to decide what to do.
-
-Alternatively, instead of reverse filtering the whole adjusted tree,
-look at just the new commit that's being propigated back from the
-adjusted to master branch. Get the diff from it to the previous
-commit; the changes that were made. Then de-adjust those changes,
-and apply the changes to the master branch.
+For example, reversing the unlock filter might lock the file. Or, it might
+do nothing, which would make all committed files remain unlocked.
## push
@@ -254,8 +303,15 @@ index in that case.
Using `git checkout` when in an adjusted branch is problimatic, because a
non-adjusted branch would then be checked out. But, we can just say, if
-you want to get into an adjusted branch, you have to run some command.
-Or, could make a post-checkout hook.
+you want to get into an adjusted branch, you have to run git annex adjust
+Or, could make a post-checkout hook. This is would mostly be confusing when
+git-annex init switched into the adjusted branch due to lack of symlink
+support.
+
+After a commit to an adjusted branch, `git push` won't do anything. The
+user has to know to git-annex sync. (Even if a pre-commit hook propigated
+the commit back to the master branch, `git push` wouldn't push it with the
+default "matching" push strategy.)
Tags are bit of a problem. If the user tags an ajusted branch, the tag
includes the local adjustments.
@@ -282,47 +338,23 @@ adjusting filter, albeit an extreme one. This might improve view branches.
For example, it's not currently possible to update a view branch with
changes fetched from a remote, and this could get us there.
-This would need the reverse filter to be able to change metadata.
+This would need the reverse filter to be able to change metadata,
+so that a commit that moved files in the view updates their metadata.
[WORKTREE: Wouldn't be able to integrate, unless view branches are changed
into adjusted view worktrees.]
-## filter interface
-
-Distilling all of the above, the filter interface needs to be something
-like this, at its most simple:
-
- data Filter = UnlockFilter | HideMissingFilter | UnlockHideMissingFilter
-
- getFilter :: Annex Filter
-
- setFilter :: Filter -> Annex ()
-
- data FilterAction
- = UnchangedFile FilePath
- | UnlockFile FilePath
- | HideFile FilePath
-
- data FileInfo = FileInfo
- { originalBranchFile :: FileStatus
- , isContentPresent :: Bool
- }
-
- data FileStatus = IsAnnexSymlink | IsAnnexPointer
- deriving (Eq)
-
- filterAction :: Filter -> FilePath -> FileInfo -> FilterAction
- filterAction UnlockFilter f fi
- | originalBranchFile fi == IsAnnexSymlink = UnlockFile f
- filterAction HideMissingFilter f fi
- | not (isContentPresent fi) = HideFile f
- filterAction UnlockHideMissingFilter f fi
- | not (isContentPresent fi) = HideFile f
- | otherwise = filterAction UnlockFilter f fi
- filterAction _ f _ = UnchangedFile f
-
- filteredCommit :: Filter -> Git.Commit -> Git.Commit
-
- -- Generate a version of the commit made on the filter branch
- -- with the filtering of modified files reversed.
- unfilteredCommit :: Filter -> Git.Commit -> Git.Commit
+## TODOs
+
+* Interface in webapp to enable adjustments.
+* Upgrade from direct mode to v6 in unlocked branch.
+* Honor annex.thin when entering an adjusted branch.
+* Cloning a repo that has an adjusted branch checked out gets into an ugly
+ state.
+* There are potentially races in code that assumes a branch like
+ master is not being changed by someone else. In particular,
+ propigateAdjustedCommits rebases the adjusted branch on top of master.
+ That is called by sync. The assumption is that any changes in master
+ have already been handled by updateAdjustedBranch. But, if another remote
+ pushed a new master at just the right time, the adjusted branch could be
+ rebased on top of a master that it doesn't incorporate, which is wrong.
diff --git a/doc/git-annex-adjust.mdwn b/doc/git-annex-adjust.mdwn
new file mode 100644
index 000000000..551eabe01
--- /dev/null
+++ b/doc/git-annex-adjust.mdwn
@@ -0,0 +1,50 @@
+# NAME
+
+git-annex adjust - enter an adjusted branch
+
+# SYNOPSIS
+
+git annex adjust --unlock`
+
+# DESCRIPTION
+
+Enters an adjusted form of the current branch. The annexed files will
+be treated differently. For example with --unlock all annexed files will
+be unlocked.
+
+The adjusted branch will have a name like "adjusted/master(unlocked)".
+Since it's a regular git branch, you can use `git checkout` to switch
+back to the original branch at any time.
+
+While in the adjusted branch, you can use git-annex and git commands as
+usual. Any commits that you make will initially only be made to the
+adjusted branch.
+
+To propigate changes from the adjusted branch back to the original branch,
+and to other repositories, as well as to merge in changes from other
+repositories, use `git annex sync`.
+
+This command can only be used in a v6 git-annex repository.
+
+# OPTIONS
+
+* `--unlock`
+
+ Unlock all annexed files in the adjusted branch. This allows
+ annexed files to be modified.
+
+# SEE ALSO
+
+[[git-annex]](1)
+
+[[git-annex-unlock]](1)
+
+[[git-annex-upgrade]](1)
+
+[[git-annex-sync]](1)
+
+# AUTHOR
+
+Joey Hess <id@joeyh.name>
+
+Warning: Automatically converted into a man page by mdwn2man. Edit with care.
diff --git a/doc/git-annex-direct.mdwn b/doc/git-annex-direct.mdwn
index 3cade1a8c..c3d7dfadc 100644
--- a/doc/git-annex-direct.mdwn
+++ b/doc/git-annex-direct.mdwn
@@ -20,6 +20,8 @@ commands.
Note that the direct mode/indirect mode distinction is removed in v6
git-annex repositories. In such a repository, you can
use [[git-annex-unlock]](1) to make a file's content be directly present.
+You can also use [[git-annex-adjust]](1) to enter a branch where all
+annexed files are unlocked, which is similar to the old direct mode.
# SEE ALSO
@@ -29,6 +31,8 @@ use [[git-annex-unlock]](1) to make a file's content be directly present.
[[git-annex-unlock]](1)
+[[git-annex-adjust]](1)
+
# AUTHOR
Joey Hess <id@joeyh.name>
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 6830f741f..e9698c169 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -295,6 +295,13 @@ subdirectories).
See [[git-annex-indirect]](1) for details.
+* `adjust`
+
+ Switches a repository to use an adjusted branch, which can automatically
+ unlock all files, etc.
+
+ See [[git-annex-adjust]](1) for details.
+
# REPOSITORY MAINTENANCE COMMANDS
* `fsck [path ...]`
diff --git a/doc/tips/unlocked_files.mdwn b/doc/tips/unlocked_files.mdwn
index fd103940e..cc9972f9e 100644
--- a/doc/tips/unlocked_files.mdwn
+++ b/doc/tips/unlocked_files.mdwn
@@ -95,6 +95,8 @@ mode is used. To make them always use unlocked mode, run:
`git config annex.addunlocked true`
"""]]
+## mixing locked and unlocked files
+
A v6 repository can contain both locked and unlocked files. You can switch
a file back and forth using the `git annex lock` and `git annex unlock`
commands. This changes what's stored in git between a git-annex symlink
@@ -102,6 +104,12 @@ commands. This changes what's stored in git between a git-annex symlink
the repository in locked mode, use `git annex add`; to add a file in
unlocked mode, use `git add`.
+If you want to mostly keep files locked, but be able to locally switch
+to having them all unlocked, you can do so using `git annex adjust
+--unlock`. See [[git-annex-adjust]] for details. This is particularly
+useful when using filesystems like FAT, and OS's like Windows that don't
+support symlinks.
+
## using less disk space
Unlocked files are handy, but they have one significant disadvantage
diff --git a/doc/todo/smudge.mdwn b/doc/todo/smudge.mdwn
index c615f8f14..a80869dc0 100644
--- a/doc/todo/smudge.mdwn
+++ b/doc/todo/smudge.mdwn
@@ -23,12 +23,6 @@ git-annex should use smudge/clean filters.
(May need to use libgit2 to do this efficiently, cannot find
any plumbing except git-update-index, which is very inneficient for
smudged files.)
-* Crippled filesystem should cause all files to be transparently unlocked.
- Note that this presents problems when dealing with merge conflicts and
- when pushing changes committed in such a repo. Ideally, should avoid
- committing implicit unlocks, or should prevent such commits leaking out
- in pushes. See [[design/adjusted_branches]].
-
* Eventually (but not yet), make v6 the default for new repositories.
Note that the assistant forces repos into direct mode; that will need to
be changed then, and it should enable annex.thin instead.