also avoid crashing in most circumstances if unable to determine the username

Mostly the username is only used for the git committer or other display
purposes, and we can just fall back to a dummy value in these cases.

The only remaining place where an error is thrown is when starting local
pairing, which needs the username to be known.

3 files changed, 14 insertions, 16 deletions

diff --git a/Annex/Environment.hs b/Annex/Environment.hs
index a066e9ab0..4f0fda986 100644
--- a/Annex/Environment.hs
+++ b/Annex/Environment.hs
@@ -33,7 +33,7 @@ checkEnvironment = do
 
 checkEnvironmentIO :: IO ()
 checkEnvironmentIO = whenM (isNothing <$> myUserGecos) $ do
-	username <- myUserName
+	username <- either (const "unknown") id <$> myUserName
 	ensureEnv "GIT_AUTHOR_NAME" username
 	ensureEnv "GIT_COMMITTER_NAME" username
   where
@@ -52,7 +52,7 @@ ensureCommit :: Annex a -> Annex a
 ensureCommit a = either retry return =<< tryNonAsync a 
   where
 	retry _ = do
-		name <- liftIO myUserName
+		name <- liftIO $ either (const "unknown") id <$> myUserName
 		setConfig (ConfigKey "user.name") name
 		setConfig (ConfigKey "user.email") name
 		a
diff --git a/Annex/Init.hs b/Annex/Init.hs
index e12a8bc80..08dd91a71 100644
--- a/Annex/Init.hs
+++ b/Annex/Init.hs
@@ -52,13 +52,11 @@ genDescription (Just d) = return d
 genDescription Nothing = do
 	reldir <- liftIO . relHome =<< liftIO . absPath =<< fromRepo Git.repoPath
 	hostname <- fromMaybe "" <$> liftIO getHostname
-#ifndef mingw32_HOST_OS
 	let at = if null hostname then "" else "@"
-	username <- liftIO myUserName
-	return $ concat [username, at, hostname, ":", reldir]
-#else
-	return $ concat [hostname, ":", reldir]
-#endif
+	v <- liftIO myUserName
+	return $ concat $ case v of
+		Right username -> [username, at, hostname, ":", reldir]
+		Left _ -> [hostname, ":", reldir]
 
 initialize :: Maybe String -> Maybe Version -> Annex ()
 initialize mdescription mversion = do
diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs
index c2edde24e..ec0b0d0b2 100644
--- a/Utility/UserInfo.hs
+++ b/Utility/UserInfo.hs
@@ -15,7 +15,7 @@ module Utility.UserInfo (
 ) where
 
 import Utility.Env
-import Utility.Exception
+import Utility.Data
 
 import System.PosixCompat
 import Control.Applicative
@@ -25,7 +25,7 @@ import Prelude
  -
  - getpwent will fail on LDAP or NIS, so use HOME if set. -}
 myHomeDir :: IO FilePath
-myHomeDir = myVal env homeDirectory
+myHomeDir = either error return =<< myVal env homeDirectory
   where
 #ifndef mingw32_HOST_OS
 	env = ["HOME"]
@@ -34,7 +34,7 @@ myHomeDir = myVal env homeDirectory
 #endif
 
 {- Current user's user name. -}
-myUserName :: IO String
+myUserName :: IO (Either String String)
 myUserName = myVal env userName
   where
 #ifndef mingw32_HOST_OS
@@ -48,15 +48,15 @@ myUserGecos :: IO (Maybe String)
 #if defined(__ANDROID__) || defined(mingw32_HOST_OS)
 myUserGecos = return Nothing
 #else
-myUserGecos = catchMaybeIO $ myVal [] userGecos
+myUserGecos = eitherToMaybe <$> myVal [] userGecos
 #endif
 
-myVal :: [String] -> (UserEntry -> String) -> IO String
+myVal :: [String] -> (UserEntry -> String) -> IO (Either String String)
 myVal envvars extract = go envvars
   where
 #ifndef mingw32_HOST_OS
-	go [] = extract <$> (getUserEntryForID =<< getEffectiveUserID)
+	go [] = Right . extract <$> (getUserEntryForID =<< getEffectiveUserID)
 #else
-	go [] = extract <$> error ("environment not set: " ++ show envvars)
+	go [] = return $ Left ("environment not set: " ++ show envvars)
 #endif
-	go (v:vs) = maybe (go vs) return =<< getEnv v
+	go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v