Add stump-nm, a StumpWM and NetworkManager integration module.

This module allows you to manage your Wi-Fi networks and VPN
connections from within StumpWM itself. It is intentionally pretty
bare-bones in features, in that it allows you to enable/disable
connections, and no more. It is not a replacement for `nmtui` and/or
`nmcli`.

It offers 2 commands:

- `nm-list-wireless-networks`
- `nm-list-vpn-connections`

Each command offers a menu where you can select a WiFi or VPN
connection.

More information in the README.org.

README.org

@@ -118,6 +118,7 @@ Advertise your module here, open a PR and include a org-mode link!
 - [[./util/screenshot/README.org][screenshot]] :: Takes screenshots and stores them as png files
 - [[./util/searchengines/README.org][searchengines]] :: Allows searching text using prompt or clipboard contents with various search engines
 - [[./util/shell-command-history/README.org][shell-command-history]] :: Save and load the stumpwm::*input-shell-history* to a file
+- [[./util/stump-nm/README.org][stump-nm]] :: StumpWM integration with NetworkManager
 - [[./util/surfraw/README.org][surfraw]] :: Integrates surfraw with stumpwm.
 - [[./util/swm-emacs/README.org][swm-emacs]] :: A set of utilities for launching the beast.
 - [[./util/swm-gaps/README.org][swm-gaps]] :: Pretty (useless) gaps for StumpWM

util/stump-nm/README.org

@@ -0,0 +1,64 @@
+* stump-nm
+
+Aka "StumpWM and NetworkManager integration".
+
+This module allows you to manage your Wi-Fi networks and VPN connections from
+within StumpWM itself. It is intentionally pretty bare-bones in features, in
+that it allows you to enable/disable connections, and no more. It is not a
+replacement for =nmtui= and/or =nmcli=.
+
+It offers 2 commands:
+
+- =nm-list-wireless-networks=
+- =nm-list-vpn-connections=
+
+Each command offers a menu where you can select a WiFi or VPN connection.
+
+An item in the menu may be prepended with a symbol to help readability.
+
+Those symbols are:
+
+- =*=: this network is active and connected.
+- =?=: this network is in the process of connecting.
+
+** Requirements
+
+NetworkManager must be installed. You can check if you have it by running this
+on a modern system:
+
+#+begin_src shell
+  systemctl status NetworkManager
+#+end_src
+
+It should show something akin to:
+
+#+begin_src shell
+  ● NetworkManager.service - Network Manager
+       Loaded: loaded (/usr/lib/systemd/system/NetworkManager.service; enabled; vendor preset: enabled)
+       Active: active (running) since Sat 2021-01-16 21:45:56 CET; 1 day 23h ago
+	 Docs: man:NetworkManager(8)
+     Main PID: 1375 (NetworkManager)
+	Tasks: 3 (limit: 38150)
+       Memory: 13.5M
+	  CPU: 52.206s
+       CGroup: /system.slice/NetworkManager.service
+	       └─1375 /usr/sbin/NetworkManager --no-daemon
+#+end_src
+
+If you don't have this, this module is not for you.
+
+** Usage
+
+Put the following in your =~/.stumpwmrc=:
+
+#+begin_src lisp
+  (load-module "stump-nm")
+#+end_src
+
+From this point on, 2 commands become available, and you can add keybindings for
+them, such as:
+
+#+begin_src lisp
+  ; This maps <prefix> C-w to list the wireless networks.
+  (define-key *root-map* (kbd "C-w") "nm-list-wireless-networks")
+#+end_src

util/stump-nm/nm-api.lisp

@@ -0,0 +1,126 @@
+(in-package #:stump-nm)
+
+(defmacro prog1-let (declaration &body body)
+  `(let (,declaration)
+     (prog1 ,(first declaration)
+       ,@body)))
+
+(defvar *service* "org.freedesktop.NetworkManager")
+
+(defun getprop (object prop)
+  "Thin wrapper over DBUS:GET-PROPERTY that works with our DBUS-OBJECT instances."
+  (get-property (bus object) *service* (path object) (interface object) prop))
+
+(defun dbus-call (object method &rest args)
+  "Thin wrapper over DBUS:OBJECT-INVOKE that works with our DBUS-OBJECT instances."
+  (let ((dbus-object (make-object-from-introspection
+                      (bus-connection (bus object))
+                      (path object)
+                      *service*)))
+    (apply #'object-invoke dbus-object (interface object) method args)))
+
+(defclass dbus-object ()
+  ((path :initarg :path :reader path)
+   (bus :initarg :bus :reader bus)
+   (interface :reader interface)))
+
+(defclass root-object (dbus-object)
+  ((path :initform "/org/freedesktop/NetworkManager")
+   (interface :initform "org.freedesktop.NetworkManager")))
+
+(defun make-root (bus)
+  (make-instance 'root-object :bus bus))
+
+(defclass settings (dbus-object)
+  ((interface :initform "org.freedesktop.NetworkManager.Settings")))
+
+(defclass setting-connection (dbus-object)
+  ((interface :initform "org.freedesktop.NetworkManager.Settings.Connection")))
+
+(defun get-settings (root)
+  (make-instance 'settings
+                 :path "/org/freedesktop/NetworkManager/Settings"
+                 :bus (bus root)))
+
+(defclass connection-settings ()
+  ((id :initarg :id :reader id)
+   (uuid :initarg :uuid :reader uuid)
+   (connection :initarg :connection :reader connection)
+   (type :initarg :type :reader cs-type)))
+
+(defun get-connection-settings (settings)
+  (mapcar (lambda (connection-path)
+            (block lambda
+              (let* ((connection (make-instance 'setting-connection
+                                                :path connection-path
+                                                :bus (bus settings)))
+                     (connection-settings (dbus-call connection "GetSettings")))
+                (dolist (setting connection-settings)
+                  (when (string= (first setting) "connection")
+                    (return-from lambda
+                      (let ((settings (second setting)))
+                        (make-instance
+                         'connection-settings
+                         :connection connection
+                         :id (first (assoc-value settings "id" :test #'string=))
+                         :uuid (first (assoc-value settings "uuid" :test #'string=))
+                         :type (first (assoc-value settings "type" :test #'string=))))))))))
+          (getprop settings "Connections")))
+
+(defclass wireless-device (dbus-object)
+  ((interface :initform "org.freedesktop.NetworkManager.Device.Wireless")))
+
+(defclass access-point (dbus-object)
+  ((interface :initform "org.freedesktop.NetworkManager.AccessPoint")
+   (active :initarg :active :reader active)
+   (ssid :accessor ssid)
+   (frequency :accessor frequency)
+   (strength :accessor strength)))
+
+(defun device-access-points (device)
+  (with-introspected-object (object (bus device) (path device) *service*)
+    (let ((active-access-point (getprop device "ActiveAccessPoint")))
+      (mapcar (lambda (access-point-path)
+                (prog1-let (ap (make-instance 'access-point
+                                              :path access-point-path
+                                              :bus (bus device)
+                                              :active (string= access-point-path
+                                                               active-access-point)))
+                  (setf (ssid ap) (access-point-ssid ap)
+                        (frequency ap) (getprop ap "Frequency")
+                        (strength ap) (getprop ap "Strength"))))
+              (object (interface device) "GetAllAccessPoints")))))
+
+(defun access-point-ssid (ap)
+  (babel:octets-to-string
+   (let ((ssid (getprop ap "Ssid")))
+     (make-array (length ssid) :element-type '(unsigned-byte 8) :initial-contents ssid))))
+
+(defclass active-connection (dbus-object)
+  ((interface :initform "org.freedesktop.NetworkManager.Connection.Active")
+   (uuid :accessor uuid)
+   (state :accessor state)))
+
+(defun get-active-connections (root)
+  (mapcar (lambda (connection-path)
+            (make-active-connection root connection-path))
+          (getprop root "ActiveConnections")))
+
+(defun make-active-connection (root connection-path)
+  (prog1-let (active-connection (make-instance
+                                 'active-connection
+                                 :path connection-path
+                                 :bus (bus root)))
+    (setf (uuid active-connection) (getprop active-connection "Uuid")
+          (state active-connection) (getprop active-connection "State"))))
+
+(defun primary-connection (root)
+  (make-active-connection root (getprop root "PrimaryConnection")))
+
+(defun connection-devices (connection)
+  (mapcar
+   (lambda (device-path)
+     (make-instance 'wireless-device
+                    :bus (bus connection)
+                    :path device-path))
+   (getprop connection "Devices")))

util/stump-nm/package.lisp

@@ -0,0 +1,3 @@
+(defpackage #:stump-nm
+  (:use #:cl #:alexandria #:dbus)
+  (:export #:nm-list-wireless-networks #:nm-list-vpn-connections))

util/stump-nm/stump-nm.asd

@@ -0,0 +1,9 @@
+(defsystem "stump-nm"
+  :serial t
+  :description "StumpWM integration with NetworkManager"
+  :author "Florian Margaine <florian@margaine.com>"
+  :license "GPLv3"
+  :depends-on ("alexandria" "babel" "stumpwm" "dbus")
+  :components ((:file "package")
+               (:file "nm-api")
+               (:file "stump-nm")))

util/stump-nm/stump-nm.lisp

@@ -0,0 +1,89 @@
+(in-package #:stump-nm)
+
+(stumpwm:defcommand nm-list-wireless-networks () ()
+  (with-open-bus (bus (system-server-addresses))
+    (let* ((root (make-root bus))
+           (primary-connection (primary-connection root))
+           (is-connected (= (getprop root "State") 70))
+           (is-wireless (search "wireless" (getprop primary-connection "Type")))
+           (device (first (connection-devices primary-connection))))
+      (when (and is-connected (not is-wireless))
+        (error "Wired connection is established"))
+      (let ((selected
+              (stumpwm:select-from-menu
+               (stumpwm:current-screen)
+               (mapcar (lambda (ap) (list (render-ap ap primary-connection) ap))
+                       (device-access-points device)))))
+        (when selected
+          (let ((ap (second selected)))
+            (dbus-call root "DeactivateConnection" (path primary-connection))
+            (unless (active ap)
+              (dbus-call root "ActivateConnection" "/" (path device) (path ap))))))))
+  nil)
+
+(stumpwm:defcommand nm-list-vpn-connections () ()
+  (with-open-bus (bus (system-server-addresses))
+    (let* ((root (make-root bus))
+           (settings (get-settings root))
+           (all-connections (get-connection-settings settings))
+           (vpn-connections (remove-if-not #'is-vpn-connection all-connections))
+           (active-connections (get-active-connections root))
+           (active-connections-uuids (mapcar #'uuid active-connections))
+           (selected (stumpwm:select-from-menu
+                      (stumpwm:current-screen)
+                      (mapcar (lambda (connection)
+                                (let ((is-active
+                                        (member (uuid connection)
+                                                active-connections-uuids
+                                                :test #'string=)))
+                                  (list
+                                   (render-vpn-connection
+                                    connection
+                                    (when is-active
+                                      (find-active-connection-by-uuid
+                                       active-connections
+                                       (uuid connection))))
+                                   connection
+                                   is-active)))
+                              vpn-connections))))
+      (when selected
+        (let ((connection (second selected))
+              (was-active (third selected)))
+          (if was-active
+              (let ((active-connection (find-active-connection-by-uuid
+                                        active-connections
+                                        (uuid connection))))
+                (dbus-call root "DeactivateConnection" (path active-connection)))
+              (dbus-call root "ActivateConnection"
+                         (path (connection connection)) "/" "/"))))))
+  nil)
+
+(defun find-active-connection-by-uuid (active-connections uuid)
+  (find-if (lambda (active-connection)
+             (string= (uuid active-connection) uuid))
+           active-connections))
+
+(defun is-vpn-connection (c)
+  (string= (cs-type c) "vpn"))
+
+(defun render-vpn-connection (connection active-connection)
+  (format nil "~A ~A"
+          (if active-connection
+              (active-connection-state-indicator (state active-connection))
+              " ")
+          (id connection)))
+
+(defun render-ap (ap connection)
+  (format nil "~A ~A (~AMHz) ~A%"
+          (if (active ap)
+              (active-connection-state-indicator (state connection))
+              " ")
+          (ssid ap) (frequency ap) (strength ap)))
+
+(defun active-connection-state-indicator (state)
+  (ecase state
+    (0 "?")
+    (1 "?")
+    (2 "*")
+    (3 " ")
+    (4 " ")))