[bug#68007] services: Add doas service.

From df03ab95649efe2e2b3ee9ad8e31518206eb6a68 Mon Sep 17 00:00:00 2001
From: Luis Guilherme Coelho <lgcoelho@disroot.org>
Date: Sun, 24 Dec 2023 13:27:36 -0300
Subject: [PATCH] services: Add doas service.

---
 gnu/services/admin.scm | 174 ++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 173 insertions(+), 1 deletion(-)

diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm
index 0b325fddb1..5bb598300e 100644
--- a/gnu/services/admin.scm
+++ b/gnu/services/admin.scm
@@ -3,6 +3,7 @@ 
 ;;; Copyright © 2016-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
+;;; Copyright © 2023 Luis Guilherme Coelho <lgcoelho@disroot.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,6 +38,8 @@  (define-module (gnu services admin)
   #:use-module (guix packages)
   #:use-module (guix records)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
   #:export (%default-rotations
@@ -93,7 +96,29 @@  (define-module (gnu services admin)
             unattended-upgrade-configuration-services-to-restart
             unattended-upgrade-configuration-system-expiration
             unattended-upgrade-configuration-maximum-duration
-            unattended-upgrade-configuration-log-file))
+            unattended-upgrade-configuration-log-file
+
+            doas-service-type
+
+            permit
+            make-permit-statement
+            permit-statement?
+            permit-statement-args
+            permit-statement-as-user
+            permit-statement-command
+            permit-statement-identity
+            permit-statement-keepenv?
+            permit-statement-nolog?
+            permit-statement-nopass?
+            permit-statement-persist?
+            permit-statement-setenv
+
+            deny
+            make-deny-statement
+            deny-statement?
+            deny-statement-args
+            deny-statement-as-user
+            deny-statement-command))
 
 ;;; Commentary:
 ;;;
@@ -537,4 +562,151 @@  (define unattended-upgrade-service-type
     "Periodically upgrade the system from the current configuration.")
    (default-value (unattended-upgrade-configuration))))
 
+
+;;;
+;;; Doas configuration.
+;;;
+
+;; Dummy serializers, just to avoid warnings
+(define empty-serializer
+  (@@ (gnu services configuration) empty-serializer))
+(define serialize-string empty-serializer)
+(define serialize-list-of-strings empty-serializer)
+
+(define assoc-list? (list-of pair?))
+(define (serialize-assoc-list field-name val)
+  (map (match-lambda
+         ((var . #t) var)
+         ((var . #f) (string-append "-" var))
+         ((var . value) (format #f "~a=~a" var value)))
+       val))
+(define-maybe list-of-strings)
+(define-maybe assoc-list)
+(define-maybe string)
+
+(define-configuration/no-serialization permit-statement
+  (nopass?
+   (boolean #f)
+   "Whether the user should be permitted to run the command without a password.")
+  (nolog?
+   (boolean #f)
+   "Wheter sucessful command exection should be logged.")
+  (persist?
+   (boolean #f)
+   "After the user sucessfully authenticates, do not ask for a password again
+for some time.")
+  (keepenv?
+   (boolean #f)
+   "Wheter environment variables other than those listed in doas should be
+retained when creating the enviroment for the new process.")
+  (identity
+   string
+   "The username to match. Groups may be specified by prepending a colon ':'.")
+  (as-user
+   maybe-string
+   "The target user the running user is allowed to run the command as.  The
+default is all users.")
+  (command
+   maybe-string
+   "The command the user is allowed to run.  The default is all commands.
+It's preferable to have commands specifieds by absolute paths. If a relative
+path is specified, only a restricted PATH will be searched.")
+  (args
+   maybe-list-of-strings
+   "Arguments to command.  The command arguments provided by the user need to
+match those specified.  The keyword args alone means that command must be run
+without arguments.")
+  (setenv
+   maybe-assoc-list
+   "Set the specified variables.  Variables may also be removed by setting them
+to #f, or simply exported, by setting them to #t.  If the first character of the
+value is ‘$’ then the value to be set is taken from the existing environment
+variable with the given name."))
+(define-syntax-rule (permit entry ...)
+  (permit-statement entry ...))
+
+(define (unset? val)
+  "Tests if VAL is unset."
+  (equal? val (@@ (gnu services configuration)
+                  %unset-value)))
+
+(define* (if-set val #:optional (proc identity))
+  "Apply PROC to VAL if VAL is not unset, otherwise returns #f."
+  (if (not (unset? val)) (proc val) #f))
+
+(define serialize-permit-statement
+  (match-record-lambda <permit-statement>
+    (identity as-user command args setenv keepenv? nopass? nolog? persist?)
+    (format #f "permit ~:[~;keepenv ~]~
+                       ~:[~;nopass ~]~
+                       ~:[~;nolog ~]~
+                       ~:[~;persist ~]~
+                       ~@[setenv {~{ ~a~} } ~]~
+                       ~a~@[ as ~a~]~
+                         ~@[ cmd ~a~]~
+                         ~@[ args~{ ~a~}~]~%"
+            keepenv?
+            nopass?
+            nolog?
+            persist?
+            (if-set setenv (cut serialize-assoc-list #f <>))
+            identity
+            (if-set as-user)
+            (if-set command)
+            (if-set args))))
+
+(define-configuration/no-serialization deny-statement
+  (identity
+   string
+   "The username to match. Groups may be specified by prepending a colon ':'.")
+  (as-user
+   maybe-string
+   "The target user the running user is allowed to run the command as.  The
+default is all users.")
+  (command
+   maybe-string
+   "The command the user is allowed to run.  The default is all commands.
+It's preferable to have commands specifieds by absolute paths. If a relative
+path is specified, only a restricted PATH will be searched.")
+  (args
+   maybe-string
+   "Arguments to command.  The command arguments provided by the user need to
+match those specified.  The keyword args alone means that command must be run
+without arguments."))
+(define-syntax-rule (deny entry ...)
+  (deny-statement entry ...))
+
+(define serialize-deny-statement
+  (match-record-lambda <deny-statement>
+    (identity as-user command args)
+    (format #f "deny ~a~@[ as ~a~]~@[ cmd ~a~]~@[ args~{ ~a~}~]~%"
+            identity
+            (if-set as-user)
+            (if-set command)
+            (if-set args))))
+
+(define (doas-config-file config)
+  (plain-file "doas.conf"
+    (apply string-append
+           (map (lambda (s)
+                  (cond ((permit-statement? s)
+                         (serialize-permit-statement s))
+                        ((deny-statement?   s)
+                         (serialize-deny-statement s))))
+                config))))
+
+(define (doas-etc-service config)
+  `(("doas.conf" ,(doas-config-file config))))
+
+(define doas-service-type
+  (service-type (name 'doas-service)
+                (extensions
+                 (list (service-extension
+                         etc-service-type
+                         doas-etc-service)))
+                (compose (compose concatenate reverse))
+                (extend append)
+                (default-value '())
+                (description "Set /etc/doas.conf")))
+
 ;;; admin.scm ends here
-- 
2.41.0