give up on SNI for now

Makefile

@@ -1,14 +1,15 @@
 bin/geml-server: src/*.lisp
 	mkdir -p bin
 	sbcl --no-userinit --no-sysinit --non-interactive \
-		 --load ~/quicklisp/setup.lisp \
-     --load build.lisp
+		--load ~/.quicklisp/setup.lisp \
+		--load build.lisp
 
 clean:
 	-rm bin/geml-server
+	-rm bin/
 
 install: bin/geml-server
-	id -u geml &>/dev/null || useradd geml --system
+	id -u geml &>/dev/null || useradd geml --system -g geml
 	install \
 		--target-directory /usr/local/bin/ \
 		--mode 744 \
@@ -27,12 +28,14 @@ install: bin/geml-server
 		--target-directory /etc/geml/ \
 		--owner geml \
 		--group geml \
-		--mode 644 \
+		--mode 664 \
 		geml.example.ini
 	mkdir -p /var/lib/geml
-	chown geml:geml -R /var/lib/geml
+	chown -R geml:geml /var/lib/geml
+	chmod 770 /var/lib/geml
 	mkdir -p /srv/gmi
-	chown geml:geml -R /srv/gmi
+	chown -R geml:geml /srv/gmi
+	chmod 770 /srv/gmi
 
 uninstall:
 	id -u geml &>/dev/null &&  userdel geml

README.md

@@ -12,6 +12,10 @@ root.
 root = /srv/gmi
 ```
 
+**NOTE**: Until [Server Name Identification](./src/server.lisp) is achieved only
+the first domain you configure will work. Certificates will still be generated
+for other configured domains they will just be unreachable.
+
 ## Usage
 
 To get an executable `bin/geml-server` run `make`.

geml.asd

@@ -1,4 +1,5 @@
 (in-package #:cl-user)
+
 (asdf:defsystem geml
   :name "geml"
   :description "Gemini Server"

src/server.lisp

@@ -1,38 +1,32 @@
 (in-package #:geml.server)
-
 (defun ensure-cert (certs-dir)
   (lambda (setting)
-    (unless (eq (car setting) :global)
-      (let* ((domain (string-downcase (symbol-name (car setting))))
-             (key (concatenate 'string
-                               (namestring certs-dir)
-                               domain ".key"))
-             (cert (concatenate 'string
-                                (namestring certs-dir)
-                                domain ".crt"))
-             (missing-cert (or (not (probe-file key))
-                                (not (probe-file cert))))
-             (openssl-cmd (format nil
-                                  "openssl req -x509 ~
-                                  -newkey rsa:4096 ~
-                                  -sha256 ~
-                                  -days 36525 -nodes ~
-                                  -subj \"/CN=~a\" ~
-                                  -keyout ~a ~
-                                  -out ~a ~
-                                  -addext \"subjectAltName=DNS:~a\""
-                                  domain
-                                  key
-                                  cert
-                                  domain)))
-        (cond
-          (missing-cert
-            (progn (format t "Creating TLS cert for ~a (~a)~%"
-                           domain openssl-cmd)
-                   (uiop:run-program openssl-cmd)))
-          (t
-            (format t "Found TLS cert for ~a~%" domain)))
-        setting))))
+    (let* ((domain (string-downcase (symbol-name (car setting))))
+           (key (format nil "~A~A.key" certs-dir domain))
+           (cert (format nil "~A~A.crt" certs-dir domain))
+           (missing-cert (or (not (probe-file key))
+                             (not (probe-file cert))))
+           (openssl-cmd (format nil
+                                "openssl req -x509 ~
+                                -newkey rsa:4096 ~
+                                -sha256 ~
+                                -days 36525 -nodes ~
+                                -subj \"/CN=~A\" ~
+                                -keyout ~A ~
+                                -out ~A ~
+                                -addext \"subjectAltName=DNS:~A\""
+                                domain
+                                key
+                                cert
+                                domain)))
+      (cond
+        (missing-cert
+          (progn (format t "Creating TLS cert for ~A (~A)~%"
+                         domain openssl-cmd)
+                 (uiop:run-program openssl-cmd)))
+        (t
+          (format t "Found TLS cert for ~A~%" domain)))
+      setting)))
 
 (defun resolve-index (path)
   (let ((index "index.gmi")
@@ -41,8 +35,8 @@
         (has-backslash (position #\/ path :start (- (length path) 1))))
     (cond
       (has-extension path)
-      (has-backslash (concatenate 'string path index))
-      (t (concatenate 'string path "/" index)))))
+      (has-backslash (format nil "~A~A" path index))
+      (t (format nil "~A/~A" path index)))))
 
 (defun write-file (filepath conn)
   (with-open-file (in filepath :element-type '(unsigned-byte 8))
@@ -56,20 +50,21 @@
   (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)))))
+         (root (cl-ini:ini-value
+                 settings
+                 :root
+                 :section (intern (string-upcase domain) :keyword)))
+         (filename (probe-file (format nil "~A~A" root (resolve-index path)))))
     (if filename
-      (progn (format t "Serving gemini://~a~a (~a)~%" domain path filename)
+      (progn (format t "Serving gemini://~A~A (~A)~%" domain path filename)
              (write-line "20 text/gemini" conn)
              (write-file filename conn))
-      (format conn "51 ~a does not exist for ~a~%" path domain)))
+      (format conn "51 ~A does not exist for ~A~%" path domain)))
   (force-output conn))
 
+(defun without-global (settings)
+  (remove (lambda (setting) (eq :global (cdr setting))) settings))
+
 (defun start-server (settings)
   (let* ((host (or (cl-ini:ini-value settings :host)
                    "0.0.0.0"))
@@ -77,38 +72,28 @@
                    1965))
          (certs-dir (probe-file (or (cl-ini:ini-value settings :certs-dir)
                                     "/var/lib/geml"))))
-    (mapcar (ensure-cert certs-dir) settings)
-    (let* ((server (usocket:socket-listen host port)))
-      (format t "Booted on ~a:~a~%" host port)
+    (cl+ssl:reload)
+    (mapcar (ensure-cert certs-dir) (without-global settings))
+    (let ((server (usocket:socket-listen host port)))
       (unwind-protect
-        (loop
-          (let* ((tcp-stream (flexi-streams:make-flexi-stream
-                               (usocket:socket-stream
-                                 (usocket:socket-accept
-                                   server
-                                   :element-type '(unsigned-byte 8)))
-                               :external-format '(:utf-8 :eol-style :crlf))))
-            (unwind-protect
-              (progn
-                ;; TODO parse domain
-                ;;      Unexpected value #xFC at start of UTF-8 sequence.
-                (format t "TCP#> ~a~%" (read-line tcp-stream))
-                ;; TODO upgrade to TLS
-                ;; (let ((cert (concatenate 'string certs-dir domain ".crt"))
-                ;;       (key (concatenate 'string certs-dir domain ".key")))
-                ;;   (loop
-                ;;     (let* ((tls-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 domain path settings)
-                ;;         (close tls-conn)))))
-                )
-              (progn
-                (format t "Closing TCP connection...~%")
-                (usocket:socket-close tcp-conn)))))
         (progn
-          (format t "Shutting down server...~%")
-          (usocket:socket-close server))))))
+          (format t "Booted on ~A:~A~%" host port)
+          (loop
+            ;; TODO Use SNI for virtual domain hosting
+            ;;   I am not capable enough at Common Lisp or OpenSSL to figure that out yet.
+            ;;   * Secion 4: https://gemini.circumlunar.space/docs/specification.gmi
+            ;;   * https://github.com/cl-plus-ssl/cl-plus-ssl#usage
+            ;;   * https://stackoverflow.com/questions/5113333/how-to-implement-server-name-indication-sni
+            ;;   * https://en.wikipedia.org/wiki/Server_Name_Indication
+            (let* ((domain (string-downcase
+                             (car (first (without-global settings)))))
+                   (tls-conn (cl+ssl:make-ssl-server-stream
+                               (usocket:socket-stream
+                                 (usocket:socket-accept server))
+                               :external-format '(:utf-8 :eol-style :crlf)
+                               :certificate (format nil "~A~A.crt" certs-dir domain)
+                               :key (format nil "~A~A.key" certs-dir domain))))
+              (unwind-protect
+                (handle-request tls-conn settings)
+                (close tls-conn)))))
+        (usocket:socket-close server)))))