| Server IP : 79.136.114.73 / Your IP : 3.139.89.220 Web Server : Apache/2.4.7 (Ubuntu) PHP/5.5.9-1ubuntu4.29 OpenSSL/1.0.1f System : Linux b8009 3.13.0-170-generic #220-Ubuntu SMP Thu May 9 12:40:49 UTC 2019 x86_64 User : www-data ( 33) PHP Version : 5.5.9-1ubuntu4.29 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority, MySQL : ON | cURL : ON | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : ON Directory : /usr/share/guile/2.0/system/repl/ |
Upload File : |
;;; Repl server
;; Copyright (C) 2003, 2010, 2011 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Code:
(define-module (system repl server)
#:use-module (system repl repl)
#:use-module (ice-9 threads)
#:export (make-tcp-server-socket
make-unix-domain-server-socket
run-server
spawn-server
stop-server-and-clients!))
(define *open-sockets* '())
(define sockets-lock (make-mutex))
(define (close-socket! s)
(with-mutex sockets-lock
(set! *open-sockets* (delq! s *open-sockets*)))
;; Close-port could block or raise an exception flushing buffered
;; output. Hmm.
(close-port s))
(define (add-open-socket! s)
(with-mutex sockets-lock
(set! *open-sockets* (cons s *open-sockets*))))
(define (stop-server-and-clients!)
(cond
((with-mutex sockets-lock
(and (pair? *open-sockets*)
(car *open-sockets*)))
=> (lambda (s)
(close-socket! s)
(stop-server-and-clients!)))))
(define* (make-tcp-server-socket #:key
(host #f)
(addr (if host (inet-aton host) INADDR_LOOPBACK))
(port 37146))
(let ((sock (socket PF_INET SOCK_STREAM 0)))
(setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
(bind sock AF_INET addr port)
sock))
(define* (make-unix-domain-server-socket #:key (path "/tmp/guile-socket"))
(let ((sock (socket PF_UNIX SOCK_STREAM 0)))
(setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
(bind sock AF_UNIX path)
sock))
(define call-with-sigint
(if (not (provided? 'posix))
(lambda (thunk) (thunk))
(lambda (thunk)
(let ((handler #f))
(dynamic-wind
(lambda ()
(set! handler
(sigaction SIGINT (lambda (sig) (throw 'interrupt)))))
thunk
(lambda ()
(if handler
;; restore Scheme handler, SIG_IGN or SIG_DFL.
(sigaction SIGINT (car handler) (cdr handler))
;; restore original C handler.
(sigaction SIGINT #f))))))))
(define* (run-server #:optional (server-socket (make-tcp-server-socket)))
(define (accept-new-client)
(catch #t
(lambda () (call-with-sigint (lambda () (accept server-socket))))
(lambda (k . args)
(cond
((port-closed? server-socket)
;; Shutting down.
#f)
((eq? k 'interrupt)
;; Interrupt.
(close-socket! server-socket)
#f)
(else
(warn "Error accepting client" k args)
;; Retry after a timeout.
(sleep 1)
(accept-new-client))))))
(sigaction SIGPIPE SIG_IGN)
(add-open-socket! server-socket)
(listen server-socket 5)
(let lp ((client (accept-new-client)))
;; If client is false, we are shutting down.
(if client
(let ((client-socket (car client))
(client-addr (cdr client)))
(add-open-socket! client-socket)
(make-thread serve-client client-socket client-addr)
(lp (accept-new-client))))))
(define* (spawn-server #:optional (server-socket (make-tcp-server-socket)))
(make-thread run-server server-socket))
(define (serve-client client addr)
(with-continuation-barrier
(lambda ()
(with-input-from-port client
(lambda ()
(with-output-to-port client
(lambda ()
(with-error-to-port client
(lambda ()
(with-fluids ((*repl-stack* '()))
(start-repl))))))))))
(close-socket! client))