diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Nickolay Kudasov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Nickolay Kudasov nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,6 @@ +bindings-lxc +============ + +[![Build Status](https://travis-ci.org/fizruk/bindings-lxc.svg?branch=master)](https://travis-ci.org/fizruk/bindings-lxc) + +Direct Haskell bindings to LXC (Linux containers) C API. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bindings-lxc.cabal b/bindings-lxc.cabal new file mode 100644 --- /dev/null +++ b/bindings-lxc.cabal @@ -0,0 +1,34 @@ +name: bindings-lxc +version: 0.1 +synopsis: Direct Haskell bindings to LXC (Linux containers) C API. +description: The package provides direct bindings to LXC C API through @bindings-dsl@. +homepage: https://github.com/fizruk/bindings-lxc +license: BSD3 +license-file: LICENSE +author: Nickolay Kudasov +maintainer: nickolay.kudasov@gmail.com +-- copyright: +category: FFI +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + default-language: Haskell2010 + hs-source-dirs: src/ + include-dirs: include/ + build-depends: base >=4.7 && <4.8 + , bindings-DSL >=1.0 && <1.1 + extra-libraries: lxc + default-extensions: + ForeignFunctionInterface + exposed-modules: + Bindings.LXC + Bindings.LXC.Container + Bindings.LXC.AttachOptions + Bindings.LXC.Sys.Types + +source-repository head + type: git + location: https://github.com/fizruk/bindings-lxc.git + branch: master diff --git a/src/Bindings/LXC.hs b/src/Bindings/LXC.hs new file mode 100644 --- /dev/null +++ b/src/Bindings/LXC.hs @@ -0,0 +1,10 @@ +module Bindings.LXC ( + module Bindings.LXC.Container, + module Bindings.LXC.AttachOptions, + module Bindings.LXC.Sys.Types +) where + +import Bindings.LXC.Container +import Bindings.LXC.AttachOptions +import Bindings.LXC.Sys.Types + diff --git a/src/Bindings/LXC/AttachOptions.hsc b/src/Bindings/LXC/AttachOptions.hsc new file mode 100644 --- /dev/null +++ b/src/Bindings/LXC/AttachOptions.hsc @@ -0,0 +1,47 @@ +#include +#include + +module Bindings.LXC.AttachOptions where +#strict_import +import Bindings.LXC.Sys.Types + +type C_lxc_attach_exec_t = FunPtr (Ptr () -> IO CInt) + +#integral_t lxc_attach_env_policy_t + +#num LXC_ATTACH_KEEP_ENV +#num LXC_ATTACH_CLEAR_ENV + +#num LXC_ATTACH_MOVE_TO_CGROUP +#num LXC_ATTACH_DROP_CAPABILITIES +#num LXC_ATTACH_SET_PERSONALITY +#num LXC_ATTACH_LSM_EXEC +#num LXC_ATTACH_REMOUNT_PROC_SYS +#num LXC_ATTACH_LSM_NOW +#num LXC_ATTACH_DEFAULT + +#num LXC_ATTACH_LSM + +#starttype lxc_attach_options_t +#field attach_flags , CInt +#field namespaces , CInt +#field personality , CLong +#field initial_cwd , CString +#field uid , +#field gid , +#field env_policy , +#field extra_env_vars , Ptr CString +#field extra_keep_env , Ptr CString +#field stdin_fd , CInt +#field stdout_fd , CInt +#field stderr_fd , CInt +#stoptype + +#starttype lxc_attach_command_t +#field program , CString +#field argv , Ptr CString +#stoptype + +#ccall lxc_attach_run_command , Ptr () -> IO CInt +#ccall lxc_attach_run_shell , Ptr () -> IO CInt + diff --git a/src/Bindings/LXC/Container.hsc b/src/Bindings/LXC/Container.hsc new file mode 100644 --- /dev/null +++ b/src/Bindings/LXC/Container.hsc @@ -0,0 +1,104 @@ +#include +#include +#include "bindings.lxc.container.h" + +module Bindings.LXC.Container where +#strict_import +import Bindings.LXC.Sys.Types +import Bindings.LXC.AttachOptions + +#num LXC_CLONE_KEEPNAME +#num LXC_CLONE_KEEPMACADDR +#num LXC_CLONE_SNAPSHOT +#num LXC_CLONE_KEEPBDEVTYPE +#num LXC_CLONE_MAYBE_SNAPSHOT +#num LXC_CLONE_MAXFLAGS +#num LXC_CREATE_QUIET +#num LXC_CREATE_MAXFLAGS + +#starttype zfs_t +#field zfsroot, CString +#stoptype + +#starttype lvm_t +#field vg , CString +#field lv , CString +#field thinpool , CString +#stoptype + +#starttype struct bdev_specs +#field fstype , CString +#field fssize , +#field zfs , +#field lvm , +#field dir , CString +#stoptype + +#starttype struct lxc_snapshot +#field name , CString +#field comment_pathname , CString +#field timestamp , CString +#field lxcpath , CString +#field free , FunPtr ( -> IO ()) +#stoptype + +#starttype struct lxc_container +#field error_string , CString +#field error_num , CInt +#field daemonize , CBool +#field config_path , CString +#field is_defined , FunPtr (Ptr -> IO CBool) +#field state , FunPtr (Ptr -> IO CString) +#field is_running , FunPtr (Ptr -> IO CBool) +#field freeze , FunPtr (Ptr -> IO CBool) +#field unfreeze , FunPtr (Ptr -> IO CBool) +#field init_pid , FunPtr (Ptr -> IO ) +#field load_config , FunPtr (Ptr -> CString -> IO CBool) +#field start , FunPtr (Ptr -> CInt -> Ptr CString -> IO CBool) +#field stop , FunPtr (Ptr -> IO CBool) +#field want_daemonize , FunPtr (Ptr -> CBool -> IO CBool) +#field want_close_all_fds , FunPtr (Ptr -> CBool -> IO CBool) +#field config_file_name , FunPtr (Ptr -> IO CString) +#field wait , FunPtr (Ptr -> CString -> CInt -> IO CBool) +#field set_config_item , FunPtr (Ptr -> CString -> CString -> IO CBool) +#field destroy , FunPtr (Ptr -> IO CBool) +#field save_config , FunPtr (Ptr -> CString -> IO CBool) +#field create , FunPtr (Ptr -> CString -> CString -> Ptr -> CInt -> Ptr CString -> IO CBool) +#field rename , FunPtr (Ptr -> CString -> IO CBool) +#field reboot , FunPtr (Ptr -> IO CBool) +#field shutdown , FunPtr (Ptr -> CInt -> IO CBool) +#field clear_config , FunPtr (Ptr -> IO CBool) +#field clear_config_item , FunPtr (Ptr -> CString -> IO CBool) +#field get_config_item , FunPtr (Ptr -> CString -> CString -> CInt -> IO CInt) +#field get_running_config_item , FunPtr (Ptr -> CString -> IO CString) +#field get_keys , FunPtr (Ptr -> CString -> CString -> CInt -> IO CInt) +#field get_interfaces , FunPtr (Ptr -> IO (Ptr CString)) +#field get_ips , FunPtr (Ptr -> CString -> CString -> CInt -> IO (Ptr CString)) +#field get_cgroup_item , FunPtr (Ptr -> CString -> Ptr CChar -> CInt -> IO CInt) +#field set_cgroup_item , FunPtr (Ptr -> CString -> CString -> IO CBool) +#field get_config_path , FunPtr (Ptr -> IO CString) +#field set_config_path , FunPtr (Ptr -> CString -> IO CBool) +#field clone , FunPtr (Ptr -> CString -> CString -> CInt -> CString -> CString -> -> Ptr CString -> IO (Ptr )) +#field console_getfd , FunPtr (Ptr -> Ptr CInt -> Ptr CInt -> IO CInt) +#field console , FunPtr (Ptr -> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt) +#field attach , FunPtr (Ptr -> C_lxc_attach_exec_t -> Ptr () -> Ptr -> Ptr -> IO CInt) +#field attach_run_wait , FunPtr (Ptr -> C_lxc_attach_exec_t -> CString -> Ptr CString -> IO CInt) +#field snapshot , FunPtr (Ptr -> CString -> IO CInt) +#field snapshot_list , FunPtr (Ptr -> Ptr (Ptr ) -> IO CInt) +#field snapshot_restore , FunPtr (Ptr -> CString -> CString -> IO CBool) +#field snapshot_destroy , FunPtr (Ptr -> CString -> IO CBool) +#field may_control , FunPtr (Ptr -> IO CBool) +#field add_device_node , FunPtr (Ptr -> CString -> CString -> IO CBool) +#field remove_device_node , FunPtr (Ptr -> CString -> CString -> IO CBool) +#stoptype + +#ccall lxc_container_new , CString -> CString -> IO (Ptr ) +#ccall lxc_container_get , Ptr -> IO CInt +#ccall lxc_container_put , Ptr -> IO CInt +#ccall lxc_get_wait_states , Ptr CString -> IO CInt +#ccall lxc_get_global_config_item , CString -> IO CString +#ccall lxc_get_version , IO CString +#ccall list_defined_containers , CString -> Ptr (Ptr CString) -> Ptr (Ptr (Ptr )) +#ccall list_active_containers , CString -> Ptr (Ptr CString) -> Ptr (Ptr (Ptr )) +#ccall list_all_containers , CString -> Ptr (Ptr CString) -> Ptr (Ptr (Ptr )) +#ccall lxc_log_close , IO () diff --git a/src/Bindings/LXC/Sys/Types.hsc b/src/Bindings/LXC/Sys/Types.hsc new file mode 100644 --- /dev/null +++ b/src/Bindings/LXC/Sys/Types.hsc @@ -0,0 +1,13 @@ +#include +#include +#include + +module Bindings.LXC.Sys.Types where +#strict_import + +type CBool = CInt + +#integral_t pid_t +#integral_t uint64_t +#integral_t uid_t +#integral_t gid_t