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

server now logs all received conversations and events to files

Browse Source
This commit is contained in:
Ibrahim Mkusa 2017-04-14 17:10:20 -04:00
parent e09975a02c
commit 83911cc5f7
3 changed files with 49 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Hermes/TODO
View File

@ -12,3 +12,5 @@ e
14. bye message prompt for clients
15. Session stickiness for clients
16. plain tcp -> ssl based
17. fix breaks for improper disconnects from clients
18. Add topics after project completion

3
Hermes/client.rkt
View File

@ -6,6 +6,7 @@
;; notes: output may need to be aligned and formatted nicely
(define host "10.0.0.160") ; internal home
(define host2 "67.186.191.81")
(define host3 "localhost")
(define port-num 4321)
@ -15,7 +16,7 @@
(define (client port-no)
(parameterize ([current-custodian main-client-cust])
;; connect to server at port 8080
(define-values (in out) (tcp-connect host2 port-no)) ;; define values
(define-values (in out) (tcp-connect host3 port-no)) ;; define values
(display in)
(displayln out)
;; binds to multiple values akin to unpacking tuples in python

67
Hermes/server.rkt
View File

@ -3,6 +3,8 @@
;; globals
(define welcome-message "Welcome to Hermes coms. Type your message below")
(define successful-connection-m "Successfully connected to a client. Sending client a welcome message.")
; track number of connections with closure
(define (make-count no-count)
(define (increment)
@ -71,16 +73,32 @@
(define messages-s (make-semaphore 1)) ;; control access to messages
;; Several threads may want to print to stdout, so lets make things civil
; constant always available
(define stdout (make-semaphore 1))
; TODO refactor to take a port. defaults to current-output port in this context
; Takes a string and a semaphore to print safely to stdout
(define displayln-safe
(lambda (a-string a-semaphore)
(semaphore-wait a-semaphore)
(displayln a-string)
(semaphore-post a-semaphore)))
(lambda (a-string [a-semaphore stdout] [a-output-port (current-output-port)])
(cond [(not (and (eq? a-semaphore stdout) (eq? a-output-port (current-output-port))))
(semaphore-wait a-semaphore)
(semaphore-wait stdout)
(displayln a-string a-output-port)
(flush-output a-output-port)
(displayln a-string)
(semaphore-post stdout)
(semaphore-post a-semaphore)]
[else
(semaphore-wait stdout)
(displayln a-string)
(semaphore-post stdout)])))
; two files to store error messages, and channel conversations
(define error-out (open-output-file "/home/pcuser/Hermes/Hermes/error.txt" #:exists 'append))
(define convs-out (open-output-file "/home/pcuser/Hermes/Hermes/conversations.txt" #:exists 'append))
(define error-out-s (make-semaphore 1))
(define convs-out-s (make-semaphore 1))
; TODO finish logging all error related messages to
(define (serve port-no)
(define main-cust (make-custodian))
(parameterize ([current-custodian main-cust])
@ -88,17 +106,24 @@
(define (loop)
(accept-and-handle listener)
(loop))
(displayln "threading the listener")
(displayln-safe "Starting up the listener." error-out-s error-out)
(thread loop)
(displayln-safe "Listener successfully started." error-out-s error-out)
;; Create a thread whose job is to simply call broadcast iteratively
(thread (lambda ()
(displayln-safe "Broadcast thread started!\n" stdout)
(displayln-safe "Broadcast thread started!\n")
(let loopb []
(sleep 0.5) ;; wait 0.5 secs before beginning to broadcast
(broadcast)
(loopb)))))
(lambda ()
(displayln "\nGoodbye, shutting down all services\n")
(displayln-safe "Goodbye, shutting down all services" error-out-s error-out)
(semaphore-wait error-out-s)
(semaphore-wait convs-out-s)
(close-output-port error-out)
(close-output-port convs-out)
(semaphore-post error-out-s)
(semaphore-post convs-out-s)
(custodian-shutdown-all main-cust)))
(define (accept-and-handle listener)
@ -110,16 +135,13 @@
((c-count 'increment))
(semaphore-post c-count-s)
(displayln-safe (string-append
"Successfully connected to a client. "
"Sending client a welcome message.")
stdout)
(displayln-safe successful-connection-m)
(displayln welcome-message out)
;; print to server log and client
(define print-no-users (string-append "Number of users in chat: "
(number->string ((c-count 'current-count)))))
(displayln print-no-users out)
(displayln-safe print-no-users stdout)
(displayln-safe print-no-users convs-out-s convs-out)
(flush-output out)
(semaphore-wait connections-s)
((c-connections 'add) in out)
@ -134,7 +156,7 @@
(thread (lambda ()
(displayln-safe (string-append
"Started a thread to kill hanging "
"connecting threads") stdout)
"connecting threads"))
(sleep 1360)
(custodian-shutdown-all cust)))))
@ -143,13 +165,11 @@
(define (something-to-say in)
(define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed)))
(cond [(eof-object? evt-t0)
; TODO remove pair of ports associated with client
(semaphore-wait connections-s)
((c-connections 'remove-ports) in out)
(semaphore-post connections-s)
(displayln-safe "Connection closed. EOF received"
stdout)
; TODO some form of identification for this client
(displayln-safe "Connection closed. EOF received" error-out-s error-out)
(semaphore-wait c-count-s)
((c-count 'decrement))
(semaphore-post c-count-s)
@ -157,12 +177,12 @@
(kill-thread (current-thread))]
[(string? evt-t0)
(semaphore-wait messages-s)
; append the message to list of messages
(display (string-append evt-t0 "\n"))
; append the message to list of messages NO NEED done during broadcast
; (displayln-safe evt-t0 convs-out-s convs-out)
((c-messages 'add) evt-t0)
(semaphore-post messages-s)]
[else
(displayln-safe "Timeout waiting. Nothing received from client" stdout)]))
(displayln-safe "Timeout waiting. Nothing received from client")]))
; Executes methods above in another thread
(thread (lambda ()
@ -180,6 +200,8 @@
(car ports))
; broadcasts received message from clients periodically
; TODO before broadcasting the message make sure the ports is still open
; no EOF if it is remove client from connections
(define broadcast
(lambda ()
(semaphore-wait messages-s)
@ -189,6 +211,7 @@
(displayln (first ((c-messages 'mes-list))) (get-output-port ports))
(flush-output (get-output-port ports)))
((c-connections 'cons-list)))
(displayln-safe (first ((c-messages 'mes-list))) convs-out-s convs-out)
;; remove top message
((c-messages 'remove-top))
(displayln "Message broadcasted"))])
@ -196,4 +219,4 @@
; TODO move to its own file
(define stop (serve 4321)) ;; start server then close with stop
(display "Server process started\n")
(displayln-safe "Server process started\n" error-out-s error-out)