basis/io/sockets/windows/windows.factor

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