diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +0.2 +--- +* LXC errors through `getLastError` function +* `getDaemonize` function +* `start` function fixed (and changed type) +* `Show` instance for `BDevSpecs` +* updated documentation (haddock and README) + 0.1.1 --- * fixed package (`bindings-lxc` dependency) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,94 @@ lxc === +[![Build Status](https://travis-ci.org/fizruk/lxc.svg?branch=master)](https://travis-ci.org/fizruk/lxc) + High level Haskell bindings to LXC (Linux containers). + +The library provides Haskell LXC API, wrapping . + +## Requirements + +Before installation make sure you have LXC installed on your system with header files and static library. + +On Ubuntu 14.04 LTS (Trusty Tahr): + +``` +$ sudo apt-get install lxc-dev +``` + +On previous Ubuntu versions (including 12.04 LTS Precise Pangolin) standard repositories do not contain `liblxc1` package. +You might want to use `ppa:ubuntu-lxc/stable` repository instead: + +``` +$ sudo apt-get install software-properties-common python-software-properties +$ sudo add-apt-repository ppa:ubuntu-lxc/stable +$ sudo apt-get update +$ sudo apt-get install lxc-dev +``` + +## Installation + +Get the latest stable version from Hackage: + +``` +$ cabal install lxc +``` + +or clone this repository: + +``` +$ git clone https://github.com/fizruk/lxc.git +$ cd lxc +$ cabal install +``` + +## Documentation + +Haddock documentation is available at http://fizruk.github.io/lxc/docs/ + +## Usage + +You can start using these bindings just like command line tool: + +``` +>>> trusty <- mkContainer "trusty" Nothing +>>> create trusty "download" Nothing Nothing [] ["-d", "ubuntu", "-r", "trusty", "-a", "amd64"] +Using image from local cache +Unpacking the rootfs + +--- +You just created an Ubuntu container (release=trusty, arch=amd64, variant=default) +The default username/password is: ubuntu / ubuntu +To gain root privileges, please use sudo. + +True +>>> start trusty False [] +True +>>> state trusty +ContainerRunning +>>> attachRunWait trusty defaultAttachOptions "echo" ["echo", "Hello, world!"] +Hello, world! +Just ExitSuccess +>>> stop trusty +True +>>> trustySnap <- clone trusty (Just "trusty-snap") Nothing [CloneSnapshot] Nothing Nothing Nothing [] +>>> start trustySnap False [] +True +>>> getInterfaces trustySnap +["eth0","lo"] +>>> getIPs trustySnap "eth0" "inet" 0 +["10.0.3.135"] +>>> shutdown trustySnap (-1) +True +>>> state trustySnap +ContainerStopped +``` + +## Contributing + +Contributions and bug reports are welcome! + +Please feel free to contact me via GitHub or on the #haskell IRC channel on irc.freenode.net. + +-Nickolay Kudasov diff --git a/lxc.cabal b/lxc.cabal --- a/lxc.cabal +++ b/lxc.cabal @@ -1,5 +1,5 @@ name: lxc -version: 0.1.1 +version: 0.2 synopsis: High level Haskell bindings to LXC (Linux containers). description: The library provides Haskell LXC API, wrapping . homepage: https://github.com/fizruk/lxc diff --git a/src/System/LXC.hs b/src/System/LXC.hs --- a/src/System/LXC.hs +++ b/src/System/LXC.hs @@ -1,3 +1,15 @@ +----------------------------------------------------------------------------- +-- | +-- Module : System.LXC +-- Copyright : (c) Nickolay Kudasov 2014 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : nickolay.kudasov@gmail.com +-- +-- Create, control and manage LXC containers through Haskell API. +-- You can get more info about LXC at . +-- +----------------------------------------------------------------------------- module System.LXC ( module System.LXC.Container, module System.LXC.AttachOptions diff --git a/src/System/LXC/AttachOptions.hs b/src/System/LXC/AttachOptions.hs --- a/src/System/LXC/AttachOptions.hs +++ b/src/System/LXC/AttachOptions.hs @@ -1,3 +1,17 @@ +----------------------------------------------------------------------------- +-- | +-- Module : System.LXC.AttachOptions +-- Copyright : (c) Nickolay Kudasov 2014 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : nickolay.kudasov@gmail.com +-- +-- Options and structures to run commands inside LXC containers. +-- You can get more info about LXC at . +-- +-- Normally you should import @System.LXC@ module only. +-- +----------------------------------------------------------------------------- module System.LXC.AttachOptions ( -- * Attach options AttachOptions(..), diff --git a/src/System/LXC/Container.hs b/src/System/LXC/Container.hs --- a/src/System/LXC/Container.hs +++ b/src/System/LXC/Container.hs @@ -1,3 +1,17 @@ +----------------------------------------------------------------------------- +-- | +-- Module : System.LXC.Container +-- Copyright : (c) Nickolay Kudasov 2014 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : nickolay.kudasov@gmail.com +-- +-- This module provides a set of functions to create, control and manage +-- LXC containers. You can get more info about LXC at . +-- +-- Normally you should import @System.LXC@ module only. +-- +----------------------------------------------------------------------------- module System.LXC.Container ( -- * Data types Container(..), @@ -10,12 +24,19 @@ CloneOption(..), CreateOption(..), cloneFlag, createFlag, + -- * LXC errors + LXCError(..), + prettyLXCError, -- * Container methods -- ** Query container state. isDefined, isRunning, state, initPID, + getInterfaces, + getIPs, + getDaemonize, + getLastError, -- ** Container config configFileName, getConfigPath, @@ -55,8 +76,6 @@ -- ** Misc wantDaemonize, wantCloseAllFDs, - getInterfaces, - getIPs, getCGroupItem, setCGroupItem, mayControl, diff --git a/src/System/LXC/Internal/AttachOptions.hs b/src/System/LXC/Internal/AttachOptions.hs --- a/src/System/LXC/Internal/AttachOptions.hs +++ b/src/System/LXC/Internal/AttachOptions.hs @@ -1,3 +1,16 @@ +----------------------------------------------------------------------------- +-- | +-- Module : System.LXC.Internal.AttachOptions +-- Copyright : (c) Nickolay Kudasov 2014 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : nickolay.kudasov@gmail.com +-- +-- Internal module to support options and structures to run +-- commands inside LXC containers. +-- Normally you should import @System.LXC@ module only. +-- +----------------------------------------------------------------------------- module System.LXC.Internal.AttachOptions where import Bindings.LXC.AttachOptions @@ -17,6 +30,9 @@ import System.Posix.Types +-- | @exec@ function to use for 'System.LXC.Container.attach'. +-- +-- See 'attachRunCommand' and 'attachRunShell'. newtype AttachExecFn = AttachExecFn { getAttachExecFn :: C_lxc_attach_exec_t } -- | LXC environment policy. @@ -25,10 +41,12 @@ | AttachClearEnv -- ^ Clear the environment. deriving (Eq, Show) +-- | Convert 'AttachEnvPolicy' to internal representation. fromAttachEnvPolicy :: Num a => AttachEnvPolicy -> a fromAttachEnvPolicy AttachKeepEnv = c'LXC_ATTACH_KEEP_ENV fromAttachEnvPolicy AttachClearEnv = c'LXC_ATTACH_CLEAR_ENV +-- | Flags for 'System.LXC.Container.attach'. data AttachFlag = AttachMoveToCGroup -- ^ Move to cgroup. On by default. | AttachDropCapabilities -- ^ Drop capabilities. On by default. @@ -40,6 +58,7 @@ | AttachLSM -- ^ All Linux Security Module flags. deriving (Eq, Show) +-- | Convert 'AttachFlag' to bit flag. fromAttachFlag :: Num a => AttachFlag -> a fromAttachFlag AttachMoveToCGroup = c'LXC_ATTACH_MOVE_TO_CGROUP fromAttachFlag AttachDropCapabilities = c'LXC_ATTACH_DROP_CAPABILITIES @@ -111,6 +130,7 @@ , attachArgv :: [String] -- ^ The @argv@ of that program, including the program itself as the first element. } +-- | Allocate @lxc_attach_options_t@ structure in a temporary storage. withC'lxc_attach_options_t :: AttachOptions -> (Ptr C'lxc_attach_options_t -> IO a) -> IO a withC'lxc_attach_options_t a f = do alloca $ \ca -> @@ -133,6 +153,7 @@ poke (p'lxc_attach_options_t'stderr_fd ca) (fromIntegral . attachStderrFD $ a) f ca +-- | Allocate @lxc_attach_command_t@ structure in a temporary storage. withC'lxc_attach_command_t :: AttachCommand -> (Ptr C'lxc_attach_command_t -> IO a) -> IO a withC'lxc_attach_command_t a f = do alloca $ \ca -> diff --git a/src/System/LXC/Internal/Container.hs b/src/System/LXC/Internal/Container.hs --- a/src/System/LXC/Internal/Container.hs +++ b/src/System/LXC/Internal/Container.hs @@ -1,3 +1,16 @@ +----------------------------------------------------------------------------- +-- | +-- Module : System.LXC.Internal.Container +-- Copyright : (c) Nickolay Kudasov 2014 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : nickolay.kudasov@gmail.com +-- +-- Internal module to provide a set of functions to create, +-- control and manage LXC containers. +-- Normally you should import @System.LXC@ module only. +-- +----------------------------------------------------------------------------- module System.LXC.Internal.Container where import Bindings.LXC.AttachOptions @@ -116,6 +129,17 @@ foreign import ccall "dynamic" mkFreeFn :: FunPtr SnapshotFreeFn -> SnapshotFreeFn +-- | LXC error structure. +data LXCError = LXCError + { lxcErrorString :: String -- ^ Error message. + , lxcErrorNum :: Int -- ^ Error number. + } + deriving (Show) + +-- | Pretty print LXC error message. +prettyLXCError :: LXCError -> String +prettyLXCError (LXCError msg num) = "Error " ++ show num ++ ": " ++ msg + -- | Options for 'clone' operation. data CloneOption = CloneKeepName -- ^ Do not edit the rootfs to change the hostname. @@ -160,18 +184,20 @@ getContainer :: Ptr C'lxc_container -- ^ A pointer to @lxc_container@ structure. } +-- | Container state. data ContainerState - = ContainerStopped - | ContainerStarting - | ContainerRunning - | ContainerStopping - | ContainerAborting - | ContainerFreezing - | ContainerFrozen - | ContainerThawed - | ContainerOtherState String + = ContainerStopped -- ^ Container is stopped. + | ContainerStarting -- ^ Container is starting. + | ContainerRunning -- ^ Container is running. + | ContainerStopping -- ^ Container is stopping. + | ContainerAborting -- ^ Container is aborting. + | ContainerFreezing -- ^ Container is freezing. + | ContainerFrozen -- ^ Container is frozen. + | ContainerThawed -- ^ Container is thawed. + | ContainerOtherState String -- ^ Container is in some other state. deriving (Eq, Show) +-- | Parse state as string representation. parseState :: String -> ContainerState parseState "STOPPED" = ContainerStopped parseState "STARTING" = ContainerStarting @@ -183,6 +209,7 @@ parseState "THAWED" = ContainerThawed parseState s = ContainerOtherState s +-- | Get string representation of a state. printState :: ContainerState -> String printState ContainerStopped = "STOPPED" printState ContainerStarting = "STARTING" @@ -204,6 +231,7 @@ , bdevLVMThinPool :: Maybe String -- ^ LVM thin pool to use, if any. , bdevDirectory :: FilePath -- ^ Directory path. } + deriving (Show) -- | Marshal Haskell 'BDevSpecs' into C structure using temporary storage. -- @@ -288,6 +316,18 @@ setItemFn' :: Field C'lxc_container (FunPtr ContainerSetItemFn) -> Container -> String -> String -> IO Bool setItemFn' g c k v = setItemFn g c k (Just v) +-- | Whether container wishes to be daemonized. +getDaemonize :: Container -> IO Bool +getDaemonize (Container c) = toBool <$> peek (p'lxc_container'daemonize c) + +-- | Get last container's error. +getLastError :: Container -> IO (Maybe LXCError) +getLastError (Container c) = do + cmsg <- peek (p'lxc_container'error_string c) + msg <- maybePeek peekCString cmsg + num <- fromIntegral <$> peek (p'lxc_container'error_num c) + return $ LXCError <$> msg <*> pure num + -- | Determine if @\/var\/lib\/lxc\/\$name\/config@ exists. -- -- @True@ if container is defined, else @False@. @@ -336,14 +376,17 @@ -- | Start the container. start :: Container -- ^ Container. - -> Int -- ^ Use @lxcinit@ rather than @/sbin/init@. + -> Bool -- ^ Use @lxcinit@ rather than @\/sbin\/init@. -> [String] -- ^ Array of arguments to pass to init. -> IO Bool -- ^ @True@ on success, else @False@. -start c n argv = do +start c useinit argv = do fn <- mkFn getContainer mkStartFn p'lxc_container'start c - withMany withCString argv $ \cargv -> - withArray0 nullPtr cargv $ \cargv' -> - toBool <$> fn (fromIntegral n) cargv' + case argv of + [] -> toBool <$> fn (fromBool useinit) nullPtr + _ -> do + withMany withCString argv $ \cargv -> + withArray0 nullPtr cargv $ \cargv' -> + toBool <$> fn (fromBool useinit) cargv' -- | Stop the container. -- @@ -637,9 +680,9 @@ -- @\/var\/lib\/lxc\/\\/snaps\/snap\@ -- where @\@ represents the container name and @\@ -- represents the zero-based snapshot number. -snapshot :: Container - -> FilePath - -> IO (Maybe Int) +snapshot :: Container -- ^ Container. + -> FilePath -- ^ Full path to file containing a description of the snapshot. + -> IO (Maybe Int) -- ^ @Nothing@ on error, or zero-based snapshot number. snapshot c path = do fn <- mkFn getContainer mkSnapshotFn p'lxc_container'snapshot c withCString path $ \cpath -> do @@ -658,8 +701,7 @@ peekField g f = peek (f ptr) >>= g -- | Obtain a list of container snapshots. -snapshotList :: Container - -> IO [Snapshot] +snapshotList :: Container -> IO [Snapshot] snapshotList c = do alloca $ \css -> do fn <- mkFn getContainer mkSnapshotListFn p'lxc_container'snapshot_list c @@ -750,8 +792,7 @@ -- -- @Just False@ on success, @Just True@ if reference was successfully dropped -- and container has been freed, and @Nothing@ on error. -dropRef :: Container - -> IO (Maybe Bool) +dropRef :: Container -> IO (Maybe Bool) dropRef (Container c) = do n <- c'lxc_container_put c return $ case n of diff --git a/src/System/LXC/Internal/Utils.hs b/src/System/LXC/Internal/Utils.hs --- a/src/System/LXC/Internal/Utils.hs +++ b/src/System/LXC/Internal/Utils.hs @@ -1,3 +1,15 @@ +----------------------------------------------------------------------------- +-- | +-- Module : System.LXC.Internal.Utils +-- Copyright : (c) Nickolay Kudasov 2014 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : nickolay.kudasov@gmail.com +-- +-- Internal module with utility functions. +-- Normally you should import @System.LXC@ module only. +-- +----------------------------------------------------------------------------- module System.LXC.Internal.Utils where import Data.Bits