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