GNU bug report logs - #78477
[PATCH] teams: Add script to refresh GNOME core packages.

Previous Next

To reply to this bug, email your comments to 78477 AT debbugs.gnu.org.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: guix-patches <at> gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH] teams: Add script to refresh GNOME core packages.
Date: Sun, 18 May 2025 22:01:20 +0900

* etc/teams/gnome/gnome-core-refresh: New file.

Change-Id: I7c7de6ce4689cef9c51d357e6ea3d16468078013
---
 etc/teams/gnome/gnome-core-refresh | 120 +++++++++++++++++++++++++++++
 1 file changed, 120 insertions(+)
 create mode 100755 etc/teams/gnome/gnome-core-refresh

diff --git a/etc/teams/gnome/gnome-core-refresh b/etc/teams/gnome/gnome-core-refresh
new file mode 100755
index 00000000000..785e9a08b59
--- /dev/null
+++ b/etc/teams/gnome/gnome-core-refresh
@@ -0,0 +1,120 @@
+#!/usr/bin/env -S guix repl --
+!#   ;-*- mode: scheme; -*-
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;;
+;;; 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 a wrapper of 'guix refresh' that refreshes all the GNOME core
+;;; packages listed in their release engineering (releng) list to their stable
+;;; version.  Set the PARTIAL_VERSIONS environment variable to update to
+;;; compatible versions instead of exact ones.  The GNOME_RELENG_VERSIONS_URI
+;;; environment variable can also point to a different URL or file, for
+;;; example to update to a past GNOME version.  The script can be invoked as:
+;;;
+;;; $ ./pre-inst-env etc/teams/gnome/gnome-core-refresh --update
+;;; or
+;;; $ ./pre-inst-env env PARTIAL_VERSIONS=1 etc/teams/gnome/gnome-core-refresh -u
+;;;
+;;; Code:
+
+(use-modules (gnu packages)
+             (guix diagnostics)
+             (guix http-client)
+             (guix scripts refresh)
+             (guix utils)
+             (ice-9 format)
+             (ice-9 exceptions)
+             (ice-9 match)
+             (ice-9 peg)
+             (ice-9 textual-ports)
+             (srfi srfi-1))
+
+(define %gnome-releng-versions-uri
+  (make-parameter
+   (or (getenv "GNOME_RELENG_VERSIONS_URI")
+       "https://gitlab.gnome.org/GNOME/releng/-/raw/master/\
+tools/versions-stable")))
+
+(define (fetch-releng-content)
+  "Return an input port to the %GNOME-RELENG-VERSIONS-URI file."
+  (call-with-port (http-fetch/cached (%gnome-releng-versions-uri))
+    get-string-all))
+
+(define-exception-type &releng-parser-error &error
+  make-releng-parser-error releng-parser-error?)
+
+(define-peg-string-patterns "\
+releng <-- (comment / entry)* !.
+entry <-- suite C name C version C subdir NL
+suite <-- text
+name <-- text
+version <-- text
+subdir <-- text?
+text <- (!NL !C  .)*
+comment < '#' (!NL .)* NL
+C < ':'
+NL < '\n'")
+
+(define %names
+  '(("adwaita-fonts" . "font-adwaita")))
+
+(define (parse-releng data)
+  "Return DATA, a string representing the content of a GNOME releng file, and
+return the complete parse tree."
+  (let ((tree (peg:tree (match-pattern releng data))))
+    (match tree
+      (#f (raise-exception (make-releng-parser-error)))
+      (_ tree))))
+
+(define (check-package-name name)
+  "Return #t if a package corresponding to NAME exists, else #f."
+  (catch 'quit
+    (lambda ()
+      (parameterize ((guix-warning-port (%make-void-port "w")))
+        (specification->package name)
+        #t))
+    (lambda _
+      (format (current-error-port) "TODO: package ~a~%" name)
+      #f)))
+
+(define* (releng-tree->update-specs tree #:key (partial-versions?
+                                                (getenv "PARTIAL_VERSIONS")))
+  "Take TREE and return a list of package specifications.  If
+PARTIAL-VERSIONS? is true, the least significant digit in version is
+stripped and the version is prefixed with the '~' character, so that 'guix
+refresh' can automatically find the newest compatible version."
+  (match tree
+    (('releng ('entry ('suite "core") ('name name) ('version version) _) ...)
+     (filter-map (lambda (name version)
+                   (let ((name (or (assoc-ref %names name) name)))
+                     (and (check-package-name name)
+                          (if partial-versions?
+                              (let* ((parts (string-split version #\.))
+                                     (num-parts (length parts)))
+                                (if (> num-parts 1)
+                                    (format #f "~a=~~~a" name
+                                            (version-prefix version
+                                                            (1- num-parts)))
+                                    (format #f "~a=~a" name version)))
+                              (format #f "~a=~a" name version)))))
+                 name version))))
+
+(apply guix-refresh (append (cdr (command-line))
+                            (releng-tree->update-specs
+                             (parse-releng (fetch-releng-content)))))

base-commit: 6b5fc4812981f2cadffcc5d39e48cd8e02ee73af
-- 
2.49.0

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.