[bug#77093,v4,rust-team,21/22] import: crate: Add Cargo.lock parser.

Message ID a33d57f8587db1e24be0546dcbf82fa8a15e9ca7.1745855744.git.hako@ultrarare.space
State New
Headers
Series Cargo.lock importer and build system changes. |

Commit Message

Hilton Chain April 28, 2025, 4:23 p.m. UTC
  * guix/import/crate/cargo-lock.scm: New file.
* Makefile.am (MODULES): Regisiter it.
* etc/teams.scm (rust)[#:scope]: 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
---
 Makefile.am                      |   1 +
 etc/teams.scm                    |   1 +
 guix/import/crate.scm            |  78 +++++++++++++++++++++++
 guix/import/crate/cargo-lock.scm | 105 +++++++++++++++++++++++++++++++
 tests/crate.scm                  |  87 +++++++++++++++++++++++++
 5 files changed, 272 insertions(+)
 create mode 100644 guix/import/crate/cargo-lock.scm
  

Patch

diff --git a/Makefile.am b/Makefile.am
index 0c12754050..8a32be3ef9 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -295,6 +295,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   			\
diff --git a/etc/teams.scm b/etc/teams.scm
index 6f10941c72..4fe121e63f 100755
--- a/etc/teams.scm
+++ b/etc/teams.scm
@@ -390,6 +390,7 @@  (define-team rust
                       "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")))
 
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index a6f247bbae..39da867805 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -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 @@  (define-module (guix import crate)
   #: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 @@  (define-module (guix import crate)
             guix-package->crate-name
             string->license
             crate-recursive-import
+            cargo-lock->expressions
             %crate-updater))
 
 
@@ -481,6 +489,76 @@  (define (guix-package->crate-name package)
     (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
diff --git a/guix/import/crate/cargo-lock.scm b/guix/import/crate/cargo-lock.scm
new file mode 100644
index 0000000000..b8a6ab20c0
--- /dev/null
+++ b/guix/import/crate/cargo-lock.scm
@@ -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)))
diff --git a/tests/crate.scm b/tests/crate.scm
index d0dc779cd2..8c1f6e738d 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -34,6 +34,7 @@  (define-module (test-crate)
   #: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 @@  (define rust-leaf-bob-3.0.2-yanked
     (description #f)
     (license #f)))
 
+(define temp-file
+  (string-append "t-crate-" (number->string (getpid))))
+
 
 (test-begin "crate")
 
@@ -1178,4 +1182,87 @@  (define rust-leaf-bob-3.0.2-yanked
           (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))