Advertisement
Guest User

Posterdati

a guest
Nov 7th, 2018
221
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 6.43 KB | None | 0 0
  1. (in-package #:test-ssl-server)
  2.  
  3. ;;
  4. ;; Parameters.
  5. ;;
  6.  
  7. (defparameter *port* 41971)
  8. (defparameter *server-hostname* "localhost")
  9. (defparameter *certificate-file-pathname* #p"Development/lisp/test-ssl-server/certs/certificate.crt.pem")
  10. (defparameter *key-file-pathname* #p"Development/lisp/test-ssl-server/certs/certificate.key.pem")
  11. (defparameter *password* nil)
  12. ;;(defparameter *external-format* '(:utf-8 :eol-style :crlf))
  13. (defparameter *external-format* '(:iso-8859-1 :eol-style :lf))
  14.  
  15. ;;
  16. ;; Functions.
  17. ;;
  18.  
  19. (defun server ()
  20.   (let ((passive-socket-object nil)
  21.         (client-socket-object nil)
  22.         (ssl-context-object (cl+ssl:make-context))
  23.         (ssl-stream-object nil))
  24.     (unwind-protect
  25.  
  26.          ;; unwind-protect protected form.
  27.  
  28.          (handler-case
  29.              (cl+ssl:with-global-context (ssl-context-object :auto-free-p t)
  30.                (format *standard-output*
  31.                        "Server started.~%")
  32.                (finish-output *standard-output*)
  33.                (format *standard-output*
  34.                        "Using SSL context ~a.~%"
  35.                        ssl-context-object)
  36.                (finish-output *standard-output*)
  37.                (setq passive-socket-object (iolib/sockets:make-socket :connect :passive
  38.                                                                       :address-family :internet
  39.                                                                       :type :stream
  40.                                                                       :external-format *external-format*
  41.                                                                       :ipv6 nil))
  42.                (when passive-socket-object
  43.                  (format *standard-output*
  44.                          "First Thread: created passive socket ~a[fd=~a].~%"
  45.                          passive-socket-object
  46.                          (iolib/sockets:socket-os-fd passive-socket-object))
  47.                  (finish-output *standard-output*)
  48.                  (when (iolib/sockets:bind-address passive-socket-object
  49.                                                    iolib/sockets:+ipv4-unspecified+
  50.                                                    :port *port*
  51.                                                    :reuse-addr t)
  52.                    (format *standard-output*
  53.                            "Bound socket to ~a.~%"
  54.                            passive-socket-object)
  55.                    (finish-output *standard-output*)
  56.                    (iolib/sockets:listen-on passive-socket-object
  57.                                             :backlog 5)
  58.                    (format *standard-output*
  59.                            "Listening on passive socket bound to: ~a:~a.~%"
  60.                            (iolib/sockets:local-host passive-socket-object)
  61.                            (iolib/sockets:local-port passive-socket-object))
  62.                    (finish-output *standard-output*)
  63.                    (format *standard-output*
  64.                            "Waiting to accept a connection...~%")
  65.                    (finish-output *standard-output*)
  66.                    (setq client-socket-object (iolib/sockets:accept-connection passive-socket-object
  67.                                                                                :element-type '(unsigned-byte 8)
  68.                                                                                :external-format *external-format*
  69.                                                                                :wait t))
  70.                    (when client-socket-object
  71.                      (multiple-value-bind (host port)
  72.                          (iolib/sockets:remote-name client-socket-object)
  73.                        (format *standard-output*
  74.                                "Accepted client connection: ~a:~a.~%"
  75.                                host
  76.                                port))
  77.                      (finish-output *standard-output*)
  78.                      (format *standard-output*
  79.                              "Using certificate ~a.~%"
  80.                              (cl-fad:merge-pathnames-as-file (user-homedir-pathname)
  81.                                                              *certificate-file-pathname*))
  82.                      (finish-output *standard-output*)
  83.                      (setq ssl-stream-object (cl+ssl:make-ssl-server-stream client-socket-object
  84.                                                                             :certificate (namestring (cl-fad:merge-pathnames-as-file (user-homedir-pathname)
  85.                                                                                                                                      *certificate-file-pathname*))
  86.                                                                             :key (namestring (cl-fad:merge-pathnames-as-file (user-homedir-pathname)
  87.                                                                                                                              *key-file-pathname*))
  88.                                                                             :external-format *external-format*))
  89.                      (when ssl-stream-object
  90.                        (format *standard-output*
  91.                                "Using an SSL stream ~a.~%"
  92.                                ssl-stream-object)
  93.                        (finish-output *standard-output*)
  94.                        (read ssl-stream-object)
  95.                        (format ssl-stream-object
  96.                                "Ciao stronzo!")
  97.                        (finish-output ssl-stream-object))))))
  98.  
  99.            (cl+ssl::ssl-error-zero-return (e)
  100.              (format *standard-output*
  101.                      "SSL connection aborted: ~s~%"
  102.                      e)
  103.              (finish-output *standard-output*)))
  104.  
  105.       ;; unwind-protect clean-up forms.
  106.  
  107.       (progn
  108.         (when ssl-stream-object
  109.           (format *standard-output*
  110.                   "Closing SSL stream.~%")
  111.           (finish-output *standard-output*)
  112.           (close ssl-stream-object))
  113.         (when client-socket-object
  114.           (format *standard-output*
  115.                   "Closing client socket.~%")
  116.           (finish-output *standard-output*)
  117.           (close client-socket-object))
  118.         (when passive-socket-object
  119.           (format *standard-output*
  120.                   "Closing passive socket.~%")
  121.           (finish-output *standard-output*)
  122.           (close passive-socket-object))))))
  123.  
  124. (defun main ()
  125.   "Launch the server which comunicates over SSL."
  126.   (server))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement