Previous: Internet Addresses and Socket Names, Up: Sockets

5.13.3 Socket

When a port is returned from one of these calls it is unbuffered. This allows both reading and writing to the same port to work. If you want buffered ports you can (assuming sock-port is a socket i/o port): 

     (require 'i/o-extensions)
     (define i-port (duplicate-port sock-port "r"))
     (define o-port (duplicate-port sock-port "w"))
— Function: make-stream-socket family
— Function: make-stream-socket family protocol

Returns a SOCK_STREAM socket of type family using protocol. If family has the value AF_INET, SO_REUSEADDR will be set. The integer argument protocol corresponds to the integer protocol numbers returned (as vector elements) from (getproto). If the protocol argument is not supplied, the default (0) for the specified family is used. SCM sockets look like ports opened for neither reading nor writing.

— Function: make-stream-socketpair family
— Function: make-stream-socketpair family protocol

Returns a pair (cons) of connected SOCK_STREAM (socket) ports of type family using protocol. Many systems support only socketpairs of the af-unix family. The integer argument protocol corresponds to the integer protocol numbers returned (as vector elements) from (getproto). If the protocol argument is not supplied, the default (0) for the specified family is used.

— Function: socket:shutdown socket how

Makes socket no longer respond to some or all operations depending on the integer argument how:

  1. Further input is disallowed.
  2. Further output is disallowed.
  3. Further input or output is disallowed.

Socket:shutdown returns socket if successful, #f if not.

— Function: socket:connect inet-socket host-number port-number
— Function: socket:connect unix-socket pathname

Returns socket (changed to a read/write port) connected to the Internet socket on host host-number, port port-number or the Unix socket specified by pathname. Returns #f if not successful.

— Function: socket:bind inet-socket port-number
— Function: socket:bind unix-socket pathname

Returns inet-socket bound to the integer port-number or the unix-socket bound to new socket in the file system at location pathname. Returns #f if not successful. Binding a unix-socket creates a socket in the file system that must be deleted by the caller when it is no longer needed (using delete-file).

— Function: socket:listen socket backlog

The bound (see bind) socket is readied to accept connections. The positive integer backlog specifies how many pending connections will be allowed before further connection requests are refused. Returns socket (changed to a read-only port) if successful, #f if not.

— Function: char-ready? listen-socket

The input port returned by a successful call to socket:listen can be polled for connections by char-ready? (see char-ready?). This avoids blocking on connections by socket:accept.

— Function: socket:accept socket

Accepts a connection on a bound, listening socket. Returns an input/output port for the connection.

The following example is not too complicated, yet shows the use of sockets for multiple connections without input blocking. 

     ;;;; Scheme chat server
     
     ;;; This program implements a simple `chat' server which accepts
     ;;; connections from multiple clients, and sends to all clients any
     ;;; characters received from any client.
     
     ;;; To connect to chat `telnet localhost 8001'
     
     (require 'socket)
     (require 'i/o-extensions)
     
     (let ((listener-socket (socket:bind (make-stream-socket af_inet) 8001))
           (connections '()))
       (socket:listen listener-socket 5)
       (do () (#f)
         (let ((actives (or (apply wait-for-input 5 listener-socket connections)
                            '())))
           (cond ((null? actives))
                 ((memq listener-socket actives)
                  (set! actives (cdr (memq listener-socket actives)))
                  (let ((con (socket:accept listener-socket)))
                    (display "accepting connection from ")
                    (display (getpeername con))
                    (newline)
                    (set! connections (cons con connections))
                    (display "connected" con)
                    (newline con))))
           (set! connections
                 (let next ((con-list connections))
                   (cond ((null? con-list) '())
                         (else
                          (let ((con (car con-list)))
                            (cond ((memq con actives)
                                   (let ((c (read-char con)))
                                     (cond ((eof-object? c)
                                            (display "closing connection from ")
                                            (display (getpeername con))
                                            (newline)
                                            (close-port con)
                                            (next (cdr con-list)))
                                           (else
                                            (for-each (lambda (con)
                                                        (file-position con 0)
                                                        (write-char c con)
                                                        (file-position con 0))
                                                      connections)
                                            (cons con (next (cdr con-list)))))))
                                  (else (cons con (next (cdr con-list)))))))))))))

You can use ‘telnet localhost 8001’ to connect to the chat server, or you can use a client written in scheme: 

     ;;;; Scheme chat client
     
     ;;; this program connects to socket 8001.  It then sends all
     ;;; characters from current-input-port to the socket and sends all
     ;;; characters from the socket to current-output-port.
     
     (require 'socket)
     (require 'i/o-extensions)
     
     (define con (make-stream-socket af_inet))
     (set! con (socket:connect con (inet:string->address "localhost") 8001))
     
     (define (go)
       (define actives (wait-for-input (* 30 60) con (current-input-port)))
       (let ((cs (and actives (memq con actives) (read-char con)))
             (ct (and actives (memq (current-input-port) actives) (read-char))))
         (cond ((or (eof-object? cs) (eof-object? ct)) (close-port con))
               (else (cond (cs (display cs)))
                     (cond (ct (file-position con 0)
                               (display ct con)
                               (file-position con 0)))
                     (go)))))
     (cond (con (display "Connecting to ")
                (display (getpeername con))
                (newline)
                (go))
           (else (display "Server not listening on port 8001")
                 (newline)))