improve description of password prompting

Since the user does not know whether it will run su or sudo, indicate
whether the password prompt will be for root or the user's password,
when possible.

I assume that programs like gksu that can prompt for either depending on
system setup will make clear in their prompt what they're asking for.

Assistant/WebApp/Configurators/Pairing.hs

@@ -22,6 +22,7 @@ import Utility.Verifiable
 #endif
 import Utility.UserInfo
 import Utility.Tor
+import Utility.Su
 import Assistant.WebApp.Pairing
 import Assistant.Alert
 import qualified Utility.MagicWormhole as Wormhole
@@ -53,7 +54,8 @@ getStartWormholePairSelfR = startWormholePairR PairingWithSelf
 
 startWormholePairR :: PairingWith -> Handler Html
 startWormholePairR pairingwith = whenTorInstalled $ whenWormholeInstalled $
-	pairPage $
+	pairPage $ do
+		sucommand <- liftIO $ mkSuCommand "git-annex" [Param "enable-tor"]
 		$(widgetFile "configurators/pairing/wormhole/start")
 
 getPrepareWormholePairR :: PairingWith -> Handler Html

Command/EnableTor.hs

@@ -49,10 +49,12 @@ start os = do
 			Just userid -> go uuid userid
 		else do
 			showStart "enable-tor" ""
-			showLongNote "Need root access to enable tor..."
 			gitannex <- liftIO readProgramFile
 			let ps = [Param (cmdname cmd), Param (show curruserid)]
-			ifM (liftIO $ runAsRoot gitannex ps)
+			sucommand <- liftIO $ mkSuCommand gitannex ps
+			maybe noop showLongNote
+				(describePasswordPrompt' sucommand)
+			ifM (liftIO $ runSuCommand sucommand)
 				( next $ next checkHiddenService
 				, giveup $ unwords $
 					[ "Failed to run as root:" , gitannex ] ++ toCommand ps

Utility/Su.hs

@@ -12,18 +12,51 @@ import Utility.Env
 
 import System.Posix.Terminal
 
--- Runs a command as root, fairly portably.
+data WhosePassword
+	= RootPassword
+	| UserPassword
+	| SomePassword
+	-- ^ may be user or root; su program should indicate which
+	deriving (Show)
+
+data PasswordPrompt
+	= WillPromptPassword WhosePassword
+	| MayPromptPassword WhosePassword
+	| NoPromptPassword
+	deriving (Show)
+
+describePasswordPrompt :: PasswordPrompt -> Maybe String
+describePasswordPrompt (WillPromptPassword whose) = Just $
+	"You will be prompted for " ++ describeWhosePassword whose ++ " password"
+describePasswordPrompt (MayPromptPassword whose) = Just $
+	"You may be prompted for " ++ describeWhosePassword whose ++ " password"
+describePasswordPrompt NoPromptPassword = Nothing
+
+describeWhosePassword :: WhosePassword -> String
+describeWhosePassword RootPassword = "root's"
+describeWhosePassword UserPassword = "your"
+describeWhosePassword SomePassword = "a"
+
+data SuCommand = SuCommand PasswordPrompt String [CommandParam]
+	deriving (Show)
+
+describePasswordPrompt' :: Maybe SuCommand -> Maybe String
+describePasswordPrompt' (Just (SuCommand p _ _)) = describePasswordPrompt p
+describePasswordPrompt' Nothing = Nothing
+
+runSuCommand :: (Maybe SuCommand) -> IO Bool
+runSuCommand (Just (SuCommand _ cmd ps)) = boolSystem cmd ps
+runSuCommand Nothing = return False
+
+-- Generates a SuCommand that runs a command as root, fairly portably.
 --
 -- Does not use sudo commands if something else is available, because
 -- the user may not be in sudoers and we couldn't differentiate between
 -- that and the command failing. Although, some commands like gksu
 -- decide based on the system's configuration whether sudo should be used.
-runAsRoot :: String -> [CommandParam] -> IO Bool
-runAsRoot cmd ps = go =<< firstM (inPath . fst) =<< selectcmds
+mkSuCommand :: String -> [CommandParam] -> IO (Maybe SuCommand)
+mkSuCommand cmd ps = firstM (\(SuCommand _ p _) -> inPath p) =<< selectcmds
   where
-	go Nothing = return False
-	go (Just (cmd', ps')) = boolSystem cmd' ps'
-
 	selectcmds = ifM (inx <||> (not <$> atconsole))
 		( return (graphicalcmds ++ consolecmds)
 		, return consolecmds
@@ -34,20 +67,27 @@ runAsRoot cmd ps = go =<< firstM (inPath . fst) =<< selectcmds
 
 	-- These will only work when the user is logged into a desktop.
 	graphicalcmds =
-		[ ("gksu", [Param shellcmd])
-		, ("kdesu", [Param shellcmd])
+		[ SuCommand (MayPromptPassword SomePassword) "gksu"
+			[Param shellcmd]
+		, SuCommand (MayPromptPassword SomePassword) "kdesu"
+			[Param shellcmd]
 		-- Available in Debian's menu package; knows about lots of
 		-- ways to gain root.
-		, ("su-to-root", [Param "-X", Param "-c", Param shellcmd])
+		, SuCommand (MayPromptPassword SomePassword) "su-to-root"
+			[Param "-X", Param "-c", Param shellcmd]
 		-- OSX native way to run a command as root, prompts in GUI
-		, ("osascript", [Param "-e", Param ("do shell script \"" ++ shellcmd ++ "\" with administrator privileges")])
+		, SuCommand (WillPromptPassword RootPassword) "osascript"
+			[Param "-e", Param ("do shell script \"" ++ shellcmd ++ "\" with administrator privileges")]
 		]
 	
 	-- These will only work when run in a console.
 	consolecmds = 
-		[ ("su", [Param "-c", Param shellcmd])
-		, ("sudo", [Param cmd] ++ ps)
-		, ("su-to-root", [Param "-c", Param shellcmd])
+		[ SuCommand (WillPromptPassword RootPassword) "su"
+			[Param "-c", Param shellcmd]
+		, SuCommand (MayPromptPassword UserPassword) "sudo"
+			([Param cmd] ++ ps)
+		, SuCommand (MayPromptPassword SomePassword) "su-to-root"
+			[Param "-c", Param shellcmd]
 		]
 	
 	shellcmd = unwords $ map shellEscape (cmd:toCommand ps)

templates/configurators/pairing/wormhole/start.hamlet

@@ -5,9 +5,9 @@
         $of PairingWithSelf
           Preparing for pairing your devices
         $of PairingWithFriend
-          Preparing for pairing with a friend
+          Preparing for sharing with a friend
     <p>
-      Pairing will connect two git-annex repositories using #
+      This will connect two git-annex repositories using #
       <a href="https://torproject.org/">Tor</a>, #
       allowing files to be shared between them.
     <p>
@@ -23,9 +23,13 @@
         <h3>
           Enabling Tor hidden service ...
       <div .modal-body>
+        $case describePasswordPrompt' sucommand
+          $of Nothing
+            #
+          $of (Just promptdesc)
+            <p>
+              #{promptdesc} in order to enable the Tor hidden service.
         <p>
-          This could take a few minutes, and you may be prompted for a #
-          password in order to enable the Tor hidden service.
-        <p>
-          If this is taking too long, check that you are connected to the #
+          This could take several minutes to finish. If it #
+          is taking too long, check that you are connected to the #
           network, and that Tor is working.