iskm/Hermes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

removed log messages from server.rkt, added semaphores stdout

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Hermes/client.rkt
View File

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

75
Hermes/server.rkt
View File

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