basis/windows/iphlpapi/iphlpapi.factor

   1 ! Copyright (C) 2010 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.c-types alien.data alien.syntax
   4 classes.struct combinators combinators.smart destructors
   5 io.encodings.string io.encodings.utf8 io.sockets.private kernel
   6 libc make sequences windows.errors windows.kernel32
   7 windows.types windows.winsock ;
   8 IN: windows.iphlpapi
   9
  10 LIBRARY: iphlpapi
  11
  12 <<
  13 CONSTANT: DEFAULT_MINIMUM_ENTITIES 32
  14 CONSTANT: MAX_ADAPTER_ADDRESS_LENGTH 8
  15 CONSTANT: MAX_ADAPTER_DESCRIPTION_LENGTH 128
  16 CONSTANT: MAX_ADAPTER_NAME_LENGTH 256
  17 CONSTANT: MAX_DOMAIN_NAME_LEN 128
  18 CONSTANT: MAX_HOSTNAME_LEN 128
  19 CONSTANT: MAX_SCOPE_ID_LEN 256
  20 CONSTANT: BROADCAST_NODETYPE 1
  21 CONSTANT: PEER_TO_PEER_NODETYPE 2
  22 CONSTANT: MIXED_NODETYPE 4
  23 CONSTANT: HYBRID_NODETYPE 8
  24 CONSTANT: IF_OTHER_ADAPTERTYPE 0
  25 CONSTANT: IF_ETHERNET_ADAPTERTYPE 1
  26 CONSTANT: IF_TOKEN_RING_ADAPTERTYPE 2
  27 CONSTANT: IF_FDDI_ADAPTERTYPE 3
  28 CONSTANT: IF_PPP_ADAPTERTYPE 4
  29 CONSTANT: IF_LOOPBACK_ADAPTERTYPE 5
  30 >>
  31
  32 CONSTANT: MAX_DOMAIN_NAME_LEN+4 132
  33 CONSTANT: MAX_HOSTNAME_LEN+4 132
  34 CONSTANT: MAX_SCOPE_ID_LEN+4 260
  35 CONSTANT: MAX_ADAPTER_NAME_LENGTH+4 264
  36 CONSTANT: MAX_ADAPTER_DESCRIPTION_LENGTH+4 136
  37 CONSTANT: ERROR_BUFFER_OVERFLOW 111
  38 CONSTANT: MIB_IF_TYPE_ETHERNET 6
  39 CONSTANT: MIB_IF_TYPE_TOKENRING 9
  40 CONSTANT: MIB_IF_TYPE_FDDI 15
  41 CONSTANT: MIB_IF_TYPE_PPP 23
  42 CONSTANT: MIB_IF_TYPE_LOOPBACK 24
  43 CONSTANT: MIB_IF_TYPE_SLIP 28
  44 CONSTANT: MAX_DNS_SUFFIX_STRING_LENGTH 256 ! 246?
  45 CONSTANT: MAX_DHCPV6_DUID_LENGTH 130
  46 CONSTANT: MAX_ADAPTER_NAME 128
  47
  48 STRUCT: IP_ADDRESS_STRING
  49     { String char[16] } ;
  50
  51 TYPEDEF: IP_ADDRESS_STRING* PIP_ADDRESS_STRING
  52 TYPEDEF: IP_ADDRESS_STRING IP_MASK_STRING
  53 TYPEDEF: IP_MASK_STRING* PIP_MASK_STRING
  54
  55 STRUCT: IP_ADDR_STRING
  56     { Next IP_ADDR_STRING* }
  57     { IpAddress IP_ADDRESS_STRING }
  58     { IpMask IP_MASK_STRING }
  59     { Context DWORD } ;
  60
  61 TYPEDEF: IP_ADDR_STRING* PIP_ADDR_STRING
  62
  63 STRUCT: FIXED_INFO
  64     { HostName char[MAX_HOSTNAME_LEN+4] }
  65     { DomainName char[MAX_DOMAIN_NAME_LEN+4] }
  66     { CurrentDnsServer PIP_ADDR_STRING }
  67     { DnsServerList IP_ADDR_STRING }
  68     { NodeType UINT }
  69     { ScopeId char[MAX_SCOPE_ID_LEN+4] }
  70     { EnableRouting UINT }
  71     { EnableProxy UINT }
  72     { EnableDns UINT }
  73     { ExtraSpace char[4096] } ;
  74
  75 DEFER: IP_ADAPTER_INFO
  76
  77 TYPEDEF: ulong time_t
  78 TYPEDEF: uchar UINT8
  79 TYPEDEF: uint NET_IF_COMPARTMENT_ID
  80 TYPEDEF: GUID NET_IF_NETWORK_GUID
  81
  82 ENUM: IP_DAD_STATE
  83   IpDadStateInvalid
  84   IpDadStateTentative,
  85   IpDadStateDuplicate,
  86   IpDadStateDeprecated,
  87   IpDadStatePreferred ;
  88
  89 ENUM: IP_PREFIX_ORIGIN
  90     IpPrefixOriginOther,
  91     IpPrefixOriginManual,
  92     IpPrefixOriginWellKnown,
  93     IpPrefixOriginDhcp,
  94     IpPrefixOriginRouterAdvertisement,
  95     { IpPrefixOriginUnchanged 16 } ;
  96
  97 ENUM: IP_SUFFIX_ORIGIN
  98     IpSuffixOriginOther
  99     IpSuffixOriginManual,
 100     IpSuffixOriginWellKnown,
 101     IpSuffixOriginDhcp,
 102     IpSuffixOriginLinkLayerAddress,
 103     IpSuffixOriginRandom,
 104     { IpSuffixOriginUnchanged 16 } ;
 105
 106 ENUM: IF_OPER_STATUS
 107     { IfOperStatusUp 1 }
 108     IfOperStatusDown,
 109     IfOperStatusTesting,
 110     IfOperStatusUnknown,
 111     IfOperStatusDormant,
 112     IfOperStatusNotPresent,
 113     IfOperStatusLowerLayerDown ;
 114
 115 ENUM: NET_IF_CONNECTION_TYPE
 116     { NET_IF_CONNECTION_DEDICATED 1 }
 117     NET_IF_CONNECTION_PASSIVE,
 118     NET_IF_CONNECTION_DEMAND,
 119     NET_IF_CONNECTION_MAXIMUM ;
 120
 121
 122 ENUM: TUNNEL_TYPE
 123     TUNNEL_TYPE_NONE,
 124     TUNNEL_TYPE_OTHER,
 125     TUNNEL_TYPE_DIRECT,
 126     TUNNEL_TYPE_6TO4,
 127     TUNNEL_TYPE_ISATAP,
 128     TUNNEL_TYPE_TEREDO,
 129     TUNNEL_TYPE_IPHTTPS ;
 130
 131
 132
 133 STRUCT: SOCKET_ADDRESS
 134     { lpSockaddr LPSOCKADDR }
 135     { iSockaddrLength INT } ;
 136
 137 ERROR: unknown-sockaddr-length sockaddr length ;
 138
 139 : SOCKET_ADDRESS>sockaddr ( obj -- sockaddr )
 140     dup iSockaddrLength>> {
 141         { 16 [ lpSockaddr>> sockaddr-in memory>struct ] }
 142         { 28 [ lpSockaddr>> sockaddr-in6 memory>struct ] }
 143         [ unknown-sockaddr-length ]
 144     } case ;
 145
 146 TYPEDEF: SOCKET_ADDRESS* PSOCKET_ADDRESS
 147
 148 STRUCT: IP_ADAPTER_INFO
 149     { Next IP_ADAPTER_INFO* }
 150     { ComboIndex DWORD }
 151     { AdapterName char[MAX_ADAPTER_NAME_LENGTH+4] }
 152     { Description char[MAX_ADAPTER_DESCRIPTION_LENGTH+4] }
 153     { AddressLength UINT }
 154     { Address BYTE[MAX_ADAPTER_ADDRESS_LENGTH] }
 155     { Index DWORD }
 156     { Type UINT }
 157     { DhcpEnabled UINT }
 158     { CurrentIpAddress PIP_ADDR_STRING }
 159     { IpAddressList IP_ADDR_STRING }
 160     { GatewayList IP_ADDR_STRING }
 161     { DhcpServer IP_ADDR_STRING }
 162     { HaveWins BOOL }
 163     { PrimaryWinsServer IP_ADDR_STRING }
 164     { SecondaryWinsServer IP_ADDR_STRING }
 165     { LeaseObtained time_t }
 166     { LeaseExpires time_t } ;
 167
 168 TYPEDEF: IP_ADAPTER_INFO* PIP_ADAPTER_INFO
 169
 170 STRUCT: LengthIndex
 171     { Length ULONG }
 172     { IfIndex DWORD } ;
 173
 174 TYPEDEF: LengthIndex LengthFlags
 175
 176 UNION-STRUCT: AlignmentLenIndex
 177     { Alignment ULONGLONG }
 178     { LenIndex LengthIndex } ;
 179
 180 UNION-STRUCT: AlignmentLenFlags
 181     { Alignment ULONGLONG }
 182     { LenFlags LengthFlags } ;
 183
 184 STRUCT: ResNetIf
 185     { Reserved ULONG64 bits: 24 }
 186     { NetLuidIndex ULONG64 bits: 24 }
 187     { IfType ULONG64 bits: 16 } ;
 188
 189 UNION-STRUCT: NET_LUID
 190     { Value ULONG64 }
 191     { Info ResNetIf } ;
 192
 193 TYPEDEF: NET_LUID* PNET_LUID
 194 TYPEDEF: NET_LUID IF_LUID
 195
 196 DEFER: IP_ADAPTER_ADDRESSES
 197 DEFER: IP_ADAPTER_UNICAST_ADDRESS
 198 STRUCT: IP_ADAPTER_UNICAST_ADDRESS
 199     { Header LengthFlags }
 200     { Next IP_ADAPTER_UNICAST_ADDRESS* }
 201     { Address SOCKET_ADDRESS }
 202     { PrefixOrigin IP_PREFIX_ORIGIN }
 203     { SuffixOrigin IP_SUFFIX_ORIGIN }
 204     { DadState IP_DAD_STATE }
 205     { ValidLifetime ULONG }
 206     { PreferredLifetime ULONG }
 207     { LeaseLifeTime ULONG }
 208     { OnLinkPrefixLength UINT8 } ;
 209
 210 TYPEDEF: IP_ADAPTER_UNICAST_ADDRESS* PIP_ADAPTER_UNICAST_ADDRESS
 211
 212 DEFER: IP_ADAPTER_ANYCAST_ADDRESS
 213 STRUCT: IP_ADAPTER_ANYCAST_ADDRESS
 214     { Header AlignmentLenFlags }
 215     { Next IP_ADAPTER_ANYCAST_ADDRESS* }
 216     { Address SOCKET_ADDRESS } ;
 217
 218 TYPEDEF: IP_ADAPTER_ANYCAST_ADDRESS* PIP_ADAPTER_ANYCAST_ADDRESS
 219
 220
 221 DEFER: IP_ADAPTER_MULTICAST_ADDRESS
 222 STRUCT: IP_ADAPTER_MULTICAST_ADDRESS
 223     { Header AlignmentLenFlags }
 224     { Next IP_ADAPTER_MULTICAST_ADDRESS* }
 225     { Address SOCKET_ADDRESS } ;
 226
 227 TYPEDEF: IP_ADAPTER_MULTICAST_ADDRESS* PIP_ADAPTER_MULTICAST_ADDRESS
 228
 229
 230 DEFER: IP_ADAPTER_DNS_SERVER_ADDRESS
 231 STRUCT: IP_ADAPTER_DNS_SERVER_ADDRESS
 232     { Header AlignmentLenFlags }
 233     { Next IP_ADAPTER_DNS_SERVER_ADDRESS* }
 234     { Address SOCKET_ADDRESS } ;
 235
 236 TYPEDEF: IP_ADAPTER_DNS_SERVER_ADDRESS* PIP_ADAPTER_DNS_SERVER_ADDRESS
 237
 238
 239 DEFER: IP_ADAPTER_WINS_SERVER_ADDRESS
 240 STRUCT: IP_ADAPTER_WINS_SERVER_ADDRESS
 241     { Header AlignmentLenFlags }
 242     { Next IP_ADAPTER_WINS_SERVER_ADDRESS* }
 243     { Address SOCKET_ADDRESS } ;
 244
 245 TYPEDEF: IP_ADAPTER_WINS_SERVER_ADDRESS* PIP_ADAPTER_WINS_SERVER_ADDRESS
 246
 247 TYPEDEF: IP_ADAPTER_WINS_SERVER_ADDRESS* PIP_ADAPTER_WINS_SERVER_ADDRESS_LH
 248
 249
 250
 251 DEFER: IP_ADAPTER_GATEWAY_ADDRESS
 252 STRUCT: IP_ADAPTER_GATEWAY_ADDRESS
 253     { Header AlignmentLenFlags }
 254     { Next IP_ADAPTER_GATEWAY_ADDRESS* }
 255     { Address SOCKET_ADDRESS } ;
 256
 257 TYPEDEF: IP_ADAPTER_GATEWAY_ADDRESS* PIP_ADAPTER_GATEWAY_ADDRESS
 258
 259 TYPEDEF: IP_ADAPTER_GATEWAY_ADDRESS* PIP_ADAPTER_GATEWAY_ADDRESS_LH
 260
 261 DEFER: IP_ADAPTER_PREFIX
 262 STRUCT: IP_ADAPTER_PREFIX
 263     { Header AlignmentLenFlags }
 264     { Next IP_ADAPTER_PREFIX* }
 265     { Address SOCKET_ADDRESS }
 266     { PrefixLength ULONG } ;
 267
 268 TYPEDEF: IP_ADAPTER_PREFIX* PIP_ADAPTER_PREFIX
 269
 270
 271 DEFER: IP_ADAPTER_DNS_SUFFIX
 272 STRUCT: IP_ADAPTER_DNS_SUFFIX
 273     { Next IP_ADAPTER_DNS_SUFFIX* }
 274     { String WCHAR[MAX_DNS_SUFFIX_STRING_LENGTH] } ;
 275
 276 TYPEDEF: IP_ADAPTER_DNS_SUFFIX* PIP_ADAPTER_DNS_SUFFIX
 277
 278
 279 CONSTANT: GAA_FLAG_SKIP_UNICAST 0x0001
 280 CONSTANT: GAA_FLAG_SKIP_ANYCAST 0x0002
 281 CONSTANT: GAA_FLAG_SKIP_MULTICAST 0x0004
 282 CONSTANT: GAA_FLAG_SKIP_DNS_SERVER 0x0008
 283 CONSTANT: GAA_FLAG_INCLUDE_PREFIX 0x0010
 284 CONSTANT: GAA_FLAG_SKIP_FRIENDLY_NAME 0x0020
 285 CONSTANT: GAA_FLAG_INCLUDE_WINS_INFO 0x0040
 286 CONSTANT: GAA_FLAG_INCLUDE_GATEWAYS 0x0080
 287 CONSTANT: GAA_FLAG_INCLUDE_ALL_INTERFACES 0x0100
 288 CONSTANT: GAA_FLAG_INCLUDE_ALL_COMPARTMENTS 0x0200
 289 CONSTANT: GAA_FLAG_INCLUDE_TUNNEL_BINDINGORDER 0x0400
 290
 291 STRUCT: IP_ADAPTER_ADDRESSES
 292     { Header AlignmentLenIndex }
 293     { Next IP_ADAPTER_ADDRESSES* }
 294     { AdapterName PCHAR }
 295     { FirstUnicastAddress PIP_ADAPTER_UNICAST_ADDRESS }
 296     { FirstAnycastAddress PIP_ADAPTER_ANYCAST_ADDRESS }
 297     { FirstMulticastAddress PIP_ADAPTER_MULTICAST_ADDRESS }
 298     { FirstDnsServerAddress PIP_ADAPTER_DNS_SERVER_ADDRESS }
 299     { DnsSuffix PWCHAR }
 300     { Description PWCHAR }
 301     { FriendlyName PWCHAR }
 302     { PhysicalAddress BYTE[MAX_ADAPTER_ADDRESS_LENGTH] }
 303     { PhysicalAddressLength DWORD }
 304     { Flags DWORD }
 305     { Mtu DWORD }
 306     { IfType DWORD }
 307     { OperStatus IF_OPER_STATUS }
 308     { Ipv6IfIndex DWORD }
 309     { ZoneIndices DWORD[16] }
 310     { FirstPrefix PIP_ADAPTER_PREFIX }
 311     { TransmitLinkSpeed ULONG64 }
 312     { ReceiveLinkSpeed ULONG64 }
 313     { FirstWinsServerAddress PIP_ADAPTER_WINS_SERVER_ADDRESS_LH }
 314     { FirstGatewayAddress PIP_ADAPTER_GATEWAY_ADDRESS_LH }
 315     { Ipv4Metric ULONG }
 316     { Ipv6Metric ULONG }
 317     { Luid IF_LUID }
 318     { Dhcpv4Server SOCKET_ADDRESS }
 319     { CompartmentId NET_IF_COMPARTMENT_ID }
 320     { NetworkGuid NET_IF_NETWORK_GUID }
 321     { ConnectionType NET_IF_CONNECTION_TYPE }
 322     { TunnelType TUNNEL_TYPE }
 323     { Dhcpv6Server SOCKET_ADDRESS }
 324     { Dhcpv6ClientDuid BYTE[MAX_DHCPV6_DUID_LENGTH] }
 325     { Dhcpv6ClientDuidLength ULONG }
 326     { Dhcpv6Iaid ULONG }
 327     { FirstDnsSuffix PIP_ADAPTER_DNS_SUFFIX } ;
 328
 329 TYPEDEF: IP_ADAPTER_ADDRESSES* PIP_ADAPTER_ADDRESSES
 330
 331 TYPEDEF: FIXED_INFO* PFIXED_INFO
 332
 333 STRUCT: S_un_b
 334     { s_b1 uchar }
 335     { s_b2 uchar }
 336     { s_b3 uchar }
 337     { s_b4 uchar } ;
 338
 339 STRUCT: S_un_w
 340     { s_w1 ushort }
 341     { s_w2 ushort } ;
 342
 343 UNION-STRUCT: IPAddr
 344     { S_un_b S_un_b }
 345     { S_un_w S_un_w }
 346     { S_addr ulong } ;
 347
 348 UNION-STRUCT: S_un
 349     { S_un_b S_un_b }
 350     { S_un_w S_un_w }
 351     { S_addr ulong } ;
 352
 353 STRUCT: IP_ADAPTER_INDEX_MAP
 354     { Index ULONG }
 355     { Name WCHAR[MAX_ADAPTER_NAME] } ;
 356 TYPEDEF: IP_ADAPTER_INDEX_MAP* PIP_ADAPTER_INDEX_MAP
 357
 358 FUNCTION: DWORD IpReleaseAddress ( PIP_ADAPTER_INDEX_MAP AdapterInfo )
 359 FUNCTION: DWORD IpRenewAddress ( PIP_ADAPTER_INDEX_MAP AdapterInfo )
 360
 361
 362 FUNCTION: DWORD GetBestInterface (
 363    IPAddr dwDestAddr,
 364    PDWORD pdwBestIfIndex
 365 )
 366
 367 FUNCTION: DWORD GetBestInterfaceEx (
 368     sockaddr* pDestAddr,
 369     PDWORD pdwBestIfIndex
 370 )
 371
 372 FUNCTION: ULONG GetAdaptersAddresses (
 373     ULONG Family,
 374     ULONG Flags,
 375     PVOID Reserved,
 376     PIP_ADAPTER_ADDRESSES AdapterAddresses,
 377     PULONG SizePointer
 378 )
 379
 380 ! Deprecated
 381 FUNCTION: DWORD GetAdaptersInfo (
 382     PIP_ADAPTER_INFO pAdapterInfo,
 383     PULONG pOutBufLen )
 384
 385 FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen )
 386
 387 : get-fixed-info ( -- FIXED_INFO )
 388     FIXED_INFO new dup byte-length ulong <ref>
 389     [ GetNetworkParams n>win32-error-check ] keepd ;
 390
 391 : dns-server-ips ( -- sequence )
 392     get-fixed-info DnsServerList>> [
 393         [
 394             [ IpAddress>> String>> [ 0 = ] trim-tail utf8 decode , ]
 395             [ Next>> ] bi dup
 396         ] loop drop
 397     ] { } make ;
 398
 399
 400 ! second struct starts at 720h
 401
 402
 403 <PRIVATE
 404
 405 : loop-list ( obj -- seq )
 406     [ Next>> ] follow ;
 407
 408 ! Don't use this, use each/map-adapters
 409 : iterate-interfaces ( -- seq )
 410     AF_UNSPEC GAA_FLAG_INCLUDE_PREFIX 0 uint <ref>
 411     65,536 [ malloc &free ] [ ULONG <ref> ] bi
 412     [ GetAdaptersAddresses win32-error=0/f ] 2keep
 413     uint deref drop
 414     IP_ADAPTER_ADDRESSES memory>struct loop-list ;
 415
 416 PRIVATE>
 417
 418 : interfaces-each ( quot -- seq )
 419     [ [ iterate-interfaces ] dip each ] with-destructors ; inline
 420
 421 : interfaces-map ( quot -- seq )
 422     [ [ iterate-interfaces ] dip { } map-as ] with-destructors ; inline
 423
 424 : interface-mac-addrs ( -- seq )
 425     [
 426         {
 427             [ Description>> ]
 428             [ [ PhysicalAddress>> ] [ PhysicalAddressLength>> ] bi head ]
 429         } cleave>array
 430     ] interfaces-map ;
 431
 432 : interface-ips ( -- seq )
 433     [
 434         {
 435             [ Description>> ]
 436             [ FirstUnicastAddress>> loop-list [ Address>> SOCKET_ADDRESS>sockaddr sockaddr>ip ] map ]
 437         } cleave>array
 438     ] interfaces-map ;
 439
 440 : get-best-interface ( inet -- interface )
 441     make-sockaddr 0 DWORD <ref>
 442     [ GetBestInterfaceEx win32-error=0/f ] keep DWORD deref ;