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 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,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"))
;; 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 (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))