bug#26099: [PATCH] services: Add inetd-service-type.

[Thomas Danckaert]

Hi Guix,

this patch adds an inetd-service.  The service is configured using a list of 
<inetd-entry> records, which correspond to lines in the inetd.conf file 
(documented in the inetutils info manual).  The following example will start inetd 
with the built-in “echo” service, and with an smtp service, which uses ssh to tunnel 
smtp traffic to a server “smtp-server” behind a gateway “hostname”:

(service inetd-service-type
                           (list
                            (inetd-entry
                             (name "echo")
                             (socket-type 'stream)
                             (protocol "tcp")
                             (wait? #t)
                             (user "root")) ; no program and arguments fields required 
for inetd's "internal" services such as echo
                            (inetd-entry
                             (node "127.0.0.1")
                             (name "smtp")
                             (socket-type 'stream)
                             (protocol "tcp")
                             (wait? #f)
                             (user "root")
                             (program (file-append openssh "/bin/ssh"))
                             (arguments "-q -T -i /path/to/key -W smtp-server:25 
address@hidden"))))

This will run inetd with a config file containing these 2 lines::
<---------------------------------------------------------------------------->
echo stream tcp wait root internal internal
127.0.0.1:smtp stream tcp nowait root 
/gnu/store/kdn1099drrdd2xbypg8x006a0aknskx8-openssh-7.4p1/bin/ssh -q -T -i 
/path/to/key -W smtp-server:25 address@hidden
<---------------------------------------------------------------------------->

The configuration doesn't include an “escape hatch” option where the user can specify 
an arbitrary inetd.conf, but I think the current configuration method captures all 
possibilities, and inetd's configuration format is unlikely to change radically?  Or 
perhaps the (inetd-config-file) procedure can be exported, so users can either use 
the procedure with a list of <inetd-entry>'s, or directly pass a 
(mixed-text-file) or any other file-like.

Obviously documentation is still missing, but I wanted to wait for a first 
round of comments before writing the docs.  Let me know if I should already 
include them anyway.

Thomas

From 85b01d04d8b140ed3a1960b1678cc133367b916b Mon Sep 17 00:00:00 2001
From: Thomas Danckaert <address@hidden>
Date: Tue, 14 Mar 2017 18:12:34 +0100
Subject: [PATCH] services: Add inetd-service-type.

* gnu/services/networking.scm (<inetd-entry>): New record type.
(inetd-config-file, inetd-shepherd-service): New procedures.
(inetd-service-type): New variable.
---
 gnu/services/networking.scm | 64 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 64 insertions(+)

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 18bce2a2b..3fad77ab4 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016 Efraim Flashner <address@hidden>
 ;;; Copyright © 2016 John Darrington <address@hidden>
 ;;; Copyright © 2017 Clément Lassieur <address@hidden>
+;;; Copyright © 2017 Thomas Danckaert <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -61,6 +62,9 @@
             ntp-service
             ntp-service-type
 
+            inetd-entry
+            inetd-service-type
+
             tor-configuration
             tor-configuration?
             tor-hidden-service
@@ -429,6 +433,66 @@ make an initial adjustment of more than 1,000 seconds."
 
 
 ;;;
+;;; Inetd.
+;;;
+
+(define-record-type* <inetd-entry> inetd-entry make-inetd-entry
+  inetd-entry?
+  (node inetd-entry-node (default #f))   ;string or #f
+  (name inetd-entry-name)                ;string, from /etc/services
+  (socket-type inetd-entry-socket-type)  ;stream | dgram | raw | rdm | 
seqpacket
+  (protocol inetd-entry-protocol)        ;string, from /etc/protocols ("tcp", 
"udp", ...)
+  (wait? inetd-entry-wait? (default #t)) ;Boolean
+  (user inetd-entry-user)                ;string
+  (program inetd-entry-program           ;string or file-like
+           (default "internal"))
+  (arguments inetd-entry-arguments       ;string
+           (default "internal")))
+
+(define (inetd-config-file service-list)
+  (apply mixed-text-file "inetd.conf"
+         (fold-right ; The order of address lines in inetd.conf matters.
+          (lambda (s prev)
+            (append
+             (list
+              (let* ((node (inetd-entry-node s))
+                     (name (inetd-entry-name s))
+                     (socket
+                      (if node (string-append node ":" name) name))
+                     (type
+                      (match (inetd-entry-socket-type s)
+                        ((or 'stream 'dgram 'raw 'rdm 'seqpacket)
+                         (symbol->string (inetd-entry-socket-type s)))))
+                     (protocol (inetd-entry-protocol s))
+                     (wait (if (inetd-entry-wait? s) "wait" "nowait"))
+                     (user (inetd-entry-user s))
+                     (program (inetd-entry-program s))
+                     (args (inetd-entry-arguments s)))
+                #~(string-join
+                   (list #$@(list socket type protocol wait user program args))
+                   " "))
+              "\n") prev)) '() service-list)))
+
+(define (inetd-shepherd-service config)
+  (list
+   (shepherd-service
+    (documentation "Run inetd.")
+    (provision '(inetd))
+    (requirement '(user-processes networking syslogd))
+    (start #~(make-forkexec-constructor
+              (list (string-append #$inetutils "/libexec/inetd")
+                    #$(inetd-config-file config))
+              #:pid-file "/var/run/inetd.pid"))
+    (stop #~(make-kill-destructor)))))
+
+(define-public inetd-service-type
+  (service-type
+   (name 'inetd)
+   (extensions
+    (list (service-extension shepherd-root-service-type 
inetd-shepherd-service)))))
+
+
+;;;
 ;;; Tor.
 ;;;
 
-- 
2.11.1