Merge branch 'adjustedbranch'
This commit is contained in:
commit
ed3e8e1886
32 changed files with 1084 additions and 262 deletions
2
Annex.hs
2
Annex.hs
|
@ -136,6 +136,7 @@ data AnnexState = AnnexState
|
||||||
, workers :: [Either AnnexState (Async AnnexState)]
|
, workers :: [Either AnnexState (Async AnnexState)]
|
||||||
, concurrentjobs :: Maybe Int
|
, concurrentjobs :: Maybe Int
|
||||||
, keysdbhandle :: Maybe Keys.DbHandle
|
, keysdbhandle :: Maybe Keys.DbHandle
|
||||||
|
, cachedcurrentbranch :: Maybe Git.Branch
|
||||||
}
|
}
|
||||||
|
|
||||||
newState :: GitConfig -> Git.Repo -> AnnexState
|
newState :: GitConfig -> Git.Repo -> AnnexState
|
||||||
|
@ -182,6 +183,7 @@ newState c r = AnnexState
|
||||||
, workers = []
|
, workers = []
|
||||||
, concurrentjobs = Nothing
|
, concurrentjobs = Nothing
|
||||||
, keysdbhandle = Nothing
|
, keysdbhandle = Nothing
|
||||||
|
, cachedcurrentbranch = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
{- Makes an Annex state object for the specified git repo.
|
{- Makes an Annex state object for the specified git repo.
|
||||||
|
|
419
Annex/AdjustedBranch.hs
Normal file
419
Annex/AdjustedBranch.hs
Normal file
|
@ -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)
|
|
@ -225,7 +225,7 @@ mergeDirectCommit allowff old branch commitmode = do
|
||||||
let merge_msg = d </> "MERGE_MSG"
|
let merge_msg = d </> "MERGE_MSG"
|
||||||
let merge_mode = d </> "MERGE_MODE"
|
let merge_mode = d </> "MERGE_MODE"
|
||||||
ifM (pure allowff <&&> canff)
|
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
|
, do
|
||||||
msg <- liftIO $
|
msg <- liftIO $
|
||||||
catchDefaultIO ("merge " ++ fromRef branch) $
|
catchDefaultIO ("merge " ++ fromRef branch) $
|
||||||
|
@ -462,7 +462,7 @@ switchHEAD = maybe noop switch =<< inRepo Git.Branch.currentUnsafe
|
||||||
where
|
where
|
||||||
switch orighead = do
|
switch orighead = do
|
||||||
let newhead = directBranch orighead
|
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.Ref.sha orighead)
|
||||||
inRepo $ Git.Branch.checkout newhead
|
inRepo $ Git.Branch.checkout newhead
|
||||||
|
|
||||||
|
@ -475,7 +475,7 @@ switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe
|
||||||
case v of
|
case v of
|
||||||
Just headsha
|
Just headsha
|
||||||
| orighead /= currhead -> do
|
| 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.checkout orighead
|
||||||
inRepo $ Git.Branch.delete currhead
|
inRepo $ Git.Branch.delete currhead
|
||||||
_ -> inRepo $ Git.Branch.checkout orighead
|
_ -> inRepo $ Git.Branch.checkout orighead
|
||||||
|
|
|
@ -35,6 +35,8 @@ import Logs.Location
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Annex.Queue
|
import qualified Annex.Queue
|
||||||
import qualified Database.Keys
|
import qualified Database.Keys
|
||||||
|
import qualified Git
|
||||||
|
import qualified Git.Branch
|
||||||
import Config
|
import Config
|
||||||
import Utility.InodeCache
|
import Utility.InodeCache
|
||||||
import Annex.ReplaceFile
|
import Annex.ReplaceFile
|
||||||
|
@ -43,6 +45,7 @@ import Utility.CopyFile
|
||||||
import Utility.Touch
|
import Utility.Touch
|
||||||
import Git.FilePath
|
import Git.FilePath
|
||||||
import Annex.InodeSentinal
|
import Annex.InodeSentinal
|
||||||
|
import Annex.AdjustedBranch
|
||||||
|
|
||||||
import Control.Exception (IOException)
|
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,
|
{- 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 :: Annex Bool
|
||||||
addUnlocked = isDirect <||>
|
addUnlocked = isDirect <||>
|
||||||
(versionSupportsUnlockedPointers <&&>
|
(versionSupportsUnlockedPointers <&&>
|
||||||
((not . coreSymlinks <$> Annex.getGitConfig) <||>
|
((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.
|
{- 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
|
- The content of the key may be provided in a temp file, which will be
|
||||||
- moved into place. -}
|
- moved into place. -}
|
||||||
|
|
|
@ -33,6 +33,7 @@ import Annex.UUID
|
||||||
import Annex.Link
|
import Annex.Link
|
||||||
import Config
|
import Config
|
||||||
import Annex.Direct
|
import Annex.Direct
|
||||||
|
import Annex.AdjustedBranch
|
||||||
import Annex.Environment
|
import Annex.Environment
|
||||||
import Annex.Hook
|
import Annex.Hook
|
||||||
import Annex.InodeSentinal
|
import Annex.InodeSentinal
|
||||||
|
@ -92,10 +93,13 @@ initialize' mversion = do
|
||||||
whenM versionSupportsUnlockedPointers $ do
|
whenM versionSupportsUnlockedPointers $ do
|
||||||
configureSmudgeFilter
|
configureSmudgeFilter
|
||||||
Database.Keys.scanAssociatedFiles
|
Database.Keys.scanAssociatedFiles
|
||||||
ifM (crippledFileSystem <&&> (not <$> isBare) <&&> (not <$> versionSupportsUnlockedPointers))
|
ifM (crippledFileSystem <&&> (not <$> isBare))
|
||||||
( do
|
( ifM versionSupportsUnlockedPointers
|
||||||
enableDirectMode
|
( adjustToCrippledFileSystem
|
||||||
setDirect True
|
, do
|
||||||
|
enableDirectMode
|
||||||
|
setDirect True
|
||||||
|
)
|
||||||
-- Handle case where this repo was cloned from a
|
-- Handle case where this repo was cloned from a
|
||||||
-- direct mode repo
|
-- direct mode repo
|
||||||
, unlessM isBare
|
, unlessM isBare
|
||||||
|
|
|
@ -52,6 +52,9 @@ versionSupportsUnlockedPointers = go <$> getVersion
|
||||||
go (Just "6") = True
|
go (Just "6") = True
|
||||||
go _ = False
|
go _ = False
|
||||||
|
|
||||||
|
versionSupportsAdjustedBranch :: Annex Bool
|
||||||
|
versionSupportsAdjustedBranch = versionSupportsUnlockedPointers
|
||||||
|
|
||||||
setVersion :: Version -> Annex ()
|
setVersion :: Version -> Annex ()
|
||||||
setVersion = setConfig versionField
|
setVersion = setConfig versionField
|
||||||
|
|
||||||
|
|
|
@ -19,7 +19,6 @@ import Assistant.RemoteControl
|
||||||
import qualified Command.Sync
|
import qualified Command.Sync
|
||||||
import Utility.Parallel
|
import Utility.Parallel
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.Branch
|
|
||||||
import qualified Git.Command
|
import qualified Git.Command
|
||||||
import qualified Git.Ref
|
import qualified Git.Ref
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
|
@ -79,16 +78,16 @@ reconnectRemotes notifypushes rs = void $ do
|
||||||
| Git.repoIsLocal r = True
|
| Git.repoIsLocal r = True
|
||||||
| Git.repoIsLocalUnknown r = True
|
| Git.repoIsLocalUnknown r = True
|
||||||
| otherwise = False
|
| otherwise = False
|
||||||
sync (Just branch) = do
|
sync currentbranch@(Just _, _) = do
|
||||||
(failedpull, diverged) <- manualPull (Just branch) gitremotes
|
(failedpull, diverged) <- manualPull currentbranch gitremotes
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
failedpush <- pushToRemotes' now notifypushes gitremotes
|
failedpush <- pushToRemotes' now notifypushes gitremotes
|
||||||
return (nub $ failedpull ++ failedpush, diverged)
|
return (nub $ failedpull ++ failedpush, diverged)
|
||||||
{- No local branch exists yet, but we can try pulling. -}
|
{- No local branch exists yet, but we can try pulling. -}
|
||||||
sync Nothing = manualPull Nothing gitremotes
|
sync (Nothing, _) = manualPull (Nothing, Nothing) gitremotes
|
||||||
go = do
|
go = do
|
||||||
(failed, diverged) <- sync
|
(failed, diverged) <- sync
|
||||||
=<< liftAnnex (inRepo Git.Branch.current)
|
=<< liftAnnex (join Command.Sync.getCurrBranch)
|
||||||
addScanRemotes diverged $
|
addScanRemotes diverged $
|
||||||
filter (not . remoteAnnexIgnore . Remote.gitconfig)
|
filter (not . remoteAnnexIgnore . Remote.gitconfig)
|
||||||
nonxmppremotes
|
nonxmppremotes
|
||||||
|
@ -133,7 +132,7 @@ pushToRemotes' now notifypushes remotes = do
|
||||||
Annex.Branch.commit "update"
|
Annex.Branch.commit "update"
|
||||||
(,,)
|
(,,)
|
||||||
<$> gitRepo
|
<$> gitRepo
|
||||||
<*> inRepo Git.Branch.current
|
<*> join Command.Sync.getCurrBranch
|
||||||
<*> getUUID
|
<*> getUUID
|
||||||
let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
|
let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
|
||||||
ret <- go True branch g u normalremotes
|
ret <- go True branch g u normalremotes
|
||||||
|
@ -145,9 +144,9 @@ pushToRemotes' now notifypushes remotes = do
|
||||||
Pushing (getXMPPClientID r) (CanPush u shas)
|
Pushing (getXMPPClientID r) (CanPush u shas)
|
||||||
return ret
|
return ret
|
||||||
where
|
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 _ _ _ _ [] = 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]
|
debug ["pushing to", show rs]
|
||||||
(succeeded, failed) <- parallelPush g rs (push branch)
|
(succeeded, failed) <- parallelPush g rs (push branch)
|
||||||
updatemap succeeded []
|
updatemap succeeded []
|
||||||
|
@ -158,7 +157,7 @@ pushToRemotes' now notifypushes remotes = do
|
||||||
map Remote.uuid succeeded
|
map Remote.uuid succeeded
|
||||||
return failed
|
return failed
|
||||||
else if shouldretry
|
else if shouldretry
|
||||||
then retry branch g u failed
|
then retry currbranch g u failed
|
||||||
else fallback branch g u failed
|
else fallback branch g u failed
|
||||||
|
|
||||||
updatemap succeeded failed = changeFailedPushMap $ \m ->
|
updatemap succeeded failed = changeFailedPushMap $ \m ->
|
||||||
|
@ -166,10 +165,10 @@ pushToRemotes' now notifypushes remotes = do
|
||||||
M.difference m (makemap succeeded)
|
M.difference m (makemap succeeded)
|
||||||
makemap l = M.fromList $ zip l (repeat now)
|
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"]
|
debug ["trying manual pull to resolve failed pushes"]
|
||||||
void $ manualPull (Just branch) rs
|
void $ manualPull currbranch rs
|
||||||
go False (Just branch) g u rs
|
go False currbranch g u rs
|
||||||
|
|
||||||
fallback branch g u rs = do
|
fallback branch g u rs = do
|
||||||
debug ["fallback pushing to", show rs]
|
debug ["fallback pushing to", show rs]
|
||||||
|
@ -227,7 +226,7 @@ syncAction rs a
|
||||||
- XMPP remotes. However, those pushes will run asynchronously, so their
|
- XMPP remotes. However, those pushes will run asynchronously, so their
|
||||||
- results are not included in the return data.
|
- 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
|
manualPull currentbranch remotes = do
|
||||||
g <- liftAnnex gitRepo
|
g <- liftAnnex gitRepo
|
||||||
let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
|
let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
|
||||||
|
|
|
@ -227,7 +227,7 @@ commitStaged msg = do
|
||||||
Right _ -> do
|
Right _ -> do
|
||||||
ok <- Command.Sync.commitStaged Git.Branch.AutomaticCommit msg
|
ok <- Command.Sync.commitStaged Git.Branch.AutomaticCommit msg
|
||||||
when ok $
|
when ok $
|
||||||
Command.Sync.updateSyncBranch =<< inRepo Git.Branch.current
|
Command.Sync.updateSyncBranch =<< join Command.Sync.getCurrBranch
|
||||||
return ok
|
return ok
|
||||||
|
|
||||||
{- OSX needs a short delay after a file is added before locking it down,
|
{- OSX needs a short delay after a file is added before locking it down,
|
||||||
|
|
|
@ -17,7 +17,7 @@ import Utility.DirWatcher.Types
|
||||||
import qualified Annex.Branch
|
import qualified Annex.Branch
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.Branch
|
import qualified Git.Branch
|
||||||
import Annex.AutoMerge
|
import qualified Command.Sync
|
||||||
import Annex.TaggedPush
|
import Annex.TaggedPush
|
||||||
import Remote (remoteFromUUID)
|
import Remote (remoteFromUUID)
|
||||||
|
|
||||||
|
@ -72,19 +72,21 @@ onChange file
|
||||||
unlessM handleDesynced $
|
unlessM handleDesynced $
|
||||||
queueDeferredDownloads "retrying deferred download" Later
|
queueDeferredDownloads "retrying deferred download" Later
|
||||||
| "/synced/" `isInfixOf` file =
|
| "/synced/" `isInfixOf` file =
|
||||||
mergecurrent =<< liftAnnex (inRepo Git.Branch.current)
|
mergecurrent =<< liftAnnex (join Command.Sync.getCurrBranch)
|
||||||
| otherwise = noop
|
| otherwise = noop
|
||||||
where
|
where
|
||||||
changedbranch = fileToBranch file
|
changedbranch = fileToBranch file
|
||||||
|
|
||||||
mergecurrent (Just current)
|
mergecurrent currbranch@(Just b, _)
|
||||||
| equivBranches changedbranch current =
|
| equivBranches changedbranch b =
|
||||||
whenM (liftAnnex $ inRepo $ Git.Branch.changed current changedbranch) $ do
|
whenM (liftAnnex $ inRepo $ Git.Branch.changed b changedbranch) $ do
|
||||||
debug
|
debug
|
||||||
[ "merging", Git.fromRef changedbranch
|
[ "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
|
mergecurrent _ = noop
|
||||||
|
|
||||||
handleDesynced = case fromTaggedBranch changedbranch of
|
handleDesynced = case fromTaggedBranch changedbranch of
|
||||||
|
|
|
@ -25,6 +25,7 @@ import Assistant.Pairing
|
||||||
import Assistant.XMPP.Git
|
import Assistant.XMPP.Git
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import Logs.UUID
|
import Logs.UUID
|
||||||
|
import qualified Command.Sync
|
||||||
|
|
||||||
import Network.Protocol.XMPP
|
import Network.Protocol.XMPP
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
|
@ -33,7 +34,6 @@ import Control.Concurrent.STM (atomically)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Git.Branch
|
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
|
|
||||||
|
@ -306,7 +306,7 @@ pull [] = noop
|
||||||
pull us = do
|
pull us = do
|
||||||
rs <- filter matching . syncGitRemotes <$> getDaemonStatus
|
rs <- filter matching . syncGitRemotes <$> getDaemonStatus
|
||||||
debug $ "push notification for" : map (fromUUID . Remote.uuid ) rs
|
debug $ "push notification for" : map (fromUUID . Remote.uuid ) rs
|
||||||
pullone rs =<< liftAnnex (inRepo Git.Branch.current)
|
pullone rs =<< liftAnnex (join Command.Sync.getCurrBranch)
|
||||||
where
|
where
|
||||||
matching r = Remote.uuid r `S.member` s
|
matching r = Remote.uuid r `S.member` s
|
||||||
s = S.fromList us
|
s = S.fromList us
|
||||||
|
|
|
@ -20,7 +20,7 @@ import qualified Annex
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.Config
|
import qualified Git.Config
|
||||||
import qualified Git.Command
|
import qualified Git.Command
|
||||||
import qualified Git.Branch
|
import qualified Command.Sync
|
||||||
import Config.Files
|
import Config.Files
|
||||||
import Utility.FreeDesktop
|
import Utility.FreeDesktop
|
||||||
import Utility.DiskFree
|
import Utility.DiskFree
|
||||||
|
@ -200,7 +200,7 @@ postNewRepositoryR = page "Add another repository" (Just Configuration) $ do
|
||||||
- immediately pulling from it. Also spawns a sync to push to it as well. -}
|
- immediately pulling from it. Also spawns a sync to push to it as well. -}
|
||||||
immediateSyncRemote :: Remote -> Assistant ()
|
immediateSyncRemote :: Remote -> Assistant ()
|
||||||
immediateSyncRemote r = do
|
immediateSyncRemote r = do
|
||||||
currentbranch <- liftAnnex (inRepo Git.Branch.current)
|
currentbranch <- liftAnnex $ join Command.Sync.getCurrBranch
|
||||||
void $ manualPull currentbranch [r]
|
void $ manualPull currentbranch [r]
|
||||||
syncRemote r
|
syncRemote r
|
||||||
|
|
||||||
|
|
|
@ -27,7 +27,6 @@ import Annex.TaggedPush
|
||||||
import Annex.CatFile
|
import Annex.CatFile
|
||||||
import Config
|
import Config
|
||||||
import Git
|
import Git
|
||||||
import qualified Git.Branch
|
|
||||||
import qualified Types.Remote as Remote
|
import qualified Types.Remote as Remote
|
||||||
import qualified Remote as Remote
|
import qualified Remote as Remote
|
||||||
import Remote.List
|
import Remote.List
|
||||||
|
@ -292,16 +291,15 @@ xmppRemotes cid theiruuid = case baseJID <$> parseJID cid of
|
||||||
{- Returns the ClientID that it pushed to. -}
|
{- Returns the ClientID that it pushed to. -}
|
||||||
runPush :: (Remote -> Assistant ()) -> NetMessage -> Assistant (Maybe ClientID)
|
runPush :: (Remote -> Assistant ()) -> NetMessage -> Assistant (Maybe ClientID)
|
||||||
runPush checkcloudrepos (Pushing cid (PushRequest theiruuid)) =
|
runPush checkcloudrepos (Pushing cid (PushRequest theiruuid)) =
|
||||||
go =<< liftAnnex (inRepo Git.Branch.current)
|
go =<< liftAnnex (join Command.Sync.getCurrBranch)
|
||||||
where
|
where
|
||||||
go Nothing = return Nothing
|
go (Just branch, _) = do
|
||||||
go (Just branch) = do
|
|
||||||
rs <- xmppRemotes cid theiruuid
|
rs <- xmppRemotes cid theiruuid
|
||||||
liftAnnex $ Annex.Branch.commit "update"
|
liftAnnex $ Annex.Branch.commit "update"
|
||||||
(g, u) <- liftAnnex $ (,)
|
(g, u) <- liftAnnex $ (,)
|
||||||
<$> gitRepo
|
<$> gitRepo
|
||||||
<*> getUUID
|
<*> 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
|
selfjid <- ((T.unpack <$>) . xmppClientID) <$> getDaemonStatus
|
||||||
if null rs
|
if null rs
|
||||||
then return Nothing
|
then return Nothing
|
||||||
|
@ -311,6 +309,7 @@ runPush checkcloudrepos (Pushing cid (PushRequest theiruuid)) =
|
||||||
xmppPush cid (taggedPush u selfjid branch r)
|
xmppPush cid (taggedPush u selfjid branch r)
|
||||||
checkcloudrepos r
|
checkcloudrepos r
|
||||||
return $ Just cid
|
return $ Just cid
|
||||||
|
go _ = return Nothing
|
||||||
runPush checkcloudrepos (Pushing cid (StartingPush theiruuid)) = do
|
runPush checkcloudrepos (Pushing cid (StartingPush theiruuid)) = do
|
||||||
rs <- xmppRemotes cid theiruuid
|
rs <- xmppRemotes cid theiruuid
|
||||||
if null rs
|
if null rs
|
||||||
|
|
|
@ -38,6 +38,7 @@ import qualified Command.SetPresentKey
|
||||||
import qualified Command.ReadPresentKey
|
import qualified Command.ReadPresentKey
|
||||||
import qualified Command.CheckPresentKey
|
import qualified Command.CheckPresentKey
|
||||||
import qualified Command.ReKey
|
import qualified Command.ReKey
|
||||||
|
import qualified Command.Adjust
|
||||||
import qualified Command.MetaData
|
import qualified Command.MetaData
|
||||||
import qualified Command.View
|
import qualified Command.View
|
||||||
import qualified Command.VAdd
|
import qualified Command.VAdd
|
||||||
|
@ -174,6 +175,7 @@ cmds testoptparser testrunner =
|
||||||
, Command.ReadPresentKey.cmd
|
, Command.ReadPresentKey.cmd
|
||||||
, Command.CheckPresentKey.cmd
|
, Command.CheckPresentKey.cmd
|
||||||
, Command.ReKey.cmd
|
, Command.ReKey.cmd
|
||||||
|
, Command.Adjust.cmd
|
||||||
, Command.MetaData.cmd
|
, Command.MetaData.cmd
|
||||||
, Command.View.cmd
|
, Command.View.cmd
|
||||||
, Command.VAdd.cmd
|
, Command.VAdd.cmd
|
||||||
|
|
41
Command/Adjust.hs
Normal file
41
Command/Adjust.hs
Normal file
|
@ -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
|
|
@ -9,8 +9,7 @@ module Command.Merge where
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex.Branch
|
import qualified Annex.Branch
|
||||||
import qualified Git.Branch
|
import Command.Sync (prepMerge, mergeLocal, getCurrBranch)
|
||||||
import Command.Sync (prepMerge, mergeLocal)
|
|
||||||
|
|
||||||
cmd :: Command
|
cmd :: Command
|
||||||
cmd = command "merge" SectionMaintenance
|
cmd = command "merge" SectionMaintenance
|
||||||
|
@ -34,4 +33,4 @@ mergeBranch = do
|
||||||
mergeSynced :: CommandStart
|
mergeSynced :: CommandStart
|
||||||
mergeSynced = do
|
mergeSynced = do
|
||||||
prepMerge
|
prepMerge
|
||||||
mergeLocal =<< inRepo Git.Branch.current
|
mergeLocal =<< join getCurrBranch
|
||||||
|
|
129
Command/Sync.hs
129
Command/Sync.hs
|
@ -1,13 +1,16 @@
|
||||||
{- git-annex command
|
{- git-annex command
|
||||||
-
|
-
|
||||||
- Copyright 2011 Joachim Breitner <mail@joachim-breitner.de>
|
- 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.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Command.Sync (
|
module Command.Sync (
|
||||||
cmd,
|
cmd,
|
||||||
|
CurrBranch,
|
||||||
|
getCurrBranch,
|
||||||
|
merge,
|
||||||
prepMerge,
|
prepMerge,
|
||||||
mergeLocal,
|
mergeLocal,
|
||||||
mergeRemote,
|
mergeRemote,
|
||||||
|
@ -43,6 +46,7 @@ import Annex.Drop
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import Logs.UUID
|
import Logs.UUID
|
||||||
import Annex.AutoMerge
|
import Annex.AutoMerge
|
||||||
|
import Annex.AdjustedBranch
|
||||||
import Annex.Ssh
|
import Annex.Ssh
|
||||||
import Annex.BloomFilter
|
import Annex.BloomFilter
|
||||||
import Utility.Bloom
|
import Utility.Bloom
|
||||||
|
@ -95,20 +99,7 @@ seek :: SyncOptions -> CommandSeek
|
||||||
seek o = allowConcurrentOutput $ do
|
seek o = allowConcurrentOutput $ do
|
||||||
prepMerge
|
prepMerge
|
||||||
|
|
||||||
-- There may not be a branch checked out until after the commit,
|
getbranch <- getCurrBranch
|
||||||
-- 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
|
|
||||||
)
|
|
||||||
let withbranch a = a =<< getbranch
|
let withbranch a = a =<< getbranch
|
||||||
|
|
||||||
remotes <- syncRemotes (syncWith o)
|
remotes <- syncRemotes (syncWith o)
|
||||||
|
@ -140,14 +131,49 @@ seek o = allowConcurrentOutput $ do
|
||||||
-- Pushes to remotes can run concurrently.
|
-- Pushes to remotes can run concurrently.
|
||||||
mapM_ (commandAction . withbranch . pushRemote o) gitremotes
|
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
|
{- 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
|
- of the repo. This also means that sync always acts on all files in the
|
||||||
- repository, not just on a subdirectory. -}
|
- repository, not just on a subdirectory. -}
|
||||||
prepMerge :: Annex ()
|
prepMerge :: Annex ()
|
||||||
prepMerge = Annex.changeDirectory =<< fromRepo Git.repoPath
|
prepMerge = Annex.changeDirectory =<< fromRepo Git.repoPath
|
||||||
|
|
||||||
syncBranch :: Git.Ref -> Git.Ref
|
merge :: CurrBranch -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool
|
||||||
syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch
|
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 -> Git.Ref
|
||||||
remoteBranch remote = Git.Ref.underBase $ "refs/remotes/" ++ Remote.name remote
|
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
|
void $ inRepo $ Git.Branch.commit commitmode False commitmessage branch parents
|
||||||
return True
|
return True
|
||||||
|
|
||||||
mergeLocal :: Maybe Git.Ref -> CommandStart
|
mergeLocal :: CurrBranch -> CommandStart
|
||||||
mergeLocal Nothing = stop
|
mergeLocal currbranch@(Just branch, madj) = go =<< needmerge
|
||||||
mergeLocal (Just branch) = go =<< needmerge
|
|
||||||
where
|
where
|
||||||
syncbranch = syncBranch branch
|
syncbranch = syncBranch branch
|
||||||
needmerge = ifM isBareRepo
|
needmerge = ifM isBareRepo
|
||||||
( return False
|
( return False
|
||||||
, ifM (inRepo $ Git.Ref.exists syncbranch)
|
, ifM (inRepo $ Git.Ref.exists syncbranch)
|
||||||
( inRepo $ Git.Branch.changed branch syncbranch
|
( inRepo $ Git.Branch.changed branch' syncbranch
|
||||||
, return False
|
, return False
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
go False = stop
|
go False = stop
|
||||||
go True = do
|
go True = do
|
||||||
showStart "merge" $ Git.Ref.describe syncbranch
|
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
|
pushLocal b = do
|
||||||
updateSyncBranch b
|
updateSyncBranch b
|
||||||
stop
|
stop
|
||||||
|
|
||||||
updateSyncBranch :: Maybe Git.Ref -> Annex ()
|
updateSyncBranch :: CurrBranch -> Annex ()
|
||||||
updateSyncBranch Nothing = noop
|
updateSyncBranch (Nothing, _) = noop
|
||||||
updateSyncBranch (Just branch) = do
|
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
|
-- 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
|
-- 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.
|
-- branch.
|
||||||
whenM isDirect $
|
whenM isDirect $
|
||||||
inRepo $ updateBranch $ fromDirectBranch branch
|
inRepo $ updateBranch (fromDirectBranch branch) branch
|
||||||
|
|
||||||
updateBranch :: Git.Ref -> Git.Repo -> IO ()
|
updateBranch :: Git.Branch -> Git.Branch -> Git.Repo -> IO ()
|
||||||
updateBranch syncbranch g =
|
updateBranch syncbranch updateto g =
|
||||||
unlessM go $ error $ "failed to update " ++ Git.fromRef syncbranch
|
unlessM go $ error $ "failed to update " ++ Git.fromRef syncbranch
|
||||||
where
|
where
|
||||||
go = Git.Command.runBool
|
go = Git.Command.runBool
|
||||||
[ Param "branch"
|
[ Param "branch"
|
||||||
, Param "-f"
|
, Param "-f"
|
||||||
, Param $ Git.fromRef $ Git.Ref.base syncbranch
|
, Param $ Git.fromRef $ Git.Ref.base syncbranch
|
||||||
|
, Param $ Git.fromRef $ updateto
|
||||||
] g
|
] g
|
||||||
|
|
||||||
pullRemote :: SyncOptions -> Remote -> Maybe Git.Ref -> CommandStart
|
pullRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart
|
||||||
pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do
|
pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do
|
||||||
showStart "pull" (Remote.name remote)
|
showStart "pull" (Remote.name remote)
|
||||||
next $ do
|
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),
|
- were committed (or pushed changes, if this is a bare remote),
|
||||||
- while the synced/master may have changes that some
|
- while the synced/master may have changes that some
|
||||||
- other remote synced to this remote. So, merge them both. -}
|
- other remote synced to this remote. So, merge them both. -}
|
||||||
mergeRemote :: Remote -> Maybe Git.Ref -> CommandCleanup
|
mergeRemote :: Remote -> CurrBranch -> CommandCleanup
|
||||||
mergeRemote remote b = ifM isBareRepo
|
mergeRemote remote currbranch = ifM isBareRepo
|
||||||
( return True
|
( return True
|
||||||
, case b of
|
, case currbranch of
|
||||||
Nothing -> do
|
(Nothing, _) -> do
|
||||||
branch <- inRepo Git.Branch.currentUnsafe
|
branch <- inRepo Git.Branch.currentUnsafe
|
||||||
and <$> mapM (merge Nothing) (branchlist branch)
|
mergelisted (pure (branchlist branch))
|
||||||
Just thisbranch -> do
|
(Just branch, _) -> do
|
||||||
inRepo $ updateBranch $ syncBranch thisbranch
|
inRepo $ updateBranch (syncBranch branch) branch
|
||||||
and <$> (mapM (merge (Just thisbranch)) =<< tomerge (branchlist b))
|
mergelisted (tomerge (branchlist (Just branch)))
|
||||||
)
|
)
|
||||||
where
|
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)
|
tomerge = filterM (changed remote)
|
||||||
branchlist Nothing = []
|
branchlist Nothing = []
|
||||||
branchlist (Just branch) = [branch, syncBranch branch]
|
branchlist (Just branch) = [branch, syncBranch branch]
|
||||||
|
|
||||||
pushRemote :: SyncOptions -> Remote -> Maybe Git.Ref -> CommandStart
|
pushRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart
|
||||||
pushRemote _o _remote Nothing = stop
|
pushRemote _o _remote (Nothing, _) = stop
|
||||||
pushRemote o remote (Just branch) = stopUnless (pure (pushOption o) <&&> needpush) $ do
|
pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> needpush) $ do
|
||||||
showStart "push" (Remote.name remote)
|
showStart "push" (Remote.name remote)
|
||||||
next $ next $ do
|
next $ next $ do
|
||||||
showOutput
|
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
|
- The sync push will fail to overwrite if receive.denyNonFastforwards is
|
||||||
- set on the remote.
|
- 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
|
pushBranch remote branch g = tryIO (directpush g) `after` syncpush g
|
||||||
where
|
where
|
||||||
syncpush = Git.Command.runBool $ pushparams
|
syncpush = Git.Command.runBool $ pushparams
|
||||||
[ Git.Branch.forcePush $ refspec Annex.Branch.name
|
[ Git.Branch.forcePush $ refspec Annex.Branch.name
|
||||||
, refspec branch
|
, refspec $ fromAdjustedBranch branch
|
||||||
]
|
]
|
||||||
directpush = Git.Command.runQuiet $ pushparams
|
directpush = Git.Command.runQuiet $ pushparams
|
||||||
[ Git.fromRef $ Git.Ref.base $ Annex.Branch.name
|
[ 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 =
|
pushparams branches =
|
||||||
[ Param "push"
|
[ Param "push"
|
||||||
|
|
|
@ -9,6 +9,8 @@ module Command.Upgrade where
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import Upgrade
|
import Upgrade
|
||||||
|
import Annex.Version
|
||||||
|
import Annex.Init
|
||||||
|
|
||||||
cmd :: Command
|
cmd :: Command
|
||||||
cmd = dontCheck repoExists $ -- because an old version may not seem to exist
|
cmd = dontCheck repoExists $ -- because an old version may not seem to exist
|
||||||
|
@ -22,5 +24,7 @@ seek = withNothing start
|
||||||
start :: CommandStart
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
showStart "upgrade" "."
|
showStart "upgrade" "."
|
||||||
|
whenM (isNothing <$> getVersion) $ do
|
||||||
|
initialize Nothing Nothing
|
||||||
r <- upgrade False
|
r <- upgrade False
|
||||||
next $ next $ return r
|
next $ next $ return r
|
||||||
|
|
|
@ -48,14 +48,24 @@ currentUnsafe r = parse . firstLine
|
||||||
changed :: Branch -> Branch -> Repo -> IO Bool
|
changed :: Branch -> Branch -> Repo -> IO Bool
|
||||||
changed origbranch newbranch repo
|
changed origbranch newbranch repo
|
||||||
| origbranch == newbranch = return False
|
| origbranch == newbranch = return False
|
||||||
| otherwise = not . null <$> diffs
|
| otherwise = not . null
|
||||||
|
<$> changed' origbranch newbranch [Param "-n1"] repo
|
||||||
where
|
where
|
||||||
diffs = pipeReadStrict
|
|
||||||
|
changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO String
|
||||||
|
changed' origbranch newbranch extraps repo = pipeReadStrict ps repo
|
||||||
|
where
|
||||||
|
ps =
|
||||||
[ Param "log"
|
[ Param "log"
|
||||||
, Param (fromRef origbranch ++ ".." ++ fromRef newbranch)
|
, Param (fromRef origbranch ++ ".." ++ fromRef newbranch)
|
||||||
, Param "-n1"
|
|
||||||
, Param "--pretty=%H"
|
, 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
|
{- Check if it's possible to fast-forward from the old
|
||||||
- ref to the new ref.
|
- ref to the new ref.
|
||||||
|
@ -90,7 +100,7 @@ fastForward branch (first:rest) repo =
|
||||||
where
|
where
|
||||||
no_ff = return False
|
no_ff = return False
|
||||||
do_ff to = do
|
do_ff to = do
|
||||||
update branch to repo
|
update' branch to repo
|
||||||
return True
|
return True
|
||||||
findbest c [] = return $ Just c
|
findbest c [] = return $ Just c
|
||||||
findbest c (r:rs)
|
findbest c (r:rs)
|
||||||
|
@ -145,7 +155,7 @@ commit commitmode allowempty message branch parentrefs repo = do
|
||||||
ifM (cancommit tree)
|
ifM (cancommit tree)
|
||||||
( do
|
( do
|
||||||
sha <- commitTree commitmode message parentrefs tree repo
|
sha <- commitTree commitmode message parentrefs tree repo
|
||||||
update branch sha repo
|
update' branch sha repo
|
||||||
return $ Just sha
|
return $ Just sha
|
||||||
, return Nothing
|
, return Nothing
|
||||||
)
|
)
|
||||||
|
@ -175,8 +185,17 @@ forcePush :: String -> String
|
||||||
forcePush b = "+" ++ b
|
forcePush b = "+" ++ b
|
||||||
|
|
||||||
{- Updates a branch (or other ref) to a new Sha. -}
|
{- Updates a branch (or other ref) to a new Sha. -}
|
||||||
update :: Branch -> Sha -> Repo -> IO ()
|
update :: String -> Branch -> Sha -> Repo -> IO ()
|
||||||
update branch sha = run
|
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 "update-ref"
|
||||||
, Param $ fromRef branch
|
, Param $ fromRef branch
|
||||||
, Param $ fromRef sha
|
, Param $ fromRef sha
|
||||||
|
|
|
@ -125,15 +125,17 @@ catCommit h commitref = go <$> catObjectDetails h commitref
|
||||||
parseCommit :: L.ByteString -> Maybe Commit
|
parseCommit :: L.ByteString -> Maybe Commit
|
||||||
parseCommit b = Commit
|
parseCommit b = Commit
|
||||||
<$> (extractSha . L8.unpack =<< field "tree")
|
<$> (extractSha . L8.unpack =<< field "tree")
|
||||||
|
<*> Just (maybe [] (mapMaybe (extractSha . L8.unpack)) (fields "parent"))
|
||||||
<*> (parsemetadata <$> field "author")
|
<*> (parsemetadata <$> field "author")
|
||||||
<*> (parsemetadata <$> field "committer")
|
<*> (parsemetadata <$> field "committer")
|
||||||
<*> Just (L8.unpack $ L.intercalate (L.singleton nl) message)
|
<*> Just (L8.unpack $ L.intercalate (L.singleton nl) message)
|
||||||
where
|
where
|
||||||
field n = M.lookup (fromString n) fields
|
field n = headMaybe =<< fields n
|
||||||
fields = M.fromList ((map breakfield) header)
|
fields n = M.lookup (fromString n) fieldmap
|
||||||
|
fieldmap = M.fromListWith (++) ((map breakfield) header)
|
||||||
breakfield l =
|
breakfield l =
|
||||||
let (k, sp_v) = L.break (== sp) 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
|
(header, message) = separate L.null ls
|
||||||
ls = L.split nl b
|
ls = L.split nl b
|
||||||
|
|
||||||
|
|
|
@ -14,6 +14,7 @@ module Git.DiffTree (
|
||||||
diffWorkTree,
|
diffWorkTree,
|
||||||
diffFiles,
|
diffFiles,
|
||||||
diffLog,
|
diffLog,
|
||||||
|
commitDiff,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Numeric
|
import Numeric
|
||||||
|
@ -72,16 +73,23 @@ diffFiles :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
|
||||||
diffFiles = getdiff (Param "diff-files")
|
diffFiles = getdiff (Param "diff-files")
|
||||||
|
|
||||||
{- Runs git log in --raw mode to get the changes that were made in
|
{- 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
|
- a particular commit to particular files. The output format
|
||||||
- as diff-tree --raw._-}
|
- is adjusted to be the same as diff-tree --raw._-}
|
||||||
diffLog :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
|
diffLog :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
|
||||||
diffLog params = getdiff (Param "log")
|
diffLog params = getdiff (Param "log")
|
||||||
(Param "-n1" : Param "--abbrev=40" : Param "--pretty=format:" : params)
|
(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 :: CommandParam -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
|
||||||
getdiff command params repo = do
|
getdiff command params repo = do
|
||||||
(diff, cleanup) <- pipeNullSplit ps repo
|
(diff, cleanup) <- pipeNullSplit ps repo
|
||||||
return (parseDiffRaw diff, cleanup)
|
return (fromMaybe (error $ "git " ++ show (toCommand ps) ++ " parse failed") (parseDiffRaw diff), cleanup)
|
||||||
where
|
where
|
||||||
ps =
|
ps =
|
||||||
command :
|
command :
|
||||||
|
@ -92,23 +100,24 @@ getdiff command params repo = do
|
||||||
params
|
params
|
||||||
|
|
||||||
{- Parses --raw output used by diff-tree and git-log. -}
|
{- Parses --raw output used by diff-tree and git-log. -}
|
||||||
parseDiffRaw :: [String] -> [DiffTreeItem]
|
parseDiffRaw :: [String] -> Maybe [DiffTreeItem]
|
||||||
parseDiffRaw l = go l []
|
parseDiffRaw l = go l []
|
||||||
where
|
where
|
||||||
go [] c = c
|
go [] c = Just c
|
||||||
go (info:f:rest) c = go rest (mk info f : c)
|
go (info:f:rest) c = case mk info f of
|
||||||
go (s:[]) _ = error $ "diff-tree parse error " ++ s
|
Nothing -> Nothing
|
||||||
|
Just i -> go rest (i:c)
|
||||||
|
go (_:[]) _ = Nothing
|
||||||
|
|
||||||
mk info f = DiffTreeItem
|
mk info f = DiffTreeItem
|
||||||
{ srcmode = readmode srcm
|
<$> readmode srcm
|
||||||
, dstmode = readmode dstm
|
<*> readmode dstm
|
||||||
, srcsha = fromMaybe (error "bad srcsha") $ extractSha ssha
|
<*> extractSha ssha
|
||||||
, dstsha = fromMaybe (error "bad dstsha") $ extractSha dsha
|
<*> extractSha dsha
|
||||||
, status = s
|
<*> pure s
|
||||||
, file = asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f
|
<*> pure (asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f)
|
||||||
}
|
|
||||||
where
|
where
|
||||||
readmode = fst . Prelude.head . readOct
|
readmode = fst <$$> headMaybe . readOct
|
||||||
|
|
||||||
-- info = :<srcmode> SP <dstmode> SP <srcsha> SP <dstsha> SP <status>
|
-- info = :<srcmode> SP <dstmode> SP <srcsha> SP <dstsha> SP <status>
|
||||||
-- All fields are fixed, so we can pull them out of
|
-- All fields are fixed, so we can pull them out of
|
||||||
|
|
|
@ -31,7 +31,7 @@ import qualified System.FilePath.Posix
|
||||||
|
|
||||||
{- A FilePath, relative to the top of the git repository. -}
|
{- A FilePath, relative to the top of the git repository. -}
|
||||||
newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath }
|
newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath }
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
{- Path to a TopFilePath, within the provided git repo. -}
|
{- Path to a TopFilePath, within the provided git repo. -}
|
||||||
fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath
|
fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath
|
||||||
|
|
78
Git/LockFile.hs
Normal file
78
Git/LockFile.hs
Normal file
|
@ -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
|
|
@ -31,11 +31,14 @@ base = Ref . remove "refs/heads/" . remove "refs/remotes/" . fromRef
|
||||||
| prefix `isPrefixOf` s = drop (length prefix) s
|
| prefix `isPrefixOf` s = drop (length prefix) s
|
||||||
| otherwise = 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
|
{- Given a directory and any ref, takes the basename of the ref and puts
|
||||||
- it under the directory. -}
|
- it under the directory. -}
|
||||||
under :: String -> Ref -> Ref
|
under :: String -> Ref -> Ref
|
||||||
under dir r = Ref $ dir ++ "/" ++
|
under dir r = Ref $ dir ++ "/" ++ fromRef (basename r)
|
||||||
(reverse $ takeWhile (/= '/') $ reverse $ fromRef r)
|
|
||||||
|
|
||||||
{- Given a directory such as "refs/remotes/origin", and a ref such as
|
{- 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,
|
- refs/heads/master, yields a version of that ref under the directory,
|
||||||
|
|
182
Git/Tree.hs
182
Git/Tree.hs
|
@ -5,7 +5,7 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-}
|
||||||
|
|
||||||
module Git.Tree (
|
module Git.Tree (
|
||||||
Tree(..),
|
Tree(..),
|
||||||
|
@ -28,6 +28,8 @@ import qualified Utility.CoProcess as CoProcess
|
||||||
import Numeric
|
import Numeric
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
import qualified Data.Set as S
|
||||||
|
import qualified Data.Map as M
|
||||||
|
|
||||||
newtype Tree = Tree [TreeContent]
|
newtype Tree = Tree [TreeContent]
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
@ -38,7 +40,7 @@ data TreeContent
|
||||||
| RecordedSubTree TopFilePath Sha [TreeContent]
|
| RecordedSubTree TopFilePath Sha [TreeContent]
|
||||||
-- A subtree that has not yet been recorded in git.
|
-- A subtree that has not yet been recorded in git.
|
||||||
| NewSubTree TopFilePath [TreeContent]
|
| NewSubTree TopFilePath [TreeContent]
|
||||||
deriving (Show)
|
deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
{- Gets the Tree for a Ref. -}
|
{- Gets the Tree for a Ref. -}
|
||||||
getTree :: Ref -> Repo -> IO Tree
|
getTree :: Ref -> Repo -> IO Tree
|
||||||
|
@ -107,74 +109,154 @@ mkTreeOutput fm ot s f = concat
|
||||||
]
|
]
|
||||||
|
|
||||||
data TreeItem = TreeItem TopFilePath FileMode Sha
|
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.
|
{- Applies an adjustment to items in a tree.
|
||||||
-
|
-
|
||||||
- While less flexible than using getTree and recordTree, this avoids
|
- While less flexible than using getTree and recordTree,
|
||||||
- buffering the whole tree in memory.
|
- this avoids buffering the whole tree in memory.
|
||||||
-}
|
-}
|
||||||
adjustTree :: (MonadIO m, MonadMask m) => (TreeItem -> m (Maybe TreeItem)) -> Ref -> Repo -> m Sha
|
adjustTree
|
||||||
adjustTree adjust r repo = withMkTreeHandle repo $ \h -> do
|
:: (MonadIO m, MonadMask m)
|
||||||
(l, cleanup) <- liftIO $ lsTreeWithObjects r repo
|
=> (TreeItem -> m (Maybe TreeItem))
|
||||||
(l', _, _) <- go h False [] topTree l
|
-- ^ Adjust an item in the tree. Nothing deletes the item.
|
||||||
sha <- liftIO $ mkTree h l'
|
-- Cannot move the item to a different tree.
|
||||||
void $ liftIO cleanup
|
-> [TreeItem]
|
||||||
return sha
|
-- ^ 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
|
where
|
||||||
go _ wasmodified c _ [] = return (c, wasmodified, [])
|
go _ wasmodified c _ [] = return (c, wasmodified, [])
|
||||||
go h wasmodified c intree (i:is)
|
go h wasmodified c intree (i:is)
|
||||||
| intree i =
|
| intree i = case readObjectType (LsTree.typeobj i) of
|
||||||
case readObjectType (LsTree.typeobj i) of
|
Just BlobObject -> do
|
||||||
Just BlobObject -> do
|
let ti = TreeItem (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
|
||||||
let ti = TreeItem (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
|
v <- adjusttreeitem ti
|
||||||
v <- adjust ti
|
case v of
|
||||||
case v of
|
Nothing -> go h True c intree is
|
||||||
Nothing -> go h True c intree is
|
Just ti'@(TreeItem f m s) ->
|
||||||
Just ti'@(TreeItem f m s) ->
|
let !modified = wasmodified || ti' /= ti
|
||||||
let !modified = wasmodified || ti' /= ti
|
blob = TreeBlob f m s
|
||||||
blob = TreeBlob f m s
|
in go h modified (blob:c) intree is
|
||||||
in go h modified (blob:c) intree is
|
Just TreeObject -> do
|
||||||
Just TreeObject -> do
|
(sl, modified, is') <- go h False [] (beneathSubTree i) is
|
||||||
(sl, modified, is') <- go h False [] (subTree i) is
|
sl' <- adjustlist h (inTree i) (beneathSubTree i) sl
|
||||||
subtree <- if modified
|
subtree <- if modified || sl' /= sl
|
||||||
then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl
|
then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl'
|
||||||
else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) []
|
else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) []
|
||||||
let !modified' = modified || wasmodified
|
let !modified' = modified || wasmodified
|
||||||
go h modified' (subtree : c) intree is'
|
go h modified' (subtree : c) intree is'
|
||||||
_ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
|
_ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
|
||||||
| otherwise = return (c, wasmodified, i:is)
|
| 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
|
{- Assumes the list is ordered, with tree objects coming right before their
|
||||||
- contents. -}
|
- contents. -}
|
||||||
extractTree :: [LsTree.TreeItem] -> Either String Tree
|
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 (t, []) -> Right (Tree t)
|
||||||
Right _ -> parseerr "unexpected tree form"
|
Right _ -> parseerr "unexpected tree form"
|
||||||
Left e -> parseerr e
|
Left e -> parseerr e
|
||||||
where
|
where
|
||||||
go t _ [] = Right (t, [])
|
go t _ [] = Right (t, [])
|
||||||
go t intree (i:is)
|
go t intree (i:is)
|
||||||
| intree i =
|
| intree i = case readObjectType (LsTree.typeobj i) of
|
||||||
case readObjectType (LsTree.typeobj i) of
|
Just BlobObject ->
|
||||||
Just BlobObject ->
|
let b = TreeBlob (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
|
||||||
let b = TreeBlob (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
|
in go (b:t) intree is
|
||||||
in go (b:t) intree is
|
Just TreeObject -> case go [] (beneathSubTree i) is of
|
||||||
Just TreeObject -> case go [] (subTree i) is of
|
Right (subtree, is') ->
|
||||||
Right (subtree, is') ->
|
let st = RecordedSubTree (LsTree.file i) (LsTree.sha i) subtree
|
||||||
let st = RecordedSubTree (LsTree.file i) (LsTree.sha i) subtree
|
in go (st:t) intree is'
|
||||||
in go (st:t) intree is'
|
Left e -> Left e
|
||||||
Left e -> Left e
|
_ -> parseerr ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
|
||||||
_ -> parseerr ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
|
|
||||||
| otherwise = Right (t, i:is)
|
| otherwise = Right (t, i:is)
|
||||||
parseerr = Left
|
parseerr = Left
|
||||||
|
|
||||||
type InTree = LsTree.TreeItem -> Bool
|
class GitPath t where
|
||||||
|
gitPath :: t -> FilePath
|
||||||
|
|
||||||
topTree :: InTree
|
instance GitPath FilePath where
|
||||||
topTree = notElem '/' . getTopFilePath . LsTree.file
|
gitPath = id
|
||||||
|
|
||||||
subTree :: LsTree.TreeItem -> InTree
|
instance GitPath TopFilePath where
|
||||||
subTree t =
|
gitPath = getTopFilePath
|
||||||
let prefix = getTopFilePath (LsTree.file t) ++ "/"
|
|
||||||
in (\i -> prefix `isPrefixOf` getTopFilePath (LsTree.file i))
|
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 ++ "/"
|
||||||
|
|
|
@ -105,6 +105,7 @@ fromBlobType SymlinkBlob = 0o120000
|
||||||
|
|
||||||
data Commit = Commit
|
data Commit = Commit
|
||||||
{ commitTree :: Sha
|
{ commitTree :: Sha
|
||||||
|
, commitParent :: [Sha]
|
||||||
, commitAuthorMetaData :: CommitMetaData
|
, commitAuthorMetaData :: CommitMetaData
|
||||||
, commitCommitterMetaData :: CommitMetaData
|
, commitCommitterMetaData :: CommitMetaData
|
||||||
, commitMessage :: String
|
, commitMessage :: String
|
||||||
|
|
4
debian/changelog
vendored
4
debian/changelog
vendored
|
@ -1,5 +1,9 @@
|
||||||
git-annex (6.20160319) UNRELEASED; urgency=medium
|
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
|
* ddar remote: fix ssh calls
|
||||||
Thanks, Robie Basak
|
Thanks, Robie Basak
|
||||||
* log: Display time with time zone.
|
* log: Display time with time zone.
|
||||||
|
|
|
@ -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
|
make other checkouts that are in the same adjusted branch end up with the
|
||||||
same B' commit when they pull B.
|
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
|
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
|
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
|
master adjusted/master
|
||||||
A
|
A
|
||||||
|
@ -112,10 +109,10 @@ beginning the merge. There may be staged changes, or changes in the work tree.
|
||||||
|
|
||||||
First filter the new commit:
|
First filter the new commit:
|
||||||
|
|
||||||
origin/master adjusted/master
|
origin/master adjusted/master master
|
||||||
A
|
A A
|
||||||
|--------------->A'
|
|--------------->A' |
|
||||||
| |
|
| | |
|
||||||
| |
|
| |
|
||||||
B
|
B
|
||||||
|
|
|
|
||||||
|
@ -123,10 +120,10 @@ First filter the new commit:
|
||||||
|
|
||||||
Then, merge that into adjusted/master:
|
Then, merge that into adjusted/master:
|
||||||
|
|
||||||
origin/master adjusted/master
|
origin/master adjusted/master master
|
||||||
A
|
A A
|
||||||
|--------------->A'
|
|--------------->A' |
|
||||||
| |
|
| | |
|
||||||
| |
|
| |
|
||||||
B |
|
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
|
making a commit, but B'' may end up being made to resolve a merge
|
||||||
conflict.)
|
conflict.)
|
||||||
|
|
||||||
Once the merge is done, we have a commit B'' on adjusted/master. To finish,
|
Once the merge is done, we have a merge commit B'' on adjusted/master.
|
||||||
adjust that commit so it does not have adjusted/master as its parent.
|
To finish, redo that commit so it does not have A' as its parent.
|
||||||
|
|
||||||
origin/master adjusted/master
|
origin/master adjusted/master master
|
||||||
A
|
A A
|
||||||
|--------------->A'
|
|--------------->A' |
|
||||||
| |
|
| | |
|
||||||
| |
|
| |
|
||||||
B
|
B
|
||||||
|
|
|
|
||||||
|--------------->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"
|
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
|
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,
|
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.]
|
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
|
## annex object add/remove
|
||||||
|
|
||||||
When objects are added/removed from the annex, the associated file has to
|
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
|
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,
|
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
|
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
|
These changes would need to be committed to the adjusted branch, otherwise
|
||||||
`git diff` would show them.
|
`git diff` would show them.
|
||||||
|
|
||||||
[WORKTREE: Simply adjust the work tree (and index) per the filter.]
|
[WORKTREE: Simply adjust the work tree (and index) per the filter.]
|
||||||
|
|
||||||
## reverse filtering
|
## reverse filtering commits
|
||||||
|
|
||||||
Reversing filter #1 would mean only converting pointer files to
|
A user's commits on the adjusted branch have to be reverse filtered
|
||||||
symlinks when the file was originally a symlink. This is problimatic when a
|
to get changes to apply to the master branch.
|
||||||
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.
|
|
||||||
|
|
||||||
Reversing filter #2 would mean not deleting removed files whose content was
|
This reversal of one filter can be done as just another filter.
|
||||||
not present. When the commit includes deletion of files that were removed
|
Since only files touched by the commit will be reverse filtered, it doesn't
|
||||||
due to their content not being present, those deletions are not propigated.
|
need to reverse all changes made by the original filter.
|
||||||
When the user deletes an unlocked file, the content is still
|
|
||||||
present in annex, so reversing the filter should propigate the file
|
|
||||||
deletion.
|
|
||||||
|
|
||||||
What if an object was sent to the annex (or removed from the annex)
|
For example, reversing the unlock filter might lock the file. Or, it might
|
||||||
after the commit and before the reverse filtering? This would cause the
|
do nothing, which would make all committed files remain unlocked.
|
||||||
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?
|
|
||||||
|
|
||||||
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.
|
|
||||||
|
|
||||||
## push
|
## push
|
||||||
|
|
||||||
|
@ -254,8 +303,15 @@ index in that case.
|
||||||
|
|
||||||
Using `git checkout` when in an adjusted branch is problimatic, because a
|
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
|
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.
|
you want to get into an adjusted branch, you have to run git annex adjust
|
||||||
Or, could make a post-checkout hook.
|
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
|
Tags are bit of a problem. If the user tags an ajusted branch, the tag
|
||||||
includes the local adjustments.
|
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
|
For example, it's not currently possible to update a view branch with
|
||||||
changes fetched from a remote, and this could get us there.
|
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
|
[WORKTREE: Wouldn't be able to integrate, unless view branches are changed
|
||||||
into adjusted view worktrees.]
|
into adjusted view worktrees.]
|
||||||
|
|
||||||
## filter interface
|
## TODOs
|
||||||
|
|
||||||
Distilling all of the above, the filter interface needs to be something
|
* Interface in webapp to enable adjustments.
|
||||||
like this, at its most simple:
|
* Upgrade from direct mode to v6 in unlocked branch.
|
||||||
|
* Honor annex.thin when entering an adjusted branch.
|
||||||
data Filter = UnlockFilter | HideMissingFilter | UnlockHideMissingFilter
|
* Cloning a repo that has an adjusted branch checked out gets into an ugly
|
||||||
|
state.
|
||||||
getFilter :: Annex Filter
|
* There are potentially races in code that assumes a branch like
|
||||||
|
master is not being changed by someone else. In particular,
|
||||||
setFilter :: Filter -> Annex ()
|
propigateAdjustedCommits rebases the adjusted branch on top of master.
|
||||||
|
That is called by sync. The assumption is that any changes in master
|
||||||
data FilterAction
|
have already been handled by updateAdjustedBranch. But, if another remote
|
||||||
= UnchangedFile FilePath
|
pushed a new master at just the right time, the adjusted branch could be
|
||||||
| UnlockFile FilePath
|
rebased on top of a master that it doesn't incorporate, which is wrong.
|
||||||
| 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
|
|
||||||
|
|
50
doc/git-annex-adjust.mdwn
Normal file
50
doc/git-annex-adjust.mdwn
Normal file
|
@ -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.
|
|
@ -20,6 +20,8 @@ commands.
|
||||||
Note that the direct mode/indirect mode distinction is removed in v6
|
Note that the direct mode/indirect mode distinction is removed in v6
|
||||||
git-annex repositories. In such a repository, you can
|
git-annex repositories. In such a repository, you can
|
||||||
use [[git-annex-unlock]](1) to make a file's content be directly present.
|
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
|
# 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-unlock]](1)
|
||||||
|
|
||||||
|
[[git-annex-adjust]](1)
|
||||||
|
|
||||||
# AUTHOR
|
# AUTHOR
|
||||||
|
|
||||||
Joey Hess <id@joeyh.name>
|
Joey Hess <id@joeyh.name>
|
||||||
|
|
|
@ -295,6 +295,13 @@ subdirectories).
|
||||||
|
|
||||||
See [[git-annex-indirect]](1) for details.
|
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
|
# REPOSITORY MAINTENANCE COMMANDS
|
||||||
|
|
||||||
* `fsck [path ...]`
|
* `fsck [path ...]`
|
||||||
|
|
|
@ -95,6 +95,8 @@ mode is used. To make them always use unlocked mode, run:
|
||||||
`git config annex.addunlocked true`
|
`git config annex.addunlocked true`
|
||||||
"""]]
|
"""]]
|
||||||
|
|
||||||
|
## mixing locked and unlocked files
|
||||||
|
|
||||||
A v6 repository can contain both locked and unlocked files. You can switch
|
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`
|
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
|
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
|
the repository in locked mode, use `git annex add`; to add a file in
|
||||||
unlocked mode, use `git add`.
|
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
|
## using less disk space
|
||||||
|
|
||||||
Unlocked files are handy, but they have one significant disadvantage
|
Unlocked files are handy, but they have one significant disadvantage
|
||||||
|
|
|
@ -23,12 +23,6 @@ git-annex should use smudge/clean filters.
|
||||||
(May need to use libgit2 to do this efficiently, cannot find
|
(May need to use libgit2 to do this efficiently, cannot find
|
||||||
any plumbing except git-update-index, which is very inneficient for
|
any plumbing except git-update-index, which is very inneficient for
|
||||||
smudged files.)
|
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.
|
* Eventually (but not yet), make v6 the default for new repositories.
|
||||||
Note that the assistant forces repos into direct mode; that will need to
|
Note that the assistant forces repos into direct mode; that will need to
|
||||||
be changed then, and it should enable annex.thin instead.
|
be changed then, and it should enable annex.thin instead.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue