diff options
| -rw-r--r-- | .gitignore | 8 | ||||
| -rw-r--r-- | Hermes/Makefile | 4 | ||||
| -rw-r--r-- | Hermes/TODO | 27 | ||||
| -rw-r--r-- | Hermes/client.rkt | 60 | ||||
| -rw-r--r-- | Hermes/modules/general.rkt | 24 | ||||
| -rw-r--r-- | Hermes/server.rkt | 169 |
6 files changed, 214 insertions, 78 deletions
@@ -1,2 +1,10 @@ # ignore temporary files *~ + +# ignore logs and configuration files +*.out +*.conf + +# ignore racket compile files +*.dep +*.zo diff --git a/Hermes/Makefile b/Hermes/Makefile index eda5bbb..fdd9a07 100644 --- a/Hermes/Makefile +++ b/Hermes/Makefile @@ -1,3 +1,3 @@ -# Remove idiotic save files +# Remove temporary files clean: - rm -rf *~ + rm -rf *~ *.out *.conf diff --git a/Hermes/TODO b/Hermes/TODO index 8ad5a92..bbc2930 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -1,14 +1,17 @@ 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 +5. parser in the client side should do something similar (/color, /quit) 16. plain tcp -> ssl based +17. fix breaks for improper disconnects from clients +18. Add topics after project completion +** regexes to parse strings for different formats -related to 5 +** align code better for readability + + +GOOD TO HAVE BUT NOT NECESSARY +7. maybe fiddle around with irc library (we leave this for future opl classes) no time got other classes +*14. bye message prompt for clients part of session stickiness +*15. Session stickiness for clients. Log received comms to a local file. +additionally save user details and prompt user to use defaults or create +new ones +10. authentication for databases - to avoid dependencies this is left out +** whispers aren't currently logged - its on purpose diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 3b65cfa..d4ad2a0 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -1,13 +1,29 @@ #lang racket + +(require "modules/general.rkt") (require math/base) ;; for random number generation ;; TODO clean up string message output and alignment +;; TODO close ports after done +;; i.e. seconds and minutes hours specifically ;; 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") + + +; we will prompt for these in the gui +(define host3 "localhost") (define port-num 4321) +(define sleep-t 0.1) + +; we won't need this. Just me being overzealous +(define hermes-conf (open-output-file "./hermes_client.conf" #:exists'append)) +(define hermes-conf-s (make-semaphore 1)) +(define convs-out (open-output-file "./convs_client.out" #:exists 'append)) +(define convs-out-s (make-semaphore 1)) + +(define error-out (open-output-file "./error_client.out" #:exists 'append)) +(define error-out-s (make-semaphore 1)) ; custodian for client connections (define main-client-cust (make-custodian)) @@ -15,30 +31,35 @@ (define (client port-no) (parameterize ([current-custodian main-client-cust]) ;; connect to server at port 8080 - (define-values (in out) (tcp-connect host2 port-no)) ;; define values - (display in) - (displayln out) + (define-values (in out) (tcp-connect host3 port-no)) ;; define values ;; binds to multiple values akin to unpacking tuples in python + + ; store username to a file for later retrieval along with relevent + ; info used for authentication with server (displayln "What's your name?") (define username (read-line)) + ;send the username to the server (username in out) + (displayln username out) + (flush-output out) + (define a (thread (lambda () - (displayln "Starting receiver thread.") + (displayln-safe "Starting receiver thread." error-out-s error-out) (let loop [] (receive-messages in) - (sleep 1) + (sleep sleep-t) (loop))))) (define t (thread (lambda () - (displayln "Starting sender thread.") + (displayln-safe "Starting sender thread." error-out-s error-out) (let loop [] (send-messages username out) - (sleep 1) + (sleep sleep-t) (loop))))) - (displayln "Now waiting for sender thread.") + (displayln-safe "Now waiting for sender thread." error-out-s error-out) (thread-wait t) ;; returns prompt back to drracket - (displayln "Closing client ports.") + (displayln-safe "Closing client ports." error-out-s error-out) (close-input-port in) (close-output-port out)) (custodian-shutdown-all main-client-cust)) @@ -55,11 +76,14 @@ ":" (number->string (date-second date-today)) " | ")) - ;; intelligent read, quits when user types in "quit" + ;; read, quits when user types in "quit" (define input (read-line)) + ; TODO /quit instead of quit (cond ((string=? input "quit") (displayln (string-append date-print username " signing out. See ya!") out) (flush-output out) + (close-output-port error-out) + (close-output-port convs-out) (exit))) (displayln (string-append date-print username ": " input) out) @@ -68,17 +92,17 @@ ; 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))) + (define evt (sync (read-line-evt in))) (cond [(eof-object? evt) - (displayln "Server connection closed.") + (displayln-safe "Server connection closed." error-out-s error-out) (custodian-shutdown-all main-client-cust) ;(exit) ] [(string? evt) - (displayln evt)] ; could time stamp here or to send message + (displayln-safe evt convs-out-s convs-out)] ; could time stamp here or to send message [else - (displayln (string-append "Nothing received from server for 2 minutes."))])) + (displayln-safe (string-append "Nothing received from server for 2 minutes.") convs-out-s convs-out)])) -(displayln "Starting client.") -(define stop (client 4321)) +(displayln-safe "Starting client." error-out-s error-out) +(define stop-client (client 4321)) diff --git a/Hermes/modules/general.rkt b/Hermes/modules/general.rkt new file mode 100644 index 0000000..b33eb8a --- /dev/null +++ b/Hermes/modules/general.rkt @@ -0,0 +1,24 @@ +#lang racket + +(provide displayln-safe) +;; Several threads may want to print to stdout, so lets make things civil +; constant always available +(define stdout (make-semaphore 1)) + +; prints to stdout with an optional output port +; requires a specified semaphore for the optional output port +(define displayln-safe + (lambda (a-string [a-semaphore stdout] [a-output-port (current-output-port)]) + (cond [(not (and (eq? a-semaphore stdout) (eq? a-output-port (current-output-port)))) + (semaphore-wait a-semaphore) + (semaphore-wait stdout) + (displayln a-string a-output-port) + (flush-output a-output-port) + (displayln a-string) + (semaphore-post stdout) + (semaphore-post a-semaphore)] + [else + (semaphore-wait stdout) + (displayln a-string) + (semaphore-post stdout)]))) + diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 5673eca..df1cf26 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -1,8 +1,14 @@ #lang racket + +(require "modules/general.rkt") (require math/base) ;; for random number generation -;; globals + (define welcome-message "Welcome to Hermes coms. Type your message below") +(define successful-connection-m "Successfully connected to a client. Sending client a welcome message.") + +(define sleep-t 0.1) + ; track number of connections with closure (define (make-count no-count) (define (increment) @@ -27,8 +33,8 @@ (define (make-connections connections) (define (null-cons?) (null? connections)) - (define (add in out) - (set! connections (append connections (list (list in out)))) + (define (add username in out) + (set! connections (append connections (list (list username in out)))) connections) (define (cons-list) connections) @@ -70,99 +76,161 @@ ; semaphore to control access to c-messages (define messages-s (make-semaphore 1)) ;; control access to messages -;; 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))) - - +; two files to store error messages, and channel conversations +(define error-out (open-output-file "/home/pcuser/Hermes/Hermes/error_server.txt" #:exists 'append)) +(define convs-out (open-output-file "/home/pcuser/Hermes/Hermes/conversations_server.txt" #:exists 'append)) +(define error-out-s (make-semaphore 1)) +(define convs-out-s (make-semaphore 1)) +; TODO finish logging all error related messages to (define (serve port-no) (define main-cust (make-custodian)) (parameterize ([current-custodian main-cust]) (define listener (tcp-listen port-no 5 #t)) (define (loop) - (accept-and-handle listener) + (receive-clients listener) (loop)) - (displayln "threading the listener") + (displayln-safe "Starting up the listener." error-out-s error-out) (thread loop) + (displayln-safe "Listener successfully started." error-out-s error-out) ;; Create a thread whose job is to simply call broadcast iteratively (thread (lambda () - (displayln-safe "Broadcast thread started!\n" stdout) + (displayln-safe "Broadcast thread started!\n") (let loopb [] - (sleep 0.5) ;; wait 0.5 secs before beginning to broadcast + (sleep sleep-t) ;; wait 0.5 secs before beginning to broadcast (broadcast) (loopb))))) (lambda () - (displayln "\nGoodbye, shutting down all services\n") + (displayln-safe "Goodbye, shutting down all services" error-out-s error-out) + (semaphore-wait error-out-s) + (semaphore-wait convs-out-s) + (close-output-port error-out) + (close-output-port convs-out) + (semaphore-post error-out-s) + (semaphore-post convs-out-s) (custodian-shutdown-all main-cust))) -(define (accept-and-handle listener) +(define (receive-clients listener) (define cust (make-custodian)) (parameterize ([current-custodian cust]) (define-values (in out) (tcp-accept listener)) + + ;TODO retrive user name for client here + ; do some error checking + (define username-evt (sync (read-line-evt in 'linefeed))) + + + ; 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-safe successful-connection-m) (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) + (displayln-safe print-no-users convs-out-s convs-out) (flush-output out) (semaphore-wait connections-s) - ((c-connections 'add) in out) + ; TODO add in a username so we have (username input output) + ((c-connections 'add) username-evt in out) (semaphore-post connections-s) ; start a thread to deal with specific client and add descriptor value to the list of threads (define threadcom (thread (lambda () - (handle in out)))) ; comms between server and particular client + (chat_with_client 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) + "connecting threads")) (sleep 1360) (custodian-shutdown-all cust))))) -(define (handle in out) +; whisper selector for the username and message +(define (whisper-info exp) + (cadr exp)) + +(define (whisper-to exp) + (caddr exp)) + +(define (whisper-message exp) + (cadddr exp)) + +(define (chat_with_client in out) ; 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))) + (define evt-t0 (sync (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) + ; TODO some form of identification for this client + (displayln-safe "Connection closed. EOF received" error-out-s error-out) (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")) - ((c-messages 'add) evt-t0) - (semaphore-post messages-s)] + ; use regexes to evaluate received input from client + (define whisper (regexp-match #px"(.*)/whisper\\s+(\\w+)\\s+(.*)" evt-t0)) ; is client trying to whisper to someone + (define list-count (regexp-match #px"(.*)/list\\s+count\\s*" evt-t0)) ;; is client asking for number of logged in users + (define list-users (regexp-match #px"(.*)/list\\s+users\\s*" evt-t0)) ;; user names + ; do something whether it was a message, a whisper, request for number of users and so on + (cond [whisper + (semaphore-wait connections-s) + ; get output port for user + (define that-user-ports + (first (filter + (lambda (ports) + (if (string=? (whisper-to whisper) (get-username ports)) + #t + #f)) + ((c-connections 'cons-list))))) + ; try to send that user the whisper + (if (port-closed? (get-output-port that-user-ports)) + (begin + (displayln "User is unavailable" out) + (flush-output out)) + (begin + (displayln (string-append (whisper-info whisper) (whisper-message whisper)) + (get-output-port that-user-ports)) + (flush-output (get-output-port that-user-ports)))) + (semaphore-post connections-s)] + [list-count + ;;should put a semaphore on connections + (semaphore-wait c-count-s) + (semaphore-wait connections-s) + (define no-of-users (string-append "Number of users in chat: " + (number->string ((c-count 'current-count))))) + (displayln no-of-users out) + (flush-output out) + (semaphore-post connections-s) + (semaphore-post c-count-s) + ] + [list-users + (semaphore-wait connections-s) + ; map over connections sending the username to the client + (displayln "Here is a list of users in chat." out) + (map + (lambda (ports) + (displayln (get-username ports) out)) + ((c-connections 'cons-list))) + (flush-output out) + (semaphore-post connections-s)] + [else + ; (displayln-safe evt-t0) debug purposes + (semaphore-wait messages-s) + ; evaluate it . + ((c-messages 'add) evt-t0) + (semaphore-post messages-s)])] [else - (displayln-safe "Timeout waiting. Nothing received from client" stdout)])) + (displayln-safe "Timeout waiting. Nothing received from client")])) ; Executes methods above in another thread (thread (lambda () @@ -173,27 +241,36 @@ ; extracts output port from a list pair of input and output port (define (get-output-port ports) - (cadr ports)) + (caddr ports)) ; extracts input port (define (get-input-port ports) + (cadr ports)) + +; extract username +(define (get-username ports) (car ports)) ; broadcasts received message from clients periodically +; TODO before broadcasting the message make sure the ports is still open +; no EOF if it is remove client from connections (define broadcast (lambda () (semaphore-wait messages-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))) + (if (not (port-closed? (get-output-port ports))) + (begin + (displayln (first ((c-messages 'mes-list))) (get-output-port ports)) + (flush-output (get-output-port ports))) + (displayln-safe "Failed to broadcast. Port not open." error-out-s error-out))) ((c-connections 'cons-list))) + (displayln-safe (first ((c-messages 'mes-list))) convs-out-s convs-out) ;; remove top message ((c-messages 'remove-top)) (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") +(define stop-server (serve 4321)) ;; start server then close with stop +(displayln-safe "Server process started\n" error-out-s error-out) |