path: root/vm.scm

(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 service-extension
               service-type simple-service))
             ((gnu services base) #:select
              (guix-service-type guix-extension %base-services))
             ((gnu services desktop) #:select (elogind-service-type))
             ((gnu services mcron) #:select (cron-daemon-service-type))
             ((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 %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))

(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 elogind-service-type))

(prepend %services
  (simple-service 'gemini-main-server-directory activation-service-type
    #~(begin
        (false-if-exception (delete-file "/srv/gemini"))
        (mkdir-p "/srv")
        (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"))
                 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

              RewriteEngine On

              RewriteRule \"^/~([^/]+)(.*)\" \"/srv/http-users/$1$2\"

              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 cron-daemon-service-type))

(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)

                    %base-packages))

  (services %services))

;;; Local Variables:
;;; eval: (put 'prepend 'scheme-indent-function 1)
;;; eval: (put 'simple-service 'scheme-indent-function 2)
;;; End: