diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,18 @@ # encapsule releases +## 0.4.1 (2026-08-07) +- require volume host paths to exist +- drop `-P` for `--path` and add `-H` for `--home` +- copy `/etc/skel` into home if `~/.bashrc` is missing (`--no-skel` to skip) +- config.toml: add dbus, dconf, machine-id capabilities +- support mount options for `--home` and `--project` (like `:O` for overlay) +- only auto SELinux `:z` for user-owned paths and not overlay `:O` +- create `--project`/`--volume` mount points in --home for $HOME targets +- add `backup` command to tarball a directory (prompts if >100MB) +- `run`,`create`: `--backup-home` / `--backup-project` to tarball those dirs +- `refresh`: always update image (drop freshness checks and `--force`) +- sanitize `.` to `-` in container hostname + ## 0.4 (2026-08-04) - convert to using subcommands - `list`: separate images and containers and include image tags diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -26,7 +26,7 @@ `$ encapsule --version` ``` -0.4 +0.4.1 ``` `$ encapsule --help` @@ -49,9 +49,11 @@ rm Remove an encapsule container rmi Remove an encapsule image stop Stop an encapsule container + backup Create a tarball backup of a directory create Create an encapsule container enter Connect to a encapsule container - refresh Update an encapsule image from a (toolbox) container + refresh Re-commit an encapsule image from a (toolbox) + container run Run a temporary encapsule container ``` @@ -67,31 +69,37 @@ ``` 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] + [-e|--env KEY[=VALUE]] [--path DIR] [-i|--init CMD] + [--cap NAME] [--pull] + [(-H|--home DIR[:opts]) [--backup-home]] + [(-p|--project DIR[:opts]) [--backup-project]] [-n|--name NAME] [--readonly] [--no-network] [--no-sudo] - [--podman-opt OPTION] [--debug] [--dryrun] [--refresh] - [CMD] + [--no-skel] [--podman-opt OPTION] [--debug] [--dryrun] + [--refresh] [CMD] Run a temporary encapsule container Available options: -v,--volume HOST:CONTAINER[:opts] - Bind mounts (default to selinux :z) + Bind mount (user's files default to selinux :z) -e,--env KEY[=VALUE] Set or pass through an environment variable - -P,--path DIR Prepend a directory to PATH inside the container + --path DIR Prepend a directory to PATH inside the container -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 as workdir + -H,--home DIR[:opts] Mount a directory as a writable home (created if + missing; use DIR:O to overlay) + --backup-home Tarball home directory before starting + -p,--project DIR[:opts] Mount a (project) directory as workdir (use DIR:O to + overlay) + --backup-project Tarball project directory before starting -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 + --no-skel Don't copy /etc/skel into an empty home --podman-opt OPTION Pass an option directly to podman --debug Show debug output --dryrun Print the podman command instead of running it @@ -131,7 +139,7 @@ $ encapsule rm my-toolbox # Set environment variables and prepend to PATH -$ encapsule run my-toolbox -e MY_VAR=hello -P ~/.local/bin +$ encapsule run my-toolbox -e MY_VAR=hello -e LANG --path ~/.local/bin # Run a specific command $ encapsule run my-toolbox -- ls / @@ -169,11 +177,11 @@ Each capability can define: -- `volumes` — list of bind mount specs -- `env` — list of environment variables to set or pass through -- `path` — list of directories to prepend to `$PATH` -- `init` — a bash snippet to run on encapsule container creation -- `security_opts` — list of `--security-opt` values passed to podman +- `volumes` : list of bind mount specs +- `env` : list of environment variables to set or pass through +- `path` : list of directories to prepend to `$PATH` +- `init` : a bash snippet to run on encapsule container creation +- `security_opts` : list of `--security-opt` values passed to podman `~` and envvars are expanded in volume and path specs. If the host and container paths are the same, you can use the shorthand @@ -207,13 +215,16 @@ cabal install ``` -(or to build the latest release: `cabal install encapsule`) ### Build with stack Alternatively you can build with: ``` stack install ``` + +### Build release +To build the latest release: `cabal install encapsule` +or `stack install encapsule`. ## Runtime Requirements 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.4 +version: 0.4.1 synopsis: Run isolated toolbox containers with podman description: This tool (originally based on the toolbox-constrained project) @@ -50,6 +50,7 @@ , shell-monad , simple-cmd >= 0.2.3 , simple-cmd-args >= 0.1.8 + , simple-prompt >= 0.2 , text , time , toml-reader diff --git a/example/config.toml b/example/config.toml --- a/example/config.toml +++ b/example/config.toml @@ -4,19 +4,23 @@ [capabilities.git] volumes = ["~/.gitconfig:ro"] +# gtk4 needs libglvnd-gles [capabilities.wayland] env = ["WAYLAND_DISPLAY", "XDG_RUNTIME_DIR"] volumes = ["$XDG_RUNTIME_DIR/$WAYLAND_DISPLAY"] security_opts = ["label=disable"] +[capabilities.dbus] +volumes = ["/run/dbus/system_bus_socket"] + +[capabilities.dconf] +volumes = ["$XDG_RUNTIME_DIR/dconf"] + +[capabilities.machine-id] +volumes = ["/etc/machine-id:ro"] + [capabilities.rust] path = ["~/.cargo/bin"] -[capabilities.claude] -volumes = [ - "~/.claude", - "~/.claude.json", -] - -[capabilities.default] -volumes = ["~/.config/isolation:~:rw"] +[capabilities.isolation] +volumes = ["~/isolation:~:rw"] diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -4,29 +4,30 @@ module Main (main) where -import Control.Monad (unless, void, when, (>=>)) +import Control.Monad.Extra (unless, void, when, whenJust, (>=>)) import Data.List.Extra (intercalate, isPrefixOf, splitOn) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe, isNothing, mapMaybe) import qualified Data.Text as T import qualified Data.Text.Lazy as TL -import Safe (headMay, lastMay) +import Data.Time.Clock (getCurrentTime) +import Data.Time.Format (defaultTimeLocale, formatTime) +import Safe (headMay, lastMay, readMay) +import SimpleCmd (cmd, cmd_, cmdBool, cmdFull, cmdLines, cmdN, warning, (+-+)) +import SimpleCmdArgs +import SimplePrompt (yesNo) import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, doesPathExist, - getHomeDirectory, getModificationTime) + getHomeDirectory) import System.Environment.XDG.BaseDir (getUserConfigFile) import System.Exit (exitWith, exitFailure) -import System.FilePath ((), takeFileName) +import System.FilePath ((), makeRelative, takeDirectory, takeFileName) import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout) import System.Posix.Process (getProcessID) import System.Posix.Env (getEnvDefault) -import System.Posix.Files (getFileStatus, isSocket) -import System.Posix.User (getEffectiveUserName) +import System.Posix.Files (fileOwner, getFileStatus, isSocket) +import System.Posix.User (getEffectiveUserID, getEffectiveUserName) import System.Process (rawSystem) -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) import Paths_encapsule (version) @@ -62,6 +63,12 @@ stopCmd <$> toolboxArg <*> optional projectNameOpt + , Subcommand "backup" "Create a tarball backup of a directory" $ + backupCmd + <$> dryrunOpt + <*> switchWith 'y' "yes" "Don't prompt for large directories" + <*> optional (strOptionWith 'o' "output" "FILE" "Output tarball (default: DIR-.tar.gz)") + <*> argumentWith str "DIR" , Subcommand "create" "Create an encapsule container" $ runCmd <$> runOpts True False False , Subcommand "enter" "Connect to a encapsule container" $ @@ -70,10 +77,9 @@ <*> pure True <*> optional toolboxArg <*> optional projectNameOpt - , Subcommand "refresh" "Update an encapsule image from a (toolbox) container" $ + , Subcommand "refresh" "Re-commit 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 @@ -81,7 +87,7 @@ where dryrunOpt = switchLongWith "dryrun" "Print the podman command instead of running it" - projectOpt = strOptionWith 'p' "project" "DIR" + projectOpt = strOptionWith 'p' "project" "DIR[:opts]" nameOpt = strOptionWith 'n' "name" "NAME" "Optional container name (prefix with '^' prefix to skip 'encapsule-' prefix)" @@ -90,22 +96,29 @@ toolboxArg = argumentWith str "TOOLBOX" + backupDirOpt s l m h = + let pair fs sn = (fs,sn) in + pair + <$> strOptionWith s l m h + <*> switchLongWith ("backup-" ++ l) ("Tarball" +-+ l +-+ "directory before starting") + runOpts keep unique refresh' = RunOpts <$> toolboxArg - <*> many (strOptionWith 'v' "volume" "HOST:CONTAINER[:opts]" "Bind mounts (default to selinux :z)") + <*> many (strOptionWith 'v' "volume" "HOST:CONTAINER[:opts]" "Bind mount (user's files 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 (strOptionLongWith "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 (backupDirOpt 'H' "home" "DIR[:opts]" "Mount a directory as a writable home (created if missing; use DIR:O to overlay)") + <*> optional (backupDirOpt 'p' "project" "DIR[:opts]" "Mount a (project) directory as workdir (use DIR:O to overlay)") <*> 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" + <*> switchLongWith "no-skel" "Don't copy /etc/skel into an empty home" <*> pure unique <*> many (strOptionLongWith "podman-opt" "OPTION" "Pass an option directly to podman") <*> switchLongWith "debug" "Show debug output" @@ -185,7 +198,7 @@ if running then do enterCmd dryrun False mbase mprojectname - else error' "no encapsule container found" + else error' "encapsule container not found" [c] -> do unless running $ warning "no running encapsule container found" @@ -217,13 +230,14 @@ , inits :: [String] , caps :: [String] , pull :: Bool - , mhome :: Maybe FilePath - , mproject :: Maybe FilePath + , mhome :: Maybe (FilePath, Bool) + , mproject :: Maybe (FilePath, Bool) , mname :: Maybe String , keep :: Bool , readonly :: Bool , nonetwork :: Bool , nosudo :: Bool + , noskel :: Bool , unique :: Bool , podmanopts :: [String] , debugging :: Bool @@ -234,11 +248,14 @@ runCmd :: RunOpts -> IO () runCmd (RunOpts {..}) = do - mprojectDir <- traverse resolveProject mproject + let (mhomeDir, homeMountOpts, backupHome) = splitDirOptsMaybe mhome + (mprojectPath, projectMountOpts, backupProject) = splitDirOptsMaybe mproject + mprojectDir <- traverse resolveProject mprojectPath containerName <- - mkContainerName toolbox $ maybe (Project <$> mproject) (Just . Name) mname + mkContainerName toolbox $ + maybe (Project <$> mprojectPath) (Just . Name) mname + debug containerName exists <- cmdBool "podman" ["container", "exists", containerName] - debug $ containerName +-+ "exists" when (keep && not unique && exists) $ error' $ "container" +-+ containerName +-+ "already exists" container <- @@ -264,6 +281,7 @@ cmd_ "podman" ["start", container] return True else return False + debug $ "running:" +-+ show running homedir <- getHomeDirectory >>= canonicalizePath debug $ "HOME:" +-+ homedir if running @@ -280,6 +298,7 @@ , not readonly , not nonetwork , not nosudo + , not noskel , null podmanopts , not refresh ] @@ -287,10 +306,17 @@ error' "cannot give options for an existing container!" warning "Entering existing container" enterContainer dryrun True container command - else createContainer homedir mprojectDir container + else do + when backupHome $ + whenJust mhomeDir $ backupCmd dryrun False Nothing + when backupProject $ + whenJust mprojectDir $ backupCmd dryrun False Nothing + createContainer homedir mhomeDir homeMountOpts mprojectDir + projectMountOpts container where - createContainer homedir mprojectDir container = do - mtemphome <- traverse (expandPath homedir >=> canonicalizePath) mhome + createContainer homedir mhomeDir homeMountOpts mprojectDir + projectMountOpts container = do + mtemphome <- traverse (expandPath homedir >=> canonicalizePath) mhomeDir case (mtemphome, mprojectDir) of (Just h, Just p) | h == p -> error' "--home and --project must be different directories" @@ -298,6 +324,7 @@ let isImage = ':' `elem` toolbox debug $ if isImage then "image:" +-+ toolbox + -- FIXME handling of unique is kind of broken: not container else "toolbox:" +-+ toolbox image <- if isImage @@ -316,7 +343,13 @@ case mtemphome of Just temphome -> do createDirectoryIfMissing True temphome - return [temphome ++ ":" ++ homedir] + -- Mount targets under $HOME land inside the temp home volume; + -- create them as the user so podman does not leave root-owned paths. + case mprojectDir of + Just p -> ensureTempHomeMountPoint homedir temphome p p + Nothing -> return () + mapM_ (ensureTempHomeVol homedir temphome) (vols ++ extraVols) + return [temphome ++ ":" ++ homedir ++ maybeOpts homeMountOpts] Nothing -> return [] username <- getEffectiveUserName @@ -326,7 +359,7 @@ Just d -> do exists <- doesDirectoryExist d if exists - then return [d ++ ':' : d] + then return [d ++ ':' : d ++ maybeOpts projectMountOpts] else error' $ "project dir not found:" +-+ d Nothing -> return [] -- mounting real $HOME needs label=disable (no :z) on Fedora/SELinux @@ -341,10 +374,10 @@ allpaths = paths ++ extraPaths allinits = inits ++ extraInits - envParts = ("HOME=" ++ homedir) : pathEnvPart allpaths - initSetup = mkInitSetup allinits - userCmdParts = mkUserCmd command allinits - runuserCmd = "env" +-+ unwords (envParts ++ map shellQuote userCmdParts) + runuserCmd = + let envParts = ("HOME=" ++ homedir) : pathEnvPart allpaths + userCmdParts = mkUserCmd command allinits + in "env" +-+ unwords (envParts ++ map shellQuote userCmdParts) sudoers = "/etc/sudoers.d" progname installSetup = @@ -360,6 +393,12 @@ then ["mkdir -p" +-+ homedir, "chown" +-+ username +-+ homedir] else [] + skelSetup = + [ "if [ ! -e " ++ shellQuote (homedir ".bashrc") ++ + " ] && [ -d /etc/skel ]; then " ++ + "runuser -u" +-+ username +-+ "-- cp -an /etc/skel/." +-+ + shellQuote (homedir ++ "/") ++ "; fi" + | not noskel ] -- 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] @@ -369,8 +408,9 @@ else "" trace = ["set -x" | debugging] setup = intercalate " && " - (trace ++ installSetup ++ sudoSetup ++ homeSetup ++ cdHome ++ - [initSetup | not (null allinits)] ++ + (trace ++ installSetup ++ sudoSetup ++ homeSetup ++ skelSetup ++ + cdHome ++ + [mkInitSetup allinits | not (null allinits)] ++ ["exec runuser -u" +-+ username +-+ "--" +-+ runuserCmd]) ++ fallback @@ -385,10 +425,14 @@ Nothing -> [] args = "run" : [ "--rm" | not keep] ++ - [ "-it", "--userns=keep-id", - "--name", container, "--hostname", container, - "--user", "root", "-e", "HOME=" ++ homedir, - "-e", "TERM", "-e", "COLORTERM"] + [ "-it", + "--userns=keep-id", + "--name", container, + "--hostname", hostnameFromName container, + "--user", "root", + "-e", "HOME=" ++ homedir, + "-e", "TERM", + "-e", "COLORTERM"] ++ workdirPart ++ (if readonly then ["--read-only", "--tmpfs", "/tmp", "--tmpfs", "/run"] @@ -404,7 +448,7 @@ ++ [image, "sh", "-c", setup] if dryrun - then putStrLn $ unwords $ "podman" : map shellQuote args + then cmdN "podman" $ map shellQuote args else do ret <- rawSystem "podman" args exitWith ret @@ -413,8 +457,8 @@ -- image management -refreshCmd :: Bool -> Bool -> String -> IO () -refreshCmd dryrun force toolbox = do +refreshCmd :: Bool -> String -> IO () +refreshCmd dryrun toolbox = do containerExists <- cmdBool "podman" ["container", "exists", toolbox] unless containerExists $ error' $ "container '" ++ toolbox ++ "' not found" @@ -422,60 +466,64 @@ 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" + void $ commitToolbox dryrun toolbox True --- 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) +-- Prompt when backing up more than this many bytes. +largeBackupBytes :: Integer +largeBackupBytes = 100 * 1024 * 1024 -inspectUTCTime :: String -> String -> IO (Maybe UTCTime) -inspectUTCTime name format = - parsePodmanTime <$> inspectFormat name format +backupCmd :: Bool -> Bool -> Maybe FilePath -> FilePath -> IO () +backupCmd dryrun yes moutput dir = do + homedir <- getHomeDirectory >>= canonicalizePath + src <- expandPath homedir dir >>= canonicalizePath + exists <- doesDirectoryExist src + unless exists $ + error' $ "directory not found:" +-+ src + size <- dirSizeBytes src + let sizeStr = humanSize size + putStrLn $ src +-+ "(" ++ sizeStr ++ ")" + when (not yes && size >= largeBackupBytes || size == 0) $ do + ok <- yesNo $ "Directory is" +-+ sizeStr ++ ", continue?" + unless ok $ + error' "aborted" + out <- + case moutput of + Just o -> expandPath homedir o + Nothing -> do + now <- getCurrentTime + let stamp = formatTime defaultTimeLocale "%Y-%m-%d_%H:%M:%SZ" now + return $ src ++ "-" ++ stamp ++ ".tar.gz" + outExists <- doesFileExist out + when outExists $ + if yes + then warning $ "overwriting" +-+ out + else error' $ "output already exists:" +-+ out +-+ "(use -y to overwrite)" + let parent = takeDirectory src + base = takeFileName src + args = ["czf", out, "-C", parent, base] + if dryrun + then putStrLn $ unwords $ "tar" : map shellQuote args + else do + putStrLn $ "Writing" +-+ out + cmd_ "tar" args --- 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 +dirSizeBytes :: FilePath -> IO Integer +dirSizeBytes path = do + out <- cmd "du" ["-sb", path] + case words out of + (n:_) | Just i <- readMay n -> return i + _ -> error' $ "could not determine size of" +-+ path -inspectFormat :: String -> String -> IO String -inspectFormat name format = do - (_, out, _) <- cmdFull "podman" ["inspect", "-f", format, name] "" - return $ filter (/= '\n') out +humanSize :: Integer -> String +humanSize n + | n >= g = show (n `div` g) ++ "G" + | n >= m = show (n `div` m) ++ "M" + | n >= k = show (n `div` k) ++ "K" + | otherwise = show n ++ "B" + where + k = 1024 + m = k * 1024 + g = m * 1024 commitToolbox :: Bool -> String -> Bool -> IO String commitToolbox dryrun toolbox refresh = do @@ -487,12 +535,15 @@ containerExists <- cmdBool "podman" ["container", "exists", toolbox] if containerExists then do + let buildah_args = ["commit", "--disable-compression", toolbox, image] ok <- - if dryrun then return True + if dryrun + then do + cmdN "buildah" buildah_args + return True else do putStr "writing image " - cmdBool "buildah" - ["commit", "--disable-compression", toolbox, image] + cmdBool "buildah" buildah_args if ok then return image else error' $ "could not commit image of container" +-+ toolbox @@ -578,12 +629,14 @@ case break (== ':') spec of (hostPart, []) -> do hostExp <- expandPath homedir hostPart + requireVolumeHost hostExp skipLabel <- shouldSkipLabel hostExp return $ hostExp ++ ":" ++ hostExp ++ if skipLabel then "" else ":z" (hostPart, _:rest') -> do hostExp <- expandPath homedir hostPart + requireVolumeHost hostExp let (containerPart, optsPart) - | isPathStart rest' = + | isVolumePathStart rest' = case break (== ':') rest' of (c, []) -> (c, Nothing) (c, _:o) -> (c, Just o) @@ -598,27 +651,60 @@ Just o -> let flags = splitOn "," o in if skipLabel || "z" `elem` flags || "Z" `elem` flags + || "O" `elem` flags then hostExp ++ ":" ++ containerExp ++ ":" ++ o else hostExp ++ ":" ++ containerExp ++ ":" ++ o ++ ",z" return labeled where - isPathStart ('/':_) = True - isPathStart ('~':_) = True - isPathStart ('$':_) = True - isPathStart _ = False - - -- sockets and real $HOME must not get :z (HOME uses label=disable instead) + -- Skip auto :z for sockets, real $HOME (uses label=disable), and paths we + -- cannot relabel (rootless lsetxattr fails on files owned by another user). shouldSkipLabel hostExp = do sockFile <- isSocketFile hostExp - return $ sockFile || hostExp == homedir + selfOwned <- ownedBySelf hostExp + return $ sockFile || hostExp == homedir || not selfOwned -isSocketFile :: FilePath -> IO Bool -isSocketFile path = do +requireVolumeHost :: FilePath -> IO () +requireVolumeHost path = do exists <- doesPathExist path - if exists - then isSocket <$> getFileStatus path - else return False + unless exists $ + error' $ "volume host path not found:" +-+ path +isSocketFile :: FilePath -> IO Bool +isSocketFile path = isSocket <$> getFileStatus path + +-- Rootless podman cannot lsetxattr on files owned by another uid (e.g. /etc/*). +ownedBySelf :: FilePath -> IO Bool +ownedBySelf path = do + uid <- getEffectiveUserID + st <- getFileStatus path + return $ fileOwner st == uid + +-- DIR[:opts] for --home/--project (opts must not look like a path). +splitDirOpts :: String -> (FilePath, Maybe String) +splitDirOpts spec = + case break (== ':') spec of + (dir, []) -> (dir, Nothing) + (dir, _:rest) + | isVolumePathStart rest -> (spec, Nothing) + | otherwise -> (dir, Just rest) + +splitDirOptsMaybe :: Maybe (String,Bool) + -> (Maybe FilePath, Maybe String, Bool) +splitDirOptsMaybe Nothing = (Nothing, Nothing, False) +splitDirOptsMaybe (Just (s,backup)) = + let (dir, opts) = splitDirOpts s + in (Just dir, opts, backup) + +maybeOpts :: Maybe String -> String +maybeOpts Nothing = "" +maybeOpts (Just o) = ':' : o + +isVolumePathStart :: String -> Bool +isVolumePathStart ('/':_) = True +isVolumePathStart ('~':_) = True +isVolumePathStart ('$':_) = True +isVolumePathStart _ = False + -- path and env expansion expandPath :: FilePath -> String -> IO FilePath @@ -663,6 +749,47 @@ warning "mounting $HOME as project (consider a subdirectory)" return finaldir +-- True if path is base or a subdirectory of base (avoids /home/foo vs /home/foobar). +isUnderDir :: FilePath -> FilePath -> Bool +isUnderDir base path = + path == base || (base ++ "/") `isPrefixOf` path + +-- Pre-create a bind mount point under temp home when the container path is +-- inside $HOME (directories, or empty files for file/socket mounts). +ensureTempHomeMountPoint :: FilePath -> FilePath -> FilePath -> FilePath -> IO () +ensureTempHomeMountPoint homedir temphome hostPath containerPath = + when (isUnderDir homedir containerPath) $ do + let dest = temphome makeRelative homedir containerPath + hostIsFile <- doesFileExist hostPath + hostIsSock <- isSocketFile hostPath + if hostIsFile || hostIsSock + then do + createDirectoryIfMissing True (takeDirectory dest) + destExists <- doesPathExist dest + unless destExists $ writeFile dest "" + else createDirectoryIfMissing True dest + +ensureTempHomeVol :: FilePath -> FilePath -> String -> IO () +ensureTempHomeVol homedir temphome spec = do + (hostPath, containerPath) <- volumePaths homedir spec + ensureTempHomeMountPoint homedir temphome hostPath containerPath + +-- Resolve host and container paths from a volume spec (before SELinux opts). +volumePaths :: FilePath -> String -> IO (FilePath, FilePath) +volumePaths homedir spec = + case break (== ':') spec of + (hostPart, []) -> do + p <- expandPath homedir hostPart + return (p, p) + (hostPart, _:rest') -> do + hostExp <- expandPath homedir hostPart + if isVolumePathStart rest' + then do + let containerPart = takeWhile (/= ':') rest' + containerExp <- expandPath homedir containerPart + return (hostExp, containerExp) + else return (hostExp, hostExp) + -- container naming sanitizeName :: String -> String @@ -670,6 +797,10 @@ where nameChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_.-" +-- Dots separate DNS labels in hostnames, so replace them for --hostname. +hostnameFromName :: String -> String +hostnameFromName = map (\c -> if c == '.' then '-' else c) + workProjectName :: FilePath -> String workProjectName = sanitizeName . takeFileName @@ -705,11 +836,11 @@ mkUserCmd [] inits = mkUserCmd ["bash"] inits mkUserCmd ["bash"] (_:_) = ["bash", "--rcfile", "/tmp" progname ++ "-init.sh"] -mkUserCmd cmd inits@(_:_) = +mkUserCmd com inits@(_:_) = let initChain = intercalate " && " inits - cmdStr = initChain +-+ "&& exec" +-+ unwords (map shellQuote cmd) + cmdStr = initChain +-+ "&& exec" +-+ unwords (map shellQuote com) in ["sh", "-c", cmdStr] -mkUserCmd cmd [] = cmd +mkUserCmd com [] = com -- utilities diff --git a/src/Script.hs b/src/Script.hs --- a/src/Script.hs +++ b/src/Script.hs @@ -1,3 +1,5 @@ +-- SPDX-License-Identifier: Apache-2.0 + {-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-} module Script (