tidied up server.rkt

This commit is contained in:
Ibrahim Mkusa 2017-04-12 13:26:01 -04:00
parent 3a5ce0d2aa
commit 2899891a63

View File

@ -19,8 +19,7 @@
;; 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 ;; Several threads may want to print to stdout, so lets make things civil
;; lets keep things civil
(define stdout (make-semaphore 1)) (define stdout (make-semaphore 1))
; Takes a string and a semaphore to print safely to stdout ; Takes a string and a semaphore to print safely to stdout
@ -30,12 +29,6 @@
(displayln a-string) (displayln a-string)
(semaphore-post a-semaphore))) (semaphore-post a-semaphore)))
;; This is a relay server making two clients communicate
;; Both `server' and `accept-and-handle' change
;; to use a custodian.
;; To start server
;; (define stop (serve 8080))
;; (stop) to close the server
(define (serve port-no) (define (serve port-no)
(define main-cust (make-custodian)) (define main-cust (make-custodian))
@ -68,34 +61,19 @@
stdout) stdout)
(displayln "Welcome to Hermes coms\nType your message below" out) (displayln "Welcome to Hermes coms\nType your message below" out)
(flush-output 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) (semaphore-wait connections-s)
; (displayln "Got the semaphore")
;; 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")
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)))) ; comms between server and particular client
;(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))) (set! threads (append threads (list threadcom)))
(semaphore-post threads-s) (semaphore-post threads-s)
; (displayln "Successfully created a thread")
; (displayln threadcom)
; 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
(thread (lambda () (thread (lambda ()
(displayln-safe (string-append (displayln-safe (string-append
"Started a thread to kill hanging " "Started a thread to kill hanging "
@ -103,11 +81,8 @@
(sleep 1360) (sleep 1360)
(custodian-shutdown-all cust))))) (custodian-shutdown-all cust)))))
; (define (handle connections)
; ())
;; each thread needs 2 new threads
(define (handle in out) (define (handle in out)
; define function to deal with incoming messages from client ; deals with queueing incoming messages for server to broadcast to all clients
(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)
@ -124,84 +99,36 @@
[else [else
(displayln-safe "Timeout waiting. Nothing received from client" stdout)])) (displayln-safe "Timeout waiting. Nothing received from client" stdout)]))
; -----NO LONGER NECESSARY not using thread mailboxes ---- ; Executes methods above in another thread
; define function to deal with out
;(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)
; )
; thread them each
;; i could bind to values, and call wait on them
;; thread that deals with incoming messages for that particular thread
(thread (lambda () (thread (lambda ()
(let loop [] (let loop []
(something-to-say in) (something-to-say in)
; (sleep 1) ; (sleep 1)
(loop)))) (loop)))))
; (thread (lambda () ; extracts output port from a list pair of input and output port
; (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
)
;; a bunch of selectors, predicates for connections
(define (get-output-port ports) (define (get-output-port ports)
(cadr ports) (cadr ports))
)
; extracts input port
(define (get-input-port ports) (define (get-input-port ports)
(car ports) (car ports))
)
;; define a broadcast function ; broadcasts received message from clients periodically
(define broadcast (define broadcast
(lambda () (lambda ()
(semaphore-wait messages-s) (semaphore-wait messages-s)
(cond [(not (null? messages)) (cond [(not (null? messages))
(begin (map (begin (map
(lambda (ports) (lambda (ports)
(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
;(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 (displayln "Message broadcasted"))])
;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))
; (begin (map (lambda (thread-descriptor)
; (thread-send thread-descriptor (first messages)))
; threads)
; (set! messages (rest messages))
; (displayln "Broadcasted a message\n")
;)
;(display "No message to display\n") ; for later create file port for errors and save error messages to that file
;)
; messages ; whats the current state of messages
;(semaphore-post threads-s)
(semaphore-post messages-s))) (semaphore-post messages-s)))
; TODO move to its own file
(define stop (serve 4321)) ;; start server then close with stop (define stop (serve 4321)) ;; start server then close with stop
(display "Server process started\n") (display "Server process started\n")