net.sockets/trivial-sockets.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Main socket methods.
   4 ;;;
   5
   6 (in-package :common-lisp-user)
   7
   8 (defpackage net.trivial-sockets
   9   (:use :common-lisp)
  10   (:export #:open-stream #:socket-error #:socket-nested-error
  11            #:unsupported #:unsupported-feature
  12            #:open-server #:close-server #:accept-connection
  13            #:with-server))
  14
  15 (in-package :net.trivial-sockets)
  16
  17 ;;;;
  18 ;;;; ERRORS
  19 ;;;;
  20
  21 ;; you're using a part of the interface that the implementation doesn't do
  22 (define-condition unsupported (error)
  23   ((feature :initarg :feature :reader unsupported-feature))
  24   (:report (lambda (c s)
  25              (format s "~S does not support trivial-socket feature ~S."
  26                      (lisp-implementation-type) (unsupported-feature c)))))
  27
  28 ;; all-purpose error: host not found, host not responding,
  29 ;; no service on that port, etc
  30 (define-condition socket-error (error)
  31   ((nested-error :initarg :nested-error :reader socket-nested-error)))
  32 \f
  33 ;;;;
  34 ;;;; Main implementation
  35 ;;;;
  36
  37 (defun resolve-hostname (name)
  38   (let ((net.sockets:*ipv6* nil))
  39     (cond
  40       ((eq name :any) net.sockets:+ipv4-unspecified+)
  41       (t (nth-value 0 (net.sockets:ensure-hostname name))))))
  42
  43 (defun open-stream (peer-host peer-port &key
  44                     (local-host :any) (local-port 0)
  45                     (external-format :default)
  46                     (element-type 'character)
  47                     (protocol :tcp))
  48   (declare (ignore element-type))
  49   (unless (eq protocol :tcp)
  50     (error 'unsupported :feature `(:protocol ,protocol)))
  51   (let ((net.sockets:*ipv6* nil))
  52     (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
  53       (net.sockets:make-socket :address-family :internet
  54                                :connect :active
  55                                :type :stream
  56                                :remote-host (resolve-hostname peer-host)
  57                                :remote-port peer-port
  58                                :local-host (resolve-hostname local-host)
  59                                :local-port local-port
  60                                :external-format external-format))))
  61
  62 (defun open-server (&key (host :any) (port 0)
  63                     (reuse-address t)
  64                     (backlog 1)
  65                     (protocol :tcp))
  66   "Returns a SERVER object and the port that was bound, as multiple values."
  67   (unless (eq protocol :tcp)
  68     (error 'unsupported :feature `(:protocol ,protocol)))
  69   (let ((net.sockets:*ipv6* nil))
  70     (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
  71       (let* ((host (if (eq host :any) net.sockets:+ipv4-unspecified+ host))
  72              (socket (net.sockets:make-socket :address-family :internet
  73                                               :type :stream
  74                                               :connect :passive
  75                                               :local-host host
  76                                               :local-port port
  77                                               :reuse-address reuse-address
  78                                               :backlog backlog)))
  79         (values socket (net.sockets:local-port socket))))))
  80
  81 (defun close-server (server)
  82   (close server))
  83
  84 (defun accept-connection (socket &key
  85                           (external-format :default)
  86                           (element-type 'character))
  87   (declare (ignore element-type))       ; bivalent streams
  88   (let ((net.sockets:*ipv6* nil))
  89     (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
  90       (net.sockets:accept-connection socket :external-format external-format))))
  91 \f
  92 ;;;;
  93 ;;;; Utilities
  94 ;;;;
  95
  96 (defmacro with-server ((name arguments) &body forms)
  97   `(with-open-stream (,name (open-server ,@arguments))
  98      (locally ,@forms)))