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.

diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs
index d04f9d8700f7bedcf8fa6ccd8238d3955ee57894..66c27a15528bfbcdd0b9a3b7d28c8c50e570407e 100644 (file)
--- a/Assistant/WebApp/Configurators/Pairing.hs
+++ b/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

diff --git a/Command/EnableTor.hs b/Command/EnableTor.hs
index 6f145413d0b8fefe34f3215c827051cde3365399..27e57d6495c8c5b54d8a3e81c2cb87d41315526b 100644 (file)
--- a/Command/EnableTor.hs
+++ b/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

diff --git a/Utility/Su.hs b/Utility/Su.hs
index 44a95c39f885c4a6dbdbe4cf2e5af838b1b605cb..b8df07dd31fe545e24618751685ddf4c3c05143a 100644 (file)
--- a/Utility/Su.hs
+++ b/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)

diff --git a/templates/configurators/pairing/wormhole/start.hamlet b/templates/configurators/pairing/wormhole/start.hamlet
index 605efe919efcb651029515c53423ecfa5ed8fcd1..2284cd0068e3fc5ad1b4f0d418d53bfa93af0eaa 100644 (file)
--- a/templates/configurators/pairing/wormhole/start.hamlet
+++ b/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.