diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,19 @@ # encapsule releases +## 0.4 (2026-08-04) +- convert to using subcommands +- `list`: separate images and containers and include image tags +- introduce `create` to make a permanent container +- add `enter` command (formerly --join) +- `run`: automate unique container name (drop --unique) +- new `refresh` command to update an existing encapsule toolbox image if container has layered changes +- correct some container name sanitizations +- check that the host project dir actually exists +- improve HOME handling and mount project to its own path for clarity +- also default workdir to home for image +- add `--pull` for `run` and `create` to pull a newer image +- Allow mounting $HOME (without SELinux :z relabeling) + ## 0.3 (2026-07-20) - project renamed from constrained-toolbox - rename `--persistent` to `--keep` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,87 +1,81 @@ # encapsule -CLI tool to run developer containers, isolating your home directory and host from container side effects: +CLI tool to run developer containers, isolating your home directory and host from general effects inside the containers: "encapsules" a project and/or temp home dir together with select "capabilities". -Originally derived from [toolbox-constrained](https://github.com/swick/toolbox-constrained) tool. +Originally derived from [toolbox-constrained](https://github.com/swick/toolbox-constrained). Run a ([toolbox](https://containertoolbx.org/)) container or image as -an isolated podman container. Unlike with `toolbox enter`, this does *not* +an isolated podman container. Unlike with `toolbox create`, this does *not* bind-mount your home directory or integrate with the host by default. -You can explicitly choose what dir(s) to mount or features to enable, +You can explicitly choose what dir(s) or file(s) to mount or features to enable, selecting user-configured "capabilities" that the encapsule container can access. ``` -encapsule TOOLBOX [options] [CMD...] +encapsule COMMAND TOOLBOX [options] [CMD...] ``` if TOOLBOX is a container it will be committed (saved) to an "encapsule" container image from the named toolbox container using buildah. - -## Examples - -```bash -# Isolated shell without host fs access -$ encapsule my-toolbox +(Though toolbox containers are recommended, as such it doesn't have to be a toolbox container.) +Your original toolbox container is left untouched: its system configuration and fs are just used as the base fs for the encapsule image. -# Mount current (project) directory in / and set it as the working directory -# (also names the container after the project, e.g. encapsule-my-toolbox-myproject) -$ encapsule my-toolbox -p . +Encapsule images and containers are prefixed by `encapsule-`. -# Bind mount a volume -$ encapsule my-toolbox -v ~/data:/data +## Usage -# Mount a temp "home" directory (created if it doesn't exist) -$ encapsule my-toolbox --home /tmp/somedir +`$ encapsule --version` -# Use capabilities from config -$ encapsule my-toolbox --cap ssh --cap git +``` +0.4 +``` -# Read-only container filesystem -$ encapsule my-toolbox --readonly +`$ encapsule --help` -# Remove the saved image -$ encapsule my-toolbox --delete-image +``` +encapsule -# Set environment variables and prepend to PATH -$ encapsule my-toolbox -e MY_VAR=hello -P ~/.local/bin +Usage: encapsule [--version] COMMAND -# Run a specific command -$ encapsule my-toolbox -- ls / + Run a toolbox image in an isolated podman container + https://github.com/juhp/encapsule#readme -# Dry run: print the full podman command without running it -$ encapsule my-toolbox --dryrun +Available options: + -h,--help Show this help text + --version Show version -# run directly from an image -$ encapsule fedora:44 --home tmphome +Available commands: + list List encapsule images and containers + list-caps List available capabilities + rm Remove an encapsule container + rmi Remove an encapsule image + stop Stop an encapsule container + create Create an encapsule container + enter Connect to a encapsule container + refresh Update an encapsule image from a (toolbox) container + run Run a temporary encapsule container ``` -Encapsule containers are ephemeral by default: use `--keep` to leave the encapsule container around for reuse. Note the saved image will be reused next time unless using `--refresh`. - -### Usage +There are 3 main commands: `run`, `create`, and `enter`. +`run` and `create` share many options. -`$ encapsule --version` +### `run` command -``` -0.3 -``` +`run` starts a temporary encapsule container (removed on exit) +from a (toolbox) image or container. -`$ encapsule --help` +`$ encapsule run --help` ``` -encapsule - -Usage: encapsule [--version] [TOOLBOX] [-v|--volume HOST:CONTAINER[:opts]] - [-e|--env KEY[=VALUE]] [-P|--path DIR] [-i|--init CMD] - [--cap NAME] [--home DIR] [-p|--project DIR] [-n|--name NAME] - [--caps | --list | --remove | --delete-image | --stop] [--keep] - [--readonly] [--no-network] [--no-sudo] [--unique] - [--podman-opt OPTION] [--debug] [--dryrun] [--refresh] [CMD] +Usage: encapsule run TOOLBOX [-v|--volume HOST:CONTAINER[:opts]] + [-e|--env KEY[=VALUE]] [-P|--path DIR] [-i|--init CMD] + [--cap NAME] [--pull] [--home DIR] [-p|--project DIR] + [-n|--name NAME] [--readonly] [--no-network] [--no-sudo] + [--podman-opt OPTION] [--debug] [--dryrun] [--refresh] + [CMD] - Run a toolbox image in an isolated podman container + Run a temporary encapsule container Available options: - -h,--help Show this help text - --version Show version -v,--volume HOST:CONTAINER[:opts] Bind mounts (default to selinux :z) -e,--env KEY[=VALUE] Set or pass through an environment variable @@ -89,31 +83,73 @@ -i,--init CMD A bash snippet run when creating the encapsule container --cap NAME Enable a capability from the config file + --pull Pull newer container image --home DIR Mount a directory as a writable home (created if missing) - -p,--project DIR Mount a project directory and set as workdir - -n,--name NAME Container name (for creating or actions) - --caps List available capabilities from the config file - --list List encapsule images and containers - --remove Remove encapsule container - --delete-image Remove encapsule image - --stop Stop encapsule container - --keep Keep the encapsule container after exiting + -p,--project DIR Mount a (project) directory as workdir + -n,--name NAME Optional container name (prefix with '^' prefix to + skip 'encapsule-' prefix) --readonly Make the encapsule container filesystem read-only --no-network Disable network access --no-sudo Skip passwordless sudo setup - --unique Run a new encapsule container even if one is already - running --podman-opt OPTION Pass an option directly to podman --debug Show debug output --dryrun Print the podman command instead of running it --refresh Force re-commit of the toolbox image + -h,--help Show this help text ``` +### `create` command +`create` is similar but creates a reusable container for a project and/or tmp home. + +### `enter` command +`enter` is used to join an existing (typically running) encapsule container. + +## Examples + +```bash +# Temporary isolated shell without host fs access +~$ encapsule run my-toolbox + +# Mount current (project) directory path and set it as the working directory +# (also names the container after the project, e.g. encapsule-my-toolbox-myproject) +~/myproj$ encapsule create my-toolbox -p . + +# Bind mount a volume +$ encapsule run my-toolbox -v ~/data:/data + +# Mount a temp "home" directory (created if it doesn't exist) +$ encapsule run my-toolbox --home /tmp/somedir + +# Use capabilities from one's config +$ encapsule create my-toolbox --cap ssh --cap git + +# Read-only container filesystem +$ encapsule run my-toolbox --readonly + +# Remove encapsule container +$ encapsule rm my-toolbox + +# Set environment variables and prepend to PATH +$ encapsule run my-toolbox -e MY_VAR=hello -P ~/.local/bin + +# Run a specific command +$ encapsule run my-toolbox -- ls / + +# Dry run: print the full podman command without running it +$ encapsule run --dryrun my-toolbox + +# run directly from an image +$ encapsule run fedora:44 --home tmphome +``` + +Note a saved encapsule image remains cached for next time, +but can be removed with the `rmi` command. + ## Capabilities -Define reusable groups of volumes, environment variables, PATH entries, -and init commands in `~/.config/encapsule/config.toml`: +Capabilities define reusable groups of volumes, environment variables, +PATH entries, and init commands in `~/.config/encapsule/config.toml`: ```toml [capabilities.ssh] @@ -148,7 +184,7 @@ 1. Commits the named toolbox container to an encapsule image using `buildah commit` (reuses the existing image unless `--refresh` is passed) 2. Runs `podman run` with `--userns=keep-id` so you are your own user, not root -3. Tries to install runuser (util-linux) and sudo if they are missing with dnf or apt-get. +3. Tries to install runuser (util-linux) and sudo (unless `--no-sudo`) if they are missing with dnf or apt-get. 4. Sets up passwordless `sudo` inside the encapsule container (unless `--no-sudo`) 5. Bind mounts get SELinux `:z` (shared) labels automatically, so multiple containers can safely access the same directories @@ -159,23 +195,31 @@ ## Installation -A copr repo is available for Fedora and Epel 10: +A copr repo is available for Fedora and EPEL 10: ## Building from source +Install `cabal-install` and `ghc`. + ```bash cabal install ``` -or `stack install`. +(or to build the latest release: `cabal install encapsule`) -## Requirements +### Build with stack +Alternatively you can build with: +``` +stack install +``` +## Runtime Requirements + - [podman](https://podman.io/) and [buildah](https://buildah.io/) - An existing (toolbox) container (created with `toolbox create`) or image. -- Alternatively some non-toolbox other container/images may also work. +- Alternatively some other non-toolbox container/images may also work. ## Related projects @@ -183,7 +227,16 @@ There is also similarly [schupfn](https://github.com/whot/schupfn/) which uses QEMU to run a toolbox container image in a VM with a direct private ssh connection. -For stronger sandboxing and isolation, specially network, consider using [OpenShell](https://github.com/NVIDIA/OpenShell/). +Another somewhat related project is [podenv](https://github.com/podenv/podenv), which "provides a declarative interface to manage containerized applications." + +For stronger sandboxing and isolation, specially network, consider using [OpenShell](https://github.com/NVIDIA/OpenShell/). At some point this project might move to wrapping or supporting openshell possibly. + +## Disclaimer +The simple isolation provided is limited best effort and +comes with no (security) warranty. +Please use this tool at your own risk. + +Reports, suggests, and contributions to improve the tool are very welcome. ## Contribute diff --git a/encapsule.cabal b/encapsule.cabal --- a/encapsule.cabal +++ b/encapsule.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: encapsule -version: 0.3 +version: 0.4 synopsis: Run isolated toolbox containers with podman description: This tool (originally based on the toolbox-constrained project) @@ -46,10 +46,12 @@ , filepath , containers , process + , safe , shell-monad , simple-cmd >= 0.2.3 , simple-cmd-args >= 0.1.8 , text + , time , toml-reader , unix , xdg-basedir diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -4,15 +4,18 @@ module Main (main) where -import Control.Monad (unless, when) -import Data.List.Extra (intercalate, splitOn) +import Control.Monad (unless, void, when, (>=>)) +import Data.List.Extra (intercalate, isPrefixOf, splitOn) import qualified Data.Map.Strict as Map -import Data.Maybe (isJust, isNothing, mapMaybe) +import Data.Maybe (fromMaybe, isNothing, mapMaybe) import qualified Data.Text as T import qualified Data.Text.Lazy as TL -import System.Directory (canonicalizePath, createDirectoryIfMissing, doesFileExist, doesPathExist, getHomeDirectory) +import Safe (headMay, lastMay) +import System.Directory (canonicalizePath, createDirectoryIfMissing, + doesDirectoryExist, doesFileExist, doesPathExist, + getHomeDirectory, getModificationTime) import System.Environment.XDG.BaseDir (getUserConfigFile) -import System.Exit (exitWith) +import System.Exit (exitWith, exitFailure) import System.FilePath ((), takeFileName) import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout) import System.Posix.Process (getProcessID) @@ -20,7 +23,9 @@ import System.Posix.Files (getFileStatus, isSocket) import System.Posix.User (getEffectiveUserName) import System.Process (rawSystem) -import SimpleCmd (cmd_, cmdBool, cmdFull, error', warning, (+-+)) +import Data.Time.Clock (UTCTime) +import Data.Time.Format (defaultTimeLocale, parseTimeM) +import SimpleCmd (cmd_, cmdBool, cmdFull, cmdLines, warning, (+-+)) import SimpleCmdArgs import TOML (Value(..), Table, renderTOMLError, decodeFile) @@ -30,23 +35,191 @@ progname :: String progname = "encapsule" -encapsule :: String -> String -> String -encapsule before after = before +-+ progname +-+ after +data ProjectName = Project FilePath | Name String -data Mode = Caps | DeleteImage | List | Remove | Run | Stop - deriving Eq +main :: IO () +main = do + hSetBuffering stdout NoBuffering + simpleCmdArgs (Just version) + progname + ("Run a toolbox image in an isolated podman container" +-+ + "https://github.com/juhp/encapsule#readme") $ + subcommands + -- FIXME add/separate: create/enter/run + [ Subcommand "list" "List encapsule images and containers" $ + pure listCmd + , Subcommand "list-caps" "List available capabilities" $ + pure listCapsCmd + , Subcommand "rm" "Remove an encapsule container" $ + removeCmd + <$> toolboxArg + <*> optional projectNameOpt + , Subcommand "rmi" "Remove an encapsule image" $ + removeImageCmd + <$> dryrunOpt + <*> toolboxArg + , Subcommand "stop" "Stop an encapsule container" $ + stopCmd + <$> toolboxArg + <*> optional projectNameOpt + , Subcommand "create" "Create an encapsule container" $ + runCmd <$> runOpts True False False + , Subcommand "enter" "Connect to a encapsule container" $ + enterCmd + <$> dryrunOpt + <*> pure True + <*> optional toolboxArg + <*> optional projectNameOpt + , Subcommand "refresh" "Update an encapsule image from a (toolbox) container" $ + refreshCmd + <$> dryrunOpt + <*> switchLongWith "force" "Re-commit even if the image looks up to date" + <*> toolboxArg + , Subcommand "run" "Run a temporary encapsule container" $ + runCmd <$> runOpts False True True + ] + where + dryrunOpt = switchLongWith "dryrun" "Print the podman command instead of running it" -data Opts = Opts - { mtoolbox :: Maybe String + projectOpt = strOptionWith 'p' "project" "DIR" + + nameOpt = strOptionWith 'n' "name" "NAME" "Optional container name (prefix with '^' prefix to skip 'encapsule-' prefix)" + + projectNameOpt = Project <$> projectOpt "Project name or path" <|> + Name <$> nameOpt + + toolboxArg = argumentWith str "TOOLBOX" + + runOpts keep unique refresh' = + RunOpts + <$> toolboxArg + <*> many (strOptionWith 'v' "volume" "HOST:CONTAINER[:opts]" "Bind mounts (default to selinux :z)") + <*> many (strOptionWith 'e' "env" "KEY[=VALUE]" "Set or pass through an environment variable") + <*> many (strOptionWith 'P' "path" "DIR" "Prepend a directory to PATH inside the container") + <*> many (strOptionWith 'i' "init" "CMD" "A bash snippet run when creating the encapsule container") + <*> many (strOptionLongWith "cap" "NAME" "Enable a capability from the config file") + <*> switchLongWith "pull" "Pull newer container image" + <*> optional (strOptionLongWith "home" "DIR" "Mount a directory as a writable home (created if missing)") + <*> optional (projectOpt "Mount a (project) directory as workdir") + <*> optional nameOpt + <*> pure keep + <*> switchLongWith "readonly" "Make the encapsule container filesystem read-only" + <*> switchLongWith "no-network" "Disable network access" + <*> switchLongWith "no-sudo" "Skip passwordless sudo setup" + <*> pure unique + <*> many (strOptionLongWith "podman-opt" "OPTION" "Pass an option directly to podman") + <*> switchLongWith "debug" "Show debug output" + <*> dryrunOpt + <*> (if refresh' + then switchLongWith "refresh" "Force re-commit of the toolbox image" + else pure False) + <*> many (argumentWith str "CMD") + + +listCmd :: IO () +listCmd = do + cmd_ "podman" ["images", + "--filter", "reference=" ++ progname ++ "-*", + "--format", "{{.Repository}}:{{.Tag}} {{.Size}} {{.Created}}"] + putChar '\n' + cmd_ "podman" ["ps", "-a", + "--filter", "name=^" ++ progname +=+ "", + "--format", "{{.Names}} {{.Status}}"] + +listCapsCmd :: IO () +listCapsCmd = do + config <- loadConfig + let capabilities = getCapabilities config + if Map.null capabilities + then putStrLn "No capabilities defined" + else do + putStrLn "Available capabilities:" + mapM_ (putStrLn . (" " ++) . T.unpack) $ Map.keys capabilities + +removeCmd :: String -> Maybe ProjectName -> IO () +removeCmd toolbox mprojectname = do + containerName <- mkContainerName toolbox mprojectname + exists <- cmdBool "podman" ["container", "exists", containerName] + if exists + then do + (_, out, _) <- cmdFull "podman" + ["container", "inspect", "-f", "{{.State.Running}}", containerName] "" + when (take 4 out == "true") $ do + putStr "stopping " + cmd_ "podman" ["stop", containerName] + putStr "rm " + cmd_ "podman" ["rm", containerName] + else warning $ "container" +-+ containerName +-+ "not found" + +removeImageCmd :: Bool -> String -> IO () +removeImageCmd dryrun name = + when dryrun $ + removeImage (progname +=+ name) + +-- FIXME dryrun +stopCmd :: String -> Maybe ProjectName -> IO () +stopCmd name mprojectname = do + containerName <- mkContainerName name mprojectname + exists <- cmdBool "podman" ["container", "exists", containerName] + if exists + then do + putStr "stop " + cmd_ "podman" ["stop", containerName] + else warning $ "container" +-+ containerName +-+ "not found" + +enterCmd :: Bool -> Bool -> Maybe String -> Maybe ProjectName -> IO () +enterCmd dryrun running mbase mprojectname = do + regexp <- + case mprojectname of + Nothing -> return $ progname +=+ fromMaybe "" mbase + Just (Name n) -> return $ progname ++ '-' : n + Just (Project p) -> do + projectDir <- resolveProject p + return $ progname ++ '-' : fromMaybe ".*" mbase ++ '-' : workProjectName projectDir + ps <- cmdLines "podman" $ "ps" : + ["-a" | not running] ++ + ["--filter", "name=" ++ '^' : regexp, + "--format", "{{.Names}}"] + case ps of + [] -> + if running + then do + enterCmd dryrun False mbase mprojectname + else error' "no encapsule container found" + [c] -> do + unless running $ + warning "no running encapsule container found" + enterContainer dryrun True c [] + _ -> error' $ "multiple" +-+ (if running then "running" else "") +-+ "containers match:\n" ++ unlines ps + +enterContainer :: Bool -> Bool -> String -> [String] -> IO () +enterContainer dryrun running container command = do + homedir <- getHomeDirectory >>= canonicalizePath + username <- getEffectiveUserName + unless running $ do + putStr "start " + cmd_ "podman" ["start", container] + let userCmd = if null command then ["bash"] else command + execCmd = ["podman", "exec", "-it", container, + "runuser", "-u", username, "--", + "env", "HOME=" ++ homedir] ++ userCmd + if dryrun + then putStrLn $ unwords (map shellQuote execCmd) + else do + ret <- rawSystem "podman" (drop 1 execCmd) + exitWith ret + +data RunOpts = RunOpts + { toolbox :: String , vols :: [String] , envs :: [String] , paths :: [String] , inits :: [String] , caps :: [String] + , pull :: Bool , mhome :: Maybe FilePath , mproject :: Maybe FilePath , mname :: Maybe String - , mode :: Mode , keep :: Bool , readonly :: Bool , nonetwork :: Bool @@ -59,160 +232,80 @@ , command :: [String] } -main :: IO () -main = do - hSetBuffering stdout NoBuffering - simpleCmdArgs (Just version) - progname - "Run a toolbox image in an isolated podman container" $ - run <$> - (Opts - <$> optional (argumentWith str "TOOLBOX") - <*> many (strOptionWith 'v' "volume" "HOST:CONTAINER[:opts]" "Bind mounts (default to selinux :z)") - <*> many (strOptionWith 'e' "env" "KEY[=VALUE]" "Set or pass through an environment variable") - <*> many (strOptionWith 'P' "path" "DIR" "Prepend a directory to PATH inside the container") - <*> many (strOptionWith 'i' "init" "CMD" ("A bash snippet run when creating the" `encapsule` "container")) - <*> many (strOptionLongWith "cap" "NAME" "Enable a capability from the config file") - <*> optional (strOptionLongWith "home" "DIR" "Mount a directory as a writable home (created if missing)") - <*> optional (strOptionWith 'p' "project" "DIR" "Mount a project directory and set as workdir") - <*> optional (strOptionWith 'n' "name" "NAME" "Container name (for creating or actions)") - <*> (flagLongWith' Caps "caps" "List available capabilities from the config file" <|> - flagLongWith' List "list" ("List" `encapsule` "images and containers") <|> - flagLongWith' Remove "remove" ("Remove" `encapsule` "container") <|> - flagLongWith' DeleteImage "delete-image" ("Remove" `encapsule` "image") <|> - flagLongWith Run Stop "stop" ("Stop" `encapsule` "container")) - <*> switchLongWith "keep" ("Keep the" `encapsule` "container after exiting") - <*> switchLongWith "readonly" ("Make the" `encapsule` "container filesystem read-only") - <*> switchLongWith "no-network" "Disable network access" - <*> switchLongWith "no-sudo" "Skip passwordless sudo setup" - <*> switchLongWith "unique" ("Run a new" `encapsule` "container even if one is already running") - <*> many (strOptionLongWith "podman-opt" "OPTION" "Pass an option directly to podman") - <*> switchLongWith "debug" "Show debug output" - <*> switchLongWith "dryrun" "Print the podman command instead of running it" - <*> switchLongWith "refresh" "Force re-commit of the toolbox image" - <*> many (argumentWith str "CMD")) - -run :: Opts -> IO () -run (Opts {..}) - | mode == Caps = do - config <- loadConfig - let capabilities = getCapabilities config - if Map.null capabilities - then putStrLn "No capabilities defined" - else do - putStrLn "Available capabilities:" - mapM_ (putStrLn . (" " ++) . T.unpack) $ Map.keys capabilities - | mode == List = do - cmd_ "podman" ["images", - "--filter", "reference=" ++ progname ++ "-*", - "--format", "{{.Repository}} {{.Size}} {{.Created}}"] - cmd_ "podman" ["ps", "-a", - "--filter", "name=^" ++ progname ++ "-", - "--format", "{{.Names}} {{.Status}}"] - | mode == DeleteImage = - when dryrun $ - removeImage (progname ++ "-" ++ containerBase) - | mode == Remove = do - mprojectDir <- resolveProjectDir mproject - let containerName = mkContainerName mname containerBase mprojectDir - exists <- cmdBool "podman" ["container", "exists", containerName] +runCmd :: RunOpts -> IO () +runCmd (RunOpts {..}) = do + mprojectDir <- traverse resolveProject mproject + containerName <- + mkContainerName toolbox $ maybe (Project <$> mproject) (Just . Name) mname + exists <- cmdBool "podman" ["container", "exists", containerName] + debug $ containerName +-+ "exists" + when (keep && not unique && exists) $ + error' $ "container" +-+ containerName +-+ "already exists" + container <- + -- FIXME Coderabbit pointed out this could lead to race with 2 invocations + if unique && exists + then do + pid <- getProcessID + return $ containerName +=+ show pid + else return containerName + debug $ "container:" +-+ container + running <- + if unique + then return False + else if exists then do (_, out, _) <- cmdFull "podman" - ["container", "inspect", "-f", "{{.State.Running}}", containerName] "" - when (take 4 out == "true") $ do - putStr "stopping " - cmd_ "podman" ["stop", containerName] - putStr "rm " - cmd_ "podman" ["rm", containerName] - else warning $ "container" +-+ containerName +-+ "not found" - | mode == Stop = do - mprojectDir <- resolveProjectDir mproject - let containerName = mkContainerName mname containerBase mprojectDir - exists <- cmdBool "podman" ["container", "exists", containerName] - if exists - then do - putStr "stop " - cmd_ "podman" ["stop", containerName] - else warning $ "container" +-+ containerName +-+ "not found" - | otherwise = do - mprojectDir <- resolveProjectDir mproject - let containerName = mkContainerName mname containerBase mprojectDir - container <- - if unique - then do - pid <- getProcessID - return $ containerName ++ "-" ++ show pid - else return containerName - debug $ "container:" +-+ container - running <- - if unique - then return False - else do - exists <- cmdBool "podman" ["container", "exists", container] - debug $ container +-+ "exists" - if exists - then do - (_, out, _) <- cmdFull "podman" - ["container", "inspect", "-f", "{{.State.Running}}", container] "" - if take 4 out == "true" - then return True - else do - putStr "start " - cmd_ "podman" ["start", container] - return True - else return False - home <- getHomeDirectory >>= canonicalizePath - debug $ "HOME:" +-+ home - if running - then do - let noopts = and - [ null vols - , null envs - , null paths - , null inits - , null caps - , isNothing mproject || isNothing mname - , isNothing mhome - , not keep - , not readonly - , not nonetwork - , not nosudo - , null podmanopts - , not refresh - ] - unless noopts $ - error' "cannot give options for an existing container!" - warning "Joining existing container" - username <- getEffectiveUserName - let userCmd = if null command then ["bash"] else command - execCmd = ["podman", "exec", "-it", container, - "runuser", "-u", username, "--", - "env", "HOME=" ++ home] ++ userCmd - if dryrun - then putStrLn $ unwords (map shellQuote execCmd) + ["container", "inspect", "-f", "{{.State.Running}}", container] "" + if take 4 out == "true" + then return True else do - ret <- rawSystem "podman" (drop 1 execCmd) - exitWith ret - else do - case mtoolbox of - Nothing -> - when (isNothing mtoolbox) $ - error' $ "TOOLBOX argument needed to create a container" +-+ - if isJust mname then "(use '--name ^...' to reference a full container name)" else "" - Just toolbox -> createContainer home mprojectDir toolbox container + putStr "start " + cmd_ "podman" ["start", container] + return True + else return False + homedir <- getHomeDirectory >>= canonicalizePath + debug $ "HOME:" +-+ homedir + if running + then do + let noopts = and + [ null vols + , null envs + , null paths + , null inits + , null caps + , isNothing mproject || isNothing mname + , isNothing mhome + , not keep + , not readonly + , not nonetwork + , not nosudo + , null podmanopts + , not refresh + ] + unless noopts $ + error' "cannot give options for an existing container!" + warning "Entering existing container" + enterContainer dryrun True container command + else createContainer homedir mprojectDir container where - createContainer home mprojectDir toolbox container = do - mhomeDir <- - case mhome of - Just dir -> Just <$> checkMountPoint home dir - Nothing -> return Nothing + createContainer homedir mprojectDir container = do + mtemphome <- traverse (expandPath homedir >=> canonicalizePath) mhome + case (mtemphome, mprojectDir) of + (Just h, Just p) | h == p -> + error' "--home and --project must be different directories" + _ -> return () let isImage = ':' `elem` toolbox - debug $ if isImage then "image:" +-+ toolbox + debug $ if isImage + then "image:" +-+ toolbox else "toolbox:" +-+ toolbox - image <- if isImage - then return toolbox - else commitToolbox dryrun toolbox refresh + image <- + if isImage + then do + when pull $ + cmd_ "podman" ["pull", toolbox] + return toolbox + else commitToolbox dryrun toolbox refresh config <- loadConfig let capabilities = getCapabilities config @@ -220,24 +313,35 @@ resolveCapabilities capabilities caps homeVol <- - case mhomeDir of - Just d -> do - createDirectoryIfMissing True d - return [d ++ ":" ++ home] + case mtemphome of + Just temphome -> do + createDirectoryIfMissing True temphome + return [temphome ++ ":" ++ homedir] Nothing -> return [] username <- getEffectiveUserName - let projectVol = - case mprojectDir of - Just d -> [d ++ ":" ++ rootDest d] - Nothing -> [] + projectVol <- + case mprojectDir of + Just d -> do + exists <- doesDirectoryExist d + if exists + then return [d ++ ':' : d] + else error' $ "project dir not found:" +-+ d + Nothing -> return [] + -- mounting real $HOME needs label=disable (no :z) on Fedora/SELinux + let mountsRealHome = + Just homedir == mtemphome || Just homedir == mprojectDir + securityOpts = + extraSecurityOpts ++ + ["label=disable" | mountsRealHome, + "label=disable" `notElem` extraSecurityOpts] volumes = homeVol ++ vols ++ extraVols ++ projectVol envVars = envs ++ extraEnvs allpaths = paths ++ extraPaths allinits = inits ++ extraInits - envParts = ("HOME=" ++ shellQuote home) : pathEnvPart allpaths + envParts = ("HOME=" ++ homedir) : pathEnvPart allpaths initSetup = mkInitSetup allinits userCmdParts = mkUserCmd command allinits runuserCmd = "env" +-+ unwords (envParts ++ map shellQuote userCmdParts) @@ -253,43 +357,47 @@ "chmod 440" +-+ sudoers] homeSetup = if isNothing mhome - then ["mkdir -p" +-+ shellQuote home, - "chown" +-+ username +-+ shellQuote home] + then ["mkdir -p" +-+ homedir, + "chown" +-+ username +-+ homedir] else [] + -- podman --workdir requires the path to exist at start; for no + -- --workdir/--project, mkdir home first then cd (see workdirPart) + cdHome = ["cd" +-+ shellQuote homedir | isNothing mprojectDir] fallback = if isImage then " || exec" +-+ runuserCmd else "" trace = ["set -x" | debugging] setup = intercalate " && " - (trace ++ installSetup ++ sudoSetup ++ homeSetup ++ + (trace ++ installSetup ++ sudoSetup ++ homeSetup ++ cdHome ++ [initSetup | not (null allinits)] ++ ["exec runuser -u" +-+ username +-+ "--" +-+ runuserCmd]) ++ fallback - debug $ "setup:" +-+ setup - mounts <- mapM (addSelinuxLabel home) volumes + when ("label=disable" `elem` securityOpts) $ + warning "SELinux labeling disabled for this container (label=disable)" + unless dryrun $ debug $ "setup:" +-+ setup + mounts <- mapM (addSelinuxLabel homedir) volumes let workdirPart = case mprojectDir of - Just d -> ["--workdir", rootDest d] - Nothing | not isImage -> ["--workdir", home] - | otherwise -> [] + Just d -> ["--workdir", d] + Nothing -> [] args = "run" : [ "--rm" | not keep] ++ [ "-it", "--userns=keep-id", - "--name", container, "--hostname", container, - "--user", "root", "-e", "HOME=" ++ home, - "-e", "TERM", "-e", "COLORTERM"] + "--name", container, "--hostname", container, + "--user", "root", "-e", "HOME=" ++ homedir, + "-e", "TERM", "-e", "COLORTERM"] ++ workdirPart ++ (if readonly then ["--read-only", "--tmpfs", "/tmp", "--tmpfs", "/run"] - ++ case mhomeDir of - Nothing -> ["--tmpfs", home] + ++ case mtemphome of + Nothing -> ["--tmpfs", homedir] Just _ -> [] else []) ++ (if nonetwork then ["--net", "none"] else []) - ++ concatMap (\s -> ["--security-opt", s]) extraSecurityOpts + ++ concatMap (\s -> ["--security-opt", s]) securityOpts ++ concatMap (\m -> ["-v", m]) mounts ++ concatMap (\e -> ["-e", e]) envVars ++ podmanopts @@ -301,19 +409,77 @@ ret <- rawSystem "podman" args exitWith ret - containerBase = - case mtoolbox of - Just toolbox -> - map (\c -> if c == ':' then '-' else c) toolbox - Nothing -> error' "no TOOLBOX arg given" - debug msg = when debugging $ warning $ "debug:" +-+ msg -- image management +refreshCmd :: Bool -> Bool -> String -> IO () +refreshCmd dryrun force toolbox = do + containerExists <- cmdBool "podman" ["container", "exists", toolbox] + unless containerExists $ + error' $ "container '" ++ toolbox ++ "' not found" + let image = progname +=+ toolbox + imageExists <- cmdBool "podman" ["image", "exists", image] + unless imageExists $ + error' $ "image" +-+ image +-+ "not found (create or run first)" + needsCommit <- + if force + then return True + else do + imageTime <- inspectUTCTime image "{{.Created}}" + toolboxTime <- toolboxFreshness toolbox + case (imageTime, toolboxTime) of + (Just img, Just tb) -> return (img < tb) + -- if we cannot compare, recommit to be safe + _ -> return True + if needsCommit + then void $ commitToolbox dryrun toolbox True + else putStrLn $ image +-+ "is up to date" + +-- Prefer overlay UpperDir mtime (system changes, not bind mounts); +-- fall back to StartedAt, then Created. +toolboxFreshness :: String -> IO (Maybe UTCTime) +toolboxFreshness toolbox = do + upper <- inspectFormat toolbox "{{.GraphDriver.Data.UpperDir}}" + mUpper <- + if null upper || upper == "" + then return Nothing + else do + exists <- doesDirectoryExist upper + if exists + then Just <$> getModificationTime upper + else return Nothing + case mUpper of + Just t -> return (Just t) + Nothing -> do + started <- inspectFormat toolbox "{{.State.StartedAt}}" + -- podman uses year 0001 when the container has never started + if null started || "0001-01-01" `isPrefixOf` started + then inspectUTCTime toolbox "{{.Created}}" + else return (parsePodmanTime started) + +inspectUTCTime :: String -> String -> IO (Maybe UTCTime) +inspectUTCTime name format = + parsePodmanTime <$> inspectFormat name format + +-- podman -f '{{.Created}}' prints Go's time.String +-- (e.g. "2026-06-29 16:18:14.981069671 +0800 +08"), not ISO8601. +parsePodmanTime :: String -> Maybe UTCTime +parsePodmanTime raw = + case words raw of + (day : clock : off : _) -> + parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q %z" + (unwords [day, clock, off]) + _ -> Nothing + +inspectFormat :: String -> String -> IO String +inspectFormat name format = do + (_, out, _) <- cmdFull "podman" ["inspect", "-f", format, name] "" + return $ filter (/= '\n') out + commitToolbox :: Bool -> String -> Bool -> IO String commitToolbox dryrun toolbox refresh = do - let image = progname ++ '-' : toolbox + let image = progname +=+ toolbox imageExists <- cmdBool "podman" ["image", "exists", image] if imageExists && not refresh then return image @@ -406,31 +572,32 @@ -- SELinux labeling +-- FIXME rather return Mount type or triple? addSelinuxLabel :: FilePath -> String -> IO String -addSelinuxLabel home spec = +addSelinuxLabel homedir spec = case break (== ':') spec of (hostPart, []) -> do - hostExp <- expandPath home hostPart - sockFile <- isSocketFile hostExp - return $ hostExp ++ ":" ++ hostExp ++ if sockFile then "" else ":z" + hostExp <- expandPath homedir hostPart + skipLabel <- shouldSkipLabel hostExp + return $ hostExp ++ ":" ++ hostExp ++ if skipLabel then "" else ":z" (hostPart, _:rest') -> do - hostExp <- expandPath home hostPart + hostExp <- expandPath homedir hostPart let (containerPart, optsPart) | isPathStart rest' = case break (== ':') rest' of (c, []) -> (c, Nothing) (c, _:o) -> (c, Just o) | otherwise = (hostExp, if null rest' then Nothing else Just rest') - containerExp <- expandPath home containerPart - sockFile <- isSocketFile hostExp + containerExp <- expandPath homedir containerPart + skipLabel <- shouldSkipLabel hostExp let labeled = case optsPart of Nothing -> - if sockFile + if skipLabel then hostExp ++ ":" ++ containerExp else hostExp ++ ":" ++ containerExp ++ ":z" Just o -> let flags = splitOn "," o - in if sockFile || "z" `elem` flags || "Z" `elem` flags + in if skipLabel || "z" `elem` flags || "Z" `elem` flags then hostExp ++ ":" ++ containerExp ++ ":" ++ o else hostExp ++ ":" ++ containerExp ++ ":" ++ o ++ ",z" return labeled @@ -440,6 +607,11 @@ isPathStart ('$':_) = True isPathStart _ = False + -- sockets and real $HOME must not get :z (HOME uses label=disable instead) + shouldSkipLabel hostExp = do + sockFile <- isSocketFile hostExp + return $ sockFile || hostExp == homedir + isSocketFile :: FilePath -> IO Bool isSocketFile path = do exists <- doesPathExist path @@ -449,14 +621,11 @@ -- path and env expansion -rootDest :: FilePath -> FilePath -rootDest dir = '/' : takeFileName dir - -expandPath :: FilePath -> String -> IO String -expandPath home ('~':'/':rest) = do +expandPath :: FilePath -> String -> IO FilePath +expandPath homedir ('~':'/':rest) = do rest' <- expandEnvVars rest - return $ home rest' -expandPath home "~" = return home + canonicalizePath $ homedir rest' +expandPath homedir "~" = return homedir expandPath _ s = expandEnvVars s expandEnvVars :: String -> IO String @@ -486,19 +655,14 @@ rest' <- expandEnvVars rest return (c : rest') -checkMountPoint :: FilePath -> FilePath -> IO FilePath -checkMountPoint home dir = do - finaldir <- expandPath home dir >>= canonicalizePath - when (finaldir == home) $ - error' "mounting $HOME not supported!" +resolveProject :: FilePath -> IO FilePath +resolveProject dir = do + homedir <- getHomeDirectory >>= canonicalizePath + finaldir <- expandPath homedir dir >>= canonicalizePath + when (finaldir == homedir) $ + warning "mounting $HOME as project (consider a subdirectory)" return finaldir -resolveProjectDir :: Maybe FilePath -> IO (Maybe FilePath) -resolveProjectDir Nothing = return Nothing -resolveProjectDir (Just dir) = do - home <- getHomeDirectory >>= canonicalizePath - Just <$> checkMountPoint home dir - -- container naming sanitizeName :: String -> String @@ -506,19 +670,22 @@ where nameChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_.-" -projectSuffix :: Maybe FilePath -> String -projectSuffix Nothing = "" -projectSuffix (Just dir) = - case sanitizeName (takeFileName dir) of - "" -> "" - name -> "-" ++ name +workProjectName :: FilePath -> String +workProjectName = sanitizeName . takeFileName -mkContainerName :: Maybe String -> String -> Maybe FilePath -> String -mkContainerName mname base mprojectDir = - case mname of - Just ('^':n) -> n - Just n -> progname ++ "-" ++ n - Nothing -> progname ++ "-" ++ base ++ projectSuffix mprojectDir +mkContainerName :: String -> Maybe ProjectName -> IO String +mkContainerName base mprojectname = do + case mprojectname of + Nothing -> return $ progname +=+ sanebase + Just mp -> + case mp of + Name ('^':n) -> return n + Name n -> return $ progname +=+ n + Project p -> do + projectDir <- resolveProject p + return $ progname ++ '-' : sanebase +=+ workProjectName projectDir + where + sanebase = sanitizeName base -- shell command construction @@ -554,3 +721,15 @@ isSafe c = c `elem` (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_./=:@,+") escSQ '\'' = "'\\''" escSQ c = [c] + +-- | Combine two strings with a single space +infixr 4 +=+ +(+=+) :: String -> String -> String +s +=+ t | lastMay s == Just '-' = s ++ t + | headMay t == Just '-' = s ++ t +s +=+ t = s ++ '-' : t + +error':: String -> IO a +error' err = do + putStrLn err + exitFailure