http.server.static: look for index.fhtml when fhtml is enabled

diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor
index 1a74e3fc6d69d6be52c5dc6a13cd9f0fb6696fce..ed146d98de4ccf0d0d8d35b17ed05bb0f1fa7e88 100644 (file)
--- a/basis/http/http-tests.factor
+++ b/basis/http/http-tests.factor
@@ -235,6 +235,13 @@ test-db [
         servers>> random addr>> port>>
     ] with-scope "port" set ;
 
+: add-port ( url -- url' )
+    >url clone "port" get >>port ;
+
+: stop-test-httpd ( -- )
+    "http://localhost/quit" add-port http-get nip
+    "Goodbye" assert= ;
+
 [ ] [
     <dispatcher>
         add-quit-action
@@ -248,9 +255,6 @@ test-db [
     test-httpd
 ] unit-test
 
-: add-port ( url -- url' )
-    >url clone "port" get >>port ;
-
 [ t ] [
     "vocab:http/test/foo.html" ascii file-contents
     "http://localhost/nested/foo.html" add-port http-get nip =
@@ -279,7 +283,7 @@ test-db [
 
 
 [ ] [
-    [ "http://localhost/quit" add-port http-get 2drop ] ignore-errors
+    [ stop-test-httpd ] ignore-errors
 ] unit-test
 
 ! Dispatcher bugs
@@ -402,7 +406,7 @@ SYMBOL: a
     "vocab:http/test/foo.html" ascii file-contents =
 ] unit-test
 
-[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test
+[ ] [ stop-test-httpd ] unit-test
 
 ! Check behavior of 307 redirect (reported by Chris Double)
 [ ] [
@@ -429,4 +433,16 @@ SYMBOL: a
     ] with-directory
 ] must-fail
 
-[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test
+[ ] [ stop-test-httpd ] unit-test
+
+! Check that index.fhtml works
+[ ] [
+    <dispatcher>
+        "resource:basis/http/test/" <static> enable-fhtml >>default
+        add-quit-action
+    test-httpd
+] unit-test
+
+[ "OK\n\n" ] [ "http://localhost/" add-port http-get nip ] unit-test
+
+[ ] [ stop-test-httpd ] unit-test

diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor
index 6b65cd5fe4bcd83fbebbe23fa33a6e6b04d0312e..294c3d7a0d1de65e27e711bf91673098cb72d0ed 100644 (file)
--- a/basis/http/server/static/static.factor
+++ b/basis/http/server/static/static.factor
@@ -7,9 +7,10 @@ io.files.info io.directories io.pathnames io.encodings.binary
 fry xml.entities destructors urls html xml.syntax\r
 html.templates.fhtml http http.server http.server.responses\r
 http.server.redirection xml.writer ;\r
+FROM: sets => adjoin ;\r
 IN: http.server.static\r
 \r
-TUPLE: file-responder root hook special allow-listings ;\r
+TUPLE: file-responder root hook special index-names allow-listings ;\r
 \r
 : modified-since ( request -- date )\r
     "if-modified-since" header ";" split1 drop\r
@@ -23,7 +24,8 @@ TUPLE: file-responder root hook special allow-listings ;
     file-responder new\r
         swap >>hook\r
         swap >>root\r
-        H{ } clone >>special ;\r
+        H{ } clone >>special\r
+        V{ "index.html" } >>index-names ;\r
 \r
 : (serve-static) ( path mime-type -- response )\r
     [\r
@@ -75,7 +77,9 @@ TUPLE: file-responder root hook special allow-listings ;
     ] if ;\r
 \r
 : find-index ( filename -- path )\r
-    "index.html" append-path dup exists? [ drop f ] unless ;\r
+    file-responder get index-names>>\r
+    [ append-path dup exists? [ drop f ] unless ] with map-find\r
+    drop ;\r
 \r
 : serve-directory ( filename -- response )\r
     url get path>> "/" tail? [\r
@@ -97,8 +101,12 @@ M: file-responder call-responder* ( path responder -- response )
     ".." over member?\r
     [ drop <400> ] [ "/" join serve-object ] if ;\r
 \r
-! file responder integration\r
+: add-index ( name responder -- )\r
+    index-names>> adjoin ;\r
+\r
+: serve-fhtml ( path -- response )\r
+    <fhtml> "text/html" <content> ;\r
+\r
 : enable-fhtml ( responder -- responder )\r
-    [ <fhtml> "text/html" <content> ]\r
-    "application/x-factor-server-page"\r
-    pick special>> set-at ;\r
+    [ serve-fhtml ] "application/x-factor-server-page" pick special>> set-at\r
+    "index.fhtml" over add-index ;\r

diff --git a/basis/http/test/index.fhtml b/basis/http/test/index.fhtml
new file mode 100644 (file)
index 0000000..72a9c87
--- /dev/null
+++ b/basis/http/test/index.fhtml
@@ -0,0 +1 @@
+<% USE: io "OK" write %>