Initial.

A  .guix-authorizations
A  .guix-channel
A  COPYING
A  README
A  whispers/packages/dict.scm
A  whispers/packages/doc.scm
A  whispers/packages/pdf.scm
A  whispers/packages/sh.scm
A  whispers/packages/whispers.scm
A  whispers/services/console.scm
A  whispers/services/dict.scm
A  whispers/services/finance.scm
A  whispers/services/gps.scm
A  whispers/services/proton.scm
A  whispers/services/ssh-agent.scm
A  whispers/services/ssh-tunneler.scm
A  whispers/services/whispers.scm
A  whispers/services/whispers/finance.scm
A  whispers/services/whispers/gps.scm
A  whispers/services/whispers/mail.scm
A  whispers/services/whispers/ssh.scm
A  whispers/services/whispers/vpn.scm
A  whispers/services/whispers/xdg.scm
A  whispers/tests/ssh-tunneler.scm

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

1 files changed, 89 insertions, 0 deletions

diff --git a/whispers/services/console.scm b/whispers/services/console.scm
new file mode 100644
index 0000000..bb72a22
--- /dev/null
+++ b/whispers/services/console.scm
@@ -0,0 +1,89 @@
+;;; 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 services console)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:use-module (gnu services)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu packages linux)
+  #:export (console-blank-configuration
+            console-blank-configuration?
+            make-console-blank-configuration
+            this-console-blank-configuration
+            console-blank-service-type))
+
+(define-record-type* <console-blank-configuration>
+  console-blank-configuration make-console-blank-configuration
+  console-blank-configuration?
+  this-console-blank-configuration
+  ;; A file-like object
+  (util-linux-package  console-blank-configuration-util-linux-package
+                        (default util-linux))
+  ;; An integer
+  (blank-time           console-blank-configuration-blank-time
+                        (default 10))
+  ;; An integer
+  (powerdown-time       console-blank-configuration-powerdown-time
+                        (default 10)))
+
+(define (console-blank-shepherd-services config)
+  "Return a list of one shepherd services setting up Linux console screen
+blanking and powerdown times, configurable by CONFIG, a record of the
+<console-blank-configuration> type."
+  (let ((util-linux (console-blank-configuration-util-linux-package config))
+        (blank (number->string
+                (console-blank-configuration-blank-time config)))
+        (powerdown (number->string
+                    (console-blank-configuration-powerdown-time config))))
+    (list
+     (shepherd-service
+      (documentation "Setup Linux console screen blanking and powerdown.")
+      (provision (list 'console-blank))
+
+      ;; Start after mingetty has been started on tty1
+      (requirement (list 'term-tty1 'console-font-tty1))
+
+      (start #~(lambda _
+                 (case (status:exit-val
+                        (system
+                         (string-append #$(file-append util-linux
+                                                       "/bin/setterm")
+                                        " --blank="
+                                        #$blank
+                                        " --powerdown="
+                                        #$powerdown
+                                        " </dev/tty1 >/dev/tty1")))
+                   ((0) #t)
+                   (else #f))))
+      (stop #~(const #f))
+      (respawn? #f)))))
+
+(define console-blank-service-type
+  (service-type
+   (name 'console-blank)
+   (description "Setup screen blanking and powerdown on the Linux console")
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             console-blank-shepherd-services)
+          (service-extension
+           profile-service-type
+           (lambda (config)
+             (list
+              (console-blank-configuration-util-linux-package config))))))
+   (default-value (console-blank-configuration))))