code.delx.au - gnu-emacs-elpa/blob - packages/systemd/systemctl.el

   1 ;;; systemctl.el --- Emacs interface to Systemd     -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2016  Free Software Foundation, Inc.
   4
   5 ;; Author: Mario Lang <mlang@delysid.org>
   6 ;; Keywords:
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; This library provides a front end to Systemd.
  24 ;;
  25 ;; Use `M-x systemctl-list-units RET' to see a list of all known
  26 ;; Systemd units and their status on localhost.  With a prefix
  27 ;; argument (`C-u M-x systemctl-list-units RET') you will be prompted
  28 ;; for a remote host to connect to.
  29 ;;
  30 ;; In systemctl-list-units-mode, `RET' will visit all relevant
  31 ;; configuration fragments for the unit at point (the equivalent of
  32 ;; "systemctl cat some.service").  With a `C-u' prefix argument, it
  33 ;; will prompt for a new override.conf file to create (somewhat
  34 ;; equivalent to "systemctl edit some.service").  Contrary to the
  35 ;; command-line "systemctl" tool, systemctl.el allows viewing and
  36 ;; editing of remote unit files thanks to TRAMP.
  37 ;;
  38 ;; Key bindings `s t a r t' and `s t o p' can be used to start and stop
  39 ;; services.  Similarily, `e n a b l e' and `d i s a b l e' can be used to
  40 ;; permanently enable and disable unit files.
  41
  42 ;;; Granting access to non-root users:
  43
  44 ;; Some operations are obviously not allowed when executed from within a
  45 ;; non-root Emacs session.  If you want to explicitly grant access to certain
  46 ;; users, you can create a polkit localauthority configuration file.
  47 ;; Below is an example.  You might want to change the group name, or use
  48 ;; "unix-user" instead.
  49 ;;
  50 ;; /etc/polkit-1/localauthority/50-local.d/10-systemd.pkla:
  51 ;;
  52 ;; [Normal Staff Permissions]
  53 ;; Identity=unix-group:sudo
  54 ;; Action=org.freedesktop.systemd1.*
  55 ;; ResultAny=no
  56 ;; ResultInactive=no
  57 ;; ResultActive=yes
  58
  59 ;;; Todo:
  60
  61 ;; * Have someone with window/frame-fu see if there is a better way to
  62 ;;   visit N files in a frame, each in a separate window.  The current approach
  63 ;;   feels a bit crude, see `systemctl-edit-unit-files'.
  64 ;; * Optionally automatically reload the Systemd daemon when a unit buffer is
  65 ;;   saved.
  66 ;; * Detect if we are not root, and use the sudo method to edit
  67 ;;   system files on localhost.
  68 ;; * Add support for local and remote systemd user sessions.
  69 ;; * Figure out what's necessary to support local and remote containers.
  70 ;; * Menu entries for `systemctl-list-units-mode'.
  71
  72 ;;; Code:
  73
  74 (require 'systemd)
  75 (require 'tabulated-list)
  76 (require 'tramp)
  77
  78 (defgroup systemctl nil
  79   "Interface to Systemd.")
  80
  81 (defcustom systemctl-default-override-file-name "override.conf"
  82   "Default file name for new override.conf files."
  83   :group 'systemctl
  84   :type 'string)
  85
  86 (defcustom systemctl-list-units-format
  87   (vector (list "Unit" 22 t)
  88           (list "Loaded" 9 t)
  89           (list "Active" 8 t)
  90           (list "State" 8 t)
  91           (list "Description" 50 nil))
  92   "Column format specification for the `systemctl-list-units' command."
  93   :group 'systemctl
  94   :type '(vector (list :tag "Unit"
  95                        (string :tag "Title")
  96                        (number :tag "Width")
  97                        (boolean :tag "Sortable"))
  98                  (list :tag "Loaded"
  99                        (string :tag "Title")
 100                        (number :tag "Width")
 101                        (boolean :tag "Sortable"))
 102                  (list :tag "Active"
 103                        (string :tag "Title")
 104                        (number :tag "Width")
 105                        (boolean :tag "Sortable"))
 106                  (list :tag "State"
 107                        (string :tag "Title")
 108                        (number :tag "Width")
 109                        (boolean :tag "Sortable"))
 110                  (list :tag "Description"
 111                        (string :tag "Title")
 112                        (number :tag "Width")
 113                        (boolean :tag "Sortable"))))
 114
 115 (defcustom systemctl-tramp-method "scpx"
 116   "The TRAMP method to use when remotely accessing Systemd Unit files."
 117   :group 'systemctl
 118   :type (cons 'choice
 119               (mapcar (lambda (method)
 120                         (list 'const (car method)))
 121                       tramp-methods)))
 122
 123 (defvar-local systemctl-bus :system
 124   "Default D-Bus bus to use when accessing Systemd.
 125 You should use the function `systemctl-bus' to retrieve the value of this
 126 variable to make sure the bus is properly initialized in case it is pointing
 127 to a remote machine.")
 128
 129 (defvar systemctl-list-units-mode-map
 130   (let ((map (make-sparse-keymap)))
 131     (define-key map "\C-m" #'systemctl-edit-unit-files)
 132     (define-key map "f" #'systemctl-find-fragment)
 133     (define-key map "start" #'systemctl-start)
 134     (define-key map "stop"  #'systemctl-stop)
 135     (define-key map "enable" #'systemctl-enable)
 136     (define-key map "disable" #'systemctl-disable)
 137     map)
 138   "Keymap for `systemctl-list-units-mode'.")
 139
 140 (defun systemctl-bus ()
 141   (when (stringp systemctl-bus)
 142     (dbus-init-bus systemctl-bus))
 143   systemctl-bus)
 144
 145 (defun systemctl-list-units-entries ()
 146   "Retrieve a list of units known to Systemd.
 147 See `systemctl-list-units-format' and `tabulated-list-entries'."
 148   (mapcar (lambda (desc)
 149             (list (nth 6 desc)
 150                   (vector (nth 0 desc)
 151                           (nth 2 desc)
 152                           (nth 3 desc)
 153                           (nth 4 desc)
 154                           (nth 1 desc))))
 155           (systemd-ListUnits (systemctl-bus))))
 156
 157 (defun systemctl-unescape-unit-name (string)
 158   (while (string-match "\\\\x\\([0-9a-f]\\{2\\}\\)" string)
 159     (setq string
 160           (replace-match (string (string-to-number (match-string 1 string) 16))
 161                          t t string)))
 162   string)
 163
 164 (defun systemctl-list-units-print-entry (id cols)
 165   "Insert a Systemd Units List entry at point.
 166 See `tabulated-list-printer'."
 167   (let ((beg (point))
 168         (x (max tabulated-list-padding 0))
 169         (inhibit-read-only t))
 170     (when (> x 0) (insert (make-string x ?\s)))
 171     (dotimes (n (length tabulated-list-format))
 172       (let ((desc (aref cols n)))
 173         (when (= n 0)
 174           (setq desc (systemctl-unescape-unit-name desc)))
 175         (setq x (tabulated-list-print-col n desc x))))
 176     (insert ?\n)
 177     (put-text-property beg (point) 'tabulated-list-id id)
 178     (put-text-property beg (point) 'tabulated-list-entry cols)))
 179
 180 (define-derived-mode systemctl-list-units-mode tabulated-list-mode
 181   "Systemd-Units"
 182   "Major mode for displaying a list of Systemd Units."
 183   (setq tabulated-list-entries #'systemctl-list-units-entries
 184         tabulated-list-format    systemctl-list-units-format
 185         tabulated-list-printer #'systemctl-list-units-print-entry)
 186   (tabulated-list-init-header))
 187
 188 ;;;###autoload
 189 (defun systemctl-list-units (&optional host)
 190   "Display a list of all Systemd Units."
 191   (interactive
 192    (list (when (equal current-prefix-arg '(4))
 193            (read-string "Remote host: "))))
 194
 195   (with-current-buffer (let ((buffer-name (if host
 196                                               (format "*Systemd Units (%s)*"
 197                                                       host)
 198                                             "*Systemd Units*")))
 199                          (get-buffer-create buffer-name))
 200     (systemctl-list-units-mode)
 201     (when host
 202       (setq systemctl-bus (systemd-remote-bus host)
 203             default-directory (systemctl-file-name "/etc/systemd/")))
 204     (tabulated-list-print)
 205     (pop-to-buffer (current-buffer))))
 206
 207 (defun systemctl-list-units-get-unit ()
 208   (when (eq major-mode 'systemctl-list-units-mode)
 209     (let ((entry (tabulated-list-get-entry)))
 210       (when entry
 211         (aref entry 0)))))
 212
 213 (defun systemctl-start (unit)
 214   "Start Systemd UNIT."
 215   (interactive (list (or (systemctl-list-units-get-unit)
 216                          (read-string "Unit: "))))
 217   (systemd-StartUnit (systemctl-bus) unit "replace")
 218   (when (eq major-mode 'systemctl-list-units-mode)
 219     (tabulated-list-revert)))
 220
 221 (defun systemctl-stop (unit)
 222   (interactive (list (or (systemctl-list-units-get-unit)
 223                          (read-string "Unit: "))))
 224   (systemd-StopUnit (systemctl-bus) unit "replace")
 225   (when (eq major-mode 'systemctl-list-units-mode)
 226     (tabulated-list-revert)))
 227
 228 (defun systemctl-enable (unit)
 229   "Enable Systemd UNIT."
 230   (interactive (list (or (systemctl-list-units-get-unit)
 231                          (read-string "Unit: "))))
 232   (pcase (systemd-EnableUnitFiles (systemctl-bus) (list unit) nil nil)
 233     (`(,carries-install-info ,changes)
 234      (if changes
 235          (pcase-dolist (`(,type ,from ,to) changes)
 236            (message "%s %s -> %s" type from to))
 237        (message "No changes")))))
 238
 239 (defun systemctl-disable (unit)
 240   "Disable Systemd UNIT."
 241   (interactive (list (or (systemctl-list-units-get-unit)
 242                          (read-string "Unit: "))))
 243   (let ((changes (systemd-DisableUnitFiles (systemctl-bus) (list unit) nil)))
 244     (if changes
 245         (pcase-dolist (`(,type ,from ,to) changes)
 246           (message "%s %s -> %s" type from to))
 247       (message "No changes"))))
 248
 249 (defun systemctl-reload ()
 250   "Reload all unit files."
 251   (interactive)
 252   (systemd-Reload (systemctl-bus)))
 253
 254 (defun systemctl-file-name (file-name)
 255   (if (and (stringp systemctl-bus)
 256            (string-match "unixexec:path=ssh,.*argv2=\\([^,]*\\),"
 257                          systemctl-bus))
 258       (let ((host (systemd-unescape-dbus-address
 259                    (match-string 1 systemctl-bus))))
 260         (concat "/" systemctl-tramp-method ":" host ":" file-name))
 261     file-name))
 262
 263 (defun systemctl-find-fragment (unit)
 264   (interactive
 265    (list (or (and (eq major-mode 'systemctl-list-units-mode)
 266                   (tabulated-list-get-id))
 267              (systemd-GetUnit (systemctl-bus) (read-string "Unit: ")))))
 268   (let ((fragment-path (systemd-unit-FragmentPath (systemctl-bus) unit)))
 269     (when fragment-path
 270       (find-file (systemctl-file-name fragment-path)))))
 271
 272 (defun systemctl-edit-unit-files (unit &optional override-file)
 273   "Visit all configuration files related to UNIT simultaneously.
 274 If optional OVERRIDE-FILE is specified, or if a prefix argument has been
 275 given interactively, open a (new) override file."
 276   (interactive
 277    (let* ((unit (if (tabulated-list-get-entry)
 278                     (systemctl-unescape-unit-name (aref (tabulated-list-get-entry) 0))
 279                   (read-string "Unit: ")))
 280           (unit-path (or (tabulated-list-get-id)
 281                          (systemd-GetUnit (systemctl-bus) unit)))
 282           (override-file
 283            (when (equal current-prefix-arg '(4))
 284              (read-file-name "Override file: "
 285                              (systemctl-file-name
 286                               (concat "/etc/systemd/system/" unit ".d/"))
 287                              nil nil
 288                              systemctl-default-override-file-name))))
 289      (list unit-path override-file)))
 290   (let ((files (mapcar #'systemctl-file-name
 291                        (systemd-unit-DropInPaths (systemctl-bus) unit))))
 292     (when override-file
 293       (push override-file files))
 294     (let ((path (systemd-unit-FragmentPath (systemctl-bus) unit)))
 295       (when (not (string= path ""))
 296         (setq files (nconc files
 297                            (list (systemctl-file-name path))))))
 298     (let ((path (systemd-unit-SourcePath (systemctl-bus) unit)))
 299       (when (not (string= path ""))
 300         (setq files (nconc files
 301                            (list (systemctl-file-name path))))))
 302     (if files
 303         (let ((buffers (mapcar #'find-file-noselect files)))
 304           (pop-to-buffer (pop buffers))
 305           (when buffers
 306             (delete-other-windows)
 307             (dolist (buffer buffers)
 308               (let ((window (split-window (car (last (window-list))))))
 309                 (shrink-window-if-larger-than-buffer)
 310                 (set-window-buffer window buffer)))
 311             (dolist (window (window-list))
 312               (shrink-window-if-larger-than-buffer window))))
 313       (when (called-interactively-p 'interactive)
 314         (message "No configuration files associated with `%s'." unit)))))
 315
 316 (provide 'systemctl)
 317 ;;; systemctl.el ends here