From a93d17e0e65458e8dbadf5d510229b0a9c9e1470 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 5 Apr 2017 15:30:10 -0400 Subject: [PATCH 01/53] Two threads of execution example --- concurrentreadandprint.rkt | 51 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) create mode 100644 concurrentreadandprint.rkt diff --git a/concurrentreadandprint.rkt b/concurrentreadandprint.rkt new file mode 100644 index 0000000..2272d97 --- /dev/null +++ b/concurrentreadandprint.rkt @@ -0,0 +1,51 @@ +#lang racket +;; author: Ibrahim Mkusa +;; about: print and read concurrently + +;; 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) + (display usernamei) + + (semaphore-wait fair) + (define input (read-line)) + ;; do something over here with input maybe send it out + (cond ((string=? input "quit") (exit))) + (display (string-append output-prompt input "\n")) + (semaphore-post fair) + (read-loop-i) + ) + + +;; print hello world continously +(define (hello-world) + (semaphore-wait fair) + (display "Hello, World!\n") + (semaphore-post fair) + (hello-world)) + +(define t (thread (lambda () + (read-loop-i)))) +(define a (thread (lambda () + (hello-world)))) +;; 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") \ No newline at end of file From 768395102489dab0997ca6b7180c28e51872e665 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 5 Apr 2017 15:46:50 -0400 Subject: [PATCH 02/53] properly kills threads and returns prompt to main --- concurrentreadandprint.rkt | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/concurrentreadandprint.rkt b/concurrentreadandprint.rkt index 2272d97..a9a71ed 100644 --- a/concurrentreadandprint.rkt +++ b/concurrentreadandprint.rkt @@ -2,6 +2,10 @@ ;; author: Ibrahim Mkusa ;; about: print and read concurrently +;; 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)) @@ -25,7 +29,8 @@ (semaphore-wait fair) (define input (read-line)) ;; do something over here with input maybe send it out - (cond ((string=? input "quit") (exit))) + (cond ((string=? input "quit") (begin (kill-thread a) + (kill-thread t)))) (display (string-append output-prompt input "\n")) (semaphore-post fair) (read-loop-i) @@ -43,6 +48,8 @@ (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) From 91c611e2afbef6491f16be2fca4bc42fe891b501 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 5 Apr 2017 16:01:17 -0400 Subject: [PATCH 03/53] fixed an issue with username not appearing nicely --- concurrentreadandprint.rkt | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/concurrentreadandprint.rkt b/concurrentreadandprint.rkt index a9a71ed..7e7a78b 100644 --- a/concurrentreadandprint.rkt +++ b/concurrentreadandprint.rkt @@ -1,4 +1,6 @@ #lang racket +(require math/base) ;; for random number generation + ;; author: Ibrahim Mkusa ;; about: print and read concurrently @@ -24,11 +26,15 @@ ;; intelligent read, quits when user types in "quit" (define (read-loop-i) - (display usernamei) + (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")) @@ -38,9 +44,13 @@ ;; 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 60)) ;; sleep between 0 and 60 seconds to simulate coms + ;; with server (semaphore-wait fair) - (display "Hello, World!\n") + (display "\nHello, World!\n") (semaphore-post fair) (hello-world)) From 819c6a9f7479a743d16b66dbfda31817b1502bd4 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 5 Apr 2017 16:22:51 -0400 Subject: [PATCH 04/53] Added simulation for multiple users --- concurrentreadandprint.rkt | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/concurrentreadandprint.rkt b/concurrentreadandprint.rkt index 7e7a78b..709dd18 100644 --- a/concurrentreadandprint.rkt +++ b/concurrentreadandprint.rkt @@ -1,8 +1,10 @@ #lang racket (require math/base) ;; for random number generation + ;; author: Ibrahim Mkusa ;; about: print and read concurrently +;; notes: output may need to be aligned and formatted nicely ;; create custodian for managing all resources ;; so we can shutdown everything at once @@ -28,7 +30,7 @@ (define (read-loop-i) - (semaphore-wait fair) + ;(semaphore-wait fair) (display usernamei) (define input (read-line)) ;; do something over here with input maybe send it out @@ -38,7 +40,7 @@ (cond ((string=? input "quit") (begin (kill-thread a) (kill-thread t)))) (display (string-append output-prompt input "\n")) - (semaphore-post fair) + ;(semaphore-post fair) (read-loop-i) ) @@ -47,11 +49,16 @@ ;; "(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 60)) ;; sleep between 0 and 60 seconds to simulate coms + (sleep (random-integer 0 15)) ;; sleep between 0 and 15 seconds to simulate coms ;; with server - (semaphore-wait fair) - (display "\nHello, World!\n") - (semaphore-post fair) + ;(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 () From 56bc37f69d92a37cea8b6f0e3ca1ebbf970397a1 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 5 Apr 2017 16:39:47 -0400 Subject: [PATCH 05/53] I can read and process input iteratively --- concurrentreadandprint.rkt | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/concurrentreadandprint.rkt b/concurrentreadandprint.rkt index 709dd18..84882b4 100644 --- a/concurrentreadandprint.rkt +++ b/concurrentreadandprint.rkt @@ -5,11 +5,13 @@ ;; 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) +;(define guard (make-custodian (current-custodian))) +;(current-custodian guard) ;; reads values continously from stdin and redisplays them (define (read-loop) (display (read-line)) From c426214e24893a895aa794f02b2e8728410c0033 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 5 Apr 2017 16:51:51 -0400 Subject: [PATCH 06/53] Lets try communication over tcp on localhost crpovertcp.rkt --- crpovertcp.rkt | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 77 insertions(+) create mode 100644 crpovertcp.rkt diff --git a/crpovertcp.rkt b/crpovertcp.rkt new file mode 100644 index 0000000..84882b4 --- /dev/null +++ b/crpovertcp.rkt @@ -0,0 +1,77 @@ +#lang racket +(require math/base) ;; for random number generation + + +;; 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 +(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") \ No newline at end of file From 1edfa0442c29f5d69e720763ae22b330de2a4388 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Fri, 7 Apr 2017 13:18:20 -0400 Subject: [PATCH 07/53] iterative updates --- Makefile | 3 +++ crpovertcp.rkt | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 57 insertions(+) create mode 100644 Makefile diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..eda5bbb --- /dev/null +++ b/Makefile @@ -0,0 +1,3 @@ +# Remove idiotic save files +clean: + rm -rf *~ diff --git a/crpovertcp.rkt b/crpovertcp.rkt index 84882b4..7ec3745 100644 --- a/crpovertcp.rkt +++ b/crpovertcp.rkt @@ -1,6 +1,60 @@ #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 '()) + +;; This is a single server communicating directly to the client + +;;;;;;;;;;;;;;;;;;;;;;Server Client communication;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (serve in-port out-port) + (let loop [] + (define evt (sync/timeout 2 + (read-line-evt in-port 'any) + (thread-receive-evt))) + (cond + [(not evt) + (displayln "Timed out, exiting") + (tcp-abandon-port in-port) + (tcp-abandon-port out-port)] + [(string? evt) + (fprintf out-port "~a~n" evt) ;; echoes back received string + (flush-output out-port) ;; flushes the buffer + (loop)] ;; iterates again + [else + (printf "Received a message in mailbox: ~a~n" + (thread-receive)) + (loop)]))) + +(define port-num 4322) +(define (start-server) + (define listener (tcp-listen port-num)) + (thread + (lambda () + (let loop () ;; the server now loops continously listening in for connections + (define-values [in-port out-port] (tcp-accept listener)) + ;; lets add this open ports to global list of connections + (semaphore-wait fair) + (append connections (list (list in-port out-port))) + (semaphore-post fair) + (serve in-port out-port) ; could be do the greeting in here + (loop))))) + +(start-server) + +(define client-thread + (thread + (lambda () + (define-values [in-port out-port] (tcp-connect "localhost" port-num)) + + (display "first\nsecond\nthird\n" out-port) + (flush-output out-port) + ; copy-port will block until EOF is read from in-port + (copy-port in-port (current-output-port))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; author: Ibrahim Mkusa ;; about: print and read concurrently From e0354fd1c24c2a918d433837b727016474c19c0b Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 9 Apr 2017 12:53:03 -0400 Subject: [PATCH 08/53] keeping count of input and output ports directly is feasible. Trying a different way. --- crpovertcp.rkt | 98 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 95 insertions(+), 3 deletions(-) diff --git a/crpovertcp.rkt b/crpovertcp.rkt index 7ec3745..de04790 100644 --- a/crpovertcp.rkt +++ b/crpovertcp.rkt @@ -4,8 +4,101 @@ ;; globals ;; must control access via semaphore as listener thread or broadcast thread ;; might need to access it -(define connections '()) +(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)) + +;; alternative one keep running list of input and output ports directly +;; broadcasts a message to all connected clients +(define broadcast-message + (lambda (message connections) + (map send_message connections) + 'ok)) + +; port pair -> '(input-port output-port) + +(define (get-input-port port-pair) + (car port-pair)) + +(define (get-output-port port-pair) + (cadr port-pair)) + +;; gets pair of input and output port of a client and sends a message +(define send-message + (lambda (client_ports) + (displayln message (get-output-port (client-ports))) + (flush-output (get-output-port (client-ports))) + 'ok)) + + +;; + +;; 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 ;;;;;;;;;;;;;;;;;;;;;;Server Client communication;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -80,7 +173,6 @@ (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) @@ -128,4 +220,4 @@ ; (kill-thread t) ; (define a (thread (display "hello world!\n"))) ; (display "John: hello soso\n") -; (display "Emmanuel: cumbaya!!!!\n") \ No newline at end of file +; (display "Emmanuel: cumbaya!!!!\n") From 53bc7d0232eb8e8923d6721fcfd1d37925439c6e Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 9 Apr 2017 12:59:00 -0400 Subject: [PATCH 09/53] cleaned up crpovertcp.rkt --- crpovertcp.rkt | 68 -------------------------------------------------- 1 file changed, 68 deletions(-) diff --git a/crpovertcp.rkt b/crpovertcp.rkt index de04790..57874a8 100644 --- a/crpovertcp.rkt +++ b/crpovertcp.rkt @@ -14,28 +14,6 @@ (define can-i-broadcast (make-semaphore 1)) -;; alternative one keep running list of input and output ports directly -;; broadcasts a message to all connected clients -(define broadcast-message - (lambda (message connections) - (map send_message connections) - 'ok)) - -; port pair -> '(input-port output-port) - -(define (get-input-port port-pair) - (car port-pair)) - -(define (get-output-port port-pair) - (cadr port-pair)) - -;; gets pair of input and output port of a client and sends a message -(define send-message - (lambda (client_ports) - (displayln message (get-output-port (client-ports))) - (flush-output (get-output-port (client-ports))) - 'ok)) - ;; @@ -100,52 +78,6 @@ (flush-output out) ) ;; This is a single server communicating directly to the client - -;;;;;;;;;;;;;;;;;;;;;;Server Client communication;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (serve in-port out-port) - (let loop [] - (define evt (sync/timeout 2 - (read-line-evt in-port 'any) - (thread-receive-evt))) - (cond - [(not evt) - (displayln "Timed out, exiting") - (tcp-abandon-port in-port) - (tcp-abandon-port out-port)] - [(string? evt) - (fprintf out-port "~a~n" evt) ;; echoes back received string - (flush-output out-port) ;; flushes the buffer - (loop)] ;; iterates again - [else - (printf "Received a message in mailbox: ~a~n" - (thread-receive)) - (loop)]))) - -(define port-num 4322) -(define (start-server) - (define listener (tcp-listen port-num)) - (thread - (lambda () - (let loop () ;; the server now loops continously listening in for connections - (define-values [in-port out-port] (tcp-accept listener)) - ;; lets add this open ports to global list of connections - (semaphore-wait fair) - (append connections (list (list in-port out-port))) - (semaphore-post fair) - (serve in-port out-port) ; could be do the greeting in here - (loop))))) - -(start-server) - -(define client-thread - (thread - (lambda () - (define-values [in-port out-port] (tcp-connect "localhost" port-num)) - - (display "first\nsecond\nthird\n" out-port) - (flush-output out-port) - ; copy-port will block until EOF is read from in-port - (copy-port in-port (current-output-port))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From 2e0ddaaf3a67659ea5448ea54bd563325d007021 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 9 Apr 2017 13:02:30 -0400 Subject: [PATCH 10/53] partitioning crpovertcp.rkt to dedicated server.rkt and client.rkt files --- client.rkt | 77 ++++++++++++++++++++++++++ server.rkt | 155 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 232 insertions(+) create mode 100644 client.rkt create mode 100644 server.rkt diff --git a/client.rkt b/client.rkt new file mode 100644 index 0000000..70df4e6 --- /dev/null +++ b/client.rkt @@ -0,0 +1,77 @@ +#lang racket +(require math/base) ;; for random number generation + +;; 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: ") + +(define fair (make-semaphore 1)) + +;; 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/server.rkt b/server.rkt new file mode 100644 index 0000000..57874a8 --- /dev/null +++ b/server.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") From f56f1cc46d738bc76820977af8c6a372f9702df4 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 9 Apr 2017 14:56:46 -0400 Subject: [PATCH 11/53] server code for interacting with client is done, not tested. Working on server broadcast function --- server.rkt | 150 +++++++++++++++++++---------------------------------- 1 file changed, 54 insertions(+), 96 deletions(-) diff --git a/server.rkt b/server.rkt index 57874a8..c5bb6f3 100644 --- a/server.rkt +++ b/server.rkt @@ -6,11 +6,24 @@ ;; might need to access it (define connections '()) ;; maintains a list of open ports ;; ((in1, out1), (in2, out2), (in3, out3), (in4, out4) ...) +(define connections-s (make-semaphore 1)) ;; control access to connections +;; every 5 seconds run to broadcast top message in list +;; and remove it from list +(define messages-s (make-semaphore 1)) ;; control access to messages +(define messages '()) ;; stores a list of messages(strings) from currents + +(define threads-s (make-semaphore 1)) ;; control access to threads ;; lets keep thread descriptor values -; +(define threads '()) ;; stores a list of client serving threads as thread descriptor values -(define fair (make-semaphore 1)) ;; managing connections above +;; define a broadcast function +(define broadcast + (lambda () + (semaphore-wait messages-s) + (semaphore-wait threads-s) + (map (lambda (thread-descriptor) + ())))) (define can-i-broadcast (make-semaphore 1)) @@ -40,116 +53,61 @@ (define cust (make-custodian)) (parameterize ([current-custodian cust]) (define-values (in out) (tcp-accept listener)) - (semaphore-wait fair) + (semaphore-wait connections-s) ;; keep track of open ports (append connections (list (list in out))) - (semaphore-wait fiar) + (semaphore-wait connections-s) - ; thread will communicate to all clients at once in a broadcast - ; manner - (thread (lambda () + ; start a thread to deal with specific client and add descriptor value to the list of threads + (append threads (list (thread (lambda () (handle in out) ;; this handles connection with that specific client (close-input-port in) - (close-output-port out))) - ) + (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)))) + (custodian-shutdown-all cust))))) ; (define (handle connections) ; ()) ;; each thread needs 2 new threads (define (handle in out) - ; define function to deal with in + ; define function to deal with incoming messages from client (define (something-to-say in) - (sync/timeout 4 (read-line-evt in 'linefeed))) + (define evt-t0 (sync/timeout 120 (read-line-evt in 'linefeed))) + (cond [(not evt-t0) + (displayln "Nothing received from " (current-thread) "exiting")] + [(string? evt-t0) + (semaphore-wait messages-s) + ; append the message to list of messages + (append messages (list evt-t0)) + (semaphore-post messages-s)])) + + ; define function to deal with out + (define (something-to-send out) + (define evt-t1 (sync/timeout 120 (thread-receive-evt))) + ;; send message to client + (fprintf out "~a~n" (thread-receive)) + (flush-output out) + ) ; thread them each + + ;; i could bind to values, and call wait on them + ;; thread that deals with incoming messages for that particular thread + (thread (lambda () + (let loop [] + (something-to-say in) + (loop)))) + + (thread (lambda () + (let loop [] + (something-to-say out) + (loop)))) ; (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") + ; (sleep 5) ;; wait 5 seconds to guarantee client has already send message + 'ok + ) From ba3f6821f5ef38b6e2e1990581765f80203817c9 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 9 Apr 2017 15:19:57 -0400 Subject: [PATCH 12/53] server.rkt is done, with exception of testing. Moving on to client.rkt --- client.rkt | 2 ++ server.rkt | 22 ++++++++++++++++------ 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/client.rkt b/client.rkt index 70df4e6..f0d3578 100644 --- a/client.rkt +++ b/client.rkt @@ -12,6 +12,8 @@ ;(define guard (make-custodian (current-custodian))) ;(current-custodian guard) ;; reads values continously from stdin and redisplays them + +;;;;;; NOT IN USE ;;;;;;; (define (read-loop) (display (read-line)) (display "\n") diff --git a/server.rkt b/server.rkt index c5bb6f3..5322a3d 100644 --- a/server.rkt +++ b/server.rkt @@ -22,11 +22,15 @@ (lambda () (semaphore-wait messages-s) (semaphore-wait threads-s) - (map (lambda (thread-descriptor) - ())))) - -(define can-i-broadcast (make-semaphore 1)) - + (if (not (null? messages)) + (begin (map (lambda (thread-descriptor) + (thread-send thread-descriptor (first messages)))) + (set! messages (rest messages)) + ) + (display "No message to display\n") ; for later create file port for errors and save error messages to that file + ) + (semaphore-post threads-s) + (semaphore-post messages-s))) ;; @@ -44,7 +48,13 @@ (define (loop) (accept-and-handle listener) (loop)) - (thread loop)) + (thread loop) + ;; Create a thread whose job is to simply call broadcast iteratively + (thread (lambda () + (let loopb [] + broadcast + (sleep 10) ;; sleep for 10 seconds between broadcasts + (loopb))))) (lambda () (displayln "\nGoodbye, shutting down all services\n") (custodian-shutdown-all main-cust))) From f0d361b49c80d9fb78c67f006ad49b1062e8ed64 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 9 Apr 2017 20:50:20 -0400 Subject: [PATCH 13/53] updates to server.rkt and client.rkt --- client.rkt | 107 ++++++++++++++++++++++--------------- concurrentreadandprint.rkt | 2 +- server.rkt | 69 +++++++++++++++--------- 3 files changed, 109 insertions(+), 69 deletions(-) diff --git a/client.rkt b/client.rkt index f0d3578..25be149 100644 --- a/client.rkt +++ b/client.rkt @@ -13,67 +13,90 @@ ;(current-custodian guard) ;; reads values continously from stdin and redisplays them -;;;;;; NOT IN USE ;;;;;;; -(define (read-loop) - (display (read-line)) - (display "\n") - (read-loop) - ) +;; Notes connect to server on localhost +;; use client template of tcpvanilla +;; use event for read-write -(define input-prompt "input: ") -(define output-prompt "output: ") +;; modify read-loop-i +; read a value and send it to server via output-port -(define fair (make-semaphore 1)) +; is there something in the input port. If yes? display it +; in the hello world -;; 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 +; make connection to server +(define (client port-no) + (define main-client-cust (make-custodian)) + (parameterize ([current-custodian main-client-cust]) + ;; connect to server at port 8080 + (define-values (in out) (tcp-connect "localhost" port-no)) ;; define values + (display in) + (displayln out) + ;; binds to multiple values akin to unpacking tuples in python + (display "What's your name?\n") + (define username (read-line)) -;; intelligent read, quits when user types in "quit" -(define (read-loop-i) - - + ; (thread (lambda () + ;; make threads 2 lines + (define a (thread + (lambda () + (let loop [] + (receive-messages in) + (sleep 1) + (loop))))) + (define t (thread + (lambda () + (let loop [] + (send-messages username out) + (sleep 1) + (loop))))) + (thread-wait t) ;; returns prompt back to drracket + (close-input-port in) + (close-output-port out)) + (custodian-shutdown-all main-client-cust)) + + +;; the send-messages +(define (send-messages username out) + ;; intelligent read, quits when user types in "quit" ;(semaphore-wait fair) - (display usernamei) + ; (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")) + ;; (cond ((string=? input "quit") (begin (kill-thread a) + ;(kill-thread t)))) + (cond ((string=? input "quit") (exit))) + ;; modify to send messages to out port + (displayln (string-append username ": " input) out) + (flush-output out) + ;(semaphore-post fair) - (read-loop-i) - ) + ; (read-loop-i out) +) + ;; print hello world continously ;; "(hello-world)" can be executed as part of background thread ;; that prints in the event there is something in the input port -(define (hello-world) - (sleep (random-integer 0 15)) ;; sleep between 0 and 15 seconds to simulate coms +(define (receive-messages in) + ; (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")) + (define evt (sync/timeout 30 (read-line-evt in))) + (cond [(eof-object? evt) + (displayln "Server connection closed") + (exit)] + [(string? evt) + (displayln evt)] ; could time stamp here or to send message + [else + (displayln (string-append "Nothing received from server for 2 minutes."))] + ) ;(semaphore-post fair) - (hello-world)) +) -(define t (thread (lambda () - (read-loop-i)))) -(define a (thread (lambda () - (hello-world)))) +(define stop (client 4321)) -(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/concurrentreadandprint.rkt b/concurrentreadandprint.rkt index 84882b4..f67f1dd 100644 --- a/concurrentreadandprint.rkt +++ b/concurrentreadandprint.rkt @@ -74,4 +74,4 @@ ; (kill-thread t) ; (define a (thread (display "hello world!\n"))) ; (display "John: hello soso\n") -; (display "Emmanuel: cumbaya!!!!\n") \ No newline at end of file +; (display "Emmanuel: cumbaya!!!!\n") diff --git a/server.rkt b/server.rkt index 5322a3d..d1f5a98 100644 --- a/server.rkt +++ b/server.rkt @@ -11,26 +11,13 @@ ;; every 5 seconds run to broadcast top message in list ;; and remove it from list (define messages-s (make-semaphore 1)) ;; control access to messages -(define messages '()) ;; stores a list of messages(strings) from currents +(define messages '("hello, world!")) ;; stores a list of messages(strings) from currents (define threads-s (make-semaphore 1)) ;; control access to threads ;; lets keep thread descriptor values (define threads '()) ;; stores a list of client serving threads as thread descriptor values -;; define a broadcast function -(define broadcast - (lambda () - (semaphore-wait messages-s) - (semaphore-wait threads-s) - (if (not (null? messages)) - (begin (map (lambda (thread-descriptor) - (thread-send thread-descriptor (first messages)))) - (set! messages (rest messages)) - ) - (display "No message to display\n") ; for later create file port for errors and save error messages to that file - ) - (semaphore-post threads-s) - (semaphore-post messages-s))) + ;; @@ -52,7 +39,8 @@ ;; Create a thread whose job is to simply call broadcast iteratively (thread (lambda () (let loopb [] - broadcast + (sleep 30) ;; wait 30 secs before beginning to broadcast + (broadcast) (sleep 10) ;; sleep for 10 seconds between broadcasts (loopb))))) (lambda () @@ -63,22 +51,26 @@ (define cust (make-custodian)) (parameterize ([current-custodian cust]) (define-values (in out) (tcp-accept listener)) + ; discard request header + ; Discard the request header (up to blank line): + (regexp-match #rx"(\r\n|^)\r\n" in) (semaphore-wait connections-s) ;; keep track of open ports - (append connections (list (list in out))) - (semaphore-wait connections-s) + (set! connections (append connections (list (list in out)))) + (semaphore-post connections-s) ; start a thread to deal with specific client and add descriptor value to the list of threads - (append threads (list (thread (lambda () + (set! threads (append threads (list (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) + (sleep 360) (custodian-shutdown-all cust))))) ; (define (handle connections) @@ -87,14 +79,19 @@ (define (handle in out) ; define function to deal with incoming messages from client (define (something-to-say in) - (define evt-t0 (sync/timeout 120 (read-line-evt in 'linefeed))) - (cond [(not evt-t0) - (displayln "Nothing received from " (current-thread) "exiting")] + (define evt-t0 (sync/timeout 30 (read-line-evt in 'linefeed))) + (cond [(eof-object? evt-t0) + (displayln (string-append "Connection closed " (current-thread) "exiting")) + (exit) + ] [(string? evt-t0) (semaphore-wait messages-s) ; append the message to list of messages - (append messages (list evt-t0)) - (semaphore-post messages-s)])) + (display (string-append evt-t0 "\n")) + (set! messages (append messages (list evt-t0))) + (semaphore-post messages-s)] + [else + (displayln (string-append "Nothing received from " (current-thread)))])) ; define function to deal with out @@ -111,13 +108,33 @@ (thread (lambda () (let loop [] (something-to-say in) + (sleep 1) (loop)))) (thread (lambda () (let loop [] - (something-to-say out) + (something-to-send out) + (sleep 1) (loop)))) ; (server-loop in out) ; (sleep 5) ;; wait 5 seconds to guarantee client has already send message 'ok ) + +;; define a broadcast function +(define broadcast + (lambda () + (semaphore-wait messages-s) + (semaphore-wait threads-s) + (if (not (null? messages)) + (begin (map (lambda (thread-descriptor) + (thread-send thread-descriptor (first messages))) + threads) + (set! messages (rest messages)) + ) + (display "No message to display\n") ; for later create file port for errors and save error messages to that file + ) + (semaphore-post threads-s) + (semaphore-post messages-s))) + +(define stop (serve 4321)) ;; start server then close with stop \ No newline at end of file From 404f3d7edfe648dc3fd51c1afc1b3984557f1902 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 9 Apr 2017 22:29:59 -0400 Subject: [PATCH 14/53] Added tcpcommunication.rkt --- tcpcommunication.rkt | 57 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 tcpcommunication.rkt diff --git a/tcpcommunication.rkt b/tcpcommunication.rkt new file mode 100644 index 0000000..27a5151 --- /dev/null +++ b/tcpcommunication.rkt @@ -0,0 +1,57 @@ +#lang racket +(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") + From cb381871d518077649be6272af823dabec2fcd28 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 9 Apr 2017 22:37:50 -0400 Subject: [PATCH 15/53] reorganized repo a bit better --- client.rkt => Hermes/client.rkt | 0 .../concurrentreadandprint.rkt | 0 server.rkt => Hermes/server.rkt | 0 tcpcommunication.rkt => Hermes/tcpcommunication.rkt | 0 README.md | 4 ++-- FP4-instructions.md => docs/FP4-instructions.md | 0 arch_diagram.png => ext/arch_diagram.png | Bin .../architecture_diagram.png | Bin .../gui/Gui_Exploration.rkt | 0 {feasibility_analysis => tests}/gui/windows.rkt | 0 {feasibility_analysis => tests}/gui/windows2.rkt | 0 {feasibility_analysis => tests}/tcpevents/README.md | 0 crpovertcp.rkt => tests/tcpevents/crpovertcp.rkt | 0 .../tcpevents/server.rkt | 0 .../tcpvanilla/README.md | 0 .../tcpvanilla/client.rkt | 0 .../tcpvanilla/client2.rkt | 0 .../tcpvanilla/server.rkt | 0 .../tcpvanilla/tcptalk.rkt | 0 19 files changed, 2 insertions(+), 2 deletions(-) rename client.rkt => Hermes/client.rkt (100%) rename concurrentreadandprint.rkt => Hermes/concurrentreadandprint.rkt (100%) rename server.rkt => Hermes/server.rkt (100%) rename tcpcommunication.rkt => Hermes/tcpcommunication.rkt (100%) rename FP4-instructions.md => docs/FP4-instructions.md (100%) rename arch_diagram.png => ext/arch_diagram.png (100%) rename architecture_diagram.png => ext/architecture_diagram.png (100%) rename Gui_Exploration.rkt => tests/gui/Gui_Exploration.rkt (100%) rename {feasibility_analysis => tests}/gui/windows.rkt (100%) rename {feasibility_analysis => tests}/gui/windows2.rkt (100%) rename {feasibility_analysis => tests}/tcpevents/README.md (100%) rename crpovertcp.rkt => tests/tcpevents/crpovertcp.rkt (100%) rename {feasibility_analysis => tests}/tcpevents/server.rkt (100%) rename {feasibility_analysis => tests}/tcpvanilla/README.md (100%) rename {feasibility_analysis => tests}/tcpvanilla/client.rkt (100%) rename {feasibility_analysis => tests}/tcpvanilla/client2.rkt (100%) rename {feasibility_analysis => tests}/tcpvanilla/server.rkt (100%) rename {feasibility_analysis => tests}/tcpvanilla/tcptalk.rkt (100%) diff --git a/client.rkt b/Hermes/client.rkt similarity index 100% rename from client.rkt rename to Hermes/client.rkt diff --git a/concurrentreadandprint.rkt b/Hermes/concurrentreadandprint.rkt similarity index 100% rename from concurrentreadandprint.rkt rename to Hermes/concurrentreadandprint.rkt diff --git a/server.rkt b/Hermes/server.rkt similarity index 100% rename from server.rkt rename to Hermes/server.rkt diff --git a/tcpcommunication.rkt b/Hermes/tcpcommunication.rkt similarity index 100% rename from tcpcommunication.rkt rename to Hermes/tcpcommunication.rkt diff --git a/README.md b/README.md index 4b247b0..2807b00 100644 --- a/README.md +++ b/README.md @@ -72,11 +72,11 @@ satisfactorily we would have met our goals. ## Architecture Diagram #### Preliminary design -![Architecture](https://github.com/oplS17projects/Hermes/blob/master/arch_diagram.png) +![Architecture](https://github.com/oplS17projects/Hermes/blob/master/ext/arch_diagram.png) #### The Game plan -![Diagram](https://github.com/oplS17projects/Hermes/blob/master/architecture_diagram.png) +![Diagram](https://github.com/oplS17projects/Hermes/blob/master/ext/architecture_diagram.png) ## Schedule diff --git a/FP4-instructions.md b/docs/FP4-instructions.md similarity index 100% rename from FP4-instructions.md rename to docs/FP4-instructions.md diff --git a/arch_diagram.png b/ext/arch_diagram.png similarity index 100% rename from arch_diagram.png rename to ext/arch_diagram.png diff --git a/architecture_diagram.png b/ext/architecture_diagram.png similarity index 100% rename from architecture_diagram.png rename to ext/architecture_diagram.png diff --git a/Gui_Exploration.rkt b/tests/gui/Gui_Exploration.rkt similarity index 100% rename from Gui_Exploration.rkt rename to tests/gui/Gui_Exploration.rkt diff --git a/feasibility_analysis/gui/windows.rkt b/tests/gui/windows.rkt similarity index 100% rename from feasibility_analysis/gui/windows.rkt rename to tests/gui/windows.rkt diff --git a/feasibility_analysis/gui/windows2.rkt b/tests/gui/windows2.rkt similarity index 100% rename from feasibility_analysis/gui/windows2.rkt rename to tests/gui/windows2.rkt diff --git a/feasibility_analysis/tcpevents/README.md b/tests/tcpevents/README.md similarity index 100% rename from feasibility_analysis/tcpevents/README.md rename to tests/tcpevents/README.md diff --git a/crpovertcp.rkt b/tests/tcpevents/crpovertcp.rkt similarity index 100% rename from crpovertcp.rkt rename to tests/tcpevents/crpovertcp.rkt diff --git a/feasibility_analysis/tcpevents/server.rkt b/tests/tcpevents/server.rkt similarity index 100% rename from feasibility_analysis/tcpevents/server.rkt rename to tests/tcpevents/server.rkt diff --git a/feasibility_analysis/tcpvanilla/README.md b/tests/tcpvanilla/README.md similarity index 100% rename from feasibility_analysis/tcpvanilla/README.md rename to tests/tcpvanilla/README.md diff --git a/feasibility_analysis/tcpvanilla/client.rkt b/tests/tcpvanilla/client.rkt similarity index 100% rename from feasibility_analysis/tcpvanilla/client.rkt rename to tests/tcpvanilla/client.rkt diff --git a/feasibility_analysis/tcpvanilla/client2.rkt b/tests/tcpvanilla/client2.rkt similarity index 100% rename from feasibility_analysis/tcpvanilla/client2.rkt rename to tests/tcpvanilla/client2.rkt diff --git a/feasibility_analysis/tcpvanilla/server.rkt b/tests/tcpvanilla/server.rkt similarity index 100% rename from feasibility_analysis/tcpvanilla/server.rkt rename to tests/tcpvanilla/server.rkt diff --git a/feasibility_analysis/tcpvanilla/tcptalk.rkt b/tests/tcpvanilla/tcptalk.rkt similarity index 100% rename from feasibility_analysis/tcpvanilla/tcptalk.rkt rename to tests/tcpvanilla/tcptalk.rkt From 44c715c55c239495da8f780276866c0041f04139 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 9 Apr 2017 22:46:18 -0400 Subject: [PATCH 16/53] final polish for release for 0.2 --- Hermes/concurrentreadandprint.rkt | 8 +++----- Hermes/tcpcommunication.rkt | 3 +++ 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/Hermes/concurrentreadandprint.rkt b/Hermes/concurrentreadandprint.rkt index f67f1dd..95d02c1 100644 --- a/Hermes/concurrentreadandprint.rkt +++ b/Hermes/concurrentreadandprint.rkt @@ -1,12 +1,10 @@ #lang racket (require math/base) ;; for random number generation +;; a proof of concept +;; one thread waits for input +;; another displays messages in the background -;; 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 diff --git a/Hermes/tcpcommunication.rkt b/Hermes/tcpcommunication.rkt index 27a5151..134e697 100644 --- a/Hermes/tcpcommunication.rkt +++ b/Hermes/tcpcommunication.rkt @@ -1,4 +1,7 @@ #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)) From 2f0d04ce7febc3617a8bc0e7bb3fa2a823ae78da Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Tue, 11 Apr 2017 23:40:33 -0400 Subject: [PATCH 17/53] Cleaned up code and added loggers to pinpoint error --- Hermes/client.rkt | 15 +++++++++++--- Hermes/server.rkt | 52 +++++++++++++++++++++++++++++++++-------------- Makefile | 3 --- 3 files changed, 49 insertions(+), 21 deletions(-) delete mode 100644 Makefile diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 25be149..d4912e0 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -23,9 +23,11 @@ ; is there something in the input port. If yes? display it ; in the hello world +; custodian for client connections +(define main-client-cust (make-custodian)) ; make connection to server (define (client port-no) - (define main-client-cust (make-custodian)) + (parameterize ([current-custodian main-client-cust]) ;; connect to server at port 8080 (define-values (in out) (tcp-connect "localhost" port-no)) ;; define values @@ -39,17 +41,21 @@ ;; make threads 2 lines (define a (thread (lambda () + (displayln "Startting receiver thread\n") (let loop [] (receive-messages in) (sleep 1) (loop))))) (define t (thread (lambda () + (displayln "Starting sender thread\n") (let loop [] (send-messages username out) (sleep 1) (loop))))) + (displayln "Now waiting for sender thread") (thread-wait t) ;; returns prompt back to drracket + (displayln "Closing client ports") (close-input-port in) (close-output-port out)) (custodian-shutdown-all main-client-cust)) @@ -69,7 +75,7 @@ ;(kill-thread t)))) (cond ((string=? input "quit") (exit))) ;; modify to send messages to out port - (displayln (string-append username ": " input) out) + (displayln (string-append username ": " input "\n") out) (flush-output out) ;(semaphore-post fair) @@ -89,7 +95,9 @@ (define evt (sync/timeout 30 (read-line-evt in))) (cond [(eof-object? evt) (displayln "Server connection closed") - (exit)] + (custodian-shutdown-all main-client-cust) + ;(exit) + ] [(string? evt) (displayln evt)] ; could time stamp here or to send message [else @@ -99,4 +107,5 @@ ) (define stop (client 4321)) +(display "Client started\n") diff --git a/Hermes/server.rkt b/Hermes/server.rkt index d1f5a98..541024e 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -11,7 +11,7 @@ ;; every 5 seconds run to broadcast top message in list ;; and remove it from list (define messages-s (make-semaphore 1)) ;; control access to messages -(define messages '("hello, world!")) ;; stores a list of messages(strings) from currents +(define messages '()) ;; stores a list of messages(strings) from currents (define threads-s (make-semaphore 1)) ;; control access to threads ;; lets keep thread descriptor values @@ -35,13 +35,14 @@ (define (loop) (accept-and-handle listener) (loop)) + (displayln "threading the listeneter") (thread loop) ;; Create a thread whose job is to simply call broadcast iteratively (thread (lambda () + (display "Broadcast thread started!\n") (let loopb [] - (sleep 30) ;; wait 30 secs before beginning to broadcast + (sleep 10) ;; wait 30 secs before beginning to broadcast (broadcast) - (sleep 10) ;; sleep for 10 seconds between broadcasts (loopb))))) (lambda () (displayln "\nGoodbye, shutting down all services\n") @@ -51,25 +52,42 @@ (define cust (make-custodian)) (parameterize ([current-custodian cust]) (define-values (in out) (tcp-accept listener)) + (displayln "Sucessfully connected to a client") + (display in) + (displayln out) + (displayln "Sending client Welcome message") + (displayln "Welcome to Hermes coms") + (flush-output out) ; discard request header ; Discard the request header (up to blank line): - (regexp-match #rx"(\r\n|^)\r\n" in) + ; (regexp-match #rx"(\r\n|^)\r\n" in) (semaphore-wait connections-s) + (displayln "Got the semaphore") ;; keep track of open ports (set! connections (append connections (list (list in out)))) (semaphore-post connections-s) + (displayln "Successfully added a pair of ports") + connections ; start a thread to deal with specific client and add descriptor value to the list of threads - (set! threads (append threads (list (thread (lambda () + (semaphore-wait threads-s) + (define threadcom (thread (lambda () (handle in out) ;; this handles connection with that specific client - (close-input-port in) - (close-output-port out)))) - ) - ) + (display "handle successfully completed\n") + ; this might have been the issue + ;(close-input-port in) + ; (close-output-port out) + ))) + (set! threads (append threads (list threadcom))) + (semaphore-post threads-s) + (displayln "Successfully created a thread") + (displayln threadcom) + threads ;; Watcher thread: ;; kills current thread for waiting too long for connection from ;; clients (thread (lambda () + (display "Started a thread to kill hanging connecting thread\n") (sleep 360) (custodian-shutdown-all cust))))) @@ -79,9 +97,9 @@ (define (handle in out) ; define function to deal with incoming messages from client (define (something-to-say in) - (define evt-t0 (sync/timeout 30 (read-line-evt in 'linefeed))) + (define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed))) (cond [(eof-object? evt-t0) - (displayln (string-append "Connection closed " (current-thread) "exiting")) + (displayln "Connection closed. EOF received") (exit) ] [(string? evt-t0) @@ -91,11 +109,11 @@ (set! messages (append messages (list evt-t0))) (semaphore-post messages-s)] [else - (displayln (string-append "Nothing received from " (current-thread)))])) + (displayln "Timeout waiting. Nothing received from client")])) ; define function to deal with out - (define (something-to-send out) + (define (something-to-broadcast out) (define evt-t1 (sync/timeout 120 (thread-receive-evt))) ;; send message to client (fprintf out "~a~n" (thread-receive)) @@ -113,7 +131,7 @@ (thread (lambda () (let loop [] - (something-to-send out) + (something-to-broadcast out) (sleep 1) (loop)))) ; (server-loop in out) @@ -131,10 +149,14 @@ (thread-send thread-descriptor (first messages))) threads) (set! messages (rest messages)) + (displayln "Broadcasted a message\n") ) (display "No message to display\n") ; for later create file port for errors and save error messages to that file ) + messages ; whats the current state of messages (semaphore-post threads-s) (semaphore-post messages-s))) -(define stop (serve 4321)) ;; start server then close with stop \ No newline at end of file +(define stop (serve 4321)) ;; start server then close with stop +(display "Server process started\n") + diff --git a/Makefile b/Makefile deleted file mode 100644 index eda5bbb..0000000 --- a/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -# Remove idiotic save files -clean: - rm -rf *~ From 69523cc2ed211285468148d835c320447f21fc04 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 00:01:52 -0400 Subject: [PATCH 18/53] Clients can now talk with each other --- Hermes/Makefile | 3 +++ Hermes/server.rkt | 46 ++++++++++++++++++++++++++++++++++++---------- 2 files changed, 39 insertions(+), 10 deletions(-) create mode 100644 Hermes/Makefile diff --git a/Hermes/Makefile b/Hermes/Makefile new file mode 100644 index 0000000..eda5bbb --- /dev/null +++ b/Hermes/Makefile @@ -0,0 +1,3 @@ +# Remove idiotic save files +clean: + rm -rf *~ diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 541024e..c57fbe7 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -139,22 +139,48 @@ 'ok ) +;; a bunch of selectors, predicates for connections +(define (get-output-port ports) + (cadr ports) + ) + +(define (get-input-port ports) + (car ports) +) ;; define a broadcast function (define broadcast (lambda () (semaphore-wait messages-s) - (semaphore-wait threads-s) + (if (not (null? messages)) - (begin (map (lambda (thread-descriptor) - (thread-send thread-descriptor (first messages))) - threads) + (begin (map + (lambda (ports) + (displayln (first messages) (get-output-port ports)) + (flush-output (get-output-port ports)) + ;; log message to server + (displayln "Message sent") + ) + connections) + ;; remove top message (set! messages (rest messages)) - (displayln "Broadcasted a message\n") - ) - (display "No message to display\n") ; for later create file port for errors and save error messages to that file - ) - messages ; whats the current state of messages - (semaphore-post threads-s) + ;; current state of messages and connections + messages + connections) + (display "No message to display\n")) + ; Approach one was to broadcast via thread mailboxes + ;(semaphore-wait threads-s) + ;(if (not (null? messages)) + ; (begin (map (lambda (thread-descriptor) + ; (thread-send thread-descriptor (first messages))) + ; threads) + ; (set! messages (rest messages)) + ; (displayln "Broadcasted a message\n") + ;) + ;(display "No message to display\n") ; for later create file port for errors and save error messages to that file + ;) + ; messages ; whats the current state of messages + ;(semaphore-post threads-s) + (semaphore-post messages-s))) (define stop (serve 4321)) ;; start server then close with stop From 66d5762bd992d786f933825acdba71713fe80fcc Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 00:23:37 -0400 Subject: [PATCH 19/53] removed log messages from server.rkt, added semaphores stdout --- Hermes/client.rkt | 2 +- Hermes/server.rkt | 75 +++++++++++++++++++++++++++++------------------ 2 files changed, 48 insertions(+), 29 deletions(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index d4912e0..574f88a 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -41,7 +41,7 @@ ;; make threads 2 lines (define a (thread (lambda () - (displayln "Startting receiver thread\n") + (displayln "Starting receiver thread\n") (let loop [] (receive-messages in) (sleep 1) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index c57fbe7..de11d0e 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -1,6 +1,8 @@ #lang racket (require math/base) ;; for random number generation +;; TODO wrap "safer send in a function that takes care of semaphores" + ;; globals ;; must control access via semaphore as listener thread or broadcast thread ;; might need to access it @@ -17,7 +19,9 @@ ;; lets keep thread descriptor values (define threads '()) ;; stores a list of client serving threads as thread descriptor values - +;; several threads that might want to print to stdout +;; lets keep things civil +(define stdout (make-semaphore 1)) ;; @@ -35,11 +39,13 @@ (define (loop) (accept-and-handle listener) (loop)) - (displayln "threading the listeneter") + (displayln "threading the listener") (thread loop) ;; Create a thread whose job is to simply call broadcast iteratively (thread (lambda () + (semaphore-wait stdout) (display "Broadcast thread started!\n") + (semaphore-post stdout) (let loopb [] (sleep 10) ;; wait 30 secs before beginning to broadcast (broadcast) @@ -52,42 +58,46 @@ (define cust (make-custodian)) (parameterize ([current-custodian cust]) (define-values (in out) (tcp-accept listener)) + (semaphore-wait stdout) (displayln "Sucessfully connected to a client") - (display in) - (displayln out) + ;(display in) + ;(displayln out) (displayln "Sending client Welcome message") - (displayln "Welcome to Hermes coms") + (semaphore-post stdout) + (displayln "Welcome to Hermes coms\nType your message below" out) (flush-output out) ; discard request header ; Discard the request header (up to blank line): ; (regexp-match #rx"(\r\n|^)\r\n" in) (semaphore-wait connections-s) - (displayln "Got the semaphore") + ; (displayln "Got the semaphore") ;; keep track of open ports (set! connections (append connections (list (list in out)))) (semaphore-post connections-s) - (displayln "Successfully added a pair of ports") + ; (displayln "Successfully added a pair of ports") connections ; start a thread to deal with specific client and add descriptor value to the list of threads (semaphore-wait threads-s) (define threadcom (thread (lambda () (handle in out) ;; this handles connection with that specific client - (display "handle successfully completed\n") + ;(display "handle successfully completed\n") ; this might have been the issue ;(close-input-port in) ; (close-output-port out) ))) (set! threads (append threads (list threadcom))) (semaphore-post threads-s) - (displayln "Successfully created a thread") - (displayln threadcom) - threads + ; (displayln "Successfully created a thread") + ; (displayln threadcom) + ; threads ;; Watcher thread: ;; kills current thread for waiting too long for connection from ;; clients (thread (lambda () + (semaphore-wait stdout) (display "Started a thread to kill hanging connecting thread\n") + (semaphore-post stdout) (sleep 360) (custodian-shutdown-all cust))))) @@ -99,7 +109,9 @@ (define (something-to-say in) (define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed))) (cond [(eof-object? evt-t0) + (semaphore-wait stdout) (displayln "Connection closed. EOF received") + (semaphore-post stdout) (exit) ] [(string? evt-t0) @@ -109,16 +121,18 @@ (set! messages (append messages (list evt-t0))) (semaphore-post messages-s)] [else - (displayln "Timeout waiting. Nothing received from client")])) - + (semaphore-wait stdout) + (displayln "Timeout waiting. Nothing received from client") + (semaphore-post stdout)])) + ; -----NO LONGER NECESSARY not using thread mailboxes ---- ; define function to deal with out - (define (something-to-broadcast out) - (define evt-t1 (sync/timeout 120 (thread-receive-evt))) + ;(define (something-to-broadcast out) + ; (define evt-t1 (sync/timeout 120 (thread-receive-evt))) ;; send message to client - (fprintf out "~a~n" (thread-receive)) - (flush-output out) - ) + ; (fprintf out "~a~n" (thread-receive)) + ; (flush-output out) + ; ) ; thread them each ;; i could bind to values, and call wait on them @@ -126,14 +140,14 @@ (thread (lambda () (let loop [] (something-to-say in) - (sleep 1) + ; (sleep 1) (loop)))) - (thread (lambda () - (let loop [] - (something-to-broadcast out) - (sleep 1) - (loop)))) + ; (thread (lambda () + ; (let loop [] + ; (something-to-broadcast out) + ; (sleep 1) + ; (loop)))) ; (server-loop in out) ; (sleep 5) ;; wait 5 seconds to guarantee client has already send message 'ok @@ -158,15 +172,20 @@ (displayln (first messages) (get-output-port ports)) (flush-output (get-output-port ports)) ;; log message to server - (displayln "Message sent") + ;(displayln "Message sent") ) connections) ;; remove top message (set! messages (rest messages)) ;; current state of messages and connections - messages - connections) - (display "No message to display\n")) + ;messages + ;connections + (displayln "Message broadcasted")) + (begin (semaphore-wait stdout) + (display "No message to display\n") + (semaphore-post stdout))) + + ;;; -- NO LONGER IN USE --- TO BE DELETED ; Approach one was to broadcast via thread mailboxes ;(semaphore-wait threads-s) ;(if (not (null? messages)) From a540bc917f34e51651960470d5d73de64c4b3ccb Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 00:31:41 -0400 Subject: [PATCH 20/53] reduced time of broadcast to every 0.5 seconds to avoid hogging cpu and temps --- Hermes/client.rkt | 2 +- Hermes/server.rkt | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 574f88a..8aa19e1 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -92,7 +92,7 @@ ;; with server ;(semaphore-wait fair) ;; we will retrieve the line printed below from the server - (define evt (sync/timeout 30 (read-line-evt in))) + (define evt (sync/timeout 60 (read-line-evt in))) (cond [(eof-object? evt) (displayln "Server connection closed") (custodian-shutdown-all main-client-cust) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index de11d0e..4b590db 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -47,7 +47,7 @@ (display "Broadcast thread started!\n") (semaphore-post stdout) (let loopb [] - (sleep 10) ;; wait 30 secs before beginning to broadcast + (sleep 0.5) ;; wait 30 secs before beginning to broadcast (broadcast) (loopb))))) (lambda () @@ -98,7 +98,7 @@ (semaphore-wait stdout) (display "Started a thread to kill hanging connecting thread\n") (semaphore-post stdout) - (sleep 360) + (sleep 1360) (custodian-shutdown-all cust))))) ; (define (handle connections) From 11f4ae1946693cf5f46e8d0ed26494c490155e76 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 00:46:08 -0400 Subject: [PATCH 21/53] More updates. --- Hermes/server.rkt | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 4b590db..d3039d3 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -47,7 +47,7 @@ (display "Broadcast thread started!\n") (semaphore-post stdout) (let loopb [] - (sleep 0.5) ;; wait 30 secs before beginning to broadcast + ; (sleep 0.5) ;; wait 30 secs before beginning to broadcast (broadcast) (loopb))))) (lambda () @@ -166,7 +166,7 @@ (lambda () (semaphore-wait messages-s) - (if (not (null? messages)) + (cond [(not (null? messages)) (begin (map (lambda (ports) (displayln (first messages) (get-output-port ports)) @@ -180,10 +180,11 @@ ;; current state of messages and connections ;messages ;connections - (displayln "Message broadcasted")) - (begin (semaphore-wait stdout) - (display "No message to display\n") - (semaphore-post stdout))) + (displayln "Message broadcasted"))] + ) + ; (begin (semaphore-wait stdout) + ; (display "No message to display\n") + ; (semaphore-post stdout))) ;;; -- NO LONGER IN USE --- TO BE DELETED ; Approach one was to broadcast via thread mailboxes From 282197b1448dc34b2e26c352e6ebd0150c1f5199 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 12:23:26 -0400 Subject: [PATCH 22/53] cleaned up displaying format, added to delay to looped functions to not burn cpu cycles --- Hermes/client.rkt | 17 +++++++++-------- Hermes/server.rkt | 2 +- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 8aa19e1..329ea5d 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -1,5 +1,6 @@ #lang racket (require math/base) ;; for random number generation +;; TODO clean up string message output and alignment ;; author: Ibrahim Mkusa ;; about: print and read concurrently @@ -34,28 +35,28 @@ (display in) (displayln out) ;; binds to multiple values akin to unpacking tuples in python - (display "What's your name?\n") + (displayln "What's your name?") (define username (read-line)) ; (thread (lambda () ;; make threads 2 lines (define a (thread (lambda () - (displayln "Starting receiver thread\n") + (displayln "Starting receiver thread.") (let loop [] (receive-messages in) (sleep 1) (loop))))) (define t (thread (lambda () - (displayln "Starting sender thread\n") + (displayln "Starting sender thread.") (let loop [] (send-messages username out) (sleep 1) (loop))))) - (displayln "Now waiting for sender thread") + (displayln "Now waiting for sender thread.") (thread-wait t) ;; returns prompt back to drracket - (displayln "Closing client ports") + (displayln "Closing client ports.") (close-input-port in) (close-output-port out)) (custodian-shutdown-all main-client-cust)) @@ -75,7 +76,7 @@ ;(kill-thread t)))) (cond ((string=? input "quit") (exit))) ;; modify to send messages to out port - (displayln (string-append username ": " input "\n") out) + (displayln (string-append username ": " input) out) (flush-output out) ;(semaphore-post fair) @@ -94,7 +95,7 @@ ;; we will retrieve the line printed below from the server (define evt (sync/timeout 60 (read-line-evt in))) (cond [(eof-object? evt) - (displayln "Server connection closed") + (displayln "Server connection closed.") (custodian-shutdown-all main-client-cust) ;(exit) ] @@ -107,5 +108,5 @@ ) (define stop (client 4321)) -(display "Client started\n") +(displayln "Client started.") diff --git a/Hermes/server.rkt b/Hermes/server.rkt index d3039d3..a178222 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -47,7 +47,7 @@ (display "Broadcast thread started!\n") (semaphore-post stdout) (let loopb [] - ; (sleep 0.5) ;; wait 30 secs before beginning to broadcast + (sleep 0.5) ;; wait 0.5 secs before beginning to broadcast (broadcast) (loopb))))) (lambda () From 8984b45ac129ac35c4b05e00d7fbbd89cb086e58 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 12:33:13 -0400 Subject: [PATCH 23/53] Added a tracker for todo items and started added utility functions --- Hermes/TODO.txt | 7 +++++++ Hermes/client.rkt | 22 ++++++---------------- 2 files changed, 13 insertions(+), 16 deletions(-) create mode 100644 Hermes/TODO.txt diff --git a/Hermes/TODO.txt b/Hermes/TODO.txt new file mode 100644 index 0000000..9f9ae33 --- /dev/null +++ b/Hermes/TODO.txt @@ -0,0 +1,7 @@ +1. Create a racket module for commonly used functions +2. Log messages to proper file on server +3. add timestamps to clients messages +4. message parsable? +5. command parsable? +6. keep count of connected clients using object orientation +7. diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 329ea5d..894c178 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -1,28 +1,18 @@ #lang racket (require math/base) ;; for random number generation ;; TODO clean up string message output and alignment - ;; 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 - -;; Notes connect to server on localhost -;; use client template of tcpvanilla -;; use event for read-write - -;; modify read-loop-i -; read a value and send it to server via output-port - -; is there something in the input port. If yes? display it -; in the hello world +; Takes a string and a semaphore to print safely to stdout +(define displayln-safe + (lambda (a-string a-semaphore) + (semaphore-wait a-semaphore) + (displayln a-string) + (semaphore-post a-semaphore))) ; custodian for client connections (define main-client-cust (make-custodian)) From 3a5ce0d2aa1a6b4ad129ff4654baed9022edce42 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 12:57:55 -0400 Subject: [PATCH 24/53] refactored code to use thread-safe displayln-safe --- Hermes/TODO.txt | 3 ++- Hermes/client.rkt | 6 ------ Hermes/server.rkt | 37 ++++++++++++++++++------------------- 3 files changed, 20 insertions(+), 26 deletions(-) diff --git a/Hermes/TODO.txt b/Hermes/TODO.txt index 9f9ae33..d66b14a 100644 --- a/Hermes/TODO.txt +++ b/Hermes/TODO.txt @@ -4,4 +4,5 @@ 4. message parsable? 5. command parsable? 6. keep count of connected clients using object orientation -7. +7. maybe fiddle around with irc library +8. separate main running code from definitions diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 894c178..064db9e 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -7,12 +7,6 @@ ;; 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 -; Takes a string and a semaphore to print safely to stdout -(define displayln-safe - (lambda (a-string a-semaphore) - (semaphore-wait a-semaphore) - (displayln a-string) - (semaphore-post a-semaphore))) ; custodian for client connections (define main-client-cust (make-custodian)) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index a178222..ad84acc 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -23,7 +23,12 @@ ;; lets keep things civil (define stdout (make-semaphore 1)) -;; +; Takes a string and a semaphore to print safely to stdout +(define displayln-safe + (lambda (a-string a-semaphore) + (semaphore-wait a-semaphore) + (displayln a-string) + (semaphore-post a-semaphore))) ;; This is a relay server making two clients communicate ;; Both `server' and `accept-and-handle' change @@ -43,9 +48,7 @@ (thread loop) ;; Create a thread whose job is to simply call broadcast iteratively (thread (lambda () - (semaphore-wait stdout) - (display "Broadcast thread started!\n") - (semaphore-post stdout) + (displayln-safe "Broadcast thread started!\n" stdout) (let loopb [] (sleep 0.5) ;; wait 0.5 secs before beginning to broadcast (broadcast) @@ -58,12 +61,11 @@ (define cust (make-custodian)) (parameterize ([current-custodian cust]) (define-values (in out) (tcp-accept listener)) - (semaphore-wait stdout) - (displayln "Sucessfully connected to a client") - ;(display in) - ;(displayln out) - (displayln "Sending client Welcome message") - (semaphore-post stdout) + ;; TODO + (displayln-safe (string-append + "Successfully connected to a client.\n" + "Sending client a welcome message.") + stdout) (displayln "Welcome to Hermes coms\nType your message below" out) (flush-output out) ; discard request header @@ -95,9 +97,9 @@ ;; kills current thread for waiting too long for connection from ;; clients (thread (lambda () - (semaphore-wait stdout) - (display "Started a thread to kill hanging connecting thread\n") - (semaphore-post stdout) + (displayln-safe (string-append + "Started a thread to kill hanging " + "connecting threads") stdout) (sleep 1360) (custodian-shutdown-all cust))))) @@ -109,9 +111,8 @@ (define (something-to-say in) (define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed))) (cond [(eof-object? evt-t0) - (semaphore-wait stdout) - (displayln "Connection closed. EOF received") - (semaphore-post stdout) + (displayln-safe "Connection closed. EOF received" + stdout) (exit) ] [(string? evt-t0) @@ -121,9 +122,7 @@ (set! messages (append messages (list evt-t0))) (semaphore-post messages-s)] [else - (semaphore-wait stdout) - (displayln "Timeout waiting. Nothing received from client") - (semaphore-post stdout)])) + (displayln-safe "Timeout waiting. Nothing received from client" stdout)])) ; -----NO LONGER NECESSARY not using thread mailboxes ---- ; define function to deal with out From 2899891a63adc7ddfdf212e00342bd297542552d Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 13:26:01 -0400 Subject: [PATCH 25/53] tidied up server.rkt --- Hermes/server.rkt | 119 +++++++++------------------------------------- 1 file changed, 23 insertions(+), 96 deletions(-) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index ad84acc..96f314b 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -19,8 +19,7 @@ ;; lets keep thread descriptor values (define threads '()) ;; stores a list of client serving threads as thread descriptor values -;; several threads that might want to print to stdout -;; lets keep things civil +;; Several threads may want to print to stdout, so lets make things civil (define stdout (make-semaphore 1)) ; Takes a string and a semaphore to print safely to stdout @@ -30,12 +29,6 @@ (displayln a-string) (semaphore-post a-semaphore))) -;; This is a relay server making two clients communicate -;; Both `server' and `accept-and-handle' change -;; to use a custodian. -;; To start server -;; (define stop (serve 8080)) -;; (stop) to close the server (define (serve port-no) (define main-cust (make-custodian)) @@ -68,46 +61,28 @@ stdout) (displayln "Welcome to Hermes coms\nType your message below" out) (flush-output out) - ; discard request header - ; Discard the request header (up to blank line): - ; (regexp-match #rx"(\r\n|^)\r\n" in) (semaphore-wait connections-s) - ; (displayln "Got the semaphore") - ;; keep track of open ports (set! connections (append connections (list (list in out)))) (semaphore-post connections-s) - ; (displayln "Successfully added a pair of ports") - connections ; start a thread to deal with specific client and add descriptor value to the list of threads (semaphore-wait threads-s) (define threadcom (thread (lambda () - (handle in out) ;; this handles connection with that specific client - ;(display "handle successfully completed\n") - ; this might have been the issue - ;(close-input-port in) - ; (close-output-port out) - ))) + (handle in out)))) ; comms between server and particular client (set! threads (append threads (list threadcom))) (semaphore-post threads-s) - ; (displayln "Successfully created a thread") - ; (displayln threadcom) - ; threads - ;; Watcher thread: - ;; kills current thread for waiting too long for connection from - ;; clients - (thread (lambda () - (displayln-safe (string-append - "Started a thread to kill hanging " - "connecting threads") stdout) - (sleep 1360) - (custodian-shutdown-all cust))))) -; (define (handle connections) -; ()) -;; each thread needs 2 new threads + ;; 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") stdout) + (sleep 1360) + (custodian-shutdown-all cust))))) + (define (handle in out) - ; define function to deal with incoming messages from client + ; deals with queueing incoming messages for server to broadcast to all clients (define (something-to-say in) (define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed))) (cond [(eof-object? evt-t0) @@ -124,84 +99,36 @@ [else (displayln-safe "Timeout waiting. Nothing received from client" stdout)])) - ; -----NO LONGER NECESSARY not using thread mailboxes ---- - ; define function to deal with out - ;(define (something-to-broadcast out) - ; (define evt-t1 (sync/timeout 120 (thread-receive-evt))) - ;; send message to client - ; (fprintf out "~a~n" (thread-receive)) - ; (flush-output out) - ; ) - ; thread them each - - ;; i could bind to values, and call wait on them - ;; thread that deals with incoming messages for that particular thread + ; Executes methods above in another thread (thread (lambda () (let loop [] (something-to-say in) ; (sleep 1) - (loop)))) + (loop))))) - ; (thread (lambda () - ; (let loop [] - ; (something-to-broadcast out) - ; (sleep 1) - ; (loop)))) - ; (server-loop in out) - ; (sleep 5) ;; wait 5 seconds to guarantee client has already send message - 'ok - ) - -;; a bunch of selectors, predicates for connections +; extracts output port from a list pair of input and output port (define (get-output-port ports) - (cadr ports) - ) + (cadr ports)) +; extracts input port (define (get-input-port ports) - (car ports) -) -;; define a broadcast function + (car ports)) + +; broadcasts received message from clients periodically (define broadcast (lambda () (semaphore-wait messages-s) - (cond [(not (null? messages)) (begin (map (lambda (ports) (displayln (first messages) (get-output-port ports)) - (flush-output (get-output-port ports)) - ;; log message to server - ;(displayln "Message sent") - ) + (flush-output (get-output-port ports))) connections) ;; remove top message (set! messages (rest messages)) - ;; current state of messages and connections - ;messages - ;connections - (displayln "Message broadcasted"))] - ) - ; (begin (semaphore-wait stdout) - ; (display "No message to display\n") - ; (semaphore-post stdout))) - - ;;; -- NO LONGER IN USE --- TO BE DELETED - ; Approach one was to broadcast via thread mailboxes - ;(semaphore-wait threads-s) - ;(if (not (null? messages)) - ; (begin (map (lambda (thread-descriptor) - ; (thread-send thread-descriptor (first messages))) - ; threads) - ; (set! messages (rest messages)) - ; (displayln "Broadcasted a message\n") - ;) - ;(display "No message to display\n") ; for later create file port for errors and save error messages to that file - ;) - ; messages ; whats the current state of messages - ;(semaphore-post threads-s) - + (displayln "Message broadcasted"))]) (semaphore-post messages-s))) +; TODO move to its own file (define stop (serve 4321)) ;; start server then close with stop (display "Server process started\n") - From 4c26f1eaa3178bef2e69f38e63bd186e89c70381 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Wed, 12 Apr 2017 13:49:20 -0400 Subject: [PATCH 26/53] tidied up client.rkt. More stuff to TODO.txt --- Hermes/TODO.txt | 2 ++ Hermes/client.rkt | 39 +++++---------------------------------- 2 files changed, 7 insertions(+), 34 deletions(-) diff --git a/Hermes/TODO.txt b/Hermes/TODO.txt index d66b14a..02c421c 100644 --- a/Hermes/TODO.txt +++ b/Hermes/TODO.txt @@ -6,3 +6,5 @@ 6. keep count of connected clients using object orientation 7. maybe fiddle around with irc library 8. separate main running code from definitions +9. closure connections, messages, threads. Avoid using set! without an object + like make-account diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 064db9e..db1a50c 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -4,15 +4,12 @@ ;; 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 ; 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 "localhost" port-no)) ;; define values @@ -22,8 +19,6 @@ (displayln "What's your name?") (define username (read-line)) - ; (thread (lambda () - ;; make threads 2 lines (define a (thread (lambda () (displayln "Starting receiver thread.") @@ -46,37 +41,17 @@ (custodian-shutdown-all main-client-cust)) -;; the send-messages +;; sends a message to the server (define (send-messages username out) ;; intelligent read, quits when user types in "quit" - ;(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)))) (cond ((string=? input "quit") (exit))) - ;; modify to send messages to out port (displayln (string-append username ": " input) out) - (flush-output out) + (flush-output out)) - ;(semaphore-post fair) - ; (read-loop-i out) -) - - - -;; print hello world continously -;; "(hello-world)" can be executed as part of background thread -;; that prints in the event there is something in the input port +; receives input from server and displays it to stdout (define (receive-messages in) - ; (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 + ; retrieve a message from server (define evt (sync/timeout 60 (read-line-evt in))) (cond [(eof-object? evt) (displayln "Server connection closed.") @@ -86,11 +61,7 @@ [(string? evt) (displayln evt)] ; could time stamp here or to send message [else - (displayln (string-append "Nothing received from server for 2 minutes."))] - ) - ;(semaphore-post fair) -) + (displayln (string-append "Nothing received from server for 2 minutes."))])) (define stop (client 4321)) (displayln "Client started.") - From cffd7a429993da67bf6d64e713c4a147fe287b9c Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Thu, 13 Apr 2017 13:45:53 -0400 Subject: [PATCH 27/53] Added counter to keep track number of connected clients --- Hermes/TODO.txt | 5 ++++- Hermes/server.rkt | 44 ++++++++++++++++++++++++++++++++++++++------ 2 files changed, 42 insertions(+), 7 deletions(-) diff --git a/Hermes/TODO.txt b/Hermes/TODO.txt index 02c421c..c1f17fa 100644 --- a/Hermes/TODO.txt +++ b/Hermes/TODO.txt @@ -6,5 +6,8 @@ 6. keep count of connected clients using object orientation 7. maybe fiddle around with irc library 8. separate main running code from definitions -9. closure connections, messages, threads. Avoid using set! without an object +**9. closure connections, messages, threads. Avoid using set! without an object like make-account +make own count to deal with closures +10. authentication for databases +11. user can ask for no of logged in users. Server has to parse diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 96f314b..b0f2dff 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -4,10 +4,35 @@ ;; TODO wrap "safer send in a function that takes care of semaphores" ;; globals -;; must control access via semaphore as listener thread or broadcast thread -;; might need to access it +; 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)) +(define c-count-s (make-semaphore 1)) + (define connections '()) ;; maintains a list of open ports -;; ((in1, out1), (in2, out2), (in3, out3), (in4, out4) ...) + +(define (make-connections connections) + (define (null-cons?) + (null? connections)) + (define (add in out) + (set! connections (append connections (list (list in out)))) + connections) + (define (cons-list) + connections)) + (define connections-s (make-semaphore 1)) ;; control access to connections ;; every 5 seconds run to broadcast top message in list @@ -54,7 +79,11 @@ (define cust (make-custodian)) (parameterize ([current-custodian cust]) (define-values (in out) (tcp-accept listener)) - ;; TODO + ; increment number of connections + (semaphore-wait c-count-s) + ((c-count 'increment)) + (semaphore-post c-count-s) + (displayln-safe (string-append "Successfully connected to a client.\n" "Sending client a welcome message.") @@ -88,8 +117,11 @@ (cond [(eof-object? evt-t0) (displayln-safe "Connection closed. EOF received" stdout) - (exit) - ] + (semaphore-wait c-count-s) + ((c-count 'decrement)) + (semaphore-post c-count-s) + ;(exit) + (kill-thread (current-thread))] [(string? evt-t0) (semaphore-wait messages-s) ; append the message to list of messages From a0fbba4a81b0ebc4819c3413a8bf06ae0d3aeb5c Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Thu, 13 Apr 2017 14:01:32 -0400 Subject: [PATCH 28/53] tracking a list of input and output ports via closures and sets --- Hermes/server.rkt | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index b0f2dff..216c6e2 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -22,8 +22,8 @@ (define c-count (make-count 0)) (define c-count-s (make-semaphore 1)) -(define connections '()) ;; maintains a list of open ports +; track list of input output port pairs in a list contained in a closure (define (make-connections connections) (define (null-cons?) (null? connections)) @@ -31,7 +31,13 @@ (set! connections (append connections (list (list in out)))) connections) (define (cons-list) - connections)) + connections) + (define (dispatch m) + (cond [(eq? m 'null-cons) null-cons?] + [(eq? m 'cons-list) cons-list] + [(eq? m 'add) add])) + dispatch) +(define c-connections (make-connections '())) (define connections-s (make-semaphore 1)) ;; control access to connections @@ -91,7 +97,8 @@ (displayln "Welcome to Hermes coms\nType your message below" out) (flush-output out) (semaphore-wait connections-s) - (set! connections (append connections (list (list in out)))) + ; (set! connections (append connections (list (list in out)))) + ((c-connections 'add) in out) (semaphore-post connections-s) ; start a thread to deal with specific client and add descriptor value to the list of threads @@ -155,7 +162,7 @@ (lambda (ports) (displayln (first messages) (get-output-port ports)) (flush-output (get-output-port ports))) - connections) + ((c-connections 'cons-list))) ;; remove top message (set! messages (rest messages)) (displayln "Message broadcasted"))]) From 2c8407d195bef9219aad357bc2a327c392d38e1a Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Thu, 13 Apr 2017 14:09:40 -0400 Subject: [PATCH 29/53] tidied up, removed some unused definitions --- Hermes/{TODO.txt => TODO} | 0 Hermes/server.rkt | 9 ++------- 2 files changed, 2 insertions(+), 7 deletions(-) rename Hermes/{TODO.txt => TODO} (100%) diff --git a/Hermes/TODO.txt b/Hermes/TODO similarity index 100% rename from Hermes/TODO.txt rename to Hermes/TODO diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 216c6e2..59f33d2 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -1,8 +1,6 @@ #lang racket (require math/base) ;; for random number generation -;; TODO wrap "safer send in a function that takes care of semaphores" - ;; globals ; track number of connections with closure (define (make-count no-count) @@ -20,6 +18,7 @@ [(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)) @@ -38,7 +37,7 @@ [(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 ;; every 5 seconds run to broadcast top message in list @@ -46,10 +45,6 @@ (define messages-s (make-semaphore 1)) ;; control access to messages (define messages '()) ;; stores a list of messages(strings) from currents -(define threads-s (make-semaphore 1)) ;; control access to threads -;; lets keep thread descriptor values -(define threads '()) ;; stores a list of client serving threads as thread descriptor values - ;; Several threads may want to print to stdout, so lets make things civil (define stdout (make-semaphore 1)) From 31308f35fdc66da7a5059b108207bb1a71276770 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Thu, 13 Apr 2017 14:38:58 -0400 Subject: [PATCH 30/53] messages are now tracked via a closure. --- Hermes/client.rkt | 2 +- Hermes/server.rkt | 36 ++++++++++++++++++++++++------------ 2 files changed, 25 insertions(+), 13 deletions(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index db1a50c..11e2041 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -63,5 +63,5 @@ [else (displayln (string-append "Nothing received from server for 2 minutes."))])) +(displayln "Starting client.") (define stop (client 4321)) -(displayln "Client started.") diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 59f33d2..a672c2b 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -2,6 +2,7 @@ (require math/base) ;; for random number generation ;; globals +(define welcome-message "Welcome to Hermes coms. Type your message below") ; track number of connections with closure (define (make-count no-count) (define (increment) @@ -40,10 +41,24 @@ ; a semaphore to control acess to c-connections (define connections-s (make-semaphore 1)) ;; control access to connections -;; every 5 seconds run to broadcast top message in list -;; and remove it from list +; 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 -(define messages '()) ;; stores a list of messages(strings) from currents ;; Several threads may want to print to stdout, so lets make things civil (define stdout (make-semaphore 1)) @@ -86,10 +101,10 @@ (semaphore-post c-count-s) (displayln-safe (string-append - "Successfully connected to a client.\n" + "Successfully connected to a client. " "Sending client a welcome message.") stdout) - (displayln "Welcome to Hermes coms\nType your message below" out) + (displayln welcome-message out) (flush-output out) (semaphore-wait connections-s) ; (set! connections (append connections (list (list in out)))) @@ -97,11 +112,8 @@ (semaphore-post connections-s) ; start a thread to deal with specific client and add descriptor value to the list of threads - (semaphore-wait threads-s) (define threadcom (thread (lambda () (handle in out)))) ; comms between server and particular client - (set! threads (append threads (list threadcom))) - (semaphore-post threads-s) ;; Watcher thread: ;; kills current thread for waiting too long for connection from @@ -128,7 +140,7 @@ (semaphore-wait messages-s) ; append the message to list of messages (display (string-append evt-t0 "\n")) - (set! messages (append messages (list evt-t0))) + ((c-messages 'add) evt-t0) (semaphore-post messages-s)] [else (displayln-safe "Timeout waiting. Nothing received from client" stdout)])) @@ -152,14 +164,14 @@ (define broadcast (lambda () (semaphore-wait messages-s) - (cond [(not (null? messages)) + (cond [(not (null? ((c-messages 'mes-list)))) (begin (map (lambda (ports) - (displayln (first messages) (get-output-port ports)) + (displayln (first ((c-messages 'mes-list))) (get-output-port ports)) (flush-output (get-output-port ports))) ((c-connections 'cons-list))) ;; remove top message - (set! messages (rest messages)) + ((c-messages 'remove-top)) (displayln "Message broadcasted"))]) (semaphore-post messages-s))) From f6687e7d62ea9139f403c3c8d7c3ffa797aa3583 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Thu, 13 Apr 2017 15:20:47 -0400 Subject: [PATCH 31/53] timestamps added to messages --- Hermes/TODO | 7 +++++-- Hermes/client.rkt | 10 +++++++++- Hermes/server.rkt | 1 - 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index c1f17fa..5a357fc 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -1,6 +1,5 @@ 1. Create a racket module for commonly used functions 2. Log messages to proper file on server -3. add timestamps to clients messages 4. message parsable? 5. command parsable? 6. keep count of connected clients using object orientation @@ -10,4 +9,8 @@ like make-account make own count to deal with closures 10. authentication for databases -11. user can ask for no of logged in users. Server has to parse +11. user can ask for no of logged in users. Server has to pars +e +12. Hide user's own input in command line +13. Need to gracefully handle disconnected clients by removing from list +of connections diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 11e2041..86813ac 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -46,13 +46,21 @@ ;; intelligent read, quits when user types in "quit" (define input (read-line)) (cond ((string=? input "quit") (exit))) - (displayln (string-append username ": " input) 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-second date-today)) + "| ")) + (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/timeout 60 (read-line-evt in))) + (cond [(eof-object? evt) (displayln "Server connection closed.") (custodian-shutdown-all main-client-cust) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index a672c2b..20a83bb 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -107,7 +107,6 @@ (displayln welcome-message out) (flush-output out) (semaphore-wait connections-s) - ; (set! connections (append connections (list (list in out)))) ((c-connections 'add) in out) (semaphore-post connections-s) From 8d9765ca8c154f1a30695f2de3c26166d0451ae4 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Thu, 13 Apr 2017 15:57:58 -0400 Subject: [PATCH 32/53] Clients now default to leaving sign out messages --- Hermes/TODO | 6 ++---- Hermes/client.rkt | 14 ++++++++++---- Hermes/server.rkt | 5 +++++ 3 files changed, 17 insertions(+), 8 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index 5a357fc..bff56e6 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -5,12 +5,10 @@ 6. keep count of connected clients using object orientation 7. maybe fiddle around with irc library 8. separate main running code from definitions -**9. closure connections, messages, threads. Avoid using set! without an object - like make-account -make own count to deal with closures 10. authentication for databases 11. user can ask for no of logged in users. Server has to pars e 12. Hide user's own input in command line -13. Need to gracefully handle disconnected clients by removing from list +** 13. Need to gracefully handle disconnected clients by removing from list of connections +14. bye message prompt for clients diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 86813ac..9b7d4a0 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -43,16 +43,22 @@ ;; sends a message to the server (define (send-messages username out) - ;; intelligent read, quits when user types in "quit" - (define input (read-line)) - (cond ((string=? input "quit") (exit))) ; get current time (define date-today (seconds->date (current-seconds) #t)) ;TODO pad the second if its only 1 character (define date-print (string-append (number->string (date-hour date-today)) + ":" + (number->string (date-minute date-today)) ":" (number->string (date-second date-today)) - "| ")) + " | ")) + ;; intelligent read, quits when user types in "quit" + (define input (read-line)) + (cond ((string=? input "quit") + (displayln (string-append date-print username " signing out. See ya!") out) + (flush-output out) + (exit))) + (displayln (string-append date-print username ": " input) out) (flush-output out)) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 20a83bb..5b599a7 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -105,6 +105,11 @@ "Sending client a welcome message.") stdout) (displayln welcome-message out) + ;; print to server log and client + (define print-no-users (string-append "Number of users in chat: " + (number->string ((c-count 'current-count))))) + (displayln print-no-users out) + (displayln-safe print-no-users stdout) (flush-output out) (semaphore-wait connections-s) ((c-connections 'add) in out) From f8fef5c5ae63c0933f92a25d82da447ff44c2444 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Fri, 14 Apr 2017 00:44:42 -0400 Subject: [PATCH 33/53] now handles disconnected clients --- Hermes/TODO | 2 +- Hermes/server.rkt | 15 +++++++++++++++ 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/Hermes/TODO b/Hermes/TODO index bff56e6..c8dbc75 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -9,6 +9,6 @@ 11. user can ask for no of logged in users. Server has to pars e 12. Hide user's own input in command line -** 13. Need to gracefully handle disconnected clients by removing from list +** 13. Need to gracefully handle disconnected clients by removing from list user filter of connections 14. bye message prompt for clients diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 5b599a7..5673eca 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -32,9 +32,19 @@ 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 '())) @@ -133,6 +143,11 @@ (define (something-to-say in) (define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed))) (cond [(eof-object? evt-t0) + ; TODO remove pair of ports associated with client + (semaphore-wait connections-s) + ((c-connections 'remove-ports) in out) + (semaphore-post connections-s) + (displayln-safe "Connection closed. EOF received" stdout) (semaphore-wait c-count-s) From 0e1636e816dc58d26bf9686f2307b17043d0b218 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Fri, 14 Apr 2017 09:40:01 -0400 Subject: [PATCH 34/53] Hermes is pre-alpha ready --- Hermes/TODO | 8 ++++---- Hermes/client.rkt | 5 ++++- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index c8dbc75..8ad5a92 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -1,14 +1,14 @@ +FEATURES 1. Create a racket module for commonly used functions -2. Log messages to proper file on server +2. Log error messages and channel conservations to proper files on server 4. message parsable? 5. command parsable? -6. keep count of connected clients using object orientation 7. maybe fiddle around with irc library 8. separate main running code from definitions 10. authentication for databases 11. user can ask for no of logged in users. Server has to pars e 12. Hide user's own input in command line -** 13. Need to gracefully handle disconnected clients by removing from list user filter -of connections 14. bye message prompt for clients +15. Session stickiness for clients +16. plain tcp -> ssl based diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 9b7d4a0..3b65cfa 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -4,6 +4,9 @@ ;; author: Ibrahim Mkusa ;; about: print and read concurrently ;; notes: output may need to be aligned and formatted nicely +(define host "10.0.0.160") ; internal home +(define host2 "67.186.191.81") +(define port-num 4321) ; custodian for client connections @@ -12,7 +15,7 @@ (define (client port-no) (parameterize ([current-custodian main-client-cust]) ;; connect to server at port 8080 - (define-values (in out) (tcp-connect "localhost" port-no)) ;; define values + (define-values (in out) (tcp-connect host2 port-no)) ;; define values (display in) (displayln out) ;; binds to multiple values akin to unpacking tuples in python From fd2488cf59f0f19ee0e09ca4792fc2262bc4708e Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Fri, 14 Apr 2017 09:51:08 -0400 Subject: [PATCH 35/53] Tell git to ignore temporary files --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..49a9d25 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +# ignore temporary files +*~ From e09975a02c24c53a6b8c4a704b74236945c3fdcc Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Fri, 14 Apr 2017 09:57:40 -0400 Subject: [PATCH 36/53] tidied up --- {Hermes => tests/gui}/concurrentreadandprint.rkt | 0 {Hermes => tests/tcpvanilla}/tcpcommunication.rkt | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename {Hermes => tests/gui}/concurrentreadandprint.rkt (100%) rename {Hermes => tests/tcpvanilla}/tcpcommunication.rkt (100%) diff --git a/Hermes/concurrentreadandprint.rkt b/tests/gui/concurrentreadandprint.rkt similarity index 100% rename from Hermes/concurrentreadandprint.rkt rename to tests/gui/concurrentreadandprint.rkt diff --git a/Hermes/tcpcommunication.rkt b/tests/tcpvanilla/tcpcommunication.rkt similarity index 100% rename from Hermes/tcpcommunication.rkt rename to tests/tcpvanilla/tcpcommunication.rkt From 83911cc5f74a0eee2401c03b4afb2ae9aace5c65 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Fri, 14 Apr 2017 17:10:20 -0400 Subject: [PATCH 37/53] server now logs all received conversations and events to files --- Hermes/TODO | 2 ++ Hermes/client.rkt | 3 ++- Hermes/server.rkt | 67 +++++++++++++++++++++++++++++++---------------- 3 files changed, 49 insertions(+), 23 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index 8ad5a92..7b2c43f 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -12,3 +12,5 @@ e 14. bye message prompt for clients 15. Session stickiness for clients 16. plain tcp -> ssl based +17. fix breaks for improper disconnects from clients +18. Add topics after project completion diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 3b65cfa..745cf84 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -6,6 +6,7 @@ ;; notes: output may need to be aligned and formatted nicely (define host "10.0.0.160") ; internal home (define host2 "67.186.191.81") +(define host3 "localhost") (define port-num 4321) @@ -15,7 +16,7 @@ (define (client port-no) (parameterize ([current-custodian main-client-cust]) ;; connect to server at port 8080 - (define-values (in out) (tcp-connect host2 port-no)) ;; define values + (define-values (in out) (tcp-connect host3 port-no)) ;; define values (display in) (displayln out) ;; binds to multiple values akin to unpacking tuples in python diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 5673eca..54b1384 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -3,6 +3,8 @@ ;; globals (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.") + ; track number of connections with closure (define (make-count no-count) (define (increment) @@ -71,16 +73,32 @@ (define messages-s (make-semaphore 1)) ;; control access to messages ;; Several threads may want to print to stdout, so lets make things civil +; constant always available (define stdout (make-semaphore 1)) +; TODO refactor to take a port. defaults to current-output port in this context ; Takes a string and a semaphore to print safely to stdout (define displayln-safe - (lambda (a-string a-semaphore) - (semaphore-wait a-semaphore) - (displayln a-string) - (semaphore-post a-semaphore))) - + (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)]))) +; two files to store error messages, and channel conversations +(define error-out (open-output-file "/home/pcuser/Hermes/Hermes/error.txt" #:exists 'append)) +(define convs-out (open-output-file "/home/pcuser/Hermes/Hermes/conversations.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]) @@ -88,17 +106,24 @@ (define (loop) (accept-and-handle listener) (loop)) - (displayln "threading the listener") + (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" stdout) + (displayln-safe "Broadcast thread started!\n") (let loopb [] (sleep 0.5) ;; wait 0.5 secs before beginning to broadcast (broadcast) (loopb))))) (lambda () - (displayln "\nGoodbye, shutting down all services\n") + (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 (accept-and-handle listener) @@ -110,16 +135,13 @@ ((c-count 'increment)) (semaphore-post c-count-s) - (displayln-safe (string-append - "Successfully connected to a client. " - "Sending client a welcome message.") - stdout) + (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 stdout) + (displayln-safe print-no-users convs-out-s convs-out) (flush-output out) (semaphore-wait connections-s) ((c-connections 'add) in out) @@ -134,7 +156,7 @@ (thread (lambda () (displayln-safe (string-append "Started a thread to kill hanging " - "connecting threads") stdout) + "connecting threads")) (sleep 1360) (custodian-shutdown-all cust))))) @@ -143,13 +165,11 @@ (define (something-to-say in) (define evt-t0 (sync/timeout 60 (read-line-evt in 'linefeed))) (cond [(eof-object? evt-t0) - ; TODO remove pair of ports associated with client (semaphore-wait connections-s) ((c-connections 'remove-ports) in out) (semaphore-post connections-s) - - (displayln-safe "Connection closed. EOF received" - stdout) + ; 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) @@ -157,12 +177,12 @@ (kill-thread (current-thread))] [(string? evt-t0) (semaphore-wait messages-s) - ; append the message to list of messages - (display (string-append evt-t0 "\n")) + ; append the message to list of messages NO NEED done during broadcast + ; (displayln-safe evt-t0 convs-out-s convs-out) ((c-messages 'add) evt-t0) (semaphore-post messages-s)] [else - (displayln-safe "Timeout waiting. Nothing received from client" stdout)])) + (displayln-safe "Timeout waiting. Nothing received from client")])) ; Executes methods above in another thread (thread (lambda () @@ -180,6 +200,8 @@ (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) @@ -189,6 +211,7 @@ (displayln (first ((c-messages 'mes-list))) (get-output-port ports)) (flush-output (get-output-port ports))) ((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"))]) @@ -196,4 +219,4 @@ ; TODO move to its own file (define stop (serve 4321)) ;; start server then close with stop -(display "Server process started\n") +(displayln-safe "Server process started\n" error-out-s error-out) From 11bcec105200eef5da68bce4f1952338d204d8c1 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sat, 15 Apr 2017 20:32:26 -0400 Subject: [PATCH 38/53] preliminary work on adding sessions stickiness --- Hermes/TODO | 5 +++-- Hermes/client.rkt | 17 +++++++++++++++-- 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index 7b2c43f..f5f0a1c 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -1,6 +1,5 @@ FEATURES 1. Create a racket module for commonly used functions -2. Log error messages and channel conservations to proper files on server 4. message parsable? 5. command parsable? 7. maybe fiddle around with irc library @@ -10,7 +9,9 @@ FEATURES e 12. Hide user's own input in command line 14. bye message prompt for clients -15. Session stickiness for clients +*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 16. plain tcp -> ssl based 17. fix breaks for improper disconnects from clients 18. Add topics after project completion diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 745cf84..5e99a96 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -1,14 +1,26 @@ #lang racket (require math/base) ;; for random number generation ;; TODO clean up string message output and alignment +;; 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 + + + (define host "10.0.0.160") ; internal home (define host2 "67.186.191.81") (define host3 "localhost") (define port-num 4321) +(define hermes-conf (open-output-file "./hermes.conf" 'append)) +(define hermes-conf-s (make-semaphore 1)) + +(define convs-out (open-output-file "./convs.out" 'append)) +(define convs-out-s (make-semaphore 1)) + +(define error-out (open-output-file "./error.out" 'append)) +(define error-out-s (make-semaphore 1)) ; custodian for client connections (define main-client-cust (make-custodian)) @@ -17,9 +29,10 @@ (parameterize ([current-custodian main-client-cust]) ;; connect to server at port 8080 (define-values (in out) (tcp-connect host3 port-no)) ;; define values - (display in) - (displayln out) ;; 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)) From 413d13d7a65fdb6797903a0c56808730fd265b37 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sat, 15 Apr 2017 20:56:47 -0400 Subject: [PATCH 39/53] created modules/general.rkt to house common functions --- .gitignore | 8 ++++++++ Hermes/client.rkt | 6 +++--- Hermes/modules/general.rkt | 24 ++++++++++++++++++++++++ Hermes/server.rkt | 24 +++--------------------- 4 files changed, 38 insertions(+), 24 deletions(-) create mode 100644 Hermes/modules/general.rkt diff --git a/.gitignore b/.gitignore index 49a9d25..7c07843 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,10 @@ # ignore temporary files *~ + +# ignore logs and configuration files +*.out +*.conf + +# ignore racket compile files +*.dep +*.zo diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 5e99a96..9f20dc4 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -13,13 +13,13 @@ (define host3 "localhost") (define port-num 4321) -(define hermes-conf (open-output-file "./hermes.conf" 'append)) +(define hermes-conf (open-output-file "./hermes.conf" #:exists'append)) (define hermes-conf-s (make-semaphore 1)) -(define convs-out (open-output-file "./convs.out" 'append)) +(define convs-out (open-output-file "./convs.out" #:exists 'append)) (define convs-out-s (make-semaphore 1)) -(define error-out (open-output-file "./error.out" 'append)) +(define error-out (open-output-file "./error.out" #:exists 'append)) (define error-out-s (make-semaphore 1)) ; custodian for client connections 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 index 54b1384..a309ddc 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -1,6 +1,9 @@ #lang racket + +(require "modules/general.rkt") (require math/base) ;; for random number generation + ;; globals (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.") @@ -72,27 +75,6 @@ ; semaphore to control access to c-messages (define messages-s (make-semaphore 1)) ;; control access to messages -;; Several threads may want to print to stdout, so lets make things civil -; constant always available -(define stdout (make-semaphore 1)) - -; TODO refactor to take a port. defaults to current-output port in this context -; Takes a string and a semaphore to print safely to stdout -(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)]))) - ; two files to store error messages, and channel conversations (define error-out (open-output-file "/home/pcuser/Hermes/Hermes/error.txt" #:exists 'append)) (define convs-out (open-output-file "/home/pcuser/Hermes/Hermes/conversations.txt" #:exists 'append)) From 63c4e2e1854deee38bdd655623a11d71a7bae6b6 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sat, 15 Apr 2017 21:06:14 -0400 Subject: [PATCH 40/53] client logs end with _client and server logs end with _server --- Hermes/TODO | 4 +--- Hermes/client.rkt | 10 ++++++---- Hermes/server.rkt | 4 ++-- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index f5f0a1c..6bd88b0 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -1,5 +1,4 @@ FEATURES -1. Create a racket module for commonly used functions 4. message parsable? 5. command parsable? 7. maybe fiddle around with irc library @@ -7,8 +6,7 @@ FEATURES 10. authentication for databases 11. user can ask for no of logged in users. Server has to pars e -12. Hide user's own input in command line -14. bye message prompt for clients +*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 diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 9f20dc4..96f55b0 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -1,4 +1,6 @@ #lang racket + +(require "modules/general.rkt") (require math/base) ;; for random number generation ;; TODO clean up string message output and alignment ;; i.e. seconds and minutes hours specifically @@ -7,19 +9,19 @@ ;; notes: output may need to be aligned and formatted nicely - +; i could prompt for these instead (define host "10.0.0.160") ; internal home (define host2 "67.186.191.81") (define host3 "localhost") (define port-num 4321) -(define hermes-conf (open-output-file "./hermes.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.out" #:exists 'append)) +(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.out" #:exists 'append)) +(define error-out (open-output-file "./error_client.out" #:exists 'append)) (define error-out-s (make-semaphore 1)) ; custodian for client connections diff --git a/Hermes/server.rkt b/Hermes/server.rkt index a309ddc..ba2c1c2 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -76,8 +76,8 @@ (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 "/home/pcuser/Hermes/Hermes/error.txt" #:exists 'append)) -(define convs-out (open-output-file "/home/pcuser/Hermes/Hermes/conversations.txt" #:exists 'append)) +(define error-out (open-output-file "/home/pcuser/Hermes/Hermes/error_server.txt" #:exists 'append)) +(define convs-out (open-output-file "/home/pcuser/Hermes/Hermes/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 From a532a8cc71bd8e6522deed63237344a03768bafb Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sat, 15 Apr 2017 21:53:49 -0400 Subject: [PATCH 41/53] all output generated from client is now logged to appropriate _client files --- Hermes/TODO | 16 +++++++++------- Hermes/client.rkt | 22 +++++++++++++--------- 2 files changed, 22 insertions(+), 16 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index 6bd88b0..8135f57 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -1,15 +1,17 @@ FEATURES 4. message parsable? 5. command parsable? -7. maybe fiddle around with irc library 8. separate main running code from definitions -10. authentication for databases -11. user can ask for no of logged in users. Server has to pars -e +16. plain tcp -> ssl based +17. fix breaks for improper disconnects from clients +18. Add topics after project completion + +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 -16. plain tcp -> ssl based -17. fix breaks for improper disconnects from clients -18. Add topics after project completion +10. authentication for databases - to avoid dependencies this is left out +11. user can ask for no of logged in users. - server already reports + diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 96f55b0..3589765 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -3,6 +3,7 @@ (require "modules/general.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 @@ -40,21 +41,21 @@ (define a (thread (lambda () - (displayln "Starting receiver thread.") + (displayln-safe "Starting receiver thread." error-out-s error-out) (let loop [] (receive-messages in) (sleep 1) (loop))))) (define t (thread (lambda () - (displayln "Starting sender thread.") + (displayln-safe "Starting sender thread." error-out-s error-out) (let loop [] (send-messages username out) (sleep 1) (loop))))) - (displayln "Now waiting for sender thread.") + (displayln-safe "Now waiting for sender thread." error-out-s error-out) (thread-wait t) ;; returns prompt back to drracket - (displayln "Closing client ports.") + (displayln-safe "Closing client ports." error-out-s error-out) (close-input-port in) (close-output-port out)) (custodian-shutdown-all main-client-cust)) @@ -71,11 +72,14 @@ ":" (number->string (date-second date-today)) " | ")) - ;; intelligent read, quits when user types in "quit" + ;; 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) @@ -87,14 +91,14 @@ (define evt (sync/timeout 60 (read-line-evt in))) (cond [(eof-object? evt) - (displayln "Server connection closed.") + (displayln-safe "Server connection closed." error-out-s error-out) (custodian-shutdown-all main-client-cust) ;(exit) ] [(string? evt) - (displayln evt)] ; could time stamp here or to send message + (displayln-safe evt convs-out-s convs-out)] ; could time stamp here or to send message [else - (displayln (string-append "Nothing received from server for 2 minutes."))])) + (displayln-safe (string-append "Nothing received from server for 2 minutes.") convs-out-s convs-out)])) -(displayln "Starting client.") +(displayln-safe "Starting client." error-out-s error-out) (define stop (client 4321)) From 52edc75849a97ba2cdee96ade120eaf14a90258c Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 16 Apr 2017 13:50:26 -0400 Subject: [PATCH 42/53] more readable names for some functions --- Hermes/TODO | 11 ++++++++--- Hermes/client.rkt | 5 +++++ Hermes/server.rkt | 27 +++++++++++++++++---------- 3 files changed, 30 insertions(+), 13 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index 8135f57..0e41901 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -1,10 +1,13 @@ FEATURES -4. message parsable? -5. command parsable? -8. separate main running code from definitions +5. command(whisper, color, quit, count, users), message parsable? 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 +** put into a list if necessary for manipulation + +** adjust sleep time on all to be 0.1 for more responsiveness +** better function names 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,4 +17,6 @@ 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 11. user can ask for no of logged in users. - server already reports +even the list of users connected. +12. on connection server should also display list of users currently logged in diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 3589765..c328095 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -16,6 +16,7 @@ (define host3 "localhost") (define port-num 4321) +; 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)) @@ -39,6 +40,10 @@ (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) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index ba2c1c2..aab2347 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -32,8 +32,8 @@ (define (make-connections connections) (define (null-cons?) (null? connections)) - (define (add in out) - (set! connections (append connections (list (list in out)))) + (define (add username in out) + (set! connections (append connections (list (list username in out)))) connections) (define (cons-list) connections) @@ -86,7 +86,7 @@ (parameterize ([current-custodian main-cust]) (define listener (tcp-listen port-no 5 #t)) (define (loop) - (accept-and-handle listener) + (receive-clients listener) (loop)) (displayln-safe "Starting up the listener." error-out-s error-out) (thread loop) @@ -108,10 +108,17 @@ (semaphore-post convs-out-s) (custodian-shutdown-all main-cust))) -(define (accept-and-handle listener) +(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 (read-line-evt out)) + + + ; increment number of connections (semaphore-wait c-count-s) ((c-count 'increment)) @@ -126,12 +133,13 @@ (displayln-safe print-no-users convs-out-s convs-out) (flush-output out) (semaphore-wait connections-s) - ((c-connections 'add) in out) + ; 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 () - (handle in out)))) ; comms between server and particular client + (chat_with_client in out)))) ; comms between server and particular client ;; Watcher thread: ;; kills current thread for waiting too long for connection from @@ -142,7 +150,7 @@ (sleep 1360) (custodian-shutdown-all cust))))) -(define (handle in out) +(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/timeout 60 (read-line-evt in 'linefeed))) @@ -175,11 +183,11 @@ ; extracts output port from a list pair of input and output port (define (get-output-port ports) - (cadr ports)) + (caddr ports)) ; extracts input port (define (get-input-port ports) - (car ports)) + (cadr ports)) ; broadcasts received message from clients periodically ; TODO before broadcasting the message make sure the ports is still open @@ -199,6 +207,5 @@ (displayln "Message broadcasted"))]) (semaphore-post messages-s))) -; TODO move to its own file (define stop (serve 4321)) ;; start server then close with stop (displayln-safe "Server process started\n" error-out-s error-out) From 5d36ba1d5d56151442edf92f4521663af741fe8e Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 16 Apr 2017 14:06:39 -0400 Subject: [PATCH 43/53] username now stored along with related input output ports --- Hermes/server.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index aab2347..749d06d 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -115,7 +115,7 @@ ;TODO retrive user name for client here ; do some error checking - (define username-evt (read-line-evt out)) + (define username-evt (sync (read-line-evt in 'linefeed))) From 61e6c973179aa2392c13a7472fb66b4975ad6478 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 16 Apr 2017 16:24:16 -0400 Subject: [PATCH 44/53] Clients can now whisper to each other /whisper --- Hermes/TODO | 2 +- Hermes/server.rkt | 49 ++++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 45 insertions(+), 6 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index 0e41901..416162e 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -1,5 +1,5 @@ FEATURES -5. command(whisper, color, quit, count, users), message parsable? +5. command(whisper, count, users), message parsable? parse in the client side should do something similar for settings (color, quit) 16. plain tcp -> ssl based 17. fix breaks for improper disconnects from clients 18. Add topics after project completion diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 749d06d..3685de0 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -150,6 +150,16 @@ (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) @@ -166,11 +176,36 @@ ;(exit) (kill-thread (current-thread))] [(string? evt-t0) - (semaphore-wait messages-s) - ; append the message to list of messages NO NEED done during broadcast - ; (displayln-safe evt-t0 convs-out-s convs-out) - ((c-messages 'add) evt-t0) - (semaphore-post messages-s)] + ; 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).*" evt-t0)) ;; is client asking for number of logged in users + (define list-users (regexp-match #px"(^/list)\\s+(users).*" evt-t0)) ;; user names + (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)] + [else + (displayln-safe evt-t0) + (semaphore-wait messages-s) + ; evaluate it . + ((c-messages 'add) evt-t0) + (semaphore-post messages-s)])] [else (displayln-safe "Timeout waiting. Nothing received from client")])) @@ -189,6 +224,10 @@ (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 From ec7b9a644a62aed32b772b4af701e9280f589e41 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 16 Apr 2017 16:48:51 -0400 Subject: [PATCH 45/53] clients can type in /list count to ask for number of logged in users --- Hermes/TODO | 4 +++- Hermes/server.rkt | 16 ++++++++++++++-- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index 416162e..a1a92df 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -5,6 +5,8 @@ FEATURES 18. Add topics after project completion ** regexes to parse strings for different formats -related to 5 ** put into a list if necessary for manipulation +** sync/timeout to plain sync +** align code better for readability ** adjust sleep time on all to be 0.1 for more responsiveness ** better function names @@ -19,4 +21,4 @@ new ones 11. user can ask for no of logged in users. - server already reports even the list of users connected. 12. on connection server should also display list of users currently logged in - +** whispers aren't currently logged diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 3685de0..3092770 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -178,8 +178,9 @@ [(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).*" evt-t0)) ;; is client asking for number of logged in users - (define list-users (regexp-match #px"(^/list)\\s+(users).*" evt-t0)) ;; user names + (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 @@ -200,6 +201,17 @@ (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) + ] [else (displayln-safe evt-t0) (semaphore-wait messages-s) From 9e1f8c33d17189c6bdf4c4db9481c0c08ee12218 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 16 Apr 2017 17:07:19 -0400 Subject: [PATCH 46/53] clients can type /list users to get usernames logged in --- Hermes/Makefile | 4 ++-- Hermes/server.rkt | 12 +++++++++++- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/Hermes/Makefile b/Hermes/Makefile index eda5bbb..940b2a5 100644 --- a/Hermes/Makefile +++ b/Hermes/Makefile @@ -1,3 +1,3 @@ -# Remove idiotic save files +# Remove temporary files clean: - rm -rf *~ + rm -rf *~ *.out diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 3092770..6314f3b 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -179,7 +179,7 @@ ; 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 + (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) @@ -212,6 +212,16 @@ (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) (semaphore-wait messages-s) From 7e7edb4a54d18d7ee75a228b7f2209d99827449f Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 16 Apr 2017 17:20:17 -0400 Subject: [PATCH 47/53] sleep delay interval setting now managed as a global variable --- Hermes/client.rkt | 5 +++-- Hermes/server.rkt | 5 +++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index c328095..e50a37f 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -15,6 +15,7 @@ (define host2 "67.186.191.81") (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)) @@ -49,14 +50,14 @@ (displayln-safe "Starting receiver thread." error-out-s error-out) (let loop [] (receive-messages in) - (sleep 1) + (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 1) + (sleep sleep-t) (loop))))) (displayln-safe "Now waiting for sender thread." error-out-s error-out) (thread-wait t) ;; returns prompt back to drracket diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 6314f3b..ee949f5 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -4,10 +4,11 @@ (require math/base) ;; for random number generation -;; globals (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) @@ -95,7 +96,7 @@ (thread (lambda () (displayln-safe "Broadcast thread started!\n") (let loopb [] - (sleep 0.5) ;; wait 0.5 secs before beginning to broadcast + (sleep sleep-t) ;; wait 0.5 secs before beginning to broadcast (broadcast) (loopb))))) (lambda () From 6680d7504b2b1c45a6cfd0049212e162c279e172 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 16 Apr 2017 17:32:02 -0400 Subject: [PATCH 48/53] sync/timeout to plain sync. Its appropriate given the chat context --- Hermes/client.rkt | 2 +- Hermes/server.rkt | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index e50a37f..8959b1c 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -94,7 +94,7 @@ ; receives input from server and displays it to stdout (define (receive-messages in) ; retrieve a message from server - (define evt (sync/timeout 60 (read-line-evt in))) + (define evt (sync (read-line-evt in))) (cond [(eof-object? evt) (displayln-safe "Server connection closed." error-out-s error-out) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index ee949f5..5e5f546 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -164,7 +164,7 @@ (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/timeout 60 (read-line-evt in 'linefeed))) + (define evt-t0 (sync (read-line-evt in 'linefeed))) (cond [(eof-object? evt-t0) (semaphore-wait connections-s) ((c-connections 'remove-ports) in out) @@ -224,7 +224,7 @@ (flush-output out) (semaphore-post connections-s)] [else - (displayln-safe evt-t0) + ; (displayln-safe evt-t0) debug purposes (semaphore-wait messages-s) ; evaluate it . ((c-messages 'add) evt-t0) From f10fb083cda715faba8d5aab40dbcf9ab0d501c1 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 16 Apr 2017 17:47:42 -0400 Subject: [PATCH 49/53] broadcast now checks whether port is open before trying to send --- Hermes/TODO | 11 ++--------- Hermes/client.rkt | 6 +++--- Hermes/server.rkt | 9 ++++++--- 3 files changed, 11 insertions(+), 15 deletions(-) diff --git a/Hermes/TODO b/Hermes/TODO index a1a92df..bbc2930 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -1,15 +1,11 @@ FEATURES -5. command(whisper, count, users), message parsable? parse in the client side should do something similar for settings (color, quit) +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 -** put into a list if necessary for manipulation -** sync/timeout to plain sync ** align code better for readability -** adjust sleep time on all to be 0.1 for more responsiveness -** better function names 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 @@ -18,7 +14,4 @@ GOOD TO HAVE BUT NOT NECESSARY 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 -11. user can ask for no of logged in users. - server already reports -even the list of users connected. -12. on connection server should also display list of users currently logged in -** whispers aren't currently logged +** whispers aren't currently logged - its on purpose diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 8959b1c..0e3c986 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -10,8 +10,8 @@ ;; notes: output may need to be aligned and formatted nicely -; i could prompt for these instead -(define host "10.0.0.160") ; internal home +; we will prompt for these in the gui +(define host "10.0.0.160") (define host2 "67.186.191.81") (define host3 "localhost") (define port-num 4321) @@ -107,4 +107,4 @@ (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 4321)) +(define stop-client (client 4321)) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 5e5f546..df1cf26 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -260,8 +260,11 @@ (cond [(not (null? ((c-messages 'mes-list)))) (begin (map (lambda (ports) - (displayln (first ((c-messages 'mes-list))) (get-output-port ports)) - (flush-output (get-output-port 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 @@ -269,5 +272,5 @@ (displayln "Message broadcasted"))]) (semaphore-post messages-s))) -(define stop (serve 4321)) ;; start server then close with stop +(define stop-server (serve 4321)) ;; start server then close with stop (displayln-safe "Server process started\n" error-out-s error-out) From ed029f79066c8566e313794a6f66ae4c73614acc Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 16 Apr 2017 18:19:00 -0400 Subject: [PATCH 50/53] minor additions --- Hermes/Makefile | 2 +- Hermes/client.rkt | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/Hermes/Makefile b/Hermes/Makefile index 940b2a5..fdd9a07 100644 --- a/Hermes/Makefile +++ b/Hermes/Makefile @@ -1,3 +1,3 @@ # Remove temporary files clean: - rm -rf *~ *.out + rm -rf *~ *.out *.conf diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 0e3c986..d4ad2a0 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -11,8 +11,6 @@ ; we will prompt for these in the gui -(define host "10.0.0.160") -(define host2 "67.186.191.81") (define host3 "localhost") (define port-num 4321) (define sleep-t 0.1) From 684f172537d838cb85ade3480600325d50a6c544 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 16 Apr 2017 18:45:22 -0400 Subject: [PATCH 51/53] use relative paths when opening files --- .gitignore | 1 + Hermes/Makefile | 2 +- Hermes/server.rkt | 4 ++-- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index 7c07843..b917769 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ # ignore temporary files *~ +*.txt # ignore logs and configuration files *.out diff --git a/Hermes/Makefile b/Hermes/Makefile index fdd9a07..c580a71 100644 --- a/Hermes/Makefile +++ b/Hermes/Makefile @@ -1,3 +1,3 @@ # Remove temporary files clean: - rm -rf *~ *.out *.conf + rm -rf *~ *.out *.conf *.txt diff --git a/Hermes/server.rkt b/Hermes/server.rkt index df1cf26..9b1a171 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -77,8 +77,8 @@ (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 "/home/pcuser/Hermes/Hermes/error_server.txt" #:exists 'append)) -(define convs-out (open-output-file "/home/pcuser/Hermes/Hermes/conversations_server.txt" #:exists 'append)) +(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 From 0f665650917f84edfbc38042665c687abca514c2 Mon Sep 17 00:00:00 2001 From: Douglas-Richardson Date: Wed, 19 Apr 2017 17:16:46 -0400 Subject: [PATCH 52/53] Added GUI to thing yay --- Hermes/Hermes_Gui1.3.rkt | 196 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 196 insertions(+) create mode 100644 Hermes/Hermes_Gui1.3.rkt 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)) + From 95f7e7443363f21cda927b1446271d5008c439d6 Mon Sep 17 00:00:00 2001 From: Douglas-Richardson Date: Wed, 19 Apr 2017 17:20:10 -0400 Subject: [PATCH 53/53] requires gui now --- Hermes/client.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index d4ad2a0..64710bb 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -1,6 +1,6 @@ #lang racket -(require "modules/general.rkt") +(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