Init cloned versions of packages.scm and services.scm

3 files changed, 307 insertions, 8 deletions

diff --git a/src/guix/packages.scm b/src/guix/packages.scm
new file mode 100644
index 0000000..691b1b1
--- /dev/null
+++ b/src/guix/packages.scm
@@ -0,0 +1,96 @@
+(define-module (packages)
+  #:use-module ((guix licenses) #:prefix licenses:)
+  #:use-module ((ice-9 popen) #:prefix popen:)
+  #:use-module ((ice-9 rdelim) #:prefix rdelim:)
+  #:use-module ((org euandre queue) #:prefix queue:)
+  #:use-module ((xyz euandreh heredoc) #:prefix heredoc:)
+  #:use-module (gnu)
+  #:use-module (guix build utils)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix download)
+  #:use-module (guix packages)
+  #:use-module (guix utils))
+(use-package-modules
+  node
+  sqlite)
+(heredoc:enable-syntax)
+
+
+(define +working-dir+
+  (if (directory-exists? "/opt/deploy/current")
+    "/opt/deploy/current"
+    (canonicalize-path ".")))
+
+(define +version-cmd+ #"-
+  if grep -q deployer /etc/passwd && [ -e /opt/deploy/current ]; then
+  	sudo -u deployer git -C /opt/deploy/current rev-parse HEAD
+  else
+  	git rev-parse HEAD
+  fi
+  "#)
+
+(define +repo-version+
+  (let* ((port (popen:open-input-pipe +version-cmd+))
+         (v (rdelim:read-line port)))
+    (popen:close-pipe port)
+    v))
+
+;; FIXME: this goes to the package repository later, alongside versions for
+;;        other package managers.  The same is true for the papo-service-type.
+(define-public papo
+  (package
+    (name "papo")
+    (version "da4d8a7b62ca33c58c1f37dfdcb8294abefc8afa")
+    (source
+      (origin
+        (method url-fetch)
+        (uri
+          (string-append "https://papo.im/git/papo/snapshot/papo-"
+                         version
+                         ".tar.xz"))
+        (sha256
+          (base32 "0z08y8nizjb8afy7hscx3l8wqsr2sxc22av5aq9z4k299jkwgp1g"))))
+    (build-system gnu-build-system)  ;; FIXME: posix-build-system
+    (arguments
+      (list
+       #:make-flags
+       #~(list
+          (string-append "PREFIX=" %output)
+          (string-append "CC=" #$(cc-for-target)))
+       #:phases
+       #~(modify-phases %standard-phases
+           (delete 'configure))))
+    (inputs
+      (list
+       node-lts
+       sqlite))
+    (synopsis    "FIXME: slurp from package")
+    (description "FIXME: slurp from package")
+    (home-page   "FIXME: slurp from package")
+    (license licenses:agpl3+)))  ;; "FIXME: also slurp from package
+
+(define-public papo.im
+  (package
+    (name "papo.im")
+    (version +repo-version+)
+    (source
+      (local-file +working-dir+ #:recursive? #t))
+    (build-system gnu-build-system)
+    (arguments
+      (list
+       #:make-flags
+       #~(list
+          (string-append "PREFIX=" %output))
+       #:phases
+       #~(modify-phases %standard-phases
+           (delete 'configure))))
+    (inputs
+      (list))
+    (home-page   #f)
+    (synopsis    #f)
+    (description #f)
+    (license     #f)))
+
+(list
+ papo
+ papo.im)
diff --git a/src/guix/services.scm b/src/guix/services.scm
new file mode 100644
index 0000000..c7d3360
--- /dev/null
+++ b/src/guix/services.scm
@@ -0,0 +1,187 @@
+(define-module (services)
+  #:use-module ((ice-9 popen) #:prefix popen:)
+  #:use-module ((ice-9 textual-ports) #:prefix textual-ports:)
+  #:use-module ((gnu build linux-container) #:prefix container:)
+  #:use-module ((srfi srfi-1) #:prefix srfi-1:)
+  #:use-module ((xyz euandreh heredoc) #:prefix heredoc:)
+  #:use-module (gnu)
+  #:use-module (guix build utils)
+  #:use-module (guix least-authority)
+  #:use-module (guix records))
+(use-package-modules
+  admin)
+(use-service-modules
+  admin
+  mcron
+  shepherd)
+(heredoc:enable-syntax)
+
+
+(define +working-dir+
+  (if (directory-exists? "/opt/deploy/current")
+    "/opt/deploy/current"
+    (canonicalize-path ".")))
+
+(add-to-load-path
+ (string-append +working-dir+ "/src/infrastructure/guix"))
+(use-modules
+  ((packages) #:prefix packages:))
+
+
+
+(define-record-type* <papo-configuration>
+  papo-configuration
+  make-papo-configuration
+  papo-configuration?
+  (package              papo-configuration-package              (default packages:papo))
+  (user                 papo-configuration-user                 (default "papo"))
+  (group                papo-configuration-group                (default "papo"))
+  (config-dirname       papo-configuration-config               (default "papo"))
+  (port                 papo-configuration-port                 (default 6666))
+  (log-file             papo-configuration-log-file             (default "/var/log/papo.log"))
+  (data-directory       papo-configuration-data-directory       (default "/var/lib/papo"))
+  (run-directory        papo-configuration-run-directory        (default "/var/run/papo"))
+  (run-in-container?    papo-configuration-run-in-container?    (default #t))
+  (container-name       papo-configuration-container-name       (default "papo-container"))
+  (container-namespaces papo-configuration-container-namespaces (default container:%namespaces))
+  (extra-mappings       papo-configuration-extra-mappings       (default '())))
+
+(define (papo-etc-files config)
+  (match-record config <papo-configuration>
+      ()
+    `(("papo.json" ,(plain-file "papo.json" "")))))
+
+(define (papo-log-rotations config)
+  (match-record config <papo-configuration>
+      (log-file)
+    (list
+      (log-rotation
+        (frequency 'weekly)
+        (files (list log-file))
+        (options '("rotate 52"))))))
+
+(define (papo-activation config)
+  (match-record config <papo-configuration>
+      (user log-file data-directory run-directory)
+    #~(begin
+        (use-modules (guix build utils))
+        (format (current-error-port)
+         "Creating papo log directory for '~a'.~%" #$log-file)
+        (mkdir-p (dirname #$log-file))
+        (when (not (file-exists? #$log-file))
+          (call-with-output-file #$log-file (const #t)))
+        (chmod #$log-file #o644)
+        (let ((user (getpwnam #$user)))
+          (format (current-error-port)
+           "Creating papo data directory '~a'.~%" #$data-directory)
+          (mkdir-p #$data-directory)
+          (chown #$data-directory (passwd:uid user) (passwd:gid user))
+          (chmod #$data-directory #o750)
+          (format (current-error-port)
+           "Creating papo run directory '~a'.~%" #$run-directory)
+          (mkdir-p #$run-directory)
+          (chown #$run-directory (passwd:uid user) (passwd:gid user))
+          (chmod #$run-directory #o755)))))
+
+(define (papo-cronjobs _config)
+  (list))
+
+(define (papo-accounts config)
+  (match-record config <papo-configuration>
+      (user group)
+    (list
+     (user-group
+       (name group)
+       (system? #t))
+     (user-account
+       (name user)
+       (group group)
+       (system? #t)
+       (comment "The user for runtime execution of papo code")
+       (home-directory "/var/empty")
+       (shell
+         (file-append shadow "/sbin/nologin"))))))
+
+(define (wrapped-command config)
+  (match-record config <papo-configuration>
+      (package data-directory
+       run-in-container? container-name container-namespaces extra-mappings)
+    (let ((bin (file-append package "/bin/papo")))
+      (if (not run-in-container?)
+        bin
+        (least-authority-wrapper
+         bin
+         #:name       container-name
+         #:namespaces container-namespaces
+         #:directory  data-directory
+         #:preserved-environment-variables
+         '()
+         #:mappings
+         (append
+          (list
+           (file-system-mapping
+             (source data-directory)
+             (target source)
+             (writable? #t))
+           (file-system-mapping
+             (source (file-append glibc-locales "/lib/locale"))
+             (target "/run/current-system/locale")))
+          extra-mappings))))))
+
+(define (exec-action config . static-args)
+  (match-record config <papo-configuration>
+      (user group log-file data-directory telegram-token-file)
+    #~(lambda dynamic-args
+        (fork+exec-command
+         (append '(#$@static-args) dynamic-args)
+         #:user      #$user
+         #:group     #$group
+         #:directory #$data-directory
+         #:log-file  #$log-file))))
+
+(define (papo-shepherd-services config)
+  (let ((cmd (wrapped-command config)))
+    (list
+     (shepherd-service
+       (provision '(papo))
+       (requirement '())
+       (start (exec-action config cmd "ircd"))
+       (stop #~(make-kill-destructor SIGKILL))
+       (documentation
+         #"-
+           The Shepherd service that runs the server via "papo-ircd"."#)))))
+
+(define-public papo-service-type
+  (service-type
+    (name 'papo)
+    (extensions
+      (list
+       (service-extension shepherd-root-service-type
+                          papo-shepherd-services)
+       (service-extension etc-service-type
+                          papo-etc-files)
+       (service-extension profile-service-type
+                          (compose list papo-configuration-package))
+       (service-extension activation-service-type
+                          papo-activation)
+       (service-extension account-service-type
+                          papo-accounts)
+       (service-extension mcron-service-type
+                          papo-cronjobs)
+       (service-extension rottlog-service-type
+                          papo-log-rotations)))
+    (default-value (papo-configuration))
+    (description
+      #"-
+        The top-level system service for papo code.
+
+        It includes:
+        - the Shepherd service for starting, stopping and reloading the
+          service ("papo");
+        - a list of cronjobs to be added to the system for sending documents
+          proactively;
+        - activation script for setting up the initial directories and permissions;
+        - the "papo" group and "papo" account for running the production service;
+        - log management (storage and rotation) for logs produced by the running services.
+
+        The defaults of <papo-configuration> provide sane values for all of these."#)))
diff --git a/src/guix/system.scm b/src/guix/system.scm
index 717f721..2b08870 100644
--- a/src/guix/system.scm
+++ b/src/guix/system.scm
@@ -25,11 +25,26 @@
 (heredoc:enable-syntax)
 
 
+(define +ipv4+ "216.238.73.1")
+(define +ipv6+ "2001:19f0:b400:1582:5400:04ff:fea9:370e")
+
+(define +users+
+  '(("andre"  "EuAndreh" ("wheel" "become-deployer" "become-secrets-keeper"))
+    ("laisse" "Laísses"  ())))
+
+
 (define +working-dir+
   (if (directory-exists? "/opt/deploy/current")
     "/opt/deploy/current"
     (canonicalize-path ".")))
 
+(add-to-load-path
+ (string-append +working-dir+ "/src/guix"))
+(use-modules
+  ((packages) #:prefix packages:)
+  ((services) #:prefix services:))
+
+
 (define (str . rest)
   (apply string-append rest))
 
@@ -51,12 +66,6 @@
   (string-trim-right
    (file "src/config/tld.txt")))
 
-(define +ipv4+ "216.238.73.1")
-(define +ipv6+ "2001:19f0:b400:1582:5400:04ff:fea9:370e")
-
-(define +users+
-  '(("andre"  "EuAndreh" ("wheel" "become-deployer" "become-secrets-keeper"))
-    ("laisse" "Laísses"  ())))
 
 (define +user-accounts+
   (map (lambda (user)
@@ -220,6 +229,12 @@
          (mail mail)
          (entries ipv6-reverse-domain-zone))))))
 
+(define private-http
+  '(#"-
+      auth_basic "Private area";
+      auth_basic_user_file /opt/secrets/htpasswd.txt;
+      "#))
+
 
 (operating-system
   (locale "en_GB.UTF-8")
@@ -387,7 +402,8 @@
                     (uri "/api/")
                     (body
                       (list
-#;
+                       ;; FIXME: use this for blue/green deployment
+                       #;
                        (fmt "include /var/run/~a/curr.conf;~%" +tld+))))
                   (nginx-location-configuration
                     (uri "/git/static/")
@@ -439,7 +455,7 @@
             mailbox_size_limit = 5120000000
             "#)))
       (service mail-aliases-service-type
-        `(("root" "andre")
+        `(("root"    "andre")
           ("support" ,@(map s1:first +users+)))))
      (modify-services %base-services
        (rottlog-service-type config =>