Compare commits
50 Commits
Author | SHA1 | Date | |
---|---|---|---|
|
f64a33f6eb | ||
42bef853a5 | |||
9dfff4db45 | |||
a252bf5b3e | |||
3c511cd625 | |||
|
5c89715942 | ||
3cfff385f1 | |||
65bd9fae3d | |||
fe0bfe15dc | |||
|
26c9029401 | ||
|
85f7c217aa | ||
b56bab8d37 | |||
37e58af6c3 | |||
bdaf3f2fe8 | |||
2e5a7beadb | |||
ba69f9541b | |||
cc0dec4e68 | |||
f072a77550 | |||
bd7b3bb531 | |||
58cff4f1b8 | |||
3e84c3a5ef | |||
a8e49e9070 | |||
9b31f3b324 | |||
1c60a61d82 | |||
28d78a8a97 | |||
e68c65c36a | |||
d65c4c634c | |||
f4060606f0 | |||
|
79495be7e5 | ||
18a9949ce6 | |||
|
4f2353c2f1 | ||
6aa488216e | |||
c80ebe3c16 | |||
|
044e36ff5d | ||
6890e2be72 | |||
c6dd0311d4 | |||
c78c2fb872 | |||
6bac96cfdb | |||
183fad9de3 | |||
44a02c7025 | |||
6b85be6490 | |||
ed5d1d7571 | |||
a1798d9e3d | |||
29c6708e13 | |||
63a3757f67 | |||
4c508fec11 | |||
a9f7121695 | |||
|
0ea83b808a | ||
ce93a60d0e | |||
42eceeb36f |
149
Douglas_Richardson.md
Normal file
149
Douglas_Richardson.md
Normal file
@ -0,0 +1,149 @@
|
||||
# Hermes project report
|
||||
|
||||
## Douglas Richardson
|
||||
### April 28, 2017
|
||||
|
||||
# Overview
|
||||
Hermes is a multi-user chat program that allows users to setup a server, connect to it
|
||||
and communicate with all other members of the server.
|
||||
|
||||
Hermes uses TCP pipes to tread input and output like a port. Essentially, each client sends
|
||||
information to the server and depending on the input, the server decides what to do with it
|
||||
and usually sends output back to all the other users.
|
||||
|
||||
# Libraries Used
|
||||
The code uses two non-default libraries:
|
||||
|
||||
```
|
||||
(require racket/gui/base)
|
||||
(require math/base)
|
||||
```
|
||||
|
||||
* The ```racket/gui/base``` library is the primary library for the GUI.
|
||||
* the ```math/base``` is used for random number generation.
|
||||
|
||||
# Key Code Excerpts
|
||||
|
||||
Here is a discussion of the most essential procedures, including a description of how they embody ideas from
|
||||
UMass Lowell's COMP.3010 Organization of Programming languages course.
|
||||
|
||||
Five examples are shown and they are individually numbered.
|
||||
|
||||
## 1. Initializing the gui
|
||||
|
||||
This line of code allows us to wrap the gui into an object.
|
||||
|
||||
```
|
||||
(define (make-gui)
|
||||
...
|
||||
(cond ((eq? command 'show) (lambda () (send main-frame show #t)))
|
||||
((eq? command 'get-color) get-my-color)
|
||||
((eq? command 'set-color) set-color)
|
||||
((eq? command 'prompt-color) prompt-color)
|
||||
((eq? command 'prompt-username) prompt-username)
|
||||
((eq? command 'prompt-hostname) prompt-hostname)
|
||||
((eq? command 'send) send-message) ;; call to show a message in a gui
|
||||
((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 should assume a message and output to screen we do not want it
|
||||
; to fail
|
||||
((eq? command 'get-message) get-message)
|
||||
(else (error "Invalid Request" command))
|
||||
))
|
||||
;;dispatch goes below that
|
||||
dispatch)
|
||||
```
|
||||
|
||||
This allows us to make our code simpler and lets us treat the gui like an object in it's self.
|
||||
Giving the gui commands to change it's self rather than having to remember all the commands it has.
|
||||
|
||||
## 2. Working with lists
|
||||
|
||||
This code is code that allows us to append a new message onto the end of the list of messages using recursion
|
||||
|
||||
```
|
||||
(define (appendlist listoflist add-to-end)
|
||||
(if (null? listoflist)
|
||||
(cons add-to-end '())
|
||||
(cons (car listoflist) (appendlist (cdr listoflist) add-to-end))))
|
||||
```
|
||||
|
||||
Normally there is a function to just append onto the end of a list, however the problem is that if we attempt to append
|
||||
a list of elements onto the end of a list, it just appends the elements onto the end of the list. For example if I had
|
||||
a list of the following '(("Doug" "Hello World!" "Purple"))
|
||||
and wanted to append the list '("Gordon" "No one else is here Doug." "Black") The list I want back would be
|
||||
'(("Doug" "Hello World!" "Purple")("Gordon" "No one else is here Doug." "Black")) but if I use the default
|
||||
list append I get'(("Doug" "Hello World!" "Purple")"Gordon" "No one else is here Doug." "Black")
|
||||
which is no good for the gui.
|
||||
|
||||
This follows on our idea of working with lists and using recursion to walk down a list.
|
||||
|
||||
## 3. Re-drawing messages
|
||||
|
||||
The following procedure is used to re-draw messages onto the canvas after a screen move or resize.
|
||||
|
||||
```
|
||||
(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))))))
|
||||
```
|
||||
|
||||
While it doesn't actually use the map function, this is a map as for every element of a list (each element is a list of three strings)
|
||||
it runs a procedure (or in this case a set of procedures) in the order of the list.
|
||||
|
||||
## 4. Parsing Messages
|
||||
|
||||
This line of code is used to parse a single string message into a three string message
|
||||
|
||||
```
|
||||
(define (user-message-parse string-i start)
|
||||
(define (helper str index)
|
||||
(if (eq? (string-ref str (+ start index)) #\~) ; regexes would allow us
|
||||
; to avoid this #\~
|
||||
(substring str start (+ start index))
|
||||
(helper str (+ index 1))))
|
||||
(helper string-i 0))
|
||||
```
|
||||
|
||||
This was used to parse a string into smaller strings. In hermes we can only send one string to each client at one time, therefore
|
||||
the three elements that the gui uses to print messages need to be compressed together. We append a ~ inbetween each of these so we can
|
||||
parse them out at the client end.
|
||||
|
||||
While we don't run any commands off it (saved that part for the commands we do interpret from strings)
|
||||
it is similar to the symbolic differentaitor.
|
||||
|
||||
## 5. Color setting
|
||||
Here we have an example of when we use a symbolic differentiator in the gui to determine when a user wants to run a command
|
||||
rather than input text.
|
||||
|
||||
```
|
||||
(define (button-do-stuff b e);b and e do nothing :/
|
||||
(if (color-change-request? (send input get-value))
|
||||
(set! my-color (get-color-from-input (send input get-value)))
|
||||
...
|
||||
|
||||
(define (color-change-request? given-string)
|
||||
(if (> (string-length given-string) 7)
|
||||
(if (equal? (substring given-string 0 6) "/color")
|
||||
#t
|
||||
#f)
|
||||
#f))
|
||||
```
|
||||
|
||||
The procedure button-do-stuff is run every time the user presses the return key or presses the send button on the gui
|
||||
and what it will do is check to see if the user typed in "/color", and if they did it sets the internal color to be
|
||||
what the user said after that. This is part of our symbolic differentiator that allows the user to use commands
|
||||
rather than the typical use of the input (which is just to send a message to other clients)
|
||||
|
354
Hermes/GUI.rkt
Normal file
354
Hermes/GUI.rkt
Normal file
@ -0,0 +1,354 @@
|
||||
#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
|
||||
; TODO make different objects threadable send button vs text area vs canvas
|
||||
|
||||
(provide make-gui)
|
||||
|
||||
; store input into a message list
|
||||
; will create closure later
|
||||
(define messages-s (make-semaphore 1))
|
||||
(define messages '())
|
||||
(define sleep-t 0.1)
|
||||
|
||||
; (define-values (gui-in gui-out) (make-pipe #f))
|
||||
(define (make-gui)
|
||||
;;Create the frame/window with title "Example5", width 500 and height 700
|
||||
(define main-frame (new frame%
|
||||
[label "Hermes"]
|
||||
[width 500]
|
||||
[height 700]
|
||||
[min-width 500]
|
||||
[min-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))))
|
||||
|
||||
; canvas for displaying messages with horizontal and vertical scrollbar.
|
||||
; on an event it calls do-stuff-paint to redraw things on the screen
|
||||
; properly
|
||||
(define read-canvas (new canvas%
|
||||
[parent main-frame]
|
||||
[paint-callback do-stuff-paint]
|
||||
[style '(hscroll vscroll)]
|
||||
[min-width 450]
|
||||
[min-height 690]
|
||||
))
|
||||
|
||||
; "send" is rackets way of doing object-oriented programming. It calls an
|
||||
; objects functions in this case "read-canvas" object's init-auto-scrollbars
|
||||
(send read-canvas init-auto-scrollbars #f #f 0 0);Start with no scrollbars
|
||||
|
||||
; editing area callback. Gets called when enter is pressed.
|
||||
(define (text-field-callback callback-type other-thing)
|
||||
(if (equal? 'text-field-enter (send other-thing get-event-type))
|
||||
(button-do-stuff 'irrelevant 'not-used)
|
||||
'()))
|
||||
|
||||
; Create a horizontal panel to house the send button and text-field
|
||||
(define hpanel (new horizontal-panel%
|
||||
[parent main-frame]
|
||||
[min-width 450]
|
||||
[min-height 10]
|
||||
[alignment (list 'left 'center)]))
|
||||
|
||||
; creates the editing area as part of the parent "main-frame" define above.
|
||||
; initially labelled "Username:"
|
||||
; NOTE: we pad label with additional spaces so we don't have to recompute
|
||||
; the window dimensions to fit the new label (the actual username)
|
||||
; TODO make label setable
|
||||
(define input (new text-field%
|
||||
[parent hpanel]
|
||||
[label "username "]
|
||||
[callback text-field-callback]
|
||||
))
|
||||
|
||||
; It's a callback function activated when the send button is pressed in the
|
||||
; GUI. It is also called manually when textfield receives an enter key
|
||||
(define (button-do-stuff b e);b and e do nothing :/
|
||||
(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)))
|
||||
(begin
|
||||
; (send-message (send input get-value) my-color);;
|
||||
(semaphore-wait messages-s)
|
||||
(set! messages (append messages (list (send input get-value))))
|
||||
(semaphore-post messages-s)
|
||||
; (open-input-string )
|
||||
)
|
||||
'()))
|
||||
(send input set-value "")
|
||||
)
|
||||
|
||||
; retrieves a message user inputed to the text field
|
||||
(define (get-message)
|
||||
(semaphore-wait messages-s)
|
||||
(define one-message
|
||||
(if (not (null? messages))
|
||||
(begin
|
||||
;(define msg (car messages))
|
||||
(car messages)
|
||||
;(set! messages (cdr messages))
|
||||
)
|
||||
'()))
|
||||
(semaphore-post messages-s)
|
||||
|
||||
(if (not (string? one-message))
|
||||
(begin
|
||||
(sleep sleep-t) ; so we don't burn cpu cycles
|
||||
(get-message))
|
||||
(begin
|
||||
(semaphore-wait messages-s)
|
||||
(set! messages (cdr messages))
|
||||
(semaphore-post messages-s)
|
||||
one-message)))
|
||||
; creates the send button
|
||||
(define send-button (new button%
|
||||
[parent hpanel]
|
||||
[label "Send"]
|
||||
[callback button-do-stuff]))
|
||||
|
||||
|
||||
(send input focus) ; move focus to text-field
|
||||
|
||||
; get-dc retrieves the canvas' device context. From racket docs. A dc object
|
||||
; is a drawing context for drawing graphics and text. It represents output
|
||||
; devices in a generic way.
|
||||
; Specifically the line below retrieves our canvas device context object.
|
||||
(define dc (send read-canvas get-dc))
|
||||
(send dc set-scale 1 1) ; set scaling config of output display to 1 to 1
|
||||
; no scalling
|
||||
(send dc set-text-foreground "black") ; color of text that gets drawn on the
|
||||
; canvas with "draw-text"
|
||||
; (send dc set-smoothing 'aligned)
|
||||
;;messaging stuff
|
||||
|
||||
; could convert below to regexes
|
||||
(define (user-message-parse string-i start)
|
||||
(define (helper str index)
|
||||
(if (eq? (string-ref str (+ start index)) #\~) ; regexes would allow us
|
||||
; to avoid this #\~
|
||||
(substring str start (+ start index))
|
||||
(helper str (+ index 1))))
|
||||
(helper string-i 0))
|
||||
|
||||
|
||||
;; draws a user input to the screen
|
||||
(define (user-message user-input)
|
||||
(define username (user-message-parse user-input 0))
|
||||
(define input (user-message-parse user-input (+ 1 (string-length username))))
|
||||
(define color (substring user-input (+ 2 (string-length username) (string-length input))))
|
||||
(send dc set-text-foreground color) ; set dc's text color to user
|
||||
; provided
|
||||
; (send dc draw-text (string-append username ":" input) 0 height)
|
||||
(send dc draw-text input 0 height) ;; just print message to string
|
||||
|
||||
(set! listy (appendlist listy (list username input color height)))
|
||||
(set! height (+ height 15)) ; 15 is space between messages
|
||||
; redraw overly long text on gui
|
||||
(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-i and extracts elements
|
||||
|
||||
; actually gets called to send input to the screen. user-message is in effect
|
||||
; its helper. It uses "~" to delimit the different components of message
|
||||
(define (send-message input color)
|
||||
(user-message (string-append name "~" input "~" color)))
|
||||
|
||||
;; draws messages to the screen canvas as text
|
||||
(define (re-draw-message username input color in-height)
|
||||
(send dc set-text-foreground color)
|
||||
; (send dc draw-text (string-append username ":" input) 0 in-height)
|
||||
(send dc draw-text input 0 in-height)
|
||||
)
|
||||
|
||||
; used when redrawing the screen along with its helper.
|
||||
(define (update given-list)
|
||||
(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
|
||||
; for interfacing with outside elements
|
||||
(define gui-input-in-s '())
|
||||
(define gui-input-out-s '())
|
||||
(define gui-input-in '())
|
||||
(define gui-input-out '())
|
||||
|
||||
(define name "Me")
|
||||
(define min-h-size 80)
|
||||
(define min-v-size 30)
|
||||
;(define listy (list (list "Server" "Connected" "Red" 0))) ; initializes
|
||||
(define listy '())
|
||||
; listy with first message to be drawn on screen
|
||||
; wrap in closure
|
||||
(define my-color "black") ; default color of the text messages if none
|
||||
; specified
|
||||
; associated methods to prompt for color, get color and set color
|
||||
(define (set-color new-color)
|
||||
(set! my-color new-color))
|
||||
|
||||
(define (get-my-color)
|
||||
my-color)
|
||||
|
||||
; TODO loop to make sure you get right user input
|
||||
; not really needed as user can set in window
|
||||
(define (prompt-color)
|
||||
(define returned (get-text-from-user "Color set-up" "Please enter color for text"
|
||||
main-frame "black" (list 'disallow-invalid)
|
||||
#:validate
|
||||
(lambda (input)
|
||||
(if (and (string? input) (<= (string-length input) 10)
|
||||
(>= (string-length input) 3))
|
||||
#t
|
||||
#f))))
|
||||
(set! my-color returned)
|
||||
returned)
|
||||
(define height 0) ; determines starting height
|
||||
; TODO create height variable that stores the height/space between messages
|
||||
|
||||
;; prompt user for username
|
||||
;; could randomly assign a user
|
||||
;; after calling get-text set it as new label of text-field
|
||||
; TODO there is a pattern here could wrap all this into resusable prompt funciton
|
||||
;
|
||||
(define (prompt-username)
|
||||
(define returned (get-text-from-user "Username set-up" "Please enter a username"
|
||||
main-frame "user" (list 'disallow-invalid)
|
||||
#:validate
|
||||
(lambda (input)
|
||||
(if (and (string? input) (<= (string-length input) 10)
|
||||
(>= (string-length input) 2))
|
||||
#t
|
||||
#f))))
|
||||
(send input set-label returned)
|
||||
returned)
|
||||
|
||||
(define (prompt-hostname)
|
||||
(define returned (get-text-from-user "Hostname set-up" "Please enter a hostname"
|
||||
main-frame "67.186.191.81" (list 'disallow-invalid)
|
||||
#:validate
|
||||
(lambda (input)
|
||||
(if (and (string? input) (<= (string-length input) 50)
|
||||
(>= (string-length input) 2))
|
||||
#t
|
||||
#f))))
|
||||
; (send input set-label returned)
|
||||
returned)
|
||||
|
||||
|
||||
|
||||
;;dispatch goes below that
|
||||
;; TODO get username function maybe
|
||||
(define (dispatch command)
|
||||
; show gui should return the users the name as well as its first message
|
||||
; to be called
|
||||
(cond ((eq? command 'show) (lambda () (send main-frame show #t)))
|
||||
((eq? command 'get-color) get-my-color)
|
||||
((eq? command 'set-color) set-color)
|
||||
((eq? command 'prompt-color) prompt-color)
|
||||
((eq? command 'prompt-username) prompt-username)
|
||||
((eq? command 'prompt-hostname) prompt-hostname)
|
||||
((eq? command 'send) send-message) ;; call to show a message in a gui
|
||||
((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 should assume a message and output to screen we do not want it
|
||||
; to fail
|
||||
((eq? command 'get-message) get-message)
|
||||
(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
|
||||
|
||||
; listoflist is listy here, and add-to-end is what gets appended to the end
|
||||
; really expensive operation but its important for Doug to showcase some opl
|
||||
; concepts
|
||||
(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)))))
|
||||
|
||||
|
||||
|
||||
; did user request for color change /
|
||||
(define (color-change-request? given-string)
|
||||
(if (> (string-length given-string) 7)
|
||||
(if (equal? (substring given-string 0 6) "/color")
|
||||
#t
|
||||
#f)
|
||||
#f))
|
||||
|
||||
; we should use regexes for this.
|
||||
(define (get-color-from-input given-string)
|
||||
(substring given-string 7))
|
||||
;(define thing1 (make-gui))
|
||||
;(define thing2 (make-gui))
|
||||
; (define hermes-gui (make-gui))
|
||||
; ((hermes-gui 'show))
|
||||
|
@ -1,196 +0,0 @@
|
||||
#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))
|
||||
|
34
Hermes/README.md
Normal file
34
Hermes/README.md
Normal file
@ -0,0 +1,34 @@
|
||||
# Hermes - the code
|
||||
## Installation
|
||||
|
||||
The only pre-requisite is to have a recent version of Drracket, then go ahead
|
||||
and launch an instance of Drracket running server.rkt and one or more
|
||||
instances running client.rkt.
|
||||
|
||||
## Using Hermes
|
||||
|
||||
### General
|
||||
|
||||
The clients can run on the same computer with the server, or you can run the
|
||||
server alone in another compute on the internet. As long as you have the
|
||||
server's public ip address, the port its listening on(must port forward on home
|
||||
network!), and the server allows communication through that port in the firewall
|
||||
you are good to go.
|
||||
|
||||
### Clients
|
||||
|
||||
In the clients follow the prompts to set you up. Type in messages to send to
|
||||
other clients. You may try connecting to server instance running locally
|
||||
"localhost" or have an ip-address for a hermes server running elsewhere.
|
||||
|
||||
#### Commands
|
||||
* Change color of your messages with /color color. Default is black.
|
||||
* You can list users in chat with /list users.
|
||||
* You can get the count of users with /list count.
|
||||
* If you want to send a message to a particular user, do /whisper username message in chat.
|
||||
* If you want to leave chat, type /quit.
|
||||
|
||||
### Server
|
||||
|
||||
You can stop the server by typing in (stop-server) in the interactive window.
|
||||
It's really important you do this to free up the ports.
|
@ -1,7 +1,6 @@
|
||||
FEATURES
|
||||
5. parser in the client side should do something similar (/color, /quit)
|
||||
need to pass color settings between users
|
||||
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
|
||||
@ -15,3 +14,5 @@ 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
|
||||
automated test sets for networking and client code
|
||||
encryption over SSL using root certificates
|
||||
|
@ -1,6 +1,10 @@
|
||||
#lang racket
|
||||
; Author: Ibrahim Mkusa
|
||||
; About: code that enables communication with the client. It uses GUI code
|
||||
; authored by Doug-Richardson
|
||||
|
||||
(require "modules/general.rkt" "Hermes_Gui1.3.rkt")
|
||||
|
||||
(require "modules/general.rkt" "GUI.rkt")
|
||||
(require math/base) ;; for random number generation
|
||||
;; TODO clean up string message output and alignment
|
||||
;; TODO close ports after done
|
||||
@ -10,11 +14,18 @@
|
||||
;; notes: output may need to be aligned and formatted nicely
|
||||
|
||||
|
||||
; we will prompt for these in the gui
|
||||
(define host3 "localhost")
|
||||
(define hermes-gui (make-gui)) ;; our gui
|
||||
((hermes-gui 'show))
|
||||
;(sleep 0.25)
|
||||
|
||||
|
||||
; (define host3 "localhost")
|
||||
(define hostname ((hermes-gui 'prompt-hostname)))
|
||||
(define port-num 4321)
|
||||
(define sleep-t 0.1)
|
||||
|
||||
(define hermes-gui-s (make-semaphore 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))
|
||||
@ -25,19 +36,21 @@
|
||||
(define error-out (open-output-file "./error_client.out" #:exists 'append))
|
||||
(define error-out-s (make-semaphore 1))
|
||||
|
||||
; custodian for client connections
|
||||
; custodian for client connections. Define at top level since a function needs
|
||||
; to see it
|
||||
(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
|
||||
|
||||
;; TODO catch error here
|
||||
(define-values (in out) (tcp-connect hostname 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))
|
||||
;; TODO could store theses info in a file for retrieval later
|
||||
(define username ((hermes-gui 'prompt-username)))
|
||||
((hermes-gui 'prompt-color))
|
||||
|
||||
;send the username to the server (username in out)
|
||||
(displayln username out)
|
||||
@ -58,11 +71,14 @@
|
||||
(sleep sleep-t)
|
||||
(loop)))))
|
||||
(displayln-safe "Now waiting for sender thread." error-out-s error-out)
|
||||
(thread-wait t) ;; returns prompt back to drracket
|
||||
; (thread-wait t) ;; returns prompt back to drracket
|
||||
)
|
||||
|
||||
(lambda ()
|
||||
(displayln-safe "Closing client ports." error-out-s error-out)
|
||||
(close-input-port in)
|
||||
(close-output-port out))
|
||||
(custodian-shutdown-all main-client-cust))
|
||||
;(close-input-port in)
|
||||
;(close-output-port out)
|
||||
(custodian-shutdown-all main-client-cust)))
|
||||
|
||||
|
||||
;; sends a message to the server
|
||||
@ -70,25 +86,40 @@
|
||||
; 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))
|
||||
(define date-print (string-append (pad-date (number->string (date-hour date-today)))
|
||||
":"
|
||||
(number->string (date-minute date-today))
|
||||
(pad-date (number->string (date-minute date-today)))
|
||||
":"
|
||||
(number->string (date-second date-today))
|
||||
(pad-date (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)
|
||||
;; TODO read from GUI instead
|
||||
;(define input (read-line))
|
||||
;(semaphore-wait hermes-gui-s)
|
||||
(define input ((hermes-gui 'get-message)))
|
||||
;(semaphore-post hermes-gui-s)
|
||||
|
||||
; /color color is appended to input to specify the color the message should
|
||||
; be displayed in
|
||||
(cond ((string=? input "/quit")
|
||||
(displayln (string-append date-print username " signing out. See ya!"
|
||||
" /color " ((hermes-gui 'get-color))) out)
|
||||
(flush-output out)
|
||||
(close-output-port error-out)
|
||||
(close-output-port convs-out)
|
||||
;(custodian-shutdown-all main-client-cust)
|
||||
(exit)))
|
||||
|
||||
(displayln (string-append date-print username ": " input) out)
|
||||
(displayln (string-append date-print username ": " input
|
||||
" /color " ((hermes-gui 'get-color))) out)
|
||||
(flush-output out))
|
||||
|
||||
; a wrap around to call ((hermes-gui 'send) zzz yyy) without complaints from
|
||||
; drracket
|
||||
(define send-to-gui
|
||||
(lambda (message color)
|
||||
((hermes-gui 'send) message color)))
|
||||
|
||||
; receives input from server and displays it to stdout
|
||||
(define (receive-messages in)
|
||||
; retrieve a message from server
|
||||
@ -96,13 +127,29 @@
|
||||
|
||||
(cond [(eof-object? evt)
|
||||
(displayln-safe "Server connection closed." error-out-s error-out)
|
||||
(custodian-shutdown-all main-client-cust)
|
||||
(exit)
|
||||
;(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
|
||||
(displayln-safe evt convs-out-s convs-out)
|
||||
(define evt-matched
|
||||
(regexp-match #px"(.*)\\s+/color\\s+(\\w+).*"
|
||||
evt))
|
||||
; TODO set color to current client if the message is from him
|
||||
; otherwise set it to the remote
|
||||
;(semaphore-wait hermes-gui-s)
|
||||
;(send-to-gui evt ((hermes-gui 'get-color)))
|
||||
|
||||
; extracts the message and color from received message
|
||||
(send-to-gui (cadr evt-matched) (caddr evt-matched))
|
||||
;(semaphore-post hermes-gui-s)
|
||||
] ; 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))
|
||||
;(define stop-client (client 4321))
|
||||
; we will prompt for these in the gui
|
||||
|
||||
|
78
Hermes/logs/conversations_server.txt
Normal file
78
Hermes/logs/conversations_server.txt
Normal file
@ -0,0 +1,78 @@
|
||||
Number of users in chat: 1 /color blue
|
||||
Number of users in chat: 2 /color blue
|
||||
18:15:50 | Ibrahim: hello /color violet
|
||||
18:15:29 | Doug: fsdfdsfads /color red
|
||||
18:16:08 | Doug signing out. See ya! /color red
|
||||
18:16:01 | Ibrahim signing out. See ya! /color violet
|
||||
Number of users in chat: 1 /color blue
|
||||
18:21:58 | Ibrahim signing out. See ya! /color blue
|
||||
Number of users in chat: 1 /color blue
|
||||
18:24:14 | Doug signing out. See ya! /color black
|
||||
Number of users in chat: 1 /color blue
|
||||
11:12:05 | Ibrahim signing out. See ya! /color black
|
||||
Number of users in chat: 1 /color blue
|
||||
11:12:39 | user signing out. See ya! /color green
|
||||
Number of users in chat: 1 /color blue
|
||||
Number of users in chat: 2 /color blue
|
||||
11:16:51 | Doug: whats going on? /color blue
|
||||
11:16:41 | Ibrahim: I am alright /color green
|
||||
11:17:26 | Ibrahim: heheheh /color red
|
||||
11:17:35 | Ibrahim signing out. See ya! /color red
|
||||
11:17:50 | Doug signing out. See ya! /color blue
|
||||
Number of users in chat: 1 /color blue
|
||||
Number of users in chat: 2 /color blue
|
||||
12:02:59 | Doug: Yo /color black
|
||||
12:05:27 | Ibrahim signing out. See ya! /color green
|
||||
Number of users in chat: 2 /color blue
|
||||
12:07:31 | Ibrahi: hello /color blue
|
||||
12:07:51 | Ibrahi: how are you, Doug? /color blue
|
||||
12:03:40 | Doug: Doing well thanks /color black
|
||||
12:09:09 | Doug: Hello there /color black
|
||||
12:09:57 | Doug: Hello /color purple
|
||||
12:09:08 | Ibrahi: What's up fellaz /color blue
|
||||
12:13:57 | Ibrahi: hello /color blue
|
||||
12:16:04 | Ibrahi: hello dou /color red
|
||||
12:11:44 | Doug: say whatever we want /color purple
|
||||
12:18:14 | Doug: now im eco friendly /color green
|
||||
12:18:48 | Doug: /listusers /color green
|
||||
12:16:42 | Ibrahi signing out. See ya! /color red
|
||||
Number of users in chat: 1 /color blue
|
||||
Number of users in chat: 2 /color blue
|
||||
12:20:18 | Jill: Doesnt matter /color Blue
|
||||
12:20:28 | Jill: Does this woirk /color magenta
|
||||
12:21:26 | Jill: /list user /color magenta
|
||||
Number of users in chat: 2 /color blue
|
||||
12:22:01 | Mongol: hello /color green
|
||||
Number of users in chat: 3 /color blue
|
||||
12:24:20 | Bob: hello /color cyan
|
||||
12:21:57 | Jill: Nothing /color raddish
|
||||
12:24:32 | Jill: no way /color gold
|
||||
12:24:46 | Jill: does this work? /color silver
|
||||
12:24:57 | Jill: waht /color bronze
|
||||
12:25:18 | Jill: maybe? /color terquoise
|
||||
12:25:33 | Jill: this one cant work /color peach
|
||||
12:25:48 | Jill: yeah /color violet
|
||||
12:26:15 | Jill: hep /color purple
|
||||
12:26:25 | Jill: what /color indego
|
||||
12:26:53 | Jill: so like this /color indigo
|
||||
12:22:06 | Mongol: i'm rolling /color gold
|
||||
12:27:07 | Jill: orange /color orange
|
||||
12:27:32 | Jill: type stuff /color orange
|
||||
12:32:13 | Jill: now its red /color red
|
||||
12:34:14 | Jill: What /color red
|
||||
12:35:35 | Jill: something /color red
|
||||
12:36:21 | Jill: anything else /color red
|
||||
12:36:26 | Jill: now its blue /color blue
|
||||
12:27:27 | Mongol: hello world /color gold
|
||||
12:41:47 | Mongol: hello /color green
|
||||
12:37:19 | Jill: anything in here /color blue
|
||||
12:43:22 | Jill: i can do that /color silver
|
||||
12:27:58 | Bob signing out. See ya! /color cyan
|
||||
Number of users in chat: 3 /color blue
|
||||
12:44:10 | Julian: hohoho /color red
|
||||
12:43:36 | Jill: something /color black
|
||||
12:44:50 | Jill: say something else /color pink
|
||||
12:45:21 | Jill: works better /color purple
|
||||
12:45:55 | Jill signing out. See ya! /color purple
|
||||
12:42:05 | Mongol signing out. See ya! /color green
|
||||
12:44:19 | Julian signing out. See ya! /color red
|
28
Hermes/logs/error_server.txt
Normal file
28
Hermes/logs/error_server.txt
Normal file
@ -0,0 +1,28 @@
|
||||
Starting up the listener.
|
||||
Listener successfully started.
|
||||
Server process started.
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Goodbye, shutting down all services
|
||||
Starting up the listener.
|
||||
Listener successfully started.
|
||||
Server process started.
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Goodbye, shutting down all services
|
||||
Starting up the listener.
|
||||
Listener successfully started.
|
||||
Server process started.
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Connection closed. EOF received
|
||||
Goodbye, shutting down all services
|
@ -1,6 +1,6 @@
|
||||
#lang racket
|
||||
|
||||
(provide displayln-safe)
|
||||
(provide displayln-safe pad-date)
|
||||
;; Several threads may want to print to stdout, so lets make things civil
|
||||
; constant always available
|
||||
(define stdout (make-semaphore 1))
|
||||
@ -22,3 +22,8 @@
|
||||
(displayln a-string)
|
||||
(semaphore-post stdout)])))
|
||||
|
||||
; adds padding to dates
|
||||
(define (pad-date date-element)
|
||||
(if (> (string-length date-element) 1)
|
||||
date-element
|
||||
(string-append "0" date-element)))
|
||||
|
@ -1,11 +1,15 @@
|
||||
#lang racket
|
||||
; Author: Ibrahim Mkusa
|
||||
; About: code that powers Hermes server
|
||||
|
||||
(require "modules/general.rkt")
|
||||
|
||||
(require "modules/general.rkt") ;; common function(s)
|
||||
(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.")
|
||||
;; server messages in blue
|
||||
(define welcome-message "Welcome to Hermes coms. Type your message below /color blue ")
|
||||
(define successful-connection-m "Successfully connected to a client. Sending client a welcome message. /color blue ")
|
||||
|
||||
(define sleep-t 0.1)
|
||||
|
||||
@ -53,11 +57,12 @@
|
||||
[(eq? m 'remove-ports) remove-ports]
|
||||
[(eq? m 'add) add]))
|
||||
dispatch)
|
||||
; "instantiate" to track the connections
|
||||
(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
|
||||
; Track received messages in a closure. Initialy messages is '()
|
||||
(define (make-messages messages)
|
||||
(define (add message)
|
||||
(set! messages (append messages (list message)))
|
||||
@ -72,6 +77,7 @@
|
||||
[(eq? m 'mes-list) mes-list]
|
||||
[(eq? m 'remove-top) remove-top]))
|
||||
dispatch)
|
||||
; "instantiate" a make-message variable to track our messages
|
||||
(define c-messages (make-messages '()))
|
||||
; semaphore to control access to c-messages
|
||||
(define messages-s (make-semaphore 1)) ;; control access to messages
|
||||
@ -81,9 +87,12 @@
|
||||
(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
|
||||
|
||||
; Main server code wrapped in a function
|
||||
(define (serve port-no)
|
||||
; custodian manages resources put under its domain
|
||||
(define main-cust (make-custodian))
|
||||
; "parameterize" puts resources under the domain of created custodian
|
||||
(parameterize ([current-custodian main-cust])
|
||||
(define listener (tcp-listen port-no 5 #t))
|
||||
(define (loop)
|
||||
@ -94,7 +103,7 @@
|
||||
(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")
|
||||
(displayln-safe "Broadcast thread started!")
|
||||
(let loopb []
|
||||
(sleep sleep-t) ;; wait 0.5 secs before beginning to broadcast
|
||||
(broadcast)
|
||||
@ -114,8 +123,7 @@
|
||||
(parameterize ([current-custodian cust])
|
||||
(define-values (in out) (tcp-accept listener))
|
||||
|
||||
;TODO retrive user name for client here
|
||||
; do some error checking
|
||||
; TODO do some error checking
|
||||
(define username-evt (sync (read-line-evt in 'linefeed)))
|
||||
|
||||
|
||||
@ -129,7 +137,8 @@
|
||||
(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)))))
|
||||
(number->string ((c-count 'current-count)))
|
||||
" /color blue"))
|
||||
(displayln print-no-users out)
|
||||
(displayln-safe print-no-users convs-out-s convs-out)
|
||||
(flush-output out)
|
||||
@ -148,7 +157,7 @@
|
||||
(displayln-safe (string-append
|
||||
"Started a thread to kill hanging "
|
||||
"connecting threads"))
|
||||
(sleep 1360)
|
||||
(sleep 7200) ; kills clients threads after a while could refresh this on new message
|
||||
(custodian-shutdown-all cust)))))
|
||||
|
||||
; whisper selector for the username and message
|
||||
@ -182,32 +191,38 @@
|
||||
(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
|
||||
; this might be null
|
||||
(define that-user-ports
|
||||
(first (filter
|
||||
(filter
|
||||
(lambda (ports)
|
||||
(if (string=? (whisper-to whisper) (get-username ports))
|
||||
#t
|
||||
#f))
|
||||
((c-connections 'cons-list)))))
|
||||
((c-connections 'cons-list))))
|
||||
; try to send that user the whisper
|
||||
(if (port-closed? (get-output-port that-user-ports))
|
||||
(if (and (null? that-user-ports)
|
||||
#t) ; #t is placeholder for further checks
|
||||
(begin
|
||||
(displayln "User is unavailable" out)
|
||||
(displayln "User is unavailable. /color blue" 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))))
|
||||
(displayln (string-append "(whisper) "
|
||||
(whisper-info whisper) (whisper-message whisper))
|
||||
(get-output-port (car that-user-ports)))
|
||||
(flush-output (get-output-port (car 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)))))
|
||||
(number->string ((c-count 'current-count)))
|
||||
" /color blue"))
|
||||
(displayln no-of-users out)
|
||||
(flush-output out)
|
||||
(semaphore-post connections-s)
|
||||
@ -216,14 +231,15 @@
|
||||
[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)
|
||||
(displayln "Here is a list of users in chat. /color blue" out)
|
||||
(map
|
||||
(lambda (ports)
|
||||
(displayln (get-username ports) out))
|
||||
(displayln (string-append (get-username ports) " /color blue") out))
|
||||
((c-connections 'cons-list)))
|
||||
(flush-output out)
|
||||
(semaphore-post connections-s)]
|
||||
[else
|
||||
; Its an ordinarly message
|
||||
; (displayln-safe evt-t0) debug purposes
|
||||
(semaphore-wait messages-s)
|
||||
; evaluate it .
|
||||
@ -239,7 +255,7 @@
|
||||
; (sleep 1)
|
||||
(loop)))))
|
||||
|
||||
; extracts output port from a list pair of input and output port
|
||||
; extracts output port from a list pair of username, input and output port
|
||||
(define (get-output-port ports)
|
||||
(caddr ports))
|
||||
|
||||
@ -258,7 +274,7 @@
|
||||
(lambda ()
|
||||
(semaphore-wait messages-s)
|
||||
(cond [(not (null? ((c-messages 'mes-list))))
|
||||
(begin (map
|
||||
(map
|
||||
(lambda (ports)
|
||||
(if (not (port-closed? (get-output-port ports)))
|
||||
(begin
|
||||
@ -267,10 +283,12 @@
|
||||
(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
|
||||
;; remove top message from "queue" after broadcasting
|
||||
((c-messages 'remove-top))
|
||||
(displayln "Message broadcasted"))])
|
||||
; debugging displayln below
|
||||
; (displayln "Message broadcasted")
|
||||
]) ; end of cond
|
||||
(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)
|
||||
(displayln-safe "Server process started." error-out-s error-out)
|
||||
|
226
IBRAHIM_MKUSA.md
Normal file
226
IBRAHIM_MKUSA.md
Normal file
@ -0,0 +1,226 @@
|
||||
# Hermes - A chat server and client written in Racket
|
||||
|
||||
## Ibrahim Mkusa
|
||||
### April 30, 2017
|
||||
|
||||
# Overview
|
||||
Hermes is a chat server and client written in Racket. One can run the Hermes
|
||||
server on any machine that is internet accessible. The Hermes clients then
|
||||
connect to the server from anywhere on the internet. It's inspired by chat
|
||||
systems and clients like irc.
|
||||
|
||||
The goal in building Hermes was to expose myself to several concepts integral to
|
||||
systems like networking, synchronization, and multitasking.
|
||||
|
||||
|
||||
# Libraries Used
|
||||
Most libraries and utilities used are part of base Drracket installation and
|
||||
therefore do not need to be imported.
|
||||
|
||||
The date and time modules were used for various time related queries.
|
||||
The tcp module was used for communication via Transmission Control Protocol.
|
||||
Concurrency and synchronization modules that provide threads, and semaphores
|
||||
were also used.
|
||||
|
||||
Below are libraries that were not part of base system:
|
||||
|
||||
```
|
||||
(require racket/gui/base)
|
||||
(require math/base)
|
||||
```
|
||||
|
||||
* The ```racket/gui/base``` library used to build graphical user interface.
|
||||
* The ```math/base``` library was used for testing purposes. It was used to
|
||||
generated random numbers.
|
||||
|
||||
# Key Code Excerpts
|
||||
|
||||
Here is a discussion of the most essential procedures, including a description of how they embody ideas from
|
||||
UMass Lowell's COMP.3010 Organization of Programming languages course.
|
||||
|
||||
Five examples are shown and they are individually numbered.
|
||||
|
||||
## 1. Tracking client connections using an object and closures.
|
||||
|
||||
The following code defines and creates a global object, ```make-connections```
|
||||
that abstracts client connections. It also creates a semaphore to control access
|
||||
to ```make-connections``` object.
|
||||
|
||||
```
|
||||
(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 '()))
|
||||
|
||||
(define connections-s (make-semaphore 1)) ;; control access to connections
|
||||
```
|
||||
|
||||
When the tcp-listener accepts a connection from a client, the associated input
|
||||
output ports along with username are added as an entry in ```make-connections``` via ```add``` function.
|
||||
External functions can operate on the connections by securing the semaphore,
|
||||
and then calling ```cons-list``` to expose the underlying list of connections.
|
||||
```remove-ports``` method is also available to remove input output ports from
|
||||
managed connections.
|
||||
|
||||
|
||||
|
||||
|
||||
## 2. Tracking received messages via objects and closures.
|
||||
|
||||
The code below manages broadcast messages from one client to the rest. It wraps
|
||||
a list of strings inside an object that has functions similar to ```make-connections``` for
|
||||
exposing and manipulating the list from external functions. The code creates
|
||||
```make-messages``` global object and a semaphore to control access to it from
|
||||
various threads of execution.
|
||||
|
||||
```
|
||||
(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 '()))
|
||||
|
||||
(define messages-s (make-semaphore 1)) ;; control access to messages
|
||||
```
|
||||
|
||||
## 3. Using map to broadcast messages from client to clients
|
||||
|
||||
The ```broadcast``` function is called repeatedly in a loop to extract a message
|
||||
from ```make-messages``` object, and send it to every other client. It uses the
|
||||
```make-connections``` objects to extract output port of a client. The ```map```
|
||||
routine is called on every client in the connections object to send it
|
||||
a message.
|
||||
|
||||
```
|
||||
(define broadcast
|
||||
(lambda ()
|
||||
(semaphore-wait messages-s)
|
||||
(cond [(not (null? ((c-messages 'mes-list))))
|
||||
(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 from "queue" after broadcasting
|
||||
((c-messages 'remove-top))
|
||||
; debugging displayln below
|
||||
; (displayln "Message broadcasted")
|
||||
]) ; end of cond
|
||||
(semaphore-post messages-s)))
|
||||
```
|
||||
After the message is send, the message is removed from the "queue" via the
|
||||
```remove-top```.
|
||||
|
||||
The code snippet below creates a thread that iteratively calls ```broadcast```
|
||||
every interval, where interval(in secs) is defined by ```sleep-t```.
|
||||
|
||||
```sleep``` is very important for making Hermes behave gracefully
|
||||
in a system. Without it, it would be called at the rate derived from cpu clock
|
||||
rate. This raises cpu temperatures substantially, and make cause a pre-mature
|
||||
system shutdown.
|
||||
|
||||
```
|
||||
(thread (lambda ()
|
||||
(displayln-safe "Broadcast thread started!")
|
||||
(let loopb []
|
||||
(sleep sleep-t) ;; wait 0.2 ~ 0.5 secs before beginning to broadcast
|
||||
(broadcast)
|
||||
(loopb))))
|
||||
```
|
||||
|
||||
## 4. Filtering a List of connections to find recipient of a whisper
|
||||
|
||||
I implemented a whisper functionality, where a user can whisper to any user in
|
||||
the chat room. The whisper message is only sent to specified user. To implement
|
||||
this i used ```filter``` over the connections, where the predicate tested whether the
|
||||
current list item matched that of a specific user.
|
||||
|
||||
```
|
||||
(define whisper (regexp-match #px"(.*)/whisper\\s+(\\w+)\\s+(.*)" evt-t0))
|
||||
|
||||
[whisper
|
||||
(semaphore-wait connections-s)
|
||||
; get output port for user
|
||||
; this might be null
|
||||
(define that-user-ports
|
||||
(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 (and (null? that-user-ports)
|
||||
#t) ; #t is placeholder for further checks
|
||||
(begin
|
||||
(displayln "User is unavailable. /color blue" out)
|
||||
(flush-output out))
|
||||
(begin
|
||||
(displayln (string-append "(whisper) "
|
||||
(whisper-info whisper) (whisper-message whisper))
|
||||
(get-output-port (car that-user-ports)))
|
||||
(flush-output (get-output-port (car that-user-ports)))))
|
||||
(semaphore-post connections-s)]
|
||||
```
|
||||
|
||||
The snippet above is part of cond statement that tests contents of input from
|
||||
clients to determine what the client is trying wants/trying to do. The top-line
|
||||
is using regexes to determine whether the received message is a whisper or not.
|
||||
|
||||
|
||||
|
||||
## 5. Selectors for dealing with content of a whisper from clients
|
||||
|
||||
Below are are three selectors that help abstract the contents of a whisper
|
||||
message.
|
||||
|
||||
```
|
||||
(define (whisper-info exp)
|
||||
(cadr exp))
|
||||
|
||||
(define (whisper-to exp)
|
||||
(caddr exp))
|
||||
|
||||
(define (whisper-message exp)
|
||||
(cadddr exp))
|
||||
```
|
||||
|
||||
```whisper-info``` retrieves the date-time and username info.
|
||||
```whisper-to``` retrieves the username of the intented recipient of a whisper.
|
||||
```whisper-message``` retrieves the actual whisper.
|
86
README.md
86
README.md
@ -1,59 +1,67 @@
|
||||
# Hermes
|
||||
|
||||
![example](https://github.com/oplS17projects/Hermes/blob/master/ext/Test_Figure.png)
|
||||
|
||||
|
||||
### Statement
|
||||
Hermes is a multi-client chat program akin to IRC written in Racket. Building
|
||||
Hermes is interesting as it exposes us to various design problems namely networking,
|
||||
synchronization, scheduling, and GUI design.
|
||||
Hermes was interesting as it exposed us to various design problems namely networking,
|
||||
synchronization, scheduling, GUI design, and component design.
|
||||
|
||||
### Analysis
|
||||
> Will you use data abstraction? How?
|
||||
|
||||
TCP communication will be abstracted away, so that we deal with Hermes
|
||||
TCP communication has been abstracted away, so that we deal with Hermes
|
||||
definition of a message.
|
||||
We will try to encrypt the messages passed around. The encryption will be
|
||||
abstracted away, so we only have to think about it once during implementation.
|
||||
|
||||
> Will you use recursion? How?
|
||||
|
||||
The server will continually loop waiting for connections from clients.
|
||||
The GUI will continually loop to handle input from the user, and to and fro
|
||||
the server.
|
||||
The server continually loops waiting for connections from clients. The clients
|
||||
are always on standby to receive input.
|
||||
The GUI continually loops to handle input from the user,
|
||||
as well as to keep the canvas it writes the messages on updated.
|
||||
|
||||
> Will you use map/filter/reduce? How?
|
||||
|
||||
Map will be used for dealing with input area of clients, and iterating over a list
|
||||
of open ports to send messages.
|
||||
Map was used for dealing with input area of clients, and iterating over a list
|
||||
of open ports to send messages. Filter was used to find the recipient of
|
||||
a whisper.
|
||||
|
||||
> Will you use object-orientation? How?
|
||||
|
||||
Keeping count of the number of clients will require an object of some sort.
|
||||
With procedures to increment and decrement the number of users.
|
||||
Keeping count of the number of clients required working with objects that are able to
|
||||
increment and decrement the number of users. We handled a list of connection
|
||||
ports, messages similarly.
|
||||
We also keep the GUI in an object so the many moving parts of the
|
||||
user interface are packaged in one place.
|
||||
|
||||
> Will you use functional approaches to processing your data? How?
|
||||
|
||||
The communication part of Hermes is over tcp which uses a lot of functional
|
||||
approaches e.g. you start a listener which you can call tcp-accept on.
|
||||
The result of tcp accept are two pairs of ports which we can then bind to some
|
||||
variables.
|
||||
variables. Functional approaches are exemplied in most of the code base.
|
||||
|
||||
> Will you use state-modification approaches? How? (If so, this should be encapsulated within objects. `set!` pretty much should only exist inside an object.)
|
||||
|
||||
State-modification will be used e.g. keeping count of logged in users requires
|
||||
state modification via set! to maintain the true user account.
|
||||
State-modification was used e.g. keeping count of logged in users requires
|
||||
state modification via set! to maintain the true user account, managing the list
|
||||
of open connections and messages required state-modification.
|
||||
The user interface also needs a few states that it needs to keep up to date.
|
||||
|
||||
> Will you build an expression evaluator, like we did in the symbolic differentatior and the metacircular evaluator?
|
||||
|
||||
Users will type their input into a text field from the GUI. We will retrieve
|
||||
the command and evaluate it to see if its a message, or a command to change
|
||||
GUI state. We will do something that resembles the metacircular evaluator.
|
||||
|
||||
We allowed the use of a few commands through the user interface. The most notable ones
|
||||
are the /whisper to send private messages to a user, /list count and /list users
|
||||
to view user statistics , and the /color command to allow
|
||||
the user to change the color of their text.
|
||||
|
||||
### Deliverable and Demonstration
|
||||
There are two big deliverables for this project. Code for the server
|
||||
, and the clients which not only has code for interacting with Hermes,
|
||||
but also a GUI for interactivity with a user.
|
||||
|
||||
We plan to demonstrate Hermes by running the server code on a remote machine.
|
||||
We are going to demonstrate Hermes by running the server code on a remote machine.
|
||||
We will connect to the server via our PCs running client code. We will ssh into
|
||||
the remote machine to see the server running. Since Hermes is a multichat anyone
|
||||
can join in the demonstration by connecting their computers to the remote
|
||||
@ -62,29 +70,24 @@ machine!
|
||||
|
||||
|
||||
### Evaluation of Results
|
||||
Evaluating Hermes is very simple. Can at least two clients hold a meaningful
|
||||
Evaluating Hermes was very simple. Can at least two clients hold a meaningful
|
||||
conversation remotely? If Client A speaks at 11:01 am, and client B does so at
|
||||
11:01 plus a few seconds, Hermes has to convey this state correctly. Is the GUI
|
||||
intuitive for current irc users? When we can successfully answer this questions
|
||||
satisfactorily we would have met our goals.
|
||||
intuitive for current irc users? We successfully met these questions, and more.
|
||||
|
||||
|
||||
## Architecture Diagram
|
||||
|
||||
#### Preliminary design
|
||||
#### Completed design
|
||||
![Architecture](https://github.com/oplS17projects/Hermes/blob/master/ext/arch_diagram.png)
|
||||
|
||||
|
||||
#### The Game plan
|
||||
![Diagram](https://github.com/oplS17projects/Hermes/blob/master/ext/architecture_diagram.png)
|
||||
|
||||
|
||||
## Schedule
|
||||
The first step in our project will be to setup a system to get data from one machine to another. What data exactly isn't directly important and the other machine doesn't really need to display it in a pretty manner, it just needs to relay that it has recieved the correct information.
|
||||
The first step in our project was to setup a system to get data from one machine to another. What data exactly wasn't directly important and the other machine didn't really need to display it in a pretty manner, it just needed to relay that it has recieved the correct information.
|
||||
|
||||
Next we need to create a user interface that looks nice. Some way to control the connection and display information in a convient and readable format.
|
||||
Next we needed to create a user interface that looked nice. Some way to control the connection and display information in a convient and readable format.
|
||||
|
||||
After we have finished the user interface and connecting the machines, we will need to merge them together and begin expanding the utility if time permits.
|
||||
After we finished the user interface and connecting the machines, we needed to merge them together and begin expanding the utility if time permits.
|
||||
|
||||
### First Milestone (Sun Apr 9)
|
||||
Get two different machines to relay information meaningfully.
|
||||
@ -92,21 +95,20 @@ Get two different machines to relay information meaningfully.
|
||||
### Second Milestone (Sun Apr 16)
|
||||
Get a GUI that looks professional and uses the correct format.
|
||||
|
||||
### Public Presentation (Mon Apr 24, Wed Apr 26, or Fri Apr 28 [your date to be determined later])
|
||||
### Public Presentation (Mon Apr 24)
|
||||
Merging the GUI and information relay together into one program. If time permits we also plan on adding additional features.
|
||||
|
||||
## Group Responsibilities
|
||||
|
||||
### Douglas Richardson @Doug-Richardson
|
||||
Will write the GUI code. This should allow the user to access different
|
||||
aspects of our program in a clean easy to use interface. Most of
|
||||
how the program responds to user input will be filtered through the gui.
|
||||
If time permits I will also be writing code to encrypt and decrypt the information
|
||||
going from the server to the clients.
|
||||
I have written the code for the GUI.
|
||||
It presents the user with a simple readable format for displaying the information
|
||||
that the server provides. For the most part the program only interacts with the user
|
||||
through the GUI.
|
||||
|
||||
### Ibrahim Mkusa @iskm
|
||||
Will write the networking code i.e. code that allows communication between
|
||||
clients through server. I will also write scheduling code responsible for queueing
|
||||
fairly and orderly the client messages and broadcasting to the rest of connected
|
||||
clients. If time permits, i will also be responsible for authenticating users
|
||||
via a backend database.
|
||||
I wrote the networking code i.e. code that allows communication between
|
||||
clients through server. I wrote scheduling code responsible for queueing
|
||||
fairly the client messages and broadcasting to the rest of connected
|
||||
clients. I also implemented the logic for handling /list, /whisper commands,
|
||||
dialogs for gui code and related utilities.
|
||||
|
BIN
ext/Test_Figure.jpg
Normal file
BIN
ext/Test_Figure.jpg
Normal file
Binary file not shown.
After Width: | Height: | Size: 53 KiB |
BIN
ext/Test_Figure.png
Normal file
BIN
ext/Test_Figure.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 38 KiB |
Binary file not shown.
Before Width: | Height: | Size: 23 KiB After Width: | Height: | Size: 16 KiB |
Loading…
Reference in New Issue
Block a user