io.sockets: fix to work in deployed apps

db4
Slava Pestov 2009-09-04 03:57:57 -05:00
parent 7c04b912bb
commit 742db564f3
4 changed files with 92 additions and 83 deletions

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces continuations
destructors io debugger io.sockets sequences summary calendar
delegate system vocabs.loader combinators present ;
USING: accessors kernel namespaces continuations destructors io
debugger io.sockets io.sockets.private sequences summary
calendar delegate system vocabs.loader combinators present ;
IN: io.sockets.secure
SYMBOL: secure-socket-timeout

View File

@ -1,12 +1,12 @@
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors unix byte-arrays kernel sequences
namespaces math math.order combinators init alien alien.c-types
USING: accessors unix byte-arrays kernel sequences namespaces
math math.order combinators init alien alien.c-types
alien.strings libc continuations destructors openssl
openssl.libcrypto openssl.libssl io io.files io.ports
io.backend.unix io.sockets.unix io.encodings.ascii io.buffers
io.sockets io.sockets.secure io.sockets.secure.openssl
io.timeouts system summary fry ;
io.sockets io.sockets.private io.sockets.secure
io.sockets.secure.openssl io.timeouts system summary fry ;
FROM: io.ports => shutdown ;
IN: io.sockets.secure.unix

View File

@ -15,6 +15,8 @@ IN: io.sockets
} cond use-vocab >>
! Addressing
<PRIVATE
GENERIC: protocol-family ( addrspec -- af )
GENERIC: sockaddr-size ( addrspec -- n )
@ -37,6 +39,21 @@ GENERIC: inet-pton ( str addrspec -- data )
GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec )
: sockaddr-of-family ( alien af -- addrspec )
{
{ AF_INET [ sockaddr-in memory>struct ] }
{ AF_INET6 [ sockaddr-in6 memory>struct ] }
{ AF_UNIX [ sockaddr-un memory>struct ] }
[ 2drop f ]
} case ;
PRIVATE>
TUPLE: abstract-inet host port ;
M: abstract-inet present
[ host>> ":" ] [ port>> number>string ] bi 3append ;
TUPLE: local path ;
: <local> ( path -- addrspec )
@ -44,11 +61,6 @@ TUPLE: local path ;
M: local present path>> "Unix domain socket: " prepend ;
TUPLE: abstract-inet host port ;
M: abstract-inet present
[ host>> ":" ] [ port>> number>string ] bi 3append ;
TUPLE: inet4 < abstract-inet ;
C: <inet4> inet4
@ -146,24 +158,10 @@ M: inet6 parse-sockaddr
[ [ addr>> ] dip inet-ntop ]
[ drop port>> ntohs ] 2bi <inet6> ;
: addrspec-of-family ( af -- addrspec )
{
{ AF_INET [ T{ inet4 } ] }
{ AF_INET6 [ T{ inet6 } ] }
{ AF_UNIX [ T{ local } ] }
[ drop f ]
} case ;
: sockaddr-of-family ( af -- addrspec )
{
{ AF_INET [ sockaddr-in ] }
{ AF_INET6 [ sockaddr-in6 ] }
{ AF_UNIX [ sockaddr-un ] }
[ drop f ]
} case ;
M: f parse-sockaddr nip ;
<PRIVATE
GENERIC: (get-local-address) ( handle remote -- sockaddr )
: get-local-address ( handle remote -- local )
@ -198,6 +196,66 @@ M: object (client) ( remote -- client-in client-out local )
2bi
] with-destructors ;
TUPLE: server-port < port addr encoding ;
: check-server-port ( port -- port )
dup check-disposed
dup server-port? [ "Not a server port" throw ] unless ; inline
GENERIC: (server) ( addrspec -- handle )
GENERIC: (accept) ( server addrspec -- handle sockaddr )
TUPLE: datagram-port < port addr ;
HOOK: (datagram) io-backend ( addr -- datagram )
: check-datagram-port ( port -- port )
dup check-disposed
dup datagram-port? [ "Not a datagram port" throw ] unless ; inline
HOOK: (receive) io-backend ( datagram -- packet addrspec )
: check-datagram-send ( packet addrspec port -- packet addrspec port )
check-datagram-port
2dup addr>> [ class ] bi@ assert=
pick class byte-array assert= ;
HOOK: (send) io-backend ( packet addrspec datagram -- )
: addrspec-of-family ( af -- addrspec )
{
{ AF_INET [ T{ inet4 } ] }
{ AF_INET6 [ T{ inet6 } ] }
{ AF_UNIX [ T{ local } ] }
[ drop f ]
} case ;
: addrinfo>addrspec ( addrinfo -- addrspec )
[ [ addr>> ] [ family>> ] bi sockaddr-of-family ]
[ family>> addrspec-of-family ] bi
parse-sockaddr ;
: parse-addrinfo-list ( addrinfo -- seq )
[ next>> dup [ addrinfo memory>struct ] when ] follow
[ addrinfo>addrspec ] map
sift ;
HOOK: addrinfo-error io-backend ( n -- )
: resolve-passive-host ( -- addrspecs )
{ T{ inet6 f "::" f } T{ inet4 f "0.0.0.0" f } } [ clone ] map ;
: prepare-addrinfo ( -- addrinfo )
addrinfo <struct>
PF_UNSPEC >>family
IPPROTO_TCP >>protocol ;
: fill-in-ports ( addrspecs port -- addrspecs )
'[ _ >>port ] map ;
PRIVATE>
: <client> ( remote encoding -- stream local )
[ (client) ] dip swap [ <encoder-duplex> ] dip ;
@ -213,14 +271,6 @@ SYMBOL: remote-address
] dip with-stream
] with-scope ; inline
TUPLE: server-port < port addr encoding ;
: check-server-port ( port -- port )
dup check-disposed
dup server-port? [ "Not a server port" throw ] unless ; inline
GENERIC: (server) ( addrspec -- handle )
: <server> ( addrspec encoding -- server )
[
[ (server) ] keep
@ -228,8 +278,6 @@ GENERIC: (server) ( addrspec -- handle )
>>addr
] dip >>encoding ;
GENERIC: (accept) ( server addrspec -- handle sockaddr )
: accept ( server -- client remote )
[
dup addr>>
@ -238,10 +286,6 @@ GENERIC: (accept) ( server addrspec -- handle sockaddr )
<ports>
] keep encoding>> <encoder-duplex> swap ;
TUPLE: datagram-port < port addr ;
HOOK: (datagram) io-backend ( addr -- datagram )
: <datagram> ( addrspec -- datagram )
[
[ (datagram) |dispose ] keep
@ -249,55 +293,19 @@ HOOK: (datagram) io-backend ( addr -- datagram )
>>addr
] with-destructors ;
: check-datagram-port ( port -- port )
dup check-disposed
dup datagram-port? [ "Not a datagram port" throw ] unless ; inline
HOOK: (receive) io-backend ( datagram -- packet addrspec )
: receive ( datagram -- packet addrspec )
check-datagram-port
[ (receive) ] [ addr>> ] bi parse-sockaddr ;
: check-datagram-send ( packet addrspec port -- packet addrspec port )
check-datagram-port
2dup addr>> [ class ] bi@ assert=
pick class byte-array assert= ;
HOOK: (send) io-backend ( packet addrspec datagram -- )
: send ( packet addrspec datagram -- )
check-datagram-send (send) ;
: addrinfo>addrspec ( addrinfo -- addrspec )
[ [ addr>> ] [ family>> sockaddr-of-family ] bi memory>struct ]
[ family>> addrspec-of-family ] bi
parse-sockaddr ;
: parse-addrinfo-list ( addrinfo -- seq )
[ next>> dup [ addrinfo memory>struct ] when ] follow
[ addrinfo>addrspec ] map
sift ;
HOOK: addrinfo-error io-backend ( n -- )
GENERIC: resolve-host ( addrspec -- seq )
TUPLE: inet < abstract-inet ;
C: <inet> inet
: resolve-passive-host ( -- addrspecs )
{ T{ inet6 f "::" f } T{ inet4 f "0.0.0.0" f } } [ clone ] map ;
: prepare-addrinfo ( -- addrinfo )
addrinfo <struct>
PF_UNSPEC >>family
IPPROTO_TCP >>protocol ;
: fill-in-ports ( addrspecs port -- addrspecs )
'[ _ >>port ] map ;
M: inet resolve-host
[ port>> ] [ host>> ] bi [
f prepare-addrinfo f <void*>

View File

@ -1,10 +1,11 @@
! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings generic kernel math threads
sequences byte-arrays io.binary io.backend.unix io.streams.duplex
io.backend io.pathnames io.files.private io.encodings.utf8 math.parser
continuations libc combinators system accessors destructors unix
locals init classes.struct ;
USING: alien alien.c-types alien.strings generic kernel math
threads sequences byte-arrays io.binary io.backend.unix
io.streams.duplex io.backend io.pathnames io.sockets.private
io.files.private io.encodings.utf8 math.parser continuations
libc combinators system accessors destructors unix locals init
classes.struct ;
EXCLUDE: namespaces => bind ;
EXCLUDE: io => read write ;