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

Merge pull request #2 from oplS17projects/mango

Browse Source 
Mango
This commit is contained in:
iskm 2017-04-14 11:02:48 -04:00 committed by GitHub
commit 4cb1b05ae9
7 changed files with 196 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
# ignore temporary files
*~

0
Makefile → Hermes/Makefile
View File

14
Hermes/TODO Normal file
View File

@ -0,0 +1,14 @@
FEATURES
1. Create a racket module for commonly used functions
2. Log error messages and channel conservations to proper files on server
4. message parsable?
5. command parsable?
7. maybe fiddle around with irc library
8. separate main running code from definitions
10. authentication for databases
11. user can ask for no of logged in users. Server has to pars
e
12. Hide user's own input in command line
14. bye message prompt for clients
15. Session stickiness for clients
16. plain tcp -> ssl based

94
Hermes/client.rkt
View File

@ -1,102 +1,84 @@
#lang racket
(require math/base) ;; for random number generation
;; TODO clean up string message output and alignment
;; author: Ibrahim Mkusa
;; about: print and read concurrently
;; notes: output may need to be aligned and formatted nicely
;; look into
;; https://docs.racket-lang.org/gui/text-field_.html#%28meth._%28%28%28lib._mred%2Fmain..rkt%29._text-field~25%29._get-editor%29%29
(define host "10.0.0.160") ; internal home
(define host2 "67.186.191.81")
(define port-num 4321)
;; create custodian for managing all resources
;; so we can shutdown everything at once
;(define guard (make-custodian (current-custodian)))
;(current-custodian guard)
;; reads values continously from stdin and redisplays them
;; Notes connect to server on localhost
;; use client template of tcpvanilla
;; use event for read-write
;; modify read-loop-i
; read a value and send it to server via output-port
; 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
(define-values (in out) (tcp-connect host2 port-no)) ;; define values
(display in)
(displayln out)
;; binds to multiple values akin to unpacking tuples in python
(display "What's your name?\n")
(displayln "What's your name?")
(define username (read-line))
; (thread (lambda ()
;; make threads 2 lines
(define a (thread
(lambda ()
(displayln "Starting receiver thread.")
(let loop []
(receive-messages in)
(sleep 1)
(loop)))))
(define t (thread
(lambda ()
(displayln "Starting sender thread.")
(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))
;; the send-messages
;; sends a message to the server
(define (send-messages username out)
; get current time
(define date-today (seconds->date (current-seconds) #t))
;TODO pad the second if its only 1 character
(define date-print (string-append (number->string (date-hour date-today))
":"
(number->string (date-minute date-today))
":"
(number->string (date-second date-today))
" | "))
;; intelligent read, quits when user types in "quit"
;(semaphore-wait fair)
; (display usernamei)
(define input (read-line))
;; do something over here with input maybe send it out
(cond ((string=? input "quit")
(displayln (string-append date-print username " signing out. See ya!") out)
(flush-output out)
(exit)))
;; 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))))
(cond ((string=? input "quit") (exit)))
;; modify to send messages to out port
(displayln (string-append username ": " input) out)
(flush-output out)
(displayln (string-append date-print username ": " input) out)
(flush-output out))
;(semaphore-post fair)
; (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
; receives input from server and displays it to stdout
(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
(define evt (sync/timeout 30 (read-line-evt in)))
; retrieve a message from server
(define evt (sync/timeout 60 (read-line-evt in)))
(cond [(eof-object? evt)
(displayln "Server connection closed")
(exit)]
(displayln "Server connection closed.")
(custodian-shutdown-all main-client-cust)
;(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)
)
(displayln (string-append "Nothing received from server for 2 minutes."))]))
(displayln "Starting client.")
(define stop (client 4321))

225
Hermes/server.rkt
View File

@ -2,32 +2,85 @@
(require math/base) ;; for random number generation
;; globals
;; must control access via semaphore as listener thread or broadcast thread
;; might need to access it
(define connections '()) ;; maintains a list of open ports
;; ((in1, out1), (in2, out2), (in3, out3), (in4, out4) ...)
(define welcome-message "Welcome to Hermes coms. Type your message below")
; track number of connections with closure
(define (make-count no-count)
(define (increment)
(set! no-count (+ no-count 1))
no-count)
(define (decrement)
(set! no-count (- no-count 1))
no-count)
(define (current-count)
no-count)
(define (dispatch m)
(cond [(eq? m 'increment) increment]
[(eq? m 'decrement) decrement]
[(eq? m 'current-count) current-count]))
dispatch)
(define c-count (make-count 0))
; a semaphore to control access to c-count
(define c-count-s (make-semaphore 1))
; track list of input output port pairs in a list contained in a closure
(define (make-connections connections)
(define (null-cons?)
(null? connections))
(define (add in out)
(set! connections (append connections (list (list in out))))
connections)
(define (cons-list)
connections)
(define (remove-ports in out)
(set! connections
(filter
(lambda (ports)
(if (and (eq? in (get-input-port ports))
(eq? out (get-output-port ports)))
#f
#t))
connections)))
(define (dispatch m)
(cond [(eq? m 'null-cons) null-cons?]
[(eq? m 'cons-list) cons-list]
[(eq? m 'remove-ports) remove-ports]
[(eq? m 'add) add]))
dispatch)
(define c-connections (make-connections '()))
; a semaphore to control acess to c-connections
(define connections-s (make-semaphore 1)) ;; control access to connections
;; every 5 seconds run to broadcast top message in list
;; and remove it from list
; Track received messages in a closure
(define (make-messages messages)
(define (add message)
(set! messages (append messages (list message)))
messages)
(define (mes-list)
messages)
(define (remove-top)
(set! messages (rest messages))
messages)
(define (dispatch m)
(cond [(eq? m 'add) add]
[(eq? m 'mes-list) mes-list]
[(eq? m 'remove-top) remove-top]))
dispatch)
(define c-messages (make-messages '()))
; semaphore to control access to c-messages
(define messages-s (make-semaphore 1)) ;; control access to messages
(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
;; Several threads may want to print to stdout, so lets make things civil
(define stdout (make-semaphore 1))
; 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)))
;;
;; 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 main-cust (make-custodian))
(parameterize ([current-custodian main-cust])
@ -35,13 +88,14 @@
(define (loop)
(accept-and-handle listener)
(loop))
(displayln "threading the listener")
(thread loop)
;; Create a thread whose job is to simply call broadcast iteratively
(thread (lambda ()
(displayln-safe "Broadcast thread started!\n" stdout)
(let loopb []
(sleep 30) ;; wait 30 secs before beginning to broadcast
(sleep 0.5) ;; wait 0.5 secs before beginning to broadcast
(broadcast)
(sleep 10) ;; sleep for 10 seconds between broadcasts
(loopb)))))
(lambda ()
(displayln "\nGoodbye, shutting down all services\n")
@ -51,90 +105,95 @@
(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)
; increment number of connections
(semaphore-wait c-count-s)
((c-count 'increment))
(semaphore-post c-count-s)
(displayln-safe (string-append
"Successfully connected to a client. "
"Sending client a welcome message.")
stdout)
(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)
(flush-output out)
(semaphore-wait connections-s)
;; keep track of open ports
(set! connections (append connections (list (list in out))))
((c-connections 'add) in out)
(semaphore-post connections-s)
; start a thread to deal with specific client and add descriptor value to the list of threads
(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 360)
(custodian-shutdown-all cust)))))
(define threadcom (thread (lambda ()
(handle in out)))) ; comms between server and particular client
;; Watcher thread:
;; kills current thread for waiting too long for connection from
(thread (lambda ()
(displayln-safe (string-append
"Started a thread to kill hanging "
"connecting threads") stdout)
(sleep 1360)
(custodian-shutdown-all cust)))))
; (define (handle connections)
; ())
;; each thread needs 2 new threads
(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 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"))
(exit)
]
; 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)
(semaphore-wait c-count-s)
((c-count 'decrement))
(semaphore-post c-count-s)
;(exit)
(kill-thread (current-thread))]
[(string? evt-t0)
(semaphore-wait messages-s)
; append the message to list of messages
(display (string-append evt-t0 "\n"))
(set! messages (append messages (list evt-t0)))
((c-messages 'add) evt-t0)
(semaphore-post messages-s)]
[else
(displayln (string-append "Nothing received from " (current-thread)))]))
(displayln-safe "Timeout waiting. Nothing received from client" stdout)]))
; define function to deal with out
(define (something-to-send 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
; Executes methods above in another thread
(thread (lambda ()
(let loop []
(something-to-say in)
(sleep 1)
(loop))))
; (sleep 1)
(loop)))))
(thread (lambda ()
(let loop []
(something-to-send out)
(sleep 1)
(loop))))
; (server-loop in out)
; (sleep 5) ;; wait 5 seconds to guarantee client has already send message
'ok
)
; extracts output port from a list pair of input and output port
(define (get-output-port ports)
(cadr ports))
;; define a broadcast function
; extracts input port
(define (get-input-port ports)
(car ports))
; broadcasts received message from clients periodically
(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)
(cond [(not (null? ((c-messages 'mes-list))))
(begin (map
(lambda (ports)
(displayln (first ((c-messages 'mes-list))) (get-output-port ports))
(flush-output (get-output-port ports)))
((c-connections 'cons-list)))
;; remove top message
((c-messages 'remove-top))
(displayln "Message broadcasted"))])
(semaphore-post messages-s)))
(define stop (serve 4321)) ;; start server then close with stop
; TODO move to its own file
(define stop (serve 4321)) ;; start server then close with stop
(display "Server process started\n")

0
Hermes/concurrentreadandprint.rkt → tests/gui/concurrentreadandprint.rkt
View File

0
Hermes/tcpcommunication.rkt → tests/tcpvanilla/tcpcommunication.rkt
View File