From 9babff1bbe42532f8e4658677f68bd41e34983ea Mon Sep 17 00:00:00 2001 From: Jelle Licht Date: Mon, 13 Feb 2023 17:47:04 +0100 Subject: 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. --- nongnu/packages/linux.scm | 67 ++++++++++++++++++++++++++++++++++------------- 1 file changed, 49 insertions(+), 18 deletions(-) diff --git a/nongnu/packages/linux.scm b/nongnu/packages/linux.scm index 011818f..095e697 100644 --- a/nongnu/packages/linux.scm +++ b/nongnu/packages/linux.scm @@ -19,6 +19,7 @@ ;;; Copyright © 2022 Simen Endsjø ;;; Copyright © 2022 Leo Famulari ;;; Copyright © 2023 Morgan Smith +;;; Copyright © 2023 Jelle Licht (define-module (nongnu packages linux) #:use-module (gnu packages) @@ -37,28 +38,58 @@ #: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")) - (package - (inherit - (customize-linux - #:name name - #:source (origin (inherit (package-source freedo)) - (method url-fetch) - (uri (linux-urls (package-version freedo))) - (patches '())))) - (version (package-version freedo)) - (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."))) + + ;; 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 gexp-input->origin + (match-lambda + ((? origin? source) source) + (_ #f))) + + (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 + (method url-fetch) + (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.")))) (define-public linux-6.1 (corrupt-linux linux-libre-6.1)) -- cgit v1.2.3