net.sockets/trivial-sockets.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
   2 ;;;
   3 ;;; socket-methods.lisp --- Various socket methods.
   4 ;;;
   5 ;;; Copyright (C) 2004 Daniel Barlow and contributors
   6 ;;; Copyright (C) 2007 Stelian Ionescu  <sionescu@common-lisp.net>
   7 ;;;
   8 ;;; Permission is hereby granted, free of charge, to any person obtaining
   9 ;;; a copy of this software and associated documentation files (the
  10 ;;; "Software"), to deal in the Software without restriction, including
  11 ;;; without limitation the rights to use, copy, modify, merge,publish,
  12 ;;; distribute, sublicense, and/or sell copies of the Software, and to
  13 ;;; permit persons to whom the Software is furnished to do so, subject to
  14 ;;; the following conditions:
  15 ;;;
  16 ;;; The above copyright notice and this permission notice shall be
  17 ;;; included in all copies or substantial portions of the Software.
  18 ;;;
  19 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  20 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  21 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  22 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
  23 ;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
  24 ;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
  25 ;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  26
  27 (in-package :common-lisp-user)
  28
  29 (defpackage net.trivial-sockets
  30   (:use :common-lisp)
  31   (:export #:open-stream #:socket-error #:socket-nested-error
  32            #:unsupported #:unsupported-feature
  33            #:open-server #:close-server #:accept-connection
  34            #:with-server))
  35
  36 (in-package :net.trivial-sockets)
  37
  38 ;;;;
  39 ;;;; ERRORS
  40 ;;;;
  41
  42 ;; you're using a part of the interface that the implementation doesn't do
  43 (define-condition unsupported (error)
  44   ((feature :initarg :feature :reader unsupported-feature))
  45   (:report (lambda (c s)
  46              (format s "~S does not support trivial-socket feature ~S."
  47                      (lisp-implementation-type) (unsupported-feature c)))))
  48
  49 ;; all-purpose error: host not found, host not responding,
  50 ;; no service on that port, etc
  51 (define-condition socket-error (error)
  52   ((nested-error :initarg :nested-error :reader socket-nested-error)))
  53 \f
  54 ;;;;
  55 ;;;; Main implementation
  56 ;;;;
  57
  58 (defun resolve-hostname (name)
  59   (let ((net.sockets:*ipv6* nil))
  60     (cond
  61       ((eq name :any) net.sockets:+ipv4-unspecified+)
  62       (t (nth-value 0 (net.sockets:ensure-hostname name))))))
  63
  64 (defun open-stream (peer-host peer-port &key
  65                     (local-host :any) (local-port 0)
  66                     (external-format :default)
  67                     (element-type 'character)
  68                     (protocol :tcp))
  69   (declare (ignore element-type))
  70   (unless (eq protocol :tcp)
  71     (error 'unsupported :feature `(:protocol ,protocol)))
  72   (let ((net.sockets:*ipv6* nil))
  73     (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
  74       (net.sockets:make-socket :family :internet
  75                                :connect :active
  76                                :type :stream
  77                                :remote-host (resolve-hostname peer-host)
  78                                :remote-port peer-port
  79                                :local-host (resolve-hostname local-host)
  80                                :local-port local-port
  81                                :external-format external-format))))
  82
  83 (defun open-server (&key (host :any) (port 0)
  84                     (reuse-address t)
  85                     (backlog 1)
  86                     (protocol :tcp))
  87   "Returns a SERVER object and the port that was bound, as multiple values."
  88   (unless (eq protocol :tcp)
  89     (error 'unsupported :feature `(:protocol ,protocol)))
  90   (let ((net.sockets:*ipv6* nil))
  91     (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
  92       (let* ((host (if (eq host :any) net.sockets:+ipv4-unspecified+ host))
  93              (socket (net.sockets:make-socket :family :internet
  94                                               :type :stream
  95                                               :connect :passive
  96                                               :local-host host
  97                                               :local-port port
  98                                               :reuse-address reuse-address
  99                                               :backlog backlog)))
 100         (values socket (net.sockets:local-port socket))))))
 101
 102 (defun close-server (server)
 103   (close server))
 104
 105 (defun accept-connection (socket &key
 106                           (external-format :default)
 107                           (element-type 'character))
 108   (declare (ignore element-type))       ; bivalent streams
 109   (let ((net.sockets:*ipv6* nil))
 110     (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
 111       (net.sockets:accept-connection socket :external-format external-format))))
 112 \f
 113 ;;;;
 114 ;;;; Utilities
 115 ;;;;
 116
 117 (defmacro with-server ((name arguments) &body forms)
 118   `(with-open-stream (,name (open-server ,@arguments))
 119      (locally ,@forms)))