diff options
| -rw-r--r-- | .gitignore | 11 | ||||
| -rw-r--r-- | Hermes/Hermes_Gui1.3.rkt | 196 | ||||
| -rw-r--r-- | Hermes/Makefile | 3 | ||||
| -rw-r--r-- | Hermes/TODO | 17 | ||||
| -rw-r--r-- | Hermes/client.rkt | 108 | ||||
| -rw-r--r-- | Hermes/modules/general.rkt | 24 | ||||
| -rw-r--r-- | Hermes/server.rkt | 276 | ||||
| -rw-r--r-- | README.md | 4 | ||||
| -rw-r--r-- | docs/FP4-instructions.md (renamed from FP4-instructions.md) | 0 | ||||
| -rw-r--r-- | ext/arch_diagram.png (renamed from arch_diagram.png) | bin | 23853 -> 23853 bytes | |||
| -rw-r--r-- | ext/architecture_diagram.png (renamed from architecture_diagram.png) | bin | 65212 -> 65212 bytes | |||
| -rw-r--r-- | tests/gui/Gui_Exploration.rkt (renamed from Gui_Exploration.rkt) | 0 | ||||
| -rw-r--r-- | tests/gui/concurrentreadandprint.rkt | 75 | ||||
| -rw-r--r-- | tests/gui/windows.rkt (renamed from feasibility_analysis/gui/windows.rkt) | 0 | ||||
| -rw-r--r-- | tests/gui/windows2.rkt (renamed from feasibility_analysis/gui/windows2.rkt) | 0 | ||||
| -rw-r--r-- | tests/tcpevents/README.md (renamed from feasibility_analysis/tcpevents/README.md) | 0 | ||||
| -rw-r--r-- | tests/tcpevents/crpovertcp.rkt | 155 | ||||
| -rw-r--r-- | tests/tcpevents/server.rkt (renamed from feasibility_analysis/tcpevents/server.rkt) | 0 | ||||
| -rw-r--r-- | tests/tcpvanilla/README.md (renamed from feasibility_analysis/tcpvanilla/README.md) | 0 | ||||
| -rw-r--r-- | tests/tcpvanilla/client.rkt (renamed from feasibility_analysis/tcpvanilla/client.rkt) | 0 | ||||
| -rw-r--r-- | tests/tcpvanilla/client2.rkt (renamed from feasibility_analysis/tcpvanilla/client2.rkt) | 0 | ||||
| -rw-r--r-- | tests/tcpvanilla/server.rkt (renamed from feasibility_analysis/tcpvanilla/server.rkt) | 0 | ||||
| -rw-r--r-- | tests/tcpvanilla/tcpcommunication.rkt | 60 | ||||
| -rw-r--r-- | tests/tcpvanilla/tcptalk.rkt (renamed from feasibility_analysis/tcpvanilla/tcptalk.rkt) | 0 |
24 files changed, 927 insertions, 2 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b917769 --- /dev/null +++ b/.gitignore @@ -0,0 +1,11 @@ +# ignore temporary files +*~ +*.txt + +# ignore logs and configuration files +*.out +*.conf + +# ignore racket compile files +*.dep +*.zo diff --git a/Hermes/Hermes_Gui1.3.rkt b/Hermes/Hermes_Gui1.3.rkt new file mode 100644 index 0000000..ba239c3 --- /dev/null +++ b/Hermes/Hermes_Gui1.3.rkt @@ -0,0 +1,196 @@ +#lang racket +(require racket/gui/base) +;Author:Douglas Richardson +;Notes:Our GUI mostly deals with lists of a list of 3 strings and a number +;although the number is always delt with locally +;When using user-message you need to give it a list of 3 things +;The name of the user as a string, what they said as a string, +;and the color as a string + +;Object stuff + +(provide make-gui) + +(define (make-gui) + (begin + ;;Create the frame + (define main-frame (new frame% + [label "Example5"] + [width 500] + [height 700] + )) + ;;Editing canvas + (define (do-stuff-paint paint-canvas paint-dc) + (do-more-stuff-paint listy paint-canvas paint-dc)) + + (define (do-more-stuff-paint paint-listy paint-canvas paint-dc) + (if (null? paint-listy) + '() + (begin + (re-draw-message (get-username-from-list (car paint-listy)) + (get-message-from-list (car paint-listy)) + (get-color-from-list (car paint-listy)) + (get-height-from-list (car paint-listy))) + (do-more-stuff-paint (cdr paint-listy) paint-canvas paint-dc)))) + + (define read-canvas (new canvas% + [parent main-frame] + [paint-callback do-stuff-paint] + [style '(hscroll vscroll)] + )) + + (send read-canvas init-auto-scrollbars #f #f 0 0);Start with no scrollbars + ;;text-field stuff + (define (text-feild-callback callback-type other-thing) + (if (equal? 'text-field-enter (send other-thing get-event-type)) + (button-do-stuff 'irrelevant 'not-used) + '())) + + (define input (new text-field% + [parent main-frame] + [label "Username:"] + [callback text-feild-callback] + )) + ;;button stuff + (define (button-do-stuff b e);b and e do nothing :/ + (begin + (if (color-change-request? (send input get-value)) + (set! my-color (get-color-from-input (send input get-value))) + (if (< 0 (string-length (send input get-value))) + (send-message (send input get-value) my-color);; + '())) + (send input set-value "") + )) + (define send-button (new button% + [parent main-frame] + [label "Send"] + [callback button-do-stuff])) + ;;I forget what these do but don't move them + (define dc (send read-canvas get-dc)) + (send dc set-scale 1 1) + (send dc set-text-foreground "black") + ;;messaging stuff + + (define (user-message-parse string start) + (begin + (define (helper str index) + (if (eq? (string-ref str (+ start index)) #\~) + (substring str start (+ start index)) + (helper str (+ index 1)))) + (helper string 0))) + + (define (user-message onetrueinput) + (begin + (define username (user-message-parse onetrueinput 0)) + (define input (user-message-parse onetrueinput (+ 1(string-length username)))) + (define color (substring onetrueinput (+ 2 (string-length username) (string-length input)))) + (send dc set-text-foreground color) + (send dc draw-text (string-append username ":" input) 0 height) + (set! listy (appendlist listy (list username input color height))) + (set! height (+ height 15)) + (set! min-v-size (+ min-v-size 15)) + (if (> (* 20 (string-length input)) min-h-size) + (set! min-h-size (* 20 (string-length input))) + '()) + (send read-canvas init-auto-scrollbars min-h-size min-v-size 0 1) + )) + ;;Add a function that parces input from a string and extracts elements + + ;;This probably won't change... + (define (send-message input color) + (user-message (string-append name "~" input "~" color))) + ;;Although re-draw is kind of misleading, it is just print the whole + ;;list of strings to the screen + (define (re-draw-message username input color in-height) + (begin + (send dc set-text-foreground color) + (send dc draw-text (string-append username ":" input) 0 in-height) + )) + + (define (update given-list) + (begin (set! listy '()) + (set! height 0) + (update-helper given-list))) + + (define (update-helper given-list) + (if (null? given-list) + '() + (if (null? (car given-list)) + '() + (begin (user-message + (get-username-from-list (car given-list)) + (get-message-from-list (car given-list)) + (get-color-from-list (car given-list))) + (update-helper (cdr given-list)))))) + + ;;Variables go below functions + (define name "Me") + (define min-h-size 80) + (define min-v-size 30) + (define listy (list (list "Server" "Connected" "Red" 0))) + (define my-color "black") + (define height 15) + ;;dispatch goes below that + (define (dispatch command) + (cond ((eq? command 'show) (send main-frame show #t)) + ((eq? command 'send) send-message) + ((eq? command 'set-name) (lambda (newname) (if (string? newname) + (set! name newname) + (print "Thats not good")))) + ((eq? command 'recieve-message) user-message) + ((eq? command 'get-list) listy) + ((eq? command 'set-list) update) + ;;Something up with that + (else (error "Invalid Request" command)) + )) + ;;dispatch goes below that + dispatch)) + + +;This one displays information + + + + +;Initilize scrolling + +;Then we need to find out if we need them or not. + +;Listy is going to be a list of lists of strings +;each element in listy will contain three strings +;the username the message they said and the color they used +;The the height the message should display at + + +(define (appendlist listoflist add-to-end) + (if (null? listoflist) + (cons add-to-end '()) + (cons (car listoflist) (appendlist (cdr listoflist) add-to-end)))) + +(define (get-username-from-list in-list) + (car in-list)) + +(define (get-message-from-list in-list) + (car (cdr in-list))) + +(define (get-color-from-list in-list) + (car (cdr (cdr in-list)))) + +(define (get-height-from-list in-list) + (car (cdr (cdr (cdr in-list))))) + + + +;this one is a crap version of justpressing the enter key +(define (color-change-request? given-string) + (if (> (string-length given-string) 7) + (if (equal? (substring given-string 0 6) "/color") + #t + #f) + #f)) + +(define (get-color-from-input given-string) + (substring given-string 7)) +;(define thing1 (make-gui)) +;(define thing2 (make-gui)) + diff --git a/Hermes/Makefile b/Hermes/Makefile new file mode 100644 index 0000000..c580a71 --- /dev/null +++ b/Hermes/Makefile @@ -0,0 +1,3 @@ +# Remove temporary files +clean: + rm -rf *~ *.out *.conf *.txt diff --git a/Hermes/TODO b/Hermes/TODO new file mode 100644 index 0000000..bbc2930 --- /dev/null +++ b/Hermes/TODO @@ -0,0 +1,17 @@ +FEATURES +5. parser in the client side should do something similar (/color, /quit) +16. plain tcp -> ssl based +17. fix breaks for improper disconnects from clients +18. Add topics after project completion +** regexes to parse strings for different formats -related to 5 +** align code better for readability + + +GOOD TO HAVE BUT NOT NECESSARY +7. maybe fiddle around with irc library (we leave this for future opl classes) no time got other classes +*14. bye message prompt for clients part of session stickiness +*15. Session stickiness for clients. Log received comms to a local file. +additionally save user details and prompt user to use defaults or create +new ones +10. authentication for databases - to avoid dependencies this is left out +** whispers aren't currently logged - its on purpose diff --git a/Hermes/client.rkt b/Hermes/client.rkt new file mode 100644 index 0000000..64710bb --- /dev/null +++ b/Hermes/client.rkt @@ -0,0 +1,108 @@ +#lang racket + +(require "modules/general.rkt" "Hermes_Gui1.3.rkt") +(require math/base) ;; for random number generation +;; TODO clean up string message output and alignment +;; TODO close ports after done +;; i.e. seconds and minutes hours specifically +;; author: Ibrahim Mkusa +;; about: print and read concurrently +;; notes: output may need to be aligned and formatted nicely + + +; we will prompt for these in the gui +(define host3 "localhost") +(define port-num 4321) +(define sleep-t 0.1) + +; we won't need this. Just me being overzealous +(define hermes-conf (open-output-file "./hermes_client.conf" #:exists'append)) +(define hermes-conf-s (make-semaphore 1)) + +(define convs-out (open-output-file "./convs_client.out" #:exists 'append)) +(define convs-out-s (make-semaphore 1)) + +(define error-out (open-output-file "./error_client.out" #:exists 'append)) +(define error-out-s (make-semaphore 1)) + +; custodian for client connections +(define main-client-cust (make-custodian)) +; make connection to server +(define (client port-no) + (parameterize ([current-custodian main-client-cust]) + ;; connect to server at port 8080 + (define-values (in out) (tcp-connect host3 port-no)) ;; define values + ;; binds to multiple values akin to unpacking tuples in python + + ; store username to a file for later retrieval along with relevent + ; info used for authentication with server + (displayln "What's your name?") + (define username (read-line)) + + ;send the username to the server (username in out) + (displayln username out) + (flush-output out) + + (define a (thread + (lambda () + (displayln-safe "Starting receiver thread." error-out-s error-out) + (let loop [] + (receive-messages in) + (sleep sleep-t) + (loop))))) + (define t (thread + (lambda () + (displayln-safe "Starting sender thread." error-out-s error-out) + (let loop [] + (send-messages username out) + (sleep sleep-t) + (loop))))) + (displayln-safe "Now waiting for sender thread." error-out-s error-out) + (thread-wait t) ;; returns prompt back to drracket + (displayln-safe "Closing client ports." error-out-s error-out) + (close-input-port in) + (close-output-port out)) + (custodian-shutdown-all main-client-cust)) + + +;; sends a message to the server +(define (send-messages username out) + ; get current time + (define date-today (seconds->date (current-seconds) #t)) + ;TODO pad the second if its only 1 character + (define date-print (string-append (number->string (date-hour date-today)) + ":" + (number->string (date-minute date-today)) + ":" + (number->string (date-second date-today)) + " | ")) + ;; read, quits when user types in "quit" + (define input (read-line)) + ; TODO /quit instead of quit + (cond ((string=? input "quit") + (displayln (string-append date-print username " signing out. See ya!") out) + (flush-output out) + (close-output-port error-out) + (close-output-port convs-out) + (exit))) + + (displayln (string-append date-print username ": " input) out) + (flush-output out)) + +; receives input from server and displays it to stdout +(define (receive-messages in) + ; retrieve a message from server + (define evt (sync (read-line-evt in))) + + (cond [(eof-object? evt) + (displayln-safe "Server connection closed." error-out-s error-out) + (custodian-shutdown-all main-client-cust) + ;(exit) + ] + [(string? evt) + (displayln-safe evt convs-out-s convs-out)] ; could time stamp here or to send message + [else + (displayln-safe (string-append "Nothing received from server for 2 minutes.") convs-out-s convs-out)])) + +(displayln-safe "Starting client." error-out-s error-out) +(define stop-client (client 4321)) diff --git a/Hermes/modules/general.rkt b/Hermes/modules/general.rkt new file mode 100644 index 0000000..b33eb8a --- /dev/null +++ b/Hermes/modules/general.rkt @@ -0,0 +1,24 @@ +#lang racket + +(provide displayln-safe) +;; Several threads may want to print to stdout, so lets make things civil +; constant always available +(define stdout (make-semaphore 1)) + +; prints to stdout with an optional output port +; requires a specified semaphore for the optional output port +(define displayln-safe + (lambda (a-string [a-semaphore stdout] [a-output-port (current-output-port)]) + (cond [(not (and (eq? a-semaphore stdout) (eq? a-output-port (current-output-port)))) + (semaphore-wait a-semaphore) + (semaphore-wait stdout) + (displayln a-string a-output-port) + (flush-output a-output-port) + (displayln a-string) + (semaphore-post stdout) + (semaphore-post a-semaphore)] + [else + (semaphore-wait stdout) + (displayln a-string) + (semaphore-post stdout)]))) + diff --git a/Hermes/server.rkt b/Hermes/server.rkt new file mode 100644 index 0000000..9b1a171 --- /dev/null +++ b/Hermes/server.rkt @@ -0,0 +1,276 @@ +#lang racket + +(require "modules/general.rkt") +(require math/base) ;; for random number generation + + +(define welcome-message "Welcome to Hermes coms. Type your message below") +(define successful-connection-m "Successfully connected to a client. Sending client a welcome message.") + +(define sleep-t 0.1) + +; track number of connections with closure +(define (make-count no-count) + (define (increment) + (set! no-count (+ no-count 1)) + no-count) + (define (decrement) + (set! no-count (- no-count 1)) + no-count) + (define (current-count) + no-count) + (define (dispatch m) + (cond [(eq? m 'increment) increment] + [(eq? m 'decrement) decrement] + [(eq? m 'current-count) current-count])) + dispatch) +(define c-count (make-count 0)) +; a semaphore to control access to c-count +(define c-count-s (make-semaphore 1)) + + +; track list of input output port pairs in a list contained in a closure +(define (make-connections connections) + (define (null-cons?) + (null? connections)) + (define (add username in out) + (set! connections (append connections (list (list username in out)))) + connections) + (define (cons-list) + connections) + (define (remove-ports in out) + (set! connections + (filter + (lambda (ports) + (if (and (eq? in (get-input-port ports)) + (eq? out (get-output-port ports))) + #f + #t)) + connections))) + (define (dispatch m) + (cond [(eq? m 'null-cons) null-cons?] + [(eq? m 'cons-list) cons-list] + [(eq? m 'remove-ports) remove-ports] + [(eq? m 'add) add])) + dispatch) +(define c-connections (make-connections '())) +; a semaphore to control acess to c-connections +(define connections-s (make-semaphore 1)) ;; control access to connections + +; Track received messages in a closure +(define (make-messages messages) + (define (add message) + (set! messages (append messages (list message))) + messages) + (define (mes-list) + messages) + (define (remove-top) + (set! messages (rest messages)) + messages) + (define (dispatch m) + (cond [(eq? m 'add) add] + [(eq? m 'mes-list) mes-list] + [(eq? m 'remove-top) remove-top])) + dispatch) +(define c-messages (make-messages '())) +; semaphore to control access to c-messages +(define messages-s (make-semaphore 1)) ;; control access to messages + +; two files to store error messages, and channel conversations +(define error-out (open-output-file "./error_server.txt" #:exists 'append)) +(define convs-out (open-output-file "./conversations_server.txt" #:exists 'append)) +(define error-out-s (make-semaphore 1)) +(define convs-out-s (make-semaphore 1)) +; TODO finish logging all error related messages to +(define (serve port-no) + (define main-cust (make-custodian)) + (parameterize ([current-custodian main-cust]) + (define listener (tcp-listen port-no 5 #t)) + (define (loop) + (receive-clients listener) + (loop)) + (displayln-safe "Starting up the listener." error-out-s error-out) + (thread loop) + (displayln-safe "Listener successfully started." error-out-s error-out) + ;; Create a thread whose job is to simply call broadcast iteratively + (thread (lambda () + (displayln-safe "Broadcast thread started!\n") + (let loopb [] + (sleep sleep-t) ;; wait 0.5 secs before beginning to broadcast + (broadcast) + (loopb))))) + (lambda () + (displayln-safe "Goodbye, shutting down all services" error-out-s error-out) + (semaphore-wait error-out-s) + (semaphore-wait convs-out-s) + (close-output-port error-out) + (close-output-port convs-out) + (semaphore-post error-out-s) + (semaphore-post convs-out-s) + (custodian-shutdown-all main-cust))) + +(define (receive-clients listener) + (define cust (make-custodian)) + (parameterize ([current-custodian cust]) + (define-values (in out) (tcp-accept listener)) + + ;TODO retrive user name for client here + ; do some error checking + (define username-evt (sync (read-line-evt in 'linefeed))) + + + + ; increment number of connections + (semaphore-wait c-count-s) + ((c-count 'increment)) + (semaphore-post c-count-s) + + (displayln-safe successful-connection-m) + (displayln welcome-message out) + ;; print to server log and client + (define print-no-users (string-append "Number of users in chat: " + (number->string ((c-count 'current-count))))) + (displayln print-no-users out) + (displayln-safe print-no-users convs-out-s convs-out) + (flush-output out) + (semaphore-wait connections-s) + ; TODO add in a username so we have (username input output) + ((c-connections 'add) username-evt in out) + (semaphore-post connections-s) + + ; start a thread to deal with specific client and add descriptor value to the list of threads + (define threadcom (thread (lambda () + (chat_with_client in out)))) ; comms between server and particular client + + ;; Watcher thread: + ;; kills current thread for waiting too long for connection from + (thread (lambda () + (displayln-safe (string-append + "Started a thread to kill hanging " + "connecting threads")) + (sleep 1360) + (custodian-shutdown-all cust))))) + +; whisper selector for the username and message +(define (whisper-info exp) + (cadr exp)) + +(define (whisper-to exp) + (caddr exp)) + +(define (whisper-message exp) + (cadddr exp)) + +(define (chat_with_client in out) + ; deals with queueing incoming messages for server to broadcast to all clients + (define (something-to-say in) + (define evt-t0 (sync (read-line-evt in 'linefeed))) + (cond [(eof-object? evt-t0) + (semaphore-wait connections-s) + ((c-connections 'remove-ports) in out) + (semaphore-post connections-s) + ; TODO some form of identification for this client + (displayln-safe "Connection closed. EOF received" error-out-s error-out) + (semaphore-wait c-count-s) + ((c-count 'decrement)) + (semaphore-post c-count-s) + ;(exit) + (kill-thread (current-thread))] + [(string? evt-t0) + ; use regexes to evaluate received input from client + (define whisper (regexp-match #px"(.*)/whisper\\s+(\\w+)\\s+(.*)" evt-t0)) ; is client trying to whisper to someone + (define list-count (regexp-match #px"(.*)/list\\s+count\\s*" evt-t0)) ;; is client asking for number of logged in users + (define list-users (regexp-match #px"(.*)/list\\s+users\\s*" evt-t0)) ;; user names + ; do something whether it was a message, a whisper, request for number of users and so on + (cond [whisper + (semaphore-wait connections-s) + ; get output port for user + (define that-user-ports + (first (filter + (lambda (ports) + (if (string=? (whisper-to whisper) (get-username ports)) + #t + #f)) + ((c-connections 'cons-list))))) + ; try to send that user the whisper + (if (port-closed? (get-output-port that-user-ports)) + (begin + (displayln "User is unavailable" out) + (flush-output out)) + (begin + (displayln (string-append (whisper-info whisper) (whisper-message whisper)) + (get-output-port that-user-ports)) + (flush-output (get-output-port that-user-ports)))) + (semaphore-post connections-s)] + [list-count + ;;should put a semaphore on connections + (semaphore-wait c-count-s) + (semaphore-wait connections-s) + (define no-of-users (string-append "Number of users in chat: " + (number->string ((c-count 'current-count))))) + (displayln no-of-users out) + (flush-output out) + (semaphore-post connections-s) + (semaphore-post c-count-s) + ] + [list-users + (semaphore-wait connections-s) + ; map over connections sending the username to the client + (displayln "Here is a list of users in chat." out) + (map + (lambda (ports) + (displayln (get-username ports) out)) + ((c-connections 'cons-list))) + (flush-output out) + (semaphore-post connections-s)] + [else + ; (displayln-safe evt-t0) debug purposes + (semaphore-wait messages-s) + ; evaluate it . + ((c-messages 'add) evt-t0) + (semaphore-post messages-s)])] + [else + (displayln-safe "Timeout waiting. Nothing received from client")])) + + ; Executes methods above in another thread + (thread (lambda () + (let loop [] + (something-to-say in) + ; (sleep 1) + (loop))))) + +; extracts output port from a list pair of input and output port +(define (get-output-port ports) + (caddr ports)) + +; extracts input port +(define (get-input-port ports) + (cadr ports)) + +; extract username +(define (get-username ports) + (car ports)) + +; broadcasts received message from clients periodically +; TODO before broadcasting the message make sure the ports is still open +; no EOF if it is remove client from connections +(define broadcast + (lambda () + (semaphore-wait messages-s) + (cond [(not (null? ((c-messages 'mes-list)))) + (begin (map + (lambda (ports) + (if (not (port-closed? (get-output-port ports))) + (begin + (displayln (first ((c-messages 'mes-list))) (get-output-port ports)) + (flush-output (get-output-port ports))) + (displayln-safe "Failed to broadcast. Port not open." error-out-s error-out))) + ((c-connections 'cons-list))) + (displayln-safe (first ((c-messages 'mes-list))) convs-out-s convs-out) + ;; remove top message + ((c-messages 'remove-top)) + (displayln "Message broadcasted"))]) + (semaphore-post messages-s))) + +(define stop-server (serve 4321)) ;; start server then close with stop +(displayln-safe "Server process started\n" error-out-s error-out) @@ -72,11 +72,11 @@ satisfactorily we would have met our goals. ## Architecture Diagram #### Preliminary design - + #### The Game plan - + ## Schedule diff --git a/FP4-instructions.md b/docs/FP4-instructions.md index 6a04e91..6a04e91 100644 --- a/FP4-instructions.md +++ b/docs/FP4-instructions.md diff --git a/arch_diagram.png b/ext/arch_diagram.png Binary files differindex 6bb8803..6bb8803 100644 --- a/arch_diagram.png +++ b/ext/arch_diagram.png diff --git a/architecture_diagram.png b/ext/architecture_diagram.png Binary files differindex 1949ae0..1949ae0 100644 --- a/architecture_diagram.png +++ b/ext/architecture_diagram.png diff --git a/Gui_Exploration.rkt b/tests/gui/Gui_Exploration.rkt index ff4d2d3..ff4d2d3 100644 --- a/Gui_Exploration.rkt +++ b/tests/gui/Gui_Exploration.rkt diff --git a/tests/gui/concurrentreadandprint.rkt b/tests/gui/concurrentreadandprint.rkt new file mode 100644 index 0000000..95d02c1 --- /dev/null +++ b/tests/gui/concurrentreadandprint.rkt @@ -0,0 +1,75 @@ +#lang racket +(require math/base) ;; for random number generation + +;; a proof of concept +;; one thread waits for input +;; another displays messages in the background + + +;; create custodian for managing all resources +;; so we can shutdown everything at once +;(define guard (make-custodian (current-custodian))) +;(current-custodian guard) +;; reads values continously from stdin and redisplays them +(define (read-loop) + (display (read-line)) + (display "\n") + (read-loop) + ) + +(define input-prompt "input: ") +(define output-prompt "output: ") + +;; prompt for username and bind to a variable username +(display "What's your name?\n") +(define username (read-line)) +(define usernamei (string-append username ": ")) ;; make username appear nicer in a prompt +(define fair (make-semaphore 1)) + +;; intelligent read, quits when user types in "quit" +(define (read-loop-i) + + + ;(semaphore-wait fair) + (display usernamei) + (define input (read-line)) + ;; do something over here with input maybe send it out + + ;; Tests input if its a quit then kills all threads + ;; An if would be better here tbh + (cond ((string=? input "quit") (begin (kill-thread a) + (kill-thread t)))) + (display (string-append output-prompt input "\n")) + ;(semaphore-post fair) + (read-loop-i) + ) + + +;; print hello world continously +;; "(hello-world)" can be executed as part of background thread +;; that prints in the event there is something in the input port +(define (hello-world) + (sleep (random-integer 0 15)) ;; sleep between 0 and 15 seconds to simulate coms + ;; with server + ;(semaphore-wait fair) + ;; we will retrieve the line printed below from the server + ;; at this time we simulate the input from different users + (define what-to-print (random-integer 0 2)) + (if (= what-to-print 0) + (display "Doug: What's up, up?\n") + (display "Fred: Looking good, good!\n")) + ;(semaphore-post fair) + (hello-world)) + +(define t (thread (lambda () + (read-loop-i)))) +(define a (thread (lambda () + (hello-world)))) + +(thread-wait t) ;; returns prompt back to drracket +;; below doesn't execute +; (sleep 10) +; (kill-thread t) +; (define a (thread (display "hello world!\n"))) +; (display "John: hello soso\n") +; (display "Emmanuel: cumbaya!!!!\n") diff --git a/feasibility_analysis/gui/windows.rkt b/tests/gui/windows.rkt index 4524673..4524673 100644 --- a/feasibility_analysis/gui/windows.rkt +++ b/tests/gui/windows.rkt diff --git a/feasibility_analysis/gui/windows2.rkt b/tests/gui/windows2.rkt index 3f60c80..3f60c80 100644 --- a/feasibility_analysis/gui/windows2.rkt +++ b/tests/gui/windows2.rkt diff --git a/feasibility_analysis/tcpevents/README.md b/tests/tcpevents/README.md index 7c3ec21..7c3ec21 100644 --- a/feasibility_analysis/tcpevents/README.md +++ b/tests/tcpevents/README.md diff --git a/tests/tcpevents/crpovertcp.rkt b/tests/tcpevents/crpovertcp.rkt new file mode 100644 index 0000000..57874a8 --- /dev/null +++ b/tests/tcpevents/crpovertcp.rkt @@ -0,0 +1,155 @@ +#lang racket +(require math/base) ;; for random number generation + +;; globals +;; must control access via semaphore as listener thread or broadcast thread +;; might need to access it +(define connections '()) ;; maintains a list of open ports +;; ((in1, out1), (in2, out2), (in3, out3), (in4, out4) ...) + +;; lets keep thread descriptor values +; + +(define fair (make-semaphore 1)) ;; managing connections above + +(define can-i-broadcast (make-semaphore 1)) + + +;; + +;; This is a relay server making two clients communicate +;; Both `server' and `accept-and-handle' change +;; to use a custodian. +;; To start server +;; (define stop (serve 8080)) +;; (stop) to close the server + +(define (serve port-no) + (define main-cust (make-custodian)) + (parameterize ([current-custodian main-cust]) + (define listener (tcp-listen port-no 5 #t)) + (define (loop) + (accept-and-handle listener) + (loop)) + (thread loop)) + (lambda () + (displayln "\nGoodbye, shutting down all services\n") + (custodian-shutdown-all main-cust))) + +(define (accept-and-handle listener) + (define cust (make-custodian)) + (parameterize ([current-custodian cust]) + (define-values (in out) (tcp-accept listener)) + (semaphore-wait fair) + ;; keep track of open ports + (append connections (list (list in out))) + (semaphore-wait fiar) + + ; thread will communicate to all clients at once in a broadcast + ; manner + (thread (lambda () + (handle in out) ;; this handles connection with that specific client + (close-input-port in) + (close-output-port out))) + ) + ;; Watcher thread: + ;; kills current thread for waiting too long for connection from + ;; clients + (thread (lambda () + (sleep 120) + (custodian-shutdown-all cust)))) + +; (define (handle connections) +; ()) +;; each thread needs 2 new threads +(define (handle in out) + ; define function to deal with in + (define (something-to-say in) + (sync/timeout 4 (read-line-evt in 'linefeed))) + ; define function to deal with out + ; thread them each + ; (server-loop in out) + (sleep 5) ;; wait 5 seconds to guarantee client has already send message + (define echo (read-line in)) ;; bind message to echo + (displayln (string-append echo "\n")) + ; echo back the message, appending echo + ; could regex match the input to extract the name + (writeln "Admin: Hello there" out) ;; append "echo " to echo and send back + (flush-output out) +) +;; This is a single server communicating directly to the client +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;; author: Ibrahim Mkusa +;; about: print and read concurrently +;; notes: output may need to be aligned and formatted nicely +;; look into +;; https://docs.racket-lang.org/gui/text-field_.html#%28meth._%28%28%28lib._mred%2Fmain..rkt%29._text-field~25%29._get-editor%29%29 + +;; create custodian for managing all resources +;; so we can shutdown everything at once +;(define guard (make-custodian (current-custodian))) +;(current-custodian guard) +;; reads values continously from stdin and redisplays them +(define (read-loop) + (display (read-line)) + (display "\n") + (read-loop) + ) + +(define input-prompt "input: ") +(define output-prompt "output: ") + +;; prompt for username and bind to a variable username +(display "What's your name?\n") +(define username (read-line)) +(define usernamei (string-append username ": ")) ;; make username appear nicer in a prompt + +;; intelligent read, quits when user types in "quit" +(define (read-loop-i) + + + ;(semaphore-wait fair) + (display usernamei) + (define input (read-line)) + ;; do something over here with input maybe send it out + + ;; Tests input if its a quit then kills all threads + ;; An if would be better here tbh + (cond ((string=? input "quit") (begin (kill-thread a) + (kill-thread t)))) + (display (string-append output-prompt input "\n")) + ;(semaphore-post fair) + (read-loop-i) + ) + + +;; print hello world continously +;; "(hello-world)" can be executed as part of background thread +;; that prints in the event there is something in the input port +(define (hello-world) + (sleep (random-integer 0 15)) ;; sleep between 0 and 15 seconds to simulate coms + ;; with server + ;(semaphore-wait fair) + ;; we will retrieve the line printed below from the server + ;; at this time we simulate the input from different users + (define what-to-print (random-integer 0 2)) + (if (= what-to-print 0) + (display "Doug: What's up, up?\n") + (display "Fred: Looking good, good!\n")) + ;(semaphore-post fair) + (hello-world)) + +(define t (thread (lambda () + (read-loop-i)))) +(define a (thread (lambda () + (hello-world)))) + +(thread-wait t) ;; returns prompt back to drracket +;; below doesn't execute +; (sleep 10) +; (kill-thread t) +; (define a (thread (display "hello world!\n"))) +; (display "John: hello soso\n") +; (display "Emmanuel: cumbaya!!!!\n") diff --git a/feasibility_analysis/tcpevents/server.rkt b/tests/tcpevents/server.rkt index 4313bda..4313bda 100644 --- a/feasibility_analysis/tcpevents/server.rkt +++ b/tests/tcpevents/server.rkt diff --git a/feasibility_analysis/tcpvanilla/README.md b/tests/tcpvanilla/README.md index b8e2883..b8e2883 100644 --- a/feasibility_analysis/tcpvanilla/README.md +++ b/tests/tcpvanilla/README.md diff --git a/feasibility_analysis/tcpvanilla/client.rkt b/tests/tcpvanilla/client.rkt index 967d2b9..967d2b9 100644 --- a/feasibility_analysis/tcpvanilla/client.rkt +++ b/tests/tcpvanilla/client.rkt diff --git a/feasibility_analysis/tcpvanilla/client2.rkt b/tests/tcpvanilla/client2.rkt index 47e3052..47e3052 100644 --- a/feasibility_analysis/tcpvanilla/client2.rkt +++ b/tests/tcpvanilla/client2.rkt diff --git a/feasibility_analysis/tcpvanilla/server.rkt b/tests/tcpvanilla/server.rkt index bf72aff..bf72aff 100644 --- a/feasibility_analysis/tcpvanilla/server.rkt +++ b/tests/tcpvanilla/server.rkt diff --git a/tests/tcpvanilla/tcpcommunication.rkt b/tests/tcpvanilla/tcpcommunication.rkt new file mode 100644 index 0000000..134e697 --- /dev/null +++ b/tests/tcpvanilla/tcpcommunication.rkt @@ -0,0 +1,60 @@ +#lang racket +;; Reads input iteratively then sends it to local server +;; client reads back the message and displays it + +(require math/base) ;; for random number generation + +(define listener (tcp-listen 4326 5 #t)) +(define a (thread (lambda () + (define-values (s-in s-out) (tcp-accept listener)) + ; Discard the request header (up to blank line): + ;(regexp-match #rx"(\r\n|^)\r\n" s-in) + (sleep 10) + (define (echo) + (define input (read-line s-in)) + (displayln input s-out) + (flush-output s-out) + (if (eof-object? input) + (displayln "Done talking\n") + (echo))) + (echo) + (close-input-port s-in) + (close-output-port s-out) + (tcp-close listener) + 'ok))) + +(define t (thread (lambda () + (define-values (c-in c-out) (tcp-connect "localhost" 4326)) + (define input-prompt "input: ") + (define output-prompt "output: ") + + ;; prompt for username and bind to a variable username + (display "What's your name?\n") + (define username (read-line)) + (define usernamei (string-append username ": ")) ;; make username appear nicer in a prompt + (define fair (make-semaphore 1)) + + ;; intelligent read, quits when user types in "quit" + (define (read-loop-i) + ;(semaphore-wait fair) + ; (display usernamei) + (define input (read-line)) + ;; do something over here with input maybe send it out + + ;; Tests input if its a quit then kills all threads + ;; An if would be better here tbh + (cond ((string=? input "quit") (exit))) + (display (string-append output-prompt input "\n") c-out) + (flush-output c-out) + (displayln (read-line c-in)) ;; server echoes back sent input + ;(semaphore-post fair) + (read-loop-i) + ) + (read-loop-i) + 'ok))) + +;(kill-thread a) +;(kill-thread t) +(thread-wait t) +(display "DONE!!\n") + diff --git a/feasibility_analysis/tcpvanilla/tcptalk.rkt b/tests/tcpvanilla/tcptalk.rkt index d069851..d069851 100644 --- a/feasibility_analysis/tcpvanilla/tcptalk.rkt +++ b/tests/tcpvanilla/tcptalk.rkt |
