syndicate-lang
/
racket-ssh-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Limit number of concurrent logins

This commit is contained in:
Tony Garnock-Jones 2011-11-04 13:23:35 -04:00
parent f70354c683
commit cf7563e5ed
1 changed files with 17 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
repl-server.rkt
View File

@ -17,6 +17,8 @@
(define *user-states* (make-hash))
(define *login-limit* (make-semaphore 3))
(define *interaction* (make-room 'interaction))
(spy-on *interaction*)
@ -120,9 +122,23 @@
(close-input-port in)
(close-output-port out)))
(define (limited-repl-shell username in out)
(call-with-semaphore *login-limit*
(lambda () (repl-shell username in out))
(lambda () (reject-login username in out))))
(define (reject-login username in out)
(parameterize ((current-input-port in)
(current-output-port out)
(current-error-port out))
(printf "Hello, ~a - unfortunately, the system is too busy to accept your\n" username)
(printf "login right now. Please try again later.\n")
(close-input-port in)
(close-output-port out)))
(define (t-server)
(define s (tcp-listen 2322 4 #t))
(printf "Accepting...\n")
(tcp-pty-ssh-server s repl-shell #:prompt *prompt*))
(tcp-pty-ssh-server s limited-repl-shell #:prompt *prompt*))
(t-server)