864 lines
39 KiB
EmacsLisp
864 lines
39 KiB
EmacsLisp
;;; firejail-mode --- Major mode for editing firejail profiles -*- lexical-binding: t -*-
|
|
;;; Commentary:
|
|
;;; Code:
|
|
(require 'find-file)
|
|
(require 'custom)
|
|
(require 'thingatpt)
|
|
(require 'man)
|
|
|
|
(eval-when-compile
|
|
(require 'rx))
|
|
|
|
(defgroup firejail-mode ()
|
|
"Major mode for editing Firejail profiles."
|
|
:group 'programming
|
|
:prefix "firejail-")
|
|
|
|
(defcustom firejail-executable "firejail"
|
|
"Executable to use when calling firejail."
|
|
:tag "Executable"
|
|
:group 'firejail-mode
|
|
:type 'string)
|
|
|
|
(defcustom firejail-include-search-directories
|
|
'("./" "~/.config/firejail/" "/etc/firejail/" "/usr/local/etc/firejail/")
|
|
"List of directories to search for include files."
|
|
:tag "Include Search Directories"
|
|
:group 'firejail-mode
|
|
:type '(repeat string))
|
|
|
|
(defcustom firejail-include-search-suffixes
|
|
'("inc" "local" "profile")
|
|
"List of file suffixes to use when searching for include files.
|
|
These should _NOT_ have a leading period."
|
|
:tag "Include Search Suffixes"
|
|
:group 'firejail-mode
|
|
:type '(repeat string))
|
|
|
|
(defcustom firejail-include-ignored-files
|
|
'(".git/")
|
|
"List of file names that should be ignored when searching for include files.
|
|
These should end with a slash (/) if their are a directory."
|
|
:tag "Include Ignored Files"
|
|
:group 'firejail-mode
|
|
:type '(repeat string))
|
|
|
|
(defface firejail-error-face
|
|
'((t :background "red"))
|
|
"Face for reporting Firejail syntax errors."
|
|
:tag "Error Face"
|
|
:group 'firejail-mode)
|
|
|
|
(defun firejail--debug-output-to-list (&rest args)
|
|
"Convert the output from one of Firejail's --debug-* commands to a list.
|
|
ARGS are passed uncaged to Firejail and should include the proper debug command."
|
|
(ignore-error file-missing
|
|
(mapcan (lambda (line)
|
|
(when (string-match (rx "- " (group (+ any)) eol) line)
|
|
(list (match-string 1 line))))
|
|
(apply 'process-lines firejail-executable args))))
|
|
|
|
(defconst firejail--known-caps
|
|
(firejail--debug-output-to-list "--debug-caps")
|
|
"A list of known Linux capabilities.
|
|
This will probably be empty on anything but Linux.")
|
|
|
|
(defconst firejail--known-syscalls64
|
|
(firejail--debug-output-to-list "--debug-syscalls")
|
|
"A list of known 64 bit system calls.
|
|
This will probably be empty on anything by Linux.")
|
|
|
|
(defconst firejail--known-syscalls32
|
|
(firejail--debug-output-to-list "--debug-syscalls32")
|
|
"A list of known system 32 bit calls.
|
|
This will probably be empty on anything by Linux.")
|
|
|
|
(defconst firejail--known-errnos
|
|
(firejail--debug-output-to-list "--debug-errnos")
|
|
"A list of known system 32 bit calls.
|
|
This will probably be empty on anything by Linux.")
|
|
|
|
(defconst firejail--known-conditionals
|
|
'("HAS_APPIMAGE" "HAS_NET" "HAS_NODBUS" "HAS_NOSOUND" "HAS_PRIVATE"
|
|
"HAS_X11" "ALLOW_TRAY" "BROWSER_DISABLE_U2F" "BROWSER_ALLOW_DRM")
|
|
"List of conditionals known to Firejail.")
|
|
|
|
(defun firejail--list-dbus-services (bus)
|
|
"List all DBus services on BUS.
|
|
BUS is one of `:system' or `:session'."
|
|
(ignore-errors
|
|
(require 'dbus nil t)
|
|
(when (fboundp 'dbus-call-method) ;; silence byte compiler
|
|
(dbus-call-method bus "org.freedesktop.DBus" "/org/freedesktop/DBus"
|
|
"org.freedesktop.DBus" "ListNames"))))
|
|
|
|
(defun firejail--insert-entire-special-file (file)
|
|
"Insert all of FILE (e.g. /proc/cpuinfo), even if it's special."
|
|
(while (>= (cl-second (insert-file-contents file nil (1- (point))
|
|
(+ (point) 9999)))
|
|
10000)
|
|
(goto-char (point-max))))
|
|
|
|
(defvar-local firejail--num-cpus-cache nil
|
|
"The number of CPUs the current system has.
|
|
This might be nil on platforms other than Linux.")
|
|
|
|
(defun firejail--get-num-cpus ()
|
|
"Return the number of CPUs the current system has."
|
|
(if (local-variable-p 'firejail--num-cpus-cache)
|
|
firejail--num-cpus-cache
|
|
(ignore-error file-missing
|
|
(with-temp-buffer
|
|
(firejail--insert-entire-special-file "/proc/cpuinfo")
|
|
(goto-char (point-max))
|
|
(when (re-search-backward (rx bol "processor" blank ":" blank
|
|
(group (+ digit)) eol))
|
|
(setq firejail--num-cpus-cache
|
|
(string-to-number (match-string-no-properties 1))))))))
|
|
|
|
(defun firejail--find-next-glob-char (limit)
|
|
"Find the next glob char between point and LIMIT."
|
|
(let ((max-lisp-eval-depth 10000))
|
|
(when (search-forward "*" limit t)
|
|
(backward-char)
|
|
(if (not (eq t (nth 5 (syntax-ppss))))
|
|
(progn
|
|
(looking-at (regexp-quote "*"))
|
|
(forward-char)
|
|
t)
|
|
(forward-char)
|
|
(firejail--find-next-glob-char limit)))))
|
|
|
|
(defun firejail--generate-documentation-table ()
|
|
"Parse the firejail-profile(5) man page to get a documentation table."
|
|
(ignore-error file-missing
|
|
(let ((path (car (process-lines-handling-status
|
|
manual-program (lambda (status)
|
|
(when (not (zerop status))
|
|
(signal 'file-missing "")))
|
|
"-w" "firejail-profile")))
|
|
(ht (make-hash-table)))
|
|
(with-temp-buffer
|
|
;; Emacs will auto unzip this if needed
|
|
(insert-file-contents path)
|
|
(when (re-search-forward (rx bol ".TP\n"
|
|
bol "\\fBinclude other.profile" eol)
|
|
nil t)
|
|
(forward-line -1)
|
|
(while (and (not (looking-at-p (rx bol ".SH FILES" eol)))
|
|
(re-search-forward (rx bol ".TP\n" bol
|
|
"\\fB" (group
|
|
(+ (not (any "\n" blank)))))
|
|
nil t))
|
|
(let ((name (intern (match-string-no-properties 1)))
|
|
(start (+ 3 (pos-bol))))
|
|
(when (re-search-forward (rx bol ".TP" eol) nil t)
|
|
(forward-line -1)
|
|
(when (looking-at-p (rx bol eol))
|
|
(forward-line -1))
|
|
(let* ((raw-doc (buffer-substring-no-properties
|
|
start (pos-eol)))
|
|
(new-doc (replace-regexp-in-string (rx bol ".br" eol)
|
|
"\n" raw-doc))
|
|
(cur-doc (gethash name ht)))
|
|
(puthash name (concat cur-doc
|
|
(when cur-doc "\n\n")
|
|
new-doc)
|
|
ht)))))))
|
|
;; some manual fixing
|
|
(cl-macrolet ((summary (dir text)
|
|
`(let ((old-val (gethash ',dir ht)))
|
|
(puthash ',dir (concat (symbol-name ',dir) "\n"
|
|
,text (when old-val "\n\n")
|
|
old-val)
|
|
ht))))
|
|
(summary net "Enable a new network namespace.")
|
|
(summary bind "Mount bind directories or files."))
|
|
ht)))
|
|
|
|
(defvar-local firejail--documentation-table nil
|
|
"Table mapping Firejail directives to their documentation.")
|
|
|
|
(defun firejail--documentation-for (dir)
|
|
"Lookup the documentation for DIR."
|
|
(unless firejail--documentation-table
|
|
(setq firejail--documentation-table
|
|
(firejail--generate-documentation-table)))
|
|
(gethash (intern-soft dir) firejail--documentation-table))
|
|
|
|
(defconst firejail-profile-font-lock-keywords
|
|
(let* ((cond-rx (rx (* space) "?" (group (* (any alnum "_"))) (? ":")))
|
|
(ignore-rx (rx (group (+ (* space) bow "ignore"))))
|
|
(prefix-rx (rx bol (? (regexp cond-rx)) (? (regexp ignore-rx))
|
|
(* space)))
|
|
kwds)
|
|
(cl-flet ((add (dirs &optional opts (face 'font-lock-keyword-face))
|
|
(push (list
|
|
(rx (regexp prefix-rx)
|
|
bow (regexp (regexp-opt (ensure-list dirs) t)) eow
|
|
(* space)
|
|
(? (regexp (regexp-opt (ensure-list opts) t)) eow))
|
|
'(1 font-lock-builtin-face nil t)
|
|
'(2 font-lock-keyword-face nil t)
|
|
'(3 font-lock-keyword-face)
|
|
`(4 ,face nil t))
|
|
kwds))
|
|
(add-many (dirs opts &optional (face 'font-lock-keyword-face))
|
|
(push (list
|
|
(rx (regexp prefix-rx)
|
|
bow (regexp (regexp-opt (ensure-list dirs) t)) eow)
|
|
'(1 font-lock-builtin-face nil t)
|
|
'(2 font-lock-keyword-face nil t)
|
|
'(3 font-lock-keyword-face)
|
|
`(,(rx bow (regexp (regexp-opt opts t)) eow)
|
|
nil nil (0 ,face)))
|
|
kwds)))
|
|
;; NOTE the order below matters
|
|
;; glob asterisk
|
|
(push '("*" 0 'bold append) kwds)
|
|
;; invalid characters
|
|
(push `(,(rx (or "\"" "\\")) 0 'firejail-error-face t) kwds)
|
|
;; variables
|
|
(push (list (rx "${" (+ (any alnum "_")) "}") 0
|
|
'font-lock-variable-name-face t)
|
|
kwds)
|
|
;; ignore
|
|
(push (list (rx bol (? (regexp cond-rx)) (regexp ignore-rx) eow)
|
|
2 'font-lock-keyword-face)
|
|
kwds)
|
|
;; conditional
|
|
(push (list (rx bol (regexp cond-rx) eow) 1 'font-lock-builtin-face) kwds)
|
|
;; can't have a conditional include or quiet
|
|
(push (list (rx bol (? (regexp ignore-rx)) (* space)
|
|
bow (group (or "include" "quiet")) eow)
|
|
2 'font-lock-keyword-face)
|
|
kwds)
|
|
;; directives
|
|
(add '("noblacklist" "nowhitelist" "blacklist" "blacklist-nolog" "bind"
|
|
"disable-mnt" "keep-config-pulse" "keep-dev-shm" "keep-var-tmp"
|
|
"mkdir" "mkfile" "noexec" "private" "private-bin" "private-cache"
|
|
"private-cwd" "private-dev" "private-etc" "private-home"
|
|
"private-lib" "private-opt" "private-srv" "private-tmp" "read-only"
|
|
"read-write" "tmpfs" "tracelog" "whitelist" "whitelist-ro"
|
|
"writable-etc" "writable-run-user" "writable-var"
|
|
"writable-var-log" "allow-debuggers" "apparmor" "caps" "caps.keep"
|
|
"caps.drop" "memory-deny-write-execute" "nonewprivs" "noprinters"
|
|
"noroot" "restrict-namespaces" "seccomp" "seccomp.32"
|
|
"seccomp.drop" "seccomp.32.drop" "seccomp.keep" "seccomp.32.keep"
|
|
"seccomp.block-secondary" "protocol" "xephyr-screen"
|
|
"dbus-system.own" "dbus-system.talk" "dbus-system.see"
|
|
"dbus-system.call" "dbus-system.broadcast" "dbus-user.own"
|
|
"dbus-user.talk" "dbus-user.see" "dbus-user.call"
|
|
"dbus-user.broadcast" "nodbus" "cpu" "nice" "rlimit-as"
|
|
"rlimit-cpu" "rlimit-fsize" "rlimit-nproc" "rlimit-nofile"
|
|
"rlimit-sigpending" "timeout" "allusers" "env" "ipc-namespace"
|
|
"keep-fd" "name" "no3d" "noautopulse" "nodvd" "nogroups" "noinput"
|
|
"nosound" "notv" "nou2f" "novideo" "machine-id" "defaultgw" "dns"
|
|
"hostname" "hosts-file" "x11" "dbus-system" "dbus-user" "ip" "ip6"
|
|
"iprange" "mac" "mtu" "net" "netfilter" "netfilter" "netlock"
|
|
"netmask" "netns" "veth-name" "deterministic-exit-code"
|
|
"deterministic-shutdown" "join-or-start"))
|
|
(add "caps.drop" "all")
|
|
(add '("net" "shell") "none")
|
|
(add '("dbus-system" "dbus-user") '("none" "filter"))
|
|
(add '("ip" "ip6") '("none" "dhcp"))
|
|
(add "x11" '("none" "xephyr" "xorg" "xpra" "xvfb"))
|
|
(add-many "restrict-namespaces" '("cgroup" "ipc" "net" "mnt"
|
|
"time" "user" "uts"))
|
|
(add-many "protocol" '("unix" "inet" "inet6" "netlink"
|
|
"packet" "bluetooth"))
|
|
(add-many '("caps.drop" "caps.keep")
|
|
firejail--known-caps 'font-lock-builtin-face)
|
|
(add-many '("seccomp" "seccomp.drop" "seccomp.keep")
|
|
firejail--known-syscalls64 'font-lock-builtin-face)
|
|
(add-many '("seccomp.32" "seccomp.32.drop" "seccomp.32.keep")
|
|
firejail--known-syscalls32 'font-lock-builtin-face)
|
|
(add "seccomp-error-action" '("kill" "log"))
|
|
(add "seccomp-error-action" firejail--known-errnos
|
|
'font-lock-builtin-face)
|
|
kwds))
|
|
"Highlight keywords for `firejail-profile-mode'.")
|
|
|
|
(defvar firejail-profile-syntax-table
|
|
(let ((syn-table (make-syntax-table)))
|
|
(modify-syntax-entry ?# "<" syn-table)
|
|
(modify-syntax-entry ?\n ">" syn-table)
|
|
(modify-syntax-entry ?\" "." syn-table)
|
|
(modify-syntax-entry ?\( "." syn-table)
|
|
(modify-syntax-entry ?\) "." syn-table)
|
|
(modify-syntax-entry ?\[ "." syn-table)
|
|
(modify-syntax-entry ?\] "." syn-table)
|
|
syn-table)
|
|
"Syntax table for `firejail-profile-mode'.")
|
|
|
|
(defconst firejail-profile--keyword-list
|
|
'("ignore" "include" "noblacklist" "nowhitelist" "blacklist" "blacklist-nolog"
|
|
"bind" "disable-mnt" "keep-config-pulse" "keep-dev-shm" "keep-var-tmp"
|
|
"mkdir" "mkfile" "noexec" "private" "private-bin" "private-cache"
|
|
"private-cwd" "private-dev" "private-etc" "private-home" "private-lib"
|
|
"private-opt" "private-srv" "private-tmp" "read-only" "read-write" "tmpfs"
|
|
"tracelog" "whitelist" "whitelist-ro" "writable-etc" "writable-run-user"
|
|
"writable-var" "writable-var-log" "allow-debuggers" "apparmor" "caps"
|
|
"caps.keep" "caps.drop" "memory-deny-write-execute" "nonewprivs"
|
|
"noprinters" "noroot" "restrict-namespaces" "seccomp" "seccomp.32"
|
|
"seccomp.drop" "seccomp.32.drop" "seccomp.keep" "seccomp.32.keep"
|
|
"seccomp.block-secondary" "seccomp-error-action" "protocol" "xephyr-screen"
|
|
"dbus-system.own" "dbus-system.talk" "dbus-system.see" "dbus-system.call"
|
|
"dbus-system.broadcast" "dbus-user.own" "dbus-user.talk" "dbus-user.see"
|
|
"dbus-user.call" "dbus-user.broadcast" "nodbus" "cpu" "nice" "rlimit-as"
|
|
"rlimit-cpu" "rlimit-fsize" "rlimit-nproc" "rlimit-nofile"
|
|
"rlimit-sigpending" "timeout" "allusers" "env" "ipc-namespace" "keep-fd"
|
|
"name" "no3d" "noautopulse" "nodvd" "nogroups" "noinput" "nosound" "notv"
|
|
"nou2f" "novideo" "machine-id" "defaultgw" "dns" "hostname" "hosts-file"
|
|
"x11" "dbus-system" "dbus-user" "ip" "ip6" "iprange" "mac" "mtu" "net"
|
|
"netfilter" "netfilter" "netlock" "netmask" "netns" "veth-name"
|
|
"deterministic-exit-code" "deterministic-shutdown" "join-or-start" "net"
|
|
"shell" "protocol")
|
|
"List of keywords used for `firejail-profile-capf'.")
|
|
|
|
(defun firejail--symlink-directory-p (symlink)
|
|
"Return non-nil if SYMLINK has a directory at the end of its chain."
|
|
(file-directory-p (file-truename symlink)))
|
|
|
|
(defun firejail--collect-includes (&optional relative-to)
|
|
"Return a list of files that the user is likely to want to include.
|
|
With RELATIVE-TO, return a list of files relative to each directory in it."
|
|
(let ((pat (concat "\\." (regexp-opt firejail-include-search-suffixes) "\\'"))
|
|
(buffer-file (file-name-nondirectory
|
|
(directory-file-name (buffer-file-name)))))
|
|
(seq-difference
|
|
(mapcan (lambda (dir)
|
|
(ignore-error file-missing
|
|
(cl-loop for (name type) in (directory-files-and-attributes dir)
|
|
when (or (and (eq t type)
|
|
(not (member name (list "." ".."))))
|
|
(and (stringp type)
|
|
(firejail--symlink-directory-p type)))
|
|
collect (concat name "/")
|
|
when (and (string-match-p pat name)
|
|
(not (equal name buffer-file))
|
|
(not (auto-save-file-name-p name))
|
|
(not (backup-file-name-p name)))
|
|
collect name)))
|
|
(or (ensure-list relative-to) firejail-include-search-directories))
|
|
firejail-include-ignored-files)))
|
|
|
|
(defun firejail--include-completion-table (current-input)
|
|
"Return completion table for file name based on CURRENT-INPUT.
|
|
The completion table contains just the last component. Therefore, the capf
|
|
should specify the START position of this table to be the first character after
|
|
the last slash (/) on the line. If none of that made sense, see the
|
|
documentation for `completion-at-point-functions'."
|
|
(if-let ((last-slash (cl-position ?/ current-input :from-end t))
|
|
(base (file-truename
|
|
(substring current-input 0 (1+ last-slash)))))
|
|
(let ((default-directory base))
|
|
(firejail--collect-includes default-directory))
|
|
(firejail--collect-includes)))
|
|
|
|
(defun firejail--guess-system-cfg-directory ()
|
|
"Guess the system config directory.
|
|
The return value will have a trailing slash."
|
|
(or (cl-find-if 'file-directory-p
|
|
'("/etc/firejail/" "/usr/local/etc/firejail/"))
|
|
"/etc/firejail/"))
|
|
|
|
(defun firejail--exec-path ()
|
|
"Parse the PATH environment variable.
|
|
Return a list of files."
|
|
(cl-loop for (dir . rest) = exec-path then rest
|
|
while rest ;; ignore last element
|
|
collect (file-name-as-directory dir)))
|
|
|
|
(defun firejail--parse-file-argument (arg)
|
|
"Parse ARG by resolving variables.
|
|
This will return a list. This is because the PATH variable has many directories
|
|
in it."
|
|
(if (string-match (rx "${" (group (or "HOME" "CFG" "PATH"
|
|
"RUNUSER")) "}" (? "/")) arg)
|
|
(let ((var (match-string 1 arg))
|
|
(rest (substring arg (match-end 0))))
|
|
(cond
|
|
((equal var "HOME")
|
|
(list (concat (expand-file-name "~/") rest)))
|
|
((equal var "CFG")
|
|
(list (concat (firejail--guess-system-cfg-directory) rest)))
|
|
((equal var "RUNUSER")
|
|
(list (concat (file-name-as-directory (getenv "XDG_RUNTIME_DIR"))
|
|
rest)))
|
|
((equal var "PATH")
|
|
(mapcar (lambda (elt)
|
|
(concat elt rest))
|
|
(firejail--exec-path)))))
|
|
(list arg)))
|
|
|
|
(defun firejail--file-completion-table (current-input &optional dir-only)
|
|
"Generate a completion table for files.
|
|
CURRENT-INPUT is the current text of the argument to complete. With DIR-ONLY,
|
|
only report directory completions."
|
|
(ignore-error file-missing
|
|
(let ((dir (if-let ((last-idx (cl-position ?/ current-input
|
|
:from-end t)))
|
|
(substring current-input 0 (1+ last-idx))
|
|
current-input)))
|
|
(cl-loop for (name type) in (directory-files-and-attributes dir)
|
|
when (or (and (eq t type)
|
|
(not (member name '("." ".."))))
|
|
(and (stringp type)
|
|
(firejail--symlink-directory-p type)))
|
|
collect (concat name "/")
|
|
unless (or type dir-only)
|
|
collect name))))
|
|
|
|
(defun firejail--move-over-string-chars (count)
|
|
"Move over COUNT characters, assuming the point is inside a string.
|
|
This may move over more than COUNT characters if the string contains escapes."
|
|
(cl-loop repeat count
|
|
do (cl-loop with read-buf = (string (char-after))
|
|
for read-val = (condition-case nil
|
|
(read (concat "\"" read-buf "\""))
|
|
(end-of-file))
|
|
until read-val
|
|
do (forward-char) and
|
|
do (setq read-buf (concat read-buf (string
|
|
(char-after))))
|
|
finally (forward-char)
|
|
finally return read-val)))
|
|
|
|
(defun firejail--complete-file-from-table (table-fn index args)
|
|
"Complete INDEX of ARGS using TABLE-FN.
|
|
TABLE-FN should be a function of one argument that takes the current arg and
|
|
returns a completion table for it."
|
|
(cl-destructuring-bind (start _end text) (nth index args)
|
|
(let* ((base (or (file-name-directory text) ""))
|
|
(table (funcall table-fn base)))
|
|
(list (+ start (length base)) (+ start (length text)) table))))
|
|
|
|
(defun firejail--complete-include (index args _directive)
|
|
"Complete an include directive's arg numbered INDEX of ARGS."
|
|
(firejail--complete-file-from-table #'firejail--include-completion-table
|
|
index args))
|
|
|
|
(defun firejail--complete-file (index args _directive)
|
|
"Complete file taking directive's arg numbered INDEX of ARGS."
|
|
(firejail--complete-file-from-table #'firejail--file-completion-table
|
|
index args))
|
|
|
|
(defun firejail--complete-directory (index args _directive)
|
|
"Complete directory taking directive's arg numbered INDEX of ARGS."
|
|
(firejail--complete-file-from-table #'(lambda (base)
|
|
(firejail--file-completion-table
|
|
base 'dironly))
|
|
index args))
|
|
|
|
(defvar-local firejail--relative-to-cache nil
|
|
"Cache for `firejail--complete-relative-to'.")
|
|
|
|
(defmacro firejail--complete-relative-to (dirs &optional no-absolute)
|
|
"Return a function that completes relative to DIRS.
|
|
With NO-ABSOLUTE, don't complete absolute file names."
|
|
(let ((index (make-symbol "index"))
|
|
(args (make-symbol "args"))
|
|
(directive (make-symbol "directive"))
|
|
(out (make-symbol "out"))
|
|
(idirs (make-symbol "dirs"))
|
|
(dir (make-symbol "dir"))
|
|
(adirname (make-symbol "adirname"))
|
|
(evaled-dirs (eval dirs t)))
|
|
`(lambda (,index ,args ,directive)
|
|
(unless firejail--relative-to-cache
|
|
(setq firejail--relative-to-cache (make-hash-table :test 'equal)))
|
|
(let ((,idirs (cl-remove-if-not #'file-directory-p
|
|
(ensure-list ',evaled-dirs)))
|
|
(,adirname (file-name-directory (cl-third (nth ,index ,args)))))
|
|
(if-let ((cache (gethash (cons ,adirname ,dirs)
|
|
firejail--relative-to-cache)))
|
|
cache
|
|
(let (,out)
|
|
(dolist (,dir ,idirs)
|
|
,(let ((stmt
|
|
`(let ((default-directory ,dir))
|
|
(push (firejail--complete-file ,index ,args
|
|
,directive)
|
|
,out))))
|
|
(if no-absolute
|
|
`(unless (file-name-absolute-p
|
|
(cl-third (nth ,index ,args)))
|
|
,stmt)
|
|
stmt)))
|
|
(puthash (cons ,adirname ,idirs)
|
|
(append (seq-take (car ,out) 2)
|
|
(list (seq-uniq (mapcan 'cl-third ,out))))
|
|
firejail--relative-to-cache)))))))
|
|
|
|
(defmacro firejail--complete-many-from-set (vals)
|
|
"Return a function to complete a multi-arg directive from VALS."
|
|
(let ((index (make-symbol "index"))
|
|
(args (make-symbol "args"))
|
|
(directive (make-symbol "directive"))
|
|
(i (make-symbol "i"))
|
|
(arg (make-symbol "arg"))
|
|
(present (make-symbol "present"))
|
|
(evaled-vals (eval vals t)))
|
|
`(lambda (,index ,args ,directive)
|
|
(let ((,present (cl-loop for ,i upfrom 0
|
|
for ,arg in ,args
|
|
unless (= ,i ,index)
|
|
collect (cl-third ,arg))))
|
|
(append (seq-take (nth ,index ,args) 2)
|
|
(list (seq-difference ,evaled-vals ,present)))))))
|
|
|
|
(defun firejail--get-all-env-keys ()
|
|
"Return the name of every current environment variable."
|
|
(mapcar (lambda (elt)
|
|
(if-let ((sep (cl-position ?= elt)))
|
|
(substring elt 0 sep)
|
|
elt))
|
|
process-environment))
|
|
|
|
(defun firejail--complete-env (index args _directive)
|
|
"Complete the arg numbered INDEX in ARGS for an \"env\" directive."
|
|
(cl-destructuring-bind (start _end text) (nth index args)
|
|
(let ((sep-pos (or (cl-position ?= text) (length text))))
|
|
(when (<= (point) (+ start sep-pos))
|
|
(list start (+ start sep-pos) (firejail--get-all-env-keys))))))
|
|
|
|
(defconst firejail-profile--keyword-handlers
|
|
(let ((ht (make-hash-table :test 'equal)))
|
|
(cl-flet* ((complete (args fun dirs)
|
|
(dolist (arg (ensure-list (or args (list nil))))
|
|
(dolist (dir (ensure-list dirs))
|
|
(puthash (cons dir arg) fun ht))))
|
|
(complete-all (fun dirs)
|
|
(complete nil fun dirs)))
|
|
(complete 1 #'firejail--complete-include "include")
|
|
(complete 1 #'firejail--complete-file
|
|
'("whitelist" "nowhitelist" "blacklist" "noblacklist"
|
|
"blacklist-nolog" "noexec" "read-only" "read-write"
|
|
"whitelist-ro" "hosts-file"))
|
|
(complete 1 #'firejail--complete-directory
|
|
'("mkdir" "mkfile" "private" "private-cwd" "tmpfs"))
|
|
(complete '(1 2) #'firejail--complete-file "bind")
|
|
(complete-all (firejail--complete-relative-to
|
|
'("/bin" "/sbin" "/usr/bin" "/usr/sbin" "/usr/local/bin")
|
|
t)
|
|
"private-bin")
|
|
(complete-all (firejail--complete-relative-to '(getenv "HOME") t)
|
|
"private-home")
|
|
(complete-all (firejail--complete-relative-to "/lib" t)
|
|
"private-lib")
|
|
(complete-all (firejail--complete-relative-to "/etc" t)
|
|
"private-etc")
|
|
(complete-all (firejail--complete-relative-to "/opt" t)
|
|
"private-opt")
|
|
(complete-all (firejail--complete-relative-to "/srv" t)
|
|
"private-srv")
|
|
(complete-all (firejail--complete-many-from-set
|
|
;; evaluate at runtime
|
|
'firejail--known-caps)
|
|
"caps.keep")
|
|
(complete-all (firejail--complete-many-from-set
|
|
;; evaluate at runtime
|
|
'(cons "all" firejail--known-caps))
|
|
"caps.drop")
|
|
(complete-all (firejail--complete-many-from-set
|
|
''("unix" "inet" "inet6" "netlink" "packet" "bluetooth"))
|
|
"protocol")
|
|
(complete-all (firejail--complete-many-from-set
|
|
''("cgroup" "ipc" "mnt" "pid" "time" "user" "uts"))
|
|
"restrict-namespaces")
|
|
(complete-all (firejail--complete-many-from-set
|
|
'firejail--known-syscalls64)
|
|
'("seccomp" "seccomp.drop" "seccomp.keep" ))
|
|
(complete-all (firejail--complete-many-from-set
|
|
'firejail--known-syscalls32)
|
|
'("seccomp.32" "seccomp.32.drop" "seccomp.32.keep"))
|
|
(complete 1 (firejail--complete-many-from-set
|
|
'(firejail--list-dbus-services :system))
|
|
'("dbus-system" "dbus-system.own" "dbus-system.talk"
|
|
"dbus-system.see"))
|
|
(complete 1 (firejail--complete-many-from-set
|
|
'(firejail--list-dbus-services :session))
|
|
'("dbus-user" "dbus-user.own" "dbus-user.talk" "dbus-user.see"))
|
|
(complete 1 (firejail--complete-many-from-set
|
|
'(append '("kill" "log") firejail--known-errnos))
|
|
"seccomp-error-action")
|
|
(complete 1 (firejail--complete-many-from-set
|
|
''("none" "xephyr" "xorg" "xpra" "xvfb"))
|
|
"x11")
|
|
(complete 1 (firejail--complete-many-from-set
|
|
''("none" "filter"))
|
|
'("dbus-system" "dbus-user"))
|
|
(complete 1 (firejail--complete-many-from-set
|
|
''("none" "dhcp"))
|
|
'("ip" "ip6"))
|
|
(complete 1 (firejail--complete-many-from-set
|
|
''("none"))
|
|
'("net" "shell"))
|
|
(complete-all (firejail--complete-many-from-set
|
|
'(mapcar 'number-to-string
|
|
(number-sequence 0 (firejail--get-num-cpus))))
|
|
"cpu")
|
|
(complete 1 #'firejail--complete-env "env"))
|
|
ht)
|
|
"Hash table mapping firejail profile directives to their handler.
|
|
Each handler is a function of three arguments. The first is the index of the
|
|
current argument, the second is a list of the arguments, the third the
|
|
directive. These functions mustn't move the point. The point will be on the
|
|
first character of the argument. The keys of this table are a cons of a
|
|
directive and its argument number. The values are the completion functions.")
|
|
|
|
(defun firejail--quiet-allowed-p ()
|
|
"Return non-nil if the \"quiet\" directive is allowed on line under point."
|
|
(save-excursion
|
|
(let ((orig-line (line-number-at-pos)))
|
|
(goto-char (point-min))
|
|
(while (forward-comment 1))
|
|
(>= (line-number-at-pos) orig-line))))
|
|
|
|
(defun firejail--ignored-line-p ()
|
|
"Return non-nil if the line under point is an \"ignore\" directive.
|
|
Actually, return the position of the first character of the \"real\" directive."
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(when (looking-at (rx bol (* space) (? "?" (* (any alnum "_")) (? ":"))
|
|
(+ (* space) "ignore" eow) (or eol (+ space))
|
|
(group (* nonl)) eol))
|
|
(match-beginning 1))))
|
|
|
|
(defun firejail--read-next-arg ()
|
|
"Return the bounds of the next argument from the buffer starting at point.
|
|
This returns a list of four things, the first two are the start and end of the
|
|
current argument. The third is the text of the argument."
|
|
(skip-syntax-forward "-")
|
|
(looking-at (rx (group (* (not (any "\n" "," "#"))))
|
|
(* space) (or eol "," "#")))
|
|
(goto-char (match-end 0))
|
|
(when (eql ?# (char-before))
|
|
(backward-char))
|
|
(list (match-beginning 1) (match-end 1)
|
|
(match-string-no-properties 1)))
|
|
|
|
(defun firejail--has-more-args-p ()
|
|
"Return non-nil if there are probably more args beyond point on this line."
|
|
(save-excursion
|
|
(skip-syntax-forward "-")
|
|
(not (or (eobp) (memql (char-after) '(?\n ?#))))))
|
|
|
|
(defun firejail--multi-arg-directive-p (name)
|
|
"Return non-nil if NAME is a multi-argument directive."
|
|
(member name '("bind" "private-bin" "private-etc" "private-home"
|
|
"private-lib" "private-opt" "private-srv" "caps.drop"
|
|
"caps.keep" "protocol" "restrict-namespaces"
|
|
"seccomp" "seccomp.32" "seccomp.drop" "seccomp.32.drop"
|
|
"seccomp.keep" "seccomp.32.keep" "cpu" "iprange")))
|
|
|
|
(defun firejail--current-args (dir arg-start)
|
|
"Return a list of the text of each argument in the directive DIR under point.
|
|
ARG-START is the first character of the list of arguments."
|
|
(if (firejail--multi-arg-directive-p dir)
|
|
(append (save-excursion
|
|
(goto-char arg-start)
|
|
(cl-loop while (firejail--has-more-args-p)
|
|
collect (firejail--read-next-arg)))
|
|
(list (list (point) (point) "")))
|
|
(save-excursion
|
|
(goto-char arg-start)
|
|
(skip-syntax-forward "-")
|
|
(let ((eol (pos-eol)))
|
|
(list (list (point) eol
|
|
(buffer-substring-no-properties
|
|
(point) eol)))))))
|
|
|
|
(defun firejail--count-args (start end)
|
|
"Return the number of arguments between START and END."
|
|
(1+ (how-many "," start end)))
|
|
|
|
(defun firejail--complete-arguments (directive arg-start)
|
|
"Generate completions for the argument that the point is currently in.
|
|
DIRECTIVE is the directive to generate completions for. ARG-START is the first
|
|
argument character on the current line."
|
|
(let* ((cur-arg (if (firejail--multi-arg-directive-p directive)
|
|
(firejail--count-args arg-start (point))
|
|
1)))
|
|
(when-let ((handler (or (gethash (cons directive nil)
|
|
firejail-profile--keyword-handlers)
|
|
(gethash (cons directive cur-arg)
|
|
firejail-profile--keyword-handlers))))
|
|
(funcall handler (1- cur-arg)
|
|
(firejail--current-args directive arg-start)
|
|
directive))))
|
|
|
|
(defun firejail--line-conditional-p ()
|
|
"Return non-nil if the line under point begins with a conditional.
|
|
Actually, return a list of its bounds and the bounds of its name."
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(skip-syntax-forward "-")
|
|
(when (looking-at (rx (group "?" (group (* (any "_" alnum))) (? ":"))
|
|
(or eol (+ space) "#")))
|
|
(list (match-beginning 1) (match-end 1) (match-beginning 2)
|
|
(match-end 2)))))
|
|
|
|
(defun firejail--complete-conditional (start end)
|
|
"Complete the conditional around point.
|
|
START and END are the bounds of the name of the conditional."
|
|
(list start end '()))
|
|
|
|
(defun firejail-profile-capf ()
|
|
"Complete the Firejail profile directive at point."
|
|
(save-excursion
|
|
;; don't complete comments
|
|
(unless (nth 4 (syntax-ppss (point)))
|
|
(let ((start-pos (point)))
|
|
(back-to-indentation)
|
|
(let ((condition (firejail--line-conditional-p))
|
|
(ignored (firejail--ignored-line-p)))
|
|
(if (and condition (>= start-pos (cl-first condition))
|
|
(<= start-pos (cl-second condition)))
|
|
(list (cl-third condition) (cl-fourth condition)
|
|
;; is there already a '?'
|
|
(if (= (cl-second condition) (cl-fourth condition))
|
|
(mapcar (lambda (elt)
|
|
(concat elt ":"))
|
|
firejail--known-conditionals)
|
|
firejail--known-conditionals))
|
|
(cond
|
|
(ignored (goto-char ignored))
|
|
(condition
|
|
(goto-char (1+ (cl-second condition)))
|
|
(skip-syntax-forward "-")))
|
|
;; read the directive name
|
|
(looking-at (rx (group (* (not (any space "#" "\n"))))
|
|
(? (group space))))
|
|
(let ((directive-start (match-beginning 1))
|
|
(directive-end (match-end 1))
|
|
(arg-start (match-end 2)))
|
|
(if (and arg-start (>= start-pos arg-start))
|
|
(progn
|
|
(goto-char start-pos)
|
|
(firejail--complete-arguments
|
|
(buffer-substring-no-properties directive-start
|
|
directive-end)
|
|
arg-start))
|
|
(cond
|
|
((= directive-start directive-end)
|
|
(setq directive-start start-pos
|
|
directive-end start-pos))
|
|
((and (< start-pos directive-start)
|
|
(eql 2 (syntax-class (syntax-after (1- start-pos)))))
|
|
(save-excursion
|
|
(goto-char start-pos)
|
|
(forward-word -1)
|
|
(setq directive-start (point)
|
|
directive-end start-pos)))
|
|
((< start-pos directive-start)
|
|
(setq directive-start start-pos
|
|
directive-end start-pos)))
|
|
(list
|
|
directive-start directive-end
|
|
(append (when (and (not condition) (not ignored)
|
|
(firejail--quiet-allowed-p))
|
|
'("quiet"))
|
|
firejail-profile--keyword-list))))))))))
|
|
|
|
(defun firejail--directive-at-point ()
|
|
"Return the name of the directive at point."
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(when (looking-at (rx bol (* space)
|
|
(? "?" (* (any alnum "_")) (? ":")
|
|
(+ space))
|
|
(* "ignore" (+ space))
|
|
(group (+ (not (any space "\n" "#"))))))
|
|
(let ((name (match-string-no-properties 1)))
|
|
(unless (or (equal name "ignore")
|
|
(string-prefix-p "?" name)
|
|
(string-suffix-p ":" name))
|
|
name)))))
|
|
|
|
(defun firejail--read-next-sentence ()
|
|
"Return from point up to the next sentance end."
|
|
(let ((start (point))
|
|
(end (or (re-search-forward (rx eow "." (or " " eol))
|
|
nil t)
|
|
(point-max))))
|
|
(when (eql (char-before end) ? )
|
|
(cl-decf end)
|
|
(backward-char))
|
|
(cl-substitute ? ?\n (buffer-substring-no-properties
|
|
start end))))
|
|
|
|
(defun firejail--format-doc-string-and-get-summary (dir doc)
|
|
"Format DOC and get a summary for DIR.
|
|
Return a list of the formatted doc and a summary."
|
|
(with-temp-buffer
|
|
(insert doc)
|
|
(goto-char (point-min))
|
|
(forward-line)
|
|
(let ((summary (save-excursion
|
|
(firejail--read-next-sentence))))
|
|
(cl-loop for start = (point)
|
|
until (eobp) do
|
|
(forward-paragraph)
|
|
(fill-region-as-paragraph start (point))
|
|
(forward-line)
|
|
when (looking-at-p (rx bol (literal dir) (or eol " ")))
|
|
do (forward-line))
|
|
(goto-char (point-min))
|
|
(replace-regexp-in-region (rx (>= 3 "\n")) "\n\n")
|
|
(replace-regexp-in-region (rx eow "." (+ blank)) ". ")
|
|
(while (re-search-forward (rx ":" eol) nil t)
|
|
(forward-line)
|
|
(while (and (not (eobp))
|
|
(not (char-uppercase-p (char-after))))
|
|
(if (= (pos-bol) (pos-eol))
|
|
(delete-char 1)
|
|
(insert " ")
|
|
(forward-line)))
|
|
(unless (eobp)
|
|
(insert "\n")))
|
|
(list (buffer-string) summary))))
|
|
|
|
(defun firejail-eldoc-documentation-function (callback &rest _args)
|
|
"Call CALLBACK with the documentation of the directive under point."
|
|
(save-excursion
|
|
(when-let ((name (firejail--directive-at-point))
|
|
(doc (firejail--documentation-for name)))
|
|
(cl-destructuring-bind (clean-doc summary)
|
|
(firejail--format-doc-string-and-get-summary name doc)
|
|
(funcall callback clean-doc `(:thing ,name
|
|
:echo ,summary))))))
|
|
|
|
(defvar-keymap firejail-profile-mode-map
|
|
:doc "Keymap for `firejail-profile-mode'."
|
|
:parent prog-mode-map
|
|
"C-c C-o" #'ff-find-other-file)
|
|
|
|
(define-derived-mode firejail-profile-mode prog-mode "Firejail-Profile"
|
|
"Major mode for editing firejail profiles."
|
|
:group 'firejail-mode
|
|
:syntax-table firejail-profile-syntax-table
|
|
(add-to-list (make-local-variable 'completion-at-point-functions)
|
|
#'firejail-profile-capf)
|
|
(setq-local font-lock-defaults '(firejail-profile-font-lock-keywords)
|
|
comment-start "#"
|
|
comment-end ""
|
|
electric-pair-pairs '((?{ . ?}))
|
|
ff-search-directories firejail-include-search-directories
|
|
ff-other-file-alist '(("\\.local\\'" (".profile"))
|
|
("\\.profile\\'" (".local")))
|
|
eldoc-documentation-functions
|
|
'(firejail-eldoc-documentation-function
|
|
t)))
|
|
|
|
(add-to-list 'auto-mode-alist
|
|
'("\\.\\(firejail\\|profile\\|local\\|inc\\)\\'" . firejail-profile-mode))
|
|
|
|
(provide 'firejail-mode)
|
|
;;; firejail-mode.el ends here
|
|
|
|
;; Local Variables:
|
|
;; jinx-local-words: "Firejail Firejail's"
|
|
;; End:
|