[bug#44800] [PATCH 0/2] publish: Add Avahi support.

[bug#44800] [PATCH 0/2] publish: Add Avahi support.

[Mathieu Othacehe]

Hello,

Here are two patches adding Avahi support to "guix publish". When the
"--enable-avahi" option is passed to "guix publish", the server is advertised
on the local network.

Future patches will use this option to automatically add all the publish
servers on the local network to the daemon "substitute-urls" list.

Thanks,

Mathieu

Mathieu Othacehe (2):
  Add Avahi support.
  publish: Add avahi support.

 Makefile.am                         |   1 +
 configure.ac                        |   6 ++
 doc/guix.texi                       |   5 +
 gnu/packages/package-management.scm |   2 +
 guix/avahi.scm                      | 162 ++++++++++++++++++++++++++++
 guix/scripts/publish.scm            |  23 ++++
 guix/self.scm                       |   9 +-
 7 files changed, 206 insertions(+), 2 deletions(-)
 create mode 100644 guix/avahi.scm

-- 
2.29.2

[bug#44802] [PATCH 1/2] Add Avahi support.

[Mathieu Othacehe]

* guix/avahi.scm: New file.
* Makefile.am (MODULES): Add it.
* configure.ac: Add Guile-Avahi dependency.
* doc/guix.texi (Requirements): Document it.
* gnu/packages/package-management.scm (guix)[native-inputs]: Add
"guile-avahi",
[propagated-inputs]: ditto.
* guix/self.scm (specification->package): Add guile-avahi.
(compiled-guix): Ditto.
---
 Makefile.am                         |   1 +
 configure.ac                        |   6 ++
 doc/guix.texi                       |   1 +
 gnu/packages/package-management.scm |   2 +
 guix/avahi.scm                      | 162 ++++++++++++++++++++++++++++
 guix/self.scm                       |   9 +-
 6 files changed, 179 insertions(+), 2 deletions(-)
 create mode 100644 guix/avahi.scm

diff --git a/Makefile.am b/Makefile.am
index ea43650a14..7c716804c8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -73,6 +73,7 @@ include gnu/local.mk
 include po/doc/local.mk
 
 MODULES =					\
+  guix/avahi.scm				\
   guix/base16.scm				\
   guix/base32.scm				\
   guix/base64.scm				\
diff --git a/configure.ac b/configure.ac
index 6e718afdd1..307e8b361f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -161,6 +161,12 @@ if test "x$have_guile_lzlib" != "xyes"; then
   AC_MSG_ERROR([Guile-lzlib is missing; please install it.])
 fi
 
+dnl Check for Guile-Avahi.
+GUILE_MODULE_AVAILABLE([have_guile_avahi], [(avahi)])
+if test "x$have_guile_avahi" != "xyes"; then
+  AC_MSG_ERROR([Guile-Avahi is missing; please install it.])
+fi
+
 dnl Guile-newt is used by the graphical installer.
 GUILE_MODULE_AVAILABLE([have_guile_newt], [(newt)])
 
diff --git a/doc/guix.texi b/doc/guix.texi
index b7f1bc1f00..e2361c25e3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -827,6 +827,7 @@ Guile,, gnutls-guile, GnuTLS-Guile});
 or later;
 @item @uref{https://notabug.org/guile-zlib/guile-zlib, Guile-zlib};
 @item @uref{https://notabug.org/guile-lzlib/guile-lzlib, Guile-lzlib};
+@item @uref{https://www.nongnu.org/guile-avahi/, Guile-Avahi};
 @item
 @c FIXME: Specify a version number once a release has been made.
 @uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, version 0.3.0
diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 7ceb7737d8..bc393a8417 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -343,6 +343,7 @@ $(prefix)/etc/init.d\n")))
                        ;; cross-compilation.
                        ("guile" ,guile-3.0-latest) ;for faster builds
                        ("gnutls" ,gnutls)
+                       ("guile-avahi" ,guile-avahi)
                        ("guile-gcrypt" ,guile-gcrypt)
                        ("guile-json" ,guile-json-4)
                        ("guile-sqlite3" ,guile-sqlite3)
@@ -393,6 +394,7 @@ $(prefix)/etc/init.d\n")))
          ("glibc-utf8-locales" ,glibc-utf8-locales)))
       (propagated-inputs
        `(("gnutls" ,(if (%current-target-system) gnutls-3.6.14 gnutls))
+         ("guile-avahi" ,guile-avahi)
          ("guile-gcrypt" ,guile-gcrypt)
          ("guile-json" ,guile-json-4)
          ("guile-sqlite3" ,guile-sqlite3)
diff --git a/guix/avahi.scm b/guix/avahi.scm
new file mode 100644
index 0000000000..fa4a258066
--- /dev/null
+++ b/guix/avahi.scm
@@ -0,0 +1,162 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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.
+;;;
+;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix avahi)
+  #:use-module (guix records)
+  #:use-module (guix ui)
+  #:use-module (guix build syscalls)
+  #:use-module (avahi)
+  #:use-module (avahi client)
+  #:use-module (avahi client lookup)
+  #:use-module (avahi client publish)
+  #:use-module (ice-9 threads)
+  #:export (avahi-service
+            avahi-service?
+            avahi-service-name
+            avahi-service-interface
+            avahi-service-local-address
+            avahi-service-address
+            avahi-service-port
+            avahi-service-txt
+
+            avahi-publish-service-thread
+            avahi-browse-service-thread))
+
+(define-record-type* <avahi-service>
+  avahi-service make-avahi-service
+  avahi-service?
+  (name avahi-service-name)
+  (interface avahi-service-interface)
+  (local-address avahi-service-local-address)
+  (address avahi-service-address)
+  (port avahi-service-port)
+  (txt avahi-service-txt))
+
+(define* (avahi-publish-service-thread name
+                                       #:key
+                                       type port
+                                       (stop-loop? (const #f))
+                                       (timeout 100)
+                                       (txt '()))
+  "Publish the service TYPE using Avahi, for the given PORT, on all interfaces
+and for all protocols. Also, advertise the given TXT record list.
+
+This procedure starts a new thread running the Avahi event loop.  It exits
+when STOP-LOOP? procedure returns true."
+  (define client-callback
+    (lambda (client state)
+      (when (eq? state client-state/s-running)
+        (let ((group (make-entry-group client (const #t))))
+          (apply
+           add-entry-group-service! group interface/unspecified
+           protocol/unspecified '()
+           name type #f #f port txt)
+          (commit-entry-group group)))))
+
+  (call-with-new-thread
+   (lambda ()
+     (let* ((poll (make-simple-poll))
+            (client (make-client (simple-poll poll)
+                                 (list
+                                  client-flag/ignore-user-config)
+                                 client-callback)))
+       (while (not (stop-loop?))
+         (iterate-simple-poll poll timeout))))))
+
+(define (interface->ip-address interface)
+  "Return the local IP address of the given INTERFACE."
+  (let ((address
+         (network-interface-address
+          (socket AF_INET SOCK_STREAM 0) interface)))
+    (inet-ntop (sockaddr:fam address) (sockaddr:addr address))))
+
+(define* (avahi-browse-service-thread proc
+                                      #:key
+                                      type
+                                      (family AF_INET)
+                                      (stop-loop? (const #f))
+                                      (timeout 100))
+  "Browse services of the given TYPE and FAMILY using Avahi.  Each time a new
+service is found, PROC is called and passed as argument the corresponding
+AVAHI-SERVICE record.  If a service is available on multiple network
+interfaces, it will only be reported on the first interface found.
+
+This procedure starts a new thread running the Avahi event loop.  It exits
+when STOP-LOOP? procedure returns true."
+  (define %known-hosts
+    ;; Set of Avahi discovered hosts.
+    (make-hash-table))
+
+  (define (service-resolver-callback resolver interface protocol event
+                                     service-name service-type domain
+                                     host-name address-type address port
+                                     txt flags)
+    ;; Handle service resolution events.
+    (cond ((eq? event resolver-event/found)
+           (info (G_ "resolved service `~a' at `~a:~a'~%")
+                 service-name (inet-ntop family address) port)
+           ;; Add the service if the host is unknown.  This means that if a
+           ;; service is available on multiple network interfaces for a single
+           ;; host, only the first interface found will be considered.
+           (unless (hash-ref %known-hosts service-name)
+             (let* ((address (inet-ntop family address))
+                    (local-address (interface->ip-address interface))
+                    (service* (avahi-service
+                               (name service-name)
+                               (interface interface)
+                               (local-address local-address)
+                               (address address)
+                               (port port)
+                               (txt txt))))
+               (hash-set! %known-hosts service-name service*)
+               (proc service*))))
+          ((eq? event resolver-event/failure)
+           (report-error (G_ "failed to resolve service `~a'~%")
+                         service-name)))
+    (free-service-resolver! resolver))
+
+  (define (service-browser-callback browser interface protocol event
+                                    service-name service-type
+                                    domain flags)
+    (cond
+     ((eq? event browser-event/new)
+      (make-service-resolver (service-browser-client browser)
+                             interface protocol
+                             service-name service-type domain
+                             protocol/unspecified '()
+                             service-resolver-callback))
+     ((eq? event browser-event/remove)
+      (when (hash-ref %known-hosts service-name)
+        (hash-remove! %known-hosts service-name)))))
+
+  (define client-callback
+    (lambda (client state)
+      (if (eq? state client-state/s-running)
+          (make-service-browser client
+                                interface/unspecified
+                                protocol/inet
+                                type #f '()
+                                service-browser-callback))))
+
+  (let* ((poll (make-simple-poll))
+         (client (make-client (simple-poll poll)
+                              '() ;; no flags
+                              client-callback)))
+    (and (client? client)
+         (while (not (stop-loop?))
+           (iterate-simple-poll poll timeout)))))
diff --git a/guix/self.scm b/guix/self.scm
index bbfd2f1b95..344dc7c3de 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -50,6 +50,7 @@
                (module-ref (resolve-interface module) variable))))
     (match-lambda
       ("guile"      (ref '(gnu packages guile) 'guile-3.0/libgc-7))
+      ("guile-avahi" (ref '(gnu packages guile) 'guile-avahi))
       ("guile-json" (ref '(gnu packages guile) 'guile-json-4))
       ("guile-ssh"  (ref '(gnu packages ssh)   'guile-ssh))
       ("guile-git"  (ref '(gnu packages guile) 'guile-git))
@@ -778,6 +779,9 @@ Info manual."
                         (xz (specification->package "xz"))
                         (guix (specification->package "guix")))
   "Return a file-like object that contains a compiled Guix."
+  (define guile-avahi
+    (specification->package "guile-avahi"))
+
   (define guile-json
     (specification->package "guile-json"))
 
@@ -806,8 +810,9 @@ Info manual."
     (match (append-map (lambda (package)
                          (cons (list "x" package)
                                (package-transitive-propagated-inputs package)))
-                       (list guile-gcrypt gnutls guile-git guile-json
-                             guile-ssh guile-sqlite3 guile-zlib guile-lzlib))
+                       (list guile-gcrypt gnutls guile-git guile-avahi
+                             guile-json guile-ssh guile-sqlite3 guile-zlib
+                             guile-lzlib))
       (((labels packages _ ...) ...)
        packages)))
 
-- 
2.29.2

[bug#44801] [PATCH 2/2] publish: Add avahi support.

[Mathieu Othacehe]

* guix/scripts/publish.scm (%options): Add "--enable-avahi" option.
(show-help): Document it.
(service-name): New procedure,
(service-type): new variable.
(run-publish-server): Add "avahi?" and "port" parameters. Use them to publish
the server using Avahi.
(guix-publish): Pass the "avahi?" option to "run-publish-server".
---
 doc/guix.texi            |  4 ++++
 guix/scripts/publish.scm | 23 +++++++++++++++++++++++
 2 files changed, 27 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index e2361c25e3..cfbf495cbc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12151,6 +12151,10 @@ The signing key pair must be generated before @command{guix publish} is
 launched, using @command{guix archive --generate-key} (@pxref{Invoking
 guix archive}).
 
+When the @option{--enable-avahi} option is passed, the publish server is
+advertised on the local network as an Avahi service, using Guile-Avahi
+bindings.
+
 The general syntax is:
 
 @example
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index a12abf5b4d..34fcb682b5 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -41,6 +41,7 @@
   #:use-module (web server)
   #:use-module (web uri)
   #:autoload   (sxml simple) (sxml->xml)
+  #:use-module (guix avahi)
   #:use-module (guix base32)
   #:use-module (guix base64)
   #:use-module (guix config)
@@ -82,6 +83,8 @@ Publish ~a over HTTP.\n") %store-directory)
   (display (G_ "
   -u, --user=USER        change privileges to USER as soon as possible"))
   (display (G_ "
+  -a, --enable-avahi     enable Avahi based discovery"))
+  (display (G_ "
   -C, --compression[=METHOD:LEVEL]
                          compress archives with METHOD at LEVEL"))
   (display (G_ "
@@ -156,6 +159,9 @@ usage."
         (option '(#\V "version") #f #f
                 (lambda _
                   (show-version-and-exit "guix publish")))
+        (option '(#\a "enable-avahi") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'enable-avahi? #t result)))
         (option '(#\u "user") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'user arg result)))
@@ -1043,11 +1049,25 @@ methods, return the applicable compression."
           (x (not-found request)))
         (not-found request))))
 
+(define (service-name)
+  "Return the Avahi service name of the server."
+  (string-append "guix-publish-" (gethostname)))
+
+(define service-type
+  ;; Return the Avahi service type of the server.
+  "_guix_publish._tcp")
+
 (define* (run-publish-server socket store
                              #:key
+                             avahi? port
                              (compressions (list %no-compression))
                              (nar-path "nar") narinfo-ttl
                              cache pool)
+  (when avahi?
+    (avahi-publish-service-thread (service-name)
+                                  #:type service-type
+                                  #:port port))
+
   (run-server (make-request-handler store
                                     #:cache cache
                                     #:pool pool
@@ -1092,6 +1112,7 @@ methods, return the applicable compression."
                                 (lambda (arg result)
                                   (leave (G_ "~A: extraneous argument~%") arg))
                                 %default-options))
+           (avahi?  (assoc-ref opts 'enable-avahi?))
            (user    (assoc-ref opts 'user))
            (port    (assoc-ref opts 'port))
            (ttl     (assoc-ref opts 'narinfo-ttl))
@@ -1152,6 +1173,8 @@ consider using the '--user' option!~%")))
 
         (with-store store
           (run-publish-server socket store
+                              #:avahi? avahi?
+                              #:port port
                               #:cache cache
                               #:pool (and cache (make-pool workers
                                                            #:thread-name
-- 
2.29.2

[bug#44800] [PATCH 0/2] publish: Add Avahi support.

[zimoun]

Hi Mathieu,

On Sun, 22 Nov 2020 at 16:56, Mathieu Othacehe <othacehe@gnu.org> wrote:

> Here are two patches adding Avahi support to "guix publish". When the
> "--enable-avahi" option is passed to "guix publish", the server is advertised
> on the local network.

Is this part of your new design?

> Future patches will use this option to automatically add all the publish
> servers on the local network to the daemon "substitute-urls" list.

What happen if the option is passed but the servers are not reliable
(the connection is unstable)?


All the best,
simon

[bug#44800] [PATCH v2 0/3] publish: Add Avahi support.

[Mathieu Othacehe]

Hello,

Here's a v2 that now provides a complete chain. "guix publish" services that
are started with "--enable-avahi" will be discovered by the "guix-daemon" when
the "--use-local-publish" option is passed.

A new "guix discover" script is used to discover publish services in the
background. I have tested this setup by starting a guix-publish server in a
VM.

As suggested here:
https://guix.gnu.org/blog/2017/reproducible-builds-a-status-update/ the local
publish servers are prefixed to the substitute-url list, so that the daemon
will try to use substitute from the local network first, before falling back
to the CI build farm.

Thanks,

Mathieu

Mathieu Othacehe (3):
  Add Avahi support.
  publish: Add avahi support.
  Use substitute servers on the local network.

 Makefile.am                         |   2 +
 configure.ac                        |   6 +
 doc/guix.texi                       |  13 +++
 gnu/packages/package-management.scm |   5 +-
 gnu/services/base.scm               |  17 ++-
 guix/avahi.scm                      | 170 ++++++++++++++++++++++++++++
 guix/scripts/discover.scm           | 158 ++++++++++++++++++++++++++
 guix/scripts/publish.scm            |  24 ++++
 guix/scripts/substitute.scm         |  11 +-
 guix/self.scm                       |   9 +-
 nix/libstore/globals.cc             |   1 +
 nix/libstore/globals.hh             |   4 +
 nix/nix-daemon/guix-daemon.cc       |  20 ++++
 13 files changed, 433 insertions(+), 7 deletions(-)
 create mode 100644 guix/avahi.scm
 create mode 100644 guix/scripts/discover.scm

-- 
2.29.2

[bug#44800] [PATCH v2 1/3] Add Avahi support.

[Mathieu Othacehe]

* guix/avahi.scm: New file.
* Makefile.am (MODULES): Add it.
* configure.ac: Add Guile-Avahi dependency.
* doc/guix.texi (Requirements): Document it.
* gnu/packages/package-management.scm (guix)[native-inputs]: Add
"guile-avahi",
[propagated-inputs]: ditto.
* guix/self.scm (specification->package): Add guile-avahi.
(compiled-guix): Ditto.
---
 Makefile.am                         |   1 +
 configure.ac                        |   6 +
 doc/guix.texi                       |   1 +
 gnu/packages/package-management.scm |   5 +-
 guix/avahi.scm                      | 170 ++++++++++++++++++++++++++++
 guix/self.scm                       |   9 +-
 6 files changed, 189 insertions(+), 3 deletions(-)
 create mode 100644 guix/avahi.scm

diff --git a/Makefile.am b/Makefile.am
index d63f2ae4b7..7049da9594 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -73,6 +73,7 @@ include gnu/local.mk
 include po/doc/local.mk
 
 MODULES =					\
+  guix/avahi.scm				\
   guix/base16.scm				\
   guix/base32.scm				\
   guix/base64.scm				\
diff --git a/configure.ac b/configure.ac
index 6e718afdd1..307e8b361f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -161,6 +161,12 @@ if test "x$have_guile_lzlib" != "xyes"; then
   AC_MSG_ERROR([Guile-lzlib is missing; please install it.])
 fi
 
+dnl Check for Guile-Avahi.
+GUILE_MODULE_AVAILABLE([have_guile_avahi], [(avahi)])
+if test "x$have_guile_avahi" != "xyes"; then
+  AC_MSG_ERROR([Guile-Avahi is missing; please install it.])
+fi
+
 dnl Guile-newt is used by the graphical installer.
 GUILE_MODULE_AVAILABLE([have_guile_newt], [(newt)])
 
diff --git a/doc/guix.texi b/doc/guix.texi
index ea220fbd63..e9cf25fc90 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -829,6 +829,7 @@ Guile,, gnutls-guile, GnuTLS-Guile});
 or later;
 @item @uref{https://notabug.org/guile-zlib/guile-zlib, Guile-zlib};
 @item @uref{https://notabug.org/guile-lzlib/guile-lzlib, Guile-lzlib};
+@item @uref{https://www.nongnu.org/guile-avahi/, Guile-Avahi};
 @item
 @c FIXME: Specify a version number once a release has been made.
 @uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, version 0.3.0
diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 4a6881d475..03abfdfee2 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -294,6 +294,7 @@ $(prefix)/etc/init.d\n")))
                                (guile  ,@(if (%current-target-system)
                                              '((assoc-ref native-inputs "guile"))
                                              '((assoc-ref inputs "guile"))))
+                               (avahi  (assoc-ref inputs "guile-avahi"))
                                (gcrypt (assoc-ref inputs "guile-gcrypt"))
                                (json   (assoc-ref inputs "guile-json"))
                                (sqlite (assoc-ref inputs "guile-sqlite3"))
@@ -305,7 +306,7 @@ $(prefix)/etc/init.d\n")))
                                (ssh    (assoc-ref inputs "guile-ssh"))
                                (gnutls (assoc-ref inputs "gnutls"))
                                (locales (assoc-ref inputs "glibc-utf8-locales"))
-                               (deps   (list gcrypt json sqlite gnutls
+                               (deps   (list avahi gcrypt json sqlite gnutls
                                              git bs ssh zlib lzlib))
                                (effective
                                 (read-line
@@ -349,6 +350,7 @@ $(prefix)/etc/init.d\n")))
                        ;; cross-compilation.
                        ("guile" ,guile-3.0-latest) ;for faster builds
                        ("gnutls" ,gnutls)
+                       ("guile-avahi" ,guile-avahi)
                        ("guile-gcrypt" ,guile-gcrypt)
                        ("guile-json" ,guile-json-4)
                        ("guile-sqlite3" ,guile-sqlite3)
@@ -399,6 +401,7 @@ $(prefix)/etc/init.d\n")))
          ("glibc-utf8-locales" ,glibc-utf8-locales)))
       (propagated-inputs
        `(("gnutls" ,(if (%current-target-system) gnutls-3.6.14 gnutls))
+         ("guile-avahi" ,guile-avahi)
          ("guile-gcrypt" ,guile-gcrypt)
          ("guile-json" ,guile-json-4)
          ("guile-sqlite3" ,guile-sqlite3)
diff --git a/guix/avahi.scm b/guix/avahi.scm
new file mode 100644
index 0000000000..cd38619df6
--- /dev/null
+++ b/guix/avahi.scm
@@ -0,0 +1,170 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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.
+;;;
+;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix avahi)
+  #:use-module (guix records)
+  #:use-module (guix ui)
+  #:use-module (guix build syscalls)
+  #:use-module (avahi)
+  #:use-module (avahi client)
+  #:use-module (avahi client lookup)
+  #:use-module (avahi client publish)
+  #:use-module (ice-9 threads)
+  #:export (avahi-service
+            avahi-service?
+            avahi-service-name
+            avahi-service-type
+            avahi-service-interface
+            avahi-service-local-address
+            avahi-service-address
+            avahi-service-port
+            avahi-service-txt
+
+            avahi-publish-service-thread
+            avahi-browse-service-thread))
+
+(define-record-type* <avahi-service>
+  avahi-service make-avahi-service
+  avahi-service?
+  (name avahi-service-name)
+  (type avahi-service-type)
+  (interface avahi-service-interface)
+  (local-address avahi-service-local-address)
+  (address avahi-service-address)
+  (port avahi-service-port)
+  (txt avahi-service-txt))
+
+(define* (avahi-publish-service-thread name
+                                       #:key
+                                       type port
+                                       (stop-loop? (const #f))
+                                       (timeout 100)
+                                       (txt '()))
+  "Publish the service TYPE using Avahi, for the given PORT, on all interfaces
+and for all protocols. Also, advertise the given TXT record list.
+
+This procedure starts a new thread running the Avahi event loop.  It exits
+when STOP-LOOP? procedure returns true."
+  (define client-callback
+    (lambda (client state)
+      (when (eq? state client-state/s-running)
+        (let ((group (make-entry-group client (const #t))))
+          (apply
+           add-entry-group-service! group interface/unspecified
+           protocol/unspecified '()
+           name type #f #f port txt)
+          (commit-entry-group group)))))
+
+  (call-with-new-thread
+   (lambda ()
+     (let* ((poll (make-simple-poll))
+            (client (make-client (simple-poll poll)
+                                 (list
+                                  client-flag/ignore-user-config)
+                                 client-callback)))
+       (while (not (stop-loop?))
+         (iterate-simple-poll poll timeout))))))
+
+(define (interface->ip-address interface)
+  "Return the local IP address of the given INTERFACE."
+  (let ((address
+         (network-interface-address
+          (socket AF_INET SOCK_STREAM 0) interface)))
+    (inet-ntop (sockaddr:fam address) (sockaddr:addr address))))
+
+(define* (avahi-browse-service-thread proc
+                                      #:key
+                                      types
+                                      (family AF_INET)
+                                      (stop-loop? (const #f))
+                                      (timeout 100))
+  "Browse services which type is part of the TYPES list, using Avahi.  The
+search is restricted to services with the given FAMILY.  Each time a service
+is found or removed, PROC is called and passed as argument the corresponding
+AVAHI-SERVICE record.  If a service is available on multiple network
+interfaces, it will only be reported on the first interface found.
+
+This procedure starts a new thread running the Avahi event loop.  It exits
+when STOP-LOOP? procedure returns true."
+  (define %known-hosts
+    ;; Set of Avahi discovered hosts.
+    (make-hash-table))
+
+  (define (service-resolver-callback resolver interface protocol event
+                                     service-name service-type domain
+                                     host-name address-type address port
+                                     txt flags)
+    ;; Handle service resolution events.
+    (cond ((eq? event resolver-event/found)
+           (info (G_ "resolved service `~a' at `~a:~a'~%")
+                 service-name (inet-ntop family address) port)
+           ;; Add the service if the host is unknown.  This means that if a
+           ;; service is available on multiple network interfaces for a single
+           ;; host, only the first interface found will be considered.
+           (unless (hash-ref %known-hosts service-name)
+             (let* ((address (inet-ntop family address))
+                    (local-address (interface->ip-address interface))
+                    (service* (avahi-service
+                               (name service-name)
+                               (type service-type)
+                               (interface interface)
+                               (local-address local-address)
+                               (address address)
+                               (port port)
+                               (txt txt))))
+               (hash-set! %known-hosts service-name service*)
+               (proc 'new-service service*))))
+          ((eq? event resolver-event/failure)
+           (report-error (G_ "failed to resolve service `~a'~%")
+                         service-name)))
+    (free-service-resolver! resolver))
+
+  (define (service-browser-callback browser interface protocol event
+                                    service-name service-type
+                                    domain flags)
+    (cond
+     ((eq? event browser-event/new)
+      (make-service-resolver (service-browser-client browser)
+                             interface protocol
+                             service-name service-type domain
+                             protocol/unspecified '()
+                             service-resolver-callback))
+     ((eq? event browser-event/remove)
+      (let ((service (hash-ref %known-hosts service-name)))
+        (when service
+            (proc 'remove-service service)
+            (hash-remove! %known-hosts service-name))))))
+
+  (define client-callback
+    (lambda (client state)
+      (if (eq? state client-state/s-running)
+          (for-each (lambda (type)
+                      (make-service-browser client
+                                            interface/unspecified
+                                            protocol/inet
+                                            type #f '()
+                                            service-browser-callback))
+                    types))))
+
+  (let* ((poll (make-simple-poll))
+         (client (make-client (simple-poll poll)
+                              '() ;; no flags
+                              client-callback)))
+    (and (client? client)
+         (while (not (stop-loop?))
+           (iterate-simple-poll poll timeout)))))
diff --git a/guix/self.scm b/guix/self.scm
index 026dcd9c1a..257c8eefde 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -50,6 +50,7 @@
                (module-ref (resolve-interface module) variable))))
     (match-lambda
       ("guile"      (ref '(gnu packages guile) 'guile-3.0/libgc-7))
+      ("guile-avahi" (ref '(gnu packages guile) 'guile-avahi))
       ("guile-json" (ref '(gnu packages guile) 'guile-json-4))
       ("guile-ssh"  (ref '(gnu packages ssh)   'guile-ssh))
       ("guile-git"  (ref '(gnu packages guile) 'guile-git))
@@ -784,6 +785,9 @@ Info manual."
                         (xz (specification->package "xz"))
                         (guix (specification->package "guix")))
   "Return a file-like object that contains a compiled Guix."
+  (define guile-avahi
+    (specification->package "guile-avahi"))
+
   (define guile-json
     (specification->package "guile-json"))
 
@@ -812,8 +816,9 @@ Info manual."
     (match (append-map (lambda (package)
                          (cons (list "x" package)
                                (package-transitive-propagated-inputs package)))
-                       (list guile-gcrypt gnutls guile-git guile-json
-                             guile-ssh guile-sqlite3 guile-zlib guile-lzlib))
+                       (list guile-gcrypt gnutls guile-git guile-avahi
+                             guile-json guile-ssh guile-sqlite3 guile-zlib
+                             guile-lzlib))
       (((labels packages _ ...) ...)
        packages)))
 
-- 
2.29.2

[bug#44800] [PATCH v2 2/3] publish: Add avahi support.

[Mathieu Othacehe]

* guix/scripts/publish.scm (%options): Add "--enable-avahi" option.
(show-help): Document it.
(service-name): New procedure,
(publish-service-type): new variable.
(run-publish-server): Add "avahi?" and "port" parameters. Use them to publish
the server using Avahi.
(guix-publish): Pass the "avahi?" option to "run-publish-server".
* gnu/services/base.scm (<guix-publish-configuration>): Add "enable-avahi?"
field.
(guix-publish-shepherd-service): Honor it.
---
 doc/guix.texi            |  4 ++++
 gnu/services/base.scm    |  8 +++++++-
 guix/scripts/publish.scm | 24 ++++++++++++++++++++++++
 3 files changed, 35 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index e9cf25fc90..f8efc34310 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12170,6 +12170,10 @@ The signing key pair must be generated before @command{guix publish} is
 launched, using @command{guix archive --generate-key} (@pxref{Invoking
 guix archive}).
 
+When the @option{--enable-avahi} option is passed, the publish server is
+advertised on the local network as an Avahi service, using Guile-Avahi
+bindings.
+
 The general syntax is:
 
 @example
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 029df5ac16..87c247bdf1 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1743,6 +1743,8 @@ proxy of 'guix-daemon'...~%")
            (default 80))
   (host    guix-publish-configuration-host        ;string
            (default "localhost"))
+  (enable-avahi? guix-publish-enable-avahi?       ;boolean
+                 (default #f))
   (compression       guix-publish-configuration-compression
                      (thunked)
                      (default (default-compression this-record
@@ -1789,7 +1791,8 @@ raise a deprecation warning if the 'compression-level' field was used."
                    lst))))
 
   (match-record config <guix-publish-configuration>
-    (guix port host nar-path cache workers ttl cache-bypass-threshold)
+    (guix port host nar-path cache workers ttl cache-bypass-threshold
+          enable-avahi?)
     (list (shepherd-service
            (provision '(guix-publish))
            (requirement '(guix-daemon))
@@ -1800,6 +1803,9 @@ raise a deprecation warning if the 'compression-level' field was used."
                            #$@(config->compression-options config)
                            (string-append "--nar-path=" #$nar-path)
                            (string-append "--listen=" #$host)
+                           #$@(if enable-avahi?
+                                  #~("--enable-avahi")
+                                  #~())
                            #$@(if workers
                                   #~((string-append "--workers="
                                                     #$(number->string
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 2a2185e2b9..d2bb7ae982 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -42,6 +42,7 @@
   #:use-module (web server)
   #:use-module (web uri)
   #:autoload   (sxml simple) (sxml->xml)
+  #:use-module (guix avahi)
   #:use-module (guix base32)
   #:use-module (guix base64)
   #:use-module (guix config)
@@ -70,6 +71,7 @@
             signed-string
 
             open-server-socket
+            publish-service-type
             run-publish-server
             guix-publish))
 
@@ -83,6 +85,8 @@ Publish ~a over HTTP.\n") %store-directory)
   (display (G_ "
   -u, --user=USER        change privileges to USER as soon as possible"))
   (display (G_ "
+  -a, --enable-avahi     enable Avahi based discovery"))
+  (display (G_ "
   -C, --compression[=METHOD:LEVEL]
                          compress archives with METHOD at LEVEL"))
   (display (G_ "
@@ -157,6 +161,9 @@ usage."
         (option '(#\V "version") #f #f
                 (lambda _
                   (show-version-and-exit "guix publish")))
+        (option '(#\a "enable-avahi") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'enable-avahi? #t result)))
         (option '(#\u "user") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'user arg result)))
@@ -1069,11 +1076,25 @@ methods, return the applicable compression."
           (x (not-found request)))
         (not-found request))))
 
+(define (service-name)
+  "Return the Avahi service name of the server."
+  (string-append "guix-publish-" (gethostname)))
+
+(define publish-service-type
+  ;; Return the Avahi service type of the server.
+  "_guix_publish._tcp")
+
 (define* (run-publish-server socket store
                              #:key
+                             avahi? port
                              (compressions (list %no-compression))
                              (nar-path "nar") narinfo-ttl
                              cache pool)
+  (when avahi?
+    (avahi-publish-service-thread (service-name)
+                                  #:type publish-service-type
+                                  #:port port))
+
   (run-server (make-request-handler store
                                     #:cache cache
                                     #:pool pool
@@ -1119,6 +1140,7 @@ methods, return the applicable compression."
                                 (lambda (arg result)
                                   (leave (G_ "~A: extraneous argument~%") arg))
                                 %default-options))
+           (avahi?  (assoc-ref opts 'enable-avahi?))
            (user    (assoc-ref opts 'user))
            (port    (assoc-ref opts 'port))
            (ttl     (assoc-ref opts 'narinfo-ttl))
@@ -1179,6 +1201,8 @@ consider using the '--user' option!~%")))
 
         (with-store store
           (run-publish-server socket store
+                              #:avahi? avahi?
+                              #:port port
                               #:cache cache
                               #:pool (and cache (make-pool workers
                                                            #:thread-name
-- 
2.29.2

[bug#44800] [PATCH v2 3/3] Use substitute servers on the local network.

[Mathieu Othacehe]

* guix/scripts/discover.scm: New file.
* Makefile.am (MODULES): Add it.
* nix/nix-daemon/guix-daemon.cc (options): Add "use-local-publish" option,
(parse-opt): parse it,
(main): start "guix discover" process when the option is set.
* nix/libstore/globals.hh (Settings): Add "useLocalPublish" public member.
* nix/libstore/globals.cc (Settings): Initialize it.
* guix/scripts/substitute.scm (%local-substitute-urls): New variable,
(substitute-urls): add it.
* gnu/services/base.scm (<guix-configuration>): Add "use-local-publish?"
field,
(guix-shepherd-service): honor it.
* doc/guix.texi (Invoking guix-daemon): Document "use-local-publish" option,
(Base Services): ditto.
---
 Makefile.am                   |   1 +
 doc/guix.texi                 |   8 ++
 gnu/services/base.scm         |   9 +-
 guix/scripts/discover.scm     | 158 ++++++++++++++++++++++++++++++++++
 guix/scripts/substitute.scm   |  11 ++-
 nix/libstore/globals.cc       |   1 +
 nix/libstore/globals.hh       |   4 +
 nix/nix-daemon/guix-daemon.cc |  20 +++++
 8 files changed, 209 insertions(+), 3 deletions(-)
 create mode 100644 guix/scripts/discover.scm

diff --git a/Makefile.am b/Makefile.am
index 7049da9594..41b366eb75 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -257,6 +257,7 @@ MODULES =					\
   guix/import/texlive.scm   			\
   guix/import/utils.scm				\
   guix/scripts.scm				\
+  guix/scripts/discover.scm			\
   guix/scripts/download.scm			\
   guix/scripts/perform-download.scm		\
   guix/scripts/build.scm			\
diff --git a/doc/guix.texi b/doc/guix.texi
index f8efc34310..72531533ff 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1584,6 +1584,10 @@ Unless @option{--lose-logs} is used, all the build logs are kept in the
 @var{localstatedir}.  To save space, the daemon automatically compresses
 them with Bzip2 by default.
 
+@item --use-local-publish[=yes|no]
+Whether to use publish servers discovered a the local network, using
+Avahi, for substitutution.
+
 @item --disable-deduplication
 @cindex deduplication
 Disable automatic file ``deduplication'' in the store.
@@ -14999,6 +15003,10 @@ disables the timeout.
 The type of compression used for build logs---one of @code{gzip},
 @code{bzip2}, or @code{none}.
 
+@item @code{use-local-publish?} (default: @code{#f})
+Whether to use publish servers discovered a the local network, using
+Avahi, for substitutution.
+
 @item @code{extra-options} (default: @code{'()})
 List of extra command-line options for @command{guix-daemon}.
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 87c247bdf1..718fa4096a 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1529,6 +1529,8 @@ archive' public keys, with GUIX."
                     (default 0))
   (log-compression  guix-configuration-log-compression
                     (default 'bzip2))
+  (use-local-publish? guix-configuration-use-local-publish?
+                      (default #f))
   (extra-options    guix-configuration-extra-options ;list of strings
                     (default '()))
   (log-file         guix-configuration-log-file   ;string
@@ -1570,8 +1572,8 @@ proxy of 'guix-daemon'...~%")
   (match-record config <guix-configuration>
     (guix build-group build-accounts authorize-key? authorized-keys
           use-substitutes? substitute-urls max-silent-time timeout
-          log-compression extra-options log-file http-proxy tmpdir
-          chroot-directories)
+          log-compression use-local-publish? extra-options log-file
+          http-proxy tmpdir chroot-directories)
     (list (shepherd-service
            (documentation "Run the Guix daemon.")
            (provision '(guix-daemon))
@@ -1605,6 +1607,9 @@ proxy of 'guix-daemon'...~%")
                           #$@(if use-substitutes?
                                  '()
                                  '("--no-substitutes"))
+                          #$@(if use-local-publish?
+                                 '("--use-local-publish=yes")
+                                 '())
                           "--substitute-urls" #$(string-join substitute-urls)
                           #$@extra-options
 
diff --git a/guix/scripts/discover.scm b/guix/scripts/discover.scm
new file mode 100644
index 0000000000..d17b2bcfe4
--- /dev/null
+++ b/guix/scripts/discover.scm
@@ -0,0 +1,158 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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.
+;;;
+;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts discover)
+  #:use-module (guix avahi)
+  #:use-module (guix config)
+  #:use-module (guix scripts)
+  #:use-module (guix ui)
+  #:use-module (guix build syscalls)
+  #:use-module (guix build utils)
+  #:use-module (guix scripts publish)
+  #:use-module (ice-9 rdelim)
+  #:use-module (srfi srfi-37)
+  #:export (read-publish-urls
+
+            guix-discover))
+
+(define (show-help)
+  (format #t (G_ "Usage: guix discover [OPTION]...
+Discover Guix related services using Avahi.\n"))
+  (display (G_ "
+  -c, --cache=DIRECTORY     cache discovery results in DIRECTORY"))
+  (display (G_ "
+  -h, --help                display this help and exit"))
+  (display (G_ "
+  -V, --version             display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  (list (option '(#\c "cache") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'cache arg result)))
+        (option '(#\h "help") #f #f
+                (lambda _
+                  (show-help)
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda _
+                  (show-version-and-exit "guix discover")))))
+
+(define %default-options
+  `((cache . ,%state-directory)))
+
+\f
+;;;
+;;; Publish servers.
+;;;
+
+(define %publish-services
+  ;; Set of discovered publish services.
+  (make-hash-table))
+
+(define (publish-file cache-directory)
+  "Return the name of the file storing the discovered publish services inside
+CACHE-DIRECTORY."
+  (let ((directory (string-append cache-directory "/discover")))
+    (string-append directory "/publish")))
+
+(define %publish-file
+  (make-parameter (publish-file %state-directory)))
+
+(define* (write-publish-file #:key (file (%publish-file)))
+  "Dump the content of %PUBLISH-SERVICES hash table into FILE.  Use a write
+lock on FILE to synchronize with any potential readers."
+  (with-file-lock file
+    (call-with-output-file file
+      (lambda (port)
+        (hash-for-each
+         (lambda (name service)
+           (format port "http://~a:~a~%"
+                   (avahi-service-address service)
+                   (avahi-service-port service)))
+         %publish-services)))
+        (chmod file #o644)))
+
+(define (call-with-read-file-lock file thunk)
+  "Call THUNK with a read lock on FILE."
+  (let ((port #f))
+    (dynamic-wind
+      (lambda ()
+        (set! port
+              (let ((port (open-file file "r0")))
+                (fcntl-flock port 'read-lock)
+                port)))
+      thunk
+      (lambda ()
+        (when port
+          (unlock-file port))))))
+
+(define-syntax-rule (with-read-file-lock file exp ...)
+  "Wait to acquire a read lock on FILE and evaluate EXP in that context."
+  (call-with-read-file-lock file (lambda () exp ...)))
+
+(define* (read-publish-urls #:key (file (%publish-file)))
+  "Read publish urls list from FILE and return it.  Use a read lock on FILE to
+synchronize with the writer."
+  (with-read-file-lock file
+    (call-with-input-file file
+      (lambda (port)
+        (let loop ((url (read-line port))
+                   (urls '()))
+          (if (eof-object? url)
+              urls
+              (loop (read-line port) (cons url urls))))))))
+
+\f
+;;;
+;;; Entry point.
+;;;
+
+(define %services
+  ;; List of services we want to discover.
+  (list publish-service-type))
+
+(define (service-proc action service)
+  (let ((name (avahi-service-name service))
+        (type (avahi-service-type service)))
+    (when (string=? type publish-service-type)
+      (case action
+        ((new-service)
+         (hash-set! %publish-services name service))
+        ((remove-service)
+         (hash-remove! %publish-services name)))
+      (write-publish-file))))
+
+(define-command (guix-discover . args)
+  (category plumbing)
+  (synopsis "discover Guix related services using Avahi")
+
+  (with-error-handling
+    (let* ((opts (args-fold* args %options
+                             (lambda (opt name arg result)
+                               (leave (G_ "~A: unrecognized option~%") name))
+                             (lambda (arg result)
+                               (leave (G_ "~A: extraneous argument~%") arg))
+                             %default-options))
+           (cache (assoc-ref opts 'cache))
+           (publish-file (publish-file cache)))
+      (parameterize ((%publish-file publish-file))
+        (mkdir-p (dirname publish-file))
+        (avahi-browse-service-thread service-proc
+                                     #:types %services)))))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index ddb885d344..16e8fe6106 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -27,6 +27,7 @@
   #:use-module (guix config)
   #:use-module (guix records)
   #:use-module ((guix serialization) #:select (restore-file))
+  #:use-module (guix scripts discover)
   #:use-module (gcrypt hash)
   #:use-module (guix base32)
   #:use-module (guix base64)
@@ -1078,9 +1079,17 @@ found."
      ;; daemon.
      '("http://ci.guix.gnu.org"))))
 
+(define %local-substitute-urls
+  ;; If the following option is passed to the daemon, use the substitutes list
+  ;; provided by "guix discover" process.
+  (if (find-daemon-option "use-local-publish")
+      (read-publish-urls)
+      '()))
+
 (define substitute-urls
   ;; List of substitute URLs.
-  (make-parameter %default-substitute-urls))
+  (make-parameter (append %local-substitute-urls
+                          %default-substitute-urls)))
 
 (define (client-terminal-columns)
   "Return the number of columns in the client's terminal, if it is known, or a
diff --git a/nix/libstore/globals.cc b/nix/libstore/globals.cc
index 0cc001fbe4..2b621af982 100644
--- a/nix/libstore/globals.cc
+++ b/nix/libstore/globals.cc
@@ -35,6 +35,7 @@ Settings::Settings()
     maxSilentTime = 0;
     buildTimeout = 0;
     useBuildHook = true;
+    useLocalPublish = false;
     printBuildTrace = false;
     multiplexedBuildOutput = false;
     reservedSize = 8 * 1024 * 1024;
diff --git a/nix/libstore/globals.hh b/nix/libstore/globals.hh
index 27616a2283..43653aef48 100644
--- a/nix/libstore/globals.hh
+++ b/nix/libstore/globals.hh
@@ -116,6 +116,10 @@ struct Settings {
        users want to disable this from the command-line. */
     bool useBuildHook;
 
+    /* Whether to use publish servers found on the local network for
+       substitution. */
+    bool useLocalPublish;
+
     /* Whether buildDerivations() should print out lines on stderr in
        a fixed format to allow its progress to be monitored.  Each
        line starts with a "@".  The following are defined:
diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc
index cd949aca67..f0ace9ce8b 100644
--- a/nix/nix-daemon/guix-daemon.cc
+++ b/nix/nix-daemon/guix-daemon.cc
@@ -89,6 +89,7 @@ builds derivations on behalf of its clients.");
 #define GUIX_OPT_TIMEOUT 18
 #define GUIX_OPT_MAX_SILENT_TIME 19
 #define GUIX_OPT_LOG_COMPRESSION 20
+#define GUIX_OPT_USE_LOCAL_PUBLISH 21
 
 static const struct argp_option options[] =
   {
@@ -129,6 +130,9 @@ static const struct argp_option options[] =
       n_("disable compression of the build logs") },
     { "log-compression", GUIX_OPT_LOG_COMPRESSION, "TYPE", 0,
       n_("use the specified compression type for build logs") },
+    { "use-local-publish", GUIX_OPT_USE_LOCAL_PUBLISH,
+      "yes/no", OPTION_ARG_OPTIONAL,
+      n_("use publish servers discovered on the local network") },
 
     /* '--disable-deduplication' was known as '--disable-store-optimization'
        up to Guix 0.7 included, so keep the alias around.  */
@@ -261,6 +265,10 @@ parse_opt (int key, char *arg, struct argp_state *state)
     case GUIX_OPT_NO_BUILD_HOOK:
       settings.useBuildHook = false;
       break;
+    case GUIX_OPT_USE_LOCAL_PUBLISH:
+      settings.useLocalPublish = string_to_bool (arg);
+      settings.set("use-local-publish", arg);
+      break;
     case GUIX_OPT_DEBUG:
       verbosity = lvlDebug;
       break;
@@ -506,6 +514,18 @@ using `--build-users-group' is highly recommended\n"));
 		    format ("extra chroot directories: '%1%'") % chroot_dirs);
 	}
 
+      if (settings.useLocalPublish)
+      {
+        Strings args;
+
+        args.push_back("guix");
+        args.push_back("discover");
+
+        startProcess([&]() {
+          execv(settings.guixProgram.c_str(), stringsToCharPtrs(args).data());
+        });
+      }
+
       printMsg (lvlDebug,
 		format ("automatic deduplication set to %1%")
 		% settings.autoOptimiseStore);
-- 
2.29.2

[bug#44800] [PATCH 0/2] publish: Add Avahi support.

[Mathieu Othacehe]

Hey zimoun,

> Is this part of your new design?

Somehow because it allows the machines on a local network to share
substitutes between each other transparently.

It not strictly needed however because the offloading workers directly
add the offloading server to their substitute list in the design I'm
proposing.

> What happen if the option is passed but the servers are not reliable
> (the connection is unstable)?

The build fails with the following message:

--8<---------------cut here---------------start------------->8---
guix substitute: error: connect: No route to host
substitution of /gnu/store/pbaihd2k2dbv02s7aq3aybk29r00lg9h-abduco-0.6 failed
guix build: error: some substitutes for the outputs of derivation `/gnu/store/xnfyilqfhk05rgxbq7hmx81d65bsnprh-abduco-0.6.drv' failed (usually happens due to networking issues); try `--fallback' to build derivation from source 
--8<---------------cut here---------------end--------------->8---

Thanks,

Mathieu

[bug#44800] [PATCH v2 0/3] publish: Add Avahi support.

[Ludovic Courtès]

Hi Mathieu,

Mathieu Othacehe <othacehe@gnu.org> skribis:

> Here's a v2 that now provides a complete chain. "guix publish" services that
> are started with "--enable-avahi" will be discovered by the "guix-daemon" when
> the "--use-local-publish" option is passed.
>
> A new "guix discover" script is used to discover publish services in the
> background. I have tested this setup by starting a guix-publish server in a
> VM.
>
> As suggested here:
> https://guix.gnu.org/blog/2017/reproducible-builds-a-status-update/ the local
> publish servers are prefixed to the substitute-url list, so that the daemon
> will try to use substitute from the local network first, before falling back
> to the CI build farm.

As discussed on IRC, this is very cool stuff!

Some comments follow.

[bug#44800] [PATCH v2 1/3] Add Avahi support.

[Ludovic Courtès]

Mathieu Othacehe <othacehe@gnu.org> skribis:

> * guix/avahi.scm: New file.
> * Makefile.am (MODULES): Add it.
> * configure.ac: Add Guile-Avahi dependency.
> * doc/guix.texi (Requirements): Document it.
> * gnu/packages/package-management.scm (guix)[native-inputs]: Add
> "guile-avahi",
> [propagated-inputs]: ditto.
> * guix/self.scm (specification->package): Add guile-avahi.
> (compiled-guix): Ditto.

[...]

> --- a/configure.ac
> +++ b/configure.ac
> @@ -161,6 +161,12 @@ if test "x$have_guile_lzlib" != "xyes"; then
>    AC_MSG_ERROR([Guile-lzlib is missing; please install it.])
>  fi
>  
> +dnl Check for Guile-Avahi.
> +GUILE_MODULE_AVAILABLE([have_guile_avahi], [(avahi)])
> +if test "x$have_guile_avahi" != "xyes"; then
> +  AC_MSG_ERROR([Guile-Avahi is missing; please install it.])
> +fi

I wonder if we could/should make it an optional dependency.

(guix avahi) would need to autoload (avahi), which might be slightly
annoying.

An argument in favor of making it mandatory is that it would help make
the feature more widely used, and thus more widely useful.

> +(define-record-type* <avahi-service>
> +  avahi-service make-avahi-service
> +  avahi-service?
> +  (name avahi-service-name)
> +  (type avahi-service-type)
> +  (interface avahi-service-interface)
> +  (local-address avahi-service-local-address)
> +  (address avahi-service-address)
> +  (port avahi-service-port)
> +  (txt avahi-service-txt))

You could use (srfi srfi-9) ‘define-record-type’ since the extra (guix
records) features are not necessary here.

> +(define* (avahi-publish-service-thread name
> +                                       #:key
> +                                       type port
> +                                       (stop-loop? (const #f))
> +                                       (timeout 100)
> +                                       (txt '()))
> +  "Publish the service TYPE using Avahi, for the given PORT, on all interfaces
> +and for all protocols. Also, advertise the given TXT record list.
> +
> +This procedure starts a new thread running the Avahi event loop.  It exits
> +when STOP-LOOP? procedure returns true."
> +  (define client-callback
> +    (lambda (client state)
> +      (when (eq? state client-state/s-running)
> +        (let ((group (make-entry-group client (const #t))))
> +          (apply
> +           add-entry-group-service! group interface/unspecified
> +           protocol/unspecified '()
> +           name type #f #f port txt)
> +          (commit-entry-group group)))))
> +
> +  (call-with-new-thread
> +   (lambda ()
> +     (let* ((poll (make-simple-poll))
> +            (client (make-client (simple-poll poll)
> +                                 (list
> +                                  client-flag/ignore-user-config)
> +                                 client-callback)))
> +       (while (not (stop-loop?))
> +         (iterate-simple-poll poll timeout))))))

(I wanted to add an API in Guile-Avahi to “invert inversion of control”
so that one could escape callback hell but never got around to
completing it.)

> +(define (interface->ip-address interface)
> +  "Return the local IP address of the given INTERFACE."
> +  (let ((address
> +         (network-interface-address
> +          (socket AF_INET SOCK_STREAM 0) interface)))
> +    (inet-ntop (sockaddr:fam address) (sockaddr:addr address))))

Make sure to close the socket.

Can’t we obtain the IP address without creating a socket actually?  Noob
here.

> +    ;; Handle service resolution events.
> +    (cond ((eq? event resolver-event/found)
> +           (info (G_ "resolved service `~a' at `~a:~a'~%")
> +                 service-name (inet-ntop family address) port)

IWBN to not add UI code in here.

Thanks,
Ludo’.

[bug#44800] [PATCH v2 1/3] Add Avahi support.

[zimoun]

Hi Ludo,

On Fri, 27 Nov 2020 at 18:04, Ludovic Courtès <ludo@gnu.org> wrote:

> (I wanted to add an API in Guile-Avahi to “invert inversion of control”
> so that one could escape callback hell but never got around to
> completing it.)

Out of curiosity, what do you mean by “invert inversion of control”?


Cheers,
simon

[bug#44800] [PATCH v2 2/3] publish: Add avahi support.

[Ludovic Courtès]

Hi,

Mathieu Othacehe <othacehe@gnu.org> skribis:

> * guix/scripts/publish.scm (%options): Add "--enable-avahi" option.
> (show-help): Document it.
> (service-name): New procedure,
> (publish-service-type): new variable.
> (run-publish-server): Add "avahi?" and "port" parameters. Use them to publish
> the server using Avahi.
> (guix-publish): Pass the "avahi?" option to "run-publish-server".
> * gnu/services/base.scm (<guix-publish-configuration>): Add "enable-avahi?"
> field.
> (guix-publish-shepherd-service): Honor it.

Neat!

> +When the @option{--enable-avahi} option is passed, the publish server is
> +advertised on the local network as an Avahi service, using Guile-Avahi
> +bindings.

s/bindings/(@pxref{Top,,, guile-avahi, Using Avahi in Guile Scheme Programs}/

As discussed on IRC, I would avoid using the name Avahi on the CLI and
to some extent in the API as well.  The command-line option could be
“--advertise”.

The documentation would be something like:

  … the server advertises its availability on the local network using
  multicast DNS (mDNS) and DNS service discovery (DNS-SD), currently
  @i{via} Guile-Avahi …

(I remember that Julien posted a DNS client implementation a few years
ago, we never know what the future will be like…  :-))

> +  (enable-avahi? guix-publish-enable-avahi?       ;boolean
> +                 (default #f))

Same here.

>  (define* (run-publish-server socket store
>                               #:key
> +                             avahi? port
>                               (compressions (list %no-compression))
>                               (nar-path "nar") narinfo-ttl
>                               cache pool)
> +  (when avahi?
> +    (avahi-publish-service-thread (service-name)
> +                                  #:type publish-service-type
> +                                  #:port port))

Maybe add (info (_ "advertising …")) here.  Ideally, you’d need a
callback because you can’t tell what the actual advertised name is since
Avahi can pick one to avoid name clashes.

Thanks,
Ludo’.

[bug#44800] [PATCH v2 3/3] Use substitute servers on the local network.

[Ludovic Courtès]

Mathieu Othacehe <othacehe@gnu.org> skribis:

> * guix/scripts/discover.scm: New file.
> * Makefile.am (MODULES): Add it.
> * nix/nix-daemon/guix-daemon.cc (options): Add "use-local-publish" option,
> (parse-opt): parse it,
> (main): start "guix discover" process when the option is set.
> * nix/libstore/globals.hh (Settings): Add "useLocalPublish" public member.
> * nix/libstore/globals.cc (Settings): Initialize it.
> * guix/scripts/substitute.scm (%local-substitute-urls): New variable,
> (substitute-urls): add it.
> * gnu/services/base.scm (<guix-configuration>): Add "use-local-publish?"
> field,
> (guix-shepherd-service): honor it.
> * doc/guix.texi (Invoking guix-daemon): Document "use-local-publish" option,
> (Base Services): ditto.

[...]

> +@item --use-local-publish[=yes|no]
> +Whether to use publish servers discovered a the local network, using
> +Avahi, for substitutution.

How about ‘--discover-substitute-servers’ or ‘--discover-substitutes’ or
even ‘--discover’?

s/publish servers/substitute servers/

I think we need a note about the performance, security, and privacy
implications of this here, namely:

  0. It might be faster/less expensive than fetching from remote
     servers; 

  1. There are no security risks, only genuine substitutes will be used
     (add cross-ref);

  2. An attacker advertising ‘guix publish’ on your LAN cannot serve you
     malicious binaries, but they can learn what software you’re
     installing.

  3. Servers may serve substitute over HTTP, unencrypted, so anyone on
     the LAN can see what software you’re installing.

IWBN to have an action of the Shepherd service to turn it on and off;
you might want to do that depending on how much you trust the LAN you’re
on.  (That can come later though.)

> +++ b/gnu/services/base.scm
> @@ -1529,6 +1529,8 @@ archive' public keys, with GUIX."
>                      (default 0))
>    (log-compression  guix-configuration-log-compression
>                      (default 'bzip2))
> +  (use-local-publish? guix-configuration-use-local-publish?
> +                      (default #f))

Same here.

> +(define %publish-services
> +  ;; Set of discovered publish services.
> +  (make-hash-table))
> +
> +(define (publish-file cache-directory)
> +  "Return the name of the file storing the discovered publish services inside
> +CACHE-DIRECTORY."
> +  (let ((directory (string-append cache-directory "/discover")))
> +    (string-append directory "/publish")))
> +
> +(define %publish-file
> +  (make-parameter (publish-file %state-directory)))
> +
> +(define* (write-publish-file #:key (file (%publish-file)))
> +  "Dump the content of %PUBLISH-SERVICES hash table into FILE.  Use a write
> +lock on FILE to synchronize with any potential readers."

Aren’t we partly duplicating what avahi-daemon’s already doing?
avahi-daemon maintains a list of currently valid advertisements, which
can be seen with:

  avahi-browse --cache _workstation._tcp

However, that cache first needs to be initialized by running the same
command without ‘--cache’.  Hmm, maybe there’s no other choice.  I
wonder how others deal with that.

> +(define-command (guix-discover . args)
> +  (category plumbing)

Should be “internal” IMO.

> +++ b/nix/libstore/globals.cc
> @@ -35,6 +35,7 @@ Settings::Settings()
>      maxSilentTime = 0;
>      buildTimeout = 0;
>      useBuildHook = true;
> +    useLocalPublish = false;
>      printBuildTrace = false;
>      multiplexedBuildOutput = false;
>      reservedSize = 8 * 1024 * 1024;
> diff --git a/nix/libstore/globals.hh b/nix/libstore/globals.hh
> index 27616a2283..43653aef48 100644
> --- a/nix/libstore/globals.hh
> +++ b/nix/libstore/globals.hh
> @@ -116,6 +116,10 @@ struct Settings {
>         users want to disable this from the command-line. */
>      bool useBuildHook;
>  
> +    /* Whether to use publish servers found on the local network for
> +       substitution. */
> +    bool useLocalPublish;

I think you don’t even need to field here since the variable is only
used in guix-daemon.cc.

> +    case GUIX_OPT_USE_LOCAL_PUBLISH:
> +      settings.useLocalPublish = string_to_bool (arg);
> +      settings.set("use-local-publish", arg);
> +      break;

Just set a variable local to this file and that’s enough.  You still
need the second line so that (guix scripts substitute) knows whether it
should read the thing.

> diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
> index ddb885d344..16e8fe6106 100755
> --- a/guix/scripts/substitute.scm
> +++ b/guix/scripts/substitute.scm
> @@ -27,6 +27,7 @@
>    #:use-module (guix config)
>    #:use-module (guix records)
>    #:use-module ((guix serialization) #:select (restore-file))
> +  #:use-module (guix scripts discover)
>    #:use-module (gcrypt hash)
>    #:use-module (guix base32)
>    #:use-module (guix base64)
> @@ -1078,9 +1079,17 @@ found."
>       ;; daemon.
>       '("http://ci.guix.gnu.org"))))
>  
> +(define %local-substitute-urls
> +  ;; If the following option is passed to the daemon, use the substitutes list
> +  ;; provided by "guix discover" process.
> +  (if (find-daemon-option "use-local-publish")
> +      (read-publish-urls)
> +      '()))
> +
>  (define substitute-urls
>    ;; List of substitute URLs.
> -  (make-parameter %default-substitute-urls))
> +  (make-parameter (append %local-substitute-urls
> +                          %default-substitute-urls)))

As discussed on IRC, we should probably need to set an upper limit. on
the number of local substitute URLs.

Imagine: you’re at GuixCon 2021, there are 500 participants all of which
are running ‘guix publish --advertise’; every Guix operation leads to
everyone’s Guix talking to every other person’s Guix, the whole thing
gets slow as hell, 500 people staring at “updating list of substitutes”,
500 people eventually giving up and signing up for CONDACon.

Also, we must make sure ‘guix substitute’ gracefully handles disconnects
and servers still advertised but no longer around (timeouts etc.)

We’ll need real world tests to see how it behaves I think.  In the
meantime, we can describe it as a technology preview™ in the manual.

WDYT?

Ludo’.

[bug#44800] [PATCH v2 1/3] Add Avahi support.

[Ludovic Courtès]

Hi,

zimoun <zimon.toutoune@gmail.com> skribis:

> On Fri, 27 Nov 2020 at 18:04, Ludovic Courtès <ludo@gnu.org> wrote:
>
>> (I wanted to add an API in Guile-Avahi to “invert inversion of control”
>> so that one could escape callback hell but never got around to
>> completing it.)
>
> Out of curiosity, what do you mean by “invert inversion of control”?

Users of the Avahi client library are supposed to pass “callbacks”,
which leads to “inversion of control”: the library decides when you code
is called.  See <https://en.wikipedia.org/wiki/Inversion_of_control>.

Inverting it would mean providing a natural way for users to call the
library.

HTH!

Ludo’.

[bug#44800] [PATCH v2 1/3] Add Avahi support.

[zimoun]

Hi,

On Sat, 28 Nov 2020 at 12:02, Ludovic Courtès <ludo@gnu.org> wrote:

> Users of the Avahi client library are supposed to pass “callbacks”,
> which leads to “inversion of control”: the library decides when you code
> is called.  See <https://en.wikipedia.org/wiki/Inversion_of_control>.
>
> Inverting it would mean providing a natural way for users to call the
> library.

Thanks!  I did not know the concept name and that it was so formalized.

Really helpful.


Cheers,
simon

[bug#44800] [PATCH v2 1/3] Add Avahi support.

[Mathieu Othacehe]

Hey Ludo,

Thanks for the review :)

> An argument in favor of making it mandatory is that it would help make
> the feature more widely used, and thus more widely useful.

Yes, and most of the other Guile dependencies are mandatory, so having
Guile-Avahi also mandatory feels safer. Plus I'm sure that it can be
useful for other use cases such as offloading.

> You could use (srfi srfi-9) ‘define-record-type’ since the extra (guix
> records) features are not necessary here.

I use (guix records) feature allowing to call the record constructor
with non positional arguments.

> (I wanted to add an API in Guile-Avahi to “invert inversion of control”
> so that one could escape callback hell but never got around to
> completing it.)

Sure, it would be nice, but given libavahi design, not an easy task :).

> Can’t we obtain the IP address without creating a socket actually?  Noob
> here.

I think we can use "getifaddrs" and the its "network-interfaces"
binding, but the resulting code does not seem more readable.

>
>> +    ;; Handle service resolution events.
>> +    (cond ((eq? event resolver-event/found)
>> +           (info (G_ "resolved service `~a' at `~a:~a'~%")
>> +                 service-name (inet-ntop family address) port)
>
> IWBN to not add UI code in here.

Sure, removed!

Mathieu

[bug#44800] [PATCH v2 2/3] publish: Add avahi support.

[Mathieu Othacehe]

> The documentation would be something like:
>
>   … the server advertises its availability on the local network using
>   multicast DNS (mDNS) and DNS service discovery (DNS-SD), currently
>   @i{via} Guile-Avahi …

Right, fixed!

> Maybe add (info (_ "advertising …")) here.  Ideally, you’d need a
> callback because you can’t tell what the actual advertised name is since
> Avahi can pick one to avoid name clashes.

Done!

Thanks,

Mathieu

[bug#44800] [PATCH v2 3/3] Use substitute servers on the local network.

[Mathieu Othacehe]

Hey,

> How about ‘--discover-substitute-servers’ or ‘--discover-substitutes’ or
> even ‘--discover’?

"--discover" seems nice.

> I think we need a note about the performance, security, and privacy
> implications of this here, namely:
>
>   0. It might be faster/less expensive than fetching from remote
>      servers; 
>
>   1. There are no security risks, only genuine substitutes will be used
>      (add cross-ref);
>
>   2. An attacker advertising ‘guix publish’ on your LAN cannot serve you
>      malicious binaries, but they can learn what software you’re
>      installing.
>
>   3. Servers may serve substitute over HTTP, unencrypted, so anyone on
>      the LAN can see what software you’re installing.

I added a variant of this snippet to the documentation.

> IWBN to have an action of the Shepherd service to turn it on and off;
> you might want to do that depending on how much you trust the LAN you’re
> on.  (That can come later though.)

Yup, I agree.

> Aren’t we partly duplicating what avahi-daemon’s already doing?
> avahi-daemon maintains a list of currently valid advertisements, which
> can be seen with:
>
>   avahi-browse --cache _workstation._tcp
>
> However, that cache first needs to be initialized by running the same
> command without ‘--cache’.  Hmm, maybe there’s no other choice.  I
> wonder how others deal with that.

If the local network machines are connected with multiple interfaces
such as Wifi and Ethernet, then the discovered services will appear
multiple times, regardless of the "cache" option I think.

Couldn't find any useful resources about that, someone maybe?

> Just set a variable local to this file and that’s enough.  You still
> need the second line so that (guix scripts substitute) knows whether it
> should read the thing.

Right, fixed.

> Imagine: you’re at GuixCon 2021, there are 500 participants all of which
> are running ‘guix publish --advertise’; every Guix operation leads to
> everyone’s Guix talking to every other person’s Guix, the whole thing
> gets slow as hell, 500 people staring at “updating list of substitutes”,
> 500 people eventually giving up and signing up for CONDACon.

Haha, that would be a shame. I limited the number of local substitute
servers to 50. Maybe that's too high. I think that we will be able to
fine tune this value once we have more experience with it. Deploying
this mechanism on berlin will probably help.

> Also, we must make sure ‘guix substitute’ gracefully handles disconnects
> and servers still advertised but no longer around (timeouts etc.)
>
> We’ll need real world tests to see how it behaves I think.  In the
> meantime, we can describe it as a technology preview™ in the manual.

Sure, I described this option as "experimental" in the
documentation. Regarding the disconnections and timeouts, there's
probably some work, but I think it's transverse to this development.

Pushed the whole patchset, taking your remarks into account. Thanks
again for reviewing.

Thanks,

Mathieu

[bug#44800] [PATCH v2 3/3] Use substitute servers on the local network.

[Ludovic Courtès]

Hi,

Mathieu Othacehe <othacehe@gnu.org> skribis:

> Pushed the whole patchset, taking your remarks into account. Thanks
> again for reviewing.

Woohoo, thanks!

I’ll give it a spin in the coming days/weeks and we’ll see.  Can’t wait
to be physically back at the office to see how it goes with more
publishers/users.  :-)

Ludo’.

bug#44800: [PATCH v2 3/3] Use substitute servers on the local network.

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 315 bytes --]


Hey Ludo,

> I’ll give it a spin in the coming days/weeks and we’ll see.  Can’t wait
> to be physically back at the office to see how it goes with more
> publishers/users.  :-)

Great, I hope it will work fine :). Here's the system configuration I
used to test this feature.

Thanks,

Mathieu


[-- Attachment #2: advertise-os.scm --]
[-- Type: application/octet-stream, Size: 3055 bytes --]

;; This is an operating system configuration template
;; for a "bare bones" setup, with no X11 display server.

(use-modules (gnu))
(use-service-modules avahi base networking ssh)
(use-package-modules package-management screen ssh)

(define (operating-system-with-current-guix os)
  "Return a variant of OS that uses the current Guix."
  (operating-system
    (inherit os)
    (services (modify-services (operating-system-user-services os)
                (guix-service-type config =>
                                   (guix-configuration
                                    (inherit config)
                                    (guix (current-guix))))))))

(operating-system-with-current-guix
 (operating-system
   (host-name "komputilo")
   (timezone "Europe/Berlin")
   (locale "en_US.utf8")

   (name-service-switch %mdns-host-lookup-nss)
   ;; Boot in "legacy" BIOS mode, assuming /dev/sdX is the
   ;; target hard disk, and "my-root" is the label of the target
   ;; root file system.
   (bootloader (bootloader-configuration
                (bootloader grub-bootloader)
                (target "/dev/sdX")))
   (file-systems (cons (file-system
                         (device (file-system-label "my-root"))
                         (mount-point "/")
                         (type "ext4"))
                       %base-file-systems))

   ;; This is where user accounts are specified.  The "root"
   ;; account is implicit, and is initially created with the
   ;; empty password.
   (users (cons (user-account
                 (name "alice")
                 (comment "Bob's sister")
                 (group "users")

                 ;; Adding the account to the "wheel" group
                 ;; makes it a sudoer.  Adding it to "audio"
                 ;; and "video" allows the user to play sound
                 ;; and access the webcam.
                 (supplementary-groups '("wheel"
                                         "audio" "video")))
                %base-user-accounts))

   ;; Globally-installed packages.
   (packages (cons screen %base-packages))

   ;; Add services to the baseline: a DHCP client and
   ;; an SSH server.
   (services (append (list (service guix-publish-service-type
                                    (guix-publish-configuration
                                     (host "0.0.0.0")
                                     (port 3000)
                                     (advertise? #t)
                                     (cache #f)
                                     (ttl #f)
                                     (compression-level 9)))
                           (service avahi-service-type
                                    (avahi-configuration (debug? #t)))
                           (service dhcp-client-service-type)
                           (service openssh-service-type
                                    (openssh-configuration
                                     (openssh openssh-sans-x)
                                     (port-number 2222))))
                     %base-services))))