On 10/7/26 20:45, Hugo Buddelmeijer via wrote:
On 10/7/26 20:21, Hugo Buddelmeijer via wrote:
Basically, I want to always keep everything in the store that
corresponds to the tip of master or the tip of python-team; I never
want to collect those, because chances are high I'm going to need
those packages later.
So I'm now running 'guix build -r $PKG $PKG --no-grafts' for all 2700
packages I have already built, but it takes about 2 seconds per
package, so it will take hours. So this is not something I can do
before every `guix gc` either.
Apparently, all that 'guix build -r myroot mypkg --no-grafts' does, is:
1. build mypkg
2. create a symlink called myroot that points to the output in the store
3. create a symlink in /var/guix/gcroots/auto to myroot
(With multiple symlinks for multiple outputs.) And
1. the package is already built by design,
2. the myroot symlink I can bulk create myself,
3. the /var/guix/gcroots/auto symlink is created by addIndirectRoot I think
So if I can figure out a way to call addIndirectRoot in bulk, then I'm
done.
Well that wasn't so hard, because register-root maps directly to
addIndirectRoot it seems.
Kinda ugly code below, but well it works. (My aim is to be embarrassed
about my old code, but not ashamed.)
It uses the logic from `guix weather` to get all possible store paths,
and then just calls register-root. It is not even strictly necessary to
check whether the store paths actually exist.
I have garbage collected, and everything I wanted is still there, so it
works!
I should check whether it garbage collected source code though, would be
nice to keep that too, but that is for later. And I should add the
logic for other systems back in.
I'm a bit worried about this comment in gc.cc though:
> !!! This can be very slow on machines that have many roots.
And I now have 16000 roots. Not sure whether that is many.
But that comment is in "addPermRoot", which is one of the two functions
that call "addIndirectRoot", and "addPermRoot" seems to be dead code, as
it is not called anywhere. So I'll be fine.
The other way to call addIndirectRoot, is through performOp, which is
called by processConnection, which I would expect register-root to follow.
(define-module (make-store-links)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module (guix derivations)
#:use-module (guix progress)
#:use-module (guix monads)
#:use-module (guix store)
#:use-module (guix gexp)
#:use-module (guix scripts build)
#:use-module (gnu packages)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (ice-9 vlist))
;;; from guix weather
(define (call-with-progress-reporter reporter proc)
"This is a variant of 'call-with-progress-reporter' that works with
monadic
scope."
(with-monad %store-monad
(start-progress-reporter! reporter)
(mlet* %store-monad
((report -> (lambda ()
(progress-reporter-report! reporter)))
(result (proc report)))
(stop-progress-reporter! reporter)
(return result))))
;;; from guix weather
(define (package->derivation/no-grafts obj)
(mlet* %store-monad ((previous (set-grafting #f))
(drv (package->derivation obj))
(_ (set-grafting previous)))
(return drv)))
(define* (get-all-store-paths packages)
"Return the list of outputs of all of PACKAGES."
(format (current-error-port)
(G_ "computing ~h package derivations...~%")
(length packages))
(call-with-progress-reporter
(progress-reporter/bar (length packages))
(lambda (report)
(foldm %store-monad
(lambda (package result)
(mlet %store-monad
((drv (package->derivation/no-grafts package)))
(report)
(match (derivation->output-paths drv)
(((names . items) ...)
(return
(append items result))))))
'()
packages))))
(define packages-all
(fold-packages
cons
'()))
(define all-current-store-paths
(with-store store
((get-all-store-paths packages-all) store)))
(define now (date->string (current-date) "~Y~m~dT~H~M~S"))
(define rootp-base
(string-append
(getenv "HOME")
"/guix-roots/bulk-"
now))
(if (not (file-exists? rootp-base))
(mkdir rootp-base))
(with-store store
(for-each
(lambda (path)
(define rootp
(string-append rootp-base "/" (basename path)))
(if (and
(file-exists? path)
(not (file-exists? rootp)))
(register-root
store
(list path)
rootp)))
all-current-store-paths))
