1 ! Copyright (C) 2021 John Benediktsson
2 ! See https://factorcode.org/license.txt for BSD license
4 USING: accessors calendar combinators combinators.short-circuit
5 command-line formatting io io.directories io.encodings.binary
6 io.encodings.string io.encodings.utf8 io.files io.files.info
7 io.files.types io.pathnames io.servers io.sockets.secure kernel
8 math mime.types namespaces sequences sorting splitting strings
13 TUPLE: gemini-server < threaded-server
14 { serving-directory string } ;
18 : send-file ( path -- )
19 binary [ [ write ] each-block ] with-file-reader ;
21 : write-utf8 ( string -- )
24 : send-status ( path file-info -- )
26 { +directory+ [ drop "text/gemini" ] }
27 { +regular-file+ [ mime-type ] }
29 } case "application/octet-stream" or
30 "20 %s\r\n" sprintf write-utf8 ;
32 : file-modified ( entry -- string )
33 modified>> "%Y-%b-%d %H:%M" strftime ;
35 : file-size ( entry -- string )
40 { [ dup 40 2^ >= ] [ 40 2^ /f "TB" ] }
41 { [ dup 30 2^ >= ] [ 30 2^ /f "GB" ] }
42 { [ dup 20 2^ >= ] [ 20 2^ /f "MB" ] }
44 } cond "%.1f %s" sprintf
47 :: list-directory ( server path -- )
48 path server serving-directory>> ?head drop [
49 "# [%s]\r\n\r\n" sprintf write-utf8
53 "=> %s %-69s\r\n" sprintf
59 [ name>> "." head? ] reject
60 [ { [ directory? ] [ regular-file? ] } 1|| ] filter
63 [ name>> ] [ directory? [ "/" append ] when ] bi
67 dup file-info [ file-modified ] [ file-size ] bi
68 "%-40s %s %10s" sprintf
70 "=> %s %s\r\n" sprintf
73 ] with-directory-entries ;
75 : send-directory ( server path -- )
76 dup ".geminimap" append-path dup file-exists? [
79 drop dup ".geminihead" append-path
80 dup file-exists? [ send-file ] [ drop ] if
84 : read-gemini-path ( -- path )
85 readln utf8 decode "\r" ?tail drop >url path>> ;
87 M: gemini-server handle-client*
88 dup serving-directory>> read-gemini-path append
89 dup file-info [ send-status ] 2keep type>> {
90 { +directory+ [ send-directory ] }
91 { +regular-file+ [ nip send-file ] }
97 : <gemini-secure-config> ( -- secure-config )
99 "key-file" get absolute-path >>key-file
100 "dh-file" get absolute-path >>dh-file
101 "key-password" get >>password ;
103 : <gemini-server> ( directory port -- server )
104 utf8 gemini-server new-threaded-server
105 <gemini-secure-config> >>secure-config
108 swap resolve-symlinks >>serving-directory
109 "gemini.server" >>name
111 5 minutes >>timeout ;
113 : gemini-server-main ( -- )
114 command-line get ?first "." or
115 1965 <gemini-server> start-server wait-for-server ;
117 MAIN: gemini-server-main
119 ! ./factor -key-file=cert.pem -dh-file=dh2048.pem -key-password=password -run=gemini.server