Changeset 13990 for trunk/source/level-1


Ignore:
Timestamp:
Jul 20, 2010, 8:09:11 AM (9 years ago)
Author:
gb
Message:

In the windows version of %GET-IP-INTERFACES, handle the "buffer too
small" case correctly.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-sockets.lisp

    r13773 r13990  
    14401440  (let* ((socket (#_socket #$AF_INET #$SOCK_DGRAM #$IPPROTO_IP)))
    14411441    (unwind-protect
    1442     (rlet ((realoutlen #>DWORD 0))
    1443       (do* ((reservedlen (* 4 (record-length #>INTERFACE_INFO))
    1444                          (* 2 reservedlen)))
    1445            ()
    1446         (%stack-block ((buf reservedlen))
    1447           (unless (eql 0 (#_WSAIoctl
    1448                           socket
    1449                           #$SIO_GET_INTERFACE_LIST
    1450                           (%null-ptr)
    1451                           0
    1452                           buf
    1453                           reservedlen
    1454                           realoutlen
    1455                           (%null-ptr)
    1456                           (%null-ptr)))
    1457             (return))
    1458           (let* ((noutbytes (pref realoutlen #>DWORD)))
    1459             (when (< noutbytes reservedlen)
    1460               (let* ((interfaces nil))
    1461                 (do* ((offset 0 (+ offset (record-length #>INTERFACE_INFO)))
    1462                       (nameidx 0 (1+ nameidx)))
    1463                      ((>= offset noutbytes))
    1464                   (with-macptrs ((p (%inc-ptr buf offset)))
    1465                     (push (make-ip-interface
    1466                            :name (format nil "ip~d" nameidx)
    1467                            :addr (ntohl
    1468                                   (pref (pref p #>INTERFACE_INFO.iiAddress)
    1469                                         #>sockaddr_gen.AddressIn.sin_addr.S_un.S_addr))
    1470                            :netmask (ntohl
    1471                                      (pref (pref p #>INTERFACE_INFO.iiNetmask)
    1472                                         #>sockaddr_gen.AddressIn.sin_addr.S_un.S_addr))
    1473                            :flags (pref p #>INTERFACE_INFO.iiFlags)
    1474                            :address-family #$AF_INET)
    1475                           interfaces)))
    1476                 (return interfaces)))))))
     1442         (rlet ((realoutlen #>DWORD 0))
     1443           (do* ((reservedlen (* 4 (record-length #>INTERFACE_INFO))
     1444                              (* 2 reservedlen)))
     1445                ()
     1446             (%stack-block ((buf reservedlen))
     1447               (if (eql 0  (#_WSAIoctl
     1448                            socket
     1449                            #$SIO_GET_INTERFACE_LIST
     1450                            (%null-ptr)
     1451                            0
     1452                            buf
     1453                            reservedlen
     1454                            realoutlen
     1455                            (%null-ptr)
     1456                            (%null-ptr)))
     1457               (let* ((noutbytes (pref realoutlen #>DWORD)))
     1458                 (when (< noutbytes reservedlen)
     1459                   (let* ((interfaces nil))
     1460
     1461                     (do* ((offset 0 (+ offset (record-length #>INTERFACE_INFO)))
     1462                           (nameidx 0 (1+ nameidx)))
     1463                          ((>= offset noutbytes))
     1464                       (with-macptrs ((p (%inc-ptr buf offset)))
     1465                         (push (make-ip-interface
     1466                                :name (format nil "ip~d" nameidx)
     1467                                :addr (ntohl
     1468                                       (pref (pref p #>INTERFACE_INFO.iiAddress)
     1469                                             #>sockaddr_gen.AddressIn.sin_addr.S_un.S_addr))
     1470                                :netmask (ntohl
     1471                                          (pref (pref p #>INTERFACE_INFO.iiNetmask)
     1472                                                #>sockaddr_gen.AddressIn.sin_addr.S_un.S_addr))
     1473                                :flags (pref p #>INTERFACE_INFO.iiFlags)
     1474                                :address-family #$AF_INET)
     1475                               interfaces)))
     1476                     (return interfaces))))
     1477               (let* ((err (#_WSAGetLastError)))
     1478                 (unless (eql err #$WSAEFAULT)
     1479                   (return)))))))
    14771480      (#_closesocket socket))))
    14781481
Note: See TracChangeset for help on using the changeset viewer.