;; tinmop: a multiprotocol client
;; Copyright © cage

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].

(in-package :gemini-dummy-server)

(cffi:defcallback no-verify :int ((preverify-ok :int) (x509-store-ctx :pointer))
  (declare (ignore preverify-ok x509-store-ctx))
  1)

(defun start (&optional (port +gemini-default-port+))
  "Start a  trivial server listening  on `PORT' using  the certificate
and  key   stored  in  the   file  pointed  by  the   filesystem  path
`CERTIFICATE' and `KEY' respectively"
  (multiple-value-bind (certificate key)
      (os-utils:generate-ssl-certificate (os-utils:default-temp-dir))
    (format t
            "generated certificate and private key in ~s ~s respectively~%"
            certificate
            key)
    (let ((server (usocket:socket-listen "127.0.0.1" port :element-type '(unsigned-byte 8))))
      (format t "SSL server listening on port ~d~%" port)
      (unwind-protect
           (labels ((get-data ()
                      (let* ((client-socket (usocket:socket-accept server))
                             (client-stream (usocket:socket-stream client-socket)))
                        (format t "opening socket~%")
                        (let ((ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-peer+
                                                        :verify-callback 'no-verify)))
                          (cl+ssl:with-global-context (ctx :auto-free-p t)
                            (let* ((stream (cl+ssl:make-ssl-server-stream client-stream
                                                                          :external-format
                                                                          nil
                                                                          :certificate
                                                                          certificate
                                                                          :key
                                                                          key))
                                   (client-cert-fingerprint (x509:certificate-fingerprint stream)))
                              (let* ((data    (misc:read-line-into-array stream))
                                     (request (text-utils:trim-blanks (text-utils:to-s data))))
                                (format t
                                        "request ~s fingerprint ~a~%"
                                        request
                                        client-cert-fingerprint)
                                (when (null client-cert-fingerprint)
                                  (let ((response (format nil
                                                          "~a please provide a certificate~a~a"
                                                          (code gemini-client::+60+)
                                                          #\return #\newline)))
                                  (write-sequence (text-utils:string->octets response)
                                                  stream)
                                    (close stream)
                                    (get-data))))))))))
             (get-data))
        (usocket:socket-close server)))))