changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: add cli/tools/wg

changeset 589: 16a3cdc06cbc
parent 588: 0552341ac196
child 590: 71c05868c4e7
author: Richard Westhaver <ellis@rwest.io>
date: Mon, 12 Aug 2024 21:16:14 -0400
files: lisp/lib/cli/cli.asd lisp/lib/cli/tools/pkg.lisp lisp/lib/cli/tools/wg.lisp lisp/std/os.lisp lisp/std/pkg.lisp
description: add cli/tools/wg
     1.1--- a/lisp/lib/cli/cli.asd	Mon Aug 12 18:32:35 2024 -0400
     1.2+++ b/lisp/lib/cli/cli.asd	Mon Aug 12 21:16:14 2024 -0400
     1.3@@ -19,6 +19,7 @@
     1.4                  (:file "pacman" :depends-on ("pkg"))
     1.5                  (:file "cc" :depends-on ("pkg"))
     1.6                  (:file "systemd" :depends-on ("pkg"))
     1.7+                 (:file "wg" :depends-on ("pkg"))
     1.8                  (:file "cargo" :depends-on ("pkg"))
     1.9                  (:file "sbcl" :depends-on ("pkg"))))
    1.10                (:module "clap"
     2.1--- a/lisp/lib/cli/tools/pkg.lisp	Mon Aug 12 18:32:35 2024 -0400
     2.2+++ b/lisp/lib/cli/tools/pkg.lisp	Mon Aug 12 21:16:14 2024 -0400
     2.3@@ -55,3 +55,15 @@
     2.4    :with-sbcl
     2.5    :*sbcl-runtime-options*
     2.6    :*sbcl-toplevel-options*))
     2.7+
     2.8+(defpackage :cli/tools/wg
     2.9+  (:use :cl :std :cli/env)
    2.10+  (:import-from :std/os :with-umask)
    2.11+  (:export
    2.12+   :*wg*
    2.13+   :run-wg
    2.14+   :wg-error
    2.15+   :wg-generate-key-files
    2.16+   :wg-generate-keys
    2.17+   :wg-public-key
    2.18+   :wg-private-key))
     3.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2+++ b/lisp/lib/cli/tools/wg.lisp	Mon Aug 12 21:16:14 2024 -0400
     3.3@@ -0,0 +1,53 @@
     3.4+;;; wg.lisp --- WireGuard Tools
     3.5+
     3.6+;; CLI Access to wg* tools from lisp. Requires the wireguard package.
     3.7+
     3.8+;;; Code:
     3.9+(in-package :cli/tools/wg)
    3.10+(deferror cc-error (simple-error error) ())
    3.11+
    3.12+(defun wg-error (fmt &rest args)
    3.13+  (error 'wg-error :format-arguments args :format-control fmt))
    3.14+
    3.15+(defparameter *wg* (find-exe "wg"))
    3.16+
    3.17+(defun run-wg* (args &optional (output *standard-output*) input)
    3.18+  (let ((proc (if input
    3.19+                  (sb-ext:run-program *wg* (or args nil) :output :stream :input input)
    3.20+                  (sb-ext:run-program *wg* (or args nil) :output :stream))))
    3.21+  (with-open-stream (s (sb-ext:process-output proc))
    3.22+    (loop for l = (read-line s nil nil)
    3.23+          while l
    3.24+          do (write-string l  output)))
    3.25+  (if (eq 0 (sb-ext:process-exit-code proc))
    3.26+      nil
    3.27+      (wg-error "WG command failed: ~A ~A" *wg* (or args "")))))
    3.28+
    3.29+(defun run-wg (&rest args)
    3.30+  (run-wg* args))
    3.31+
    3.32+(defun wg-private-key ()
    3.33+  (with-output-to-string (s)
    3.34+    (run-wg* '("genkey") s)))
    3.35+
    3.36+(defun wg-public-key (private-key)
    3.37+  (with-output-to-string (public-key)
    3.38+    (with-input-from-string (s private-key)
    3.39+      (run-wg* '("pubkey") public-key s))))
    3.40+
    3.41+(defun wg-generate-keys ()
    3.42+  "Generate a wireguard keypair, returning (values PUBLIC-KEY PRIVATE-KEY)."
    3.43+  (let* ((privkey (wg-private-key))
    3.44+         (pubkey (wg-public-key privkey)))
    3.45+    (values pubkey privkey)))
    3.46+
    3.47+
    3.48+(defun wg-generate-key-files (&optional (private "private.key") (public "public.key"))
    3.49+  (multiple-value-bind (pubkey privkey) (wg-generate-keys)
    3.50+    (with-umask #o077
    3.51+      (log:trace! "setting umask to 077")
    3.52+      (with-open-file (f public :direction :output)
    3.53+        (write-line pubkey f))
    3.54+      (with-open-file (f private :direction :output)
    3.55+        (write-line privkey f)))))
    3.56+
     4.1--- a/lisp/std/os.lisp	Mon Aug 12 18:32:35 2024 -0400
     4.2+++ b/lisp/std/os.lisp	Mon Aug 12 21:16:14 2024 -0400
     4.3@@ -26,3 +26,12 @@
     4.4                                         (sb-posix:group-name g)
     4.5                                         (sb-posix:group-mem g))
     4.6                                   r))))
     4.7+
     4.8+(defmacro with-umask (mask &body body)
     4.9+  "Temporarily set the system-wide umask for the extent of BODY."
    4.10+  (with-gensyms (umask)
    4.11+    `(let ((,umask (sb-posix:umask ,mask)))
    4.12+       (unwind-protect (progn ,@body)
    4.13+         (sb-posix:umask ,umask)))))
    4.14+
    4.15+;; (with-umask #o22 nil)
     5.1--- a/lisp/std/pkg.lisp	Mon Aug 12 18:32:35 2024 -0400
     5.2+++ b/lisp/std/pkg.lisp	Mon Aug 12 21:16:14 2024 -0400
     5.3@@ -385,9 +385,11 @@
     5.4 
     5.5 (defpkg :std/os
     5.6   (:use :cl)
     5.7+  (:import-from :std/macs :with-gensyms)
     5.8   (:export
     5.9    :list-all-users
    5.10-   :list-all-groups))
    5.11+   :list-all-groups
    5.12+   :with-umask))
    5.13 
    5.14 (defpkg :std/file
    5.15   (:use :cl)