Doug Coleman
parent
6f8043241e
commit
c5df68d7b3
|
|
@ -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 ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue