From: Eric Bavier <bav...@member.fsf.org>
* 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
