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