diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/publish.scm | 6 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 23 |
2 files changed, 25 insertions, 4 deletions
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 3d197384d6..5306afcf07 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -208,13 +208,13 @@ References: ~a~%" (narinfo-string store store-path (force %private-key)) <>))))) -(define (render-nar request store-item) +(define (render-nar store request store-item) "Render archive of the store path corresponding to STORE-ITEM." (let ((store-path (string-append %store-directory "/" store-item))) ;; The ISO-8859-1 charset *must* be used otherwise HTTP clients will ;; interpret the byte stream as UTF-8 and arbitrarily change invalid byte ;; sequences. - (if (file-exists? store-path) + (if (valid-path? store store-path) (values '((content-type . (application/x-nix-archive (charset . "ISO-8859-1")))) ;; XXX: We're not returning the actual contents, deferring @@ -314,7 +314,7 @@ blocking." (render-narinfo store request hash)) ;; /nar/<store-item> (("nar" store-item) - (render-nar request store-item)) + (render-nar store request store-item)) (_ (not-found request))) (not-found request)))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 7279be0c43..401aa8b60a 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -211,6 +211,19 @@ the ownership of '~a' may be incorrect!~%") (lambda () (environ env))))) +(define-syntax-rule (save-load-path-excursion body ...) + "Save the current values of '%load-path' and '%load-compiled-path', run +BODY..., and restore them." + (let ((path %load-path) + (cpath %load-compiled-path)) + (dynamic-wind + (const #t) + (lambda () + body ...) + (lambda () + (set! %load-path path) + (set! %load-compiled-path cpath))))) + (define-syntax-rule (warn-on-system-error body ...) (catch 'system-error (lambda () @@ -273,6 +286,9 @@ bring the system down." (info (_ "loading new services:~{ ~a~}...~%") to-load-names) (mlet %store-monad ((files (mapm %store-monad shepherd-service-file to-load))) + ;; Here we assume that FILES are exactly those that were computed + ;; as part of the derivation that built OS, which is normally the + ;; case. (load-services (map derivation->output-path files)) (for-each start-service @@ -299,7 +315,12 @@ it atomically, and then run OS's activation script." ;; Tell 'activate-current-system' what the new system is. (setenv "GUIX_NEW_SYSTEM" system) - (primitive-load (derivation->output-path script))) + ;; The activation script may modify '%load-path' & co., so protect + ;; against that. This is necessary to ensure that + ;; 'upgrade-shepherd-services' gets to see the right modules when it + ;; computes derivations with (gexp->derivation #:modules …). + (save-load-path-excursion + (primitive-load (derivation->output-path script)))) ;; Finally, try to update system services. (upgrade-shepherd-services os)))) |