├── .gitignore ├── .travis.yml ├── LICENSE ├── Makefile ├── README.md ├── lxc-wrapper-test.asd ├── lxc-wrapper.asd ├── manpage.md ├── src ├── cli.lisp ├── ip.lisp ├── lxc-wrapper.lisp ├── lxc.lisp └── package.lisp └── test ├── cli.lisp ├── ip.lisp ├── lxc-wrapper.lisp └── test-suites.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | deps 3 | install-deps 4 | .quicklocal/ 5 | bin/ 6 | quicklisp.lisp 7 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: lisp 2 | 3 | env: 4 | matrix: 5 | - LISP=sbcl 6 | 7 | matrix: 8 | allow_failures: 9 | # CIM not available for CMUCL 10 | - env: LISP=cmucl 11 | 12 | # either use a local install.sh script or install it via curl. Feel 13 | # free to simplify this section in your own .travis.yml file. 14 | install: 15 | curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | sh; 16 | 17 | # this bit is just testing that travis correctly sets up ASDF to find 18 | # systems placed somewhere within ~/lisp. You can remove this section 19 | # in your own .travis.yml file. 20 | before_script: 21 | - echo "(defsystem :dummy-cl-travis-system)" > ~/lisp/dummy-cl-travis-system.asd 22 | 23 | # this serves as an example of how to use the 'cl' script (provided by 24 | # CIM) to test your Lisp project. Here, we're using the RT framework 25 | # to do unit testing; other frameworks will have different ways of 26 | # determining whether a test suite fails or succeeds. 27 | script: 28 | - cl -e '(ql:quickload :lxc-wrapper)' 29 | -e '(ql:quickload :fiveam)' 30 | -e '(setf fiveam:*debug-on-error* t 31 | fiveam:*debug-on-failure* t)' 32 | -e '(setf *debugger-hook* 33 | (lambda (c h) 34 | (declare (ignore c h)) 35 | (uiop:quit -1)))' 36 | -e '(asdf:test-system :lxc-wrapper)' 37 | 38 | # testing (albeit not extensively) that, even when invoked directly, 39 | # Lisps still have Quicklisp available. 40 | - if [ "$LISP" = "sbcl" ]; then 41 | sbcl --non-interactive 42 | --eval '(format t "~%Quicklisp version ~a is available!~%" 43 | (ql:client-version))'; 44 | fi 45 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Florian Margaine 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 21 | THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | APP_NAME=lxc-wrapper 2 | VERSION= 3 | LISP_FILES=$(shell find . -name '*.lisp') 4 | ASDF_TREE ?= ~/quicklisp/ 5 | DIST_FOLDER=dist/root/usr/bin 6 | APP_OUT=dist/root/usr/bin/lxc-wrapper 7 | QL_LOCAL=$(PWD)/.quicklocal/quicklisp 8 | QUICKLISP_SCRIPT=http://beta.quicklisp.org/quicklisp.lisp 9 | LOCAL_OPTS=--noinform --noprint --disable-debugger --no-sysinit --no-userinit 10 | QL_OPTS=--load $(QL_LOCAL)/setup.lisp 11 | LISP ?= sbcl 12 | SOURCES := $(wildcard src/*.lisp) $(wildcard *.asd) 13 | BUILDAPP = ./bin/buildapp 14 | TEST_SOURCES=$(shell find test/ -name '*.lisp') 15 | 16 | .PHONY: clean install release deb rpm test man 17 | 18 | all: $(APP_OUT) 19 | 20 | test: $(TEST_SOURCES) $(QL_LOCAL)/setup.lisp install-deps 21 | @sbcl $(QL_OPTS) \ 22 | --eval '(ql:quickload :fiveam)' \ 23 | --eval '(ql:quickload :lxc-wrapper)' \ 24 | --eval '(asdf:test-system :lxc-wrapper)' \ 25 | --quit 26 | 27 | release: 28 | make clean 29 | make 30 | make man 31 | make deb 32 | make rpm 33 | 34 | man: 35 | mkdir -p dist/root/usr/share/man/man1/ 36 | pandoc -s -t man manpage.md > dist/root/usr/share/man/man1/lxc-wrapper.1 37 | gzip dist/root/usr/share/man/man1/lxc-wrapper.1 38 | 39 | deb: $(APP_OUT) 40 | @fpm -p dist/ \ 41 | -d "lxc (>= 1.0)" \ 42 | -s dir -t deb -n $(APP_NAME) -v $(VERSION) -C dist/root usr 43 | @gpg --output dist/$(APP_NAME)_$(VERSION)-deb.sig \ 44 | --detach-sig dist/$(APP_NAME)_$(VERSION)_amd64.deb 45 | 46 | rpm: $(APP_OUT) 47 | @fpm -p dist/ \ 48 | -d "lxc" \ 49 | -s dir -t rpm -n $(APP_NAME) -v $(VERSION) -C dist/root usr 50 | @gpg --output dist/$(APP_NAME)_$(VERSION)-rpm.sig \ 51 | --detach-sig dist/$(APP_NAME)-$(VERSION)-1.x86_64.rpm 52 | 53 | install: $(APP_OUT) 54 | install $(APP_OUT) $(DESTDIR)/usr/bin 55 | install -g 0 -o 0 -m 0644 dist/root/usr/share/man/man1/lxc-wrapper.1.gz /usr/share/man/man1/ 56 | 57 | bin: 58 | @mkdir bin 59 | 60 | clean: 61 | @-yes | rm -rf $(QL_LOCAL) 62 | @-rm -f $(APP_OUT) deps install-deps 63 | @-rm -f dist/lxc-wrapper* 64 | 65 | $(QL_LOCAL)/setup.lisp: 66 | @curl -O $(QUICKLISP_SCRIPT) 67 | @sbcl $(LOCAL_OPTS) \ 68 | --load quicklisp.lisp \ 69 | --eval '(quicklisp-quickstart:install :path "$(QL_LOCAL)")' \ 70 | --eval '(quit)' 71 | 72 | deps: 73 | @sbcl $(LOCAL_OPTS) $(QL_OPTS) \ 74 | --eval '(push "$(PWD)/" asdf:*central-registry*)' \ 75 | --eval '(ql:quickload :lxc-wrapper)' \ 76 | --eval '(quit)' 77 | @touch $@ 78 | 79 | install-deps: $(QL_LOCAL)/setup.lisp deps 80 | @touch $@ 81 | 82 | bin/buildapp: bin $(QL_LOCAL)/setup.lisp 83 | @cd $(shell sbcl $(LOCAL_OPTS) $(QL_OPTS) \ 84 | --eval '(ql:quickload :buildapp :silent t)' \ 85 | --eval '(format t "~A~%" (asdf:system-source-directory :buildapp))' \ 86 | --eval '(quit)') && \ 87 | $(MAKE) DESTDIR=$(PWD) install 88 | 89 | $(APP_OUT): $(SOURCES) bin/buildapp $(QL_LOCAL)/setup.lisp install-deps 90 | @mkdir -p $(DIST_FOLDER) 91 | @$(BUILDAPP) --logfile /tmp/build.log \ 92 | --sbcl sbcl \ 93 | --asdf-path . \ 94 | --asdf-tree $(QL_LOCAL)/local-projects \ 95 | --asdf-tree $(QL_LOCAL)/dists \ 96 | --asdf-path . \ 97 | --load-system $(APP_NAME) \ 98 | --entry $(APP_NAME):main \ 99 | --compress-core \ 100 | --output $(APP_OUT) 101 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # lxc-wrapper 2 | 3 | [![Build Status](https://travis-ci.org/Ralt/lxc-wrapper.svg?branch=master)](https://travis-ci.org/Ralt/lxc-wrapper) 4 | 5 | An opinionated LXC wrapper. 6 | 7 | 8 | 9 | 10 | - [LX-What?](#lx-what) 11 | - [Motivation](#motivation) 12 | - [What it does](#what-it-does) 13 | - [Example session](#example-session) 14 | - [Why not docker?!](#why-not-docker) 15 | - [Installation](#installation) 16 | - [CLI Usage](#cli-usage) 17 | - [Requirements](#requirements) 18 | - [Limitations](#limitations) 19 | - [Development](#development) 20 | - [API](#api) 21 | - [Functions](#functions) 22 | - [`create`](#create) 23 | - [`destroy`](#destroy) 24 | - [`start`](#start) 25 | - [`stop`](#stop) 26 | - [`ls`](#ls) 27 | - [`package`](#package) 28 | - [`deploy`](#deploy) 29 | - [`autostart`](#autostart) 30 | - [Variables](#variables) 31 | - [`*lxc-default-folder*`](#lxc-default-folder) 32 | - [`*lxc-rootfs*`](#lxc-rootfs) 33 | - [`*lxc-folder`*`](#lxc-folder) 34 | - [`*lxc-host-extension*`](#lxc-host-extension) 35 | - [`*lxc-gateway*`](#lxc-gateway) 36 | - [`*default-dns-nameserver*`](#default-dns-nameserver) 37 | - [`*hosts-file*`](#hosts-file) 38 | - [`*lxc-network*`](#lxc-network) 39 | - [`*ip-regex*`](#ip-regex) 40 | - [`*lxc-interfaces-file*`](#lxc-interfaces-file) 41 | - [`*default-shell*`](#default-shell) 42 | - [`*lxc-package-extension*`](#lxc-package-extension) 43 | - [`*lxc-config*`](#lxc-config) 44 | - [License](#license) 45 | 46 | 47 | 48 | ## LX-What? 49 | 50 | LXC, aka Linux Containers. In case you don't know what they are, it's 51 | basically virtual machines without emulating the hardware. In 52 | technical details, it's chroot on steroids, because the filesystem, 53 | processes and networking are separated from the host. More information 54 | [here][0]. 55 | 56 | This technology is getting a lot of traction since ~2 years, because 57 | it allows people to create isolated environments very quickly, very 58 | cheaply. Fedora 21, for example, will have each application run in a 59 | different container. Deploying containers on AWS lets you build 60 | multi-tier architectures for cheap, etc etc. There are many 61 | applications. 62 | 63 | I personally use them as "VMs" for my projects (each project gets a 64 | VM). And lxc-wrapper is there to help me with that. I think this is a 65 | common usage though, so I thought it was worth sharing. 66 | 67 | ## Motivation 68 | 69 | I use LXC in a very opinionated way, and has some manual maintenance to 70 | do every time I do something with LXCs. So I created this tool to 71 | automate what I do with them. 72 | 73 | ## What it does 74 | 75 | - I always forget the `--name` option. lxc-wrapper assumes that the 76 | argument is the name of the container. 77 | - Writing `--fancy` when I want an ls should be the default. No 78 | argument needed. 79 | - When creating a container, it assigns a static IP to it, adds an 80 | entry to the hosts file so that the container is reachable, and adds 81 | a symbolic link to the rootfs in a defined folder. 82 | - Destroying a container cleans up behind itself. 83 | 84 | ## Example session 85 | 86 | Starting a new project "bar" based on the "foo" stack. 87 | 88 | $ sudo lxc-wrapper --base foo create bar 89 | Created container bar as copy of foo 90 | $ sudo lxc-wrapper ls 91 | NAME STATE IPV4 IPV6 GROUPS AUTOSTART 92 | ---------------------------------------------------- 93 | bar STOPPED - - - NO 94 | foo STOPPED - - - NO 95 | $ ls ~/lxc/ 96 | foo bar 97 | $ ls ~/lxc/bar 98 | bin boot dev etc home lib lib64 media mnt opt proc root run sbin srv sys tmp usr var 99 | $ sudo lxc-wrapper start bar 100 | $ sudo lxc-wrapper ls 101 | NAME STATE IPV4 IPV6 GROUPS AUTOSTART 102 | ---------------------------------------------------- 103 | bar STARTED 10.0.3.4 - - NO 104 | foo STOPPED - - - NO 105 | $ ssh ubuntu@bar.lxc 106 | 107 | When done with the project: 108 | 109 | $ sudo lxc-wrapper stop bar 110 | $ sudo lxc-wrapper destroy bar 111 | $ sudo lxc-wrapper ls 112 | NAME STATE IPV4 IPV6 GROUPS AUTOSTART 113 | ---------------------------------------------------- 114 | foo STOPPED - - - NO 115 | 116 | ## Why not docker?! 117 | 118 | Good question. 119 | 120 | Several reasons: 121 | 122 | - Docker is based on an overlayfs system all the time. My usage is 123 | simply having long-term projects, so docker's containers don't make 124 | sense. 125 | - Docker's networking doesn't allow me to assign a static IP to a 126 | container. It makes it inconvenient, especially for long-term 127 | containers, to connect to them via ssh. 128 | - Docker's containers' filesystems are hidden when they're not 129 | started. I don't want to start a container just to get some random 130 | file in it. 131 | - Docker CLI are not a very beautiful API. lxc-wrapper is supposed to 132 | be **simple** to use. 133 | 134 | ## Installation 135 | 136 | You can: 137 | 138 | - Download the sources and run `make && make install`. Only `sbcl` is 139 | needed. 140 | - Download and install the [rpm 141 | file](https://github.com/Ralt/lxc-wrapper/releases/download/1.0.3/lxc-wrapper-1.0.3-1.x86_64.rpm) 142 | ([pgp signature](https://github.com/Ralt/lxc-wrapper/releases/download/1.0.3/lxc-wrapper_1.0.3-rpm.sig)) 143 | if you're on Fedora/CentOS/Red Hat (x86~64~ only) 144 | - Download and install the [deb 145 | file](https://github.com/Ralt/lxc-wrapper/releases/download/1.0.3/lxc-wrapper_1.0.3_amd64.deb) 146 | ([pgp signature](https://github.com/Ralt/lxc-wrapper/releases/download/1.0.3/lxc-wrapper_1.0.3-deb.sig)) 147 | if you're on Ubuntu/Debian (amd64 only) 148 | - Download and install the 149 | [PKGBUILD](https://aur.archlinux.org/packages/lxc-wrapper/) if 150 | you're on ArchLinux 151 | 152 | ## CLI Usage 153 | 154 | ``` 155 | $ lxc-wrapper help 156 | Usage: lxc-wrapper [OPTIONS] [COMMAND] 157 | Wrapper around lxc for an opinionated workflow. 158 | 159 | Commands: 160 | 161 | help 162 | Shows this help 163 | 164 | create NAME 165 | Creates a container named NAME 166 | 167 | Options (must be BEFORE the command): 168 | --base=BASE 169 | Clones the BASE container 170 | --template=TEMPLATE 171 | Uses the TEMPLATE lxc template 172 | 173 | Overridable variables and default values (must be BEFORE the command): 174 | --lxc-default-folder=/var/lib/lxc/ 175 | --lxc-rootfs=rootfs/ 176 | --lxc-folder=~/lxc/ 177 | --lxc-host-extension=.lxc 178 | --default-dns-nameserver=8.8.8.8 179 | --hosts-file=/etc/hosts 180 | --lxc-interfaces-file=etc/network/interfaces 181 | 182 | start NAME 183 | Starts the container named NAME 184 | 185 | stop NAME 186 | Stops the container named NAME 187 | 188 | ls 189 | Lists the containers 190 | 191 | destroy NAME 192 | Destroys the container named NAME 193 | 194 | Overridable variables and default values (must be BEFORE the command): 195 | --lxc-folder=~/lxc/ 196 | --lxc-host-extension=.lxc 197 | --hosts-file=/etc/hosts 198 | 199 | package NAME 200 | Packages the container named NAME 201 | 202 | Options (must be BEFORE the command): 203 | --archive-path=PATH 204 | the path of the archive 205 | 206 | Overridable variables and default values (must be BEFORE the command): 207 | --lxc-package-extension=.tar.gz 208 | --lxc-default-folder=/var/lib/lxc/ 209 | 210 | deploy --archive ARCHIVE NAME 211 | Deploys the ARCHIVE archive in a container named NAME 212 | 213 | Overridable variables and default values (must be BEFORE the command): 214 | --lxc-default-folder=/var/lib/lxc/ 215 | --lxc-config=config 216 | --hosts-file=/etc/hosts 217 | 218 | autostart NAME 219 | Toggles the autostart status of the container named NAME 220 | 221 | Overridable variables and default values (must be BEFORE the command): 222 | --lxc-default-folder=/var/lib/lxc/ 223 | --lxc-config=config 224 | 225 | Overridable variables and default values for all commands (must be BEFORE the c 226 | ommand): 227 | --default-shell=/bin/bash 228 | 229 | ``` 230 | 231 | ## Requirements 232 | 233 | Linux only. 234 | 235 | If you just want to use the distributed package, that's all you need. 236 | 237 | If you want to compile yourself, you need: 238 | 239 | - sbcl 240 | - lxc 241 | 242 | And run: 243 | 244 | ``` 245 | $ git clone https://github.com/Ralt/lxc-wrapper 246 | $ cd lxc-wrapper 247 | $ make 248 | $ make install 249 | ``` 250 | 251 | Eventually using `sudo` for the `make install`. 252 | 253 | Tested on SBCL only. There is a requirement on `sb-posix` to get the 254 | version number. 255 | 256 | The swank server or the CLI utility needs to be ran as root. (Ideally 257 | with sudo, so that `~` matches your user folder) 258 | 259 | ## Limitations 260 | 261 | Known limitations: 262 | 263 | - Only /24 subnetworks supported. Which means you can only make 254 264 | containers **with lxc-wrapper** on one host. 265 | - Autostart management not supported yet. 266 | 267 | ## Development 268 | 269 | You need: 270 | 271 | - SBCL 272 | - QuickLisp 273 | 274 | To create a CLI utility, you need: 275 | 276 | - buildapp 277 | 278 | The Makefile supports the following tasks: 279 | 280 | - `all`: builds the `./dist/usr/bin/lxc-wrapper` binary, along with 281 | downloading dependencies in a local quicklisp environment 282 | - `clean`: deletes the dependencies and the binary 283 | - `install`: copies the `./dist/usr/binlxc-wrapper` binary to `DESTDIR` 284 | which is `/usr/bin` by default 285 | - `test`: runs tests; requires a functional lisp environment 286 | 287 | ## API 288 | 289 | ### Functions 290 | 291 | #### `create` 292 | 293 | ```lisp 294 | (defcommand create (name args) 295 | "Creates an LXC" 296 | (destructuring-bind (&key base template) 297 | args 298 | ``` 299 | 300 | Creates an LXC. 301 | 302 | If a base LXC is provided, then it makes a clone of it. 303 | 304 | If a template is provided, then it creates a new LXC based on this 305 | template. 306 | 307 | The opinionated part of lxc-wrapper comes here. For every new LXC: 308 | 309 | - It gives it a static IP 310 | - It adds the static IP to the host's /etc/hosts 311 | - It makes a symlink to the rootfs 312 | 313 | #### `destroy` 314 | 315 | ```lisp 316 | (defcommand destroy (name args) 317 | "Destroys an LXC and its leftovers" 318 | (declare (ignore args)) 319 | ``` 320 | 321 | Destroys an LXC. 322 | 323 | The opinionated part of lxc-wrapper comes here too. When an LXC is 324 | destroyed: 325 | 326 | - It destroys the entry in the host's /etc/hosts 327 | - It deletes the symlink to the rootfs 328 | 329 | #### `start` 330 | 331 | ```lisp 332 | (defcommand start (name args) 333 | "Starts an LXC" 334 | (declare (ignore args)) 335 | ``` 336 | 337 | Starts an LXC. The argument can be a string or a symbol. 338 | 339 | #### `stop` 340 | 341 | ```lisp 342 | (defcommand stop (name args) 343 | "Stops an LXC" 344 | (declare (ignore args)) 345 | ``` 346 | 347 | Stops an LXC. The argument can be a string or a symbol. 348 | 349 | #### `ls` 350 | 351 | ```lisp 352 | (defcommand ls (name args) 353 | "Lists all the LXC" 354 | (declare (ignore args)) 355 | ``` 356 | 357 | Returns the fancy output of the list of LXCs. 358 | 359 | #### `package` 360 | 361 | ```lisp 362 | (defcommand package (name args) 363 | "Packages an LXC" 364 | ``` 365 | 366 | Packages an LXC into an shareable archive file. 367 | 368 | #### `deploy` 369 | 370 | ```lisp 371 | (defcommand deploy (name args) 372 | "Deploys an archive created by lxc-wrapper" 373 | (destructuring-bind (&key archive) 374 | args 375 | ``` 376 | 377 | Deploys an archive created by `lxc-wrapper package`. 378 | 379 | #### `autostart` 380 | 381 | ```lisp 382 | (defcommand autostart (name args) 383 | "Toggles the autostart setting of a container" 384 | ``` 385 | 386 | Toggles the autostart setting of a container. 387 | 388 | ### Variables 389 | 390 | Variables are used throughout the code to be able to customize them 391 | through dynamic scoping. 392 | 393 | #### `*lxc-default-folder*` 394 | 395 | Used by: `create` 396 | 397 | Default value: `/var/lib/lxc/` 398 | 399 | The folder where LXC stores its containers. 400 | 401 | #### `*lxc-rootfs*` 402 | 403 | Used by: `create` 404 | 405 | Default value: `rootfs` 406 | 407 | The folder where the filesystem of the container lives. 408 | 409 | #### `*lxc-folder`*` 410 | 411 | Used by: `create`, `destroy` 412 | 413 | Default value: `~/lxc` 414 | 415 | The folder where symbolic links to the containers' filesystems are made. 416 | 417 | #### `*lxc-host-extension*` 418 | 419 | Used by: `create`, `destroy` 420 | 421 | Default value: `.lxc` 422 | 423 | The TLD of the container hostname. 424 | 425 | #### `*lxc-gateway*` 426 | 427 | Used by: `create` 428 | 429 | Default value: `10.0.3.1` 430 | 431 | The gateway that the container uses. 432 | 433 | #### `*default-dns-nameserver*` 434 | 435 | Used by: `create` 436 | 437 | Default value: `8.8.8.8` 438 | 439 | The DNS nameserver that the container uses. 440 | 441 | #### `*hosts-file*` 442 | 443 | Used by: `create`, `destroy` 444 | 445 | Default value: `/etc/hosts` 446 | 447 | The host's hosts file. 448 | 449 | #### `*lxc-network*` 450 | 451 | Used by: `create`, `destroy` 452 | 453 | Default value: `'(10 0 3 0)` 454 | 455 | The network of the container. Only /24 supported. 456 | 457 | #### `*ip-regex*` 458 | 459 | Used by: `create` 460 | 461 | Default value: `^(\\d+)\\.(\\d+)\\.(\\d+)\\.(\\d+)` 462 | 463 | The regex used to find IPs in the hosts file. 464 | 465 | #### `*lxc-interfaces-file*` 466 | 467 | Used by: `create` 468 | 469 | Default value: `etc/network/interfaces` 470 | 471 | The file where interfaces are written in the container. 472 | 473 | #### `*default-shell*` 474 | 475 | Used by: `create`, `destroy`, `start`, `stop`, `ls` 476 | 477 | Default value: `/bin/bash` 478 | 479 | The shell used by the commands. 480 | 481 | #### `*lxc-package-extension*` 482 | 483 | Used by: `package` 484 | 485 | Default value: `.tar.gz` 486 | 487 | The extension to give to archives created by `package`. 488 | 489 | #### `*lxc-config*` 490 | 491 | Used by: `deploy` 492 | 493 | Default value: `#p"config"` 494 | 495 | The name of the configuration file of the containers. 496 | 497 | ## License 498 | 499 | MIT License. 500 | 501 | 502 | [0]: http://en.wikipedia.org/wiki/LXC 503 | -------------------------------------------------------------------------------- /lxc-wrapper-test.asd: -------------------------------------------------------------------------------- 1 | ;; -*- mode: common-lisp -*- 2 | (asdf:defsystem #:lxc-wrapper-test 3 | :description "Test package for lxc-wrapper" 4 | :author "Florian Margaine " 5 | :license "MIT License" 6 | :serial t 7 | :depends-on ("lxc-wrapper" "fiveam") 8 | :components ((:module "test" 9 | :components 10 | ((:file "test-suites") 11 | (:file "cli") 12 | (:file "lxc-wrapper") 13 | (:file "ip"))))) 14 | -------------------------------------------------------------------------------- /lxc-wrapper.asd: -------------------------------------------------------------------------------- 1 | ;; -*- mode: common-lisp -*- 2 | (asdf:defsystem #:lxc-wrapper 3 | :description "An opinionated LXC wrapper" 4 | :author "Florian Margaine " 5 | :license "MIT License" 6 | :serial t 7 | :depends-on ("external-program" 8 | "cl-ppcre" 9 | "alexandria" 10 | "apply-argv" 11 | "sb-posix") 12 | :in-order-to ((asdf:test-op (asdf:test-op #:lxc-wrapper-test))) 13 | :components ((:module "src" 14 | :components 15 | ((:file "package") 16 | (:file "cli") 17 | (:file "lxc-wrapper") 18 | (:file "ip") 19 | (:file "lxc"))))) 20 | -------------------------------------------------------------------------------- /manpage.md: -------------------------------------------------------------------------------- 1 | % LXC-WRAPPER(1) lxc-wrapper man page 2 | % Florian Margaine 3 | % February 2, 2015 4 | 5 | # NAME 6 | 7 | lxc-wrapper - Wrapper around lxc for an opinionated workflow. 8 | 9 | # SYNOPSIS 10 | 11 | lxc-wrapper [OPTIONS] [COMMAND] 12 | 13 | # DESCRIPTION 14 | 15 | lxc-wrapper lets you manage your containers with a simple API, in an opinionated workflow. 16 | Notably, it automatically takes care of networking. 17 | 18 | help 19 | Shows the help 20 | 21 | version 22 | Shows the version of lxc-wrapper 23 | 24 | create NAME 25 | Creates a container named NAME 26 | 27 | Options (must be BEFORE the command): 28 | --base=BASE 29 | Clones the BASE container 30 | --template=TEMPLATE 31 | Uses the TEMPLATE lxc template 32 | 33 | Overridable variables and default values (must be BEFORE the command): 34 | --lxc-default-folder=/var/lib/lxc/ 35 | --lxc-rootfs=rootfs/ 36 | --lxc-folder=~/lxc/ 37 | --lxc-host-extension=.lxc 38 | --default-dns-nameserver=8.8.8.8 39 | --hosts-file=/etc/hosts 40 | --lxc-interfaces-file=etc/network/interfaces 41 | 42 | start NAME 43 | Starts the container named NAME 44 | 45 | stop NAME 46 | Stops the container named NAME 47 | 48 | ls 49 | Lists the containers 50 | 51 | destroy NAME 52 | Destroys the container named NAME 53 | 54 | Overridable variables and default values (must be BEFORE the command): 55 | --lxc-folder=~/lxc/ 56 | --lxc-host-extension=.lxc 57 | --hosts-file=/etc/hosts 58 | 59 | package NAME 60 | Packages the container named NAME 61 | 62 | Options (must be BEFORE the command): 63 | --archive-path=PATH 64 | the path of the archive 65 | 66 | Overridable variables and default values (must be BEFORE the command): 67 | --lxc-package-extension=.tar.gz 68 | --lxc-default-folder=/var/lib/lxc/ 69 | 70 | deploy --archive ARCHIVE NAME 71 | Deploys the ARCHIVE archive in a container named NAME 72 | 73 | Overridable variables and default values (must be BEFORE the command): 74 | --lxc-default-folder=/var/lib/lxc/ 75 | --lxc-config=config 76 | --hosts-file=/etc/hosts 77 | 78 | autostart NAME 79 | Toggles the autostart status of the container named NAME 80 | 81 | Overridable variables and default values (must be BEFORE the command): 82 | --lxc-default-folder=/var/lib/lxc/ 83 | --lxc-config=config 84 | 85 | Overridable variables and default values for all commands (must be BEFORE the command): 86 | --default-shell=/bin/bash 87 | 88 | # BUGS 89 | 90 | If you find any bug, please send your reports to lxc-wrapper@googlegroups.com 91 | -------------------------------------------------------------------------------- /src/cli.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:lxc-wrapper) 2 | 3 | ;; Default behavior is to get in the debugger, 4 | ;; change that. 5 | (defvar *debug* nil) 6 | (defvar *original-hook* *debugger-hook*) 7 | (setf *debugger-hook* 8 | (lambda (c h) 9 | (if *debug* 10 | (funcall *original-hook* c h) 11 | (progn 12 | (format t "An internal error occured. Are you sure the options are before the command?~%") 13 | (uiop:quit -1))))) 14 | 15 | (defvar *commands* (make-hash-table :test #'equal)) 16 | (defvar *doc-strings* (make-hash-table :test #'equal)) 17 | (defvar *lxc-default-folder* #p"/var/lib/lxc/") 18 | (defvar *lxc-rootfs* #p"rootfs/") 19 | (defvar *lxc-folder* (merge-pathnames #p"lxc/" (user-homedir-pathname))) 20 | (defvar *lxc-host-extension* ".lxc") 21 | (defvar *lxc-gateway* "10.0.3.1") 22 | (defvar *default-dns-nameserver* "8.8.8.8") 23 | (defvar *default-shell* #p"/bin/bash") 24 | (defvar *hosts-file* #p"/etc/hosts") 25 | (defvar *lxc-network* '(10 0 3 0)) 26 | (defvar *ip-regex* "^(\\d+)\\.(\\d+)\\.(\\d+)\\.(\\d+)") 27 | (defvar *lxc-interfaces-file* #p"etc/network/interfaces") 28 | (defvar *lxc-package-extension* ".tar.gz") 29 | (defvar *lxc-config* #p"config") 30 | 31 | (defmacro defcommand (name args doc-string &body body) 32 | ;; Using this to be able to use (check-type) 33 | (let ((doc (gensym))) 34 | `(progn 35 | (let ((,doc ,doc-string)) 36 | (check-type ,doc string) 37 | (defun ,name ,args 38 | ,@body) 39 | (setf (gethash (symbol-name ',name) *commands*) #',name) 40 | (setf (gethash (symbol-name ',name) *doc-strings*) ,doc))))) 41 | 42 | (defmacro default-variables-let (vars &body body) 43 | `(let (,@(loop for var in vars 44 | collect `(,var (or 45 | (getf (cdr parsed-args) 46 | (intern 47 | (clean-stars (symbol-name ',var)) 48 | "KEYWORD")) 49 | ,var)))) 50 | ,@body)) 51 | 52 | (defun clean-stars (var) 53 | "Removes the stars from a string" 54 | (cl-ppcre:regex-replace-all "\\*" var "")) 55 | 56 | (defun main (args) 57 | "CLI entry point" 58 | (handler-case 59 | (let* ((parsed-args (apply-argv:parse-argv (cdr args))) 60 | (command (caar parsed-args)) 61 | (name (cadar parsed-args))) 62 | ;; *lxc-network* and *ip-regex* are voluntarily not available 63 | (default-variables-let (*debug* 64 | *lxc-default-folder* 65 | *lxc-rootfs* 66 | *lxc-folder* 67 | *lxc-host-extension* 68 | *lxc-gateway* 69 | *default-dns-nameserver* 70 | *hosts-file* 71 | *lxc-interfaces-file* 72 | *lxc-package-extension* 73 | *lxc-config* 74 | *default-shell*) 75 | (if (and command (gethash (string-upcase command) *commands*)) 76 | (funcall (gethash (string-upcase command) *commands*) name (cdr parsed-args)) 77 | (help nil nil)))))) 78 | 79 | (defcommand help (name args) 80 | "help 81 | Shows this help" 82 | (declare (ignore name)) 83 | (declare (ignore args)) 84 | (format t 85 | "Usage: lxc-wrapper [OPTIONS] [COMMAND] 86 | Wrapper around lxc for an opinionated workflow. 87 | 88 | Commands: 89 | ") 90 | (maphash #'(lambda (name doc-string) 91 | (declare (ignore name)) 92 | (format t 93 | "~%~{ ~A~%~}" 94 | (cl-ppcre:split "\\n" doc-string))) 95 | *doc-strings*) 96 | (format t " 97 | Overridable variables and default values for all commands (must be BEFORE the command): 98 | --default-shell=/bin/bash 99 | 100 | ")) 101 | 102 | (defcommand version (name args) 103 | "version 104 | Shows the version of lxc-wrapper" 105 | (declare (ignore name)) 106 | (declare (ignore args)) 107 | ;; load-time-value because it's built with buildapp 108 | (format t "~A~%" (load-time-value (sb-posix:getenv "VERSION")))) 109 | -------------------------------------------------------------------------------- /src/ip.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:lxc-wrapper) 2 | 3 | (defun next-ip (file) 4 | "Finds the next available IP for the LXC" 5 | (format 6 | nil 7 | "~{~D~^.~}" 8 | (generate-next-ip 9 | (with-open-file (f file) 10 | (loop for line = (read-line f nil) 11 | while line 12 | when (line-matches-ip line) 13 | collect (line-get-ip line)))))) 14 | 15 | (defun add-ip (file ip host) 16 | "Adds the ip:extension pair to the hosts file" 17 | (with-open-file (f file :direction :output :if-exists :append) 18 | (format f "~A ~A~%" ip host))) 19 | 20 | (defun line-matches-ip (line) 21 | "Finds if the line matches an IP. Which means that 22 | the line must starts with an IP address." 23 | (multiple-value-bind (match numbers) 24 | (cl-ppcre:scan-to-strings *ip-regex* (car (cl-ppcre:split " " line))) 25 | (declare (ignore match)) 26 | (unless numbers 27 | (return-from line-matches-ip)) 28 | (let ((int-numbers (mapcar #'parse-integer (vector-to-list numbers)))) 29 | (loop for i from 0 upto 2 ;; only /24 supported 30 | unless (= (elt *lxc-network* i) (elt int-numbers i)) 31 | do (return-from line-matches-ip nil)) 32 | t))) 33 | 34 | (defun vector-to-list (vector) 35 | (loop for el across vector collect el)) 36 | 37 | (defun line-get-ip (line) 38 | "Gets the IP of a line." 39 | (multiple-value-bind (matches vector) 40 | (cl-ppcre:scan-to-strings *ip-regex* (car (cl-ppcre:split " " line))) 41 | (declare (ignore matches)) 42 | (mapcar #'parse-integer (vector-to-list vector)))) 43 | 44 | (defun generate-next-ip (ips) 45 | "Generates the next IP from a list of IPs." 46 | ;; Just try to make sequential IPs using the netmask until one 47 | ;; doesn't exist. 48 | ;; We can't just sort the list of IPs and add one, because the IPs 49 | ;; may not be sequential. 50 | (let ((numbers (loop for i in ips collect (elt i 3)))) 51 | (loop for i from 2 upto 254 52 | unless (member i numbers) 53 | do (return-from generate-next-ip (new-ip *lxc-network* i 3))))) 54 | 55 | (defun new-ip (ip number place) 56 | "Gets a new IP from a full IP and its last number." 57 | (let ((counter -1)) 58 | (loop for i in ip 59 | collect (progn 60 | (incf counter) 61 | (if (= counter place) 62 | number 63 | i))))) 64 | 65 | (defun assign-static-ip (name ip gateway dns) 66 | "Assigns a static IP to an LXC" 67 | ;; @todo 68 | (let ((path (path-lxc-interfaces name))) 69 | (lxc-delete-file path) 70 | (with-open-file (file path :if-does-not-exist :create :direction :output) 71 | (format file " 72 | auto lo 73 | iface lo inet loopback 74 | 75 | auto eth0 76 | iface eth0 inet static 77 | address ~A 78 | gateway ~A 79 | dns-nameserver ~A~%" ip gateway dns)))) 80 | 81 | (defun path-lxc-interfaces (name) 82 | "Returns the path to the LXC interfaces file" 83 | (merge-pathnames 84 | *lxc-interfaces-file* 85 | (merge-pathnames 86 | *lxc-rootfs* 87 | (merge-pathnames (concatenate 'string name "/") *lxc-default-folder*)))) 88 | 89 | (defun remove-ip (file name) 90 | "Removes a line from the hosts file" 91 | ;; @todo 92 | (let ((hosts (alexandria:read-file-into-string file))) 93 | (lxc-delete-file file) 94 | (alexandria:write-string-into-file 95 | (cl-ppcre:regex-replace (concatenate 96 | 'string 97 | "\\d+\\.\\d+\\.\\d+\\.\\d+ " 98 | name 99 | "\\" *lxc-host-extension* 100 | "\\n") 101 | hosts 102 | "") 103 | file))) 104 | -------------------------------------------------------------------------------- /src/lxc-wrapper.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:lxc-wrapper) 2 | 3 | (defmacro run (&body command) 4 | "Runs a command. To avoid having an awkward API 5 | (i.e. passing a list), defining this as a macro." 6 | `(external-program:run 7 | (car (list ,@command)) 8 | (cdr (list ,@command)) 9 | :output *standard-output* 10 | ;; see man environ 11 | :environment (list (cons "SHELL" *default-shell*)))) 12 | 13 | (defcommand create (name args) 14 | "create NAME 15 | Creates a container named NAME 16 | 17 | Options (must be BEFORE the command): 18 | --base=BASE 19 | Clones the BASE container 20 | --template=TEMPLATE 21 | Uses the TEMPLATE lxc template 22 | 23 | Overridable variables and default values (must be BEFORE the command): 24 | --lxc-default-folder=/var/lib/lxc/ 25 | --lxc-rootfs=rootfs/ 26 | --lxc-folder=~/lxc/ 27 | --lxc-host-extension=.lxc 28 | --default-dns-nameserver=8.8.8.8 29 | --hosts-file=/etc/hosts 30 | --lxc-interfaces-file=etc/network/interfaces" 31 | (destructuring-bind (&key base template) 32 | args 33 | (if base 34 | (create-clone base name) 35 | (create-base name template)))) 36 | 37 | (defcommand start (name args) 38 | "start NAME 39 | Starts the container named NAME" 40 | (declare (ignore args)) 41 | (let ((cli-name (adapt-arg name))) 42 | (format t "Starting ~A..." cli-name) 43 | (run 44 | "lxc-start" 45 | "--name" cli-name) 46 | (format t " done.~%"))) 47 | 48 | (defcommand stop (name args) 49 | "stop NAME 50 | Stops the container named NAME" 51 | (declare (ignore args)) 52 | (let ((cli-name (adapt-arg name))) 53 | (format t "Stopping ~A..." cli-name) 54 | (run 55 | "lxc-stop" 56 | "--name" cli-name) 57 | (format t " done.~%"))) 58 | 59 | (defcommand ls (name args) 60 | "ls 61 | Lists the containers" 62 | (declare (ignore name)) 63 | (declare (ignore args)) 64 | (run 65 | "lxc-ls" 66 | "--fancy")) 67 | 68 | (defcommand destroy (name args) 69 | "destroy NAME 70 | Destroys the container named NAME 71 | 72 | Overridable variables and default values (must be BEFORE the command): 73 | --lxc-folder=~/lxc/ 74 | --lxc-host-extension=.lxc 75 | --hosts-file=/etc/hosts" 76 | (declare (ignore args)) 77 | (let ((cli-name (adapt-arg name))) 78 | (format t "Destroying ~A..." cli-name) 79 | (run 80 | "lxc-destroy" 81 | "--name" cli-name) 82 | (format t " done.~%") 83 | (format t "Removing leftovers...") 84 | (remove-lxc-leftovers cli-name) 85 | (format t " done.~%"))) 86 | 87 | (defcommand package (name args) 88 | "package NAME 89 | Packages the container named NAME 90 | 91 | Options (must be BEFORE the command): 92 | --archive-path=PATH 93 | the path of the archive 94 | 95 | Overridable variables and default values (must be BEFORE the command): 96 | --lxc-package-extension=.tar.gz 97 | --lxc-default-folder=/var/lib/lxc/" 98 | (let* ((cli-name (adapt-arg name)) 99 | (archive (concatenate 'string cli-name *lxc-package-extension*))) 100 | (when args 101 | (destructuring-bind (&key archive-path) 102 | args 103 | (setf archive archive-path))) 104 | (format t "Packaging ~A...~%" cli-name) 105 | (run 106 | "tar" 107 | "-C" (merge-pathnames cli-name *lxc-default-folder*) 108 | "-czf" archive 109 | ".") 110 | (format t "Created ~A~%" archive))) 111 | 112 | (defcommand deploy (name args) 113 | "deploy --archive ARCHIVE NAME 114 | Deploys the ARCHIVE archive in a container named NAME 115 | 116 | Overridable variables and default values (must be BEFORE the command): 117 | --lxc-default-folder=/var/lib/lxc/ 118 | --lxc-config=config 119 | --hosts-file=/etc/hosts" 120 | (destructuring-bind (&key archive) 121 | args 122 | (let* ((cli-name (adapt-arg name)) 123 | (lxc-path (merge-pathnames (concatenate 'string cli-name "/") 124 | *lxc-default-folder*))) 125 | (run 126 | "mkdir" "-p" lxc-path) 127 | (format t "Deploying ~A..." cli-name) 128 | (run 129 | "tar" 130 | "xf" archive 131 | "-C" lxc-path) 132 | (fix-lxc-config cli-name lxc-path *lxc-config*) 133 | (format t " done.~%") 134 | (init-lxc cli-name *hosts-file*)))) 135 | 136 | (defcommand autostart (name args) 137 | "autostart NAME 138 | Toggles the autostart status of the container named NAME 139 | 140 | Overridable variables and default values (must be BEFORE the command): 141 | --lxc-default-folder=/var/lib/lxc/ 142 | --lxc-config=config" 143 | (declare (ignore args)) 144 | (let* ((cli-name (adapt-arg name)) 145 | (lxc-path (merge-pathnames *lxc-config* 146 | (merge-pathnames 147 | (concatenate 'string cli-name "/") 148 | *lxc-default-folder*))) 149 | (config-content (alexandria:read-file-into-string 150 | lxc-path))) 151 | (if (lxc-config-has-autostart config-content) 152 | (toggle-autostart-value lxc-path config-content) 153 | (add-autostart-line lxc-path)))) 154 | 155 | (defun adapt-arg (name) 156 | "Adapts an argument to string" 157 | (when (symbolp name) 158 | (return-from adapt-arg (string-downcase (symbol-name name)))) 159 | (when (stringp name) 160 | (return-from adapt-arg (string-downcase name)))) 161 | -------------------------------------------------------------------------------- /src/lxc.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:lxc-wrapper) 2 | 3 | (defun create-clone (base name) 4 | "Creates a clone of another LXC" 5 | (let ((cli-base (adapt-arg base)) 6 | (cli-name (adapt-arg name))) 7 | (format t "Cloning ~A..." cli-base) 8 | (run 9 | "lxc-clone" 10 | "--orig" cli-base 11 | "--new" cli-name) 12 | (format t " done.~%") 13 | (init-lxc cli-name *hosts-file*))) 14 | 15 | (defun create-base (name template) 16 | "Creates an LXC from no base" 17 | (let ((cli-name (adapt-arg name)) 18 | (cli-template (adapt-arg template))) 19 | (format t "Creating ~A..." cli-name) 20 | (run 21 | "lxc-create" 22 | "--name" cli-name 23 | "-t" cli-template) 24 | (format t " done.~%") 25 | (init-lxc cli-name *hosts-file*))) 26 | 27 | (defun init-lxc (name file) 28 | "Initializes the LXC after creating it. It means: 29 | - Giving it a static IP 30 | - Adding the static IP to the host's /etc/hosts 31 | - Making a symlink to the rootfs somewhere 32 | - Making the container directory readable by all" 33 | (format t "Initializing ~A..." name) 34 | (let ((ip (next-ip file)) 35 | (lxc-path (merge-pathnames (concatenate 'string name "/") 36 | *lxc-default-folder*))) 37 | (assign-static-ip name ip *lxc-gateway* *default-dns-nameserver*) 38 | (add-ip *hosts-file* ip (concatenate 'string name *lxc-host-extension*)) 39 | (make-lxc-symlink (merge-pathnames *lxc-rootfs* lxc-path) 40 | (merge-pathnames name *lxc-folder*)) 41 | (fix-permissions lxc-path)) 42 | (format t " done.~%")) 43 | 44 | (defun fix-permissions (path) 45 | "Makes the folder readable by all" 46 | (run "chmod" "o+x" path)) 47 | 48 | (defun remove-lxc-leftovers (name) 49 | "Removes the leftovers such as: 50 | - The IP in /etc/hosts 51 | - The symbolic link to the now-missing rootfs" 52 | (remove-ip *hosts-file* name) 53 | (lxc-delete-file (merge-pathnames name *lxc-folder*))) 54 | 55 | (defun make-lxc-symlink (base end) 56 | "Makes a symlink from end to base" 57 | (run 58 | "ln" 59 | "-s" base end)) 60 | 61 | (defun lxc-delete-file (file) 62 | "Deletes a file if it exists" 63 | (when (probe-file file) 64 | (delete-file file))) 65 | 66 | (defun fix-lxc-config (name lxc-path config) 67 | "Fixes the config of a newly deployed container" 68 | (let* ((config-path (merge-pathnames config lxc-path)) 69 | (config-string (alexandria:read-file-into-string config-path)) 70 | (base-name (get-base-lxc-name config-string))) 71 | (alexandria:write-string-into-file 72 | (cl-ppcre:regex-replace-all base-name 73 | config-string 74 | name) 75 | config-path 76 | :if-exists :overwrite))) 77 | 78 | (defun get-base-lxc-name (config) 79 | "Gets the name of the base lxc" 80 | (multiple-value-bind (match name) 81 | (cl-ppcre:scan-to-strings "\\n\\s*lxc\\.utsname\\s*=\\s*(\\w+)" config) 82 | (declare (ignore match)) 83 | (elt name 0))) 84 | 85 | (defun lxc-config-has-autostart (content) 86 | "Finds out if a content holds the autostart line" 87 | (cl-ppcre:scan "lxc\\.start\\.auto" content)) 88 | 89 | (defun toggle-autostart-value (file content) 90 | "Toggles the autostart value" 91 | (let ((value (parse-integer 92 | (elt 93 | (multiple-value-bind (match val) 94 | (cl-ppcre:scan-to-strings "lxc\\.start\\.auto\\s*=\\s*(\\d+)" 95 | content) 96 | (declare (ignore match)) 97 | val) 98 | 0)))) 99 | (alexandria:write-string-into-file 100 | (cl-ppcre:regex-replace "lxc\\.start\\.auto\\s*=\\s*\\d+" 101 | content 102 | (format nil 103 | "lxc.start.auto = ~A" 104 | (if (= value 0) 1 0))) 105 | file 106 | :if-exists :overwrite))) 107 | 108 | (defun add-autostart-line (file) 109 | "Adds the autostart line in the file" 110 | (with-open-file (f file :direction :output :if-exists :append) 111 | (format f "lxc.start.auto = 1"))) 112 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; package.lisp 2 | 3 | (defpackage #:lxc-wrapper 4 | (:use #:cl) 5 | (:shadow :package) 6 | (:export 7 | :main 8 | ;; Functions 9 | :create :start :stop :ls :destroy 10 | ;; Variables 11 | :*lxc-default-folder* :*lxc-rootfs* :*lxc-folder* 12 | :*lxc-host-extension* :*lxc-gateway* :*default-dns-nameserver* 13 | :*hosts-file* :*lxc-network* :*ip-regex* :*lxc-interfaces-file 14 | :*default-shell*)) 15 | -------------------------------------------------------------------------------- /test/cli.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:lxc-wrapper-test) 2 | 3 | (5am:in-suite cli) 4 | 5 | (5am:test test-clean-stars 6 | (5am:is-true (string= "foo" (lxc-wrapper::clean-stars "*foo*")))) 7 | 8 | (5am:test test-help 9 | (5am:is-true (eq (type-of #'lxc-wrapper::help) 'function)) 10 | (multiple-value-bind (fn present) 11 | (gethash "HELP" lxc-wrapper::*commands*) 12 | (declare (ignore fn)) 13 | (5am:is-true present))) 14 | -------------------------------------------------------------------------------- /test/ip.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:lxc-wrapper-test) 2 | 3 | (5am:in-suite ip) 4 | 5 | (5am:test test-line-matches-ip 6 | (5am:is-true (lxc-wrapper::line-matches-ip "10.0.3.4 foo")) 7 | (5am:is-false (lxc-wrapper::line-matches-ip "10.10.3.4 bar")) 8 | (5am:is-false (lxc-wrapper::line-matches-ip "foo bar"))) 9 | 10 | (5am:test test-vector-to-list 11 | (5am:is-true (eq (type-of (lxc-wrapper::vector-to-list #(1 2 3))) 'cons))) 12 | 13 | (5am:test test-line-get-ip 14 | (5am:is-true (equal '(10 0 3 1) (lxc-wrapper::line-get-ip "10.0.3.1 foobar")))) 15 | 16 | (5am:test test-generate-next-ip 17 | (5am:is-true (equal '(10 0 3 3) (lxc-wrapper::generate-next-ip 18 | '((10 0 3 1) (10 0 3 2)))))) 19 | 20 | (5am:test test-new-ip 21 | (5am:is-true (equal '(10 0 3 3) (lxc-wrapper::new-ip '(10 0 3 2) 3 3)))) 22 | 23 | (5am:test test-path-lxc-interfaces 24 | (5am:is-true (equal #p"/var/lib/lxc/foo/rootfs/etc/network/interfaces" 25 | (lxc-wrapper::path-lxc-interfaces "foo")))) 26 | -------------------------------------------------------------------------------- /test/lxc-wrapper.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:lxc-wrapper-test) 2 | 3 | (5am:in-suite lxc-wrapper) 4 | 5 | (5am:test test-adapt-arg 6 | (5am:is-true (string= "foo" (lxc-wrapper::adapt-arg "foo"))) 7 | (5am:is-true (string= "foo" (lxc-wrapper::adapt-arg 'foo))) 8 | (5am:is-true (string= "foo" (lxc-wrapper::adapt-arg :foo)))) 9 | 10 | (5am:test test-commands 11 | (loop for command in (list (list "CREATE" #'lxc-wrapper::create) 12 | (list "START" #'lxc-wrapper::start) 13 | (list "STOP" #'lxc-wrapper::stop) 14 | (list "LS" #'lxc-wrapper::ls) 15 | (list "DESTROY" #'lxc-wrapper::destroy)) 16 | do (progn 17 | (5am:is-true (eq (type-of (cadr command)) 'function)) 18 | (multiple-value-bind (fn present) 19 | (gethash (car command) lxc-wrapper::*commands*) 20 | (declare (ignore fn)) 21 | (5am:is-true present))))) 22 | -------------------------------------------------------------------------------- /test/test-suites.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:lxc-wrapper-test 2 | (:use :cl)) 3 | 4 | (in-package #:lxc-wrapper-test) 5 | 6 | ;; If the debugger is fired, it means something went wrong. 7 | (setf fiveam:*debug-on-error* t 8 | fiveam:*debug-on-failure* t) 9 | (setf *debugger-hook* 10 | (lambda (c h) 11 | (declare (ignore c h)) 12 | (uiop:quit -1))) 13 | 14 | (5am:def-suite cli) 15 | (5am:def-suite lxc-wrapper) 16 | (5am:def-suite ip) 17 | 18 | (defmethod asdf:perform ((op asdf:test-op) (system (eql (asdf:find-system :lxc-wrapper-test)))) 19 | (5am:run! 'cli) 20 | (5am:run! 'lxc-wrapper) 21 | (5am:run! 'ip)) 22 | --------------------------------------------------------------------------------