diff --git a/_web_server/server/playground-server.scm b/_web_server/server/playground-server.scm index fa8b2bb..73bbfee 100755 --- a/_web_server/server/playground-server.scm +++ b/_web_server/server/playground-server.scm @@ -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: "))))) @@ -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)))))))