encapsule 0.4 → 0.4.1
raw patch · 6 files changed
+299/−137 lines, 6 filesdep +simple-prompt
Dependencies added: simple-prompt
Files
- ChangeLog.md +13/−0
- README.md +29/−18
- encapsule.cabal +2/−1
- example/config.toml +12/−8
- src/Main.hs +241/−110
- src/Script.hs +2/−0
ChangeLog.md view
@@ -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
README.md view
@@ -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
encapsule.cabal view
@@ -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
example/config.toml view
@@ -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"]
src/Main.hs view
@@ -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-<timestamp>.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 == "<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)+-- 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
src/Script.hs view
@@ -1,3 +1,5 @@+-- SPDX-License-Identifier: Apache-2.0+ {-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-} module Script (