Compare commits

..

50 Commits

Author SHA1 Message Date
Fred Martin
f64a33f6eb fixed code formatting 2017-05-06 15:14:09 -04:00
42bef853a5 updates to README.md and test figure 2017-05-01 15:34:09 -04:00
9dfff4db45 updated README.md 2017-05-01 00:17:55 -04:00
a252bf5b3e final report draft 1 for iskm 2017-04-30 23:52:39 -04:00
3c511cd625 Start work on final report. Using Prof. Martin's template. 2017-04-30 16:21:38 -04:00
Doug-Richardson
5c89715942 Created report
I didn't forget this time
2017-04-28 09:35:22 -04:00
3cfff385f1 Merge branch 'master' of github.com:oplS17projects/Hermes
* 'master' of github.com:oplS17projects/Hermes:
  minor configs for demo
2017-04-24 14:08:38 -04:00
65bd9fae3d Added server logs from todays demos. 2017-04-24 14:07:36 -04:00
fe0bfe15dc minor configs for demo 2017-04-24 11:07:36 -04:00
Doug-Richardson
26c9029401 Added example file to readme
Not sure that is where it should go but it felt appropriate. This is Hermes. Here it is. It works.
2017-04-24 10:13:53 -04:00
Doug-Richardson
85f7c217aa Added an example image
I figured it would be good to add an example image of the program in action. I definitely didn't make it during class at all.
2017-04-24 10:11:21 -04:00
b56bab8d37 Merge branch 'master' of github.com:oplS17projects/Hermes
* 'master' of github.com:oplS17projects/Hermes:
  updates to README.md(manual)
2017-04-23 18:44:56 -04:00
37e58af6c3 updates to README.md(manual) 2017-04-23 18:44:27 -04:00
bdaf3f2fe8 updates to README.md(manual) 2017-04-23 18:18:56 -04:00
2e5a7beadb updates to README.md 2017-04-23 18:06:09 -04:00
ba69f9541b updates to README.md 2017-04-23 18:03:34 -04:00
cc0dec4e68 updated architecture diagram 2017-04-23 18:00:51 -04:00
f072a77550 updates to README.md 2017-04-23 17:48:05 -04:00
bd7b3bb531 Hermes is fully functional 2017-04-23 17:30:14 -04:00
58cff4f1b8 fixed bug causing multiple GUI to show up. Now prompts for hostname and
color
2017-04-23 17:15:44 -04:00
3e84c3a5ef timestamps are properly padded 2017-04-23 16:55:34 -04:00
a8e49e9070 server colors default to blue 2017-04-23 16:34:30 -04:00
9b31f3b324 text-field and send-button display on the same line 2017-04-23 16:27:41 -04:00
1c60a61d82 whispers are properly tagged 2017-04-23 15:50:53 -04:00
28d78a8a97 Handles disconnected users gracefully when you /whisper 2017-04-23 15:43:32 -04:00
e68c65c36a on launch focus goes to text-field 2017-04-23 15:19:51 -04:00
d65c4c634c clients now display received messages in the color of their origin 2017-04-23 15:09:18 -04:00
f4060606f0 updates to Hermes/Hermes/README.md 2017-04-23 13:56:08 -04:00
iskm
79495be7e5 Merge pull request #7 from oplS17projects/mango
updates to README.md (manual) to reflect command change quit -> /quit
2017-04-23 13:40:06 -04:00
18a9949ce6 updates to README.md (manual) to reflect change quit -> /quit 2017-04-23 13:33:47 -04:00
iskm
4f2353c2f1 Merge pull request #6 from oplS17projects/mango
Mango - Hermes core is ready
2017-04-23 13:30:45 -04:00
6aa488216e preliminary work on a short-manual for using Hermes 2017-04-23 13:28:12 -04:00
c80ebe3c16 Hermes is ready. Did some polishing and updated TODOs. 2017-04-23 13:24:34 -04:00
iskm
044e36ff5d Merge pull request #5 from oplS17projects/mango
Mango
2017-04-23 12:57:02 -04:00
6890e2be72 bug fix: improved responsiveness of GUI 2017-04-23 12:54:34 -04:00
c6dd0311d4 GUI no longer burns through CPU cycles. 2017-04-23 12:48:54 -04:00
c78c2fb872 Validate that username is at most 10 characters. Added Padding for username. 2017-04-23 11:43:52 -04:00
6bac96cfdb Now accepts "/quit" to quit instead of "quit" 2017-04-23 11:27:38 -04:00
183fad9de3 Now prompts for user name via the GUI 2017-04-23 11:15:58 -04:00
44a02c7025 updated TODO's 2017-04-23 04:21:36 -04:00
6b85be6490 bug fix: no longer attaches username to every received message. 2017-04-23 04:04:45 -04:00
ed5d1d7571 Basic input and output now can be done through gui 2017-04-23 03:50:12 -04:00
a1798d9e3d messages from other clients now display on the GUI 2017-04-23 02:52:39 -04:00
29c6708e13 renamed Hermes_Gui1.3.rkt to GUI.rkt for readability 2017-04-23 01:39:06 -04:00
63a3757f67 beginning merge process 2017-04-23 01:36:46 -04:00
4c508fec11 Merge branch 'master' of github.com:oplS17projects/Hermes into mango
* 'master' of github.com:oplS17projects/Hermes:
  Modified the readme
2017-04-23 01:28:37 -04:00
a9f7121695 removed unnecessary begin statements. Added more documentation to gui code. 2017-04-23 00:51:25 -04:00
Doug-Richardson
0ea83b808a Modified the readme
Mostly just updating the language.
2017-04-22 19:50:14 -04:00
ce93a60d0e removed unnecessary begin statements 2017-04-21 18:14:16 -04:00
42eceeb36f Formatting edits to code to enhance readibility for coming merge 2017-04-20 15:29:06 -04:00
16 changed files with 1056 additions and 374 deletions

3
.gitignore vendored
View File

@ -9,6 +9,3 @@
# ignore racket compile files
*.dep
*.zo
#ignore backup files
*.bak

149
Douglas_Richardson.md Normal file
View 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
View 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))

View File

@ -1,233 +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
(displayln "Makin...");;eat this note
;;Create the frame
(define main-frame (new frame%
[label "Hermes"]
[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
(define given-input (send input get-value))
(if (string? given-input)
(if (color-change-request? given-input)
(set! my-color (get-color-from-input given-input))
(if (quit-request? given-input)
(write "quit" the-output-port)
(if (< 0 (string-length-safe given-input))
(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)
(define (helper str index)
(if (string? string)
(if (>= (+ start index) (string-length-safe string))
(display string);;Something went wrong
(if (eq? (string-ref str (+ start index)) #\~)
(substring-s str start (+ start index))
(helper str (+ index 1))))
'()))
(helper string start))
(define (user-message onetrueinput)
(display "Godit!");;eat this note
(displayln onetrueinput);;eat this note
(if (not (string=? onetrueinput ""))
(let();;This is kind of stupid but whatever it works.
(define username (user-message-parse onetrueinput 0))
(define user-input (user-message-parse onetrueinput (+ 1(string-length-safe username))))
(define color (substring-s onetrueinput (+ 2 (string-length-safe username) (string-length-safe user-input)) (string-length-safe onetrueinput)))
(send dc set-text-foreground color)
(send dc draw-text (string-append username ":" user-input) 0 height)
(set! listy (appendlist listy (list username user-input color height)))
(set! height (+ height 15))
(set! min-v-size (+ min-v-size 15))
(if (> (* 20 (string-length-safe user-input)) min-h-size)
(set! min-h-size (* 20 (string-length-safe user-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
(define the-output-port (open-output-string))
;;This probably won't change...
(define (send-message input color)
(write (string-append name "~" input "~" color) the-output-port))
;;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
(displayln "Fixy!");eat this note
(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 'close)(send main-frame show #f))
((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)
((eq? command 'get-output-port) the-output-port)
;;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)))))
(define (get-color-from-input input)
(substring-s input 6 (string-length-safe input)))
;this one is a crap version of justpressing the enter key
(define (color-change-request? given-string)
(if (> (string-length-safe given-string) 7)
(if (equal? (substring-s given-string 0 6) "/color")
#t
#f)
#f))
(define (quit-request? given-string)
(if (>= (string-length-safe given-string) 5)
(if (equal? (substring-s given-string 0 5) "/quit")
#t
#f)
#f))
(define (string-length-safe string)
(if (string? string)
(string-length string)
0))
(define (substring-s string start end)
(if (<= start end)
(if (<= end (string-length-safe string))
(substring string start end)
"")
""))
;(define thing1 (make-gui))
;(define thing2 (make-gui))

34
Hermes/README.md Normal file
View 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.

View File

@ -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

View File

@ -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,13 +14,20 @@
;; 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 (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))
@ -25,24 +36,24 @@
(define error-out (open-output-file "./error_client.out" #:exists 'append))
(define error-out-s (make-semaphore 1))
(define gui (make-gui))
; 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))
((gui 'set-name) username)
(gui 'show)
;; 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)
(displayln username out)
(flush-output out)
(define a (thread
@ -60,45 +71,55 @@
(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)
(gui 'close))
(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
(define (send-messages username out)
; get current time
;(define date-today (seconds->date (current-seconds) #t))
(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))
; " | "))
(define date-print (string-append (pad-date (number->string (date-hour date-today)))
":"
(pad-date (number->string (date-minute date-today)))
":"
(pad-date (number->string (date-second date-today)))
" | "))
;; read, quits when user types in "quit"
;; TODO read from GUI instead
;(define input (read-line))
(define input (get-output-string (gui 'get-output-port)))
; TODO /quit instead of quit
(cond ((string=? input "quit")
;(displayln (string-append date-print username " signing out. See ya!") out)
;(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)
(if (not (null? input))
(if (not (equal? input ""))
((let()
(displayln input);;eat this note
(displayln 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
@ -106,18 +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
(if (not (equal? evt ""))
((gui 'recieve-message) evt)
'())]
(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 (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

View 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

View 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

View File

@ -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)))

View File

@ -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,17 +57,16 @@
[(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)
(if (string=? message "")
messages
((set! messages (append messages (list message)))
messages)))
(set! messages (append messages (list message)))
messages)
(define (mes-list)
messages)
(define (remove-top)
@ -74,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
@ -83,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)
@ -96,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)
@ -116,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)))
@ -128,10 +134,11 @@
(semaphore-post c-count-s)
(displayln-safe successful-connection-m)
;(displayln welcome-message out)
(displayln welcome-message out)
;; print to server log and client
(define print-no-users (string-append "Server~Number of users in chat: "
(number->string ((c-count 'current-count))) "~Red"))
(define print-no-users (string-append "Number of users in chat: "
(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)
@ -150,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
@ -184,33 +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 "Server~User is unavailable~red" 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 "Server~Number of users in chat: "
(define no-of-users (string-append "Number of users in chat: "
(number->string ((c-count 'current-count)))
"~red"))
" /color blue"))
(displayln no-of-users out)
(flush-output out)
(semaphore-post connections-s)
@ -219,17 +231,15 @@
[list-users
(semaphore-wait connections-s)
; map over connections sending the username to the client
(displayln "Server~Here is a list of users in chat.~red" out)
(displayln "Here is a list of users in chat. /color blue" out)
(map
(lambda (ports)
(displayln (string-append
"Server~"
(get-username ports)
"~red")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 .
@ -245,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))
@ -264,22 +274,21 @@
(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
(displayln (first ((c-messages 'mes-list)))
(get-output-port ports))
(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
(displayln (null? ((c-messages 'mes-list))));;eat this note
(displayln ((c-messages 'mes-list)));;eat this note
;; 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
View 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.

View File

@ -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

Binary file not shown.

After

Width:  |  Height:  |  Size: 53 KiB

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