 ! Copyright (C) 2010 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.data alien.syntax
-classes.struct io.encodings.string io.encodings.utf8 kernel
-make sequences windows.errors windows.types ;
+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 ;
 IN: windows.iphlpapi
 
 LIBRARY: iphlpapi

            [ Next>> ] bi dup
        ] loop drop
    ] { } make ;

    { 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

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 )
