gemini.server: adding a gemini server.

diff --git a/extra/gemini/server/authors.txt b/extra/gemini/server/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/extra/gemini/server/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/extra/gemini/server/server.factor b/extra/gemini/server/server.factor
new file mode 100644 (file)
index 0000000..2d63416
--- /dev/null
+++ b/extra/gemini/server/server.factor
@@ -0,0 +1,119 @@
+! Copyright (C) 2021 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors calendar combinators combinators.short-circuit
+command-line formatting io io.directories io.encodings.binary
+io.encodings.string io.encodings.utf8 io.files io.files.info
+io.files.types io.pathnames io.servers io.sockets.secure kernel
+math mime.types namespaces sequences sorting splitting strings
+urls urls.encoding ;
+
+IN: gemini.server
+
+TUPLE: gemini-server < threaded-server
+    { serving-directory string } ;
+
+<PRIVATE
+
+: send-file ( path -- )
+    binary [ [ write ] each-block ] with-file-reader ;
+
+: write-utf8 ( string -- )
+    utf8 encode write ;
+
+: send-status ( path file-info -- )
+    type>> {
+        { +directory+ [ drop "text/gemini" ] }
+        { +regular-file+ [ mime-type ] }
+        [ 2drop f ]
+    } case "application/octet-stream" or
+    "20 %s\r\n" sprintf write-utf8 ;
+
+: file-modified ( entry -- string )
+    modified>> "%Y-%b-%d %H:%M" strftime ;
+
+: file-size ( entry -- string )
+    dup directory? [
+        drop "-  "
+    ] [
+        size>> {
+            { [ dup 40 2^ >= ] [ 40 2^ /f "TB" ] }
+            { [ dup 30 2^ >= ] [ 30 2^ /f "GB" ] }
+            { [ dup 20 2^ >= ] [ 20 2^ /f "MB" ] }
+            [ 10 2^ /f "KB" ]
+        } cond "%.1f %s" sprintf
+    ] if ;
+
+:: list-directory ( server path -- )
+    path server serving-directory>> ?head drop [
+        "# [%s]\r\n\r\n" sprintf write-utf8
+    ] [
+        dup "/" = [ drop ] [
+            parent-directory ".."
+            "=> %s %-69s\r\n" sprintf
+            write-utf8
+        ] if
+    ] bi
+
+    path [
+        [ name>> "." head? ] reject
+        [ { [ directory? ] [ regular-file? ] } 1|| ] filter
+        [ name>> ] sort-with
+        [
+            [ name>> ] [ directory? [ "/" append ] when ] bi
+            [
+                url-encode
+            ] [
+                dup file-info [ file-modified ] [ file-size ] bi
+                "%-40s %s %10s" sprintf
+            ] bi
+            "=> %s %s\r\n" sprintf
+            write-utf8
+        ] each
+    ] with-directory-entries ;
+
+: send-directory ( server path -- )
+    dup ".geminimap" append-path dup exists? [
+        send-file 2drop
+    ] [
+        drop dup ".geminihead" append-path
+        dup exists? [ send-file ] [ drop ] if
+        list-directory
+    ] if ;
+
+: read-gemini-path ( -- path )
+    readln utf8 decode "\r" ?tail drop >url path>> ;
+
+M: gemini-server handle-client*
+    dup serving-directory>> read-gemini-path append
+    dup file-info [ send-status ] 2keep type>> {
+        { +directory+ [ send-directory ] }
+        { +regular-file+ [ nip send-file ] }
+        [ 3drop ]
+    } case flush ;
+
+PRIVATE>
+
+: <gemini-secure-config> ( -- secure-config )
+    <secure-config>
+        "key-file" get absolute-path >>key-file
+        "dh-file" get absolute-path >>dh-file
+        "key-password" get >>password ;
+
+: <gemini-server> ( directory port -- server )
+    utf8 gemini-server new-threaded-server
+        <gemini-secure-config> >>secure-config
+        f >>insecure
+        swap >>secure
+        swap resolve-symlinks >>serving-directory
+        "gemini.server" >>name
+        binary >>encoding
+        5 minutes >>timeout ;
+
+: gemini-server-main ( -- )
+    command-line get ?first "." or
+    1234 <gemini-server> start-server wait-for-server ;
+
+MAIN: gemini-server-main
+
+! ./factor -key-file=cert.pem -dh-file=dh2048.pem -key-password=password -run=gemini.server

diff --git a/extra/gemini/server/summary.txt b/extra/gemini/server/summary.txt
new file mode 100644 (file)
index 0000000..7346683
--- /dev/null
+++ b/extra/gemini/server/summary.txt
@@ -0,0 +1 @@
+Gemini server

diff --git a/extra/gemini/server/tags.txt b/extra/gemini/server/tags.txt
new file mode 100644 (file)
index 0000000..59112da
--- /dev/null
+++ b/extra/gemini/server/tags.txt
@@ -0,0 +1,2 @@
+network
+servers