From 05e669ac50cd15db30c2bfc0681a4c2a24cf080d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nguy=E1=BB=85n=20Gia=20Phong?= Date: Thu, 27 Nov 2025 17:46:50 +0900 Subject: guix: Implement fossil-download. * guix/fossil-download.scm: New file. * guix/build/fossil.scm: New file. * Makefile.am (MODULES): Add them. * etc/teams.scm (core)[#:scope]: Add "guix/fossil-download.scm". (vcs)[#:scope]: Add "guix/build/fossil.scm". * CODEOWNERS: Regenerate file. * doc/guix.texi (origin Reference): Document fossil-fetch and fossil-reference. * NEWS: Add entry about fossil-fetch. Change-Id: Ia252bcbbb417159a842d5092a937e2aad55a1656 Signed-off-by: Liliana Marie Prikler --- CODEOWNERS | 2 + Makefile.am | 2 + NEWS | 3 ++ doc/guix.texi | 46 +++++++++++++++++ etc/teams.scm | 2 + guix/build/fossil.scm | 59 ++++++++++++++++++++++ guix/fossil-download.scm | 125 +++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 239 insertions(+) create mode 100644 guix/build/fossil.scm create mode 100644 guix/fossil-download.scm diff --git a/CODEOWNERS b/CODEOWNERS index 2daec3630cc..1b7dc17d1f5 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -68,6 +68,7 @@ guix/discovery\.scm @guix/core guix/docker\.scm @guix/core guix/download\.scm @guix/core guix/elf\.scm @guix/core +guix/fossil-download\.scm @guix/core guix/ftp-client\.scm @guix/core guix/gexp\.scm @guix/core guix/git-authenticate\.scm @guix/core @@ -484,6 +485,7 @@ gnu/services/version-control\.scm @guix/vcs gnu/tests/version-control\.scm @guix/vcs guix/build/bzr\.scm @guix/vcs guix/build/cvs\.scm @guix/vcs +guix/build/fossil\.scm @guix/vcs guix/build/git\.scm @guix/vcs guix/build/hg\.scm @guix/vcs guix/build/svn\.scm @guix/vcs diff --git a/Makefile.am b/Makefile.am index 976c5cad742..7fd6cf892f3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -104,6 +104,7 @@ MODULES = \ guix/discovery.scm \ guix/android-repo-download.scm \ guix/bzr-download.scm \ + guix/fossil-download.scm \ guix/git-download.scm \ guix/hg-download.scm \ guix/hash.scm \ @@ -236,6 +237,7 @@ MODULES = \ guix/build/asdf-build-system.scm \ guix/build/bzr.scm \ guix/build/copy-build-system.scm \ + guix/build/fossil.scm \ guix/build/git.scm \ guix/build/hg.scm \ guix/build/glib-or-gtk-build-system.scm \ diff --git a/NEWS b/NEWS index 6fd51b38fa4..4d95880c575 100644 --- a/NEWS +++ b/NEWS @@ -20,6 +20,9 @@ Please send Guix bug reports to bug-guix@gnu.org. *** New service for Fossil SCM *** TeX Live updated to 2026.1 +** Programming interfaces +*** New (guix fossil-download) module, for fetching Fossil repositories + * Changes in 1.5.0 (since 1.4.0) ** Package management *** New ‘rpm’ format for the ‘guix pack’ command diff --git a/doc/guix.texi b/doc/guix.texi index 198ecb3413b..aaee903d95a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8737,6 +8737,52 @@ The example below denotes a version of gnu-standards to fetch: @end deftp +For Fossil repositories, the module @code{(guix fossil-download)} defines +the @code{fossil-fetch} origin method and @code{fossil-reference} data type +for support of the Fossil @abbr{SCM, software configuration management} system. + +@deffn {Procedure} fossil-fetch ref hash-algo hash [name] +Return a fixed-output derivation that fetches @var{ref}, a +@code{} object. The output is expected to have recursive +hash @var{hash} of type @var{hash-algo} (a symbol). Use @var{name} as +the file name, or a generic name if @code{#f}. +@end deffn + +@deftp {Data Type} fossil-reference +This data type represents a Fossil reference +for @code{fossil-fetch} to retrieve. + +@table @asis +@item @code{uri} (type: string) +The URI of a Fossil repository to clone, in one of the following forms, +in which @code{[...]} denotes optional elements: + +@table @code +@item http[s]://[userid[:password]@@]host[:port][/path] +A HTTP/HTTPS URL. +@item [file://]path/to/repo.fossil +A file URI, where the path must have an extra leading @code{/} +to use an absolute path (without the URI scheme, the repository +is opened directly without cloning). +@end table + +@item @code{check-in} (type: string) +A @url{https://fossil-scm.org/home/doc/trunk/www/checkin_names.wiki, +name of the check-in} to fetch, e.g.@: its canonical hexadecimal identifier, +associated tag and/or timestamp. +@end table + +The example below denotes the @code{version-3.51.1} tag +of the SQLite repository: + +@lisp +(fossil-reference + (uri "https://sqlite.org/src") + (check-in "version-3.51.1")) +@end lisp + +@end deftp + @node Defining Package Variants @section Defining Package Variants diff --git a/etc/teams.scm b/etc/teams.scm index c26a0c11f83..1e179f445df 100755 --- a/etc/teams.scm +++ b/etc/teams.scm @@ -565,6 +565,7 @@ challenges")) "guix/docker.scm" "guix/download.scm" "guix/elf.scm" + "guix/fossil-download.scm" "guix/ftp-client.scm" "guix/gexp.scm" "guix/git-authenticate.scm" @@ -1214,6 +1215,7 @@ the \"texlive\" importer." "gnu/tests/version-control.scm" "guix/build/bzr.scm" "guix/build/cvs.scm" + "guix/build/fossil.scm" "guix/build/git.scm" "guix/build/hg.scm" "guix/build/svn.scm"))) diff --git a/guix/build/fossil.scm b/guix/build/fossil.scm new file mode 100644 index 00000000000..a8c03e3eb80 --- /dev/null +++ b/guix/build/fossil.scm @@ -0,0 +1,59 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2025 Nguyễn Gia Phong +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . +;;; +;;; Commentary: +;;; +;;; This is the build-side support code of (guix fossil-download). +;;; It allows a Fossil repository to be opened at a specific revision. +;;; +;;; Code: + +(define-module (guix build fossil) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (web uri) + #:export (fossil-fetch)) + +(define* (fossil-fetch uri check-in file #:key (fossil-command "fossil")) + "Fetch CHECK-IN from URI into DIRECTORY. CHECK-IN must be a valid +Fossil check-in name. Return #t on success, else raise an exception." + (setenv "FOSSIL_HOME" "/tmp") + (invoke fossil-command + "tarball" check-in file "-R" + (case (uri-scheme (string->uri-reference uri)) + ((file https) ;clone the repository first + (match-let ((repository (simple-format #f "/tmp/~a.fossil" + (basename file ".tar.gz"))) + ((input . output) (pipe))) + ;; Trust the TLS certificate of the server, + ;; since we'll later verify the tarball's checksum. + (display "y" output) + (close-port output) + (with-input-from-port input + (cut invoke fossil-command "clone" + "--no-open" "--once" uri repository)) + (close-port input) + repository)) + ((ssh) ;TODO: authentication for SSH + (let ((message (string-append "fetching a Fossil repository through SSH" + " is not supported: " uri))) + (raise (condition (&message (message message)))))) + ((#f) uri)))) ;local file diff --git a/guix/fossil-download.scm b/guix/fossil-download.scm new file mode 100644 index 00000000000..d371ee2d0db --- /dev/null +++ b/guix/fossil-download.scm @@ -0,0 +1,125 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2025 Nguyễn Gia Phong +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . +;;; +;;; Commentary: +;;; +;;; An method that open Fossil checkout at a specific version. +;;; The repository URI and version are specified +;;; with a object. +;;; +;;; Code: + +(define-module (guix fossil-download) + #:use-module (guix build-system) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (guix monads) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix store) + #:use-module (ice-9 match) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (web uri) + #:export (fossil-reference + fossil-reference? + fossil-reference-uri + fossil-reference-check-in + + fossil-fetch + fossil-version + fossil-file-name)) + +(define-record-type* + fossil-reference make-fossil-reference fossil-reference? + (uri fossil-reference-uri) + (check-in fossil-reference-check-in)) + +(define (fossil-version version revision check-in) + "Return the version string for packages using fossil-download." + ;; fossil-version is almost exclusively executed while modules + ;; are being loaded, leading to any errors hiding their backtrace. + ;; Avoid the mysterious error "Value out of range 0 to N: 10" + ;; when the check-in ID is too short, which can happen, for example, + ;; when the user swapped the revision and check-in arguments by mistake. + (when (< (string-length check-in) 10) + (raise + (condition + (&message (message "fossil-version: check-in ID unexpectedly short"))))) + (string-append version "-" revision "." (string-take check-in 10))) + +(define (fossil-file-name name version) + "Return the file-name for packages using fossil-download." + (string-append name "-" version ".tar.gz")) + +(define* (fossil-fetch ref hash-algo hash + #:optional name + #:key (system (%current-system)) + (guile (default-guile)) + (fossil (@* (gnu packages version-control) + fossil))) + "Return a fixed-output derivation that fetches REF, a +object. The output is expected to have recursive hash HASH of type +HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." + (let* ((modules (source-module-closure '((guix build fossil) + (guix build download) + (guix build download-nar)))) + (uri (fossil-reference-uri ref)) + (scheme-of-uri (uri-scheme (string->uri-reference uri))) + (check-in (fossil-reference-check-in ref)) + (tarball-name (or name (fossil-file-name (basename uri) check-in))) + (tarball-url (and (eq? 'https scheme-of-uri) + (simple-format #f "~a/tarball/~a/~a" + uri check-in tarball-name))) + (guile-json (@* (gnu packages guile) guile-json-4)) + (gnutls (@* (gnu packages tls) guile-gnutls)) + (guile-lzlib (@* (gnu packages guile) guile-lzlib)) + (build + (with-imported-modules modules + (with-extensions (list guile-json gnutls ;for (guix swh) + guile-lzlib) + #~(begin + (use-modules (guix build fossil) + ((guix build download) + #:select (download-method-enabled? url-fetch)) + (guix build download-nar)) + (or (and (download-method-enabled? 'upstream) + (or (and #$tarball-url + (url-fetch #$tarball-url #$output)) + (fossil-fetch + #$(if scheme-of-uri uri (local-file uri)) + #$check-in + #$output + #:fossil-command + #+(file-append fossil "/bin/fossil")))) + (and (download-method-enabled? 'nar) + (download-nar #$output)))))))) + (mlet %store-monad ((guile (package->derivation guile system))) + (gexp->derivation tarball-name build + #:leaked-env-vars '("http_proxy" "https_proxy" + "COLUMNS" "USER") + #:env-vars (match (getenv "GUIX_DOWNLOAD_METHODS") + (#f '()) + (value + `(("GUIX_DOWNLOAD_METHODS" . ,value)))) + #:system system + #:hash-algo hash-algo + #:hash hash + #:recursive? #t + #:guile-for-build guile + #:local-build? #t)))) -- cgit v1.2.3