projects/guix·blob python-team · refs

210 lines · 7.2 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2025 Giacomo Leidi <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19;;; Commentary:
20;;;
21;;; This module contains helpers used as part of the oci-service-type
22;;; definition.
23;;;
24;;; Code:
25
26(define-module (gnu build oci-containers)
27 #:use-module (ice-9 format)
28 #:use-module (ice-9 match)
29 #:use-module (ice-9 popen)
30 #:use-module (ice-9 rdelim)
31 #:use-module (ice-9 textual-ports)
32 #:use-module (srfi srfi-1)
33 #:export (oci-read-lines
34 oci-system*
35 oci-object-exists?
36 oci-object-service-available?
37 oci-image-load
38 oci-log-verbose
39 oci-container-execlp
40 oci-object-create))
41
42(define* (oci-read-lines invocation #:key verbose?)
43 (define (get-lines port)
44 (let ((lines-string (get-string-all port)))
45 (string-split lines-string #\newline)))
46
47 (define command
48 (string-join invocation " "))
49
50 (when verbose? (format #t "Running ~a~%" command))
51
52 (with-input-from-port (open-input-pipe command)
53 (lambda _
54 (get-lines (current-input-port)))))
55
56(define* (oci-log-verbose invocation)
57 (format #t "Running in verbose mode...
58Current user: ~a ~a
59Current group: ~a ~a
60Current directory: ~a~%"
61 (getuid) (passwd:name (getpwuid (getuid)))
62 (getgid) (group:name (getgrgid (getgid)))
63 (getcwd))
64
65 (format #t "Running~{ ~a~}~%" invocation))
66
67(define* (oci-system* invocation #:key verbose?)
68 (when verbose?
69 (format #t "Running~{ ~a~}~%" invocation))
70
71 (let* ((status (apply system* invocation))
72 (exit-code (status:exit-val status)))
73 (when verbose?
74 (format #t "Exit code: ~a~%" exit-code))
75 status))
76
77(define* (oci-object-member name objects
78 #:key verbose?)
79
80 (define member? (member name objects))
81
82 (when (and verbose? (> (length objects) 0))
83 (format #t "~a is ~apart of:~{ ~a~}~%"
84 name
85 (if member? "" "not ")
86 objects))
87 member?)
88
89(define* (oci-object-list runtime-cli object
90 #:key verbose?
91 (format-string "{{.Name}}"))
92
93 (define invocation
94 (list runtime-cli object "ls" "--format"
95 (string-append "\"" format-string "\"")))
96
97 (filter
98 (lambda (name)
99 (not (string=? (string-trim name) "")))
100 (oci-read-lines invocation #:verbose? verbose?)))
101
102(define* (docker-object-exist? runtime-cli object name
103 #:key verbose?
104 (format-string "{{.Name}}"))
105
106 (define objects
107 (oci-object-list runtime-cli object
108 #:verbose? verbose?
109 #:format-string format-string))
110
111 (oci-object-member name objects #:verbose? verbose?))
112
113(define* (podman-object-exist? runtime-cli object name #:key verbose?)
114 (let ((invocation (list runtime-cli object "exists" name)))
115 (define exit-code
116 (status:exit-val (oci-system* invocation #:verbose? verbose?)))
117 (equal? EXIT_SUCCESS exit-code)))
118
119(define* (oci-object-exists? runtime runtime-cli object name
120 #:key verbose?
121 (format-string "{{.Name}}"))
122 (if (eq? runtime 'podman)
123 (podman-object-exist? runtime-cli object name
124 #:verbose? verbose?)
125 (docker-object-exist? runtime-cli object name
126 #:verbose? verbose?
127 #:format-string format-string)))
128
129(define* (oci-object-service-available? runtime-cli object names
130 #:key verbose?
131 (format-string "{{.Name}}"))
132 "Whether NAMES are provisioned in the current OBJECT environment."
133 (define environment
134 (oci-object-list runtime-cli object
135 #:verbose? verbose?
136 #:format-string format-string))
137 (when verbose?
138 (format #t "~a environment:~{ ~a~}~%" object environment))
139
140 (define available?
141 (every
142 (lambda (name)
143 (oci-object-member name environment #:verbose? verbose?))
144 names))
145
146 (when verbose?
147 (format #t "~a service is~a available~%" object (if available? "" " not")))
148
149 available?)
150
151(define* (oci-image-load runtime runtime-cli tarball name tag
152 #:key verbose?
153 (format-string "{{.Repository}}:{{.Tag}}"))
154 (define load-invocation
155 (list runtime-cli "load" "-i" tarball))
156
157 (if (oci-object-exists? runtime runtime-cli "image" tag
158 #:verbose? verbose?
159 #:format-string format-string)
160 (format #t "~a image already exists, skipping.~%" tag)
161 (begin
162 (format #t "Loading image for ~a from ~a...~%" name tarball)
163
164 (let ((line (first
165 (oci-read-lines load-invocation #:verbose? verbose?))))
166 (unless (or (eof-object? line)
167 (string-null? line))
168
169 (format #t "~a~%" line)
170
171 (let* ((repository&tag
172 (string-drop line
173 (string-length
174 "Loaded image: ")))
175 (tag-invocation
176 (list runtime-cli "tag" repository&tag tag))
177 (drop-old-tag-invocation
178 (list runtime-cli "image" "rm" "-f" repository&tag)))
179
180 (unless (string=? repository&tag tag)
181 (let ((exit-code
182 (status:exit-val
183 (oci-system* tag-invocation #:verbose? verbose?))))
184 (format #t "Tagged ~a with ~a...~%" tarball tag)
185
186 (when (equal? EXIT_SUCCESS exit-code)
187 (oci-system* drop-old-tag-invocation #:verbose? verbose?))))))))))
188
189(define* (oci-container-execlp invocation #:key verbose? pre-script)
190 (when pre-script
191 (pre-script))
192 (when verbose?
193 (oci-log-verbose invocation))
194 (apply execlp (first invocation) invocation))
195
196(define* (oci-object-create runtime runtime-cli runtime-name
197 object
198 invocations
199 #:key verbose?
200 (format-string "{{.Name}}"))
201 (for-each
202 (lambda (invocation)
203 (define name (last invocation))
204 (if (oci-object-exists? runtime runtime-cli object name
205 #:format-string format-string
206 #:verbose? verbose?)
207 (format #t "~a ~a ~a already exists, skipping creation.~%"
208 runtime-name name object)
209 (oci-system* invocation #:verbose? verbose?)))
210 invocations))