From 48066a7da4ffc62c0020119b7d27f37012b74a3a Mon Sep 17 00:00:00 2001 From: Jan Tuomi Date: Fri, 9 Feb 2024 23:49:40 +0200 Subject: Fix race conditions with file reads by adding a try-with-backoff mechanism --- app.scm | 39 ++++++++++++++++++++++++++++++++++----- 1 file changed, 34 insertions(+), 5 deletions(-) (limited to 'app.scm') diff --git a/app.scm b/app.scm index 4491202..355fe58 100644 --- a/app.scm +++ b/app.scm @@ -18,7 +18,8 @@ uri-common (chicken process) (chicken process-context) - (chicken condition)) + (chicken condition) + trace) (define *PORT* (get-environment-variable "PORT")) (define *WEBROOT* (or (get-environment-variable "WEBROOT") @@ -84,9 +85,36 @@ (@ highlight lang) (@ string-trim-both))) +(define (try-with-backoff thunk + #!optional (backoffs (list 10 50 150 500))) + (define (inner boffs return) + (call/cc + (lambda (k) + (with-exception-handler (lambda (exn) (k exn)) + (lambda () (return (thunk)))))) + + (if (null? boffs) (return #f)) + (thread-sleep! (/ (car boffs) 1000.0)) + (inner (cdr boffs) return)) + + (call/cc (lambda (k) (inner backoffs k)))) + (define (convert-md-to-html filepath) - (with-output-to-string - (lambda () (markdown->html (open-input-file filepath))))) + (define (read-md) + (define result (read-string #f (open-input-file filepath))) + (if (eq? #!eof result) + (error 'eof "md file is empty")) + result) + + (define md (try-with-backoff read-md)) + + (if (string? md) + (with-output-to-string + (lambda () (markdown->html (open-input-string md)))) + + ;; else + (begin (print "warning: md file " filepath " seems to be empty!") + ""))) (define (highlight-code-blocks html) (define (highlight-match m) @@ -97,8 +125,9 @@ highlight-match)) (define (insert-to-page-tmpl tmpl-path html) - (format (read-string #f (open-input-file tmpl-path)) - html)) + (define tmpl-port (open-input-file tmpl-path)) + (define tmpl-string (read-string #f tmpl-port)) + (format tmpl-string html)) (define (system-has-fswatch?) (call/cc (lambda (k) -- cgit v1.3