Exploring Common Lisp socket...

chat-room-sockets.lisp

(ql:quickload :usocket)
;; (ql:quickload 'cl-cpus) 
(use-package :sb-thread)
(use-package :usocket)

(defun start-server (port)
  "Starts a socket server to with multiple threads, can be input and output"
  (format t "~A Let's Start!! ~%" (now))
  (let ((input *standard-input*)
        (output *standard-output*)
        (thread-pool '())
        (count-thread 2) ;; (* 2 (cpus:get-number-of-processors)))
        (broadcast-streams '())
        close)
    
    (with-socket-listener (server-socket "0.0.0.0" port :reuse-address t)
      (dotimes (i count-thread)
        (push (make-thread
               #'(lambda ()
                   (let* ((stream-socket (socket-accept server-socket))
                          (server-stream (socket-stream stream-socket)))

                     (format output "Get one customer: ~A~%~A~%" stream-socket server-stream)
                     (push server-stream broadcast-streams)

                     (make-thread #'(lambda ()	;; Receive
                                      (handler-case
                                          (loop
                                             (let ((message (read-line server-stream)))	;; read-line from socket == receive
                                               ;; (format output "~%Got message:~%")
                                               ;; (vars output stream-socket server-stream request)
                                               (with-open-file (file "socket/send-to-server.txt"
                                                                     :direction :output
                                                                     :if-exists :append :if-does-not-exist :create) ;; Save to a file
                                                 (format file "~A: ~A~%" (now) message))
                                               (format output "~A~%" message)
                                               
                                               (dolist (client (remove-if #'(lambda (stream) (eql stream server-stream)) broadcast-streams))
                                                 (format client "Broadcast From ~A:~%~A~%" stream-socket message)
                                                 (finish-output client)))
                                             (when close (return)))
                                        (error (c)
                                          (format t "~%Read Error? ~%~A~%~%" c)
                                          (setf close t))))
                                  :name "Server-Read")
                     
                     (make-thread #'(lambda ()	;; Send
                                      (handler-case
                                          (loop
                                             (format output "To All Clients: ")
                                             (let ((message (read-line input)))
                                                 (dolist (client broadcast-streams)
                                                   (format client "~A~%" message)
                                                   (finish-output client))
                                                 (when (equalp message "bye")
                                                   (sleep 1)
                                                   (setf close t)
                                                   (return))))
                                        (error (c)
                                          (format t "~%Output Error:~%~A.~%~%" c)
                                          (setf close t))))
                                  :name "Server-Write")
                     (loop
                        (if close
                            (return (now))
                            (sleep 10))))))
              thread-pool))
      (princ thread-pool)
      (format t "~&Wating...~%")
      (mapcar #'join-thread thread-pool)  ;; May not be done if there are listening thread
      (format t "~%Goodbye :) ~%"))))

(defun start-client (port &optional (id (random (expt 10 10))))
  "Create a client to talk with the server, one thread for each of I/O"
  (with-client-socket (client-socket client-stream "0.0.0.0" port)
    (format t "~A~%~A~%" client-socket client-stream)
    (let ((input *standard-input*)
          (output *standard-output*)
          close)
      (make-thread #'(lambda ()  ; Input
                       (loop
                          (format output "To Server: ")
                          (format client-stream "[~A] ~A~%" id (read-line input))                   ; write
                          (finish-output client-stream)
                          (when close (return))))
                   :name "Client-Input ")

      (make-thread #'(lambda()			;; Output
                       (loop
                          (let ((response (read-line client-stream)))
                            (with-open-file (file "socket/send-to-client.txt"
                                                  :direction :output
                                                  :if-exists :append :if-does-not-exist :create)
                              (format file "~A: ~A~%" (now) response))
                            (format output "~%~A~%" response)
                            (when (equalp response "bye")
                              (setf close t)
                              (return)))))
                   :name "Client-Output")
      (loop
         (when close
           (format t "Woke up~$")
           (princ client-stream)
           (return))
         (sleep 10)))))