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

updates to server.rkt and client.rkt

Browse Source
This commit is contained in:
Ibrahim Mkusa 2017-04-09 20:50:20 -04:00
parent ba3f6821f5
commit f0d361b49c
3 changed files with 109 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
client.rkt
View File

@ -13,67 +13,90 @@
;(current-custodian guard)
;; reads values continously from stdin and redisplays them
;;;;;; NOT IN USE ;;;;;;;
(define (read-loop)
(display (read-line))
(display "\n")
(read-loop)
)
;; Notes connect to server on localhost
;; use client template of tcpvanilla
;; use event for read-write
(define input-prompt "input: ")
(define output-prompt "output: ")
;; modify read-loop-i
; read a value and send it to server via output-port
(define fair (make-semaphore 1))
; is there something in the input port. If yes? display it
; in the hello world
;; prompt for username and bind to a variable username
(display "What's your name?\n")
(define username (read-line))
(define usernamei (string-append username ": ")) ;; make username appear nicer in a prompt
; make connection to server
(define (client port-no)
(define main-client-cust (make-custodian))
(parameterize ([current-custodian main-client-cust])
;; connect to server at port 8080
(define-values (in out) (tcp-connect "localhost" port-no)) ;; define values
(display in)
(displayln out)
;; binds to multiple values akin to unpacking tuples in python
(display "What's your name?\n")
(define username (read-line))
;; intelligent read, quits when user types in "quit"
(define (read-loop-i)
; (thread (lambda ()
;; make threads 2 lines
(define a (thread
(lambda ()
(let loop []
(receive-messages in)
(sleep 1)
(loop)))))
(define t (thread
(lambda ()
(let loop []
(send-messages username out)
(sleep 1)
(loop)))))
(thread-wait t) ;; returns prompt back to drracket
(close-input-port in)
(close-output-port out))
(custodian-shutdown-all main-client-cust))
;; the send-messages
(define (send-messages username out)
;; intelligent read, quits when user types in "quit"
;(semaphore-wait fair)
(display usernamei)
; (display usernamei)
(define input (read-line))
;; do something over here with input maybe send it out
;; Tests input if its a quit then kills all threads
;; An if would be better here tbh
(cond ((string=? input "quit") (begin (kill-thread a)
(kill-thread t))))
(display (string-append output-prompt input "\n"))
;; (cond ((string=? input "quit") (begin (kill-thread a)
;(kill-thread t))))
(cond ((string=? input "quit") (exit)))
;; modify to send messages to out port
(displayln (string-append username ": " input) out)
(flush-output out)
;(semaphore-post fair)
(read-loop-i)
)
; (read-loop-i out)
)
;; print hello world continously
;; "(hello-world)" can be executed as part of background thread
;; that prints in the event there is something in the input port
(define (hello-world)
(sleep (random-integer 0 15)) ;; sleep between 0 and 15 seconds to simulate coms
(define (receive-messages in)
; (sleep (random-integer 0 15)) ;; sleep between 0 and 15 seconds to simulate coms
;; with server
;(semaphore-wait fair)
;; we will retrieve the line printed below from the server
;; at this time we simulate the input from different users
(define what-to-print (random-integer 0 2))
(if (= what-to-print 0)
(display "Doug: What's up, up?\n")
(display "Fred: Looking good, good!\n"))
(define evt (sync/timeout 30 (read-line-evt in)))
(cond [(eof-object? evt)
(displayln "Server connection closed")
(exit)]
[(string? evt)
(displayln evt)] ; could time stamp here or to send message
[else
(displayln (string-append "Nothing received from server for 2 minutes."))]
)
;(semaphore-post fair)
(hello-world))
)
(define t (thread (lambda ()
(read-loop-i))))
(define a (thread (lambda ()
(hello-world))))
(define stop (client 4321))
(thread-wait t) ;; returns prompt back to drracket
;; below doesn't execute
; (sleep 10)
; (kill-thread t)
; (define a (thread (display "hello world!\n")))
; (display "John: hello soso\n")
; (display "Emmanuel: cumbaya!!!!\n")

69
server.rkt
View File

@ -11,26 +11,13 @@
;; every 5 seconds run to broadcast top message in list
;; and remove it from list
(define messages-s (make-semaphore 1)) ;; control access to messages
(define messages '()) ;; stores a list of messages(strings) from currents
(define messages '("hello, world!")) ;; stores a list of messages(strings) from currents
(define threads-s (make-semaphore 1)) ;; control access to threads
;; lets keep thread descriptor values
(define threads '()) ;; stores a list of client serving threads as thread descriptor values
;; define a broadcast function
(define broadcast
(lambda ()
(semaphore-wait messages-s)
(semaphore-wait threads-s)
(if (not (null? messages))
(begin (map (lambda (thread-descriptor)
(thread-send thread-descriptor (first messages))))
(set! messages (rest messages))
)
(display "No message to display\n") ; for later create file port for errors and save error messages to that file
)
(semaphore-post threads-s)
(semaphore-post messages-s)))
;;
@ -52,7 +39,8 @@
;; Create a thread whose job is to simply call broadcast iteratively
(thread (lambda ()
(let loopb []
broadcast
(sleep 30) ;; wait 30 secs before beginning to broadcast
(broadcast)
(sleep 10) ;; sleep for 10 seconds between broadcasts
(loopb)))))
(lambda ()
@ -63,22 +51,26 @@
(define cust (make-custodian))
(parameterize ([current-custodian cust])
(define-values (in out) (tcp-accept listener))
; discard request header
; Discard the request header (up to blank line):
(regexp-match #rx"(\r\n|^)\r\n" in)
(semaphore-wait connections-s)
;; keep track of open ports
(append connections (list (list in out)))
(semaphore-wait connections-s)
(set! connections (append connections (list (list in out))))
(semaphore-post connections-s)
; start a thread to deal with specific client and add descriptor value to the list of threads
(append threads (list (thread (lambda ()
(set! threads (append threads (list (thread (lambda ()
(handle in out) ;; this handles connection with that specific client
(close-input-port in)
(close-output-port out))))
)
)
;; Watcher thread:
;; kills current thread for waiting too long for connection from
;; clients
(thread (lambda ()
(sleep 120)
(sleep 360)
(custodian-shutdown-all cust)))))
; (define (handle connections)
@ -87,14 +79,19 @@
(define (handle in out)
; define function to deal with incoming messages from client
(define (something-to-say in)
(define evt-t0 (sync/timeout 120 (read-line-evt in 'linefeed)))
(cond [(not evt-t0)
(displayln "Nothing received from " (current-thread) "exiting")]
(define evt-t0 (sync/timeout 30 (read-line-evt in 'linefeed)))
(cond [(eof-object? evt-t0)
(displayln (string-append "Connection closed " (current-thread) "exiting"))
(exit)
]
[(string? evt-t0)
(semaphore-wait messages-s)
; append the message to list of messages
(append messages (list evt-t0))
(semaphore-post messages-s)]))
(display (string-append evt-t0 "\n"))
(set! messages (append messages (list evt-t0)))
(semaphore-post messages-s)]
[else
(displayln (string-append "Nothing received from " (current-thread)))]))
; define function to deal with out
@ -111,13 +108,33 @@
(thread (lambda ()
(let loop []
(something-to-say in)
(sleep 1)
(loop))))
(thread (lambda ()
(let loop []
(something-to-say out)
(something-to-send out)
(sleep 1)
(loop))))
; (server-loop in out)
; (sleep 5) ;; wait 5 seconds to guarantee client has already send message
'ok
)
;; define a broadcast function
(define broadcast
(lambda ()
(semaphore-wait messages-s)
(semaphore-wait threads-s)
(if (not (null? messages))
(begin (map (lambda (thread-descriptor)
(thread-send thread-descriptor (first messages)))
threads)
(set! messages (rest messages))
)
(display "No message to display\n") ; for later create file port for errors and save error messages to that file
)
(semaphore-post threads-s)
(semaphore-post messages-s)))
(define stop (serve 4321)) ;; start server then close with stop