From c5df68d7b34f18f1e7a4f40c4fcab5b727a2b13c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 16 Sep 2012 17:51:05 -0700 Subject: [PATCH] windows.iphlpapi: Add a way to get interfaces, mac addrs, and ips on windows. --- basis/windows/iphlpapi/iphlpapi.factor | 331 ++++++++++++++++++++++++- 1 file changed, 328 insertions(+), 3 deletions(-) diff --git a/basis/windows/iphlpapi/iphlpapi.factor b/basis/windows/iphlpapi/iphlpapi.factor index 9beb3bd9a6..a4c6aa17dd 100644 --- a/basis/windows/iphlpapi/iphlpapi.factor +++ b/basis/windows/iphlpapi/iphlpapi.factor @@ -1,8 +1,10 @@ ! Copyright (C) 2010 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.data alien.syntax -classes.struct io.encodings.string io.encodings.utf8 kernel -make sequences windows.errors windows.types ; +USING: accessors alien alien.c-types alien.data alien.strings +alien.syntax arrays byte-arrays classes.struct combinators +combinators.smart destructors io.encodings.string +io.encodings.utf8 kernel libc make sequences sequences.extras +windows.errors windows.kernel32 windows.types windows.winsock ; IN: windows.iphlpapi LIBRARY: iphlpapi @@ -30,6 +32,18 @@ CONSTANT: IF_LOOPBACK_ADAPTERTYPE 5 CONSTANT: MAX_DOMAIN_NAME_LEN+4 132 CONSTANT: MAX_HOSTNAME_LEN+4 132 CONSTANT: MAX_SCOPE_ID_LEN+4 260 +CONSTANT: MAX_ADAPTER_NAME_LENGTH+4 264 +CONSTANT: MAX_ADAPTER_DESCRIPTION_LENGTH+4 136 +CONSTANT: ERROR_BUFFER_OVERFLOW 111 +CONSTANT: MIB_IF_TYPE_ETHERNET 6 +CONSTANT: MIB_IF_TYPE_TOKENRING 9 +CONSTANT: MIB_IF_TYPE_FDDI 15 +CONSTANT: MIB_IF_TYPE_PPP 23 +CONSTANT: MIB_IF_TYPE_LOOPBACK 24 +CONSTANT: MIB_IF_TYPE_SLIP 28 +CONSTANT: MAX_DNS_SUFFIX_STRING_LENGTH 256 ! 246? +CONSTANT: MAX_DHCPV6_DUID_LENGTH 130 + STRUCT: IP_ADDRESS_STRING { String char[16] } ; @@ -58,8 +72,277 @@ STRUCT: FIXED_INFO { EnableDns UINT } { ExtraSpace char[4096] } ; +DEFER: IP_ADAPTER_INFO + +TYPEDEF: ulong time_t +TYPEDEF: uchar UINT8 +TYPEDEF: uint NET_IF_COMPARTMENT_ID +TYPEDEF: GUID NET_IF_NETWORK_GUID + +ENUM: IP_DAD_STATE + IpDadStateInvalid + IpDadStateTentative, + IpDadStateDuplicate, + IpDadStateDeprecated, + IpDadStatePreferred ; + +ENUM: IP_PREFIX_ORIGIN + IpPrefixOriginOther, + IpPrefixOriginManual, + IpPrefixOriginWellKnown, + IpPrefixOriginDhcp, + IpPrefixOriginRouterAdvertisement, + { IpPrefixOriginUnchanged 16 } ; + +ENUM: IP_SUFFIX_ORIGIN + IpSuffixOriginOther + IpSuffixOriginManual, + IpSuffixOriginWellKnown, + IpSuffixOriginDhcp, + IpSuffixOriginLinkLayerAddress, + IpSuffixOriginRandom, + { IpSuffixOriginUnchanged 16 } ; + +ENUM: IF_OPER_STATUS + { IfOperStatusUp 1 } + IfOperStatusDown, + IfOperStatusTesting, + IfOperStatusUnknown, + IfOperStatusDormant, + IfOperStatusNotPresent, + IfOperStatusLowerLayerDown ; + +ENUM: NET_IF_CONNECTION_TYPE + { NET_IF_CONNECTION_DEDICATED 1 } + NET_IF_CONNECTION_PASSIVE, + NET_IF_CONNECTION_DEMAND, + NET_IF_CONNECTION_MAXIMUM ; + + +ENUM: TUNNEL_TYPE + TUNNEL_TYPE_NONE, + TUNNEL_TYPE_OTHER, + TUNNEL_TYPE_DIRECT, + TUNNEL_TYPE_6TO4, + TUNNEL_TYPE_ISATAP, + TUNNEL_TYPE_TEREDO, + TUNNEL_TYPE_IPHTTPS ; + + + +STRUCT: SOCKET_ADDRESS + { lpSockaddr LPSOCKADDR } + { iSockaddrLength INT } ; + +ERROR: unknown-sockaddr-length sockaddr length ; + +: SOCKET_ADDRESS>sockaddr ( obj -- sockaddr ) + dup iSockaddrLength>> { + { 16 [ lpSockaddr>> sockaddr-in memory>struct ] } + { 28 [ lpSockaddr>> sockaddr-in6 memory>struct ] } + [ unknown-sockaddr-length ] + } case ; + +TYPEDEF: SOCKET_ADDRESS* PSOCKET_ADDRESS + +STRUCT: IP_ADAPTER_INFO + { Next IP_ADAPTER_INFO* } + { ComboIndex DWORD } + { AdapterName char[MAX_ADAPTER_NAME_LENGTH+4] } + { Description char[MAX_ADAPTER_DESCRIPTION_LENGTH+4] } + { AddressLength UINT } + { Address BYTE[MAX_ADAPTER_ADDRESS_LENGTH] } + { Index DWORD } + { Type UINT } + { DhcpEnabled UINT } + { CurrentIpAddress PIP_ADDR_STRING } + { IpAddressList IP_ADDR_STRING } + { GatewayList IP_ADDR_STRING } + { DhcpServer IP_ADDR_STRING } + { HaveWins BOOL } + { PrimaryWinsServer IP_ADDR_STRING } + { SecondaryWinsServer IP_ADDR_STRING } + { LeaseObtained time_t } + { LeaseExpires time_t } ; + +TYPEDEF: IP_ADAPTER_INFO* PIP_ADAPTER_INFO + +STRUCT: LengthIndex + { Length ULONG } + { IfIndex DWORD } ; + +TYPEDEF: LengthIndex LengthFlags + +UNION-STRUCT: AlignmentLenIndex + { Alignment ULONGLONG } + { LenIndex LengthIndex } ; + +UNION-STRUCT: AlignmentLenFlags + { Alignment ULONGLONG } + { LenFlags LengthFlags } ; + +STRUCT: ResNetIf + { Reserved ULONG64 bits: 24 } + { NetLuidIndex ULONG64 bits: 24 } + { IfType ULONG64 bits: 16 } ; + +UNION-STRUCT: NET_LUID + { Value ULONG64 } + { Info ResNetIf } ; + +TYPEDEF: NET_LUID* PNET_LUID +TYPEDEF: NET_LUID IF_LUID + +DEFER: IP_ADAPTER_ADDRESSES +DEFER: IP_ADAPTER_UNICAST_ADDRESS +STRUCT: IP_ADAPTER_UNICAST_ADDRESS + { Header LengthFlags } + { Next IP_ADAPTER_UNICAST_ADDRESS* } + { Address SOCKET_ADDRESS } + { PrefixOrigin IP_PREFIX_ORIGIN } + { SuffixOrigin IP_SUFFIX_ORIGIN } + { DadState IP_DAD_STATE } + { ValidLifetime ULONG } + { PreferredLifetime ULONG } + { LeaseLifeTime ULONG } + { OnLinkPrefixLength UINT8 } ; + +TYPEDEF: IP_ADAPTER_UNICAST_ADDRESS* PIP_ADAPTER_UNICAST_ADDRESS + +DEFER: IP_ADAPTER_ANYCAST_ADDRESS +STRUCT: IP_ADAPTER_ANYCAST_ADDRESS + { Header AlignmentLenFlags } + { Next IP_ADAPTER_ANYCAST_ADDRESS* } + { Address SOCKET_ADDRESS } ; + +TYPEDEF: IP_ADAPTER_ANYCAST_ADDRESS* PIP_ADAPTER_ANYCAST_ADDRESS + + +DEFER: IP_ADAPTER_MULTICAST_ADDRESS +STRUCT: IP_ADAPTER_MULTICAST_ADDRESS + { Header AlignmentLenFlags } + { Next IP_ADAPTER_MULTICAST_ADDRESS* } + { Address SOCKET_ADDRESS } ; + +TYPEDEF: IP_ADAPTER_MULTICAST_ADDRESS* PIP_ADAPTER_MULTICAST_ADDRESS + + +DEFER: IP_ADAPTER_DNS_SERVER_ADDRESS +STRUCT: IP_ADAPTER_DNS_SERVER_ADDRESS + { Header AlignmentLenFlags } + { Next IP_ADAPTER_DNS_SERVER_ADDRESS* } + { Address SOCKET_ADDRESS } ; + +TYPEDEF: IP_ADAPTER_DNS_SERVER_ADDRESS* PIP_ADAPTER_DNS_SERVER_ADDRESS + + +DEFER: IP_ADAPTER_WINS_SERVER_ADDRESS +STRUCT: IP_ADAPTER_WINS_SERVER_ADDRESS + { Header AlignmentLenFlags } + { Next IP_ADAPTER_WINS_SERVER_ADDRESS* } + { Address SOCKET_ADDRESS } ; + +TYPEDEF: IP_ADAPTER_WINS_SERVER_ADDRESS* PIP_ADAPTER_WINS_SERVER_ADDRESS + +TYPEDEF: IP_ADAPTER_WINS_SERVER_ADDRESS* PIP_ADAPTER_WINS_SERVER_ADDRESS_LH + + + +DEFER: IP_ADAPTER_GATEWAY_ADDRESS +STRUCT: IP_ADAPTER_GATEWAY_ADDRESS + { Header AlignmentLenFlags } + { Next IP_ADAPTER_GATEWAY_ADDRESS* } + { Address SOCKET_ADDRESS } ; + +TYPEDEF: IP_ADAPTER_GATEWAY_ADDRESS* PIP_ADAPTER_GATEWAY_ADDRESS + +TYPEDEF: IP_ADAPTER_GATEWAY_ADDRESS* PIP_ADAPTER_GATEWAY_ADDRESS_LH + +DEFER: IP_ADAPTER_PREFIX +STRUCT: IP_ADAPTER_PREFIX + { Header AlignmentLenFlags } + { Next IP_ADAPTER_PREFIX* } + { Address SOCKET_ADDRESS } + { PrefixLength ULONG } ; + +TYPEDEF: IP_ADAPTER_PREFIX* PIP_ADAPTER_PREFIX + + +DEFER: IP_ADAPTER_DNS_SUFFIX +STRUCT: IP_ADAPTER_DNS_SUFFIX + { Next IP_ADAPTER_DNS_SUFFIX* } + { String WCHAR[MAX_DNS_SUFFIX_STRING_LENGTH] } ; + +TYPEDEF: IP_ADAPTER_DNS_SUFFIX* PIP_ADAPTER_DNS_SUFFIX + + +CONSTANT: GAA_FLAG_SKIP_UNICAST 0x0001 +CONSTANT: GAA_FLAG_SKIP_ANYCAST 0x0002 +CONSTANT: GAA_FLAG_SKIP_MULTICAST 0x0004 +CONSTANT: GAA_FLAG_SKIP_DNS_SERVER 0x0008 +CONSTANT: GAA_FLAG_INCLUDE_PREFIX 0x0010 +CONSTANT: GAA_FLAG_SKIP_FRIENDLY_NAME 0x0020 +CONSTANT: GAA_FLAG_INCLUDE_WINS_INFO 0x0040 +CONSTANT: GAA_FLAG_INCLUDE_GATEWAYS 0x0080 +CONSTANT: GAA_FLAG_INCLUDE_ALL_INTERFACES 0x0100 +CONSTANT: GAA_FLAG_INCLUDE_ALL_COMPARTMENTS 0x0200 +CONSTANT: GAA_FLAG_INCLUDE_TUNNEL_BINDINGORDER 0x0400 + +STRUCT: IP_ADAPTER_ADDRESSES + { Header AlignmentLenIndex } + { Next IP_ADAPTER_ADDRESSES* } + { AdapterName PCHAR } + { FirstUnicastAddress PIP_ADAPTER_UNICAST_ADDRESS } + { FirstAnycastAddress PIP_ADAPTER_ANYCAST_ADDRESS } + { FirstMulticastAddress PIP_ADAPTER_MULTICAST_ADDRESS } + { FirstDnsServerAddress PIP_ADAPTER_DNS_SERVER_ADDRESS } + { DnsSuffix PWCHAR } + { Description PWCHAR } + { FriendlyName PWCHAR } + { PhysicalAddress BYTE[MAX_ADAPTER_ADDRESS_LENGTH] } + { PhysicalAddressLength DWORD } + { Flags DWORD } + { Mtu DWORD } + { IfType DWORD } + { OperStatus IF_OPER_STATUS } + { Ipv6IfIndex DWORD } + { ZoneIndices DWORD[16] } + { FirstPrefix PIP_ADAPTER_PREFIX } + { TransmitLinkSpeed ULONG64 } + { ReceiveLinkSpeed ULONG64 } + { FirstWinsServerAddress PIP_ADAPTER_WINS_SERVER_ADDRESS_LH } + { FirstGatewayAddress PIP_ADAPTER_GATEWAY_ADDRESS_LH } + { Ipv4Metric ULONG } + { Ipv6Metric ULONG } + { Luid IF_LUID } + { Dhcpv4Server SOCKET_ADDRESS } + { CompartmentId NET_IF_COMPARTMENT_ID } + { NetworkGuid NET_IF_NETWORK_GUID } + { ConnectionType NET_IF_CONNECTION_TYPE } + { TunnelType TUNNEL_TYPE } + { Dhcpv6Server SOCKET_ADDRESS } + { Dhcpv6ClientDuid BYTE[MAX_DHCPV6_DUID_LENGTH] } + { Dhcpv6ClientDuidLength ULONG } + { Dhcpv6Iaid ULONG } + { FirstDnsSuffix PIP_ADAPTER_DNS_SUFFIX } ; + +TYPEDEF: IP_ADAPTER_ADDRESSES* PIP_ADAPTER_ADDRESSES + TYPEDEF: FIXED_INFO* PFIXED_INFO +FUNCTION: ULONG GetAdaptersAddresses ( + ULONG Family, + ULONG Flags, + PVOID Reserved, + PIP_ADAPTER_ADDRESSES AdapterAddresses, + PULONG SizePointer +) ; + +! Deprecated +FUNCTION: DWORD GetAdaptersInfo ( + PIP_ADAPTER_INFO pAdapterInfo, + PULONG pOutBufLen ) ; + FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen ) ; : get-fixed-info ( -- FIXED_INFO ) @@ -73,3 +356,45 @@ FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen ) ; [ Next>> ] bi dup ] loop drop ] { } make ; + + +! second struct starts at 720h + + +> ] when ] keep ] loop>array nip ; + +! Don't use this, use each/map-adapters +: iterate-interfaces ( -- seq ) + AF_UNSPEC GAA_FLAG_INCLUDE_PREFIX 0 uint + 65,536 [ malloc &free ] [ ULONG ] bi + [ GetAdaptersAddresses win32-error=0/f ] 2keep + uint deref drop + IP_ADAPTER_ADDRESSES memory>struct loop-list ; + +PRIVATE> + + +: interfaces-each ( quot -- seq ) + [ [ iterate-interfaces ] dip each ] with-destructors ; inline + +: interfaces-map ( quot -- seq ) + [ [ iterate-interfaces ] dip { } map-as ] with-destructors ; inline + +: interface-mac-addrs ( -- seq ) + [ + { + [ Description>> ] + [ [ PhysicalAddress>> ] [ PhysicalAddressLength>> ] bi head ] + } cleave>array + ] interfaces-map ; + +: interface-ips ( -- seq ) + [ + { + [ Description>> ] + [ FirstUnicastAddress>> loop-list [ Address>> SOCKET_ADDRESS>sockaddr sockaddr>ip ] map ] + } cleave>array + ] interfaces-map ; -- 2.34.1