windows.iphlpapi: Add a way to get interfaces, mac addrs, and ips on

windows.
db4
Doug Coleman 2012-09-16 17:51:05 -07:00
parent 6f8043241e
commit c5df68d7b3
1 changed files with 328 additions and 3 deletions

View File

@ -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
<PRIVATE
: loop-list ( obj -- seq )
[ [ dup [ Next>> ] when ] keep ] loop>array nip ;
! Don't use this, use each/map-adapters
: iterate-interfaces ( -- seq )
AF_UNSPEC GAA_FLAG_INCLUDE_PREFIX 0 uint <ref>
65,536 [ malloc &free ] [ ULONG <ref> ] 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 ;