nongnu: corrupt-linux: Extract upstream hashes.

* nongnu/packages/linux.scm (linux-urls): Rename to ...
(linux-url): ... this. Return single url with mirror prefix like guix does.
(corrupt-linux): Use implementation details to dig up original hash of
upstream linux kernel sources.
This commit is contained in:
Jelle Licht 2023-02-13 17:47:04 +01:00
parent 225185a1bd
commit 4f3e4c6dfa
No known key found for this signature in database
GPG Key ID: DA4597F947B41025

View File

@ -19,6 +19,7 @@
;;; Copyright © 2022 Simen Endsjø <simendsjo@gmail.com>
;;; Copyright © 2022 Leo Famulari <leo@famulari.name>
;;; Copyright © 2023 Morgan Smith <Morgan.J.Smith@outlook.com>
;;; Copyright © 2023 Jelle Licht <jlicht@fsfe.org>
(define-module (nongnu packages linux)
#:use-module (gnu packages)
@ -37,28 +38,53 @@
#:use-module (guix build-system trivial)
#:use-module (ice-9 match)
#:use-module (nonguix licenses)
#:use-module (srfi srfi-1)
#:export (corrupt-linux))
(define (linux-urls version)
"Return a list of URLS for Linux VERSION."
(list (string-append "https://www.kernel.org/pub/linux/kernel/v"
(version-major version) ".x/linux-" version ".tar.xz")))
(define (linux-url version)
"Return a URL for Linux VERSION."
(string-append "mirror://kernel.org"
"/linux/kernel/v" (version-major version) ".x"
"/linux-" version ".tar.xz"))
(define* (corrupt-linux freedo #:key (name "linux"))
;; TODO: This very directly depends on guix internals.
;; Throw it all out when we manage kernel hashes.
(define gexp-inputs (@@ (guix gexp) gexp-inputs))
(define extract-gexp-inputs
(compose gexp-inputs force origin-uri))
(define (find-source-hash sources url)
(let ((versioned-origin
(find (lambda (source)
(let ((uri (origin-uri source)))
(and (string? uri) (string=? uri url)))) sources)))
(if versioned-origin
(origin-hash versioned-origin)
#f)))
(let* ((version (package-version freedo))
(url (linux-url version))
(pristine-source (package-source freedo))
(inputs (map gexp-input-thing (extract-gexp-inputs pristine-source)))
(sources (filter origin? inputs))
(hash (find-source-hash sources url)))
(package
(inherit
(customize-linux
#:name name
#:source (origin (inherit (package-source freedo))
#:source (origin
(method url-fetch)
(uri (linux-urls (package-version freedo)))
(patches '()))))
(version (package-version freedo))
(uri url)
(hash hash))))
(version version)
(home-page "https://www.kernel.org/")
(synopsis "Linux kernel with nonfree binary blobs included")
(description
"The unmodified Linux kernel, including nonfree blobs, for running Guix
System on hardware which requires nonfree software to function.")))
"The unmodified Linux kernel, including nonfree blobs, for running Guix System
on hardware which requires nonfree software to function."))))
(define-public linux-6.1
(corrupt-linux linux-libre-6.1))