services: Add yggdrasil-service-type.

* gnu/services/networking.scm (yggdrasil-configuration)
(yggdrasil-configuration?, yggdrasil-configuration-package)
(yggdrasil-configuration-auto-conf, yggdrasil-configuration-log-level)
(yggdrasil-configuration-log-to): New procedures.
(yggdrasil-service-type): New variable.
* doc/guix.texi: Document it.
* gnu/system/examples/yggdrasil.tmpl: Provide example.

Signed-off-by: Julien Lepiller <julien@lepiller.eu>

2 files changed, 176 insertions, 1 deletions

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 64f54e787f..9ec0f6a9ca 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -61,7 +61,9 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-43)
   #:use-module (ice-9 match)
+  #:use-module (json)
   #:re-export (static-networking-service
                static-networking-service-type)
   #:export (%facebook-host-aliases
@@ -180,7 +182,17 @@
             pagekite-configuration-kitesecret
             pagekite-configuration-frontend
             pagekite-configuration-kites
-            pagekite-configuration-extra-file))
+            pagekite-configuration-extra-file
+
+            yggdrasil-service-type
+            yggdrasil-configuration
+            yggdrasil-configuration?
+            yggdrasil-configuration-autoconf?
+            yggdrasil-configuration-config-file
+            yggdrasil-configuration-log-level
+            yggdrasil-configuration-log-to
+            yggdrasil-configuration-json-config
+            yggdrasil-configuration-package))
 
 ;;; Commentary:
 ;;;
@@ -1750,4 +1762,107 @@ table inet filter {
     "Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make
 local servers publicly accessible on the web, even behind NATs and firewalls.")))
 
+
+;;;
+;;; Yggdrasil
+;;;
+
+(define-record-type* <yggdrasil-configuration>
+  yggdrasil-configuration
+  make-yggdrasil-configuration
+  yggdrasil-configuration?
+  (package yggdrasil-configuration-package
+           (default yggdrasil))
+  (json-config yggdrasil-configuration-json-config
+               (default '()))
+  (config-file yggdrasil-config-file
+               (default "/etc/yggdrasil-private.conf"))
+  (autoconf? yggdrasil-configuration-autoconf?
+             (default #f))
+  (log-level yggdrasil-configuration-log-level
+             (default 'info))
+  (log-to yggdrasil-configuration-log-to
+          (default 'stdout)))
+
+(define (yggdrasil-configuration-file config)
+  (define (scm->yggdrasil-json x)
+    (define key-value?
+      dotted-list?)
+    (define (param->camel str)
+      (string-concatenate
+       (map
+	string-capitalize
+	(string-split str (cut eqv? <> #\-)))))
+    (cond
+     ((key-value? x)
+      (let ((k (car x))
+	    (v (cdr x)))
+	(cons
+	 (if (symbol? k)
+	     (param->camel (symbol->string k))
+	     k)
+	 v)))
+     ((list? x) (map scm->yggdrasil-json x))
+     ((vector? x) (vector-map scm->yggdrasil-json x))
+     (else x)))
+  (computed-file
+   "yggdrasil.conf"
+   #~(call-with-output-file #$output
+       (lambda (port)
+         ;; it's HJSON, so comments are a-okay
+         (display "# Generated by yggdrasil-service\n" port)
+         (display #$(scm->json-string
+                     (scm->yggdrasil-json
+                      (yggdrasil-configuration-json-config config)))
+                  port)))))
+
+(define (yggdrasil-shepherd-service config)
+  "Return a <shepherd-service> for yggdrasil with CONFIG."
+  (define yggdrasil-command
+    #~(append
+       (list (string-append
+              #$(yggdrasil-configuration-package config)
+              "/bin/yggdrasil")
+             "-useconffile"
+             #$(yggdrasil-configuration-file config))
+       (if #$(yggdrasil-configuration-autoconf? config)
+           '("-autoconf")
+           '())
+       (let ((extraconf #$(yggdrasil-config-file config)))
+         (if extraconf
+             (list "-extraconffile" extraconf)
+             '()))
+       (list "-loglevel"
+             #$(symbol->string
+		(yggdrasil-configuration-log-level config))
+             "-logto"
+             #$(symbol->string
+		(yggdrasil-configuration-log-to config)))))
+  (list (shepherd-service
+         (documentation "Connect to the Yggdrasil mesh network")
+         (provision '(yggdrasil))
+         (requirement '(networking))
+         (start #~(make-forkexec-constructor
+                   #$yggdrasil-command
+                   #:log-file "/var/log/yggdrasil.log"
+                   #:group "yggdrasil"))
+         (stop #~(make-kill-destructor)))))
+
+(define %yggdrasil-accounts
+  (list (user-group (name "yggdrasil") (system? #t))))
+
+(define yggdrasil-service-type
+  (service-type
+   (name 'yggdrasil)
+   (description
+    "Connect to the Yggdrasil mesh network.
+See yggdrasil -genconf for config options.")
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             yggdrasil-shepherd-service)
+          (service-extension account-service-type
+                             (const %yggdrasil-accounts))
+          (service-extension profile-service-type
+                             (compose list yggdrasil-configuration-package))))))
+
 ;;; networking.scm ends here
diff --git a/gnu/system/examples/yggdrasil.tmpl b/gnu/system/examples/yggdrasil.tmpl
new file mode 100644
index 0000000000..be80bf4de9
--- /dev/null
+++ b/gnu/system/examples/yggdrasil.tmpl
@@ -0,0 +1,60 @@
+;; This is an operating system configuration template
+;; for a "bare bones" setup, with no X11 display server.
+
+(use-modules (gnu))
+(use-service-modules networking ssh)
+(use-package-modules admin curl networking screen)
+
+(operating-system
+  (host-name "ruby-guard-5545")
+  (timezone "Europe/Budapest")
+  (locale "en_US.utf8")
+
+  ;; 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))
+  (users (cons (user-account
+                (name "alice")
+                (comment "Bob's sister")
+                (group "users")
+                ;; adding her to the yggdrasil group means she can use
+                ;; yggdrasilctl to modify the configuration
+                (supplementary-groups '("wheel" "yggdrasil")))
+               %base-user-accounts))
+
+  ;; Globally-installed packages.
+  (packages (cons* screen curl %base-packages))
+
+  ;; Add services to the baseline: a DHCP client and
+  ;; an SSH server.
+  ;; If you add an /etc/yggdrasil-private.conf, you can log in to ssh
+  ;; using your Yggdrasil IPv6 address from another machine running Yggdrasil.
+  ;; Alternatively, the client can sit behind a router that has Yggdrasil.
+  ;; That file is specifically _not_ handled by Guix, because we don't want its
+  ;; contents to sit in the world-readable /gnu/store.
+  (services
+   (append
+    (list
+     (service dhcp-client-service-type)
+     (service yggdrasil-service-type
+              (yggdrasil-configuration
+               (log-to 'stdout)
+               (log-level 'debug)
+               (autoconf? #f)
+               (json-config
+                ;; choose a few from
+                ;; https://github.com/yggdrasil-network/public-peers
+                '((peers . #("tcp://1.2.3.4:1337"))))
+               (config-file #f)))
+     (service openssh-service-type
+              (openssh-configuration
+               (port-number 2222))))
+    %base-services)))