From 1e12d5d3e2d5c09fce9958aed4d1eed9e2354474 Mon Sep 17 00:00:00 2001
From: Nikolay Puzanov <np@embddr.com>
Date: Fri, 9 Dec 2022 09:20:53 +0300
Subject: [PATCH] Don't save unmodified code

---
 _web_server/server/playground-server.scm | 50 ++++++++++++++++++------
 1 file changed, 37 insertions(+), 13 deletions(-)

diff --git a/_web_server/server/playground-server.scm b/_web_server/server/playground-server.scm
index cf40fd4..13f48f5 100755
--- a/_web_server/server/playground-server.scm
+++ b/_web_server/server/playground-server.scm
@@ -809,6 +809,15 @@
                    (uri-path
                     (request-uri request))))
 
+            ;; Snippet dir path relative to stor-base
+            (ref-stor-dir
+             (let ((ref (assoc 'referer (request-headers request))))
+               (and ref
+                    (let ((p (get-storage-dir (cdr ref) root)))
+                      (and (storage-dir-valid? p)
+                           (storage-path-exists? (path+ stor-base p))
+                           p)))))
+
             ;; Body of the POST request
             (code
              (if request-body
@@ -828,6 +837,10 @@
 
         (logger LOG-VERBOSE "Request ~a:~a" (request-method request) path)
         (logger LOG-VERBOSE "Request query:~a" query)
+        (logger LOG-DBG "  stor:'~a' len:~a/~a"
+                ref-stor-dir
+                (request-content-length request)
+                (string-length code))
 
         (cond
          ;;
@@ -909,19 +922,30 @@
            ;; Save snippet
            ((or (equal? path savecode-path))
             (logger LOG-DBG "Request code saving")
-            (let ((stor-dir
-                   (basename
-                    (mkdtemp
-                     (path+
-                      stor-base
-                      (if USE-TIME-IN-SAVE-URL
-                          (format "~a-XXXXXX" (current-time))
-                          "XXXXXX"))))))
-              (save-to-storage (path+ stor-base stor-dir) code)
-              (make-response
-               (encode-and-join-uri-path
-                (append root-path `(,stor-dir)))
-               #:content-type 'text/plain)))
+            (let ((old-code
+                   (if ref-stor-dir
+                       (read-from-storage (path+ stor-base ref-stor-dir))
+                       DEFAULT-CODE)))
+              (if (equal? code old-code)
+                  ;; If code is not changed do nothing
+                  (make-response
+                   (encode-and-join-uri-path
+                    (append root-path `(,ref-stor-dir)))
+                   #:content-type 'text/plain)
+                  ;; New code save to new location
+                  (let ((stor-dir
+                         (basename
+                          (mkdtemp
+                           (path+
+                            stor-base
+                            (if USE-TIME-IN-SAVE-URL
+                                (format "~a-XXXXXX" (current-time))
+                                "XXXXXX"))))))
+                    (save-to-storage (path+ stor-base stor-dir) code)
+                    (make-response
+                     (encode-and-join-uri-path
+                      (append root-path `(,stor-dir)))
+                     #:content-type 'text/plain)))))
 
            ;; Wrong POST request
            (else