sockets/socket-methods.lisp

   1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 ;;   Copyright (C) 2006, 2007 Stelian Ionescu
   4 ;;
   5 ;;   This code is free software; you can redistribute it and/or
   6 ;;   modify it under the terms of the version 2.1 of
   7 ;;   the GNU Lesser General Public License as published by
   8 ;;   the Free Software Foundation, as clarified by the
   9 ;;   preamble found here:
  10 ;;       http://opensource.franz.com/preamble.html
  11 ;;
  12 ;;   This program is distributed in the hope that it will be useful,
  13 ;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;   GNU General Public License for more details.
  16 ;;
  17 ;;   You should have received a copy of the GNU Lesser General
  18 ;;   Public License along with this library; if not, write to the
  19 ;;   Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  20 ;;   Boston, MA 02110-1301, USA
  21
  22 (in-package :net.sockets)
  23
  24 (defparameter *socket-type-map*
  25   '(((:ipv4  :stream   :active  :default) . socket-stream-internet-active)
  26     ((:ipv6  :stream   :active  :default) . socket-stream-internet-active)
  27     ((:ipv4  :stream   :passive :default) . socket-stream-internet-passive)
  28     ((:ipv6  :stream   :passive :default) . socket-stream-internet-passive)
  29     ((:local :stream   :active  :default) . socket-stream-local-active)
  30     ((:local :stream   :passive :default) . socket-stream-local-passive)
  31     ((:local :datagram :active  :default) . socket-datagram-local-active)
  32     ((:ipv4  :datagram :active  :default) . socket-datagram-internet-active)
  33     ((:ipv6  :datagram :active  :default) . socket-datagram-internet-active)))
  34
  35 (defun select-socket-type (family type connect protocol)
  36   (or (cdr (assoc (list family type connect protocol) *socket-type-map*
  37                   :test #'equal))
  38       (error "No socket class found !!")))
  39
  40
  41 ;;;;;;;;;;;;;;;;;;;;;;;;;
  42 ;;  SHARED-INITIALIZE  ;;
  43 ;;;;;;;;;;;;;;;;;;;;;;;;;
  44
  45 (defun translate-make-socket-keywords-to-constants (family type protocol)
  46   (let ((sf (ecase family
  47               (:ipv4  et:af-inet)
  48               (:ipv6  et:af-inet6)
  49               (:local et:af-local)))
  50         (st (ecase type
  51               (:stream   et:sock-stream)
  52               (:datagram et:sock-dgram)))
  53         (sp (cond
  54               ((integerp protocol) protocol)
  55               ((eql protocol :default) 0)
  56               ((keywordp protocol)
  57                (protocol-number
  58                 (get-protocol-by-name (string-downcase
  59                                        (string protocol))))))))
  60     (values sf st sp)))
  61
  62 (defmethod shared-initialize :after ((socket socket) slot-names
  63                                      &key file-descriptor family
  64                                      type (protocol :default))
  65   (when (socket-open-p socket)
  66     (close socket))
  67   (with-slots (fd (fam family) (proto protocol)) socket
  68     (multiple-value-bind (sf st sp)
  69         (translate-make-socket-keywords-to-constants family type protocol)
  70       (if file-descriptor
  71           (setf fd file-descriptor)
  72           (setf fd (with-socket-error-filter
  73                      (et:socket sf st sp))))
  74       (setf fam family
  75             proto protocol))))
  76
  77 (defmethod socket-type ((socket stream-socket))
  78   :stream)
  79
  80 (defmethod socket-type ((socket datagram-socket))
  81   :datagram)
  82
  83
  84 ;;;;;;;;;;;;;;;;;;;;
  85 ;;  PRINT-OBJECT  ;;
  86 ;;;;;;;;;;;;;;;;;;;;
  87
  88 (defmethod print-object ((socket socket-stream-internet-active) stream)
  89   (print-unreadable-object (socket stream :type nil :identity t)
  90     (format stream "active internet stream socket" )
  91     (if (socket-connected-p socket)
  92         (multiple-value-bind (addr port) (remote-name socket)
  93           (format stream " connected to ~A/~A"
  94                   (sockaddr->presentation addr) port))
  95         (if (slot-value socket 'fd)
  96             (format stream ", unconnected")
  97             (format stream ", closed")))))
  98
  99 (defmethod print-object ((socket socket-stream-internet-passive) stream)
 100   (print-unreadable-object (socket stream :type nil :identity t)
 101     (format stream "passive internet stream socket" )
 102     (if (socket-bound-p socket)
 103         (multiple-value-bind (addr port) (local-name socket)
 104           (format stream " ~A ~A/~A"
 105                   (if (socket-listening-p socket)
 106                       "waiting for connections @"
 107                       "bound to")
 108                   (sockaddr->presentation addr) port))
 109         (if (slot-value socket 'fd)
 110             (format stream ", unbound")
 111             (format stream ", closed")))))
 112
 113 (defmethod print-object ((socket socket-stream-local-active) stream)
 114   (print-unreadable-object (socket stream :type nil :identity t)
 115     (format stream "active local stream socket" )
 116     (if (socket-connected-p socket)
 117         (format stream " connected")
 118         (if (slot-value socket 'fd)
 119             (format stream ", unconnected")
 120             (format stream ", closed")))))
 121
 122 (defmethod print-object ((socket socket-stream-local-passive) stream)
 123   (print-unreadable-object (socket stream :type nil :identity t)
 124     (format stream "passive local stream socket" )
 125     (if (socket-bound-p socket)
 126         (format stream " ~A ~A"
 127                 (if (socket-listening-p socket)
 128                     "waiting for connections @"
 129                     "bound to")
 130                 (sockaddr->presentation (socket-address socket)))
 131         (if (slot-value socket 'fd)
 132             (format stream ", unbound")
 133             (format stream ", closed")))))
 134
 135 (defmethod print-object ((socket socket-datagram-local-active) stream)
 136   (print-unreadable-object (socket stream :type nil :identity t)
 137     (format stream "local datagram socket" )
 138     (if (socket-connected-p socket)
 139         (format stream " connected")
 140         (if (slot-value socket 'fd)
 141             (format stream ", unconnected")
 142             (format stream ", closed")))))
 143
 144 (defmethod print-object ((socket socket-datagram-internet-active) stream)
 145   (print-unreadable-object (socket stream :type nil :identity t)
 146     (format stream "internet datagram socket" )
 147     (if (socket-connected-p socket)
 148         (multiple-value-bind (addr port) (remote-name socket)
 149           (format stream " connected to ~A/~A"
 150                   (sockaddr->presentation addr) port))
 151         (if (slot-value socket 'fd)
 152             (format stream ", unconnected")
 153             (format stream ", closed")))))
 154
 155
 156 ;;;;;;;;;;;;;
 157 ;;  CLOSE  ;;
 158 ;;;;;;;;;;;;;
 159
 160 (defmethod close :around ((socket socket) &key abort)
 161   (declare (ignore abort))
 162   (when (slot-value socket 'fd)
 163     (with-socket-error-filter
 164       (et:close (socket-fd socket))))
 165   (setf (slot-value socket 'fd) nil)
 166   (call-next-method)
 167   (values socket))
 168
 169 (defmethod close :around ((socket passive-socket) &key abort)
 170   (declare (ignore abort))
 171   (call-next-method)
 172   (setf (slot-value socket 'bound) nil)
 173   (setf (slot-value socket 'listening) nil)
 174   (values socket))
 175
 176 (defmethod close ((socket socket) &key abort)
 177   (declare (ignore socket abort)))
 178
 179 (defmethod socket-open-p ((socket socket))
 180   (unless (slot-value socket 'fd)
 181     (return-from socket-open-p nil))
 182   (with-socket-error-filter
 183     (handler-case
 184         (with-foreign-object (ss 'et:sockaddr-storage)
 185           (et:bzero ss et:size-of-sockaddr-storage)
 186           (with-foreign-pointer (size et:size-of-socklen)
 187             (setf (mem-ref size :socklen)
 188                   et:size-of-sockaddr-storage)
 189             (et:getsockname (socket-fd socket)
 190                             ss size)
 191             t))
 192       (unix-error (err)
 193         (case (error-identifier err)
 194           ((:ebadf
 195             #+freebsd :econnreset)
 196            nil)
 197           ;; some other error
 198           (otherwise (error err)))))))
 199
 200
 201 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 202 ;;  get and set O_NONBLOCK  ;;
 203 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 204
 205 (defmethod socket-non-blocking ((socket socket))
 206   (with-slots (fd) socket
 207     (let ((current-flags (with-socket-error-filter
 208                            (et:fcntl fd et:f-getfl))))
 209       (logtest et:o-nonblock current-flags))))
 210
 211 (defmethod (setf socket-non-blocking) (value (socket socket))
 212   (check-type value boolean "a boolean value")
 213   (with-slots (fd) socket
 214     (with-socket-error-filter
 215       (let* ((current-flags (et:fcntl fd et:f-getfl))
 216              (new-flags (if value
 217                             (logior current-flags et:o-nonblock)
 218                             (logandc2 current-flags et:o-nonblock))))
 219         (when (/= new-flags current-flags)
 220           (et:fcntl fd et:f-setfl new-flags)))))
 221   (values value))
 222
 223
 224 ;;;;;;;;;;;;;;;;;;;
 225 ;;  GETSOCKNAME  ;;
 226 ;;;;;;;;;;;;;;;;;;;
 227
 228 (defmethod local-name ((socket internet-socket))
 229   (with-foreign-object (ss 'et:sockaddr-storage)
 230     (et:bzero ss et:size-of-sockaddr-storage)
 231     (with-foreign-pointer (size et:size-of-socklen)
 232       (setf (mem-ref size :socklen)
 233             et:size-of-sockaddr-storage)
 234       (with-socket-error-filter
 235         (et:getsockname (socket-fd socket)
 236                         ss size))
 237       (return-from local-name
 238         (sockaddr-storage->sockaddr ss)))))
 239
 240 (defmethod local-name ((socket local-socket))
 241   (with-foreign-object (sun 'et:sockaddr-un)
 242     (et:bzero sun et:size-of-sockaddr-un)
 243     (with-foreign-pointer (size et:size-of-socklen)
 244       (setf (mem-ref size :socklen)
 245             et:size-of-sockaddr-storage)
 246       (with-socket-error-filter
 247         (et:getsockname (socket-fd socket)
 248                         sun size))
 249       (return-from local-name
 250         (sockaddr-un->sockaddr sun)))))
 251
 252 (defmethod socket-address ((socket socket))
 253   (nth-value 0 (local-name socket)))
 254
 255 (defmethod socket-port ((socket internet-socket))
 256   (nth-value 1 (local-name socket)))
 257
 258
 259 ;;;;;;;;;;;;;;;;;;;
 260 ;;  GETPEERNAME  ;;
 261 ;;;;;;;;;;;;;;;;;;;
 262
 263 (defmethod remote-name ((socket internet-socket))
 264   (with-foreign-object (ss 'et:sockaddr-storage)
 265     (et:bzero ss et:size-of-sockaddr-storage)
 266     (with-foreign-pointer (size et:size-of-socklen)
 267       (setf (mem-ref size :socklen)
 268             et:size-of-sockaddr-storage)
 269       (with-socket-error-filter
 270         (et:getpeername (socket-fd socket)
 271                         ss size))
 272       (return-from remote-name
 273         (sockaddr-storage->sockaddr ss)))))
 274
 275 (defmethod remote-name ((socket local-socket))
 276   (with-foreign-object (sun 'et:sockaddr-un)
 277     (et:bzero sun et:size-of-sockaddr-un)
 278     (with-foreign-pointer (size et:size-of-socklen)
 279       (setf (mem-ref size :socklen)
 280             et:size-of-sockaddr-storage)
 281       (with-socket-error-filter
 282         (et:getpeername (socket-fd socket)
 283                         sun size))
 284       (return-from remote-name
 285         (sockaddr-un->sockaddr sun)))))
 286
 287
 288 ;;;;;;;;;;;;
 289 ;;  BIND  ;;
 290 ;;;;;;;;;;;;
 291
 292 (defmethod bind-address :before ((socket internet-socket)
 293                                  address &key (reuse-address t))
 294   (when reuse-address
 295     (set-socket-option socket :reuse-address :value t)))
 296
 297 (defun bind-ipv4-address (fd address port)
 298   (with-foreign-object (sin 'et:sockaddr-in)
 299     (make-sockaddr-in sin address port)
 300     (with-socket-error-filter
 301       (et:bind fd sin et:size-of-sockaddr-in))))
 302
 303 (defun bind-ipv6-address (fd address port)
 304   (with-foreign-object (sin6 'et:sockaddr-in6)
 305     (make-sockaddr-in6 sin6 address port)
 306     (with-socket-error-filter
 307       (et:bind fd sin6 et:size-of-sockaddr-in6))))
 308
 309 (defmethod bind-address ((socket internet-socket)
 310                          (address ipv4addr)
 311                          &key (port 0))
 312   (if (eql (socket-family socket) :ipv6)
 313       (bind-ipv6-address (socket-fd socket)
 314                          (map-ipv4-vector-to-ipv6 (name address))
 315                          port)
 316       (bind-ipv4-address (socket-fd socket) (name address) port))
 317   (values socket))
 318
 319 (defmethod bind-address ((socket internet-socket)
 320                          (address ipv6addr)
 321                          &key (port 0))
 322   (bind-ipv6-address (socket-fd socket) (name address) port)
 323   (values socket))
 324
 325 (defmethod bind-address :before ((socket local-socket)
 326                                  (address localaddr) &key)
 327   (when (typep socket 'active-socket)
 328     (error "You can't bind an active Unix socket.")))
 329
 330 (defmethod bind-address ((socket local-socket)
 331                          (address localaddr) &key)
 332   (with-foreign-object (sun 'et:sockaddr-un)
 333     (make-sockaddr-un sun (name address))
 334     (with-socket-error-filter
 335       (et:bind (socket-fd socket) sun et:size-of-sockaddr-un)))
 336   (values socket))
 337
 338 (defmethod bind-address :after ((socket socket)
 339                                 (address sockaddr) &key)
 340   (setf (slot-value socket 'bound) t))
 341
 342
 343 ;;;;;;;;;;;;;;
 344 ;;  LISTEN  ;;
 345 ;;;;;;;;;;;;;;
 346
 347 (defmethod socket-listen ((socket passive-socket)
 348                           &key (backlog (min *default-backlog-size*
 349                                              +max-backlog-size+)))
 350   (check-type backlog unsigned-byte "a non-negative integer")
 351   (with-socket-error-filter
 352     (et:listen (socket-fd socket) backlog))
 353   (setf (slot-value socket 'listening) t)
 354   (values socket))
 355
 356 (defmethod socket-listen ((socket active-socket)
 357                           &key backlog)
 358   (declare (ignore backlog))
 359   (error "You can't listen on active sockets."))
 360
 361
 362 ;;;;;;;;;;;;;;
 363 ;;  ACCEPT  ;;
 364 ;;;;;;;;;;;;;;
 365
 366 (defmethod accept-connection ((socket active-socket)
 367                               &key wait)
 368   (declare (ignore wait))
 369   (error "You can't accept connections on active sockets."))
 370
 371 (defmethod accept-connection ((socket passive-socket)
 372                               &key (wait t))
 373   (with-foreign-object (ss 'et:sockaddr-storage)
 374     (et:bzero ss et:size-of-sockaddr-storage)
 375     (with-foreign-pointer (size et:size-of-socklen)
 376       (setf (mem-ref size :socklen)
 377             et:size-of-sockaddr-storage)
 378       (let (non-blocking-state
 379             client-fd)
 380         (with-socket-error-filter
 381           (handler-case
 382               (if wait
 383                   ;; do a "normal" accept
 384                   ;; Note: the socket may already be in non-blocking mode
 385                   (setf client-fd (et:accept (socket-fd socket)
 386                                              ss size))
 387                   ;; set the socket to non-blocking mode before calling accept()
 388                   ;; if there's no new connection return NIL
 389                   (unwind-protect
 390                        (progn
 391                          ;; saving the current non-blocking state
 392                          (setf non-blocking-state (socket-non-blocking socket))
 393                          ;; switch the socket to non-blocking mode
 394                          (setf (socket-non-blocking socket) t)
 395                          (setf client-fd (et:accept (socket-fd socket)
 396                                                     ss size)))
 397                     ;; restoring the socket's non-blocking state
 398                     (setf (socket-non-blocking socket) non-blocking-state)))
 399             ;; the socket is marked non-blocking and there's no new connection
 400             (et:unix-error-wouldblock (err)
 401               (declare (ignore err))
 402               (return-from accept-connection nil))))
 403
 404         (let ((client-socket
 405                ;; create the client socket object
 406                (make-instance (active-class socket)
 407                               :file-descriptor client-fd)))
 408           (return-from accept-connection client-socket))))))
 409
 410
 411 ;;;;;;;;;;;;;;;
 412 ;;  CONNECT  ;;
 413 ;;;;;;;;;;;;;;;
 414
 415 #+freebsd
 416 (defmethod connect :before ((socket active-socket)
 417                             sockaddr &key)
 418   (when *no-sigpipe*
 419     (set-socket-option socket :no-sigpipe :value t)))
 420
 421 (defun ipv4-connect (fd address port)
 422   (with-foreign-object (sin 'et:sockaddr-in)
 423     (make-sockaddr-in sin address port)
 424     (with-socket-error-filter
 425       (et:connect fd sin et:size-of-sockaddr-in))))
 426
 427 (defun ipv6-connect (fd address port)
 428   (with-foreign-object (sin6 'et:sockaddr-in6)
 429     (make-sockaddr-in6 sin6 address port)
 430     (with-socket-error-filter
 431       (et:connect fd sin6 et:size-of-sockaddr-in6))))
 432
 433 (defmethod connect ((socket internet-socket)
 434                     (address ipv4addr) &key (port 0))
 435   (if (eql (socket-family socket) :ipv6)
 436       (ipv6-connect (socket-fd socket)
 437                     (map-ipv4-vector-to-ipv6 (name address))
 438                     port)
 439       (ipv4-connect (socket-fd socket) (name address) port))
 440   (values socket))
 441
 442 (defmethod connect ((socket internet-socket)
 443                     (address ipv6addr) &key (port 0))
 444   (ipv6-connect (socket-fd socket) (name address) port)
 445   (values socket))
 446
 447 (defmethod connect ((socket local-socket)
 448                     (address localaddr) &key)
 449   (with-foreign-object (sun 'et:sockaddr-un)
 450     (make-sockaddr-un sun (name address))
 451     (with-socket-error-filter
 452       (et:connect (socket-fd socket) sun et:size-of-sockaddr-un)))
 453   (values socket))
 454
 455 (defmethod connect ((socket passive-socket)
 456                     address &key)
 457   (error "You cannot connect passive sockets."))
 458
 459 (defmethod socket-connected-p ((socket socket))
 460   (unless (slot-value socket 'fd)
 461     (return-from socket-connected-p nil))
 462   (with-socket-error-filter
 463     (handler-case
 464         (with-foreign-object (ss 'et:sockaddr-storage)
 465           (et:bzero ss et:size-of-sockaddr-storage)
 466           (with-foreign-pointer (size et:size-of-socklen)
 467             (setf (mem-ref size :socklen)
 468                   et:size-of-sockaddr-storage)
 469             (et:getpeername (socket-fd socket)
 470                             ss size)
 471             t))
 472       (et:unix-error-notconn (err)
 473         (declare (ignore err))
 474         nil))))
 475
 476
 477 ;;;;;;;;;;;;;;;;
 478 ;;  SHUTDOWN  ;;
 479 ;;;;;;;;;;;;;;;;
 480
 481 (defmethod shutdown ((socket active-socket) direction)
 482   (check-type direction (member :read :write :read-write)
 483               "valid direction specifier")
 484   (with-socket-error-filter
 485     (et:shutdown (socket-fd socket)
 486                  (ecase direction
 487                    (:read et:shut-rd)
 488                    (:write et:shut-wr)
 489                    (:read-write et:shut-rdwr))))
 490   (values socket))
 491
 492 (defmethod shutdown ((socket passive-socket) direction)
 493   (error "You cannot shut down passive sockets."))
 494
 495
 496 ;;;;;;;;;;;;
 497 ;;  SEND  ;;
 498 ;;;;;;;;;;;;
 499
 500 (defun normalize-send-buffer (buff vstart vend)
 501   (let ((start (or vstart 0))
 502         (end (if vend
 503                  (min vend (length buff))
 504                  (length buff))))
 505     (assert (<= start end))
 506     (etypecase buff
 507       ((simple-array ub8 (*)) (values buff start (- end start)))
 508       ((vector ub8) (values (coerce buff '(simple-array ub8 (*)))
 509                             start (- end start)))
 510       (string (values (coerce (io.encodings:string-to-octets buff :external-format :iso-8859-1
 511                                                               :start start :end end)
 512                               '(simple-array ub8 (*)))
 513                       0 (- end start))))))
 514
 515 (defmethod socket-send :before ((buffer array)
 516                                 (socket active-socket)
 517                                 &key start end
 518                                 remote-address remote-port)
 519   (check-type start (or unsigned-byte null)
 520               "a non-negative value or NIL")
 521   (check-type end (or unsigned-byte null)
 522               "a non-negative value or NIL")
 523   (when (or remote-port remote-address)
 524     (check-type remote-address sockaddr "a network address")
 525     (check-type remote-port (unsigned-byte 16) "a valid IP port number")))
 526
 527 (defmethod socket-send ((buffer array)
 528                         (socket active-socket) &key start end
 529                         remote-address remote-port end-of-record
 530                         dont-route dont-wait (no-signal *no-sigpipe*)
 531                         out-of-band #+linux more #+linux confirm)
 532
 533   (let ((flags (logior (if end-of-record et:msg-eor 0)
 534                        (if dont-route et:msg-dontroute 0)
 535                        (if dont-wait  et:msg-dontwait 0)
 536                        (if no-signal  et:msg-nosignal 0)
 537                        (if out-of-band et:msg-oob 0)
 538                        #+linux (if more et:msg-more 0)
 539                        #+linux (if confirm et:msg-confirm 0))))
 540
 541     (when (and (ipv4-address-p remote-address)
 542                (eql (socket-family socket) :ipv6))
 543       (setf remote-address (map-ipv4-address->ipv6 remote-address)))
 544     (multiple-value-bind (buff start-offset bufflen)
 545         (normalize-send-buffer buffer start end)
 546       (with-foreign-object (ss 'et:sockaddr-storage)
 547         (et:bzero ss et:size-of-sockaddr-storage)
 548         (when remote-address
 549           (sockaddr->sockaddr-storage ss remote-address remote-port))
 550         (with-pointer-to-vector-data (buff-sap buff)
 551           (incf-pointer buff-sap start-offset)
 552           (with-socket-error-filter
 553             (return-from socket-send
 554               (et:sendto (socket-fd socket)
 555                          buff-sap bufflen
 556                          flags
 557                          (if remote-address ss (null-pointer))
 558                          (if remote-address et:size-of-sockaddr-storage 0)))))))))
 559
 560 (defmethod socket-send (buffer (socket passive-socket) &key)
 561   (error "You cannot send data on a passive socket."))
 562
 563
 564 ;;;;;;;;;;;;
 565 ;;  RECV  ;;
 566 ;;;;;;;;;;;;
 567
 568 (defun normalize-receive-buffer (buff vstart vend)
 569   (let ((start (or vstart 0))
 570         (end (if vend
 571                  (min vend (length buff))
 572                  (length buff))))
 573     (assert (<= start end))
 574     (etypecase buff
 575       ((simple-array ub8 (*)) (values buff start (- end start)))
 576       (simple-base-string (values buff start (- end start))))))
 577
 578 (defmethod socket-receive :before ((buffer array)
 579                                    (socket active-socket)
 580                                    &key start end)
 581   (check-type start (or unsigned-byte null)
 582               "a non-negative value or NIL")
 583   (check-type end (or unsigned-byte null)
 584               "a non-negative value or NIL"))
 585
 586 (defmethod socket-receive ((buffer array)
 587                            (socket active-socket) &key start end
 588                            out-of-band peek wait-all
 589                            dont-wait (no-signal *no-sigpipe*))
 590
 591   (let ((flags (logior (if out-of-band et:msg-oob 0)
 592                        (if peek        et:msg-peek 0)
 593                        (if wait-all    et:msg-waitall 0)
 594                        (if dont-wait   et:msg-dontwait 0)
 595                        (if no-signal   et:msg-nosignal 0)))
 596         bytes-received)
 597
 598     (multiple-value-bind (buff start-offset bufflen)
 599         (normalize-receive-buffer buffer start end)
 600       (with-foreign-object (ss 'et:sockaddr-storage)
 601         (et:bzero ss et:size-of-sockaddr-storage)
 602         (with-foreign-pointer (size et:size-of-socklen)
 603           (setf (mem-ref size :socklen)
 604                 et:size-of-sockaddr-storage)
 605           (with-pointer-to-vector-data (buff-sap buff)
 606             (incf-pointer buff-sap start-offset)
 607             (with-socket-error-filter
 608               (setf bytes-received
 609                     (et:recvfrom (socket-fd socket)
 610                                  buff-sap bufflen
 611                                  flags
 612                                  ss size)))))
 613
 614         (return-from socket-receive
 615           ;; when socket is a datagram socket
 616           ;; return the sender's address as 3rd value
 617           (if (typep socket 'datagram-socket)
 618               (multiple-value-bind (remote-address remote-port)
 619                   (sockaddr-storage->sockaddr ss)
 620                 (values buffer bytes-received remote-address remote-port))
 621               (values buffer bytes-received)))))))
 622
 623 (defmethod socket-receive (buffer (socket passive-socket) &key)
 624   (error "You cannot receive data from a passive socket."))
 625
 626
 627 ;;
 628 ;; Only for datagram sockets
 629 ;;
 630
 631 (defmethod unconnect :before ((socket active-socket))
 632   (unless (typep socket 'datagram-socket)
 633     (error "You can only unconnect active datagram sockets.")))
 634
 635 (defmethod unconnect ((socket datagram-socket))
 636   (with-socket-error-filter
 637     (with-foreign-object (sin 'et:sockaddr-in)
 638       (et:bzero sin et:size-of-sockaddr-in)
 639       (setf (foreign-slot-value sin 'et:sockaddr-in 'et:addr) et:af-unspec)
 640       (et:connect (socket-fd socket) sin et:size-of-sockaddr-in))))