From d4c642e989ab10e476757dbdc48c0d5dd6b3bb8b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 6 Jan 2013 13:34:08 -0400
Subject: assistant: Detect when system is not configured with a user name, and
 set environment to prevent git from failing.

---
 Assistant.hs             |  2 ++
 Assistant/Environment.hs | 26 ++++++++++++++++++++++++++
 Utility/UserInfo.hs      |  6 +++++-
 debian/changelog         |  2 ++
 4 files changed, 35 insertions(+), 1 deletion(-)
 create mode 100644 Assistant/Environment.hs

diff --git a/Assistant.hs b/Assistant.hs
index a0d4ed2ff..e529df487 100644
--- a/Assistant.hs
+++ b/Assistant.hs
@@ -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
diff --git a/Assistant/Environment.hs b/Assistant/Environment.hs
new file mode 100644
index 000000000..3153fcfe5
--- /dev/null
+++ b/Assistant/Environment.hs
@@ -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
diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs
index bdddf4f8e..8fba3e17f 100644
--- a/Utility/UserInfo.hs
+++ b/Utility/UserInfo.hs
@@ -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
diff --git a/debian/changelog b/debian/changelog
index abc06ce47..59021ca7c 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -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
 
-- 
cgit v1.2.3