├── .gitignore ├── FAQ.md ├── README.md ├── USAGE.md ├── corona-test.asd ├── corona-web.asd ├── corona.asd ├── src ├── corona.lisp ├── files.lisp ├── system-list.lisp ├── system.lisp ├── vagrant-cloud.lisp └── virtual-machines.lisp ├── t ├── setup.lisp └── tests.lisp └── web ├── files.lisp ├── scripts.js ├── style.lass └── templates.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* 9 | *.html 10 | *.css 11 | -------------------------------------------------------------------------------- /FAQ.md: -------------------------------------------------------------------------------- 1 | ## Why not Vagrant? 2 | 3 | The advantage over Vagrant is simply that it's written in Common Lisp and, as 4 | such, available in Quicklisp without any external commands. This way, the 5 | library can be included as a dependency and used without anyone having to set up 6 | an external tool other than VirtualBox. 7 | 8 | ## Where are disk images stored? 9 | 10 | Everything is stored in specific subdirectories under 11 | `~/.config/corona/`. Vagrant Cloud images are stored, in their extracted form, 12 | in `~/.config/corona/files/vagrant-cloud/`. The disk images of virtual machines 13 | are stored in `~/.config/corona/files/virtual-machines`. 14 | 15 | ## How are VM names handled? 16 | 17 | Virtual machines are identified by a name, which is a Common Lisp symbol. Inside 18 | the VM directory, all the data for a virtual machine is stored inside a folder 19 | for the package and another folder for the symbol name. For example: 20 | 21 | ``` 22 | virtual-machines/ 23 | COMMON-LISP/ 24 | TEST-VM/ 25 | UBUNTU-PERSONAL/ 26 | MY-APP/ 27 | TESTING/ 28 | STAGING/ 29 | ``` 30 | 31 | The names of your virtual machines are restricted by the limitations of your 32 | filesystem (Allowed characters, pathname length, etc.). Rather than add specific 33 | checks for meaningless edge cases, I'll just warn you not to name your virtual 34 | machines `myapp:My/Test\<>`. 35 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Corona 2 | 3 | Corona is a library for creating and managing virtual machines from Common 4 | Lisp. All you need is VirtualBox and an internet connection. 5 | 6 | Corona uses [Vagrant Cloud][vc] as a source of base systems to bootstrap virtual 7 | machines from. 8 | 9 | [vc]: https://vagrantcloud.com/ 10 | 11 | ## Usage 12 | 13 | ~~~lisp 14 | (defmachine my-app 15 | :system (:ubuntu :14.04 :64) 16 | :memory 1024) 17 | 18 | (start my-app) 19 | 20 | (stop my-app) 21 | ~~~ 22 | 23 | That's it. 24 | 25 | # Use Cases 26 | 27 | ## Development Environments 28 | 29 | Corona can be used to create isolated, reproducible development environments so 30 | you and your team can work on the same system. 31 | 32 | No more 'works on my machine', no more difference between development and 33 | production. 34 | 35 | ## Testing 36 | 37 | If you have a library that uses an external tool, like a database server or 38 | something equally large, you can use Corona to set up a virtual machine and 39 | install whatever dependencies you need, so the user doesn't actually have to run 40 | anything on their computer. 41 | 42 | Additionally, since you can set up multiple virtual machines with different 43 | systems, you can use Corona to ensure your library works on most operating 44 | systems. This is especially useful for testing compilers and similar 45 | applications where portability is critical. 46 | 47 | ## Building 48 | 49 | You can use Corona as a build server: Fire up virtual machines of the operating 50 | system you want to build on, set them up with everything you need, and run the 51 | builds. 52 | 53 | # Usage 54 | 55 | ## Defining Machines 56 | 57 | Machines are defined with the `defmachine` macro. The first argument to 58 | `defmachine` is a symbol, which will be the machine's name (Including the 59 | package). The other arguments are: 60 | 61 | `system` 62 | : This is a system triple, a literal list with three elements which uniquely 63 | identifies a base system: The system's name, version, and architecture. 64 | 65 | `memory` 66 | : The amount of RAM given to the VM in megabytes. Default: `512`. 67 | 68 | `cpu-count` 69 | : The number of virtual CPUs. One by default. 70 | 71 | `ip` 72 | : The system's IP address. By default this is not used. 73 | 74 | Examples: 75 | 76 | ```lisp 77 | (defmachine my-app:db-server 78 | :system (:debian :7.4 :32) 79 | :memory 2048 80 | :ip "192.128.65.20") 81 | 82 | (defmachine my-app:web-server 83 | :system (:freebsd :10.0 :64) 84 | :memory 512 85 | :cpu-count 2) 86 | ``` 87 | 88 | ## Controlling VM State 89 | 90 | The following six functions can be used to control the state of the virtual 91 | machines: 92 | 93 | `start`, `stop` 94 | : Start and shut down the VM. If possible, shut it down gently. 95 | 96 | `pause`, `resume` 97 | : Pause and resume the VM. 98 | 99 | `reboot` 100 | : Reboot the virtual machine. 101 | 102 | `poweroff` 103 | : Force VM shutdown. 104 | 105 | Examples: 106 | 107 | ```lisp 108 | (start my-app:web-server) 109 | 110 | ;; Do some work 111 | 112 | (pause my-app:web-server) 113 | 114 | ;; Come back to work next morning 115 | 116 | (resume my-app:web-server) 117 | 118 | ;; Shut it down 119 | 120 | (stop my-app:web-server) 121 | ``` 122 | 123 | # FAQ 124 | 125 | ## Why not Vagrant? 126 | 127 | The advantage over Vagrant is simply that it's written in Common Lisp and, as 128 | such, available in Quicklisp without any external commands. This way, the 129 | library can be included as a dependency and used without anyone having to set up 130 | an external tool other than VirtualBox. 131 | 132 | ## Where are disk images stored? 133 | 134 | Everything is stored in specific subdirectories under 135 | `~/.config/corona/`. Vagrant Cloud images are stored, in their extracted form, 136 | in `~/.config/corona/files/vagrant-cloud/`. The disk images of virtual machines 137 | are stored in `~/.config/corona/files/virtual-machines`. 138 | 139 | ## How are VM names handled? 140 | 141 | Virtual machines are identified by a name, which is a Common Lisp symbol. Inside 142 | the VM directory, all the data for a virtual machine is stored inside a folder 143 | for the package and another folder for the symbol name. For example: 144 | 145 | ~~~ 146 | virtual-machines/ 147 | COMMON-LISP/ 148 | TEST-VM/ 149 | UBUNTU-PERSONAL/ 150 | MY-APP/ 151 | TESTING/ 152 | STAGING/ 153 | ~~~ 154 | 155 | The names of your virtual machines are restricted by the limitations of your 156 | filesystem (Allowed characters, pathname length, etc.). Rather than add specific 157 | checks for meaningless edge cases, I'll just warn you not to name your virtual 158 | machines `myapp:My/Test\<>`. 159 | 160 | # License 161 | 162 | Copyright (c) 2014-2015 Fernando Borretti (eudoxiahp@gmail.com) 163 | 164 | Licensed under the MIT License. 165 | -------------------------------------------------------------------------------- /USAGE.md: -------------------------------------------------------------------------------- 1 | ## Defining Machines 2 | 3 | Machines are defined with the `defmachine` macro. The first argument to 4 | `defmachine` is a symbol, which will be the machine's name (Including the 5 | package). The other arguments are: 6 | 7 | `system` 8 | : This is a system triple, a literal list with three elements which uniquely 9 | identifies a base system: The system's name, version, and architecture. 10 | 11 | `memory` 12 | : The amount of RAM given to the VM in megabytes. Default: `512`. 13 | 14 | `cpu-count` 15 | : The number of virtual CPUs. One by default. 16 | 17 | `ip` 18 | : The system's IP address. By default this is not used. 19 | 20 | Examples: 21 | 22 | ``` 23 | (defmachine my-app:db-server 24 | :system (:debian :7.4 :32) 25 | :memory 2048 26 | :ip "192.128.65.20") 27 | 28 | (defmachine my-app:web-server 29 | :system (:freebsd :10.0 :64) 30 | :memory 512 31 | :cpu-count 2) 32 | ``` 33 | 34 | ## Controlling VM State 35 | 36 | The following six functions can be used to control the state of the virtual 37 | machines: 38 | 39 | `start`, `stop` 40 | : Start and shut down the VM. If possible, shut it down gently. 41 | 42 | `pause`, `resume` 43 | : Pause and resume the VM. 44 | 45 | `reboot` 46 | : Reboot the virtual machine. 47 | 48 | `poweroff` 49 | : Force VM shutdown. 50 | 51 | Examples: 52 | 53 | ``` 54 | (start my-app:web-server) 55 | 56 | ;; Do some work 57 | 58 | (pause my-app:web-server) 59 | 60 | ;; Come back to work next morning 61 | 62 | (resume my-app:web-server) 63 | 64 | ;; Shut it down 65 | 66 | (stop my-app:web-server) 67 | ``` 68 | -------------------------------------------------------------------------------- /corona-test.asd: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage corona-test-asd 3 | (:use :cl :asdf)) 4 | (in-package :corona-test-asd) 5 | 6 | (eval-when (:execute :load-toplevel :compile-toplevel) 7 | (push :corona-testing *features*)) 8 | 9 | (defsystem corona-test 10 | :author "Fernando Borretti" 11 | :license "MIT" 12 | :depends-on (:corona 13 | :fiveam 14 | :clack 15 | :clack-v1-compat 16 | :archive 17 | :cl-fad) 18 | :components ((:module "t" 19 | :serial t 20 | :components 21 | ((:file "setup") 22 | (:file "tests"))))) 23 | -------------------------------------------------------------------------------- /corona-web.asd: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage corona-web-asd 3 | (:use :cl :asdf)) 4 | (in-package :corona-web-asd) 5 | 6 | (defsystem corona-web 7 | :author "Fernando Borretti" 8 | :license "MIT" 9 | :depends-on (:corona 10 | :cl-markup 11 | :lass 12 | :3bmd 13 | :3bmd-ext-code-blocks 14 | :3bmd-ext-definition-lists) 15 | :components ((:module "web" 16 | :serial t 17 | :components 18 | ((:file "templates") 19 | (:file "files"))))) 20 | -------------------------------------------------------------------------------- /corona.asd: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage corona-asd 3 | (:use :cl :asdf)) 4 | (in-package :corona-asd) 5 | 6 | (defsystem corona 7 | :author "Fernando Borretti " 8 | :maintainer "Fernando Borretti " 9 | :license "MIT" 10 | :version "0.1" 11 | :homepage "http://eudoxia.me/corona" 12 | :bug-tracker "https://github.com/eudoxia0/corona/issues" 13 | :source-control (:git "git@github.com:eudoxia0/corona.git") 14 | :depends-on (:cl-virtualbox 15 | :trivial-download 16 | :trivial-types 17 | :trivial-extract 18 | :ironclad 19 | :cl-fad 20 | :log4cl 21 | :anaphora) 22 | :components ((:module "src" 23 | :serial t 24 | :components 25 | ((:file "files") 26 | (:file "vagrant-cloud") 27 | (:file "system") 28 | (:file "system-list") 29 | (:file "virtual-machines") 30 | (:file "corona")))) 31 | :description "Isolated, reproducible virtual development environments." 32 | :long-description 33 | #.(uiop:read-file-string 34 | (uiop:subpathname *load-pathname* "README.md")) 35 | :in-order-to ((test-op (test-op corona-test)))) 36 | -------------------------------------------------------------------------------- /src/corona.lisp: -------------------------------------------------------------------------------- 1 | ;;;; The main interface 2 | (in-package :cl-user) 3 | (defpackage corona 4 | (:use :cl) 5 | (:import-from :corona.vm 6 | :start 7 | :stop 8 | :pause 9 | :resume 10 | :reboot 11 | :poweroff) 12 | (:export :defmachine 13 | :start 14 | :stop 15 | :pause 16 | :resume 17 | :reboot 18 | :poweroff)) 19 | (in-package :corona) 20 | 21 | (defmacro defmachine (name &key system (memory 512) (cpu-count 1) ip) 22 | `(defparameter ,name 23 | (make-instance 'corona.vm: 24 | :name ',name 25 | :system (corona.sys:find-system ,@system) 26 | :hardware (make-instance 'corona.vm: 27 | :memory ,memory 28 | :cpu-count ,cpu-count) 29 | :ip ,ip))) 30 | -------------------------------------------------------------------------------- /src/files.lisp: -------------------------------------------------------------------------------- 1 | ;;;; The directories where Corona stores its files, and tools for verifying 2 | ;;;; their integrity 3 | (in-package :cl-user) 4 | (defpackage corona.files 5 | (:use :cl) 6 | (:export :+corona-directory+ 7 | :+vagrant-cloud-directory+ 8 | :+vm-directory+ 9 | :verify-file 10 | :download 11 | :extract-tarball 12 | :copy-files-to-directory)) 13 | (in-package :corona.files) 14 | 15 | ;;; File directories 16 | 17 | (defparameter +corona-directory+ 18 | #-corona-testing 19 | (merge-pathnames #p".corona/" 20 | (user-homedir-pathname)) 21 | #+corona-testing 22 | (asdf:system-relative-pathname :corona #p"t/corona-files/") 23 | "The directory where Corona stores everything it needs. By default, this is 24 | `~/.corona`, but when testing this is overriden to the path to the Corona 25 | system definition, plus `t/corona`.") 26 | 27 | (defparameter +files-directory+ 28 | (merge-pathnames #p"files/" +corona-directory+) 29 | "The directory where Corona stores files (CD/DVD images, virtual machine 30 | images, virtual hard drives, etc.)") 31 | 32 | (defparameter +vagrant-cloud-directory+ 33 | (merge-pathnames #p"vagrant-cloud/" +files-directory+) 34 | "The directory where Corona stores Vagrant Cloud images.") 35 | 36 | (defparameter +vm-directory+ 37 | (merge-pathnames #p"virtual-machines/" +files-directory+) 38 | "The directory where images of specific virtual machines are stored.") 39 | 40 | ;;; File verification 41 | 42 | (define-condition checksum-mismatch (error) 43 | ((path :reader path :initarg :path) 44 | (checksum-type :reader checksum-type :initarg :checksum-type) 45 | (file-sum :reader file-sum :initarg :file-sum) 46 | (trusted-sum :reader trusted-sum :initarg :trusted-sum)) 47 | 48 | (:report 49 | (lambda (condition stream) 50 | (format stream 51 | "Checksum mismatch: The file ~S has ~A checksum ~S, which differs from the trusted checksum ~S." 52 | (path condition) 53 | (checksum-type condition) 54 | (file-sum condition) 55 | (trusted-sum condition))))) 56 | 57 | (defun file-checksum (checksum-type pathname) 58 | "Generate the checksum of a file." 59 | (let* ((array (make-array 4096 :element-type '(unsigned-byte 8))) 60 | (digester (ironclad:make-digest checksum-type)) 61 | (digest (make-array (ironclad:digest-length checksum-type) 62 | :element-type '(unsigned-byte 8)))) 63 | (ironclad:digest-file digester pathname :buffer array :digest digest) 64 | (ironclad:byte-array-to-hex-string digest))) 65 | 66 | (defun verify-file (pathname checksum-type checksum) 67 | "Verify the `checksum-type` checksum of the file at `pathname` is equal to 68 | `checksum`." 69 | (let ((file-checksum (file-checksum checksum-type pathname))) 70 | (if (equal file-checksum checksum) 71 | t 72 | (error 'checksum-mismatch 73 | :path pathname 74 | :checksum-type checksum-type 75 | :file-checksum file-checksum 76 | :trusted-checksum checksum)))) 77 | 78 | ;;; File downloads 79 | 80 | (defun have-curl-p () 81 | (equal 0 82 | (third 83 | (multiple-value-list (uiop:run-program "which curl" 84 | :ignore-error-status t))))) 85 | 86 | (defun download-over-curl (url pathname) 87 | (ensure-directories-exist 88 | (cl-fad:pathname-directory-pathname pathname)) 89 | (uiop:run-program 90 | (format nil "curl -o ~S ~S" (namestring pathname) url))) 91 | 92 | (defun download (url pathname) 93 | "Download the file from `url` to its pathname if it doesn't exist, returning 94 | `t`. If it already exists, return `nil`." 95 | (if (not (probe-file pathname)) 96 | (progn 97 | ;; trivial-download is pretty slow for large data, so we cat cheat and 98 | ;; use curl where available. 99 | (trivial-download:download url pathname) 100 | t) 101 | nil)) 102 | 103 | ;;; File copying 104 | 105 | (defun copy-files-to-directory (files destination) 106 | "Copy a list of files to the `destination` directory." 107 | (let* ((destination-paths 108 | (loop for path in files collecting 109 | (make-pathname :name (pathname-name path) 110 | :type (pathname-type path) 111 | :defaults destination))) 112 | (pairs (mapcar #'(lambda (a b) (list a b)) 113 | files 114 | destination-paths))) 115 | (ensure-directories-exist destination) 116 | (loop for (source destination) in pairs do 117 | (cl-fad:copy-file source destination)))) 118 | -------------------------------------------------------------------------------- /src/system-list.lisp: -------------------------------------------------------------------------------- 1 | (in-package :corona.sys) 2 | 3 | ;;;; Linux distributions 4 | 5 | ;;; Ubuntu 6 | 7 | (define-system 8 | :name :ubuntu 9 | :version :14.04 10 | :arch :64 11 | :box (define-box 12 | :name "ubuntu-14.04" 13 | :author "chef")) 14 | 15 | (define-system 16 | :name :ubuntu 17 | :version :14.04 18 | :arch :32 19 | :box (define-box 20 | :name "ubuntu-14.04-i386" 21 | :author "chef")) 22 | 23 | (define-system 24 | :name :ubuntu 25 | :version :13.10 26 | :arch :64 27 | :box (define-box 28 | :name "ubuntu-13.10" 29 | :author "chef")) 30 | 31 | (define-system 32 | :name :ubuntu 33 | :version :13.10 34 | :arch :32 35 | :box (define-box 36 | :name "ubuntu-13.10-i386" 37 | :author "chef")) 38 | 39 | (define-system 40 | :name :ubuntu 41 | :version :13.04 42 | :arch :64 43 | :box (define-box 44 | :name "ubuntu-13.04" 45 | :author "chef")) 46 | 47 | (define-system 48 | :name :ubuntu 49 | :version :13.04 50 | :arch :32 51 | :box (define-box 52 | :name "ubuntu-13.04-i386" 53 | :author "chef")) 54 | 55 | (define-system 56 | :name :ubuntu 57 | :version :10.04 58 | :arch :64 59 | :box (define-box 60 | :name "ubuntu-10.04" 61 | :author "chef")) 62 | 63 | (define-system 64 | :name :ubuntu 65 | :version :10.04 66 | :arch :32 67 | :box (define-box 68 | :name "ubuntu-10.04-i386" 69 | :author "chef")) 70 | 71 | ;;; Debian 72 | 73 | (define-system 74 | :name :debian 75 | :version :7.6 76 | :arch :64 77 | :box (define-box 78 | :name "debian-7.6" 79 | :author "chef")) 80 | 81 | (define-system 82 | :name :debian 83 | :version :7.6 84 | :arch :32 85 | :box (define-box 86 | :name "debian-7.6-i386" 87 | :author "chef")) 88 | 89 | (define-system 90 | :name :debian 91 | :version :7.4 92 | :arch :64 93 | :box (define-box 94 | :name "debian-7.4" 95 | :author "chef")) 96 | 97 | (define-system 98 | :name :debian 99 | :version :7.4 100 | :arch :32 101 | :box (define-box 102 | :name "debian-7.4-i386" 103 | :author "chef")) 104 | 105 | ;;; CentOS 106 | 107 | (define-system 108 | :name :centos 109 | :version :6.5 110 | :arch :64 111 | :box (define-box 112 | :name "centos-6.5" 113 | :author "chef")) 114 | 115 | (define-system 116 | :name :centos 117 | :version :6.5 118 | :arch :32 119 | :box (define-box 120 | :name "centos-6.5-i386" 121 | :author "chef")) 122 | 123 | ;;; Fedora 124 | 125 | (define-system 126 | :name :fedora 127 | :version :20 128 | :arch :64 129 | :box (define-box 130 | :name "fedora-20" 131 | :author "chef")) 132 | 133 | (define-system 134 | :name :fedora 135 | :version :20 136 | :arch :32 137 | :box (define-box 138 | :name "fedora-20-i386" 139 | :author "chef")) 140 | 141 | (define-system 142 | :name :fedora 143 | :version :19 144 | :arch :64 145 | :box (define-box 146 | :name "fedora-19" 147 | :author "chef")) 148 | 149 | ;;;; BSD forks 150 | 151 | ;;; FreeBSD 152 | 153 | (define-system 154 | :name :freebsd 155 | :version :10.0 156 | :arch :64 157 | :box (define-box 158 | :name "freebsd-10.0" 159 | :author "chef")) 160 | 161 | (define-system 162 | :name :freebsd 163 | :version :9.2 164 | :arch :64 165 | :box (define-box 166 | :name "freebsd-9.2" 167 | :author "chef")) 168 | 169 | (define-system 170 | :name :freebsd 171 | :version :9.2 172 | :arch :32 173 | :box (define-box 174 | :name "freebsd-9.2-i386" 175 | :author "chef")) 176 | 177 | ;;; OpenBSD 178 | 179 | (define-system 180 | :name :openbsd 181 | :version :5.5 182 | :arch :64 183 | :box (define-box 184 | :name "openbsd-5.5" 185 | :author "tmatilai")) 186 | 187 | ;; Simulate keeping the order 188 | (setf *known-systems* (reverse *known-systems*)) 189 | -------------------------------------------------------------------------------- /src/system.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Defining systems, and a list of known systems we can pull from Vagrant Cloud 2 | (in-package :cl-user) 3 | (defpackage corona.sys 4 | (:use :cl) 5 | (:import-from :corona.cloud 6 | :) 7 | (:export : 8 | :name 9 | :version 10 | :arch 11 | :box 12 | :ensure-box 13 | :list-system-names 14 | :list-versions-for-system 15 | :list-archs-for-system 16 | :list-systems 17 | :find-system)) 18 | (in-package :corona.sys) 19 | 20 | (defclass () 21 | ((name :reader name 22 | :initarg :name 23 | :type keyword 24 | :documentation "The name of the operating system, 25 | e.g. :ubuntu, :windows.") 26 | (version :reader version 27 | :initarg :version 28 | :type keyword 29 | :documentation "The operating system's version string as a keyword, 30 | e.g. :13.13.") 31 | (arch :reader arch 32 | :initarg :arch 33 | :type keyword 34 | :documentation "The operating system's architecture as a keyword, 35 | e.g. :64, :sparc.") 36 | (box :reader box 37 | :initarg :box 38 | :type corona.cloud: 39 | :documentation "The box that bootstraps this system."))) 40 | 41 | (defmethod ensure-box ((sys )) 42 | "Ensure the system's box is ready to be imported." 43 | (corona.cloud:download-and-extract-box (box sys))) 44 | 45 | ;;; Known systems 46 | 47 | (defparameter *known-systems* (list) 48 | "A list of available systems.") 49 | 50 | (defmacro define-system (&rest params) 51 | `(push (make-instance ' ,@params) *known-systems*)) 52 | 53 | (defmacro define-box (&rest params) 54 | `(make-instance ' ,@params)) 55 | 56 | (defun list-system-names () 57 | "List the names of available systems." 58 | (remove-duplicates 59 | (loop for system in *known-systems* collecting (name system)))) 60 | 61 | (defun list-versions-for-system (name) 62 | "List the available versions of a given system." 63 | (remove-duplicates 64 | (loop for system in *known-systems* 65 | if (eq name (name system)) collect (version system)))) 66 | 67 | (defun list-archs-for-system (name) 68 | "List the available architectures of a given system." 69 | (remove-duplicates 70 | (loop for system in *known-systems* 71 | if (eq name (name system)) collect (arch system)))) 72 | 73 | (defun list-systems (&optional (stream *standard-output*)) 74 | "Return a summary of available systems, their versions and architectures." 75 | (loop for system-name in (list-system-names) do 76 | (let ((versions (list-versions-for-system system-name)) 77 | (archs (list-archs-for-system system-name))) 78 | (format stream 79 | "~A:~% Versions: ~{~A~#[~:;, ~]~}~% Architectures: ~{~A~#[~:;, ~]~}~%" 80 | system-name versions archs)))) 81 | 82 | (defun find-system (name version architecture) 83 | (loop for system in *known-systems* 84 | if (and (eq name (name system)) 85 | (eq version (version system)) 86 | (eq architecture (arch system))) 87 | return system)) 88 | -------------------------------------------------------------------------------- /src/vagrant-cloud.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Tools for downloading virtual machines from Vagrant Cloud 2 | (in-package :cl-user) 3 | (defpackage corona.cloud 4 | (:use :cl) 5 | (:export : 6 | :name 7 | :author 8 | :version 9 | :checksum-type 10 | :checksum 11 | :source-url 12 | :box-directory 13 | :local-box-p 14 | :download-and-extract-box)) 15 | (in-package :corona.cloud) 16 | 17 | (defparameter +vagrant-cloud-url-fmt+ 18 | "https://app.vagrantup.com/~A/boxes/~A/versions/~A/providers/virtualbox.box" 19 | "The format control string for a Vagrant Cloud box URL. The first parameter is 20 | the username, then the box name, and finally the version number.") 21 | 22 | (defclass () 23 | ((name :reader name 24 | :initarg :name 25 | :type string 26 | :documentation "The box name in Vagrant Cloud.") 27 | (author :reader author 28 | :initarg :author 29 | :type string 30 | :documentation "The author name in Vagrant Cloud.") 31 | (version :reader version 32 | :initarg :version 33 | :type keyword 34 | :documentation "The box version in Vagrant Cloud.") 35 | (checksum-type :reader checksum-type 36 | :initarg :checksum-type 37 | :type keyword 38 | :initform nil 39 | :documentation "The type of checksum used to verify the 40 | download, e.g. :sha1, :md5.") 41 | (checksum :reader checksum 42 | :initarg :checksum 43 | :initform nil 44 | :type string 45 | :documentation "The checksum string.")) 46 | (:documentation "A base box.")) 47 | 48 | ;;; Downloading boxes 49 | 50 | (defmethod source-url ((box )) 51 | "URL to download a cloud box." 52 | (format nil +vagrant-cloud-url-fmt+ (author box) (name box) (version box))) 53 | 54 | (defmethod box-directory ((box )) 55 | "Directory where a box contents would be/are stored." 56 | (merge-pathnames (parse-namestring 57 | (format nil "~A-~A-~A/" 58 | (author box) 59 | (name box) 60 | (version box))) 61 | corona.files:+vagrant-cloud-directory+)) 62 | 63 | ;;; Once we have a local copy of a box, we have to extract the VirtualBox 64 | ;;; image. A Vagrant box file is just a .zip, which internally looks like this: 65 | ;;; 66 | ;;; name.box/ 67 | ;;; Vagrantfile 68 | ;;; box.ovf 69 | ;;; box-disk1.vmdk 70 | ;;; 71 | ;;; The OVF file is what we have to import, and the VMDK file is the virtual 72 | ;;; HDD. 73 | 74 | (defmethod local-box-p ((box )) 75 | "Have we already downloaded the box?" 76 | (and (directory (merge-pathnames #p"*.ovf" (box-directory box))) 77 | (directory (merge-pathnames #p"*.vmdk" (box-directory box))))) 78 | 79 | (defmethod download-and-extract-box ((box )) 80 | "Download a box from Vagrant Cloud, and extract its contents unless it already 81 | exists." 82 | ;; Only download the box if we don't already have it) 83 | (unless (local-box-p box) 84 | (let ((url (source-url box)) 85 | (archive-path (merge-pathnames #p"box-file.box" 86 | (box-directory box)))) 87 | ;; First things first. We download the box. 88 | (corona.files:download url archive-path) 89 | ;; Then we verify the checksums, if any 90 | (with-slots (checksum-type checksum) box 91 | (if (and checksum-type checksum) 92 | (corona.files:verify-file archive-path checksum-type checksum))) 93 | ;; Now that it's passed verification we extract the tarball 94 | (handler-bind 95 | ((t #'(lambda (c) 96 | (declare (ignore c)) 97 | (log:error "Corrupt archive. Deleting archive and starting again.") 98 | (delete-file archive-path) 99 | (download-and-extract-box box)))) 100 | (trivial-extract:extract archive-path)) 101 | ;; Since we don't want to duplicate content, we delete the archive once it's 102 | ;; extracted 103 | (delete-file archive-path) 104 | ;; We also delete the Vagrantfile, which we don't use 105 | (let ((vagrantfile (make-pathname :name "Vagrantfile" 106 | :directory (pathname-directory archive-path)))) 107 | (when (probe-file vagrantfile) 108 | (delete-file vagrantfile))) 109 | ;; And finally, just to be neat, return t 110 | t))) 111 | -------------------------------------------------------------------------------- /src/virtual-machines.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Defining virtual machines (instances of a box) and building them 2 | (in-package :cl-user) 3 | (defpackage corona.vm 4 | (:use :cl :anaphora) 5 | (:import-from :corona.sys 6 | : 7 | :box) 8 | (:export : 9 | :memory 10 | :cpu-count 11 | : 12 | :name 13 | :system 14 | :hardware 15 | :gb 16 | :vm-directory 17 | :already-built-p 18 | :build-vm 19 | :setup-vm 20 | :start 21 | :stop 22 | :pause 23 | :resume 24 | :reboot 25 | :poweroff)) 26 | (in-package :corona.vm) 27 | 28 | (defparameter +wait-time+ 3) 29 | 30 | (defclass () 31 | ((memory :reader memory 32 | :initarg :memory 33 | :type integer 34 | :initform 1024 35 | :documentation "The virtual memory in megabytes.") 36 | (cpu-count :reader cpu-count 37 | :initarg :cpu-count 38 | :type integer 39 | :initform 1 40 | :documentation "The number of virtual CPUs.")) 41 | (:documentation "Virtual machine hardware. Some of these are probably 42 | VirtualBox-specific.")) 43 | 44 | (defun gb (amount) 45 | "Convert `amount` gigabytes to megabytes." 46 | (* amount 1000)) 47 | 48 | (defclass () 49 | ((name :reader name 50 | :initarg :name 51 | :type symbol 52 | :documentation "The virtual machine name.") 53 | (system :reader system 54 | :initarg :system 55 | :type 56 | :documentation "The system this VM holds.") 57 | (hardware :reader hardware 58 | :initarg :hardware 59 | :type 60 | :documentation "The virtual hardware.") 61 | (ip :reader ip 62 | :initarg :ip 63 | :initform nil 64 | :type string 65 | :documentation "The VM's IP address as a string.")) 66 | (:documentation "A virtual machine is an instance of a system's base box with 67 | its own virtual drive and resources.")) 68 | 69 | (defmethod stored-name ((vm )) 70 | "The name of the virtual machine that VirtualBox knows." 71 | (concatenate 'string 72 | (package-name (symbol-package (name vm))) 73 | ":" 74 | (symbol-name (name vm)))) 75 | 76 | (defmethod network-name ((vm )) 77 | "The name of the machine's network." 78 | (concatenate 'string "vboxnet" (stored-name vm))) 79 | 80 | (defmethod vm-directory ((vm )) 81 | "Directory where VM configuration/disks are stored." 82 | (merge-pathnames 83 | (make-pathname :directory (list :relative 84 | (package-name (symbol-package (name vm))) 85 | (symbol-name (name vm)))) 86 | corona.files:+vm-directory+)) 87 | 88 | (defmethod already-built-p ((vm )) 89 | "Have we already built the VM?" 90 | (if (virtualbox:find-by-name (stored-name vm)) t)) 91 | 92 | ;;; The way we build virtual machienes from base boxes is roughly: 93 | ;;; 94 | ;;; 1. Make sure the box is downloaded and extracted. 95 | ;;; 2. Copy the virtual drive and OVF to a folder we control. 96 | ;;; 3. Import the copied OVF file. 97 | 98 | (defmethod build-vm ((vm )) 99 | "Build a virtual machine if it's not yet built, downloading its base box if 100 | it's not yet available. Returns `t` if everything went as planned, `nil` if the 101 | VM was already built." 102 | ;; First, ensure we have the box 103 | (unless (already-built-p vm) 104 | (corona.sys:ensure-box (system vm)) 105 | (let* ((box (box (system vm))) 106 | (destination-directory (vm-directory vm)) 107 | (box-contents (cl-fad:list-directory (corona.cloud:box-directory box)))) 108 | ;; Now we have to copy everything in box-contents to destination-directory 109 | (log:info "Copying OVF file to Corona directory.") 110 | (handler-case 111 | (corona.files:copy-files-to-directory box-contents 112 | destination-directory) 113 | (t () (log:info "OVF file already copied."))) 114 | (let ((ovf-file (first 115 | (remove-if-not #'(lambda (path) 116 | (equal (pathname-type path) "ovf")) 117 | box-contents)))) 118 | ;; And now, finally, actually issue the import command using 119 | (log:info "Importing OVF file.") 120 | ;; cl-virtualbox If we're testing, don't actually import anything 121 | #-corona-testing 122 | (virtualbox:import-vm ovf-file (stored-name vm)) 123 | t)))) 124 | 125 | (defmethod setup-vm ((vm )) 126 | "Apply the virtual machine's virtual hardware settings." 127 | (when (slot-boundp vm 'hardware) 128 | (let ((hardware (hardware vm)) 129 | (name (stored-name vm))) 130 | (log:info "Setting VM memory.") 131 | (virtualbox:set-vm-memory name (memory hardware)) 132 | (log:info "Setting VM CPU count.") 133 | (virtualbox:set-vm-cpu-count name (cpu-count hardware)) 134 | (aif (ip vm) 135 | (virtualbox:set-vm-ip (stored-name vm) 136 | (network-name vm) 137 | it))))) 138 | 139 | (defmethod ensure-vm ((vm )) 140 | "Ensure the VM is built an setup." 141 | (build-vm vm) 142 | (setup-vm vm)) 143 | 144 | (defmethod readyp ((vm )) 145 | "Is the virtual machine ready to accept a login?" 146 | ;; To test whether the machine is ready, we check the output of 147 | ;; virtualbox:execute 148 | (handler-case 149 | (virtualbox:execute (stored-name vm) 150 | "/bin/ls" 151 | "vagrant" 152 | "vagrant" 153 | :wait-stdout t) 154 | (uiop/run-program:subprocess-error () 155 | nil))) 156 | 157 | (defmethod wait-for-ready ((vm )) 158 | "Wait until the machine is ready for operation." 159 | (loop until (readyp vm) do 160 | (log:info "Waiting for machine to boot...") 161 | (sleep +wait-time+))) 162 | 163 | (defmethod start ((vm )) 164 | "Start the VM." 165 | (ensure-vm vm) 166 | (log:info "Starting...") 167 | (virtualbox:start-vm (stored-name vm)) 168 | (wait-for-ready vm)) 169 | 170 | (defmethod stop ((vm )) 171 | "Stop the VM." 172 | (log:info "Stopping...") 173 | (poweroff vm)) 174 | 175 | (defmethod pause ((vm )) 176 | "Pause the VM." 177 | (log:info "Pausing...") 178 | (virtualbox:pause-vm (stored-name vm))) 179 | 180 | (defmethod resume ((vm )) 181 | "Resume a paused VM." 182 | (log:info "Resuming...") 183 | (virtualbox:resume-vm (stored-name vm))) 184 | 185 | (defmethod reboot ((vm )) 186 | "Reboot the VM." 187 | (log:info "Rebooting...") 188 | (virtualbox:cold-reboot-vm (stored-name vm))) 189 | 190 | (defmethod poweroff ((vm )) 191 | "Force the VM to shut down." 192 | (log:info "Forcing shutdown...") 193 | (virtualbox:poweroff-vm (stored-name vm))) 194 | 195 | (defmethod map-ports ((vm ) host-port guest-port) 196 | "Map traffic going to `host-port` to `guest-port` if the machine has a 197 | `host`." 198 | (aif (ip vm) 199 | (virtualbox:map-vm-ports (stored-name vm) 200 | host-port 201 | it 202 | guest-port))) 203 | -------------------------------------------------------------------------------- /t/setup.lisp: -------------------------------------------------------------------------------- 1 | ;;;; We create a fake system, including a fake box, whose source tarball we'll 2 | ;;;; build here, from files we'll also generate here. 3 | (in-package :cl-user) 4 | (defpackage corona-test 5 | (:use :cl :fiveam)) 6 | (in-package :corona-test) 7 | 8 | ;;; The temporary directory will hold the fake box tarball 9 | 10 | (defparameter +tmp-dir+ 11 | (asdf:system-relative-pathname :corona #p"tmp/")) 12 | 13 | ;;; The server will serve files from +tmp-directory+, including the tarball 14 | 15 | (defparameter +server+ 16 | (make-instance 'clack.middleware.static: 17 | :path "/" 18 | :root +tmp-dir+)) 19 | 20 | (defparameter *server-handler* nil) 21 | 22 | (defparameter +server-port+ 41111) 23 | 24 | ;;;; We create this class to override the source-url method 25 | 26 | (defclass (corona.cloud:) ()) 27 | 28 | (defmethod corona.cloud:source-url ((box )) 29 | (format nil "http://localhost:~A/file.tar" +server-port+)) 30 | 31 | ;;; Here we define the fake system we'll be building 32 | 33 | (defparameter +box+ 34 | (make-instance ' 35 | :name "test" 36 | :author "test")) 37 | 38 | (defparameter +system+ 39 | (make-instance 'corona.sys: 40 | :name :test 41 | :version :0.1 42 | :arch :imaginary 43 | :box +box+)) 44 | 45 | ;;; Here are some utilities to generate the box files and tarball 46 | 47 | (defun make-fake-file (pathname) 48 | "A utility function to generate fake files." 49 | (with-open-file (stream pathname 50 | :direction :output 51 | :if-does-not-exist :create 52 | :if-exists :supersede) 53 | (write-string "beep boop meaningless data" stream))) 54 | 55 | (defun pathname-file (pathname) 56 | (make-pathname :name (pathname-name pathname) 57 | :type (pathname-type pathname))) 58 | 59 | (defun make-tarball (tarball-path files) 60 | (let ((current-dpf *default-pathname-defaults*)) 61 | (setf *default-pathname-defaults* 62 | (make-pathname :directory (pathname-directory tarball-path))) 63 | (archive::create-tar-file 64 | tarball-path 65 | (loop for file in files collecting (pathname-file file))) 66 | (setf *default-pathname-defaults* current-dpf) 67 | t)) 68 | 69 | ;;; Now, we build the actual box. 70 | 71 | (defparameter +image-file+ 72 | (merge-pathnames #p"box.ovf" +tmp-dir+)) 73 | (defparameter +hdd-file+ 74 | (merge-pathnames #p"box-disk1.vmdk" +tmp-dir+)) 75 | (defparameter +vagrantfile+ 76 | (merge-pathnames #p"Vagrantfile" +tmp-dir+)) 77 | (defparameter +tarball-path+ 78 | (merge-pathnames #p"file.tar" +tmp-dir+)) 79 | (defparameter +tarball-file-list+ 80 | (list +image-file+ +hdd-file+ +vagrantfile+)) 81 | 82 | ;;; Now we define a virtual machine that uses this system 83 | 84 | (defparameter +vm+ 85 | (make-instance 'corona.vm: 86 | :name 'test-vm 87 | :system +system+)) 88 | -------------------------------------------------------------------------------- /t/tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :corona-test) 2 | 3 | ;;; Test suites 4 | 5 | (def-suite corona) 6 | (in-suite corona) 7 | 8 | (test testing-environment 9 | (finishes 10 | (ensure-directories-exist +tmp-dir+)) 11 | (is-true 12 | #+corona-testing t #-corona-testing nil) 13 | (is (equal corona.files:+corona-directory+ 14 | (asdf:system-relative-pathname :corona #p"t/corona-files/")))) 15 | 16 | (test start-box-server 17 | (finishes 18 | (setf *server-handler* 19 | (clack:clackup +server+ :port +server-port+)))) 20 | 21 | (test (create-fake-files :depends-on testing-environment) 22 | (finishes 23 | (loop for file in +tarball-file-list+ do 24 | (make-fake-file file))) 25 | (finishes 26 | (make-tarball +tarball-path+ 27 | +tarball-file-list+)) 28 | (finishes 29 | (loop for file in +tarball-file-list+ do 30 | (delete-file file)))) 31 | 32 | (test (download-box :depends-on create-fake-files) 33 | (is-false 34 | (corona.cloud:local-box-p +box+)) 35 | (is-true 36 | (corona.cloud:download-and-extract-box +box+)) 37 | (is-false 38 | (corona.cloud:download-and-extract-box +box+)) 39 | (is-true 40 | (corona.cloud:local-box-p +box+))) 41 | 42 | (test (setup-vm :depends-on download-box) 43 | (finishes 44 | (corona.vm:build-vm +vm+))) 45 | 46 | (test (clean-up :depends-on setup-vm) 47 | (finishes 48 | (clack:stop *server-handler*)) 49 | (finishes 50 | (cl-fad:delete-directory-and-files +tmp-dir+)) 51 | (finishes 52 | (cl-fad:delete-directory-and-files corona.files:+corona-directory+))) 53 | 54 | (run! 'corona) 55 | 56 | (remove :corona-testing *features*) 57 | -------------------------------------------------------------------------------- /web/files.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage corona-web.files 3 | (:use :cl)) 4 | (in-package :corona-web.files) 5 | 6 | (defparameter +index+ 7 | (asdf:system-relative-pathname :corona #p"index.html")) 8 | (defparameter +stylesheet+ 9 | (asdf:system-relative-pathname :corona #p"web/style.lass")) 10 | 11 | (defun write-file (pathname content) 12 | (with-open-file (stream pathname 13 | :direction :output 14 | :if-exists :supersede 15 | :if-does-not-exist :create) 16 | (write-string content stream))) 17 | 18 | (write-file +index+ (corona-web.tmpl:index)) 19 | (lass:generate +stylesheet+) 20 | -------------------------------------------------------------------------------- /web/scripts.js: -------------------------------------------------------------------------------- 1 | function highlightMachineDefinition() { 2 | const code = document.getElementById('definition-code'); 3 | HighlightLisp.highlight_element(code); 4 | } 5 | 6 | function renderCodeExample(sys_name, sys_version, sys_arch) { 7 | var sys_str = '(:' + sys_name + ' :' + sys_version + ' :' + sys_arch 8 | + ')'; 9 | sys_str = '(defmachine my-machine\n :system ' + sys_str + '\n :memory 1024)\n'; 10 | sys_str += '\n(start my-machine) ;; Bring it up\n'; 11 | sys_str += '\n(stop my-machine) ;; Stop it'; 12 | return sys_str; 13 | } 14 | 15 | $('#system-list li').click(function (e) { 16 | $('#system-list li.active').removeClass('active'); 17 | $(this).addClass('active'); 18 | const name = $(this).attr('data-sys-name'); 19 | const ver = $(this).attr('data-sys-version') 20 | const arch = $(this).attr('data-sys-arch') 21 | $('#definition-code').html(renderCodeExample(name, ver, arch)); 22 | highlightMachineDefinition(); 23 | }) 24 | 25 | $(document).ready(function() { 26 | // Highlight usage code 27 | $('#usage pre code').each(function(idx, elem) { 28 | $(elem).addClass('lisp'); 29 | }); 30 | HighlightLisp.highlight_auto(); 31 | // Highlight the machine definition's code 32 | highlightMachineDefinition(); 33 | // Click on the first item in the list of available systems 34 | $('#system-list li').first().click(); 35 | }); 36 | -------------------------------------------------------------------------------- /web/style.lass: -------------------------------------------------------------------------------- 1 | (html 2 | :background-color "#111") 3 | (body 4 | :font-family "Source Sans Pro" 5 | :width "60%" 6 | :margin "0 auto" 7 | :padding "22px" 8 | :color "#111" 9 | :background-color "white") 10 | (header 11 | :margin-bottom "20px" 12 | :overflow "auto" 13 | (img 14 | :width "150px" 15 | :float "left" 16 | :padding-right "20px") 17 | (.title 18 | :padding-top "95px" 19 | :font-size "3.5em" 20 | :font-family "Exo") 21 | (.tagline 22 | :padding-top "10px")) 23 | (h1 24 | :margin-bottom "0") 25 | (hr 26 | :margin "0" 27 | :border "1px solid #f4c142") 28 | (section 29 | :width "90%" 30 | :margin "0 auto") 31 | (section#systems 32 | :overflow auto 33 | (ul#system-list 34 | :list-style-type none 35 | :width "30%" 36 | :float left 37 | :padding-left "0" 38 | (a 39 | :color "#3498DB") 40 | (li.active 41 | (a 42 | :color "#EA6153"))) 43 | (div#machine-definition 44 | :width "65%" 45 | :float left 46 | :margin-top "16px")) 47 | (a 48 | :text-decoration none) 49 | (p 50 | :text-align justify) 51 | ((:not pre) 52 | (> 53 | (code 54 | :background-color "#f8f8f8" 55 | :padding "2px" 56 | :border "1px solid #ccc" 57 | :border-radius "3px"))) 58 | -------------------------------------------------------------------------------- /web/templates.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage corona-web.tmpl 3 | (:use :cl :cl-markup) 4 | (:export :index)) 5 | (in-package :corona-web.tmpl) 6 | 7 | (defun head () 8 | (markup 9 | (:head 10 | (:meta :charset "utf-8") 11 | (:meta :http-equiv "X-UA-Compatible" :content "IE=edge") 12 | (:meta :name "viewport" :content "width=device-width, initial-scale=1") 13 | (:title "Corona") 14 | (:link :rel "stylesheet" :href "http://fonts.googleapis.com/css?family=Source+Sans+Pro") 15 | (:link :rel "stylesheet" :href "http://fonts.googleapis.com/css?family=Exo") 16 | (:link :rel "stylesheet" :href "web/style.css")))) 17 | 18 | (defun header () 19 | (markup 20 | (:header 21 | (:img :src "logo.jpg") 22 | (:div :class "title" "Corona") 23 | (:div :class "tagline" 24 | "Build and manage virtual machines from Common Lisp.")))) 25 | 26 | (defun footer () 27 | (markup 28 | (:footer ""))) 29 | 30 | (defmacro layout (&rest content) 31 | `(html5 32 | (raw (head)) 33 | (:body 34 | ,@content 35 | (:script :src "https://ajax.googleapis.com/ajax/libs/jquery/1.11.1/jquery.min.js" 36 | "") 37 | (:script :src "web/scripts.js" "") 38 | (:script :src "web/highlight-lisp/highlight-lisp.js" "") 39 | (:link :rel "stylesheet" :href "web/highlight-lisp/themes/github.css") 40 | (raw (footer))))) 41 | 42 | (defun description () 43 | (markup 44 | (:h1 "What is this?") 45 | (:hr) 46 | (:section :id "desc" 47 | (:p 48 | "Corona is a library for building and controlling virtual machines. It's 49 | essentially a clone of " 50 | (:a :href "https://www.vagrantup.com/" "Vagrant") 51 | ", with the advantage that it's written in pure Common Lisp, and can be 52 | installed simply from Quicklisp.") 53 | (:p 54 | "Corona uses " 55 | (:a :href "https://vagrantcloud.com/" "Vagrant Cloud") 56 | " as a source of base images for the virtual machines, so you can get 57 | started with any system in minutes.") 58 | (:p 59 | "Corona just manages the machines. To access them through SSH, consider the " 60 | (:code 61 | (:a :href "https://github.com/eudoxia0/trivial-ssh" 62 | "trivial-ssh")) 63 | " library.") 64 | (:p 65 | (:a :href "https://github.com/eudoxia0/corona" 66 | "View the source code on GitHub") 67 | ".")))) 68 | 69 | (defun use-cases () 70 | (markup 71 | (:h1 "Use Cases") 72 | (:hr) 73 | (:section :id "use-cases" 74 | (:h2 "Development Environments") 75 | (:p "Corona can be used to create isolated, reproducible development 76 | environments so you and your team can work on the same system.") 77 | (:p "No more 'works on my machine', no more difference between development 78 | and production.") 79 | (:h2 "Testing") 80 | (:p "If you have a library that uses an external tool, like a database 81 | server or something equally large, you can use Corona to set up a virtual 82 | machine and install whatever dependencies you need, so the user doesn't actually 83 | have to run anything on their computer.") 84 | (:p "Additionally, since you can set up multiple virtual machines with 85 | different systems, you can use Corona to ensure your library works on most 86 | operating systems. This is especially useful for testing compilers and similar 87 | applications where portability is critical.") 88 | (:h2 "Building") 89 | (:p "You can use Corona as a build server: Fire up virtual machines of the 90 | operating system you want to build on, set them up with everything you need, and 91 | run the builds.")))) 92 | 93 | (defun humanize-system-name (name) 94 | (cond 95 | ((equal name "freebsd") 96 | "FreeBSD") 97 | ((equal name "openbsd") 98 | "OpenBSD") 99 | (t 100 | (string-capitalize name)))) 101 | 102 | (defun available-systems () 103 | (markup 104 | (:h1 "Available Systems") 105 | (:hr) 106 | (:section :id "systems" 107 | (:ul :id "system-list" 108 | (:h2 "List of Systems") 109 | (loop for sys in corona.sys::*known-systems* collecting 110 | (let ((name (string-downcase (symbol-name (corona.sys:name sys)))) 111 | (version (corona.sys:version sys)) 112 | (arch (corona.sys:arch sys))) 113 | (markup 114 | (:li 115 | :data-sys-name name 116 | :data-sys-version version 117 | :data-sys-arch arch 118 | (:a :href "#machine-def-header" 119 | (format nil "~A, ~A, ~A-bit" 120 | (humanize-system-name name) 121 | version 122 | arch))))))) 123 | (:div :id "machine-definition" 124 | (:h2 :id "machine-def-header" 125 | "Machine Definition") 126 | (:span "Click on a system in the list to get the machine definition.") 127 | (:pre 128 | (:code :class "lisp" 129 | :id "definition-code" 130 | "(defmachine my-machine)")))))) 131 | 132 | (setf 3bmd-code-blocks:*code-blocks* t 133 | 3bmd-definition-lists:*definition-lists* t) 134 | 135 | (defun parse-markdown (pathname) 136 | (with-output-to-string (str) 137 | (3bmd:parse-string-and-print-to-stream 138 | (uiop:read-file-string pathname) 139 | str))) 140 | 141 | (defparameter +usage+ 142 | (parse-markdown (asdf:system-relative-pathname :corona "USAGE.md"))) 143 | (defparameter +faq+ 144 | (parse-markdown (asdf:system-relative-pathname :corona "FAQ.md"))) 145 | 146 | (defun usage () 147 | (markup 148 | (:h1 "Usage") 149 | (:hr) 150 | (:section :id "usage" 151 | (raw +usage+)))) 152 | 153 | (defun faq () 154 | (markup 155 | (:h1 "FAQ") 156 | (:hr) 157 | (:section :id "faq" 158 | (raw +faq+)))) 159 | 160 | (defun index () 161 | (layout 162 | (raw (header)) 163 | (raw (description)) 164 | (raw (use-cases)) 165 | (raw (available-systems)) 166 | (raw (usage)) 167 | (raw (faq)))) 168 | --------------------------------------------------------------------------------