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

Cleaned up code and added loggers to pinpoint error

Browse Source
This commit is contained in:
Ibrahim Mkusa 2017-04-11 23:40:33 -04:00
parent 44c715c55c
commit 2f0d04ce7f
3 changed files with 49 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
Hermes/client.rkt
View File

@ -23,9 +23,11 @@
; is there something in the input port. If yes? display it
; in the hello world
; custodian for client connections
(define main-client-cust (make-custodian))
; 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
@ -39,17 +41,21 @@
;; make threads 2 lines
(define a (thread
(lambda ()
(displayln "Startting receiver thread\n")
(let loop []
(receive-messages in)
(sleep 1)
(loop)))))
(define t (thread
(lambda ()
(displayln "Starting sender thread\n")
(let loop []
(send-messages username out)
(sleep 1)
(loop)))))
(displayln "Now waiting for sender thread")
(thread-wait t) ;; returns prompt back to drracket
(displayln "Closing client ports")
(close-input-port in)
(close-output-port out))
(custodian-shutdown-all main-client-cust))
@ -69,7 +75,7 @@
;(kill-thread t))))
(cond ((string=? input "quit") (exit)))
;; modify to send messages to out port
(displayln (string-append username ": " input) out)
(displayln (string-append username ": " input "\n") out)
(flush-output out)
;(semaphore-post fair)
@ -89,7 +95,9 @@
(define evt (sync/timeout 30 (read-line-evt in)))
(cond [(eof-object? evt)
(displayln "Server connection closed")
(exit)]
(custodian-shutdown-all main-client-cust)
;(exit)
]
[(string? evt)
(displayln evt)] ; could time stamp here or to send message
[else
@ -99,4 +107,5 @@
)
(define stop (client 4321))
(display "Client started\n")

50
Hermes/server.rkt
View File

@ -11,7 +11,7 @@
;; 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 '("hello, world!")) ;; stores a list of messages(strings) from currents
(define messages '()) ;; stores a list of messages(strings) from currents
(define threads-s (make-semaphore 1)) ;; control access to threads
;; lets keep thread descriptor values
@ -35,13 +35,14 @@
(define (loop)
(accept-and-handle listener)
(loop))
(displayln "threading the listeneter")
(thread loop)
;; Create a thread whose job is to simply call broadcast iteratively
(thread (lambda ()
(display "Broadcast thread started!\n")
(let loopb []
(sleep 30) ;; wait 30 secs before beginning to broadcast
(sleep 10) ;; wait 30 secs before beginning to broadcast
(broadcast)
(sleep 10) ;; sleep for 10 seconds between broadcasts
(loopb)))))
(lambda ()
(displayln "\nGoodbye, shutting down all services\n")
@ -51,25 +52,42 @@
(define cust (make-custodian))
(parameterize ([current-custodian cust])
(define-values (in out) (tcp-accept listener))
(displayln "Sucessfully connected to a client")
(display in)
(displayln out)
(displayln "Sending client Welcome message")
(displayln "Welcome to Hermes coms")
(flush-output out)
; discard request header
; 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)
(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")
connections
; start a thread to deal with specific client and add descriptor value to the list of threads
(set! threads (append threads (list (thread (lambda ()
(semaphore-wait threads-s)
(define threadcom (thread (lambda ()
(handle in out) ;; this handles connection with that specific client
(close-input-port in)
(close-output-port out))))
)
)
(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
;; Watcher thread:
;; kills current thread for waiting too long for connection from
;; clients
(thread (lambda ()
(display "Started a thread to kill hanging connecting thread\n")
(sleep 360)
(custodian-shutdown-all cust)))))
@ -79,9 +97,9 @@
(define (handle in out)
; define function to deal with incoming messages from client
(define (something-to-say in)
(define evt-t0 (sync/timeout 30 (read-line-evt in 'linefeed)))
(define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed)))
(cond [(eof-object? evt-t0)
(displayln (string-append "Connection closed " (current-thread) "exiting"))
(displayln "Connection closed. EOF received")
(exit)
]
[(string? evt-t0)
@ -91,11 +109,11 @@
(set! messages (append messages (list evt-t0)))
(semaphore-post messages-s)]
[else
(displayln (string-append "Nothing received from " (current-thread)))]))
(displayln "Timeout waiting. Nothing received from client")]))
; define function to deal with out
(define (something-to-send 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))
@ -113,7 +131,7 @@
(thread (lambda ()
(let loop []
(something-to-send out)
(something-to-broadcast out)
(sleep 1)
(loop))))
; (server-loop in out)
@ -131,10 +149,14 @@
(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)))
(define stop (serve 4321)) ;; start server then close with stop
(display "Server process started\n")

3
Makefile
View File

@ -1,3 +0,0 @@
# Remove idiotic save files
clean:
rm -rf *~