; sbcl.28005

(eval-when (:compile-toplevel :load-toplevel :execute)
  (asdf:oos 'asdf:load-op :iolib.sockets))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (asdf:oos 'asdf:load-op :alexandria))

(use-package 'common-lisp)
(use-package 'iolib.sockets)
(use-package 'alexandria)

(defparameter *event-base* nil)
(defparameter *sockets* nil)
(defparameter *port* 10000)
(defparameter *count* 0)
(defvar *streams* nil)

(defun start-server (&key (host iolib.sockets:+ipv4-unspecified+) (port *port*) (timeout (* 60 60 24)))

  (setf *streams* (make-hash-table :test #'equal))

  (let ((iolib.sockets:*ipv6* nil))
       (unwind-protect
        (progn
         (setf *event-base* (make-instance 'iomux:event-base))
         (format t "About to start-my-server~%")
         (with-open-stream (sock (start-my-server host port))
                           (declare (ignorable sock))
                           (format t "Starting event-dispatch...~%")
                           (do ()
                               (nil nil)
                               ;; here is where I should stick one main loop
                               ;; iteration and then N i/o iterations.
                               (stdout-streams)
                               (transmit-work `(work ,(get-universal-time)))
                               (iomux:event-dispatch *event-base*
                                                     :timeout .10
                                                     :one-shot t))
                           (format t "Ending event-dispatch...~%")))
        (format t  "No new clients in ~A seconds: timed out. Terminating." 
                timeout)
        (close-all-sockets)
        (close *event-base*))))

(defun close-all-sockets ()
  (setf *streams* (make-hash-table :test #'equal))
  (map 'nil #'close-socket *sockets*))

(defun start-my-server (host port)
  (format t "Start-my-server called: ~A ~A~%" host port)
  (let ((socket
         (iolib.sockets:make-socket 
          :connect :passive 
          :address-family :internet
          :type :stream 
          :local-host host
          :local-port port 
          :backlog 5 
          :reuse-address t
          :external-format '(:utf-8 :eol-style :crlf)
          :ipv6 nil)))

       (format t "socket bound: ~A~%" socket)
       (setf *sockets* nil)
       (unwind-protect-case ()
                            (progn
                             (format t "Setting socket to nonblocking~%")
                             (setf (iolib.streams:fd-non-blocking socket) t)
                             (format t "set-io-handler called...~%")
                             (iomux:set-io-handler
                              *event-base*
                              (iolib.sockets:socket-os-fd socket)
                              :read 
                              (make-listener-handler socket)
                              :timeout 10))
                            (:abort 
                             (close socket)))
       (format t "start-my-server returning a socket!~%")
       socket))

(defun make-listener-handler (socket)
  (format t "Making listener handler...~%")
  #'(lambda (fd event exception)
            (declare (ignore fd event))
            (block nil
                   (when (eql :timeout exception)
                         (warn "Got a server timeout: ~A (time ~A)!" *count*
                               (get-universal-time))
                         (incf *count*)
                         (transmit-work '(a server timeout))
                         (return))
                   (let ((client (iolib.sockets:accept-connection socket)))
                        (format t "accepted connection: ~A~%" client)
                        (when client
                              (format t "set client to nonblocking~%")
                              (setf (iolib.streams:fd-non-blocking client) t)
                              (add-socket client)
                              (format t "Accepted a client~%")
                              (serve client))))))


(defun serve (socket)
  (format t "Serving the client and setting up i/o handler~%")
  (iomux:set-io-handler *event-base*
                        (iolib.sockets:socket-os-fd socket)
                        :read
                        (make-conversation socket (make-disconnector socket))))


(defun make-disconnector (socket)
  #'(lambda ()
            (format t "Disconnecting a socket~%")
            (remove-stream socket)
            (close-socket socket)))

(defun make-conversation (stream disconnector)
  (format t "Making an conversation function.~%")
  (add-stream stream)
  #'(lambda (fd event exception)
            (declare (ignore fd event exception))
            (handler-case
             (conversation stream disconnector)
             (end-of-file ()
                          (remove-stream stream)
                          (funcall disconnector)))))

;; read a lisp form from the stream and write 'ok back to the stream.
(defun conversation (stream disconnector)
  (let ((*read-eval* nil))
       (let ((form (read stream)))
            (cond ((equal form '(quit))
                   (funcall disconnector))
                  (t
                   (format t "Form from Client: ~A~%" form)
                   (format stream "~s~%" 'OK)
                   (ignore-some-conditions
                    (iolib.streams:hangup)
                    (finish-output stream)))))))


(defun close-socket (socket)
  (format t "close-socket: ~A~%" socket)
  (let ((fd (iolib.sockets:socket-os-fd socket)))
       (ignore-some-conditions (isys:syscall-error)
                               (iomux:remove-fd-handlers *event-base* fd))
       (remove-socket socket)
       (close socket)))

(defun remove-socket (socket)
  (format t "remove-socket ~s~%" socket)
  (removef *sockets* socket))

(defun add-socket (socket)
  (format t "add-socket ~s~%" socket)
  (push socket *sockets*))

(defun remove-stream (stream)
  (format t "remove-stream [count: ~A] ~s~%" (hash-table-count *streams*) stream)
  (remhash stream *streams*))

(defun add-stream (stream)
  (format t "add-stream [count: ~A] ~s~%" (hash-table-count *streams*) stream)
  (setf (gethash stream *streams*) stream))

(defun stdout-streams ()
  (when (> (hash-table-count *streams*) 0)
        (maphash
         #'(lambda (k v) 
                   (format t "State of stream ~s is ~s~%" k v))
         *streams*)))


(defun transmit-work (form)
  (when (> (hash-table-count *streams*) 0)
        (maphash
         #'(lambda (k v) 
                   (declare (ignore k))
                   ;(format t "Transmitting to ~s~%" k)
                   (format v "~s~%" form)
                   (finish-output v)
         *streams*)))

;; commented out.
;;(handler-bind
;;  ((isys:eintr (lambda (e) (invoke-restart
;;                            'ignore-syscall-error))))
;;  (send-to socket (cl-serializer:serialize 42)
;;           :remote-host "hostname" :remote-port
;;           9999))