wangliu-iscas/guix-mirror
1
0
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2026-04-28 06:34:05 +00:00
Code Issues Packages Projects Releases Wiki Activity

guix: Implement fossil-download.

Browse Source 
* 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 <liliana.prikler@gmail.com>
This commit is contained in:
Nguyễn Gia Phong
2025-11-27 17:46:50 +09:00
committed by Liliana Marie Prikler
parent 08341ec277
commit 05e669ac50
7 changed files with 239 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
CODEOWNERS
View File

@@ -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

2
Makefile.am
View File

@@ -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 \

3
NEWS
View File

@@ -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

46
doc/guix.texi
View File

@@ -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{<fossil-reference>} 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

2
etc/teams.scm
View File

@@ -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")))

59
guix/build/fossil.scm Normal file
View File

@@ -0,0 +1,59 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2025 Nguyễn Gia Phong <cnx@loang.net>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
;;;
;;; 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

125
guix/fossil-download.scm Normal file
View File

@@ -0,0 +1,125 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2025 Nguyễn Gia Phong <cnx@loang.net>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
;;;
;;; Commentary:
;;;
;;; An <origin> method that open Fossil checkout at a specific version.
;;; The repository URI and version are specified
;;; with a <fossil-reference> 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>
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 <fossil-reference>
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))))