diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | Hermes/Makefile (renamed from Makefile) | 0 | ||||
| -rw-r--r-- | Hermes/TODO | 14 | ||||
| -rw-r--r-- | Hermes/client.rkt | 94 | ||||
| -rw-r--r-- | Hermes/server.rkt | 227 | ||||
| -rw-r--r-- | tests/gui/concurrentreadandprint.rkt (renamed from Hermes/concurrentreadandprint.rkt) | 0 | ||||
| -rw-r--r-- | tests/tcpvanilla/tcpcommunication.rkt (renamed from Hermes/tcpcommunication.rkt) | 0 |
7 files changed, 197 insertions, 140 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..49a9d25 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +# ignore temporary files +*~ diff --git a/Makefile b/Hermes/Makefile index eda5bbb..eda5bbb 100644 --- a/Makefile +++ b/Hermes/Makefile diff --git a/Hermes/TODO b/Hermes/TODO new file mode 100644 index 0000000..8ad5a92 --- /dev/null +++ b/Hermes/TODO @@ -0,0 +1,14 @@ +FEATURES +1. Create a racket module for commonly used functions +2. Log error messages and channel conservations to proper files on server +4. message parsable? +5. command parsable? +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 +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 25be149..3b65cfa 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -1,102 +1,84 @@ #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 +(define host "10.0.0.160") ; internal home +(define host2 "67.186.191.81") +(define port-num 4321) -;; 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 +; 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 + (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 - (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.") (let loop [] (receive-messages in) (sleep 1) (loop))))) (define t (thread (lambda () + (displayln "Starting sender thread.") (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)) -;; the send-messages +;; sends a message to the server (define (send-messages username 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-minute date-today)) + ":" + (number->string (date-second date-today)) + " | ")) ;; 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 + (cond ((string=? input "quit") + (displayln (string-append date-print username " signing out. See ya!") out) + (flush-output out) + (exit))) - ;; 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) - - ;(semaphore-post fair) - ; (read-loop-i out) -) + (displayln (string-append date-print username ": " input) out) + (flush-output 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 - (define evt (sync/timeout 30 (read-line-evt in))) + ; retrieve a message from server + (define evt (sync/timeout 60 (read-line-evt in))) + (cond [(eof-object? evt) - (displayln "Server connection closed") - (exit)] + (displayln "Server connection closed.") + (custodian-shutdown-all main-client-cust) + ;(exit) + ] [(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."))])) +(displayln "Starting client.") (define stop (client 4321)) - diff --git a/Hermes/server.rkt b/Hermes/server.rkt index d1f5a98..5673eca 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -2,31 +2,84 @@ (require math/base) ;; for random number generation ;; globals -;; must control access via semaphore as listener thread or broadcast thread -;; might need to access it -(define connections '()) ;; maintains a list of open ports -;; ((in1, out1), (in2, out2), (in3, out3), (in4, out4) ...) +(define welcome-message "Welcome to Hermes coms. Type your message below") +; 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)) +; a semaphore to control access to c-count +(define c-count-s (make-semaphore 1)) + + +; track list of input output port pairs in a list contained in a closure +(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 (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 '())) +; 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 '("hello, world!")) ;; 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)) +; 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 -;; 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)) @@ -35,13 +88,14 @@ (define (loop) (accept-and-handle listener) (loop)) + (displayln "threading the listener") (thread loop) ;; Create a thread whose job is to simply call broadcast iteratively (thread (lambda () + (displayln-safe "Broadcast thread started!\n" stdout) (let loopb [] - (sleep 30) ;; wait 30 secs before beginning to broadcast + (sleep 0.5) ;; wait 0.5 secs before beginning to broadcast (broadcast) - (sleep 10) ;; sleep for 10 seconds between broadcasts (loopb))))) (lambda () (displayln "\nGoodbye, shutting down all services\n") @@ -51,90 +105,95 @@ (define cust (make-custodian)) (parameterize ([current-custodian cust]) (define-values (in out) (tcp-accept listener)) - ; discard request header - ; Discard the request header (up to blank line): - (regexp-match #rx"(\r\n|^)\r\n" in) + ; 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. " + "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) - ;; keep track of open ports - (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 - (set! threads (append threads (list (thread (lambda () - (handle in out) ;; this handles connection with that specific client - (close-input-port in) - (close-output-port out)))) - ) - ) - ;; Watcher thread: - ;; kills current thread for waiting too long for connection from - ;; clients - (thread (lambda () - (sleep 360) - (custodian-shutdown-all cust))))) + (define threadcom (thread (lambda () + (handle in out)))) ; comms between server and particular client + + ;; 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 connections) -; ()) -;; each thread needs 2 new threads (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 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")) - (exit) - ] + ; 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) + ((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 (display (string-append evt-t0 "\n")) - (set! messages (append messages (list evt-t0))) + ((c-messages 'add) evt-t0) (semaphore-post messages-s)] [else - (displayln (string-append "Nothing received from " (current-thread)))])) + (displayln-safe "Timeout waiting. Nothing received from client" stdout)])) - - ; define function to deal with out - (define (something-to-send 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)))) + ; (sleep 1) + (loop))))) - (thread (lambda () - (let loop [] - (something-to-send out) - (sleep 1) - (loop)))) - ; (server-loop in out) - ; (sleep 5) ;; wait 5 seconds to guarantee client has already send message - 'ok - ) - -;; define a broadcast function +; extracts output port from a list pair of input and output port +(define (get-output-port ports) + (cadr ports)) + +; extracts input port +(define (get-input-port ports) + (car ports)) + +; broadcasts received message from clients periodically (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) - (set! messages (rest messages)) - ) - (display "No message to display\n") ; for later create file port for errors and save error messages to that file - ) - (semaphore-post threads-s) + (cond [(not (null? ((c-messages 'mes-list)))) + (begin (map + (lambda (ports) + (displayln (first ((c-messages 'mes-list))) (get-output-port ports)) + (flush-output (get-output-port ports))) + ((c-connections 'cons-list))) + ;; remove top message + ((c-messages 'remove-top)) + (displayln "Message broadcasted"))]) (semaphore-post messages-s))) -(define stop (serve 4321)) ;; start server then close with stop
\ No newline at end of file +; TODO move to its own file +(define stop (serve 4321)) ;; start server then close with stop +(display "Server process started\n") diff --git a/Hermes/concurrentreadandprint.rkt b/tests/gui/concurrentreadandprint.rkt index 95d02c1..95d02c1 100644 --- a/Hermes/concurrentreadandprint.rkt +++ b/tests/gui/concurrentreadandprint.rkt diff --git a/Hermes/tcpcommunication.rkt b/tests/tcpvanilla/tcpcommunication.rkt index 134e697..134e697 100644 --- a/Hermes/tcpcommunication.rkt +++ b/tests/tcpvanilla/tcpcommunication.rkt |