Posterdati

(in-package #:test-ssl-server)

;;
;; Parameters.
;;

(defparameter *port* 41971)
(defparameter *server-hostname* "localhost")
(defparameter *certificate-file-pathname* #p"Development/lisp/test-ssl-server/certs/certificate.crt.pem")
(defparameter *key-file-pathname* #p"Development/lisp/test-ssl-server/certs/certificate.key.pem")
(defparameter *password* nil)
;;(defparameter *external-format* '(:utf-8 :eol-style :crlf))
(defparameter *external-format* '(:iso-8859-1 :eol-style :lf))

;;
;; Functions.
;;

(defun server ()
  (let ((passive-socket-object nil)
        (client-socket-object nil)
        (ssl-context-object (cl+ssl:make-context))
        (ssl-stream-object nil))
    (unwind-protect

         ;; unwind-protect protected form.

         (handler-case
             (cl+ssl:with-global-context (ssl-context-object :auto-free-p t)
               (format *standard-output*
                       "Server started.~%")
               (finish-output *standard-output*)
               (format *standard-output*
                       "Using SSL context ~a.~%"
                       ssl-context-object)
               (finish-output *standard-output*)
               (setq passive-socket-object (iolib/sockets:make-socket :connect :passive
                                                                      :address-family :internet
                                                                      :type :stream
                                                                      :external-format *external-format*
                                                                      :ipv6 nil))
               (when passive-socket-object
                 (format *standard-output*
                         "First Thread: created passive socket ~a[fd=~a].~%"
                         passive-socket-object
                         (iolib/sockets:socket-os-fd passive-socket-object))
                 (finish-output *standard-output*)
                 (when (iolib/sockets:bind-address passive-socket-object
                                                   iolib/sockets:+ipv4-unspecified+
                                                   :port *port*
                                                   :reuse-addr t)
                   (format *standard-output*
                           "Bound socket to ~a.~%"
                           passive-socket-object)
                   (finish-output *standard-output*)
                   (iolib/sockets:listen-on passive-socket-object
                                            :backlog 5)
                   (format *standard-output*
                           "Listening on passive socket bound to: ~a:~a.~%"
                           (iolib/sockets:local-host passive-socket-object)
                           (iolib/sockets:local-port passive-socket-object))
                   (finish-output *standard-output*)
                   (format *standard-output*
                           "Waiting to accept a connection...~%")
                   (finish-output *standard-output*)
                   (setq client-socket-object (iolib/sockets:accept-connection passive-socket-object
                                                                               :element-type '(unsigned-byte 8)
                                                                               :external-format *external-format*
                                                                               :wait t))
                   (when client-socket-object
                     (multiple-value-bind (host port)
                         (iolib/sockets:remote-name client-socket-object)
                       (format *standard-output*
                               "Accepted client connection: ~a:~a.~%"
                               host
                               port))
                     (finish-output *standard-output*)
                     (format *standard-output*
                             "Using certificate ~a.~%"
                             (cl-fad:merge-pathnames-as-file (user-homedir-pathname)
                                                             *certificate-file-pathname*))
                     (finish-output *standard-output*)
                     (setq ssl-stream-object (cl+ssl:make-ssl-server-stream client-socket-object
                                                                            :certificate (namestring (cl-fad:merge-pathnames-as-file (user-homedir-pathname)
                                                                                                                                     *certificate-file-pathname*))
                                                                            :key (namestring (cl-fad:merge-pathnames-as-file (user-homedir-pathname)
                                                                                                                             *key-file-pathname*))
                                                                            :external-format *external-format*))
                     (when ssl-stream-object
                       (format *standard-output*
                               "Using an SSL stream ~a.~%"
                               ssl-stream-object)
                       (finish-output *standard-output*)
                       (read ssl-stream-object)
                       (format ssl-stream-object
                               "Ciao stronzo!")
                       (finish-output ssl-stream-object))))))

           (cl+ssl::ssl-error-zero-return (e)
             (format *standard-output*
                     "SSL connection aborted: ~s~%"
                     e)
             (finish-output *standard-output*)))

      ;; unwind-protect clean-up forms.

      (progn
        (when ssl-stream-object
          (format *standard-output*
                  "Closing SSL stream.~%")
          (finish-output *standard-output*)
          (close ssl-stream-object))
        (when client-socket-object
          (format *standard-output*
                  "Closing client socket.~%")
          (finish-output *standard-output*)
          (close client-socket-object))
        (when passive-socket-object
          (format *standard-output*
                  "Closing passive socket.~%")
          (finish-output *standard-output*)
          (close passive-socket-object))))))

(defun main ()
  "Launch the server which comunicates over SSL."
  (server))