Allow several static directories, mapped to different paths.

src/webcontainer/webcontainer.rkt

@@ -134,7 +134,11 @@
   ))
 
 ; Webcontainer constructor
-(define (make-webcontainer #:port [port 8080] #:address [address #f] #:static [static "./static"])
+(define (make-webcontainer
+          #:port [port 8080]
+          #:address [address #f]
+          #:static [static (make-immutable-hash '(("" . "./static")))]
+          )
   (let* ((weblets (make-hash))
          (symlinks (make-hash))
          (redirections (make-hash))
@@ -198,20 +202,48 @@
         not-found-servlet)
       )))
 
+(define (remove-prefix path pfx)
+  (cond
+    ((null? pfx) path)
+    ((null? path) path)
+    ((equal? (car path) (car pfx))
+     (remove-prefix (cdr path) (cdr pfx)))
+    (#t path)))
+
 ; Start the server - do not return
 (define (webcontainer-start wcontainer)
   (serve
     #:dispatch
-      (sequencer:make
-        ; File dispatcher, search in the static directory for files
-        (files:make
-          #:url->path (make-url->path (string->path (webcontainer-static wcontainer)))
-          #:path->mime-type (make-path->mime-type "./mime.types"))
-        ; Servlet dispatcher
-        (servlet:make (webcontainer-dispatcher wcontainer))
-        ; 404 error servlet
-        (servlet:make (webcontainer-not-found-dispatcher wcontainer))
-      )
+      (apply
+        sequencer:make
+        (append
+          ; File dispatchers for each entry in the static map
+          (hash-map
+            (webcontainer-static wcontainer)
+            (lambda (root dir)
+              (define root-path (clean-path root))
+              (define dir-path (string->path dir))
+              (files:make
+                #:url->path (lambda (url)
+                              ; Remove the root from the url
+                              (define path-without-root
+                                (remove-prefix
+                                  (url->path url)
+                                  root-path))
+                              ; Build the new url
+                              (define url-without-root
+                                (path->url
+                                  (string->path
+                                    (string-join path-without-root "/" #:before-first "/"))))
+                              ;
+                              ((make-url->path dir-path) url-without-root))
+                #:path->mime-type (make-path->mime-type "./mime.types"))))
+          (list
+            ; Servlet dispatcher
+            (servlet:make (webcontainer-dispatcher wcontainer))
+            ; 404 error servlet
+            (servlet:make (webcontainer-not-found-dispatcher wcontainer))
+            )))
     #:port (webcontainer-server-port wcontainer)
     #:listen-ip (webcontainer-server-address wcontainer))
   (do-not-return))