From a571b7bd8b6a48b1343f159287bbc8287c0e8b20 Mon Sep 17 00:00:00 2001
From: Philip Kaludercic <philipk@posteo.net>
Date: Wed, 13 Apr 2022 10:29:58 +0200
Subject: [PATCH 2/2] Support sandboxing using Guix

* elpa-admin.el (elpaa--sandbox-mechanism): Add new variable.
(elpaa-read-config): Allow configuring elpaa--sandbox-mechanism.
(elpaa--guix-args): Add new variable, listing all the necessary
  packages for sandboxing.
(elpaa--sandbox-args): Add new generic function to prepare a command.
(elpaa--call-sandboxed): Call elpaa--sandbox-args.
(elpa--markdown-executable): Check elpaa--sandbox-mechanism to set
  what markdown compiler to use.
---
 elpa-admin.el | 44 ++++++++++++++++++++++++++++++++------------
 1 file changed, 32 insertions(+), 12 deletions(-)

diff --git a/elpa-admin.el b/elpa-admin.el
index e86b8d3196..8efec7bfcf 100644
--- a/elpa-admin.el
+++ b/elpa-admin.el
@@ -55,6 +55,11 @@
 
 (defvar elpaa--sandbox-extra-ro-dirs nil)
 
+(defvar elpaa--sandbox-mechanism
+  (cond ((executable-find "guix") 'guix)
+        ((executable-find "bwrap") 'bwrap))
+  "What mechanism to use for sandboxing.")
+
 (defvar elpaa--sandbox
   ;; Currently sandboxing is implemented using `bwrap' which AFAIK doesn't
   ;; exist for w32 nor for macos, so there's no point defaulting to non-nil
@@ -112,6 +117,7 @@ See variable `org-export-options-alist'.")
               ('email-from		elpaa--email-from)
               ('email-reply-to		elpaa--email-reply-to)
               ('sandbox			elpaa--sandbox)
+              ('sandbox-mechanism       elpaa--sandbox-mechanism)
               ('sandbox-extra-ro-dirs	elpaa--sandbox-extra-ro-dirs)
               ('doc-dir                 elpaa--doc-subdirectory)
               ('debug			elpaa--debug))
@@ -954,9 +960,28 @@ The INFILE and DISPLAY arguments are fixed as nil."
     "--proc" "/proc"
     "--tmpfs" "/tmp"))
 
+(defconst elpaa--guix-args
+  '("shell" "--container" "--pure"
+    ;; List of required packages
+    "coreutils" "emacs-minimal" "cmark" "texinfo" "make"))
+
 (defvar elpaa--sandbox-ro-binds
   '("/lib" "/lib64" "/bin" "/usr" "/etc/alternatives" "/etc/emacs"))
 
+(cl-defmethod elpaa--sandbox-args ((_mechaism (eql bwrap)) args)
+  (let ((dd (expand-file-name default-directory))) ;No `~' allowed!
+    (setq args (cl-list* "--bind" dd dd args)))
+  ;; Add read-only dirs in reverse order.
+  (dolist (b (append elpaa--sandbox-ro-binds elpaa--sandbox-extra-ro-dirs))
+    (when (file-exists-p b)         ;`brwap' burps on binds that don't exist!
+      (setq b (expand-file-name b))
+      (setq args (cl-list* "--ro-bind" b b args))))
+  (append (list "bwrap") elpaa--bwrap-args args))
+
+(cl-defmethod elpaa--sandbox-args ((_mechaism (eql guix)) args)
+  ;; Indicate the remaining arguments are the command to be executed.
+  (append (list "guix") elpaa--guix-args (cons "--" args)))
+
 (defun elpaa--call-sandboxed (destination &rest args)
   "Like ‘elpaa--call’ but sandboxed.
 More specifically, uses Bubblewrap such that the command is
@@ -964,18 +989,9 @@ confined to only have write access to the `default-directory'.
 Signal an error if the command did not finish with exit code 0."
   (if (not elpaa--sandbox)
       (apply #'elpaa--call destination args)
-    (elpaa--message "call-sandboxed %S" args)
-    (let ((dd (expand-file-name default-directory))) ;No `~' allowed!
-      (setq args (nconc `("--bind" ,dd ,dd) args)))
-    ;; Add read-only dirs in reverse order.
-    (dolist (b (append elpaa--sandbox-ro-binds
-                       elpaa--sandbox-extra-ro-dirs))
-      (when (file-exists-p b)         ;`brwap' burps on binds that don't exist!
-        (setq b (expand-file-name b))
-        (setq args (nconc `("--ro-bind" ,b ,b) args))))
-    (let ((exitcode
-           (apply #'elpaa--call destination "bwrap"
-                  (append elpaa--bwrap-args args))))
+    (elpaa--message "call-sandboxed %S [%S]" args elpaa--sandbox-mechanism)
+    (let ((exitcode (apply #'elpaa--call destination
+                           (elpaa--sandbox-args elpaa--sandbox-mechanism args))))
       (unless (eq exitcode 0)
         (if (eq destination t)
             (error "Error-indicating exit code in elpaa--call-sandboxed:\n%s"
@@ -1266,6 +1282,10 @@ which see."
 
 (defun elpa--markdown-executable ()
   (catch 'exists
+    (when (eq elpaa--sandbox-mechanism 'guix)
+      ;; When using Guix, we can ensure what markdown implementation
+      ;; we want to use, so we just return a fixed one here.
+      (throw 'exists "cmark"))
     (dolist (cmd elpaa--markdown-candidates)
       (when (executable-find cmd)
         (throw 'exists cmd)))
-- 
2.30.2