encapsule 0.3 → 0.4
raw patch · 4 files changed
+547/−299 lines, 4 filesdep +safedep +time
Dependencies added: safe, time
Files
- ChangeLog.md +14/−0
- README.md +122/−69
- encapsule.cabal +3/−1
- src/Main.hs +408/−229
ChangeLog.md view
@@ -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`
README.md view
@@ -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: <https://copr.fedorainfracloud.org/coprs/petersen/encapsule/> ## 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
encapsule.cabal view
@@ -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
src/Main.hs view
@@ -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 == "<no value>"+ 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