commit
4cb1b05ae9
2
.gitignore
vendored
Normal file
2
.gitignore
vendored
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
# ignore temporary files
|
||||||
|
*~
|
14
Hermes/TODO
Normal file
14
Hermes/TODO
Normal 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
|
@ -1,102 +1,84 @@
|
|||||||
#lang racket
|
#lang racket
|
||||||
(require math/base) ;; for random number generation
|
(require math/base) ;; for random number generation
|
||||||
|
;; TODO clean up string message output and alignment
|
||||||
;; author: Ibrahim Mkusa
|
;; author: Ibrahim Mkusa
|
||||||
;; about: print and read concurrently
|
;; about: print and read concurrently
|
||||||
;; notes: output may need to be aligned and formatted nicely
|
;; notes: output may need to be aligned and formatted nicely
|
||||||
;; look into
|
(define host "10.0.0.160") ; internal home
|
||||||
;; 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 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
|
; make connection to server
|
||||||
(define (client port-no)
|
(define (client port-no)
|
||||||
(define main-client-cust (make-custodian))
|
|
||||||
(parameterize ([current-custodian main-client-cust])
|
(parameterize ([current-custodian main-client-cust])
|
||||||
;; connect to server at port 8080
|
;; 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)
|
(display in)
|
||||||
(displayln out)
|
(displayln out)
|
||||||
;; binds to multiple values akin to unpacking tuples in python
|
;; 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))
|
(define username (read-line))
|
||||||
|
|
||||||
; (thread (lambda ()
|
|
||||||
;; make threads 2 lines
|
|
||||||
(define a (thread
|
(define a (thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
(displayln "Starting receiver thread.")
|
||||||
(let loop []
|
(let loop []
|
||||||
(receive-messages in)
|
(receive-messages in)
|
||||||
(sleep 1)
|
(sleep 1)
|
||||||
(loop)))))
|
(loop)))))
|
||||||
(define t (thread
|
(define t (thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
(displayln "Starting sender thread.")
|
||||||
(let loop []
|
(let loop []
|
||||||
(send-messages username out)
|
(send-messages username out)
|
||||||
(sleep 1)
|
(sleep 1)
|
||||||
(loop)))))
|
(loop)))))
|
||||||
|
(displayln "Now waiting for sender thread.")
|
||||||
(thread-wait t) ;; returns prompt back to drracket
|
(thread-wait t) ;; returns prompt back to drracket
|
||||||
|
(displayln "Closing client ports.")
|
||||||
(close-input-port in)
|
(close-input-port in)
|
||||||
(close-output-port out))
|
(close-output-port out))
|
||||||
(custodian-shutdown-all main-client-cust))
|
(custodian-shutdown-all main-client-cust))
|
||||||
|
|
||||||
|
|
||||||
;; the send-messages
|
;; sends a message to the server
|
||||||
(define (send-messages username out)
|
(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"
|
;; intelligent read, quits when user types in "quit"
|
||||||
;(semaphore-wait fair)
|
|
||||||
; (display usernamei)
|
|
||||||
(define input (read-line))
|
(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
|
(displayln (string-append date-print username ": " input) out)
|
||||||
;; An if would be better here tbh
|
(flush-output out))
|
||||||
;; (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)
|
; receives input from server and displays it to stdout
|
||||||
; (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 (receive-messages in)
|
(define (receive-messages in)
|
||||||
; (sleep (random-integer 0 15)) ;; sleep between 0 and 15 seconds to simulate coms
|
; retrieve a message from server
|
||||||
;; with server
|
(define evt (sync/timeout 60 (read-line-evt in)))
|
||||||
;(semaphore-wait fair)
|
|
||||||
;; we will retrieve the line printed below from the server
|
|
||||||
(define evt (sync/timeout 30 (read-line-evt in)))
|
|
||||||
(cond [(eof-object? evt)
|
(cond [(eof-object? evt)
|
||||||
(displayln "Server connection closed")
|
(displayln "Server connection closed.")
|
||||||
(exit)]
|
(custodian-shutdown-all main-client-cust)
|
||||||
|
;(exit)
|
||||||
|
]
|
||||||
[(string? evt)
|
[(string? evt)
|
||||||
(displayln evt)] ; could time stamp here or to send message
|
(displayln evt)] ; could time stamp here or to send message
|
||||||
[else
|
[else
|
||||||
(displayln (string-append "Nothing received from server for 2 minutes."))]
|
(displayln (string-append "Nothing received from server for 2 minutes."))]))
|
||||||
)
|
|
||||||
;(semaphore-post fair)
|
|
||||||
)
|
|
||||||
|
|
||||||
|
(displayln "Starting client.")
|
||||||
(define stop (client 4321))
|
(define stop (client 4321))
|
||||||
|
|
||||||
|
@ -2,32 +2,85 @@
|
|||||||
(require math/base) ;; for random number generation
|
(require math/base) ;; for random number generation
|
||||||
|
|
||||||
;; globals
|
;; globals
|
||||||
;; must control access via semaphore as listener thread or broadcast thread
|
(define welcome-message "Welcome to Hermes coms. Type your message below")
|
||||||
;; might need to access it
|
; track number of connections with closure
|
||||||
(define connections '()) ;; maintains a list of open ports
|
(define (make-count no-count)
|
||||||
;; ((in1, out1), (in2, out2), (in3, out3), (in4, out4) ...)
|
(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
|
(define connections-s (make-semaphore 1)) ;; control access to connections
|
||||||
|
|
||||||
;; every 5 seconds run to broadcast top message in list
|
; Track received messages in a closure
|
||||||
;; and remove it from list
|
(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-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
|
;; Several threads may want to print to stdout, so lets make things civil
|
||||||
;; lets keep thread descriptor values
|
(define stdout (make-semaphore 1))
|
||||||
(define threads '()) ;; stores a list of client serving threads as thread descriptor values
|
|
||||||
|
|
||||||
|
; 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 (serve port-no)
|
||||||
(define main-cust (make-custodian))
|
(define main-cust (make-custodian))
|
||||||
(parameterize ([current-custodian main-cust])
|
(parameterize ([current-custodian main-cust])
|
||||||
@ -35,13 +88,14 @@
|
|||||||
(define (loop)
|
(define (loop)
|
||||||
(accept-and-handle listener)
|
(accept-and-handle listener)
|
||||||
(loop))
|
(loop))
|
||||||
|
(displayln "threading the listener")
|
||||||
(thread loop)
|
(thread loop)
|
||||||
;; Create a thread whose job is to simply call broadcast iteratively
|
;; Create a thread whose job is to simply call broadcast iteratively
|
||||||
(thread (lambda ()
|
(thread (lambda ()
|
||||||
|
(displayln-safe "Broadcast thread started!\n" stdout)
|
||||||
(let loopb []
|
(let loopb []
|
||||||
(sleep 30) ;; wait 30 secs before beginning to broadcast
|
(sleep 0.5) ;; wait 0.5 secs before beginning to broadcast
|
||||||
(broadcast)
|
(broadcast)
|
||||||
(sleep 10) ;; sleep for 10 seconds between broadcasts
|
|
||||||
(loopb)))))
|
(loopb)))))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(displayln "\nGoodbye, shutting down all services\n")
|
(displayln "\nGoodbye, shutting down all services\n")
|
||||||
@ -51,90 +105,95 @@
|
|||||||
(define cust (make-custodian))
|
(define cust (make-custodian))
|
||||||
(parameterize ([current-custodian cust])
|
(parameterize ([current-custodian cust])
|
||||||
(define-values (in out) (tcp-accept listener))
|
(define-values (in out) (tcp-accept listener))
|
||||||
; discard request header
|
; increment number of connections
|
||||||
; Discard the request header (up to blank line):
|
(semaphore-wait c-count-s)
|
||||||
(regexp-match #rx"(\r\n|^)\r\n" in)
|
((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)
|
(semaphore-wait connections-s)
|
||||||
;; keep track of open ports
|
((c-connections 'add) in out)
|
||||||
(set! connections (append connections (list (list in out))))
|
|
||||||
(semaphore-post connections-s)
|
(semaphore-post connections-s)
|
||||||
|
|
||||||
; start a thread to deal with specific client and add descriptor value to the list of threads
|
; start a thread to deal with specific client and add descriptor value to the list of threads
|
||||||
(set! threads (append threads (list (thread (lambda ()
|
(define threadcom (thread (lambda ()
|
||||||
(handle in out) ;; this handles connection with that specific client
|
(handle in out)))) ; comms between server and particular client
|
||||||
(close-input-port in)
|
|
||||||
(close-output-port out))))
|
;; Watcher thread:
|
||||||
)
|
;; kills current thread for waiting too long for connection from
|
||||||
)
|
(thread (lambda ()
|
||||||
;; Watcher thread:
|
(displayln-safe (string-append
|
||||||
;; kills current thread for waiting too long for connection from
|
"Started a thread to kill hanging "
|
||||||
;; clients
|
"connecting threads") stdout)
|
||||||
(thread (lambda ()
|
(sleep 1360)
|
||||||
(sleep 360)
|
(custodian-shutdown-all cust)))))
|
||||||
(custodian-shutdown-all cust)))))
|
|
||||||
|
|
||||||
; (define (handle connections)
|
|
||||||
; ())
|
|
||||||
;; each thread needs 2 new threads
|
|
||||||
(define (handle in out)
|
(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 (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)
|
(cond [(eof-object? evt-t0)
|
||||||
(displayln (string-append "Connection closed " (current-thread) "exiting"))
|
; TODO remove pair of ports associated with client
|
||||||
(exit)
|
(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)
|
[(string? evt-t0)
|
||||||
(semaphore-wait messages-s)
|
(semaphore-wait messages-s)
|
||||||
; append the message to list of messages
|
; append the message to list of messages
|
||||||
(display (string-append evt-t0 "\n"))
|
(display (string-append evt-t0 "\n"))
|
||||||
(set! messages (append messages (list evt-t0)))
|
((c-messages 'add) evt-t0)
|
||||||
(semaphore-post messages-s)]
|
(semaphore-post messages-s)]
|
||||||
[else
|
[else
|
||||||
(displayln (string-append "Nothing received from " (current-thread)))]))
|
(displayln-safe "Timeout waiting. Nothing received from client" stdout)]))
|
||||||
|
|
||||||
|
; Executes methods above in another thread
|
||||||
; 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
|
|
||||||
(thread (lambda ()
|
(thread (lambda ()
|
||||||
(let loop []
|
(let loop []
|
||||||
(something-to-say in)
|
(something-to-say in)
|
||||||
(sleep 1)
|
; (sleep 1)
|
||||||
(loop))))
|
(loop)))))
|
||||||
|
|
||||||
(thread (lambda ()
|
; extracts output port from a list pair of input and output port
|
||||||
(let loop []
|
(define (get-output-port ports)
|
||||||
(something-to-send out)
|
(cadr ports))
|
||||||
(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 input port
|
||||||
|
(define (get-input-port ports)
|
||||||
|
(car ports))
|
||||||
|
|
||||||
|
; broadcasts received message from clients periodically
|
||||||
(define broadcast
|
(define broadcast
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(semaphore-wait messages-s)
|
(semaphore-wait messages-s)
|
||||||
(semaphore-wait threads-s)
|
(cond [(not (null? ((c-messages 'mes-list))))
|
||||||
(if (not (null? messages))
|
(begin (map
|
||||||
(begin (map (lambda (thread-descriptor)
|
(lambda (ports)
|
||||||
(thread-send thread-descriptor (first messages)))
|
(displayln (first ((c-messages 'mes-list))) (get-output-port ports))
|
||||||
threads)
|
(flush-output (get-output-port ports)))
|
||||||
(set! messages (rest messages))
|
((c-connections 'cons-list)))
|
||||||
)
|
;; remove top message
|
||||||
(display "No message to display\n") ; for later create file port for errors and save error messages to that file
|
((c-messages 'remove-top))
|
||||||
)
|
(displayln "Message broadcasted"))])
|
||||||
(semaphore-post threads-s)
|
|
||||||
(semaphore-post messages-s)))
|
(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")
|
||||||
|
Loading…
Reference in New Issue
Block a user