/etc/geml/geml.ini

.editorconfig

@@ -0,0 +1,6 @@
+[*]
+charset=utf-8
+indent_style=space
+indent_size=2
+tab_width=2
+trim_trailing_whitespace=true

README.md

@@ -0,0 +1,46 @@
+# geml
+
+Gemini server written in Common Lisp
+
+## /etc/geml/geml.ini
+
+geml requires `cert` and `key` to be configured before it will run. And will
+have nothing to serve until you configure at least one domain and root. See
+[`geml.ini`](./geml.ini)  an example.
+
+```
+cert = /var/lib/geml/localhost.crt
+key = /var/lib/geml/localhost.key
+
+[my.gmi.capsule]
+root = /srv/gmi
+```
+
+### Generate Self-Signed SSL Certificate
+
+- [ ] include/write helper script for this
+
+```sh
+openssl req -x509 \
+  -out localhost.crt \
+  -keyout localhost.key \
+  -newkey rsa:2048 \
+  -nodes \
+  -sha256 \
+  -subj '/CN=localhost' \
+  -extensions EXT \
+  -config <(printf "[dn]\nCN=localhost\n[req]\ndistinguished_name = dn\n[EXT]\nsubjectAltName=DNS:localhost\nkeyUsage=digitalSignature\nextendedKeyUsage=serverAuth")
+```
+
+## Usage
+
+### SBCL
+
+Start sbcl with proper readline support: `rlwrap sbcl`
+
+```lisp
+(gemini.server:start-server)
+; or with a custom settings file location
+(gemini.server:start-server "/path/to/geml.ini")
+```
+

README.org

@@ -1,13 +0,0 @@
-* geml
-Gemini server written in Common Lisp
-
-** Usage
-#+begin_src lisp
-(gemini.server:start-server "ssl.crt" "rsa.key")
-#+end_src
-
-** Generate Self-Signed SSL Certificate
-#+begin_src sh
-openssl req -x509 -out localhost.crt -keyout localhost.key -newkey rsa:2048 -nodes -sha256 -subj '/CN=localhost' -extensions EXT \
-        -config <(printf "[dn]\nCN=localhost\n[req]\ndistinguished_name = dn\n[EXT]\nsubjectAltName=DNS:localhost\nkeyUsage=digitalSignature\nextendedKeyUsage=serverAuth")
-#+end_src

geml.asd

@@ -1,11 +1,14 @@
 (in-package #:cl-user)
 (asdf:defsystem geml
+  :name "geml"
   :description "Gemini Server"
-  :author "resttime"
+  :author ("resttime" "secretspecter")
+  :version "0.0.2"
+  :license "MIT"
   :depends-on (:usocket
-               :cl+ssl)
+               :cl+ssl
+               :quri
+               :cl-ini)
   :serial t
-  :components
-  ((:module "src"
-    :components ((:file "server"))))
-  )
+  :components ((:module "src" :components
+                        ((:file "server")))))

geml.ini

@@ -0,0 +1,10 @@
+;; host can be a dotted IP address, or a hostname for lookup in the DNS system.
+;; see usocket: https://github.com/usocket/usocket#api-definition
+host = 0.0.0.0
+port = 1965
+
+cert = /var/lib/geml/localhost.crt
+key = /var/lib/geml/localhost.key
+
+[localhost]
+root = /home/specter/Code/talon.computer

src/server.lisp

@@ -1,8 +1,19 @@
 (defpackage #:geml.server
-  (:use #:cl)
-  (:local-nicknames (:us :usocket)))
+  (:use :common-lisp))
 (in-package #:geml.server)
 
+;; TODO use path library for portability:
+;; http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/sec_the_filen_s_dictionary.html
+(defun resolve-index (path)
+  (let ((index "index.gmi")
+        (has-extension (if (< 5 (length path))
+                         (search ".gmi" path :start2 (- (length path) 4))))
+        (has-backslash (position #\/ path :start (- (length path) 1))))
+    (cond
+      (has-extension path)
+      (has-backslash (concatenate 'string path index))
+      (t (concatenate 'string path "/" index)))))
+
 (defun write-file (filepath conn)
   (with-open-file (in filepath :element-type '(unsigned-byte 8))
     (loop
@@ -11,42 +22,47 @@
       until (zerop pos)
       do (write-sequence buffer conn :end pos))))
 
-(defun handle-request (conn)
-  (let ((req (read-line conn)))
-    (format t "Request: ~a~%" req)
-    (write-line "20 text/gemini" conn)
-    ;; (write-file "../hi.gmi" conn)
-    (format conn "# Welcome~%content")
-    (force-output conn)))
+(defun handle-request (conn settings)
+  (let* ((uri (quri:uri (read-line conn)))
+         (domain (quri:uri-domain uri))
+         (path (quri:uri-path uri))
+         (root (cl-ini:ini-value settings
+                                 :root
+                                 :section (intern (string-upcase domain)
+                                                  :keyword)))
+         (filename (probe-file (concatenate 'string
+                                            root
+                                            (resolve-index path)))))
+    (if filename
+      (progn (format t "serving ~a~%" filename)
+             (write-line "20 text/gemini" conn)
+             (write-file filename conn))
+      (format conn "51 ~a does not exist for ~a~%" path domain)))
+  (force-output conn))
 
-(defun start-server (cert key)
-  (let ((server (us:socket-listen "localhost" 1965)))
+(defun start-server (&optional settings-file)
+  (let* ((settings-file (or settings-file
+                            "/etc/geml/geml.ini"))
+         (settings (cl-ini:parse-ini settings-file))
+         (host (or (cl-ini:ini-value settings :host)
+                   "0.0.0.0"))
+         (port (or (cl-ini:ini-value settings :port)
+                   1965))
+         (server (usocket:socket-listen host port)))
+    (format t "geml is live on ~a:~a with settings from ~a~%"
+            host
+            port
+            settings-file)
     (unwind-protect
-         (loop (let* ((socket (us:socket-accept server))
-                      (conn (cl+ssl:make-ssl-server-stream
-                             (us:socket-stream socket)
-                             :external-format '(:utf-8 :eol-style :crlf)
-                             :certificate cert
-                             :key key)))
-                 (unwind-protect (handle-request conn)
-                   (close conn))))
+      (loop (let* ((socket (usocket:socket-accept server))
+                   (key (cl-ini:ini-value settings :key))
+                   (cert (cl-ini:ini-value settings :cert))
+                   (conn (cl+ssl:make-ssl-server-stream
+                           (usocket:socket-stream socket)
+                           :external-format '(:utf-8 :eol-style :crlf)
+                           :certificate cert
+                           :key key)))
+              (unwind-protect (handle-request conn settings)
+                (close conn))))
       (format t "Closing Server~%")
-      (us:socket-close server))))
-
-(defun test ()
-  (let* ((socket (us:socket-connect "localhost" 1965))
-         (conn (cl+ssl:make-ssl-client-stream
-                (us:socket-stream socket)
-                :external-format '(:utf-8 :eol-style :crlf)
-                :verify nil)))
-    (unwind-protect
-         (progn
-           (write-line "gemini://localhost/test" conn)
-           (force-output conn)
-           (format t "Response Header:~%~a~%~%" (read-line conn))
-           (format t "Response Body:~%")
-           (loop with buffer = (make-array 1024 :element-type 'character)
-                 for pos = (read-sequence buffer conn)
-                 until (zerop pos)
-                 do (write-sequence buffer *standard-output* :end pos)))
-      (close conn))))
+      (usocket:socket-close server))))