path: root/openrc.el

;;; openrc.el --- OpenRC integration -*- lexical-binding: t -*-


;; Copyright 2022 Gentoo Authors


;; 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 2 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.


;; Author: Maciej Barć <xgqt@riseup.net>
;; Homepage: https://gitweb.gentoo.org/proj/emacs-openrc.git
;; Keywords: processes
;; Maintainer: <emacs@gentoo.org>
;; Package-Requires: ((emacs "24.3"))
;; Version: 1.0.0



;;; Commentary:


;; OpenRC integration.


;; This library was originally written as part of "emacs-gentoo"
;; by Maciej Barć.
;; It was later relicensed by the author under the GPL-2-or-later license
;; and republished under the Gentoo GNU Emacs project.

;; Original repository: https://gitlab.com/xgqt/emacs-gentoo



;;; Code:


;; Commands to consider:
;;  - rc-service -l  -- all of services
;;  - rc-status -f "ini" boot
;;  - rc-update show -v


(defconst openrc-version "1.0.0"
  "Emacs-Openrc version.")

(defgroup openrc nil
  "OpenRC integration."
  :group 'external)


;; Executables

(defcustom openrc-rc-command "/sbin/rc"
  "Path to the \"rc\" binary."
  :safe 'stringp
  :type 'file
  :group 'openrc)

(defcustom openrc-rc-update-command (concat openrc-rc-command "-update")
  "Path to the \"rc-update\" binary."
  :safe 'stringp
  :type 'file
  :group 'openrc)

(defcustom openrc-rc-service-command (concat openrc-rc-command "-service")
  "Path to the \"rc-service\" binary."
  :safe 'stringp
  :type 'file
  :group 'openrc)

(defcustom openrc-sudo-command "sudo"
  "Path to the \"sudo\" binary.
Used to gain privilege for some commands."
  :safe 'stringp
  :type 'file
  :group 'openrc)


;; Directories

(defcustom openrc-run-dir "/run/openrc"
  "Path to OpenRC run directory (defaults to \"/run/openrc\")."
  :safe 'stringp
  :type 'file
  :group 'openrc)

(defcustom openrc-started-dir (expand-file-name "started" openrc-run-dir)
  "Path to OpenRC directory containing started services."
  :safe 'stringp
  :type 'file
  :group 'openrc)


;; Other

(defcustom openrc-use-sudo
  (or (executable-find openrc-sudo-command)
      (file-executable-p openrc-sudo-command))
  "Whether to use \"sudo\" or \"su\" for commands that need root privileges.
The invoked \"sudo\" executable location is controlled by the
‘openrc-sudo-command’ variable."
  :type 'boolean
  :group 'openrc)



;; Helpers

(defun openrc--service-started? (service)
  "Check if SERVICE is started."
  (file-exists-p (expand-file-name service openrc-started-dir)))

(defun openrc--get-services ()
  "Get all OpenRC services."
  (mapcar
   (lambda (s)
     (let* ((lst (split-string s "|" t " *"))
            (service (car lst))
            (runlevel (cdr lst)))
       (vector service
               (if (openrc--service-started? service) "YES" "NO")
               (if (equal runlevel nil) "none" (car runlevel)))))
   (split-string (shell-command-to-string
                  (concat openrc-rc-update-command " show -v")) "\n" t)))

(defun openrc--tabulated-list (vectors list-length tabulated-list)
  "Create a TABULATED-LIST from list of VECTORS of length LIST-LENGTH."
  (cond
   ((equal vectors nil) tabulated-list)
   (t (openrc--tabulated-list
       (cdr vectors)
       list-length
       (append tabulated-list
               (list (list (- list-length (length vectors))
                           (car vectors))))))))

(defun openrc-refresh-services ()
  "Refresh the list of OpenRC services."
  (interactive)
  (message "Refreshing OpenRC services list...")
  (let ((services (openrc--get-services)))
    (setq tabulated-list-entries
          (openrc--tabulated-list services (length services) '())))
  (tabulated-list-init-header)
  (tabulated-list-print t)
  (message "...OpenRC services list refresh done!"))

(defun openrc--async-shell-command (privileged &rest args)
  "Run `async-shell-command' with ARGS.
If PRIVILEGED is true, then use the \"sudo\" or \"su\" to run the command."
  (let ((buffer-name "*OpenRC Command*")
        (error-buffer-name "*OpenRC Command ERRORS*")
        (command (apply 'concat (mapcar (lambda (s) (concat " " s)) args))))
    (let ((buffer (get-buffer-create buffer-name)))
      (with-current-buffer buffer
        (if privileged
            (if openrc-use-sudo
                (async-shell-command (concat "sudo " command)
                                     buffer-name
                                     error-buffer-name)
              (async-shell-command (concat "su -c \"" command "\"")
                                   buffer-name
                                   error-buffer-name))
          (async-shell-command command buffer-name error-buffer-name))
        (view-mode)))))


;; Describing services

(defun openrc--describe (service)
  "Describe a SERVICE."
  (openrc--async-shell-command
   nil openrc-rc-service-command service "describe" "--verbose"))

(defun openrc-describe-entry ()
  "Describe a service under the tabulated list entry."
  (interactive)
  (openrc--describe (aref (tabulated-list-get-entry) 0)))


;; Stopping and starting services

(defun openrc--toggle (service started?)
  "Start or stop a SERVICE depending on STARTED? state."
  (openrc--async-shell-command
   'privileged
   openrc-rc-service-command
   service
   (if started? "stop" "start") "--verbose"))

(defun openrc-toggle-entry ()
  "Start or stop a service under the tabulated list entry depending on state."
  (interactive)
  (let ((service (aref (tabulated-list-get-entry) 0)))
    (openrc--toggle service (openrc--service-started? service))))

(defun openrc--restart (service)
  "Restart a SERVICE."
  (openrc--async-shell-command
   'privileged openrc-rc-service-command service "restart" "--verbose"))

(defun openrc-restart-entry ()
  "Restart a service under the tabulated list entry."
  (interactive)
  (openrc--restart (aref (tabulated-list-get-entry) 0)))


;; Adding and removing services from runlevels

(defconst openrc--runlevels
  '("boot" "default" "nonetwork" "shutdown" "sysinit")
  "List of available runlevels.")

(defun openrc--read-runlevel ()
  "Read a runlevel selected by the user."
  (completing-read "Runlevel:" openrc--runlevels))

(defun openrc--add (service runlevel)
  "Add a SERVICE to a RUNLEVEL."
  (openrc--async-shell-command
   'privileged openrc-rc-update-command "add" service runlevel "--verbose" ))

(defun openrc-add-entry ()
  "Add a service under the tabulated list entry to a runlevel."
  (interactive)
  (openrc--add
   (aref (tabulated-list-get-entry) 0) (openrc--read-runlevel)))

(defun openrc--del (service runlevel)
  "Remove a SERVICE from a RUNLEVEL."
  (openrc--async-shell-command
   'privileged openrc-rc-update-command "del" service runlevel "--verbose"))

(defun openrc-del-entry ()
  "Remove a service under the tabulated list entry from a runlevel."
  (interactive)
  (openrc--del
   (aref (tabulated-list-get-entry) 0) (openrc--read-runlevel)))


;; Mode

(defvar openrc-services-menu-mode-hook nil
  "Hook for `openrc-services-menu' major mode.")

(defvar openrc-services-menu-mode-map
  (let ((openrc-services-menu-mode-map (make-keymap)))
    (define-key
      openrc-services-menu-mode-map (kbd "/") #'isearch-forward)
    (define-key openrc-services-menu-mode-map (kbd "e")
      #'openrc-describe-entry)
    (define-key openrc-services-menu-mode-map (kbd "a")
      #'openrc-add-entry)
    (define-key openrc-services-menu-mode-map (kbd "d")
      #'openrc-del-entry)
    (define-key openrc-services-menu-mode-map (kbd "g")
      #'openrc-refresh-services)
    (define-key openrc-services-menu-mode-map (kbd "r")
      #'openrc-restart-entry)
    (define-key openrc-services-menu-mode-map (kbd "t")
      #'openrc-toggle-entry)
    openrc-services-menu-mode-map)
  "Key map for `openrc-services-menu' major mode.")


(easy-menu-define openrc-services-menu-menu openrc-services-menu-mode-map
  "Menu for `el-fetch-mode'."
  '("OpenRC"
    ["Refresh" openrc-refresh-services]
    ["Describe service" openrc-describe-entry]
    ["Restart service" openrc-restart-entry]
    ["Toggle service" openrc-toggle-entry]
    ["Add to runlevel" openrc-add-entry]
    ["Delete from runlevel" openrc-del-entry]
    ["Quit" quit-window]
    ["Help" describe-mode]))

(define-derived-mode openrc-services-menu-mode tabulated-list-mode
  "OpenRC Services Menu"
  "Major mode for listing the OpenRC services."
  (setq tabulated-list-format
        [("Service"  30 t)
         ("Started"  10 t)
         ("Runlevel" 20 t)])
  (setq tabulated-list-sort-key (cons "Runlevel" nil))
  (run-hooks 'openrc-services-menu-mode-hook)
  (use-local-map openrc-services-menu-mode-map))


;; Main provided features

;;;###autoload
(defun openrc-list-services ()
  "Display a list of OpenRC services."
  (interactive)
  (let ((buffer (get-buffer-create "*OpenRC Services*")))
    (with-current-buffer buffer
      (openrc-services-menu-mode)
      (openrc-refresh-services))
    (display-buffer buffer)))


(provide 'openrc)



;;; openrc.el ends here