Fix spelling.
[iolib.git] / net.sockets / trivial-sockets.lisp
blob66077c648f5b3cdc079ef060013d1fe49d69cd1e
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.
27 (in-package :common-lisp-user)
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))
36 (in-package :net.trivial-sockets)
38 ;;;;
39 ;;;; ERRORS
40 ;;;;
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)))))
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)))
54 ;;;;
55 ;;;; Main implementation
56 ;;;;
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))))))
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))))
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))))))
102 (defun close-server (server)
103 (close server))
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))))
113 ;;;;
114 ;;;; Utilities
115 ;;;;
117 (defmacro with-server ((name arguments) &body forms)
118 `(with-open-stream (,name (open-server ,@arguments))
119 (locally ,@forms)))