Ignore:
Timestamp:
Jul 22, 2005, 6:51:25 AM (14 years ago)
Author:
gb
Message:

Kinder, gentler %GET-IP-INTERFACES, based on #_getifaddrs.

#_getifaddrs seems to be supported on Darwin at least as far back as Jaguar,
and on Linux at least as far back as ... libc versions from 2002 or so.
(Note that /usr/include/ifaddrs.h hasn't been included in the Linux interfaces
up until this point; note also that the interface names aren't returned correctly
on PPC64 Darwin as of OS release 10.4.1).

File:
1 edited

Legend:

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

    r1966 r2036  
    11491149
    11501150(defun %get-ip-interfaces ()
    1151   (let* ((buffsize 4000))
    1152     (%stack-block ((buff buffsize))
    1153       (rlet ((conf :ifconf :ifc_len buffsize))
    1154         (setf (pref conf :ifconf.ifc_ifcu.ifcu_buf) buff)
    1155         (let* ((fd (c_socket #$AF_INET #$SOCK_DGRAM 0)))
    1156           (if (< fd 0)
    1157             (error "Error creating socket."))
    1158           (if (< (#_ioctl fd #$SIOCGIFCONF :address conf) 0)
    1159             (error "Can't get interfaces configuration"))
    1160           (do* ((n (pref conf :ifconf.ifc_len))
    1161                 (offset 0)
    1162                 (req (pref conf :ifconf.ifc_ifcu.ifcu_req))
    1163                 (res ()))
    1164                ((>= offset n) (progn (fd-close fd) (nreverse res)))
    1165             (declare (fixnum offset n))
    1166             (let* ((sa_len #+darwinppc-target (pref (pref req :ifreq.ifr_ifru.ifru_addr) :sockaddr_in.sin_len)
    1167                            #+linuxppc-target
    1168                            (external-call "__libc_sa_len"
    1169                                           :unsigned-halfword
    1170                                           (pref (pref req :ifreq.ifr_ifru.ifru_addr) :sockaddr_in.sin_family)
    1171                                           :signed-fullword))
    1172                    (delta
    1173                     (max (+ 16 sa_len)
    1174                          (%foreign-type-or-record-size :ifreq :bytes))))
    1175               (declare (fixnum sa_len delta))
    1176               ;(dump-buffer req delta)
    1177               (let* ((name (%get-cstring (pref req
    1178                                                #+darwinppc-target :ifreq.ifr_name
    1179                                                #+linuxppc-target :ifreq.ifr_ifrn.ifrn_name
    1180                                                ))))
    1181                 (unless (member name res
    1182                                 :test #'string=
    1183                                 :key #'ip-interface-name)
    1184                   (when (zerop (#_ioctl fd #$SIOCGIFADDR :address req))
    1185                     (let* ((addr (pref (pref req :ifreq.ifr_ifru.ifru_addr)
    1186                                        :sockaddr_in.sin_addr.s_addr))
    1187                            (af (pref (pref req :ifreq.ifr_ifru.ifru_addr)
    1188                                      :sockaddr_in.sin_family)))
    1189                       (when (zerop (#_ioctl fd #$SIOCGIFFLAGS :address req))
    1190                         (let* ((flags (pref req :ifreq.ifr_ifru.ifru_flags)))
    1191                           (when (zerop (#_ioctl fd #$SIOCGIFNETMASK :address req))
    1192                             (push (make-ip-interface
    1193                                    :name name
    1194                                    :addr addr
    1195                                    :netmask (pref (pref req :ifreq.ifr_ifru.ifru_addr)
     1151  (rlet ((p :address (%null-ptr)))
     1152    (if (zerop (#_getifaddrs p))
     1153      (unwind-protect
     1154           (do* ((q (%get-ptr p) (pref q :ifaddrs.ifa_next))
     1155                 (res ()))
     1156                ((%null-ptr-p q) (nreverse res))
     1157             (let* ((addr (pref q :ifaddrs.ifa_addr)))
     1158               (when (eql (pref addr :sockaddr.sa_family) #$AF_INET)
     1159                 (push (make-ip-interface
     1160                                   :name (%get-cstring (pref q :ifaddrs.ifa_name))
     1161                                   :addr (pref addr :sockaddr_in.sin_addr.s_addr)
     1162                                   :netmask (pref (pref q :ifaddrs.ifa_netmask)
    11961163                                                  :sockaddr_in.sin_addr.s_addr)
    1197                                    :flags flags
    1198                                    :address-family af)
    1199                                   res))))))))
    1200               (%incf-ptr req delta)
    1201               (incf offset delta))))))))
     1164                                   :flags (pref q :ifaddrs.ifa_flags)
     1165                                   :address-family #$AF_INET)
     1166                       res))))
     1167        (#_freeifaddrs (pref p :address))))))
    12021168
    12031169
Note: See TracChangeset for help on using the changeset viewer.