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
| | ;;; -*- lexical-binding: t -*-
(defconst sandbox-mechanism
;; FIXME: make it a defcustom? What about other systems?
(cond ((eq system-type 'darwin) 'darwin)
((eq system-type 'gnu/linux) 'bwrap)))
(defun sandbox-available-p ()
"Non-nil if a sandboxing mechanism is available."
;; FIXME: We should check for availability of bwrap etc.
(not (null sandbox-mechanism)))
(defun sandbox--program-args (sandbox-spec prog)
"Return (PROGRAM . ARGS) for running PROG according to SANDBOX-SPEC."
(let ((allow-read-dirs (plist-get sandbox-spec :allow-read-dirs)))
;; FIXME: Would `:allow-write-dirs' make sense and be useful?
(pcase-exhaustive sandbox-mechanism
('darwin
(list prog "--eval"
(prin1-to-string `(darwin-sandbox-enter ',allow-read-dirs))))
('bwrap
;; FIXME: with seccomp?
`("bwrap"
"--unshare-all"
"--dev" "/dev"
"--proc" "/proc"
"--tmpfs" "/tmp"
,@(mapcan (lambda (dir) (let ((d (expand-file-name dir)))
(list "--ro-bind" d d)))
allow-read-dirs)
,prog)))))
(defun sandbox--emacs-command (sandbox-spec args)
(let* ((emacs (expand-file-name invocation-name invocation-directory))
(program-args (sandbox--program-args sandbox-spec emacs)))
`(,@program-args "--batch" ,@args)))
(defun sandbox-run-emacs (sandbox-spec destination args)
"Run sandboxed Emacs in batch mode, synchronously.
SANDBOX-SPEC is a sandbox specification plist. Currently defined key:
`:allow-read-dirs' -- the value is a list of directories that can
be read from (but not written to).
DESTINATION is as in `call-process'.
ARGS is a list of command-line arguments passed to the sandboxed Emacs.
Return value is as in `call-process'.
Depending on the platform, the sandbox restrictions do not necessarily
take effect until Emacs has been initialised and loaded the site and user
init files. If that is not desirable, suppress their use by adding the
corresponding flags (eg \"-Q\") to ARGS."
(let ((command (sandbox--emacs-command sandbox-spec args)))
(apply #'call-process (car command) nil destination nil (cdr command))))
(defun sandbox-start-emacs (sandbox-spec params args)
"Run sandboxed Emacs in batch mode, asynchronously.
SANDBOX-SPEC is a sandbox specification plist. Currently defined key:
`:allow-read-dirs' -- the value is a list of directories that can
be read from (but not written to).
ARGS is a list of command-line arguments passed to the sandboxed Emacs.
PARAMS is a plist of parameters passed to `make-process'. Do not
supply `:command'; it will be overridden by ARGS.
Return value is as in `make-process'.
Depending on the platform, the sandbox restrictions do not necessarily
take effect until Emacs has been initialised and loaded the site and user
init files. If that is not desirable, suppress their use by adding the
corresponding flags (eg \"-Q\") to ARGS."
(let* ((command (sandbox--emacs-command sandbox-spec args))
(params (copy-sequence params))
(params (plist-put params :command command)))
(unless (plist-member params :name)
(setq params (plist-put params :name "emacs")))
(unless (plist-member params :connection-type)
(setq params (plist-put params :connection-type 'pipe)))
(apply #'make-process params)))
(provide 'sandbox)
|