! 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 kernel libc make sequences sequences.extras
-windows.errors windows.kernel32 windows.types windows.winsock ;
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.c-types alien.data alien.syntax
+classes.struct combinators combinators.smart destructors
+io.encodings.string io.encodings.utf8 io.sockets.private kernel
+libc make sequences windows.errors windows.kernel32
+windows.types windows.winsock ;
IN: windows.iphlpapi
LIBRARY: iphlpapi
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
IpDadStateDuplicate,
IpDadStateDeprecated,
IpDadStatePreferred ;
-
+
ENUM: IP_PREFIX_ORIGIN
IpPrefixOriginOther,
IpPrefixOriginManual,
IpPrefixOriginDhcp,
IpPrefixOriginRouterAdvertisement,
{ IpPrefixOriginUnchanged 16 } ;
-
+
ENUM: IP_SUFFIX_ORIGIN
IpSuffixOriginOther
IpSuffixOriginManual,
IpSuffixOriginLinkLayerAddress,
IpSuffixOriginRandom,
{ IpSuffixOriginUnchanged 16 } ;
-
+
ENUM: IF_OPER_STATUS
{ IfOperStatusUp 1 }
IfOperStatusDown,
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_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 }
STRUCT: LengthIndex
{ Length ULONG }
{ IfIndex DWORD } ;
-
+
TYPEDEF: LengthIndex LengthFlags
UNION-STRUCT: AlignmentLenIndex
{ Alignment ULONGLONG }
{ LenIndex LengthIndex } ;
-
+
UNION-STRUCT: AlignmentLenFlags
{ Alignment ULONGLONG }
{ LenFlags LengthFlags } ;
UNION-STRUCT: NET_LUID
{ Value ULONG64 }
{ Info ResNetIf } ;
-
+
TYPEDEF: NET_LUID* PNET_LUID
TYPEDEF: NET_LUID IF_LUID
{ PreferredLifetime ULONG }
{ LeaseLifeTime ULONG }
{ OnLinkPrefixLength UINT8 } ;
-
+
TYPEDEF: IP_ADAPTER_UNICAST_ADDRESS* PIP_ADAPTER_UNICAST_ADDRESS
DEFER: IP_ADAPTER_ANYCAST_ADDRESS
{ Header AlignmentLenFlags }
{ Next IP_ADAPTER_ANYCAST_ADDRESS* }
{ Address SOCKET_ADDRESS } ;
-
+
TYPEDEF: IP_ADAPTER_ANYCAST_ADDRESS* PIP_ADAPTER_ANYCAST_ADDRESS
{ Header AlignmentLenFlags }
{ Next IP_ADAPTER_MULTICAST_ADDRESS* }
{ Address SOCKET_ADDRESS } ;
-
+
TYPEDEF: IP_ADAPTER_MULTICAST_ADDRESS* PIP_ADAPTER_MULTICAST_ADDRESS
{ Header AlignmentLenFlags }
{ Next IP_ADAPTER_DNS_SERVER_ADDRESS* }
{ Address SOCKET_ADDRESS } ;
-
+
TYPEDEF: IP_ADAPTER_DNS_SERVER_ADDRESS* PIP_ADAPTER_DNS_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
{ 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
{ Next IP_ADAPTER_PREFIX* }
{ Address SOCKET_ADDRESS }
{ PrefixLength ULONG } ;
-
+
TYPEDEF: IP_ADAPTER_PREFIX* PIP_ADAPTER_PREFIX
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
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 ) ;
+ 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 ;
-
+ FIXED_INFO new dup byte-length ulong <ref>
+ [ GetNetworkParams n>win32-error-check ] keepd ;
+
: dns-server-ips ( -- sequence )
get-fixed-info DnsServerList>> [
[
[ Next>> ] bi dup
] loop drop
] { } make ;
-
+
! second struct starts at 720h
<PRIVATE
: loop-list ( obj -- seq )
- [ [ dup [ Next>> ] when ] keep ] loop>array nip ;
+ [ Next>> ] follow ;
! Don't use this, use each/map-adapters
: iterate-interfaces ( -- seq )
PRIVATE>
-
: interfaces-each ( quot -- seq )
[ [ iterate-interfaces ] dip each ] with-destructors ; inline
[ [ PhysicalAddress>> ] [ PhysicalAddressLength>> ] bi head ]
} cleave>array
] interfaces-map ;
-
+
: interface-ips ( -- seq )
[
{
[ 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 ;
projects / factor.git / blobdiff