From: Alex Kost <alezost@gmail.com>
To: guix-devel@gnu.org
Subject: [PATCH] Export 'check-package-freshness'
Date: Sat, 16 Aug 2014 22:23:25 +0400 [thread overview]
Message-ID: <87ppg0cmzm.fsf@gmail.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 389 bytes --]
Ludovic Courtès (2014-08-13 20:03 +0400) wrote:
[...]
> Alex Kost <alezost@gmail.com> skribis:
>
> [...]
>
>> Also I think "guix.el" should check for freshness too, so
>> ‘check-package-freshness’ should probably be exported.
>
> Yes, probably in the (gnu packages) module?
Here is the patch for that. I'm not sure about the commit message.
Should it be changed?
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Move-check-package-freshness-from-guix-package-to-pa.patch --]
[-- Type: text/x-patch, Size: 9089 bytes --]
From a13dbc81b6ca8c16343aaaafd17ec57812f0c24e Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Sat, 16 Aug 2014 22:00:34 +0400
Subject: [PATCH] Move 'check-package-freshness' from 'guix package' to
'packages'
* guix/scripts/package.scm (%sigint-prompt, call-with-sigint-handler)
(waiting, ftp-open*, check-package-freshness): Move to...
* gnu/packages.scm: ... here.
---
gnu/packages.scm | 84 +++++++++++++++++++++++++++++++++++++++++++++++-
guix/scripts/package.scm | 79 ---------------------------------------------
2 files changed, 83 insertions(+), 80 deletions(-)
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 77d9d3e..bad7efb 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -22,6 +22,8 @@
#:use-module (guix packages)
#:use-module (guix ui)
#:use-module (guix utils)
+ #:use-module ((guix ftp-client) #:select (ftp-open))
+ #:use-module (guix gnu-maintenance)
#:use-module (ice-9 ftw)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
@@ -41,7 +43,9 @@
package-direct-dependents
package-transitive-dependents
- package-covering-dependents))
+ package-covering-dependents
+
+ check-package-freshness))
;;; Commentary:
;;;
@@ -246,3 +250,81 @@ include all of PACKAGES and all packages that depend on PACKAGES."
(lambda (node) (vhash-refq dependency-dag node))
;; Start with the dependents to avoid including PACKAGES in the result.
(package-direct-dependents packages))))
+
+\f
+(define %sigint-prompt
+ ;; The prompt to jump to upon SIGINT.
+ (make-prompt-tag "interruptible"))
+
+(define (call-with-sigint-handler thunk handler)
+ "Call THUNK and return its value. Upon SIGINT, call HANDLER with the signal
+number in the context of the continuation of the call to this function, and
+return its return value."
+ (call-with-prompt %sigint-prompt
+ (lambda ()
+ (sigaction SIGINT
+ (lambda (signum)
+ (sigaction SIGINT SIG_DFL)
+ (abort-to-prompt %sigint-prompt signum)))
+ (dynamic-wind
+ (const #t)
+ thunk
+ (cut sigaction SIGINT SIG_DFL)))
+ (lambda (k signum)
+ (handler signum))))
+
+(define-syntax-rule (waiting exp fmt rest ...)
+ "Display the given message while EXP is being evaluated."
+ (let* ((message (format #f fmt rest ...))
+ (blank (make-string (string-length message) #\space)))
+ (display message (current-error-port))
+ (force-output (current-error-port))
+ (call-with-sigint-handler
+ (lambda ()
+ (dynamic-wind
+ (const #f)
+ (lambda () exp)
+ (lambda ()
+ ;; Clear the line.
+ (display #\cr (current-error-port))
+ (display blank (current-error-port))
+ (display #\cr (current-error-port))
+ (force-output (current-error-port)))))
+ (lambda (signum)
+ (format (current-error-port) " interrupted by signal ~a~%" SIGINT)
+ #f))))
+
+(define ftp-open*
+ ;; Memoizing version of `ftp-open'. The goal is to avoid initiating a new
+ ;; FTP connection for each package, esp. since most of them are to the same
+ ;; server. This has a noticeable impact when doing "guix upgrade -u".
+ (memoize ftp-open))
+
+(define (check-package-freshness package)
+ "Check whether PACKAGE has a newer version available upstream, and report
+it."
+ ;; TODO: Automatically inject the upstream version when desired.
+
+ (catch #t
+ (lambda ()
+ (when (false-if-exception (gnu-package? package))
+ (let ((name (package-name package))
+ (full-name (package-full-name package)))
+ (match (waiting (latest-release name
+ #:ftp-open ftp-open*
+ #:ftp-close (const #f))
+ (_ "looking for the latest release of GNU ~a...") name)
+ ((latest-version . _)
+ (when (version>? latest-version full-name)
+ (format (current-error-port)
+ (_ "~a: note: using ~a \
+but ~a is available upstream~%")
+ (location->string (package-location package))
+ full-name latest-version)))
+ (_ #t)))))
+ (lambda (key . args)
+ ;; Silently ignore networking errors rather than preventing
+ ;; installation.
+ (case key
+ ((getaddrinfo-error ftp-error) #f)
+ (else (apply throw key args))))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 3bfef4f..239df77 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -29,7 +29,6 @@
#:use-module (guix config)
#:use-module (guix scripts build)
#:use-module ((guix build utils) #:select (directory-exists? mkdir-p))
- #:use-module ((guix ftp-client) #:select (ftp-open))
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
@@ -42,7 +41,6 @@
#:use-module (gnu packages)
#:use-module ((gnu packages base) #:select (guile-final))
#:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
- #:use-module (guix gnu-maintenance)
#:export (specification->package+output
guix-package))
@@ -258,48 +256,6 @@ RX."
(package-name p2))))
same-location?))
-(define %sigint-prompt
- ;; The prompt to jump to upon SIGINT.
- (make-prompt-tag "interruptible"))
-
-(define (call-with-sigint-handler thunk handler)
- "Call THUNK and return its value. Upon SIGINT, call HANDLER with the signal
-number in the context of the continuation of the call to this function, and
-return its return value."
- (call-with-prompt %sigint-prompt
- (lambda ()
- (sigaction SIGINT
- (lambda (signum)
- (sigaction SIGINT SIG_DFL)
- (abort-to-prompt %sigint-prompt signum)))
- (dynamic-wind
- (const #t)
- thunk
- (cut sigaction SIGINT SIG_DFL)))
- (lambda (k signum)
- (handler signum))))
-
-(define-syntax-rule (waiting exp fmt rest ...)
- "Display the given message while EXP is being evaluated."
- (let* ((message (format #f fmt rest ...))
- (blank (make-string (string-length message) #\space)))
- (display message (current-error-port))
- (force-output (current-error-port))
- (call-with-sigint-handler
- (lambda ()
- (dynamic-wind
- (const #f)
- (lambda () exp)
- (lambda ()
- ;; Clear the line.
- (display #\cr (current-error-port))
- (display blank (current-error-port))
- (display #\cr (current-error-port))
- (force-output (current-error-port)))))
- (lambda (signum)
- (format (current-error-port) " interrupted by signal ~a~%" SIGINT)
- #f))))
-
(define-syntax-rule (leave-on-EPIPE exp ...)
"Run EXP... in a context when EPIPE errors are caught and lead to 'exit'
with successful exit code. This is useful when writing to the standard output
@@ -363,41 +319,6 @@ an output path different than CURRENT-PATH."
(not (string=? current-path candidate-path))))))
(#f #f)))
-(define ftp-open*
- ;; Memoizing version of `ftp-open'. The goal is to avoid initiating a new
- ;; FTP connection for each package, esp. since most of them are to the same
- ;; server. This has a noticeable impact when doing "guix upgrade -u".
- (memoize ftp-open))
-
-(define (check-package-freshness package)
- "Check whether PACKAGE has a newer version available upstream, and report
-it."
- ;; TODO: Automatically inject the upstream version when desired.
-
- (catch #t
- (lambda ()
- (when (false-if-exception (gnu-package? package))
- (let ((name (package-name package))
- (full-name (package-full-name package)))
- (match (waiting (latest-release name
- #:ftp-open ftp-open*
- #:ftp-close (const #f))
- (_ "looking for the latest release of GNU ~a...") name)
- ((latest-version . _)
- (when (version>? latest-version full-name)
- (format (current-error-port)
- (_ "~a: note: using ~a \
-but ~a is available upstream~%")
- (location->string (package-location package))
- full-name latest-version)))
- (_ #t)))))
- (lambda (key . args)
- ;; Silently ignore networking errors rather than preventing
- ;; installation.
- (case key
- ((getaddrinfo-error ftp-error) #f)
- (else (apply throw key args))))))
-
\f
;;;
;;; Search paths.
--
2.0.3
next reply other threads:[~2014-08-16 18:23 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-08-16 18:23 Alex Kost [this message]
2014-08-20 8:56 ` [PATCH] Export 'check-package-freshness' Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87ppg0cmzm.fsf@gmail.com \
--to=alezost@gmail.com \
--cc=guix-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).