Merge remote-tracking branch 'refs/remotes/origin/master' into grape
This commit is contained in:
commit
5e3bdbeeb4
11
.gitignore
vendored
Normal file
11
.gitignore
vendored
Normal file
@ -0,0 +1,11 @@
|
||||
# ignore temporary files
|
||||
*~
|
||||
*.txt
|
||||
|
||||
# ignore logs and configuration files
|
||||
*.out
|
||||
*.conf
|
||||
|
||||
# ignore racket compile files
|
||||
*.dep
|
||||
*.zo
|
196
Hermes/Hermes_Gui1.3.rkt
Normal file
196
Hermes/Hermes_Gui1.3.rkt
Normal file
@ -0,0 +1,196 @@
|
||||
#lang racket
|
||||
(require racket/gui/base)
|
||||
;Author:Douglas Richardson
|
||||
;Notes:Our GUI mostly deals with lists of a list of 3 strings and a number
|
||||
;although the number is always delt with locally
|
||||
;When using user-message you need to give it a list of 3 things
|
||||
;The name of the user as a string, what they said as a string,
|
||||
;and the color as a string
|
||||
|
||||
;Object stuff
|
||||
|
||||
(provide make-gui)
|
||||
|
||||
(define (make-gui)
|
||||
(begin
|
||||
;;Create the frame
|
||||
(define main-frame (new frame%
|
||||
[label "Example5"]
|
||||
[width 500]
|
||||
[height 700]
|
||||
))
|
||||
;;Editing canvas
|
||||
(define (do-stuff-paint paint-canvas paint-dc)
|
||||
(do-more-stuff-paint listy paint-canvas paint-dc))
|
||||
|
||||
(define (do-more-stuff-paint paint-listy paint-canvas paint-dc)
|
||||
(if (null? paint-listy)
|
||||
'()
|
||||
(begin
|
||||
(re-draw-message (get-username-from-list (car paint-listy))
|
||||
(get-message-from-list (car paint-listy))
|
||||
(get-color-from-list (car paint-listy))
|
||||
(get-height-from-list (car paint-listy)))
|
||||
(do-more-stuff-paint (cdr paint-listy) paint-canvas paint-dc))))
|
||||
|
||||
(define read-canvas (new canvas%
|
||||
[parent main-frame]
|
||||
[paint-callback do-stuff-paint]
|
||||
[style '(hscroll vscroll)]
|
||||
))
|
||||
|
||||
(send read-canvas init-auto-scrollbars #f #f 0 0);Start with no scrollbars
|
||||
;;text-field stuff
|
||||
(define (text-feild-callback callback-type other-thing)
|
||||
(if (equal? 'text-field-enter (send other-thing get-event-type))
|
||||
(button-do-stuff 'irrelevant 'not-used)
|
||||
'()))
|
||||
|
||||
(define input (new text-field%
|
||||
[parent main-frame]
|
||||
[label "Username:"]
|
||||
[callback text-feild-callback]
|
||||
))
|
||||
;;button stuff
|
||||
(define (button-do-stuff b e);b and e do nothing :/
|
||||
(begin
|
||||
(if (color-change-request? (send input get-value))
|
||||
(set! my-color (get-color-from-input (send input get-value)))
|
||||
(if (< 0 (string-length (send input get-value)))
|
||||
(send-message (send input get-value) my-color);;
|
||||
'()))
|
||||
(send input set-value "")
|
||||
))
|
||||
(define send-button (new button%
|
||||
[parent main-frame]
|
||||
[label "Send"]
|
||||
[callback button-do-stuff]))
|
||||
;;I forget what these do but don't move them
|
||||
(define dc (send read-canvas get-dc))
|
||||
(send dc set-scale 1 1)
|
||||
(send dc set-text-foreground "black")
|
||||
;;messaging stuff
|
||||
|
||||
(define (user-message-parse string start)
|
||||
(begin
|
||||
(define (helper str index)
|
||||
(if (eq? (string-ref str (+ start index)) #\~)
|
||||
(substring str start (+ start index))
|
||||
(helper str (+ index 1))))
|
||||
(helper string 0)))
|
||||
|
||||
(define (user-message onetrueinput)
|
||||
(begin
|
||||
(define username (user-message-parse onetrueinput 0))
|
||||
(define input (user-message-parse onetrueinput (+ 1(string-length username))))
|
||||
(define color (substring onetrueinput (+ 2 (string-length username) (string-length input))))
|
||||
(send dc set-text-foreground color)
|
||||
(send dc draw-text (string-append username ":" input) 0 height)
|
||||
(set! listy (appendlist listy (list username input color height)))
|
||||
(set! height (+ height 15))
|
||||
(set! min-v-size (+ min-v-size 15))
|
||||
(if (> (* 20 (string-length input)) min-h-size)
|
||||
(set! min-h-size (* 20 (string-length input)))
|
||||
'())
|
||||
(send read-canvas init-auto-scrollbars min-h-size min-v-size 0 1)
|
||||
))
|
||||
;;Add a function that parces input from a string and extracts elements
|
||||
|
||||
;;This probably won't change...
|
||||
(define (send-message input color)
|
||||
(user-message (string-append name "~" input "~" color)))
|
||||
;;Although re-draw is kind of misleading, it is just print the whole
|
||||
;;list of strings to the screen
|
||||
(define (re-draw-message username input color in-height)
|
||||
(begin
|
||||
(send dc set-text-foreground color)
|
||||
(send dc draw-text (string-append username ":" input) 0 in-height)
|
||||
))
|
||||
|
||||
(define (update given-list)
|
||||
(begin (set! listy '())
|
||||
(set! height 0)
|
||||
(update-helper given-list)))
|
||||
|
||||
(define (update-helper given-list)
|
||||
(if (null? given-list)
|
||||
'()
|
||||
(if (null? (car given-list))
|
||||
'()
|
||||
(begin (user-message
|
||||
(get-username-from-list (car given-list))
|
||||
(get-message-from-list (car given-list))
|
||||
(get-color-from-list (car given-list)))
|
||||
(update-helper (cdr given-list))))))
|
||||
|
||||
;;Variables go below functions
|
||||
(define name "Me")
|
||||
(define min-h-size 80)
|
||||
(define min-v-size 30)
|
||||
(define listy (list (list "Server" "Connected" "Red" 0)))
|
||||
(define my-color "black")
|
||||
(define height 15)
|
||||
;;dispatch goes below that
|
||||
(define (dispatch command)
|
||||
(cond ((eq? command 'show) (send main-frame show #t))
|
||||
((eq? command 'send) send-message)
|
||||
((eq? command 'set-name) (lambda (newname) (if (string? newname)
|
||||
(set! name newname)
|
||||
(print "Thats not good"))))
|
||||
((eq? command 'recieve-message) user-message)
|
||||
((eq? command 'get-list) listy)
|
||||
((eq? command 'set-list) update)
|
||||
;;Something up with that
|
||||
(else (error "Invalid Request" command))
|
||||
))
|
||||
;;dispatch goes below that
|
||||
dispatch))
|
||||
|
||||
|
||||
;This one displays information
|
||||
|
||||
|
||||
|
||||
|
||||
;Initilize scrolling
|
||||
|
||||
;Then we need to find out if we need them or not.
|
||||
|
||||
;Listy is going to be a list of lists of strings
|
||||
;each element in listy will contain three strings
|
||||
;the username the message they said and the color they used
|
||||
;The the height the message should display at
|
||||
|
||||
|
||||
(define (appendlist listoflist add-to-end)
|
||||
(if (null? listoflist)
|
||||
(cons add-to-end '())
|
||||
(cons (car listoflist) (appendlist (cdr listoflist) add-to-end))))
|
||||
|
||||
(define (get-username-from-list in-list)
|
||||
(car in-list))
|
||||
|
||||
(define (get-message-from-list in-list)
|
||||
(car (cdr in-list)))
|
||||
|
||||
(define (get-color-from-list in-list)
|
||||
(car (cdr (cdr in-list))))
|
||||
|
||||
(define (get-height-from-list in-list)
|
||||
(car (cdr (cdr (cdr in-list)))))
|
||||
|
||||
|
||||
|
||||
;this one is a crap version of justpressing the enter key
|
||||
(define (color-change-request? given-string)
|
||||
(if (> (string-length given-string) 7)
|
||||
(if (equal? (substring given-string 0 6) "/color")
|
||||
#t
|
||||
#f)
|
||||
#f))
|
||||
|
||||
(define (get-color-from-input given-string)
|
||||
(substring given-string 7))
|
||||
;(define thing1 (make-gui))
|
||||
;(define thing2 (make-gui))
|
||||
|
3
Hermes/Makefile
Normal file
3
Hermes/Makefile
Normal file
@ -0,0 +1,3 @@
|
||||
# Remove temporary files
|
||||
clean:
|
||||
rm -rf *~ *.out *.conf *.txt
|
17
Hermes/TODO
Normal file
17
Hermes/TODO
Normal file
@ -0,0 +1,17 @@
|
||||
FEATURES
|
||||
5. parser in the client side should do something similar (/color, /quit)
|
||||
16. plain tcp -> ssl based
|
||||
17. fix breaks for improper disconnects from clients
|
||||
18. Add topics after project completion
|
||||
** regexes to parse strings for different formats -related to 5
|
||||
** align code better for readability
|
||||
|
||||
|
||||
GOOD TO HAVE BUT NOT NECESSARY
|
||||
7. maybe fiddle around with irc library (we leave this for future opl classes) no time got other classes
|
||||
*14. bye message prompt for clients part of session stickiness
|
||||
*15. Session stickiness for clients. Log received comms to a local file.
|
||||
additionally save user details and prompt user to use defaults or create
|
||||
new ones
|
||||
10. authentication for databases - to avoid dependencies this is left out
|
||||
** whispers aren't currently logged - its on purpose
|
108
Hermes/client.rkt
Normal file
108
Hermes/client.rkt
Normal file
@ -0,0 +1,108 @@
|
||||
#lang racket
|
||||
|
||||
(require "modules/general.rkt" "Hermes_Gui1.3.rkt")
|
||||
(require math/base) ;; for random number generation
|
||||
;; TODO clean up string message output and alignment
|
||||
;; TODO close ports after done
|
||||
;; i.e. seconds and minutes hours specifically
|
||||
;; author: Ibrahim Mkusa
|
||||
;; about: print and read concurrently
|
||||
;; notes: output may need to be aligned and formatted nicely
|
||||
|
||||
|
||||
; we will prompt for these in the gui
|
||||
(define host3 "localhost")
|
||||
(define port-num 4321)
|
||||
(define sleep-t 0.1)
|
||||
|
||||
; we won't need this. Just me being overzealous
|
||||
(define hermes-conf (open-output-file "./hermes_client.conf" #:exists'append))
|
||||
(define hermes-conf-s (make-semaphore 1))
|
||||
|
||||
(define convs-out (open-output-file "./convs_client.out" #:exists 'append))
|
||||
(define convs-out-s (make-semaphore 1))
|
||||
|
||||
(define error-out (open-output-file "./error_client.out" #:exists 'append))
|
||||
(define error-out-s (make-semaphore 1))
|
||||
|
||||
; custodian for client connections
|
||||
(define main-client-cust (make-custodian))
|
||||
; make connection to server
|
||||
(define (client port-no)
|
||||
(parameterize ([current-custodian main-client-cust])
|
||||
;; connect to server at port 8080
|
||||
(define-values (in out) (tcp-connect host3 port-no)) ;; define values
|
||||
;; binds to multiple values akin to unpacking tuples in python
|
||||
|
||||
; store username to a file for later retrieval along with relevent
|
||||
; info used for authentication with server
|
||||
(displayln "What's your name?")
|
||||
(define username (read-line))
|
||||
|
||||
;send the username to the server (username in out)
|
||||
(displayln username out)
|
||||
(flush-output out)
|
||||
|
||||
(define a (thread
|
||||
(lambda ()
|
||||
(displayln-safe "Starting receiver thread." error-out-s error-out)
|
||||
(let loop []
|
||||
(receive-messages in)
|
||||
(sleep sleep-t)
|
||||
(loop)))))
|
||||
(define t (thread
|
||||
(lambda ()
|
||||
(displayln-safe "Starting sender thread." error-out-s error-out)
|
||||
(let loop []
|
||||
(send-messages username out)
|
||||
(sleep sleep-t)
|
||||
(loop)))))
|
||||
(displayln-safe "Now waiting for sender thread." error-out-s error-out)
|
||||
(thread-wait t) ;; returns prompt back to drracket
|
||||
(displayln-safe "Closing client ports." error-out-s error-out)
|
||||
(close-input-port in)
|
||||
(close-output-port out))
|
||||
(custodian-shutdown-all main-client-cust))
|
||||
|
||||
|
||||
;; 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))
|
||||
" | "))
|
||||
;; read, quits when user types in "quit"
|
||||
(define input (read-line))
|
||||
; TODO /quit instead of quit
|
||||
(cond ((string=? input "quit")
|
||||
(displayln (string-append date-print username " signing out. See ya!") out)
|
||||
(flush-output out)
|
||||
(close-output-port error-out)
|
||||
(close-output-port convs-out)
|
||||
(exit)))
|
||||
|
||||
(displayln (string-append date-print username ": " input) out)
|
||||
(flush-output out))
|
||||
|
||||
; receives input from server and displays it to stdout
|
||||
(define (receive-messages in)
|
||||
; retrieve a message from server
|
||||
(define evt (sync (read-line-evt in)))
|
||||
|
||||
(cond [(eof-object? evt)
|
||||
(displayln-safe "Server connection closed." error-out-s error-out)
|
||||
(custodian-shutdown-all main-client-cust)
|
||||
;(exit)
|
||||
]
|
||||
[(string? evt)
|
||||
(displayln-safe evt convs-out-s convs-out)] ; could time stamp here or to send message
|
||||
[else
|
||||
(displayln-safe (string-append "Nothing received from server for 2 minutes.") convs-out-s convs-out)]))
|
||||
|
||||
(displayln-safe "Starting client." error-out-s error-out)
|
||||
(define stop-client (client 4321))
|
24
Hermes/modules/general.rkt
Normal file
24
Hermes/modules/general.rkt
Normal file
@ -0,0 +1,24 @@
|
||||
#lang racket
|
||||
|
||||
(provide displayln-safe)
|
||||
;; Several threads may want to print to stdout, so lets make things civil
|
||||
; constant always available
|
||||
(define stdout (make-semaphore 1))
|
||||
|
||||
; prints to stdout with an optional output port
|
||||
; requires a specified semaphore for the optional output port
|
||||
(define displayln-safe
|
||||
(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)])))
|
||||
|
276
Hermes/server.rkt
Normal file
276
Hermes/server.rkt
Normal file
@ -0,0 +1,276 @@
|
||||
#lang racket
|
||||
|
||||
(require "modules/general.rkt")
|
||||
(require math/base) ;; for random number generation
|
||||
|
||||
|
||||
(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.")
|
||||
|
||||
(define sleep-t 0.1)
|
||||
|
||||
; 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 username in out)
|
||||
(set! connections (append connections (list (list username 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
|
||||
|
||||
; 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
|
||||
|
||||
; two files to store error messages, and channel conversations
|
||||
(define error-out (open-output-file "./error_server.txt" #:exists 'append))
|
||||
(define convs-out (open-output-file "./conversations_server.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])
|
||||
(define listener (tcp-listen port-no 5 #t))
|
||||
(define (loop)
|
||||
(receive-clients listener)
|
||||
(loop))
|
||||
(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")
|
||||
(let loopb []
|
||||
(sleep sleep-t) ;; wait 0.5 secs before beginning to broadcast
|
||||
(broadcast)
|
||||
(loopb)))))
|
||||
(lambda ()
|
||||
(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 (receive-clients listener)
|
||||
(define cust (make-custodian))
|
||||
(parameterize ([current-custodian cust])
|
||||
(define-values (in out) (tcp-accept listener))
|
||||
|
||||
;TODO retrive user name for client here
|
||||
; do some error checking
|
||||
(define username-evt (sync (read-line-evt in 'linefeed)))
|
||||
|
||||
|
||||
|
||||
; increment number of connections
|
||||
(semaphore-wait c-count-s)
|
||||
((c-count 'increment))
|
||||
(semaphore-post c-count-s)
|
||||
|
||||
(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 convs-out-s convs-out)
|
||||
(flush-output out)
|
||||
(semaphore-wait connections-s)
|
||||
; TODO add in a username so we have (username input output)
|
||||
((c-connections 'add) username-evt in out)
|
||||
(semaphore-post connections-s)
|
||||
|
||||
; start a thread to deal with specific client and add descriptor value to the list of threads
|
||||
(define threadcom (thread (lambda ()
|
||||
(chat_with_client 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"))
|
||||
(sleep 1360)
|
||||
(custodian-shutdown-all cust)))))
|
||||
|
||||
; whisper selector for the username and message
|
||||
(define (whisper-info exp)
|
||||
(cadr exp))
|
||||
|
||||
(define (whisper-to exp)
|
||||
(caddr exp))
|
||||
|
||||
(define (whisper-message exp)
|
||||
(cadddr exp))
|
||||
|
||||
(define (chat_with_client in out)
|
||||
; deals with queueing incoming messages for server to broadcast to all clients
|
||||
(define (something-to-say in)
|
||||
(define evt-t0 (sync (read-line-evt in 'linefeed)))
|
||||
(cond [(eof-object? evt-t0)
|
||||
(semaphore-wait connections-s)
|
||||
((c-connections 'remove-ports) in out)
|
||||
(semaphore-post connections-s)
|
||||
; 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)
|
||||
;(exit)
|
||||
(kill-thread (current-thread))]
|
||||
[(string? evt-t0)
|
||||
; use regexes to evaluate received input from client
|
||||
(define whisper (regexp-match #px"(.*)/whisper\\s+(\\w+)\\s+(.*)" evt-t0)) ; is client trying to whisper to someone
|
||||
(define list-count (regexp-match #px"(.*)/list\\s+count\\s*" evt-t0)) ;; is client asking for number of logged in users
|
||||
(define list-users (regexp-match #px"(.*)/list\\s+users\\s*" evt-t0)) ;; user names
|
||||
; do something whether it was a message, a whisper, request for number of users and so on
|
||||
(cond [whisper
|
||||
(semaphore-wait connections-s)
|
||||
; get output port for user
|
||||
(define that-user-ports
|
||||
(first (filter
|
||||
(lambda (ports)
|
||||
(if (string=? (whisper-to whisper) (get-username ports))
|
||||
#t
|
||||
#f))
|
||||
((c-connections 'cons-list)))))
|
||||
; try to send that user the whisper
|
||||
(if (port-closed? (get-output-port that-user-ports))
|
||||
(begin
|
||||
(displayln "User is unavailable" out)
|
||||
(flush-output out))
|
||||
(begin
|
||||
(displayln (string-append (whisper-info whisper) (whisper-message whisper))
|
||||
(get-output-port that-user-ports))
|
||||
(flush-output (get-output-port that-user-ports))))
|
||||
(semaphore-post connections-s)]
|
||||
[list-count
|
||||
;;should put a semaphore on connections
|
||||
(semaphore-wait c-count-s)
|
||||
(semaphore-wait connections-s)
|
||||
(define no-of-users (string-append "Number of users in chat: "
|
||||
(number->string ((c-count 'current-count)))))
|
||||
(displayln no-of-users out)
|
||||
(flush-output out)
|
||||
(semaphore-post connections-s)
|
||||
(semaphore-post c-count-s)
|
||||
]
|
||||
[list-users
|
||||
(semaphore-wait connections-s)
|
||||
; map over connections sending the username to the client
|
||||
(displayln "Here is a list of users in chat." out)
|
||||
(map
|
||||
(lambda (ports)
|
||||
(displayln (get-username ports) out))
|
||||
((c-connections 'cons-list)))
|
||||
(flush-output out)
|
||||
(semaphore-post connections-s)]
|
||||
[else
|
||||
; (displayln-safe evt-t0) debug purposes
|
||||
(semaphore-wait messages-s)
|
||||
; evaluate it .
|
||||
((c-messages 'add) evt-t0)
|
||||
(semaphore-post messages-s)])]
|
||||
[else
|
||||
(displayln-safe "Timeout waiting. Nothing received from client")]))
|
||||
|
||||
; Executes methods above in another thread
|
||||
(thread (lambda ()
|
||||
(let loop []
|
||||
(something-to-say in)
|
||||
; (sleep 1)
|
||||
(loop)))))
|
||||
|
||||
; extracts output port from a list pair of input and output port
|
||||
(define (get-output-port ports)
|
||||
(caddr ports))
|
||||
|
||||
; extracts input port
|
||||
(define (get-input-port ports)
|
||||
(cadr ports))
|
||||
|
||||
; extract username
|
||||
(define (get-username ports)
|
||||
(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)
|
||||
(cond [(not (null? ((c-messages 'mes-list))))
|
||||
(begin (map
|
||||
(lambda (ports)
|
||||
(if (not (port-closed? (get-output-port ports)))
|
||||
(begin
|
||||
(displayln (first ((c-messages 'mes-list))) (get-output-port ports))
|
||||
(flush-output (get-output-port ports)))
|
||||
(displayln-safe "Failed to broadcast. Port not open." error-out-s error-out)))
|
||||
((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"))])
|
||||
(semaphore-post messages-s)))
|
||||
|
||||
(define stop-server (serve 4321)) ;; start server then close with stop
|
||||
(displayln-safe "Server process started\n" error-out-s error-out)
|
@ -72,11 +72,11 @@ satisfactorily we would have met our goals.
|
||||
## Architecture Diagram
|
||||
|
||||
#### Preliminary design
|
||||
![Architecture](https://github.com/oplS17projects/Hermes/blob/master/arch_diagram.png)
|
||||
![Architecture](https://github.com/oplS17projects/Hermes/blob/master/ext/arch_diagram.png)
|
||||
|
||||
|
||||
#### The Game plan
|
||||
![Diagram](https://github.com/oplS17projects/Hermes/blob/master/architecture_diagram.png)
|
||||
![Diagram](https://github.com/oplS17projects/Hermes/blob/master/ext/architecture_diagram.png)
|
||||
|
||||
|
||||
## Schedule
|
||||
|
Before Width: | Height: | Size: 23 KiB After Width: | Height: | Size: 23 KiB |
Before Width: | Height: | Size: 64 KiB After Width: | Height: | Size: 64 KiB |
75
tests/gui/concurrentreadandprint.rkt
Normal file
75
tests/gui/concurrentreadandprint.rkt
Normal file
@ -0,0 +1,75 @@
|
||||
#lang racket
|
||||
(require math/base) ;; for random number generation
|
||||
|
||||
;; a proof of concept
|
||||
;; one thread waits for input
|
||||
;; another displays messages in the background
|
||||
|
||||
|
||||
;; 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
|
||||
(define (read-loop)
|
||||
(display (read-line))
|
||||
(display "\n")
|
||||
(read-loop)
|
||||
)
|
||||
|
||||
(define input-prompt "input: ")
|
||||
(define output-prompt "output: ")
|
||||
|
||||
;; prompt for username and bind to a variable username
|
||||
(display "What's your name?\n")
|
||||
(define username (read-line))
|
||||
(define usernamei (string-append username ": ")) ;; make username appear nicer in a prompt
|
||||
(define fair (make-semaphore 1))
|
||||
|
||||
;; intelligent read, quits when user types in "quit"
|
||||
(define (read-loop-i)
|
||||
|
||||
|
||||
;(semaphore-wait fair)
|
||||
(display usernamei)
|
||||
(define input (read-line))
|
||||
;; do something over here with input maybe send it out
|
||||
|
||||
;; 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))))
|
||||
(display (string-append output-prompt input "\n"))
|
||||
;(semaphore-post fair)
|
||||
(read-loop-i)
|
||||
)
|
||||
|
||||
|
||||
;; 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 (hello-world)
|
||||
(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
|
||||
;; at this time we simulate the input from different users
|
||||
(define what-to-print (random-integer 0 2))
|
||||
(if (= what-to-print 0)
|
||||
(display "Doug: What's up, up?\n")
|
||||
(display "Fred: Looking good, good!\n"))
|
||||
;(semaphore-post fair)
|
||||
(hello-world))
|
||||
|
||||
(define t (thread (lambda ()
|
||||
(read-loop-i))))
|
||||
(define a (thread (lambda ()
|
||||
(hello-world))))
|
||||
|
||||
(thread-wait t) ;; returns prompt back to drracket
|
||||
;; below doesn't execute
|
||||
; (sleep 10)
|
||||
; (kill-thread t)
|
||||
; (define a (thread (display "hello world!\n")))
|
||||
; (display "John: hello soso\n")
|
||||
; (display "Emmanuel: cumbaya!!!!\n")
|
155
tests/tcpevents/crpovertcp.rkt
Normal file
155
tests/tcpevents/crpovertcp.rkt
Normal file
@ -0,0 +1,155 @@
|
||||
#lang racket
|
||||
(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) ...)
|
||||
|
||||
;; lets keep thread descriptor values
|
||||
;
|
||||
|
||||
(define fair (make-semaphore 1)) ;; managing connections above
|
||||
|
||||
(define can-i-broadcast (make-semaphore 1))
|
||||
|
||||
|
||||
;;
|
||||
|
||||
;; 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])
|
||||
(define listener (tcp-listen port-no 5 #t))
|
||||
(define (loop)
|
||||
(accept-and-handle listener)
|
||||
(loop))
|
||||
(thread loop))
|
||||
(lambda ()
|
||||
(displayln "\nGoodbye, shutting down all services\n")
|
||||
(custodian-shutdown-all main-cust)))
|
||||
|
||||
(define (accept-and-handle listener)
|
||||
(define cust (make-custodian))
|
||||
(parameterize ([current-custodian cust])
|
||||
(define-values (in out) (tcp-accept listener))
|
||||
(semaphore-wait fair)
|
||||
;; keep track of open ports
|
||||
(append connections (list (list in out)))
|
||||
(semaphore-wait fiar)
|
||||
|
||||
; thread will communicate to all clients at once in a broadcast
|
||||
; manner
|
||||
(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 120)
|
||||
(custodian-shutdown-all cust))))
|
||||
|
||||
; (define (handle connections)
|
||||
; ())
|
||||
;; each thread needs 2 new threads
|
||||
(define (handle in out)
|
||||
; define function to deal with in
|
||||
(define (something-to-say in)
|
||||
(sync/timeout 4 (read-line-evt in 'linefeed)))
|
||||
; define function to deal with out
|
||||
; thread them each
|
||||
; (server-loop in out)
|
||||
(sleep 5) ;; wait 5 seconds to guarantee client has already send message
|
||||
(define echo (read-line in)) ;; bind message to echo
|
||||
(displayln (string-append echo "\n"))
|
||||
; echo back the message, appending echo
|
||||
; could regex match the input to extract the name
|
||||
(writeln "Admin: Hello there" out) ;; append "echo " to echo and send back
|
||||
(flush-output out)
|
||||
)
|
||||
;; This is a single server communicating directly to the client
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
;; 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
|
||||
(define (read-loop)
|
||||
(display (read-line))
|
||||
(display "\n")
|
||||
(read-loop)
|
||||
)
|
||||
|
||||
(define input-prompt "input: ")
|
||||
(define output-prompt "output: ")
|
||||
|
||||
;; prompt for username and bind to a variable username
|
||||
(display "What's your name?\n")
|
||||
(define username (read-line))
|
||||
(define usernamei (string-append username ": ")) ;; make username appear nicer in a prompt
|
||||
|
||||
;; intelligent read, quits when user types in "quit"
|
||||
(define (read-loop-i)
|
||||
|
||||
|
||||
;(semaphore-wait fair)
|
||||
(display usernamei)
|
||||
(define input (read-line))
|
||||
;; do something over here with input maybe send it out
|
||||
|
||||
;; 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))))
|
||||
(display (string-append output-prompt input "\n"))
|
||||
;(semaphore-post fair)
|
||||
(read-loop-i)
|
||||
)
|
||||
|
||||
|
||||
;; 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 (hello-world)
|
||||
(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
|
||||
;; at this time we simulate the input from different users
|
||||
(define what-to-print (random-integer 0 2))
|
||||
(if (= what-to-print 0)
|
||||
(display "Doug: What's up, up?\n")
|
||||
(display "Fred: Looking good, good!\n"))
|
||||
;(semaphore-post fair)
|
||||
(hello-world))
|
||||
|
||||
(define t (thread (lambda ()
|
||||
(read-loop-i))))
|
||||
(define a (thread (lambda ()
|
||||
(hello-world))))
|
||||
|
||||
(thread-wait t) ;; returns prompt back to drracket
|
||||
;; below doesn't execute
|
||||
; (sleep 10)
|
||||
; (kill-thread t)
|
||||
; (define a (thread (display "hello world!\n")))
|
||||
; (display "John: hello soso\n")
|
||||
; (display "Emmanuel: cumbaya!!!!\n")
|
60
tests/tcpvanilla/tcpcommunication.rkt
Normal file
60
tests/tcpvanilla/tcpcommunication.rkt
Normal file
@ -0,0 +1,60 @@
|
||||
#lang racket
|
||||
;; Reads input iteratively then sends it to local server
|
||||
;; client reads back the message and displays it
|
||||
|
||||
(require math/base) ;; for random number generation
|
||||
|
||||
(define listener (tcp-listen 4326 5 #t))
|
||||
(define a (thread (lambda ()
|
||||
(define-values (s-in s-out) (tcp-accept listener))
|
||||
; Discard the request header (up to blank line):
|
||||
;(regexp-match #rx"(\r\n|^)\r\n" s-in)
|
||||
(sleep 10)
|
||||
(define (echo)
|
||||
(define input (read-line s-in))
|
||||
(displayln input s-out)
|
||||
(flush-output s-out)
|
||||
(if (eof-object? input)
|
||||
(displayln "Done talking\n")
|
||||
(echo)))
|
||||
(echo)
|
||||
(close-input-port s-in)
|
||||
(close-output-port s-out)
|
||||
(tcp-close listener)
|
||||
'ok)))
|
||||
|
||||
(define t (thread (lambda ()
|
||||
(define-values (c-in c-out) (tcp-connect "localhost" 4326))
|
||||
(define input-prompt "input: ")
|
||||
(define output-prompt "output: ")
|
||||
|
||||
;; prompt for username and bind to a variable username
|
||||
(display "What's your name?\n")
|
||||
(define username (read-line))
|
||||
(define usernamei (string-append username ": ")) ;; make username appear nicer in a prompt
|
||||
(define fair (make-semaphore 1))
|
||||
|
||||
;; intelligent read, quits when user types in "quit"
|
||||
(define (read-loop-i)
|
||||
;(semaphore-wait fair)
|
||||
; (display usernamei)
|
||||
(define input (read-line))
|
||||
;; do something over here with input maybe send it out
|
||||
|
||||
;; Tests input if its a quit then kills all threads
|
||||
;; An if would be better here tbh
|
||||
(cond ((string=? input "quit") (exit)))
|
||||
(display (string-append output-prompt input "\n") c-out)
|
||||
(flush-output c-out)
|
||||
(displayln (read-line c-in)) ;; server echoes back sent input
|
||||
;(semaphore-post fair)
|
||||
(read-loop-i)
|
||||
)
|
||||
(read-loop-i)
|
||||
'ok)))
|
||||
|
||||
;(kill-thread a)
|
||||
;(kill-thread t)
|
||||
(thread-wait t)
|
||||
(display "DONE!!\n")
|
||||
|
Loading…
Reference in New Issue
Block a user