[Openmcl-devel] Useful code: get info about network interfaces on Windows.

[Gary Byers]

On Mon, 1 Nov 2010, Kaz Kylheku wrote:

>
> I found that the IP helper API is not represented in the FFI database, so
> I hacked this up. Share, criticize, improve ...
>
> Is there a nicer way to handle the len-inout variable? I define it in a stack 
> block as a region of the length of :unsigned-long and then set its initial 
> value using (setf (%get-unsigned-long ...) ...).
>
> I'd like to just RLET it to be of type #>ULONG and then assign to it without 
> mentioning the type in the assignment.

   (%stack-block ((blk blk-size))
     (rlet ((len-inout #>ULONG blk-size))

RLET macroexpands into something very much like your code.

It might be nice to:

a) recognize that it's 2010
b) have some concise syntax that'd allow you to say something like:

   (setf @len-inout blk-size)

and have that (symbol-)macroexpand into something like:

   (setf (pref len-inout #>ULONG) blk-size)

for you.

(I don't know if prefixing the names of some things bound by RLET with an #\@
is workable concise syntax or not.)

Note that LEN-INOUT is already a lisp variable (that happens to be bound to
a stack-allocated pointer), so

(setf len-inout blk-size)

is

(a) already well-defined
(b) almost certaintly not something you intend to do (the compiler will warn
     about such an assignment.)

At least for cases where RLET establishes a binding to a pointer to a
scalar type, having -something- remember what that type is and let you
reference/assign to the underlying thing of that type could make some
code easier to read/write/understand.

>
> Sample run:
>
> ? (get-network-interface-list)
> (((144 230 186 208 255 3) (("192.168.1.103" "255.255.255.0"))
> "{BB3E5BE7-4409-4DCC-A96D-FCAD6F80CFBF}"
> "ASUS 802.11 g/b Wireless PCI Adapter")
> ((0 255 163 4 251 147) (("0.0.0.0" "0.0.0.0"))
> "{A304FB93-661E-4C64-BD4C-4988FFF93571}" "TAP-Win32 Adapter V8")
> ((0 255 217 143 238 242) (("0.0.0.0" "0.0.0.0"))
> "{D98FEEF2-3050-45C4-A819-13D583E29F24}" "TAP-Win32 Adapter V9")
> ((0 25 33 80 198 222) (("0.0.0.0" "0.0.0.0"))
> "{49C3B646-9DDD-48CC-9F72-73B8A4DFDF00}"
> "Marvell Yukon 88E8056 PCI-E Gigabit Ethernet Controller")
> ((0 80 86 192 0 1) (("169.254.205.164" "255.255.0.0"))
> "{78D5CAA7-B278-4358-BA60-B4403AB9F635}"
> "VMware Virtual Ethernet Adapter for VMnet1")
> ((0 80 86 192 0 8) (("192.168.206.1" "255.255.255.0"))
> "{31C44EA6-F6D8-44AE-8998-0469EF6FF32D}"
> "VMware Virtual Ethernet Adapter for VMnet8")
> ((8 0 39 0 20 110) (("192.168.56.1" "255.255.255.0"))
> "{B20AEB46-8C0B-4A34-8104-84968E222F89}"
> "VirtualBox Host-Only Ethernet Adapter"))
>
>
> Microsoft consistency. IP addresses in text, link addresses in binary!
>
>
> Source:
>
> (eval-when (:compile-toplevel :load-toplevel :execute)
> (open-shared-library "iphlpapi.dll")
> (defconstant MAX_ADAPTER_NAME_LENGTH 256)
> (defconstant MAX_ADAPTER_DESCRIPTION_LENGTH 128)
> (defconstant MAX_ADAPTER_ADDRESS_LENGTH 8))
>
>
> (def-foreign-type #>IP_ADDR_STRING
> (struct #>IP_ADDR_STRING
>   (#>Next :address)
>   (#>IpAddress (:array :char 16))
>   (#>IpMask (:array :char 16))
>   (#>Context #>DWORD)))
>
> (def-foreign-type #>IP_ADAPTER_INFO
> (struct #>IP_ADAPTER_INFO
>   (#>Next :address)
>   (#>ComboIndex #>DWORD)
>   (#>AdapterName (:array :char #.(+ MAX_ADAPTER_NAME_LENGTH 4)))
>   (#>Description (:array :char #.(+ MAX_ADAPTER_DESCRIPTION_LENGTH 4)))
>   (#>AddressLength #>UINT)
>   (#>Address (:array BYTE #.(+ MAX_ADAPTER_ADDRESS_LENGTH)))
>   (#>Index #>DWORD)
>   (#>Type #>UINT)
>   (#>DhcpEnabled #>UINT)
>   (#>CurrentIpAddress :address)
>   (#>IpAddressList #>IP_ADDR_STRING)
>   #| ... other members omitted ... |# ))
>
>
> (defun get-ip-address-list (first)
> (loop for ptr = first then (pref ptr #>IP_ADDR_STRING.Next)
>       until (%null-ptr-p ptr)
>       collecting
>         (let ((addr (pref ptr #>IP_ADDR_STRING.IpAddress))
>               (mask (pref ptr #>IP_ADDR_STRING.IpMask)))
>           (list (%get-cstring addr) (%get-cstring mask)))))
>
>
> (defun get-network-interface-list ()
> (let ((blk-size 65536) ;; crude!
>       (get-adapters-info (foreign-symbol-address "GetAdaptersInfo")))
>     (if get-adapters-info
>       (%stack-block ((blk blk-size)
>                      (len-inout (ccl::record-length :unsigned-long)))
>         (setf (%get-unsigned-long len-inout) blk-size)
>         (if (zerop (ff-call get-adapters-info :address blk
>                                               :address len-inout
>                                               #>DWORD))
>           (loop for ptr = blk then (pref ptr #>IP_ADAPTER_INFO.Next)
>                 until (%null-ptr-p ptr)
>                 collecting
>                   (let ((alen (pref ptr #>IP_ADAPTER_INFO.AddressLength))
>                         (addr (pref ptr #>IP_ADAPTER_INFO.Address))
>                         (aname (pref ptr #>IP_ADAPTER_INFO.AdapterName))
>                         (descr (pref ptr #>IP_ADAPTER_INFO.Description))
>                         (iplist (pref ptr #>IP_ADAPTER_INFO.IpAddressList)))
>                     (list (loop for i below alen
>                                 collecting (%get-unsigned-byte addr i))
>                           (get-ip-address-list iplist)
>                           (%get-cstring aname)
>                           (%get-cstring descr)))))))))
>
> _______________________________________________
> Openmcl-devel mailing list
> Openmcl-devel at clozure.com
> http://clozure.com/mailman/listinfo/openmcl-devel
>
>