From ff43e353a1920a47a763024cd0682f2dc805964b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 1 Sep 2016 23:48:08 +0200 Subject: build-system/gnu: 'strip' phase lists files in sorted order. This fixes a bug whereby the choice between stripping 'libfoo.so.0.1.2' and stripping 'libfoo.so' (the symlink) would be non-deterministic. * guix/build/gnu-build-system.scm (strip)[strip-dir]: Use 'find-files' instead of 'file-system-fold' so that files are picked in deterministic order. --- guix/build/gnu-build-system.scm | 31 +++++++++++-------------------- 1 file changed, 11 insertions(+), 20 deletions(-) (limited to 'guix/build/gnu-build-system.scm') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 34edff7f40..ab97c92a2b 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -386,26 +386,17 @@ makefiles." (when debug-output (format #t "debugging output written to ~s using ~s~%" debug-output objcopy-command)) - (file-system-fold (const #t) - (lambda (path stat result) ; leaf - (and (file-exists? path) ;discard dangling symlinks - (or (elf-file? path) (ar-file? path)) - (or (not debug-output) - (make-debug-file path)) - (zero? (apply system* strip-command - (append strip-flags (list path)))) - (or (not debug-output) - (add-debug-link path)))) - (const #t) ; down - (const #t) ; up - (const #t) ; skip - (lambda (path stat errno result) - (format (current-error-port) - "strip: failed to access `~a': ~a~%" - path (strerror errno)) - #f) - #t - dir)) + + (for-each (lambda (file) + (and (file-exists? file) ;discard dangling symlinks + (or (elf-file? file) (ar-file? file)) + (or (not debug-output) + (make-debug-file file)) + (zero? (apply system* strip-command + (append strip-flags (list file)))) + (or (not debug-output) + (add-debug-link file)))) + (find-files dir))) (or (not strip-binaries?) (every strip-dir -- cgit v1.2.3 From 5c9632c75afd57f2ee2d9ee7467ba9abcd2cb292 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 12 Sep 2016 21:51:25 +0200 Subject: build-system/gnu: Do not patch symlinks in the source. This is a followup to 13a9feb5b64fd819eaed38a17da0284bbe2b8d9. * guix/build/gnu-build-system.scm (patch-source-shebangs): Remove call to 'remove'. Pass a second argument to 'find-files' to filter out symlinks; pass #:stat lstat. (patch-generated-file-shebangs): Likewise, and also filter out non-executable files. --- guix/build/gnu-build-system.scm | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) (limited to 'guix/build/gnu-build-system.scm') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index ab97c92a2b..93ddc9abc8 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -172,22 +172,23 @@ files such as `.in' templates. Most scripts honor $SHELL and $CONFIG_SHELL, but some don't, such as `mkinstalldirs' or Automake's `missing' script." (for-each patch-shebang - (remove (lambda (file) - (or (not (file-exists? file)) ;dangling symlink - (file-is-directory? file))) - (find-files ".")))) + (find-files "." + (lambda (file stat) + ;; Filter out symlinks. + (eq? 'regular (stat:type stat))) + #:stat lstat))) (define (patch-generated-file-shebangs . rest) "Patch shebangs in generated files, including `SHELL' variables in makefiles." - ;; Patch executable files, some of which might have been generated by - ;; `configure'. + ;; Patch executable regular files, some of which might have been generated + ;; by `configure'. (for-each patch-shebang - (filter (lambda (file) - (and (file-exists? file) - (executable-file? file) - (not (file-is-directory? file)))) - (find-files "."))) + (find-files "." + (lambda (file stat) + (and (eq? 'regular (stat:type stat)) + (not (zero? (logand (stat:mode stat) #o100))))) + #:stat lstat)) ;; Patch `SHELL' in generated makefiles. (for-each patch-makefile-SHELL (find-files "." "^(GNU)?[mM]akefile$"))) -- cgit v1.2.3 From d31860b9de07810e114490db5cc160a8b078c58d Mon Sep 17 00:00:00 2001 From: John Darrington Date: Sun, 25 Sep 2016 07:43:21 +0200 Subject: build-system/gnu: Add 'patch-dot-desktop-files' phase. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/gnu-build-system.scm (patch-dot-desktop-files): New procedure. (%standard-phases): Add it. Co-authored-by: Ludovic Courtès --- guix/build/gnu-build-system.scm | 42 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) (limited to 'guix/build/gnu-build-system.scm') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 93ddc9abc8..1dfd85450c 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -544,6 +544,47 @@ DOCUMENTATION-COMPRESSOR-FLAGS." outputs) #t) + +(define* (patch-dot-desktop-files #:key outputs inputs #:allow-other-keys) + "Replace any references to executables in '.desktop' files with their +absolute file names." + (define bin-directories + (append-map (match-lambda + ((_ . directory) + (list (string-append directory "/bin") + (string-append directory "/sbin")))) + outputs)) + + (define (which program) + (or (search-path bin-directories program) + (begin + (format (current-error-port) + "warning: '.desktop' file refers to '~a', \ +which cannot be found~%" + program) + program))) + + (for-each (match-lambda + ((_ . directory) + (let ((applications (string-append directory + "/share/applications"))) + (when (directory-exists? applications) + (let ((files (find-files applications "\\.desktop$"))) + (format #t "adjusting ~a '.desktop' files in ~s~%" + (length files) applications) + + ;; '.desktop' files contain translations and are always + ;; UTF-8-encoded. + (with-fluids ((%default-port-encoding "UTF-8")) + (substitute* files + (("^Exec=([^/[:blank:]\r\n]*)(.*)$" _ binary rest) + (string-append "Exec=" (which binary) rest)) + (("^TryExec=([^/[:blank:]\r\n]*)(.*)$" _ binary rest) + (string-append "TryExec=" + (which binary) rest))))))))) + outputs) + #t) + (define %standard-phases ;; Standard build phases, as a list of symbol/procedure pairs. (let-syntax ((phases (syntax-rules () @@ -556,6 +597,7 @@ DOCUMENTATION-COMPRESSOR-FLAGS." validate-runpath validate-documentation-location delete-info-dir-file + patch-dot-desktop-files compress-documentation))) -- cgit v1.2.3