guix/build/ant-build-system.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016, 2018 Ricardo Wurmus <rekado@elephly.net>
   3 ;;; Copyright © 2019 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (guix build ant-build-system)
  21   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
  22   #:use-module (guix build syscalls)
  23   #:use-module (guix build utils)
  24   #:use-module (sxml simple)
  25   #:use-module (ice-9 match)
  26   #:use-module (ice-9 ftw)
  27   #:use-module (srfi srfi-1)
  28   #:use-module (srfi srfi-26)
  29   #:export (%standard-phases
  30             ant-build))
  31
  32 ;; Commentary:
  33 ;;
  34 ;; Builder-side code of the standard build procedure for Java packages using
  35 ;; Ant.
  36 ;;
  37 ;; Code:
  38
  39 (define* (default-build.xml jar-name prefix #:optional
  40                             (source-dir ".") (test-dir "./test") (main-class #f)
  41                             (test-include '("**/*Test.java"))
  42                             (test-exclude '("**/Abstract*Test.java")))
  43   "Create a simple build.xml with standard targets for Ant."
  44   (call-with-output-file "build.xml"
  45     (lambda (port)
  46       (sxml->xml
  47        `(project (@ (basedir ".")
  48                     (name ,jar-name))
  49                  (property (@ (name "classes.dir")
  50                               (value "${basedir}/build/classes")))
  51                  (property (@ (name "manifest.dir")
  52                               (value "${basedir}/build/manifest")))
  53                  (property (@ (name "manifest.file")
  54                               (value "${manifest.dir}/MANIFEST.MF")))
  55                  (property (@ (name "jar.dir")
  56                               (value "${basedir}/build/jar")))
  57                  (property (@ (name "dist.dir")
  58                               (value ,prefix)))
  59                  (property (@ (name "test.home")
  60                               (value ,test-dir)))
  61                  (property (@ (name "test.classes.dir")
  62                               (value "${basedir}/build/test-classes")))
  63
  64                  ;; respect the CLASSPATH environment variable
  65                  (property (@ (name "build.sysclasspath")
  66                               (value "first")))
  67                  (property (@ (environment "env")))
  68                  (path (@ (id "classpath"))
  69                        (pathelement (@ (location "${env.CLASSPATH}"))))
  70
  71                  (target (@ (name "manifest"))
  72                          (mkdir (@ (dir "${manifest.dir}")))
  73                          (manifest (@ (file "${manifest.file}"))
  74                                    ,(if main-class
  75                                        `(attribute (@ (name "Main-Class")
  76                                                       (value ,main-class)))
  77                                        "")))
  78
  79                  (target (@ (name "compile"))
  80                          (mkdir (@ (dir "${classes.dir}")))
  81                          (javac (@ (includeantruntime "false")
  82                                    (srcdir ,source-dir)
  83                                    (destdir "${classes.dir}")
  84                                    (classpath (@ (refid "classpath"))))))
  85
  86                  (target (@ (name "compile-tests"))
  87                          (mkdir (@ (dir "${test.classes.dir}")))
  88                          (javac (@ (includeantruntime "false")
  89                                    (srcdir ,test-dir)
  90                                    (destdir "${test.classes.dir}"))
  91                                 (classpath
  92                                  (pathelement (@ (path "${env.CLASSPATH}")))
  93                                  (pathelement (@ (location "${classes.dir}")))
  94                                  (pathelement (@ (location "${test.classes.dir}"))))))
  95
  96                  (target (@ (name "check")
  97                             (depends "compile-tests"))
  98                          (mkdir (@ (dir "${test.home}/test-reports")))
  99                          (junit (@ (printsummary "true")
 100                                    (showoutput "true")
 101                                    (fork "yes")
 102                                    (haltonfailure "yes"))
 103                                 (classpath
 104                                  (pathelement (@ (path "${env.CLASSPATH}")))
 105                                  (pathelement (@ (location "${test.home}/resources")))
 106                                  (pathelement (@ (location "${classes.dir}")))
 107                                  (pathelement (@ (location "${test.classes.dir}"))))
 108                                 (formatter (@ (type "plain")
 109                                               (usefile "true")))
 110                                 (batchtest (@ (fork "yes")
 111                                               (todir "${test.home}/test-reports"))
 112                                            (fileset (@ (dir "${test.home}/java"))
 113                                                     ,@(map (lambda (file)
 114                                                             `(include (@ (name ,file))))
 115                                                        test-include)
 116                                                     ,@(map (lambda (file)
 117                                                             `(exclude (@ (name ,file))))
 118                                                        test-exclude)))))
 119
 120                  (target (@ (name "jar")
 121                             (depends "compile, manifest"))
 122                          (mkdir (@ (dir "${jar.dir}")))
 123                          (jar (@ (destfile ,(string-append "${jar.dir}/" jar-name))
 124                                  (manifest "${manifest.file}")
 125                                  (basedir "${classes.dir}"))))
 126
 127                  (target (@ (name "install"))
 128                          (copy (@ (todir "${dist.dir}"))
 129                                (fileset (@ (dir "${jar.dir}"))
 130                                         (include (@ (name "**/*.jar")))))))
 131        port)))
 132   (utime "build.xml" 0 0)
 133   #t)
 134
 135 (define (generate-classpath inputs)
 136   "Return a colon-separated string of full paths to jar files found among the
 137 INPUTS."
 138   (string-join
 139    (apply append (map (match-lambda
 140                         ((_ . dir)
 141                          (find-files dir "\\.jar$")))
 142                       inputs)) ":"))
 143
 144 (define* (unpack #:key source #:allow-other-keys)
 145   "Unpack the jar archive SOURCE.  When SOURCE is not a jar archive fall back
 146 to the default GNU unpack strategy."
 147   (if (string-suffix? ".jar" source)
 148       (begin
 149         (mkdir "src")
 150         (with-directory-excursion "src"
 151           (invoke "jar" "-xf" source))
 152         #t)
 153       ;; Use GNU unpack strategy for things that aren't jar archives.
 154       ((assq-ref gnu:%standard-phases 'unpack) #:source source)))
 155
 156 (define* (configure #:key inputs outputs (jar-name #f)
 157                     (source-dir "src")
 158                     (test-dir "src/test")
 159                     (main-class #f)
 160                     (test-include '("**/*Test.java"))
 161                     (test-exclude '("**/Abstract*.java")) #:allow-other-keys)
 162   (when jar-name
 163     (default-build.xml jar-name
 164                        (string-append (assoc-ref outputs "out")
 165                                       "/share/java")
 166                        source-dir test-dir main-class test-include test-exclude))
 167   (setenv "JAVA_HOME" (assoc-ref inputs "jdk"))
 168   (setenv "CLASSPATH" (generate-classpath inputs))
 169   #t)
 170
 171 (define* (build #:key (make-flags '()) (build-target "jar")
 172                 #:allow-other-keys)
 173   (apply invoke `("ant" ,build-target ,@make-flags)))
 174
 175 (define (regular-jar-file-predicate file stat)
 176   "Predicate returning true if FILE is ending on '.jar'
 177 and STAT indicates it is a regular file."
 178     (and ((file-name-predicate "\\.jar$") file stat)
 179          (eq? 'regular (stat:type stat))))
 180
 181 (define* (generate-jar-indices #:key outputs #:allow-other-keys)
 182   "Generate file \"META-INF/INDEX.LIST\".  This file does not use word wraps
 183 and is preferred over \"META-INF/MANIFEST.MF\", which does use word wraps,
 184 by Java when resolving dependencies.  So we make sure to create it so that
 185 grafting works - and so that the garbage collector doesn't collect
 186 dependencies of this jar file."
 187   (define (generate-index jar)
 188     (invoke "jar" "-i" jar))
 189   (for-each (match-lambda
 190               ((output . directory)
 191                (for-each generate-index
 192                          (find-files
 193                           directory
 194                           regular-jar-file-predicate))))
 195             outputs)
 196   #t)
 197
 198 (define* (strip-jar-timestamps #:key outputs
 199                                #:allow-other-keys)
 200   "Unpack all jar archives, reset the timestamp of all contained files, and
 201 repack them.  This is necessary to ensure that archives are reproducible."
 202   (define (repack-archive jar)
 203     (format #t "repacking ~a\n" jar)
 204     (let* ((dir (mkdtemp! "jar-contents.XXXXXX"))
 205            (manifest (string-append dir "/META-INF/MANIFEST.MF")))
 206       (with-directory-excursion dir
 207         (invoke "jar" "xf" jar))
 208       (delete-file jar)
 209       ;; XXX: copied from (gnu build install)
 210       (for-each (lambda (file)
 211                   (let ((s (lstat file)))
 212                     (unless (eq? (stat:type s) 'symlink)
 213                       (utime file 0 0 0 0))))
 214                 (find-files dir #:directories? #t))
 215
 216       ;; The jar tool will always set the timestamp on the manifest file
 217       ;; and the containing directory to the current time, even when we
 218       ;; reuse an existing manifest file.  To avoid this we use "zip"
 219       ;; instead of "jar".  It is important that the manifest appears
 220       ;; first.
 221       (with-directory-excursion dir
 222         (let* ((files (find-files "." ".*" #:directories? #t))
 223                ;; To ensure that the reference scanner can detect all
 224                ;; store references in the jars we disable compression
 225                ;; with the "-0" option.
 226                (command (if (file-exists? manifest)
 227                             `("zip" "-0" "-X" ,jar ,manifest ,@files)
 228                             `("zip" "-0" "-X" ,jar ,@files))))
 229           (apply invoke command)))
 230       (utime jar 0 0)
 231       #t))
 232
 233   (for-each (match-lambda
 234               ((output . directory)
 235                (for-each repack-archive
 236                          (find-files directory regular-jar-file-predicate))))
 237             outputs)
 238   #t)
 239
 240 (define* (check #:key target (make-flags '()) (tests? (not target))
 241                 (test-target "check")
 242                 #:allow-other-keys)
 243   (if tests?
 244       (apply invoke `("ant" ,test-target ,@make-flags))
 245       (format #t "test suite not run~%"))
 246   #t)
 247
 248 (define* (install #:key (make-flags '()) #:allow-other-keys)
 249   (apply invoke `("ant" "install" ,@make-flags)))
 250
 251 (define %standard-phases
 252   (modify-phases gnu:%standard-phases
 253     (replace 'unpack unpack)
 254     (delete 'bootstrap)
 255     (replace 'configure configure)
 256     (replace 'build build)
 257     (replace 'check check)
 258     (replace 'install install)
 259     (add-after 'install 'reorder-jar-content
 260                strip-jar-timestamps)
 261     (add-after 'reorder-jar-content 'generate-jar-indices generate-jar-indices)
 262     (add-after 'generate-jar-indices 'strip-jar-timestamps
 263                strip-jar-timestamps)))
 264
 265 (define* (ant-build #:key inputs (phases %standard-phases)
 266                     #:allow-other-keys #:rest args)
 267   "Build the given Java package, applying all of PHASES in order."
 268   (apply gnu:gnu-build #:inputs inputs #:phases phases args))
 269
 270 ;;; ant-build-system.scm ends here