[PATCH] gnu: lint: Check package outputs.

[ericbavier]

From: Eric Bavier <address@hidden>

* guix/scripts/lint.scm (check-output): New procedure.
(%checkers): Add it.
---
 guix/scripts/lint.scm | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 53 insertions(+)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index b4fdb6f..64d4d76 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -29,6 +29,7 @@
   #:use-module (guix packages)
   #:use-module (guix licenses)
   #:use-module (guix records)
+  #:use-module (guix derivations)
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix combinators)
@@ -45,6 +46,7 @@
                 #:select (maybe-expand-mirrors
                           open-connection-for-uri
                           close-connection))
+  #:use-module (guix build utils)
   #:use-module (web request)
   #:use-module (web response)
   #:use-module (srfi srfi-1)
@@ -581,6 +583,53 @@ descriptions maintained upstream."
                     (format #f (_ "failed to create derivation: ~s~%")
                             args)))))
 
+(define (check-output package)
+  "Emit warnings about common issues with a package's output.  This check is
+potentially very expensive; it may require a package to be built if the
+output is not already in the store."
+  (define check-build-dir
+    ;; Check for references to a temp build directory
+    (let ((build-dir-rx
+           (make-regexp "guix-build-[[:graphic:]]*\\.drv-[[:digit:]]+")))
+      (lambda (out)
+        (for-each
+         (lambda (file)
+           (call-with-input-file file
+             (lambda (port)
+               (let loop ((line-number 0))
+                 (let ((line (read-line port)))
+                   (unless (eof-object? line)
+                     (match (regexp-exec build-dir-rx
+                                         ;; (ice-9 regex) cannot handle
+                                         ;; strings with #\nul characters, so
+                                         ;; replace with something else.
+                                         (string-map
+                                          (λ (x) (if (eq? x #\nul) #\x01 x))
+                                          line))
+                       (#f
+                        (loop (1+ line-number)))
+                       (m
+                        (emit-warning package
+                                      (format #f (_ "build directory '~a' ~
+                                                     reference at ~a:~d:~d")
+                                              (match:substring m 0)
+                                              file line-number
+                                              (match:start m 0)))
+                        (loop (1+ line-number))))))))))
+         (find-files out #:directories? #f)))))
+
+  (define validate-output
+    (match-lambda
+      ((name . path)
+       (check-build-dir path))))
+
+  (with-store store
+    (let* ((drv (package-derivation store package #:graft? #f))
+           (outputs (derivation->output-paths drv)))
+      (build-derivations store (list drv))
+      ;; Now validate each output
+      (for-each validate-output outputs))))
+
 (define (check-license package)
   "Warn about type errors of the 'license' field of PACKAGE."
   (match (package-license package)
@@ -792,6 +841,10 @@ or a list thereof")
      (description "Report failure to compile a package to a derivation")
      (check       check-derivation))
    (lint-checker
+     (name        'output)
+     (description "Validate package output(s)")
+     (check       check-output))
+   (lint-checker
      (name        'synopsis)
      (description "Validate package synopses")
      (check       check-synopsis-style))
-- 
2.9.0