Changeset 10109


Ignore:
Timestamp:
Jul 18, 2008, 9:00:11 PM (11 years ago)
Author:
gb
Message:

%GET-IP-INTERFACES for Solaris; very different from other versions.

File:
1 edited

Legend:

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

    r10074 r10109  
    11001100               (values nil (- (pref herr :signed)))))))))))
    11011101
     1102#+solaris-target
     1103(defun c_gethostbyaddr (addr)
     1104  (rlet ((hostent :hostent)
     1105         (herr :signed)
     1106         (addrp :unsigned))
     1107    (setf (pref addrp :unsigned) addr)
     1108    (do* ((buflen 1024 (+ buflen buflen))) ()
     1109      (declare (fixnum buflen))
     1110      (%stack-block ((buf buflen))
     1111        (let* ((res (#_gethostbyaddr_r addrp (record-length :unsigned) #$AF_INET
     1112                                       hostent buf buflen herr)))
     1113          (if (%null-ptr-p res)
     1114            (unless (eql (%get-errno) (- #$ERANGE))
     1115              (return (values nil (- (pref herr :signed)))))
     1116            (return (%get-cstring (pref res :hostent.h_name)))))))))
     1117
    11021118#+(or darwin-target freebsd-target)
    11031119(defun c_gethostbyname (name)
     
    11291145                    (%get-ptr (pref (%get-ptr hp) :hostent.h_addr_list)))
    11301146                   (values nil (- err))))))))))))
     1147
     1148#+solaris-target
     1149(defun c_gethostbyname (name)
     1150  (with-cstrs ((name (string name)))
     1151    (rlet ((hostent :hostent)
     1152           (herr :signed 0))
     1153       (do* ((buflen 1024 (+ buflen buflen))) ()
     1154         (declare (fixnum buflen))
     1155         (%stack-block ((buf buflen))
     1156           (setf (pref herr :signed) 0)
     1157           (let* ((res (#_gethostbyname_r name hostent buf buflen herr)))
     1158             (if (%null-ptr-p res)
     1159               (unless (eql (%get-errno) (- #$ERANGE))
     1160                 (return (values nil (- (pref herr :signed)))))
     1161               (return
     1162                 (%get-unsigned-long
     1163                  (%get-ptr (pref res :hostent.h_addr_list)))))))))))
     1164 
    11311165
    11321166(defun _getservbyname (name proto)
     
    15651599                 (push (make-ip-interface
    15661600                        :name (%get-cstring (pref q :ifaddrs.ifa_name))
    1567                         :addr (pref addr
    1568                                     #-solaris-target :sockaddr_in.sin_addr.s_addr
    1569                                     #+solaris-target #>sockaddr_in.sin_addr.S_un.S_addr)
    1570                         :netmask (pref (pref q :ifaddrs.ifa_netmask)
    1571                                        :sockaddr_in.sin_addr.s_addr)
    1572                         :flags (pref q :ifaddrs.ifa_flags)
    1573                         :address-family #$AF_INET)
    1574                        res))))
    1575         (#_freeifaddrs (pref p :address))))))
     1601                        :addr (pref addr :sockaddr_in.sin_addr.s_addr)
     1602                        :netmask (pref (pref q :ifaddrs.ifa_netmask)
     1603                                       :sockaddr_in.sin_addr.s_addr)
     1604                        :flags (pref q :ifaddrs.ifa_flags)
     1605                        :address-family #$AF_INET)
     1606                       res))))
     1607        (#_freeifaddrs (pref p :address))))))
     1608
     1609#+solaris-target
     1610(progn
     1611  ;;; Interface translator has trouble with a lot of ioctl constants.
     1612  (eval-when (:compile-toplevel :execute)
     1613    (defconstant os::|SIOCGLIFNUM| #xc00c6982)
     1614    (defconstant os::|SIOCGLIFCONF| #xc01069a5)
     1615    (defconstant os::|SIOCGLIFADDR| #xc0786971)
     1616    (defconstant os::|SIOCGLIFFLAGS| #xc0786975)
     1617    (defconstant os::|SIOCGLIFNETMASK| #xc078697d)
     1618    )
     1619
     1620(defun %get-ip-interfaces ()
     1621  (let* ((sock (c_socket #$AF_INET #$SOCK_DGRAM #$IPPROTO_UDP))
     1622         (res nil))
     1623    (when (>= sock 0)
     1624      (unwind-protect
     1625           (let* ((flags (logior #$LIFC_NOXMIT #$LIFC_TEMPORARY #$LIFC_ALLZONES))
     1626                  (ninterfaces (rlet ((lifnum :lifnum
     1627                                        :lifn_flags flags
     1628                                        :lifn_family #$AF_INET
     1629                                        :lifn_count 0))
     1630                                 (#_ioctl sock os::SIOCGLIFNUM :address lifnum)
     1631                                 (pref lifnum :lifnum.lifn_count))))
     1632             (declare (fixnum ninterfaces))
     1633             (when (> ninterfaces 0)
     1634               (let* ((bufsize (* ninterfaces (record-length :lifreq))))
     1635                 (%stack-block ((buf bufsize :clear t))
     1636                   (rlet ((lifc :lifconf
     1637                            :lifc_family #$AF_INET
     1638                            :lifc_flags flags
     1639                            :lifc_len bufsize
     1640                            :lifc_lifcu.lifcu_buf buf))
     1641                     (when (>= (#_ioctl sock os::SIOCGLIFCONF :address lifc) 0)
     1642                       (do* ((i 0 (1+ i))
     1643                             (p (pref lifc :lifconf.lifc_lifcu.lifcu_buf)
     1644                                (%inc-ptr p (record-length :lifreq))))
     1645                            ((= i ninterfaces))
     1646                         (let* ((name (%get-cstring (pref p :lifreq.lifr_name)))
     1647                                (address-family (pref p :lifreq.lifr_lifru.lifru_addr.ss_family))
     1648                                (if-flags nil)
     1649                                (address nil)
     1650                                (netmask nil))
     1651                           (if (>= (#_ioctl sock os::SIOCGLIFFLAGS :address p)
     1652                                   0)
     1653                             (setq if-flags (pref p :lifreq.lifr_lifru.lifru_flags)))
     1654                           (if (>= (#_ioctl sock os::SIOCGLIFADDR :address p)
     1655                                   0)
     1656                             (setq address (pref
     1657                                            (pref p :lifreq.lifr_lifru.lifru_addr)
     1658                                            #>sockaddr_in.sin_addr.S_un.S_addr)))
     1659                           (if (>= (#_ioctl sock os::SIOCGLIFNETMASK :address p)
     1660                                   0)
     1661                             (setq netmask (pref
     1662                                            (pref p :lifreq.lifr_lifru.lifru_subnet)
     1663                                            #>sockaddr_in.sin_addr.S_un.S_addr)))
     1664                             
     1665                           (push (make-ip-interface
     1666                                  :name name
     1667                                  :addr address
     1668                                  :netmask netmask
     1669                                  :flags if-flags
     1670                                  :address-family address-family)
     1671                                 res)))))))))
     1672        (fd-close sock)))
     1673    res))
     1674)
     1675
     1676             
     1677
     1678     
    15761679
    15771680
Note: See TracChangeset for help on using the changeset viewer.