1{- adjusted branch 2 - 3 - Copyright 2016-2020 Joey Hess <id@joeyh.name> 4 - 5 - Licensed under the GNU AGPL version 3 or higher. 6 -} 7 8{-# LANGUAGE BangPatterns, OverloadedStrings #-} 9 10module Annex.AdjustedBranch ( 11 Adjustment(..), 12 LinkAdjustment(..), 13 PresenceAdjustment(..), 14 LinkPresentAdjustment(..), 15 adjustmentHidesFiles, 16 adjustmentIsStable, 17 OrigBranch, 18 AdjBranch(..), 19 originalToAdjusted, 20 adjustedToOriginal, 21 fromAdjustedBranch, 22 getAdjustment, 23 enterAdjustedBranch, 24 adjustedBranchRefresh, 25 adjustedBranchRefreshFull, 26 adjustBranch, 27 adjustTree, 28 adjustToCrippledFileSystem, 29 commitForAdjustedBranch, 30 propigateAdjustedCommits, 31 propigateAdjustedCommits', 32 commitAdjustedTree, 33 commitAdjustedTree', 34 BasisBranch(..), 35 basisBranch, 36 setBasisBranch, 37 preventCommits, 38 AdjustedClone(..), 39 checkAdjustedClone, 40 checkVersionSupported, 41 isGitVersionSupported, 42) where 43 44import Annex.Common 45import Types.AdjustedBranch 46import Annex.AdjustedBranch.Name 47import qualified Annex 48import qualified Annex.Queue 49import Git 50import Git.Types 51import qualified Git.Branch 52import qualified Git.Ref 53import qualified Git.Command 54import qualified Git.Tree 55import qualified Git.DiffTree 56import Git.Tree (TreeItem(..)) 57import Git.Sha 58import Git.Env 59import Git.Index 60import Git.FilePath 61import qualified Git.LockFile 62import qualified Git.Version 63import Annex.CatFile 64import Annex.Link 65import Annex.Content.Presence 66import Annex.CurrentBranch 67import Types.CleanupActions 68import qualified Database.Keys 69import Config 70 71import qualified Data.Map as M 72 73class AdjustTreeItem t where 74 -- How to perform various adjustments to a TreeItem. 75 adjustTreeItem :: t -> TreeItem -> Annex (Maybe TreeItem) 76 -- Will adjusting a given tree always yield the same adjusted tree? 77 adjustmentIsStable :: t -> Bool 78 79instance AdjustTreeItem Adjustment where 80 adjustTreeItem (LinkAdjustment l) t = adjustTreeItem l t 81 adjustTreeItem (PresenceAdjustment p Nothing) t = adjustTreeItem p t 82 adjustTreeItem (PresenceAdjustment p (Just l)) t = 83 adjustTreeItem p t >>= \case 84 Nothing -> return Nothing 85 Just t' -> adjustTreeItem l t' 86 adjustTreeItem (LinkPresentAdjustment l) t = adjustTreeItem l t 87 88 adjustmentIsStable (LinkAdjustment l) = adjustmentIsStable l 89 adjustmentIsStable (PresenceAdjustment p _) = adjustmentIsStable p 90 adjustmentIsStable (LinkPresentAdjustment l) = adjustmentIsStable l 91 92instance AdjustTreeItem LinkAdjustment where 93 adjustTreeItem UnlockAdjustment = 94 ifSymlink adjustToPointer noAdjust 95 adjustTreeItem LockAdjustment = 96 ifSymlink noAdjust adjustToSymlink 97 adjustTreeItem FixAdjustment = 98 ifSymlink adjustToSymlink noAdjust 99 adjustTreeItem UnFixAdjustment = 100 ifSymlink (adjustToSymlink' gitAnnexLinkCanonical) noAdjust 101 102 adjustmentIsStable _ = True 103 104instance AdjustTreeItem PresenceAdjustment where 105 adjustTreeItem HideMissingAdjustment = 106 ifPresent noAdjust hideAdjust 107 adjustTreeItem ShowMissingAdjustment = 108 noAdjust 109 110 adjustmentIsStable HideMissingAdjustment = False 111 adjustmentIsStable ShowMissingAdjustment = True 112 113instance AdjustTreeItem LinkPresentAdjustment where 114 adjustTreeItem UnlockPresentAdjustment = 115 ifPresent adjustToPointer adjustToSymlink 116 adjustTreeItem LockPresentAdjustment = 117 -- Turn all pointers back to symlinks, whether the content 118 -- is present or not. This is done because the content 119 -- availability may have changed and the branch not been 120 -- re-adjusted to keep up, so there may be pointers whose 121 -- content is not present. 122 ifSymlink noAdjust adjustToSymlink 123 124 adjustmentIsStable UnlockPresentAdjustment = False 125 adjustmentIsStable LockPresentAdjustment = True 126 127ifSymlink 128 :: (TreeItem -> Annex a) 129 -> (TreeItem -> Annex a) 130 -> TreeItem 131 -> Annex a 132ifSymlink issymlink notsymlink ti@(TreeItem _f m _s) 133 | toTreeItemType m == Just TreeSymlink = issymlink ti 134 | otherwise = notsymlink ti 135 136ifPresent 137 :: (TreeItem -> Annex (Maybe TreeItem)) 138 -> (TreeItem -> Annex (Maybe TreeItem)) 139 -> TreeItem 140 -> Annex (Maybe TreeItem) 141ifPresent ispresent notpresent ti@(TreeItem _ _ s) = 142 catKey s >>= \case 143 Just k -> ifM (inAnnex k) (ispresent ti, notpresent ti) 144 Nothing -> return (Just ti) 145 146noAdjust :: TreeItem -> Annex (Maybe TreeItem) 147noAdjust = return . Just 148 149hideAdjust :: TreeItem -> Annex (Maybe TreeItem) 150hideAdjust _ = return Nothing 151 152adjustToPointer :: TreeItem -> Annex (Maybe TreeItem) 153adjustToPointer ti@(TreeItem f _m s) = catKey s >>= \case 154 Just k -> do 155 Database.Keys.addAssociatedFile k f 156 Just . TreeItem f (fromTreeItemType TreeFile) 157 <$> hashPointerFile k 158 Nothing -> return (Just ti) 159 160adjustToSymlink :: TreeItem -> Annex (Maybe TreeItem) 161adjustToSymlink = adjustToSymlink' gitAnnexLink 162 163adjustToSymlink' :: (RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath) -> TreeItem -> Annex (Maybe TreeItem) 164adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = catKey s >>= \case 165 Just k -> do 166 absf <- inRepo $ \r -> absPath $ fromTopFilePath f r 167 linktarget <- calcRepo $ gitannexlink absf k 168 Just . TreeItem f (fromTreeItemType TreeSymlink) 169 <$> hashSymlink linktarget 170 Nothing -> return (Just ti) 171 172-- This is a hidden branch ref, that's used as the basis for the AdjBranch, 173-- since pushes can overwrite the OrigBranch at any time. So, changes 174-- are propigated from the AdjBranch to the head of the BasisBranch. 175newtype BasisBranch = BasisBranch Ref 176 177-- The basis for refs/heads/adjusted/master(unlocked) is 178-- refs/basis/adjusted/master(unlocked). 179basisBranch :: AdjBranch -> BasisBranch 180basisBranch (AdjBranch adjbranch) = BasisBranch $ 181 Ref ("refs/basis/" <> fromRef' (Git.Ref.base adjbranch)) 182 183getAdjustment :: Branch -> Maybe Adjustment 184getAdjustment = fmap fst . adjustedToOriginal 185 186fromAdjustedBranch :: Branch -> OrigBranch 187fromAdjustedBranch b = maybe b snd (adjustedToOriginal b) 188 189{- Enter an adjusted version of current branch (or, if already in an 190 - adjusted version of a branch, changes the adjustment of the original 191 - branch). 192 - 193 - Can fail, if no branch is checked out, or if the adjusted branch already 194 - exists, or if staged changes prevent a checkout. 195 -} 196enterAdjustedBranch :: Adjustment -> Annex Bool 197enterAdjustedBranch adj = inRepo Git.Branch.current >>= \case 198 Just currbranch -> case getAdjustment currbranch of 199 Just curradj | curradj == adj -> 200 updateAdjustedBranch adj (AdjBranch currbranch) 201 (fromAdjustedBranch currbranch) 202 _ -> go currbranch 203 Nothing -> do 204 warning "not on any branch!" 205 return False 206 where 207 go currbranch = do 208 let origbranch = fromAdjustedBranch currbranch 209 let adjbranch = adjBranch $ originalToAdjusted origbranch adj 210 ifM (inRepo (Git.Ref.exists adjbranch) <&&> (not <$> Annex.getState Annex.force)) 211 ( do 212 mapM_ (warning . unwords) 213 [ [ "adjusted branch" 214 , Git.Ref.describe adjbranch 215 , "already exists." 216 ] 217 , [ "Aborting because that branch may have changes that have not yet reached" 218 , Git.Ref.describe origbranch 219 ] 220 , [ "You can check out the adjusted branch manually to enter it," 221 , "or add the --force option to overwrite the old branch." 222 ] 223 ] 224 return False 225 , do 226 b <- preventCommits $ const $ 227 adjustBranch adj origbranch 228 checkoutAdjustedBranch b False 229 ) 230 231checkoutAdjustedBranch :: AdjBranch -> Bool -> Annex Bool 232checkoutAdjustedBranch (AdjBranch b) quietcheckout = do 233 -- checkout can have output in large repos 234 unless quietcheckout 235 showOutput 236 inRepo $ Git.Command.runBool $ 237 [ Param "checkout" 238 , Param $ fromRef $ Git.Ref.base b 239 , if quietcheckout then Param "--quiet" else Param "--progress" 240 ] 241 242{- Already in a branch with this adjustment, but the user asked to enter it 243 - again. This should have the same result as propagating any commits 244 - back to the original branch, checking out the original branch, deleting 245 - and rebuilding the adjusted branch, and then checking it out. 246 - But, it can be implemented more efficiently than that. 247 -} 248updateAdjustedBranch :: Adjustment -> AdjBranch -> OrigBranch -> Annex Bool 249updateAdjustedBranch adj (AdjBranch currbranch) origbranch 250 | not (adjustmentIsStable adj) = do 251 b <- preventCommits $ \commitlck -> do 252 -- Avoid losing any commits that the adjusted branch 253 -- has that have not yet been propigated back to the 254 -- origbranch. 255 _ <- propigateAdjustedCommits' origbranch adj commitlck 256 257 -- Git normally won't do anything when asked to check 258 -- out the currently checked out branch, even when its 259 -- ref has changed. Work around this by writing a raw 260 -- sha to .git/HEAD. 261 inRepo (Git.Ref.sha currbranch) >>= \case 262 Just headsha -> inRepo $ \r -> 263 writeFile (Git.Ref.headFile r) (fromRef headsha) 264 _ -> noop 265 266 adjustBranch adj origbranch 267 268 -- Make git checkout quiet to avoid warnings about 269 -- disconnected branch tips being lost. 270 checkoutAdjustedBranch b True 271 | otherwise = preventCommits $ \commitlck -> do 272 -- Done for consistency. 273 _ <- propigateAdjustedCommits' origbranch adj commitlck 274 -- No need to actually update the branch because the 275 -- adjustment is stable. 276 return True 277 278{- Passed an action that, if it succeeds may get or drop the Key associated 279 - with the file. When the adjusted branch needs to be refreshed to reflect 280 - those changes, it's handled here. 281 - 282 - Note that the AssociatedFile must be verified by this to point to the 283 - Key. In some cases, the value was provided by the user and might not 284 - really be an associated file. 285 -} 286adjustedBranchRefresh :: AssociatedFile -> Annex a -> Annex a 287adjustedBranchRefresh _af a = do 288 r <- a 289 annexAdjustedBranchRefresh <$> Annex.getGitConfig >>= \case 290 0 -> return () 291 n -> go n 292 return r 293 where 294 go n = getCurrentBranch >>= \case 295 (Just origbranch, Just adj) -> 296 unless (adjustmentIsStable adj) $ 297 ifM (checkcounter n) 298 ( update adj origbranch 299 , Annex.addCleanupAction AdjustedBranchUpdate $ 300 adjustedBranchRefreshFull adj origbranch 301 ) 302 _ -> return () 303 304 checkcounter n 305 -- Special case, 1 (or true) refreshes only at shutdown. 306 | n == 1 = pure False 307 | otherwise = Annex.withState $ \s -> 308 let !c = Annex.adjustedbranchrefreshcounter s + 1 309 !enough = c >= pred n 310 !c' = if enough then 0 else c 311 !s' = s { Annex.adjustedbranchrefreshcounter = c' } 312 in pure (s', enough) 313 314 update adj origbranch = do 315 -- Flush the queue, to make any pending changes be written 316 -- out to disk. But mostly so any pointer files 317 -- restagePointerFile was called on get updated so git 318 -- checkout won't fall over. 319 Annex.Queue.flush 320 -- This is slow, it would be better to incrementally 321 -- adjust the AssociatedFile, and only call this once 322 -- at shutdown to handle cases where not all 323 -- AssociatedFiles are known. 324 adjustedBranchRefreshFull adj origbranch 325 326{- Slow, but more dependable version of adjustedBranchRefresh that 327 - does not rely on all AssociatedFiles being known. -} 328adjustedBranchRefreshFull :: Adjustment -> OrigBranch -> Annex () 329adjustedBranchRefreshFull adj origbranch = do 330 let adjbranch = originalToAdjusted origbranch adj 331 unlessM (updateAdjustedBranch adj adjbranch origbranch) $ 332 warning $ unwords [ "Updating adjusted branch failed." ] 333 334adjustToCrippledFileSystem :: Annex () 335adjustToCrippledFileSystem = do 336 warning "Entering an adjusted branch where files are unlocked as this filesystem does not support locked files." 337 checkVersionSupported 338 whenM (isNothing <$> inRepo Git.Branch.current) $ 339 commitForAdjustedBranch [] 340 inRepo Git.Branch.current >>= \case 341 Just currbranch -> case getAdjustment currbranch of 342 Just curradj | curradj == adj -> return () 343 _ -> do 344 let adjbranch = originalToAdjusted currbranch adj 345 ifM (inRepo (Git.Ref.exists $ adjBranch adjbranch)) 346 ( unlessM (checkoutAdjustedBranch adjbranch False) $ 347 failedenter 348 , unlessM (enterAdjustedBranch adj) $ 349 failedenter 350 ) 351 Nothing -> failedenter 352 where 353 adj = LinkAdjustment UnlockAdjustment 354 failedenter = warning "Failed to enter adjusted branch!" 355 356{- Commit before entering adjusted branch. Only needs to be done 357 - when the current branch does not have any commits yet. 358 - 359 - If something is already staged, it will be committed, but otherwise 360 - an empty commit will be made. 361 -} 362commitForAdjustedBranch :: [CommandParam] -> Annex () 363commitForAdjustedBranch ps = do 364 cmode <- annexCommitMode <$> Annex.getGitConfig 365 let cquiet = Git.Branch.CommitQuiet True 366 void $ inRepo $ Git.Branch.commitCommand cmode cquiet $ 367 [ Param "--allow-empty" 368 , Param "-m" 369 , Param "commit before entering adjusted branch" 370 ] ++ ps 371 372setBasisBranch :: BasisBranch -> Ref -> Annex () 373setBasisBranch (BasisBranch basis) new = 374 inRepo $ Git.Branch.update' basis new 375 376setAdjustedBranch :: String -> AdjBranch -> Ref -> Annex () 377setAdjustedBranch msg (AdjBranch b) r = inRepo $ Git.Branch.update msg b r 378 379adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch 380adjustBranch adj origbranch = do 381 -- Start basis off with the current value of the origbranch. 382 setBasisBranch basis origbranch 383 sha <- adjustCommit adj basis 384 setAdjustedBranch "entering adjusted branch" adjbranch sha 385 return adjbranch 386 where 387 adjbranch = originalToAdjusted origbranch adj 388 basis = basisBranch adjbranch 389 390adjustCommit :: Adjustment -> BasisBranch -> Annex Sha 391adjustCommit adj basis = do 392 treesha <- adjustTree adj basis 393 commitAdjustedTree treesha basis 394 395adjustTree :: Adjustment -> BasisBranch -> Annex Sha 396adjustTree adj (BasisBranch basis) = do 397 let toadj = adjustTreeItem adj 398 treesha <- Git.Tree.adjustTree 399 toadj 400 [] 401 (\_old new -> new) 402 [] 403 basis =<< Annex.gitRepo 404 return treesha 405 406type CommitsPrevented = Git.LockFile.LockHandle 407 408{- Locks git's index file, preventing git from making a commit, merge, 409 - or otherwise changing the HEAD ref while the action is run. 410 - 411 - Throws an IO exception if the index file is already locked. 412 -} 413preventCommits :: (CommitsPrevented -> Annex a) -> Annex a 414preventCommits = bracket setup cleanup 415 where 416 setup = do 417 lck <- fromRepo $ indexFileLock . indexFile 418 liftIO $ Git.LockFile.openLock (fromRawFilePath lck) 419 cleanup = liftIO . Git.LockFile.closeLock 420 421{- Commits a given adjusted tree, with the provided parent ref. 422 - 423 - This should always yield the same value, even if performed in different 424 - clones of a repo, at different times. The commit message and other 425 - metadata is based on the parent. 426 -} 427commitAdjustedTree :: Sha -> BasisBranch -> Annex Sha 428commitAdjustedTree treesha parent@(BasisBranch b) = 429 commitAdjustedTree' treesha parent [b] 430 431commitAdjustedTree' :: Sha -> BasisBranch -> [Ref] -> Annex Sha 432commitAdjustedTree' treesha (BasisBranch basis) parents = 433 go =<< catCommit basis 434 where 435 go Nothing = do 436 cmode <- annexCommitMode <$> Annex.getGitConfig 437 inRepo $ mkcommit cmode 438 go (Just basiscommit) = do 439 cmode <- annexCommitMode <$> Annex.getGitConfig 440 inRepo $ commitWithMetaData 441 (commitAuthorMetaData basiscommit) 442 (commitCommitterMetaData basiscommit) 443 (mkcommit cmode) 444 mkcommit cmode = Git.Branch.commitTree cmode 445 adjustedBranchCommitMessage parents treesha 446 447{- This message should never be changed. -} 448adjustedBranchCommitMessage :: String 449adjustedBranchCommitMessage = "git-annex adjusted branch" 450 451findAdjustingCommit :: AdjBranch -> Annex (Maybe Commit) 452findAdjustingCommit (AdjBranch b) = go =<< catCommit b 453 where 454 go Nothing = return Nothing 455 go (Just c) 456 | commitMessage c == adjustedBranchCommitMessage = return (Just c) 457 | otherwise = case commitParent c of 458 [p] -> go =<< catCommit p 459 _ -> return Nothing 460 461{- Check for any commits present on the adjusted branch that have not yet 462 - been propigated to the basis branch, and propigate them to the basis 463 - branch and from there on to the orig branch. 464 - 465 - After propigating the commits back to the basis banch, 466 - rebase the adjusted branch on top of the updated basis branch. 467 -} 468propigateAdjustedCommits :: OrigBranch -> Adjustment -> Annex () 469propigateAdjustedCommits origbranch adj = 470 preventCommits $ \commitsprevented -> 471 join $ snd <$> propigateAdjustedCommits' origbranch adj commitsprevented 472 473{- Returns sha of updated basis branch, and action which will rebase 474 - the adjusted branch on top of the updated basis branch. -} 475propigateAdjustedCommits' 476 :: OrigBranch 477 -> Adjustment 478 -> CommitsPrevented 479 -> Annex (Maybe Sha, Annex ()) 480propigateAdjustedCommits' origbranch adj _commitsprevented = 481 inRepo (Git.Ref.sha basis) >>= \case 482 Just origsha -> catCommit currbranch >>= \case 483 Just currcommit -> 484 newcommits >>= go origsha False >>= \case 485 Left e -> do 486 warning e 487 return (Nothing, return ()) 488 Right newparent -> return 489 ( Just newparent 490 , rebase currcommit newparent 491 ) 492 Nothing -> return (Nothing, return ()) 493 Nothing -> return (Nothing, return ()) 494 where 495 (BasisBranch basis) = basisBranch adjbranch 496 adjbranch@(AdjBranch currbranch) = originalToAdjusted origbranch adj 497 newcommits = inRepo $ Git.Branch.changedCommits basis currbranch 498 -- Get commits oldest first, so they can be processed 499 -- in order made. 500 [Param "--reverse"] 501 go parent _ [] = do 502 setBasisBranch (BasisBranch basis) parent 503 inRepo $ Git.Branch.update' origbranch parent 504 return (Right parent) 505 go parent pastadjcommit (sha:l) = catCommit sha >>= \case 506 Just c 507 | commitMessage c == adjustedBranchCommitMessage -> 508 go parent True l 509 | pastadjcommit -> 510 reverseAdjustedCommit parent adj (sha, c) origbranch 511 >>= \case 512 Left e -> return (Left e) 513 Right commit -> go commit pastadjcommit l 514 _ -> go parent pastadjcommit l 515 rebase currcommit newparent = do 516 -- Reuse the current adjusted tree, and reparent it 517 -- on top of the newparent. 518 commitAdjustedTree (commitTree currcommit) (BasisBranch newparent) 519 >>= inRepo . Git.Branch.update rebaseOnTopMsg currbranch 520 521rebaseOnTopMsg :: String 522rebaseOnTopMsg = "rebasing adjusted branch on top of updated original branch" 523 524{- Reverses an adjusted commit, and commit with provided commitparent, 525 - yielding a commit sha. 526 - 527 - Adjusts the tree of the commitparent, changing only the files that the 528 - commit changed, and reverse adjusting those changes. 529 - 530 - The commit message, and the author and committer metadata are 531 - copied over from the basiscommit. However, any gpg signature 532 - will be lost, and any other headers are not copied either. -} 533reverseAdjustedCommit :: Sha -> Adjustment -> (Sha, Commit) -> OrigBranch -> Annex (Either String Sha) 534reverseAdjustedCommit commitparent adj (csha, basiscommit) origbranch 535 | length (commitParent basiscommit) > 1 = return $ 536 Left $ "unable to propigate merge commit " ++ show csha ++ " back to " ++ show origbranch 537 | otherwise = do 538 cmode <- annexCommitMode <$> Annex.getGitConfig 539 treesha <- reverseAdjustedTree commitparent adj csha 540 revadjcommit <- inRepo $ commitWithMetaData 541 (commitAuthorMetaData basiscommit) 542 (commitCommitterMetaData basiscommit) $ 543 Git.Branch.commitTree cmode 544 (commitMessage basiscommit) 545 [commitparent] treesha 546 return (Right revadjcommit) 547 548{- Adjusts the tree of the basis, changing only the files that the 549 - commit changed, and reverse adjusting those changes. 550 - 551 - commitDiff does not support merge commits, so the csha must not be a 552 - merge commit. -} 553reverseAdjustedTree :: Sha -> Adjustment -> Sha -> Annex Sha 554reverseAdjustedTree basis adj csha = do 555 (diff, cleanup) <- inRepo (Git.DiffTree.commitDiff csha) 556 let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti `elem` nullShas) diff 557 let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti `elem` nullShas) others 558 adds' <- catMaybes <$> 559 mapM (adjustTreeItem reverseadj) (map diffTreeToTreeItem adds) 560 treesha <- Git.Tree.adjustTree 561 (propchanges changes) 562 adds' 563 (\_old new -> new) 564 (map Git.DiffTree.file removes) 565 basis 566 =<< Annex.gitRepo 567 void $ liftIO cleanup 568 return treesha 569 where 570 reverseadj = reverseAdjustment adj 571 propchanges changes ti@(TreeItem f _ _) = 572 case M.lookup (norm f) m of 573 Nothing -> return (Just ti) -- not changed 574 Just change -> adjustTreeItem reverseadj change 575 where 576 m = M.fromList $ map (\i@(TreeItem f' _ _) -> (norm f', i)) $ 577 map diffTreeToTreeItem changes 578 norm = normalise . fromRawFilePath . getTopFilePath 579 580diffTreeToTreeItem :: Git.DiffTree.DiffTreeItem -> TreeItem 581diffTreeToTreeItem dti = TreeItem 582 (Git.DiffTree.file dti) 583 (Git.DiffTree.dstmode dti) 584 (Git.DiffTree.dstsha dti) 585 586data AdjustedClone = InAdjustedClone | NotInAdjustedClone 587 588{- Cloning a repository that has an adjusted branch checked out will 589 - result in the clone having the same adjusted branch checked out -- but 590 - the origbranch won't exist in the clone, nor will the basis. So 591 - to properly set up the adjusted branch, the origbranch and basis need 592 - to be set. 593 - 594 - We can't trust that the origin's origbranch matches up with the currently 595 - checked out adjusted branch; the origin could have the two branches 596 - out of sync (eg, due to another branch having been pushed to the origin's 597 - origbranch), or due to a commit on its adjusted branch not having been 598 - propigated back to origbranch. 599 - 600 - So, find the adjusting commit on the currently checked out adjusted 601 - branch, and use the parent of that commit as the basis, and set the 602 - origbranch to it. 603 -} 604checkAdjustedClone :: Annex AdjustedClone 605checkAdjustedClone = ifM isBareRepo 606 ( return NotInAdjustedClone 607 , go =<< inRepo Git.Branch.current 608 ) 609 where 610 go Nothing = return NotInAdjustedClone 611 go (Just currbranch) = case adjustedToOriginal currbranch of 612 Nothing -> return NotInAdjustedClone 613 Just (adj, origbranch) -> do 614 let basis@(BasisBranch bb) = basisBranch (originalToAdjusted origbranch adj) 615 unlessM (inRepo $ Git.Ref.exists bb) $ do 616 aps <- fmap commitParent <$> findAdjustingCommit (AdjBranch currbranch) 617 case aps of 618 Just [p] -> do 619 unlessM (inRepo $ Git.Ref.exists origbranch) $ 620 inRepo $ Git.Branch.update' origbranch p 621 setBasisBranch basis p 622 _ -> giveup $ "Unable to clean up from clone of adjusted branch; perhaps you should check out " ++ Git.Ref.describe origbranch 623 return InAdjustedClone 624 625checkVersionSupported :: Annex () 626checkVersionSupported = 627 unlessM (liftIO isGitVersionSupported) $ 628 giveup "Your version of git is too old; upgrade it to 2.2.0 or newer to use adjusted branches." 629 630-- git 2.2.0 needed for GIT_COMMON_DIR which is needed 631-- by updateAdjustedBranch to use withWorkTreeRelated. 632isGitVersionSupported :: IO Bool 633isGitVersionSupported = not <$> Git.Version.older "2.2.0" 634