cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Further improve load-new-guix-revision-jobs

Browse source 
Split the derivations up in to some groups, and run
invalidate-derivation-caches! inbetween to try and reduce the memory
usage.

Also make a couple of other changes to reduce memory usage or protect
against errors.
This commit is contained in:
Christopher Baines 2019-03-16 17:26:44 +00:00
parent 9f162c3b2c
commit a092db5007
Signed by: cbaines
GPG key ID: 5E28A33B0B84F577
2 changed files with 101 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

6
guix-data-service/jobs.scm
View file

@ -4,8 +4,8 @@
#:export (process-jobs))
(define (process-jobs conn)
(while #t
(match (process-next-load-new-guix-revision-job conn)
(#f (begin (simple-format #t "Waiting for new jobs...")
(sleep 60)
(process-jobs conn)))
(_ (process-jobs conn))))
(sleep 60)))
(_ #f))))

64
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -37,7 +37,23 @@
result))
(define (all-inferior-package-derivations store inf packages)
(define proc
(define inferior-%supported-systems
(inferior-eval '(@ (guix packages) %supported-systems) inf))
(define supported-system-pairs
(map (lambda (system)
(cons system system))
inferior-%supported-systems))
(define supported-system-cross-build-pairs
(map (lambda (system)
(filter-map (lambda (target)
(and (not (string=? system target))
(cons system target)))
inferior-%supported-systems))
inferior-%supported-systems))
(define (proc packages system-target-pairs)
`(lambda (store)
(append-map
(lambda (inferior-package-id)
@ -66,10 +82,18 @@
target
system))))))
(lambda args
;; misc-error #f ~A ~S (No cross-compilation for clojure-build-system yet:
;; misc-error #f ~A ~S (No
;; cross-compilation for
;; clojure-build-system yet:
#f)))
supported-systems))
supported-systems)))
(lset-intersection
string=?
supported-systems
(list ,@(map cdr system-target-pairs)))))
(lset-intersection
string=?
supported-systems
(list ,@(map car system-target-pairs))))))
(lambda args
(simple-format (current-error-port)
"error: while processing ~A ignoring error: ~A\n"
@ -78,7 +102,20 @@
'()))))
(list ,@(map inferior-package-id packages)))))
(inferior-eval-with-store inf store proc))
(append-map
(lambda (system-target-pairs)
(format (current-error-port)
"heap size: ~a MiB~%"
(round
(/ (assoc-ref (gc-stats) 'heap-size)
(expt 2. 20))))
(log-time
(simple-format #f "getting derivations for ~A" system-target-pairs)
(lambda ()
(inferior-eval '(invalidate-derivation-caches!) inf)
(inferior-eval-with-store inf store (proc packages system-target-pairs)))))
(append (map list supported-system-pairs)
supported-system-cross-build-pairs)))
(define (inferior-guix->package-derivation-ids store conn inf)
(let* ((packages (log-time "fetching inferior packages"
@ -157,6 +194,9 @@
(list (string-append
"SSL_CERT_DIR=" (nss-certs-store-path store))))))
(catch
#t
(lambda ()
;; Create /etc/pass, as %known-shorthand-profiles in (guix
;; profiles) tries to read from this file. Because the environment
;; is cleaned in build-self.scm, xdg-directory in (guix utils)
@ -202,7 +242,15 @@
(close-inferior inferior)
file-name))))
file-name)))
(lambda args
(simple-format (current-error-port)
"error: channel->derivation-file-name: ~A\n"
args)
(close-inferior inferior)
#f))))
(define (channel->manifest-store-item store channel)
(let* ((manifest-store-item-derivation-file-name
@ -233,7 +281,8 @@
'("/gnu/store"))))
(inferior-eval '(use-modules (srfi srfi-1)
(srfi srfi-34)
(guix grafts))
(guix grafts)
(guix derivations))
inf)
(inferior-eval '(%graft? #f) inf)
@ -298,4 +347,3 @@
id
"'"))))
(_ #f))))