1 ! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types alien.data alien.strings
4 byte-arrays classes.struct combinators continuations
5 destructors generic init io.backend io.backend.unix io.binary
6 io.encodings.utf8 io.files.private io.pathnames
7 io.sockets.private io.streams.duplex kernel libc locals math
8 math.parser sequences system threads unix unix.ffi
10 EXCLUDE: namespaces => bind ;
11 EXCLUDE: io => read write ;
12 EXCLUDE: io.sockets => accept ;
15 : socket-fd ( domain type protocol -- fd )
16 socket dup io-error <fd> init-fd |dispose ;
18 : set-socket-option ( fd level opt -- )
19 [ handle-fd ] 2dip 1 int <ref> dup byte-length setsockopt io-error ;
21 M: unix addrinfo-error ( n -- )
22 [ gai_strerror throw ] unless-zero ;
24 M: unix sockaddr-of-family ( alien af -- addrspec )
26 { AF_INET [ sockaddr-in memory>struct ] }
27 { AF_INET6 [ sockaddr-in6 memory>struct ] }
28 { AF_UNIX [ sockaddr-un memory>struct ] }
32 M: unix addrspec-of-family ( af -- addrspec )
34 { AF_INET [ T{ ipv4 } ] }
35 { AF_INET6 [ T{ ipv6 } ] }
36 { AF_UNIX [ T{ local } ] }
40 ! Client sockets - TCP and Unix domain
41 M: object (get-local-address) ( handle remote -- sockaddr )
42 [ handle-fd ] dip empty-sockaddr/size int <ref>
43 [ getsockname io-error ] 2keep drop ;
45 M: object (get-remote-address) ( handle local -- sockaddr )
46 [ handle-fd ] dip empty-sockaddr/size int <ref>
47 [ getpeername io-error ] 2keep drop ;
49 : init-client-socket ( fd -- )
50 SOL_SOCKET SO_OOBINLINE set-socket-option ;
52 : wait-to-connect ( port -- )
53 dup handle>> handle-fd f 0 write
56 { [ errno EAGAIN = ] [ dup +output+ wait-for-port wait-to-connect ] }
57 { [ errno EINTR = ] [ wait-to-connect ] }
61 M:: object establish-connection ( client-out remote -- )
65 [ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect
69 { [ errno EINTR = ] [ drop client-out remote establish-connection ] }
70 { [ errno EINPROGRESS = ] [
71 [ +output+ wait-for-port ] [ wait-to-connect ] bi
76 : ?bind-client ( socket -- )
77 bind-local-address get [
78 [ fd>> ] dip make-sockaddr/size
79 [ bind ] unix-system-call drop
84 M: object ((client)) ( addrspec -- fd )
85 [ protocol-family SOCK_STREAM ] [ protocol ] bi socket-fd
86 [ init-client-socket ] [ ?bind-client ] [ ] tri ;
88 ! Server sockets - TCP and Unix domain
89 : init-server-socket ( fd -- )
90 SOL_SOCKET SO_REUSEADDR set-socket-option ;
92 : server-socket-fd ( addrspec type -- fd )
93 [ dup protocol-family ] dip pick protocol socket-fd
94 [ init-server-socket ] keep
95 [ handle-fd swap make-sockaddr/size [ bind ] unix-system-call drop ] keep ;
97 M: object (server) ( addrspec -- handle )
99 SOCK_STREAM server-socket-fd
100 dup handle-fd 128 [ listen ] unix-system-call drop
103 : do-accept ( server addrspec -- fd sockaddr )
104 [ handle>> handle-fd ] [ empty-sockaddr/size int <ref> ] bi*
105 [ accept ] 2keep drop ; inline
107 M: object (accept) ( server addrspec -- fd sockaddr )
110 { [ over 0 >= ] [ [ 2nip <fd> init-fd ] dip ] }
111 { [ errno EINTR = ] [ 2drop (accept) ] }
112 { [ errno EAGAIN = ] [
114 [ drop +input+ wait-for-port ]
121 ! Datagram sockets - UDP and Unix domain
123 [ SOCK_DGRAM server-socket-fd ] with-destructors ;
126 [ SOCK_RAW server-socket-fd ] with-destructors ;
128 :: do-receive ( n buf port -- count sockaddr )
129 port addr>> empty-sockaddr/size :> ( sockaddr len )
130 port handle>> handle-fd ! s
135 len int <ref> ! fromlen
136 recvfrom sockaddr ; inline
138 : (receive-loop) ( n buf datagram -- count sockaddr )
139 3dup do-receive over 0 > [ [ 3drop ] 2dip ] [
140 2drop [ +input+ wait-for-port ] [ (receive-loop) ] bi
141 ] if ; inline recursive
143 M: unix (receive-unsafe) ( n buf datagram -- count sockaddr )
146 :: do-send ( packet sockaddr len socket datagram -- )
147 socket handle-fd packet dup length 0 sockaddr len sendto
150 packet sockaddr len socket datagram do-send
153 datagram +output+ wait-for-port
154 packet sockaddr len socket datagram do-send
159 ] when ; inline recursive
161 M: unix (send) ( packet addrspec datagram -- )
162 [ make-sockaddr/size ] [ [ handle>> ] keep ] bi* do-send ;
164 ! Unix domain sockets
165 M: local protocol-family drop PF_UNIX ;
167 M: local sockaddr-size drop sockaddr-un heap-size ;
169 M: local empty-sockaddr drop sockaddr-un <struct> ;
171 M: local make-sockaddr
173 dup length 1 + max-un-path > [ "Path too long" throw ] when
176 swap utf8 string>alien >>path ;
178 M: local parse-sockaddr
180 path>> utf8 alien>string <local> ;
182 os linux? [ "io.sockets.unix.linux" require ] when