#lang racket

(require web-server/servlet web-server/dispatch)
(require xml xml/path)
(require racket/system racket/runtime-path)
(require redis data/ring-buffer)
(require "pasterack-utils.rkt")
(provide/contract (start (request? . -> . response?)))

(define-runtime-path htdocs-dir "htdocs")
(define-runtime-path here ".")
(define-runtime-path tmp-dir "tmp")

(define pastebin-url "http://www.pasterack.org/")
(define paste-url-base (++ pastebin-url "pastes/"))
(define racket-docs-url "http://docs.racket-lang.org/")
(define racket-lang-url "http://racket-lang.org")
(define racket-logo-url "http://racket-lang.org/logo.png")

(define (mk-paste-url paste-num) (++ paste-url-base paste-num))

(define (mk-link url txt) `(a ((href ,url)) ,txt))

(define (fresh-str)
  (with-redis-connection
   (let loop () (define str (mk-rand-str)) (if (EXISTS str) (loop) str))))

(define sample-pastes
  '("8953" ; Sierpinski
    "5563" ; Greek letters
    "4837" ; lazy fib
    "1989" ; set bang (test multi-expr, no #lang)
    "3259" ; scribble syntax
    "5238" ; big bang (test 2 requires on 1 line)
    "3883" ; echo serv, test limits, and forms in racket but not racket/base
    "7658" ; typed/racket
    "9269" ; type error
    "2277" ; checkerboard
    "5873")) ; plot
;    "7489")) ; bad syntax
(define sample-pastes-htmls
  (let ([ns (with-redis-connection
             (do-MULTI (for ([p sample-pastes]) (send-cmd 'HGET p 'name))))])
    (for/list ([name/bytes ns] [pnum sample-pastes])
      (define name (bytes->string/utf-8 name/bytes))
      `(tr (td ,(mk-link (mk-paste-url pnum) pnum))
           (td ((style "width:1px"))) (td ,name)))))

(define NUM-RECENT-PASTES 16)
(define recent-pastes (empty-ring-buffer NUM-RECENT-PASTES))
(for ([p sample-pastes]) (ring-buffer-push! recent-pastes p))

;; lang regexp patterns
(define hashlang-pat #px"^\\#lang ([\\w/-]+)\\s*(.*)")
(define weblang-pat #px"^web-server.*")
(define scribblelang-pat #px"^scribble/.*")
(define htdplang-pat #px"^htdp/(.*)")
(define TRlang-pat #px"^typed/racket.*")
(define require-pat #px"^\\(require (.*)\\)$")
(define (hashlang? code)
  (define in (open-input-string code))
  (begin0 (read-language in (const #f)) (close-input-port in)))
;; returns two string values, one for lang and one for the rest of the program
(define (hashlang-split code)
  (match (regexp-match hashlang-pat code)
    [(list _ lang rst) (values lang rst)]
    [_ (values "racket" code)]))
(define (scribble-lang? lang) (regexp-match scribblelang-pat lang))
(define (htdp-lang? lang) (regexp-match htdplang-pat lang))
(define (TR-lang? lang) (regexp-match TRlang-pat lang))
(define (web-lang? lang) (regexp-match weblang-pat lang))
(define (require-datum? e) (get-require-spec e))
(define (get-require-spec e) (regexp-match require-pat (to-string e)))

(define TR-bad-ids
  (++ "#%module-begin with-handlers lambda λ #%top-interaction for for* "
      "define default-continuation-prompt-tag"))

;; returns generated pastenum
(define (write-codeblock-scrbl-file code pnum)
  (define tmp-scrbl-file (build-path tmp-dir pnum (++ pnum "code.scrbl")))
  (define-values (lang code-no-lang) (hashlang-split code))
  (define lang-lst
    (cond [(scribble-lang? lang) (list "racket" lang)]
          [(htdp-lang? lang)
           (match (second (regexp-match htdplang-pat lang))
             ["bsl"  (list "lang/htdp-beginner")]
             ["bsl+" (list "lang/htdp-beginner-abbr")]
             ["isl"  (list "lang/htdp-intermediate")]
             ["isl+" (list "lang/htdp-intermediate-lambda")]
             ["asl"  (list "lang/htdp-advanced")]
             [_ (list "racket")])]
          [(TR-lang? lang) (list)]
          [(web-lang? lang) (list "web-server" "web-server/http")]
          [else (list lang)]))
  (define reqs   
    (with-handlers ([exn:fail? (const null)])  ;; read fail = non-sexp syntax
      (with-input-from-string code-no-lang
        (lambda () (for/list ([e (in-port)] #:when (require-datum? e))
                     (second (get-require-spec e)))))))
  (with-output-to-file tmp-scrbl-file
    (lambda () (printf
      (++ "#lang scribble/manual\n"
          "@(require racket/require)\n"
          "@(require (for-label "
          (cond
           [(TR-lang? lang)
            (++ "(except-in typed/racket " TR-bad-ids ")\n"
                "(only-meta-in 0 (only-in typed/racket " TR-bad-ids "))\n")]
            [else ""])
          (cond
           [(htdp-lang? lang)
            (++ (car lang-lst) " (subtract-in (combine-in "
                (string-join reqs) ") " (car lang-lst) ")")]
           [else (string-join (append lang-lst reqs))])
          "))\n"
          "@codeblock|{\n~a}|")
      code))
    #:mode 'text
    #:exists 'replace))
(define (write-eval-scrbl-file code pnum)
  ; parse out #lang if it's there, otherwise use racket
  (define-values (lang code-no-lang) (hashlang-split code))
  (define tmp-scrbl-file (build-path tmp-dir pnum (++ pnum "eval.scrbl")))
  (with-output-to-file tmp-scrbl-file
    (lambda ()
      (printf
       (++ "#lang scribble/manual\n"
           "@(require scribble/eval racket/sandbox)\n"
           "@(define-namespace-anchor anchor)\n"
           "@(define the-eval\n"
           "      (parameterize ([sandbox-output 'string]\n"
           "                     [sandbox-error-output 'string]\n"
           "                     [sandbox-propagate-breaks #f]\n"
           "                     [sandbox-namespace-specs "
                                   "(cons "
                            "(lambda () (namespace-anchor->namespace anchor)) "
                            "'(racket/pretty file/convertible))]\n"
           "                    [sandbox-path-permissions '([read \"/\"])]\n"
           "                    [sandbox-eval-limits '(20 128)])\n"
           "        (let ([e (make-evaluator '" lang ")])\n"
           "            (call-in-sandbox-context e\n"
           "              (lambda ()\n"
           "                (current-print (dynamic-require 'racket/pretty "
                                             "'pretty-print-handler))))\n"
           "          e)))\n"
           "@interaction[#:eval the-eval\n~a]")
       code-no-lang))
      #:mode 'text
      #:exists 'replace))

(define (compile-scrbl-file/get-html pnum)
  (define new-tmpdir (build-path tmp-dir pnum))
  (define err (open-output-file (build-path new-tmpdir (++ pnum "code.err"))))
  (define scrbl-file (build-path new-tmpdir (++ pnum "code.scrbl")))
  (define html-file (build-path new-tmpdir (++ pnum "code.html")))
  (and (parameterize ([current-error-port err])
         (begin0 (system (++ "/home/stchang/pltpkg/racket/bin/scribble --html "
                             "+m --redirect-main " racket-docs-url " "
                             "--dest " (path->string new-tmpdir) " "
                             (path->string scrbl-file)))
                 (close-output-port err)))
       (with-input-from-file html-file port->bytes)))
(define (compile-eval-scrbl-file/get-html pnum)
  (define new-tmpdir (build-path tmp-dir pnum))
  (define scrbl-file (build-path new-tmpdir (++ pnum "eval.scrbl")))
  (define html-file (build-path new-tmpdir (++ pnum "eval.html")))
  (and (system (++ "/home/stchang/pltpkg/racket/bin/scribble --html "
                   "--dest " (path->string new-tmpdir) " "
               (path->string scrbl-file)))
       (with-input-from-file html-file port->bytes)))

;; files/directories layout ---------------------------------------------------
;; web-server files are in htdocs/
;; each paste creates a directory tmp/<pastenum>
;; - scrbl for code is tmp/<pastenum>/<pastenum>code.scrbl
;; - compiled code is  tmp/<pastenum>/<pastenum>code.html
;; -- if code scrbl file couldn't be compiled, then error is in
;;    tmp/<pastenum>/<pastenum>code.err
;; - scrbl for eval is tmp/<pastenum>/<pastenum>eval.scrbl
;; - compiled eval is  tmp/<pastenum>/<pastenum>eval.html
;; -- if eval results in 1 pict: tmp/<pastenum>/pict.png
;; -- if eval results in n picts: tmp/<pastenum>/pict_1.png through pict_n.png

(define (generate-paste-html code pastenum)
  (define paste-dir (build-path tmp-dir pastenum))
  (unless (directory-exists? paste-dir) (make-directory paste-dir))
  (write-codeblock-scrbl-file code pastenum)
  (compile-scrbl-file/get-html pastenum))
(define (generate-eval-html code pastenum)
  ;; should check that tmp/pastenum dir exists here
  (write-eval-scrbl-file code pastenum)
  (compile-eval-scrbl-file/get-html pastenum))

(define google-analytics-script
  (++ "var _gaq = _gaq || [];\n"
      "_gaq.push(['_setAccount', 'UA-44480001-1']);\n"
      "_gaq.push(['_trackPageview']);\n"
      "(function() {\n"
      "var ga = document.createElement('script'); "
      "ga.type = 'text/javascript'; ga.async = true;\n"
      "ga.src = ('https:' == document.location.protocol "
      "? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';\n"
      "var s = document.getElementsByTagName('script')[0];"
      "s.parentNode.insertBefore(ga, s);\n"
      "})();"))
(define twitter-script
  (++ "!function(d,s,id){"
      "var js,fjs=d.getElementsByTagName(s)[0],"
      "p=/^http:/.test(d.location)?'http':'https';"
      "if(!d.getElementById(id)){"
      "js=d.createElement(s);js.id=id;"
      "js.src=p+'://platform.twitter.com/widgets.js';"
      "fjs.parentNode.insertBefore(js,fjs);}}"
      "(document, 'script', 'twitter-wjs');"))

;; generate SUBMIT button image
;; (require images/icons/control)
;; (require images/icons/style)
;; (require pict racket/draw)
;; (send 
;;  (pict->bitmap
;;   (cc-superimpose
;;    (bitmap (record-icon #:color (make-object color% 64 64 255) #:height 64
;;                         #:material glass-icon-material))
;;    (bitmap (play-icon #:color light-metal-icon-color #:height 32
;;                       #:material metal-icon-material))))
;;  save-file "htdocs/submit.png" 'png)

(define-syntax-rule (~~ prop ...) (string-join (list prop ...) ";"))

;; ----------------------------------------------------------------------------
;; serve home -----------------------------------------------------------------
(define (serve-home request #:title [title ""]
                            #:content [content "#lang racket"]
                            #:fork-from [fork-from ""]
                            #:status [status ""])
  (define (response-generator embed/url)
    (response/xexpr
     `(html ([style ,(~~ "background-image:url('/plt-back.1024x768.png')"
                         "background-attachment:fixed"
                         "background-size:cover")])
       ;; head ----------------------------------------------------------------
       (head
        (title "PasteRack: A Racket-evaluating pastebin")
        (script ((type "text/javascript")) ,google-analytics-script)
        (link ([type "text/css"] [rel "stylesheet"]
               [href "http://fonts.googleapis.com/css?family=PT+Sans"]))
        (link ([type "text/css"] [rel "stylesheet"]
               [href "http://fonts.googleapis.com/css?family=Droid+Sans+Mono"])))
       ;; body ----------------------------------------------------------------
       (body ((style "font-family:'PT Sans',sans-serif"))
        ;; left --------------------------------------------------------------
        (div ((style ,(~~ "position:absolute;left:1em;top:2em"
                          "width:12em"
                          "font-size:95%")))
          (h4 "Total pastes: " ,(number->string (DBSIZE)))
          (h4 "Sample pastes:")
          (table ((style "margin-top:-15px;font-size:95%"))
                 ,@sample-pastes-htmls)
          (h4 "Recent pastes:")
          (table ((style "margin-top:-15px;font-size:95%"))
          ,@(reverse
             (with-redis-connection
              (for/list ([pnum recent-pastes] #:when pnum)
                (define name (HGET/str pnum 'name))
                `(tr (td ,(mk-link (mk-paste-url pnum) pnum))
                     (td ((style "width:1px"))) (td ,name)))))))
        ;; middle ------------------------------------------------------------
        (div ((style ,(~~ "position:absolute;left:14em;top:2em")))
         (center
          (img ((src ,racket-logo-url)))
          (h2 ,(mk-link pastebin-url "PasteRack")
              ": An evaluating pastebin for "
              ,(mk-link racket-lang-url "Racket") ".")
          (form ((action ,(embed/url process-paste)) (method "post"))
            (div ([style "text-align:left"])
              (input ([type "text"] [name "name"] [size "60"] [value ,title]
                      [style ,(~~ "background-color:#FFFFF0"
                                  "border:inset thin"
                                  "font-size:105%"
                                  "font-family:'PT Sans',sans-serif")]))
              (span ([style "font-size:90%"]) " (paste title)"))
            (textarea ([style ,(~~ "font-family:'Droid Sans Mono',monospace"
                                   "background-color:#FFFFF0"
                                   "border:inset"
                                   "border-width:thin"
                                   "height:32em" "width:50em")]
                       [name "paste"]) ,content)
            (input ([type "hidden"] [name "fork-from"] [value ,fork-from]))
            (br)
            (table (tr
              (td ((style "width:10em")))
              (td ((style "width:5em"))
                  (input ([type "image"] [alt "Submit Paste and Run"]
                          [src "/submit.png"])))
              (td (input ([type "checkbox"] [name "astext"] [value "off"])))
              (td ((style "font-size:90%")) " Submit as text only"))
              (tr (td) (td ([colspan "3"]) ,status))
              (tr (td) (td ([colspan "3"])
                      ,(if (string=? "" fork-from) ""
                          `(span "Forked from paste # " ,fork-from))))))
         (br)(br)(br)
         ;; middle bottom (part of middle) ------------------------------------
         (div ((style "font-size:small;color:#808080"))
           "Powered by " ,(mk-link racket-lang-url "Racket") ". "
           "View "
           ,(mk-link "https://github.com/stchang/pasterack" "source") "."
           " Report issues or suggestions "
           ,(mk-link "https://github.com/stchang/pasterack/issues" "here") ". "
            "Inspired by "
            ,(mk-link "https://github.com/samth/paste.rkt" "paste.rkt") "."
            )
         ))
         ))))
  (send/suspend/dispatch response-generator))

(define (process-paste request)
  (define bs (request-bindings request))
  (cond
   [(exists-binding? 'paste bs)
    (define paste-num (fresh-str))
    (define paste-name (extract-binding/single 'name bs))
    (define pasted-code (extract-binding/single 'paste bs))
    (define fork-from (extract-binding/single 'fork-from bs))
    (define html-res
      (if (exists-binding? 'astext bs) #f
          (generate-paste-html pasted-code paste-num)))
    (define paste-html-str (or html-res pasted-code))
    (define eval-html-str
      (if html-res
          ;; eval only if able to read pasted code
          (generate-eval-html pasted-code paste-num)
          ;; if not, use read error as output,
          ;; unless as-text was explicitly checked
          (if (exists-binding? 'astext bs) #f
              (with-input-from-file
                (build-path tmp-dir paste-num (++ paste-num "code.err"))
                port->string))))
    (define paste-url (mk-paste-url paste-num))
    (ring-buffer-push! recent-pastes paste-num)
    (SET/hash paste-num (hash 'name paste-name
                              'code pasted-code
                              'code-html paste-html-str
                              'eval-html (or eval-html-str "")
                              'time (get-time/iso8601)
                              'fork-from fork-from
                              'views 0))
    (response/xexpr
     `(html ()
        (head ()
          (script () ,(++ "location.href=\"" paste-url "\"")))
        (body ())))]
   [else
    (response/xexpr
     `(html ()
        (head ())
        (body () "ERROR: bad paste" ,(mk-link pastebin-url "Go Back"))))]))

(define (get-main-div html-bytes)
  (with-handlers ([exn:fail? (lambda (x) (bytes->string/utf-8 html-bytes))])
    (car (filter
          (lambda (d) (equal? "main" (se-path* '(div #:class) d)))
          (se-path*/list '(div)
            (xml->xexpr (document-element
                         (with-input-from-bytes html-bytes read-xml))))))))

(define droidsansmono-css/x
  '(link ([type "text/css"] [rel "stylesheet"]
          [href "http://fonts.googleapis.com/css?family=Droid+Sans+Mono"])))
(define scrbl-css/x
  '(link ([type "text/css"] [rel "stylesheet"]
          [href "http://pasterack.org/scribble.css"])))
(define rkt-css/x
  '(link ([type "text/css"] [rel "stylesheet"]
          [href "http://pasterack.org/racket.css"])))
             
(define (serve-paste request pastenum)
  (define retrieved-paste-hash
    (with-redis-connection
     (when (HEXISTS pastenum 'views) (HINCRBY pastenum 'views 1))
     (GET/hash pastenum #:map-key bytes->symbol)))
  (cond
   [(equal? (hash) retrieved-paste-hash)
    (response/xexpr
     `(html() (head (title "Paste not found"))
        (body ()
         ,(format "Paste # ~a doesn't exist." pastenum) (br)
         ,(mk-link pastebin-url "Go Back"))))]
   [else
    (define-values (name code code-html eval-html time-str fork-from views)
      (match retrieved-paste-hash
        [(hash-table ('name paste-name) ('code code) ('code-html code-html)
                     ('eval-html eval-html) ('time time-str)
                     ('fork-from fork-from) ('views views))
         (values (bytes->string/utf-8 paste-name)
                 (bytes->string/utf-8 code)
                 code-html eval-html
                 (bytes->string/utf-8 time-str)
                 (bytes->string/utf-8 fork-from)
                 (bytes->string/utf-8 views))]
        ;; old record layouts
        [(hash-table ('name paste-name) ('code code-html)
                     ('eval eval-html)  ('time time-str))
         (values (bytes->string/utf-8 paste-name)
                 "" code-html eval-html
                 (bytes->string/utf-8 time-str) "" "")]))
    (define code-main-div (get-main-div code-html))
    (define eval-main-div (get-main-div eval-html))
    (define paste-url (string-append paste-url-base pastenum))
    (define main-html
      (match code-main-div
           [`(div ((class "main")) ,ver
               (blockquote ((class "SCodeFlow"))
                 (table ,table-params . ,rows)))
            (define new-rows
              (map
               (lambda (r)
                 (match r
                   [`(tr () (td () . ,rst))
                    `(li (span ((style "font-family:'Droid Sans Mono',monospace;font-size:125%")) . ,rst))]
                   [_ r]))
               rows))
;            `(div ;((class "main"))
            `(div ([style ,(~~ "font-family:'Droid Sans Mono',monospace"
                              "background-color:transparent")])
          ;    (blockquote ;((class "SCodeFlow"))
                 (ol ((start "0")(style "font-size:70%;color:#A0A0A0"))
                   . ,new-rows)
              (p "=>")
              ,(match eval-main-div
                 [`(div ((class "main")) ,ver
                     (blockquote ,attr1 (table ,attr2 . ,results)))
;                  `(blockquote ,attr1 (table ,attr2 .
                  `(blockquote (table ([style ,(~~ "font-size:90%"
                                                   "table-layout:fixed"
                                                   "width:100%"
                                                   "word-wrap:break-word")]) .
                  ,(filter
                    identity
                    (map
                    (lambda (x)
                      (match x
                        ;; single-line evaled expr (with ">" prompt), skip
                        [`(tr () (td () (span ((class "stt")) ">" " ") . ,rst))
                         #f]
                        ;; multi-line evaled expr
                        [`(tr () (td ()
                            (table ((cellspacing "0")
                                    (class "RktBlk"))
                              (tr () (td () (span ((class "stt")) ">" " ")
                                         . ,rst1)) . ,rst))) #f]
                        ;; void result, skip
                        [`(tr () (td () (table ,attr (tr () (td ()))))) #f]
                        ;; fix filename in image link
                        [`(tr () (td () (p () (img
                            ((alt "image") ,height
                             (src ,filename) ,width)))))
                         ;; rename file to avoid future clashes
                         (define rxmatch
                           (regexp-match #px"^(pict|\\d+)\\_*(\\d+)*\\.png"
                                         filename))
                         (unless rxmatch
                           (error "scribble made non-pict.png ~a" filename))
                         (match-define (list _ base offset) rxmatch)
                         (define new-file
                           (++ pastenum (if offset (++ "_" offset) "") ".png"))
                         (define curr-file-path
                           (build-path tmp-dir pastenum filename))
                         (define new-file-path
                           (build-path htdocs-dir new-file))
                         (unless (file-exists? new-file-path)
                           (copy-file curr-file-path new-file-path)
                           (delete-file curr-file-path))
                         `(tr () (td () (p () (img
                            ((alt "image") ,height
                             (src ,(++ "http://pasterack.org/" new-file)) ,width)))))]
                        ;; nested table
                        [`(tr () (td () (table ,attrs . ,rows)))
                         `(tr () (td () (table ([style ,(~~ "font-size:95%"
                                                            "table-layout:fixed"
                                                            "width:100%"
                                                            "word-wrap:break-word")])
                                               . ,rows)))]
                        [x x]))
                    results))))]
                 [_ `(div (pre ,eval-main-div))]))]
           [_ `(div (pre ,code-main-div)
                    ,(if (string=? eval-main-div "") ""
                         `(span (p "=>") (pre ,eval-main-div)))
                    )]))
    (serve-home #:content code #:title name #:fork-from pastenum
    (send/suspend
      (lambda (home-url)
    (response/xexpr
     `(html ([style ,(~~ "background-image:url('/plt-back.1024x768.png')"
                         "background-attachment:fixed"
                         "background-size:cover")])
        (head ()
          (meta ((content "text-html; charset=utf-8")
                 (http-equiv "content-type")))
          (title ,(++ "Paste # " pastenum ": " name))
          (link ((href "/scribble.css")       (rel "stylesheet")
                 (title "default")            (type "text/css")))
          (link ((href "/racket.css")         (rel "stylesheet")
                 (title "default")            (type "text/css")))
          (link ((href "/scribble-style.css") (rel "stylesheet")
                 (title "default")            (type "text/css")))
          (link ([type "text/css"] [rel "stylesheet"]
                 [href "http://fonts.googleapis.com/css?family=PT+Sans"]))
          (link ([type "text/css"] [rel "stylesheet"]
                 [href "http://fonts.googleapis.com/css?family=Droid+Sans+Mono"]))
          (script ((src "/scribble-common.js")  (type "text/javascript")))
          (script ,twitter-script))
      (body ([style ,(~~ "font-family:'PT Sans',sans-serif"
                         "background-color:transparent")])
       ;; left ----------------------------------------------------------------
       (div ([style "position:absolute;left:1em;top:2em"])
         (table ([cellspacing "0"] [cellpadding "0"])
           (tr (td ,(mk-link pastebin-url "PasteRack.org")))
           (tr (td ((height "10px"))))
           (tr (td "Paste # " (a ((href ,paste-url)) ,pastenum)))
           (tr (td ([colspan "3"] [style "font-size:90%"]) ,time-str))
           (tr (td ,(if (string=? "" fork-from) ""
                             `(span (br) "Forked from paste # "
                             ,(mk-link (++ paste-url-base fork-from) fork-from)
                               "."))))
           (tr (td 
               ,(if (string=? "" code) ""
                    `(span (br) (a ([href ,home-url]) "Fork") " as a new paste."))))
           (tr (td ,(if (string=? "" views) ""
                             `(span (br) "Paste viewed " ,views " time"
                              ,(if (string=? "1" views) "." "s.")))))
           (tr (td (br)
           (a ([href "https://twitter.com/share"][class "twitter-share-button"]
               [data-related "racketlang"][data-dnt "true"]) "Tweet")))
           (tr (td (br) "Embed:"))
           (tr (td (textarea ([rows "2"][cols "16"])
                     ,(xexpr->string scrbl-css/x)
                     ,(xexpr->string rkt-css/x)
                     ,(xexpr->string droidsansmono-css/x)
                     ,(xexpr->string main-html))))))
       ;; middle --------------------------------------------------------------
       (div ((style "position:absolute;left:14em"))
        ,(if (string=? name "") '(br) `(h4 ,name))
        ,main-html)))))) )]))

(define-values (do-dispatch mk-url)
  (dispatch-rules
   [("") serve-home]
   [("pastes" (string-arg)) serve-paste]
   #;[else serve-home]))


(define (start request) (do-dispatch request))

(require web-server/servlet-env)
(serve/servlet start
               #:launch-browser? #f
               #:quit? #f
               #:listen-ip #f
               #:port 8000
               #:extra-files-paths (list htdocs-dir)
               #:servlet-path "/"
               #:servlet-regexp #rx".*")