diff options
| author | Jan Tuomi <jans.tuomi@gmail.com> | 2024-01-28 22:39:16 +0200 |
|---|---|---|
| committer | Jan Tuomi <jans.tuomi@gmail.com> | 2024-01-28 22:39:16 +0200 |
| commit | 092a811a554b0978e94f6c56d4ed2ace3d0bc519 (patch) | |
| tree | b7941d284db6e58dae9479b9d573f4dd4c46924d | |
| parent | 295c4cc6c71ed7384a3e22301386bcc9a0f98d78 (diff) | |
Improve build
| -rw-r--r-- | desmoctl.scm | 47 | ||||
| -rw-r--r-- | examples/build-manifest | 2 | ||||
| -rw-r--r-- | requirements.list | 1 |
3 files changed, 36 insertions, 14 deletions
diff --git a/desmoctl.scm b/desmoctl.scm index edbd4c3..98ccdf4 100644 --- a/desmoctl.scm +++ b/desmoctl.scm @@ -7,6 +7,8 @@ (chicken port) (chicken io) (chicken file) + (chicken file posix) + (chicken string) srfi-13 medea matchable @@ -15,6 +17,7 @@ intarweb uri-common shell + filepath ) ;;;;;;;;;;;;;;; @@ -67,7 +70,7 @@ (define default-cfg `((user-cfg-path - . ,(string-append (get-environment-variable "HOME") "/" ".desmorc")) + . ,(filepath:combine (get-environment-variable "HOME") ".desmorc")) (mgmt-api-url . "http://localhost:9939") (mgmt-api-key @@ -430,15 +433,34 @@ (begin (debug-print "manifest content:") (pretty-print content))) - (define files-list - (let ((pair (assoc 'files content))) - (if pair - (vector->list (cdr pair)) - '()))) + (define filespec-list + (match (assoc 'files content) + [#f '()] + [pair (vector->list (cdr pair))])) - (define desmometa-path "__desmometa") + (define work-area-path "__desmowork") + (define desmometa-path (filepath:combine work-area-path "__desmometa")) + (create-directory work-area-path) (create-directory desmometa-path) + + (define pwd (get-environment-variable "PWD")) + + (define (symlink-to-work-area filespec) + (match-let (((from to-jail-abs) (string-split filespec ":"))) + (define to (string-append work-area-path to-jail-abs)) + (define to-dir (filepath:take-directory to)) + + (create-directory to-dir #t) + + (define symlink-from (filepath:combine pwd from)) + (define symlink-to (filepath:combine pwd to)) + + (debug-print (format "from: ~A" symlink-from)) + (debug-print (format "to: ~A" symlink-to)) + (create-symbolic-link symlink-from symlink-to))) + + (for-each symlink-to-work-area filespec-list) (define manifest-json (to-json-string content)) @@ -448,11 +470,11 @@ (debug-print (format "manifest-json: ~A" manifest-json)) (define meta-json-path - (string-append desmometa-path "/manifest.json")) + (filepath:combine desmometa-path "manifest.json")) (define meta-scm-path - (string-append desmometa-path "/manifest.scm")) + (filepath:combine desmometa-path "manifest.scm")) (define meta-version-path - (string-append desmometa-path "/version")) + (filepath:combine desmometa-path "version")) ;; https://stackoverflow.com/a/10441464 (define (write-to-a-file path txt) @@ -468,7 +490,7 @@ (define archive-path (cdr (assoc 'build-archive-path cfg))) (define tar-cmd - (apply string-append "2>&1 tar cvf " archive-path " " desmometa-path " " files-list)) + (format "2>&1 tar cvhf ~A -C ~A ." archive-path work-area-path)) (debug-print "tar-cmd:") (debug-print tar-cmd) @@ -482,8 +504,7 @@ [other (print (format "Failed to build archive ~A." archive-path)) (exit 1)]) - (delete-directory desmometa-path #t) ; recursive - ) + (delete-directory work-area-path #t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Parse flags and subcommand ;; diff --git a/examples/build-manifest b/examples/build-manifest index d0c0e56..0e18f58 100644 --- a/examples/build-manifest +++ b/examples/build-manifest @@ -1,7 +1,7 @@ ((packages . #("nginx")) (files - . #("nginx.conf")) + . #("nginx.conf:/etc/nginx/nginx.conf")) (build-commands . #("sysrc nginx_enable=YES")) (start-command diff --git a/requirements.list b/requirements.list index f2e5de5..f6bea65 100644 --- a/requirements.list +++ b/requirements.list @@ -5,3 +5,4 @@ (openssl "2.2.5") (intarweb "2.1.0") (uri-common "2.0") +(filepath "1.6") |
