mirror of https://codeberg.org/cage/tinmop/
- added a dummy gemini server for debugging purposes.
This commit is contained in:
parent
2ce0f97a4a
commit
a16fc03337
|
@ -92,7 +92,10 @@
|
||||||
(:name :print-lisp-dependencies
|
(:name :print-lisp-dependencies
|
||||||
:description (_ "Download lisp libraries (useful for packaging only).")
|
:description (_ "Download lisp libraries (useful for packaging only).")
|
||||||
:short #\X
|
:short #\X
|
||||||
:long "lisp-dependencies-uris")))
|
:long "lisp-dependencies-uris")
|
||||||
|
(:name :start-dummy-server
|
||||||
|
:description (_ "Start a dummy sever, just useful for debugging.")
|
||||||
|
:long "start-dummy-server")))
|
||||||
|
|
||||||
(defparameter *start-folder* nil)
|
(defparameter *start-folder* nil)
|
||||||
|
|
||||||
|
@ -122,6 +125,8 @@
|
||||||
|
|
||||||
(defparameter *rpc-client-mode* nil)
|
(defparameter *rpc-client-mode* nil)
|
||||||
|
|
||||||
|
(defparameter *start-dummy-server* nil)
|
||||||
|
|
||||||
(defun exit-on-error (e)
|
(defun exit-on-error (e)
|
||||||
(format *error-output* "~a~%" e)
|
(format *error-output* "~a~%" e)
|
||||||
(os-utils:exit-program 1))
|
(os-utils:exit-program 1))
|
||||||
|
@ -158,4 +163,5 @@
|
||||||
(set-option-variable options :check-follows-requests *check-follow-requests*)
|
(set-option-variable options :check-follows-requests *check-follow-requests*)
|
||||||
(set-option-variable options :gemini-full-screen-mode *gemini-full-screen-mode*)
|
(set-option-variable options :gemini-full-screen-mode *gemini-full-screen-mode*)
|
||||||
(set-option-variable options :notify-mentions *notify-mentions*)
|
(set-option-variable options :notify-mentions *notify-mentions*)
|
||||||
(set-option-variable options :print-lisp-dependencies *print-lisp-dependencies*))))
|
(set-option-variable options :print-lisp-dependencies *print-lisp-dependencies*)
|
||||||
|
(set-option-variable options :start-dummy-server *start-dummy-server*))))
|
||||||
|
|
|
@ -201,6 +201,17 @@
|
||||||
:build-redirect-iri
|
:build-redirect-iri
|
||||||
:slurp-gemini-url))
|
:slurp-gemini-url))
|
||||||
|
|
||||||
|
(defpackage :gemini-dummy-server
|
||||||
|
(:use
|
||||||
|
:cl
|
||||||
|
:text-utils
|
||||||
|
:misc
|
||||||
|
:gemini-constants
|
||||||
|
:gemini-client)
|
||||||
|
(:local-nicknames (:a :alexandria))
|
||||||
|
(:export
|
||||||
|
:start))
|
||||||
|
|
||||||
(defpackage :gemini-subscription
|
(defpackage :gemini-subscription
|
||||||
(:use
|
(:use
|
||||||
:cl
|
:cl
|
||||||
|
|
|
@ -251,8 +251,7 @@
|
||||||
actual-iri
|
actual-iri
|
||||||
:cached t))
|
:cached t))
|
||||||
(progn
|
(progn
|
||||||
(debug-gemini-gui "caching *not* found for ~a"
|
(debug-gemini-gui "caching *not* found for ~a" actual-iri)
|
||||||
actual-iri)
|
|
||||||
(%gemini-request actual-iri
|
(%gemini-request actual-iri
|
||||||
:certificate-key certificate-key
|
:certificate-key certificate-key
|
||||||
:certificate certificate
|
:certificate certificate
|
||||||
|
|
|
@ -260,6 +260,8 @@ etc.) happened"
|
||||||
(res:init)
|
(res:init)
|
||||||
(command-line:manage-opts)
|
(command-line:manage-opts)
|
||||||
(cond
|
(cond
|
||||||
|
(command-line:*start-dummy-server*
|
||||||
|
(gemini-dummy-server:start))
|
||||||
(command-line:*rpc-server-mode*
|
(command-line:*rpc-server-mode*
|
||||||
(db-utils:with-ready-database (:connect nil)
|
(db-utils:with-ready-database (:connect nil)
|
||||||
(rpc-server-init)))
|
(rpc-server-init)))
|
||||||
|
|
|
@ -1561,6 +1561,7 @@
|
||||||
:*update-timeline-climb-message-tree*
|
:*update-timeline-climb-message-tree*
|
||||||
:*gemini-full-screen-mode*
|
:*gemini-full-screen-mode*
|
||||||
:*print-lisp-dependencies*
|
:*print-lisp-dependencies*
|
||||||
|
:*start-dummy-server*
|
||||||
:*rpc-server-mode*
|
:*rpc-server-mode*
|
||||||
:*rpc-client-mode*
|
:*rpc-client-mode*
|
||||||
:manage-opts))
|
:manage-opts))
|
||||||
|
|
|
@ -58,9 +58,11 @@
|
||||||
(cl+ssl:x509-free ,cert))))
|
(cl+ssl:x509-free ,cert))))
|
||||||
|
|
||||||
(defmethod certificate-fingerprint ((object cl+ssl::ssl-stream) &key (hash-algorithm :sha256))
|
(defmethod certificate-fingerprint ((object cl+ssl::ssl-stream) &key (hash-algorithm :sha256))
|
||||||
(let* ((cert (cl+ssl:ssl-stream-x509-certificate object)))
|
(let ((cert (cl+ssl:ssl-stream-x509-certificate object)))
|
||||||
(decode-fingerprint cert hash-algorithm)))
|
(when (not (cffi:null-pointer-p cert))
|
||||||
|
(decode-fingerprint cert hash-algorithm))))
|
||||||
|
|
||||||
(defmethod certificate-fingerprint ((object string) &key (hash-algorithm :sha256))
|
(defmethod certificate-fingerprint ((object string) &key (hash-algorithm :sha256))
|
||||||
(let* ((cert (cl+ssl:decode-certificate-from-file (pem->der object) :format :der)))
|
(let ((cert (cl+ssl:decode-certificate-from-file (pem->der object) :format :der)))
|
||||||
(decode-fingerprint cert hash-algorithm)))
|
(when (not (cffi:null-pointer-p cert))
|
||||||
|
(decode-fingerprint cert hash-algorithm))))
|
||||||
|
|
|
@ -99,6 +99,7 @@
|
||||||
(:file "gemini-constants")
|
(:file "gemini-constants")
|
||||||
(:file "gemini-parser")
|
(:file "gemini-parser")
|
||||||
(:file "client")
|
(:file "client")
|
||||||
|
(:file "dummy-server")
|
||||||
(:file "titan")
|
(:file "titan")
|
||||||
(:file "subscription")))
|
(:file "subscription")))
|
||||||
(:module kami
|
(:module kami
|
||||||
|
|
Loading…
Reference in New Issue