Start install script for actual server

actual-server-installer.scm

@@ -0,0 +1,257 @@
+(define-module (actual-server-installer)
+#:use-module (guix packages)
+#:use-module (guix git-download)
+#:use-module (guix build-system node)
+#:use-module (guix utils)
+#:use-module (guix build-system gnu)
+#:use-module (guix licenses)
+#:use-module (gnu packages)
+#:use-module (gnu packages base)
+#:use-module (gnu packages bash)
+#:use-module (gnu packages gawk)
+#:use-module (gnu packages guile)
+#:use-module (gnu packages shells)
+#:use-module (gnu packages compression)
+#:use-module (gnu packages node)
+#:use-module (gnu packages package-management)
+#:use-module (gnu packages gnupg)
+#:use-module
+(gnu packages gcc)
+#:use-module (ice-9 pretty-print)
+#:use-module (srfi srfi-1)
+#:use-module (srfi srfi-26))
+
+(define-public actual-server-installer
+(package
+  (name "actual-server-installer")
+  (version "24.4.0")
+  (source (origin
+            (method git-fetch)
+            (uri (git-reference
+                  (url "https://github.com/actualbudget/actual-server")
+                  (commit "deec1f9")))
+            (file-name (git-file-name name version))
+            (sha256 (base32 "1lq5lqa3818ajyn4cs8paw0iy4ibpggzsp9p1l4xwpa1xz10jb52"))
+(snippet
+             '(begin
+                ;; Guile code to pretty-print to a file
+                (use-modules (ice-9 pretty-print))
+                (let ((build-output-file "build.scm")
+		      (run-output-file "actual-server-install"))
+		  (call-with-output-file run-output-file
+			(lambda (port)
+				(format port "#!/usr/bin/env guile~%!#~%")
+				(pretty-print
+					'(begin
+(use-modules (ice-9 popen)
+(ice-9 rdelim)
+(srfi srfi-1)
+(rnrs io ports)
+(rnrs bytevectors)
+(rnrs files)
+(guix build utils)
+(ice-9 pretty-print)
+(gcrypt hash)
+(guix base32)
+(ice-9 ftw))
+
+(define (run-and-display-command command)
+(let* ((port (open-pipe* OPEN_READ "sh" "-c" command))
+       (status #f))
+  (let loop ()
+    (let ((line (read-line port 'concat)))
+      (if (eof-object? line)
+          (begin
+            (set! status (close-pipe port))
+            (if (not (zero? status))
+                (error "Command failed" command status)))
+          (begin
+            (display line)
+            (force-output)
+            (loop)))))))
+
+(run-and-display-command "guix shell --container --network --pure --no-cwd --emulate-fhs --share=/tmp/actual-server-installer=/actual-server --user=build actual-server-installer -- bash -c 'guile $GUIX_ENVIRONMENT/lib/actual-server-installer/build.scm'")
+
+(run-and-display-command "cd /tmp/actual-server-installer")
+
+) port)))
+                  (call-with-output-file build-output-file
+                    (lambda (port)
+                      (pretty-print
+'(begin
+(use-modules (ice-9 popen)
+(ice-9 rdelim)
+(srfi srfi-1)
+(rnrs io ports)
+(rnrs bytevectors)
+(rnrs files)
+(guix build utils)
+(ice-9 pretty-print)
+(gcrypt hash)
+(guix base32)
+(ice-9 ftw))
+
+(define (run-and-display-command command)
+(let* ((port (open-pipe* OPEN_READ "sh" "-c" command))
+       (status #f))
+  (let loop ()
+    (let ((line (read-line port 'concat)))
+      (if (eof-object? line)
+          (begin
+            (set! status (close-pipe port))
+            (if (not (zero? status))
+                (error "Command failed" command status)))
+          (begin
+            (display line)
+            (force-output)
+            (loop)))))))
+
+(define (delete-directory-contents dir)
+(for-each (lambda (file)
+            (let ((full-path (string-append dir "/" file)))
+              (if (directory-exists? full-path)
+                  (delete-file-recursively full-path)
+                  (delete-file full-path))))
+          (filter (lambda (file)
+                    (not (member file '("." ".."))))
+                  (scandir dir))))
+
+(define (chmod-r path mode)
+       (define (change-permissions file stat flag)
+         (chmod file mode))
+       (ftw path change-permissions))
+
+(delete-directory-contents "/actual-server")
+
+(mkdir-p "/actual-server-build/lib")
+
+(copy-recursively (string-append (getenv "GUIX_ENVIRONMENT") "/lib/actual-server-installer/repo")
+"/actual-server-build/lib/actual-server")
+
+(chmod-r "/actual-server-build/lib/actual-server" #o755)
+
+(chdir "/actual-server-build/lib/actual-server")
+
+;; Enable corepack and install yarn
+(run-and-display-command "corepack enable")
+(run-and-display-command "corepack install")
+(run-and-display-command "yarn install")
+
+;; Create the necessary directory
+(mkdir-p "/actual-server-build/lib/actual-server-node")
+
+;; Copy directory
+(copy-recursively "~/.cache" "/actual-server-build/lib/actual-server-node/.cache")
+
+;; Create tar.gz archive
+(run-and-display-command "tar -czvf /actual-server/actual-server.tar.gz -C /actual-server-build .")
+
+;; Calculate checksum
+(define (sha256sum file)
+(call-with-input-file file
+  (lambda (port)
+    (let ((digest (sha256 (get-bytevector-all port))))
+      (bytevector->nix-base32-string digest)))))
+
+(let* ((checksum (sha256sum "/actual-server/actual-server.tar.gz"))
+(actual-server-scm
+ `(
+    (define-module (actual-server)
+      #:use-module (guix packages)
+#:use-module (gnu packages bash)
+#:use-module (gnu packages base)
+      #:use-module (guix build-system gnu)
+#:use-module (gnu packages gcc)
+      #:use-module (guix licenses)
+      #:use-module (guix download)
+      #:use-module (gnu packages)
+      #:use-module (gnu packages node)
+#:use-module
+(gnu packages gcc)
+#:use-module
+(guix build utils)
+#:use-module
+(gnu packages elf))
+
+    (define-public actual-server
+      (package
+        (name "actual-server")
+        (version "24.4.0")
+        (source (origin
+                  (method url-fetch)
+                  (uri "file:///tmp/actual-server-installer/actual-server.tar.gz")
+                  (sha256
+                   (base32 ,checksum))))
+        (build-system gnu-build-system)
+        (propagated-inputs
+       `(("gcc" ,gcc "lib")
+("node" ,node-lts)
+("bash" ,bash)
+("coreutils" ,coreutils)
+("findutils" ,findutils)))
+(native-inputs
+`(("patchelf" ,patchelf)))
+        (arguments
+         `(#:tests? #f ; Disable tests
+           #:phases (modify-phases %standard-phases
+                      (delete 'configure)
+                      (delete 'build)
+                      (delete 'install)
+                      (add-after 'unpack 'copy-files
+                        (lambda* (#:key outputs #:allow-other-keys)
+                          (let ((out (assoc-ref outputs "out")))
+                            (copy-recursively "." (string-append out "/lib"))
+                            #t)))
+                     (add-after 'copy-files 'patch-runpath
+                     (lambda* (#:key inputs outputs #:allow-other-keys)
+                       (let* ((out (assoc-ref outputs "out"))
+                          (gcc-lib (string-append (assoc-ref inputs "gcc") "/lib")))
+                         (for-each
+                          (lambda (binary)
+                            (invoke "patchelf" "--set-rpath" gcc-lib binary))
+                          (find-files (string-append out "/lib") ".*\\.node$"))))))))
+                      (home-page "https://github.com/actualbudget/actual-server")
+        (synopsis "Actual server for budget management")
+        (description "Actual is a local-first personal finance tool.")
+        (license expat))))))
+
+;; Write the content to actual-server.scm
+(call-with-output-file "/actual-server/actual-server.scm"
+(lambda (port)
+  (for-each (lambda (expr) (pretty-print expr port))
+            actual-server-scm)))))
+port))))))))
+  (build-system gnu-build-system)
+(propagated-inputs
+`(("bash" ,bash)
+("coreutils" ,coreutils)
+("findutils" ,findutils)
+("tar" ,tar)
+("gzip" ,gzip)
+("gawk" ,gawk)
+("guix" ,guix)
+("guile" ,guile-3.0)
+("guile-gcrypt" ,guile-gcrypt)
+("node", node-lts)
+("gcc" ,gcc "lib")))
+        (arguments
+   `(#:tests? #f ; Disable tests for simplicity
+     #:phases (modify-phases %standard-phases
+                (delete 'configure)
+                (delete 'build)
+                (delete 'install)
+                (add-after 'unpack 'store-source
+                  (lambda* (#:key outputs #:allow-other-keys)
+                    (let ((source-dir (assoc-ref outputs "out")))
+                      (copy-recursively "." (string-append source-dir "/lib/actual-server-installer/repo"))
+		      (mkdir-p (string-append source-dir "/bin"))
+                      (format #t "Checking if build.scm exists: ~a~%" (file-exists? (string-append source-dir "/lib/actual-server-installer/repo/build.scm")))
+                      (format #t "Checking if actual-server-install exists: ~a~%" (file-exists? (string-append source-dir "/lib/actual-server-installer/repo/actual-server-install")))
+                      (rename-file (string-append source-dir "/lib/actual-server-installer/repo/build.scm") (string-append source-dir "/lib/actual-server-installer/build.scm"))
+                      (rename-file (string-append source-dir "/lib/actual-server-installer/repo/actual-server-install") (string-append source-dir "/bin/actual-server-install"))
+                      (chmod (string-append source-dir "/bin/actual-server-install") #o755)
+		      #t))))))
+  (home-page "https://github.com/actualbudget/actual-server")
+  (synopsis "Actual server for budget management")
+  (description "Actual is a local-first personal finance tool.")
+  (license expat)))

actual-server.scm

@@ -1,40 +0,0 @@
-(define-module (actual-server)
-  #:use-module (guix packages)
-  #:use-module (guix git-download)
-  #:use-module (guix build-system node)
-  #:use-module (guix utils)
-  #:use-module (guix build-system gnu)
-  #:use-module (guix licenses)
-  #:use-module (gnu packages)
-  #:use-module (gnu packages node)
-  #:use-module (gnu packages package-management))
-
-(define-public actual-server-src
-  (package
-    (name "actual-server-src")
-    (version "24.4.0")
-    (source (origin
-              (method git-fetch)
-              (uri (git-reference
-                    (url "https://github.com/actualbudget/actual-server")
-                    (commit "deec1f9")))
-              (file-name (git-file-name name version))
-              (sha256 (base32 "1lq5lqa3818ajyn4cs8paw0iy4ibpggzsp9p1l4xwpa1xz10jb52"))))
-    (build-system gnu-build-system)
-	(inputs
-	`(("node" ,node-lts)))
-	    (arguments
-     `(#:tests? #f ; Disable tests for simplicity
-       #:phases (modify-phases %standard-phases
-                  (delete 'configure)
-                  (delete 'build)
-                  (delete 'install)
-                  (add-after 'unpack 'store-source
-                    (lambda* (#:key outputs #:allow-other-keys)
-                      (let ((source-dir (assoc-ref outputs "out")))
-                        (copy-recursively "." (string-append source-dir "/src"))
-                        #t))))))
-    (home-page "https://github.com/actualbudget/actual-server")
-    (synopsis "Actual server for budget management")
-    (description "Actual is a local-first personal finance tool.")
-    (license expat)))