1 ;;; vmd.el --- vmd interaction mode                  -*- lexical-binding: t; -*-
2 
3 ;; Copyright (C) 2021  Omar Polo
4 
5 ;; Author: Omar Polo <op@omarpolo.com>
6 ;; Keywords: tools
7 ;; Version: 0.1.0
8 ;; Package-Requires: ((transient "0.3.4"))
9 
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14 
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19 
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
22 
23 ;;; Commentary:
24 
25 ;; vmd.el is an interface to list and manage OpenBSD' vmd virtual
26 ;; machines.
27 ;;
28 ;; To start, run `M-x vmd RET' to bring up a *vmd* buffer with the list
29 ;; of virtual machines.  Then press `x' to bring up a transient with
30 ;; the action aviable.
31 
32 ;;; Code:
33 
34 (require 'term)
35 (require 'transient)
36 
37 (defgroup vmd nil
38   "Vmd."
39   :group 'vmd)
40 
41 (defcustom vmd-vmctl-cmd "vmctl"
42   "Path to the vmctl command to use."
43   :type 'string)
44 
45 (defcustom vmd-console-function #'vmd-run-in-term
46   "Function to use for the `vmd-console' command.
47 It takes two arguments, the string name and the cmd arguments
48 list, and should pop a buffer with a terminal running the
49 commands in cmd."
50   :type 'function)
51 
52 (defun vmd-run-in-term (name cmd)
53   "Run CMD inside a term buffer called NAME."
54   (pop-to-buffer (apply #'term-ansi-make-term
55                         (concat "*" name "*")
56                         (car cmd) nil (cdr cmd))))
57 
58 (defun vmd--update-table ()
59   "Update the `tabulated-list-mode' with the list of virtual machines."
60   (let ((columns [("ID"     3  t)
61                   ("PID"    5  nil)
62                   ("VCPUS"  5  nil)
63                   ("MAXMEM" 6  nil)
64                   ("CURMEM" 6  nil)
65                   ("TTY"    10 t)
66                   ("OWNER"  8  t)
67                   ("STATE"  8  t)
68                   ("NAME"   30 t)])
69         (rows (mapcar (lambda (x) `(,(car x) ,(apply #'vector x)))
70                       (mapcar (lambda (x)
71                                 (split-string x nil t))
72                               (cdr
73                                (split-string (shell-command-to-string
74                                               (concat vmd-vmctl-cmd " status"))
75                                              "\n" t))))))
76     (setq tabulated-list-format columns
77           tabulated-list-entries rows)
78     (tabulated-list-init-header)
79     (tabulated-list-print)))
80 
81 (defun vmd--vm-at-point ()
82   "Return the vm name at point."
83   (unless (derived-mode-p 'vmd-mode)
84     (error "Not in vmd-mode"))
85   (let* ((row (tabulated-list-get-entry))
86          (len (length row)))
87     (when (or (null row)
88               (= len 0))
89       (error "No vm at point"))
90     (aref row (1- len))))
91 
92 (defun vmd--vmctl (&rest args)
93   "Run a vmctl command with ARGS."
94   (shell-command (mapconcat #'shell-quote-argument (cons vmd-vmctl-cmd args) " ")))
95 
96 (defun vmd-console (vm)
97   "Open a console for the VM at point."
98   (interactive (list (vmd--vm-at-point)) vmd-mode)
99   (funcall vmd-console-function
100            (concat "vmd console " vm)
101            (mapcar #'shell-quote-argument
102                    (list vmd-vmctl-cmd "console" vm))))
103 
104 (defun vmd-pause (vm)
105   "Pause the VM at point."
106   (interactive (list (vmd--vm-at-point)) vmd-mode)
107   (vmd--vmctl "pause" vm)
108   (vmd--update-table))
109 
110 (defun vmd-start (vm)
111   "Start the VM at point."
112   (interactive (list (vmd--vm-at-point)) vmd-mode)
113   (vmd--vmctl "start" vm)
114   (vmd--update-table))
115 
116 (defun vmd-stop (vm)
117   "Stop the VM at point."
118   (interactive (list (vmd--vm-at-point)) vmd-mode)
119   (vmd--vmctl "stop" vm)
120   (vmd--update-table))
121 
122 (defun vmd-unpause (vm)
123   "Unpause the VM at point."
124   (interactive (list (vmd--vm-at-point)) vmd-mode)
125   (vmd--vmctl "unpause" vm)
126   (vmd--update-table))
127 
128 (transient-define-prefix vmd--transient ()
129   "Vmd."
130   ["Action"
131    [("c" "console"    vmd-console)
132     ("P" "pause"      vmd-pause)
133     ("s" "start"      vmd-start)
134     ("S" "stop"       vmd-stop)
135     ("u" "unpause"    vmd-unpause)]])
136 
137 (defvar vmd-mode-map
138   (let ((m (make-sparse-keymap)))
139     (define-key m (kbd "c") #'vmd-console)
140     (define-key m (kbd "P") #'vmd-pause) ; don't conflict with previous-line
141     (define-key m (kbd "s") #'vmd-start)
142     (define-key m (kbd "S") #'vmd-stop)
143     (define-key m (kbd "u") #'vmd-unpause)
144 
145     ;; one transient to rule them all
146     (define-key m (kbd "x") #'vmd--transient)
147     m))
148 
149 (define-derived-mode vmd-mode tabulated-list-mode "vmd"
150   "Vmd mode."
151   (vmd--update-table)
152   (add-hook 'tabulated-list-revert-hook #'vmd--update-table nil t))
153 
154 (defun vmd ()
155   "Start vmd."
156   (interactive)
157   (switch-to-buffer "*vmd*")
158   (vmd-mode))
159 
160 (provide 'vmd)
161 ;;; vmd.el ends here