removed log messages from server.rkt, added semaphores stdout

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