Add optionsfor work dir, storage dir and logging level. Split GET and POST requests. Some other changes.
This commit is contained in:
Nikolay Puzanov
parent
43a2e51137
commit
0e4d5a2df3
@ -22,7 +22,6 @@
|
||||
(embddr optargs))
|
||||
|
||||
(define INDEX-FILE "index.html")
|
||||
(define LOGGING #t)
|
||||
(define DELETE-WORK-DIR #t)
|
||||
|
||||
(define DEFAULT-CODE
|
||||
@ -35,6 +34,21 @@
|
||||
" end\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)
|
||||
(apply string-append
|
||||
(insert-between strings "\n")))
|
||||
@ -78,10 +92,23 @@
|
||||
(display (apply format args))
|
||||
(newline))
|
||||
|
||||
(define (printlog . args)
|
||||
(when LOGGING
|
||||
(display (apply format args))
|
||||
(newline)))
|
||||
;;;
|
||||
;;; 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))
|
||||
(newline))))))
|
||||
|
||||
;;;
|
||||
;;; Return directory list
|
||||
@ -193,31 +220,48 @@
|
||||
(match:substring (string-match "[a-zA-Z0-9_]+$" modname))
|
||||
#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
|
||||
;;;
|
||||
(define (create-dump-module path modname top)
|
||||
(define (* . fmt) (display (apply format fmt)) (newline))
|
||||
(let ((filename (format "~a/~a.v" path modname)))
|
||||
(define (-> . fmt) (display (apply format fmt)) (newline))
|
||||
(let ((filename (path+ path (format "~a.v" modname))))
|
||||
(with-output-to-file filename
|
||||
(lambda ()
|
||||
(* "`timescale 1ps/1ps")
|
||||
(* "module ~a();" modname)
|
||||
(* " initial begin")
|
||||
(* " $dumpfile(\"~a/~a.vcd\");" path modname)
|
||||
(* " $dumpvars(0, ~a);" top)
|
||||
(* " end")
|
||||
(* "endmodule")))
|
||||
(-> "`timescale 1ps/1ps")
|
||||
(-> "module ~a();" modname)
|
||||
(-> " initial begin")
|
||||
(-> " $dumpfile(\"~a/~a.vcd\");" path modname)
|
||||
(-> " $dumpvars(0, ~a);" top)
|
||||
(-> " end")
|
||||
(-> "endmodule")))
|
||||
filename))
|
||||
|
||||
;;;
|
||||
;;; Make workdir with sources and command file
|
||||
;;; Returns work directory path string
|
||||
;;;
|
||||
(define (make-sim-workdir simulator code top)
|
||||
(let* ((work-dir (mkdtemp (format "work-~a-XXXXXX" (current-time))))
|
||||
(verilog-file (format "~a/testbench.sv" work-dir))
|
||||
(command-file (format "~a/testbench.vc" work-dir))
|
||||
(define (make-sim-workdir simulator code top base)
|
||||
(let* ((work-dir (mkdtemp (path+ base (format "work-~a-XXXXXX" (current-time)))))
|
||||
(verilog-file (path+ work-dir SIM-SV-FILE))
|
||||
(command-file (path+ work-dir SIM-VC-FILE))
|
||||
(dump-file (create-dump-module work-dir "dump" top)))
|
||||
(with-output-to-file verilog-file (cut display code))
|
||||
(with-output-to-file command-file
|
||||
@ -235,35 +279,36 @@
|
||||
;;; Returns (values status log)
|
||||
;;;
|
||||
(define (exec-sim-iverilog work-dir vvp-exe iverilog-exe)
|
||||
;; Compile
|
||||
(let ((cmdline (format "~a -g2012 -o ~a/testbench.vvp -c~a/testbench.vc"
|
||||
iverilog-exe work-dir work-dir)))
|
||||
(let-values (((status out)
|
||||
(system-to-string cmdline)))
|
||||
(let ((compile-log
|
||||
(exe-log-pretty cmdline status out)))
|
||||
(if (not (zero? status))
|
||||
(values status compile-log)
|
||||
(let ((exe-file (path+ work-dir SIM-EXE-FILE))
|
||||
(command-file (path+ work-dir SIM-VC-FILE)))
|
||||
;; Compile
|
||||
(let ((cmdline (format "~a -g2012 -o ~a -c~a" iverilog-exe exe-file command-file)))
|
||||
(let-values (((status out)
|
||||
(system-to-string cmdline)))
|
||||
(let ((compile-log
|
||||
(exe-log-pretty cmdline status out)))
|
||||
(if (not (zero? status))
|
||||
(values status compile-log)
|
||||
|
||||
;; Execute
|
||||
(let ((cmdline (format "~a ~a/testbench.vvp" vvp-exe work-dir)))
|
||||
(let-values (((status out)
|
||||
(system-to-string cmdline)))
|
||||
(let ((execution-log
|
||||
(exe-log-pretty cmdline status out)))
|
||||
(values status (string-append compile-log execution-log))))))))))
|
||||
;; Execute
|
||||
(let ((cmdline (format "~a ~a" vvp-exe exe-file)))
|
||||
(let-values (((status out)
|
||||
(system-to-string cmdline)))
|
||||
(let ((execution-log
|
||||
(exe-log-pretty cmdline status out)))
|
||||
(values status (string-append compile-log execution-log)))))))))))
|
||||
|
||||
;;;
|
||||
;;; Execute simulation
|
||||
;;;
|
||||
(define* (exec-sim simulator code
|
||||
(define* (exec-sim simulator code base
|
||||
#:key
|
||||
(vvp-exe "vvp")
|
||||
(iverilog-exe "iverilog"))
|
||||
(let ((top (module-name code)))
|
||||
(if (not top)
|
||||
"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
|
||||
(((status log)
|
||||
(cond
|
||||
@ -286,9 +331,9 @@
|
||||
" 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
|
||||
(substring (uri-path uri)
|
||||
(string-length root-path))
|
||||
@ -297,9 +342,9 @@
|
||||
;;;
|
||||
;;; Check storage path validity
|
||||
;;;
|
||||
(define (valid-storage-path path)
|
||||
(if (or (< (string-length path) 1)
|
||||
(> (string-length path) 32))
|
||||
(define (storage-dir-valid? dir)
|
||||
(if (or (< (string-length dir) 1)
|
||||
(> (string-length dir) 32))
|
||||
#f
|
||||
(string-fold
|
||||
(lambda (c valid)
|
||||
@ -307,14 +352,14 @@
|
||||
(char-numeric? c)
|
||||
(char=? c #\-))
|
||||
valid #f))
|
||||
#t path)))
|
||||
#t dir)))
|
||||
|
||||
;;;
|
||||
;;; Check storage exists
|
||||
;;;
|
||||
(define (storage-exists path)
|
||||
(define (storage-path-exists? path)
|
||||
(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
|
||||
(eq? (stat:type dir-stat) 'directory)
|
||||
(eq? (stat:type file-stat) 'regular)
|
||||
@ -325,100 +370,145 @@
|
||||
;;; Save code to storage
|
||||
;;;
|
||||
(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)))
|
||||
|
||||
;;;
|
||||
;;; Read from storage
|
||||
;;;
|
||||
(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))
|
||||
|
||||
;;;
|
||||
;;; Web page handler
|
||||
;;;
|
||||
(define (make-page-handler host root index-file
|
||||
work-base stor-base
|
||||
max-code-size
|
||||
vvp-exe iverilog-exe)
|
||||
|
||||
(let* ((root-path (split-and-decode-uri-path root))
|
||||
(root (encode-and-join-uri-path root-path))
|
||||
(iverilog-path (append root-path '("iverilog")))
|
||||
(savecode-path (append root-path '("save")))
|
||||
(iverilog-post-uri (string-append host "/" (encode-and-join-uri-path iverilog-path)))
|
||||
(savecode-post-uri (string-append host "/" (encode-and-join-uri-path savecode-path)))
|
||||
(iverilog-path (append root-path `(,URI-IVERILOG)))
|
||||
(savecode-path (append root-path `(,URI-SAVE-CODE)))
|
||||
(iverilog-post-uri (encode-and-join-uri-path iverilog-path))
|
||||
(savecode-post-uri (encode-and-join-uri-path savecode-path))
|
||||
(index-html (read-template-text index-file `(("IVERILOGPOSTURI" ,iverilog-post-uri)
|
||||
("SAVECODEURI" ,savecode-post-uri)))))
|
||||
|
||||
(lambda (request request-body)
|
||||
(let* ((path (split-and-decode-uri-path
|
||||
(uri-path
|
||||
(request-uri request))))
|
||||
(ref (assoc 'referer (request-headers request)))
|
||||
(ref-stor (if ref (get-storage-path (cdr ref) root) ""))
|
||||
(ref-stor (if (and (valid-storage-path ref-stor)
|
||||
(storage-exists ref-stor))
|
||||
ref-stor #f))
|
||||
(code (if request-body (utf8->string request-body) ""))
|
||||
(code (if (or (zero? max-code-size)
|
||||
(let (;; Requested resource path
|
||||
(path (split-and-decode-uri-path
|
||||
(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
|
||||
(let ((code (utf8->string request-body)))
|
||||
(if (or (zero? max-code-size)
|
||||
(<= (string-length code) max-code-size))
|
||||
code
|
||||
(substring code 0 max-code-size))))
|
||||
(substring code 0 max-code-size)))
|
||||
"")))
|
||||
|
||||
(printlog "-- path: ~a" path)
|
||||
(printlog "-- ref-stor: ~a" ref-stor)
|
||||
(printlog "-- length: ~a/~a"
|
||||
(request-content-length request)
|
||||
(string-length code))
|
||||
(logger LOG-VERBOSE "Request ~a:~a" (request-method request) path)
|
||||
(logger LOG-DBG " stor:'~a' len:~a/~a"
|
||||
ref-stor-dir
|
||||
(request-content-length request)
|
||||
(string-length code))
|
||||
|
||||
(cond
|
||||
;; Iverilog
|
||||
((equal? path iverilog-path)
|
||||
(printlog "-- Request simulate")
|
||||
|
||||
(when ref-stor
|
||||
(save-to-storage ref-stor code))
|
||||
|
||||
(make-response
|
||||
(exec-sim 'iverilog
|
||||
(sanitize-verilog code)
|
||||
#:vvp-exe vvp-exe
|
||||
#:iverilog-exe iverilog-exe)
|
||||
#:type 'text/plain))
|
||||
|
||||
;; Save code
|
||||
((equal? path savecode-path)
|
||||
(printlog "-- Request save code")
|
||||
(let ((storage (or ref-stor
|
||||
(mkdtemp (format "~a-XXXXXX" (current-time))))))
|
||||
(save-to-storage storage code)
|
||||
;;
|
||||
;; ---- GET requests
|
||||
;;
|
||||
((eq? 'GET (request-method request))
|
||||
(cond
|
||||
;; Index page
|
||||
((equal? path root-path)
|
||||
(logger LOG-DBG "Request index page")
|
||||
(make-response
|
||||
(encode-and-join-uri-path
|
||||
(append root-path `(,storage))))))
|
||||
(substitute index-html "@~a@" `((CODE ,DEFAULT-CODE)))))
|
||||
|
||||
;; Index page
|
||||
((equal? path root-path)
|
||||
(printlog "-- Request index page")
|
||||
(make-response
|
||||
(substitute index-html "@~a@" `((CODE ,DEFAULT-CODE)))))
|
||||
;; Get saved snippet
|
||||
((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))))))
|
||||
|
||||
;; 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 GET request
|
||||
(else
|
||||
(logger LOG-DBG "Wrong GET request")
|
||||
(not-found request))))
|
||||
|
||||
;; Wrong 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
|
||||
(exec-sim 'iverilog
|
||||
(sanitize-verilog code)
|
||||
work-base
|
||||
#:vvp-exe vvp-exe
|
||||
#:iverilog-exe iverilog-exe)
|
||||
#:type 'text/plain))
|
||||
|
||||
;; Save snippet
|
||||
((equal? path savecode-path)
|
||||
(logger LOG-DBG "Request code saving")
|
||||
(let ((stor-dir
|
||||
(or ref-stor-dir
|
||||
(basename
|
||||
(mkdtemp
|
||||
(path+
|
||||
stor-base
|
||||
(format "~a-XXXXXX"
|
||||
(current-time))))))))
|
||||
(save-to-storage (path+ stor-base stor-dir) code)
|
||||
(make-response
|
||||
(encode-and-join-uri-path
|
||||
(append root-path `(,stor-dir)))
|
||||
#:type 'text/plain)))
|
||||
|
||||
;; Wrong POST request
|
||||
(else
|
||||
(logger LOG-DBG "Wrong POST request")
|
||||
(not-found request))))
|
||||
|
||||
;;
|
||||
;; ---- Unknown requests type
|
||||
;;
|
||||
(else
|
||||
(printlog "-- Request wrong path")
|
||||
(logger LOG-DBG "Wrong request method")
|
||||
(not-found request)))))))
|
||||
|
||||
;;;
|
||||
@ -445,6 +535,9 @@
|
||||
(-> " --ivverilog-exe PATH Set Icarus Verilog compiler executable. Default: iverilog")
|
||||
(-> " --vvp-exe PATH Set Icarus Verilog interpreter executable. Default: vvp")
|
||||
(-> " --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")
|
||||
(-> "")
|
||||
(-> "Source code and issue tracker: <https://github.com/punzik/>")))))
|
||||
@ -461,6 +554,9 @@
|
||||
'(("vvp-exe") required)
|
||||
'(("iverilog-exe") required)
|
||||
'(("max-len") required)
|
||||
'(("work-base") required)
|
||||
'(("stor-base") required)
|
||||
'(("log-level") required)
|
||||
'(("help" #\h) none))))
|
||||
|
||||
(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") "")))
|
||||
(vvp (string-trim (or (option-get opts "vvp-exe") "vvp")))
|
||||
(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
|
||||
(err
|
||||
@ -482,10 +583,14 @@
|
||||
(exit -1))
|
||||
|
||||
(else
|
||||
(printlog "Listen on '~a' port '~a'" addr port)
|
||||
(printlog "Server URL: '~a/~a'" host root)
|
||||
(printlog "Max code size: ~a" max-code-size)
|
||||
(logger LOG-INFO "Listen on '~a' port '~a'" addr port)
|
||||
(logger LOG-INFO "Server URL: '~a/~a'" host root)
|
||||
(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
|
||||
(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)))))))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user