From e92f2d1080d29dca3e0279c4239ed53f41fd52af Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 28 Dec 2016 15:55:54 -0400 Subject: [PATCH] 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 | 4 +- Command/EnableTor.hs | 6 +- Utility/Su.hs | 66 +++++++++++++++---- .../pairing/wormhole/start.hamlet | 16 +++-- 4 files changed, 70 insertions(+), 22 deletions(-) diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs index d04f9d8700..66c27a1552 100644 --- 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 6f145413d0..27e57d6495 100644 --- 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 44a95c39f8..b8df07dd31 100644 --- 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 605efe919e..2284cd0068 100644 --- 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

- Pairing will connect two git-annex repositories using # + This will connect two git-annex repositories using # Tor, # allowing files to be shared between them.

@@ -23,9 +23,13 @@

Enabling Tor hidden service ...
+ $case describePasswordPrompt' sucommand + $of Nothing + # + $of (Just promptdesc) +

+ #{promptdesc} in order to enable the Tor hidden service.

- This could take a few minutes, and you may be prompted for a # - password in order to enable the Tor hidden service. -

- 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.