build

README.md

@@ -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
 

build.lisp

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

geml.asd

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

packages.lisp

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

src/bin.lisp

@@ -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))))

src/server.lisp

@@ -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~%"
-            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)))
-              (unwind-protect (handle-request conn settings)
-                (close conn))))
-      (format t "Closing Server~%")
-      (usocket:socket-close server))))
+         (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))
+                          (conn (cl+ssl:make-ssl-server-stream
+                                  (usocket:socket-stream socket)
+                                  :external-format '(:utf-8 :eol-style :crlf)
+                                  :certificate (namestring cert)
+                                  :key (namestring key))))
+                     (unwind-protect (handle-request conn settings)
+                       (close conn))))
+             (format t "geml is shutting down...~%")
+             (usocket:socket-close server)))))))