describe: Add 'current-profile-date'.
* guix/describe.scm (current-profile-date): New procedure.
This commit is contained in:
parent
19c0cdb9e6
commit
cd2e4b2a8d
|
@ -21,10 +21,12 @@
|
||||||
#:use-module (guix profiles)
|
#:use-module (guix profiles)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module ((guix utils) #:select (location-file))
|
#:use-module ((guix utils) #:select (location-file))
|
||||||
#:use-module ((guix store) #:select (%store-prefix))
|
#:use-module ((guix store) #:select (%store-prefix store-path?))
|
||||||
|
#:use-module ((guix config) #:select (%state-directory))
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:export (current-profile
|
#:export (current-profile
|
||||||
|
current-profile-date
|
||||||
current-profile-entries
|
current-profile-entries
|
||||||
package-path-entries
|
package-path-entries
|
||||||
|
|
||||||
|
@ -55,6 +57,27 @@ or #f if this is not applicable."
|
||||||
(and (file-exists? (string-append candidate "/manifest"))
|
(and (file-exists? (string-append candidate "/manifest"))
|
||||||
candidate)))))))
|
candidate)))))))
|
||||||
|
|
||||||
|
(define (current-profile-date)
|
||||||
|
"Return the creation date of the current profile (produced by 'guix pull'),
|
||||||
|
as a number of seconds since the Epoch, or #f if it could not be determined."
|
||||||
|
;; Normally 'current-profile' will return ~/.config/guix/current. We need
|
||||||
|
;; to 'readlink' once to get '/var/guix/…/guix-profile', whose mtime is the
|
||||||
|
;; piece of information we're looking for.
|
||||||
|
(let loop ((profile (current-profile)))
|
||||||
|
(match profile
|
||||||
|
(#f #f)
|
||||||
|
((? store-path?) #f)
|
||||||
|
(file
|
||||||
|
(if (string-prefix? %state-directory file)
|
||||||
|
(and=> (lstat file) stat:mtime)
|
||||||
|
(catch 'system-error
|
||||||
|
(lambda ()
|
||||||
|
(let ((target (readlink file)))
|
||||||
|
(loop (if (string-prefix? "/" target)
|
||||||
|
target
|
||||||
|
(string-append (dirname file) "/" target)))))
|
||||||
|
(const #f)))))))
|
||||||
|
|
||||||
(define current-profile-entries
|
(define current-profile-entries
|
||||||
(mlambda ()
|
(mlambda ()
|
||||||
"Return the list of entries in the 'guix pull' profile the calling process
|
"Return the list of entries in the 'guix pull' profile the calling process
|
||||||
|
|
Loading…
Reference in New Issue