From cdbc2bca017b364505f015d160fbc46427f70c39 Mon Sep 17 00:00:00 2001
From: resttime <resttime@users.noreply.github.com>
Date: Sun, 14 Nov 2021 10:28:12 -0600
Subject: [PATCH] Initial commit

---
 README.org      |  8 ++++++++
 geml.asd        | 11 +++++++++++
 src/server.lisp | 52 +++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 71 insertions(+)
 create mode 100644 README.org
 create mode 100644 geml.asd
 create mode 100644 src/server.lisp

diff --git a/README.org b/README.org
new file mode 100644
index 0000000..d766e6f
--- /dev/null
+++ b/README.org
@@ -0,0 +1,8 @@
+* geml
+Gemini server written in Common Lisp
+
+** 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
diff --git a/geml.asd b/geml.asd
new file mode 100644
index 0000000..3b85abd
--- /dev/null
+++ b/geml.asd
@@ -0,0 +1,11 @@
+(in-package #:cl-user)
+(asdf:defsystem geml
+  :description "Gemini Server"
+  :author "resttime"
+  :depends-on (:usocket
+               :cl+ssl)
+  :serial t
+  :components
+  ((:module "src"
+    :components ((:file "server"))))
+  )
diff --git a/src/server.lisp b/src/server.lisp
new file mode 100644
index 0000000..fc2c225
--- /dev/null
+++ b/src/server.lisp
@@ -0,0 +1,52 @@
+(defpackage #:geml.server
+  (:use #:cl)
+  (:local-nicknames (:us :usocket)))
+(in-package #:geml.server)
+
+(defun write-file (filepath conn)
+  (with-open-file (in filepath :element-type '(unsigned-byte 8))
+    (loop
+      with buffer = (make-array 1024 :element-type '(unsigned-byte 8))
+      for pos = (read-sequence buffer in)
+      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 start-server (cert key)
+  (let ((server (us:socket-listen "localhost" 1965)))
+    (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))))
+      (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))))