guix: lint: Add checker for new upstream versions.

* guix/scripts/lint.scm (check-for-updates): New procedure.
(%checkers): Add it.
* guix/scripts/refresh.scm (importer-modules, %updaters): Move
from here ...
* guix/upstream.scm: ... to here.
This commit is contained in:
Efraim Flashner 2017-07-06 09:13:31 +03:00
parent c723271f30
commit adf0c531a8
No known key found for this signature in database
GPG key ID: 41AAE7DCCA3D8351
3 changed files with 36 additions and 19 deletions

View file

@ -33,6 +33,7 @@ (define-module (guix scripts lint)
#:use-module (guix licenses) #:use-module (guix licenses)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix upstream)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (guix scripts) #:use-module (guix scripts)
@ -73,6 +74,7 @@ (define-module (guix scripts lint)
check-mirror-url check-mirror-url
check-license check-license
check-vulnerabilities check-vulnerabilities
check-for-updates
check-formatting check-formatting
run-checkers run-checkers
@ -826,6 +828,17 @@ (define (check-vulnerabilities package)
(string-join (map vulnerability-id unpatched) (string-join (map vulnerability-id unpatched)
", "))))))))) ", ")))))))))
(define (check-for-updates package)
"Check if there is an update available for PACKAGE."
(match (package-latest-release* package (force %updaters))
((? upstream-source? source)
(when (version>? (upstream-source-version source)
(package-version package))
(emit-warning package
(format #f (G_ "can be upgraded to ~a~%")
(upstream-source-version source)))))
(#f #f))) ; cannot find newer upstream release
;;; ;;;
;;; Source code formatting. ;;; Source code formatting.
@ -991,6 +1004,10 @@ (define %checkers
(description "Check the Common Vulnerabilities and Exposures\ (description "Check the Common Vulnerabilities and Exposures\
(CVE) database") (CVE) database")
(check check-vulnerabilities)) (check check-vulnerabilities))
(lint-checker
(name 'refresh)
(description "Check the package for new upstream releases")
(check check-for-updates))
(lint-checker (lint-checker
(name 'formatting) (name 'formatting)
(description "Look for formatting issues in the source") (description "Look for formatting issues in the source")

View file

@ -30,7 +30,6 @@ (define-module (guix scripts refresh)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix upstream) #:use-module (guix upstream)
#:use-module (guix discovery)
#:use-module (guix graph) #:use-module (guix graph)
#:use-module (guix scripts graph) #:use-module (guix scripts graph)
#:use-module (guix monads) #:use-module (guix monads)
@ -46,8 +45,7 @@ (define-module (guix scripts refresh)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-37) #:use-module (srfi srfi-37)
#:use-module (ice-9 binary-ports) #:use-module (ice-9 binary-ports)
#:export (guix-refresh #:export (guix-refresh))
%updaters))
;;; ;;;
@ -162,22 +160,6 @@ (define (show-help)
;;; Updates. ;;; Updates.
;;; ;;;
(define (importer-modules)
"Return the list of importer modules."
(cons (resolve-interface '(guix gnu-maintenance))
(all-modules (map (lambda (entry)
`(,entry . "guix/import"))
%load-path))))
(define %updaters
;; The list of publically-known updaters.
(delay (fold-module-public-variables (lambda (obj result)
(if (upstream-updater? obj)
(cons obj result)
result))
'()
(importer-modules))))
(define (lookup-updater-by-name name) (define (lookup-updater-by-name name)
"Return the updater called NAME." "Return the updater called NAME."
(or (find (lambda (updater) (or (find (lambda (updater)

View file

@ -20,6 +20,7 @@
(define-module (guix upstream) (define-module (guix upstream)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix discovery)
#:use-module ((guix download) #:use-module ((guix download)
#:select (download-to-store)) #:select (download-to-store))
#:use-module (guix gnupg) #:use-module (guix gnupg)
@ -55,6 +56,7 @@ (define-module (guix upstream)
upstream-updater-predicate upstream-updater-predicate
upstream-updater-latest upstream-updater-latest
%updaters
lookup-updater lookup-updater
download-tarball download-tarball
@ -146,6 +148,22 @@ (define-record-type* <upstream-updater>
(pred upstream-updater-predicate) (pred upstream-updater-predicate)
(latest upstream-updater-latest)) (latest upstream-updater-latest))
(define (importer-modules)
"Return the list of importer modules."
(cons (resolve-interface '(guix gnu-maintenance))
(all-modules (map (lambda (entry)
`(,entry . "guix/import"))
%load-path))))
(define %updaters
;; The list of publically-known updaters.
(delay (fold-module-public-variables (lambda (obj result)
(if (upstream-updater? obj)
(cons obj result)
result))
'()
(importer-modules))))
(define (lookup-updater package updaters) (define (lookup-updater package updaters)
"Return an updater among UPDATERS that matches PACKAGE, or #f if none of "Return an updater among UPDATERS that matches PACKAGE, or #f if none of
them matches." them matches."