fail early on a few conditions

1 files changed, 12 insertions, 6 deletions

diff --git a/fsmgr.hs b/fsmgr.hs
index 6d559aa..e87ebc9 100644
--- a/fsmgr.hs
+++ b/fsmgr.hs
@@ -20,11 +20,13 @@ import Development.Shake.Command  ()
 import Development.Shake.FilePath
 
 import qualified Options.Applicative as Opt
-         ;import Options.Applicative hiding (action)
+         ;import Options.Applicative hiding (action, command)
 
 import ConfigFile
 import System.Directory     (createDirectoryIfMissing)
 import System.Posix.Process (getProcessID)
+import System.Posix.Types   (CUid (..))
+import System.Posix.User    (getEffectiveUserID)
 
 noParent :: BaseImageSpecification -> Bool
 noParent (EmptyImageOfBytes _)     = True
@@ -121,9 +123,6 @@ buildOpts = Build . BuildOpts <$> argument str idm
 chrootOpts :: Parser Command
 chrootOpts = fmap Chroot $ ChrootOpts <$> argument str idm <*> many (argument str idm)
 
--- TODO: Fail early on:
--- 1. not running as root
--- 2. no "selfstrap" in PATH
 main :: IO ()
 main = customExecParser (prefs showHelpOnEmpty) (info opts desc) >>= run
   where
@@ -142,8 +141,8 @@ main = customExecParser (prefs showHelpOnEmpty) (info opts desc) >>= run
     info' o d = info (helper <*> o) (progDesc $ unwords d)
 
 run :: Options -> IO ()
-run (Options (Build (BuildOpts target)))        = shakeBuildOneImage target
-run (Options (Chroot (ChrootOpts target args))) = chrootImage target args
+run (Options (Build (BuildOpts target)))        = earlyFail >> shakeBuildOneImage target
+run (Options (Chroot (ChrootOpts target args))) = earlyFail >> chrootImage target args
 
 useCGroups :: Bool
 useCGroups = True               -- TODO: make command-line option
@@ -215,6 +214,13 @@ cgroupChroot groupName mnt args = do
     "sh -exc" ["mount -t proc proc /proc; mount -t devpts devpts /dev/pts; exec \"$@\""]
     "sh" args
 
+earlyFail :: IO ()
+earlyFail = do
+  CUid euid <- liftIO getEffectiveUserID
+  when (euid /= 0) $ fail "you are not root"
+  Stdout () <- cmd (Traced []) "which selfstrap"
+  return ()
+
 shakeRules :: Rules ()
 shakeRules = do
   "_build/*.yaml.canon" %> \out -> do