|
13 | 13 | (defvar *io-lock* (make-lock "io mutex") |
14 | 14 | "I/O Mutex for avoid terminal race conditions") |
15 | 15 |
|
| 16 | +(defvar *periodic-ping-interval* 30 |
| 17 | + "Interval in seconds to send a ping to the server") |
| 18 | + |
| 19 | +(defvar *stop* nil |
| 20 | + "Stop sign to end the client") |
| 21 | + |
16 | 22 | (defun erase-last-line () |
17 | 23 | "Erase the last line by using ANSI Escape codes" |
18 | 24 | (format t "~C[1A~C[2K" #\Esc #\Esc)) |
|
32 | 38 | (write-line message (socket-stream socket)) |
33 | 39 | (finish-output (socket-stream socket))) |
34 | 40 |
|
| 41 | +(defun system-pongp (message) |
| 42 | + "SYSTEM-PONGP detect if a pong response was received as systematic send" |
| 43 | + (search "[@server]: pong (system)" message)) |
| 44 | + |
35 | 45 | ;; HACK: I don't know a better way to save state of cl-readline |
36 | 46 | ;; before printing messages from server, so I'm cleaning all the stuff |
37 | 47 | ;; before print a new message, and restore again. Maybe there is a |
38 | 48 | ;; better way for doing that. |
39 | 49 | (defun receive-message (message) |
40 | 50 | "Receive a message and print in the terminal carefully with IO race conditions" |
41 | 51 | (with-lock-held (*io-lock*) |
42 | | - (let ((line cl-readline:*line-buffer*) |
43 | | - (prompt cl-readline:+prompt+)) |
44 | | - ;; erase |
45 | | - (cl-readline:replace-line "" nil) |
46 | | - (cl-readline:set-prompt "") |
47 | | - (cl-readline:redisplay) |
48 | | - ;; print message from server |
49 | | - (write-line message) |
50 | | - ;; restore |
51 | | - (cl-readline:replace-line (or line "") nil) |
52 | | - (setq cl-readline:*point* cl-readline:+end+) |
53 | | - (cl-readline:set-prompt prompt) |
54 | | - (cl-readline:redisplay)))) |
| 52 | + (unless (system-pongp message) |
| 53 | + (let ((line cl-readline:*line-buffer*) |
| 54 | + (prompt cl-readline:+prompt+)) |
| 55 | + ;; erase |
| 56 | + (cl-readline:replace-line "" nil) |
| 57 | + (cl-readline:set-prompt "") |
| 58 | + (cl-readline:redisplay) |
| 59 | + ;; print message from server |
| 60 | + (write-line message) |
| 61 | + ;; restore |
| 62 | + (cl-readline:replace-line (or line "") nil) |
| 63 | + (setq cl-readline:*point* cl-readline:+end+) |
| 64 | + (cl-readline:set-prompt prompt) |
| 65 | + (cl-readline:redisplay))))) |
55 | 66 |
|
56 | 67 | (defun client-sender (socket username) |
57 | 68 | "Routine to check new messages being typed by the user" |
|
87 | 98 | (send-message username socket) |
88 | 99 | username)) |
89 | 100 |
|
| 101 | +(defun client-background-ping (socket) |
| 102 | + "Maintain TCP/IP connection by sending periodic ping to maintain connection alive. |
| 103 | +
|
| 104 | +The systematic pong is consumed and the @server response is not shown in the terminal |
| 105 | +" |
| 106 | + (loop (sleep *periodic-ping-interval*) |
| 107 | + (ignore-errors |
| 108 | + (send-message "/ping system" socket)))) |
90 | 109 |
|
91 | 110 | (defun client-loop (host port) |
92 | 111 | "Dispatch client threads for basic functioning system" |
|
96 | 115 | (let ((sender (make-thread (lambda () (client-sender socket username)) |
97 | 116 | :name "client sender")) |
98 | 117 | (broadcast (make-thread (lambda () (server-broadcast socket)) |
99 | | - :name "server broadcast"))) |
| 118 | + :name "server broadcast")) |
| 119 | + (background-ping (make-thread (lambda () (client-background-ping socket)) |
| 120 | + :name "background ping"))) |
| 121 | + (join-thread background-ping) |
100 | 122 | (join-thread sender) |
101 | 123 | (join-thread broadcast)))) |
102 | 124 |
|
|
0 commit comments