From 94dfe35eadddc36df4e26a4a0a325ff2b828f69b Mon Sep 17 00:00:00 2001
From: Lehi Toskin <lehi@tosk.in>
Date: Sat, 22 Sep 2018 13:04:59 -0700
Subject: [PATCH] Resolve #97

Use temporary file when writing to disk.
---
 embed.rkt      | 60 +++++++++++++++++++++++---------------------------
 thumbnails.rkt | 20 ++++++-----------
 2 files changed, 35 insertions(+), 45 deletions(-)

diff --git a/embed.rkt b/embed.rkt
index 1305f8c..b3c857d 100644
--- a/embed.rkt
+++ b/embed.rkt
@@ -265,10 +265,7 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP"
   (define itxt-hash (make-itxt-hash itxt-bstr))
   (define new-hash (itxt-set png-hash itxt-hash "XML:com.adobe.xmp"))
   (define new-png (hash->png new-hash))
-  (with-output-to-file png
-    (λ () (display new-png))
-    #:mode 'binary
-    #:exists 'truncate/replace))
+  (call-with-atomic-output-file png (λ (out tmp-png) (void (write-bytes new-png out)))))
 
 (define (add-embed-jpeg! jpeg taglist)
   (define jpeg-bytes (if (bytes? jpeg)
@@ -347,15 +344,16 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP"
                                            (cdr marker))
                                        len
                                        (bytes-length len-bstr))))
-  (with-output-to-file flif
-    (λ () (printf "~a~a~a~a~a"
-                  before
-                  #"eXmp"
-                  (length->bytes (bytes-length deflated-bstr))
-                  deflated-bstr
-                  after))
-    #:mode 'binary
-    #:exists 'truncate/replace))
+  (call-with-atomic-output-file
+   flif
+   (λ (out tmp-flif)
+     (fprintf out
+              "~a~a~a~a~a"
+              before
+              #"eXmp"
+              (length->bytes (bytes-length deflated-bstr))
+              deflated-bstr
+              after))))
 
 (define (set-embed-flif! flif taglist)
   (define old-xmp (get-embed-flif flif))
@@ -375,10 +373,7 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP"
   (define itxt-hash (make-itxt-hash itxt-bstr))
   (define new-hash (itxt-set png-hash itxt-hash "XML:com.adobe.xmp"))
   (define new-png (hash->png new-hash))
-  (with-output-to-file png
-    (λ () (display new-png))
-    #:mode 'binary
-    #:exists 'truncate/replace))
+  (call-with-atomic-output-file png (λ (out tmp-png) (void (write-bytes new-png out)))))
 
 ; takes a list of strings and embeds them into a valid PNG
 (define (set-embed-png! png taglist)
@@ -429,15 +424,15 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP"
                     (integer->integer-bytes len 2 #f #t)
                     jpeg-XMP-id
                     xmp-bstr)))
-  (with-output-to-file jpeg
-    (λ ()
-      ; sandwich the new XMP APP1 between the old data
-      (printf "~a~a~a"
+  (call-with-atomic-output-file
+   jpeg
+   (λ (out tmp-jpeg)
+     ; sandwich the new XMP APP1 beteen the old data
+     (fprintf out
+              "~a~a~a"
               bstr-before
               app1-bstr
-              bstr-after))
-    #:mode 'binary
-    #:exists 'truncate/replace))
+              bstr-after))))
 
 ; what a giant mess this is
 (define (set-embed-jpeg! jpeg taglist)
@@ -490,10 +485,14 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP"
   (define after-bstr (if (empty? pos-pair)
                          (bytes #x3b)
                          (subbytes bstr (+ (first (first pos-pair)) (second (first pos-pair))))))
-  (with-output-to-file gif
-    (λ () (printf "~a~a~a" before-bstr new-appn-xmp after-bstr))
-    #:mode 'binary
-    #:exists 'truncate/replace))
+  (call-with-atomic-output-file
+   gif
+   (λ (out tmp-gif)
+     (fprintf out
+              "~a~a~a"
+              before-bstr
+              new-appn-xmp
+              after-bstr))))
 
 ; embed the taglist into the gif
 ; application extension only available for GIF89a!
@@ -539,10 +538,7 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP"
                   (string->bytes/utf-8 xmp-str)
                   #"</metadata>"
                   after))
-  (with-output-to-file svg
-    (λ () (display xmp-bstr))
-    #:mode 'binary
-    #:exists 'truncate/replace))
+  (call-with-atomic-output-file svg (λ (out tmp-svg) (void (write-bytes xmp-bstr out)))))
 
 (define/contract (set-embed-svg! img taglist)
   ((and/c path-string? embed-support?) (listof string?) . -> . void?)
diff --git a/thumbnails.rkt b/thumbnails.rkt
index 1950079..e14e46c 100644
--- a/thumbnails.rkt
+++ b/thumbnails.rkt
@@ -7,6 +7,7 @@
          png-image
          racket/contract
          racket/draw
+         racket/file
          racket/list
          racket/path
          racket/string
@@ -53,17 +54,9 @@
          (first (flif->list path #:animation? #f))]
         [else (read-bitmap path)]))
     (define thumb-path (path->md5 path))
-    ; use a temporary file in case there's concurrent
-    ; thumbnail generation going on
-    (define thumb-tmp
-      (build-path thumbnails-path
-                  (string-append (number->string (current-seconds)) "_ivy-tmp.png")))
     ; use pict to scale the image to 128x128
     (define thumb-pct (bitmap thumb-bmp))
     (define thumb-small (pict->bitmap (scale-to-fit thumb-pct 128 128)))
-    (define thumb-port-out (open-output-file thumb-tmp
-                                             #:mode 'binary
-                                             #:exists 'truncate/replace))
     (printf "Writing bytes to ~a~n" thumb-path)
     (define thumb-hash (png->hash (convert thumb-small 'png-bytes)))
     ; set thumbnail attributes
@@ -99,10 +92,11 @@
                              (make-text-chunk mime "Thumb::Mimetype"))
                             "Thumb::Mimetype")])
         (text-set mty (make-text-hash (make-text-chunk software "Software")) "Software")))
-    ; save to disk
-    (write-bytes (hash->png setted) thumb-port-out)
-    (close-output-port thumb-port-out)
-    ; rename thumb-tmp to thumb-path
-    (rename-file-or-directory thumb-tmp thumb-path #t)
+    ; use a temporary file in case there's concurrent thumbnail generation going on
+    (call-with-atomic-output-file
+     thumb-path
+     (λ (thumb-out thumb-tmp)
+       ; save to disk
+       (write-bytes (hash->png setted) thumb-out)))
     (unless (eq? (system-type) 'windows)
       (file-or-directory-permissions thumb-path #o600))))