summaryrefslogtreecommitdiff
path: root/guix/scripts/package.scm
diff options
context:
space:
mode:
authorAlex Kost <alezost@gmail.com>2014-08-16 22:00:34 +0400
committerLudovic Courtès <ludo@gnu.org>2014-08-20 10:55:29 +0200
commit4ea444198da3467ce74480d25a9f69dbafaccc4f (patch)
tree9e921420099bb9c1cc5c71c22379500d05184b8f /guix/scripts/package.scm
parentb211a66163afd18b282a787e2841a79fbcdb6877 (diff)
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. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'guix/scripts/package.scm')
-rw-r--r--guix/scripts/package.scm79
1 files changed, 0 insertions, 79 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 75ab118900..c33fd7b605 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))
@@ -215,48 +213,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
@@ -320,41 +276,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))))))
-
;;;
;;; Search paths.