From mboxrd@z Thu Jan 1 00:00:00 1970 From: ericbavier@openmailbox.org Subject: [PATCH] guix: lint: Check for version-only origin file names. Date: Sun, 23 Aug 2015 18:05:34 -0500 Message-ID: <1440371134-2699-1-git-send-email-ericbavier@openmailbox.org> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:56067) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZTiuW-00034x-1b for guix-devel@gnu.org; Sun, 23 Aug 2015 23:59:05 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZTiuS-0004rI-Pi for guix-devel@gnu.org; Sun, 23 Aug 2015 23:59:03 -0400 Received: from smtp10.openmailbox.org ([62.4.1.44]:39965) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZTiuS-0004r9-EK for guix-devel@gnu.org; Sun, 23 Aug 2015 23:59:00 -0400 List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org Cc: Eric Bavier From: Eric Bavier * guix/scripts/lint.scm (check-source): Emit warning if source filename contains only the version of the package. --- guix/scripts/lint.scm | 64 +++++++++++++++++++++++++++++++--------------= ------ 1 file changed, 39 insertions(+), 25 deletions(-) diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 14ac8cb..c0300bc 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2014 Cyril Roelandt -;;; Copyright =C2=A9 2014 Eric Bavier +;;; Copyright =C2=A9 2014, 2015 Eric Bavier ;;; Copyright =C2=A9 2013, 2014, 2015 Ludovic Court=C3=A8s ;;; ;;; This file is part of GNU Guix. @@ -20,6 +20,7 @@ =20 (define-module (guix scripts lint) #:use-module (guix store) + #:use-module (guix derivations) #:use-module (guix base32) #:use-module (guix download) #:use-module (guix ftp-client) @@ -466,31 +467,44 @@ descriptions maintained upstream." uris)) '())) =20 + (define (origin-version-name? origin) + ;; Return #t if the source file name contains only a version; indica= tes + ;; that the origin needs a 'file-name' field. + (string-prefix? (package-version package) + (store-path-package-name + (with-store store + (derivation->output-path + (package-source-derivation store origin)))))) + (let ((origin (package-source package))) - (when (and origin - (eqv? (origin-method origin) url-fetch)) - (let* ((strings (origin-uri origin)) - (uris (if (list? strings) - (map string->uri strings) - (list (string->uri strings))))) - - ;; Just make sure that at least one of the URIs is valid. - (call-with-values - (lambda () (try-uris uris)) - (lambda (success? warnings) - ;; When everything fails, report all of WARNINGS, otherwise = don't - ;; report anything. - ;; - ;; XXX: Ideally we'd still allow warnings to be raised if *s= ome* - ;; URIs are unreachable, but distinguish that from the error= case - ;; where *all* the URIs are unreachable. - (unless success? - (emit-warning package - (_ "all the source URIs are unreachable:") - 'source) - (for-each (lambda (warning) - (display warning (guix-warning-port))) - (reverse warnings))))))))) + (when origin + (if (eqv? (origin-method origin) url-fetch) + (let* ((strings (origin-uri origin)) + (uris (if (list? strings) + (map string->uri strings) + (list (string->uri strings))))) + + ;; Just make sure that at least one of the URIs is valid. + (call-with-values + (lambda () (try-uris uris)) + (lambda (success? warnings) + ;; When everything fails, report all of WARNINGS, otherw= ise don't + ;; report anything. + ;; + ;; XXX: Ideally we'd still allow warnings to be raised i= f *some* + ;; URIs are unreachable, but distinguish that from the e= rror case + ;; where *all* the URIs are unreachable. + (unless success? + (emit-warning package + (_ "all the source URIs are unreachable:= ") + 'source) + (for-each (lambda (warning) + (display warning (guix-warning-port))) + (reverse warnings))))))) + (if (origin-version-name? origin) + (emit-warning package + (_ "the source filename should contain the packa= ge name") + 'source))))) =20 (define (check-derivation package) "Emit a warning if we fail to compile PACKAGE to a derivation." --=20 2.4.3