Re: Enterprise Guix Hosting?

[Ricardo Wurmus]

"Thompson, David" <dthompson2@worcester.edu> writes:

>> Using a shared /gnu/store as a big cache for all containers can be a
>> real asset.  We can learn lessons from the HPC experience here.
>
> What might have a positive impact is if Guix had an answer to 'docker
> compose'.  Most of the pieces are there already.  Such a tool could be
> combined with 'guix shell' so you could get all the tools needed for
> local development *and* automatically start any necessary daemons,
> like database servers, in isolated containers.

Yes, this would be useful.

Another thing that seems to be missing is a way to supervise and manage
running containers.  I use a shepherd instance for this with
container-specific actions like this:

(define %ip
  (let ((loc #f))
    (lambda ()
      "Return the absolute file name of the ip command."
      (or loc
          (let ((value (which "ip")))
            (set! loc value)
            value)))))

(define (launch container-id script)
   (herd "root" "eval"
         (format #false
           "~s"
           `(begin
              (use-modules (srfi srfi-2)
                           (ice-9 popen)
                           (ice-9 rdelim)
                           (ice-9 match))
              (define (guix-container id script)
                (make <service>
                  #:provides (list
                              (string->symbol (string-append "guix-container-" 
id)))
                  #:docstring "Run a Guix System container"
                  #:start
                  ;; TODO: Using /bin/sh -c is ugly, but
                  ;; without it the container would be stuck in the early boot 
process.
                  (make-forkexec-constructor
                   `("/bin/sh" "-c" (string-join (list "exec" script ,@args) 
#\space)))
                  #:stop (make-kill-destructor)
                  #:actions
                  (make-actions
                   (pid
                    "Show the PID of the system container."
                    (lambda (running)
                      (let ((pid (call-with-input-file
                                     (format #false "/proc/~a/task/~a/children"
                                             running running)
                                   read)))
                        (display (match pid
                                   ((? eof-object?) "")
                                   (_ pid))))))
                   (ip
                    "Show the IP address of the system container."
                    (lambda (running)
                      (let* ((pid (number->string
                                   (call-with-input-file
                                       (format #false 
"/proc/~a/task/~a/children"
                                               running running)
                                     read)))
                             (ns (format #false "guix-~a" pid))
                             (ip ,(%ip))
                             (address
                              (catch #true
                                (lambda ()
                                  (let* ((pipe (open-pipe* OPEN_READ
                                                           ip "netns" "exec" ns
                                                           "ip" "-o" "-4"
                                                           "-family" "inet"
                                                           "addr" "show"
                                                           "dev" (format #false 
"ceth-~a" pid)))
                                         (output (read-line pipe)))
                                    (match (string-tokenize output)
                                      ((number if "inet" ip . rest) ip)
                                      (_ ""))))
                                (lambda _ ""))))
                        (display address))))
                   (up
                    "Connect network for the system container."
                    (lambda (running)
                      (let* ((pid (number->string
                                   (call-with-input-file
                                       (format #false 
"/proc/~a/task/~a/children"
                                               running running)
                                     read)))
                             (ns (format #false "guix-~a" pid))
                             (host (format #false "veth-~a" pid))
                             (client (format #false "ceth-~a" pid))
                             (ip ,(%ip))
                             (sys (lambda args
                                    (or (zero? (apply system* args))
                                        (error args)))))
                        ;; Make existing network namespace available to ip netns
                        (sys ip "netns" "attach" ns pid)

                        ;; Create veth pair and move the client side into the 
container.
                        (sys ip "link" "add" host "type" "veth" "peer" "name" 
client)
                        (sys ip "link" "set" host "up")
                        (sys ip "link" "set" client "netns" ns)

                        ;; Attach host side to host bridge
                        (sys ip "link" "set" host "master" "br0")

                        ;; Bring up interface in container
                        (sys ip "netns" "exec" ns "ip" "link" "set" "lo" "up")
                        (sys ip "netns" "exec" ns "ip" "link" "set" client 
"up"))))
                   (down
                    "Disconnect network for the system container."
                    (lambda (running)
                      (let* ((pid (number->string
                                   (call-with-input-file
                                       (format #false 
"/proc/~a/task/~a/children"
                                               running running)
                                     read)))
                             (ns (format #false "guix-~a" pid))
                             (host (format #false "veth-~a" pid))
                             (ip ,(%ip))
                             (sys (lambda args
                                    (or (zero? (apply system* args))
                                        (error args)))))
                        (sys ip "netns" "delete" ns)
                        (sys ip "link" "delete" host))))
                   (netstat
                    (lambda (running)
                      (and-let* ((pid (number->string
                                       (call-with-input-file
                                           (format #false 
"/proc/~a/task/~a/children"
                                                   running running)
                                         read)))
                                 (template (lambda (what)
                                             (format #false 
"/sys/class/net/veth-~a/statistics/~a_bytes" pid what)))
                                 (rx (call-with-input-file (template "rx") 
read))
                                 (tx (call-with-input-file (template "tx") 
read)))
                        (format #true "receive:~a transmit:~a" rx tx)))))))
              (let ((service (guix-container ,vm-id ,script)))
                (register-services service)
                (start service))))))


-- 
Ricardo