<commit_before>;; Common Lisp Script
;; <NAME>

(when (not (find-package :usocket))
  (ql:quickload :usocket))

(when (not (find-package :lisp-chat-config))
  (load "config"))

(defpackage :lisp-chat-server
  (:use :usocket :cl :lisp-chat-config)
  (:export :main))

(in-package :lisp-chat-server)


;; global vars
(defparameter *clients* nil)
(defparameter *messages-stack* nil)
(defparameter *messages-log* nil)
(defparameter *commands-names* '("/users" "/help" "/log" "/quit"))

;; thread control
(defvar *message-semaphore* (sb-thread:make-semaphore :name "message semaphore" :count 0))
(defvar *message-mutex* (sb-thread:make-mutex :name "message mutex"))
(defvar *client-mutex* (sb-thread:make-mutex :name "client list mutex"))



(defstruct message from content time)

(defstruct client name socket)


(defun client-stream (c)
  (socket-stream (client-socket c)))


(defun debug-format (&rest args)
  (if *debug*
      (apply #'format args)))


(defun get-time ()
  (multiple-value-bind (second minute hour)
      (get-decoded-time)
    (format nil "~2,'0d:~2,'0d:~2,'0d" hour minute second)))


(defun formated-message (message)
  (format nil "|~a| [~a]: ~a"
          (message-time message)
          (message-from message)
          (message-content message)))


(defun command-message (content)
  (let* ((from "@server")
         (time (get-time))
         (message (make-message :from from :content content :time time)))
    (formated-message message)))


;; user commands prefixed with /
(defun /users ()
  (command-message (format nil "~{~a~^, ~}" (mapcar #'client-name *clients*))))


(defun /help ()
  (command-message (format nil "~{~a~^, ~}" *commands-names*)))


(defun /log (&optional (depth 15))
  (format nil "~{~a~^~%~}" (reverse (subseq *messages-log* 0
                                            (min depth (length *messages-log*))))))


(defun push-message (from content)
  (sb-thread:with-mutex (*message-mutex*)
    (push (make-message :from from
                        :content content
                        :time (get-time))
          *messages-stack*)
    (sb-thread:signal-semaphore *message-semaphore*)))

(defun client-delete (client)
  (push-message "@server"
                (format nil "The user ~s exited from the party :(" (client-name client)))
  (socket-close (client-socket client))
  (sb-thread:with-mutex (*client-mutex*)
    (setf *clients* (remove-if (lambda (c)
                                 (equal (client-name c)
                                        (client-name client)))
                               *clients*)))
  (debug-format t "Deleted user ~s ~%" (client-name client)))

(defun send-message (client message)
  (let ((stream (client-stream client)))
    (write-line message stream)
    (finish-output stream)))


(defun client-reader-routine (client)
  (loop for message = (read-line (client-stream client))
        while (not (equal message "/quit"))
        when (equal message "/users")
          do (send-message client (/users))
        when (equal message "/log")
          do (send-message client (/log))
        when (equal message "/help")
          do (send-message client (/help))
        when (and (> (length message) 0)
                  (not (member message *commands-names* :test #'equal)))
          do (push-message (client-name client)
                           message)
        finally (client-delete client)))


(defun client-reader (client)
  (handler-case (client-reader-routine client)
    (end-of-file () (client-delete client))))


(defun create-client (connection)
  (debug-format t "Incoming connection from ~{~a~^.~}\:~a ~%"
                (map 'list #'identity (get-peer-address connection))
                (get-peer-port connection))
  (let ((client-stream (socket-stream connection)))
    (write-line "> Type your username: " client-stream)
    (finish-output client-stream)
    (let ((client (make-client :name (read-line client-stream)
                              :socket connection)))
      (sb-thread:with-mutex (*client-mutex*)
        (debug-format t "Added new user ~s ~%" (client-name client))
        (push client *clients*))
      (push-message "@server" (format nil "The user ~s joined to the party!" (client-name client)))
      (sb-thread:make-thread #'client-reader
                             :name (format nil "~a reader thread" (client-name client))
                             :arguments (list client)))))


(defun message-broadcast ()
  (loop when (sb-thread:wait-on-semaphore *message-semaphore*)
          do (sb-thread:with-mutex (*message-mutex*)
               (let ((message (formated-message (pop *messages-stack*))))
                 (push message *messages-log*)
                 (loop for client in *clients*
                    do (handler-case (send-message client message)
                         (sb-int:simple-stream-error () (client-delete client))))))))

(defun connection-handler (socket-server)
  (loop for connection = (socket-accept socket-server)
        do (sb-thread:make-thread #'create-client
                                  :arguments (list connection)
                                  :name "create client")))


(defun server-loop (socket-server)
  (format t "Running server... ~%")
  (let* ((connection-thread (sb-thread:make-thread #'connection-handler
                                                   :arguments (list socket-server)
                                                   :name "Connection handler"))
         (broadcast-thread (sb-thread:make-thread #'message-broadcast
                                                  :name "Message broadcast")))
    (sb-thread:join-thread connection-thread)
    (sb-thread:join-thread broadcast-thread)))


(defun main ()
  (let ((socket-server (socket-listen *host* *port*)))
    (handler-case (server-loop socket-server)
      (usocket:address-in-use-error () (format t "Address ~a\@~a already busy."
                                               *host*
                                               *port*))
      (sb-sys:interactive-interrupt () (format t "Closing the server...")))
    (socket-close socket-server))
  (sb-ext:exit))
<commit_msg>Update server client-delete procedure: delete by host:port peer<commit_after>;; Common Lisp Script
;; <NAME>

(when (not (find-package :usocket))
  (ql:quickload :usocket))

(when (not (find-package :lisp-chat-config))
  (load "config"))

(defpackage :lisp-chat-server
  (:use :usocket :cl :lisp-chat-config)
  (:export :main))

(in-package :lisp-chat-server)


;; global vars
(defparameter *clients* nil)
(defparameter *messages-stack* nil)
(defparameter *messages-log* nil)
(defparameter *commands-names* '("/users" "/help" "/log" "/quit"))

;; thread control
(defvar *message-semaphore* (sb-thread:make-semaphore :name "message semaphore" :count 0))
(defvar *message-mutex* (sb-thread:make-mutex :name "message mutex"))
(defvar *client-mutex* (sb-thread:make-mutex :name "client list mutex"))



(defstruct message from content time)

(defstruct client name socket)


(defun socket-id (socket)
  (format nil "~{~a~^.~}\:~a"
          (map 'list #'identity (get-peer-address socket))
          (get-peer-port socket)))

(defun client-id (client)
  (socket-id (client-socket client)))

(defun client-stream (c)
  (socket-stream (client-socket c)))


(defun debug-format (&rest args)
  (if *debug*
      (apply #'format args)))


(defun get-time ()
  (multiple-value-bind (second minute hour)
      (get-decoded-time)
    (format nil "~2,'0d:~2,'0d:~2,'0d" hour minute second)))


(defun formated-message (message)
  (format nil "|~a| [~a]: ~a"
          (message-time message)
          (message-from message)
          (message-content message)))

(defun command-message (content)
  (let* ((from "@server")
         (time (get-time))
         (message (make-message :from from :content content :time time)))
    (formated-message message)))

;; user commands prefixed with /
(defun /users ()
  (command-message (format nil "~{~a~^, ~}" (mapcar #'client-name *clients*))))


(defun /help ()
  (command-message (format nil "~{~a~^, ~}" *commands-names*)))


(defun /log (&optional (depth 15))
  (format nil "~{~a~^~%~}" (reverse (subseq *messages-log* 0
                                            (min depth (length *messages-log*))))))

(defun push-message (from content)
  (sb-thread:with-mutex (*message-mutex*)
    (push (make-message :from from
                        :content content
                        :time (get-time))
          *messages-stack*)
    (sb-thread:signal-semaphore *message-semaphore*)))

(defun client-delete (client)
  (sb-thread:with-mutex (*client-mutex*)
    (setf *clients* (remove-if (lambda (c)
                                 (equal (client-id c)
                                        (client-id client)))
                               *clients*)))
  (push-message "@server" (format nil "The user ~s exited from the party :("
                                  (client-name client)))
  (debug-format t "Deleted user ~a@~a~%"
                (client-name client)
                (client-id client))
  (socket-close (client-socket client)))

(defun send-message (client message)
  (let ((stream (client-stream client)))
    (write-line message stream)
    (finish-output stream)))

(defun client-reader-routine (client)
  (loop for message = (read-line (client-stream client))
        while (not (equal message "/quit"))
        when (equal message "/users")
          do (send-message client (/users))
        when (equal message "/log")
          do (send-message client (/log))
        when (equal message "/help")
          do (send-message client (/help))
        when (and (> (length message) 0)
                  (not (member message *commands-names* :test #'equal)))
          do (push-message (client-name client)
                           message)
        finally (client-delete client)))

(defun client-reader (client)
  (handler-case (client-reader-routine client)
    (end-of-file () (client-delete client))))

(defun create-client (connection)
  (debug-format t "Incoming connection from ~a ~%" (socket-id connection))
  (let ((client-stream (socket-stream connection)))
    (write-line "> Type your username: " client-stream)
    (finish-output client-stream)
    (let ((client (make-client :name (read-line client-stream)
                               :socket connection)))
      (sb-thread:with-mutex (*client-mutex*)
        (debug-format t "Added new user ~a@~a ~%"
                      (client-name client)
                      (client-id client))
        (push client *clients*))
      (push-message "@server" (format nil "The user ~s joined to the party!" (client-name client)))
      (sb-thread:make-thread #'client-reader
                             :name (format nil "~a reader thread" (client-name client))
                             :arguments (list client)))))

(defun message-broadcast ()
  (loop when (sb-thread:wait-on-semaphore *message-semaphore*)
          do (sb-thread:with-mutex (*message-mutex*)
               (let ((message (formated-message (pop *messages-stack*))))
                 (push message *messages-log*)
                 (loop for client in *clients*
                    do (handler-case (send-message client message)
                         (sb-int:simple-stream-error () (client-delete client))))))))

(defun connection-handler (socket-server)
  (loop for connection = (socket-accept socket-server)
        do (sb-thread:make-thread #'create-client
                                  :arguments (list connection)
                                  :name "create client")))

(defun server-loop (socket-server)
  (format t "Running server... ~%")
  (let* ((connection-thread (sb-thread:make-thread #'connection-handler
                                                   :arguments (list socket-server)
                                                   :name "Connection handler"))
         (broadcast-thread (sb-thread:make-thread #'message-broadcast
                                                  :name "Message broadcast")))
    (sb-thread:join-thread connection-thread)
    (sb-thread:join-thread broadcast-thread)))

(defun main ()
  (let ((socket-server (socket-listen *host* *port*)))
    (handler-case (server-loop socket-server)
      (usocket:address-in-use-error () (format t "Address ~a\@~a already busy."
                                               *host*
                                               *port*))
      (sb-sys:interactive-interrupt () (format t "Closing the server...")))
    (socket-close socket-server))
  (sb-ext:exit))
{'fraction_non_alphanumeric': 0.1497305009511731, 'fraction_numerical': 0.0017438173747622067, 'mean_word_length': 2.2568404749612805, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 33, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '167262', 'n_tokens_mistral': 3717, 'n_tokens_neox': 3616, 'n_words': 991}