removed log messages from server.rkt, added semaphores stdout
This commit is contained in:
parent
69523cc2ed
commit
66d5762bd9
@ -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)
|
||||||
|
@ -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))
|
||||||
|
Loading…
Reference in New Issue
Block a user