encapsule (empty) → 0.3
raw patch · 7 files changed
+1100/−0 lines, 7 filesdep +basedep +containersdep +directory
Dependencies added: base, containers, directory, extra, filepath, process, shell-monad, simple-cmd, simple-cmd-args, text, toml-reader, unix, xdg-basedir
Files
- ChangeLog.md +47/−0
- LICENSE +177/−0
- README.md +191/−0
- encapsule.cabal +70/−0
- example/config.toml +22/−0
- src/Main.hs +556/−0
- src/Script.hs +37/−0
+ ChangeLog.md view
@@ -0,0 +1,47 @@+# encapsule releases++## 0.3 (2026-07-20)+- project renamed from constrained-toolbox+- rename `--persistent` to `--keep`+- add `--list` command to show encapsule containers and images+- add `--no-sudo` to remove sudo from the container+- check toolbox container exists before buildah commit+- support running container images directly (name:tag)+- add `--name` option+- add `--debug` flag for verbose startup output+- use `--name ^...` to reference a full container name explicitly+- export TERM and COLORTERM+- `--delete` and commit image now respect --dryrun+- use shell-monad for installSetup Script+- installScript now respects `--no-sudo` and outputs "installing"+- use xdg-basedir for config file+- error for `--project`/`--home` on HOME+- `--project` now names the container after the project directory too,+ so different projects can run concurrently in separate containers+- add `--podman-opt` to pass options directly to podman++## 0.2.1 (2026-07-17)+- add --delete container command+- handle missing container gracefully in --stop and --remove+- default to ephemeral containers again, use --persistent to keep++## 0.2 (2026-07-16)+- add `--home` option to mount a directory as a writable home+- name the container and exec into it if already running+- add `--unique` option to run a separate container instance+- make home directory writable and workdir by default+- change `--delete` to `--delete-image` standalone command+- add `--ephemeral`, restart stopped containers+- error for unused options when joining running container+- add --stop command++## 0.1 (2026-07-03)+- initial release with `--delete` and `--project` options+- defaults to :z shared bind mounts+- `--caps` to list user's defined capabilities+- wayland: fix socket handling in SELinux labeling+- add `security_opts` capability field+- support PATH[:opts] shorthand for same host/container mount path+ (makes config incompatible with toolbox-constrained)+- add `--no-network` option to disable network access+- exit cleanly on shell error instead of throwing an exception
+ LICENSE view
@@ -0,0 +1,177 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to the Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by the Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding any notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS
+ README.md view
@@ -0,0 +1,191 @@+# encapsule++CLI tool to run developer containers, isolating your home directory and host from container side effects:+"encapsules" a project and/or temp home dir together with select "capabilities".++Originally derived from [toolbox-constrained](https://github.com/swick/toolbox-constrained) tool.++Run a ([toolbox](https://containertoolbx.org/)) container or image as+an isolated podman container. Unlike with `toolbox enter`, 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,+selecting user-configured "capabilities" that the encapsule container can access.++```+encapsule 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++# 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 .++# Bind mount a volume+$ encapsule my-toolbox -v ~/data:/data++# Mount a temp "home" directory (created if it doesn't exist)+$ encapsule my-toolbox --home /tmp/somedir++# Use capabilities from config+$ encapsule my-toolbox --cap ssh --cap git++# Read-only container filesystem+$ encapsule my-toolbox --readonly++# Remove the saved image+$ encapsule my-toolbox --delete-image++# Set environment variables and prepend to PATH+$ encapsule my-toolbox -e MY_VAR=hello -P ~/.local/bin++# Run a specific command+$ encapsule my-toolbox -- ls /++# Dry run: print the full podman command without running it+$ encapsule my-toolbox --dryrun++# run directly from an image+$ encapsule fedora:44 --home tmphome+```++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++`$ encapsule --version`++```+0.3+```++`$ encapsule --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]++ Run a toolbox image in an isolated podman 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+ -P,--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+ --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+ --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+```++## Capabilities++Define reusable groups of volumes, environment variables, PATH entries,+and init commands in `~/.config/encapsule/config.toml`:++```toml+[capabilities.ssh]+volumes = ["~/.ssh:~/.ssh:ro"]++[capabilities.git]+volumes = ["~/.gitconfig:ro"]++[capabilities.wayland]+env = ["WAYLAND_DISPLAY", "XDG_RUNTIME_DIR"]+volumes = ["$XDG_RUNTIME_DIR/$WAYLAND_DISPLAY"]+security_opts = ["label=disable"]++[capabilities.rust]+path = ["~/.cargo/bin"]+```++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++`~` and envvars are expanded in volume and path specs.+If the host and container paths are the same, you can use the shorthand+`PATH[:opts]` instead of `PATH:PATH[:opts]`.++## How it works++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.+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+6. When `-p/--project DIR` is used (and `--name` isn't), the container name+ includes the project directory's name (e.g. `encapsule-mytoolbox-myproject`),+ so you can run the same toolbox against different projects at the same time+ in separate encapsule containers++## Installation++A copr repo is available for Fedora and Epel 10:++<https://copr.fedorainfracloud.org/coprs/petersen/encapsule/>++## Building from source++```bash+cabal install+```++or `stack install`.++## 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.++## Related projects++I already mentioned [toolbox-constrained](https://github.com/swick/toolbox-constrained) from which the initial code was derived.++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/).++## Contribute++`encapsule` is at <https://github.com/juhp/encapsule> and distributed+under the Apache-2.0 license.
+ encapsule.cabal view
@@ -0,0 +1,70 @@+cabal-version: 2.2+name: encapsule+version: 0.3+synopsis: Run isolated toolbox containers with podman+description:+ This tool (originally based on the toolbox-constrained project)+ allows running isolated toolbox containers with podman.+ Mounting of home and host integration are not enabled by default,+ but one can choose options to do so including capabilities+ specified in a toml configuration file.+license: Apache-2.0+license-file: LICENSE+author: Jens Petersen <juhpetersen@gmail.com>+maintainer: Jens Petersen <juhpetersen@gmail.com>+copyright: 2026 Jens Petersen <juhpetersen@gmail.com>+category: Utility+homepage: https://github.com/juhp/encapsule+bug-reports: https://github.com/juhp/encapsule/issues+build-type: Simple+extra-doc-files: README.md+ ChangeLog.md+ example/config.toml+tested-with: GHC == 8.10.7+ || == 9.0.2+ || == 9.2.8+ || == 9.4.8+ || == 9.6.7+ || == 9.8.4+ || == 9.10.3+ || == 9.12.4+ || == 9.14.1++source-repository head+ type: git+ location: https://github.com/juhp/encapsule.git++executable encapsule+ main-is: Main.hs+ other-modules: Paths_encapsule+ Script+ autogen-modules: Paths_encapsule+ hs-source-dirs: src+ build-depends: base < 5+ , directory+ , extra+ , filepath+ , containers+ , process+ , shell-monad+ , simple-cmd >= 0.2.3+ , simple-cmd-args >= 0.1.8+ , text+ , toml-reader+ , unix+ , xdg-basedir+ default-language: Haskell2010+ ghc-options: -Wall+ if impl(ghc >= 8.0)+ ghc-options: -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields+ if impl(ghc >= 8.10)+ ghc-options: -Wunused-packages
+ example/config.toml view
@@ -0,0 +1,22 @@+[capabilities.ssh]+volumes = ["~/.ssh:~/.ssh:ro"]++[capabilities.git]+volumes = ["~/.gitconfig:ro"]++[capabilities.wayland]+env = ["WAYLAND_DISPLAY", "XDG_RUNTIME_DIR"]+volumes = ["$XDG_RUNTIME_DIR/$WAYLAND_DISPLAY"]+security_opts = ["label=disable"]++[capabilities.rust]+path = ["~/.cargo/bin"]++[capabilities.claude]+volumes = [+ "~/.claude",+ "~/.claude.json",+]++[capabilities.default]+volumes = ["~/.config/isolation:~:rw"]
+ src/Main.hs view
@@ -0,0 +1,556 @@+-- SPDX-License-Identifier: Apache-2.0++{-# LANGUAGE RecordWildCards #-}++module Main (main) where++import Control.Monad (unless, when)+import Data.List.Extra (intercalate, splitOn)+import qualified Data.Map.Strict as Map+import Data.Maybe (isJust, isNothing, mapMaybe)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import System.Directory (canonicalizePath, createDirectoryIfMissing, doesFileExist, doesPathExist, getHomeDirectory)+import System.Environment.XDG.BaseDir (getUserConfigFile)+import System.Exit (exitWith)+import System.FilePath ((</>), 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.Process (rawSystem)+import SimpleCmd (cmd_, cmdBool, cmdFull, error', warning, (+-+))+import SimpleCmdArgs+import TOML (Value(..), Table, renderTOMLError, decodeFile)++import Paths_encapsule (version)+import Script++progname :: String+progname = "encapsule"++encapsule :: String -> String -> String+encapsule before after = before +-+ progname +-+ after++data Mode = Caps | DeleteImage | List | Remove | Run | Stop+ deriving Eq++data Opts = Opts+ { mtoolbox :: Maybe String+ , vols :: [String]+ , envs :: [String]+ , paths :: [String]+ , inits :: [String]+ , caps :: [String]+ , mhome :: Maybe FilePath+ , mproject :: Maybe FilePath+ , mname :: Maybe String+ , mode :: Mode+ , keep :: Bool+ , readonly :: Bool+ , nonetwork :: Bool+ , nosudo :: Bool+ , unique :: Bool+ , podmanopts :: [String]+ , debugging :: Bool+ , dryrun :: Bool+ , refresh :: Bool+ , 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]+ 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)+ 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+ where+ createContainer home mprojectDir toolbox container = do+ mhomeDir <-+ case mhome of+ Just dir -> Just <$> checkMountPoint home dir+ Nothing -> return Nothing+ let isImage = ':' `elem` toolbox+ debug $ if isImage then "image:" +-+ toolbox+ else "toolbox:" +-+ toolbox+ image <- if isImage+ then return toolbox+ else commitToolbox dryrun toolbox refresh+ config <- loadConfig+ let capabilities = getCapabilities config++ (extraVols, extraEnvs, extraPaths, extraInits, extraSecurityOpts) <-+ resolveCapabilities capabilities caps++ homeVol <-+ case mhomeDir of+ Just d -> do+ createDirectoryIfMissing True d+ return [d ++ ":" ++ home]+ Nothing -> return []++ username <- getEffectiveUserName++ let projectVol =+ case mprojectDir of+ Just d -> [d ++ ":" ++ rootDest d]+ Nothing -> []+ volumes = homeVol ++ vols ++ extraVols ++ projectVol+ envVars = envs ++ extraEnvs+ allpaths = paths ++ extraPaths+ allinits = inits ++ extraInits++ envParts = ("HOME=" ++ shellQuote home) : pathEnvPart allpaths+ initSetup = mkInitSetup allinits+ userCmdParts = mkUserCmd command allinits+ runuserCmd = "env" +-+ unwords (envParts ++ map shellQuote userCmdParts)++ sudoers = "/etc/sudoers.d" </> progname+ installSetup =+ [TL.unpack $ installScript debugging (not nosudo) | isImage]+ sudoSetup =+ if nosudo+ then ["rm -f /usr/bin/sudo"]+ else ["echo" +-+ shellQuote (username +-+ "ALL=(ALL) NOPASSWD:ALL")+ +-+ ">" +-+ sudoers,+ "chmod 440" +-+ sudoers]+ homeSetup =+ if isNothing mhome+ then ["mkdir -p" +-+ shellQuote home,+ "chown" +-+ username +-+ shellQuote home]+ else []+ fallback =+ if isImage+ then " || exec" +-+ runuserCmd+ else ""+ trace = ["set -x" | debugging]+ setup = intercalate " && "+ (trace ++ installSetup ++ sudoSetup ++ homeSetup +++ [initSetup | not (null allinits)] +++ ["exec runuser -u" +-+ username +-+ "--" +-+ runuserCmd])+ ++ fallback++ debug $ "setup:" +-+ setup+ mounts <- mapM (addSelinuxLabel home) volumes++ let workdirPart =+ case mprojectDir of+ Just d -> ["--workdir", rootDest d]+ Nothing | not isImage -> ["--workdir", home]+ | otherwise -> []+ args = "run" :+ [ "--rm" | not keep] +++ [ "-it", "--userns=keep-id",+ "--name", container, "--hostname", container,+ "--user", "root", "-e", "HOME=" ++ home,+ "-e", "TERM", "-e", "COLORTERM"]+ ++ workdirPart+ ++ (if readonly+ then ["--read-only", "--tmpfs", "/tmp", "--tmpfs", "/run"]+ ++ case mhomeDir of+ Nothing -> ["--tmpfs", home]+ Just _ -> []+ else [])+ ++ (if nonetwork then ["--net", "none"] else [])+ ++ concatMap (\s -> ["--security-opt", s]) extraSecurityOpts+ ++ concatMap (\m -> ["-v", m]) mounts+ ++ concatMap (\e -> ["-e", e]) envVars+ ++ podmanopts+ ++ [image, "sh", "-c", setup]++ if dryrun+ then putStrLn $ unwords $ "podman" : map shellQuote args+ else do+ 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++commitToolbox :: Bool -> String -> Bool -> IO String+commitToolbox dryrun toolbox refresh = do+ let image = progname ++ '-' : toolbox+ imageExists <- cmdBool "podman" ["image", "exists", image]+ if imageExists && not refresh+ then return image+ else do+ containerExists <- cmdBool "podman" ["container", "exists", toolbox]+ if containerExists+ then do+ ok <-+ if dryrun then return True+ else do+ putStr "writing image "+ cmdBool "buildah"+ ["commit", "--disable-compression", toolbox, image]+ if ok+ then return image+ else error' $ "could not commit image of container" +-+ toolbox+ else error' $ "container '" ++ toolbox ++ "' not found"++removeImage :: String -> IO ()+removeImage image = do+ putStr "rmi "+ cmd_ "podman" ["rmi", image]++-- config++configPath :: IO FilePath+configPath = getUserConfigFile progname "config.toml"++loadConfig :: IO (Maybe Table)+loadConfig = do+ path <- configPath+ exists <- doesFileExist path+ if not exists+ then return Nothing+ else do+ result <- decodeFile path+ case result of+ Left e -> error' $ "config parse error:" +-+ T.unpack (renderTOMLError e)+ Right table -> return (Just table)++getCapabilities :: Maybe Table -> Table+getCapabilities Nothing = Map.empty+getCapabilities (Just table) =+ case Map.lookup (T.pack "capabilities") table of+ Just (Table t) -> t+ _ -> Map.empty++resolveCapabilities :: Table -> [String] -> IO ([String], [String], [String], [String], [String])+resolveCapabilities caps capNames = do+ results <- mapM (resolveCap caps) capNames+ let (vs, es, ps, is, ss) = unzip5 results+ return (concat vs, concat es, concat ps, concat is, concat ss)+ where+ unzip5 = foldr (\(a,b,c,d,e) (as,bs,cs,ds,es) -> (a:as,b:bs,c:cs,d:ds,e:es))+ ([],[],[],[],[])++resolveCap :: Table -> String -> IO ([String], [String], [String], [String], [String])+resolveCap caps name =+ case Map.lookup (T.pack name) caps of+ Just (Table cap) ->+ return ( getStringList "volumes" cap+ , getStringList "env" cap+ , getStringList "path" cap+ , case getStringVal "init" cap of+ Just s -> [s]+ Nothing -> []+ , getStringList "security_opts" cap+ )+ _ -> do+ let available = if Map.null caps+ then "(none defined)"+ else intercalate ", " $ map T.unpack $ Map.keys caps+ error' $ "unknown capability '" ++ name ++ "'. Available:" +-+ available++getStringList :: String -> Table -> [String]+getStringList key table =+ case Map.lookup (T.pack key) table of+ Just (Array arr) -> mapMaybe valueToString arr+ _ -> []++getStringVal :: String -> Table -> Maybe String+getStringVal key table =+ case Map.lookup (T.pack key) table of+ Just (String t) -> Just (T.unpack t)+ _ -> Nothing++valueToString :: Value -> Maybe String+valueToString (String t) = Just (T.unpack t)+valueToString _ = Nothing++-- SELinux labeling++addSelinuxLabel :: FilePath -> String -> IO String+addSelinuxLabel home spec =+ case break (== ':') spec of+ (hostPart, []) -> do+ hostExp <- expandPath home hostPart+ sockFile <- isSocketFile hostExp+ return $ hostExp ++ ":" ++ hostExp ++ if sockFile then "" else ":z"+ (hostPart, _:rest') -> do+ hostExp <- expandPath home 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+ let labeled = case optsPart of+ Nothing ->+ if sockFile+ then hostExp ++ ":" ++ containerExp+ else hostExp ++ ":" ++ containerExp ++ ":z"+ Just o ->+ let flags = splitOn "," o+ in if sockFile || "z" `elem` flags || "Z" `elem` flags+ then hostExp ++ ":" ++ containerExp ++ ":" ++ o+ else hostExp ++ ":" ++ containerExp ++ ":" ++ o ++ ",z"+ return labeled+ where+ isPathStart ('/':_) = True+ isPathStart ('~':_) = True+ isPathStart ('$':_) = True+ isPathStart _ = False++isSocketFile :: FilePath -> IO Bool+isSocketFile path = do+ exists <- doesPathExist path+ if exists+ then isSocket <$> getFileStatus path+ else return False++-- path and env expansion++rootDest :: FilePath -> FilePath+rootDest dir = '/' : takeFileName dir++expandPath :: FilePath -> String -> IO String+expandPath home ('~':'/':rest) = do+ rest' <- expandEnvVars rest+ return $ home </> rest'+expandPath home "~" = return home+expandPath _ s = expandEnvVars s++expandEnvVars :: String -> IO String+expandEnvVars [] = return []+expandEnvVars ('$':'{':rest) =+ case break (== '}') rest of+ (var, '}':after) -> do+ val <- getEnvDefault var ""+ rest' <- expandEnvVars after+ return (val ++ rest')+ _ -> do+ rest' <- expandEnvVars rest+ return ("${" ++ rest')+expandEnvVars ('$':rest) =+ let (var, after) = span isVarChar rest+ in if null var+ then do+ rest' <- expandEnvVars rest+ return ('$' : rest')+ else do+ val <- getEnvDefault var ""+ rest' <- expandEnvVars after+ return (val ++ rest')+ where+ isVarChar c = c `elem` (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_")+expandEnvVars (c:rest) = do+ 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!"+ 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+sanitizeName = map (\c -> if c `elem` nameChars then c else '-')+ where+ nameChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_.-"++projectSuffix :: Maybe FilePath -> String+projectSuffix Nothing = ""+projectSuffix (Just dir) =+ case sanitizeName (takeFileName dir) of+ "" -> ""+ name -> "-" ++ name++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++-- shell command construction++pathEnvPart :: [String] -> [String]+pathEnvPart [] = []+pathEnvPart ps =+ let prefix = intercalate ":" ps+ in ["PATH=\"" ++ prefix ++ ":$PATH\""]++mkInitSetup :: [String] -> String+mkInitSetup [] = ""+mkInitSetup snippets =+ let content = intercalate "\\n" snippets+ in "printf" +-+ shellQuote content +-+ "> /tmp" </> progname ++ "-init.sh"++mkUserCmd :: [String] -> [String] -> [String]+mkUserCmd [] inits = mkUserCmd ["bash"] inits+mkUserCmd ["bash"] (_:_) =+ ["bash", "--rcfile", "/tmp" </> progname ++ "-init.sh"]+mkUserCmd cmd inits@(_:_) =+ let initChain = intercalate " && " inits+ cmdStr = initChain +-+ "&& exec" +-+ unwords (map shellQuote cmd)+ in ["sh", "-c", cmdStr]+mkUserCmd cmd [] = cmd++-- utilities++shellQuote :: String -> String+shellQuote s+ | all isSafe s = s+ | otherwise = "'" ++ concatMap escSQ s ++ "'"+ where+ isSafe c = c `elem` (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_./=:@,+")+ escSQ '\'' = "'\\''"+ escSQ c = [c]
+ src/Script.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}++module Script (+ installScript+ )+where++import Control.Monad.Shell+import qualified Data.Text.Lazy as T+import System.Posix.IO++default (T.Text)++installScript :: Bool -> Bool -> T.Text+installScript dbg sudo =+ T.replace "\t" " " . linearScript $ do+ unlessCmd (haveCmd "runuser") $ do+ let pkgs = "util-linux" : ["sudo" | sudo]+ installargs = ["install", "-y"] ++ pkgs+ run "echo" $ T.pack "installing:" : pkgs+ ifCmd (haveCmd "dnf")+ (runHide "dnf" installargs+ -||-+ run "true" [])+ (whenCmd (haveCmd "apt-get") $+ runHide "apt-get" ["update"]+ -&&-+ runHide "apt-get" installargs+ -||-+ run "true" [])+ where+ redir s dest =+ if dbg then s else s |> (dest :: String) &stdError>&stdOutput++ runHide c args = run c args `redir` "/dev/null"++ haveCmd c = runHide "command" ["-v",c]