diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..afdf465 --- /dev/null +++ b/.editorconfig @@ -0,0 +1,6 @@ +[*] +charset=utf-8 +indent_style=space +indent_size=2 +tab_width=2 +trim_trailing_whitespace=true diff --git a/README.md b/README.md new file mode 100644 index 0000000..5b6b7b2 --- /dev/null +++ b/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") +``` + diff --git a/README.org b/README.org deleted file mode 100644 index ea901e4..0000000 --- a/README.org +++ /dev/null @@ -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 diff --git a/geml.asd b/geml.asd index 3b85abd..6b71bb8 100644 --- a/geml.asd +++ b/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"))))) diff --git a/geml.ini b/geml.ini new file mode 100644 index 0000000..0269f60 --- /dev/null +++ b/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 diff --git a/src/server.lisp b/src/server.lisp index fc2c225..b12a94a 100644 --- a/src/server.lisp +++ b/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))))