commit
9b5da77619
8
.gitignore
vendored
8
.gitignore
vendored
@ -1,2 +1,10 @@
|
|||||||
# ignore temporary files
|
# ignore temporary files
|
||||||
*~
|
*~
|
||||||
|
|
||||||
|
# ignore logs and configuration files
|
||||||
|
*.out
|
||||||
|
*.conf
|
||||||
|
|
||||||
|
# ignore racket compile files
|
||||||
|
*.dep
|
||||||
|
*.zo
|
||||||
|
@ -1,3 +1,3 @@
|
|||||||
# Remove idiotic save files
|
# Remove temporary files
|
||||||
clean:
|
clean:
|
||||||
rm -rf *~
|
rm -rf *~ *.out *.conf
|
||||||
|
27
Hermes/TODO
27
Hermes/TODO
@ -1,14 +1,17 @@
|
|||||||
FEATURES
|
FEATURES
|
||||||
1. Create a racket module for commonly used functions
|
5. parser in the client side should do something similar (/color, /quit)
|
||||||
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
|
|
||||||
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
|
|
||||||
14. bye message prompt for clients
|
|
||||||
15. Session stickiness for clients
|
|
||||||
16. plain tcp -> ssl based
|
16. plain tcp -> ssl based
|
||||||
|
17. fix breaks for improper disconnects from clients
|
||||||
|
18. Add topics after project completion
|
||||||
|
** regexes to parse strings for different formats -related to 5
|
||||||
|
** align code better for readability
|
||||||
|
|
||||||
|
|
||||||
|
GOOD TO HAVE BUT NOT NECESSARY
|
||||||
|
7. maybe fiddle around with irc library (we leave this for future opl classes) no time got other classes
|
||||||
|
*14. bye message prompt for clients part of session stickiness
|
||||||
|
*15. Session stickiness for clients. Log received comms to a local file.
|
||||||
|
additionally save user details and prompt user to use defaults or create
|
||||||
|
new ones
|
||||||
|
10. authentication for databases - to avoid dependencies this is left out
|
||||||
|
** whispers aren't currently logged - its on purpose
|
||||||
|
@ -1,44 +1,65 @@
|
|||||||
#lang racket
|
#lang racket
|
||||||
|
|
||||||
|
(require "modules/general.rkt")
|
||||||
(require math/base) ;; for random number generation
|
(require math/base) ;; for random number generation
|
||||||
;; TODO clean up string message output and alignment
|
;; TODO clean up string message output and alignment
|
||||||
|
;; TODO close ports after done
|
||||||
|
;; i.e. seconds and minutes hours specifically
|
||||||
;; author: Ibrahim Mkusa
|
;; author: Ibrahim Mkusa
|
||||||
;; about: print and read concurrently
|
;; about: print and read concurrently
|
||||||
;; notes: output may need to be aligned and formatted nicely
|
;; 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)
|
|
||||||
|
|
||||||
|
|
||||||
|
; we will prompt for these in the gui
|
||||||
|
(define host3 "localhost")
|
||||||
|
(define port-num 4321)
|
||||||
|
(define sleep-t 0.1)
|
||||||
|
|
||||||
|
; we won't need this. Just me being overzealous
|
||||||
|
(define hermes-conf (open-output-file "./hermes_client.conf" #:exists'append))
|
||||||
|
(define hermes-conf-s (make-semaphore 1))
|
||||||
|
|
||||||
|
(define convs-out (open-output-file "./convs_client.out" #:exists 'append))
|
||||||
|
(define convs-out-s (make-semaphore 1))
|
||||||
|
|
||||||
|
(define error-out (open-output-file "./error_client.out" #:exists 'append))
|
||||||
|
(define error-out-s (make-semaphore 1))
|
||||||
|
|
||||||
; custodian for client connections
|
; custodian for client connections
|
||||||
(define main-client-cust (make-custodian))
|
(define main-client-cust (make-custodian))
|
||||||
; make connection to server
|
; make connection to server
|
||||||
(define (client port-no)
|
(define (client port-no)
|
||||||
(parameterize ([current-custodian main-client-cust])
|
(parameterize ([current-custodian main-client-cust])
|
||||||
;; connect to server at port 8080
|
;; 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
|
;; 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?")
|
(displayln "What's your name?")
|
||||||
(define username (read-line))
|
(define username (read-line))
|
||||||
|
|
||||||
|
;send the username to the server (username in out)
|
||||||
|
(displayln username out)
|
||||||
|
(flush-output out)
|
||||||
|
|
||||||
(define a (thread
|
(define a (thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(displayln "Starting receiver thread.")
|
(displayln-safe "Starting receiver thread." error-out-s error-out)
|
||||||
(let loop []
|
(let loop []
|
||||||
(receive-messages in)
|
(receive-messages in)
|
||||||
(sleep 1)
|
(sleep sleep-t)
|
||||||
(loop)))))
|
(loop)))))
|
||||||
(define t (thread
|
(define t (thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(displayln "Starting sender thread.")
|
(displayln-safe "Starting sender thread." error-out-s error-out)
|
||||||
(let loop []
|
(let loop []
|
||||||
(send-messages username out)
|
(send-messages username out)
|
||||||
(sleep 1)
|
(sleep sleep-t)
|
||||||
(loop)))))
|
(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
|
(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-input-port in)
|
||||||
(close-output-port out))
|
(close-output-port out))
|
||||||
(custodian-shutdown-all main-client-cust))
|
(custodian-shutdown-all main-client-cust))
|
||||||
@ -55,11 +76,14 @@
|
|||||||
":"
|
":"
|
||||||
(number->string (date-second date-today))
|
(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))
|
(define input (read-line))
|
||||||
|
; TODO /quit instead of quit
|
||||||
(cond ((string=? input "quit")
|
(cond ((string=? input "quit")
|
||||||
(displayln (string-append date-print username " signing out. See ya!") out)
|
(displayln (string-append date-print username " signing out. See ya!") out)
|
||||||
(flush-output out)
|
(flush-output out)
|
||||||
|
(close-output-port error-out)
|
||||||
|
(close-output-port convs-out)
|
||||||
(exit)))
|
(exit)))
|
||||||
|
|
||||||
(displayln (string-append date-print username ": " input) out)
|
(displayln (string-append date-print username ": " input) out)
|
||||||
@ -68,17 +92,17 @@
|
|||||||
; receives input from server and displays it to stdout
|
; receives input from server and displays it to stdout
|
||||||
(define (receive-messages in)
|
(define (receive-messages in)
|
||||||
; retrieve a message from server
|
; 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)
|
(cond [(eof-object? evt)
|
||||||
(displayln "Server connection closed.")
|
(displayln-safe "Server connection closed." error-out-s error-out)
|
||||||
(custodian-shutdown-all main-client-cust)
|
(custodian-shutdown-all main-client-cust)
|
||||||
;(exit)
|
;(exit)
|
||||||
]
|
]
|
||||||
[(string? evt)
|
[(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
|
[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))
|
(define stop-client (client 4321))
|
||||||
|
24
Hermes/modules/general.rkt
Normal file
24
Hermes/modules/general.rkt
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
#lang racket
|
||||||
|
|
||||||
|
(provide displayln-safe)
|
||||||
|
;; Several threads may want to print to stdout, so lets make things civil
|
||||||
|
; constant always available
|
||||||
|
(define stdout (make-semaphore 1))
|
||||||
|
|
||||||
|
; prints to stdout with an optional output port
|
||||||
|
; requires a specified semaphore for the optional output port
|
||||||
|
(define displayln-safe
|
||||||
|
(lambda (a-string [a-semaphore stdout] [a-output-port (current-output-port)])
|
||||||
|
(cond [(not (and (eq? a-semaphore stdout) (eq? a-output-port (current-output-port))))
|
||||||
|
(semaphore-wait a-semaphore)
|
||||||
|
(semaphore-wait stdout)
|
||||||
|
(displayln a-string a-output-port)
|
||||||
|
(flush-output a-output-port)
|
||||||
|
(displayln a-string)
|
||||||
|
(semaphore-post stdout)
|
||||||
|
(semaphore-post a-semaphore)]
|
||||||
|
[else
|
||||||
|
(semaphore-wait stdout)
|
||||||
|
(displayln a-string)
|
||||||
|
(semaphore-post stdout)])))
|
||||||
|
|
@ -1,8 +1,14 @@
|
|||||||
#lang racket
|
#lang racket
|
||||||
|
|
||||||
|
(require "modules/general.rkt")
|
||||||
(require math/base) ;; for random number generation
|
(require math/base) ;; for random number generation
|
||||||
|
|
||||||
;; globals
|
|
||||||
(define welcome-message "Welcome to Hermes coms. Type your message below")
|
(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
|
; track number of connections with closure
|
||||||
(define (make-count no-count)
|
(define (make-count no-count)
|
||||||
(define (increment)
|
(define (increment)
|
||||||
@ -27,8 +33,8 @@
|
|||||||
(define (make-connections connections)
|
(define (make-connections connections)
|
||||||
(define (null-cons?)
|
(define (null-cons?)
|
||||||
(null? connections))
|
(null? connections))
|
||||||
(define (add in out)
|
(define (add username in out)
|
||||||
(set! connections (append connections (list (list in out))))
|
(set! connections (append connections (list (list username in out))))
|
||||||
connections)
|
connections)
|
||||||
(define (cons-list)
|
(define (cons-list)
|
||||||
connections)
|
connections)
|
||||||
@ -70,99 +76,161 @@
|
|||||||
; semaphore to control access to c-messages
|
; semaphore to control access to c-messages
|
||||||
(define messages-s (make-semaphore 1)) ;; control access to messages
|
(define messages-s (make-semaphore 1)) ;; control access to messages
|
||||||
|
|
||||||
;; Several threads may want to print to stdout, so lets make things civil
|
; two files to store error messages, and channel conversations
|
||||||
(define stdout (make-semaphore 1))
|
(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))
|
||||||
; Takes a string and a semaphore to print safely to stdout
|
(define error-out-s (make-semaphore 1))
|
||||||
(define displayln-safe
|
(define convs-out-s (make-semaphore 1))
|
||||||
(lambda (a-string a-semaphore)
|
; TODO finish logging all error related messages to
|
||||||
(semaphore-wait a-semaphore)
|
|
||||||
(displayln a-string)
|
|
||||||
(semaphore-post a-semaphore)))
|
|
||||||
|
|
||||||
|
|
||||||
(define (serve port-no)
|
(define (serve port-no)
|
||||||
(define main-cust (make-custodian))
|
(define main-cust (make-custodian))
|
||||||
(parameterize ([current-custodian main-cust])
|
(parameterize ([current-custodian main-cust])
|
||||||
(define listener (tcp-listen port-no 5 #t))
|
(define listener (tcp-listen port-no 5 #t))
|
||||||
(define (loop)
|
(define (loop)
|
||||||
(accept-and-handle listener)
|
(receive-clients listener)
|
||||||
(loop))
|
(loop))
|
||||||
(displayln "threading the listener")
|
(displayln-safe "Starting up the listener." error-out-s error-out)
|
||||||
(thread loop)
|
(thread loop)
|
||||||
|
(displayln-safe "Listener successfully started." error-out-s error-out)
|
||||||
;; Create a thread whose job is to simply call broadcast iteratively
|
;; Create a thread whose job is to simply call broadcast iteratively
|
||||||
(thread (lambda ()
|
(thread (lambda ()
|
||||||
(displayln-safe "Broadcast thread started!\n" stdout)
|
(displayln-safe "Broadcast thread started!\n")
|
||||||
(let loopb []
|
(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)
|
(broadcast)
|
||||||
(loopb)))))
|
(loopb)))))
|
||||||
(lambda ()
|
(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)))
|
(custodian-shutdown-all main-cust)))
|
||||||
|
|
||||||
(define (accept-and-handle listener)
|
(define (receive-clients listener)
|
||||||
(define cust (make-custodian))
|
(define cust (make-custodian))
|
||||||
(parameterize ([current-custodian cust])
|
(parameterize ([current-custodian cust])
|
||||||
(define-values (in out) (tcp-accept listener))
|
(define-values (in out) (tcp-accept listener))
|
||||||
|
|
||||||
|
;TODO retrive user name for client here
|
||||||
|
; do some error checking
|
||||||
|
(define username-evt (sync (read-line-evt in 'linefeed)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
; increment number of connections
|
; increment number of connections
|
||||||
(semaphore-wait c-count-s)
|
(semaphore-wait c-count-s)
|
||||||
((c-count 'increment))
|
((c-count 'increment))
|
||||||
(semaphore-post c-count-s)
|
(semaphore-post c-count-s)
|
||||||
|
|
||||||
(displayln-safe (string-append
|
(displayln-safe successful-connection-m)
|
||||||
"Successfully connected to a client. "
|
|
||||||
"Sending client a welcome message.")
|
|
||||||
stdout)
|
|
||||||
(displayln welcome-message out)
|
(displayln welcome-message out)
|
||||||
;; print to server log and client
|
;; print to server log and client
|
||||||
(define print-no-users (string-append "Number of users in chat: "
|
(define print-no-users (string-append "Number of users in chat: "
|
||||||
(number->string ((c-count 'current-count)))))
|
(number->string ((c-count 'current-count)))))
|
||||||
(displayln print-no-users out)
|
(displayln print-no-users out)
|
||||||
(displayln-safe print-no-users stdout)
|
(displayln-safe print-no-users convs-out-s convs-out)
|
||||||
(flush-output out)
|
(flush-output out)
|
||||||
(semaphore-wait connections-s)
|
(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)
|
(semaphore-post connections-s)
|
||||||
|
|
||||||
; start a thread to deal with specific client and add descriptor value to the list of threads
|
; start a thread to deal with specific client and add descriptor value to the list of threads
|
||||||
(define threadcom (thread (lambda ()
|
(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:
|
;; Watcher thread:
|
||||||
;; kills current thread for waiting too long for connection from
|
;; kills current thread for waiting too long for connection from
|
||||||
(thread (lambda ()
|
(thread (lambda ()
|
||||||
(displayln-safe (string-append
|
(displayln-safe (string-append
|
||||||
"Started a thread to kill hanging "
|
"Started a thread to kill hanging "
|
||||||
"connecting threads") stdout)
|
"connecting threads"))
|
||||||
(sleep 1360)
|
(sleep 1360)
|
||||||
(custodian-shutdown-all cust)))))
|
(custodian-shutdown-all cust)))))
|
||||||
|
|
||||||
(define (handle in out)
|
; 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
|
; deals with queueing incoming messages for server to broadcast to all clients
|
||||||
(define (something-to-say in)
|
(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)
|
(cond [(eof-object? evt-t0)
|
||||||
; TODO remove pair of ports associated with client
|
|
||||||
(semaphore-wait connections-s)
|
(semaphore-wait connections-s)
|
||||||
((c-connections 'remove-ports) in out)
|
((c-connections 'remove-ports) in out)
|
||||||
(semaphore-post connections-s)
|
(semaphore-post connections-s)
|
||||||
|
; TODO some form of identification for this client
|
||||||
(displayln-safe "Connection closed. EOF received"
|
(displayln-safe "Connection closed. EOF received" error-out-s error-out)
|
||||||
stdout)
|
|
||||||
(semaphore-wait c-count-s)
|
(semaphore-wait c-count-s)
|
||||||
((c-count 'decrement))
|
((c-count 'decrement))
|
||||||
(semaphore-post c-count-s)
|
(semaphore-post c-count-s)
|
||||||
;(exit)
|
;(exit)
|
||||||
(kill-thread (current-thread))]
|
(kill-thread (current-thread))]
|
||||||
[(string? evt-t0)
|
[(string? evt-t0)
|
||||||
(semaphore-wait messages-s)
|
; use regexes to evaluate received input from client
|
||||||
; append the message to list of messages
|
(define whisper (regexp-match #px"(.*)/whisper\\s+(\\w+)\\s+(.*)" evt-t0)) ; is client trying to whisper to someone
|
||||||
(display (string-append evt-t0 "\n"))
|
(define list-count (regexp-match #px"(.*)/list\\s+count\\s*" evt-t0)) ;; is client asking for number of logged in users
|
||||||
((c-messages 'add) evt-t0)
|
(define list-users (regexp-match #px"(.*)/list\\s+users\\s*" evt-t0)) ;; user names
|
||||||
(semaphore-post messages-s)]
|
; do something whether it was a message, a whisper, request for number of users and so on
|
||||||
|
(cond [whisper
|
||||||
|
(semaphore-wait connections-s)
|
||||||
|
; get output port for user
|
||||||
|
(define that-user-ports
|
||||||
|
(first (filter
|
||||||
|
(lambda (ports)
|
||||||
|
(if (string=? (whisper-to whisper) (get-username ports))
|
||||||
|
#t
|
||||||
|
#f))
|
||||||
|
((c-connections 'cons-list)))))
|
||||||
|
; try to send that user the whisper
|
||||||
|
(if (port-closed? (get-output-port that-user-ports))
|
||||||
|
(begin
|
||||||
|
(displayln "User is unavailable" out)
|
||||||
|
(flush-output out))
|
||||||
|
(begin
|
||||||
|
(displayln (string-append (whisper-info whisper) (whisper-message whisper))
|
||||||
|
(get-output-port that-user-ports))
|
||||||
|
(flush-output (get-output-port that-user-ports))))
|
||||||
|
(semaphore-post connections-s)]
|
||||||
|
[list-count
|
||||||
|
;;should put a semaphore on connections
|
||||||
|
(semaphore-wait c-count-s)
|
||||||
|
(semaphore-wait connections-s)
|
||||||
|
(define no-of-users (string-append "Number of users in chat: "
|
||||||
|
(number->string ((c-count 'current-count)))))
|
||||||
|
(displayln no-of-users out)
|
||||||
|
(flush-output out)
|
||||||
|
(semaphore-post connections-s)
|
||||||
|
(semaphore-post c-count-s)
|
||||||
|
]
|
||||||
|
[list-users
|
||||||
|
(semaphore-wait connections-s)
|
||||||
|
; map over connections sending the username to the client
|
||||||
|
(displayln "Here is a list of users in chat." out)
|
||||||
|
(map
|
||||||
|
(lambda (ports)
|
||||||
|
(displayln (get-username ports) out))
|
||||||
|
((c-connections 'cons-list)))
|
||||||
|
(flush-output out)
|
||||||
|
(semaphore-post connections-s)]
|
||||||
|
[else
|
||||||
|
; (displayln-safe evt-t0) debug purposes
|
||||||
|
(semaphore-wait messages-s)
|
||||||
|
; evaluate it .
|
||||||
|
((c-messages 'add) evt-t0)
|
||||||
|
(semaphore-post messages-s)])]
|
||||||
[else
|
[else
|
||||||
(displayln-safe "Timeout waiting. Nothing received from client" stdout)]))
|
(displayln-safe "Timeout waiting. Nothing received from client")]))
|
||||||
|
|
||||||
; Executes methods above in another thread
|
; Executes methods above in another thread
|
||||||
(thread (lambda ()
|
(thread (lambda ()
|
||||||
@ -173,27 +241,36 @@
|
|||||||
|
|
||||||
; extracts output port from a list pair of input and output port
|
; extracts output port from a list pair of input and output port
|
||||||
(define (get-output-port ports)
|
(define (get-output-port ports)
|
||||||
(cadr ports))
|
(caddr ports))
|
||||||
|
|
||||||
; extracts input port
|
; extracts input port
|
||||||
(define (get-input-port ports)
|
(define (get-input-port ports)
|
||||||
|
(cadr ports))
|
||||||
|
|
||||||
|
; extract username
|
||||||
|
(define (get-username ports)
|
||||||
(car ports))
|
(car ports))
|
||||||
|
|
||||||
; broadcasts received message from clients periodically
|
; 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
|
(define broadcast
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(semaphore-wait messages-s)
|
(semaphore-wait messages-s)
|
||||||
(cond [(not (null? ((c-messages 'mes-list))))
|
(cond [(not (null? ((c-messages 'mes-list))))
|
||||||
(begin (map
|
(begin (map
|
||||||
(lambda (ports)
|
(lambda (ports)
|
||||||
(displayln (first ((c-messages 'mes-list))) (get-output-port ports))
|
(if (not (port-closed? (get-output-port ports)))
|
||||||
(flush-output (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)))
|
((c-connections 'cons-list)))
|
||||||
|
(displayln-safe (first ((c-messages 'mes-list))) convs-out-s convs-out)
|
||||||
;; remove top message
|
;; remove top message
|
||||||
((c-messages 'remove-top))
|
((c-messages 'remove-top))
|
||||||
(displayln "Message broadcasted"))])
|
(displayln "Message broadcasted"))])
|
||||||
(semaphore-post messages-s)))
|
(semaphore-post messages-s)))
|
||||||
|
|
||||||
; TODO move to its own file
|
(define stop-server (serve 4321)) ;; start server then close with stop
|
||||||
(define stop (serve 4321)) ;; start server then close with stop
|
(displayln-safe "Server process started\n" error-out-s error-out)
|
||||||
(display "Server process started\n")
|
|
||||||
|
Loading…
Reference in New Issue
Block a user