diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build/clojure-build-system.scm | 58 | ||||
| -rw-r--r-- | guix/download.scm | 84 | ||||
| -rw-r--r-- | guix/scripts/deploy.scm | 32 |
3 files changed, 123 insertions, 51 deletions
diff --git a/guix/build/clojure-build-system.scm b/guix/build/clojure-build-system.scm index 7d494078ea..cacbefb386 100644 --- a/guix/build/clojure-build-system.scm +++ b/guix/build/clojure-build-system.scm @@ -22,11 +22,15 @@ ant-build)) #:use-module (guix build clojure-utils) #:use-module (guix build java-utils) + #:use-module (guix build syscalls) #:use-module (guix build utils) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (%standard-phases - clojure-build)) + clojure-build + reset-class-timestamps)) ;; Commentary: ;; @@ -108,6 +112,55 @@ priority over TEST-INCLUDE." jar-names))) #t) +(define (regular-jar-file? file stat) + "Predicate returning true if FILE is ending on '.jar' +and STAT indicates it is a regular file." + (and (string-suffix? ".jar" file) + (eq? 'regular (stat:type stat)))) + +;; XXX: The only difference compared to 'strip-jar-timestamps' in +;; ant-build-system.scm is the date. TODO: Adjust and factorize. +(define* (reset-class-timestamps #:key outputs #:allow-other-keys) + "Unpack all jar archives, reset the timestamp of all contained class files, +and repack them. This is necessary to ensure that archives are reproducible." + (define (repack-archive jar) + (format #t "resetting class timestamps and repacking ~a\n" jar) + + ;; Note: .class files need to be strictly newer than source files, + ;; otherwise the Clojure compiler will recompile sources. + (let* ((early-1980 315619200) ; 1980-01-02 UTC + (dir (mkdtemp! "jar-contents.XXXXXX")) + (manifest (string-append dir "/META-INF/MANIFEST.MF"))) + (with-directory-excursion dir + (invoke "jar" "xf" jar)) + (delete-file jar) + (for-each (lambda (file) + (let ((s (lstat file))) + (unless (eq? (stat:type s) 'symlink) + (when (string-match "^(.*)\\.class$" file) + (utime file early-1980 early-1980))))) + (find-files dir #:directories? #t)) + ;; The jar tool will always set the timestamp on the manifest file + ;; and the containing directory to the current time, even when we + ;; reuse an existing manifest file. To avoid this we use "zip" + ;; instead of "jar". It is important that the manifest appears + ;; first. + (with-directory-excursion dir + (let* ((files (find-files "." ".*" #:directories? #t)) + ;; To ensure that the reference scanner can detect all + ;; store references in the jars we disable compression + ;; with the "-0" option. + (command (if (file-exists? manifest) + `("zip" "-0" "-X" ,jar ,manifest ,@files) + `("zip" "-0" "-X" ,jar ,@files)))) + (apply invoke command))) + (utime jar 0 0))) + (for-each (match-lambda + ((output . directory) + (for-each repack-archive + (find-files directory regular-jar-file?)))) + outputs)) + (define-with-docs install "Standard 'install' phase for clojure-build-system." (install-jars "./")) @@ -119,7 +172,8 @@ priority over TEST-INCLUDE." (replace 'build build) (replace 'check check) (replace 'install install) - (add-after 'install-license-files 'install-doc install-doc))) + (add-after 'install-license-files 'install-doc install-doc) + (add-after 'reset-gzip-timestamps 'reset-class-timestamps reset-class-timestamps))) (define* (clojure-build #:key inputs diff --git a/guix/download.scm b/guix/download.scm index 1a80e3abd2..d459ba8cf1 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -269,49 +269,55 @@ (kde "https://download.kde.org/" "https://download.kde.org/Attic/" ; for when it gets archived. - ;; Mirrors from http://files.kde.org/extra/mirrors.html + ;; I could not find the classic static mirror list anymore. Instead, + ;; add ‘.mirrorlist’ to the end of a recent download.kde.org tarball URL. ;; Europe - "http://mirror.easyname.at/kde" - "http://mirror.karneval.cz/pub/kde" - "http://ftp.fi.muni.cz/pub/kde/" - "http://mirror.oss.maxcdn.com/kde/" - "http://ftp5.gwdg.de/pub/linux/kde/" - "http://ftp-stud.fht-esslingen.de/Mirrors/ftp.kde.org/pub/kde/" - "http://mirror.klaus-uwe.me/kde/ftp/" - "http://kde.beta.mirror.ga/" - "http://kde.alpha.mirror.ga/" - "http://mirror.netcologne.de/kde" - "http://vesta.informatik.rwth-aachen.de/ftp/pub/mirror/kde/" - "http://ftp.rz.uni-wuerzburg.de/pub/unix/kde/" - "http://mirrors.dotsrc.org/kde/" - "http://ftp.funet.fi/pub/mirrors/ftp.kde.org/pub/kde/" - "http://kde-mirror.freenux.org/" - "http://mirrors.ircam.fr/pub/KDE/" - "http://www-ftp.lip6.fr/pub/X11/kde/" - "http://fr2.rpmfind.net/linux/KDE/" + "https://mirrors.xtom.de/kde/" + "https://mirror.lyrahosting.com/pub/kde/" + "https://mirrors.xtom.nl/kde/" + "https://mirror.hs-esslingen.de/Mirrors/ftp.kde.org/pub/kde/" + "https://mirror.kumi.systems/kde/ftp/" + "https://mirrors.ircam.fr/pub/KDE/" + "https://ftp.gwdg.de/pub/linux/kde/" + "https://mirrors.gethosted.online/kde/pub/kde/" + "https://fr2.rpmfind.net/linux/KDE/" + "https://mirror.faigner.de/kde/ftp/" + "https://www.mirrorservice.org/sites/download.kde.org/" + "https://mirrors.ukfast.co.uk/sites/kde.org/ftp/" + "https://mirrors.dotsrc.org/kde/" "http://kde.mirror.anlx.net/" - "http://www.mirrorservice.org/sites/ftp.kde.org/pub/kde/" - "http://ftp.heanet.ie/mirrors/ftp.kde.org/" - "http://ftp.nluug.nl/pub/windowing/kde/" - "http://ftp.surfnet.nl/windowing/kde/" - "http://ftp.icm.edu.pl/pub/unix/kde/" - "http://ftp.pbone.net/pub/kde/" - "http://piotrkosoft.net/pub/mirrors/ftp.kde.org/" - "http://mirrors.fe.up.pt/pub/kde/" - "http://ftp.iasi.roedu.net/pub/mirrors/ftp.kde.org/" - "http://ftp.acc.umu.se/mirror/kde.org/ftp/" - "http://kde.ip-connect.vn.ua/" + "https://mirror.karneval.cz/pub/kde/" + "https://ftp.fi.muni.cz/pub/kde/" + "https://www-ftp.lip6.fr/pub/X11/kde/" + "https://ftp.icm.edu.pl/pub/unix/kde/" + "https://kde.mirror.garr.it/kde/ftp/" + "https://ftp.acc.umu.se/mirror/kde.org/ftp/" + "https://mirrors.up.pt/pub/kde/" + "https://mirrors.nav.ro/kde/" + "https://mirrors.xtom.ee/kde/" + "https://ftp.funet.fi/pub/mirrors/ftp.kde.org/pub/kde/" + "https://kde.ip-connect.vn.ua/" + "https://mirrors.netix.net/kde/" + "https://ftp.cc.uoc.gr/mirrors/kde/" ;; North America - "http://mirror.its.dal.ca/kde/" - "http://mirror.csclub.uwaterloo.ca/kde/" - "http://mirror.cc.columbia.edu/pub/software/kde/" - "http://kde.mirrors.hoobly.com/" - "http://ftp.ussg.iu.edu/kde/" - "http://mirrors.mit.edu/kde/" - "http://kde.mirrors.tds.net/pub/kde/" + "https://mirror.its.dal.ca/kde/" + "https://nnenix.mm.fcix.net/kdeftp/" + "https://mirrors.mit.edu/kde/" + "https://mirror.csclub.uwaterloo.ca/kde/" + "https://mirror.fcix.net/kdeftp/" + "https://mirrors.ocf.berkeley.edu/kde/" + "https://mirrors.xtom.com/kde/" + ;; South America + "https://kde.c3sl.ufpr.br/" + ;; Asia + "https://mirrors.bfsu.edu.cn/kde/" + "https://ftp-srv2.kddi-research.jp/pub/X11/kde/" + "https://mirrors.xtom.jp/kde/" + "https://mirrors.xtom.hk/kde/" + ;; Africa + "http://mirror.retentionrange.co.bw/kde/" ;; Oceania - "http://ftp.kddlabs.co.jp/pub/X11/kde/" - "http://kde.mirror.uber.com.au/") + "https://mirrors.xtom.au/kde/") (openbsd "https://ftp.openbsd.org/pub/OpenBSD/" ;; Anycast CDN redirecting to your friendly local mirror. diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index 27478eabc0..2c76645173 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -76,6 +76,9 @@ Perform the deployment specified by FILE.\n")) (lambda args (show-version-and-exit "guix deploy"))) + (option '(#\n "dry-run") #f #f + (lambda (opt name arg result) + (alist-cons 'dry-run? #t result))) (option '(#\x "execute") #f #f (lambda (opt name arg result) (alist-cons 'execute-command? #t result))) @@ -110,14 +113,20 @@ Perform the deployment specified by FILE.\n")) environment-modules)))) (load* file module))) -(define (show-what-to-deploy machines) +(define* (show-what-to-deploy machines #:key (dry-run? #f)) "Show the list of machines to deploy, MACHINES." (let ((count (length machines))) - (format (current-error-port) - (N_ "The following ~d machine will be deployed:~%" - "The following ~d machines will be deployed:~%" + (if dry-run? + (format (current-error-port) + (N_ "The following ~d machine would be deployed:~%" + "The following ~d machines would be deployed:~%" + count) count) - count) + (format (current-error-port) + (N_ "The following ~d machine will be deployed:~%" + "The following ~d machines will be deployed:~%" + count) + count)) (display (indented-string (fill-paragraph (string-join (map machine-display-name machines) ", ") @@ -241,6 +250,7 @@ otherwise." #:argument-handler handle-argument)) (file (assq-ref opts 'file)) (machines (and file (load-source-file file))) + (dry-run? (assoc-ref opts 'dry-run?)) (execute-command? (assoc-ref opts 'execute-command?))) (unless file (leave (G_ "missing deployment file argument~%"))) @@ -254,7 +264,8 @@ otherwise." (with-build-handler (build-notifier #:use-substitutes? (assoc-ref opts 'substitutes?) #:verbosity - (assoc-ref opts 'verbosity)) + (assoc-ref opts 'verbosity) + #:dry-run? dry-run?) (parameterize ((%graft? (assq-ref opts 'graft?))) (if execute-command? (match command @@ -270,7 +281,8 @@ otherwise." (_ (leave (G_ "'-x' specified but no command given~%")))) (begin - (show-what-to-deploy machines) - (map/accumulate-builds store - (cut deploy-machine* store <>) - machines)))))))))) + (show-what-to-deploy machines #:dry-run? dry-run?) + (unless dry-run? + (map/accumulate-builds store + (cut deploy-machine* store <>) + machines))))))))))) |