installer: Use dynamic-wind to setup installer.
* gnu/installer.scm (installer-program): Use dynamic-wind, so that completely uncaught exceptions can be printed properly. Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
This commit is contained in:
		
							parent
							
								
									7cbd95a9f6
								
							
						
					
					
						commit
						41eb0f01fc
					
				
					 1 changed files with 44 additions and 43 deletions
				
			
		|  | @ -416,51 +416,52 @@ selected keymap." | |||
| 
 | ||||
|             (define current-installer newt-installer) | ||||
|             (define steps (#$steps current-installer)) | ||||
|             ((installer-init current-installer)) | ||||
|             (dynamic-wind | ||||
|               (installer-init current-installer) | ||||
|               (lambda () | ||||
|                 (parameterize | ||||
|                     ((run-command-in-installer | ||||
|                       (installer-run-command current-installer))) | ||||
|                   (catch #t | ||||
|                     (lambda () | ||||
|                       (define results | ||||
|                         (run-installer-steps | ||||
|                          #:rewind-strategy 'menu | ||||
|                          #:menu-proc (installer-menu-page current-installer) | ||||
|                          #:steps steps)) | ||||
| 
 | ||||
|             (parameterize | ||||
|                 ((run-command-in-installer | ||||
|                   (installer-run-command current-installer))) | ||||
|               (catch #t | ||||
|                 (lambda () | ||||
|                   (define results | ||||
|                     (run-installer-steps | ||||
|                      #:rewind-strategy 'menu | ||||
|                      #:menu-proc (installer-menu-page current-installer) | ||||
|                      #:steps steps)) | ||||
|                       (match (result-step results 'final) | ||||
|                         ('success | ||||
|                          ;; We did it!  Let's reboot! | ||||
|                          (sync) | ||||
|                          (stop-service 'root)) | ||||
|                         (_ | ||||
|                          ;; The installation failed, exit so that it is restarted | ||||
|                          ;; by login. | ||||
|                          #f))) | ||||
|                     (const #f) | ||||
|                     (lambda (key . args) | ||||
|                       (installer-log-line "crashing due to uncaught exception: ~s ~s" | ||||
|                                           key args) | ||||
|                       (let ((error-file "/tmp/last-installer-error") | ||||
|                             (dump-archive "/tmp/dump.tgz")) | ||||
|                         (call-with-output-file error-file | ||||
|                           (lambda (port) | ||||
|                             (display-backtrace (make-stack #t) port) | ||||
|                             (print-exception port | ||||
|                                              (stack-ref (make-stack #t) 1) | ||||
|                                              key args))) | ||||
|                         (make-dump dump-archive | ||||
|                                    #:result %current-result | ||||
|                                    #:backtrace error-file) | ||||
|                         (let ((report | ||||
|                                ((installer-dump-page current-installer) | ||||
|                                 dump-archive))) | ||||
|                           ((installer-exit-error current-installer) | ||||
|                            error-file report key args))) | ||||
|                       (primitive-exit 1))))) | ||||
| 
 | ||||
|                   (match (result-step results 'final) | ||||
|                     ('success | ||||
|                      ;; We did it!  Let's reboot! | ||||
|                      (sync) | ||||
|                      (stop-service 'root)) | ||||
|                     (_ | ||||
|                      ;; The installation failed, exit so that it is restarted | ||||
|                      ;; by login. | ||||
|                      #f))) | ||||
|                 (const #f) | ||||
|                 (lambda (key . args) | ||||
|                   (installer-log-line "crashing due to uncaught exception: ~s ~s" | ||||
|                           key args) | ||||
|                   (let ((error-file "/tmp/last-installer-error") | ||||
|                         (dump-archive "/tmp/dump.tgz")) | ||||
|                     (call-with-output-file error-file | ||||
|                       (lambda (port) | ||||
|                         (display-backtrace (make-stack #t) port) | ||||
|                         (print-exception port | ||||
|                                          (stack-ref (make-stack #t) 1) | ||||
|                                          key args))) | ||||
|                     (make-dump dump-archive | ||||
|                                #:result %current-result | ||||
|                                #:backtrace error-file) | ||||
|                     (let ((report | ||||
|                            ((installer-dump-page current-installer) | ||||
|                             dump-archive))) | ||||
|                       ((installer-exit-error current-installer) | ||||
|                        error-file report key args))) | ||||
|                   (primitive-exit 1)))) | ||||
| 
 | ||||
|             ((installer-exit current-installer)))))) | ||||
|               (installer-exit current-installer)))))) | ||||
| 
 | ||||
|   (program-file | ||||
|    "installer" | ||||
|  |  | |||
		Reference in a new issue