Initial commit.

1 files changed, 364 insertions, 0 deletions

diff --git a/vm.scm b/vm.scm
new file mode 100644
index 0000000..aeae035
--- /dev/null
+++ b/vm.scm
@@ -0,0 +1,364 @@
+(use-modules ((srfi srfi-26) #:select (cut))
+
+             ((ice-9 match) #:select (match))
+             ((ice-9 popen) #:select (open-pipe* close-pipe))
+             ((ice-9 ports) #:select (OPEN_READ))
+             ((ice-9 regex) #:select (match:substring string-match))
+             ((ice-9 textual-ports) #:select (get-string-all))
+
+             ((gnu bootloader) #:select (bootloader-configuration))
+             ((gnu bootloader grub) #:select (grub-bootloader))
+             ((gnu packages) #:select (specifications->packages))
+             ((gnu packages admin) #:select (shadow))
+             ((gnu packages autotools) #:select
+              (autoconf automake lawrence-boilerplate))
+             ((gnu packages base) #:select (coreutils))
+             ((gnu packages guile) #:select (guile-3.0))
+             ((gnu packages guile-xyz) #:select (guile-cantius guile-lib))
+             ((gnu packages pkg-config) #:select (pkg-config))
+             ((gnu packages tls) #:select (openssl))
+             ((gnu packages web) #:select (httpd))
+             ((gnu services) #:select
+              (activation-service-type modify-services service-extension
+               service-type simple-service))
+             ((gnu services base) #:select
+              (guix-service-type guix-extension %base-services))
+             ((gnu services ldap) #:select
+              (backend-userroot-configuration
+               directory-server-instance-configuration
+               directory-server-service-type slapd-configuration))
+             ((gnu services mcron) #:prefix mc:)
+             ((gnu services networking) #:select (dhcp-client-service-type))
+             ((gnu services shepherd) #:select
+              (shepherd-root-service-type shepherd-service))
+             ((gnu services ssh) #:select
+              (openssh-service-type openssh-configuration))
+             ((gnu services web) #:prefix web:)
+             ((gnu system) #:select
+              (operating-system %base-packages))
+             ((gnu system accounts) #:select
+              (user-account user-extra-groups user-group))
+             ((gnu system file-systems) #:prefix fs:)
+             ((gnu system keyboard) #:select (keyboard-layout))
+             ((gnu system shadow) #:select (%base-groups %base-user-accounts))
+             ((guix build-system gnu)
+              #:select (%gnu-build-system-modules gnu-build-system))
+             ((guix gexp) #:select
+              (file-append gexp local-file with-imported-modules))
+             ((guix licenses) #:prefix license:)
+             ((guix packages) #:select (package)))
+
+(define %here (dirname (current-filename)))
+
+(define 389-ds-base
+  (load (string-append %here "/good-dirsrv.scm")))
+
+(define %ctftilde-phases
+  (with-imported-modules '((guix build guile-build-system))
+    #~(modify-phases %standard-phases
+        (add-after 'install 'patch-executable
+          (lambda* (#:key inputs #:allow-other-keys)
+            (use-modules ((guix build guile-build-system) #:select
+                          (target-guile-effective-version)))
+
+            (define* (find-subdirs subdir #:optional
+                                   (dirs (cons #$output (map cdr inputs))))
+              (filter-map (lambda (pkg)
+                            (let ((path (string-append pkg subdir)))
+                              (and (file-exists? path) path)))
+                          dirs))
+
+            (let* ((gver (target-guile-effective-version))
+                   (scmdir (format #f "/share/guile/site/~a" gver))
+                   (gobjdir (format #f "/lib/guile/~a/site-ccache" gver))
+                   (executable (format #f "~a/bin/ctftilde" #$output))
+                   (bin-pkgs (map (cut assoc-ref inputs <>)
+                                  '("coreutils" "guile" "openssl")))
+                   (sbin-pkgs (list (assoc-ref inputs "shadow")))
+                   (path (append (find-subdirs "/bin" bin-pkgs)
+                                 (find-subdirs "/sbin" sbin-pkgs)))
+                   (load-path (find-subdirs scmdir))
+                   (compiled-path (find-subdirs gobjdir)))
+
+              (patch-shebang executable)
+
+              (wrap-program executable
+                (list "PATH" 'prefix path)
+                (list "GUILE_LOAD_PATH" 'prefix load-path)
+                (list "GUILE_LOAD_COMPILED_PATH" 'prefix compiled-path)))))
+
+        (delete 'strip))))
+
+(define ctftilde
+  (package
+    (name "ctftilde")
+    (version "current")
+    (source (local-file (string-append %here "/ctftilde")
+                        #:recursive? #t))
+    (build-system gnu-build-system)
+    (arguments
+     (list #:modules (cons* '(srfi srfi-1)
+                            '(srfi srfi-26)
+                            %gnu-build-system-modules)
+           #:phases %ctftilde-phases))
+    (native-inputs
+     (list autoconf
+           automake
+           guile-3.0
+           pkg-config
+           lawrence-boilerplate))
+    (inputs
+     (list coreutils guile-3.0 openssl shadow))
+    (propagated-inputs
+     (list guile-cantius guile-lib))
+    (home-page "https://ctftilde.koszko.org/")
+    (synopsis "Ctftilde website and user management.")
+    (description "Simple users management tool and website and built with
+Cantius, part of a CTF competition VM.")
+    (license license:cc0)))
+
+(define %services
+  %base-services)
+
+(define-syntax-rule (prepend list item)
+  (define list
+    (cons item list)))
+
+(prepend %services
+  (service dhcp-client-service-type))
+
+(define ds-root-password-hash
+  (let* ((password (call-with-input-file "ds-389.password" get-string-all))
+         (path (string-split (getenv "PATH") #\:))
+         (has-pwdhash? (search-path path "pwdhash"))
+         (command (list "pwdhash" "-s" "SHA256" password))
+         (command* (if has-pwdhash?
+                       command
+                       (cons* "guix" "shell" "389-ds-base" "--" command)))
+         (pipe (apply open-pipe* OPEN_READ command*))
+         (hash (get-string-all pipe)))
+    (close-pipe pipe)
+    (string-trim-right hash #\newline)))
+
+(format #t "directory server root password hash: ~A~%" ds-root-password-hash)
+
+(prepend %services
+  (simple-service 'cert-access-ctftilde activation-service-type
+    #~(let ((access-gid (group:gid (getgrnam "cert-ctftilde"))))
+        (for-each (lambda (file mode)
+                    (let ((full-path (string-append "/etc/cert-ctftilde" file)))
+                      (chown full-path 0 access-gid)
+                      (chmod full-path mode)))
+                  '(""    "/fullchain.pem" "/privkey.pem")
+                  '(#o750 #o640            #o640)))))
+
+(prepend %services
+  (service directory-server-service-type
+           (directory-server-instance-configuration
+            (package 389-ds-base)
+            (full-machine-name "ctftilde.koszko.org")
+            (slapd (slapd-configuration
+                    (instance-name "ctftilde")
+                    (root-dn "cn=CTF Manager")
+                    (root-password ds-root-password-hash)
+                    (run-dir "/var/run/dirsrv")))
+            (backend-userroot ((@@ (gnu services ldap) backend-userroot-configuration)
+                               ;;(create-suffix-entry? #f)
+                               (suffix "dc=ctftilde,dc=koszko,dc=org"))))))
+
+(prepend %services
+  (simple-service 'gemini-main-server-directory activation-service-type
+    #~(begin
+        (false-if-exception (delete-file "/srv/gemini"))
+        (symlink #$(local-file (string-append %here "/gemini")
+                               #:recursive? #t)
+                 "/srv/gemini"))))
+        
+(prepend %services
+  (simple-service 'gemini-users-directory activation-service-type
+    #~(mkdir-p "/srv/gemini-users")))
+
+(prepend %services
+  (service web:gmnisrv-service-type
+           (web:gmnisrv-configuration
+            (config-file (local-file "gmnisrv.ini")))))
+
+(prepend %services
+  (simple-service 'guix-authorize-key guix-service-type
+    (guix-extension
+     (authorized-keys (list (local-file "guix-signing-key.pub"))))))
+
+(prepend %services
+  (simple-service 'http-users-directory activation-service-type
+    #~(mkdir-p "/srv/http-users")))
+
+(prepend %services
+  (service web:httpd-service-type
+    (web:httpd-configuration
+     (config
+      (web:httpd-config-file
+       (server-name "ctftilde.koszko.org")
+       (listen '("80" "443"))
+       (error-log "/var/log/httpd/error.log")
+       (modules (append
+                 (map (lambda (name)
+                        (let ((filename (format #f "/modules/mod_~a.so" name)))
+                          (web:httpd-module
+                           (name (string-append name "_module"))
+                           (file (file-append httpd filename)))))
+                      (list "cgid"
+                            "headers"
+                            "logio"
+                            "proxy"
+                            "proxy_http"
+                            "rewrite"
+                            "ssl"
+                            "userdir"))
+                 web:%default-httpd-modules))
+       (extra-config
+        (list "\
+         LogFormat \"%>s %u %t \\\"%r\\\" %I in %O out \
+\\\"%{Referer}i\\\" \\\"%{User-Agent}i\\\"\" combined
+         CustomLog /var/log/httpd/access.log combined
+         ScriptSock /var/run/cgid.sock
+         ")))))))
+
+(prepend %services
+  (simple-service 'http-virtualhost-ctftilde web:httpd-service-type
+    (map (lambda (port)
+           (web:httpd-virtualhost
+            (format #f "*:~a" port)
+            `("\
+              ServerName ctftilde.koszko.org
+              ServerAlias www.ctftilde.koszko.org
+              ServerAdmin webmaster@ctftilde.koszko.org
+
+              UserDir /srv/http-users
+
+              ProxyPassMatch ^/(([^~].*)?)$ http://127.0.0.1:8080/$1
+              ProxyPassReverse / http://127.0.0.1:8080/
+              "
+              . ,(if (= port 443)
+                     '("\
+                       SSLEngine on
+                       SSLCertificateFile /etc/cert-ctftilde/fullchain.pem
+                       SSLCertificateKeyFile /etc/cert-ctftilde/privkey.pem
+                       ")
+                     '()))))
+         '(80 443))))
+
+(prepend %services
+  (service mc:mcron-service-type
+           (mc:mcron-configuration
+            (/var-tabs? #t))))
+
+(prepend %services
+  (service openssh-service-type
+    (openssh-configuration
+     (permit-root-login 'prohibit-password)
+     (authorized-keys `(("root" ,(local-file "owner.pub"))))
+     (port-number 22))))
+
+(define %ctftilde-accounts
+  (list (user-group (name "ctftilde") (system? #t))
+        (user-account
+          (name "ctftilde")
+          (group "ctftilde")
+          (system? #t)
+          (comment "ctftilde http website server user")
+          (home-directory "/var/run/ctftilde")
+          (shell (file-append shadow "/sbin/nologin")))))
+
+(define %ctftilde-activation
+  #~(begin
+      (mkdir-p "/var/db")
+
+      (let ((old-umask (umask)))
+        (dynamic-wind
+
+          noop
+
+          (lambda _
+            (umask #o077)
+            (mkdir-p "/var/db/ctftilde/users")
+            (mkdir-p "/var/db/ctftilde/users-to-delete"))
+
+          (lambda _
+            (umask old-umask))))
+
+      (system* (string-append #$ctftilde "/bin/ctftilde") "--users-recreate"
+               "--log-file" "/var/log/ctftilde")))
+
+(define %ctftilde-shepherd-services
+  (list (shepherd-service
+         (requirement '(networking))
+         (provision '(ctftilde))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append ctftilde "/bin/ctftilde")
+                         "--site-host" "--log-file" "/var/log/ctftilde")))
+         (stop #~(make-kill-destructor))
+         (documentation
+          "ctftilde server daemon (user management & http site)."))))
+
+(define ctftile-service-type
+  (service-type (name 'ctftilde)
+                (description "Host ctftilde main website and manage users.")
+                (extensions
+                 (list (service-extension account-service-type
+                                          (const %ctftilde-accounts))
+                       (service-extension activation-service-type
+                                          (const %ctftilde-activation))
+                       (service-extension shepherd-root-service-type
+                                          (const %ctftilde-shepherd-services))))
+                (default-value #f)))
+
+(prepend %services
+  (service ctftile-service-type))
+
+(define bootloader-target
+  (or (getenv "CTFTILDE_DISK_DEV") "/dev/sda"))
+
+(format #t "bootloader target: ~A~%" bootloader-target)
+
+(operating-system
+  (host-name "ctftilde")
+  (timezone "Europe/Warsaw")
+  (locale "en_US.utf8")
+
+  (keyboard-layout (keyboard-layout "pl"))
+
+  (bootloader (bootloader-configuration
+               (bootloader grub-bootloader)
+               (targets (list bootloader-target))))
+
+  (users %base-user-accounts)
+
+  (groups (cons* (user-group (name "cert-ctftilde") (system? #t))
+                 (user-group (name "hackers"))
+                 %base-groups))
+
+  (extra-groups (list (user-extra-groups
+                       (user "httpd")
+                       (groups '("cert-ctftilde")))))
+
+  (file-systems (cons* (fs:file-system
+                         (device (fs:file-system-label "ctftilde-root"))
+                         (mount-point "/")
+                         (type "ext4"))
+                       fs:%base-file-systems))
+
+  (packages (append (specifications->packages
+                     '("file"
+                       "net-tools"
+                       "man-pages-posix"
+                       "emacs"))
+                    (list ctftilde
+                          389-ds-base)
+                    %base-packages))
+
+  (services %services))
+
+;;; Local Variables:
+;;; eval: (put 'prepend 'scheme-indent-function 1)
+;;; eval: (put 'simple-service 'scheme-indent-function 2)
+;;; End: