src/sockets/socket-methods.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Various socket methods.
   4 ;;;
   5
   6 (in-package :iolib/sockets)
   7
   8 ;;;-------------------------------------------------------------------------
   9 ;;; Shared Initialization
  10 ;;;-------------------------------------------------------------------------
  11
  12 (defun translate-make-socket-keywords-to-constants (address-family type protocol)
  13   (let ((sf (ecase address-family
  14               (:ipv4  af-inet)
  15               (:ipv6  af-inet6)
  16               (:local af-local)
  17               #+linux
  18               (:netlink af-netlink)))
  19         (st (ecase type
  20               (:stream   sock-stream)
  21               (:datagram sock-dgram)
  22               (:raw      sock-raw)))
  23         (sp (etypecase protocol
  24               ((eql :default) 0)
  25               (integer        protocol))))
  26     (values sf st sp)))
  27
  28 (defmethod socket-os-fd ((socket socket))
  29   (fd-of socket))
  30
  31 (defmethod shared-initialize :after
  32     ((socket socket) slot-names
  33      &key file-descriptor (dup t) address-family type protocol)
  34   (declare (ignore slot-names))
  35   (with-accessors ((fd fd-of) (fam socket-address-family) (proto socket-protocol))
  36       socket
  37     (setf fd (or (and file-descriptor (if dup
  38                                           (isys:dup file-descriptor)
  39                                           file-descriptor))
  40                  (multiple-value-call #'%socket
  41                    (translate-make-socket-keywords-to-constants
  42                     address-family type protocol))))
  43     (setf fam address-family
  44           proto protocol)))
  45
  46 (defmethod (setf external-format-of) (external-format (socket passive-socket))
  47   (setf (slot-value socket 'external-format)
  48         (babel:ensure-external-format (or external-format :default))))
  49
  50 (defmethod shared-initialize :after ((socket passive-socket) slot-names
  51                                      &key external-format
  52                                      input-buffer-size output-buffer-size)
  53   ;; Makes CREATE-SOCKET simpler
  54   (declare (ignore slot-names input-buffer-size output-buffer-size))
  55   (setf (external-format-of socket) (or external-format :default)))
  56 \f
  57
  58 ;;;-------------------------------------------------------------------------
  59 ;;; Misc
  60 ;;;-------------------------------------------------------------------------
  61
  62 (defmethod socket-type ((socket stream-socket))
  63   :stream)
  64
  65 (defmethod socket-type ((socket datagram-socket))
  66   :datagram)
  67
  68 (defun socket-ipv6-p (socket)
  69   "Return T if SOCKET is an AF_INET6 socket."
  70   (eql :ipv6 (socket-address-family socket)))
  71
  72 (defun ipv6-socket-p (&rest args)
  73   (apply #'socket-ipv6-p args))
  74
  75 (defobsolete ipv6-socket-p socket-ipv6-p)
  76 \f
  77
  78 ;;;-------------------------------------------------------------------------
  79 ;;; PRINT-OBJECT
  80 ;;;-------------------------------------------------------------------------
  81
  82 (defun sock-fam (socket)
  83   (ecase (socket-address-family socket)
  84     (:ipv4 "IPv4")
  85     (:ipv6 "IPv6")))
  86
  87 (defmethod print-object ((socket socket-stream-internet-active) stream)
  88   (print-unreadable-object (socket stream :identity t)
  89     (format stream "active ~A stream socket" (sock-fam socket))
  90     (if (socket-connected-p socket)
  91         (multiple-value-bind (host port) (remote-name socket)
  92           (format stream " connected to ~A/~A"
  93                   (address-to-string host) port))
  94         (format stream ", ~:[closed~;unconnected~]" (fd-of socket)))))
  95
  96 (defmethod print-object ((socket socket-stream-internet-passive) stream)
  97   (print-unreadable-object (socket stream :identity t)
  98     (format stream "passive ~A stream socket" (sock-fam socket))
  99     (if (socket-bound-p socket)
 100         (multiple-value-bind (host port) (local-name socket)
 101           (format stream " ~:[bound to~;waiting @~] ~A/~A"
 102                   (socket-listening-p socket)
 103                   (address-to-string host) port))
 104         (format stream ", ~:[closed~;unbound~]" (fd-of socket)))))
 105
 106 (defmethod print-object ((socket socket-stream-local-active) stream)
 107   (print-unreadable-object (socket stream :identity t)
 108     (format stream "active local stream socket")
 109     (if (socket-connected-p socket)
 110         (format stream " connected to ~S"
 111                 (address-to-string (remote-filename socket)))
 112         (format stream ", ~:[closed~;unconnected~]" (fd-of socket)))))
 113
 114 (defmethod print-object ((socket socket-stream-local-passive) stream)
 115   (print-unreadable-object (socket stream :identity t)
 116     (format stream "passive local stream socket")
 117     (if (socket-bound-p socket)
 118         (format stream " ~:[bound to~;waiting @~] ~A"
 119                   (socket-listening-p socket)
 120                   (address-to-string (local-filename socket)))
 121         (format stream ", ~:[closed~;unbound~]" (fd-of socket)))))
 122
 123 (defmethod print-object ((socket socket-datagram-local) stream)
 124   (print-unreadable-object (socket stream :identity t)
 125     (format stream "local datagram socket")
 126     (if (socket-connected-p socket)
 127         (format stream " connected to ~S"
 128                 (address-to-string (remote-filename socket)))
 129         (if (fd-of socket)
 130             (format stream " waiting @ ~S" (address-to-string (local-filename socket)))
 131             (format stream ", closed" )))))
 132
 133 (defmethod print-object ((socket socket-datagram-internet) stream)
 134   (print-unreadable-object (socket stream :identity t)
 135     (format stream "~A datagram socket" (sock-fam socket))
 136     (if (socket-connected-p socket)
 137         (multiple-value-bind (host port) (remote-name socket)
 138           (format stream " connected to ~A/~A"
 139                   (address-to-string host) port))
 140         (if (fd-of socket)
 141             (multiple-value-bind (host port) (local-name socket)
 142               (format stream " waiting @ ~A/~A"
 143                       (address-to-string host) port))
 144             (format stream ", closed" )))))
 145
 146 #+linux
 147 (defmethod print-object ((socket socket-raw-netlink) stream)
 148   (print-unreadable-object (socket stream :identity t)
 149     (format stream "netlink socket")
 150     (if (socket-bound-p socket)
 151         (multiple-value-bind (address port)
 152             (local-name socket)
 153           (format stream " bound to ~A@~A"
 154                   port (address-to-string address)))
 155         (format stream ", ~:[closed~;unbound~]" (fd-of socket)))))
 156 \f
 157
 158 ;;;-------------------------------------------------------------------------
 159 ;;; CLOSE
 160 ;;;-------------------------------------------------------------------------
 161
 162 (defmethod close :before ((socket socket) &key abort)
 163   (declare (ignore abort))
 164   (setf (slot-value socket 'bound) nil))
 165
 166 (defmethod close ((socket socket) &key abort)
 167   (declare (ignore abort))
 168   (when (next-method-p)
 169     (call-next-method))
 170   (socket-open-p socket))
 171
 172 (defmethod close :before ((socket passive-socket) &key abort)
 173   (declare (ignore abort))
 174   (setf (slot-value socket 'listening) nil))
 175
 176 (defmethod socket-open-p ((socket socket))
 177   (if (null (fd-of socket))
 178       nil
 179       (with-sockaddr-storage-and-socklen (ss size)
 180         (handler-case
 181             (%getsockname (fd-of socket) ss size)
 182           (isys:ebadf () nil)
 183           (socket-connection-reset-error () nil)
 184           (:no-error (_) (declare (ignore _)) t)))))
 185 \f
 186
 187 ;;;-------------------------------------------------------------------------
 188 ;;; GETSOCKNAME
 189 ;;;-------------------------------------------------------------------------
 190
 191 (defun %local-name (socket)
 192   (with-sockaddr-storage-and-socklen (ss size)
 193     (%getsockname (fd-of socket) ss size)
 194     (sockaddr-storage->sockaddr ss)))
 195
 196 (defmethod local-name ((socket socket))
 197   (%local-name socket))
 198
 199 (defmethod local-host ((socket internet-socket))
 200   (nth-value 0 (%local-name socket)))
 201
 202 (defmethod local-port ((socket internet-socket))
 203   (nth-value 1 (%local-name socket)))
 204
 205 #+linux
 206 (defmethod local-port ((socket netlink-socket))
 207   (nth-value 1 (%local-name socket)))
 208
 209 (defmethod local-filename ((socket local-socket))
 210   (%local-name socket))
 211 \f
 212
 213 ;;;-------------------------------------------------------------------------
 214 ;;; GETPEERNAME
 215 ;;;-------------------------------------------------------------------------
 216
 217 (defun %remote-name (socket)
 218   (with-sockaddr-storage-and-socklen (ss size)
 219     (%getpeername (fd-of socket) ss size)
 220     (sockaddr-storage->sockaddr ss)))
 221
 222 (defmethod remote-name ((socket socket))
 223   (%remote-name socket))
 224
 225 (defmethod remote-host ((socket internet-socket))
 226   (nth-value 0 (%remote-name socket)))
 227
 228 (defmethod remote-port ((socket internet-socket))
 229   (nth-value 1 (%remote-name socket)))
 230
 231 (defmethod remote-filename ((socket local-socket))
 232   (%remote-name socket))
 233 \f
 234
 235 ;;;-------------------------------------------------------------------------
 236 ;;; BIND
 237 ;;;-------------------------------------------------------------------------
 238
 239 (defmethod bind-address :before ((socket internet-socket) address
 240                                  &key (reuse-address t))
 241   (declare (ignore address))
 242   (when reuse-address
 243     (setf (socket-option socket :reuse-address) t)))
 244
 245 (defun bind-ipv4-address (fd address port)
 246   (with-sockaddr-in (sin address port)
 247     (%bind fd sin (isys:sizeof '(:struct sockaddr-in)))))
 248
 249 (defun bind-ipv6-address (fd address port)
 250   (with-sockaddr-in6 (sin6 address port)
 251     (%bind fd sin6 (isys:sizeof '(:struct sockaddr-in6)))))
 252
 253 (defmethod bind-address ((socket internet-socket) (address ipv4-address)
 254                          &key (port 0))
 255   (let ((port (ensure-numerical-service port)))
 256     (if (socket-ipv6-p socket)
 257         (bind-ipv6-address (fd-of socket)
 258                            (map-ipv4-vector-to-ipv6 (address-name address))
 259                            port)
 260         (bind-ipv4-address (fd-of socket) (address-name address) port)))
 261   (values socket))
 262
 263 (defmethod bind-address ((socket internet-socket) (address ipv6-address)
 264                          &key (port 0))
 265   (bind-ipv6-address (fd-of socket)
 266                      (address-name address)
 267                      (ensure-numerical-service port))
 268   (values socket))
 269
 270 (defmethod bind-address ((socket local-socket) (address local-address) &key)
 271   (with-sockaddr-un (sun (address-name address) (abstract-address-p address))
 272     (%bind (fd-of socket) sun (actual-size-of-sockaddr-un sun)))
 273   (values socket))
 274
 275 #+linux
 276 (defmethod bind-address ((socket netlink-socket) (address netlink-address)
 277                          &key (port 0))
 278   (with-sockaddr-nl (snl (netlink-address-multicast-groups address) port)
 279     (%bind (fd-of socket) snl (isys:sizeof '(:struct sockaddr-nl))))
 280   (values socket))
 281
 282 (defmethod bind-address :after ((socket socket) (address address) &key)
 283   (setf (slot-value socket 'bound) t))
 284 \f
 285
 286 ;;;-------------------------------------------------------------------------
 287 ;;; LISTEN
 288 ;;;-------------------------------------------------------------------------
 289
 290 (defmethod listen-on ((socket socket) &key backlog)
 291   (unless backlog (setf backlog (min *default-backlog-size*
 292                                      +max-backlog-size+)))
 293   (check-type backlog unsigned-byte "a non-negative integer")
 294   (%listen (fd-of socket) backlog)
 295   (setf (slot-value socket 'listening) t)
 296   (values socket))
 297 \f
 298
 299 ;;;-------------------------------------------------------------------------
 300 ;;; ACCEPT
 301 ;;;-------------------------------------------------------------------------
 302
 303 (defmethod accept-connection ((socket passive-socket) &key external-format
 304                               input-buffer-size output-buffer-size (wait t))
 305   (check-type wait timeout-designator)
 306   (flet ((make-client-socket (fd)
 307            (make-instance (active-class socket)
 308                           :address-family (socket-address-family socket)
 309                           :file-descriptor fd :dup nil
 310                           :external-format (or external-format
 311                                                (external-format-of socket))
 312                           :input-buffer-size input-buffer-size
 313                           :output-buffer-size output-buffer-size)))
 314     (ignore-some-conditions (isys:ewouldblock iomux:poll-timeout)
 315       (iomux:wait-until-fd-ready (fd-of socket) :input (wait->timeout wait) t)
 316       (with-sockaddr-storage-and-socklen (ss size)
 317         (multiple-value-call #'values
 318           (make-client-socket (%accept (fd-of socket) ss size))
 319           (sockaddr-storage->sockaddr ss))))))
 320 \f
 321
 322 ;;;-------------------------------------------------------------------------
 323 ;;; CONNECT
 324 ;;;-------------------------------------------------------------------------
 325
 326 (defun ipv4-connect (fd address port)
 327   (with-sockaddr-in (sin address port)
 328     (%connect fd sin (isys:sizeof '(:struct sockaddr-in)))))
 329
 330 (defun ipv6-connect (fd address port)
 331   (with-sockaddr-in6 (sin6 address port)
 332     (%connect fd sin6 (isys:sizeof '(:struct sockaddr-in6)))))
 333
 334 (defun call-with-socket-to-wait-connect (socket thunk wait)
 335   (check-type wait timeout-designator)
 336   (let ((timeout (wait->timeout wait)))
 337     (flet
 338         ((wait-connect ()
 339            (when (or (null  timeout)
 340                      (plusp timeout))
 341              (handler-case
 342                  (iomux:wait-until-fd-ready (fd-of socket) :output timeout t)
 343                (iomux:poll-error ()
 344                  (let ((errcode (socket-option socket :error)))
 345                    (if (zerop errcode)
 346                        (bug "Polling socket signalled an error but SO_ERROR is 0")
 347                        (signal-socket-error errcode "connect" (fd-of socket)))))))))
 348       (ignore-some-conditions (iomux:poll-timeout)
 349         (handler-case
 350             (funcall thunk)
 351           ((or isys:ewouldblock
 352                isys:einprogress) ()
 353             (wait-connect)))))))
 354
 355 (defmacro with-socket-to-wait-connect ((socket wait) &body body)
 356   `(call-with-socket-to-wait-connect ,socket (lambda () ,@body) ,wait))
 357
 358 (defmethod connect ((socket internet-socket) (address inet-address)
 359                     &key (port 0) (wait t))
 360   (let ((name (address-name address))
 361         (port (ensure-numerical-service port)))
 362     (with-socket-to-wait-connect (socket wait)
 363       (cond
 364         ((socket-ipv6-p socket)
 365          (when (ipv4-address-p address)
 366            (setf name (map-ipv4-vector-to-ipv6 name)))
 367          (ipv6-connect (fd-of socket) name port))
 368         (t (ipv4-connect (fd-of socket) name port)))))
 369   (values socket))
 370
 371 (defmethod connect ((socket local-socket) (address local-address) &key (wait t))
 372   (with-socket-to-wait-connect (socket wait)
 373     (with-sockaddr-un (sun (address-name address) (abstract-address-p address))
 374         (%connect (fd-of socket) sun (actual-size-of-sockaddr-un sun))))
 375   (values socket))
 376
 377 (defmethod socket-connected-p ((socket socket))
 378   (if (fd-of socket)
 379       (with-sockaddr-storage-and-socklen (ss size)
 380         (handler-case
 381             (%getpeername (fd-of socket) ss size)
 382           ((or isys:enotconn isys:einval) ()  nil)
 383           (:no-error (_) (declare (ignore _)) t)))
 384       nil))
 385 \f
 386
 387 ;;;-------------------------------------------------------------------------
 388 ;;; DISCONNECT
 389 ;;;-------------------------------------------------------------------------
 390
 391 (defmethod disconnect ((socket datagram-socket))
 392   (with-foreign-object (sin '(:struct sockaddr-in))
 393     (isys:bzero sin (isys:sizeof '(:struct sockaddr-in)))
 394     (setf (foreign-slot-value sin '(:struct sockaddr-in) 'addr) af-unspec)
 395     (%connect (fd-of socket) sin (isys:sizeof '(:struct sockaddr-in)))
 396     (values socket)))
 397 \f
 398
 399 ;;;-------------------------------------------------------------------------
 400 ;;; SHUTDOWN
 401 ;;;-------------------------------------------------------------------------
 402
 403 (defmethod shutdown ((socket socket) &key read write)
 404   (assert (or read write) (read write)
 405           "You must select at least one direction to shut down.")
 406   (%shutdown (fd-of socket)
 407              (multiple-value-case ((read write))
 408                ((*   nil) shut-rd)
 409                ((nil *)   shut-wr)
 410                (t         shut-rdwr)))
 411   (values socket))
 412 \f
 413
 414 ;;;-------------------------------------------------------------------------
 415 ;;; Socket flag definition
 416 ;;;-------------------------------------------------------------------------
 417
 418 (defmacro define-socket-flag (place name value platform)
 419   (let ((val (cond ((or (not platform)
 420                         (featurep platform)) value)
 421                    ((not (featurep platform)) 0))))
 422     `(pushnew (cons ,name ,val) ,place)))
 423
 424 (defmacro define-socket-flags (place &body definitions)
 425   (flet ((dflag (form)
 426            (destructuring-bind (name value &optional platform) form
 427              `(define-socket-flag ,place ,name ,value ,platform))))
 428     `(progn
 429        ,@(mapcar #'dflag definitions))))
 430 \f
 431
 432 ;;;-------------------------------------------------------------------------
 433 ;;; SENDTO
 434 ;;;-------------------------------------------------------------------------
 435
 436 (defvar *sendto-flags* ())
 437
 438 (define-socket-flags *sendto-flags*
 439   (:dont-route    msg-dontroute)
 440   (:dont-wait     msg-dontwait  (:not :windows))
 441   (:out-of-band   msg-oob)
 442   (:more          msg-more      :linux)
 443   (:confirm       msg-confirm   :linux))
 444
 445 (defun %%send-to (fd ss got-peer buff-sap start length flags)
 446   (incf-pointer buff-sap start)
 447   (loop
 448     (restart-case
 449         (return*
 450          (%sendto fd buff-sap length flags
 451                   (if got-peer ss (null-pointer))
 452                   (if got-peer (sockaddr-size ss) 0)))
 453       (ignore-syscall-error ()
 454         :report "Ignore this socket condition"
 455         :test isys:syscall-error-p
 456         (return* 0))
 457       (retry-syscall (&optional (timeout 15.0d0))
 458         :report "Try to send data again"
 459         :test isys:syscall-error-p
 460         (when (plusp timeout)
 461           (iomux:wait-until-fd-ready fd :output timeout nil))))))
 462
 463 (defun %send-to (fd ss got-peer buffer start end flags)
 464   (etypecase buffer
 465     (ub8-sarray
 466      (check-bounds buffer start end)
 467      (with-pointer-to-vector-data (buff-sap buffer)
 468        (%%send-to fd ss got-peer buff-sap start (- end start) flags)))
 469     ((or ub8-vector (vector t))
 470      (check-bounds buffer start end)
 471      (with-pointer-to-vector-data (buff-sap (coerce buffer 'ub8-sarray))
 472        (%%send-to fd ss got-peer buff-sap start (- end start) flags)))
 473     (foreign-pointer
 474      (check-type start unsigned-byte)
 475      (check-type end   unsigned-byte)
 476      (%%send-to fd ss got-peer buffer start (- end start) flags))))
 477
 478 (defmethod send-to ((socket internet-socket) buffer &rest args
 479                     &key (start 0) end remote-host (remote-port 0) flags (ipv6 *ipv6*))
 480   (let ((*ipv6* ipv6))
 481     (with-sockaddr-storage (ss)
 482       (when remote-host
 483         (sockaddr->sockaddr-storage ss (ensure-hostname remote-host)
 484                                     (ensure-numerical-service remote-port)))
 485       (%send-to (fd-of socket) ss (if remote-host t) buffer start end
 486                 (or flags (compute-flags *sendto-flags* args))))))
 487
 488 (defmethod send-to ((socket local-socket) buffer &rest args
 489                     &key (start 0) end remote-filename flags)
 490   (with-sockaddr-storage (ss)
 491     (when remote-filename
 492       (sockaddr->sockaddr-storage ss (ensure-address remote-filename :family :local) 0))
 493     (%send-to (fd-of socket) ss (if remote-filename t) buffer start end
 494               (or flags (compute-flags *sendto-flags* args)))))
 495
 496 (define-compiler-macro send-to (&whole form &environment env socket buffer &rest args
 497                                 &key (start 0) end (remote-host nil host-p) (remote-port 0 port-p)
 498                                 (remote-filename nil file-p) flags (ipv6 '*ipv6* ipv6-p) &allow-other-keys)
 499   (let ((flags-val (compute-flags *sendto-flags* args env)))
 500     (cond
 501       ((and (not flags) flags-val)
 502        (append
 503         `(send-to ,socket ,buffer :start ,start :end ,end :flags ,flags-val)
 504         (when host-p `(:remote-host ,remote-host))
 505         (when port-p `(:remote-port ,remote-port))
 506         (when ipv6-p `(:ipv6 ,ipv6))
 507         (when file-p `(:remote-filename ,remote-filename))))
 508       (t
 509        form))))
 510 \f
 511
 512 ;;;-------------------------------------------------------------------------
 513 ;;; RECVFROM
 514 ;;;-------------------------------------------------------------------------
 515
 516 (defvar *recvfrom-flags* ())
 517
 518 (define-socket-flags *recvfrom-flags*
 519   (:out-of-band msg-oob)
 520   (:peek        msg-peek)
 521   (:wait-all    msg-waitall  (:not :windows))
 522   (:dont-wait   msg-dontwait (:not :windows)))
 523
 524 (defun %%receive-from (fd ss size buffer start length flags)
 525   (with-pointer-to-vector-data (buff-sap buffer)
 526     (incf-pointer buff-sap start)
 527     (loop
 528        (restart-case
 529            (return* (%recvfrom fd buff-sap length flags ss size))
 530          (ignore-syscall-error ()
 531            :report "Ignore this socket condition"
 532            :test isys:syscall-error-p
 533            (return* 0))
 534          (retry-syscall (&optional (timeout 15.0d0))
 535            :report "Try to receive data again"
 536            :test isys:syscall-error-p
 537            (when (plusp timeout)
 538              (iomux:wait-until-fd-ready fd :input timeout nil)))))))
 539
 540 (defun %receive-from (fd ss size buffer start end flags)
 541   (check-bounds buffer start end)
 542   (flet ((%do-recvfrom (buff start length)
 543            (%%receive-from fd ss size buff start length flags)))
 544     (let (nbytes)
 545       (etypecase buffer
 546         (ub8-sarray
 547          (setf nbytes (%do-recvfrom buffer start (- end start))))
 548         ((or ub8-vector (vector t))
 549          (let ((tmpbuff (make-array (- end start) :element-type 'ub8)))
 550            (setf nbytes (%do-recvfrom tmpbuff 0 (- end start)))
 551            (replace buffer tmpbuff :start1 start :end1 end :start2 0 :end2 nbytes))))
 552       (values nbytes))))
 553
 554 (defmethod receive-from :around ((socket socket) &rest args
 555                                  &key buffer size (start 0) end flags &allow-other-keys)
 556   (let ((flags-val (or flags (compute-flags *recvfrom-flags* args))))
 557     (cond
 558       (buffer
 559        (call-next-method socket :buffer buffer :start start :end end :flags flags-val))
 560       (t
 561        (check-type size unsigned-byte "a non-negative integer")
 562        (call-next-method socket :buffer (make-array size :element-type 'ub8)
 563                          :start 0 :end size :flags flags-val)))))
 564
 565 (defmethod receive-from ((socket stream-socket) &key buffer start end flags)
 566   (with-sockaddr-storage-and-socklen (ss size)
 567     (let ((nbytes (%receive-from (fd-of socket) ss size buffer start end flags)))
 568       (values buffer nbytes))))
 569
 570 (defmethod receive-from ((socket raw-socket) &key buffer start end flags)
 571   (with-sockaddr-storage-and-socklen (ss size)
 572     (let ((nbytes (%receive-from (fd-of socket) ss size buffer start end flags)))
 573       (values buffer nbytes))))
 574
 575 (defmethod receive-from ((socket datagram-socket) &key buffer start end flags)
 576   (with-sockaddr-storage-and-socklen (ss size)
 577     (let ((nbytes (%receive-from (fd-of socket) ss size buffer start end flags)))
 578       (multiple-value-call #'values buffer nbytes
 579                            (sockaddr-storage->sockaddr ss)))))
 580
 581 (define-compiler-macro receive-from (&whole form &environment env socket &rest args
 582                                      &key buffer size (start 0) end flags &allow-other-keys)
 583   (let ((flags-val (compute-flags *recvfrom-flags* args env)))
 584     (cond
 585       ((and (not flags) flags-val)
 586        `(receive-from ,socket :buffer ,buffer :start ,start :end ,end
 587                       :size ,size :flags ,flags-val))
 588       (t
 589        form))))