File: systemd.el

package info (click to toggle)
systemd-el 1.6-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 128 kB
  • sloc: lisp: 370; makefile: 36
file content (423 lines) | stat: -rw-r--r-- 16,133 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
;;; systemd.el --- Major mode for editing systemd units -*- lexical-binding: t -*-

;; Copyright (C) 2014-2017  Mark Oteiza <mvoteiza@udel.edu>

;; Author: Mark Oteiza <mvoteiza@udel.edu>
;; Version: 1.6
;; Package-Requires: ((emacs "24.4"))
;; Keywords: tools, unix

;; This file is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 3
;; of the License, or (at your option) any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Major mode for editing systemd units.

;; Similar to `conf-mode' but with enhanced highlighting; e.g. for
;; specifiers and booleans.  Employs strict regex for whitespace.
;; Features a facility for browsing documentation: use C-c C-o to open
;; links to documentation in a unit (cf. systemctl help).

;; Supports completion of directives and sections in either units or
;; network configuration.  Both a completer for
;; `completion-at-point-functions' and a company backend are provided.
;; The latter can be enabled by adding `company-mode' to
;; `systemd-mode-hook'.

;;; Code:

(require 'conf-mode)
(require 'thingatpt)
(require 'url-parse)

(declare-function company-begin-backend "company")
(declare-function company-grab-symbol "company")

(defvar font-lock-beg)
(defvar font-lock-end)

(defgroup systemd ()
  "Major mode for editing systemd units."
  :link '(url-link "http://www.freedesktop.org/wiki/Software/systemd/")
  :group 'tools)

(defcustom systemd-browse-url-function 'browse-url
  "Browser to use for HTTP(S) documentation."
  :type `(radio (function-item browse-url)
                ,@(when (fboundp 'eww) '((function-item eww)))
                ,@(when (fboundp 'w3m-browse-url) '((function-item w3m-browse-url)))
                (function :tag "Other function"))
  :group 'systemd)

(defcustom systemd-comment-start "#"
  "String to insert to start a new comment."
  :type '(choice (string :tag "Comment sign" "#")
                 (string :tag "Semicolon" ";"))
  :group 'systemd)

(defcustom systemd-man-function 'man
  "Pager to use for system manual pages."
  :type '(radio (function-item man)
                (function-item woman)
                (function :tag "Other function"))
  :group 'systemd)

(defcustom systemd-mode-hook nil
  "Hook run after entering `systemd-mode'."
  :type 'hook
  :options '(company-mode flycheck-mode)
  :group 'systemd)

(defconst systemd-unit-sections
  '("Unit" "Install" "Service")
  "Configuration sections for systemd 225.")

(defconst systemd-unit-directives
  (eval-when-compile
    (with-temp-buffer
      (insert-file-contents
       (let ((f "unit-directives.txt"))
         (if (null load-file-name) f
           (expand-file-name f (file-name-directory load-file-name)))))
      (split-string (buffer-string))))
  "Configuration directives for systemd.")

(defconst systemd-network-sections
  '("Match" "Link" "NetDev" "VLAN" "MACVLAN" "MACVTAP" "IPVLAN" "VXLAN"
    "Tunnel" "Peer" "Tun" "Tap" "Bond" "Network" "Address" "Route" "DHCP"
    "Bridge" "BridgeFDB")
  "Network configuration sections for systemd 225.")

(defconst systemd-network-directives
  (eval-when-compile
    (with-temp-buffer
      (insert-file-contents
       (let ((f "network-directives.txt"))
         (if (null load-file-name) f
           (expand-file-name f (file-name-directory load-file-name)))))
      (split-string (buffer-string))))
  "Network configuration directives for systemd.")

(defconst systemd-nspawn-sections
  '("Exec" "Files" "Network")
  "Namespace container configuration sections for systemd 232.")

(defconst systemd-nspawn-directives
  (eval-when-compile
    (with-temp-buffer
      (insert-file-contents
       (let ((f "nspawn-directives.txt"))
         (if (null load-file-name) f
           (expand-file-name f (file-name-directory load-file-name)))))
      (split-string (buffer-string))))
  "Namespace container configuration directives for systemd.")

;;;###autoload
(defconst systemd-autoload-regexp
  (eval-when-compile
    (rx (+? (any "a-zA-Z0-9-_.@\\")) "."
        (or "automount" "busname" "mount" "service" "slice"
            "socket" "swap" "target" "timer" "link" "netdev" "network")
        string-end))
  "Regexp for file buffers in which to autoload `systemd-mode'.")

;;;###autoload
(defconst systemd-tempfn-autoload-regexp
  (eval-when-compile
    (rx ".#"
        (or (and (+? (any "a-zA-Z0-9-_.@\\")) "."
                 (or "automount" "busname" "mount" "service" "slice"
                     "socket" "swap" "target" "timer" "link" "netdev" "network"))
            "override.conf")
        (= 16 (char hex-digit)) string-end))
  "Regexp for temp file buffers in which to autoload `systemd-mode'.")

;;;###autoload
(defconst systemd-dropin-autoload-regexp
  (eval-when-compile
    (rx "/systemd/" (+? anything) ".d/" (+? (not (any ?/))) ".conf" string-end))
  "Regexp for dropin config file buffers in which to autoload `systemd-mode'.")

(defun systemd-get-value (start)
  "Return the value of the key whose value begins at position START.
Lines ending in a backslash are concatenated with the next
according to systemd.unit(5)."
  (let (end)
    (save-excursion
      (while (= (char-before (line-end-position)) ?\\)
        (forward-line))
      (setq end (line-end-position))
      (replace-regexp-in-string "\\\\\n" " " (buffer-substring start end)))))

(defun systemd-doc-find ()
  "Find the value of the unit's “Documentation” keys.
Return values in a list of strings, otherwise nil."
  (let ((key "^Documentation=")
        string)
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward key nil t)
        (setq string (concat string " " (systemd-get-value (point))))))
    (when string
      (remove "\\" (split-string string)))))

(defun systemd-doc-man (page)
  "Open a manual page PAGE with `systemd-man-function'."
  (pcase (symbol-name systemd-man-function)
    ("woman" (woman (replace-regexp-in-string "([[:alnum:]]+)" "" page)))
    ("man" (man page))
    (_ (apply 'systemd-man-function page))))

(defun systemd-doc-open (url)
  "Prompt to open URL.
Interactively completes the documentation in the current unit
file, defaulting to the link under point, if any."
  (interactive
   (let* ((completion-cycle-threshold t)
          (collection (systemd-doc-find))
          (uri (or (thing-at-point-url-at-point)
                   (car-safe collection)))
          (prompt (concat "URL"
                          (when uri (format " (default %s)" uri))
                          ": ")))
     (list (completing-read prompt collection nil nil nil nil uri))))
  (let ((link (url-generic-parse-url url)))
    (pcase (url-type link)
      ("file" (find-file (url-filename link)))
      ("man" (systemd-doc-man (url-filename link)))
      ("info" (url-info link))
      ((or "http" "https") (funcall systemd-browse-url-function url))
      (_ (user-error "Invalid link")))))

(defun systemd-doc-directives ()
  "Open systemd.directives(7)."
  (interactive)
  (systemd-doc-man "systemd.directives(7)"))

(defun systemd-buffer-section-p ()
  "Return t if current line begins with \"[\", otherwise nil."
  (= (char-after (line-beginning-position)) ?\[))

(defun systemd-file-network-p (filename)
  "Return non-nil if FILENAME has a network-type extension, otherwise nil."
  (string-match-p (eval-when-compile
                    (rx "." (or "link" "netdev" "network") string-end))
                  filename))

(defun systemd-file-nspawn-p (filename)
  "Return non-nil if FILENAME has an nspawn extension, otherwise nil."
  (string-match-p (eval-when-compile (rx ".nspawn" string-end)) filename))

(defun systemd-completion-table (&rest _ignore)
  "Return a list of completion candidates."
  (let ((sectionp (systemd-buffer-section-p))
        (name (buffer-name)))
    (cond
     ((systemd-file-nspawn-p name)
      (if sectionp systemd-nspawn-sections systemd-nspawn-directives))
     ((systemd-file-network-p name)
      (if sectionp systemd-network-sections systemd-network-directives))
     (t (if sectionp systemd-unit-sections systemd-unit-directives)))))

(defun systemd-complete-at-point ()
  "Complete the symbol at point."
  (let ((bounds (bounds-of-thing-at-point 'symbol)))
    (list (or (car bounds) (point))
          (or (cdr bounds) (point))
          (completion-table-dynamic #'systemd-completion-table))))

(defun systemd-company-backend (command &optional arg &rest ignored)
  "Backend for `company-mode' in `systemd-mode' buffers."
  (interactive (list 'interactive))
  (pcase command
    (`interactive (company-begin-backend 'systemd-company-backend))
    (`prefix (and (eq major-mode 'systemd-mode) (company-grab-symbol)))
    (`candidates (all-completions arg (systemd-completion-table nil)))
    (`post-completion (if (not (systemd-buffer-section-p)) (insert "=")))))

(defun systemd-construct-start-p ()
  "Return non-nil if the current line is the first in a multi-line construct."
  (let ((flag t))
    (save-excursion
      (while (and (zerop (forward-line -1))
                  (eq ?\\ (char-before (line-end-position)))
                  (skip-chars-forward " \t")
                  (setq flag (memq (following-char) '(?# ?\;))))))
    flag))

(defun systemd-syntax-propertize (start end)
  "`systemd-propertize-function' for `systemd-mode' buffers."
  (let ((case-fold-search nil))
    (goto-char start)
    (funcall
     (syntax-propertize-rules
      ("^[ \t]*\\([;#]\\)$?"
       (1 (when (systemd-construct-start-p) (string-to-syntax "<")))))
     start end)))

(defun systemd-value-extend-region ()
  "Return the EOL position of the last line of the construct at point."
  (while (and (= (char-before (line-end-position)) ?\\)
              (skip-chars-forward " \t")
              (not (memq (following-char) '(?# ?\;)))
              (zerop (forward-line))))
  (line-end-position))

(defun systemd-font-lock-extend-region ()
  (goto-char font-lock-beg)
  (while (and (zerop (forward-line -1))
              (= (char-before (line-end-position)) ?\\)
              (skip-chars-forward " \t")
              (not (memq (following-char) '(?# ?\;)))))
  (setq font-lock-beg (point-marker))
  (goto-char font-lock-end)
  (setq font-lock-end (systemd-value-extend-region)))

(defmacro define-systemd-matcher (name regexp &optional docstring)
  "Define a new function NAME that matches REGEXP in a multi-line construct.
Only returns matches of REGEXP on lines passing `systemd-construct-start-p'."
  (declare (debug (symbolp stringp &optional stringp))
           (indent 2) (doc-string 3))
  `(defun ,name (limit)
     ,docstring
     (let (match)
       (while (and (setq match (re-search-forward ,regexp limit t))
                   (not (systemd-construct-start-p))))
       match)))

(define-systemd-matcher systemd-section-matcher
    "^\\(\\[\\([[:upper:]][[:alnum:]]+\\|X-.*?\\)\\]\\)"
  "Matcher for section titles.")

(define-systemd-matcher systemd-key-matcher "^\\([[:upper:]][[:alnum:]]+\\)="
  "Matcher for keys (unit directives).")

(defun systemd-exec-prefix-anchored-matcher (limit)
  "Matcher for the exec prefix in anchored font-lock rule.
See `font-lock-keywords' and (info \"(elisp) Search-based Fontification\")."
  (let ((pos (car (match-data)))
        (prefixes '(?- ?@ ?+))
        char end res)
    (while (and (memq (setq char (following-char)) prefixes)
                (< (point) limit))
      (forward-char)
      (setq prefixes (remq char prefixes))
      (setq end (point-marker)))
    (when end
      (prog1 (setq res (list (1+ pos) end))
        (set-match-data res)))))

(defconst systemd-font-lock-keywords-1
  `((systemd-section-matcher 1 'font-lock-type-face)
    (systemd-key-matcher 1 'font-lock-keyword-face))
  "Minimal expressions to highlight in `systemd-mode'.")

(defconst systemd-font-lock-keywords-2
  `(,@systemd-font-lock-keywords-1
    ("\\\\$" 0 'font-lock-warning-face) ; line break
    ;; boolean arguments
    (,(rx "=" (group (or "yes" "true" "on" "0" "no" "false" "off")) eol)
     1 'font-lock-constant-face)
    ("="
     ;; exec prefixes
     (systemd-exec-prefix-anchored-matcher
      nil nil (0 'font-lock-negation-char-face))
     ;; environment variables
     ("\\$[A-Z_]+\\>"
      (systemd-value-extend-region) nil (0 'font-lock-variable-name-face))
     ;; specifiers
     ("%[nNpPiIfcrRtuUhsmbHv%]"
      (systemd-value-extend-region) nil (0 'font-lock-constant-face))))
  "Extended expressions to highlight in `systemd-mode'.")

(defconst systemd-font-lock-keywords-3
  `(,@systemd-font-lock-keywords-2
    ("^Type=\\(simple\\|forking\\|oneshot\\|dbus\\|notify\\|idle\\)$"
     1 'font-lock-builtin-face)
    (,(rx bol "Restart="
          (group (or "no" "on-success" "on-failure"
                     "on-abnormal" "on-watchdog" "on-abort" "always"))
          eol)
     1 'font-lock-builtin-face)
    ("^KillMode=\\(control-group\\|process\\|mixed\\|none\\)$"
     1 'font-lock-builtin-face)
    (,(rx bol "KillSignal="
          (group
           (or "SIGHUP" "SIGINT" "SIGQUIT" "SIGILL" "SIGABRT" "SIGFPE" "SIGKILL"
               "SIGSEGV" "SIGPIPE" "SIGALRM" "SIGTERM" "SIGUSR1" "SIGUSR2"
               "SIGCHLD" "SIGCONT" "SIGSTOP" "SIGTSTP" "SIGTTIN" "SIGTTOU"))
          eol)
     1 'font-lock-constant-face))
  "Flamboyant expressions to highlight in `systemd-mode'.")

(defvar systemd-font-lock-keywords 'systemd-font-lock-keywords-2
  "Default expressions to highlight in `systemd-mode'.
See systemd.unit(5) for details on unit file syntax.")

(defvar systemd-mode-syntax-table
  (let ((table (make-syntax-table)))
    (modify-syntax-entry ?% "/" table)
    (modify-syntax-entry ?$ "'" table)
    (modify-syntax-entry ?\; "." table)
    table)
  "Syntax table used in `systemd-mode' buffers.")

(defvar systemd-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "C-c C-d") 'systemd-doc-directives)
    (define-key map (kbd "C-c C-o") 'systemd-doc-open)
    map)
  "Keymap used in `systemd-mode' buffers.")

(easy-menu-define systemd-mode-menu systemd-mode-map
  "Menu used in `systemd-mode' buffers."
  '("Systemd"
    ["Open Unit File help" systemd-doc-open
     :help "Documentation referenced in current buffer"]
    ["Open systemd.directives(7)" systemd-doc-directives
     :help "Index of configuration directives"]))

;;;###autoload (add-to-list 'auto-mode-alist '("\\.nspawn\\'" . systemd-mode))
;;;###autoload (add-to-list 'auto-mode-alist `(,systemd-autoload-regexp . systemd-mode))
;;;###autoload (add-to-list 'auto-mode-alist `(,systemd-tempfn-autoload-regexp . systemd-mode))
;;;###autoload (add-to-list 'auto-mode-alist `(,systemd-dropin-autoload-regexp . systemd-mode))

;;;###autoload
(define-derived-mode systemd-mode conf-mode "Systemd"
  "Major mode for editing systemd unit files.
See http://www.freedesktop.org/wiki/Software/systemd/ for more
information about systemd.

In addition to any hooks its parent mode might have run, this
mode runs the hook `systemd-mode-hook' at mode initialization.

Key bindings:
\\{systemd-mode-map}"
  (set-keymap-parent systemd-mode-map nil)
  (conf-mode-initialize systemd-comment-start)
  (setq-local auto-fill-inhibit-regexp "^[ \t]*?[^;#]")
  (add-hook 'company-backends #'systemd-company-backend)
  (add-hook 'completion-at-point-functions #'systemd-complete-at-point nil t)
  (add-hook 'font-lock-extend-region-functions
            'systemd-font-lock-extend-region nil t)
  (setq-local syntax-propertize-function #'systemd-syntax-propertize)
  (setq font-lock-defaults
        '((systemd-font-lock-keywords
           systemd-font-lock-keywords-1
           systemd-font-lock-keywords-2
           systemd-font-lock-keywords-3))))

(provide 'systemd)

;;; systemd.el ends here