;;;; -*- coding: utf-8; fill-column: 78 -*-
changes relative to sbcl-1.0.36:
+ * INCOMPATIBLE CHANGE: the SB-QUEUE contrib was merged into the
+ SB-CONCURRENCY contrib module.
* new contrib: SB-CONCURRENCY is a new contrib; it's supposed to contain
additional data structures and tools for concurrent programming; at the
moment it contains a lock-free queue, and a lock-free mailbox
implementation.
- * deprecated contrib: the SB-QUEUE contrib was merged into the
- SB-CONCURRENCY contrib and deprecated.
* new feature: added SB-THREAD:TRY-SEMAPHORE, a non-blocking variant of
SB-THREAD:WAIT-ON-SEMAPHORE.
* new feature: SB-EXT:ATOMIC-DECF has been added as a companion to
* enhancement: errors from NO-APPLICABLE-METHOD and
NO-PRIMARY-METHOD now have a RETRY restart available to retry the
generic function call.
+ * enhancement: SB-BSD-SOCKET improvements
+ ** sockets and socket streams now have a more informative printed
+ representation based on the corresponding SOCKET-NAME and
+ SOCKET-PEERNAME.
+ ** SOCKET-MAKE-STREAM once more supports the :AUTO-CLOSE option.
+ (lp#540413)
* bug fix: correct restart text for the continuable error in MAKE-PACKAGE.
* bug fix: a rare case of startup-time page table corruption.
* bug fix: a semaphore with multiple waiters and some of them unwinding due
;;; XXX should we *...* this?
(defparameter inet-address-any (vector 0 0 0 0))
+(defmethod socket-namestring ((socket inet-socket))
+ (ignore-errors
+ (multiple-value-bind (addr port) (socket-name socket)
+ (format nil "~{~A~^.~}:~A" (coerce addr 'list) port))))
+
+(defmethod socket-peerstring ((socket inet-socket))
+ (ignore-errors
+ (multiple-value-bind (addr port) (socket-peername socket)
+ (format nil "~{~A~^.~}:~A" (coerce addr 'list) port))))
+
;;; binding a socket to an address and port. Doubt that anyone's
;;; actually using this much, to be honest.
(:documentation "Class representing local domain (AF_LOCAL) sockets,
also known as unix-domain sockets."))
+(defmethod socket-namestring ((socket local-socket))
+ (ignore-errors (socket-name socket)))
+
+(defmethod socket-peerstring ((socket local-socket))
+ (ignore-errors (socket-peername socket)))
+
(defmethod make-sockaddr-for ((socket local-socket)
&optional sockaddr &rest address &aux (filename (first address)))
(let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-un))))
(defmethod print-object ((object socket) stream)
(print-unreadable-object (object stream :type t :identity t)
- (princ "descriptor " stream)
- (princ (slot-value object 'file-descriptor) stream)))
+ (format stream "~@[~A, ~]~@[peer: ~A, ~]fd: ~A"
+ (socket-namestring object)
+ (socket-peerstring object)
+ (slot-value object 'file-descriptor))))
+(defgeneric socket-namestring (socket))
+
+(defmethod socket-namestring (socket)
+ nil)
+
+(defgeneric socket-peerstring (socket))
+
+(defmethod socket-peerstring (socket)
+ nil)
(defmethod shared-initialize :after ((socket socket) slot-names
&key protocol type
(element-type 'character)
(buffering :full)
(external-format :default)
- timeout)
- "Default method for SOCKET objects. An ELEMENT-TYPE of :DEFAULT
-will construct a bivalent stream. Acceptable values for BUFFERING
-are :FULL, :LINE and :NONE. Streams will have no TIMEOUT
-by default.
- The stream for SOCKET will be cached, and a second invocation of this
-method will return the same stream. This may lead to oddities if this
-function is invoked with inconsistent arguments \(e.g., one might request
-an input stream and get an output stream in response\)."
+ timeout
+ auto-close)
+ "Default method for SOCKET objects. An ELEMENT-TYPE of :DEFAULT will
+construct a bivalent stream. Acceptable values for BUFFERING are :FULL, :LINE
+and :NONE. Streams will have no TIMEOUT by default. If AUTO-CLOSE is true, the
+underlying OS socket is automatically closed after the stream and the socket
+have been garbage collected.
+
+The stream for SOCKET will be cached, and a second invocation of this method
+will return the same stream. This may lead to oddities if this function is
+invoked with inconsistent arguments \(e.g., one might request an input stream
+and get an output stream in response\)."
(let ((stream
(and (slot-boundp socket 'stream) (slot-value socket 'stream))))
(unless stream
(setf stream (sb-sys:make-fd-stream
(socket-file-descriptor socket)
- :name "a socket"
+ :name (format nil "socket~@[ ~A~]~@[, peer: ~A~]"
+ (socket-namestring socket)
+ (socket-peerstring socket))
:dual-channel-p t
:input input
:output output
:element-type element-type
:buffering buffering
:external-format external-format
- :timeout timeout)))
+ :timeout timeout
+ :auto-close auto-close)))
(setf (slot-value socket 'stream) stream)
(sb-ext:cancel-finalization socket)
stream))
projects / sbcl.git / commitdiff