removed log messages from server.rkt, added semaphores stdout

This commit is contained in:
Ibrahim Mkusa 2017-04-12 00:23:37 -04:00
parent 69523cc2ed
commit 66d5762bd9
2 changed files with 48 additions and 29 deletions

View File

@ -41,7 +41,7 @@
;; make threads 2 lines ;; make threads 2 lines
(define a (thread (define a (thread
(lambda () (lambda ()
(displayln "Startting receiver thread\n") (displayln "Starting receiver thread\n")
(let loop [] (let loop []
(receive-messages in) (receive-messages in)
(sleep 1) (sleep 1)

View File

@ -1,6 +1,8 @@
#lang racket #lang racket
(require math/base) ;; for random number generation (require math/base) ;; for random number generation
;; TODO wrap "safer send in a function that takes care of semaphores"
;; globals ;; globals
;; must control access via semaphore as listener thread or broadcast thread ;; must control access via semaphore as listener thread or broadcast thread
;; might need to access it ;; might need to access it
@ -17,7 +19,9 @@
;; lets keep thread descriptor values ;; lets keep thread descriptor values
(define threads '()) ;; stores a list of client serving threads as 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) (define (loop)
(accept-and-handle listener) (accept-and-handle listener)
(loop)) (loop))
(displayln "threading the listeneter") (displayln "threading the listener")
(thread loop) (thread loop)
;; Create a thread whose job is to simply call broadcast iteratively ;; Create a thread whose job is to simply call broadcast iteratively
(thread (lambda () (thread (lambda ()
(semaphore-wait stdout)
(display "Broadcast thread started!\n") (display "Broadcast thread started!\n")
(semaphore-post stdout)
(let loopb [] (let loopb []
(sleep 10) ;; wait 30 secs before beginning to broadcast (sleep 10) ;; wait 30 secs before beginning to broadcast
(broadcast) (broadcast)
@ -52,42 +58,46 @@
(define cust (make-custodian)) (define cust (make-custodian))
(parameterize ([current-custodian cust]) (parameterize ([current-custodian cust])
(define-values (in out) (tcp-accept listener)) (define-values (in out) (tcp-accept listener))
(semaphore-wait stdout)
(displayln "Sucessfully connected to a client") (displayln "Sucessfully connected to a client")
(display in) ;(display in)
(displayln out) ;(displayln out)
(displayln "Sending client Welcome message") (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) (flush-output out)
; discard request header ; discard request header
; Discard the request header (up to blank line): ; 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) (semaphore-wait connections-s)
(displayln "Got the semaphore") ; (displayln "Got the semaphore")
;; keep track of open ports ;; keep track of open ports
(set! connections (append connections (list (list in out)))) (set! connections (append connections (list (list in out))))
(semaphore-post connections-s) (semaphore-post connections-s)
(displayln "Successfully added a pair of ports") ; (displayln "Successfully added a pair of ports")
connections connections
; start a thread to deal with specific client and add descriptor value to the list of threads ; start a thread to deal with specific client and add descriptor value to the list of threads
(semaphore-wait threads-s) (semaphore-wait threads-s)
(define threadcom (thread (lambda () (define threadcom (thread (lambda ()
(handle in out) ;; this handles connection with that specific client (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 ; this might have been the issue
;(close-input-port in) ;(close-input-port in)
; (close-output-port out) ; (close-output-port out)
))) )))
(set! threads (append threads (list threadcom))) (set! threads (append threads (list threadcom)))
(semaphore-post threads-s) (semaphore-post threads-s)
(displayln "Successfully created a thread") ; (displayln "Successfully created a thread")
(displayln threadcom) ; (displayln threadcom)
threads ; threads
;; Watcher thread: ;; Watcher thread:
;; kills current thread for waiting too long for connection from ;; kills current thread for waiting too long for connection from
;; clients ;; clients
(thread (lambda () (thread (lambda ()
(semaphore-wait stdout)
(display "Started a thread to kill hanging connecting thread\n") (display "Started a thread to kill hanging connecting thread\n")
(semaphore-post stdout)
(sleep 360) (sleep 360)
(custodian-shutdown-all cust))))) (custodian-shutdown-all cust)))))
@ -99,7 +109,9 @@
(define (something-to-say in) (define (something-to-say in)
(define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed))) (define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed)))
(cond [(eof-object? evt-t0) (cond [(eof-object? evt-t0)
(semaphore-wait stdout)
(displayln "Connection closed. EOF received") (displayln "Connection closed. EOF received")
(semaphore-post stdout)
(exit) (exit)
] ]
[(string? evt-t0) [(string? evt-t0)
@ -109,16 +121,18 @@
(set! messages (append messages (list evt-t0))) (set! messages (append messages (list evt-t0)))
(semaphore-post messages-s)] (semaphore-post messages-s)]
[else [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 function to deal with out
(define (something-to-broadcast out) ;(define (something-to-broadcast out)
(define evt-t1 (sync/timeout 120 (thread-receive-evt))) ; (define evt-t1 (sync/timeout 120 (thread-receive-evt)))
;; send message to client ;; send message to client
(fprintf out "~a~n" (thread-receive)) ; (fprintf out "~a~n" (thread-receive))
(flush-output out) ; (flush-output out)
) ; )
; thread them each ; thread them each
;; i could bind to values, and call wait on them ;; i could bind to values, and call wait on them
@ -126,14 +140,14 @@
(thread (lambda () (thread (lambda ()
(let loop [] (let loop []
(something-to-say in) (something-to-say in)
(sleep 1) ; (sleep 1)
(loop)))) (loop))))
(thread (lambda () ; (thread (lambda ()
(let loop [] ; (let loop []
(something-to-broadcast out) ; (something-to-broadcast out)
(sleep 1) ; (sleep 1)
(loop)))) ; (loop))))
; (server-loop in out) ; (server-loop in out)
; (sleep 5) ;; wait 5 seconds to guarantee client has already send message ; (sleep 5) ;; wait 5 seconds to guarantee client has already send message
'ok 'ok
@ -158,15 +172,20 @@
(displayln (first messages) (get-output-port ports)) (displayln (first messages) (get-output-port ports))
(flush-output (get-output-port ports)) (flush-output (get-output-port ports))
;; log message to server ;; log message to server
(displayln "Message sent") ;(displayln "Message sent")
) )
connections) connections)
;; remove top message ;; remove top message
(set! messages (rest messages)) (set! messages (rest messages))
;; current state of messages and connections ;; current state of messages and connections
messages ;messages
connections) ;connections
(display "No message to display\n")) (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 ; Approach one was to broadcast via thread mailboxes
;(semaphore-wait threads-s) ;(semaphore-wait threads-s)
;(if (not (null? messages)) ;(if (not (null? messages))