basis/io/sockets/windows/windows.factor

   1 USING: kernel accessors io.sockets io.sockets.private\r
   2 io.backend.windows io.backend windows.winsock system destructors\r
   3 alien.c-types classes.struct combinators ;\r
   4 IN: io.sockets.windows\r
   5 \r
   6 M: windows addrinfo-error ( n -- )\r
   7     winsock-return-check ;\r
   8 \r
   9 M: windows sockaddr-of-family ( alien af -- addrspec )\r
  10     {\r
  11         { AF_INET [ sockaddr-in memory>struct ] }\r
  12         { AF_INET6 [ sockaddr-in6 memory>struct ] }\r
  13         [ 2drop f ]\r
  14     } case ;\r
  15 \r
  16 M: windows addrspec-of-family ( af -- addrspec )\r
  17     {\r
  18         { AF_INET [ T{ inet4 } ] }\r
  19         { AF_INET6 [ T{ inet6 } ] }\r
  20         [ drop f ]\r
  21     } case ;\r
  22 \r
  23 HOOK: WSASocket-flags io-backend ( -- DWORD )\r
  24 \r
  25 TUPLE: win32-socket < win32-file ;\r
  26 \r
  27 : <win32-socket> ( handle -- win32-socket )\r
  28     win32-socket new-win32-handle ;\r
  29 \r
  30 M: win32-socket dispose ( stream -- )\r
  31     handle>> closesocket drop ;\r
  32 \r
  33 : unspecific-sockaddr/size ( addrspec -- sockaddr len )\r
  34     [ empty-sockaddr/size ] [ protocol-family ] bi pick (>>family) ;\r
  35 \r
  36 : opened-socket ( handle -- win32-socket )\r
  37     <win32-socket> |dispose dup add-completion ;\r
  38 \r
  39 : open-socket ( addrspec type -- win32-socket )\r
  40     [ protocol-family ] dip\r
  41     0 f 0 WSASocket-flags WSASocket\r
  42     dup socket-error\r
  43     opened-socket ;\r
  44 \r
  45 M: object (get-local-address) ( socket addrspec -- sockaddr )\r
  46     [ handle>> ] dip empty-sockaddr/size <int>\r
  47     [ getsockname socket-error ] 2keep drop ;\r
  48 \r
  49 M: object (get-remote-address) ( socket addrspec -- sockaddr )\r
  50     [ handle>> ] dip empty-sockaddr/size <int>\r
  51     [ getpeername socket-error ] 2keep drop ;\r
  52 \r
  53 : bind-socket ( win32-socket sockaddr len -- )\r
  54     [ handle>> ] 2dip bind socket-error ;\r
  55 \r
  56 M: object ((client)) ( addrspec -- handle )\r
  57     [ SOCK_STREAM open-socket ] keep\r
  58     [ unspecific-sockaddr/size bind-socket ] [ drop ] 2bi ;\r
  59 \r
  60 : server-socket ( addrspec type -- fd )\r
  61     [ open-socket ] [ drop ] 2bi\r
  62     [ make-sockaddr/size bind-socket ] [ drop ] 2bi ;\r
  63 \r
  64 ! http://support.microsoft.com/kb/127144\r
  65 ! NOTE: Possibly tweak this because of SYN flood attacks\r
  66 : listen-backlog ( -- n ) HEX: 7fffffff ; inline\r
  67 \r
  68 M: object (server) ( addrspec -- handle )\r
  69     [\r
  70         SOCK_STREAM server-socket\r
  71         dup handle>> listen-backlog listen winsock-return-check\r
  72     ] with-destructors ;\r
  73 \r
  74 M: windows (datagram) ( addrspec -- handle )\r
  75     [ SOCK_DGRAM server-socket ] with-destructors ;\r