guix/build/ant-build-system.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix build ant-build-system)
  20   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
  21   #:use-module (guix build syscalls)
  22   #:use-module (guix build utils)
  23   #:use-module (sxml simple)
  24   #:use-module (ice-9 match)
  25   #:use-module (ice-9 ftw)
  26   #:use-module (srfi srfi-1)
  27   #:use-module (srfi srfi-26)
  28   #:export (%standard-phases
  29             ant-build))
  30
  31 ;; Commentary:
  32 ;;
  33 ;; Builder-side code of the standard build procedure for Java packages using
  34 ;; Ant.
  35 ;;
  36 ;; Code:
  37
  38 (define (default-build.xml jar-name prefix)
  39   "Create a simple build.xml with standard targets for Ant."
  40   (call-with-output-file "build.xml"
  41     (lambda (port)
  42       (sxml->xml
  43        `(project (@ (basedir "."))
  44                  (property (@ (name "classes.dir")
  45                               (value "${basedir}/build/classes")))
  46                  (property (@ (name "jar.dir")
  47                               (value "${basedir}/build/jar")))
  48                  (property (@ (name "dist.dir")
  49                               (value ,prefix)))
  50
  51                  ;; respect the CLASSPATH environment variable
  52                  (property (@ (name "build.sysclasspath")
  53                               (value "first")))
  54                  (property (@ (environment "env")))
  55                  (path (@ (id "classpath"))
  56                        (pathelement (@ (location "${env.CLASSPATH}"))))
  57
  58                  (target (@ (name "compile"))
  59                          (mkdir (@ (dir "${classes.dir}")))
  60                          (javac (@ (includeantruntime "false")
  61                                    (srcdir "src")
  62                                    (destdir "${classes.dir}")
  63                                    (classpath (@ (refid "classpath"))))))
  64
  65                  (target (@ (name "jar")
  66                             (depends "compile"))
  67                          (mkdir (@ (dir "${jar.dir}")))
  68                          ;; We cannot use the simpler "jar" task here, because
  69                          ;; there is no way to disable generation of a
  70                          ;; manifest.  We do not include a generated manifest
  71                          ;; to ensure determinism, because we cannot easily
  72                          ;; reset the ctime/mtime before creating the archive.
  73                          (exec (@ (executable "jar"))
  74                                (arg (@ (line ,(string-append "-Mcf ${jar.dir}/" jar-name
  75                                                              " -C ${classes.dir} ."))))))
  76
  77                  (target (@ (name "install"))
  78                          (copy (@ (todir "${dist.dir}"))
  79                                (fileset (@ (dir "${jar.dir}"))
  80                                         (include (@ (name "**/*.jar")))))))
  81        port)))
  82   (utime "build.xml" 0 0)
  83   #t)
  84
  85 (define (generate-classpath inputs)
  86   "Return a colon-separated string of full paths to jar files found among the
  87 INPUTS."
  88   (string-join
  89    (apply append (map (match-lambda
  90                         ((_ . dir)
  91                          (find-files dir "\\.*jar$")))
  92                       inputs)) ":"))
  93
  94 (define* (configure #:key inputs outputs (jar-name #f)
  95                     #:allow-other-keys)
  96   (when jar-name
  97     (default-build.xml jar-name
  98                        (string-append (assoc-ref outputs "out")
  99                                       "/share/java")))
 100   (setenv "JAVA_HOME" (assoc-ref inputs "jdk"))
 101   (setenv "CLASSPATH" (generate-classpath inputs)))
 102
 103 (define* (build #:key (make-flags '()) (build-target "jar")
 104                 #:allow-other-keys)
 105   (zero? (apply system* `("ant" ,build-target ,@make-flags))))
 106
 107 (define* (strip-jar-timestamps #:key outputs
 108                  #:allow-other-keys)
 109   "Unpack all jar archives, reset the timestamp of all contained files, and
 110 repack them.  This is necessary to ensure that archives are reproducible."
 111   (define (repack-archive jar)
 112     (format #t "repacking ~a\n" jar)
 113     (let ((dir (mkdtemp! "jar-contents.XXXXXX")))
 114       (and (with-directory-excursion dir
 115              (zero? (system* "jar" "xf" jar)))
 116            ;; The manifest file contains timestamps
 117            (for-each delete-file (find-files dir "MANIFEST.MF"))
 118            (delete-file jar)
 119            ;; XXX: copied from (gnu build install)
 120            (for-each (lambda (file)
 121                        (let ((s (lstat file)))
 122                          (unless (eq? (stat:type s) 'symlink)
 123                            (utime file 0 0 0 0))))
 124                      (find-files dir #:directories? #t))
 125            (unless (zero? (system* "jar" "-Mcf" jar "-C" dir "."))
 126              (error "'jar' failed"))
 127            (utime jar 0 0)
 128            #t)))
 129
 130   (every (match-lambda
 131            ((output . directory)
 132             (every repack-archive (find-files directory "\\.jar$"))))
 133          outputs))
 134
 135 (define* (check #:key target (make-flags '()) (tests? (not target))
 136                 (test-target "check")
 137                 #:allow-other-keys)
 138   (if tests?
 139       (zero? (apply system* `("ant" ,test-target ,@make-flags)))
 140       (begin
 141         (format #t "test suite not run~%")
 142         #t)))
 143
 144 (define* (install #:key (make-flags '()) #:allow-other-keys)
 145   (zero? (apply system* `("ant" "install" ,@make-flags))))
 146
 147 (define %standard-phases
 148   (modify-phases gnu:%standard-phases
 149     (replace 'configure configure)
 150     (replace 'build build)
 151     (replace 'check check)
 152     (replace 'install install)
 153     (add-after 'install 'strip-jar-timestamps strip-jar-timestamps)))
 154
 155 (define* (ant-build #:key inputs (phases %standard-phases)
 156                     #:allow-other-keys #:rest args)
 157   "Build the given Java package, applying all of PHASES in order."
 158   (apply gnu:gnu-build #:inputs inputs #:phases phases args))
 159
 160 ;;; ant-build-system.scm ends here