offload: Better report failure to create the GC root directory.
Suggested by Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de>. * guix/scripts/offload.scm (register-gc-root)[script]: Replace 'false-if-exception' with a finer-grain 'system-error handler. Provide the name of MACHINE in 'leave' error message.
This commit is contained in:
		
							parent
							
								
									7d157c652c
								
							
						
					
					
						commit
						353e34a626
					
				
					 1 changed files with 9 additions and 2 deletions
				
			
		|  | @ -310,7 +310,14 @@ hook." | ||||||
|        ;; directory. |        ;; directory. | ||||||
|        (let ((root-directory (string-append %state-directory |        (let ((root-directory (string-append %state-directory | ||||||
|                                             "/gcroots/tmp"))) |                                             "/gcroots/tmp"))) | ||||||
|          (false-if-exception (mkdir root-directory)) |          (catch 'system-error | ||||||
|  |            (lambda () | ||||||
|  |              (mkdir root-directory)) | ||||||
|  |            (lambda args | ||||||
|  |              (unless (= EEXIST (system-error-errno args)) | ||||||
|  |                (error "failed to create remote GC root directory" | ||||||
|  |                       root-directory (system-error-errno args))))) | ||||||
|  | 
 | ||||||
|          (catch 'system-error |          (catch 'system-error | ||||||
|            (lambda () |            (lambda () | ||||||
|              (symlink ,file |              (symlink ,file | ||||||
|  | @ -331,7 +338,7 @@ hook." | ||||||
|         ;; Better be safe than sorry: if we ignore the error here, then FILE |         ;; Better be safe than sorry: if we ignore the error here, then FILE | ||||||
|         ;; may be GC'd just before we start using it. |         ;; may be GC'd just before we start using it. | ||||||
|         (leave (_ "failed to register GC root for '~a' on '~a' (status: ~a)~%") |         (leave (_ "failed to register GC root for '~a' on '~a' (status: ~a)~%") | ||||||
|                file machine status))))) |                file (build-machine-name machine) status))))) | ||||||
| 
 | 
 | ||||||
| (define (remove-gc-roots machine) | (define (remove-gc-roots machine) | ||||||
|   "Remove from MACHINE the GC roots previously installed with |   "Remove from MACHINE the GC roots previously installed with | ||||||
|  |  | ||||||
		Reference in a new issue