diff --git a/guix/rustup/build/manifest.scm b/guix/rustup/build/manifest.scm index 270fe1e..47ff588 100644 --- a/guix/rustup/build/manifest.scm +++ b/guix/rustup/build/manifest.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (rustup build manifest) + #:use-module (rustup packages) #:use-module (rnrs enums) #:use-module (guix records) #:use-module (guix base32) @@ -45,6 +46,7 @@ download-manifest compact-manifest download-and-compact-manifest + write-manifest %rustc-target-triplets? %toolchain-components %toolchain-components? @@ -475,8 +477,10 @@ (define* (download-and-compact-manifest str) (let ((manifest (download-manifest str))) (if manifest - (compact-manifest str manifest) - #f))) + (let ((compacted (compact-manifest str manifest))) + (write-manifest compacted (manifests-directory-cache-directory)) + compacted) + #f))) (define* (download-manifest str) (define c (channel->from-str str)) @@ -623,3 +627,45 @@ ) `(,url . ,hash))) + +(define* (write-manifest data manifests-dir + #:optional (no-update-default-channel #t)) + (define (channel version) + (cond ((string-contains version "beta") + "beta") + ((string-contains version "nightly") + "nightly") + (else + "stable"))) + + (let* ((version (car data)) + (date (cadr data)) + (channel (channel version)) + (filename (format #f "~a~a-~a" manifests-dir channel date))) + (call-with-output-file filename + (lambda (port) + (write data port))) + (unless (string= channel "nightly") + (call-with-port + (open manifests-dir O_RDONLY) + (lambda (port) + (when (file-exists? (format #f "~a/~a" manifests-dir version)) + (delete-file-at port version)) + (symlinkat port (basename filename) version) + ;; (readlink version) + ))) + (unless no-update-default-channel + (call-with-port + (open manifests-dir O_RDONLY) + (lambda (port) + (when (file-exists? (format #f "~a/~a" manifests-dir channel)) + (delete-file-at port channel)) + (symlinkat port (basename filename) channel) + ;; (readlink version) + ))) + ;; (info (G_ "no update default channel '~a'...~%") no-update-default-channel) + ;; (info (G_ "version '~a'...~%") version) + ;; (info (G_ "date '~a'...~%") date) + ;; (info (G_ "filename '~a'...~%") filename) + ) + ) diff --git a/guix/rustup/packages.scm b/guix/rustup/packages.scm index b6da562..be18a9c 100644 --- a/guix/rustup/packages.scm +++ b/guix/rustup/packages.scm @@ -2,8 +2,11 @@ #:use-module (guix ui) #:use-module (guix utils) #:use-module (guix diagnostics) + #:use-module ((guix build utils) #:select (mkdir-p)) + #:use-module (srfi srfi-26) #:use-module (ice-9 match) - #:export (search-manifest)) + #:export (search-manifest + manifests-directory-cache-directory)) (define %distro-root-directory ;; Absolute file name of the module hierarchy. Since (gnu packages …) might @@ -26,7 +29,7 @@ ("rustup/packages.scm" rustup/) ("rustup.scm")))) -(define %manifest-path +(define %manifests-directory ;; Define it after '%package-module-path' so that '%load-path' contains user ;; directories, allowing patches in $GUIX_PACKAGE_PATH to be found. (make-parameter @@ -36,6 +39,32 @@ directory)) %load-path))) +;; copied from (guix utils) +(define* (xdg-directory variable suffix #:key (ensure? #t)) + "Return the name of the XDG directory that matches VARIABLE and SUFFIX, +after making sure that it exists if ENSURE? is true. VARIABLE is an +environment variable name like \"XDG_CONFIG_HOME\"; SUFFIX is a suffix like +\"/.config\". Honor the XDG specs, +." + (let ((dir (and=> (or (getenv variable) + (and=> (or (getenv "HOME") + (passwd:dir (getpwuid (getuid)))) + (cut string-append <> suffix))) + (cut string-append <> "/guix-rustup")))) + (when ensure? + (mkdir-p dir)) + dir)) + +(define cache-directory + (cut xdg-directory "XDG_CACHE_HOME" "/.cache" <...>)) + +(define* (manifests-directory-cache-directory #:key (ensure? #t)) + (let ((dir (string-append (cache-directory) "/manifests/"))) + (when ensure? + (mkdir-p dir)) + dir)) + (define* (search-manifest file-name) "Search the manifest FILE-NAME. Raise an error if not found." - (search-path (%manifest-path) file-name)) + (or (search-path (%manifests-directory) file-name) + (search-path (list (manifests-directory-cache-directory)) file-name))) diff --git a/scripts/update.scm b/scripts/update.scm index c386c8e..a27bef0 100755 --- a/scripts/update.scm +++ b/scripts/update.scm @@ -12,14 +12,6 @@ (define %manifests-dir (string-append %root "/guix/rustup/manifests/")) -(define (channel version) - (cond ((string-contains version "beta") - "beta") - ((string-contains version "nightly") - "nightly") - (else - "stable"))) - (define (update arg0 . args) (when (nil? args) (error (G_ "No channel specified '~a'...~%") `(,arg0 ,@args))) @@ -27,37 +19,7 @@ (no-update-default-channel (if (nil? (cdr args)) #f (cadr args))) - (data (download-and-compact-manifest channel-str)) - (version (car data)) - (date (cadr data)) - (channel (channel version)) - (filename (format #f "~a~a-~a" %manifests-dir channel date))) - (call-with-output-file filename - (lambda (port) - (write data port))) - (unless (string= channel "nightly") - (call-with-port - (open %manifests-dir O_RDONLY) - (lambda (port) - (when (file-exists? (format #f "~a/~a" %manifests-dir version)) - (delete-file-at port version)) - (symlinkat port (basename filename) version) - ;; (readlink version) - ))) - (unless no-update-default-channel - (call-with-port - (open %manifests-dir O_RDONLY) - (lambda (port) - (when (file-exists? (format #f "~a/~a" %manifests-dir channel)) - (delete-file-at port channel)) - (symlinkat port (basename filename) channel) - ;; (readlink version) - ))) - ;; (info (G_ "no update default channel '~a'...~%") no-update-default-channel) - ;; (info (G_ "version '~a'...~%") version) - ;; (info (G_ "date '~a'...~%") date) - ;; (info (G_ "filename '~a'...~%") filename) - ) - ) + (data (download-and-compact-manifest channel-str))) + (write-manifest data %manifests-dir no-update-default-channel))) (apply update (command-line))