diff options
Diffstat (limited to 'gnu/services/networking.scm')
| -rw-r--r-- | gnu/services/networking.scm | 156 |
1 files changed, 132 insertions, 24 deletions
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 93d9b6a15e..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. ;;; @@ -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: ;;; @@ -345,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) @@ -394,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 @@ -416,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 @@ -1526,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 |