Initial.HEADv0.1trunk

A  .gitignore
A  AUTHORS
A  COPYING
A  ChangeLog
A  HACKING
A  Makefile.am
A  NEWS
A  README
A  build-aux/test-driver.scm
A  configure.ac
A  guix.scm
A  hall.scm
A  pre-inst-env.in
A  scripts/whispers.in
A  whispers.scm
A  whispers/hconfig.scm

Signed-off-by: Runciter <runciter@whispers-vpn.org>

1 files changed, 49 insertions, 0 deletions

diff --git a/whispers.scm b/whispers.scm
new file mode 100644
index 0000000..a736784
--- /dev/null
+++ b/whispers.scm
@@ -0,0 +1,49 @@
+;;; Whispers --- Stealth VPN and ssh tunneler
+;;; Copyright © 2024 Runciter <runciter@whispers-vpn.org>
+;;;
+;;; This file is part of Whispers.
+;;;
+;;; Whispers 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 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Whispers 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 Whispers.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (whispers)
+  #:export (whispers))
+
+(define herd-path "/run/current-system/profile/bin/herd")
+
+(define (strip-final-slash path)
+  "Strip the last character of the string PATH if it is a slash, and return
+the resulting string."
+  (let ((lgth (string-length path)))
+    (if (equal? "/" (substring path (- lgth 1) lgth))
+        (substring path 0 (- lgth 1))
+        path)))
+
+(define* (whispers #:key
+                   (lieutenant "/")
+                   (act '("status")))
+  "Call an herd sub-process to command the whispers lieutenant at the
+whispers path LIEUTENANT to perform the shepherd action described by the
+list of strings ACT of the form either (ACTION) or (ACTION SERVICE
+. ARGS), in which ARGS is optionally the emtpy list."
+  (let ((lieut (strip-final-slash lieutenant)))
+    (apply system*
+           (append (list herd-path
+                         "-s"
+                         (string-append "/run/whispers"
+                                        lieut
+                                        "/unix-sockets/"
+                                        (basename (string-append "/whispers"
+                                                                 lieut))
+                                        ".sock"))
+                           act))))