From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 20 Sep 2010 02:35:52 +0000 (-0500)
Subject: Fix io.servers -- if it doesn't start up, don't throw an error when it's stopped... 
X-Git-Tag: 0.97~4257^2~102
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=8aa22487da685bb75b595f753e6e0b7f4dfcbf96

Fix io.servers -- if it doesn't start up, don't throw an error when it's stopped.  IPV6 must be enabled on windows with the command: ipv6 install (the build machines need this before we get clean windows builds).  Fix up winsock error handling.
---

diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor
index b44aa943b8..a6e13090a1 100644
--- a/basis/io/servers/connection/connection.factor
+++ b/basis/io/servers/connection/connection.factor
@@ -44,7 +44,7 @@ ERROR: server-not-running threaded-server ;
     running-servers get adjoin ;
 
 : remove-running-server ( threaded-server -- )
-    must-be-running
+    ! must-be-running
     running-servers get delete ;
 
 PRIVATE>
@@ -72,6 +72,8 @@ GENERIC: handle-client* ( threaded-server -- )
 GENERIC: (>insecure) ( obj -- obj )
 
 M: inet (>insecure) ;
+M: inet4 (>insecure) ;
+M: inet6 (>insecure) ;
 M: local (>insecure) ;
 M: integer (>insecure) internet-server ;
 M: string (>insecure) internet-server ;
@@ -224,6 +226,12 @@ PRIVATE>
 
 : insecure-port ( -- n/f ) [ addr>> secure? not ] first-port ;
 
+: secure-addr ( -- inet )
+    threaded-server get servers>> [ addr>> secure? ] filter random ;
+
+: insecure-addr ( -- inet )
+    threaded-server get servers>> [ addr>> secure? not ] filter random addr>> ;
+    
 : server. ( threaded-server -- )
     [ [ "=== " write name>> ] [ ] bi write-object nl ]
     [ servers>> [ addr>> present print ] each ] bi ;
@@ -231,6 +239,9 @@ PRIVATE>
 : all-servers ( -- sequence )
     running-servers get-global members ;
 
+: get-servers-named ( string -- sequence )
+    [ all-servers ] dip '[ name>> _ = ] filter ;
+    
 : servers. ( -- )
     all-servers [ server. ] each ;
 
diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor
index b617519fce..ade64485db 100755
--- a/basis/io/sockets/windows/windows.factor
+++ b/basis/io/sockets/windows/windows.factor
@@ -100,7 +100,7 @@ M: winnt WSASocket-flags ( -- DWORD )
         f
         f
         WSAIoctl SOCKET_ERROR = [
-            winsock-error-string throw
+            maybe-winsock-exception throw
         ] when
     ] with-out-parameters ;
 
@@ -134,7 +134,7 @@ TUPLE: ConnectEx-args port
     int
     { SOCKET void* int PVOID DWORD LPDWORD void* }
     stdcall alien-indirect drop
-    winsock-error-string [ throw ] when* ; inline
+    winsock-error ; inline
 
 M: object establish-connection ( client-out remote -- )
     make-sockaddr/size <ConnectEx-args>
@@ -164,6 +164,7 @@ TUPLE: AcceptEx-args port
         f >>lpdwBytesReceived
         (make-overlapped) >>lpOverlapped ; inline
 
+! AcceptEx return value is useless
 : call-AcceptEx ( AcceptEx -- )
     {
         [ sListenSocket>> ]
@@ -174,8 +175,7 @@ TUPLE: AcceptEx-args port
         [ dwRemoteAddressLength>> ]
         [ lpdwBytesReceived>> ]
         [ lpOverlapped>> ]
-    } cleave AcceptEx drop
-    winsock-error-string [ throw ] when* ; inline
+    } cleave AcceptEx drop winsock-error ; inline
 
 : (extract-remote-address) ( lpOutputBuffer dwReceiveDataLength dwLocalAddressLength dwRemoteAddressLength -- sockaddr )
     f <void*> 0 <int> f <void*> [ 0 <int> GetAcceptExSockaddrs ] keep *void* ;
diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index 4dd7d7385c..99e5e49295 100644
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -7,7 +7,7 @@ classes.struct windows.com.syntax init ;
 FROM: alien.c-types => short ;
 IN: windows.winsock
 
-TYPEDEF: void* SOCKET
+TYPEDEF: int* SOCKET
 
 : <wsadata> ( -- byte-array )
     HEX: 190 <byte-array> ;
@@ -394,35 +394,40 @@ CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
 
 CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
 
+ERROR: winsock-exception n string ;
+
 : winsock-expected-error? ( n -- ? )
     ${ ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING } member? ;
 
-: (winsock-error-string) ( n -- str )
+: (maybe-winsock-exception) ( n -- winsock-exception/f )
     ! #! WSAStartup returns the error code 'n' directly
     dup winsock-expected-error?
-    [ drop f ] [ n>win32-error-string ] if ;
+    [ drop f ] [ [ ] [ n>win32-error-string ] bi \ winsock-exception boa ] if ;
 
-: winsock-error-string ( -- string/f )
-    WSAGetLastError (winsock-error-string) ;
+: maybe-winsock-exception ( -- winsock-exception/f )
+    WSAGetLastError (maybe-winsock-exception) ;
 
 : winsock-error ( -- )
-    winsock-error-string [ throw ] when* ;
+    maybe-winsock-exception [ throw ] when* ;
+
+: (throw-winsock-error) ( n -- * )
+    [ ] [ n>win32-error-string ] bi winsock-exception ;
 
+: throw-winsock-error ( -- * )
+    WSAGetLastError (throw-winsock-error) ;
+    
 : winsock-error=0/f ( n/f -- )
-    { 0 f } member? [
-        winsock-error-string throw
-    ] when ;
+    { 0 f } member? [ throw-winsock-error ] when ;
 
 : winsock-error!=0/f ( n/f -- )
-    { 0 f } member? [
-        winsock-error-string throw
-    ] unless ;
+    { 0 f } member? [ throw-winsock-error ] unless ;
 
+! WSAStartup and WSACleanup return the error code directly
 : winsock-return-check ( n/f -- )
     dup { 0 f } member? [
         drop
     ] [
-        (winsock-error-string) throw
+        [ ] [ n>win32-error-string ] bi winsock-exception
     ] if ;
 
 : socket-error* ( n -- )
@@ -431,7 +436,7 @@ CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
         dup WSA_IO_PENDING = [
             drop
         ] [
-            (winsock-error-string) throw
+            (maybe-winsock-exception) throw
         ] if
     ] when ;