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.

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

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

Assistant/Gpg.hs

@@ -17,7 +17,7 @@ import qualified Data.Map as M
 newUserId :: GpgCmd -> IO UserId
 newUserId cmd = do
 	oldkeys <- secretKeys cmd
-	username <- myUserName
+	username <- either (const "unknown") id <$> myUserName
 	let basekeyname = username ++ "'s git-annex encryption key"
 	return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys)
 		( basekeyname

Assistant/WebApp/Configurators/Pairing.hs

@@ -226,7 +226,7 @@ startLocalPairing stage oncancel alert muuid displaysecret secret = do
 		let pubkey = either error id $ validateSshPubKey $ sshPubKey keypair
 		pairdata <- liftIO $ PairData
 			<$> getHostname
-			<*> myUserName
+			<*> (either error id <$> myUserName)
 			<*> pure reldir
 			<*> pure pubkey
 			<*> (maybe genUUID return muuid)
@@ -291,8 +291,8 @@ promptSecret msg cont = pairPage $ do
 		let (username, hostname) = maybe ("", "")
 			(\(_, v, a) -> (T.pack $ remoteUserName v, T.pack $ fromMaybe (showAddr a) (remoteHostName v)))
 			(verifiableVal . fromPairMsg <$> msg)
-		u <- T.pack <$> liftIO myUserName
-		let sameusername = username == u
+		u <- liftIO myUserName
+		let sameusername = Right username == (T.pack <$> u)
 		$(widgetFile "configurators/pairing/local/prompt")
 
 {- This counts unicode characters as more than one character,

Assistant/WebApp/Configurators/Ssh.hs

@@ -156,10 +156,10 @@ getAddSshR :: Handler Html
 getAddSshR = postAddSshR
 postAddSshR :: Handler Html
 postAddSshR = sshConfigurator $ do
-	username <- liftIO $ T.pack <$> myUserName
+	username <- liftIO $ either (const Nothing) (Just . T.pack) <$> myUserName
 	((result, form), enctype) <- liftH $
 		runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ sshInputAForm textField $
-			SshInput Nothing (Just username) Password Nothing Nothing 22
+			SshInput Nothing username Password Nothing Nothing 22
 	case result of
 		FormSuccess sshinput -> do
 			s <- liftAssistant $ testServer sshinput

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