From 095544beabc73f480377c3eaf1a4ea7c100ce735 Mon Sep 17 00:00:00 2001
From: vindarel <vindarel@mailz.org>
Date: Fri, 20 Jan 2023 23:27:29 +0100
Subject: [PATCH] script simpleHTTPserver: list and serve files

---
 docs/scripting.md                 | 43 +++++++------------------
 src/scripts/simpleHTTPserver.lisp | 53 +++++++++++++++++++++++++++++--
 2 files changed, 62 insertions(+), 34 deletions(-)

diff --git a/docs/scripting.md b/docs/scripting.md
index 337c30e..346402b 100644
--- a/docs/scripting.md
+++ b/docs/scripting.md
@@ -178,29 +178,11 @@ Call built-in scripts with `--script` or `-s`.
 $ ciel -s simpleHTTPserver 9000
 ```
 
-see `src/scripts/simpleHTTPserver.lisp` in the CIEL repository.
+open `http://localhost:9000` and see the list of files.
 
-~~~lisp
-(in-package :ciel-user)
+See `src/scripts/simpleHTTPserver.lisp` in the CIEL repository.
 
-;; CLI args: the script name, an optional port number.
-(defparameter *port* (or (ignore-errors (parse-integer (second uiop:*command-line-arguments*)))
-                         8000))
-
-(defvar *acceptor* (make-instance 'hunchentoot:easy-acceptor
-                     :document-root "./"
-                     :port *port*))
-(hunchentoot:start *acceptor*)  ;; async, runs in its own thread.
-
-(format! t "~&Serving files on port ~a…~&" *port*)
-(handler-case
-    ;; The server runs on another thread, don't quit instantly.
-    (sleep most-positive-fixnum)
-  ;; Catch a C-c and quit gracefully.
-  (sb-sys:interactive-interrupt ()
-    (format! t "Bye!")
-    (hunchentoot:stop *acceptor*)))
-~~~
+You can preview HTML files and have static assets under a `static/` directory.
 
 Given you have an `index.html` file:
 
@@ -218,15 +200,7 @@ Given you have an `index.html` file:
 </html>
 ```
 
-If you want to serve static assets under a `static/` directory:
-
-~~~lisp
-;; Serve static assets under static/
-(push (hunchentoot:create-folder-dispatcher-and-handler
-       "/static/"  "static/"
-       )
-      hunchentoot:*dispatch-table*)
-~~~
+The script will serve static assets under a `static/` directory.
 
 Now load a .js file as usual in your template:
 
@@ -242,8 +216,13 @@ alert("hello CIEL!");
 Example output:
 
 ```
-$ ciel src/scripts/simpleHTTPserver.lisp 4444
-Serving files on port 4444…
+$ ciel -s simpleHTTPserver 4242
+Serving files on port 4242…
+
+  ⤷ http://127.0.0.1:4242
+
+[click on the index.html file]
+
 127.0.0.1 - [2022-12-14 12:06:00] "GET / HTTP/1.1" 200 200 "-" "Mozilla/5.0 (X11; Linux x86_64; rv:103.0) Gecko/20100101 Firefox/103.0"
 ```
 
diff --git a/src/scripts/simpleHTTPserver.lisp b/src/scripts/simpleHTTPserver.lisp
index befe36e..e15386c 100644
--- a/src/scripts/simpleHTTPserver.lisp
+++ b/src/scripts/simpleHTTPserver.lisp
@@ -1,12 +1,14 @@
 ;;;
 ;;; Run with:
-;;; $ ciel simpleHTTPserver.lisp 4242
+;;; $ ciel -s simpleHTTPserver 4242
 ;;;
 ;;; or add a shebang line and make this script executable.
 ;;;
 
 (in-package :ciel-user)
 
+(use-package :spinneret)
+
 ;; CLI args: the script name, an optional port number.
 (defparameter *port* (or (ignore-errors (parse-integer (second uiop:*command-line-arguments*)))
                          9000))
@@ -14,7 +16,54 @@
 (defparameter *acceptor* (make-instance 'hunchentoot:easy-acceptor
                                         :document-root "./"
                                         :port *port*))
-(hunchentoot:start *acceptor*)
+
+(defmacro with-page ((&key title) &body body)
+  `(with-html-string
+       (:doctype)
+     (:html
+      (:head
+       (:title ,title))
+      (:body ,@body))))
+
+(defun file-or-directory-namestring (path)
+  "Return the name of this file or of this directory.
+  XXX: we want the name of the directory, not the full path."
+  (if (uiop:file-pathname-p path)
+      (file-namestring path)
+      ;; How to simply get the directory name, not full path?
+      ;; pathname-directory -> (:relative "path" "to" "dir")
+      (str:ensure-ends-with "/"
+                            (first (last (pathname-directory path))))))
+
+(defun show-file-list (file-list &key title)
+  (with-page (:title title)
+    (:header
+     (:h2 title))
+    (:ol (dolist (item file-list)
+           (:li (:a :href
+                    (format nil "~a" (file-or-directory-namestring item))
+                    (format nil "~a" (file-or-directory-namestring item))))))
+    (:br)
+    (:footer :style "color: dimgrey" ("Powered by CIEL Is an Extended Lisp" ))))
+
+(defun file-list ()
+  (show-file-list (append
+                   ;; This is how to list directories,
+                   ;; but we have to serve their content now.
+                   ;; (uiop:subdirectories (uiop:getcwd))
+                   (uiop:directory-files (uiop:getcwd)))
+                  :title (format nil "Files for ~a" (uiop:getcwd))))
+
+;; On the root URL "/" show the listing, but when clicking on a file let the server serve it.
+(defun serve-root ()
+  (push
+   (hunchentoot:create-regex-dispatcher "/$" #'file-list)
+   hunchentoot:*dispatch-table*))
+
+(serve-root)
+
+#+(or)
+(setf hunchentoot:*dispatch-table* nil)
 
 ;; Serve static assets under a static/ directory (optional).
 (push (hunchentoot:create-folder-dispatcher-and-handler