01/08: gnu: ant-build-system: Don't override symlinks.

[guix-commits]

hoebjo pushed a commit to branch staging
in repository guix.

commit d967fbc13aaf47c8d7edc4102e45f2eaf8902ed8
Author: Björn Höfling <address@hidden>
Date:   Wed Mar 6 08:05:06 2019 +0100

    gnu: ant-build-system: Don't override symlinks.
    
    When repacking jar-files, don't work on symlinks: Otherwise, they would be
    overridden with the repacked jar-file.
    
    * guix/build/ant-build-system.scm (regular-jar-file-predicate): New 
procedure.
    (generate-jar-indices, strip-jar-timestamps): Use it.
---
 guix/build/ant-build-system.scm | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/guix/build/ant-build-system.scm b/guix/build/ant-build-system.scm
index 49549c1..fae1b47 100644
--- a/guix/build/ant-build-system.scm
+++ b/guix/build/ant-build-system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2018 Ricardo Wurmus <address@hidden>
+;;; Copyright © 2019 Björn Höfling <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -171,6 +172,12 @@ to the default GNU unpack strategy."
                 #:allow-other-keys)
   (apply invoke `("ant" ,build-target ,@make-flags)))
 
+(define (regular-jar-file-predicate file stat)
+  "Predicate returning true if FILE is ending on '.jar'
+and STAT indicates it is a regular file."
+    (and ((file-name-predicate "\\.jar$") file stat)
+         (eq? 'regular (stat:type stat))))
+
 (define* (generate-jar-indices #:key outputs #:allow-other-keys)
   "Generate file \"META-INF/INDEX.LIST\".  This file does not use word wraps
 and is preferred over \"META-INF/MANIFEST.MF\", which does use word wraps,
@@ -181,7 +188,10 @@ dependencies of this jar file."
     (invoke "jar" "-i" jar))
   (for-each (match-lambda
               ((output . directory)
-               (for-each generate-index (find-files directory "\\.jar$"))))
+               (for-each generate-index
+                         (find-files
+                          directory
+                          regular-jar-file-predicate))))
             outputs)
   #t)
 
@@ -222,7 +232,8 @@ repack them.  This is necessary to ensure that archives are 
reproducible."
 
   (for-each (match-lambda
               ((output . directory)
-               (for-each repack-archive (find-files directory "\\.jar$"))))
+               (for-each repack-archive
+                         (find-files directory regular-jar-file-predicate))))
             outputs)
   #t)