Add docker command

Add the 'docker' command for linux systems.  It takes as arguments an
Emacs version along with an eldev command and its arguments, and runs
the eldev command in a container running that Emacs version.

eldev-util.el

@@ -990,6 +990,10 @@ through `executable-find' if possible.  Since Eldev 0.8.")
 Can be set explicitly or left to t, in which case it is located
 through `executable-find' if possible.  Since Eldev 0.8.")
 
+(defvar eldev-docker-executable t
+  "Docker executable.
+Can be set explicitly or left to t, in which case it is located
+through `executable-find' if possible.")
 
 (defmacro eldev-find-executable (cache-var not-required finder-form error-message &rest error-arguments)
   "Find and executable using FINDER-FORM.
@@ -1072,6 +1076,13 @@ See also variable `eldev-svnadmin-executable'."
     (executable-find "svnadmin")
     "Subversion is not installed (cannot find `svnadmin' executable)"))
 
+(defun eldev-docker-executable (&optional not-required)
+  "Find `docker' executable.
+See also variable `eldev-docker-executable'."
+  (eldev-find-executable eldev-docker-executable not-required
+    (executable-find "docker")
+    "Docker is not installed (cannot find `docker' executable)"))
+
 (defvar vc-svn-program)
 (with-eval-after-load 'vc-svn
   (setf vc-svn-program (eldev-svn-executable t)))
@@ -1164,7 +1175,7 @@ Also, eat up several options from BODY if present:
       (eldev-verbose header-message))
     (if only-when-verbose
         (eldev-verbose "%s" (buffer-string))
-      (eldev-output "%s" (buffer-string)))))
+      (eldev-output :nolf "%s" (buffer-string)))))
 
 
 

eldev.el

@@ -111,6 +111,9 @@ instead.")
   "Name of Eldev cache subdirectory, `.eldev'.
 See also function `eldev-cache-dir'.")
 
+(defconst eldev-global-cache-dir "global-cache"
+  "Name of the global cache directory (a subdirectory of `eldev-dir').")
+
 (defvar eldev--internal-pseudoarchive "--eldev--")
 
 (defvar eldev--loading-modes
@@ -980,7 +983,7 @@ Returns COMMAND-LINE with options removed."
       (nreverse without-options))))
 
 (defun eldev-global-package-archive-cache-dir ()
-  (expand-file-name "global-cache" eldev-dir))
+  (expand-file-name eldev-global-cache-dir eldev-dir))
 
 (defun eldev-cache-dir (emacs-version-specific &optional ensure-exists)
   "Get the directory where various internal caches should be stored.
@@ -4095,6 +4098,225 @@ be passed to Emacs, else it will most likely fail."
         :die-on-error  "child Emacs"
         (eldev--forward-process-output "Output of the child Emacs process:" "Child Emacs process produced no output")))))
 
+;; eldev emacs-docker
+
+(defvar eldev--emacs-gui-args
+  (list "-e" "DISPLAY" "-v" "/tmp/.X11-unix:/tmp/.X11-unix")
+  "Arguments needed to launch dockerized Emacs as a GUI.")
+
+(defvar eldev-docker-run-extra-args nil
+  "Extra arguments to pass to \"docker run\".")
+
+(defvar eldev--xhost-hint
+  "It appears your X server is not accepting connections from the docker container.  Have you ran \"xhost +local:root\"? Error trace:\n"
+  "Message to output if it appears the user has not enabled X forwarding.")
+
+(defvar eldev--container-bootstrap-cmd-fn
+  #'eldev--container-bootstrap-cmd-fn
+  "Function to determine the command used by \"docker run\".
+
+It should take one parameter: the arguments of the \"eldev\" call.")
+
+(defvar eldev--docker-home-name "docker-home"
+  "Name of the home directory of the docker user.")
+
+(defvar eldev--docker-os-error-fmt-string
+  "OS %s is not currently supported by \"eldev docker\""
+  "Error message format string if the os is not supported.")
+
+(defun eldev--container-bootstrap-cmd-fn (eldev-args)
+  "Return a command in the form of an argument list for \"docker run\".
+
+ELDEV-ARGS will be passed to an \"eldev\" call."
+  (list
+   "sh" "-c"
+   (format "export PATH=\"$HOME/bin:$PATH\" && eldev %s" eldev-args)))
+
+(defun eldev--container-eldev-source-install-cmd (eldev-src-repo-dir eldev-args)
+  "Return command for \"docker run\" that will install eldev from source.
+
+Return a command that installs eldev from the source repository
+ELDEV-SRC-REPO-DIR (a full path on the container), and then calls eldev
+with ELDEV-ARGS."
+  (list
+   "sh" "-c"
+   (format "ELDEV_LOCAL=%s %s/bin/eldev %s"
+           eldev-src-repo-dir
+           eldev-src-repo-dir
+           eldev-args)))
+
+(defun eldev--docker-determine-img (img-string)
+  "Return an appropriate docker image based on IMG-STRING."
+  (if (string-match-p ".*/.*" img-string)
+      img-string
+    (format "silex/emacs:%s" img-string)))
+
+(defun eldev--docker-local-dep-mounts (home)
+  "Return bind mount arguments of local dependencies for docker run.
+
+HOME is the home directory of the container user."
+  (eldev-flatten-tree
+   (mapcar (lambda (local-dep)
+             (let* ((dir (nth 3 local-dep))
+                    (dir-rel (file-relative-name dir (expand-file-name "~")))
+                    (container-dir
+                     (if (eldev-external-filename dir-rel)
+                         dir
+                       (concat (file-name-as-directory home) dir-rel))))
+               (list "-v" (format "%s:%s" (expand-file-name dir) container-dir))))
+           eldev--local-dependencies)))
+
+(defun eldev--docker-create-directories (docker-home)
+  "Make directories required for \"eldev docker\" given DOCKER-HOME.
+
+This is necessary since if we mount a volume such that the directory
+on the host does not exist, then it will be created on the container
+owned by root."
+  (mapc (lambda (cache-sub-dir)
+          (unless (file-exists-p docker-home)
+            (make-directory
+             (concat (file-name-as-directory docker-home)
+                     (file-name-as-directory eldev-cache-dir)
+                     cache-sub-dir)
+             t)))
+        (list "config" eldev-global-cache-dir))
+  (let ((home-bin (concat (file-name-as-directory docker-home) "bin")))
+    (unless (file-exists-p home-bin) (make-directory home-bin))))
+
+(defun eldev--docker-home ()
+  "Return the host directory of the container docker home."
+  (concat (file-name-as-directory (eldev-cache-dir nil t))
+          eldev--docker-home-name))
+
+(defun eldev--docker-args (img eldev-args &optional as-gui local-eldev)
+  "Return command line args to run the docker image IMG.
+
+ELDEV-ARGS will be appended to the eldev call in the container.
+
+The global config file and cache will be mounted unless
+`eldev-skip-global-config' is nil.
+
+If AS-GUI is non-nil include arguments necessary to run Emacs as a GUI.
+
+If LOCAL-ELDEV (a directory) is specified, the returned arguments will
+contain a mount of it at /eldev."
+  (let* ((container-project-dir (file-name-nondirectory
+                        (directory-file-name eldev-project-dir)))
+         (container-home (concat "/"
+                                 (file-name-as-directory container-project-dir)
+                                 (file-name-as-directory eldev-cache-dir)
+                                 eldev--docker-home-name))
+         (container-eldev-cache-dir
+          (concat (file-name-as-directory container-home) eldev-cache-dir))
+         (container-bin (concat (file-name-as-directory container-home) "bin")))
+    (eldev--docker-create-directories (eldev--docker-home))
+    (append (list "run" "--rm"
+                  "-e" (format "HOME=%s" container-home)
+                  "-u" (format "%s:%s" (user-uid) (group-gid))
+                  "-v" (format "%s:/%s" eldev-project-dir container-project-dir)
+                  "-w" (concat "/" container-project-dir))
+            (when as-gui eldev--emacs-gui-args)
+            (if local-eldev
+                (when (not (string= (directory-file-name eldev-project-dir)
+                                    (directory-file-name local-eldev)))
+                  (list "-v" (format "%s:/eldev" local-eldev)))
+              (list "-v" (format "%s:%s/eldev"
+                                 (locate-file "bin/eldev" load-path)
+                                 container-bin)))
+            (unless eldev-skip-global-config
+              (list "-v" (format "%s:%s/config"
+                                 eldev-user-config-file
+                                 container-eldev-cache-dir)
+                    "-v" (format "%s:%s/%s"
+                                 (eldev-global-package-archive-cache-dir)
+                                 container-eldev-cache-dir
+                                 eldev-global-cache-dir)))
+            (eldev--docker-local-dep-mounts container-home)
+            eldev-docker-run-extra-args
+            (cons img (funcall eldev--container-bootstrap-cmd-fn
+                               (mapconcat #'identity eldev-args " "))))))
+
+(defun eldev--docker-container-eldev-cmd (args)
+  "Return the eldev command to call in the docker container deduced from ARGS."
+  (car (eldev-filter (not (string-prefix-p "-" it)) args)))
+
+(defun eldev--docker-on-supported-os ()
+  "Return t if on a supported OS, else return nil."
+  (memq system-type '(gnu/linux gnu/kfreebsd darwin)))
+
+(eldev-defcommand eldev-docker (&rest parameters)
+  "Launch a specified Emacs version in a docker container.
+
+This command will execute the eldev command ELDEV_COMMAND against a
+specified Emacs version with the project loaded with all its
+dependencies in a docker container.
+
+GLOBAL_ARGS such as \"--trace\" may also precede ELDEV_COMMAND, in
+which case they will also be forwarded to the eldev call inside the
+container.
+
+VERSION must be a valid Emacs version, e.g. \"27.2\".
+
+A repository name/full image name may also be used in place of VERSION,
+in which case it will be fed directly to \"docker pull\" and
+\"docker run\".  Any string containing a \"/\" will be interpreted as
+such rather than an Emacs version.
+
+Note it will be assumed that Emacs is installed on any image that is run.
+
+Command line arguments appearing after VERSION will be forwarded to an
+\"eldev\" call within the container.  For example:
+
+    eldev docker 25 emacs
+
+Will run \"eldev emacs\" inside an Emacs 25 container.
+
+The contents of `eldev-docker-run-extra-args' will be added to the
+\"docker run\" call this command makes.
+
+Emacs will not be started as a GUI unless the command is \"emacs\" and
+the \"--batch\" flag is not present.
+
+Note currently only linux and Mac OS systems are supported by this command."
+  :parameters     "VERSION [GLOBAL_ARGS..] ELDEV_COMMAND [ARGS...]"
+  :aliases        emacs-docker
+  :custom-parsing t
+  (unless (eldev--docker-on-supported-os)
+    (signal 'eldev-error
+            `(t ,(format eldev--docker-os-error-fmt-string system-type))))
+  (unless (car parameters)
+    (signal 'eldev-wrong-command-usage `(t "version not specified")))
+  (let* ((img (eldev--docker-determine-img (car parameters)))
+         (docker-exec (eldev-docker-executable))
+         (escaped-params (mapcar #'eldev-quote-sh-string (cdr parameters)))
+         (container-cmd (eldev--docker-container-eldev-cmd escaped-params))
+         (as-gui (and (string= "emacs" container-cmd)
+                      (not (member "--batch" parameters))))
+         (local-eldev (getenv "ELDEV_LOCAL"))
+         (eldev--container-bootstrap-cmd-fn
+          (if local-eldev
+              (apply-partially
+               #'eldev--container-eldev-source-install-cmd "/eldev")
+            eldev--container-bootstrap-cmd-fn))
+         (args (append
+                (eldev--docker-args img escaped-params as-gui local-eldev))))
+    (eldev-call-process
+        docker-exec
+        args
+      :pre-execution
+      (eldev-verbose "Running command '%s %s'"
+                     docker-exec
+                     (mapconcat #'identity args " "))
+      :die-on-error
+      (progn
+        (delete-directory (eldev--docker-home) t)
+        (when (string-match-p ".*unavailable, simulating -nw.*" (buffer-string))
+          (eldev-warn eldev--xhost-hint))
+        (format "%s run" docker-exec))
+      (eldev--forward-process-output
+       (format "Output of the %s process:" docker-exec)
+       (format "%s process produced no output" docker-exec)))
+    (delete-directory (eldev--docker-home) t)))
 
 
 ;; eldev targets, eldev build, eldev compile, eldev package

test/emacs.el

@@ -10,28 +10,28 @@
 (ert-deftest eldev-emacs-2 ()
   ;; Unlike our `eval' Emacs doesn't print `--eval' results.
   (eldev--test-run "trivial-project" ("emacs" "--batch" "--eval" `(prin1 (+ 1 2)))
-    (should (string= stdout "3\n"))
+    (should (string= stdout "3"))
     (should (= exit-code 0))))
 
 (ert-deftest eldev-emacs-3 ()
   (eldev--test-run "project-a" ("--quiet" "emacs" "--batch" "--eval" `(princ (project-a-hello)))
-    (should (string= stdout "Hello\n"))
+    (should (string= stdout "Hello"))
     (should (= exit-code 0))))
 
 (ert-deftest eldev-emacs-4 ()
   (eldev--test-run "project-b" ("--quiet" "emacs" "--batch" "--eval" `(princ (project-b-hello)))
-    (should (string= stdout "Hello\n"))
+    (should (string= stdout "Hello"))
     (should (= exit-code 0))))
 
 (ert-deftest eldev-emacs-5 ()
   (eldev--test-run "project-c" ("--quiet" "emacs" "--batch" "--eval" `(princ (project-c-hello)))
-    (should (string= stdout "Hello\n"))
+    (should (string= stdout "Hello"))
     (should (= exit-code 0))))
 
 (ert-deftest eldev-emacs-6 ()
   ;; Important to test as the "project" involves some macro magic.
   (eldev--test-run "project-e" ("--quiet" "emacs" "--batch" "--eval" `(princ (project-e-hello)))
-    (should (string= stdout "Hello\n"))
+    (should (string= stdout "Hello"))
     (should (= exit-code 0))))
 
 (ert-deftest eldev-emacs-missing-dependency-1 ()

test/integration/docker.el

@@ -0,0 +1,47 @@
+(require 'test/common)
+
+(defvar eldev--docker-emacs-version "27.2")
+
+(ert-deftest eldev-docker-emacs-1 ()
+  (skip-unless (and (eldev-docker-executable nil)
+                    (eldev--docker-on-supported-os)))
+  (let ((eldev--test-eldev-local (expand-file-name default-directory)))
+    (eldev--test-run "trivial-project"
+        ("--quiet"
+         "docker"
+         eldev--docker-emacs-version
+         "emacs"
+         "--batch"
+         "--eval"
+         `(prin1 (+ 1 2)))
+        (should (string-suffix-p "3" stdout))
+        (should (= exit-code 0)))))
+
+(ert-deftest eldev-docker-emacs-2 ()
+  (skip-unless (and (eldev-docker-executable nil)
+                    (eldev--docker-on-supported-os)))
+  (let ((eldev--test-eldev-local (expand-file-name default-directory)))
+    (eldev--test-run "trivial-project"
+        ("--quiet"
+         "docker"
+         "25"
+         "emacs"
+         "--batch"
+         "--eval"
+         `(prin1 (+ 1 2)))
+        (should (string-suffix-p "3" stdout))
+        (should (= exit-code 0)))))
+
+(ert-deftest eldev-docker-test-1 ()
+  (skip-unless (and (eldev-docker-executable nil)
+                    (eldev--docker-on-supported-os)))
+  (eldev--test-run "project-c" ("clean" "all")
+    (should (= exit-code 0)))
+  (let ((eldev--test-eldev-local (expand-file-name default-directory)))
+    (eldev--test-run "project-c"
+        ("docker"
+        eldev--docker-emacs-version
+        "test")
+        (should (= exit-code 0)))))
+
+(provide 'test/emacs-docker)

test/project-c/Eldev

@@ -1 +1,5 @@
 (eldev-use-package-archive `("archive-a" . ,(expand-file-name "../package-archive-a")))
+
+(setq eldev-docker-run-extra-args
+      `("-v" ,(concat (expand-file-name "../package-archive-a/")
+                      ":/package-archive-a")))