aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoriskm <iskm@users.noreply.github.com>2017-04-14 11:02:48 -0400
committerGitHub <noreply@github.com>2017-04-14 11:02:48 -0400
commit4cb1b05ae9f892638d12a9baff728d0bb811c959 (patch)
tree44a207bdc9280976f71a13482b3689386e7dc490
parent385c4f4664ae8157e62f118f15d4c670a4c1356b (diff)
parente09975a02c24c53a6b8c4a704b74236945c3fdcc (diff)
Merge pull request #2 from oplS17projects/mango
Mango
-rw-r--r--.gitignore2
-rw-r--r--Hermes/Makefile (renamed from Makefile)0
-rw-r--r--Hermes/TODO14
-rw-r--r--Hermes/client.rkt94
-rw-r--r--Hermes/server.rkt227
-rw-r--r--tests/gui/concurrentreadandprint.rkt (renamed from Hermes/concurrentreadandprint.rkt)0
-rw-r--r--tests/tcpvanilla/tcpcommunication.rkt (renamed from Hermes/tcpcommunication.rkt)0
7 files changed, 197 insertions, 140 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..49a9d25
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+# ignore temporary files
+*~
diff --git a/Makefile b/Hermes/Makefile
index eda5bbb..eda5bbb 100644
--- a/Makefile
+++ b/Hermes/Makefile
diff --git a/Hermes/TODO b/Hermes/TODO
new file mode 100644
index 0000000..8ad5a92
--- /dev/null
+++ b/Hermes/TODO
@@ -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
diff --git a/Hermes/client.rkt b/Hermes/client.rkt
index 25be149..3b65cfa 100644
--- a/Hermes/client.rkt
+++ b/Hermes/client.rkt
@@ -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
-
-;; 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
+(define host "10.0.0.160") ; internal home
+(define host2 "67.186.191.81")
+(define port-num 4321)
-;; 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)
-
- ;(semaphore-post fair)
- ; (read-loop-i out)
-)
+ (displayln (string-append date-print username ": " input) out)
+ (flush-output 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))
-
diff --git a/Hermes/server.rkt b/Hermes/server.rkt
index d1f5a98..5673eca 100644
--- a/Hermes/server.rkt
+++ b/Hermes/server.rkt
@@ -2,31 +2,84 @@
(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))
@@ -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
- )
-
-;; define a broadcast function
+; extracts output port from a list pair of input and output port
+(define (get-output-port ports)
+ (cadr ports))
+
+; 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 \ No newline at end of file
+; TODO move to its own file
+(define stop (serve 4321)) ;; start server then close with stop
+(display "Server process started\n")
diff --git a/Hermes/concurrentreadandprint.rkt b/tests/gui/concurrentreadandprint.rkt
index 95d02c1..95d02c1 100644
--- a/Hermes/concurrentreadandprint.rkt
+++ b/tests/gui/concurrentreadandprint.rkt
diff --git a/Hermes/tcpcommunication.rkt b/tests/tcpvanilla/tcpcommunication.rkt
index 134e697..134e697 100644
--- a/Hermes/tcpcommunication.rkt
+++ b/tests/tcpvanilla/tcpcommunication.rkt