diff --git a/guix/import/nvidia.scm b/guix/import/nvidia.scm new file mode 100644 index 0000000..49ca159 --- /dev/null +++ b/guix/import/nvidia.scm @@ -0,0 +1,121 @@ +;;; SPDX-License-Identifier: GPL-3.0-or-later +;;; Copyright © 2024 Nicolas Graves + +;;; This file is not part of GNU Guix but requires this naming scheme +;;; so that the %nvidia-updater is properly read when using +;;; `guix refresh -L$(pwd) nvidia-driver' in nonguix root. + +(define-module (guix import nvidia) + #:use-module (web client) + #:use-module (sxml match) + #:use-module (sxml simple) + #:use-module (guix memoization) + #:use-module (guix packages) + #:use-module (guix upstream) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-71) + #:export (%nvidia-updater)) + +(define nvidia-latest-url "https://www.nvidia.com/en-us/drivers/unix/") + +(define (archive->guix-arch system) + (match system + ("https://www.nvidia.com/object/linux-amd64-display-archive.html" + "x86_64-linux") + ("https://www.nvidia.com/en-us/drivers/unix/linux-aarch64-archive/" + "aarch64-linux") + (_ #f))) + +(define (archive? cand) + (or (string= cand (string-append nvidia-latest-url "linux-aarch64-archive/")) + (and (string-prefix? "https://www.nvidia.com/object/" cand) + (string-suffix? "-archive.html" cand)))) + +(define nvidia-versions + (memoize + (lambda _ + (let* ((response content (http-get nvidia-latest-url)) + (match-str (string-match "
" + content)) + (greedy-right-content (match:substring match-str)) + (match-str (string-match "
" greedy-right-content)) + (right-content + (string-append (match:prefix match-str) "")) + ;; xml->sxml is not flexible enough for html. + ;; For instance,
tags don't have closing
. + ;; This trick preprocesses html to extract all tags in + ;; a wrapper, which sxml-match can handle well. + (xml (xml->sxml + (string-append + "<" + (string-join + (filter (cute string-prefix? "a " <>) + (string-split right-content #\<)) + "<") + "") + #:trim-whitespace? #t)) + (link-alist + (sxml-match + xml + ((*TOP* + (body + (a (@ (href ,url)) ,version) ...)) + (fold acons + '() + (list (or (string= version "Archive") + (string-trim version)) + ...) + (list (if (archive? url) + (archive->guix-arch url) + url) + ...))))) + (system #f) + (versions + (fold + (lambda (el rest) + (match el + (`(#t . ,s) + (set! system s) + rest) + (`(,version . ,address) + ;; aarch64 seems to follow the same driver versions than x86_64 + ;; KISS: use only an alist of versions + ;; go for an alist of alists insted if they diverge + (if (and (string? system) (string= system "x86_64-linux")) + (cons version rest) + rest)) + (_ rest))) + '() + link-alist))) + (fold acons '() (list "main" "latest" "beta") (take versions 3)))))) + +(define* (latest-release package #:key (version #f)) + "Return an for the latest-release of PACKAGE." + (let* ((name (package-name package)) + (kind (match name + ("nvidia-driver" "main") + ("nvidia-driver-beta" "beta"))) + (version (or version (assoc-ref (nvidia-versions) kind)))) + (upstream-source + (package name) + (version version) + (urls (list (string-append + "https://us.download.nvidia.com/XFree86/Linux-x86_64/" + version "/NVIDIA-Linux-x86_64-" version ".run")))))) + +(define (nvidia-package? package) + "Return true if PACKAGE is Nvidia." + (member (package-name package) + (list "nvidia-driver" "nvidia-driver-beta"))) + +(define %nvidia-updater + (upstream-updater + (name 'nvidia) + (description "Updater for Nvidia packages") + (pred nvidia-package?) + (import latest-release))) + +;; nvidia.scm ends here.