1 ! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.c-types alien.strings generic kernel math
4 namespaces threads sequences byte-arrays io.ports
5 io.binary io.unix.backend io.streams.duplex
6 io.backend io.ports io.files io.files.private
7 io.encodings.utf8 math.parser continuations libc combinators
8 system accessors qualified destructors unix locals init ;
10 EXCLUDE: io => read write close ;
11 EXCLUDE: io.sockets => accept ;
15 : socket-fd ( domain type -- fd )
16 0 socket dup io-error <fd> init-fd |dispose ;
18 : set-socket-option ( fd level opt -- )
19 [ handle-fd ] 2dip 1 <int> "int" heap-size setsockopt io-error ;
21 M: unix addrinfo-error ( n -- )
22 dup zero? [ drop ] [ gai_strerror throw ] if ;
24 ! Client sockets - TCP and Unix domain
25 M: object (get-local-address) ( handle remote -- sockaddr )
26 [ handle-fd ] dip empty-sockaddr/size <int>
27 [ getsockname io-error ] 2keep drop ;
29 M: object (get-remote-address) ( handle local -- sockaddr )
30 [ handle-fd ] dip empty-sockaddr/size <int>
31 [ getpeername io-error ] 2keep drop ;
33 : init-client-socket ( fd -- )
34 SOL_SOCKET SO_OOBINLINE set-socket-option ;
36 : wait-to-connect ( port -- )
37 dup handle>> handle-fd f 0 write
40 { [ err_no EAGAIN = ] [ dup +output+ wait-for-port wait-to-connect ] }
41 { [ err_no EINTR = ] [ wait-to-connect ] }
45 M: object establish-connection ( client-out remote -- )
46 [ drop ] [ [ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect ] 2bi
49 { [ err_no EINPROGRESS = ] [
50 [ +output+ wait-for-port ] [ wait-to-connect ] bi
55 M: object ((client)) ( addrspec -- fd )
56 protocol-family SOCK_STREAM socket-fd dup init-client-socket ;
58 ! Server sockets - TCP and Unix domain
59 : init-server-socket ( fd -- )
60 SOL_SOCKET SO_REUSEADDR set-socket-option ;
62 : server-socket-fd ( addrspec type -- fd )
63 [ dup protocol-family ] dip socket-fd
64 dup init-server-socket
65 dup handle-fd rot make-sockaddr/size bind io-error ;
67 M: object (server) ( addrspec -- handle )
69 SOCK_STREAM server-socket-fd
70 dup handle-fd 128 listen io-error
73 : do-accept ( server addrspec -- fd sockaddr )
74 [ handle>> handle-fd ] [ empty-sockaddr/size <int> ] bi*
75 [ accept ] 2keep drop ; inline
77 M: object (accept) ( server addrspec -- fd sockaddr )
80 { [ over 0 >= ] [ [ 2nip <fd> init-fd ] dip ] }
81 { [ err_no EINTR = ] [ 2drop (accept) ] }
82 { [ err_no EAGAIN = ] [
84 [ drop +input+ wait-for-port ]
91 ! Datagram sockets - UDP and Unix domain
93 [ SOCK_DGRAM server-socket-fd ] with-destructors ;
95 SYMBOL: receive-buffer
97 : packet-size 65536 ; inline
99 [ packet-size malloc receive-buffer set-global ] "io.unix.sockets" add-init-hook
101 :: do-receive ( port -- packet sockaddr )
102 port addr>> empty-sockaddr/size [| sockaddr len |
103 port handle>> handle-fd ! s
104 receive-buffer get-global ! buf
110 receive-buffer get-global swap memory>byte-array sockaddr
116 M: unix (receive) ( datagram -- packet sockaddr )
117 dup do-receive dup [ [ drop ] 2dip ] [
118 2drop [ +input+ wait-for-port ] [ (receive) ] bi
121 :: do-send ( packet sockaddr len socket datagram -- )
122 socket handle-fd packet dup length 0 sockaddr len sendto
125 packet sockaddr len socket datagram do-send
128 datagram +output+ wait-for-port
129 packet sockaddr len socket datagram do-send
136 M: unix (send) ( packet addrspec datagram -- )
137 [ make-sockaddr/size ] [ [ handle>> ] keep ] bi* do-send ;
139 ! Unix domain sockets
140 M: local protocol-family drop PF_UNIX ;
142 M: local sockaddr-size drop "sockaddr-un" heap-size ;
144 M: local empty-sockaddr drop "sockaddr-un" <c-object> ;
146 M: local make-sockaddr
147 path>> (normalize-path)
148 dup length 1 + max-un-path > [ "Path too long" throw ] when
149 "sockaddr-un" <c-object>
150 AF_UNIX over set-sockaddr-un-family
151 dup sockaddr-un-path rot utf8 string>alien dup length memcpy ;
153 M: local parse-sockaddr
155 sockaddr-un-path utf8 alien>string <local> ;