From 4b0ce31c5f139d371af1b063f83cf980e06fabaf Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Mon, 25 Sep 2023 23:43:23 +0100 Subject: Ensure atomic writes to cache. * rent.scm (call-with-atomic-output-file): New function. (http-get*): Use call-with-atomic-output-file instead of call-with-output-file. --- rent.scm | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) (limited to 'rent.scm') diff --git a/rent.scm b/rent.scm index 3fe8d94..7258c5e 100644 --- a/rent.scm +++ b/rent.scm @@ -1,5 +1,5 @@ ;;; rent-in-london --- Shortlist houses to rent in London -;;; Copyright © 2022 Arun Isaac +;;; Copyright © 2022, 2023 Arun Isaac ;;; ;;; This program is free software: you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as @@ -61,6 +61,22 @@ (define %tfl-base-url "https://api.tfl.gov.uk") +(define (call-with-atomic-output-file filename proc) + "Open @var{filename} for output and pass the open port to +@var{proc}. Writes to @var{filename} are guaranteed to be atomic." + (let* ((temporary-port (mkstemp "rent-XXXXXX")) + (temporary-filename (port-filename temporary-port))) + (dynamic-wind + (const #t) + (lambda () + (call-with-port temporary-port + (lambda _ + (proc temporary-port) + (fsync temporary-port))) + (rename-file temporary-filename filename)) + (lambda () + (false-if-exception (delete-file temporary-filename)))))) + (define (json-ref scm . keys) (match keys ((key other-keys ...) @@ -207,7 +223,7 @@ (> (current-time) (+ (stat:mtime (stat cache-file)) cache-live-time)))) - (call-with-output-file cache-file + (call-with-atomic-output-file cache-file (cut put-bytevector <> (http-get-follow uri)))) ;; Return contents of cache. (call-with-input-file cache-file -- cgit v1.2.3