From 6b220b1c90750e9038e7113fb5e9658bf5b502b5 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Fri, 28 Mar 2025 00:57:29 +0000
Subject: tissue: Update to 0.1.0-2.a918759.
* guix/forge/tissue.scm (tissue): Update to 0.1.0-2.a918759.
(<tissue-host>)[user, upstream-repository]: Delete fields.
[projects]: New field.
(<tissue-project>): New record type.
(tissue-conf-gexp): Serialize tissue.conf in accordance with update.
(tissue-activation): Find project directories to chown from new
configuration record structure.
---
guix/forge/tissue.scm | 78 ++++++++++++++++++++++++++++++++++-----------------
1 file changed, 53 insertions(+), 25 deletions(-)
(limited to 'guix/forge/tissue.scm')
diff --git a/guix/forge/tissue.scm b/guix/forge/tissue.scm
index 4ece204..0e7791e 100644
--- a/guix/forge/tissue.scm
+++ b/guix/forge/tissue.scm
@@ -1,5 +1,5 @@
;;; guix-forge --- Guix software forge meta-service
-;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2022, 2023, 2025 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of guix-forge.
;;;
@@ -46,14 +46,19 @@
tissue-host
tissue-host?
tissue-host-name
- tissue-host-user
- tissue-host-upstream-repository))
+ tissue-host-projects
+ <tissue-project>
+ tissue-project
+ tissue-project-name
+ tissue-project-user
+ tissue-project-base-path
+ tissue-project-upstream-repository))
;; Run an updated version of tissue until the the 0.1.1 release is
;; out.
(define-public tissue
- (let ((commit "0c3d6cb7d781fbc0c12eba1563cc7b7ebb370ba9")
- (revision "1"))
+ (let ((commit "a9187595cccca4954c7d4920b93b922ea190e179")
+ (revision "2"))
(package
(inherit guix:tissue)
(name "tissue")
@@ -66,7 +71,7 @@
(file-name (git-file-name name version))
(sha256
(base32
- "0hdqa5n8dm2nc4ccx39xclgajv3ivwpb1hbz9kpbbv25iizqhnv2"))))
+ "0pgdznck8vwmbccmpcqd3xnikbgzb2phxik7bcm80dls6g4n3py2"))))
(inputs
(modify-inputs (package-inputs guix:tissue)
(replace "guile-git" guile-git))))))
@@ -88,9 +93,22 @@
tissue-host make-tissue-host
tissue-host?
(name tissue-host-name)
- (user tissue-host-user
+ (projects tissue-host-projects
+ (default '())))
+
+(define-record-type* <tissue-project>
+ tissue-project make-tissue-project
+ tissue-project?
+ this-tissue-project
+ (name tissue-project-name)
+ (user tissue-project-user
(default "tissue"))
- (upstream-repository tissue-host-upstream-repository))
+ (base-path tissue-project-base-path
+ (default (string-append "/"
+ (tissue-project-name this-tissue-project)
+ "/"))
+ (thunked))
+ (upstream-repository tissue-project-upstream-repository))
(define %tissue-accounts
(list (user-account
@@ -105,6 +123,19 @@
(system? #t))))
(define (tissue-conf-gexp config)
+ (define project->alist
+ (match-record-lambda <tissue-project>
+ (name base-path upstream-repository)
+ `(,name
+ (base-path . ,base-path)
+ (upstream-repository . ,upstream-repository))))
+
+ (define host->alist
+ (match-record-lambda <tissue-host>
+ (name projects)
+ `(,name
+ (projects . ,(map project->alist projects)))))
+
(match-record config <tissue-configuration>
(socket state-directory hosts)
#~(begin
@@ -129,11 +160,7 @@
"Socket must be a <forge-ip-socket> or <forge-unix-socket> record")
(make-irritants-condition socket))))))
(state-directory . #$state-directory)
- (hosts . #$(map (lambda (host)
- (match-record host <tissue-host>
- (name upstream-repository)
- `(,name (upstream-repository . ,upstream-repository))))
- hosts)))
+ (hosts . #$(map host->alist hosts)))
port))))))
;; We cannot just pass the configuration file on the command-line
@@ -162,22 +189,23 @@
;; the tissue user.
(mkdir-p #$state-directory)
(chown #$state-directory (passwd:uid user) (passwd:gid user)))
- ;; Create host directories if they don't exist, and set
- ;; permissions. Each host directory may be owned by its own
- ;; user.
+ ;; Create project directories if they don't exist, and set
+ ;; permissions. Each project directory may be owned by its
+ ;; own user.
(for-each (match-lambda
- ((hostname username)
- (let ((host-directory (string-append #$state-directory "/" hostname))
+ ((project-name username)
+ (let ((project-directory (string-append #$state-directory "/" project-name))
(user (getpw username)))
- (mkdir-p host-directory)
+ (mkdir-p project-directory)
(for-each (lambda (file)
(chown file (passwd:uid user) (passwd:gid user)))
- (find-files host-directory #:directories? #t)))))
- '#$(map (lambda (host)
- (match-record host <tissue-host>
- (name user)
- (list name user)))
- hosts))))))
+ (find-files project-directory #:directories? #t)))))
+ '#$(append-map (lambda (host)
+ (map (match-record-lambda <tissue-project>
+ (name user)
+ (list name user))
+ (tissue-host-projects host)))
+ hosts))))))
(define (tissue-shepherd-service config)
(match-record config <tissue-configuration>
--
cgit v1.2.3