Something happened to the attachments. Let's try that again. Sorry
about that.
`~Eric
On 2015-09-10 15:50, Eric Bavier wrote:
On Fri, 28 Aug 2015 09:48:48 +0200
[email protected] (Ludovic Courtès) wrote:
Eric Bavier <[email protected]> skribis:
> From 0311d5b383003600ac43d3a9bfdec0ad3c398db2 Mon Sep 17 00:00:00 2001
> From: Eric Bavier <[email protected]>
> Date: Sun, 23 Aug 2015 18:00:45 -0500
> Subject: [PATCH] guix: lint: Check for version-only origin file names.
>
> * guix/scripts/lint.scm (check-source): Emit warning if source filename
> contains only the version of the package.
> * tests/lint.scm ("source: filename", "source: filename v",
> "source: filename valid"): New tests.
> * doc/guix.texi (Invoking guix lint): Mention file name check.
> Offending packages updated.
This is useful, thanks for looking into it.
Thanks for the review!
I would prefer it to make a separate linter, like ‘source-file-name’.
The reason is that ‘source’ is a relatively expensive check, since it
needs to probe URLs (so you might want to skip it in some cases),
whereas the linter your propose is lightweight.
Makes sense.
> --- a/gnu/packages/algebra.scm
> +++ b/gnu/packages/algebra.scm
> @@ -386,6 +386,7 @@ cosine/ sine transforms or DCT/DST).")
> (method url-fetch)
> (uri (string-append "https://bitbucket.org/eigen/eigen/get/";
> version ".tar.bz2"))
> + (file-name (string-append name "-" version ".tar.bz2"))
Could you make these package updates a separate patch? Some may
trigger
large rebuilds, so you may have to keep them for ‘core-updates’ or
such.
I've left the package updates out of the attached patches.
> + (define (origin-version-name? origin)
> + ;; Return #t if the source file name contains only a version; indicates
> + ;; that the origin needs a 'file-name' field.
> + (let ((filename (store-path-package-name
> + (with-store store
> + (derivation->output-path
> + (package-source-derivation store origin)))))
> + (version (package-version package)))
> + (or (string-prefix? version filename)
> + ;; Common in many projects is for the filename to start with a "v"
> + ;; followed by the version, e.g. "v3.2.0.tar.gz".
> + (string-prefix? (string-append "v" version) filename))))
Opening a connection to the store in the middle of the code
(‘with-store’) is Bad Practice. ;-)
I think this can actually be made simpler, with something akin to what
‘node-full-name’ does in guix/scripts/graph.scm. Maybe we could
extract
an ‘origin-actual-file-name’ procedure from that and move it to (guix
packages). WDYT?
The first attached patch does this. Is using the basename of the
source URI always accurate? I.e. are there cases where the store file
name might not match the URI's basename? This uncertainty, I think, is
what caused me to use store-path-package-name initially.
This revised patch might actually be considered "more accurate" in that
the checker now flags origins from 'git-reference' et al where no
'file-name' field is declared.
`~Eric
From 8db3e5978394b99ad14d69494b00343b70f918e1 Mon Sep 17 00:00:00 2001
From: Eric Bavier <[email protected]>
Date: Thu, 10 Sep 2015 15:39:44 -0500
Subject: [PATCH 1/2] guix: packages: Add origin-actual-file-name.
* guix/scripts/graph.scm (uri->file-name, node-full-name): Move origin file
name logic to...
* guix/packages.scm (origin-actual-file-name): ...here.
---
guix/packages.scm | 22 ++++++++++++++++++++++
guix/scripts/graph.scm | 15 +--------------
2 files changed, 23 insertions(+), 14 deletions(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index e466ffe..edcb53e 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -37,6 +37,7 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (web uri)
#:re-export (%current-system
%current-target-system
search-path-specification) ;for convenience
@@ -46,6 +47,7 @@
origin-method
origin-sha256
origin-file-name
+ origin-actual-file-name
origin-patches
origin-patch-flags
origin-patch-inputs
@@ -188,6 +190,26 @@ representation."
((_ str)
#'(nix-base32-string->bytevector str)))))
+(define (origin-actual-file-name origin)
+ "Return the file name of ORIGIN, either its 'file-name' field or the file
+name of its URI."
+ (define (uri->file-name uri)
+ ;; Return the 'base name' of URI or URI itself, where URI is a string.
+ (let ((path (and=> (string->uri uri) uri-path)))
+ (if path
+ (basename path)
+ uri)))
+
+ (or (origin-file-name origin)
+ (match (origin-uri origin)
+ ((head . tail)
+ (uri->file-name head))
+ ((? string? uri)
+ (uri->file-name uri))
+ (else
+ ;; git, svn, cvs, etc. reference
+ #f))))
+
(define %supported-systems
;; This is the list of system types that are supported. By default, we
;; expect all packages to build successfully here.
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 2b671be..cddd63e 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -33,7 +33,6 @@
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
- #:use-module (web uri)
#:export (%package-node-type
%bag-node-type
%bag-emerged-node-type
@@ -78,25 +77,13 @@
;;; Package DAG.
;;;
-(define (uri->file-name uri)
- "Return the 'base name' of URI or URI itself, where URI is a string."
- (let ((path (and=> (string->uri uri) uri-path)))
- (if path
- (basename path)
- uri)))
-
(define (node-full-name thing)
"Return a human-readable name to denote THING, a package, origin, or file
name."
(cond ((package? thing)
(package-full-name thing))
((origin? thing)
- (or (origin-file-name thing)
- (match (origin-uri thing)
- ((head . tail)
- (uri->file-name head))
- ((? string? uri)
- (uri->file-name uri)))))
+ (origin-actual-file-name thing))
((string? thing) ;file name
(or (basename thing)
(error "basename" thing)))
--
2.4.3
From 03c3f2b21a2467675092830aea2ddf192e133ff5 Mon Sep 17 00:00:00 2001
From: Eric Bavier <[email protected]>
Date: Thu, 10 Sep 2015 15:34:58 -0500
Subject: [PATCH 2/2] guix: lint: Check for meaningful origin file names.
* guix/scripts/lint.scm (check-source-file-name): New procedure.
(%checkers): Add 'source-file-name' checker.
* tests/lint.scm ("source: file name", "source: file name v")
("source: file name valid", "source: file name bad checkout")
("source: file name good checkout"): New tests.
* doc/guix.texi (Invoking guix lint): Mention file name check.
---
doc/guix.texi | 5 +++-
guix/scripts/lint.scm | 75 +++++++++++++++++++++++++++++++----------------
tests/lint.scm | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++-
3 files changed, 133 insertions(+), 27 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 9ae91a8..6c563a9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4217,8 +4217,11 @@ Identify inputs that should most likely be native inputs.
@item source
@itemx home-page
+@itemx source-file-name
Probe @code{home-page} and @code{source} URLs and report those that are
-invalid.
+invalid. Check that the source file name is meaningful, e.g. is not
+just a version number or ``git-checkout'', and should not have a
+@code{file-name} declared (@pxref{origin Reference}).
@item formatting
Warn about obvious source code formatting issues: trailing white space,
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 2a618c9..6adea14 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Cyril Roelandt <[email protected]>
-;;; Copyright © 2014 Eric Bavier <[email protected]>
+;;; Copyright © 2014, 2015 Eric Bavier <[email protected]>
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <[email protected]>
;;;
;;; This file is part of GNU Guix.
@@ -57,6 +57,7 @@
check-derivation
check-home-page
check-source
+ check-source-file-name
check-license
check-formatting
@@ -476,30 +477,50 @@ descriptions maintained upstream."
'()))
(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 *some*
- ;; 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, otherwise don't
+ ;; report anything.
+ ;;
+ ;; XXX: Ideally we'd still allow warnings to be raised if *some*
+ ;; 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))))))))))
+
+(define (check-source-file-name package)
+ "Emit a warning if PACKAGE's origin has a version-only file name."
+ (define (origin-file-name-valid? origin)
+ ;; Return #t if the source file name contains only a version; indicates
+ ;; that the origin needs a 'file-name' field.
+ (let ((file-name (origin-actual-file-name origin))
+ (version (package-version package)))
+ (and file-name
+ (not (or (string-prefix? version file-name)
+ ;; Common in many projects is for the filename to start
+ ;; with a "v" followed by the version,
+ ;; e.g. "v3.2.0.tar.gz".
+ (string-prefix? (string-append "v" version) file-name))))))
+
+ (let ((origin (package-source package)))
+ (unless (or (not origin) (origin-file-name-valid? origin))
+ (emit-warning package
+ (_ "the source file name should contain the package name")
+ 'source))))
(define (check-derivation package)
"Emit a warning if we fail to compile PACKAGE to a derivation."
@@ -643,6 +664,10 @@ or a list thereof")
(description "Validate source URLs")
(check check-source))
(lint-checker
+ (name 'source-file-name)
+ (description "Validate file names of sources")
+ (check check-source-file-name))
+ (lint-checker
(name 'derivation)
(description "Report failure to compile a package to a derivation")
(check check-derivation))
diff --git a/tests/lint.scm b/tests/lint.scm
index ac47dbb..2fac284 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <[email protected]>
-;;; Copyright © 2014 Eric Bavier <[email protected]>
+;;; Copyright © 2014, 2015 Eric Bavier <[email protected]>
;;; Copyright © 2014, 2015 Ludovic Courtès <[email protected]>
;;;
;;; This file is part of GNU Guix.
@@ -21,6 +21,7 @@
(define-module (test-lint)
#:use-module (guix tests)
#:use-module (guix download)
+ #:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module (guix packages)
#:use-module (guix scripts lint)
@@ -398,6 +399,83 @@ requests."
(check-home-page pkg))))
"not reachable: 404")))
+(test-assert "source: file name"
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (version "3.2.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri "http://www.example.com/3.2.1.tar.gz";)
+ (sha256 %null-sha256))))))
+ (check-source-file-name pkg)))
+ "file name should contain the package name")))
+
+(test-assert "source: file name v"
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (version "3.2.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri "http://www.example.com/v3.2.1.tar.gz";)
+ (sha256 %null-sha256))))))
+ (check-source-file-name pkg)))
+ "file name should contain the package name")))
+
+(test-assert "source: file name bad checkout"
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (version "3.2.1")
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "http://www.example.com/x.git";)
+ (commit "0")))
+ (sha256 %null-sha256))))))
+ (check-source-file-name pkg)))
+ "file name should contain the package name")))
+
+(test-assert "source: file name good checkout"
+ (not
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (version "3.2.1")
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "http://git.example.com/x.git";)
+ (commit "0")))
+ (file-name (string-append "x-" version))
+ (sha256 %null-sha256))))))
+ (check-source-file-name pkg)))
+ "file name should contain the package name"))))
+
+(test-assert "source: file name valid"
+ (not
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (version "3.2.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri "http://www.example.com/x-3.2.1.tar.gz";)
+ (sha256 %null-sha256))))))
+ (check-source-file-name pkg)))
+ "file name should contain the package name"))))
+
(test-skip (if %http-server-socket 0 1))
(test-equal "source: 200"
""
--
2.4.3
