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