diff --git a/extra/io/files/unique/unique-docs.factor b/extra/io/files/unique/unique-docs.factor index 01b8e131cc..bb4e9ef01f 100644 --- a/extra/io/files/unique/unique-docs.factor +++ b/extra/io/files/unique/unique-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax io io.nonblocking kernel math +USING: help.markup help.syntax io io.ports kernel math io.files.unique.private math.parser io.files ; IN: io.files.unique diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index e28742537d..0bfac74416 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -4,7 +4,7 @@ USING: system kernel namespaces strings hashtables sequences assocs combinators vocabs.loader init threads continuations math accessors concurrency.flags destructors io io.backend io.timeouts io.pipes io.pipes.private io.encodings -io.streams.duplex io.nonblocking ; +io.streams.duplex io.ports ; IN: io.launcher TUPLE: process < identity-tuple diff --git a/extra/io/pipes/pipes-tests.factor b/extra/io/pipes/pipes-tests.factor index c1b37f6efc..4fb9d57748 100755 --- a/extra/io/pipes/pipes-tests.factor +++ b/extra/io/pipes/pipes-tests.factor @@ -1,6 +1,6 @@ USING: io io.pipes io.streams.string io.encodings.utf8 -io.streams.duplex io.encodings namespaces continuations -tools.test kernel ; +io.streams.duplex io.encodings io.timeouts namespaces +continuations tools.test kernel calendar ; IN: io.pipes.tests [ "Hello" ] [ @@ -24,3 +24,10 @@ IN: io.pipes.tests [ input-stream [ utf8 ] change readln ] } run-pipeline ] unit-test + +[ + utf8 [ + 5 seconds over set-timeout + stream-readln + ] with-disposal +] must-fail diff --git a/extra/io/pipes/pipes.factor b/extra/io/pipes/pipes.factor index cae7ef8158..a3315d02ca 100644 --- a/extra/io/pipes/pipes.factor +++ b/extra/io/pipes/pipes.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io.encodings io.backend io.nonblocking io.streams.duplex +USING: io.encodings io.backend io.ports io.streams.duplex io splitting sequences sequences.lib namespaces kernel destructors math concurrency.combinators accessors arrays continuations quotations ; diff --git a/extra/io/nonblocking/authors.txt b/extra/io/ports/authors.txt similarity index 100% rename from extra/io/nonblocking/authors.txt rename to extra/io/ports/authors.txt diff --git a/extra/io/nonblocking/nonblocking-docs.factor b/extra/io/ports/ports-docs.factor similarity index 90% rename from extra/io/nonblocking/nonblocking-docs.factor rename to extra/io/ports/ports-docs.factor index 7a489d8606..e94df99a84 100755 --- a/extra/io/nonblocking/nonblocking-docs.factor +++ b/extra/io/ports/ports-docs.factor @@ -1,9 +1,9 @@ USING: io io.buffers io.backend help.markup help.syntax kernel byte-arrays sbufs words continuations byte-vectors classes ; -IN: io.nonblocking +IN: io.ports -ARTICLE: "io.nonblocking" "Non-blocking I/O implementation" -"On Windows and Unix, Factor implements blocking file and network streams on top of a non-blocking I/O substrate, ensuring that Factor threads will yield when performing I/O. This substrate is implemented in the " { $vocab-link "io.nonblocking" } " vocabulary." +ARTICLE: "io.ports" "Non-blocking I/O implementation" +"On Windows and Unix, Factor implements blocking file and network streams on top of a non-blocking I/O substrate, ensuring that Factor threads will yield when performing I/O. This substrate is implemented in the " { $vocab-link "io.ports" } " vocabulary." $nl "A " { $emphasis "port" } " is a stream using non-blocking I/O substrate:" { $subsection port } @@ -29,7 +29,7 @@ $nl { $subsection server-port } { $subsection datagram-port } ; -ABOUT: "io.nonblocking" +ABOUT: "io.ports" HELP: port { $class-description "Instances of this class present a blocking stream interface on top of an underlying non-blocking I/O system, giving the illusion of blocking by yielding the thread which is waiting for input or output." @@ -81,10 +81,6 @@ HELP: (wait-to-read) { $contract "Suspends the current thread until the port's buffer has data available for reading." } ; HELP: wait-to-read -{ $values { "count" "a non-negative integer" } { "port" input-port } } -{ $description "If the port's buffer has at least " { $snippet "count" } " unread bytes, returns immediately, otherwise suspends the current thread until some data is available for reading." } ; - -HELP: wait-to-read1 { $values { "port" input-port } } { $description "If the port's buffer has unread data, returns immediately, otherwise suspends the current thread until some data is available for reading." } ; diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/ports/ports.factor similarity index 72% rename from extra/io/nonblocking/nonblocking.factor rename to extra/io/ports/ports.factor index 74133e5abb..16e089a4a6 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/ports/ports.factor @@ -5,12 +5,12 @@ byte-vectors system io.encodings math.order io.backend continuations debugger classes byte-arrays namespaces splitting dlists assocs io.encodings.binary inspector accessors destructors ; -IN: io.nonblocking +IN: io.ports SYMBOL: default-buffer-size 64 1024 * default-buffer-size set-global -TUPLE: port handle buffer error timeout closed eof ; +TUPLE: port handle error timeout closed ; M: port timeout timeout>> ; @@ -37,26 +37,6 @@ M: handle-destructor dispose ( obj -- ) new swap dup init-handle >>handle ; inline -: ( handle class -- port ) - - default-buffer-size get >>buffer ; inline - -TUPLE: input-port < port ; - -: ( handle -- input-port ) - input-port ; - -TUPLE: output-port < port ; - -: ( handle -- output-port ) - output-port ; - -: ( read-handle write-handle -- input-port output-port ) - [ - [ dup add-error-destructor ] - [ dup add-error-destructor ] bi* - ] with-destructors ; - : pending-error ( port -- ) [ f ] change-error drop [ throw ] when* ; @@ -68,19 +48,21 @@ M: port-closed-error summary : check-closed ( port -- port ) dup closed>> [ port-closed-error ] when ; -HOOK: cancel-io io-backend ( port -- ) +TUPLE: buffered-port < port buffer ; -M: object cancel-io drop ; +: ( handle class -- port ) + + default-buffer-size get >>buffer ; inline -M: port timed-out cancel-io ; +TUPLE: input-port < buffered-port eof ; + +: ( handle -- input-port ) + input-port ; HOOK: (wait-to-read) io-backend ( port -- ) -: wait-to-read ( count port -- ) - tuck buffer>> buffer-length > [ (wait-to-read) ] [ drop ] if ; - -: wait-to-read1 ( port -- ) - 1 swap wait-to-read ; +: wait-to-read ( port -- ) + dup buffer>> buffer-empty? [ (wait-to-read) ] [ drop ] if ; : unless-eof ( port quot -- value ) >r dup buffer>> buffer-empty? over eof>> and @@ -88,12 +70,16 @@ HOOK: (wait-to-read) io-backend ( port -- ) M: input-port stream-read1 check-closed - dup wait-to-read1 [ buffer>> buffer-pop ] unless-eof ; + dup wait-to-read [ buffer>> buffer-pop ] unless-eof ; : read-step ( count port -- byte-array/f ) - [ wait-to-read ] 2keep + [ wait-to-read ] keep [ dupd buffer>> buffer-read ] unless-eof nip ; +M: input-port stream-read-partial ( max stream -- byte-array/f ) + check-closed + >r 0 max >integer r> read-step ; + : read-loop ( count port accum -- ) pick over length - dup 0 > [ pick read-step dup [ @@ -117,9 +103,10 @@ M: input-port stream-read ] [ 2nip ] if ] [ 2nip ] if ; -M: input-port stream-read-partial ( max stream -- byte-array/f ) - check-closed - >r 0 max >fixnum r> read-step ; +TUPLE: output-port < buffered-port ; + +: ( handle -- output-port ) + output-port ; : can-write? ( len buffer -- ? ) [ buffer-fill + ] keep buffer-capacity <= ; @@ -143,7 +130,10 @@ M: output-port stream-write [ buffer>> >buffer ] 2bi ] if ; -HOOK: flush-port io-backend ( port -- ) +HOOK: (wait-to-write) io-backend ( port -- ) + +: flush-port ( port -- ) + dup buffer>> buffer-empty? [ drop ] [ (wait-to-write) ] if ; M: output-port stream-flush ( port -- ) check-closed @@ -154,35 +144,23 @@ GENERIC: close-port ( port -- ) M: output-port close-port [ flush-port ] [ call-next-method ] bi ; +M: buffered-port close-port + [ call-next-method ] + [ [ [ buffer-free ] when* f ] change-buffer drop ] + bi ; + +HOOK: cancel-io io-backend ( port -- ) + +M: port timed-out cancel-io ; + M: port close-port - dup cancel-io - dup handle>> close-handle - [ [ buffer-free ] when* f ] change-buffer drop ; + [ cancel-io ] [ handle>> close-handle ] bi ; M: port dispose dup closed>> [ drop ] [ t >>closed close-port ] if ; -TUPLE: server-port < port addr client client-addr encoding ; - -: ( handle addr encoding -- server ) - rot server-port - swap >>encoding - swap >>addr ; - -: check-server-port ( port -- port ) - dup server-port? [ "Not a server port" throw ] unless ; inline - -TUPLE: datagram-port < port addr packet packet-addr ; - -: ( handle addr -- datagram ) - swap datagram-port - swap >>addr ; - -: check-datagram-port ( port -- port ) - check-closed - dup datagram-port? [ "Not a datagram port" throw ] unless ; inline - -: check-datagram-send ( packet addrspec port -- packet addrspec port ) - check-datagram-port - 2dup addr>> [ class ] bi@ assert= - pick class byte-array assert= ; +: ( read-handle write-handle -- input-port output-port ) + [ + [ dup add-error-destructor ] + [ dup add-error-destructor ] bi* + ] with-destructors ; diff --git a/extra/io/nonblocking/summary.txt b/extra/io/ports/summary.txt similarity index 100% rename from extra/io/nonblocking/summary.txt rename to extra/io/ports/summary.txt diff --git a/extra/io/server/server-tests.factor b/extra/io/server/server-tests.factor index e1297a9839..f3ee309380 100755 --- a/extra/io/server/server-tests.factor +++ b/extra/io/server/server-tests.factor @@ -2,3 +2,4 @@ IN: io.server.tests USING: tools.test io.server io.server.private ; { 2 0 } [ [ ] server-loop ] must-infer-as +{ 2 0 } [ [ ] with-connection ] must-infer-as diff --git a/extra/io/server/server.factor b/extra/io/server/server.factor index 1d626a9e15..2bddb78206 100755 --- a/extra/io/server/server.factor +++ b/extra/io/server/server.factor @@ -12,17 +12,19 @@ SYMBOL: servers LOG: accepted-connection NOTICE -: with-client ( client addrspec quot -- ) - [ - swap accepted-connection - with-stream* - ] 2curry with-disposal ; inline +SYMBOL: remote-address -\ with-client DEBUG add-error-logging +: with-connection ( client addrspec quot -- ) + [ + >r [ remote-address set ] [ accepted-connection ] bi + r> call + ] 2curry with-stream ; inline + +\ with-connection DEBUG add-error-logging : accept-loop ( server quot -- ) [ - >r accept r> [ with-client ] 3curry "Client" spawn drop + >r accept r> [ with-connection ] 3curry "Client" spawn drop ] 2keep accept-loop ; inline : server-loop ( addrspec encoding quot -- ) diff --git a/extra/io/sockets/headers/headers.factor b/extra/io/sockets/headers/headers.factor index 2547fee5ae..7ae9265220 100755 --- a/extra/io/sockets/headers/headers.factor +++ b/extra/io/sockets/headers/headers.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.syntax byte-arrays io -io.sockets.impl kernel structs math math.parser +io.sockets kernel structs math math.parser prettyprint sequences ; IN: io.sockets.headers diff --git a/extra/io/sockets/impl/authors.txt b/extra/io/sockets/impl/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/extra/io/sockets/impl/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/extra/io/sockets/impl/impl-tests.factor b/extra/io/sockets/impl/impl-tests.factor deleted file mode 100644 index 6b930a994e..0000000000 --- a/extra/io/sockets/impl/impl-tests.factor +++ /dev/null @@ -1,45 +0,0 @@ -USING: io.sockets.impl io.sockets kernel tools.test ; -IN: io.sockets.impl.tests - -[ B{ 1 2 3 4 } ] -[ "1.2.3.4" T{ inet4 } inet-pton ] unit-test - -[ "1.2.3.4" ] -[ B{ 1 2 3 4 } T{ inet4 } inet-ntop ] unit-test - -[ "255.255.255.255" ] -[ B{ 255 255 255 255 } T{ inet4 } inet-ntop ] unit-test - -[ B{ 255 255 255 255 } ] -[ "255.255.255.255" T{ inet4 } inet-pton ] unit-test - -[ B{ 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 } ] -[ "1:2:3:4:5:6:7:8" T{ inet6 } inet-pton ] unit-test - -[ "1:2:3:4:5:6:7:8" ] -[ B{ 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 } T{ inet6 } inet-ntop ] unit-test - -[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } ] -[ "::" T{ inet6 } inet-pton ] unit-test - -[ "0:0:0:0:0:0:0:0" ] -[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } T{ inet6 } inet-ntop ] unit-test - -[ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } ] -[ "1::" T{ inet6 } inet-pton ] unit-test - -[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } ] -[ "::1" T{ inet6 } inet-pton ] unit-test - -[ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 2 } ] -[ "1::2" T{ inet6 } inet-pton ] unit-test - -[ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 2 0 3 } ] -[ "1::2:3" T{ inet6 } inet-pton ] unit-test - -[ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } ] -[ "1:2::3:4" T{ inet6 } inet-pton ] unit-test - -[ "1:2:0:0:0:0:3:4" ] -[ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } T{ inet6 } inet-ntop ] unit-test - diff --git a/extra/io/sockets/impl/impl.factor b/extra/io/sockets/impl/impl.factor deleted file mode 100755 index fa82080259..0000000000 --- a/extra/io/sockets/impl/impl.factor +++ /dev/null @@ -1,134 +0,0 @@ -! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov -! See http://factorcode.org/license.txt for BSD license. -USING: arrays byte-arrays io.backend io.binary io.sockets -io.encodings.ascii kernel math math.parser sequences splitting -system alien.c-types alien.strings alien combinators namespaces -parser ; -IN: io.sockets.impl - -<< { - { [ os windows? ] [ "windows.winsock" ] } - { [ os unix? ] [ "unix" ] } -} cond use+ >> - -GENERIC: protocol-family ( addrspec -- af ) - -GENERIC: sockaddr-type ( addrspec -- type ) - -GENERIC: make-sockaddr ( addrspec -- sockaddr ) - -: make-sockaddr/size ( addrspec -- sockaddr size ) - dup make-sockaddr swap sockaddr-type heap-size ; - -GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec ) - -HOOK: addrinfo-error io-backend ( n -- ) - -! IPV4 and IPV6 -GENERIC: address-size ( addrspec -- n ) - -GENERIC: inet-ntop ( data addrspec -- str ) - -GENERIC: inet-pton ( str addrspec -- data ) - - -M: inet4 inet-ntop ( data addrspec -- str ) - drop 4 memory>byte-array [ number>string ] { } map-as "." join ; - -M: inet4 inet-pton ( str addrspec -- data ) - drop "." split [ string>number ] B{ } map-as ; - -M: inet4 address-size drop 4 ; - -M: inet4 protocol-family drop PF_INET ; - -M: inet4 sockaddr-type drop "sockaddr-in" c-type ; - -M: inet4 make-sockaddr ( inet -- sockaddr ) - "sockaddr-in" - AF_INET over set-sockaddr-in-family - over inet4-port htons over set-sockaddr-in-port - over inet4-host - "0.0.0.0" or - rot inet-pton *uint over set-sockaddr-in-addr ; - -SYMBOL: port-override - -: (port) port-override get swap or ; - -M: inet4 parse-sockaddr - >r dup sockaddr-in-addr r> inet-ntop - swap sockaddr-in-port ntohs (port) ; - -M: inet6 inet-ntop ( data addrspec -- str ) - drop 16 memory>byte-array 2 [ be> >hex ] map ":" join ; - -M: inet6 inet-pton ( str addrspec -- data ) - drop "::" split1 - [ [ ":" split [ hex> dup 0 ? ] map ] [ f ] if* ] bi@ - 2dup [ length ] bi@ + 8 swap - 0 swap 3append - [ 2 >be ] map concat >byte-array ; - -M: inet6 address-size drop 16 ; - -M: inet6 protocol-family drop PF_INET6 ; - -M: inet6 sockaddr-type drop "sockaddr-in6" c-type ; - -M: inet6 make-sockaddr ( inet -- sockaddr ) - "sockaddr-in6" - AF_INET6 over set-sockaddr-in6-family - over inet6-port htons over set-sockaddr-in6-port - over inet6-host "::" or - rot inet-pton over set-sockaddr-in6-addr ; - -M: inet6 parse-sockaddr - >r dup sockaddr-in6-addr r> inet-ntop - swap sockaddr-in6-port ntohs (port) ; - -: addrspec-of-family ( af -- addrspec ) - { - { [ dup AF_INET = ] [ T{ inet4 } ] } - { [ dup AF_INET6 = ] [ T{ inet6 } ] } - { [ dup AF_UNIX = ] [ T{ local } ] } - [ f ] - } cond nip ; - -M: f parse-sockaddr nip ; - -: addrinfo>addrspec ( addrinfo -- addrspec ) - [ addrinfo-addr ] [ addrinfo-family addrspec-of-family ] bi - parse-sockaddr ; - -: parse-addrinfo-list ( addrinfo -- seq ) - [ addrinfo-next ] follow - [ addrinfo>addrspec ] map - [ ] filter ; - -: prepare-resolve-host ( host serv passive? -- host' serv' flags ) - #! If the port is a number, we resolve for 'http' then - #! change it later. This is a workaround for a FreeBSD - #! getaddrinfo() limitation -- on Windows, Linux and Mac, - #! we can convert a number to a string and pass that as the - #! service name, but on FreeBSD this gives us an unknown - #! service error. - >r - dup integer? [ port-override set "http" ] when - r> AI_PASSIVE 0 ? ; - -M: object resolve-host ( host serv passive? -- seq ) - [ - prepare-resolve-host - "addrinfo" - [ set-addrinfo-flags ] keep - PF_UNSPEC over set-addrinfo-family - IPPROTO_TCP over set-addrinfo-protocol - f [ getaddrinfo addrinfo-error ] keep *void* - [ parse-addrinfo-list ] keep - freeaddrinfo - ] with-scope ; - -M: object host-name ( -- name ) - 256 dup dup length gethostname - zero? [ "gethostname failed" throw ] unless - ascii alien>string ; diff --git a/extra/io/sockets/sockets-docs.factor b/extra/io/sockets/sockets-docs.factor index ee3cb3aa7b..2061a123de 100755 --- a/extra/io/sockets/sockets-docs.factor +++ b/extra/io/sockets/sockets-docs.factor @@ -64,7 +64,7 @@ HELP: local } ; HELP: inet -{ $class-description "Host name/port number specifier for TCP/IP and UDP/IP connections. The " { $link inet-host } " and " { $link inet-port } " slots hold the host name and port name or number, respectively. New instances are created by calling " { $link } "." } +{ $class-description "Host name/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the host name and port name or number, respectively. New instances are created by calling " { $link } "." } { $notes "This address specifier is only supported by " { $link } ", which calls " { $link resolve-host } " to obtain a list of IP addresses associated with the host name, and attempts a connection to each one in turn until one succeeds. Other network words do not accept this address specifier, and " { $link resolve-host } " must be called directly; it is then up to the application to pick the correct address from the (possibly several) addresses associated to the host name." } @@ -74,7 +74,7 @@ HELP: inet } ; HELP: inet4 -{ $class-description "IPv4 address/port number specifier for TCP/IP and UDP/IP connections. The " { $link inet4-host } " and " { $link inet4-port } " slots hold the IPv4 address and port number, respectively. New instances are created by calling " { $link } "." } +{ $class-description "IPv4 address/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the IPv4 address and port number, respectively. New instances are created by calling " { $link } "." } { $notes "New instances should not be created directly; instead, use " { $link resolve-host } " to look up the address associated to a host name. Also, try to support IPv6 where possible." } @@ -83,7 +83,7 @@ HELP: inet4 } ; HELP: inet6 -{ $class-description "IPv6 address/port number specifier for TCP/IP and UDP/IP connections. The " { $link inet6-host } " and " { $link inet6-port } " slots hold the IPv6 address and port number, respectively. New instances are created by calling " { $link } "." } +{ $class-description "IPv6 address/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the IPv6 address and port number, respectively. New instances are created by calling " { $link } "." } { $notes "New instances should not be created directly; instead, use " { $link resolve-host } " to look up the address associated to a host name." } { $examples @@ -91,13 +91,19 @@ HELP: inet6 } ; HELP: -{ $values { "addrspec" "an address specifier" } { "encoding" "an encding descriptor" } { "stream" "a bidirectional stream" } } -{ $description "Opens a network connection and outputs a bidirectional stream using the given encoding." } +{ $values { "remote" "an address specifier" } { "encoding" "an encding descriptor" } { "stream" "a bidirectional stream" } { "local" "an address specifier" } } +{ $description "Opens a network connection and outputs a bidirectional stream using the given encoding, together with the local address the socket was bound to." } { $errors "Throws an error if the connection cannot be established." } +{ $notes "The " { $link with-client } " word is easier to use in most situations." } { $examples { $code "\"www.apple.com\" \"http\" utf8 " } } ; +HELP: with-client +{ $values { "remote" "an address specifier" } { "encoding" "an encding descriptor" } { "quot" quotation } } +{ $description "Opens a network connection and calls the quotation in a new dynamic scope with " { $link input-stream } " and " { $link output-stream } " rebound to the network streams. The local address the socket is bound to is stored in the " { $link local-address } " variable." } +{ $errors "Throws an error if the connection cannot be established." } ; + HELP: { $values { "addrspec" "an address specifier" } { "encoding" "an encoding descriptor" } { "server" "a handle" } } { $description @@ -113,6 +119,13 @@ HELP: "To start a server which listens for connections from the loopback interface only, use an address specifier returned by the following code, where 1234 is the desired port number:" { $code "\"localhost\" 1234 t resolve-host" } "Since " { $link resolve-host } " can return multiple address specifiers, your server code must listen on them all to work properly. The " { $vocab-link "io.server" } " vocabulary can be used to help with this." + $nl + "To start a TCP/IP server which listens for connections on a randomly-assigned port, set the port number in the address specifier to 0, and then read the " { $snippet "addr" } " slot of the server instance to obtain the actual port number it is listening on:" + { $unchecked-example + "f 0 ascii " + "[ addr>> . ] [ dispose ] bi" + "T{ inet4 f \"0.0.0.0\" 58901 }" + } } { $errors "Throws an error if the address is already in use, or if it if the system forbids access." } ; diff --git a/extra/io/sockets/sockets-tests.factor b/extra/io/sockets/sockets-tests.factor index 1810b8587b..b4dd910004 100644 --- a/extra/io/sockets/sockets-tests.factor +++ b/extra/io/sockets/sockets-tests.factor @@ -1,4 +1,46 @@ IN: io.sockets.tests USING: io.sockets sequences math tools.test ; +[ B{ 1 2 3 4 } ] +[ "1.2.3.4" T{ inet4 } inet-pton ] unit-test + +[ "1.2.3.4" ] +[ B{ 1 2 3 4 } T{ inet4 } inet-ntop ] unit-test + +[ "255.255.255.255" ] +[ B{ 255 255 255 255 } T{ inet4 } inet-ntop ] unit-test + +[ B{ 255 255 255 255 } ] +[ "255.255.255.255" T{ inet4 } inet-pton ] unit-test + +[ B{ 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 } ] +[ "1:2:3:4:5:6:7:8" T{ inet6 } inet-pton ] unit-test + +[ "1:2:3:4:5:6:7:8" ] +[ B{ 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 } T{ inet6 } inet-ntop ] unit-test + +[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } ] +[ "::" T{ inet6 } inet-pton ] unit-test + +[ "0:0:0:0:0:0:0:0" ] +[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } T{ inet6 } inet-ntop ] unit-test + +[ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } ] +[ "1::" T{ inet6 } inet-pton ] unit-test + +[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } ] +[ "::1" T{ inet6 } inet-pton ] unit-test + +[ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 2 } ] +[ "1::2" T{ inet6 } inet-pton ] unit-test + +[ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 2 0 3 } ] +[ "1::2:3" T{ inet6 } inet-pton ] unit-test + +[ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } ] +[ "1:2::3:4" T{ inet6 } inet-pton ] unit-test + +[ "1:2:0:0:0:0:3:4" ] +[ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } T{ inet6 } inet-ntop ] unit-test + [ t ] [ "localhost" 80 f resolve-host length 1 >= ] unit-test diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 7b0f55cab7..971ad95e5e 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -1,10 +1,39 @@ -! Copyright (C) 2007, 2008 Slava Pestov, Daniel Ehrenberg. +! Copyright (C) 2007, 2008 Slava Pestov, Doug Coleman, +! Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: generic kernel io.backend namespaces continuations -sequences arrays io.encodings io.nonblocking io.streams.duplex -accessors destructors ; +sequences arrays io.encodings io.ports io.streams.duplex +io.encodings.ascii alien.strings io.binary accessors destructors +classes debugger byte-arrays system combinators parser +alien.c-types math.parser splitting math assocs inspector ; IN: io.sockets +<< { + { [ os windows? ] [ "windows.winsock" ] } + { [ os unix? ] [ "unix" ] } +} cond use+ >> + +! Addressing +GENERIC: protocol-family ( addrspec -- af ) + +GENERIC: sockaddr-type ( addrspec -- type ) + +GENERIC: make-sockaddr ( addrspec -- sockaddr ) + +GENERIC: address-size ( addrspec -- n ) + +GENERIC: inet-ntop ( data addrspec -- str ) + +GENERIC: inet-pton ( str addrspec -- data ) + +: make-sockaddr/size ( addrspec -- sockaddr size ) + dup make-sockaddr swap sockaddr-type heap-size ; + +: empty-sockaddr/size ( addrspec -- sockaddr len ) + sockaddr-type [ ] [ heap-size ] bi ; + +GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec ) + TUPLE: local path ; : ( path -- addrspec ) @@ -14,59 +43,248 @@ TUPLE: inet4 host port ; C: inet4 +M: inet4 inet-ntop ( data addrspec -- str ) + drop 4 memory>byte-array [ number>string ] { } map-as "." join ; + +ERROR: invalid-inet4 string reason ; + +M: invalid-inet4 summary drop "Invalid IPv4 address" ; + +M: inet4 inet-pton ( str addrspec -- data ) + drop + [ + "." split dup length 4 = [ + "Must have four components" throw + ] unless + [ + string>number + [ "Dotted component not a number" throw ] unless* + ] B{ } map-as + ] [ invalid-inet4 ] recover ; + +M: inet4 address-size drop 4 ; + +M: inet4 protocol-family drop PF_INET ; + +M: inet4 sockaddr-type drop "sockaddr-in" c-type ; + +M: inet4 make-sockaddr ( inet -- sockaddr ) + "sockaddr-in" + AF_INET over set-sockaddr-in-family + over inet4-port htons over set-sockaddr-in-port + over inet4-host + "0.0.0.0" or + rot inet-pton *uint over set-sockaddr-in-addr ; + + + +M: inet4 parse-sockaddr + >r dup sockaddr-in-addr r> inet-ntop + swap sockaddr-in-port ntohs (port) ; + TUPLE: inet6 host port ; C: inet6 +M: inet6 inet-ntop ( data addrspec -- str ) + drop 16 memory>byte-array 2 [ be> >hex ] map ":" join ; + +ERROR: invalid-inet6 string reason ; + +M: invalid-inet6 summary drop "Invalid IPv6 address" ; + + [ "Component not a number" throw ] unless* + ] B{ } map-as + ] if ; + +: pad-inet6 ( string1 string2 -- seq ) + 2dup [ length ] bi@ + 8 swap - + dup 0 < [ "More than 8 components" throw ] when + swap 3append ; + +: inet6-bytes ( seq -- bytes ) + [ 2 >be ] { } map-as concat >byte-array ; + +PRIVATE> + +M: inet6 inet-pton ( str addrspec -- data ) + drop + [ + "::" split1 [ parse-inet6 ] bi@ pad-inet6 inet6-bytes + ] [ invalid-inet6 ] recover ; + +M: inet6 address-size drop 16 ; + +M: inet6 protocol-family drop PF_INET6 ; + +M: inet6 sockaddr-type drop "sockaddr-in6" c-type ; + +M: inet6 make-sockaddr ( inet -- sockaddr ) + "sockaddr-in6" + AF_INET6 over set-sockaddr-in6-family + over inet6-port htons over set-sockaddr-in6-port + over inet6-host "::" or + rot inet-pton over set-sockaddr-in6-addr ; + +M: inet6 parse-sockaddr + >r dup sockaddr-in6-addr r> inet-ntop + swap sockaddr-in6-port ntohs (port) ; + +: addrspec-of-family ( af -- addrspec ) + { + { AF_INET [ T{ inet4 } ] } + { AF_INET6 [ T{ inet6 } ] } + { AF_UNIX [ T{ local } ] } + [ drop f ] + } case ; + +M: f parse-sockaddr nip ; + +GENERIC# (wait-to-connect) 1 ( client-out handle remote -- sockaddr ) + +: wait-to-connect ( client-out handle remote -- local ) + [ (wait-to-connect) ] keep parse-sockaddr ; + +GENERIC: ((client)) ( remote -- handle ) + +GENERIC: (client) ( remote -- client-in client-out local ) + +M: array (client) [ (client) 3array ] attempt-all first3 ; + +M: object (client) ( remote -- client-in client-out local ) + [ + [ + ((client)) + dup + 2dup [ add-error-destructor ] bi@ + dup dup handle>> + ] keep wait-to-connect + ] with-destructors ; + +: ( remote encoding -- stream local ) + >r (client) -rot r> swap ; + +SYMBOL: local-address + +: with-client ( addrspec encoding quot -- ) + >r [ local-address set ] curry + r> compose with-stream ; inline + +TUPLE: server-port < port addr encoding ; + +: check-server-port ( port -- port ) + check-closed + dup server-port? [ "Not a server port" throw ] unless ; inline + +GENERIC: (server) ( addrspec -- handle sockaddr ) + +: ( addrspec encoding -- server ) + >r [ (server) ] keep parse-sockaddr + swap server-port + swap >>addr + r> >>encoding ; + +HOOK: (accept) io-backend ( server -- handle sockaddr ) + +: accept ( server -- client addrspec ) + check-server-port + [ (accept) ] keep + tuck + [ [ dup ] [ encoding>> ] bi* ] + [ addr>> parse-sockaddr ] + 2bi* ; + +TUPLE: datagram-port < port addr ; + +HOOK: (datagram) io-backend ( addr -- datagram ) + +: ( addr -- datagram ) + dup (datagram) datagram-port swap >>addr ; + +: check-datagram-port ( port -- port ) + check-closed + dup datagram-port? [ "Not a datagram port" throw ] unless ; inline + +HOOK: (receive) io-backend ( datagram -- packet addrspec ) + +: receive ( datagram -- packet sockaddr ) + 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 ) + [ addrinfo-addr ] [ addrinfo-family addrspec-of-family ] bi + parse-sockaddr ; + +: parse-addrinfo-list ( addrinfo -- seq ) + [ addrinfo-next ] follow + [ addrinfo>addrspec ] map + [ ] filter ; + +: prepare-resolve-host ( host serv passive? -- host' serv' flags ) + #! If the port is a number, we resolve for 'http' then + #! change it later. This is a workaround for a FreeBSD + #! getaddrinfo() limitation -- on Windows, Linux and Mac, + #! we can convert a number to a string and pass that as the + #! service name, but on FreeBSD this gives us an unknown + #! service error. + >r + dup integer? [ port-override set "http" ] when + r> AI_PASSIVE 0 ? ; + +HOOK: addrinfo-error io-backend ( n -- ) + +: resolve-host ( host serv passive? -- seq ) + [ + prepare-resolve-host + "addrinfo" + [ set-addrinfo-flags ] keep + PF_UNSPEC over set-addrinfo-family + IPPROTO_TCP over set-addrinfo-protocol + f [ getaddrinfo addrinfo-error ] keep *void* + [ parse-addrinfo-list ] keep + freeaddrinfo + ] with-scope ; + +: host-name ( -- string ) + 256 dup dup length gethostname + zero? [ "gethostname failed" throw ] unless + ascii alien>string ; + TUPLE: inet host port ; C: inet -GENERIC: wait-to-connect ( client-out handle -- ) - -GENERIC: ((client)) ( addrspec -- handle ) - -GENERIC: (client) ( addrspec -- client-in client-out ) - -M: array (client) [ (client) 2array ] attempt-all first2 ; - -M: object (client) - [ - ((client)) - dup - 2dup [ add-error-destructor ] bi@ - dup dup handle>> wait-to-connect - ] with-destructors ; - -: ( addrspec encoding -- stream ) - >r (client) r> ; - -: with-client ( addrspec encoding quot -- ) - >r r> with-stream ; inline - -HOOK: (server) io-backend ( addrspec -- handle ) - -: ( addrspec encoding -- server ) - >r [ (server) ] keep r> ; - -HOOK: (accept) io-backend ( server -- addrspec handle ) - -: accept ( server -- client addrspec ) - [ (accept) dup ] [ encoding>> ] bi - swap ; - -HOOK: io-backend ( addrspec -- datagram ) - -HOOK: receive io-backend ( datagram -- packet addrspec ) - -HOOK: send io-backend ( packet addrspec datagram -- ) - -HOOK: resolve-host io-backend ( host serv passive? -- seq ) - -HOOK: host-name io-backend ( -- string ) - : resolve-client-addr ( inet -- seq ) [ host>> ] [ port>> ] bi f resolve-host ; M: inet (client) resolve-client-addr (client) ; + +ERROR: invalid-inet-server addrspec ; + +M: invalid-inet-server summary + drop "Cannot use with ; use or instead" ; + +M: inet (server) + invalid-inet-server ; diff --git a/extra/io/timeouts/timeouts.factor b/extra/io/timeouts/timeouts.factor index f9ffd5e98f..816bfd1b19 100755 --- a/extra/io/timeouts/timeouts.factor +++ b/extra/io/timeouts/timeouts.factor @@ -4,7 +4,6 @@ USING: kernel calendar alarms io io.encodings accessors namespaces ; IN: io.timeouts -! Won't need this with new slot accessors GENERIC: timeout ( obj -- dt/f ) GENERIC: set-timeout ( dt/f obj -- ) @@ -14,8 +13,6 @@ M: encoder set-timeout stream>> set-timeout ; GENERIC: timed-out ( obj -- ) -M: object timed-out drop ; - : queue-timeout ( obj timeout -- alarm ) >r [ timed-out ] curry r> later ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 652d4e77b3..5a21e8da68 100644 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -1,69 +1,85 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien generic assocs kernel kernel.private math -io.nonblocking sequences strings structs sbufs threads unix +io.ports sequences strings structs sbufs threads unix vectors io.buffers io.backend io.encodings math.parser continuations system libc qualified namespaces io.timeouts -io.encodings.utf8 accessors ; +io.encodings.utf8 accessors inspector combinators ; QUALIFIED: io IN: io.unix.backend ! I/O tasks -TUPLE: io-task port callbacks ; - GENERIC: handle-fd ( handle -- fd ) M: integer handle-fd ; -: io-task-fd port>> handle>> handle-fd ; - -: ( port continuation/f class -- task ) - new - swap [ 1vector ] [ V{ } clone ] if* >>callbacks - swap >>port ; inline - -TUPLE: input-task < io-task ; - -TUPLE: output-task < io-task ; - -GENERIC: do-io-task ( task -- ? ) -GENERIC: io-task-container ( mx task -- hashtable ) - ! I/O multiplexers TUPLE: mx fd reads writes ; -M: input-task io-task-container drop reads>> ; - -M: output-task io-task-container drop writes>> ; - : new-mx ( class -- obj ) new H{ } clone >>reads H{ } clone >>writes ; inline -GENERIC: register-io-task ( task mx -- ) -GENERIC: unregister-io-task ( task mx -- ) +GENERIC: add-input-callback ( thread fd mx -- ) + +: add-callback ( thread fd assoc -- ) + [ ?push ] change-at ; + +M: mx add-input-callback reads>> add-callback ; + +GENERIC: add-output-callback ( thread fd mx -- ) + +M: mx add-output-callback writes>> add-callback ; + +GENERIC: remove-input-callbacks ( fd mx -- callbacks ) + +M: mx remove-input-callbacks reads>> delete-at* drop ; + +GENERIC: remove-output-callbacks ( fd mx -- callbacks ) + +M: mx remove-output-callbacks writes>> delete-at* drop ; + GENERIC: wait-for-events ( ms mx -- ) -: fd/container ( task mx -- task fd container ) - over io-task-container >r dup io-task-fd r> ; inline +TUPLE: unix-io-error error port ; -: check-io-task ( task mx -- ) - fd/container key? nip [ - "Cannot perform multiple reads from the same port" throw - ] when ; +: report-error ( error port -- ) + tuck unix-io-error boa >>error drop ; -M: mx register-io-task ( task mx -- ) - 2dup check-io-task fd/container set-at ; +: input-available ( fd mx -- ) + remove-input-callbacks [ resume ] each ; -: add-io-task ( task -- ) - mx get-global register-io-task ; +: output-available ( fd mx -- ) + remove-output-callbacks [ resume ] each ; -: with-port-continuation ( port quot -- port ) - [ "I/O" suspend drop ] curry with-timeout ; inline +TUPLE: io-timeout ; -M: mx unregister-io-task ( task mx -- ) - fd/container delete-at drop ; +M: io-timeout summary drop "I/O operation timed out" ; + +M: unix cancel-io ( port -- ) + io-timeout new over report-error + handle>> handle-fd mx get-global + [ input-available ] [ output-available ] 2bi ; + +SYMBOL: +retry+ ! just try the operation again without blocking +SYMBOL: +input+ +SYMBOL: +output+ + +: wait-for-port ( port event -- ) + dup +retry+ eq? [ 2drop ] [ + [ + [ + >r + swap handle>> handle-fd + mx get-global + r> { + { +input+ [ add-input-callback ] } + { +output+ [ add-output-callback ] } + } case + ] curry "I/O" suspend drop + ] curry with-timeout pending-error + ] if ; ! Some general stuff : file-mode OCT: 0666 ; @@ -88,43 +104,8 @@ M: integer init-handle ( fd -- ) M: integer close-handle ( fd -- ) close ; -TUPLE: unix-io-error error port ; - -: report-error ( error port -- ) - tuck unix-io-error boa >>error drop ; - -: ignorable-error? ( n -- ? ) - [ EAGAIN number= ] [ EINTR number= ] bi or ; - -: defer-error ( port -- ? ) - #! Return t if it is an unrecoverable error. - err_no dup ignorable-error? - [ 2drop f ] [ strerror swap report-error t ] if ; - -: pop-callbacks ( mx task -- ) - dup rot unregister-io-task - io-task-callbacks [ resume ] each ; - -: perform-io-task ( mx task -- ) - dup do-io-task [ pop-callbacks ] [ 2drop ] if ; - -: handle-timeout ( port mx assoc -- ) - >r swap port-handle r> delete-at* [ - "I/O operation cancelled" over port>> report-error - pop-callbacks - ] [ - 2drop - ] if ; - -: cancel-io-tasks ( port mx -- ) - [ dup reads>> handle-timeout ] - [ dup writes>> handle-timeout ] 2bi ; - -M: unix cancel-io ( port -- ) - mx get-global cancel-io-tasks ; - ! Readers -: reader-eof ( reader -- ) +: eof ( reader -- ) dup buffer>> buffer-empty? [ t >>eof ] when drop ; : (refill) ( port -- n ) @@ -132,62 +113,42 @@ M: unix cancel-io ( port -- ) [ buffer>> buffer-end ] [ buffer>> buffer-capacity ] tri read ; -GENERIC: refill ( port handle -- ? ) +! Returns an event to wait for which will ensure completion of +! this request +GENERIC: refill ( port handle -- event/f ) M: integer refill - #! Return f if there is a recoverable error - drop - dup buffer>> buffer-empty? [ - dup (refill) dup 0 >= [ - swap buffer>> n>buffer t - ] [ - drop defer-error - ] if - ] [ drop t ] if ; + over buffer>> [ buffer-end ] [ buffer-capacity ] bi read + { + { [ dup 0 = ] [ drop eof f ] } + { [ dup 0 > ] [ swap buffer>> n>buffer f ] } + { [ err_no EINTR = ] [ 2drop +retry+ ] } + { [ err_no EAGAIN = ] [ 2drop +input+ ] } + [ (io-error) ] + } cond ; -TUPLE: read-task < input-task ; - -: ( port continuation -- task ) read-task ; - -M: read-task do-io-task - port>> dup dup handle>> refill - [ [ reader-eof ] [ drop ] if ] keep ; - -M: unix (wait-to-read) - [ add-io-task ] with-port-continuation - pending-error ; +M: unix (wait-to-read) ( port -- ) + dup dup handle>> refill dup + [ dupd wait-for-port (wait-to-read) ] [ 2drop ] if ; ! Writers -GENERIC: drain ( port handle -- ? ) +GENERIC: drain ( port handle -- event/f ) M: integer drain - drop - dup - [ handle>> ] - [ buffer>> buffer@ ] - [ buffer>> buffer-length ] tri - write dup 0 >= - [ swap buffer>> buffer-consume f ] - [ drop defer-error ] if ; + over buffer>> [ buffer@ ] [ buffer-length ] bi write + { + { [ dup 0 >= ] [ + over buffer>> buffer-consume + buffer>> buffer-empty? f +output+ ? + ] } + { [ err_no EINTR = ] [ 2drop +retry+ ] } + { [ err_no EAGAIN = ] [ 2drop +output+ ] } + [ (io-error) ] + } cond ; -TUPLE: write-task < output-task ; - -: ( port continuation -- task ) write-task ; - -M: write-task do-io-task - io-task-port dup [ buffer>> buffer-empty? ] [ port-error ] bi or - [ 0 swap buffer>> buffer-reset t ] [ dup handle>> drain ] if ; - -: add-write-io-task ( port continuation -- ) - over handle>> mx get-global writes>> at* - [ io-task-callbacks push drop ] - [ drop add-io-task ] if ; - -: (wait-to-write) ( port -- ) - [ add-write-io-task ] with-port-continuation drop ; - -M: unix flush-port ( port -- ) - dup buffer>> buffer-empty? [ drop ] [ (wait-to-write) ] if ; +M: unix (wait-to-write) ( port -- ) + dup dup handle>> drain dup + [ dupd wait-for-port (wait-to-write) ] [ 2drop ] if ; M: unix io-multiplex ( ms/f -- ) mx get-global wait-for-events ; @@ -203,16 +164,10 @@ TUPLE: mx-port < port mx ; : ( mx -- port ) dup fd>> mx-port swap >>mx ; -TUPLE: mx-task < io-task ; - -: ( port -- task ) - f mx-task ; - -M: mx-task do-io-task - port>> mx>> 0 swap wait-for-events f ; - : multiplexer-error ( n -- ) - 0 < [ err_no ignorable-error? [ (io-error) ] unless ] when ; + 0 < [ + err_no [ EAGAIN = ] [ EINTR = ] bi or [ (io-error) ] unless + ] when ; : ?flag ( n mask symbol -- n ) pick rot bitand 0 > [ , ] [ drop ] if ; diff --git a/extra/io/unix/bsd/bsd.factor b/extra/io/unix/bsd/bsd.factor index d74c355642..c8219a9f63 100755 --- a/extra/io/unix/bsd/bsd.factor +++ b/extra/io/unix/bsd/bsd.factor @@ -3,16 +3,16 @@ IN: io.unix.bsd USING: namespaces system kernel accessors assocs continuations unix -io.backend io.unix.backend io.unix.select io.unix.kqueue io.monitors ; +io.backend io.unix.backend io.unix.select io.monitors ; M: bsd init-io ( -- ) - mx set-global - kqueue-mx set-global - kqueue-mx get-global - dup io-task-fd - [ mx get-global reads>> set-at ] - [ mx get-global writes>> set-at ] 2bi ; + mx set-global ; +! kqueue-mx set-global +! kqueue-mx get-global +! dup io-task-fd +! [ mx get-global reads>> set-at ] +! [ mx get-global writes>> set-at ] 2bi ; -M: bsd (monitor) ( path recursive? mailbox -- ) - swap [ "Recursive kqueue monitors not supported" throw ] when - ; +! M: bsd (monitor) ( path recursive? mailbox -- ) +! swap [ "Recursive kqueue monitors not supported" throw ] when +! ; diff --git a/extra/io/unix/epoll/epoll.factor b/extra/io/unix/epoll/epoll.factor index f34a4c7009..406a7fcb50 100644 --- a/extra/io/unix/epoll/epoll.factor +++ b/extra/io/unix/epoll/epoll.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types kernel io.nonblocking io.unix.backend +USING: alien.c-types kernel io.ports io.unix.backend bit-arrays sequences assocs unix unix.linux.epoll math namespaces structs ; IN: io.unix.epoll diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 835b14e66d..121cd6dec3 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io.backend io.nonblocking io.unix.backend io.files io +USING: io.backend io.ports io.unix.backend io.files io unix unix.stat unix.time kernel math continuations math.bitfields byte-arrays alien combinators calendar io.encodings.binary accessors sequences strings system diff --git a/extra/io/unix/files/unique/unique.factor b/extra/io/unix/files/unique/unique.factor index 035e6398ee..54ced6e5ce 100644 --- a/extra/io/unix/files/unique/unique.factor +++ b/extra/io/unix/files/unique/unique.factor @@ -1,4 +1,4 @@ -USING: kernel io.nonblocking io.unix.backend math.bitfields +USING: kernel io.ports io.unix.backend math.bitfields unix io.files.unique.backend system ; IN: io.unix.files.unique diff --git a/extra/io/unix/kqueue/kqueue.factor b/extra/io/unix/kqueue/kqueue.factor index ad5240e548..8888d0182f 100755 --- a/extra/io/unix/kqueue/kqueue.factor +++ b/extra/io/unix/kqueue/kqueue.factor @@ -4,7 +4,7 @@ USING: alien.c-types kernel math math.bitfields namespaces locals accessors combinators threads vectors hashtables sequences assocs continuations sets unix unix.time unix.kqueue unix.process -io.nonblocking io.unix.backend io.launcher io.unix.launcher +io.ports io.unix.backend io.launcher io.unix.launcher io.monitors ; IN: io.unix.kqueue diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 043b2bd73e..d8a0c3cfe9 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -3,7 +3,7 @@ USING: kernel namespaces math system sequences debugger continuations arrays assocs combinators alien.c-types strings threads accessors -io io.backend io.launcher io.nonblocking io.files +io io.backend io.launcher io.ports io.files io.files.private io.unix.files io.unix.backend io.unix.launcher.parser unix unix.process ; diff --git a/extra/io/unix/linux/monitors/monitors.factor b/extra/io/unix/linux/monitors/monitors.factor index 31dbe42e64..43733e8481 100644 --- a/extra/io/unix/linux/monitors/monitors.factor +++ b/extra/io/unix/linux/monitors/monitors.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel io.backend io.monitors io.monitors.recursive -io.files io.buffers io.monitors io.nonblocking io.timeouts +io.files io.buffers io.monitors io.ports io.timeouts io.unix.backend io.unix.select io.encodings.utf8 unix.linux.inotify assocs namespaces threads continuations init math math.bitfields sets alien alien.strings alien.c-types @@ -110,7 +110,7 @@ M: linux-monitor dispose ( monitor -- ) ] if ; : inotify-read-loop ( port -- ) - dup wait-to-read1 + dup wait-to-read 0 over buffer>> parse-file-notifications 0 over buffer>> buffer-reset inotify-read-loop ; diff --git a/extra/io/unix/pipes/pipes.factor b/extra/io/unix/pipes/pipes.factor index 4fc5acf634..dd7ed4a94a 100644 --- a/extra/io/unix/pipes/pipes.factor +++ b/extra/io/unix/pipes/pipes.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: system alien.c-types kernel unix math sequences -qualified io.unix.backend io.nonblocking ; +qualified io.unix.backend io.ports ; IN: io.unix.pipes QUALIFIED: io.pipes diff --git a/extra/io/unix/select/select.factor b/extra/io/unix/select/select.factor index 58b8371d89..fea5f4e9ae 100755 --- a/extra/io/unix/select/select.factor +++ b/extra/io/unix/select/select.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types kernel io.nonblocking io.unix.backend +USING: alien.c-types kernel io.ports io.unix.backend bit-arrays sequences assocs unix math namespaces structs -accessors math.order ; +accessors math.order locals ; IN: io.unix.select TUPLE: select-mx < mx read-fdset write-fdset ; @@ -21,21 +21,20 @@ TUPLE: select-mx < mx read-fdset write-fdset ; : clear-nth ( n seq -- ? ) [ nth ] [ f -rot set-nth ] 2bi ; -: check-fd ( fd task fdset mx -- ) - roll munge rot clear-nth - [ swap perform-io-task ] [ 2drop ] if ; +:: check-fd ( fd fdset mx quot -- ) + fd munge fdset clear-nth [ fd mx quot call ] when ; inline -: check-fdset ( tasks fdset mx -- ) - [ check-fd ] 2curry assoc-each ; +: check-fdset ( fds fdset mx quot -- ) + [ check-fd ] 3curry each ; inline -: init-fdset ( tasks fdset -- ) - [ >r drop t swap munge r> set-nth ] curry assoc-each ; +: init-fdset ( fds fdset -- ) + [ >r t swap munge r> set-nth ] curry each ; : read-fdset/tasks - [ reads>> ] [ read-fdset>> ] bi ; + [ reads>> keys ] [ read-fdset>> ] bi ; : write-fdset/tasks - [ writes>> ] [ write-fdset>> ] bi ; + [ writes>> keys ] [ write-fdset>> ] bi ; : max-fd ( assoc -- n ) dup assoc-empty? [ drop 0 ] [ keys supremum ] if ; @@ -45,12 +44,13 @@ TUPLE: select-mx < mx read-fdset write-fdset ; : init-fdsets ( mx -- nfds read write except ) [ num-fds ] - [ read-fdset/tasks tuck init-fdset ] - [ write-fdset/tasks tuck init-fdset ] tri + [ read-fdset/tasks [ init-fdset ] keep ] + [ write-fdset/tasks [ init-fdset ] keep ] tri f ; -M: select-mx wait-for-events ( ms mx -- ) - swap >r dup init-fdsets r> dup [ make-timeval ] when - select multiplexer-error - dup read-fdset/tasks pick check-fdset - dup write-fdset/tasks rot check-fdset ; +M:: select-mx wait-for-events ( ms mx -- ) + mx + [ init-fdsets ms dup [ make-timeval ] when select multiplexer-error ] + [ [ read-fdset/tasks ] keep [ input-available ] check-fdset ] + [ [ write-fdset/tasks ] keep [ output-available ] check-fdset ] + tri ; diff --git a/extra/io/unix/sockets/secure/secure.factor b/extra/io/unix/sockets/secure/secure.factor index e8bcd0e0f0..bb8364d58e 100644 --- a/extra/io/unix/sockets/secure/secure.factor +++ b/extra/io/unix/sockets/secure/secure.factor @@ -4,7 +4,7 @@ USING: accessors byte-arrays kernel debugger sequences namespaces math math.order combinators init alien alien.c-types alien.strings libc continuations destructors openssl openssl.libcrypto openssl.libssl -io.files io.nonblocking io.unix.backend io.unix.sockets +io.files io.ports io.unix.backend io.unix.sockets io.encodings.ascii io.buffers io.sockets io.sockets.secure unix ; IN: io.unix.sockets.secure @@ -16,64 +16,56 @@ IN: io.unix.sockets.secure M: ssl-handle handle-fd file>> ; -: syscall-error ( port r -- ) +: syscall-error ( port r -- * ) ERR_get_error dup zero? [ drop { - { -1 [ err_no strerror ] } - { 0 [ "Premature EOF" ] } + { -1 [ (io-error) ] } + { 0 [ "Premature EOF" throw ] } } case ] [ - nip (ssl-error-string) - ] if swap report-error ; + nip (ssl-error) + ] if ; : check-response ( port r -- port r n ) over handle>> handle>> over SSL_get_error ; inline ! Input ports -: report-ssl-error ( port r -- ) - drop ssl-error-string swap report-error ; - -: check-read-response ( port r -- ? ) +: check-read-response ( port r -- event ) check-response { - { SSL_ERROR_NONE [ swap buffer>> n>buffer t ] } - { SSL_ERROR_ZERO_RETURN [ drop reader-eof t ] } - { SSL_ERROR_WANT_READ [ 2drop f ] } - { SSL_ERROR_WANT_WRITE [ 2drop f ] } ! XXX - { SSL_ERROR_SYSCALL [ syscall-error t ] } - { SSL_ERROR_SSL [ report-ssl-error t ] } + { SSL_ERROR_NONE [ swap buffer>> n>buffer f ] } + { SSL_ERROR_ZERO_RETURN [ drop eof f ] } + { SSL_ERROR_WANT_READ [ 2drop +input+ ] } + { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } + { SSL_ERROR_SYSCALL [ syscall-error ] } + { SSL_ERROR_SSL [ (ssl-error) ] } } case ; M: ssl-handle refill - drop - dup buffer>> buffer-empty? [ - dup - [ handle>> handle>> ] ! ssl - [ buffer>> buffer-end ] ! buf - [ buffer>> buffer-capacity ] tri ! len - SSL_read - check-read-response - ] [ drop t ] if ; + handle>> ! ssl + over buffer>> + [ buffer-end ] ! buf + [ buffer-capacity ] bi ! len + SSL_read + check-read-response ; ! Output ports -: check-write-response ( port r -- ? ) +: check-write-response ( port r -- event ) check-response { { SSL_ERROR_NONE [ swap buffer>> buffer-consume f ] } - ! { SSL_ERROR_ZERO_RETURN [ drop reader-eof ] } ! XXX - { SSL_ERROR_WANT_READ [ 2drop f ] } ! XXX - { SSL_ERROR_WANT_WRITE [ 2drop f ] } - { SSL_ERROR_SYSCALL [ syscall-error t ] } - { SSL_ERROR_SSL [ report-ssl-error t ] } + { SSL_ERROR_WANT_READ [ 2drop +input+ ] } + { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } + { SSL_ERROR_SYSCALL [ syscall-error ] } + { SSL_ERROR_SSL [ (ssl-error) ] } } case ; M: ssl-handle drain - drop - dup - [ handle>> handle>> ] ! ssl - [ buffer>> buffer@ ] ! buf - [ buffer>> buffer-length ] tri ! len + handle>> ! ssl + over buffer>> + [ buffer@ ] ! buf + [ buffer-length ] bi ! len SSL_write check-write-response ; @@ -81,17 +73,20 @@ M: ssl-handle drain M: ssl ((client)) ( addrspec -- handle ) [ addrspec>> ((client)) ] with-destructors ; -: check-connect-response ( port r -- ? ) +: check-connect-response ( port r -- event ) check-response { - { SSL_ERROR_NONE [ 2drop t ] } - { SSL_ERROR_WANT_READ [ 2drop f ] } ! XXX - { SSL_ERROR_WANT_WRITE [ 2drop f ] } ! XXX - { SSL_ERROR_SYSCALL [ syscall-error t ] } - { SSL_ERROR_SSL [ report-ssl-error t ] } + { SSL_ERROR_NONE [ 2drop f ] } + { SSL_ERROR_WANT_READ [ 2drop +input+ ] } + { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] } + { SSL_ERROR_SYSCALL [ syscall-error ] } + { SSL_ERROR_SSL [ (ssl-error) ] } } case ; -M: ssl-handle (wait-to-connect) - handle>> ! ssl - SSL_connect - check-connect-response ; +: do-ssl-connect ( port ssl -- ) + 2dup SSL_connect check-connect-response dup + [ nip wait-for-port ] [ 3drop ] if ; + +M: ssl-handle wait-to-connect + [ file>> wait-to-connect ] + [ handle>> do-ssl-connect ] 2bi ; diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index fee4821f50..01c0736663 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -1,11 +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 -namespaces threads sequences byte-arrays io.nonblocking -io.binary io.unix.backend io.streams.duplex io.sockets.impl -io.backend io.nonblocking io.files io.files.private +namespaces threads sequences byte-arrays io.ports +io.binary io.unix.backend io.streams.duplex +io.backend io.ports io.files io.files.private io.encodings.utf8 math.parser continuations libc combinators -system accessors qualified destructors unix ; +system accessors qualified destructors unix locals ; EXCLUDE: io => read write close ; EXCLUDE: io.sockets => accept ; @@ -28,23 +28,11 @@ M: unix addrinfo-error ( n -- ) : init-client-socket ( fd -- ) SOL_SOCKET SO_OOBINLINE sockopt ; -TUPLE: connect-task < output-task ; - -: ( port continuation -- task ) - connect-task ; - -GENERIC: (wait-to-connect) ( port handle -- ? ) +: get-socket-name ( fd addrspec -- sockaddr ) + empty-sockaddr/size [ getsockname io-error ] 2keep drop ; M: integer (wait-to-connect) - f 0 write 0 < [ defer-error ] [ drop t ] if ; - -M: connect-task do-io-task - port>> dup handle>> (wait-to-connect) ; - -M: object wait-to-connect ( client-out fd -- ) - drop - [ add-io-task ] with-port-continuation - pending-error ; + >r >r +output+ wait-for-port r> r> get-socket-name ; M: object ((client)) ( addrspec -- fd ) [ protocol-family SOCK_STREAM socket-fd ] [ make-sockaddr/size ] bi @@ -56,49 +44,41 @@ M: object ((client)) ( addrspec -- fd ) : init-server-socket ( fd -- ) SOL_SOCKET SO_REUSEADDR sockopt ; -TUPLE: accept-task < input-task ; - -: ( port continuation -- task ) - accept-task ; - -: accept-sockaddr ( port -- fd sockaddr ) - [ handle>> ] [ addr>> sockaddr-type ] bi - dup [ swap heap-size accept ] keep ; inline - -: do-accept ( port fd sockaddr -- ) - swapd over addr>> parse-sockaddr >>client-addr (>>client) ; - -M: accept-task do-io-task - io-task-port dup accept-sockaddr - over 0 >= [ do-accept t ] [ 2drop defer-error ] if ; - -: wait-to-accept ( server -- ) - [ add-io-task ] with-port-continuation drop ; - : server-socket-fd ( addrspec type -- fd ) >r dup protocol-family r> socket-fd dup init-server-socket - dup rot make-sockaddr/size bind - zero? [ dup close (io-error) ] unless ; + dup rot make-sockaddr/size bind io-error ; -M: unix (server) ( addrspec -- handle ) +M: object (server) ( addrspec -- handle sockaddr ) [ - SOCK_STREAM server-socket-fd - dup 10 listen io-error + [ + SOCK_STREAM server-socket-fd + dup 10 listen io-error + dup + ] keep + get-socket-name ] with-destructors ; -M: unix (accept) ( server -- addrspec handle ) - #! Wait for a client connection. - check-server-port - [ wait-to-accept ] - [ pending-error ] - [ [ client-addr>> ] [ client>> ] bi ] tri ; +: do-accept ( server -- fd sockaddr ) + [ handle>> ] [ addr>> empty-sockaddr/size ] bi + [ accept ] 2keep drop ; inline + +M: unix (accept) ( server -- fd sockaddr ) + dup do-accept + { + { [ over 0 >= ] [ rot drop ] } + { [ err_no EINTR = ] [ 2drop do-accept ] } + { [ err_no EAGAIN = ] [ + 2drop + [ +input+ wait-for-port ] + [ do-accept ] bi + ] } + [ (io-error) ] + } cond ; ! Datagram sockets - UDP and Unix domain -M: unix - [ - [ SOCK_DGRAM server-socket-fd ] keep - ] with-destructors ; +M: unix (datagram) + [ SOCK_DGRAM server-socket-fd ] with-destructors ; SYMBOL: receive-buffer @@ -106,76 +86,45 @@ SYMBOL: receive-buffer packet-size receive-buffer set-global -: setup-receive ( port -- s buffer len flags from fromlen ) - dup port-handle - swap datagram-port-addr sockaddr-type - dup swap heap-size - >r >r receive-buffer get-global packet-size 0 r> r> ; +:: do-receive ( port -- packet sockaddr ) + port addr>> empty-sockaddr/size [| sockaddr len | + port handle>> ! s + receive-buffer get-global ! buf + packet-size ! nbytes + 0 ! flags + sockaddr ! from + len ! fromlen + recvfrom dup 0 >= [ + receive-buffer get-global swap head sockaddr + ] [ + drop f f + ] if + ] call ; -: do-receive ( s buffer len flags from fromlen -- sockaddr data ) - over >r recvfrom r> - over -1 = [ - 2drop f f - ] [ - receive-buffer get-global - rot head +M: unix (receive) ( datagram -- packet sockaddr ) + dup do-receive dup [ rot drop ] [ + 2drop [ +input+ wait-for-port ] [ (receive) ] bi ] if ; -TUPLE: receive-task < input-task ; +:: do-send ( packet sockaddr len socket datagram -- ) + socket packet dup length 0 sockaddr len sendto + 0 < [ + err_no EINTR = [ + packet sockaddr len socket datagram do-send + ] [ + err_no EAGAIN = [ + datagram +output+ wait-for-port + packet sockaddr len socket datagram do-send + ] [ + (io-error) + ] if + ] if + ] when ; -: ( stream continuation -- task ) - receive-task ; - -M: receive-task do-io-task - io-task-port - dup setup-receive do-receive dup [ - pick set-datagram-port-packet - over datagram-port-addr parse-sockaddr - swap set-datagram-port-packet-addr - t - ] [ - 2drop defer-error - ] if ; - -: wait-receive ( stream -- ) - [ add-io-task ] with-port-continuation drop ; - -M: unix receive ( datagram -- packet addrspec ) - check-datagram-port - [ wait-receive ] - [ pending-error ] - [ [ packet>> ] [ packet-addr>> ] bi ] tri ; - -: do-send ( socket data sockaddr len -- n ) - >r >r dup length 0 r> r> sendto ; - -TUPLE: send-task < output-task packet sockaddr len ; - -: ( packet sockaddr len stream continuation -- task ) - send-task [ - { - set-send-task-packet - set-send-task-sockaddr - set-send-task-len - } set-slots - ] keep ; - -M: send-task do-io-task - [ io-task-port port-handle ] keep - [ send-task-packet ] keep - [ send-task-sockaddr ] keep - [ send-task-len do-send ] keep - swap 0 < [ io-task-port defer-error ] [ drop t ] if ; - -: wait-send ( packet sockaddr len stream -- ) - [ add-io-task ] with-port-continuation - 2drop 2drop ; - -M: unix send ( packet addrspec datagram -- ) - check-datagram-send - [ >r make-sockaddr/size r> wait-send ] keep - pending-error ; +M: unix (send) ( packet addrspec datagram -- ) + [ make-sockaddr/size ] [ [ handle>> ] keep ] bi* do-send ; +! Unix domain sockets M: local protocol-family drop PF_UNIX ; M: local sockaddr-type drop "sockaddr-un" c-type ; diff --git a/extra/io/windows/ce/backend/backend.factor b/extra/io/windows/ce/backend/backend.factor index 46564f2aec..7209a68ebf 100755 --- a/extra/io/windows/ce/backend/backend.factor +++ b/extra/io/windows/ce/backend/backend.factor @@ -1,4 +1,4 @@ -USING: io.nonblocking io.windows threads.private kernel +USING: io.ports io.windows threads.private kernel io.backend windows.winsock windows.kernel32 windows io.streams.duplex io namespaces alien.syntax system combinators io.buffers io.encodings io.encodings.utf8 combinators.lib ; diff --git a/extra/io/windows/ce/files/files.factor b/extra/io/windows/ce/files/files.factor index 8f7390aa7c..83d456832b 100755 --- a/extra/io/windows/ce/files/files.factor +++ b/extra/io/windows/ce/files/files.factor @@ -1,5 +1,5 @@ USING: alien alien.c-types combinators io io.backend io.buffers -io.files io.nonblocking io.windows kernel libc math namespaces +io.files io.ports io.windows kernel libc math namespaces prettyprint sequences strings threads threads.private windows windows.kernel32 io.windows.ce.backend system ; IN: windows.ce.files diff --git a/extra/io/windows/ce/sockets/sockets.factor b/extra/io/windows/ce/sockets/sockets.factor index 45c10ea258..b3117dcde1 100755 --- a/extra/io/windows/ce/sockets/sockets.factor +++ b/extra/io/windows/ce/sockets/sockets.factor @@ -1,5 +1,5 @@ USING: alien alien.c-types combinators io io.backend io.buffers -io.nonblocking io.sockets io.sockets.impl io.windows kernel libc +io.ports io.sockets io.windows kernel libc math namespaces prettyprint qualified sequences strings threads threads.private windows windows.kernel32 io.windows.ce.backend byte-arrays system ; @@ -41,7 +41,6 @@ M: wince (server) ( addrspec -- handle ) M: wince (accept) ( server -- client ) [ - dup check-server-port [ dup port-handle win32-file-handle swap server-port-addr sockaddr-type heap-size diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 8a15a57f83..d83c789d36 100755 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -3,7 +3,7 @@ USING: alien.c-types io.backend io.files io.windows kernel math windows windows.kernel32 windows.time calendar combinators math.functions sequences namespaces words symbols system -combinators.lib io.nonblocking destructors math.bitfields.lib ; +combinators.lib io.ports destructors math.bitfields.lib ; IN: io.windows.files SYMBOLS: +read-only+ +hidden+ +system+ diff --git a/extra/io/windows/files/unique/unique.factor b/extra/io/windows/files/unique/unique.factor index 0449980286..2c166373e7 100644 --- a/extra/io/windows/files/unique/unique.factor +++ b/extra/io/windows/files/unique/unique.factor @@ -1,5 +1,5 @@ USING: kernel system io.files.unique.backend -windows.kernel32 io.windows io.nonblocking windows ; +windows.kernel32 io.windows io.ports windows ; IN: io.windows.files.unique M: windows (make-unique-file) ( path -- ) diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index a5d7338cd6..28e7e241e5 100755 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types arrays continuations io -io.windows io.windows.nt.pipes libc io.nonblocking +io.windows io.windows.nt.pipes libc io.ports windows.types math windows.kernel32 namespaces io.launcher kernel sequences windows.errors splitting system threads init strings combinators diff --git a/extra/io/windows/mmap/mmap.factor b/extra/io/windows/mmap/mmap.factor index dc29405b12..b401ed5556 100755 --- a/extra/io/windows/mmap/mmap.factor +++ b/extra/io/windows/mmap/mmap.factor @@ -1,5 +1,5 @@ USING: alien alien.c-types alien.syntax arrays continuations -destructors generic io.mmap io.nonblocking io.windows +destructors generic io.mmap io.ports io.windows kernel libc math namespaces quotations sequences windows windows.advapi32 windows.kernel32 io.backend system ; IN: io.windows.mmap diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor index fe7f1ecc61..99364f832d 100755 --- a/extra/io/windows/nt/backend/backend.factor +++ b/extra/io/windows/nt/backend/backend.factor @@ -1,5 +1,5 @@ USING: alien alien.c-types arrays assocs combinators -continuations destructors io io.backend io.nonblocking +continuations destructors io io.backend io.ports io.windows libc kernel math namespaces sequences threads classes.tuple.lib windows windows.errors windows.kernel32 strings splitting io.files qualified ascii diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 12fad1a2d0..2b3021a3f1 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -1,5 +1,5 @@ USING: continuations destructors io.buffers io.files io.backend -io.timeouts io.nonblocking io.windows io.windows.nt.backend +io.timeouts io.ports io.windows io.windows.nt.backend kernel libc math threads windows windows.kernel32 system alien.c-types alien.arrays alien.strings sequences combinators combinators.lib sequences.lib ascii splitting alien strings diff --git a/extra/io/windows/nt/launcher/launcher.factor b/extra/io/windows/nt/launcher/launcher.factor index 39edd931b1..c18523e68d 100755 --- a/extra/io/windows/nt/launcher/launcher.factor +++ b/extra/io/windows/nt/launcher/launcher.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types arrays continuations destructors io -io.windows libc io.nonblocking io.pipes windows.types +io.windows libc io.ports io.pipes windows.types math windows.kernel32 windows namespaces io.launcher kernel sequences windows.errors assocs splitting system strings io.windows.launcher io.windows.nt.pipes io.backend io.files diff --git a/extra/io/windows/nt/monitors/monitors.factor b/extra/io/windows/nt/monitors/monitors.factor index 37784c673c..ee8c6c60e1 100755 --- a/extra/io/windows/nt/monitors/monitors.factor +++ b/extra/io/windows/nt/monitors/monitors.factor @@ -5,7 +5,7 @@ kernel math assocs namespaces continuations sequences hashtables sorting arrays combinators math.bitfields strings system accessors threads splitting io.backend io.windows io.windows.nt.backend io.windows.nt.files -io.monitors io.nonblocking io.buffers io.files io.timeouts io +io.monitors io.ports io.buffers io.files io.timeouts io windows windows.kernel32 windows.types ; IN: io.windows.nt.monitors diff --git a/extra/io/windows/nt/pipes/pipes.factor b/extra/io/windows/nt/pipes/pipes.factor index aa565b52e8..8a0fa05b74 100755 --- a/extra/io/windows/nt/pipes/pipes.factor +++ b/extra/io/windows/nt/pipes/pipes.factor @@ -3,7 +3,7 @@ USING: alien alien.c-types arrays destructors io io.windows libc windows.types math.bitfields windows.kernel32 windows namespaces kernel sequences windows.errors assocs math.parser system random -combinators accessors io.pipes io.nonblocking ; +combinators accessors io.pipes io.ports ; IN: io.windows.nt.pipes ! This code is based on diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index 89e1ea3277..5baa0a31e5 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -1,6 +1,6 @@ USING: alien alien.accessors alien.c-types byte-arrays -continuations destructors io.nonblocking io.timeouts io.sockets -io.sockets.impl io namespaces io.streams.duplex io.windows +continuations destructors io.ports io.timeouts io.sockets +io.sockets io namespaces io.streams.duplex io.windows io.windows.nt.backend windows.winsock kernel libc math sequences threads classes.tuple.lib system accessors ; IN: io.windows.nt.sockets @@ -125,7 +125,6 @@ TUPLE: AcceptEx-args port M: winnt (accept) ( server -- addrspec handle ) [ [ - check-server-port \ AcceptEx-args new [ init-accept ] keep [ ((accept)) ] keep @@ -141,13 +140,11 @@ M: winnt (server) ( addrspec -- handle ) f ] with-destructors ; -M: winnt ( addrspec -- datagram ) +M: winnt (datagram) ( addrspec -- handle ) [ - [ - SOCK_DGRAM server-fd - dup add-completion - f - ] keep + SOCK_DGRAM server-fd + dup add-completion + f ] with-destructors ; TUPLE: WSARecvFrom-args port diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 6f793bc939..5c0a1c8ecf 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types arrays destructors io io.backend -io.buffers io.files io.nonblocking io.sockets io.binary -io.sockets.impl windows.errors strings +io.buffers io.files io.ports io.sockets io.binary +io.sockets windows.errors strings kernel math namespaces sequences windows windows.kernel32 windows.shell32 windows.types windows.winsock splitting continuations math.bitfields system accessors ; diff --git a/extra/openssl/openssl.factor b/extra/openssl/openssl.factor index 3b58a606a0..41e413c966 100755 --- a/extra/openssl/openssl.factor +++ b/extra/openssl/openssl.factor @@ -5,7 +5,7 @@ math.order combinators init alien alien.c-types alien.strings libc continuations destructors debugger inspector locals unicode.case openssl.libcrypto openssl.libssl -io.nonblocking io.files io.encodings.ascii io.sockets.secure ; +io.ports io.files io.encodings.ascii io.sockets.secure ; IN: openssl ! This code is based on http://www.rtfm.com/openssl-examples/ @@ -25,8 +25,11 @@ M: TLSv1 ssl-method drop TLSv1_method ; : ssl-error-string ( -- string ) ERR_get_error ERR_clear_error f ERR_error_string ; +: (ssl-error) ( -- * ) + ssl-error-string throw ; + : ssl-error ( obj -- ) - { f 0 } member? [ ssl-error-string throw ] when ; + { f 0 } member? [ (ssl-error) ] when ; : init-ssl ( -- ) SSL_library_init ssl-error diff --git a/extra/random/unix/unix.factor b/extra/random/unix/unix.factor index 7fda7c5d1d..e534691ecd 100644 --- a/extra/random/unix/unix.factor +++ b/extra/random/unix/unix.factor @@ -1,4 +1,4 @@ -USING: alien.c-types io io.files io.nonblocking kernel +USING: alien.c-types io io.files io.ports kernel namespaces random io.encodings.binary init accessors system ; IN: random.unix diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor index 1374254612..4f0d6ac036 100755 --- a/extra/tools/deploy/shaker/shaker.factor +++ b/extra/tools/deploy/shaker/shaker.factor @@ -133,7 +133,7 @@ IN: tools.deploy.shaker [ io.backend:io-backend , - "default-buffer-size" "io.nonblocking" lookup , + "default-buffer-size" "io.ports" lookup , ] { } make { "alarms" "io" "tools" } strip-vocab-globals % diff --git a/extra/unix/linux/ifreq/ifreq.factor b/extra/unix/linux/ifreq/ifreq.factor index d688153bd0..5dc1c0fde2 100755 --- a/extra/unix/linux/ifreq/ifreq.factor +++ b/extra/unix/linux/ifreq/ifreq.factor @@ -1,7 +1,6 @@ USING: kernel alien alien.c-types io.sockets - io.sockets.impl unix unix.linux.sockios unix.linux.if ; diff --git a/extra/unix/linux/route/route.factor b/extra/unix/linux/route/route.factor index c4eeadb69e..4d9bbfae99 100644 --- a/extra/unix/linux/route/route.factor +++ b/extra/unix/linux/route/route.factor @@ -42,7 +42,7 @@ C-STRUCT: struct-rtentry ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -USING: kernel alien.c-types io.sockets io.sockets.impl +USING: kernel alien.c-types io.sockets unix unix.linux.sockios ; : route ( dst gateway genmask flags -- )