Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: b802c6ef8f
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 146 lines (132 sloc) 6.923 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
(ns lxc-crate.api
  (:require
   [pallet.algo.fsmop :as fsmop]
   [pallet.node :as node]
   [pallet.configure :as configure]
   [pallet.compute :as compute]
   [pallet.api :as api]
   [pallet-nodelist-helpers :as helpers]
   [lxc-crate.lxc :as lxc]))

(defn host-is-lxc-server?
  "Check if a host is a LXC server (as understood by the lxc-create)"
  [hostname]
  (helpers/host-has-phase? hostname :create-lxc-container))

(defn host-is-lxc-image-server?
  "Check if a host is an image server (as understood by the lxc-create)"
  [hostname]
  (helpers/host-has-phase? hostname :snapshot-tmp-container))

(defn boot-up-fresh-tmp-container
  "Boot up our known pre-defined lxc container"
  [image-server spec-kw image-specs]
  (helpers/ensure-nodelist-bindings)
  (when-not (host-is-lxc-image-server? image-server)
    (throw (IllegalArgumentException. (format "%s is not an image server!" image-server))))
  (let [image-server-conf (get-in helpers/*nodelist-hosts-config* [image-server :image-server])
        tmp-hostname (:tmp-hostname image-server-conf)]
    (println "Bring up minimal minimal base container..")
    (let [result (helpers/run-one-plan-fn image-server (api/plan-fn (lxc/create-lxc-container :overwrite? true))
                                          {:container-for tmp-hostname
                                           :override-spec spec-kw
                                           :tmp-container-run true
                                           :image-specs image-specs})]
      (when (fsmop/failed? result)
        (throw (IllegalStateException. "Failed to bring up fresh tmp container!")))
      (println "Waiting for container to spin up (10s)..")
      (Thread/sleep (* 10 1000))
      (println "tmp container up - connect to it using:" tmp-hostname))))

(defn run-setup-fn-in-tmp-container
  "Run a given image-spec's setup-fn in the tmp container"
  [image-server spec-kw image-specs]
  (helpers/ensure-nodelist-bindings)
  (when-not (host-is-lxc-image-server? image-server)
    (throw (IllegalArgumentException. (format "%s is not an image server!" image-server))))
  (let [image-server-conf (get-in helpers/*nodelist-hosts-config* [image-server :image-server])
        tmp-hostname (:tmp-hostname image-server-conf)]
    (println "Run setup-fn..")
    (let [result (helpers/run-one-plan-fn tmp-hostname lxc/run-setup-fn-in-tmp-container {:override-spec spec-kw
                                                                                          :image-specs image-specs})]
      (when (fsmop/failed? result)
        (throw (IllegalStateException. "Failed to run setup-fn in tmp container!")))
      (println "Setup-fn finished."))))

(defn halt-tmp-container
  "Halt the tmp container"
  [image-server]
  (helpers/ensure-nodelist-bindings)
  (when-not (host-is-lxc-image-server? image-server)
    (throw (IllegalArgumentException. (format "%s is not an image server!" image-server))))
  (println "Halt tmp container..")
  (let [image-server-conf (get-in helpers/*nodelist-hosts-config* [image-server :image-server])
        tmp-hostname (:tmp-hostname image-server-conf)
        result (helpers/run-one-plan-fn tmp-hostname lxc/halt-tmp-container)]
    (when (fsmop/failed? result)
      (throw (IllegalStateException. "Failed to halt tmp container!")))
    (println "Waiting for container to halt (70s)..")
    (Thread/sleep (* 70 1000))
    (println "tmp container halted.")))

(defn snapshot-image-of-tmp-container
  "Take a snapshot of the tmp container."
  [image-server spec-kw]
  (helpers/ensure-nodelist-bindings)
  (when-not (host-is-lxc-image-server? image-server)
    (throw (IllegalArgumentException. (format "%s is not an image server!" image-server))))
  (println "Snapshot tmp container..")
  (let [result (helpers/run-one-plan-fn image-server lxc/snapshot-tmp-container {:override-spec spec-kw})]
    (when (fsmop/failed? result)
      (throw (IllegalStateException. "Failed to snapshot tmp container!")))
    (println "Finished tmp container snapshot for " spec-kw)))

(defn destroy-tmp-container
  "Destroy the tmp container."
  [image-server]
  (helpers/ensure-nodelist-bindings)
  (when-not (host-is-lxc-image-server? image-server)
    (throw (IllegalArgumentException. (format "%s is not an image server!" image-server))))
  (println "Destroy the tmp container..")
  (let [result (helpers/run-one-plan-fn image-server lxc/destroy-tmp-container)]
    (when (fsmop/failed? result)
      (throw (IllegalStateException. "Failed to destroy tmp container!")))
    (println "tmp container destroyed.")))

(defn create-lxc-image-all-steps
  [image-server spec-kw image-specs]
  (boot-up-fresh-tmp-container image-server spec-kw image-specs)
  (run-setup-fn-in-tmp-container image-server spec-kw image-specs)
  (halt-tmp-container image-server)
  (snapshot-image-of-tmp-container image-server spec-kw)
  (destroy-tmp-container image-server))

(defn- root-from-image-spec
  [image-spec]
  (let [ssh-public-key-path (:root-key-pub image-spec)
        ssh-private-key-path (:root-key-priv image-spec)
        passphrase (:root-key-passphrase image-spec)]
    (api/make-user "root"
                   :public-key (slurp ssh-public-key-path)
                   :private-key (slurp ssh-private-key-path)
                   :passphrase passphrase
                   :no-sudo true)))

(defn setup-container-admin-user
  "Setup admin user for container"
  [hostname image-specs]
  (helpers/ensure-nodelist-bindings)
  (let [container-config (get helpers/*nodelist-hosts-config* hostname)
        root-from-spec (root-from-image-spec ((:base-image container-config) image-specs))
        result (helpers/run-one-plan-fn hostname root-from-spec lxc/setup-container-admin-user {})]
    (when (fsmop/failed? result)
      (throw (IllegalStateException. "Failed to create admin user!")))))

(defn create-lxc-container
  "Create a lxc container on a given lxc server."
  [hostname image-specs]
  (helpers/ensure-nodelist-bindings)
  (let [container-config (get helpers/*nodelist-hosts-config* hostname)
        lxc-server (:lxc-server container-config)]
    (when-not (host-is-lxc-server? lxc-server)
      (throw (IllegalArgumentException. (format "%s is not an LXC server!" lxc-server))))
    (println (format "Create container %s (on server %s).."
                     hostname lxc-server))

    (let [result (helpers/lift-one-node-and-phase lxc-server :create-lxc-container {:container-for hostname
                                                                                    :image-specs image-specs})]
      (when (fsmop/failed? result)
        (throw (IllegalStateException. "Failed to create container!"))))

    (println "Waiting 10s for container to boot..")
    (println (Thread/sleep (* 10 1000)))
    (println "Setting up container admin user..")
    (setup-container-admin-user hostname image-specs)
    (println (format "Container created for %s." hostname))))
Something went wrong with that request. Please try again.