Compare commits

...

1 Commits

Author SHA1 Message Date
Jelle Licht
9babff1bbe
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.
2023-02-14 00:31:26 +01:00

View File

@ -19,6 +19,7 @@
;;; Copyright © 2022 Simen Endsjø <simendsjo@gmail.com> ;;; Copyright © 2022 Simen Endsjø <simendsjo@gmail.com>
;;; Copyright © 2022 Leo Famulari <leo@famulari.name> ;;; Copyright © 2022 Leo Famulari <leo@famulari.name>
;;; Copyright © 2023 Morgan Smith <Morgan.J.Smith@outlook.com> ;;; Copyright © 2023 Morgan Smith <Morgan.J.Smith@outlook.com>
;;; Copyright © 2023 Jelle Licht <jlicht@fsfe.org>
(define-module (nongnu packages linux) (define-module (nongnu packages linux)
#:use-module (gnu packages) #:use-module (gnu packages)
@ -37,28 +38,58 @@
#:use-module (guix build-system trivial) #:use-module (guix build-system trivial)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (nonguix licenses) #:use-module (nonguix licenses)
#:use-module (srfi srfi-1)
#:export (corrupt-linux)) #:export (corrupt-linux))
(define (linux-urls version) (define (linux-url version)
"Return a list of URLS for Linux VERSION." "Return a URL for Linux VERSION."
(list (string-append "https://www.kernel.org/pub/linux/kernel/v" (string-append "mirror://kernel.org"
(version-major version) ".x/linux-" version ".tar.xz"))) "/linux/kernel/v" (version-major version) ".x"
"/linux-" version ".tar.xz"))
(define* (corrupt-linux freedo #:key (name "linux")) (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 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 (package
(inherit (inherit
(customize-linux (customize-linux
#:name name #:name name
#:source (origin (inherit (package-source freedo)) #:source (origin
(method url-fetch) (method url-fetch)
(uri (linux-urls (package-version freedo))) (uri url)
(patches '())))) (hash hash))))
(version (package-version freedo)) (version version)
(home-page "https://www.kernel.org/") (home-page "https://www.kernel.org/")
(synopsis "Linux kernel with nonfree binary blobs included") (synopsis "Linux kernel with nonfree binary blobs included")
(description (description
"The unmodified Linux kernel, including nonfree blobs, for running Guix "The unmodified Linux kernel, including nonfree blobs, for running Guix System
System on hardware which requires nonfree software to function."))) on hardware which requires nonfree software to function."))))
(define-public linux-6.1 (define-public linux-6.1
(corrupt-linux linux-libre-6.1)) (corrupt-linux linux-libre-6.1))