X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela_server.scm;h=ef7b24e881114e973b0fd88ac896129e46b107ed;hb=ee8cc28a7551d08466af97636c38e55516a22876;hp=f58c8b6399666098fd586d370e4d9b9f4158aa7a;hpb=c4dbd17a165312f189ec5211069dab4d039d5471;p=gacela.git diff --git a/src/gacela_server.scm b/src/gacela_server.scm index f58c8b6..ef7b24e 100644 --- a/src/gacela_server.scm +++ b/src/gacela_server.scm @@ -17,6 +17,7 @@ (define start-server #f) (define check-connections #f) +(define clean-closed-connections #f) (define eval-from-clients #f) (define stop-server #f) @@ -29,8 +30,19 @@ (bind server-socket AF_INET INADDR_ANY port) (listen server-socket 5))) + (set! clean-closed-connections + (lambda (conns) + (cond ((null? conns) '()) + (else + (let* ((cli (car conns)) (sock (car cli))) + (cond ((port-closed? sock) + (clean-closed-connections (cdr conns))) + (else + (cons cli (clean-closed-connections (cdr conns)))))))))) + (set! check-connections (lambda () + (set! clients (clean-closed-connections clients)) (catch #t ; (lambda () (set! clients (cons (accept server-socket) clients))) (lambda () @@ -45,8 +57,18 @@ (let ((sock (car cli))) (cond ((char-ready? sock) (catch #t - (lambda () (display (primitive-eval (read sock)) sock)) - (lambda (key . args) #f)))))) + (lambda () + (let ((exp (read sock))) + (cond ((eof-object? exp) + (close sock)) + (else + (format sock "~a~%" (primitive-eval exp)))))) + (lambda (key . args) + (let ((fmt (string-concatenate (list (cadr args) "~%"))) + (params (caddr args))) + (if params + (apply format (cons sock (cons fmt params))) + (format sock fmt))))))))) clients))) (set! stop-server