Merge pull request #3 from oplS17projects/mango

Mango

.gitignore

@@ -1,2 +1,10 @@
 # ignore temporary files
 *~ 
+
+# ignore logs and configuration files
+*.out
+*.conf
+
+# ignore racket compile files
+*.dep
+*.zo

Hermes/Makefile

@@ -1,3 +1,3 @@
-# Remove idiotic save files
+# Remove temporary files
 clean:
-	rm -rf *~
+	rm -rf *~ *.out *.conf

Hermes/TODO

@@ -1,14 +1,17 @@
 FEATURES
-1. Create a racket module for commonly used functions
+5. parser in the client side should do something similar (/color, /quit)
-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 
+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

Hermes/client.rkt

@@ -1,44 +1,65 @@
 #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")
-(define port-num 4321)
 
 
+; 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))
 ; 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 host2 port-no)) ;; define values
+    (define-values (in out) (tcp-connect host3 port-no)) ;; define values
-    (display in)
-    (displayln out)
     ;; 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.")
+(displayln-safe "Starting client." error-out-s error-out)
-(define stop (client 4321))
+(define stop-client (client 4321))

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)])))
+

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)
+   (define (add username in out)
-    (set! connections (append connections (list (list 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
+; two files to store error messages, and channel conversations
-(define stdout (make-semaphore 1))
+(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))
-; Takes a string and a semaphore to print safely to stdout
+(define error-out-s (make-semaphore 1))
-(define displayln-safe
+(define convs-out-s (make-semaphore 1))
-  (lambda (a-string a-semaphore)
+; TODO finish logging all error related messages to 
-    (semaphore-wait a-semaphore)
-    (displayln a-string)
-    (semaphore-post a-semaphore)))
-
-
 (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
+    (displayln-safe successful-connection-m)
-                      "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)
+    (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)
-
+           ; TODO some form of identification for this client
-           (displayln-safe "Connection closed. EOF received"
+           (displayln-safe "Connection closed. EOF received" error-out-s error-out)
-                           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)
+           ; use regexes to evaluate received input from client
-           ; append the message to list of messages
+           (define whisper (regexp-match #px"(.*)/whisper\\s+(\\w+)\\s+(.*)" evt-t0)) ; is client trying to whisper to someone
-           (display (string-append evt-t0 "\n"))
+           (define list-count  (regexp-match #px"(.*)/list\\s+count\\s*" evt-t0)) ;; is client asking for number of logged in users
-           ((c-messages 'add) evt-t0)
+           (define list-users (regexp-match #px"(.*)/list\\s+users\\s*" evt-t0)) ;; user names
-           (semaphore-post messages-s)]
+           ; 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 "Timeout waiting. Nothing received from client" stdout)]))
+                  ; (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")]))
 
   ; 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)
+                  (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-server (serve 4321)) ;; start server then close with stop
-(define stop (serve 4321)) ;; start server then close with stop
+(displayln-safe "Server process started\n" error-out-s error-out)
-(display "Server process started\n")