emacs-config/elisp/firejail-mode.el

;;; 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-hook 'completion-at-point-functions #'firejail-profile-capf nil t)
  (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: