ray/ordo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Import just what we need, rename fs functions

Browse source
This commit is contained in:
Ray Miller 2025-01-21 21:06:23 +00:00
parent 47b63da25e
commit c126639016
Signed by: ray
GPG key ID: 043F786C4CD681B8
2 changed files with 18 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

3
modules/ordo/action/apt.scm
View file

@ -1,5 +1,6 @@
(define-module (ordo action apt)
#:use-module (ordo))
#:use-module ((ordo connection) #:select (run))
#:use-module ((ordo context) #:select (current-connection)))
(define noninteractive-env '(("DEBIAN_FRONTEND" . "noninteractive")
("APT_LISTCHANGES_FRONTEND" . "none")))

42
modules/ordo/action/filesystem.scm
View file

@ -7,15 +7,16 @@
#:use-module (srfi srfi-26) ; cut
#:use-module (srfi srfi-71) ; extended let
#:use-module ((srfi srfi-197) #:select (chain-when))
#:use-module (ordo)
#:export (action:create-tmp-dir
action:install-dir
action:install-file
action:stat
action:remove
action:link))
#:use-module ((ordo connection) #:select (run))
#:use-module ((ordo context) #:select (current-connection))
#:export (fs:create-tmp-dir
fs:install-dir
fs:install-file
fs:stat
fs:remove
fs:link))
(define (action:stat path)
(define (fs:stat path)
(define (parse-stat-result s)
(match-let* (((file-type user group . rest) (string-split s #\:))
((uid gid size mode atime mtime ctime) (map string->number rest)))
@ -35,7 +36,7 @@
((string-contains (first result) "No such file or directory") #f)
(else (error (format #f "stat ~a: ~a" path (first result)))))))
(define* (action:remove path #:key (recurse? #f) (force? #f) (verbose? #t))
(define* (fs:remove path #:key (recurse? #f) (force? #f) (verbose? #t))
(run (current-connection)
"rm" (chain-when '()
(verbose? (append _ '("-v")))
@ -44,7 +45,7 @@
(#t (append _ `(,path))))
#:check? #t))
(define* (action:link target link-name #:key (symbolic? #f) (force? #f) (backup? #f))
(define* (fs:link target link-name #:key (symbolic? #f) (force? #f) (backup? #f))
"Create a link to @code{target} with the name @code{link-name}."
(run (current-connection)
"ln" (chain-when '()
@ -54,7 +55,7 @@
(#t (append `(,target ,link-name))))
#:check? #t))
(define* (action:create-tmp-dir #:key tmpdir suffix template)
(define* (fs:create-tmp-dir #:key tmpdir suffix template)
(match-let (((tmp-dir) (run (current-connection)
"mktemp" (chain-when
'("--directory")
@ -64,18 +65,7 @@
#:check? #t)))
tmp-dir))
(define* (action:install-dir path #:key owner group mode)
;; If owner/group/mode is unspecified and the destination directory already exists,
;; preserve the current ownership and mode.
;; TODO: this does not make much sense: if the object exists but is not a directory
;; then the install will fail. If the object exists an *is* a directory, then we
;; should just chmod/chown it.
(unless (and owner group mode)
(let ((st (action:stat path)))
(when st
(set! owner (or owner (assoc-ref st 'user)))
(set! group (or group (assoc-ref st 'group)))
(set! mode (or mode (assoc-ref st 'mode))))))
(define* (fs:install-dir path #:key owner group mode)
(when (integer? mode)
(set! mode (number->string mode 8)))
(run (current-connection)
@ -102,7 +92,7 @@
;; If owner/group/mode is unspecified and the destination file already exists,
;; preserve the current ownership and mode.
(unless (and owner group mode)
(let ((st (action:stat dest)))
(let ((st (fs:stat dest)))
(when st
(set! owner (or owner (assoc-ref st 'owner)))
(set! group (or group (assoc-ref st 'group)))
@ -119,7 +109,7 @@
(#t (append _ (list src dest))))
#:check? #t))
(define* (action:install-file path #:key owner group mode content local-src remote-src backup?)
(define* (fs:install-file path #:key owner group mode content local-src remote-src backup?)
(when (not (= 1 (length (filter identity (list content local-src remote-src)))))
(error "exactly one of #:content, #:local-src, or #:remote-src is required"))
(if remote-src
@ -138,5 +128,5 @@
(else (error "unsupported type for #:content")))
(install-remote-file tmp-file path owner group mode backup?))
(lambda ()
(action:remove tmp-file #:force? #t)))))
(fs:remove tmp-file #:force? #t)))))
path)