Add script to generate actual-server package

actual-server-installer.scm

@@ -6,8 +6,17 @@
 #: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))
@@ -41,25 +50,50 @@
 (guix build utils)
 (ice-9 pretty-print)
 (gcrypt hash)
-(guix base32))
-
-(define (run-shell-command command)
-(let* ((p (open-pipe* OPEN_READ "sh" "-c" command))
-(output (get-string-all p)))
-(close-pipe p)
-output))
+(guix base32)
+(ice-9 ftw))
 
 (define (run-and-display-command command)
-(let ((port (open-pipe* OPEN_READ "sh" "-c" command)))
+(let* ((port (open-pipe* OPEN_READ "sh" "-c" command))
+       (status #f))
   (let loop ()
     (let ((line (read-line port 'concat)))
       (if (eof-object? line)
-          (close-pipe port)
+          (begin
+            (set! status (close-pipe port))
+            (if (not (zero? status))
+                (error "Command failed" command status)))
           (begin
             (display line)
-            (force-output) ; Ensure output is flushed immediately
+            (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")
@@ -86,11 +120,20 @@ output))
  `(
     (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 node)
+#:use-module
+(gnu packages gcc)
+#:use-module
+(guix build utils)
+#:use-module
+(gnu packages elf))
 
     (define-public actual-server
       (package
@@ -102,8 +145,14 @@ output))
                   (sha256
                    (base32 ,checksum))))
         (build-system gnu-build-system)
-        (inputs
-         `(("node" ,node-lts)))
+        (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
@@ -113,9 +162,16 @@ output))
                       (add-after 'unpack 'copy-files
                         (lambda* (#:key outputs #:allow-other-keys)
                           (let ((out (assoc-ref outputs "out")))
-                            (mkdir-p (string-append out "/lib"))
-                            (copy-recursively (string-append (assoc-ref %build-inputs "source") "/lib") (string-append out "/lib"))
-                            #t))))))
+                            (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.")
@@ -128,8 +184,19 @@ output))
             actual-server-scm)))))
 port))))))))
   (build-system gnu-build-system)
-     (inputs
-     `(("node" ,node-lts)))
+(propagated-inputs
+`(("bash" ,bash)
+("coreutils" ,coreutils)
+("findutils" ,findutils)
+("tar" ,tar)
+("gzip" ,gzip)
+("gawk" ,gawk)
+("node" ,node)
+("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
@@ -140,6 +207,7 @@ port))))))))
                   (lambda* (#:key outputs #:allow-other-keys)
                     (let ((source-dir (assoc-ref outputs "out")))
                       (copy-recursively "." (string-append source-dir "/lib/actual-server-installer/repo"))
+                      (rename-file (string-append source-dir "/lib/actual-server-installer/repo/build.scm") (string-append source-dir "/lib/actual-server-installer/build.scm"))
                       #t))))))
   (home-page "https://github.com/actualbudget/actual-server")
   (synopsis "Actual server for budget management")