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