444 lines
12 KiB
Factor
444 lines
12 KiB
Factor
! Copyright (C) 2010 Doug Coleman.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
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 io.sockets io.sockets.private kernel libc
|
|
make refs sequences sequences.extras windows.errors
|
|
windows.kernel32 windows.types windows.winsock fry ;
|
|
IN: windows.iphlpapi
|
|
|
|
LIBRARY: iphlpapi
|
|
|
|
<<
|
|
CONSTANT: DEFAULT_MINIMUM_ENTITIES 32
|
|
CONSTANT: MAX_ADAPTER_ADDRESS_LENGTH 8
|
|
CONSTANT: MAX_ADAPTER_DESCRIPTION_LENGTH 128
|
|
CONSTANT: MAX_ADAPTER_NAME_LENGTH 256
|
|
CONSTANT: MAX_DOMAIN_NAME_LEN 128
|
|
CONSTANT: MAX_HOSTNAME_LEN 128
|
|
CONSTANT: MAX_SCOPE_ID_LEN 256
|
|
CONSTANT: BROADCAST_NODETYPE 1
|
|
CONSTANT: PEER_TO_PEER_NODETYPE 2
|
|
CONSTANT: MIXED_NODETYPE 4
|
|
CONSTANT: HYBRID_NODETYPE 8
|
|
CONSTANT: IF_OTHER_ADAPTERTYPE 0
|
|
CONSTANT: IF_ETHERNET_ADAPTERTYPE 1
|
|
CONSTANT: IF_TOKEN_RING_ADAPTERTYPE 2
|
|
CONSTANT: IF_FDDI_ADAPTERTYPE 3
|
|
CONSTANT: IF_PPP_ADAPTERTYPE 4
|
|
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
|
|
CONSTANT: MAX_ADAPTER_NAME 128
|
|
|
|
STRUCT: IP_ADDRESS_STRING
|
|
{ String char[16] } ;
|
|
|
|
TYPEDEF: IP_ADDRESS_STRING* PIP_ADDRESS_STRING
|
|
TYPEDEF: IP_ADDRESS_STRING IP_MASK_STRING
|
|
TYPEDEF: IP_MASK_STRING* PIP_MASK_STRING
|
|
|
|
STRUCT: IP_ADDR_STRING
|
|
{ Next IP_ADDR_STRING* }
|
|
{ IpAddress IP_ADDRESS_STRING }
|
|
{ IpMask IP_MASK_STRING }
|
|
{ Context DWORD } ;
|
|
|
|
TYPEDEF: IP_ADDR_STRING* PIP_ADDR_STRING
|
|
|
|
STRUCT: FIXED_INFO
|
|
{ HostName char[MAX_HOSTNAME_LEN+4] }
|
|
{ DomainName char[MAX_DOMAIN_NAME_LEN+4] }
|
|
{ CurrentDnsServer PIP_ADDR_STRING }
|
|
{ DnsServerList IP_ADDR_STRING }
|
|
{ NodeType UINT }
|
|
{ ScopeId char[MAX_SCOPE_ID_LEN+4] }
|
|
{ EnableRouting UINT }
|
|
{ EnableProxy UINT }
|
|
{ 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
|
|
|
|
STRUCT: S_un_b
|
|
{ s_b1 uchar }
|
|
{ s_b2 uchar }
|
|
{ s_b3 uchar }
|
|
{ s_b4 uchar } ;
|
|
|
|
STRUCT: S_un_w
|
|
{ s_w1 ushort }
|
|
{ s_w2 ushort } ;
|
|
|
|
UNION-STRUCT: IPAddr
|
|
{ S_un_b S_un_b }
|
|
{ S_un_w S_un_w }
|
|
{ S_addr ulong } ;
|
|
|
|
UNION-STRUCT: S_un
|
|
{ S_un_b S_un_b }
|
|
{ S_un_w S_un_w }
|
|
{ S_addr ulong } ;
|
|
|
|
STRUCT: IP_ADAPTER_INDEX_MAP
|
|
{ Index ULONG }
|
|
{ Name WCHAR[MAX_ADAPTER_NAME] } ;
|
|
TYPEDEF: IP_ADAPTER_INDEX_MAP* PIP_ADAPTER_INDEX_MAP
|
|
|
|
FUNCTION: DWORD IpReleaseAddress ( PIP_ADAPTER_INDEX_MAP AdapterInfo ) ;
|
|
FUNCTION: DWORD IpRenewAddress ( PIP_ADAPTER_INDEX_MAP AdapterInfo ) ;
|
|
|
|
|
|
FUNCTION: DWORD GetBestInterface (
|
|
IPAddr dwDestAddr,
|
|
PDWORD pdwBestIfIndex
|
|
) ;
|
|
|
|
FUNCTION: DWORD GetBestInterfaceEx (
|
|
sockaddr* pDestAddr,
|
|
PDWORD pdwBestIfIndex
|
|
) ;
|
|
|
|
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 )
|
|
FIXED_INFO <struct> dup byte-length ulong <ref>
|
|
[ GetNetworkParams n>win32-error-check ] 2keep drop ;
|
|
|
|
: dns-server-ips ( -- sequence )
|
|
get-fixed-info DnsServerList>> [
|
|
[
|
|
[ IpAddress>> String>> [ 0 = ] trim-tail utf8 decode , ]
|
|
[ 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 ;
|
|
|
|
: get-best-interface ( inet -- interface )
|
|
make-sockaddr 0 DWORD <ref>
|
|
[ GetBestInterfaceEx win32-error=0/f ] keep DWORD deref ;
|