86 lines
3.2 KiB
Scheme
86 lines
3.2 KiB
Scheme
;;; connection.scm
|
|
|
|
;; Handle creation of sockets, client connections, upgrading to TLS, etc.
|
|
;; Other than the default port and priorities, though, this does NOT handle
|
|
;; any Gemini-specific behaviour; do that within the client-handler proc args
|
|
|
|
(define-module (connection)
|
|
#:export (credentials-from-file
|
|
client->string
|
|
start-ssl-server))
|
|
|
|
(use-modules (rnrs bytevectors)
|
|
(ice-9 rdelim)
|
|
(ice-9 threads)
|
|
(gnutls))
|
|
|
|
|
|
(define (credentials-from-file cert-file key-file)
|
|
;; Create certificate credentials using the certificate and private key files
|
|
|
|
(define (file->utf8 file)
|
|
;; Read an entire file into a UTF-8 bytevector
|
|
(call-with-input-file file
|
|
(lambda (port) (string->utf8 (read-string port)))))
|
|
|
|
(let* ((pem x509-certificate-format/pem)
|
|
(certificate (import-x509-certificate (file->utf8 cert-file) pem))
|
|
(private-key (import-x509-private-key (file->utf8 key-file) pem))
|
|
(credentials (make-certificate-credentials)))
|
|
(set-certificate-credentials-x509-keys!
|
|
credentials (list certificate) private-key)
|
|
credentials))
|
|
|
|
|
|
(define (client->string client)
|
|
;; Turn client info into a nice-looking string
|
|
(format #f "[~a]:~a"
|
|
(inet-ntop AF_INET6 (sockaddr:addr client))
|
|
(sockaddr:port client)))
|
|
|
|
|
|
(define (call-with-client/ssl client-connection credentials
|
|
options client-handler)
|
|
;; Wrap the client connection with TLS, then call client-handler
|
|
|
|
(define (make-ssl-session client credentials)
|
|
;; Set up the SSL session for the client
|
|
(let ((priorities "NORMAL:-VERS-ALL:+VERS-TLS1.2:+VERS-TLS1.3")
|
|
(session (make-session connection-end/server)))
|
|
(set-session-default-priority! session)
|
|
(set-session-priorities! session priorities)
|
|
(set-session-credentials! session credentials)
|
|
(set-session-transport-fd! session (fileno client))
|
|
session))
|
|
|
|
(let* ((client-socket (car client-connection))
|
|
(client-info (cdr client-connection))
|
|
(session (make-ssl-session client-socket credentials)))
|
|
(handshake session)
|
|
(client-handler client-info options (session-record-port session))
|
|
(bye session close-request/rdwr)
|
|
(close client-socket)))
|
|
|
|
|
|
(define (handle-client-connections server-socket credentials
|
|
options client-handler)
|
|
(format #t "The server has been started!\n")
|
|
;; Listen for new client connections; spin off a new thread for each one
|
|
(while #t
|
|
(let ((client (accept server-socket)))
|
|
(call-with-new-thread ;; TODO: Limit the thread count (i.e. thread pool)
|
|
(lambda ()
|
|
(call-with-client/ssl client credentials
|
|
options client-handler))))))
|
|
|
|
|
|
(define* (start-ssl-server credentials options client-handler
|
|
#:key (port 1965) (listen-queue 16))
|
|
;; Open a socket to listen for and handle client connections via SSL
|
|
(let* ((server-socket (socket PF_INET6 SOCK_STREAM 0)))
|
|
(setsockopt server-socket SOL_SOCKET SO_REUSEADDR 1)
|
|
|
|
(bind server-socket AF_INET6 INADDR_ANY port)
|
|
(listen server-socket listen-queue)
|
|
|
|
(handle-client-connections server-socket credentials options client-handler)))
|