02/02: gnu-maintenance: Use 'home-page' as an additional hint of "GNUness".

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 55d1f529e1a50387d6bf7d474a3cbe3839a1f885
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jun 16 10:28:19 2015 +0200

    gnu-maintenance: Use 'home-page' as an additional hint of "GNUness".
    
    Reported by Rastus_Vernon on IRC.
    Fixes 'gnu-package?' for GNUcash.
    
    * guix/gnu-maintenance.scm (gnu-package?)[gnu-home-page?]: New procedure.  
Use
      it to determine whether PACKAGE is GNU.
---
 guix/gnu-maintenance.scm |   25 ++++++++++++++++---------
 1 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 8d47cee..ac83df4 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -192,15 +192,22 @@ network to check in GNU's database."
                   ;; Definitely non-GNU.
                   'non-gnu)))))
 
-       (let ((url  (and=> (package-source package) origin-uri))
-             (name (package-name package)))
-         (case (and (string? url) (mirror-type url))
-           ((gnu) #t)
-           ((non-gnu) #f)
-           (else
-            ;; Last resort: resort to the network.
-            (and (member name (map gnu-package-name (official-gnu-packages)))
-                 #t))))))))
+       (define (gnu-home-page? package)
+         (and=> (package-home-page package)
+                (lambda (url)
+                  (and=> (uri-host (string->uri url))
+                         (lambda (host)
+                           (member host '("www.gnu.org" "gnu.org")))))))
+
+       (or (gnu-home-page? package)
+           (let ((url  (and=> (package-source package) origin-uri))
+                 (name (package-name package)))
+             (case (and (string? url) (mirror-type url))
+               ((gnu) #t)
+               ((non-gnu) #f)
+               (else
+                (and (member name (map gnu-package-name 
(official-gnu-packages)))
+                     #t)))))))))
 
 
 ;;;