From 882fc8361b2d9cfe1d5c72b137a8474f902f36a0 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Sun, 5 May 2019 12:18:35 +0200 Subject: [PATCH] Graceful handling of errors in scripts. --- burrower.scm | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/burrower.scm b/burrower.scm index 867a289..a03c266 100644 --- a/burrower.scm +++ b/burrower.scm @@ -82,7 +82,7 @@ ((or (= (string-length l) 0) (string-suffix? "/" l)) 1) ((has-suffix? l ".txt" ".org" ".md") 0) ((has-suffix? l ".png" ".jpg" ".gif" ".bmp" ".tif" ".tga") 'I) - ((has-suffix? l "?") 7) + ((has-suffix? l "?.scm") 7) (else 9)))) @@ -145,8 +145,7 @@ (error "File not found." file-name)))) (define (serve-query selector arguments remote-ip config) - (let ((file-name (make-pathname (config-root-dir config) - (conc (string-chomp selector "?") ".scm")))) + (let ((file-name (make-pathname (config-root-dir config) selector))) (if (and (regular-file? file-name) (= (length arguments) 1)) (with-input-from-file file-name @@ -217,10 +216,15 @@ (define (with-current-working-directory directory thunk) (let ((old-wd (current-directory)) (result 'none)) - (change-directory directory) - (set! result (thunk)) - (change-directory old-wd) - result)) + (condition-case + (begin + (change-directory directory) + (set! result (thunk)) + (change-directory old-wd) + result) + (o (exn) + (change-directory old-wd) + (signal o))))) (define (with-selector-dir selector config thunk) (with-current-working-directory -- 2.20.1