Files
verilog-playground/_web_server/server/playground-server.scm

803 lines
28 KiB
Scheme
Raw Normal View History

2022-11-29 20:53:17 +03:00
#!/usr/bin/env -S guile -e "main" -s
!#
;; -*- geiser-scheme-implementation: guile -*-
(import (srfi srfi-1)
(srfi srfi-11)
2022-11-30 13:10:58 +03:00
(srfi srfi-26)
2022-11-29 20:53:17 +03:00
(srfi srfi-28)
(rnrs bytevectors)
(web server)
(web request)
(web response)
(web uri)
(sxml simple)
(ice-9 regex)
(ice-9 binary-ports)
(ice-9 textual-ports)
(ice-9 popen))
(import (embddr common)
(embddr optargs))
2022-11-30 13:10:58 +03:00
(define INDEX-FILE "index.html")
2022-11-30 15:05:02 +03:00
(define DELETE-WORK-DIR #t)
2022-11-29 20:53:17 +03:00
2022-12-03 18:36:50 +03:00
(define TOP-MODULE "testbench")
(define SNIPPET-FILE "code.sv")
2022-12-03 18:36:50 +03:00
(define IVERILOG-METATOP-FILE "top_iverilog.sv")
(define VERILATOR-CPP-FILE "top_verilator.cpp")
(define USE-TIME-IN-SAVE-URL #f)
2022-12-03 18:36:50 +03:00
(define IVERILOG-EXE "iverilog")
(define VVP-EXE "vvp")
(define VERILATR-EXE "verilator")
(define URI-IVERILOG "iverilog")
2022-12-03 18:36:50 +03:00
(define URI-VERILATOR "verilator")
(define URI-SAVE-CODE "save")
2022-12-02 14:53:43 +03:00
(define URI-SAVEAS-CODE "saveas")
(define LOG-DBG 3)
(define LOG-VERBOSE 2)
(define LOG-INFO 1)
(define LOG-ERROR 0)
(define LOG-LEVEL LOG-VERBOSE)
2022-12-03 18:36:50 +03:00
(define DEFAULT-CODE
(string-append
"`timescale 1ps/1ps\n\n"
(format "module ~a (input clock);\n" TOP-MODULE)
" initial begin\n"
" $display(\"Hello world!\");\n"
" $finish();\n"
" end\n"
"endmodule\n"))
2022-11-29 20:53:17 +03:00
(define (multistring . strings)
(apply string-append
(insert-between strings "\n")))
(define-syntax guard
(syntax-rules ()
((_ default code...)
(with-exception-handler (lambda (e) default)
(lambda () code...)
#:unwind? #t))))
2022-11-30 18:01:52 +03:00
(define (print . args)
(display (apply format args)))
(define (println . args)
(display (apply format args))
(newline))
;;;
;;; Logger
;;;
(define (logger . args)
2022-12-05 20:26:04 +03:00
(unless (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))
2022-12-01 22:15:59 +03:00
(newline))))
(force-output (current-output-port))))
2022-11-29 20:53:17 +03:00
;;;
;;; Return directory list
;;;
(define (list-dir path)
(if (file-exists? path)
(let ((dir (opendir path)))
(let loop ((ls '()))
(let ((item (readdir dir)))
(if (eof-object? item)
(begin
(closedir dir)
ls)
(if (or (string=? item ".")
(string=? item ".."))
(loop ls)
(loop (cons (string-append path "/" item) ls)))))))
'()))
;;;
;;; Recursive delete directory
;;;
(define (delete-recursive path)
(let ((path (canonicalize-path path)))
(if (eq? 'directory (stat:type (stat path)))
(begin
(for-each delete-recursive (list-dir path))
(rmdir path))
(delete-file path))))
;;;
;;; Trim list
;;;
(define (list-trim l pred)
(cond
((null? l) '())
((pred (car l)) (list-trim (cdr l) pred))
(else
(let ((lr (reverse l)))
(if (pred (car lr))
(reverse (list-trim (cdr lr) pred))
l)))))
2022-11-30 13:10:58 +03:00
;;;
;;; Read template to string
;;;
(define (read-template-text file subst)
(let ((lines (read-template file "%~a%" subst)))
(apply string-append
(append-map (cut list <> "\n") lines))))
;;;
;;; 404 response
;;;
(define (not-found request)
(values (build-response #:code 404)
(string-append "Resource not found: "
(uri->string (request-uri request)))))
;;;
;;; Common text/html response
;;;
(define* (make-response str #:key
(content-type 'text/html)
(content-type-params '((charset . "utf-8"))))
(values (build-response
#:headers `((content-type . (,content-type ,@content-type-params)))
;; #:headers `((content-type . (,(if (null? encoding)
;; type
;; (cons type encoding)))))
#:code 200)
str))
;;;
;;; File reader
;;;
(define* (file-reader file-name #:key
(max-read-length 512)
(max-file-size #f))
(lambda (port)
(guard ""
(call-with-input-file file-name
(lambda (in)
(let loop ((readed 0))
(when (or (not max-file-size)
(< readed max-file-size))
(let ((data (get-bytevector-n in max-read-length)))
2022-12-05 20:26:04 +03:00
(unless (eof-object? data)
(put-bytevector port data)
(loop (+ readed (bytevector-length data))))))))
#:binary #t))))
;;;
;;; File response
;;;
(define* (file-response file #:key
(content-type 'application/octet-stream)
(content-type-params '((charset . "")))
(max-file-size #f))
(make-response
(file-reader file #:max-file-size max-file-size)
#:content-type content-type
#:content-type-params content-type-params))
2022-11-29 20:53:17 +03:00
;;;
2022-12-03 13:32:09 +03:00
;;; Execute system command and capture stdout and stderr to string
2022-11-29 20:53:17 +03:00
;;;
(define* (system-to-string cmd #:key (pwd #f))
(let* ((cmd (string-append cmd " 2>&1"))
(cmd (if pwd (format "cd ~a; ~a" pwd cmd) cmd))
(p (open-input-pipe cmd))
(out (get-string-all p)))
(values (close-pipe p) out)))
;;;
;;; Same as system-to-string but returns execution time (in ms) also
;;;
(define* (system-to-string-with-time cmd #:key (pwd #f))
(let ((start-time (gettimeofday)))
(let-values
(((status out)
(system-to-string cmd #:pwd pwd)))
(let ((stop-time (gettimeofday)))
(values status out
(exact->inexact
(- (+ (* (car stop-time) 1000)
(/ (cdr stop-time) 1000))
(+ (* (car start-time) 1000)
(/ (cdr start-time) 1000)))))))))
2022-11-30 13:10:58 +03:00
;;;
2022-12-03 13:32:09 +03:00
;;; Execute system command and capture stdout and stderr to string list
2022-11-30 13:10:58 +03:00
;;;
2022-12-03 13:32:09 +03:00
(define* (system-to-string-list cmd #:key (pwd #f))
(let-values (((status out)
(system-to-string cmd #:pwd pwd)))
(values
status
(list-trim (string-split out #\newline) string-null?))))
2022-11-29 20:53:17 +03:00
2022-11-30 18:01:52 +03:00
;;;
;;; Make pretty log from executable output
;;;
(define (exe-log-pretty cmdline status out time)
2022-11-30 18:01:52 +03:00
(string-append
(format "$ ~a\n" cmdline)
(format "Return code: ~a, Exec time: ~a ms\n" status time)
2022-11-30 18:01:52 +03:00
(if (string-null? out)
"\n"
(format "--\n~a\n" out))))
2022-11-29 20:53:17 +03:00
;;;
;;; Trivial sanitize verilog code
;;;
(define (sanitize-verilog code)
(let* (;; $f* functions but not $finish
(code (regexp-substitute/global #f "\\$f[a-hj-z][a-z]+" code 'pre "$error" 'post))
;; $scanf
(code (regexp-substitute/global #f "\\$.?scanf" code 'pre "$error" 'post))
;; $readmem
(code (regexp-substitute/global #f "\\$readmem[bh]" code 'pre "$error" 'post))
;; $dump*
(code (regexp-substitute/global #f "\\$dump[a-z]*" code 'pre "$error" 'post)))
code))
;;;
;;; 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))
"/")))))
2022-12-03 18:36:50 +03:00
(define (wrap-exe exe wrapper)
(format "~a~a" (if wrapper (format "~a " wrapper) "") exe))
2022-11-29 20:53:17 +03:00
;;;
2022-12-03 18:36:50 +03:00
;;; Make workdir with sources and command file. Common part
;;; Returns work directory path string, verilog file name
;;; and command file name.
2022-11-30 18:01:52 +03:00
;;;
2022-12-03 18:36:50 +03:00
(define* (make-sim-workdir code base top)
(let* ((work-dir (mkdtemp (path+ base (format "work-~a-XXXXXX" (current-time)))))
2022-12-03 18:36:50 +03:00
(verilog-file (path+ work-dir (format "~a.sv" top)))
(command-file (path+ work-dir (format "~a.vc" top))))
2022-11-30 18:01:52 +03:00
(with-output-to-file verilog-file (cut display code))
2022-12-03 18:36:50 +03:00
(values work-dir verilog-file command-file)))
;;;
;;; Create workdir for Icarus Verilog
;;; Returns directory path
;;;
(define* (make-iverilog-workdir code metatop base top)
(let-values (((work-dir verilog-file command-file)
(make-sim-workdir code base top)))
(let ((metatop-file (path+ work-dir (format "__~a__.sv" top))))
(with-output-to-file metatop-file
(cut display (substitute metatop "@~a@"
`((WORKDIR ,work-dir)
(TOPMODULE ,top)))))
(with-output-to-file command-file
(lambda ()
(println "~a" metatop-file)
2022-12-04 11:29:25 +03:00
(println "~a" verilog-file)
2022-12-03 18:36:50 +03:00
(println "+define+TESTBENCH")
(println "+timescale+1ps/1ps"))))
work-dir))
;;;
;;; Create workdir for Verilator
;;; Returns directory path
;;;
2022-12-03 19:30:58 +03:00
(define* (make-verilator-workdir code cpp jobs base top)
2022-12-03 18:36:50 +03:00
(let-values (((work-dir verilog-file command-file)
(make-sim-workdir code base top)))
(let ((cpp-file (path+ work-dir (format "~a.cpp" top))))
(with-output-to-file cpp-file
(cut display (substitute cpp "@~a@" `((WORKDIR ,work-dir)
(TOPMODULE ,top)))))
(with-output-to-file command-file
(lambda ()
2022-11-30 18:01:52 +03:00
(println "+define+TESTBENCH")
2022-12-03 18:36:50 +03:00
(println "--timescale 1ps/1ps")
(println "--top-module ~a" top)
(println "--Mdir ~a" (path+ work-dir top))
(println "-cc")
(println "-O2")
2022-12-03 19:30:58 +03:00
(when (> jobs 0)
(println "--build-jobs ~a" jobs))
2022-12-03 18:36:50 +03:00
(println "-o ~a" top)
(println "--exe")
(println "--build")
(println "-sv")
(println "-Wno-WIDTH")
(println "+1800-2017ext+sv")
(println "--timing")
(println "--trace")
(println "--quiet-exit")
(println "~a" verilog-file)
(println "~a.cpp" top))))
2022-11-30 18:01:52 +03:00
work-dir))
2022-11-29 20:53:17 +03:00
2022-11-30 18:01:52 +03:00
;;;
;;; Compile sources and execute simulation with Icarus Verilog
;;; Returns (values status log)
;;;
2022-12-03 18:36:50 +03:00
(define (exec-sim-iverilog top work-dir iverilog-wrap vvp-wrap)
(let ((command-file (path+ work-dir (format "~a.vc" top)))
(exe-file (path+ work-dir (format "~a.out" top))))
;; Compile
2022-12-03 18:36:50 +03:00
(let ((cmdline (format "~a -g2012 -s __~a__ -o ~a -c~a"
(wrap-exe IVERILOG-EXE iverilog-wrap)
top exe-file command-file)))
(let-values (((status out time)
(system-to-string-with-time cmdline)))
(let ((compile-log
(exe-log-pretty cmdline status out time)))
(if (not (zero? status))
(values status compile-log)
;; Execute
2022-12-03 18:36:50 +03:00
(let ((cmdline (format "~a -N ~a" (wrap-exe VVP-EXE vvp-wrap) exe-file)))
(let-values (((status out time)
(system-to-string-with-time cmdline)))
(let ((execution-log
(exe-log-pretty cmdline status out time)))
(values status (string-append compile-log execution-log)))))))))))
2022-11-30 18:01:52 +03:00
2022-12-03 18:36:50 +03:00
;;;
;;; Compile sources and execute simulation with Verilator
;;; Returns (values status log)
;;;
(define (exec-sim-verilator top work-dir verilator-wrap verilator-sim-wrap)
;; Compile
(let* ((command-file (path+ work-dir (format "~a.vc" top)))
(cmdline (format "~a -f ~a"
(wrap-exe VERILATR-EXE verilator-wrap)
command-file)))
(let-values (((status out time)
(system-to-string-with-time cmdline)))
2022-12-03 18:36:50 +03:00
(let ((compile-log
(exe-log-pretty cmdline status out time)))
2022-12-03 18:36:50 +03:00
(if (not (zero? status))
(values status compile-log)
;; Execute
(let ((cmdline (wrap-exe (path+ work-dir (format "~a/~a" top top))
verilator-sim-wrap)))
(let-values (((status out time)
(system-to-string-with-time cmdline)))
2022-12-03 18:36:50 +03:00
(let ((execution-log
(exe-log-pretty cmdline status out time)))
2022-12-03 18:36:50 +03:00
(values status (string-append compile-log execution-log))))))))))
;;;
;;; Execute simulation
;;;
(define* (exec-sim simulator code base top #:key
(vvp-wrap "") (iverilog-wrap "") (metatop "")
2022-12-03 19:30:58 +03:00
(verilator-wrap "") (verilator-sim-wrap "")
(verilator-cpp "") (verilator-build-jobs 0))
2022-12-03 18:36:50 +03:00
(let-values
(((work-dir status log)
(cond
;; Run Icarus Verilog
((eq? simulator 'iverilog)
(let ((work-dir (make-iverilog-workdir code metatop base top)))
(let-values (((status log)
(exec-sim-iverilog top work-dir iverilog-wrap vvp-wrap)))
(values work-dir status log))))
;; Run Verilator
((eq? simulator 'verilator)
2022-12-03 19:30:58 +03:00
(let ((work-dir (make-verilator-workdir code verilator-cpp verilator-build-jobs base top)))
2022-12-03 18:36:50 +03:00
(let-values (((status log)
(exec-sim-verilator top work-dir verilator-wrap verilator-sim-wrap)))
(values work-dir status log))))
;; Inknown simulator
(else
(values #f #f #f)))))
(if (not work-dir)
("ERROR: Unknown simulator")
(begin
;; Delete work dir
(when DELETE-WORK-DIR
(delete-recursive work-dir))
;; Return log
(string-append
log
(format "-----------------\nSimulation complete~a\n"
(if (zero? status) " succesfully"" with errors")))))))
2022-12-03 13:32:09 +03:00
;;;
2022-12-03 13:52:43 +03:00
;;; Get app version
2022-12-03 13:32:09 +03:00
;;;
2022-12-03 13:52:43 +03:00
(define* (app-version exe #:optional (option "--version"))
2022-12-03 13:32:09 +03:00
(let-values (((status out)
(system-to-string-list
2022-12-03 13:52:43 +03:00
(format "~a ~a" exe option))))
2022-12-03 13:32:09 +03:00
(if (and (zero? status)
(not (null? out)))
(car out)
"Unknown")))
2022-11-30 18:01:52 +03:00
;;;
;;; Get storage dir from URI
2022-11-30 18:01:52 +03:00
;;;
(define (get-storage-dir uri root-path)
(string-trim-both
2022-11-30 18:01:52 +03:00
(substring (uri-path uri)
(string-length root-path))
#\/))
;;;
;;; Check storage path validity
;;;
(define (storage-dir-valid? dir)
(if (or (< (string-length dir) 1)
(> (string-length dir) 32))
2022-11-30 18:01:52 +03:00
#f
(string-fold
(lambda (c valid)
(if (or (char-alphabetic? c)
(char-numeric? c)
(char=? c #\-))
valid #f))
#t dir)))
2022-11-30 18:01:52 +03:00
;;;
;;; Check storage exists
;;;
(define (storage-path-exists? path)
2022-11-30 18:01:52 +03:00
(let ((dir-stat (stat path #f))
(file-stat (stat (path+ path SNIPPET-FILE) #f)))
2022-11-30 18:01:52 +03:00
(and dir-stat file-stat
(eq? (stat:type dir-stat) 'directory)
(eq? (stat:type file-stat) 'regular)
(not (zero? (logand #o444 (stat:perms file-stat))))
(not (zero? (logand #o222 (stat:perms file-stat)))))))
;;;
;;; Save code to storage
;;;
(define (save-to-storage path code)
(with-output-to-file (path+ path SNIPPET-FILE)
2022-11-30 18:01:52 +03:00
(cut display code)))
;;;
;;; Read from storage
;;;
(define (read-from-storage path)
(call-with-input-file (path+ path SNIPPET-FILE)
2022-11-30 18:01:52 +03:00
get-string-all))
2022-11-29 20:53:17 +03:00
;;;
;;; Web page handler
;;;
(define (make-page-handler host root index-file
work-base stor-base
2022-12-04 11:29:25 +03:00
max-code-size sanitize
2022-12-03 18:36:50 +03:00
iverilog-wrap vvp-wrap
2022-12-03 19:30:58 +03:00
verilator-wrap verilator-sim-wrap verilator-build-jobs)
2022-11-30 13:10:58 +03:00
(let* ((root-path (split-and-decode-uri-path root))
2022-11-30 18:01:52 +03:00
(root (encode-and-join-uri-path root-path))
(iverilog-path (append root-path `(,URI-IVERILOG)))
2022-12-03 18:36:50 +03:00
(verilator-path (append root-path `(,URI-VERILATOR)))
(savecode-path (append root-path `(,URI-SAVE-CODE)))
2022-12-02 14:53:43 +03:00
(saveas-path (append root-path `(,URI-SAVEAS-CODE)))
2022-12-03 13:32:09 +03:00
(index-html
(read-template-text
index-file
2022-12-03 18:36:50 +03:00
`(("IVERILOGPOSTURI" ,(encode-and-join-uri-path iverilog-path))
("VERILATORPOSTURI" ,(encode-and-join-uri-path verilator-path))
("SAVECODEURI" ,(encode-and-join-uri-path savecode-path))
("SAVEASURI" ,(encode-and-join-uri-path saveas-path))
2022-12-03 13:32:09 +03:00
("HELPSTRING",
(string-concatenate
(insert-between
`("Verilog Playground by Punzik (c) 2022"
""
,(format "Icarus: ~a"
2022-12-03 18:36:50 +03:00
(app-version (wrap-exe IVERILOG-EXE iverilog-wrap) "-V"))
2022-12-03 13:52:43 +03:00
,(format "Verilator: ~a"
2022-12-03 18:36:50 +03:00
(app-version (wrap-exe VERILATR-EXE verilator-wrap)))
2022-12-03 13:32:09 +03:00
""
"Rules:"
"0. Don't fool around ;)"
2022-12-03 18:36:50 +03:00
"1. The top module must be named 'testbench'."
"2. The top module for the Verilator must have an input clock signal."
2022-12-03 13:32:09 +03:00
"3. Code size should not exceed 10000 characters."
"4. Code execution time no longer than 5 seconds.")
2022-12-03 18:36:50 +03:00
"\\n"))))))
(iverilog-metatop
(call-with-input-file IVERILOG-METATOP-FILE get-string-all))
(verilator-cpp
(call-with-input-file VERILATOR-CPP-FILE get-string-all)))
2022-11-30 13:10:58 +03:00
(lambda (request request-body)
(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)
2022-11-30 20:21:21 +03:00
(<= (string-length code) max-code-size))
code
(substring code 0 max-code-size)))
"")))
2022-11-30 20:21:21 +03:00
(logger LOG-VERBOSE "Request ~a:~a" (request-method request) path)
(logger LOG-VERBOSE "Request query:~a" (uri-query (request-uri request)))
(logger LOG-DBG " stor:'~a' len:~a/~a"
ref-stor-dir
(request-content-length request)
(string-length code))
2022-11-30 13:10:58 +03:00
(cond
;;
;; ---- GET requests
;;
((eq? 'GET (request-method request))
(cond
;; Index page
((equal? path root-path)
(logger LOG-DBG "Request index page")
2022-11-30 18:01:52 +03:00
(make-response
(substitute index-html "@~a@" `((CODE ,DEFAULT-CODE)))))
;; Site favicon
((equal? path (append root-path '("favicon.ico")))
(logger LOG-DBG "Request favicon.ico")
(file-response "favicon.png"
#:content-type 'image/png
#:max-file-size 10000))
;; 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))))))
;; 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
(exec-sim 'iverilog
2022-12-04 11:29:25 +03:00
(if sanitize (sanitize-verilog code) code)
work-base
2022-12-03 18:36:50 +03:00
TOP-MODULE
#:metatop iverilog-metatop
#:vvp-wrap vvp-wrap
#:iverilog-wrap iverilog-wrap)
#:content-type 'text/plain))
;; Run verilator simulation
((equal? path verilator-path)
(logger LOG-DBG "Request verilator simulation")
(when ref-stor-dir
(save-to-storage (path+ stor-base ref-stor-dir) code))
(make-response
(exec-sim 'verilator
2022-12-04 11:29:25 +03:00
(if sanitize (sanitize-verilog code) code)
2022-12-03 18:36:50 +03:00
work-base
TOP-MODULE
#:verilator-wrap verilator-wrap
#:verilator-sim-wrap verilator-sim-wrap
2022-12-03 19:30:58 +03:00
#:verilator-cpp verilator-cpp
#:verilator-build-jobs verilator-build-jobs)
#:content-type 'text/plain))
;; Save snippet
2022-12-02 14:53:43 +03:00
((or (equal? path savecode-path)
(equal? path saveas-path))
(let ((saveas (equal? path saveas-path)))
(logger LOG-DBG "Request code saving~a"
(if saveas " as new snippet" ""))
(let ((stor-dir
(if (or saveas
(not ref-stor-dir))
(basename
(mkdtemp
(path+
stor-base
(if USE-TIME-IN-SAVE-URL
(format "~a-XXXXXX" (current-time))
"XXXXXX"))))
2022-12-02 14:53:43 +03:00
ref-stor-dir)))
(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
(logger LOG-DBG "Wrong POST request")
(not-found request))))
;;
;; ---- Unknown requests type
;;
2022-11-30 13:10:58 +03:00
(else
(logger LOG-DBG "Wrong request method")
2022-11-30 13:10:58 +03:00
(not-found request)))))))
;;;
;;; ----------------------------------------------------------------------
;;; ------------------------------- MAIN ---------------------------------
;;; ----------------------------------------------------------------------
;;;
(define (print-help app-name)
(define (-> . args)
(display (apply format args) (current-error-port))
(newline (current-error-port)))
(let ((app-name (basename app-name)))
(with-output-to-port (current-error-port)
(lambda ()
(-> "Usage: ~a [OPTION]..." app-name)
(-> "Start Verilog playground WEB server")
(-> "")
(-> "Options:")
2022-12-03 18:36:50 +03:00
(-> " -a, --addr ADDR Listen on ADDR address. Default: 127.0.0.1")
(-> " -p, --port PORT Listen on PORT port. Default: 8080")
(-> " -s, --host URL Run on URL hostname. Default: http://127.0.0.1:8080")
(-> " -r, --root URN Service location root. Default: ''")
(-> " --iverilog-wrap PATH Icarus compiler wrapper.")
(-> " --vvp-wrap PATH Icarus Verilog interpreter wrapper.")
(-> " --verilator-wrap PATH Verilator compiler wrapper.")
(-> " --verilator-sim-wrap PATH Verilator simulation executable wrapper.")
2022-12-03 19:30:58 +03:00
(-> " --verilator-build-jobs N Verilator parallel build.")
2022-12-03 18:36:50 +03:00
(-> " --max-len LEN Set maximum code size in symbols. Default: 0 (infinite)")
2022-12-04 11:29:25 +03:00
(-> " --dont-sanitize Do not sanitize verilog code (dangerous)")
2022-12-03 18:36:50 +03:00
(-> " --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")
2022-11-30 13:10:58 +03:00
(-> "")
(-> "Source code and issue tracker: <https://github.com/punzik/>")))))
2022-11-29 20:53:17 +03:00
2022-12-03 18:36:50 +03:00
(define (string-trim-if-string str)
(if (string? str)
(string-trim-both str)
2022-12-03 18:36:50 +03:00
str))
2022-11-29 20:53:17 +03:00
(define (main args)
2022-11-30 13:10:58 +03:00
(debug-disable 'backtrace)
(let-values
(((opts rest err)
(parse-opts (cdr args)
'(("addr" #\a) required)
'(("port" #\p) required)
'(("host" #\s) required)
'(("root" #\r) required)
2022-12-03 18:36:50 +03:00
'(("vvp-wrap") required)
'(("iverilog-wrap") required)
'(("verilator-wrap") required)
'(("verilator-sim-wrap") required)
2022-12-03 19:30:58 +03:00
'(("verilator-build-jobs") required)
2022-11-30 20:21:21 +03:00
'(("max-len") required)
2022-12-04 11:29:25 +03:00
'(("dont-sanitize") none)
'(("work-base") required)
'(("stor-base") required)
'(("log-level") required)
'(("help" #\h) none))))
(let ((addr (string-trim-both (or (option-get opts "addr") "127.0.0.1")))
(port (string->number (string-trim-both (or (option-get opts "port") "8080"))))
(host (string-trim-both (or (option-get opts "host") "http://127.0.0.1:8080")))
(root (string-trim-both (or (option-get opts "root") "")))
2022-12-03 18:36:50 +03:00
(vvp-wrap (string-trim-if-string (option-get opts "vvp-wrap")))
(iverilog-wrap (string-trim-if-string (option-get opts "iverilog-wrap")))
(verilator-wrap (string-trim-if-string (option-get opts "verilator-wrap")))
(verilator-sim-wrap (string-trim-if-string (option-get opts "verilator-sim-wrap")))
(verilator-build-jobs (string->number (string-trim-both (or (option-get opts "verilator-build-jobs") "0"))))
(max-code-size (string->number (string-trim-both (or (option-get opts "max-len") "0"))))
2022-12-04 11:29:25 +03:00
(sanitize (not (option-get opts "dont-sanitize")))
(work-base (string-trim-both (or (option-get opts "work-base") "./")))
(stor-base (string-trim-both (or (option-get opts "stor-base") "./")))
(log-level (string->number (string-trim-both (or (option-get opts "log-level") "1")))))
2022-11-30 20:02:31 +03:00
(cond
(err
(display (format "Unknown option '~a'\n" err))
(print-help (car args))
(exit -1))
((option-get opts "help")
(print-help (car args))
(exit -1))
(else
(set! LOG-LEVEL log-level)
(logger LOG-INFO "Listen on '~a' port '~a'" addr port)
(logger LOG-INFO "Server URL: '~a/~a'" host root)
2022-12-03 18:36:50 +03:00
(logger LOG-INFO "iverilog wrapper: '~a'" iverilog-wrap)
(logger LOG-INFO "vvp wrapper: '~a'" vvp-wrap)
(logger LOG-INFO "verilator compiler wrapper: '~a'" verilator-wrap)
(logger LOG-INFO "verilator simulator wrapper: '~a'" verilator-sim-wrap)
2022-12-03 19:30:58 +03:00
(logger LOG-INFO "verilator build jobs: ~a" verilator-build-jobs)
(logger LOG-INFO "Max code size: ~a" max-code-size)
2022-12-04 11:29:25 +03:00
(logger LOG-INFO "Sanitize code: ~a" sanitize)
(logger LOG-INFO "Work base path: '~a'" work-base)
(logger LOG-INFO "Storage base path: '~a'" stor-base)
2022-12-01 22:15:59 +03:00
(logger LOG-INFO "Log level: '~a'" log-level)
2022-11-30 20:02:31 +03:00
(run-server
(make-page-handler host root INDEX-FILE
work-base stor-base
2022-12-04 11:29:25 +03:00
max-code-size sanitize
2022-12-03 18:36:50 +03:00
iverilog-wrap vvp-wrap
2022-12-03 19:30:58 +03:00
verilator-wrap verilator-sim-wrap verilator-build-jobs)
2022-11-30 20:02:31 +03:00
'http `(#:host ,addr #:port ,port)))))))