Server: add setuid/setgid capabilities

machine/configuration.nix

@@ -22,7 +22,7 @@ let
       if [[ $2 =~ $regex ]]
       then
         username="''${BASH_REMATCH[1]}"
-        cty --user $username --socket /curiosity.sock $SSH_ORIGINAL_COMMAND
+        cty --user $username --socket /run/curiosity.sock $SSH_ORIGINAL_COMMAND
       else
         echo "Expecting 'cty --user <username>' command prefix."
         exit 1

modules/curiosity.nix

@@ -29,6 +29,9 @@
         --data-dir ${(import ../.).data} \
         --scenarios-dir ${(import ../.).scenarios} \
         --stdout
+        --unix-socket-path /run/curiosity.sock
+        --user-name curiosity
+        --user-group curiosity
       '';
 
       # Hardening Options

src/Curiosity/Parse.hs

@@ -37,14 +37,20 @@ makeLenses ''Conf
 
 -- | HTTP server config.
 data ServerConf = ServerConf
-  { _serverPort          :: Int
-  , _serverStaticDir     :: FilePath
-  , _serverDataDir       :: FilePath
-  , _serverScenariosDir  :: FilePath
-  , _serverCookie        :: SAuth.CookieSettings
+  { _serverPort           :: Int
+  , _serverStaticDir      :: FilePath
+  , _serverDataDir        :: FilePath
+  , _serverScenariosDir   :: FilePath
+  , _serverCookie         :: SAuth.CookieSettings
     -- ^ Settings for setting cookies as a server (for authentication etc.).
-  , _serverUnixDomain    :: Bool
+  , _serverUnixDomain     :: Bool
     -- ^ Enable (when True) the UNIX-domain socket server.
+  , _serverUnixSocketPath :: Text
+    -- ^ Path pointing to the Unix socket. Will defaults to $PWD/curiosity.sock.
+  , _serverUserName       :: Maybe Text
+    -- ^ User name used to run the server. Will default to the current one if Nothing.
+  , _serverGroupName      :: Maybe Text
+    -- ^ Group name used to run the server. Will default to the current one if Nothing.
   }
   deriving (Eq, Show)
 
@@ -101,6 +107,18 @@ serverParser = do
     )
   _serverUnixDomain <- not <$> A.switch
     (A.long "no-socket" <> A.help "Disable the UNIX-domain socket server.")
+  _serverUnixSocketPath <- A.strOption
+    (A.long "unix-socket-path" <> A.value "./curiosity.sock" <> A.metavar "UNIX-SOCK" <> A.help
+       "Path pointing to the Unix socket."
+    )
+  _serverUserName <- optional $ A.strOption
+    (A.long "user-name" <> A.metavar "USER-NAME" <> A.help
+       "User name used to run curiosity."
+    )
+  _serverGroupName <- optional $ A.strOption
+    (A.long "group-name" <> A.metavar "GROUP-NAME" <> A.help
+       "Group name to run curiosity."
+    )
 
   pure ServerConf
     {
@@ -115,16 +133,19 @@ serverParser = do
 
 defaultServerConf :: ServerConf
 defaultServerConf = ServerConf
-  { _serverCookie        = SAuth.defaultCookieSettings
-                             { SAuth.cookieIsSecure    = SAuth.NotSecure
-                             , SAuth.cookieXsrfSetting = Nothing
-                             , SAuth.cookieSameSite    = SAuth.SameSiteStrict
-                             }
-  , _serverPort          = 9000
-  , _serverStaticDir     = "./_site/"
-  , _serverDataDir       = "./data/"
-  , _serverScenariosDir  = "./scenarios/"
-  , _serverUnixDomain    = True
+  { _serverCookie         = SAuth.defaultCookieSettings
+                              { SAuth.cookieIsSecure    = SAuth.NotSecure
+                              , SAuth.cookieXsrfSetting = Nothing
+                              , SAuth.cookieSameSite    = SAuth.SameSiteStrict
+                              }
+  , _serverPort           = 9000
+  , _serverStaticDir      = "./_site/"
+  , _serverDataDir        = "./data/"
+  , _serverScenariosDir   = "./scenarios/"
+  , _serverUnixDomain     = True
+  , _serverUnixSocketPath = "./curiosity.sock"
+  , _serverUserName       = Nothing
+  , _serverGroupName      = Nothing
   }
 
 

src/Curiosity/Process.hs

@@ -18,7 +18,7 @@ import qualified Curiosity.Server              as Srv
 --------------------------------------------------------------------------------
 startServer :: Command.ServerConf -> Rt.Runtime -> IO Errs.RuntimeErr
 startServer conf runtime@Rt.Runtime {..} = do
-  let Command.ServerConf port _ _ _ _ _ = conf
+  let port = Command._serverPort conf
   startupLogInfo _rLoggers $ "Starting up server on port " <> show port <> "..."
   try @SomeException (Srv.run conf runtime) >>= pure . either
     Errs.RuntimeException

src/Curiosity/Run.hs

@@ -25,6 +25,7 @@ import qualified System.Console.Haskeline      as HL
 import           System.Directory               ( doesFileExist )
 import           System.Environment             ( lookupEnv )
 import           System.Posix.User              ( getLoginName )
+import qualified System.Posix.User             as PU
 
 
 --------------------------------------------------------------------------------
@@ -239,12 +240,21 @@ run (Command.CommandWithTarget command target (Command.User user)) = do
 
 --------------------------------------------------------------------------------
 handleServe :: P.Conf -> P.ServerConf -> IO ExitCode
-handleServe conf serverConf = do
+handleServe conf serverConf@P.ServerConf{..} = do
+  muserEntry <- mapM (PU.getUserEntryForName . T.unpack) _serverUserName
+  mgroupEntry <- mapM (PU.getGroupEntryForName . T.unpack) _serverGroupName
+  let muid = PU.userID <$> muserEntry
+  let mgid = PU.groupID <$> mgroupEntry
+  -- Note: setOwnerAndGroup won't change a uid/gid if it's set to -1.
+  let uid = fromMaybe (-1) muid
+  let gid = fromMaybe (-1) mgid
+
   threads <- Rt.emptyHttpThreads
   runtime@Rt.Runtime {..} <- Rt.bootConf conf threads >>= either throwIO pure
   Rt.runRunM runtime Rt.spawnEmailThread
+  let unixSocketConf = Rt.UnixSocket _serverUnixSocketPath uid gid
   when (P._serverUnixDomain serverConf) $
-    void $ Rt.runRunM runtime Rt.spawnUnixThread
+    void $ Rt.runRunM runtime $ Rt.spawnUnixThread unixSocketConf
   P.startServer serverConf runtime >>= P.endServer _rLoggers
   mPowerdownErrs <- Rt.powerdown runtime
   maybe exitSuccess throwIO mPowerdownErrs
@@ -255,7 +265,7 @@ handleSock :: P.Conf -> IO ExitCode
 handleSock conf = do
   putStrLn @Text "Creating runtime..."
   runtime <- Rt.bootConf conf Rt.NoThreads >>= either throwIO pure
-  Rt.runWithRuntime runtime
+  Rt.runWithRuntime runtime $ Rt.UnixSocket "./curiosity.sock" (-1) (-1)
   exitSuccess
 
 

src/Curiosity/Runtime.hs

@@ -8,6 +8,7 @@ module Curiosity.Runtime
   ( emptyReplThreads
   , emptyHttpThreads
   , spawnEmailThread
+  , UnixSocket(..)
   , spawnUnixThread
   , runWithRuntime
   , RunM(..)
@@ -116,6 +117,7 @@ import           Data.List                      ( lookup
                                                 , nub
                                                 )
 import qualified Data.Map                      as M
+import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as T
 import qualified Data.Text.Lazy                as LT
 import           Data.UnixTime                  ( formatUnixTime
@@ -131,6 +133,9 @@ import qualified Options.Applicative           as A
 import           Prelude                 hiding ( state )
 import qualified Servant
 import           System.PosixCompat.Types       ( EpochTime )
+import qualified System.Posix.Files            as PF
+import qualified System.Posix.User             as PU
+import           System.Posix.Types             ( UserID, GroupID )
 
 --------------------------------------------------------------------------------
 showThreads :: Threads -> IO [Text]
@@ -351,34 +356,42 @@ verifyEmailStepDryRun = do
   db <- asks _rDb
   atomicallyM $ filterUsers db User.PredicateEmailAddrToVerify
 
-spawnUnixThread :: RunM Text
-spawnUnixThread = do
+data UnixSocket = UnixSocket {
+  _unixSocketPath :: Text,
+  _unixSocketUid  :: UserID,
+  -- ^ Let's align with the POSIX conventions here. -1 == Nothing. :P
+  _unixSocketGid  :: GroupID
+  -- ^ Let's align with the POSIX conventions here. -1 == Nothing. :P
+  } deriving (Eq, Show)
+
+spawnUnixThread :: UnixSocket -> RunM Text
+spawnUnixThread usocket = do
   runtime <- ask
   ts      <- asks _rThreads
   case ts of
     NoThreads              -> pure "Threads are disabled."
     ReplThreads _          -> pure "No UNIX-domain socket thread in REPL." -- TODO
-    HttpThreads _ mvarUnix -> spawnUnixThread' runtime mvarUnix
+    HttpThreads _ mvarUnix -> spawnUnixThread' runtime mvarUnix usocket
 
-spawnUnixThread' :: Runtime -> MVar ThreadId -> RunM Text
-spawnUnixThread' runtime mvar = do
+spawnUnixThread' :: Runtime -> MVar ThreadId -> UnixSocket -> RunM Text
+spawnUnixThread' runtime mvar usocket = do
   mthread <- liftIO $ tryTakeMVar mvar
   case mthread of
     Nothing -> do
       ML.localEnv (<> "Threads" <> "UNIX") $ do
         ML.info "Starting UNIX-domain socket thread."
       liftIO $ do
-        t <- forkIO $ runRunM runtime unixThread
+        t <- forkIO $ runRunM runtime $ unixThread usocket
         putMVar mvar t
         pure "UNIX-domain socket thread started."
     Just t -> do
       liftIO $ putMVar mvar t
       pure "UNIX-domain socket thread alread running."
 
-unixThread :: RunM ()
-unixThread = do
+unixThread :: UnixSocket -> RunM ()
+unixThread usocket = do
   runtime <- ask
-  liftIO $ runWithRuntime runtime
+  liftIO $ runWithRuntime runtime usocket
 
 -- | Natural transformation from some `AppM` in any given mode, to a servant
 -- Handler.
@@ -391,7 +404,7 @@ appMHandlerNatTrans rt appM =
       unwrapReaderT          = (`runReaderT` rt) . runAppM $ appM
       -- Map our errors to `ServantError`
       runtimeErrToServantErr = withExceptT Errs.asServantError
-  in 
+  in
       -- Re-wrap as servant `Handler`
       Servant.Handler $ runtimeErrToServantErr unwrapReaderT
 
@@ -1772,13 +1785,22 @@ deleteForm getTVar db (profile, key) =
 
 
 --------------------------------------------------------------------------------
-runWithRuntime runtime = do
-  putStrLn @Text "Creating curiosity.sock..." -- fixme: use logger?
+runWithRuntime runtime UnixSocket{..} = do
+  let usock = T.unpack _unixSocketPath
+  putStrLn @Text $ "Creating " <> _unixSocketPath <> "..." -- fixme: use logger?
   sock <- socket AF_UNIX Stream 0
-  bind sock $ SockAddrUnix "curiosity.sock"
+  bind sock $ SockAddrUnix usock
+  -- Setting the right socket permissions
+  PF.setOwnerAndGroup usock _unixSocketUid _unixSocketGid
   listen sock maxListenQueue
-
-  putStrLn @Text "Listening on curiosity.sock..." -- fixme: use logger?
+  -- Setting the process real UID/GID.
+  -- Implementation note: this has to happen *after* we created/chown
+  -- the socket but *before* we enter the server main loop.
+  when (_unixSocketUid /= -1) $
+    PU.setUserID _unixSocketUid
+  when (_unixSocketGid /= -1) $
+    PU.setGroupID _unixSocketGid
+  putStrLn @Text $ "Listening on " <> _unixSocketPath <> "..." -- fixme: use logger?
   server runtime sock -- TODO bracket (or catch) and close
   close sock