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

Add optionsfor work dir, storage dir and logging level. Split GET and POST requests. Some other changes.

Browse Source
This commit is contained in:
Nikolay Puzanov 2022-12-01 16:50:01 +03:00
parent 43a2e51137
commit 0e4d5a2df3
1 changed files with 218 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,7 +22,6 @@
(embddr optargs)) (embddr optargs))
(define INDEX-FILE "index.html") (define INDEX-FILE "index.html")
(define LOGGING #t)
(define DELETE-WORK-DIR #t) (define DELETE-WORK-DIR #t)
(define DEFAULT-CODE (define DEFAULT-CODE
@ -35,6 +34,21 @@
" end\n" " end\n"
"endmodule\n")) "endmodule\n"))
(define SIM-SV-FILE "testbench.sv")
(define SIM-VC-FILE "testbench.vc")
(define SIM-EXE-FILE "testbench.out")
(define SNIPPET-FILE "code.sv")
(define URI-IVERILOG "iverilog")
(define URI-SAVE-CODE "save")
(define LOG-DBG 3)
(define LOG-VERBOSE 2)
(define LOG-INFO 1)
(define LOG-ERROR 0)
(define LOG-LEVEL LOG-VERBOSE)
(define (multistring . strings) (define (multistring . strings)
(apply string-append (apply string-append
(insert-between strings "\n"))) (insert-between strings "\n")))
@ -78,10 +92,23 @@
(display (apply format args)) (display (apply format args))
(newline)) (newline))
(define (printlog . args) ;;;
(when LOGGING ;;; Logger
;;;
(define (logger . args)
(when (not (null? args))
(let ((prefix
(format "~a | "
(strftime "%c" (localtime (current-time))))))
(if (number? (car args))
(when (<= (car args) LOG-LEVEL)
(display prefix)
(display (apply format (cdr args)))
(newline))
(begin
(display prefix)
(display (apply format args)) (display (apply format args))
(newline))) (newline))))))
;;; ;;;
;;; Return directory list ;;; Return directory list
@ -193,31 +220,48 @@
(match:substring (string-match "[a-zA-Z0-9_]+$" modname)) (match:substring (string-match "[a-zA-Z0-9_]+$" modname))
#f)))))) #f))))))
;;;
;;; Concatenate path elements and remove duplicate slashes
;;;
(define (path+ . paths)
(reverse-list->string
(string-fold
(lambda (c s)
(if (and (not (null? s))
(char=? c #\/)
(char=? (car s) #\/))
s (cons c s)))
'() (string-concatenate
(insert-between
(remove string-null?
(map string-trim-both paths))
"/")))))
;;; ;;;
;;; Create dump module ;;; Create dump module
;;; ;;;
(define (create-dump-module path modname top) (define (create-dump-module path modname top)
(define (* . fmt) (display (apply format fmt)) (newline)) (define (-> . fmt) (display (apply format fmt)) (newline))
(let ((filename (format "~a/~a.v" path modname))) (let ((filename (path+ path (format "~a.v" modname))))
(with-output-to-file filename (with-output-to-file filename
(lambda () (lambda ()
(* "`timescale 1ps/1ps") (-> "`timescale 1ps/1ps")
(* "module ~a();" modname) (-> "module ~a();" modname)
(* " initial begin") (-> " initial begin")
(* " $dumpfile(\"~a/~a.vcd\");" path modname) (-> " $dumpfile(\"~a/~a.vcd\");" path modname)
(* " $dumpvars(0, ~a);" top) (-> " $dumpvars(0, ~a);" top)
(* " end") (-> " end")
(* "endmodule"))) (-> "endmodule")))
filename)) filename))
;;; ;;;
;;; Make workdir with sources and command file ;;; Make workdir with sources and command file
;;; Returns work directory path string ;;; Returns work directory path string
;;; ;;;
(define (make-sim-workdir simulator code top) (define (make-sim-workdir simulator code top base)
(let* ((work-dir (mkdtemp (format "work-~a-XXXXXX" (current-time)))) (let* ((work-dir (mkdtemp (path+ base (format "work-~a-XXXXXX" (current-time)))))
(verilog-file (format "~a/testbench.sv" work-dir)) (verilog-file (path+ work-dir SIM-SV-FILE))
(command-file (format "~a/testbench.vc" work-dir)) (command-file (path+ work-dir SIM-VC-FILE))
(dump-file (create-dump-module work-dir "dump" top))) (dump-file (create-dump-module work-dir "dump" top)))
(with-output-to-file verilog-file (cut display code)) (with-output-to-file verilog-file (cut display code))
(with-output-to-file command-file (with-output-to-file command-file
@ -235,9 +279,10 @@
;;; Returns (values status log) ;;; Returns (values status log)
;;; ;;;
(define (exec-sim-iverilog work-dir vvp-exe iverilog-exe) (define (exec-sim-iverilog work-dir vvp-exe iverilog-exe)
(let ((exe-file (path+ work-dir SIM-EXE-FILE))
(command-file (path+ work-dir SIM-VC-FILE)))
;; Compile ;; Compile
(let ((cmdline (format "~a -g2012 -o ~a/testbench.vvp -c~a/testbench.vc" (let ((cmdline (format "~a -g2012 -o ~a -c~a" iverilog-exe exe-file command-file)))
iverilog-exe work-dir work-dir)))
(let-values (((status out) (let-values (((status out)
(system-to-string cmdline))) (system-to-string cmdline)))
(let ((compile-log (let ((compile-log
@ -246,24 +291,24 @@
(values status compile-log) (values status compile-log)
;; Execute ;; Execute
(let ((cmdline (format "~a ~a/testbench.vvp" vvp-exe work-dir))) (let ((cmdline (format "~a ~a" vvp-exe exe-file)))
(let-values (((status out) (let-values (((status out)
(system-to-string cmdline))) (system-to-string cmdline)))
(let ((execution-log (let ((execution-log
(exe-log-pretty cmdline status out))) (exe-log-pretty cmdline status out)))
(values status (string-append compile-log execution-log)))))))))) (values status (string-append compile-log execution-log)))))))))))
;;; ;;;
;;; Execute simulation ;;; Execute simulation
;;; ;;;
(define* (exec-sim simulator code (define* (exec-sim simulator code base
#:key #:key
(vvp-exe "vvp") (vvp-exe "vvp")
(iverilog-exe "iverilog")) (iverilog-exe "iverilog"))
(let ((top (module-name code))) (let ((top (module-name code)))
(if (not top) (if (not top)
"Error: No module declaration\n" "Error: No module declaration\n"
(let ((work-dir (make-sim-workdir simulator code top))) (let ((work-dir (make-sim-workdir simulator code top base)))
(let-values (let-values
(((status log) (((status log)
(cond (cond
@ -286,9 +331,9 @@
" with errors")))))))) " with errors"))))))))
;;; ;;;
;;; Get storage path from URI ;;; Get storage dir from URI
;;; ;;;
(define (get-storage-path uri root-path) (define (get-storage-dir uri root-path)
(string-trim (string-trim
(substring (uri-path uri) (substring (uri-path uri)
(string-length root-path)) (string-length root-path))
@ -297,9 +342,9 @@
;;; ;;;
;;; Check storage path validity ;;; Check storage path validity
;;; ;;;
(define (valid-storage-path path) (define (storage-dir-valid? dir)
(if (or (< (string-length path) 1) (if (or (< (string-length dir) 1)
(> (string-length path) 32)) (> (string-length dir) 32))
#f #f
(string-fold (string-fold
(lambda (c valid) (lambda (c valid)
@ -307,14 +352,14 @@
(char-numeric? c) (char-numeric? c)
(char=? c #\-)) (char=? c #\-))
valid #f)) valid #f))
#t path))) #t dir)))
;;; ;;;
;;; Check storage exists ;;; Check storage exists
;;; ;;;
(define (storage-exists path) (define (storage-path-exists? path)
(let ((dir-stat (stat path #f)) (let ((dir-stat (stat path #f))
(file-stat (stat (format "~a/code.v" path) #f))) (file-stat (stat (path+ path SNIPPET-FILE) #f)))
(and dir-stat file-stat (and dir-stat file-stat
(eq? (stat:type dir-stat) 'directory) (eq? (stat:type dir-stat) 'directory)
(eq? (stat:type file-stat) 'regular) (eq? (stat:type file-stat) 'regular)
@ -325,100 +370,145 @@
;;; Save code to storage ;;; Save code to storage
;;; ;;;
(define (save-to-storage path code) (define (save-to-storage path code)
(with-output-to-file (format "~a/code.v" path) (with-output-to-file (path+ path SNIPPET-FILE)
(cut display code))) (cut display code)))
;;; ;;;
;;; Read from storage ;;; Read from storage
;;; ;;;
(define (read-from-storage path) (define (read-from-storage path)
(call-with-input-file (format "~a/code.v" path) (call-with-input-file (path+ path SNIPPET-FILE)
get-string-all)) get-string-all))
;;; ;;;
;;; Web page handler ;;; Web page handler
;;; ;;;
(define (make-page-handler host root index-file (define (make-page-handler host root index-file
work-base stor-base
max-code-size max-code-size
vvp-exe iverilog-exe) vvp-exe iverilog-exe)
(let* ((root-path (split-and-decode-uri-path root)) (let* ((root-path (split-and-decode-uri-path root))
(root (encode-and-join-uri-path root-path)) (root (encode-and-join-uri-path root-path))
(iverilog-path (append root-path '("iverilog"))) (iverilog-path (append root-path `(,URI-IVERILOG)))
(savecode-path (append root-path '("save"))) (savecode-path (append root-path `(,URI-SAVE-CODE)))
(iverilog-post-uri (string-append host "/" (encode-and-join-uri-path iverilog-path))) (iverilog-post-uri (encode-and-join-uri-path iverilog-path))
(savecode-post-uri (string-append host "/" (encode-and-join-uri-path savecode-path))) (savecode-post-uri (encode-and-join-uri-path savecode-path))
(index-html (read-template-text index-file `(("IVERILOGPOSTURI" ,iverilog-post-uri) (index-html (read-template-text index-file `(("IVERILOGPOSTURI" ,iverilog-post-uri)
("SAVECODEURI" ,savecode-post-uri))))) ("SAVECODEURI" ,savecode-post-uri)))))
(lambda (request request-body) (lambda (request request-body)
(let* ((path (split-and-decode-uri-path (let (;; Requested resource path
(path (split-and-decode-uri-path
(uri-path (uri-path
(request-uri request)))) (request-uri request))))
(ref (assoc 'referer (request-headers request)))
(ref-stor (if ref (get-storage-path (cdr ref) root) "")) ;; Snippet dir path relative to stor-base
(ref-stor (if (and (valid-storage-path ref-stor) (ref-stor-dir
(storage-exists ref-stor)) (let ((ref (assoc 'referer (request-headers request))))
ref-stor #f)) (and ref
(code (if request-body (utf8->string request-body) "")) (let ((p (get-storage-dir (cdr ref) root)))
(code (if (or (zero? max-code-size) (and (storage-dir-valid? p)
(storage-path-exists? (path+ stor-base p))
p)))))
;; Body of the POST request
(code
(if request-body
(let ((code (utf8->string request-body)))
(if (or (zero? max-code-size)
(<= (string-length code) max-code-size)) (<= (string-length code) max-code-size))
code code
(substring code 0 max-code-size)))) (substring code 0 max-code-size)))
"")))
(printlog "-- path: ~a" path) (logger LOG-VERBOSE "Request ~a:~a" (request-method request) path)
(printlog "-- ref-stor: ~a" ref-stor) (logger LOG-DBG " stor:'~a' len:~a/~a"
(printlog "-- length: ~a/~a" ref-stor-dir
(request-content-length request) (request-content-length request)
(string-length code)) (string-length code))
(cond (cond
;; Iverilog ;;
((equal? path iverilog-path) ;; ---- GET requests
(printlog "-- Request simulate") ;;
((eq? 'GET (request-method request))
(cond
;; Index page
((equal? path root-path)
(logger LOG-DBG "Request index page")
(make-response
(substitute index-html "@~a@" `((CODE ,DEFAULT-CODE)))))
(when ref-stor ;; Get saved snippet
(save-to-storage ref-stor code)) ((and (= (length path)
(+ (length root-path) 1))
(every equal? path root-path))
(logger LOG-DBG "Request code from storage")
(let ((code
(if (null? path)
DEFAULT-CODE
(let* ((stor-dir (last path))
(stor-path (path+ stor-base stor-dir)))
(if (and (storage-dir-valid? stor-dir)
(storage-path-exists? stor-path))
(read-from-storage stor-path)
DEFAULT-CODE)))))
(make-response
(substitute index-html "@~a@" `((CODE ,code))))))
;; Wrong GET request
(else
(logger LOG-DBG "Wrong GET request")
(not-found request))))
;;
;; ---- POST requests
;;
((eq? 'POST (request-method request))
(cond
;; Run iverilog simulation
((equal? path iverilog-path)
(logger LOG-DBG "Request iverilog simulation")
(when ref-stor-dir
(save-to-storage (path+ stor-base ref-stor-dir) code))
(make-response (make-response
(exec-sim 'iverilog (exec-sim 'iverilog
(sanitize-verilog code) (sanitize-verilog code)
work-base
#:vvp-exe vvp-exe #:vvp-exe vvp-exe
#:iverilog-exe iverilog-exe) #:iverilog-exe iverilog-exe)
#:type 'text/plain)) #:type 'text/plain))
;; Save code ;; Save snippet
((equal? path savecode-path) ((equal? path savecode-path)
(printlog "-- Request save code") (logger LOG-DBG "Request code saving")
(let ((storage (or ref-stor (let ((stor-dir
(mkdtemp (format "~a-XXXXXX" (current-time)))))) (or ref-stor-dir
(save-to-storage storage code) (basename
(mkdtemp
(path+
stor-base
(format "~a-XXXXXX"
(current-time))))))))
(save-to-storage (path+ stor-base stor-dir) code)
(make-response (make-response
(encode-and-join-uri-path (encode-and-join-uri-path
(append root-path `(,storage)))))) (append root-path `(,stor-dir)))
#:type 'text/plain)))
;; Index page ;; Wrong POST request
((equal? path root-path)
(printlog "-- Request index page")
(make-response
(substitute index-html "@~a@" `((CODE ,DEFAULT-CODE)))))
;; Storage
((and (> (length path)
(length root-path))
(every equal? path root-path))
(let ((storage (if (null? path) "" (last path))))
(printlog "-- Request code from storage ~a" storage)
(if (and (valid-storage-path storage)
(storage-exists storage))
(let ((code (read-from-storage storage)))
(make-response
(substitute index-html "@~a@" `((CODE ,code)))))
(make-response
(substitute index-html "@~a@" `((CODE ,DEFAULT-CODE)))))))
;; Wrong request
(else (else
(printlog "-- Request wrong path") (logger LOG-DBG "Wrong POST request")
(not-found request))))
;;
;; ---- Unknown requests type
;;
(else
(logger LOG-DBG "Wrong request method")
(not-found request))))))) (not-found request)))))))
;;; ;;;
@ -445,6 +535,9 @@
(-> " --ivverilog-exe PATH Set Icarus Verilog compiler executable. Default: iverilog") (-> " --ivverilog-exe PATH Set Icarus Verilog compiler executable. Default: iverilog")
(-> " --vvp-exe PATH Set Icarus Verilog interpreter executable. Default: vvp") (-> " --vvp-exe PATH Set Icarus Verilog interpreter executable. Default: vvp")
(-> " --max-len LEN Set maximum code size in symbols. Default: 0 (infinite)") (-> " --max-len LEN Set maximum code size in symbols. Default: 0 (infinite)")
(-> " --work-base PATH Set work base path. Default: ./")
(-> " --stor-base PATH Set snippets storage path. Default: ./")
(-> " --log-level LEVEL Set log level from 0 (quiet) to 10 (verbose). Default: 1./")
(-> " -h, --help Print this message and exit") (-> " -h, --help Print this message and exit")
(-> "") (-> "")
(-> "Source code and issue tracker: <https://github.com/punzik/>"))))) (-> "Source code and issue tracker: <https://github.com/punzik/>")))))
@ -461,6 +554,9 @@
'(("vvp-exe") required) '(("vvp-exe") required)
'(("iverilog-exe") required) '(("iverilog-exe") required)
'(("max-len") required) '(("max-len") required)
'(("work-base") required)
'(("stor-base") required)
'(("log-level") required)
'(("help" #\h) none)))) '(("help" #\h) none))))
(let ((addr (string-trim (or (option-get opts "addr") "127.0.0.1"))) (let ((addr (string-trim (or (option-get opts "addr") "127.0.0.1")))
@ -469,7 +565,12 @@
(root (string-trim (or (option-get opts "root") ""))) (root (string-trim (or (option-get opts "root") "")))
(vvp (string-trim (or (option-get opts "vvp-exe") "vvp"))) (vvp (string-trim (or (option-get opts "vvp-exe") "vvp")))
(iverilog (string-trim (or (option-get opts "iverilog-exe") "iverilog"))) (iverilog (string-trim (or (option-get opts "iverilog-exe") "iverilog")))
(max-code-size (string->number (string-trim (or (option-get opts "max-len") "0"))))) (max-code-size (string->number (string-trim (or (option-get opts "max-len") "0"))))
(work-base (string-trim (or (option-get opts "work-base") "./")))
(stor-base (string-trim (or (option-get opts "stor-base") "./")))
(log-level (string->number (string-trim (or (option-get opts "log-level") "1")))))
(set! LOG-LEVEL log-level)
(cond (cond
(err (err
@ -482,10 +583,14 @@
(exit -1)) (exit -1))
(else (else
(printlog "Listen on '~a' port '~a'" addr port) (logger LOG-INFO "Listen on '~a' port '~a'" addr port)
(printlog "Server URL: '~a/~a'" host root) (logger LOG-INFO "Server URL: '~a/~a'" host root)
(printlog "Max code size: ~a" max-code-size) (logger LOG-INFO "Max code size: ~a" max-code-size)
(logger LOG-INFO "Work base path: '~a'" work-base)
(logger LOG-INFO "Storage base path: '~a'" stor-base)
(run-server (run-server
(make-page-handler host root INDEX-FILE max-code-size vvp iverilog) (make-page-handler host root INDEX-FILE
work-base stor-base
max-code-size vvp iverilog)
'http `(#:host ,addr #:port ,port))))))) 'http `(#:host ,addr #:port ,port)))))))