Fix Yuuki's file responder bug

diff --git a/libs/httpd/file-responder.factor b/libs/httpd/file-responder.factor
index 0f03a0689f21c8133d7d363e30a087d993e2d811..0e44afb266f4bd993fd6cc5aeeb183f8a71b4266 100644 (file)
--- a/libs/httpd/file-responder.factor
+++ b/libs/httpd/file-responder.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: file-responder
 USING: calendar embedded errors html httpd io kernel math
 namespaces parser sequences strings hashtables ;
+IN: file-responder
 
 : serving-path ( filename -- filename )
     [ "" ] unless* "doc-root" get swap path+ ;
@@ -53,12 +53,22 @@ SYMBOL: page
     dup mime-type dup "application/x-factor-server-page" =
     [ drop serving-html run-page ] [ serve-static ] if ;
 
+: file. ( path name -- )
+    tuck path+
+    directory? "[DIR] " "      " ? write
+    write-pathname terpri ;
+
+: directory. ( path -- )
+    dup directory natural-sort [ file. ] each-with ;
+
 : list-directory ( directory -- )
     serving-html
      "method" get "head" = [
         drop
     ] [
-        "request" get [ dup log-message directory. ] simple-html-document
+        "request" get [
+            "" swap directory.
+        ] simple-html-document
     ] if ;
 
 : find-index ( filename -- path )

diff --git a/libs/httpd/html.factor b/libs/httpd/html.factor
index 5c7ca29f4e6f7b0fd389fccdad7fa99127556762..fcdd231ec10337e8e1a677bc860ec56cb81d0db8 100644 (file)
--- a/libs/httpd/html.factor
+++ b/libs/httpd/html.factor
@@ -62,7 +62,7 @@ IN: html
 : padding-css, ( padding -- ) "padding: " % # "px; " % ;
 
 : pre-css, ( -- )
-    "white-space: pre; font-family:monospace; " % ;
+    "white-space: pre; font-family: monospace; " % ;
 
 : div-css-style ( style -- str )
     [
@@ -88,16 +88,7 @@ GENERIC: browser-link-href ( presented -- href )
 
 M: object browser-link-href drop f ;
 
-: resolve-file-link ( path -- link )
-    #! The file responder needs relative links not absolute
-    #! links.
-    "doc-root" get [
-        ?head [ "/" ?head drop ] when
-    ] when* "/" ?tail drop ;
-
-M: pathname browser-link-href
-    pathname-string
-    "/" swap resolve-file-link url-encode append ;
+M: pathname browser-link-href pathname-string url-encode ;
 
 : object-link-tag ( style quot -- )
     presented pick hash browser-link-href