d41849bc23
Support users who have set commit.gpgsign, by disabling gpg signatures for git-annex branch commits and commits made by the assistant. The thinking here is that a user sets commit.gpgsign intending the commits that they manually initiate to be gpg signed. But not commits made in the background, whether by a deamon or implicitly to the git-annex branch. gpg signing those would be at best a waste of CPU and at worst would fail, or flood the user with gpg passphrase prompts, or put their signature on changes they did not directly do. See Debian bug #753720. Also makes all commits done by git-annex go through a few central control points, to make such changes easier in future. Also disables commit.gpgsign in the test suite. This commit was sponsored by Antoine Boegli.
70 lines
1.5 KiB
Haskell
70 lines
1.5 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Direct where
|
|
|
|
import Control.Exception.Extensible
|
|
|
|
import Common.Annex
|
|
import Command
|
|
import qualified Git
|
|
import qualified Git.LsFiles
|
|
import qualified Git.Branch
|
|
import Config
|
|
import Annex.Direct
|
|
import Annex.Exception
|
|
|
|
def :: [Command]
|
|
def = [notBareRepo $ noDaemonRunning $
|
|
command "direct" paramNothing seek
|
|
SectionSetup "switch repository to direct mode"]
|
|
|
|
seek :: CommandSeek
|
|
seek = withNothing start
|
|
|
|
start :: CommandStart
|
|
start = ifM isDirect ( stop , next perform )
|
|
|
|
perform :: CommandPerform
|
|
perform = do
|
|
showStart "commit" ""
|
|
showOutput
|
|
_ <- inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit
|
|
[ Param "-a"
|
|
, Param "-m"
|
|
, Param "commit before switching to direct mode"
|
|
]
|
|
showEndOk
|
|
|
|
top <- fromRepo Git.repoPath
|
|
(l, clean) <- inRepo $ Git.LsFiles.inRepo [top]
|
|
forM_ l go
|
|
void $ liftIO clean
|
|
next cleanup
|
|
where
|
|
go = whenAnnexed $ \f k -> do
|
|
r <- toDirectGen k f
|
|
case r of
|
|
Nothing -> noop
|
|
Just a -> do
|
|
showStart "direct" f
|
|
r' <- tryAnnex a
|
|
case r' of
|
|
Left e -> warnlocked e
|
|
Right _ -> showEndOk
|
|
return Nothing
|
|
|
|
warnlocked :: SomeException -> Annex ()
|
|
warnlocked e = do
|
|
warning $ show e
|
|
warning "leaving this file as-is; correct this problem and run git annex fsck on it"
|
|
|
|
cleanup :: CommandCleanup
|
|
cleanup = do
|
|
showStart "direct" ""
|
|
setDirect True
|
|
return True
|