Commit 206750fa authored by Symbolics's avatar Symbolics

Genera uses file attributes instead of (in-package).

parents deeeac61 b94dae3f
0.8.0:
0.8.2: (June 11, 2019)
* New feature: IOlib backend (all usocket features are supported when IOlib is available in your platform).
* General: now the HOST-OR-IP slot of NS-CONDITION has been exported. (#46)
* Bugfix: NS-HOST-NOT-FOUND-ERROR condition has unbound HOST-OR-IP slot (#46)
* Bugfix: [SBCL/LW] WAIT-FOR-INPUT waits only in the first call (when W-F-I is called with a single usocket, introduced in 0.8.0) (#50, thanks to @Hamayama for reporting/hints/testing this issue)
0.8.1: (Feb 27, 2019)
* New backend: clasp (patch from Christian Schafmeister, #45)
* Bugfix: [SBCL] fixed loading usocket.asd in SBCL 1.5.0
0.8.0: (Feb 4, 2019)
* New backend (experimental): IOlib. (Push :USOCKET-IOLIB to *FEATURES* to enable this feature)
* New feature: Optimized WAIT-FOR-INPUT for single-socket case (one-time consing)
* New feature: Exported host-to-hostname (#42)
* Bugfix: [SBCL] more robust/thread-safe WAIT-FOR-INPUT-INTERNAL
0.7.1: (Aug 31, 2018)
* New feature: GET-(RANDOM)-HOST-BY-NAME (now exported) prefer IPv4 on mixed IPv4/IPv6 (suggested by Mark H. David)
* New backend: Symbolics Open Genera (Lisp machine) (patch from @Symbolics, #33)
* Bugfix: [CLISP] fixed issues in server sockets and error handling. (patch from @vibs29, #28, #29)
* Bugfix: [SBCL, ECL] Fix wait-for-input on Windows SBCL and ECL. (patch from Stas Boukarev, #30)
* Bugfix: [LW] fixed non-existing system calls in LW 5.0 (comm::socket-set-tcp-nodelay)
......@@ -92,7 +111,7 @@
* Bugfix: [LispWorks] Fixed SOCKET-ACCEPT (Windows only) on WAIT-FOR-INPUTed sockets.
* Bugfix: [SBCL, ECL] Fixed wrongly STATE set/unset for WAIT-FOR-INPUT on Windows (report by Elliott Slaughter)
* Enhancement: Additional NAME keyword argument for SOCKET-SERVER for setting the server thread name.
* Enhancement: [ABCL] GET-ADDRESS now works with underlying IP6 addresses.
* Enhancement: [ABCL] GET-ADDRESS now works with underlying IPv6 addresses.
* Enhancement: [CLISP] missing GET-LOCAL-* methods for STREAM-SERVER-USOCKET was now added.
0.5.1: (Apr 2, 2011)
......
-*- Mode: outline -*-
List of major USOCKET contributors:
* Erik Enge
* Erik Huelsmann <ehuels@gmail.com>
- original authors
* Chun Tian <binghe.lisp@gmail.com>
* Hans Huebner <hans.huebner@gmail.com>
- current maintainers
* Attila Lendvai <attila.lendvai@gmail.com>
- better handling of unsupported Lisps
* Vladimir Sekissov <svg@surnet.ru>
- fixes for CMUCL implementation
* Pierre Thierry <nowhere.man@levallois.eu.org>
- added license information
* Stelian Ionescu <sionescu@cddr.org>
- finished conversion from generic functions
- enabled running thread-safe code in unthreaded lisps
* Douglas Crosher <dtc@scieneer.com>
- added Scieneer Common Lisp support
* Frank James
- UDP fixes and test cases
* Mark H. David <mhd@yv.org>
- UDP test cases
- Suggestions on fixing GET-HOST-BY-NAME and HOST-TO-HBO
* Elliott Slaughter <elliottslaughter@gmail.com>
- Advanced WAIT-FOR-INPUT test case
* Anton Vodonosov <avodonosov@yandex.ru>
- CLISP fixes
* Terje Norderhaug <terje@in-progress.com>
- MCL vendor code
* @Hamayama <fkyo0985@gmail.com>
- Reporting/hints/testing of issue #50 (regression in 0.8.0, 0.8.1)
......@@ -3,6 +3,7 @@
Copyright (c) 2003 Erik Enge
Copyright (c) 2006-2007 Erik Huelsmann
Copyright (c) 2008-2019 Hans Hueber and Chun Tian
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
......
# Introduction
## USOCKET - Universal socket library for Common Lisp
https://common-lisp.net/project/usocket/
This is the usocket Common Lisp sockets library: a library to bring
sockets access to the broadest of common lisp implementations as possible.
# The library currently supports:
## The library currently supports:
- SBCL
- CMUCL
- ArmedBear Common Lisp
- GNU CLISP
- Allegro Common Lisp
- LispWorks
- Allegro CL
- ABCL (ArmedBear)
- Clasp
- Clozure CL
- Corman Lisp
- GNU CLISP
- CMUCL
- ECL
- Scieneer Common Lisp
- Macintosh Common Lisp
- LispWorks (4.3 and up)
- Digitool MCL and RMCL (5.0 and up)
- Mezzano
- MOCL
- SBCL
- Scieneer CL
- Symbolics Genera
If your favorite common lisp misses in the list above, please contact
usocket-devel@common-lisp.net and submit a request. Please include
......@@ -26,7 +32,7 @@ that you can tar up a checkout and use that to ASDF-INSTALL:INSTALL
the package in your system package site. (Or use your usual ASDF
tricks to use the checkout directly.)
# Remarks on licensing
## Remarks on licensing
Even though the source code has an MIT style license attached to it,
when compiling this code with some of the supported lisp implementations
......@@ -34,7 +40,7 @@ you may not end up with an MIT style binary version due to the licensing
of the implementations themselves. ECL is such an example and - when
it will become supported - GCL is like that too.
# Non-support of :external-format
## Non-support of :external-format
Because of its definition in the hyperspec, there's no common
external-format between lisp implementations: every vendor has chosen
......@@ -48,7 +54,7 @@ defeated. So, for now, usocket doesn't support external-format.
The workaround to get reasonably portable external-format support is to
layer a flexi-stream (from flexi-streams) on top of a usocket stream.
# API definition
## API definition
- usocket (class)
- stream-usocket (class; usocket derivative)
......@@ -75,7 +81,7 @@ layer a flexi-stream (from flexi-streams) on top of a usocket stream.
the return value of which satisfies the normal stream interface
- socket-shutdown
## Errors:
### Errors:
- address-in-use-error
- address-not-available-error
- bad-file-descriptor-error
......@@ -97,14 +103,14 @@ layer a flexi-stream (from flexi-streams) on top of a usocket stream.
- timeout-error
- unkown-error
## Non-fatal conditions:
### Non-fatal conditions:
- interrupted-condition
- unkown-condition
(for a description of the API methods and functions see
https://common-lisp.net/project/usocket/api-docs.shtml)
# Test suite
## Test suite
The test suite unfortunately isn't mature enough yet to run without
some manual configuration. Several elements are required which are
......@@ -118,7 +124,7 @@ running the tests, for these variables:
- +common-lisp-net+: A vector with 4 integer elements which make up
an IP address. This must be the IP "common-lisp.net" resolves to.
# Known problems
## Known problems
- CMUCL error reporting wrt sockets raises only simple-errors
meaning there's no way to tell different error conditions apart.
......
......@@ -5,9 +5,6 @@
(in-package :usocket)
(eval-when (:load-toplevel :execute)
(setq *backend* :native))
;;; Java Classes ($*...)
(defvar $*boolean (jclass "boolean"))
(defvar $*byte (jclass "byte"))
......@@ -145,7 +142,7 @@
(defparameter +abcl-nameserver-error-map+
`(("java.net.UnknownHostException" . ns-host-not-found-error)))
(defun handle-condition (condition &optional (socket nil))
(defun handle-condition (condition &optional (socket nil) (host-or-ip nil))
(typecase condition
(java-exception
(let ((java-cause (java-exception-cause condition)))
......@@ -157,7 +154,7 @@
(nameserver-error (cdr (assoc (jclass-of java-cause) +abcl-nameserver-error-map+
:test #'string=))))
(if nameserver-error
(error nameserver-error :host-or-ip nil)
(error nameserver-error :socket socket :host-or-ip host-or-ip)
(when usock-error
(error usock-error :socket socket))))))))
......@@ -181,14 +178,14 @@
(t nil)))))) ; neither a IPv4 nor IPv6 address?!
(defun get-hosts-by-name (name)
(with-mapped-conditions ()
(with-mapped-conditions (nil name)
(map 'list #'get-address (%get-all-by-name name))))
;;; GET-HOST-BY-ADDRESS
(defun get-host-by-address (host)
(let ((inet4 (host-to-inet4 host)))
(with-mapped-conditions ()
(with-mapped-conditions (nil host)
(jcall $@getHostName/0 inet4))))
;;; SOCKET-CONNECT
......@@ -206,10 +203,10 @@
;; bind to local address if needed
(when (or local-host local-port)
(let ((local-address (jnew $%InetSocketAddress/2 (host-to-inet4 local-host) (or local-port 0))))
(with-mapped-conditions ()
(with-mapped-conditions (nil host)
(jcall $@bind/Socket/1 socket local-address))))
;; connect to dest address
(with-mapped-conditions ()
(with-mapped-conditions (nil host)
(jcall $@connect/SocketChannel/1 channel address))
(setq stream (ext:get-socket-stream socket :element-type element-type)
usocket (make-stream-socket :stream stream :socket socket))
......@@ -224,12 +221,12 @@
;; bind to local address if needed
(when (or local-host local-port)
(let ((local-address (jnew $%InetSocketAddress/2 (host-to-inet4 local-host) (or local-port 0))))
(with-mapped-conditions ()
(with-mapped-conditions (nil local-host)
(jcall $@bind/DatagramSocket/1 socket local-address))))
;; connect to dest address if needed
(when (and host port)
(let ((address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port)))
(with-mapped-conditions ()
(with-mapped-conditions (nil host)
(jcall $@connect/DatagramChannel/1 channel address))))
(setq usocket (make-datagram-socket socket :connected-p (if (and host port) t nil)))
(when timeout
......@@ -248,7 +245,7 @@
(socket (jcall $@socket/ServerSocketChannel/0 channel))
(endpoint (jnew $%InetSocketAddress/2 (host-to-inet4 host) (or port 0))))
(jcall $@setReuseAddress/1 socket (if reuseaddress java:+true+ java:+false+))
(with-mapped-conditions (socket)
(with-mapped-conditions (socket host)
(if backlog-supplied-p
(jcall $@bind/ServerSocket/2 socket endpoint backlog)
(jcall $@bind/ServerSocket/1 socket endpoint)))
......@@ -268,10 +265,6 @@
;;; SOCKET-CLOSE
(defmethod socket-close :before ((usocket usocket))
(when (wait-list usocket)
(remove-waiter (wait-list usocket) usocket)))
(defmethod socket-close ((usocket stream-server-usocket))
(with-mapped-conditions (usocket)
(jcall $@close/ServerSocket/0 (socket usocket))))
......@@ -354,7 +347,7 @@
;; prepare sending data
(loop for i from offset below (+ size offset)
do (setf (jarray-ref byte-array i) (*->byte (aref buffer i))))
(with-mapped-conditions (usocket)
(with-mapped-conditions (usocket host)
(jcall $@send/1 socket packet))))
;;; TODO: return-host and return-port cannot be get ...
......
......@@ -2,9 +2,6 @@
(in-package :usocket)
(eval-when (:load-toplevel :execute)
(setq *backend* :native))
#+cormanlisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(require :acl-socket))
......@@ -37,19 +34,24 @@
(:host-down . host-down-error)
(:host-unreachable . host-unreachable-error)))
(defun handle-condition (condition &optional (socket nil))
;; TODO: what's the error class of Corman Lisp?
(defun handle-condition (condition &optional (socket nil) (host-or-ip nil))
"Dispatch correct usocket condition."
(typecase condition
#+allegro
(excl:socket-error
(let ((usock-err
(let ((usock-error
(cdr (assoc (excl:stream-error-identifier condition)
+allegro-identifier-error-map+))))
(if usock-err
(error usock-err :socket socket)
(error 'unknown-error
:real-error condition
:socket socket))))))
(declare (type symbol usock-error))
(if usock-error
(cond ((subtypep usock-error 'ns-error)
(error usock-error :socket socket :host-or-ip host-or-ip))
(t
(error usock-error :socket socket)))
(error 'unknown-error
:real-error condition
:socket socket))))))
(defun to-format (element-type)
(if (subtypep element-type 'character)
......@@ -67,7 +69,7 @@
(let ((socket))
(setf socket
(with-mapped-conditions (socket)
(with-mapped-conditions (socket (or host local-host))
(ecase protocol
(:stream
(labels ((make-socket ()
......@@ -107,8 +109,6 @@
;; because socket-streams are also sockets.
(defmethod socket-close ((usocket usocket))
"Close socket."
(when (wait-list usocket)
(remove-waiter (wait-list usocket) usocket))
(with-mapped-conditions (usocket)
(close (socket usocket))))
......@@ -124,7 +124,7 @@
;; Allegro and OpenMCL socket interfaces bear very strong resemblence
;; whatever you change here, change it also for OpenMCL
(let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
(sock (with-mapped-conditions ()
(sock (with-mapped-conditions (nil host)
(apply #'socket:make-socket
(append (list :connect :passive
:reuse-address reuseaddress
......@@ -167,7 +167,7 @@
#+allegro
(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
(with-mapped-conditions (usocket)
(with-mapped-conditions (usocket host)
(let ((s (socket usocket)))
(socket:send-to s
(if (zerop offset)
......@@ -178,24 +178,24 @@
:remote-port port))))
#+allegro
(defmethod socket-receive ((socket datagram-usocket) buffer length &key)
(defmethod socket-receive ((usocket datagram-usocket) buffer length &key)
(declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
(integer 0) ; size
(unsigned-byte 32) ; host
(unsigned-byte 16))) ; port
(with-mapped-conditions (socket)
(let ((s (socket socket)))
(with-mapped-conditions (usocket)
(let ((s (socket usocket)))
(socket:receive-from s length :buffer buffer :extract t))))
(defun get-host-by-address (address)
(with-mapped-conditions ()
(with-mapped-conditions (nil address)
(socket:ipaddr-to-hostname (host-to-hbo address))))
(defun get-hosts-by-name (name)
;;###FIXME: ACL has the acldns module which returns all A records
;; only problem: it doesn't fall back to tcp (from udp) if the returned
;; structure is too long.
(with-mapped-conditions ()
(with-mapped-conditions (nil name)
(list (hbo-to-vector-quad (socket:lookup-hostname
(host-to-hostname name))))))
......
(in-package :usocket)
#-clasp
(progn
#-:wsock
(ffi:clines
"#include <errno.h>"
"#include <sys/socket.h>"
"#include <unistd.h>")
#+:wsock
(ffi:clines
"#ifndef FD_SETSIZE"
"#define FD_SETSIZE 1024"
"#endif"
"#include <winsock2.h>")
(ffi:clines
#+:msvc "#include <time.h>"
#-:msvc "#include <sys/time.h>"
"#include <ecl/ecl-inl.h>"))
(progn
#-clasp
(defun cerrno ()
(ffi:c-inline () () :int
"errno" :one-liner t))
#+clasp
(defun cerrno ()
(sockets-internal:errno))
#-clasp
(defun fd-setsize ()
(ffi:c-inline () () :fixnum
"FD_SETSIZE" :one-liner t))
#+clasp
(defun fd-setsize () (sockets-internal:fd-setsize))
#-clasp
(defun fdset-alloc ()
(ffi:c-inline () () :pointer-void
"ecl_alloc_atomic(sizeof(fd_set))" :one-liner t))
#+clasp (defun fdset-alloc () (sockets-internal::alloc-atomic-sizeof-fd-set))
#-clasp
(defun fdset-zero (fdset)
(ffi:c-inline (fdset) (:pointer-void) :void
"FD_ZERO((fd_set*)#0)" :one-liner t))
#+clasp(defun fdset-zero (fdset) (sockets-internal:fdset-zero fdset))
#-clasp
(defun fdset-set (fdset fd)
(ffi:c-inline (fdset fd) (:pointer-void :fixnum) :void
"FD_SET(#1,(fd_set*)#0)" :one-liner t))
#+clasp(defun fdset-set (fdset fd) (sockets-internal:fdset-set fd fdset))
#-clasp
(defun fdset-clr (fdset fd)
(ffi:c-inline (fdset fd) (:pointer-void :fixnum) :void
"FD_CLR(#1,(fd_set*)#0)" :one-liner t))
#+clasp(defun fdset-clr (fdset fd) (sockets-internal:fdset-clr fd fdset))
#-clasp
(defun fdset-fd-isset (fdset fd)
(ffi:c-inline (fdset fd) (:pointer-void :fixnum) :bool
"FD_ISSET(#1,(fd_set*)#0)" :one-liner t))
#+clasp(defun fdset-fd-isset (fdset fd) (sockets-internal:fdset-isset fd fdset))
(declaim (inline cerrno
fd-setsize
fdset-alloc
fdset-zero
fdset-set
fdset-clr
fdset-fd-isset))
#-clasp
(defun get-host-name ()
(ffi:c-inline
() () :object
"{ char *buf = (char *) ecl_alloc_atomic(257);
if (gethostname(buf,256) == 0)
@(return) = make_simple_base_string(buf);
else
@(return) = Cnil;
}" :one-liner nil :side-effects nil))
#+clasp
(defun get-host-name ()
(sockets-internal:get-host-name))
#-clasp
(defun read-select (wl to-secs &optional (to-musecs 0))
(let* ((sockets (wait-list-waiters wl))
(rfds (wait-list-%wait wl))
(max-fd (reduce #'(lambda (x y)
(let ((sy (sb-bsd-sockets:socket-file-descriptor
(socket y))))
(if (< x sy) sy x)))
(cdr sockets)
:initial-value (sb-bsd-sockets:socket-file-descriptor
(socket (car sockets))))))
(fdset-zero rfds)
(dolist (sock sockets)
(fdset-set rfds (sb-bsd-sockets:socket-file-descriptor
(socket sock))))
(let ((count
(ffi:c-inline (to-secs to-musecs rfds max-fd)
(t :unsigned-int :pointer-void :int)
:int
"
int count;
struct timeval tv;
if (#0 != Cnil) {
tv.tv_sec = fixnnint(#0);
tv.tv_usec = #1;
}
@(return) = select(#3 + 1, (fd_set*)#2, NULL, NULL,
(#0 != Cnil) ? &tv : NULL);
" :one-liner nil)))
(cond
((= 0 count)
(values nil nil))
((< count 0)
;; check for EINTR and EAGAIN; these should not err
(values nil (cerrno)))
(t
(dolist (sock sockets)
(when (fdset-fd-isset rfds (sb-bsd-sockets:socket-file-descriptor
(socket sock)))
(setf (state sock) :READ))))))))
#+clasp
(defun read-select (wl to-secs &optional (to-musecs 0))
(let* ((sockets (wait-list-waiters wl))
(rfds (wait-list-%wait wl))
(max-fd (reduce #'(lambda (x y)
(let ((sy (sb-bsd-sockets:socket-file-descriptor
(socket y))))
(if (< x sy) sy x)))
(cdr sockets)
:initial-value (sb-bsd-sockets:socket-file-descriptor
(socket (car sockets))))))
(fdset-zero rfds)
(dolist (sock sockets)
(fdset-set rfds (sb-bsd-sockets:socket-file-descriptor
(socket sock))))
(let ((count (sockets-internal:do-select to-secs to-musecs rfds max-fd)))
(cond
((= 0 count)
(values nil nil))
((< count 0)
;; check for EINTR and EAGAIN; these should not err
(values nil (cerrno)))
(t
(dolist (sock sockets)
(when (fdset-fd-isset rfds (sb-bsd-sockets:socket-file-descriptor
(socket sock)))
(setf (state sock) :READ))))))))
)
......@@ -2,9 +2,6 @@
(in-package :usocket)
(eval-when (:load-toplevel :execute)
(setq *backend* :native))
(eval-when (:compile-toplevel :load-toplevel :execute)
#-ffi
(warn "This image doesn't contain FFI package, GET-HOST-NAME won't work.")
......@@ -34,12 +31,12 @@
"localhost")
(defun get-host-by-address (address)
(with-mapped-conditions ()
(with-mapped-conditions (nil address)
(let ((hostent (posix:resolve-host-ipaddr (host-to-hostname address))))
(posix:hostent-name hostent))))
(defun get-hosts-by-name (name)
(with-mapped-conditions ()
(with-mapped-conditions (nil name)
(let ((hostent (posix:resolve-host-ipaddr name)))
(mapcar #'host-to-vector-quad
(posix:hostent-addr-list hostent)))))
......@@ -105,7 +102,7 @@
(let ((*package* (find-package "KEYWORD")))
(car (read-from-string s t nil :start pos1 :end (1+ pos2)))))))))
(defun handle-condition (condition &optional (socket nil))
(defun handle-condition (condition &optional (socket nil) (host-or-ip nil))
"Dispatch a usocket condition instead of a CLISP specific one, if we can."
(let ((errno
(cond
......@@ -117,11 +114,17 @@
(car (simple-condition-format-arguments condition))))))
(when errno
(let ((error-keyword (if (keywordp errno) errno #+ffi(os:errno errno))))
(let ((usocket-error (cdr (assoc error-keyword +clisp-error-map+))))
(when usocket-error
(if (subtypep usocket-error 'error)
(error usocket-error :socket socket)
(signal usocket-error :socket socket))))))))
(let ((usock-error (cdr (assoc error-keyword +clisp-error-map+))))
(when usock-error
(if (subtypep usock-error 'error)
(cond ((subtypep usock-error 'ns-error)
(error usock-error :socket socket :host-or-ip host-or-ip))
(t
(error usock-error :socket socket)))
(cond ((subtypep usock-error 'ns-condition)
(signal usock-error :socket socket :host-or-ip host-or-ip))
(t
(signal usock-error :socket socket))))))))))
(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
timeout deadline (nodelay t nodelay-specified)
......@@ -135,7 +138,7 @@
(:stream
(let ((socket)
(hostname (host-to-hostname host)))
(with-mapped-conditions (socket)
(with-mapped-conditions (socket host)
(setf socket
(if timeout
(socket:socket-connect port hostname
......@@ -149,10 +152,11 @@
:stream socket))) ;; the socket is a stream too
(:datagram
#+(or rawsock ffi)
(socket-create-datagram (or local-port *auto-port*)
:local-host (or local-host *wildcard-host*)
:remote-host (and host (host-to-vector-quad host))
:remote-port port)
(with-mapped-conditions (nil (or host local-host))
(socket-create-datagram (or local-port *auto-port*)
:local-host (or local-host *wildcard-host*)
:remote-host (and host (host-to-vector-quad host))
:remote-port port))
#-(or rawsock ffi)
(unsupported '(protocol :datagram) 'socket-connect))))
......@@ -169,7 +173,7 @@
:backlog backlog)
(when (ip/= host *wildcard-host*)
(list :interface host))))))
(with-mapped-conditions ()
(with-mapped-conditions (nil host)
(make-stream-server-socket sock :element-type element-type))))
(defmethod socket-accept ((socket stream-server-usocket) &key element-type)
......@@ -186,14 +190,10 @@
;; are the same object
(defmethod socket-close ((usocket usocket))
"Close socket."
(when (wait-list usocket)
(remove-waiter (wait-list usocket) usocket))
(with-mapped-conditions (usocket)
(close (socket usocket))))
(defmethod socket-close ((usocket stream-server-usocket))
(when (wait-list usocket)
(remove-waiter (wait-list usocket) usocket))
(socket:socket-server-close (socket usocket)))
(defmethod socket-shutdown ((usocket stream-usocket) direction)
......@@ -349,8 +349,6 @@ and the address of the sender as values."
rv))
(defmethod socket-close ((usocket datagram-usocket))
(when (wait-list usocket)
(remove-waiter (wait-list usocket) usocket))
(rawsock:sock-close (socket usocket)))
(declaim (inline get-socket-name))
......@@ -609,8 +607,6 @@ and the address of the sender as values."
(ext:finalize usocket 'finalize-datagram-usocket))
(defmethod socket-close ((usocket datagram-usocket))
(when (wait-list usocket)
(remove-waiter (wait-list usocket) usocket))
(with-slots (recv-buffer socket) usocket
(ffi:foreign-free recv-buffer)
(zerop (%close socket))))
......
......@@ -10,7 +10,7 @@
local-host local-port)
(when (eq nodelay :if-supported)
(setf nodelay t))
(with-mapped-conditions ()
(with-mapped-conditions (nil host)
(let* ((remote (when (and host port)
(openmcl-socket:resolve-address :host (host-to-hostname host)
:port port
......@@ -48,7 +48,7 @@
(element-type 'character))
(let ((local-address (openmcl-socket:resolve-address :host (host-to-hostname host)
:port port :connect :passive)))
(with-mapped-conditions ()
(with-mapped-conditions (nil host)
(make-stream-server-socket
(openmcl-socket:make-socket :connect :passive
:address-family (openmcl-socket:socket-address-family local-address)
......@@ -62,7 +62,7 @@
(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
(let* ((ccl-socket (socket usocket))
(socket-keys (ccl::socket-keys ccl-socket)))
(with-mapped-conditions (usocket)
(with-mapped-conditions (usocket host)
(if (and host port)
(openmcl-socket:send-to ccl-socket buffer size
:remote-host (host-to-hostname host)
......
;;;; $Id$
;;;; $URL$
;;;; See LICENSE for licensing information.
(in-package :usocket)
......@@ -22,16 +19,22 @@
(append +unix-errno-condition-map+
+unix-errno-error-map+))
(defun cmucl-map-socket-error (err &key condition socket)
(let ((usock-err
(defun cmucl-map-socket-error (err &key condition socket host-or-ip)
(let ((usock-error
(cdr (assoc err +cmucl-error-map+ :test #'member))))
(if usock-err
(if (subtypep usock-err 'error)
(error usock-err :socket socket)
(signal usock-err :socket socket))
(error 'unknown-error
:socket socket
:real-error condition))))
(if usock-error
(if (subtypep usock-error 'error)
(cond ((subtypep usock-error 'ns-error)
(error usock-error :socket socket :host-or-ip host-or-ip))
(t
(error usock-error :socket socket)))
(cond ((subtypep usock-error 'ns-condition)
(signal usock-error :socket socket :host-or-ip host-or-ip))
(t
(signal usock-error :socket socket))))
(error 'unknown-error
:socket socket
:real-error condition))))