system.scm: Shrinkmore by removing inlined files

1 files changed, 48 insertions, 620 deletions

diff --git a/src/infrastructure/guix/system.scm b/src/infrastructure/guix/system.scm
index edcc878..d7c0a26 100644
--- a/src/infrastructure/guix/system.scm
+++ b/src/infrastructure/guix/system.scm
@@ -1,4 +1,5 @@
 (use-modules
+  ((ice-9 textual-ports) #:prefix textual-ports:)
   ((guix licenses) #:prefix license:)
   ((srfi srfi-1) #:prefix s1:)
   ((xyz euandreh heredoc) #:prefix heredoc:)
@@ -46,44 +47,11 @@
 (heredoc:enable-syntax)
 
 
-(define ssh-pubkey
-  "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDnUv7iWOejQNa3fZ6v4lkHT6qFRp2+NuzIpFJ2Vy7eP58XZoiz6HJPcCU8Hf95JXwaXEwS4S7mXdw1x60hd8JIe058Ek6MZSSVQmlLfocGsAYj1wTrLmnQ8+PV0IeQlNj1aytBI1fL+v3IPt+JdLt6b+g3vwcEUU9efzxx2E0KZ5GIpb2meiCQ6ha+tcd7XqegB53eQj/h/coE2zLJodpaJ3xbj894pE/OJCNC0+4d0Sv7oHhY7QoLYldTQbSgPyhyfl4iZpJf6OEPZxK2cJaB+cbeoBB6aGNyU+CIJToM+uAJJ7H7EpvxfcnfJQ1PuY5szTdvFbW820euiUEKEW69mW4uaFNPSc6D4Z8tZ5hXQIqBD40irULhF0CYNkIILmyNV/KJIZ5HkbQ1q+UrCFHJyvuH/3aCTjj9OSfE7xHPQ3xd3Xw8vvj0Mjie09xFbbcklBTw5WRzH7cw8c+Q0O69kZZ8b+ykcdzWTeZeWNdnzptNqnMjfheig90rUIJ7DN0c+53jCUcGpWJxJhcYF9Uk1RNHmSE5+VzK1y+20t0grVFX90nApm4Tl35QPrX7Qxp9C81cWiUB8xCAE6jYrmd4x+P/3wSQfc1Xg0Eg3QjJB+6JD7cbyDJpzDR3ja+CLZCAr9I0B4rDKD2d6et/z67iXPnZUWMyZ8RVVZPFbBMOTw== openpgp:0xF727046D")
-
 (define tld "euandre.org")
 
 (define users
   '(("andreh" "EuAndreh" ("wheel" "become-deployer" "become-secrets-keeper"))))
 
-(define (ssh-file-for user)
-  (let ((name (s1:first user)))
-    (or name
-    (path (fmt "src/infrastructure/keys/SSH/~a.pub" name)))))
-
-(define authorized-keys
-  (let ((users-with-keys
-         (map (lambda (user)
-                (append user
-                        (list (slurp (ssh-file-for user)))))
-              (filter (lambda (user)
-                        (file-exists? (ssh-file-for user)))
-                      users))))
-    (append
-     (map (lambda (user)
-            (let ((name (s1:first  user))
-                  (key  (s1:fourth user)))
-              `(,name ,(plain-file (str name "-id_rsa.pub")
-                                   key))))
-          users-with-keys)
-     `(("git" ,@(map (lambda (user)
-                       (let ((name (s1:first  user))
-                             (key  (s1:fourth user)))
-                         (plain-file (str name "-git-id_rsa.pub")
-                                     key)))
-                     users-with-keys))))))
-
-(define authorized-keys
-  `(("andreh" ,(plain-file "id_rsa.pub" ssh-pubkey))
-    ("git"    ,(plain-file "id_rsa.pub" ssh-pubkey))))
 
 (define working-dir
   (if (directory-exists? "/opt/deploy/current")
@@ -96,575 +64,17 @@
 (define (fmt . rest)
   (apply format #f rest))
 
-(define rc.sh (plain-file "rc.sh" #"-
-  #!/bin/sh
-
-  # shellcheck source=/dev/null
-  . /etc/profile
-
-  export XDG_PREFIX=~/.usr
-  export XDG_CACHE_HOME="$XDG_PREFIX"/var/cache
-  export XDG_CONFIG_HOME="$XDG_PREFIX"/etc
-  export XDG_DATA_HOME="$XDG_PREFIX"/share
-  export XDG_STATE_HOME="$XDG_PREFIX"/state
-  export XDG_LOG_HOME="$XDG_PREFIX"/var/log
-
-  mkdir -p \
-  	"$XDG_CONFIG_HOME" \
-  	"$XDG_CACHE_HOME"  \
-  	"$XDG_DATA_HOME"   \
-  	"$XDG_STATE_HOME"/ssh/conn  \
-  	"$XDG_LOG_HOME"
-
-  GUIX_PROFILE="$XDG_CONFIG_HOME"/guix/current
-  if [ -r "$GUIX_PROFILE"/etc/profile ]; then
-  	# shellcheck source=/dev/null
-  	. "$GUIX_PROFILE"/etc/profile
-  fi
-
-  export ENV=~/.profile
-  export HISTSIZE=-1
-  export HISTCONTROL=ignorespace:ignoredups
-  export EDITOR=vi
-  export VISUAL="$EDITOR"
-  export PAGER='less -R'
-
-  export EXINIT='
-  	" set number
-  	" set autoindent
-  	set ruler
-  	set showmode
-  	set showmatch
-  '
-
-  export HISTFILE="$XDG_STATE_HOME"/bash-history
-  export LESSHISTFILE="$XDG_STATE_HOME"/lesshst
-  export RLWRAP_HOME="$XDG_CACHE_HOME"/rlwrap
-  export GUILE_HISTORY="$XDG_STATE_HOME"/guile-history
-
-  HOSTNAME="$(hostname)"
-  export BORG_REPO="zh3051@zh3051.rsync.net:borg/$HOSTNAME"
-  export BORG_REMOTE_PATH='borg1'
-  export BORG_PASSCOMMAND='cat /var/lib/borg-passphrase.txt'
-
-  export GIT_CONFIG_GLOBAL=/etc/gitconfig
-
-  unalias -a
-  alias l='ls -lahF --color'
-  alias grep='grep --color=auto'
-  alias diff='diff --color=auto'
-  alias watch='watch --color '
-  alias man='MANWIDTH=$((COLUMNS > 80 ? 80 : COLUMNS)) man'
-  alias less='less -R'
-  alias tree='tree -aC'
-  alias mv='mv -i'
-  alias e='vi'
-
-  alias sqlite='rlwrap sqlite3'
-  alias guile='guile -l /etc/init.scm'
-
-  error_marker() {
-  	STATUS=$?
-  	if [ "$STATUS" != 0 ]; then
-  		printf ' (!! %s !!) ' "$STATUS"
-  	fi
-  }
-  export PS1='`error_marker`\T \w/
-  \u@\H\$ '
-  "#))
-
-(define ssh.conf (plain-file "ssh.conf" #"-
-  Host *
-    ServerAliveInterval 30
-    ServerAliveCountMax 20
-    ControlMaster auto
-    ControlPath ${XDG_STATE_HOME}/ssh/conn/%r@%h:%p
-    ControlPersist 1h
-  "#))
-
-
-(define init.scm (plain-file "init.scm" #"-
-  (use-modules
-    (ice-9 colorized)
-    (ice-9 readline))
-
-  (activate-colorized)
-  (activate-readline)
-  "#))
-
-(define r.sh #"-
-  #!/bin/sh
-  set -eu
-
-  # FIXME: what about /etc/login.defs?
-
-  usage() {
-  	cat <<-'EOF'
-  		Usage:
-  		  r COMMAND...
-  		  r -h
-  	EOF
-  }
-
-  help() {
-  	cat <<-'EOF'
-
-  		Options:
-  		  -h, --help    show this message
-
-  		  COMMAND       the command to be executed
-
-
-  		Execute the given command, with a proper login environment
-                loaded.
-
-
-  		Examples:
-
-  		  Run a backup via SSH:
-
-  		    $ ssh toph r backup -q cron
-  	EOF
-  }
-
-
-  for flag in "$@"; do
-  	case "$flag" in
-  		--)
-  			break
-  			;;
-  		--help)
-  			usage
-  			help
-  			exit
-  			;;
-  		*)
-  			;;
-  	esac
-  done
-
-  while getopts 'h' flag; do
-  	case "$flag" in
-  		h)
-  			usage
-  			help
-  			exit
-  			;;
-  		*)
-  			usage >&2
-  			exit 2
-  			;;
-  	esac
-  done
-  shift $((OPTIND - 1))
-
-
-  set +eu
-  # shellcheck source=/dev/null
-  . /etc/rc
-  set -eu
-
-  exec "$@"
-  "#)
-
-(define backup.sh #"-
-  #!/bin/sh
-  set -eu
-
-  usage() {
-  	cat <<-'EOF'
-  		Usage:
-  		  backup [-q] [-C COMMENT] [-r REPO] [ARCHIVE_TAG]
-  		  backup -h
-  	EOF
-  }
-
-  help() {
-  	cat <<-'EOF'
-
-  		Options:
-  		  -q             disable verbose move, useful for
-  		                 for batch sessions
-  		  -C COMMENT     the comment text to be attached to the archive
-  		  -r REPO        operate on REPO instead of ::
-  		  -h, --help     show this message
-
-  		  ARCHIVE_TAG    the tag used to create the new
-  		                 backup (default: "manual")
-
-
-  		The repository is expected to have been created with:
-
-  		  $ borg init -e repokey-blake2
-
-  		The following environment variables are expected to be exported:
-
-  		  $BORG_PASSCOMMAND
-  		  $BORG_REPO
-  		  $BORG_REMOTE_PATH
-
-  		Password-less SSH access is required, usually done via adding
-  		~/.ssh/id_rsa.pub to the-ssh-remote:.ssh/authorized_keys.
-
-  		Root permission is also required.
-
-
-  		Examples:
-
-  		  Run backup from cronjob:
-
-  		    $ backup -q cronjob
-
-
-  		  Create backup with a comment, a tag, and verbose mode active:
-
-  		    $ backup -C 'The backup has a comment'
-  	EOF
-  }
-
-
-  for flag in "$@"; do
-  	case "$flag" in
-  		--)
-  			break
-  			;;
-  		--help)
-  			usage
-  			help
-  			exit
-  			;;
-  		*)
-  			;;
-  	esac
-  done
-
-  VERBOSE_FLAGS='--verbose --progress'
-  COMMENT=''
-  REPO=''
-  while getopts 'qC:r:h' flag; do
-  	case "$flag" in
-  		q)
-  			VERBOSE_FLAGS=''
-  			;;
-  		C)
-  			COMMENT="$OPTARG"
-  			;;
-  		r)
-  			REPO="$OPTARG"
-  			;;
-  		h)
-  			usage
-  			help
-  			exit
-  			;;
-  		*)
-  			usage >&2
-  			exit 2
-  			;;
-  	esac
-  done
-  shift $((OPTIND - 1))
-
-  ARCHIVE_TAG="${1:-manual}"
-
-
-  run() {
-  	set -x
-  	# shellcheck disable=2086
-  	sudo -i borg create \
-  		$VERBOSE_FLAGS                          \
-  		--comment " $COMMENT"                   \
-  		--stats                                 \
-  		--compression lzma,9                    \
-  		"$REPO::$(hostname)-{now}-$ARCHIVE_TAG" \
-  		/root/                                  \
-  		/home/                                  \
-  		/etc/                                   \
-  		/var/                                   \
-  		/srv/
-  	STATUS=$?
-  	set +x
+(define (path s)
+  (str working-dir "/" s))
 
-  	if [ "$STATUS" = 0 ]; then
-  		return 0
-  	elif [ "$STATUS" = 1 ]; then
-  		printf 'WARNING, but no ERROR.\n' >&2
-  		return 0
-  	else
-  		return "$STATUS"
-  	fi
-  }
-
-  run || exit $?
-
-  sudo -i borg check --verify-data --verbose "${REPO:-::}"
-  "#)
-
-(define cronjob.sh #"-
-  #!/bin/sh
-  set -eu
-
-  usage() {
-  	cat <<-'EOF'
-  		Usage:
-  		  cronjob COMMAND...
-  		  cronjob -h
-  	EOF
-  }
-
-  help() {
-  	cat <<-'EOF'
-
-  		Options:
-  		  -h, --help    show this message
-
-  		  COMMAND       the command to be executed
-
-
-  		Execute the given command, and send the output to email, with
-  		special treatment to the status code.
-
-  		It loads the appropriate files, so that the actual cron
-  		declaration is smaller.
-
-
-  		Examples:
-
-  		  Run a backup:
-
-  		    $ cronjob backup -q cron
-  	EOF
-  }
-
-
-  for flag in "$@"; do
-  	case "$flag" in
-  		--)
-  			break
-  			;;
-  		--help)
-  			usage
-  			help
-  			exit
-  			;;
-  		*)
-  			;;
-  	esac
-  done
-
-  while getopts 'h' flag; do
-  	case "$flag" in
-  		h)
-  			usage
-  			help
-  			exit
-  			;;
-  		*)
-  			usage >&2
-  			exit 2
-  			;;
-  	esac
-  done
-  shift $((OPTIND - 1))
-
-
-  CMD="$*"
-  r with-email -s "$(hostname): $CMD" -- "$@" 1>> /var/log/cronjob.log 2>&1
-  "#)
-
-(define reconfigure.sh #"-
-  #!/bin/sh
-  set -eu
-
-
-  usage() {
-  	cat <<-'EOF'
-  		Usage:
-  		  reconfigure [-U]
-  		  reconfigure -h
-  	EOF
-  }
-
-  help() {
-  	cat <<-'EOF'
-
-  		Options:
-  		  -U             pull the latest channels before reconfiguring
-  		  -h, --help    show this message
-
-
-  		Run a "guix system reconfigure".  If the -U flag is given,
-  		perform a "guix pull" prior to the reconfigure.
-
-
-  		Examples:
-
-  		  Just do the deploy:
-
-  		    $ reconfigure
-
-
-  		  Update and upgrade:
-
-  		    $ reconfigure -U
-  	EOF
-  }
-
-
-  for flag in "$@"; do
-  	case "$flag" in
-  		--)
-  			break
-  			;;
-  		--help)
-  			usage
-  			help
-  			exit
-  			;;
-  		*)
-  			;;
-  	esac
-  done
-
-  UPDATE=false
-  while getopts 'Uh' flag; do
-  	case "$flag" in
-  		U)
-  			UPDATE=true
-  			;;
-  		h)
-  			usage
-  			help
-  			exit
-  			;;
-  		*)
-  			usage >&2
-  			exit 2
-  			;;
-  	esac
-  done
-  shift $((OPTIND - 1))
-
-  if [ "$UPDATE" = true ]; then
-  	sudo -i guix pull -v3
-  fi
-
-  
-  sudo -i guix system -v3 reconfigure /etc/guix/system.scm
-  "#)
-
-(define with-email.sh #"-
-  #!/bin/sh
-  set -eu
-
-  usage() {
-  	cat <<-'EOF'
-  		Usage:
-  		  with-email [-s SUBJECT] COMMAND...
-  		  with-email -h
-  	EOF
-  }
-
-  help() {
-  	cat <<-'EOF'
-
-  		Options:
-  		  -s SUBJECT    set the subject of the email
-  		  -h, --help    show this message
-
-  		  COMMAND       the command to be wrapped
-
-
-  		Examples:
-
-  		  Send email with default subject:
-
-  		    $ with-email echo 123
-
-
-  		  Use custom subject and explicit separation of command:
-
-  		    $ with-email -s 'Something' -- do-something.sh
-  	EOF
-  }
-
-  now() {
-  	date '+%Y-%m-%dT%H:%M:%S%Z'
-  }
-
-  uuid() {
-  	od -xN20 /dev/urandom |
-  		head -n1 |
-  		awk '{OFS="-"; print $2$3,$4,$5,$6,$7$8$9}'
-  }
-
-  mkstemp() {
-  	name="${TMPDIR:-/tmp}/uuid-tmpname with spaces.$(uuid)"
-  	touch "$name"
-  	echo "$name"
-  }
-
-
-  for flag in "$@"; do
-  	case "$flag" in
-  		--)
-  			break
-  			;;
-  		--help)
-  			usage
-  			help
-  			exit
-  			;;
-  		*)
-  			;;
-  	esac
-  done
-
-  SUBJECT='NO SUBJECT'
-  while getopts 's:h' flag; do
-  	case "$flag" in
-  		s)
-  			SUBJECT="$OPTARG"
-  			;;
-  		h)
-  			usage
-  			help
-  			exit
-  			;;
-  		*)
-  			usage >&2
-  			exit 2
-  			;;
-  	esac
-  done
-  shift $((OPTIND - 1))
-
-  if [ -z "$1" ]; then
-  	printf 'Missing COMMAND.\n\n' >&2
-  	usage >&2
-  	exit 2
-  fi
-
-  STATUS=0
-  OUT="$(mkstemp)"
-  {
-  	printf 'Running command: %s\n' "$*"
-  	printf 'Starting at: %s\n' "$(now)"
-  	printf '\n'
-
-  	"$@" || STATUS=$?
-
-  	printf '\n'
-  	printf 'Finished at: %s\n' "$(now)"
-  } 1>"$OUT" 2>&1
-
-  HOSTNAME="$(hostname)"
-  mail \
-  	-a 'Content-Type: text/plain; charset=UTF-8' \
-  	-s "(exit status: $STATUS) - $SUBJECT"       \
-  	root < "$OUT" || cat "$OUT"
-  "#)
+(define (slurp s)
+  (string-trim-both
+   (call-with-input-file
+    s
+    textual-ports:get-string-all)))
 
+(define (file s)
+  (slurp (path s)))
 
 (define (script name content)
   (package
@@ -703,24 +113,40 @@
              (supplementary-groups groups))))
        users))
 
+(define (ssh-file-for user)
+  (let ((name (s1:first user)))
+    (path (fmt "src/infrastructure/keys/SSH/~a.pub" name))))
+
+(define authorized-keys
+  (let ((users-with-keys
+         (map (lambda (user)
+                (append user
+                        (list (slurp (ssh-file-for user)))))
+              (filter (lambda (user)
+                        (file-exists? (ssh-file-for user)))
+                      users))))
+    (append
+     (map (lambda (user)
+            (let ((name (s1:first  user))
+                  (key  (s1:fourth user)))
+              `(,name ,(plain-file (str name "-id_rsa.pub")
+                                   key))))
+          users-with-keys)
+     `(("git" ,@(map (lambda (user)
+                       (let ((name (s1:first  user))
+                             (key  (s1:fourth user)))
+                         (plain-file (str name "-git-id_rsa.pub")
+                                     key)))
+                     users-with-keys))))))
 
-(define gitconfig (plain-file "gitconfig" (format #f #"-
-  [init]
-    defaultBranch = main
-  [user]
-    email = ci@~a
-    name = "~a CI"
-  [advice]
-    detachedHead = false
-  "#
-  tld
-  tld)))
 
 
 (operating-system
   (locale "fr_FR.UTF-8")
   (timezone "America/Sao_Paulo")
   (host-name tld)
+  (skeletons
+    `((".profile" ,(plain-file "user-profile" (file "src/infrastructure/config/profile.sh")))))
   (users
     (append
      (list
@@ -806,11 +232,13 @@
             trash-cli
             tree))
      (list
-      (script "r"           r.sh)
-      (script "backup"      backup.sh)
-      (script "cronjob"     cronjob.sh)
-      (script "reconfigure" reconfigure.sh)
-      (script "with-email"  with-email.sh))
+      (script "r"           (file "src/infrastructure/scripts/r.sh"))
+      (script "gc"          (file "src/infrastructure/scripts/gc.sh"))
+      (script "backup"      (file "src/infrastructure/scripts/backup.sh"))
+      (script "deploy"      (file "src/infrastructure/scripts/deploy.sh"))
+      (script "report"      (file "src/infrastructure/scripts/report.sh"))
+      (script "cronjob"     (file "src/infrastructure/scripts/cronjob.sh"))
+      (script "reconfigure" (file "src/infrastructure/scripts/reconfigure.sh")))
      %base-packages))
   (services
     (append
@@ -918,10 +346,10 @@
                 readme=:README
                 "#))))
       (simple-service 'extra-etc-file etc-service-type
-        `(("rc"        ,rc.sh)
-          ("ssh.conf"  ,ssh.conf)
-          ("init.scm"  ,init.scm)
-          ("gitconfig" ,gitconfig)))
+        `(("rc"        ,(plain-file "rc.sh"     (file "src/infrastructure/config/rc.sh")))
+          ("ssh.conf"  ,(plain-file "ssh.conf"  (file "src/infrastructure/config/ssh.conf")))
+          ("init.scm"  ,(plain-file "init.scm"  (file "src/infrastructure/config/init.scm")))
+          ("gitconfig" ,(plain-file "gitconfig" (file "src/infrastructure/config/gitconfig")))))
       (service git-daemon-service-type
         (git-daemon-configuration
           (export-all? #t)))