Merge remote-tracking branch master into core-updates

1 files changed, 164 insertions, 25 deletions

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index dd63009116..6485c08ff7 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.
 ;;;
@@ -51,6 +52,7 @@
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix modules)
+  #:use-module (guix packages)
   #:use-module (guix deprecation)
   #:use-module (rnrs enums)
   #:use-module (srfi srfi-1)
@@ -110,6 +112,7 @@
             network-manager-configuration
             network-manager-configuration?
             network-manager-configuration-dns
+            network-manager-configuration-vpn-plugins
             network-manager-service-type
 
             connman-configuration
@@ -152,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:
 ;;;
@@ -343,7 +356,7 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
                 (res '()))
        (if (list? x)
            (fold loop res x)
-           (cons (format #f "~s" x) res)))))
+           (cons (format #f "~a" x) res)))))
 
   (match ntp-server
     (($ <ntp-server> type address options)
@@ -392,15 +405,16 @@ deprecated.  Please use <ntp-server> records instead.\n")
        ntp-servers))))
 
 (define ntp-shepherd-service
-  (match-lambda
-    (($ <ntp-configuration> ntp servers allow-large-adjustment?)
-     (let ()
-       ;; TODO: Add authentication support.
-       (define config
-         (string-append "driftfile /var/run/ntpd/ntp.drift\n"
-                        (string-join (map ntp-server->string servers)
-                                     "\n")
-                        "
+  (lambda (config)
+    (match config
+      (($ <ntp-configuration> ntp servers allow-large-adjustment?)
+       (let ((servers (ntp-configuration-servers config)))
+         ;; TODO: Add authentication support.
+         (define config
+           (string-append "driftfile /var/run/ntpd/ntp.drift\n"
+                          (string-join (map ntp-server->string servers)
+                                       "\n")
+                          "
 # Disable status queries as a workaround for CVE-2013-5211:
 # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
 restrict default kod nomodify notrap nopeer noquery limited
@@ -414,20 +428,20 @@ restrict -6 ::1
 # option by default, as documented in the 'ntp.conf' manual.
 restrict source notrap nomodify noquery\n"))
 
-       (define ntpd.conf
-         (plain-file "ntpd.conf" config))
+         (define ntpd.conf
+           (plain-file "ntpd.conf" config))
 
-       (list (shepherd-service
-              (provision '(ntpd))
-              (documentation "Run the Network Time Protocol (NTP) daemon.")
-              (requirement '(user-processes networking))
-              (start #~(make-forkexec-constructor
-                        (list (string-append #$ntp "/bin/ntpd") "-n"
-                              "-c" #$ntpd.conf "-u" "ntpd"
-                              #$@(if allow-large-adjustment?
-                                     '("-g")
-                                     '()))))
-              (stop #~(make-kill-destructor))))))))
+         (list (shepherd-service
+                (provision '(ntpd))
+                (documentation "Run the Network Time Protocol (NTP) daemon.")
+                (requirement '(user-processes networking))
+                (start #~(make-forkexec-constructor
+                          (list (string-append #$ntp "/bin/ntpd") "-n"
+                                "-c" #$ntpd.conf "-u" "ntpd"
+                                #$@(if allow-large-adjustment?
+                                       '("-g")
+                                       '()))))
+                (stop #~(make-kill-destructor)))))))))
 
 (define %ntp-accounts
   (list (user-account
@@ -986,7 +1000,7 @@ and @command{wicd-curses} user interfaces."
                    (default network-manager))
   (dns network-manager-configuration-dns
        (default "default"))
-  (vpn-plugins network-manager-vpn-plugins        ;list of <package>
+  (vpn-plugins network-manager-configuration-vpn-plugins ;list of <package>
                (default '())))
 
 (define network-manager-activation
@@ -1005,6 +1019,33 @@ and @command{wicd-curses} user interfaces."
   "Return a directory containing PLUGINS, the NM VPN plugins."
   (directory-union "network-manager-vpn-plugins" plugins))
 
+(define (network-manager-accounts config)
+  "Return the list of <user-account> and <user-group> for CONFIG."
+  (define nologin
+    (file-append shadow "/sbin/nologin"))
+
+  (define accounts
+    (append-map (lambda (package)
+                  (map (lambda (name)
+                         (user-account (system? #t)
+                                       (name name)
+                                       (group "network-manager")
+                                       (comment "NetworkManager helper")
+                                       (home-directory "/var/empty")
+                                       (create-home-directory? #f)
+                                       (shell nologin)))
+                       (or (assoc-ref (package-properties package)
+                                      'user-accounts)
+                           '())))
+                (network-manager-configuration-vpn-plugins config)))
+
+  (match accounts
+    (()
+     '())
+    (_
+     (cons (user-group (name "network-manager") (system? #t))
+           accounts))))
+
 (define network-manager-environment
   (match-lambda
     (($ <network-manager-configuration> network-manager dns vpn-plugins)
@@ -1054,6 +1095,8 @@ and @command{wicd-curses} user interfaces."
                                (compose
                                 list
                                 network-manager-configuration-network-manager))
+            (service-extension account-service-type
+                               network-manager-accounts)
             (service-extension activation-service-type
                                network-manager-activation)
             (service-extension session-environment-service-type
@@ -1495,4 +1538,100 @@ table inet filter {
                              (compose list nftables-configuration-package))))
    (default-value (nftables-configuration))))
 
+
+;;;
+;;; 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 config)
+  (match-record config <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-record 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 some 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