From 2f0d04ce7febc3617a8bc0e7bb3fa2a823ae78da Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Tue, 11 Apr 2017 23:40:33 -0400 Subject: [PATCH 01/20] Cleaned up code and added loggers to pinpoint error --- Hermes/client.rkt | 15 +++++++++++--- Hermes/server.rkt | 52 +++++++++++++++++++++++++++++++++-------------- Makefile | 3 --- 3 files changed, 49 insertions(+), 21 deletions(-) delete mode 100644 Makefile diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 25be149..d4912e0 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -23,9 +23,11 @@ ; is there something in the input port. If yes? display it ; in the hello world +; custodian for client connections +(define main-client-cust (make-custodian)) ; make connection to server (define (client port-no) - (define main-client-cust (make-custodian)) + (parameterize ([current-custodian main-client-cust]) ;; connect to server at port 8080 (define-values (in out) (tcp-connect "localhost" port-no)) ;; define values @@ -39,17 +41,21 @@ ;; make threads 2 lines (define a (thread (lambda () + (displayln "Startting receiver thread\n") (let loop [] (receive-messages in) (sleep 1) (loop))))) (define t (thread (lambda () + (displayln "Starting sender thread\n") (let loop [] (send-messages username out) (sleep 1) (loop))))) + (displayln "Now waiting for sender thread") (thread-wait t) ;; returns prompt back to drracket + (displayln "Closing client ports") (close-input-port in) (close-output-port out)) (custodian-shutdown-all main-client-cust)) @@ -69,7 +75,7 @@ ;(kill-thread t)))) (cond ((string=? input "quit") (exit))) ;; modify to send messages to out port - (displayln (string-append username ": " input) out) + (displayln (string-append username ": " input "\n") out) (flush-output out) ;(semaphore-post fair) @@ -89,7 +95,9 @@ (define evt (sync/timeout 30 (read-line-evt in))) (cond [(eof-object? evt) (displayln "Server connection closed") - (exit)] + (custodian-shutdown-all main-client-cust) + ;(exit) + ] [(string? evt) (displayln evt)] ; could time stamp here or to send message [else @@ -99,4 +107,5 @@ ) (define stop (client 4321)) +(display "Client started\n") diff --git a/Hermes/server.rkt b/Hermes/server.rkt index d1f5a98..541024e 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -11,7 +11,7 @@ ;; every 5 seconds run to broadcast top message in list ;; and remove it from list (define messages-s (make-semaphore 1)) ;; control access to messages -(define messages '("hello, world!")) ;; stores a list of messages(strings) from currents +(define messages '()) ;; stores a list of messages(strings) from currents (define threads-s (make-semaphore 1)) ;; control access to threads ;; lets keep thread descriptor values @@ -35,13 +35,14 @@ (define (loop) (accept-and-handle listener) (loop)) + (displayln "threading the listeneter") (thread loop) ;; Create a thread whose job is to simply call broadcast iteratively (thread (lambda () + (display "Broadcast thread started!\n") (let loopb [] - (sleep 30) ;; wait 30 secs before beginning to broadcast + (sleep 10) ;; wait 30 secs before beginning to broadcast (broadcast) - (sleep 10) ;; sleep for 10 seconds between broadcasts (loopb))))) (lambda () (displayln "\nGoodbye, shutting down all services\n") @@ -51,25 +52,42 @@ (define cust (make-custodian)) (parameterize ([current-custodian cust]) (define-values (in out) (tcp-accept listener)) + (displayln "Sucessfully connected to a client") + (display in) + (displayln out) + (displayln "Sending client Welcome message") + (displayln "Welcome to Hermes coms") + (flush-output out) ; discard request header ; Discard the request header (up to blank line): - (regexp-match #rx"(\r\n|^)\r\n" in) + ; (regexp-match #rx"(\r\n|^)\r\n" in) (semaphore-wait connections-s) + (displayln "Got the semaphore") ;; keep track of open ports (set! connections (append connections (list (list in out)))) (semaphore-post connections-s) + (displayln "Successfully added a pair of ports") + connections ; start a thread to deal with specific client and add descriptor value to the list of threads - (set! threads (append threads (list (thread (lambda () + (semaphore-wait threads-s) + (define threadcom (thread (lambda () (handle in out) ;; this handles connection with that specific client - (close-input-port in) - (close-output-port out)))) - ) - ) + (display "handle successfully completed\n") + ; this might have been the issue + ;(close-input-port in) + ; (close-output-port out) + ))) + (set! threads (append threads (list threadcom))) + (semaphore-post threads-s) + (displayln "Successfully created a thread") + (displayln threadcom) + threads ;; Watcher thread: ;; kills current thread for waiting too long for connection from ;; clients (thread (lambda () + (display "Started a thread to kill hanging connecting thread\n") (sleep 360) (custodian-shutdown-all cust))))) @@ -79,9 +97,9 @@ (define (handle in out) ; define function to deal with incoming messages from client (define (something-to-say in) - (define evt-t0 (sync/timeout 30 (read-line-evt in 'linefeed))) + (define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed))) (cond [(eof-object? evt-t0) - (displayln (string-append "Connection closed " (current-thread) "exiting")) + (displayln "Connection closed. EOF received") (exit) ] [(string? evt-t0) @@ -91,11 +109,11 @@ (set! messages (append messages (list evt-t0))) (semaphore-post messages-s)] [else - (displayln (string-append "Nothing received from " (current-thread)))])) + (displayln "Timeout waiting. Nothing received from client")])) ; define function to deal with out - (define (something-to-send out) + (define (something-to-broadcast out) (define evt-t1 (sync/timeout 120 (thread-receive-evt))) ;; send message to client (fprintf out "~a~n" (thread-receive)) @@ -113,7 +131,7 @@ (thread (lambda () (let loop [] - (something-to-send out) + (something-to-broadcast out) (sleep 1) (loop)))) ; (server-loop in out) @@ -131,10 +149,14 @@ (thread-send thread-descriptor (first messages))) threads) (set! messages (rest messages)) + (displayln "Broadcasted a message\n") ) (display "No message to display\n") ; for later create file port for errors and save error messages to that file ) + messages ; whats the current state of messages (semaphore-post threads-s) (semaphore-post messages-s))) -(define stop (serve 4321)) ;; start server then close with stop \ No newline at end of file +(define stop (serve 4321)) ;; start server then close with stop +(display "Server process started\n") + diff --git a/Makefile b/Makefile deleted file mode 100644 index eda5bbb..0000000 --- a/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -# Remove idiotic save files -clean: - rm -rf *~ From 69523cc2ed211285468148d835c320447f21fc04 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 00:01:52 -0400 Subject: [PATCH 02/20] Clients can now talk with each other --- Hermes/Makefile | 3 +++ Hermes/server.rkt | 46 ++++++++++++++++++++++++++++++++++++---------- 2 files changed, 39 insertions(+), 10 deletions(-) create mode 100644 Hermes/Makefile diff --git a/Hermes/Makefile b/Hermes/Makefile new file mode 100644 index 0000000..eda5bbb --- /dev/null +++ b/Hermes/Makefile @@ -0,0 +1,3 @@ +# Remove idiotic save files +clean: + rm -rf *~ diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 541024e..c57fbe7 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -139,22 +139,48 @@ 'ok ) +;; a bunch of selectors, predicates for connections +(define (get-output-port ports) + (cadr ports) + ) + +(define (get-input-port ports) + (car ports) +) ;; define a broadcast function (define broadcast (lambda () (semaphore-wait messages-s) - (semaphore-wait threads-s) + (if (not (null? messages)) - (begin (map (lambda (thread-descriptor) - (thread-send thread-descriptor (first messages))) - threads) + (begin (map + (lambda (ports) + (displayln (first messages) (get-output-port ports)) + (flush-output (get-output-port ports)) + ;; log message to server + (displayln "Message sent") + ) + connections) + ;; remove top message (set! messages (rest messages)) - (displayln "Broadcasted a message\n") - ) - (display "No message to display\n") ; for later create file port for errors and save error messages to that file - ) - messages ; whats the current state of messages - (semaphore-post threads-s) + ;; current state of messages and connections + messages + connections) + (display "No message to display\n")) + ; Approach one was to broadcast via thread mailboxes + ;(semaphore-wait threads-s) + ;(if (not (null? messages)) + ; (begin (map (lambda (thread-descriptor) + ; (thread-send thread-descriptor (first messages))) + ; threads) + ; (set! messages (rest messages)) + ; (displayln "Broadcasted a message\n") + ;) + ;(display "No message to display\n") ; for later create file port for errors and save error messages to that file + ;) + ; messages ; whats the current state of messages + ;(semaphore-post threads-s) + (semaphore-post messages-s))) (define stop (serve 4321)) ;; start server then close with stop From 66d5762bd992d786f933825acdba71713fe80fcc Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 00:23:37 -0400 Subject: [PATCH 03/20] removed log messages from server.rkt, added semaphores stdout --- Hermes/client.rkt | 2 +- Hermes/server.rkt | 75 +++++++++++++++++++++++++++++------------------ 2 files changed, 48 insertions(+), 29 deletions(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index d4912e0..574f88a 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -41,7 +41,7 @@ ;; make threads 2 lines (define a (thread (lambda () - (displayln "Startting receiver thread\n") + (displayln "Starting receiver thread\n") (let loop [] (receive-messages in) (sleep 1) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index c57fbe7..de11d0e 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -1,6 +1,8 @@ #lang racket (require math/base) ;; for random number generation +;; TODO wrap "safer send in a function that takes care of semaphores" + ;; globals ;; must control access via semaphore as listener thread or broadcast thread ;; might need to access it @@ -17,7 +19,9 @@ ;; lets keep thread descriptor values (define threads '()) ;; stores a list of client serving threads as thread descriptor values - +;; several threads that might want to print to stdout +;; lets keep things civil +(define stdout (make-semaphore 1)) ;; @@ -35,11 +39,13 @@ (define (loop) (accept-and-handle listener) (loop)) - (displayln "threading the listeneter") + (displayln "threading the listener") (thread loop) ;; Create a thread whose job is to simply call broadcast iteratively (thread (lambda () + (semaphore-wait stdout) (display "Broadcast thread started!\n") + (semaphore-post stdout) (let loopb [] (sleep 10) ;; wait 30 secs before beginning to broadcast (broadcast) @@ -52,42 +58,46 @@ (define cust (make-custodian)) (parameterize ([current-custodian cust]) (define-values (in out) (tcp-accept listener)) + (semaphore-wait stdout) (displayln "Sucessfully connected to a client") - (display in) - (displayln out) + ;(display in) + ;(displayln out) (displayln "Sending client Welcome message") - (displayln "Welcome to Hermes coms") + (semaphore-post stdout) + (displayln "Welcome to Hermes coms\nType your message below" out) (flush-output out) ; discard request header ; Discard the request header (up to blank line): ; (regexp-match #rx"(\r\n|^)\r\n" in) (semaphore-wait connections-s) - (displayln "Got the semaphore") + ; (displayln "Got the semaphore") ;; keep track of open ports (set! connections (append connections (list (list in out)))) (semaphore-post connections-s) - (displayln "Successfully added a pair of ports") + ; (displayln "Successfully added a pair of ports") connections ; start a thread to deal with specific client and add descriptor value to the list of threads (semaphore-wait threads-s) (define threadcom (thread (lambda () (handle in out) ;; this handles connection with that specific client - (display "handle successfully completed\n") + ;(display "handle successfully completed\n") ; this might have been the issue ;(close-input-port in) ; (close-output-port out) ))) (set! threads (append threads (list threadcom))) (semaphore-post threads-s) - (displayln "Successfully created a thread") - (displayln threadcom) - threads + ; (displayln "Successfully created a thread") + ; (displayln threadcom) + ; threads ;; Watcher thread: ;; kills current thread for waiting too long for connection from ;; clients (thread (lambda () + (semaphore-wait stdout) (display "Started a thread to kill hanging connecting thread\n") + (semaphore-post stdout) (sleep 360) (custodian-shutdown-all cust))))) @@ -99,7 +109,9 @@ (define (something-to-say in) (define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed))) (cond [(eof-object? evt-t0) + (semaphore-wait stdout) (displayln "Connection closed. EOF received") + (semaphore-post stdout) (exit) ] [(string? evt-t0) @@ -109,16 +121,18 @@ (set! messages (append messages (list evt-t0))) (semaphore-post messages-s)] [else - (displayln "Timeout waiting. Nothing received from client")])) - + (semaphore-wait stdout) + (displayln "Timeout waiting. Nothing received from client") + (semaphore-post stdout)])) + ; -----NO LONGER NECESSARY not using thread mailboxes ---- ; define function to deal with out - (define (something-to-broadcast out) - (define evt-t1 (sync/timeout 120 (thread-receive-evt))) + ;(define (something-to-broadcast out) + ; (define evt-t1 (sync/timeout 120 (thread-receive-evt))) ;; send message to client - (fprintf out "~a~n" (thread-receive)) - (flush-output out) - ) + ; (fprintf out "~a~n" (thread-receive)) + ; (flush-output out) + ; ) ; thread them each ;; i could bind to values, and call wait on them @@ -126,14 +140,14 @@ (thread (lambda () (let loop [] (something-to-say in) - (sleep 1) + ; (sleep 1) (loop)))) - (thread (lambda () - (let loop [] - (something-to-broadcast out) - (sleep 1) - (loop)))) + ; (thread (lambda () + ; (let loop [] + ; (something-to-broadcast out) + ; (sleep 1) + ; (loop)))) ; (server-loop in out) ; (sleep 5) ;; wait 5 seconds to guarantee client has already send message 'ok @@ -158,15 +172,20 @@ (displayln (first messages) (get-output-port ports)) (flush-output (get-output-port ports)) ;; log message to server - (displayln "Message sent") + ;(displayln "Message sent") ) connections) ;; remove top message (set! messages (rest messages)) ;; current state of messages and connections - messages - connections) - (display "No message to display\n")) + ;messages + ;connections + (displayln "Message broadcasted")) + (begin (semaphore-wait stdout) + (display "No message to display\n") + (semaphore-post stdout))) + + ;;; -- NO LONGER IN USE --- TO BE DELETED ; Approach one was to broadcast via thread mailboxes ;(semaphore-wait threads-s) ;(if (not (null? messages)) From a540bc917f34e51651960470d5d73de64c4b3ccb Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 00:31:41 -0400 Subject: [PATCH 04/20] reduced time of broadcast to every 0.5 seconds to avoid hogging cpu and temps --- Hermes/client.rkt | 2 +- Hermes/server.rkt | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 574f88a..8aa19e1 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -92,7 +92,7 @@ ;; with server ;(semaphore-wait fair) ;; we will retrieve the line printed below from the server - (define evt (sync/timeout 30 (read-line-evt in))) + (define evt (sync/timeout 60 (read-line-evt in))) (cond [(eof-object? evt) (displayln "Server connection closed") (custodian-shutdown-all main-client-cust) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index de11d0e..4b590db 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -47,7 +47,7 @@ (display "Broadcast thread started!\n") (semaphore-post stdout) (let loopb [] - (sleep 10) ;; wait 30 secs before beginning to broadcast + (sleep 0.5) ;; wait 30 secs before beginning to broadcast (broadcast) (loopb))))) (lambda () @@ -98,7 +98,7 @@ (semaphore-wait stdout) (display "Started a thread to kill hanging connecting thread\n") (semaphore-post stdout) - (sleep 360) + (sleep 1360) (custodian-shutdown-all cust))))) ; (define (handle connections) From 11f4ae1946693cf5f46e8d0ed26494c490155e76 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 00:46:08 -0400 Subject: [PATCH 05/20] More updates. --- Hermes/server.rkt | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 4b590db..d3039d3 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -47,7 +47,7 @@ (display "Broadcast thread started!\n") (semaphore-post stdout) (let loopb [] - (sleep 0.5) ;; wait 30 secs before beginning to broadcast + ; (sleep 0.5) ;; wait 30 secs before beginning to broadcast (broadcast) (loopb))))) (lambda () @@ -166,7 +166,7 @@ (lambda () (semaphore-wait messages-s) - (if (not (null? messages)) + (cond [(not (null? messages)) (begin (map (lambda (ports) (displayln (first messages) (get-output-port ports)) @@ -180,10 +180,11 @@ ;; current state of messages and connections ;messages ;connections - (displayln "Message broadcasted")) - (begin (semaphore-wait stdout) - (display "No message to display\n") - (semaphore-post stdout))) + (displayln "Message broadcasted"))] + ) + ; (begin (semaphore-wait stdout) + ; (display "No message to display\n") + ; (semaphore-post stdout))) ;;; -- NO LONGER IN USE --- TO BE DELETED ; Approach one was to broadcast via thread mailboxes From 282197b1448dc34b2e26c352e6ebd0150c1f5199 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 12:23:26 -0400 Subject: [PATCH 06/20] cleaned up displaying format, added to delay to looped functions to not burn cpu cycles --- Hermes/client.rkt | 17 +++++++++-------- Hermes/server.rkt | 2 +- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 8aa19e1..329ea5d 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -1,5 +1,6 @@ #lang racket (require math/base) ;; for random number generation +;; TODO clean up string message output and alignment ;; author: Ibrahim Mkusa ;; about: print and read concurrently @@ -34,28 +35,28 @@ (display in) (displayln out) ;; binds to multiple values akin to unpacking tuples in python - (display "What's your name?\n") + (displayln "What's your name?") (define username (read-line)) ; (thread (lambda () ;; make threads 2 lines (define a (thread (lambda () - (displayln "Starting receiver thread\n") + (displayln "Starting receiver thread.") (let loop [] (receive-messages in) (sleep 1) (loop))))) (define t (thread (lambda () - (displayln "Starting sender thread\n") + (displayln "Starting sender thread.") (let loop [] (send-messages username out) (sleep 1) (loop))))) - (displayln "Now waiting for sender thread") + (displayln "Now waiting for sender thread.") (thread-wait t) ;; returns prompt back to drracket - (displayln "Closing client ports") + (displayln "Closing client ports.") (close-input-port in) (close-output-port out)) (custodian-shutdown-all main-client-cust)) @@ -75,7 +76,7 @@ ;(kill-thread t)))) (cond ((string=? input "quit") (exit))) ;; modify to send messages to out port - (displayln (string-append username ": " input "\n") out) + (displayln (string-append username ": " input) out) (flush-output out) ;(semaphore-post fair) @@ -94,7 +95,7 @@ ;; we will retrieve the line printed below from the server (define evt (sync/timeout 60 (read-line-evt in))) (cond [(eof-object? evt) - (displayln "Server connection closed") + (displayln "Server connection closed.") (custodian-shutdown-all main-client-cust) ;(exit) ] @@ -107,5 +108,5 @@ ) (define stop (client 4321)) -(display "Client started\n") +(displayln "Client started.") diff --git a/Hermes/server.rkt b/Hermes/server.rkt index d3039d3..a178222 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -47,7 +47,7 @@ (display "Broadcast thread started!\n") (semaphore-post stdout) (let loopb [] - ; (sleep 0.5) ;; wait 30 secs before beginning to broadcast + (sleep 0.5) ;; wait 0.5 secs before beginning to broadcast (broadcast) (loopb))))) (lambda () From 8984b45ac129ac35c4b05e00d7fbbd89cb086e58 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 12:33:13 -0400 Subject: [PATCH 07/20] Added a tracker for todo items and started added utility functions --- Hermes/TODO.txt | 7 +++++++ Hermes/client.rkt | 22 ++++++---------------- 2 files changed, 13 insertions(+), 16 deletions(-) create mode 100644 Hermes/TODO.txt diff --git a/Hermes/TODO.txt b/Hermes/TODO.txt new file mode 100644 index 0000000..9f9ae33 --- /dev/null +++ b/Hermes/TODO.txt @@ -0,0 +1,7 @@ +1. Create a racket module for commonly used functions +2. Log messages to proper file on server +3. add timestamps to clients messages +4. message parsable? +5. command parsable? +6. keep count of connected clients using object orientation +7. diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 329ea5d..894c178 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -1,28 +1,18 @@ #lang racket (require math/base) ;; for random number generation ;; TODO clean up string message output and alignment - ;; author: Ibrahim Mkusa ;; about: print and read concurrently ;; notes: output may need to be aligned and formatted nicely ;; look into ;; https://docs.racket-lang.org/gui/text-field_.html#%28meth._%28%28%28lib._mred%2Fmain..rkt%29._text-field~25%29._get-editor%29%29 -;; create custodian for managing all resources -;; so we can shutdown everything at once -;(define guard (make-custodian (current-custodian))) -;(current-custodian guard) -;; reads values continously from stdin and redisplays them - -;; Notes connect to server on localhost -;; use client template of tcpvanilla -;; use event for read-write - -;; modify read-loop-i -; read a value and send it to server via output-port - -; is there something in the input port. If yes? display it -; in the hello world +; Takes a string and a semaphore to print safely to stdout +(define displayln-safe + (lambda (a-string a-semaphore) + (semaphore-wait a-semaphore) + (displayln a-string) + (semaphore-post a-semaphore))) ; custodian for client connections (define main-client-cust (make-custodian)) From 3a5ce0d2aa1a6b4ad129ff4654baed9022edce42 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 12:57:55 -0400 Subject: [PATCH 08/20] refactored code to use thread-safe displayln-safe --- Hermes/TODO.txt | 3 ++- Hermes/client.rkt | 6 ------ Hermes/server.rkt | 37 ++++++++++++++++++------------------- 3 files changed, 20 insertions(+), 26 deletions(-) diff --git a/Hermes/TODO.txt b/Hermes/TODO.txt index 9f9ae33..d66b14a 100644 --- a/Hermes/TODO.txt +++ b/Hermes/TODO.txt @@ -4,4 +4,5 @@ 4. message parsable? 5. command parsable? 6. keep count of connected clients using object orientation -7. +7. maybe fiddle around with irc library +8. separate main running code from definitions diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 894c178..064db9e 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -7,12 +7,6 @@ ;; look into ;; https://docs.racket-lang.org/gui/text-field_.html#%28meth._%28%28%28lib._mred%2Fmain..rkt%29._text-field~25%29._get-editor%29%29 -; Takes a string and a semaphore to print safely to stdout -(define displayln-safe - (lambda (a-string a-semaphore) - (semaphore-wait a-semaphore) - (displayln a-string) - (semaphore-post a-semaphore))) ; custodian for client connections (define main-client-cust (make-custodian)) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index a178222..ad84acc 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -23,7 +23,12 @@ ;; lets keep things civil (define stdout (make-semaphore 1)) -;; +; Takes a string and a semaphore to print safely to stdout +(define displayln-safe + (lambda (a-string a-semaphore) + (semaphore-wait a-semaphore) + (displayln a-string) + (semaphore-post a-semaphore))) ;; This is a relay server making two clients communicate ;; Both `server' and `accept-and-handle' change @@ -43,9 +48,7 @@ (thread loop) ;; Create a thread whose job is to simply call broadcast iteratively (thread (lambda () - (semaphore-wait stdout) - (display "Broadcast thread started!\n") - (semaphore-post stdout) + (displayln-safe "Broadcast thread started!\n" stdout) (let loopb [] (sleep 0.5) ;; wait 0.5 secs before beginning to broadcast (broadcast) @@ -58,12 +61,11 @@ (define cust (make-custodian)) (parameterize ([current-custodian cust]) (define-values (in out) (tcp-accept listener)) - (semaphore-wait stdout) - (displayln "Sucessfully connected to a client") - ;(display in) - ;(displayln out) - (displayln "Sending client Welcome message") - (semaphore-post stdout) + ;; TODO + (displayln-safe (string-append + "Successfully connected to a client.\n" + "Sending client a welcome message.") + stdout) (displayln "Welcome to Hermes coms\nType your message below" out) (flush-output out) ; discard request header @@ -95,9 +97,9 @@ ;; kills current thread for waiting too long for connection from ;; clients (thread (lambda () - (semaphore-wait stdout) - (display "Started a thread to kill hanging connecting thread\n") - (semaphore-post stdout) + (displayln-safe (string-append + "Started a thread to kill hanging " + "connecting threads") stdout) (sleep 1360) (custodian-shutdown-all cust))))) @@ -109,9 +111,8 @@ (define (something-to-say in) (define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed))) (cond [(eof-object? evt-t0) - (semaphore-wait stdout) - (displayln "Connection closed. EOF received") - (semaphore-post stdout) + (displayln-safe "Connection closed. EOF received" + stdout) (exit) ] [(string? evt-t0) @@ -121,9 +122,7 @@ (set! messages (append messages (list evt-t0))) (semaphore-post messages-s)] [else - (semaphore-wait stdout) - (displayln "Timeout waiting. Nothing received from client") - (semaphore-post stdout)])) + (displayln-safe "Timeout waiting. Nothing received from client" stdout)])) ; -----NO LONGER NECESSARY not using thread mailboxes ---- ; define function to deal with out From 2899891a63adc7ddfdf212e00342bd297542552d Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 13:26:01 -0400 Subject: [PATCH 09/20] tidied up server.rkt --- Hermes/server.rkt | 119 +++++++++------------------------------------- 1 file changed, 23 insertions(+), 96 deletions(-) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index ad84acc..96f314b 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -19,8 +19,7 @@ ;; lets keep thread descriptor values (define threads '()) ;; stores a list of client serving threads as thread descriptor values -;; several threads that might want to print to stdout -;; lets keep things civil +;; Several threads may want to print to stdout, so lets make things civil (define stdout (make-semaphore 1)) ; Takes a string and a semaphore to print safely to stdout @@ -30,12 +29,6 @@ (displayln a-string) (semaphore-post a-semaphore))) -;; This is a relay server making two clients communicate -;; Both `server' and `accept-and-handle' change -;; to use a custodian. -;; To start server -;; (define stop (serve 8080)) -;; (stop) to close the server (define (serve port-no) (define main-cust (make-custodian)) @@ -68,46 +61,28 @@ stdout) (displayln "Welcome to Hermes coms\nType your message below" out) (flush-output out) - ; discard request header - ; Discard the request header (up to blank line): - ; (regexp-match #rx"(\r\n|^)\r\n" in) (semaphore-wait connections-s) - ; (displayln "Got the semaphore") - ;; keep track of open ports (set! connections (append connections (list (list in out)))) (semaphore-post connections-s) - ; (displayln "Successfully added a pair of ports") - connections ; start a thread to deal with specific client and add descriptor value to the list of threads (semaphore-wait threads-s) (define threadcom (thread (lambda () - (handle in out) ;; this handles connection with that specific client - ;(display "handle successfully completed\n") - ; this might have been the issue - ;(close-input-port in) - ; (close-output-port out) - ))) + (handle in out)))) ; comms between server and particular client (set! threads (append threads (list threadcom))) (semaphore-post threads-s) - ; (displayln "Successfully created a thread") - ; (displayln threadcom) - ; threads - ;; Watcher thread: - ;; kills current thread for waiting too long for connection from - ;; clients - (thread (lambda () - (displayln-safe (string-append - "Started a thread to kill hanging " - "connecting threads") stdout) - (sleep 1360) - (custodian-shutdown-all cust))))) -; (define (handle connections) -; ()) -;; each thread needs 2 new threads + ;; Watcher thread: + ;; kills current thread for waiting too long for connection from + (thread (lambda () + (displayln-safe (string-append + "Started a thread to kill hanging " + "connecting threads") stdout) + (sleep 1360) + (custodian-shutdown-all cust))))) + (define (handle in out) - ; define function to deal with incoming messages from client + ; deals with queueing incoming messages for server to broadcast to all clients (define (something-to-say in) (define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed))) (cond [(eof-object? evt-t0) @@ -124,84 +99,36 @@ [else (displayln-safe "Timeout waiting. Nothing received from client" stdout)])) - ; -----NO LONGER NECESSARY not using thread mailboxes ---- - ; define function to deal with out - ;(define (something-to-broadcast out) - ; (define evt-t1 (sync/timeout 120 (thread-receive-evt))) - ;; send message to client - ; (fprintf out "~a~n" (thread-receive)) - ; (flush-output out) - ; ) - ; thread them each - - ;; i could bind to values, and call wait on them - ;; thread that deals with incoming messages for that particular thread + ; Executes methods above in another thread (thread (lambda () (let loop [] (something-to-say in) ; (sleep 1) - (loop)))) + (loop))))) - ; (thread (lambda () - ; (let loop [] - ; (something-to-broadcast out) - ; (sleep 1) - ; (loop)))) - ; (server-loop in out) - ; (sleep 5) ;; wait 5 seconds to guarantee client has already send message - 'ok - ) - -;; a bunch of selectors, predicates for connections +; extracts output port from a list pair of input and output port (define (get-output-port ports) - (cadr ports) - ) + (cadr ports)) +; extracts input port (define (get-input-port ports) - (car ports) -) -;; define a broadcast function + (car ports)) + +; broadcasts received message from clients periodically (define broadcast (lambda () (semaphore-wait messages-s) - (cond [(not (null? messages)) (begin (map (lambda (ports) (displayln (first messages) (get-output-port ports)) - (flush-output (get-output-port ports)) - ;; log message to server - ;(displayln "Message sent") - ) + (flush-output (get-output-port ports))) connections) ;; remove top message (set! messages (rest messages)) - ;; current state of messages and connections - ;messages - ;connections - (displayln "Message broadcasted"))] - ) - ; (begin (semaphore-wait stdout) - ; (display "No message to display\n") - ; (semaphore-post stdout))) - - ;;; -- NO LONGER IN USE --- TO BE DELETED - ; Approach one was to broadcast via thread mailboxes - ;(semaphore-wait threads-s) - ;(if (not (null? messages)) - ; (begin (map (lambda (thread-descriptor) - ; (thread-send thread-descriptor (first messages))) - ; threads) - ; (set! messages (rest messages)) - ; (displayln "Broadcasted a message\n") - ;) - ;(display "No message to display\n") ; for later create file port for errors and save error messages to that file - ;) - ; messages ; whats the current state of messages - ;(semaphore-post threads-s) - + (displayln "Message broadcasted"))]) (semaphore-post messages-s))) +; TODO move to its own file (define stop (serve 4321)) ;; start server then close with stop (display "Server process started\n") - From 4c26f1eaa3178bef2e69f38e63bd186e89c70381 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 13:49:20 -0400 Subject: [PATCH 10/20] tidied up client.rkt. More stuff to TODO.txt --- Hermes/TODO.txt | 2 ++ Hermes/client.rkt | 39 +++++---------------------------------- 2 files changed, 7 insertions(+), 34 deletions(-) diff --git a/Hermes/TODO.txt b/Hermes/TODO.txt index d66b14a..02c421c 100644 --- a/Hermes/TODO.txt +++ b/Hermes/TODO.txt @@ -6,3 +6,5 @@ 6. keep count of connected clients using object orientation 7. maybe fiddle around with irc library 8. separate main running code from definitions +9. closure connections, messages, threads. Avoid using set! without an object + like make-account diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 064db9e..db1a50c 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -4,15 +4,12 @@ ;; author: Ibrahim Mkusa ;; about: print and read concurrently ;; notes: output may need to be aligned and formatted nicely -;; look into -;; https://docs.racket-lang.org/gui/text-field_.html#%28meth._%28%28%28lib._mred%2Fmain..rkt%29._text-field~25%29._get-editor%29%29 ; custodian for client connections (define main-client-cust (make-custodian)) ; make connection to server (define (client port-no) - (parameterize ([current-custodian main-client-cust]) ;; connect to server at port 8080 (define-values (in out) (tcp-connect "localhost" port-no)) ;; define values @@ -22,8 +19,6 @@ (displayln "What's your name?") (define username (read-line)) - ; (thread (lambda () - ;; make threads 2 lines (define a (thread (lambda () (displayln "Starting receiver thread.") @@ -46,37 +41,17 @@ (custodian-shutdown-all main-client-cust)) -;; the send-messages +;; sends a message to the server (define (send-messages username out) ;; intelligent read, quits when user types in "quit" - ;(semaphore-wait fair) - ; (display usernamei) (define input (read-line)) - ;; do something over here with input maybe send it out - - ;; Tests input if its a quit then kills all threads - ;; An if would be better here tbh - ;; (cond ((string=? input "quit") (begin (kill-thread a) - ;(kill-thread t)))) (cond ((string=? input "quit") (exit))) - ;; modify to send messages to out port (displayln (string-append username ": " input) out) - (flush-output out) + (flush-output out)) - ;(semaphore-post fair) - ; (read-loop-i out) -) - - - -;; print hello world continously -;; "(hello-world)" can be executed as part of background thread -;; that prints in the event there is something in the input port +; receives input from server and displays it to stdout (define (receive-messages in) - ; (sleep (random-integer 0 15)) ;; sleep between 0 and 15 seconds to simulate coms - ;; with server - ;(semaphore-wait fair) - ;; we will retrieve the line printed below from the server + ; retrieve a message from server (define evt (sync/timeout 60 (read-line-evt in))) (cond [(eof-object? evt) (displayln "Server connection closed.") @@ -86,11 +61,7 @@ [(string? evt) (displayln evt)] ; could time stamp here or to send message [else - (displayln (string-append "Nothing received from server for 2 minutes."))] - ) - ;(semaphore-post fair) -) + (displayln (string-append "Nothing received from server for 2 minutes."))])) (define stop (client 4321)) (displayln "Client started.") - From cffd7a429993da67bf6d64e713c4a147fe287b9c Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Thu, 13 Apr 2017 13:45:53 -0400 Subject: [PATCH 11/20] Added counter to keep track number of connected clients --- Hermes/TODO.txt | 5 ++++- Hermes/server.rkt | 44 ++++++++++++++++++++++++++++++++++++++------ 2 files changed, 42 insertions(+), 7 deletions(-) diff --git a/Hermes/TODO.txt b/Hermes/TODO.txt index 02c421c..c1f17fa 100644 --- a/Hermes/TODO.txt +++ b/Hermes/TODO.txt @@ -6,5 +6,8 @@ 6. keep count of connected clients using object orientation 7. maybe fiddle around with irc library 8. separate main running code from definitions -9. closure connections, messages, threads. Avoid using set! without an object +**9. closure connections, messages, threads. Avoid using set! without an object like make-account +make own count to deal with closures +10. authentication for databases +11. user can ask for no of logged in users. Server has to parse diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 96f314b..b0f2dff 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -4,10 +4,35 @@ ;; TODO wrap "safer send in a function that takes care of semaphores" ;; globals -;; must control access via semaphore as listener thread or broadcast thread -;; might need to access it +; track number of connections with closure +(define (make-count no-count) + (define (increment) + (set! no-count (+ no-count 1)) + no-count) + (define (decrement) + (set! no-count (- no-count 1)) + no-count) + (define (current-count) + no-count) + (define (dispatch m) + (cond [(eq? m 'increment) increment] + [(eq? m 'decrement) decrement] + [(eq? m 'current-count) current-count])) + dispatch) +(define c-count (make-count 0)) +(define c-count-s (make-semaphore 1)) + (define connections '()) ;; maintains a list of open ports -;; ((in1, out1), (in2, out2), (in3, out3), (in4, out4) ...) + +(define (make-connections connections) + (define (null-cons?) + (null? connections)) + (define (add in out) + (set! connections (append connections (list (list in out)))) + connections) + (define (cons-list) + connections)) + (define connections-s (make-semaphore 1)) ;; control access to connections ;; every 5 seconds run to broadcast top message in list @@ -54,7 +79,11 @@ (define cust (make-custodian)) (parameterize ([current-custodian cust]) (define-values (in out) (tcp-accept listener)) - ;; TODO + ; increment number of connections + (semaphore-wait c-count-s) + ((c-count 'increment)) + (semaphore-post c-count-s) + (displayln-safe (string-append "Successfully connected to a client.\n" "Sending client a welcome message.") @@ -88,8 +117,11 @@ (cond [(eof-object? evt-t0) (displayln-safe "Connection closed. EOF received" stdout) - (exit) - ] + (semaphore-wait c-count-s) + ((c-count 'decrement)) + (semaphore-post c-count-s) + ;(exit) + (kill-thread (current-thread))] [(string? evt-t0) (semaphore-wait messages-s) ; append the message to list of messages From a0fbba4a81b0ebc4819c3413a8bf06ae0d3aeb5c Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Thu, 13 Apr 2017 14:01:32 -0400 Subject: [PATCH 12/20] tracking a list of input and output ports via closures and sets --- Hermes/server.rkt | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index b0f2dff..216c6e2 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -22,8 +22,8 @@ (define c-count (make-count 0)) (define c-count-s (make-semaphore 1)) -(define connections '()) ;; maintains a list of open ports +; track list of input output port pairs in a list contained in a closure (define (make-connections connections) (define (null-cons?) (null? connections)) @@ -31,7 +31,13 @@ (set! connections (append connections (list (list in out)))) connections) (define (cons-list) - connections)) + connections) + (define (dispatch m) + (cond [(eq? m 'null-cons) null-cons?] + [(eq? m 'cons-list) cons-list] + [(eq? m 'add) add])) + dispatch) +(define c-connections (make-connections '())) (define connections-s (make-semaphore 1)) ;; control access to connections @@ -91,7 +97,8 @@ (displayln "Welcome to Hermes coms\nType your message below" out) (flush-output out) (semaphore-wait connections-s) - (set! connections (append connections (list (list in out)))) + ; (set! connections (append connections (list (list in out)))) + ((c-connections 'add) in out) (semaphore-post connections-s) ; start a thread to deal with specific client and add descriptor value to the list of threads @@ -155,7 +162,7 @@ (lambda (ports) (displayln (first messages) (get-output-port ports)) (flush-output (get-output-port ports))) - connections) + ((c-connections 'cons-list))) ;; remove top message (set! messages (rest messages)) (displayln "Message broadcasted"))]) From 2c8407d195bef9219aad357bc2a327c392d38e1a Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Thu, 13 Apr 2017 14:09:40 -0400 Subject: [PATCH 13/20] tidied up, removed some unused definitions --- Hermes/{TODO.txt => TODO} | 0 Hermes/server.rkt | 9 ++------- 2 files changed, 2 insertions(+), 7 deletions(-) rename Hermes/{TODO.txt => TODO} (100%) diff --git a/Hermes/TODO.txt b/Hermes/TODO similarity index 100% rename from Hermes/TODO.txt rename to Hermes/TODO diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 216c6e2..59f33d2 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -1,8 +1,6 @@ #lang racket (require math/base) ;; for random number generation -;; TODO wrap "safer send in a function that takes care of semaphores" - ;; globals ; track number of connections with closure (define (make-count no-count) @@ -20,6 +18,7 @@ [(eq? m 'current-count) current-count])) dispatch) (define c-count (make-count 0)) +; a semaphore to control access to c-count (define c-count-s (make-semaphore 1)) @@ -38,7 +37,7 @@ [(eq? m 'add) add])) dispatch) (define c-connections (make-connections '())) - +; a semaphore to control acess to c-connections (define connections-s (make-semaphore 1)) ;; control access to connections ;; every 5 seconds run to broadcast top message in list @@ -46,10 +45,6 @@ (define messages-s (make-semaphore 1)) ;; control access to messages (define messages '()) ;; stores a list of messages(strings) from currents -(define threads-s (make-semaphore 1)) ;; control access to threads -;; lets keep thread descriptor values -(define threads '()) ;; stores a list of client serving threads as thread descriptor values - ;; Several threads may want to print to stdout, so lets make things civil (define stdout (make-semaphore 1)) From 31308f35fdc66da7a5059b108207bb1a71276770 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Thu, 13 Apr 2017 14:38:58 -0400 Subject: [PATCH 14/20] messages are now tracked via a closure. --- Hermes/client.rkt | 2 +- Hermes/server.rkt | 36 ++++++++++++++++++++++++------------ 2 files changed, 25 insertions(+), 13 deletions(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index db1a50c..11e2041 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -63,5 +63,5 @@ [else (displayln (string-append "Nothing received from server for 2 minutes."))])) +(displayln "Starting client.") (define stop (client 4321)) -(displayln "Client started.") diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 59f33d2..a672c2b 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -2,6 +2,7 @@ (require math/base) ;; for random number generation ;; globals +(define welcome-message "Welcome to Hermes coms. Type your message below") ; track number of connections with closure (define (make-count no-count) (define (increment) @@ -40,10 +41,24 @@ ; a semaphore to control acess to c-connections (define connections-s (make-semaphore 1)) ;; control access to connections -;; every 5 seconds run to broadcast top message in list -;; and remove it from list +; Track received messages in a closure +(define (make-messages messages) + (define (add message) + (set! messages (append messages (list message))) + messages) + (define (mes-list) + messages) + (define (remove-top) + (set! messages (rest messages)) + messages) + (define (dispatch m) + (cond [(eq? m 'add) add] + [(eq? m 'mes-list) mes-list] + [(eq? m 'remove-top) remove-top])) + dispatch) +(define c-messages (make-messages '())) +; semaphore to control access to c-messages (define messages-s (make-semaphore 1)) ;; control access to messages -(define messages '()) ;; stores a list of messages(strings) from currents ;; Several threads may want to print to stdout, so lets make things civil (define stdout (make-semaphore 1)) @@ -86,10 +101,10 @@ (semaphore-post c-count-s) (displayln-safe (string-append - "Successfully connected to a client.\n" + "Successfully connected to a client. " "Sending client a welcome message.") stdout) - (displayln "Welcome to Hermes coms\nType your message below" out) + (displayln welcome-message out) (flush-output out) (semaphore-wait connections-s) ; (set! connections (append connections (list (list in out)))) @@ -97,11 +112,8 @@ (semaphore-post connections-s) ; start a thread to deal with specific client and add descriptor value to the list of threads - (semaphore-wait threads-s) (define threadcom (thread (lambda () (handle in out)))) ; comms between server and particular client - (set! threads (append threads (list threadcom))) - (semaphore-post threads-s) ;; Watcher thread: ;; kills current thread for waiting too long for connection from @@ -128,7 +140,7 @@ (semaphore-wait messages-s) ; append the message to list of messages (display (string-append evt-t0 "\n")) - (set! messages (append messages (list evt-t0))) + ((c-messages 'add) evt-t0) (semaphore-post messages-s)] [else (displayln-safe "Timeout waiting. Nothing received from client" stdout)])) @@ -152,14 +164,14 @@ (define broadcast (lambda () (semaphore-wait messages-s) - (cond [(not (null? messages)) + (cond [(not (null? ((c-messages 'mes-list)))) (begin (map (lambda (ports) - (displayln (first messages) (get-output-port ports)) + (displayln (first ((c-messages 'mes-list))) (get-output-port ports)) (flush-output (get-output-port ports))) ((c-connections 'cons-list))) ;; remove top message - (set! messages (rest messages)) + ((c-messages 'remove-top)) (displayln "Message broadcasted"))]) (semaphore-post messages-s))) From f6687e7d62ea9139f403c3c8d7c3ffa797aa3583 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Thu, 13 Apr 2017 15:20:47 -0400 Subject: [PATCH 15/20] timestamps added to messages --- Hermes/TODO | 7 +++++-- Hermes/client.rkt | 10 +++++++++- Hermes/server.rkt | 1 - 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index c1f17fa..5a357fc 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -1,6 +1,5 @@ 1. Create a racket module for commonly used functions 2. Log messages to proper file on server -3. add timestamps to clients messages 4. message parsable? 5. command parsable? 6. keep count of connected clients using object orientation @@ -10,4 +9,8 @@ like make-account make own count to deal with closures 10. authentication for databases -11. user can ask for no of logged in users. Server has to parse +11. user can ask for no of logged in users. Server has to pars +e +12. Hide user's own input in command line +13. Need to gracefully handle disconnected clients by removing from list +of connections diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 11e2041..86813ac 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -46,13 +46,21 @@ ;; intelligent read, quits when user types in "quit" (define input (read-line)) (cond ((string=? input "quit") (exit))) - (displayln (string-append username ": " input) out) + ; get current time + (define date-today (seconds->date (current-seconds) #t)) + ;TODO pad the second if its only 1 character + (define date-print (string-append (number->string (date-hour date-today)) + ":" + (number->string (date-second date-today)) + "| ")) + (displayln (string-append date-print username ": " input) out) (flush-output out)) ; receives input from server and displays it to stdout (define (receive-messages in) ; retrieve a message from server (define evt (sync/timeout 60 (read-line-evt in))) + (cond [(eof-object? evt) (displayln "Server connection closed.") (custodian-shutdown-all main-client-cust) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index a672c2b..20a83bb 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -107,7 +107,6 @@ (displayln welcome-message out) (flush-output out) (semaphore-wait connections-s) - ; (set! connections (append connections (list (list in out)))) ((c-connections 'add) in out) (semaphore-post connections-s) From 8d9765ca8c154f1a30695f2de3c26166d0451ae4 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Thu, 13 Apr 2017 15:57:58 -0400 Subject: [PATCH 16/20] Clients now default to leaving sign out messages --- Hermes/TODO | 6 ++---- Hermes/client.rkt | 14 ++++++++++---- Hermes/server.rkt | 5 +++++ 3 files changed, 17 insertions(+), 8 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index 5a357fc..bff56e6 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -5,12 +5,10 @@ 6. keep count of connected clients using object orientation 7. maybe fiddle around with irc library 8. separate main running code from definitions -**9. closure connections, messages, threads. Avoid using set! without an object - like make-account -make own count to deal with closures 10. authentication for databases 11. user can ask for no of logged in users. Server has to pars e 12. Hide user's own input in command line -13. Need to gracefully handle disconnected clients by removing from list +** 13. Need to gracefully handle disconnected clients by removing from list of connections +14. bye message prompt for clients diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 86813ac..9b7d4a0 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -43,16 +43,22 @@ ;; sends a message to the server (define (send-messages username out) - ;; intelligent read, quits when user types in "quit" - (define input (read-line)) - (cond ((string=? input "quit") (exit))) ; get current time (define date-today (seconds->date (current-seconds) #t)) ;TODO pad the second if its only 1 character (define date-print (string-append (number->string (date-hour date-today)) + ":" + (number->string (date-minute date-today)) ":" (number->string (date-second date-today)) - "| ")) + " | ")) + ;; intelligent read, quits when user types in "quit" + (define input (read-line)) + (cond ((string=? input "quit") + (displayln (string-append date-print username " signing out. See ya!") out) + (flush-output out) + (exit))) + (displayln (string-append date-print username ": " input) out) (flush-output out)) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 20a83bb..5b599a7 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -105,6 +105,11 @@ "Sending client a welcome message.") stdout) (displayln welcome-message out) + ;; print to server log and client + (define print-no-users (string-append "Number of users in chat: " + (number->string ((c-count 'current-count))))) + (displayln print-no-users out) + (displayln-safe print-no-users stdout) (flush-output out) (semaphore-wait connections-s) ((c-connections 'add) in out) From f8fef5c5ae63c0933f92a25d82da447ff44c2444 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Fri, 14 Apr 2017 00:44:42 -0400 Subject: [PATCH 17/20] now handles disconnected clients --- Hermes/TODO | 2 +- Hermes/server.rkt | 15 +++++++++++++++ 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/Hermes/TODO b/Hermes/TODO index bff56e6..c8dbc75 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -9,6 +9,6 @@ 11. user can ask for no of logged in users. Server has to pars e 12. Hide user's own input in command line -** 13. Need to gracefully handle disconnected clients by removing from list +** 13. Need to gracefully handle disconnected clients by removing from list user filter of connections 14. bye message prompt for clients diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 5b599a7..5673eca 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -32,9 +32,19 @@ connections) (define (cons-list) connections) + (define (remove-ports in out) + (set! connections + (filter + (lambda (ports) + (if (and (eq? in (get-input-port ports)) + (eq? out (get-output-port ports))) + #f + #t)) + connections))) (define (dispatch m) (cond [(eq? m 'null-cons) null-cons?] [(eq? m 'cons-list) cons-list] + [(eq? m 'remove-ports) remove-ports] [(eq? m 'add) add])) dispatch) (define c-connections (make-connections '())) @@ -133,6 +143,11 @@ (define (something-to-say in) (define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed))) (cond [(eof-object? evt-t0) + ; TODO remove pair of ports associated with client + (semaphore-wait connections-s) + ((c-connections 'remove-ports) in out) + (semaphore-post connections-s) + (displayln-safe "Connection closed. EOF received" stdout) (semaphore-wait c-count-s) From 0e1636e816dc58d26bf9686f2307b17043d0b218 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Fri, 14 Apr 2017 09:40:01 -0400 Subject: [PATCH 18/20] Hermes is pre-alpha ready --- Hermes/TODO | 8 ++++---- Hermes/client.rkt | 5 ++++- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index c8dbc75..8ad5a92 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -1,14 +1,14 @@ +FEATURES 1. Create a racket module for commonly used functions -2. Log messages to proper file on server +2. Log error messages and channel conservations to proper files on server 4. message parsable? 5. command parsable? -6. keep count of connected clients using object orientation 7. maybe fiddle around with irc library 8. separate main running code from definitions 10. authentication for databases 11. user can ask for no of logged in users. Server has to pars e 12. Hide user's own input in command line -** 13. Need to gracefully handle disconnected clients by removing from list user filter -of connections 14. bye message prompt for clients +15. Session stickiness for clients +16. plain tcp -> ssl based diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 9b7d4a0..3b65cfa 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -4,6 +4,9 @@ ;; author: Ibrahim Mkusa ;; about: print and read concurrently ;; notes: output may need to be aligned and formatted nicely +(define host "10.0.0.160") ; internal home +(define host2 "67.186.191.81") +(define port-num 4321) ; custodian for client connections @@ -12,7 +15,7 @@ (define (client port-no) (parameterize ([current-custodian main-client-cust]) ;; connect to server at port 8080 - (define-values (in out) (tcp-connect "localhost" port-no)) ;; define values + (define-values (in out) (tcp-connect host2 port-no)) ;; define values (display in) (displayln out) ;; binds to multiple values akin to unpacking tuples in python From fd2488cf59f0f19ee0e09ca4792fc2262bc4708e Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Fri, 14 Apr 2017 09:51:08 -0400 Subject: [PATCH 19/20] Tell git to ignore temporary files --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..49a9d25 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +# ignore temporary files +*~ From e09975a02c24c53a6b8c4a704b74236945c3fdcc Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Fri, 14 Apr 2017 09:57:40 -0400 Subject: [PATCH 20/20] tidied up --- {Hermes => tests/gui}/concurrentreadandprint.rkt | 0 {Hermes => tests/tcpvanilla}/tcpcommunication.rkt | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename {Hermes => tests/gui}/concurrentreadandprint.rkt (100%) rename {Hermes => tests/tcpvanilla}/tcpcommunication.rkt (100%) diff --git a/Hermes/concurrentreadandprint.rkt b/tests/gui/concurrentreadandprint.rkt similarity index 100% rename from Hermes/concurrentreadandprint.rkt rename to tests/gui/concurrentreadandprint.rkt diff --git a/Hermes/tcpcommunication.rkt b/tests/tcpvanilla/tcpcommunication.rkt similarity index 100% rename from Hermes/tcpcommunication.rkt rename to tests/tcpvanilla/tcpcommunication.rkt