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 (uri-path
(request-uri request)))) (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 ;; Body of the POST request
(code (code
(if request-body (if request-body
@ -828,6 +837,10 @@
(logger LOG-VERBOSE "Request ~a:~a" (request-method request) path) (logger LOG-VERBOSE "Request ~a:~a" (request-method request) path)
(logger LOG-VERBOSE "Request query:~a" query) (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 (cond
;; ;;
@ -909,19 +922,30 @@
;; Save snippet ;; Save snippet
((or (equal? path savecode-path)) ((or (equal? path savecode-path))
(logger LOG-DBG "Request code saving") (logger LOG-DBG "Request code saving")
(let ((stor-dir (let ((old-code
(basename (if ref-stor-dir
(mkdtemp (read-from-storage (path+ stor-base ref-stor-dir))
(path+ DEFAULT-CODE)))
stor-base (if (equal? code old-code)
(if USE-TIME-IN-SAVE-URL ;; If code is not changed do nothing
(format "~a-XXXXXX" (current-time)) (make-response
"XXXXXX")))))) (encode-and-join-uri-path
(save-to-storage (path+ stor-base stor-dir) code) (append root-path `(,ref-stor-dir)))
(make-response #:content-type 'text/plain)
(encode-and-join-uri-path ;; New code save to new location
(append root-path `(,stor-dir))) (let ((stor-dir
#:content-type 'text/plain))) (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 ;; Wrong POST request
(else (else