mevedel-bash-analysis.el

;;; mevedel-bash-analysis.el --- Conservative Bash analysis -*- lexical-binding: t -*-

;;; Commentary:

;; Produces normalized facts for Bash permission decisions.  A configured
;; Bash Tree-sitter grammar supplies structured parsing when available; a
;; deliberately small scanner provides the same conservative contract when it
;; is not.  This module classifies syntax and commands but grants no authority.

;;; Code:

(eval-when-compile
  (require 'cl-lib)
  (require 'subr-x))

;; `mevedel-bash-policy'
(declare-function mevedel-bash-policy-read-only-p
                  "mevedel-bash-policy" (argv))

;; `shell'
(defvar shell-file-name-quote-list)

;; `treesit'
(declare-function treesit-language-available-p "treesit" (language &optional detail))
(declare-function treesit-node-check "treesit" (node property))
(declare-function treesit-node-child "treesit" (node n &optional named))
(declare-function treesit-node-child-count "treesit" (node &optional named))
(declare-function treesit-node-text "treesit" (node &optional no-property))
(declare-function treesit-node-type "treesit" (node))
(declare-function treesit-parser-create "treesit" (language &optional buffer no-reuse tag))
(declare-function treesit-parser-root-node "treesit" (parser))


;;
;;; Customization

(defcustom mevedel-bash-dangerous-commands
  '("rm" "sudo" "dd" "mkfs" "fdisk" "parted"
    "chmod" "chown" "chgrp" "chattr"
    "kill" "pkill" "killall"
    "curl" "wget" "nc" "ncat" "telnet"
    "ssh" "scp" "rsync" "sftp"
    "iptables" "systemctl" "service"
    "reboot" "shutdown" "poweroff" "halt")
  "Command names classified as dangerous.
This classification is advisory input to permission policy.  Explicit direct
user authority may still permit a matching command."
  :type '(repeat string)
  :group 'mevedel)

(defconst mevedel-bash-analysis--allowed-node-types
  '("program" "list" "pipeline" "command" "command_name" "word"
    "string" "string_content" "raw_string" "number" "concatenation"
    "variable_assignment" "variable_name"
    "test_command" "binary_expression" "unary_expression" "test_operator"
    "&&" "||" ";" "|" "\"" "'" "[" "]" "=" "!=")
  "Tree-sitter Bash node types accepted as plain command syntax.

A `VAR=value cmd' prefix and a single-bracket `[ ... ]' test are plain
commands to the conservative scanner, so the grammar has to read them the same
way -- otherwise installing the grammar reclassifies them as complex and the
two analyzers disagree about the same string.  Double-bracket `[[ ... ]]' is
deliberately absent: it changes quoting and globbing, so it stays complex
alongside negation and pattern operators.")

(defconst mevedel-bash-analysis--treesit-command-node-types
  '("command" "test_command")
  "Tree-sitter Bash node types whose whole text is one command.")

(defconst mevedel-bash-analysis--control-words
  '("case" "coproc" "do" "done" "elif" "else" "esac" "fi" "for"
    "function" "if" "in" "select" "then" "time" "until" "while")
  "Shell control-flow words rejected by the fallback parser.")

(defun mevedel-bash-analysis--split-command (source)
  "Split SOURCE using Bash quoting rules on every platform."
  (require 'shell)
  (let ((shell-file-name-quote-list
         '(?\| ?& ?< ?> ?\( ?\) ?\; ?\s ?$ ?* ?! ?\" ?' ?` ?# ?\\)))
    (split-string-shell-command source)))


;;
;;; Shared facts

(defun mevedel-bash-analysis--command-name (argv)
  "Return the normalized executable name from ARGV."
  (when-let* ((word (car argv)))
    (file-name-nondirectory word)))

(defun mevedel-bash-analysis--dangerous-p (commands source)
  "Return non-nil when COMMANDS or best-effort tokens in SOURCE are dangerous."
  (or (cl-some
       (lambda (argv)
         (member (mevedel-bash-analysis--command-name argv)
                 mevedel-bash-dangerous-commands))
       commands)
      (cl-some
       (lambda (name)
         (string-match-p
          (concat "\\(?:\\`\\|[^[:alnum:]_-]\\)"
                  (regexp-quote name)
                  "\\(?:\\'\\|[^[:alnum:]_-]\\)")
          source))
       mevedel-bash-dangerous-commands)))

(defun mevedel-bash-analysis--path-like-p (word)
  "Return non-nil when WORD is a literal path-like shell token."
  (and (not (string-prefix-p "-" word))
       (not (string-match-p "[$*?`{}]\\|\\[\\|\\]" word))
       (or (member word '("." ".."))
           (string-prefix-p "/" word)
           (string-prefix-p "./" word)
           (string-prefix-p "../" word)
           (string-prefix-p "~/" word)
           (string-match-p "/" word))))

(defun mevedel-bash-analysis--source-resources (source)
  "Return best-effort literal path resources visible in SOURCE.
This intentionally does not evaluate expansions.  Its purpose is to preserve
protected-path checks even when unsupported syntax prevents argv extraction."
  (let (resources)
    (dolist (fragment
             (cons source (mevedel-bash-analysis--substitution-fragments source)))
      (let ((words (condition-case nil
                       (mevedel-bash-analysis--split-command fragment)
                     (error (split-string fragment "[[:space:]]+" t)))))
        (dolist (raw words)
          (let ((word raw))
            (setq word (replace-regexp-in-string
                        "\\`[0-9]*\\(?:<<-?\\|<>\\|>>\\|>\\|<\\)" "" word))
            (setq word (replace-regexp-in-string "\\`[('\\\"]+" "" word))
            (setq word (replace-regexp-in-string "[)'\\\";|&]+\\'" "" word))
            (when (mevedel-bash-analysis--path-like-p word)
              (push word resources))))))
    (delete-dups (nreverse resources))))

(defun mevedel-bash-analysis--resources (commands source)
  "Return literal path-like arguments identified in COMMANDS and SOURCE."
  (let (resources)
    (dolist (argv commands)
      (dolist (word (cdr argv))
        (when (mevedel-bash-analysis--path-like-p word)
          (push word resources))))
    (delete-dups
     (append (nreverse resources)
             (mevedel-bash-analysis--source-resources source)))))

(defun mevedel-bash-analysis--assignment-word-p (word)
  "Return non-nil when WORD begins with a Bash assignment name."
  (and word
       (string-match-p "\\`[A-Za-z_][A-Za-z0-9_]*\\+?=" word)))

(defun mevedel-bash-analysis--normalize-line-continuations (source)
  "Remove Bash line continuations from SOURCE outside single quotes."
  (let ((index 0)
        quote
        escaped
        output)
    (while (< index (length source))
      (let ((char (aref source index))
            (next (and (< (1+ index) (length source))
                       (aref source (1+ index)))))
        (cond
         ((eq quote ?')
          (push char output)
          (when (eq char ?')
            (setq quote nil)))
         (escaped
          (push char output)
          (setq escaped nil))
         ((and (eq char ?\\) (eq next ?\n))
          (setq index (1+ index)))
         ((eq char ?\\)
          (push char output)
          (setq escaped t))
         ((eq quote ?\")
          (push char output)
          (when (eq char ?\")
            (setq quote nil)))
         (t
          (push char output)
          (when (memq char '(?' ?\"))
            (setq quote char)))))
      (setq index (1+ index)))
    (apply #'string (nreverse output))))

(defun mevedel-bash-analysis--substitution-end (source start)
  "Return the end index of command substitution in SOURCE after START.
START points immediately after the opening `$(' token.  Parentheses inside
quotes or escaped with a backslash do not close the substitution."
  (let ((depth 1)
        (index start)
        quote
        escaped)
    (while (and (< index (length source)) (> depth 0))
      (let ((char (aref source index))
            (next (and (< (1+ index) (length source))
                       (aref source (1+ index)))))
        (cond
         (escaped
          (setq escaped nil))
         ((and (eq char ?\\) (not (eq quote ?')))
          (setq escaped t))
         ((eq quote ?')
          (when (eq char ?')
            (setq quote nil)))
         ((eq quote ?`)
          (when (eq char ?`)
            (setq quote nil)))
         ((eq quote ?\")
          (cond
           ((eq char ?\")
            (setq quote nil))
           ((and (eq char ?$) (eq next ?\())
            (when-let* ((nested-end
                         (mevedel-bash-analysis--substitution-end
                          source (+ index 2))))
              (setq index (1- nested-end))))))
         ((and (eq char ?$) (eq next ?\())
          (when-let* ((nested-end
                       (mevedel-bash-analysis--substitution-end
                        source (+ index 2))))
            (setq index (1- nested-end))))
         ((memq char '(?' ?\" ?`))
          (setq quote char))
         ((eq char ?\()
          (setq depth (1+ depth)))
         ((eq char ?\))
          (setq depth (1- depth)))))
      (setq index (1+ index)))
    (and (= depth 0) index)))

(defun mevedel-bash-analysis--substitution-bodies (source)
  "Return best-effort command substitution bodies found in SOURCE."
  (let ((index 0)
        quote
        escaped
        bodies)
    (while (< index (length source))
      (let ((char (aref source index))
            (next (and (< (1+ index) (length source))
                       (aref source (1+ index))))
            (after-next (and (< (+ index 2) (length source))
                             (aref source (+ index 2)))))
        (cond
         (escaped
          (setq escaped nil))
         ((and (eq char ?\\) (not (eq quote ?')))
          (setq escaped t))
         ((and (eq char ?') (not (eq quote ?\")))
          (setq quote (unless (eq quote ?') ?')))
         ((and (eq char ?\") (not (eq quote ?')))
          (setq quote (unless (eq quote ?\") ?\")))
         ((eq quote ?'))
         ((and (eq char ?$) (eq next #x28) (not (eq after-next #x28)))
          (let* ((start (+ index 2))
                 (end (mevedel-bash-analysis--substitution-end source start)))
            (when end
              (push (substring source start (1- end)) bodies)
              (setq index (1- end)))))
         ((eq char ?`)
          (let ((start (1+ index))
                (search (1+ index))
                body-escaped
                end)
            (while (and (< search (length source)) (not end))
              (let ((body-char (aref source search)))
                (cond
                 (body-escaped (setq body-escaped nil))
                 ((eq body-char ?\\) (setq body-escaped t))
                 ((eq body-char ?`) (setq end search))))
              (setq search (1+ search)))
            (when end
              (push (string-replace "\\`" "`"
                                    (substring source start end))
                    bodies)
              (setq index end)))))
        (setq index (1+ index))))
    (let (expanded)
      (dolist (body (nreverse bodies))
        (push body expanded)
        (dolist (nested (mevedel-bash-analysis--substitution-bodies body))
          (push nested expanded)))
      (delete-dups (nreverse expanded)))))

(defun mevedel-bash-analysis--substitution-fragments (source)
  "Return substitution bodies and their command-chain segments from SOURCE."
  (let ((bodies (mevedel-bash-analysis--substitution-bodies source)))
    (append
     bodies
     (cl-mapcan
      (lambda (body)
        (car (mevedel-bash-analysis--scan-segments body)))
      bodies))))

(defun mevedel-bash-analysis--candidate-from-argv (argv)
  "Return a deny-policy candidate string from ARGV, or nil."
  (when argv
    (let ((normalized (copy-sequence argv)))
      (setcar normalized (file-name-nondirectory (car normalized)))
      (string-join normalized " "))))

(defun mevedel-bash-analysis--candidate-command (fragment)
  "Return a normalized possible command from FRAGMENT, or nil."
  (let ((candidate (string-trim fragment)))
    (setq candidate (replace-regexp-in-string "\\`[({[:space:]]+" "" candidate))
    (setq candidate (replace-regexp-in-string "[)}[:space:]]+\\'" "" candidate))
    (let ((argv (condition-case nil
                    (mevedel-bash-analysis--split-command candidate)
                  (error nil))))
      (while (and argv
                  (mevedel-bash-analysis--assignment-word-p (car argv)))
        (setq argv (cdr argv)))
      (when (member (car argv) '("then" "do" "else" "elif"))
        (setq argv (cdr argv)))
      (while (member (car argv) '("!" "time"))
        (let ((prefix (pop argv)))
          (when (and (equal prefix "time")
                     (equal (car argv) "-p"))
            (setq argv (cdr argv)))))
      (mevedel-bash-analysis--candidate-from-argv argv))))

(defun mevedel-bash-analysis--candidates (source segments commands)
  "Return best-effort command forms from SOURCE, SEGMENTS, and COMMANDS."
  (let* ((fragments
          (append segments
                  (mevedel-bash-analysis--substitution-fragments source)))
         candidates)
    (dolist (fragment fragments)
      (when-let* ((candidate
                   (mevedel-bash-analysis--candidate-command fragment)))
        (push candidate candidates)))
    (dolist (argv commands)
      (push (mevedel-bash-analysis--candidate-from-argv argv) candidates))
    (delete-dups (delq nil (nreverse candidates)))))

(defun mevedel-bash-analysis--classify (commands complex-p source)
  "Classify COMMANDS and COMPLEX-P for SOURCE."
  (cond
   ((mevedel-bash-analysis--dangerous-p commands source) 'dangerous)
   (complex-p 'complex)
   ((and commands
         (progn
           (require 'mevedel-bash-policy)
           (cl-every #'mevedel-bash-policy-read-only-p commands)))
    'read-only)
   (t 'unknown)))

(defun mevedel-bash-analysis--result
    (source parser segments commands complex-p reasons)
  "Build normalized analysis for SOURCE from PARSER, SEGMENTS, and COMMANDS."
  (let* ((class (mevedel-bash-analysis--classify commands complex-p source))
         (background-p
          (cl-some
           (lambda (fragment)
             (member "Background execution is unsupported"
                     (cadr (mevedel-bash-analysis--scan-segments fragment))))
           (cons source (mevedel-bash-analysis--substitution-bodies source)))))
    (list :class class
          :complex-p (and complex-p t)
          :background-p (and background-p t)
          :commands commands
          :segments segments
          :candidates (mevedel-bash-analysis--candidates
                       source segments commands)
          :parser parser
          :resources (mevedel-bash-analysis--resources commands source)
          :reasons (or reasons
                       (list (pcase class
                               ('read-only "All commands have read-only policies")
                               ('dangerous "A dangerous command was identified")
                               ('complex "The shell syntax is not supported")
                               (_ "No read-only command policy matched")))))))


;;
;;; Conservative scanner

(defun mevedel-bash-analysis--scan-segments (source)
  "Return (SEGMENTS REASONS) from SOURCE using the supported shell subset."
  (let ((segments nil)
        (current nil)
        (quote nil)
        (escaped nil)
        (reasons nil)
        (index 0)
        (length (length source)))
    (cl-labels ((finish-segment
                 ()
                 (let* ((segment
                         (string-trim (apply #'string (nreverse current))))
                        (candidate
                         (mevedel-bash-analysis--candidate-command segment)))
                   (when (and candidate
                              (string-match-p
                               "\\`coproc\\(?:[[:space:]]\\|\\'\\)"
                               candidate))
                     (push "Background execution is unsupported" reasons))
                   (if (string-empty-p segment)
                       (push "A command separator has an empty operand" reasons)
                     (push segment segments))
                   (setq current nil))))
      (while (< index length)
        (let* ((char (aref source index))
               (previous (and (> index 0) (aref source (1- index))))
               (next (and (< (1+ index) length)
                          (aref source (1+ index)))))
          (cond
           (escaped
            (push char current)
            (setq escaped nil))
           ((eq char ?\\)
            (push char current)
            (setq escaped t))
           ((and (eq char ?') (not (eq quote ?\")))
            (push char current)
            (setq quote (unless (eq quote ?') ?')))
           ((and (eq char ?\") (not (eq quote ?')))
            (push char current)
            (setq quote (unless (eq quote ?\") ?\")))
           (quote
            (when (and (eq quote ?\") (memq char '(?$ ?`)))
              (push "Expansion or substitution is unsupported" reasons))
            (push char current))
           ((or (and (eq char ?$) (eq next #x28)
                     (< (+ index 2) length)
                     (eq (aref source (+ index 2)) #x28))
                (and (eq char #x28) (eq next #x28)))
            (let ((start (if (eq char ?$) (+ index 2) (1+ index))))
              (push "Expansion or substitution is unsupported" reasons)
              (if-let* ((end
                         (mevedel-bash-analysis--substitution-end
                          source start)))
                  (progn
                    (dotimes (offset (- end index))
                      (push (aref source (+ index offset)) current))
                    (setq index (1- end)))
                (push char current))))
           ((and (eq char ?\[)
                 (or (null next) (memq next '(?\s ?\t)))
                 (string-match-p
                  "\\`[[:space:]]*\\'"
                  (apply #'string (reverse current))))
            (push char current))
           ((and (eq char ?\])
                 (memq previous '(?\s ?\t))
                 (let ((remaining
                        (string-trim-left (substring source (1+ index)))))
                   (or (string-empty-p remaining)
                       (string-prefix-p "&&" remaining)
                       (string-prefix-p "||" remaining)
                       (memq (aref remaining 0) '(?\; ?\| ?\n)))))
            (push char current))
           ((memq char '(?$ ?` ?< ?> ?\( ?\) ?{ ?} ?* ?? ?\[ ?\] ?!))
            (push "Expansion, substitution, grouping, or redirection is unsupported"
                  reasons)
            (push char current))
           ((eq char ?\n)
            (push "Newline command separation is unsupported" reasons)
            (finish-segment))
           ((and (eq char ?&) (eq next ?&))
            (finish-segment)
            (setq index (1+ index)))
           ((and (eq char ?&)
                 (or (memq previous '(?> ?< ?|))
                     (eq next ?>)))
            (push char current))
           ((eq char ?&)
            (push "Background execution is unsupported" reasons)
            (push char current))
           ((and (eq char ?|) (eq next ?|))
            (finish-segment)
            (setq index (1+ index)))
           ((eq char ?|)
            (finish-segment))
           ((eq char ?\;)
            (finish-segment))
           (t
            (push char current))))
        (setq index (1+ index)))
      (when quote
        (push "The command contains an unterminated quote" reasons))
      (when escaped
        (push "The command ends with an incomplete escape" reasons))
      (if current
          (finish-segment)
        (when (and segments
                   (string-match-p "\\(?:&&\\|||\\|[;|]\\)\\s-*\\'" source))
          (push "A command separator has an empty operand" reasons)))
      (list (nreverse segments) (delete-dups (nreverse reasons))))))

(defun mevedel-bash-analysis--argv (segments)
  "Return (COMMANDS REASONS) parsed from SEGMENTS."
  (let (commands reasons)
    (dolist (segment segments)
      (condition-case nil
          (let ((argv (mevedel-bash-analysis--split-command segment)))
            (cond
             ((null argv)
              (push "A command is empty" reasons))
             ((mevedel-bash-analysis--assignment-word-p (car argv))
              (push "Environment assignments are unsupported" reasons))
             ((member (car argv) mevedel-bash-analysis--control-words)
              (push "Shell control flow is unsupported" reasons))
             (t
              (push argv commands))))
        (error
         (push "The command could not be split into arguments" reasons))))
    (list (nreverse commands) (nreverse reasons))))

(defun mevedel-bash-analysis--heuristic (source)
  "Analyze SOURCE with the conservative scanner."
  (pcase-let* ((`(,segments ,scan-reasons)
                (mevedel-bash-analysis--scan-segments source))
               (`(,commands ,argv-reasons)
                (mevedel-bash-analysis--argv segments))
               (reasons (append scan-reasons argv-reasons)))
    (mevedel-bash-analysis--result
     source 'heuristic segments commands (not (null reasons)) reasons)))


;;
;;; Tree-sitter adapter

(defun mevedel-bash-analysis--treesit-supported-p (node)
  "Return non-nil when NODE contains only the supported Bash subset."
  (and (not (treesit-node-check node 'has-error))
       (member (treesit-node-type node)
               mevedel-bash-analysis--allowed-node-types)
       (let ((supported t)
             (index 0)
             (count (treesit-node-child-count node)))
         (while (and supported (< index count))
           (setq supported
                 (mevedel-bash-analysis--treesit-supported-p
                  (treesit-node-child node index)))
           (setq index (1+ index)))
         supported)))

(defun mevedel-bash-analysis--treesit-command-texts (node)
  "Return command source strings below NODE in source order.

A `test_command' is a command here too: it is one invocation with its own exit
status, and leaving it out would make `[ 1 = 2 ]' analyze as a program with no
commands at all."
  (if (member (treesit-node-type node)
              mevedel-bash-analysis--treesit-command-node-types)
      (list (treesit-node-text node t))
    (let (texts)
      (dotimes (index (treesit-node-child-count node))
        (setq texts
              (append texts
                      (mevedel-bash-analysis--treesit-command-texts
                       (treesit-node-child node index)))))
      texts)))

(defun mevedel-bash-analysis--treesit (source)
  "Analyze SOURCE with the configured Bash Tree-sitter grammar.

The conservative scanner runs alongside the grammar and keeps ownership of
the segments whenever the grammar rejects the program.  Discarding them
would leave `:segments', `:candidates', and `:resources' empty for every
unsupported construct, and those are the surfaces protected-path checks
and explicit deny rules match against: an environment assignment in front
of a denied command would otherwise present nothing to match."
  (require 'treesit)
  (with-temp-buffer
    (insert source)
    (pcase-let* ((`(,scan-segments ,scan-reasons)
                  (mevedel-bash-analysis--scan-segments source))
                 (newline-p
                  (member "Newline command separation is unsupported"
                          scan-reasons))
                 (parser (treesit-parser-create 'bash))
                 (root (treesit-parser-root-node parser))
                 (supported
                  (and (not newline-p)
                       (mevedel-bash-analysis--treesit-supported-p root)))
                 (segments
                  (if supported
                      (mevedel-bash-analysis--treesit-command-texts root)
                    scan-segments))
                 (`(,commands ,argv-reasons)
                  (mevedel-bash-analysis--argv segments))
                 (reasons (append
                           (unless supported
                             '("Tree-sitter found unsupported or invalid shell syntax"))
                           argv-reasons)))
      (mevedel-bash-analysis--result
       source 'treesit segments commands
       (or (not supported) (not (null reasons))) reasons))))


;;
;;; Public interface

;;;###autoload
(defun mevedel-bash-analysis-analyze (source)
  "Return normalized conservative Bash analysis for SOURCE.
The result contains `:class', `:commands', `:parser', `:resources', and
`:reasons'.  Tree-sitter is selected only through normal Emacs grammar
  configuration; no grammar path is added here."
  (require 'subr-x)
  (setq source (mevedel-bash-analysis--normalize-line-continuations source))
  (if (and (fboundp 'treesit-language-available-p)
           (treesit-language-available-p 'bash))
      (condition-case _err
          (mevedel-bash-analysis--treesit source)
        (error
         (let ((result (mevedel-bash-analysis--heuristic source)))
           (plist-put result :reasons
                      (cons "Tree-sitter analysis failed; used conservative fallback"
                            (plist-get result :reasons))))))
    (mevedel-bash-analysis--heuristic source)))

(provide 'mevedel-bash-analysis)

;;; mevedel-bash-analysis.el ends here