[bug#29161] [PATCH core-updates] build-system/gnu: Add 'install-license-files' phase.

[Ludovic Courtès]

Hello Guix,

This patch adds an ‘install-license-files’ phase to ‘gnu-build-system’
and to all the build systems that inherit from it.  It is a followup to
the discussion with Dave Love:

  https://lists.gnu.org/archive/html/guix-devel/2017-09/msg00097.html

It’s an improvement over what we have now, although it’s rudimentary: it
copies to share/doc/PACKAGE-VERSION any file from the top-level source
directory that matches a regexp.

Thoughts?

Ideally we could apply it in this ‘core-updates’ cycle if that’s fine
with you.

Thanks in advance,
Ludo’.

>From bcdfb1a89b82c9c10e80f1a5d6aadc0620e81156 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Sun, 5 Nov 2017 21:32:02 +0100
Subject: [PATCH] build-system/gnu: Add 'install-license-files' phase.

Suggested by Dave Love <address@hidden>.

* guix/build-system/gnu.scm (%license-file-regexp): New variable.
(gnu-build): Add #:license-file-regexp and use it.
(gnu-cross-build): Likewise.
* guix/build/gnu-build-system.scm (%license-file-regexp): New variable.
(install-license-files): New procedure.
(%standard-phases): Add it.
---
 guix/build-system/gnu.scm       |  8 ++++++++
 guix/build/gnu-build-system.scm | 25 +++++++++++++++++++++++++
 2 files changed, 33 insertions(+)

diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index 047ace7e6..f54afe167 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -273,6 +273,10 @@ standard packages used as implicit inputs of the GNU build 
system."
     (build (if target gnu-cross-build gnu-build))
     (arguments (strip-keyword-arguments private-keywords arguments))))
 
+(define %license-file-regexp
+  ;; Regexp matching license files.
+  "^(COPYING.*|LICEN[CS]E.*|[Ll]icen[cs]e.*|Copy[Rr]ight(\\.(txt|md))?)$")
+
 (define* (gnu-build store name input-drvs
                     #:key (guile #f)
                     (outputs '("out"))
@@ -291,6 +295,7 @@ standard packages used as implicit inputs of the GNU build 
system."
                     (strip-directories ''("lib" "lib64" "libexec"
                                           "bin" "sbin"))
                     (validate-runpath? #t)
+                    (license-file-regexp %license-file-regexp)
                     (phases '%standard-phases)
                     (locale "en_US.utf8")
                     (system (%current-system))
@@ -358,6 +363,7 @@ packages that must not be referenced."
                   #:patch-shebangs? ,patch-shebangs?
                   #:strip-binaries? ,strip-binaries?
                   #:validate-runpath? ,validate-runpath?
+                  #:license-file-regexp ,license-file-regexp
                   #:strip-flags ,strip-flags
                   #:strip-directories ,strip-directories)))
 
@@ -432,6 +438,7 @@ is one of `host' or `target'."
                           (strip-directories ''("lib" "lib64" "libexec"
                                                 "bin" "sbin"))
                           (validate-runpath? #t)
+                          (license-file-regexp %license-file-regexp)
                           (phases '%standard-phases)
                           (locale "en_US.utf8")
                           (system (%current-system))
@@ -509,6 +516,7 @@ platform."
                     #:patch-shebangs? ,patch-shebangs?
                     #:strip-binaries? ,strip-binaries?
                     #:validate-runpath? ,validate-runpath?
+                    #:license-file-regexp ,license-file-regexp
                     #:strip-flags ,strip-flags
                     #:strip-directories ,strip-directories))))
 
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index e37b75140..eb247ae0c 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -29,6 +29,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (rnrs io ports)
   #:export (%standard-phases
+            %license-file-regexp
             gnu-build))
 
 ;; Commentary:
@@ -641,6 +642,29 @@ which cannot be found~%"
             outputs)
   #t)
 
+(define %license-file-regexp
+  ;; Regexp matching license files.
+  "^(COPYING.*|LICEN[CS]E.*|[Ll]icen[cs]e.*|Copy[Rr]ight(\\.(txt|md))?)$")
+
+(define* (install-license-files #:key outputs
+                                (license-file-regexp %license-file-regexp)
+                                #:allow-other-keys)
+  "Install license files matching LICENSE-FILE-REGEXP to 'share/doc'."
+  (let* ((regexp    (make-regexp license-file-regexp))
+         (out       (or (assoc-ref outputs "out")
+                        (car (first outputs))))
+         (package   (strip-store-file-name out))
+         (directory (string-append out "/share/doc/" package))
+         (files     (scandir "." (lambda (file)
+                                   (regexp-exec regexp file)))))
+    (format #t "installing ~a license files~%" (length files))
+    (for-each (lambda (file)
+                (if (file-is-directory? file)
+                    (copy-recursively file directory)
+                    (install-file file directory)))
+              files)
+    #t))
+
 (define %standard-phases
   ;; Standard build phases, as a list of symbol/procedure pairs.
   (let-syntax ((phases (syntax-rules ()
@@ -654,6 +678,7 @@ which cannot be found~%"
             validate-documentation-location
             delete-info-dir-file
             patch-dot-desktop-files
+            install-license-files
             reset-gzip-timestamps
             compress-documentation)))
 
-- 
2.14.2