This commit is contained in:
secretspecter 2023-08-01 11:11:57 -06:00
parent acb2380660
commit 24a801bc0e
6 changed files with 75 additions and 35 deletions

View file

@ -39,13 +39,19 @@ openssl req -x509 \
Start sbcl with proper readline support: `rlwrap sbcl`
```lisp
(ql:quickload "geml")
(gemini.server:start-server)
; or with a custom settings file location
(gemini.server:start-server "/path/to/geml.ini")
```
### Standalone Executable
- [ ] save-lisp-and-die
To get a `geml-server` binary run:
```sh
sbcl --non-interactive --load build.lisp
```
### Systemd

5
build.lisp Normal file
View file

@ -0,0 +1,5 @@
(ql:quickload :geml/bin)
(sb-ext:save-lisp-and-die "geml-server"
:toplevel 'geml.server:bin
:executable t)

View file

@ -9,6 +9,13 @@
:cl+ssl
:quri
:cl-ini)
:components ((:file "packages")
(:module "src"
:serial t
:components ((:module "src" :components
((:file "server")))))
:components ((:file "server")))))
(asdf:defsystem geml/bin
:depends-on (:geml
:unix-opts)
:components ((:module "src"
:components ((:file "bin")))))

3
packages.lisp Normal file
View file

@ -0,0 +1,3 @@
(defpackage #:geml.server
(:use :common-lisp)
(:export :start-server :bin))

18
src/bin.lisp Normal file
View file

@ -0,0 +1,18 @@
(in-package #:geml.server)
(unix-opts:define-opts
(:name :config
:short #\c
:long "config"
;; TODO create arg-parser that resolves stuff like --config ./gmi.ini
:arg-parser #'identity
:description "path to a geml.ini file"
:default "/etc/geml/geml.ini")
;; TODO --help
;; TODO --gen-certs
)
(defun bin ()
(multiple-value-bind (options free-args) (unix-opts:get-opts)
(start-server (getf options :config))))

View file

@ -1,9 +1,13 @@
(defpackage #:geml.server
(: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 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 resolve-index (path)
(let ((index "index.gmi")
(has-extension (if (< 5 (length path))
@ -14,14 +18,6 @@
(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
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 settings)
(let* ((uri (quri:uri (read-line conn)))
(domain (quri:uri-domain uri))
@ -30,11 +26,13 @@
:root
:section (intern (string-upcase domain)
:keyword)))
;; TODO use path library?
;; http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/sec_the_filen_s_dictionary.html
(filename (probe-file (concatenate 'string
root
(resolve-index path)))))
(if filename
(progn (format t "serving ~a~%" filename)
(progn (format t "geml is 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)))
@ -48,21 +46,24 @@
"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~%"
(key (probe-file (cl-ini:ini-value settings :key)))
(cert (probe-file (cl-ini:ini-value settings :cert))))
(cond
((not cert) (format t "geml cannot read cert using path defined in ~a~%" settings-file))
((not key) (format t "geml cannot read key using path defined in ~a~%" settings-file))
(t (let ((server (usocket:socket-listen host port)))
(format t "geml booted on ~a:~a (~a)~%"
host
port
settings-file)
(unwind-protect
(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)))
:certificate (namestring cert)
:key (namestring key))))
(unwind-protect (handle-request conn settings)
(close conn))))
(format t "Closing Server~%")
(usocket:socket-close server))))
(format t "geml is shutting down...~%")
(usocket:socket-close server)))))))