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(-)

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 <arunisaac@systemreboot.net>
+;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; 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