assistant: Detect when system is not configured with a user name, and set environment to prevent git from failing.
This commit is contained in:
		
					parent
					
						
							
								24df1f6ee0
							
						
					
				
			
			
				commit
				
					
						13d2fffb2d
					
				
			
		
					 4 changed files with 35 additions and 1 deletions
				
			
		| 
						 | 
				
			
			@ -151,6 +151,7 @@ import Assistant.Threads.XMPPClient
 | 
			
		|||
#else
 | 
			
		||||
#warning Building without the webapp. You probably need to install Yesod..
 | 
			
		||||
#endif
 | 
			
		||||
import Assistant.Environment
 | 
			
		||||
import qualified Utility.Daemon
 | 
			
		||||
import Utility.LogFile
 | 
			
		||||
import Utility.ThreadScheduler
 | 
			
		||||
| 
						 | 
				
			
			@ -178,6 +179,7 @@ startDaemon assistant foreground webappwaiter
 | 
			
		|||
startAssistant :: Bool -> (IO () -> IO ()) -> Maybe (String -> FilePath -> IO ()) -> Annex ()
 | 
			
		||||
startAssistant assistant daemonize webappwaiter = withThreadState $ \st -> do
 | 
			
		||||
	checkCanWatch
 | 
			
		||||
	when assistant $ checkEnvironment
 | 
			
		||||
	dstatus <- startDaemonStatus
 | 
			
		||||
	liftIO $ daemonize $
 | 
			
		||||
		flip runAssistant go =<< newAssistantData st dstatus
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										26
									
								
								Assistant/Environment.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										26
									
								
								Assistant/Environment.hs
									
										
									
									
									
										Normal file
									
								
							| 
						 | 
				
			
			@ -0,0 +1,26 @@
 | 
			
		|||
{- git-annex assistant environment
 | 
			
		||||
 -
 | 
			
		||||
 - Copyright 2012 Joey Hess <joey@kitenet.net>
 | 
			
		||||
 -
 | 
			
		||||
 - Licensed under the GNU GPL version 3 or higher.
 | 
			
		||||
 -}
 | 
			
		||||
 | 
			
		||||
module Assistant.Environment where
 | 
			
		||||
 | 
			
		||||
import Assistant.Common
 | 
			
		||||
import Utility.UserInfo
 | 
			
		||||
import qualified Git.Config
 | 
			
		||||
 | 
			
		||||
import System.Posix.Env
 | 
			
		||||
 | 
			
		||||
{- Checks that the system's environment allows git to function.
 | 
			
		||||
 - Git requires a GECOS username, or suitable git configuration, or
 | 
			
		||||
 - environment variables. -}
 | 
			
		||||
checkEnvironment :: Annex ()
 | 
			
		||||
checkEnvironment = do
 | 
			
		||||
	username <- liftIO myUserName
 | 
			
		||||
	gecos <- liftIO myUserGecos
 | 
			
		||||
	gitusername <- fromRepo $ Git.Config.getMaybe "user.name"
 | 
			
		||||
	when (null gecos && (gitusername == Nothing || gitusername == Just "")) $
 | 
			
		||||
		-- existing environment is not overwritten
 | 
			
		||||
		liftIO $ setEnv "GIT_AUTHOR_NAME" username False
 | 
			
		||||
| 
						 | 
				
			
			@ -7,7 +7,8 @@
 | 
			
		|||
 | 
			
		||||
module Utility.UserInfo (
 | 
			
		||||
	myHomeDir,
 | 
			
		||||
	myUserName
 | 
			
		||||
	myUserName,
 | 
			
		||||
	myUserGecos,
 | 
			
		||||
) where
 | 
			
		||||
 | 
			
		||||
import Control.Applicative
 | 
			
		||||
| 
						 | 
				
			
			@ -24,6 +25,9 @@ myHomeDir = myVal ["HOME"] homeDirectory
 | 
			
		|||
myUserName :: IO String
 | 
			
		||||
myUserName = myVal ["USER", "LOGNAME"] userName
 | 
			
		||||
 | 
			
		||||
myUserGecos :: IO String
 | 
			
		||||
myUserGecos = myVal [] userGecos
 | 
			
		||||
 | 
			
		||||
myVal :: [String] -> (UserEntry -> String) -> IO String
 | 
			
		||||
myVal envvars extract = maybe (extract <$> getpwent) return =<< check envvars
 | 
			
		||||
  where
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										2
									
								
								debian/changelog
									
										
									
									
										vendored
									
									
								
							
							
						
						
									
										2
									
								
								debian/changelog
									
										
									
									
										vendored
									
									
								
							| 
						 | 
				
			
			@ -5,6 +5,8 @@ git-annex (3.20130105) UNRELEASED; urgency=low
 | 
			
		|||
  * assistant: Make expensive transfer scan work fully in direct mode.
 | 
			
		||||
  * More commands work in direct mode repositories: find, whereis, move, copy,
 | 
			
		||||
    drop, log.
 | 
			
		||||
  * assistant: Detect when system is not configured with a user name,
 | 
			
		||||
    and set environment to prevent git from failing.
 | 
			
		||||
 | 
			
		||||
 -- Joey Hess <joeyh@debian.org>  Thu, 03 Jan 2013 14:58:45 -0400
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue