import: crate: Add Cargo.lock parser.

* guix/import/crate/cargo-lock.scm: New file.
* Makefile.am (MODULES): Regisiter it.
* etc/teams.scm (rust)[#:scope]: Add it.
* CODEOWNERS: Add it.
* guix/import/crate.scm (cargo-lock->expressions): New procedure.
* tests/crate.scm (temp-file): New variable.
("crate-lockfile-import"): New test.

Co-authored-by: Murilo <murilo@disroot.org>
Co-authored-by: Luis Guilherme Coelho <lgcoelho@disroot.org>
Change-Id: I95421e9e2ba11a671b4bc4e1323c6d31a1b012c5
This commit is contained in:
Hilton Chain 2025-02-24 12:50:26 +08:00
parent 4e8eab6fe4
commit f27fb840c2
No known key found for this signature in database
GPG key ID: ACC66D09CA528292
6 changed files with 273 additions and 0 deletions

View file

@ -308,6 +308,7 @@ guix/build/cargo-build-system\.scm @guix/rust
guix/build/cargo-utils\.scm @guix/rust
guix/build-system/cargo\.scm @guix/rust
guix/import/crate\.scm @guix/rust
guix/import/crate/cargo-lock\.scm @guix/rust
guix/scripts/import/crate\.scm @guix/rust
tests/crate\.scm @guix/rust

View file

@ -298,6 +298,7 @@ MODULES = \
guix/import/cpan.scm \
guix/import/cran.scm \
guix/import/crate.scm \
guix/import/crate/cargo-lock.scm \
guix/import/egg.scm \
guix/import/elm.scm \
guix/import/elpa.scm \

View file

@ -923,6 +923,7 @@ importer."
"guix/build/cargo-utils.scm"
"guix/build-system/cargo.scm"
"guix/import/crate.scm"
"guix/import/crate/cargo-lock.scm"
"guix/scripts/import/crate.scm"
"tests/crate.scm")))

View file

@ -9,6 +9,9 @@
;;; Copyright © 2023, 2024 David Elsing <david.elsing@posteo.net>
;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2025 Herman Rimm <herman@rimm.ee>
;;; Copyright © 2024 Murilo <murilo@disroot.org>
;;; Copyright © 2024-2025 Luis Guilherme Coelho <lgcoelho@disroot.org>
;;; Copyright © 2025 Hilton Chain <hako@ultrarare.space>
;;;
;;; This file is part of GNU Guix.
;;;
@ -26,12 +29,14 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import crate)
#:use-module (guix base16)
#:use-module (guix base32)
#:use-module ((guix build-system cargo) #:hide (crate-source))
#:use-module (guix diagnostics)
#:use-module (gcrypt hash)
#:use-module (guix http-client)
#:use-module (guix i18n)
#:use-module (guix import crate cargo-lock)
#:use-module (guix import json)
#:use-module (guix import utils)
#:use-module (guix memoization)
@ -39,9 +44,11 @@
#:use-module (guix read-print)
#:use-module (guix upstream)
#:use-module (guix utils)
#:use-module (guix scripts download)
#:use-module (gnu packages)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 textual-ports)
#:use-module (json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
@ -52,6 +59,7 @@
guix-package->crate-name
string->license
crate-recursive-import
cargo-lock->expressions
%crate-updater))
@ -481,6 +489,76 @@ look up the development dependencs for the given crate."
(match parts
((name _ ...) name))))
;;;
;;; Convert Cargo.lock to Guix sources.
;;;
(define (cargo-lock->expressions lockfile package-name)
"Given LOCKFILE, a 'Cargo.lock' file, import its content as source
expressions. Return a source list and a Cargo inputs entry for PACKAGE-NAME
referencing all imported sources."
(define (crate->guix-source crate)
(match crate
(('crate
('crate-name name)
('crate-version version)
('crate-source _)
('crate-checksum checksum))
`(define
,(string->symbol
(string-append (crate-name->package-name name) "-" version))
,@(if (or (string-suffix? "src" name)
(string-suffix? "sys" name))
(list (comment ";; TODO: Check bundled sources.\n" #f))
'())
(crate-source ,name ,version
,(bytevector->nix-base32-string
(base16-string->bytevector checksum)))))
;; Git snapshot.
(('crate
('crate-name name)
('crate-version version)
('crate-source source))
(begin
(let* ((src (string-split source (char-set #\+ #\? #\#)))
(url (second src))
(commit (last src))
(version (string-append version "." (string-take commit 7)))
(checksum
(second
(string-split
(with-output-to-string
(lambda _
(guix-download "-g" url
(string-append "--commit=" commit))))
#\newline))))
`(define
,(string->symbol
(string-append (crate-name->package-name name) "-" version))
,(comment
";; TODO: Define standalone package if this is a workspace.\n"
#f)
(origin
(method git-fetch)
(uri (git-reference
(url ,url)
(commit ,commit)))
(file-name
(git-file-name ,(crate-name->package-name name) ,version))
(sha256 (base32 ,checksum)))))))
;; Cargo workspace member.
(else #f)))
(let* ((source-expressions
(filter-map crate->guix-source
(cargo-lock-string->scm
(call-with-input-file lockfile get-string-all))))
(cargo-inputs-entry
`(,(string->symbol package-name) =>
(list ,@(map second source-expressions)))))
(values source-expressions cargo-inputs-entry)))
;;;
;;; Updater

View file

@ -0,0 +1,105 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2024 Murilo <murilo@disroot.org>
;;; Copyright © 2024 Luis Guilherme Coelho <lgcoelho@disroot.org>
;;;
;;; 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/>.
(define-module (guix import crate cargo-lock)
#:use-module (ice-9 peg)
#:export (cargo-lock-string->scm
crate-name
crate-version
crate-source
crate-checksum
crate-dependencies
cargo-lock))
;;;
;;; PEG parser for Cargo.lock.
;;;
(define (cargo-lock-string->scm str)
(peg:tree (search-for-pattern cargo-lock str)))
;; Auxiliar peg patterns
(define-peg-pattern numeric-char body
(range #\0 #\9))
(define-peg-pattern lowercase-char body
(range #\a #\z))
(define-peg-pattern uppercase-char body
(range #\A #\Z))
(define-peg-pattern alphabetic-char body
(or lowercase-char uppercase-char))
(define-peg-pattern alphanumeric-char body
(or alphabetic-char numeric-char))
;; name
(define-peg-pattern crate-name all
(+ (or "-" alphabetic-char
"_" numeric-char)))
;; version
(define-peg-pattern non-negative-integer body
(+ numeric-char))
(define-peg-pattern crate-version all
(and non-negative-integer "."
non-negative-integer "."
non-negative-integer
(? (+ (or "-" lowercase-char
"." uppercase-char
"+" numeric-char "_")))))
;; source
(define-peg-pattern crate-source all
(and (or "registry" "git")
"+https://"
(+ (or "/" "." "?" "=" "-" "#" "_"
alphanumeric-char))))
;; checksum
(define-peg-pattern crate-checksum all
(+ (or lowercase-char numeric-char)))
;; dependency specification
(define-peg-pattern dependency-specification all
(and crate-name (? (and (ignore " ") crate-version))))
;; dependencies
(define-peg-pattern crate-dependencies all
(and (ignore "[\n")
(+ (and (ignore " \"")
(capture dependency-specification)
(ignore "\",\n")))
(ignore "]")))
;; crates
(define-peg-pattern crate all
(and (ignore "[[package]]\n")
(ignore "name = \"") (capture crate-name) (ignore "\"\n")
(ignore "version = \"") (capture crate-version) (ignore "\"\n")
(? (and (ignore "source = \"") (capture crate-source) (ignore "\"\n")))
(? (and (ignore "checksum = \"") (capture crate-checksum) (ignore "\"\n")))
(? (ignore (and "dependencies = " crate-dependencies "\n")))))
;; Cargo.lock
(define-peg-pattern cargo-lock all
(+ (and (ignore "\n") crate)))

View file

@ -34,6 +34,7 @@
#:use-module (gnu packages)
#:use-module (ice-9 iconv)
#:use-module (ice-9 match)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-64))
@ -476,6 +477,9 @@
(description #f)
(license #f)))
(define temp-file
(string-append "t-crate-" (number->string (getpid))))
(test-begin "crate")
@ -1178,4 +1182,87 @@
(x
(pk 'fail (pretty-print-with-comments (current-output-port) x) #f)))))
(test-assert "crate-lockfile-import"
(begin
(call-with-output-file temp-file
(lambda (port)
(display "\
# This file is automatically @generated by Cargo.
# It is not intended for manual editing.
version = 3
[[package]]
name = \"adler2\"
version = \"2.0.0\"
source = \"registry+https://github.com/rust-lang/crates.io-index\"
checksum = \"512761e0bb2578dd7380c6baaa0f4ce03e84f95e960231d1dec8bf4d7d6e2627\"
[[package]]
name = \"aho-corasick\"
version = \"1.1.3\"
source = \"registry+https://github.com/rust-lang/crates.io-index\"
checksum = \"8e60d3430d3a69478ad0993f19238d2df97c507009a52b3c10addcd7f6bcb916\"
dependencies = [
\"memchr\",
]
[[package]]
name = \"smithay\"
version = \"0.4.0\"
source = \"git+https://github.com/Smithay/smithay.git?rev=\
0cd3345c59f7cb139521f267956a1a4e33248393#\
0cd3345c59f7cb139521f267956a1a4e33248393\"
dependencies = [
\"appendlist\",
]
[[package]]
name = \"test\"
version = \"25.2.0\"\n" port)))
(mock
((guix scripts download) guix-download
(lambda _
(format #t "~a~%~a~%"
"/gnu/store/in056fyrz6nvy3jpxrxglgj30g0lwniv-smithay-0cd3345"
"191h87bpzg0l1ihfb4hmx00b86pfb5mwwc6s8i49al0vigc14l37")))
(let-values
(((source-expressions cargo-inputs-entry)
(cargo-lock->expressions temp-file "test")))
(and
(match source-expressions
(`((define rust-adler2-2.0.0
(crate-source
"adler2" "2.0.0"
"09r6drylvgy8vv8k20lnbvwq8gp09h7smfn6h1rxsy15pgh629si"))
(define rust-aho-corasick-1.1.3
(crate-source
"aho-corasick" "1.1.3"
"05mrpkvdgp5d20y2p989f187ry9diliijgwrs254fs9s1m1x6q4f"))
(define rust-smithay-0.4.0.0cd3345
,($ <comment>
";; TODO: Define standalone package if this is a workspace.\n"
#f)
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/Smithay/smithay.git")
(commit "0cd3345c59f7cb139521f267956a1a4e33248393")))
(file-name (git-file-name "rust-smithay" "0.4.0.0cd3345"))
(sha256
(base32
"191h87bpzg0l1ihfb4hmx00b86pfb5mwwc6s8i49al0vigc14l37")))))
#t)
(x
(pk 'fail (pretty-print-with-comments (current-output-port) x) #f)))
(match cargo-inputs-entry
(`(test => (list rust-adler2-2.0.0
rust-aho-corasick-1.1.3
rust-smithay-0.4.0.0cd3345))
#t)
(x
(pk 'fail x #f))))))))
(test-end "crate")
(false-if-exception (delete-file temp-file))