np/verilog-playground
1
0
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

Don't save unmodified code

Browse Source
This commit is contained in:
Nikolay Puzanov 2022-12-09 09:20:53 +03:00
parent 1bc6ec544d
commit 1e12d5d3e2
1 changed files with 37 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
_web_server/server/playground-server.scm
View File

@ -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