c784ef4586
Removed old extensible-exceptions, only needed for very old ghc. Made webdav use Utility.Exception, to work after some changes in DAV's exception handling. Removed Annex.Exception. Mostly this was trivial, but note that tryAnnex is replaced with tryNonAsync and catchAnnex replaced with catchNonAsync. In theory that could be a behavior change, since the former caught all exceptions, and the latter don't catch async exceptions. However, in practice, nothing in the Annex monad uses async exceptions. Grepping for throwTo and killThread only find stuff in the assistant, which does not seem related. Command.Add.undo is changed to accept a SomeException, and things that use it for rollback now catch non-async exceptions, rather than only IOExceptions.
66 lines
1.9 KiB
Haskell
66 lines
1.9 KiB
Haskell
{- git-annex environment
|
|
-
|
|
- Copyright 2012, 2013 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Annex.Environment where
|
|
|
|
import Common.Annex
|
|
import Utility.UserInfo
|
|
import qualified Git.Config
|
|
import Config
|
|
|
|
#ifndef mingw32_HOST_OS
|
|
import Utility.Env
|
|
#endif
|
|
|
|
{- Checks that the system's environment allows git to function.
|
|
- Git requires a GECOS username, or suitable git configuration, or
|
|
- environment variables.
|
|
-
|
|
- Git also requires the system have a hostname containing a dot.
|
|
- Otherwise, it tries various methods to find a FQDN, and will fail if it
|
|
- does not. To avoid replicating that code here, which would break if its
|
|
- methods change, this function does not check the hostname is valid.
|
|
- Instead, code that commits can use ensureCommit.
|
|
-}
|
|
checkEnvironment :: Annex ()
|
|
checkEnvironment = do
|
|
gitusername <- fromRepo $ Git.Config.getMaybe "user.name"
|
|
when (isNothing gitusername || gitusername == Just "") $
|
|
liftIO checkEnvironmentIO
|
|
|
|
checkEnvironmentIO :: IO ()
|
|
checkEnvironmentIO =
|
|
#ifdef mingw32_HOST_OS
|
|
noop
|
|
#else
|
|
whenM (null <$> myUserGecos) $ do
|
|
username <- myUserName
|
|
ensureEnv "GIT_AUTHOR_NAME" username
|
|
ensureEnv "GIT_COMMITTER_NAME" username
|
|
where
|
|
#ifndef __ANDROID__
|
|
-- existing environment is not overwritten
|
|
ensureEnv var val = void $ setEnv var val False
|
|
#else
|
|
-- Environment setting is broken on Android, so this is dealt with
|
|
-- in runshell instead.
|
|
ensureEnv _ _ = noop
|
|
#endif
|
|
#endif
|
|
|
|
{- Runs an action that commits to the repository, and if it fails,
|
|
- sets user.email and user.name to a dummy value and tries the action again. -}
|
|
ensureCommit :: Annex a -> Annex a
|
|
ensureCommit a = either retry return =<< tryNonAsync a
|
|
where
|
|
retry _ = do
|
|
name <- liftIO myUserName
|
|
setConfig (ConfigKey "user.name") name
|
|
setConfig (ConfigKey "user.email") name
|
|
a
|