unofficial mirror of bug-guix@gnu.org 
 help / color / mirror / code / Atom feed
94a2598ab2ccf3b08936939c7db80a48c888e42f blob 5021 bytes (raw)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
 
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2019, 2021 Ludovic Courtès <ludo@gnu.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 gnome)
  #:use-module (guix upstream)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:use-module (guix http-client)
  #:use-module (json)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-34)
  #:use-module (web uri)
  #:use-module (ice-9 match)
  #:export (%gnome-updater))

;;; Commentary:
;;;
;;; This package provides not an actual importer but simply an updater for
;;; GNOME packages.  It grabs package meta-data from 'cache.json' files
;;; available on ftp.gnome.org.
;;;
;;; Code:

(define (jsonish->upstream-source name jsonish)
  "Return an <upstream-source> object for package NAME, using JSONISH as the
source for metadata."
  (match jsonish
    ((version . dictionary)
     (upstream-source
      (package name)
      (version version)
      (urls (filter-map (lambda (extension)
                          (match (assoc-ref dictionary extension)
                            (#f
                             #f)
                            ((? string? relative-url)
                             (string-append "mirror://gnome/sources/"
                                            name "/" relative-url))))
                        '("tar.lz" "tar.xz" "tar.bz2" "tar.gz")))))))

(define (latest-gnome-release package)
  "Return the latest release of PACKAGE, a GNOME package, or #f if it could
not be determined."
  (define %not-dot
    (char-set-complement (char-set #\.)))

  (define (stable-minor-version? version)
    (match (string-tokenize version %not-dot)
      (((= string->number major) (= string->number minor) . rest)
       (and minor (even? minor) (< minor 90)))
      (((= string->number major) . _)
       ;; It should at last start with a digit.
       major)))

  (define allowed-major-version?
    (let ((fixed-major (assoc-ref (package-properties package)
                                  'update-major-version)))
      (if fixed-major
          (lambda (version)
            (match (string-tokenize version %not-dot)
              (((= string->number major) . _)
               (= major fixed-major))
              (_ #f)))
          (const #t))))

  (define upstream-name
    ;; Some packages like "NetworkManager" have camel-case names.
    (package-upstream-name package))

  (guard (c ((http-get-error? c)
             (if (= 404 (http-get-error-code c))
                 #f
                 (raise c))))
    (let* ((port (http-fetch/cached
                  (string->uri (string-append
                                "https://ftp.gnome.org/pub/gnome/sources/"
                                upstream-name "/cache.json"))

                  ;; ftp.gnome.org supports 'if-Modified-Since', so the local
                  ;; cache can expire early.
                  #:ttl (* 60 10)

                  ;; Hide messages about URL redirects.
                  #:log-port (%make-void-port "w")))
           (json (json->scm port)))
      (close-port port)
      (match json
        (#(4 releases _ ...)
         (let* ((releases (assoc-ref releases upstream-name))
                (latest   (fold (match-lambda*
                                  (((key . value) result)
                                   (cond
                                    ((not (allowed-major-version? key))
                                     result)
                                    ((stable-minor-version? key)
                                     (match result
                                       (#f
                                        (cons key value))
                                       ((newest . _)
                                        (if (version>? key newest)
                                            (cons key value)
                                            result))))
                                    (else result))))
                                #f
                                releases)))
           (and latest
                (jsonish->upstream-source upstream-name latest))))))))

(define %gnome-updater
  (upstream-updater
   (name 'gnome)
   (description "Updater for GNOME packages")
   (pred (url-prefix-predicate "mirror://gnome/"))
   (latest latest-gnome-release)))
debug log:

solving 94a2598ab2 ...
found 94a2598ab2 in https://yhetil.org/guix-bugs/8d1df21d42539c5a0690be407e60e90c7335697a.camel@gmail.com/
found 1a0786ab8d in https://yhetil.org/guix-bugs/8f37e2ae72f4e532f05f8cd010099a8e87e57c47.camel@gmail.com/
found 43966c1028 in https://git.savannah.gnu.org/cgit/guix.git
preparing index
index prepared:
100644 43966c1028b473144119511a0ffa504db2e4a276	guix/import/gnome.scm

applying [1/2] https://yhetil.org/guix-bugs/8f37e2ae72f4e532f05f8cd010099a8e87e57c47.camel@gmail.com/
diff --git a/guix/import/gnome.scm b/guix/import/gnome.scm
index 43966c1028..1a0786ab8d 100644


applying [2/2] https://yhetil.org/guix-bugs/8d1df21d42539c5a0690be407e60e90c7335697a.camel@gmail.com/
diff --git a/guix/import/gnome.scm b/guix/import/gnome.scm
index 1a0786ab8d..94a2598ab2 100644

Checking patch guix/import/gnome.scm...
Applied patch guix/import/gnome.scm cleanly.
Checking patch guix/import/gnome.scm...
Applied patch guix/import/gnome.scm cleanly.

index at:
100644 94a2598ab2ccf3b08936939c7db80a48c888e42f	guix/import/gnome.scm

Code repositories for project(s) associated with this inbox:

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).