diff options
| -rw-r--r-- | Annex/Direct.hs | 74 | ||||
| -rw-r--r-- | Command/Sync.hs | 12 | ||||
| -rw-r--r-- | Git/Branch.hs | 22 | ||||
| -rw-r--r-- | Git/Ref.hs | 10 | ||||
| -rw-r--r-- | Init.hs | 45 | ||||
| -rw-r--r-- | doc/todo/direct_mode_guard.mdwn | 11 |
6 files changed, 126 insertions, 48 deletions
diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 7b0dbc1e0..d4b73860e 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -15,6 +15,7 @@ import qualified Git.Merge import qualified Git.DiffTree as DiffTree import qualified Git.Config import qualified Git.Ref +import qualified Git.Branch import Git.Sha import Git.FilePath import Git.Types @@ -236,28 +237,65 @@ changedDirect oldk f = do whenM (pure (null locs) <&&> not <$> inAnnex oldk) $ logStatus oldk InfoMissing -{- Since direct mode repositories use core.bare=true, pushes are allowed - - that overwrite the master branch (or whatever branch is currently - - checked out) at any time. But committing when a change has been pushed - - to the current branch and not merged into the work tree will have the - - effect of reverting the pushed changes. - - - - To avoid this problem, when git annex commits in a direct mode - - repository, it does not commit to HEAD, but instead to annexhead. - - This ref always contains the last local commit. - -} -annexheadRef :: Ref -annexheadRef = Ref $ "refs" </> "annexhead" - {- Enable/disable direct mode. -} setDirect :: Bool -> Annex () setDirect wantdirect = do - when wantdirect $ do - f <- fromRepo $ Git.Ref.file annexheadRef - v <- inRepo $ Git.Ref.sha Git.Ref.headRef - liftIO $ maybe (nukeFile f) (writeFile f . show) v + if wantdirect + then do + switchHEAD + setbare + else do + setbare + switchHEADBack setConfig (annexConfig "direct") val - setConfig (ConfigKey Git.Config.coreBare) val Annex.changeGitConfig $ \c -> c { annexDirect = wantdirect } where val = Git.Config.boolConfig wantdirect + setbare = setConfig (ConfigKey Git.Config.coreBare) val + +{- Since direct mode sets core.bare=true, incoming pushes could change + - the currently checked out branch. To avoid this problem, HEAD + - is changed to a internal ref that nothing is going to push to. + - + - For refs/heads/master, use refs/heads/annex/direct/master; + - this way things that show HEAD (eg shell prompts) will + - hopefully show just "master". -} +directBranch :: Ref -> Ref +directBranch orighead = case split "/" $ show orighead of + ("refs":"heads":"annex":"direct":_) -> orighead + ("refs":"heads":rest) -> + Ref $ "refs/heads/annex/direct/" ++ intercalate "/" rest + _ -> Ref $ "refs/heads/" ++ show (Git.Ref.base orighead) + +{- Converts a directBranch back to the original branch. + - + - Any other ref is left unchanged. + -} +fromDirectBranch :: Ref -> Ref +fromDirectBranch directhead = case split "/" $ show directhead of + ("refs":"heads":"annex":"direct":rest) -> + Ref $ "refs/heads/" ++ intercalate "/" rest + _ -> directhead + +switchHEAD :: Annex () +switchHEAD = maybe noop switch =<< inRepo Git.Branch.currentUnsafe + where + switch orighead = do + let newhead = directBranch orighead + maybe noop (inRepo . Git.Branch.update newhead) + =<< inRepo (Git.Ref.sha orighead) + inRepo $ Git.Branch.checkout newhead + +switchHEADBack :: Annex () +switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe + where + switch currhead = do + let orighead = fromDirectBranch currhead + v <- inRepo $ Git.Ref.sha currhead + case v of + Just headsha + | orighead /= currhead -> do + inRepo $ Git.Branch.update orighead headsha + inRepo $ Git.Branch.checkout orighead + inRepo $ Git.Branch.delete currhead + _ -> inRepo $ Git.Branch.checkout orighead diff --git a/Command/Sync.hs b/Command/Sync.hs index 2a6f340e7..a37fcab98 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -75,10 +75,10 @@ prepMerge :: Annex () prepMerge = liftIO . setCurrentDirectory =<< fromRepo Git.repoPath syncBranch :: Git.Ref -> Git.Ref -syncBranch = Git.Ref.under "refs/heads/synced/" +syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch remoteBranch :: Remote -> Git.Ref -> Git.Ref -remoteBranch remote = Git.Ref.under $ "refs/remotes/" ++ Remote.name remote +remoteBranch remote = Git.Ref.underBase $ "refs/remotes/" ++ Remote.name remote syncRemotes :: [String] -> Annex [Remote] syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted ) @@ -138,7 +138,13 @@ mergeLocal (Just branch) = go =<< needmerge pushLocal :: Maybe Git.Ref -> CommandStart pushLocal Nothing = stop pushLocal (Just branch) = do + -- Update the sync branch to match the new state of the branch inRepo $ updateBranch $ syncBranch branch + -- In direct mode, we're operating on some special direct mode + -- branch, rather than the intended branch, so update the indended + -- branch. + whenM isDirect $ + inRepo $ updateBranch $ fromDirectBranch branch stop updateBranch :: Git.Ref -> Git.Repo -> IO () @@ -232,7 +238,7 @@ pushBranch remote branch g = tryIO (directpush g) `after` syncpush g , refspec branch ] directpush = Git.Command.runQuiet $ pushparams - [show $ Git.Ref.base branch] + [show $ Git.Ref.base $ fromDirectBranch branch] pushparams branches = [ Param "push" , Param $ Remote.name remote diff --git a/Git/Branch.hs b/Git/Branch.hs index 7b560246e..7b3297d74 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -13,7 +13,7 @@ import Common import Git import Git.Sha import Git.Command -import Git.Ref (headRef) +import qualified Git.Ref {- The currently checked out branch. - @@ -36,7 +36,7 @@ current r = do {- The current branch, which may not really exist yet. -} currentUnsafe :: Repo -> IO (Maybe Git.Ref) currentUnsafe r = parse . firstLine - <$> pipeReadStrict [Param "symbolic-ref", Param $ show headRef] r + <$> pipeReadStrict [Param "symbolic-ref", Param $ show Git.Ref.headRef] r where parse l | null l = Nothing @@ -113,3 +113,21 @@ update branch sha = run , Param $ show branch , Param $ show sha ] + +{- Checks out a branch, creating it if necessary. -} +checkout :: Branch -> Repo -> IO () +checkout branch = run + [ Param "checkout" + , Param "-q" + , Param "-B" + , Param $ show $ Git.Ref.base branch + ] + +{- Removes a branch. -} +delete :: Branch -> Repo -> IO () +delete branch = run + [ Param "branch" + , Param "-q" + , Param "-D" + , Param $ show $ Git.Ref.base branch + ] diff --git a/Git/Ref.hs b/Git/Ref.hs index 9706f8b6c..5057180d1 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -29,11 +29,17 @@ base = Ref . remove "refs/heads/" . remove "refs/remotes/" . show | prefix `isPrefixOf` s = drop (length prefix) s | otherwise = s +{- Given a directory and any ref, takes the basename of the ref and puts + - it under the directory. -} +under :: String -> Ref -> Ref +under dir r = Ref $ dir ++ "/" ++ + (reverse $ takeWhile (/= '/') $ reverse $ show r) + {- Given a directory such as "refs/remotes/origin", and a ref such as - refs/heads/master, yields a version of that ref under the directory, - such as refs/remotes/origin/master. -} -under :: String -> Ref -> Ref -under dir r = Ref $ dir </> show (base r) +underBase :: String -> Ref -> Ref +underBase dir r = Ref $ dir ++ "/" ++ show (base r) {- Checks if a ref exists. -} exists :: Ref -> Repo -> IO Bool @@ -53,11 +53,19 @@ genDescription Nothing = do initialize :: Maybe String -> Annex () initialize mdescription = do prepUUID - setVersion defaultVersion - checkCrippledFileSystem checkFifoSupport - unlessBare $ + checkCrippledFileSystem + unlessM isBare $ hookWrite preCommitHook + ifM (crippledFileSystem <&&> not <$> isBare) + ( do + enableDirectMode + setDirect True + setVersion directModeVersion + , do + setVersion defaultVersion + setDirect False + ) createInodeSentinalFile u <- getUUID {- This will make the first commit to git, so ensure git is set up @@ -91,8 +99,8 @@ ensureInitialized = getVersion >>= maybe needsinit checkUpgrade isInitialized :: Annex Bool isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion -unlessBare :: Annex () -> Annex () -unlessBare = unlessM $ fromRepo Git.repoIsLocalBare +isBare :: Annex Bool +isBare = fromRepo Git.repoIsLocalBare {- A crippled filesystem is one that does not allow making symlinks, - or removing write access from files. -} @@ -125,25 +133,15 @@ checkCrippledFileSystem = whenM probeCrippledFileSystem $ do warning "Detected a crippled filesystem." setCrippledFileSystem True - {- Normally git disables core.symlinks itself when the filesystem does - - not support them, but in Cygwin, git does support symlinks, while - - git-annex, not linking with Cygwin, does not. -} + {- Normally git disables core.symlinks itself when the + - filesystem does not support them, but in Cygwin, git + - does support symlinks, while git-annex, not linking + - with Cygwin, does not. -} whenM (coreSymlinks <$> Annex.getGitConfig) $ do warning "Disabling core.symlinks." setConfig (ConfigKey "core.symlinks") (Git.Config.boolConfig False) - unlessBare $ do - unlessM isDirect $ do - warning "Enabling direct mode." - top <- fromRepo Git.repoPath - (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] - forM_ l $ \f -> - maybe noop (`toDirect` f) =<< isAnnexLink f - void $ liftIO clean - setDirect True - setVersion directModeVersion - probeFifoSupport :: Annex Bool probeFifoSupport = do #ifdef mingw32_HOST_OS @@ -166,3 +164,12 @@ checkFifoSupport = unlessM probeFifoSupport $ do warning "Detected a filesystem without fifo support." warning "Disabling ssh connection caching." setConfig (annexConfig "sshcaching") (Git.Config.boolConfig False) + +enableDirectMode :: Annex () +enableDirectMode = unlessM isDirect $ do + warning "Enabling direct mode." + top <- fromRepo Git.repoPath + (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] + forM_ l $ \f -> + maybe noop (`toDirect` f) =<< isAnnexLink f + void $ liftIO clean diff --git a/doc/todo/direct_mode_guard.mdwn b/doc/todo/direct_mode_guard.mdwn index 9fbb21cd3..bb7f90897 100644 --- a/doc/todo/direct_mode_guard.mdwn +++ b/doc/todo/direct_mode_guard.mdwn @@ -96,7 +96,10 @@ even when `receive.denyCurrentBranch` is set.) > branch. However, won't work on crippled filesystems! (No +x bit) > > Could make git annex sync detect this. It could reset the master -> branch to the last one committed, before committing. Will work, -> does have the minor oddity that eg `git log` will show commits -> pushed to master before `git annex sync` has been run and so before -> those commits are reflected in the tree. +> branch to the last one committed, before committing. Seems very racy +> and hard to get right! +> +> Could make direct mode operate on a different branch, like +> `annex/direct/master` rather than `master`. Avoid pushing to that +> branch (`git annex sync` can map back from it to `master` and push there +> instead). A bit clumsy, but works. |