]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/windows/iphlpapi/iphlpapi.factor
Use canonical way to get HEAD SHA1
[factor.git] / basis / windows / iphlpapi / iphlpapi.factor
index 42152ad7b59c6c55b21c1aa7953de1b7bdadbb2a..6694c0e93ee98d8cc44b9f609eea28389658f82a 100644 (file)
@@ -1,11 +1,10 @@
 ! 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 io.sockets io.sockets.private kernel libc
-make refs sequences sequences.extras windows.errors
-windows.kernel32 windows.types windows.winsock fry ;
+! 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
@@ -46,19 +45,22 @@ 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
@@ -86,7 +88,7 @@ ENUM: IP_DAD_STATE
   IpDadStateDuplicate,
   IpDadStateDeprecated,
   IpDadStatePreferred ;
-  
+
 ENUM: IP_PREFIX_ORIGIN
     IpPrefixOriginOther,
     IpPrefixOriginManual,
@@ -94,7 +96,7 @@ ENUM: IP_PREFIX_ORIGIN
     IpPrefixOriginDhcp,
     IpPrefixOriginRouterAdvertisement,
     { IpPrefixOriginUnchanged 16 } ;
-    
+
 ENUM: IP_SUFFIX_ORIGIN
     IpSuffixOriginOther
     IpSuffixOriginManual,
@@ -103,7 +105,7 @@ ENUM: IP_SUFFIX_ORIGIN
     IpSuffixOriginLinkLayerAddress,
     IpSuffixOriginRandom,
     { IpSuffixOriginUnchanged 16 } ;
-    
+
 ENUM: IF_OPER_STATUS
     { IfOperStatusUp 1 }
     IfOperStatusDown,
@@ -118,34 +120,34 @@ ENUM: NET_IF_CONNECTION_TYPE
     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 }
@@ -171,13 +173,13 @@ 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 } ;
@@ -190,7 +192,7 @@ STRUCT: ResNetIf
 UNION-STRUCT: NET_LUID
     { Value ULONG64 }
     { Info ResNetIf } ;
-    
+
 TYPEDEF: NET_LUID* PNET_LUID
 TYPEDEF: NET_LUID IF_LUID
 
@@ -207,7 +209,7 @@ STRUCT: IP_ADAPTER_UNICAST_ADDRESS
     { PreferredLifetime ULONG }
     { LeaseLifeTime ULONG }
     { OnLinkPrefixLength UINT8 } ;
-    
+
 TYPEDEF: IP_ADAPTER_UNICAST_ADDRESS* PIP_ADAPTER_UNICAST_ADDRESS
 
 DEFER: IP_ADAPTER_ANYCAST_ADDRESS
@@ -215,7 +217,7 @@ STRUCT: IP_ADAPTER_ANYCAST_ADDRESS
     { Header AlignmentLenFlags }
     { Next IP_ADAPTER_ANYCAST_ADDRESS* }
     { Address SOCKET_ADDRESS } ;
-    
+
 TYPEDEF: IP_ADAPTER_ANYCAST_ADDRESS* PIP_ADAPTER_ANYCAST_ADDRESS
 
 
@@ -224,7 +226,7 @@ STRUCT: IP_ADAPTER_MULTICAST_ADDRESS
     { Header AlignmentLenFlags }
     { Next IP_ADAPTER_MULTICAST_ADDRESS* }
     { Address SOCKET_ADDRESS } ;
-   
+
 TYPEDEF: IP_ADAPTER_MULTICAST_ADDRESS* PIP_ADAPTER_MULTICAST_ADDRESS
 
 
@@ -233,7 +235,7 @@ 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
 
 
@@ -242,7 +244,7 @@ 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
@@ -254,7 +256,7 @@ 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
@@ -265,7 +267,7 @@ STRUCT: IP_ADAPTER_PREFIX
     { Next IP_ADAPTER_PREFIX* }
     { Address SOCKET_ADDRESS }
     { PrefixLength ULONG } ;
-    
+
 TYPEDEF: IP_ADAPTER_PREFIX* PIP_ADAPTER_PREFIX
 
 
@@ -273,7 +275,7 @@ 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
 
 
@@ -336,7 +338,7 @@ STRUCT: S_un_b
     { s_b2 uchar }
     { s_b3 uchar }
     { s_b4 uchar } ;
-    
+
 STRUCT: S_un_w
     { s_w1 ushort }
     { s_w2 ushort } ;
@@ -345,30 +347,30 @@ 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 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,
@@ -376,19 +378,19 @@ FUNCTION: ULONG GetAdaptersAddresses (
     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>> [
         [
@@ -396,7 +398,7 @@ FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen ) ;
             [ Next>> ] bi dup
         ] loop drop
     ] { } make ;
-    
+
 
 ! second struct starts at 720h
 
@@ -404,7 +406,7 @@ FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen ) ;
 <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 )
@@ -429,7 +431,7 @@ PRIVATE>
             [ [ PhysicalAddress>> ] [ PhysicalAddressLength>> ] bi head ]
         } cleave>array
     ] interfaces-map ;
-    
+
 : interface-ips ( -- seq )
     [
         {