diff --git a/elisp/firejail-mode.el b/elisp/firejail-mode.el index 1d4b497..78430b4 100644 --- a/elisp/firejail-mode.el +++ b/elisp/firejail-mode.el @@ -2,124 +2,817 @@ ;;; 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* ((normal '("quiet" "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" - "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")) - (take-all-list '("caps.drop")) - (take-none-list '("shell" "net")) - (comment-rx '("^.*\\(#.*\\)$" 1 font-lock-comment-face)) - (dbus-system-user-rx '("^ *\\(\\?[A-Z_]+: +\\)?\ -\\(\\(ignore +\\)?\ -dbus-\\(system\\|user\\) +\\(none\\|filter\\)?\\)" . 2)) - (x11-rx '("^ *\\(?:\\?[A-Z_]+: +\\)?\ -\\(\\(?:ignore +\\)?x11 +\\(?:none\\|xephyr\\|xorg\\|xpra\\|xvfb\\)?\\)" . 1)) - (ip-ip6-rx '("^ *\\(\\?[A-Z_]+: +\\)?\ -\\(\\(ignore +\\)?ip6? +\\(none\\|dhcp\\)\\)" . 2)) - (take-all `(,(concat (regexp-opt take-all-list "^ *\\(\\?[A-Z_]+: +\\)?\ -\\(\\(ignore +\\)?\\<\\(") "\\>\\)") - (2 font-lock-keyword-face) - ("\\" nil nil (0 font-lock-keyword-face)))) - (take-none `(,(concat (regexp-opt take-none-list "^ *\\(\\?[A-Z_]+: +\\)?\ -\\(\\(ignore +\\)?\\<\\(") "\\>\\)") - (2 font-lock-keyword-face) - ("\\" nil nil (0 font-lock-keyword-face)))) - (protocol '("^ *\\(\\?A+: +\\)?\ -\\(\\(ignore +\\)?\\\\)" (2 font-lock-keyword-face) -("\\" nil nil (0 font-lock-keyword-face)) -("\\" nil nil (0 font-lock-keyword-face)) -("\\" nil nil (0 font-lock-keyword-face)) -("\\" nil nil (0 font-lock-keyword-face)) -("\\" nil nil (0 font-lock-keyword-face)) -("\\" nil nil (0 font-lock-keyword-face)))) - (variable-rx '("\\${[A-Za-z_]*}" 0 font-lock-variable-name-face)) - (normal-rx `(,(concat (regexp-opt normal "^ *\\(\\?[A-Z_]+: +\\)?\ -\\(\\(ignore +\\)?\\<\\(") "\\>\\)") . 2))) - (list comment-rx x11-rx ip-ip6-rx take-all take-none protocol - dbus-system-user-rx normal-rx variable-rx - '("^ *\\(\\?[A-Z_]+: +\\)?\\(\\\\)" . 2))) + (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 - '("quiet" "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" "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" + '("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" "ignore" - "deterministic-shutdown" "join-or-start" "net" "shell" "protocol") + "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))))))) + +(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")) + 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." - (if-let ((word-bounds (bounds-of-thing-at-point 'word))) - (cl-loop for kwd in firejail-profile--keyword-list - with word-at-point = (buffer-substring-no-properties - (car word-bounds) - (cdr word-bounds)) - when (string-prefix-p word-at-point kwd) - collect kwd into candidates - finally return (list (car word-bounds) - (cdr word-bounds) - candidates)) - (list (point) - (point) - firejail-profile--keyword-list))) + "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'." @@ -128,22 +821,27 @@ dbus-\\(system\\|user\\) +\\(none\\|filter\\)?\\)" . 2)) (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 "" - ff-search-directories - ;; the map page firejail-profile(5) seems to suggest that this - ;; does _NOT_ respect $XDG_CONFIG_HOME - `("." "~/.config/firejail" "/etc/firejail" - "/usr/share/etc/firejail") + electric-pair-pairs '((?{ . ?})) + ff-search-directories firejail-include-search-directories ff-other-file-alist '(("\\.local\\'" (".profile")) - ("\\.profile\\'" (".local"))))) + ("\\.profile\\'" (".local"))) + eldoc-documentation-functions + '(firejail-eldoc-documentation-function + t))) (add-to-list 'auto-mode-alist - '("\\.\\(firejail\\|profile\\|local\\)$" . firejail-profile-mode)) + '("\\.\\(firejail\\|profile\\|local\\|inc\\)\\'" . firejail-profile-mode)) (provide 'firejail-mode) ;;; firejail-mode.el ends here + +;; Local Variables: +;; jinx-local-words: "Firejail Firejail's" +;; End: