[bug#38059] [PATCH 3/3] services: Add pagekite-service-type

["Alex Griffin" <a@ajgrf.com>]

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

This patch adds a PageKite service, so you can finally run that Guix home server without fiddling with dyndns, firewall rules, and port forwarding!

-- 
Alex Griffin

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0003-services-Add-pagekite-service-type.patch --]
[-- Type: text/x-patch; name="0003-services-Add-pagekite-service-type.patch", Size: 8315 bytes --]

From ec63d0cd530d4782f0964b9da27e46d80ec7c3f9 Mon Sep 17 00:00:00 2001
From: Alex Griffin <a@ajgrf.com>
Date: Mon, 4 Nov 2019 19:29:24 -0600
Subject: [PATCH 3/3] services: Add pagekite-service-type.

* gnu/services/networking.scm (pagekite-service-type): New service type.
(<pagekite-configuration>): New record type.
(pagekite-shepherd-service): New procedure.
* doc/guix.texi (Networking Services): Document it.
---
 doc/guix.texi               |  48 ++++++++++++++++
 gnu/services/networking.scm | 111 +++++++++++++++++++++++++++++++++++-
 2 files changed, 158 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 7b1ee163c4..b855363921 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -66,6 +66,7 @@ Copyright @copyright{} 2019 Josh Holland@*
 Copyright @copyright{} 2019 Diego Nicola Barbato@*
 Copyright @copyright{} 2019 Ivan Petkov@*
 Copyright @copyright{} 2019 Jakob L. Kreuze@*
+Copyright @copyright{} 2019 Alex Griffin@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -13953,6 +13954,53 @@ Package object of the Open vSwitch.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} pagekite-service-type
+This is the service type for the @uref{https://pagekite.net, PageKite} service,
+a tunneling solution for making localhost servers publicly visible, even from
+behind NAT or restrictive firewalls.  The value for this service type is a
+@code{pagekite-configuration} record.
+
+Here's an example exposing the local HTTP and SSH daemons:
+
+@lisp
+(service pagekite-service-type
+         (pagekite-configuration
+           (kites '("http:@@kitename:localhost:80:@@kitesecret"
+                    "raw/22:@@kitename:localhost:22:@@kitesecret"))
+           (extra-file "/etc/pagekite.rc")))
+@end lisp
+@end defvr
+
+@deftp {Data Type} pagekite-configuration
+Data type representing the configuration of PageKite.
+
+@table @asis
+@item @code{package} (default: @var{pagekite})
+Package object of PageKite.
+
+@item @code{kitename} (default: @code{#f})
+PageKite name for authenticating to the frontend server.
+
+@item @code{kitesecret} (default: @code{#f})
+Shared secret for authenticating to the frontend server.  You should probably
+put this inside @code{extra-file} instead.
+
+@item @code{frontend} (default: @code{#f})
+Connect to the named PageKite frontend server instead of the
+@uref{https://pagekite.net,,pagekite.net} service.
+
+@item @code{kites} (default: @code{'("http:@@kitename:localhost:80:@@kitesecret")})
+List of service kites to use.  The format is
+@code{proto:kitename:host:port:secret}.
+
+@item @code{extra-file} (default: @code{#f})
+Extra configuration file to read, which you are expected to create manually.
+Use this to add additional options, manage shared secrets out-of-band, or run
+PageKite as a frontend server.
+
+@end table
+@end deftp
+
 @node X Window
 @subsection X Window
 
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index a1c1aad9f6..c61b0ec1e4 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -12,6 +12,7 @@
 ;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
+;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -154,7 +155,17 @@
             nftables-configuration?
             nftables-configuration-package
             nftables-configuration-ruleset
-            %default-nftables-ruleset))
+            %default-nftables-ruleset
+
+            pagekite-service-type
+            pagekite-configuration
+            pagekite-configuration?
+            pagekite-configuration-package
+            pagekite-configuration-kitename
+            pagekite-configuration-kitesecret
+            pagekite-configuration-frontend
+            pagekite-configuration-kites
+            pagekite-configuration-extra-file))
 
 ;;; Commentary:
 ;;;
@@ -1527,4 +1538,102 @@ table inet filter {
                              (compose list nftables-configuration-package))))
    (default-value (nftables-configuration))))
 
+\f
+;;;
+;;; PageKite
+;;;
+
+(define-record-type* <pagekite-configuration>
+  pagekite-configuration
+  make-pagekite-configuration
+  pagekite-configuration?
+  (package pagekite-configuration-package
+           (default pagekite))
+  (kitename pagekite-configuration-kitename
+            (default #f))
+  (kitesecret pagekite-configuration-kitesecret
+              (default #f))
+  (frontend pagekite-configuration-frontend
+            (default #f))
+  (kites pagekite-configuration-kites
+         (default '("http:@kitename:localhost:80:@kitesecret")))
+  (extra-file pagekite-configuration-extra-file
+              (default #f)))
+
+(define pagekite-configuration-file
+  (match-lambda
+    (($ <pagekite-configuration> package kitename kitesecret
+                                 frontend kites extra-file)
+     (mixed-text-file "pagekite.rc"
+                      (if extra-file
+                          (string-append "optfile = " extra-file "\n")
+                          "")
+                      (if kitename
+                          (string-append "kitename = " kitename "\n")
+                          "")
+                      (if kitesecret
+                          (string-append "kitesecret = " kitesecret "\n")
+                          "")
+                      (if frontend
+                          (string-append "frontend = " frontend "\n")
+                          "defaults\n")
+                      (string-join (map (lambda (kite)
+                                          (string-append "service_on = " kite))
+                                        kites)
+                                   "\n"
+                                   'suffix)))))
+
+(define (pagekite-shepherd-service config)
+  (match config
+    (($ <pagekite-configuration> package kitename kitesecret
+                                 frontend kites extra-file)
+     (with-imported-modules (source-module-closure
+                             '((gnu build shepherd)
+                               (gnu system file-systems)))
+       (shepherd-service
+        (documentation "Run the PageKite service.")
+        (provision '(pagekite))
+        (requirement '(networking))
+        (modules '((gnu build shepherd)
+                   (gnu system file-systems)))
+        (start #~(make-forkexec-constructor/container
+                  (list #$(file-append package "/bin/pagekite")
+                        "--clean"
+                        "--nullui"
+                        "--nocrashreport"
+                        "--runas=pagekite:pagekite"
+                        (string-append "--optfile="
+                                       #$(pagekite-configuration-file config)))
+                  #:log-file "/var/log/pagekite.log"
+                  #:mappings #$(if extra-file
+                                   #~(list (file-system-mapping
+                                            (source #$extra-file)
+                                            (target source)))
+                                   '())))
+        ;; SIGTERM doesn't always work for reason.
+        (stop #~(make-kill-destructor SIGINT)))))))
+
+(define %pagekite-accounts
+  (list (user-group (name "pagekite") (system? #t))
+        (user-account
+         (name "pagekite")
+         (group "pagekite")
+         (system? #t)
+         (comment "PageKite user")
+         (home-directory "/var/empty")
+         (shell (file-append shadow "/sbin/nologin")))))
+
+(define pagekite-service-type
+  (service-type
+   (name 'pagekite)
+   (default-value (pagekite-configuration))
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             (compose list pagekite-shepherd-service))
+          (service-extension account-service-type
+                             (const %pagekite-accounts))))
+   (description
+    "Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make
+local servers publicly accessible on the web, even behind NATs and firewalls.")))
+
 ;;; networking.scm ends here
-- 
2.23.0