Categories
Uncategorized

Have new key

It’s messy, but I have a new key for dac.override (at) gmail.com and dominick.grift (at) defensec.nl. (I’am trying to phase out the former in favor of the latter)

This time I have https://wiki.gnupg.org/WKD set up. Get it with gpg --locate-keys dominick.grift (at) defensec.nl

There is no reason to send me unencrypted e-mail anymore.

Categories
DSSP2

Emacs major mode for editing Common Intermediate Language (CIL)

I had a cil-mode.el before but it was basically a modified lisp-mode.el. This time I created a cil-mode.el that is derived from lisp-mode instead. It makes it cleaner. Its not much though. It has custom syntax highlighting for various types of statements, keywords etc. I do need to work on my color palette though as the current scheme might not work well on light backgrounds. I also added syntax completion but only for the statements and keywords, so nothing too fancy. The indentation and positioning is derived from lisp-mode (indentation is HARD). Also added some other minor goodies. Would love to have some “abbrev” neatness but that is also non-trivial. Was looking into “statement look-up” feature but the CIL docs are on github and that does not allow you to search without subscription/login (I boycotted GitHub BTW). Anyhow, without further ado: cil-mode.el. Put it in your ~/.emacs.d and run byte-compile-file ~/.emacs.d/cil-mode.el then either load it wih m-x cil-mode or open a file with .cil extension.

;;; cil-mode.el --- major mode for editing Common Intermediate Language (CIL) -*- lexical-binding: t; -*-

;; SPDX-License-Identifier: GPL-3.0-or-later
;; Copyright (C) 2020  Dominick Grift
;; Author: Dominick Grift <dac.override@gmail.com>

;;; Code:

;;; define faces
(defface cil-access-vector-rules-face
  '((t :foreground "gold"
       ))
  "Face for access vector rules"
  :group 'cil-mode )
(defvar cil-access-vector-rules-face 'cil-access-vector-rules-face)

(defface cil-call-macro-statements-face
  '((t :foreground "royalblue"
       ))
  "Face for call/macro statements"
  :group 'cil-mode )
(defvar cil-call-macro-statements-face 'cil-call-macro-statements-face)

(defface cil-class-permission-statements-face
  '((t :foreground "magenta"
       ))
  "Face for class/permission statements"
  :group 'cil-mode )
(defvar cil-class-permission-statements-face 'cil-class-permission-statements-face)

(defface cil-conditional-statements-face
  '((t :foreground "yellow"
       ))
  "Face for conditional statements"
  :group 'cil-mode )
(defvar cil-conditional-statements-face 'cil-conditional-statements-face)

(defface cil-constraint-statements-face
  '((t :foreground "hotpink"
       ))
  "Face for constraint statements"
  :group 'cil-mode )
(defvar cil-constraint-statements-face 'cil-constraint-statements-face)

(defface cil-container-statements-face
  '((t :foreground "grey"
       ))
  "Face for container statements"
  :group 'cil-mode )
(defvar cil-container-statements-face 'cil-container-statements-face)

(defface cil-context-statement-face
  '((t :foreground "blue"
       ))
  "Face for context statement"
  :group 'cil-mode )
(defvar cil-context-statement-face 'cil-context-statement-face)

(defface cil-default-object-statements-face
  '((t :foreground "green"
       ))
  "Face for default object statements"
  :group 'cil-mode )
(defvar cil-default-object-statements-face 'cil-default-object-statements-face)

(defface cil-file-labeling-statements-face
  '((t :foreground "pink"
       ))
  "Face for file labeling statements"
  :group 'cil-mode )
(defvar cil-file-labeling-statements-face 'cil-file-labeling-statements-face)

(defface cil-infiniband-statements-face
  '((t :foreground "orange"
       ))
  "Face for infiniband statements"
  :group 'cil-mode )
(defvar cil-infiniband-statements-face 'cil-infiniband-statements-face)

(defface cil-mls-labeling-statements-face
  '((t :foreground "khaki"
       ))
  "Face for mls labeling statements"
  :group 'cil-mode )
(defvar cil-mls-labeling-statements-face 'cil-mls-labeling-statements-face)

(defface cil-network-labeling-statements-face
  '((t :foreground "teal"
       ))
  "Face for network labeling statements"
  :group 'cil-mode )
(defvar cil-network-labeling-statements-face 'cil-network-labeling-statements-face)

(defface cil-policy-config-statements-face
  '((t :foreground "aqua"
       ))
  "Face for policy config statements"
  :group 'cil-mode )
(defvar cil-policy-config-statements-face 'cil-policy-config-statements-face)

(defface cil-role-statements-face
  '((t :foreground "wheat"
       ))
  "Face for role statements"
  :group 'cil-mode )
(defvar cil-role-statements-face 'cil-role-statements-face)

(defface cil-sid-statements-face
  '((t :foreground "peru"
       ))
  "Face for sid statements"
  :group 'cil-mode )
(defvar cil-sid-statements-face 'cil-sid-statements-face)

(defface cil-type-statements-face
  '((t :foreground "deepskyblue"
       ))
  "Face for type statements"
  :group 'cil-mode )
(defvar cil-type-statements-face 'cil-type-statements-face)

(defface cil-user-statements-face
  '((t :foreground "darkolivegreen"
       ))
  "Face for user statements"
  :group 'cil-mode )
(defvar cil-user-statements-face 'cil-user-statements-face)

(defface cil-xen-statements-face
  '((t :foreground "coral"
       ))
  "Face for xen statements"
  :group 'cil-mode )
(defvar cil-xen-statements-face 'cil-xen-statements-face)

(defface cil-name-string-face
  '((t :foreground "mediumseagreen"
       ))
  "Face for name string"
  :group 'cil-mode )
(defvar cil-name-string-face 'cil-name-string-face)

(defface cil-true-false-face
  '((t :foreground "lavender"
       ))
  "Face for true/false"
  :group 'cil-mode )
(defvar cil-true-false-face 'cil-true-false-face)

(defface cil-operators-face
  '((t :foreground "orangered"
       ))
  "Face for operators"
  :group 'cil-mode )
(defvar cil-operators-face 'cil-operators-face)

;;; syntax highlighting
(setq cil-highlights
      (let* (
	     ;; define several category of keywords
	     (cil-access-vector-rules '("allow" "auditallow"
					"dontaudit" "neverallow"
					"allowx" "auditallowx"
					"dontauditx" "neverallowx"))
	     (cil-call-macro-statements '("call" "macro"))
	     (cil-class-permission-statements '("common"
						"classcommon"
						"class" "classorder"
						"classpermission"
						"classpermissionset"
						"classmap"
						"classmapping"
						"permissionx"))
	     (cil-conditional-statements '("boolean" "booleanif"
					   "tunable" "tunableif"))
	     (cil-constraint-statements '("constrain"
					  "validatetrans"
					  "mlsconstrain"
					  "mlsvalidatetrans"))
	     (cil-container-statements '("block" "blockabstract"
					 "blockinherit" "optional"
					 "in"))
	     (cil-context-statement '("context"))
	     (cil-default-object-statements '("defaultuser"
					      "defaultrole"
					      "defaulttype"
					      "defaultrange"))
	     (cil-file-labeling-statements '("filecon" "fsuse"
					     "genfscon"))
	     (cil-infiniband-statements '("ibpkeycon"
					  "ibendportcon"))
	     (cil-mls-labeling-statements '("sensitivity"
					    "sensitivityalias"
					    "sensitivityaliasactual"
					    "sensitivityorder"
					    "category"
					    "categoryalias"
					    "categoryaliasactual"
					    "categoryorder"
					    "categoryset"
					    "sensitivitycategory"
					    "level" "levelrange"
					    "rangetransition"))
	     (cil-network-labeling-statements '("ipaddr" "netifcon"
						"nodecon"
						"portcon"))
	     (cil-policy-config-statements '("mls" "handleunknown"
					     "policycap"))
	     (cil-role-statements '("role" "roletype"
				    "roleattribute"
				    "roleattributeset" "roleallow"
				    "roletransition" "rolebounds"))
	     (cil-sid-statements '("sid" "sidorder" "sidcontext"))
	     (cil-type-statements '("type" "typealias"
				    "typealiasactual"
				    "typeattribute"
				    "typeattributeset" "typebounds"
				    "typechange" "typemember"
				    "typetransition"
				    "typepermissive"))
	     (cil-user-statements '("user" "userrole"
				    "userattribute"
				    "userattributeset" "userlevel"
				    "userrange" "userbounds"
				    "userprefix" "selinuxuser"
				    "selinuxuserdefault"))
	     (cil-xen-statements '("iomemcon" "ioportcon"
				   "pcidevicecon" "pirqcon"
				   "devicetreecon"))
	     (cil-name-string '("name"))
	     (cil-true-false '("true" "false"))
	     (cil-operators '("and" "or" "xor" "eq" "neq" "not"
			      "all" "dom" "domby" "incomp" "range"))

	     ;; generate regex string for each category of keywords
	     (cil-access-vector-rules-regexp (regexp-opt cil-access-vector-rules 'words))
	     (cil-call-macro-statements-regexp (regexp-opt cil-call-macro-statements 'words))
	     (cil-class-permission-statements-regexp (regexp-opt cil-class-permission-statements 'words))
	     (cil-conditional-statements-regexp (regexp-opt cil-conditional-statements 'words))
	     (cil-constraint-statements-regexp (regexp-opt cil-constraint-statements 'words))
	     (cil-container-statements-regexp (regexp-opt cil-container-statements 'words))
	     (cil-context-statement-regexp (regexp-opt cil-context-statement 'words))
	     (cil-default-object-statements-regexp (regexp-opt cil-default-object-statements 'words))
	     (cil-file-labeling-statements-regexp (regexp-opt cil-file-labeling-statements 'words))
	     (cil-infiniband-statements-regexp (regexp-opt cil-infiniband-statements 'words))
	     (cil-mls-labeling-statements-regexp (regexp-opt cil-mls-labeling-statements 'words))
	     (cil-network-labeling-statements-regexp (regexp-opt cil-network-labeling-statements 'words))
	     (cil-policy-config-statements-regexp (regexp-opt cil-policy-config-statements 'words))
	     (cil-role-statements-regexp (regexp-opt cil-role-statements 'words))
	     (cil-sid-statements-regexp (regexp-opt cil-sid-statements 'words))
	     (cil-type-statements-regexp (regexp-opt cil-type-statements 'words))
	     (cil-user-statements-regexp (regexp-opt cil-user-statements 'words))
	     (cil-xen-statements-regexp (regexp-opt cil-xen-statements 'words))
	     (cil-name-string-regexp (regexp-opt cil-name-string 'words))
	     (cil-true-false-regexp (regexp-opt cil-true-false 'words))
	     (cil-operators-regexp (regexp-opt cil-operators 'words)))
	`(

          (,cil-access-vector-rules-regexp . cil-access-vector-rules-face)
          (,cil-call-macro-statements-regexp . cil-call-macro-statements-face)
          (,cil-class-permission-statements-regexp . cil-class-permission-statements-face)
          (,cil-conditional-statements-regexp . cil-conditional-statements-face)
	  (,cil-constraint-statements-regexp . cil-constraint-statements-face)
	  (,cil-container-statements-regexp . cil-container-statements-face)
	  (,cil-context-statement-regexp . cil-context-statement-face)
	  (,cil-default-object-statements-regexp . cil-default-object-statements-face)
	  (,cil-file-labeling-statements-regexp . cil-file-labeling-statements-face)
	  (,cil-infiniband-statements-regexp . cil-infiniband-statements-face)
	  (,cil-mls-labeling-statements-regexp . cil-mls-labeling-statements-face)
	  (,cil-network-labeling-statements-regexp . cil-network-labeling-statements-face)
	  (,cil-policy-config-statements-regexp . cil-policy-config-statements-face)
	  (,cil-role-statements-regexp . cil-role-statements-face)
	  (,cil-sid-statements-regexp . cil-sid-statements-face)
	  (,cil-type-statements-regexp . cil-type-statements-face)
	  (,cil-user-statements-regexp . cil-user-statements-face)
	  (,cil-xen-statements-regexp . cil-xen-statements-face)
	  (,cil-name-string-regexp . cil-name-string-face)
	  (,cil-true-false-regexp . cil-true-false-face)
	  (,cil-operators-regexp . cil-operators-face)
          )))

;;; syntax table
(defvar cil-syntax-table nil "Syntax table for `cil-mode'")

(setq cil-syntax-table
      (let ( (synTable (make-syntax-table)))
        ;; set/modify each char's class

	;; do not highlight syntax with . and _
	(modify-syntax-entry ?_ "W" synTable)
        (modify-syntax-entry ?. "W" synTable)

        ;; lisp style comment “;; …”
        (modify-syntax-entry ?\; ". 12b" synTable)
        (modify-syntax-entry ?\n "> b" synTable)
	synTable))

;;; command completion with ido
(require 'ido)
(setq cil-keywords
      '("allow" "auditallow" "dontaudit" "neverallow" "allowx"
	"auditallowx" "dontauditx" "neverallowx" "call" "macro"
	"common" "classcommon" "class" "classorder" "classpermission"
	"classpermissionset" "classmap" "classmapping" "permissionx"
	"boolean" "booleanif" "tunable" "tunableif" "constrain"
	"validatetrans" "mlsconstrain" "mlsvalidatetrans" "block"
	"blockabstract" "blockinherit" "optional" "in" "context"
	"defaultuser" "defaultrole" "defaulttype" "defaultrange"
	"filecon" "fsuse" "genfscon" "ibpkeycon" "ibendportcon"
	"sensitivity" "sensitivityalias" "sensitivityaliasactual"
	"sensitivityorder" "category" "categoryalias"
	"categoryaliasactual" "categoryorder" "categoryset"
	"sensitivitycategory" "level" "levelrange" "rangetransition"
	"ipaddr" "nefifcon" "nodecon" "portcon" "mls" "handleunknown"
	"policycap" "role" "roletype" "roleattribute"
	"roleattributeset" "roleallow" "roletransition" "rolebounds"
	"sid" "sidorder" "sidcontext" "type" "typealias"
	"typealiasactual" "typeattribute" "typeattributeset"
	"typebounds" "typechange" "typemember" "typetransition"
	"typepermissive" "user" "userrole" "userattribute"
	"userattributeset" "userlevel" "userrange" "userbounds"
	"userprefix" "selinuxuser" "selinuxuserdefault" "iomemcon"
	"ioportcon" "pcidevicecon" "pirqcon" "devicetreecon" "name"
	"true" "false" "and" "or" "xor" "eq" "neq" "not" "all"
	"dom" "domby" "incomp" "range"))

(defun cil-complete-symbol ()
  "Perform keyword completion on current symbol.
This uses `ido-mode' user interface for completion"
  (interactive)
  (let* (
         ($bds (bounds-of-thing-at-point 'symbol))
         ($p1 (car $bds))
         ($p2 (cdr $bds))
         ($current-sym
          (if  (or (null $p1) (null $p2) (equal $p1 $p2))
              ""
            (buffer-substring-no-properties $p1 $p2)))
         $result-sym)
    (when (not $current-sym) (setq $current-sym ""))
    (setq $result-sym
          (ido-completing-read "" cil-keywords nil nil $current-sym ))
    (delete-region $p1 $p2)
    (insert $result-sym)))

;;; keymap commands
(defvar cil-map nil "Keymap for `cil-mode'")
(progn
  (setq cil-map (make-sparse-keymap))

  ;; ido command completion
  (define-key cil-map (kbd "TAB") 'cil-complete-symbol))

;;;###autoload
(define-derived-mode cil-mode lisp-mode "cil"
  "major mode for editing Common Intermediate Language (CIL)"

  (add-to-list 'auto-mode-alist '("\\.cil\\'" . cil-mode))

  ;; keymap
  (use-local-map cil-map) 

  ;; comment-dwim support
  (setq-local comment-start "; ")
  (setq-local comment-end "")

  ;; syntax table
  (set-syntax-table cil-syntax-table)

  ;; syntax highlighting
  (setq font-lock-defaults '((cil-highlights))))

(provide 'cil-mode)
;;; cil-mode.el ends here