From f151a448c69d88b686fb7d859cca9498a050c305 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 15 May 2008 05:50:50 -0500 Subject: [PATCH 01/10] Simplify error handling logic --- extra/io/ports/ports.factor | 3 +-- extra/io/unix/backend/backend.factor | 7 +------ extra/io/windows/nt/sockets/sockets.factor | 23 +++++++++------------- 3 files changed, 11 insertions(+), 22 deletions(-) diff --git a/extra/io/ports/ports.factor b/extra/io/ports/ports.factor index 56455d7711..96492d2f93 100755 --- a/extra/io/ports/ports.factor +++ b/extra/io/ports/ports.factor @@ -113,8 +113,7 @@ HOOK: (wait-to-write) io-backend ( port -- ) dup buffer>> buffer-empty? [ drop ] [ (wait-to-write) ] if ; M: output-port stream-flush ( port -- ) - dup check-disposed - [ flush-port ] [ pending-error ] bi ; + [ check-disposed ] [ flush-port ] bi ; M: output-port dispose* [ flush-port ] [ call-next-method ] bi ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index df5669d9aa..f4a3080dd9 100644 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -48,11 +48,6 @@ M: mx remove-output-callbacks writes>> delete-at* drop ; GENERIC: wait-for-events ( ms mx -- ) -TUPLE: unix-io-error error port ; - -: report-error ( error port -- ) - tuck unix-io-error boa >>error drop ; - : input-available ( fd mx -- ) remove-input-callbacks [ resume ] each ; @@ -64,7 +59,7 @@ TUPLE: io-timeout ; M: io-timeout summary drop "I/O operation timed out" ; M: unix cancel-io ( port -- ) - io-timeout new over report-error + io-timeout new >>error handle>> handle-fd mx get-global [ input-available ] [ output-available ] 2bi ; diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index 75a08a02c4..fab50ecdd6 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -86,12 +86,10 @@ M: object (accept) ( server addr -- handle ) [ [ - { - [ call-AcceptEx ] - [ wait-for-socket drop ] - [ sAcceptSocket*>> opened-socket ] - [ port>> pending-error ] - } cleave + [ call-AcceptEx ] + [ wait-for-socket drop ] + [ sAcceptSocket*>> opened-socket ] + tri ] curry with-timeout ] with-destructors ; @@ -126,12 +124,10 @@ TUPLE: WSARecvFrom-args port M: winnt (receive) ( datagram -- packet addrspec ) [ - { - [ call-WSARecvFrom ] - [ wait-for-socket ] - [ port>> pending-error ] - [ parse-WSARecvFrom ] - } cleave + [ call-WSARecvFrom ] + [ wait-for-socket ] + [ parse-WSARecvFrom ] + tri ] with-destructors ; TUPLE: WSASendTo-args port @@ -166,6 +162,5 @@ M: winnt (send) ( packet addrspec datagram -- ) [ call-WSASendTo ] [ wait-for-socket drop ] - [ port>> pending-error ] - tri + bi ] with-destructors ; From a68f50c183ce66355b1a63596966a60156f5b216 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 15 May 2008 18:14:46 -0500 Subject: [PATCH 02/10] Simplify some code --- extra/io/ports/ports-docs.factor | 5 ----- extra/io/ports/ports.factor | 5 +---- extra/io/unix/backend/backend.factor | 19 +++++++++---------- extra/io/unix/pipes/pipes.factor | 3 +-- extra/io/unix/sockets/sockets.factor | 2 +- extra/io/windows/windows.factor | 3 --- extra/openssl/openssl.factor | 2 -- 7 files changed, 12 insertions(+), 27 deletions(-) diff --git a/extra/io/ports/ports-docs.factor b/extra/io/ports/ports-docs.factor index 0db8b01df5..63d1507692 100755 --- a/extra/io/ports/ports-docs.factor +++ b/extra/io/ports/ports-docs.factor @@ -22,7 +22,6 @@ $nl { $subsection init-stdio } { $subsection io-multiplex } "Per-port native I/O protocol:" -{ $subsection init-handle } { $subsection (wait-to-read) } { $subsection (wait-to-write) } "Additionally, the I/O backend must provide an implementation of the " { $link dispose } " generic word." ; @@ -46,10 +45,6 @@ HELP: input-port HELP: output-port { $class-description "The class of ports implementing the output stream protocol." } ; -HELP: init-handle -{ $values { "handle" "a native handle identifying an I/O resource" } } -{ $contract "Prepares a native handle for use by the port; called by " { $link } "." } ; - HELP: { $values { "handle" "a native handle identifying an I/O resource" } { "class" class } { "port" "a new " { $link port } } } { $description "Creates a new " { $link port } " with no buffer." } diff --git a/extra/io/ports/ports.factor b/extra/io/ports/ports.factor index 96492d2f93..d345975441 100755 --- a/extra/io/ports/ports.factor +++ b/extra/io/ports/ports.factor @@ -16,11 +16,8 @@ M: port timeout timeout>> ; M: port set-timeout (>>timeout) ; -GENERIC: init-handle ( handle -- ) - : ( handle class -- port ) - new - swap dup init-handle >>handle ; inline + new swap >>handle ; inline : pending-error ( port -- ) [ f ] change-error drop [ throw ] when* ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index f4a3080dd9..2d5ebb98ca 100644 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -13,7 +13,15 @@ GENERIC: handle-fd ( handle -- fd ) TUPLE: fd fd disposed ; -: ( n -- fd ) f fd boa ; +: ( n -- fd ) + #! We drop the error code rather than calling io-error, + #! since on OS X 10.3, this operation fails from init-io + #! when running the Factor.app (presumably because fd 0 and + #! 1 are closed). + [ F_SETFL O_NONBLOCK fcntl drop ] + [ F_SETFD FD_CLOEXEC fcntl drop ] + [ f fd boa ] + tri ; M: fd dispose* fd>> close-file ; @@ -96,15 +104,6 @@ SYMBOL: +output+ : io-error ( n -- ) 0 < [ (io-error) ] when ; -M: fd init-handle ( fd -- ) - #! We drop the error code rather than calling io-error, - #! since on OS X 10.3, this operation fails from init-io - #! when running the Factor.app (presumably because fd 0 and - #! 1 are closed). - fd>> - [ F_SETFL O_NONBLOCK fcntl drop ] - [ F_SETFD FD_CLOEXEC fcntl drop ] bi ; - ! Readers : eof ( reader -- ) dup buffer>> buffer-empty? [ t >>eof ] when drop ; diff --git a/extra/io/unix/pipes/pipes.factor b/extra/io/unix/pipes/pipes.factor index db2c917520..71366bfa4a 100644 --- a/extra/io/unix/pipes/pipes.factor +++ b/extra/io/unix/pipes/pipes.factor @@ -8,5 +8,4 @@ QUALIFIED: io.pipes M: unix io.pipes:(pipe) ( -- pair ) 2 "int" dup pipe io-error - 2 c-int-array> first2 [ ] bi@ - [ [ init-handle ] bi@ ] [ io.pipes:pipe boa ] 2bi ; + 2 c-int-array> first2 [ ] bi@ io.pipes:pipe boa ; diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 0bb0e3405a..fbeb25800c 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -13,7 +13,7 @@ EXCLUDE: io.sockets => accept ; IN: io.unix.sockets : socket-fd ( domain type -- fd ) - 0 socket dup io-error |dispose dup init-handle ; + 0 socket dup io-error |dispose ; : set-socket-option ( fd level opt -- ) >r >r handle-fd r> r> 1 "int" heap-size setsockopt io-error ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 6b6b54ab92..30b72f3e2f 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -24,9 +24,6 @@ TUPLE: win32-file < win32-handle ptr ; : ( handle -- win32-file ) win32-file new-win32-handle ; -M: win32-file init-handle ( handle -- ) - drop ; - HOOK: CreateFile-flags io-backend ( DWORD -- DWORD ) HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) HOOK: add-completion io-backend ( port -- ) diff --git a/extra/openssl/openssl.factor b/extra/openssl/openssl.factor index 014592dbcc..695b9a1d7d 100755 --- a/extra/openssl/openssl.factor +++ b/extra/openssl/openssl.factor @@ -133,8 +133,6 @@ M: no-ssl-context summary current-ssl-context handle>> SSL_new dup ssl-error f f ssl-handle boa ; -M: ssl-handle init-handle file>> init-handle ; - HOOK: ssl-shutdown io-backend ( handle -- ) M: ssl-handle dispose* From d6fbaf632de3596aac0d7b27b8acf22786f1d86a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 15 May 2008 19:05:07 -0500 Subject: [PATCH 03/10] Fix accept --- extra/io/sockets/sockets.factor | 7 ++++++- extra/io/unix/sockets/sockets.factor | 4 ++++ 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 36a0559bdb..da10354261 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -156,6 +156,11 @@ GENERIC: (get-local-address) ( handle remote -- sockaddr ) : get-local-address ( handle remote -- local ) [ (get-local-address) ] keep parse-sockaddr ; +GENERIC: (get-remote-address) ( handle remote -- sockaddr ) + +: get-remote-address ( handle local -- remote ) + [ (get-remote-address) ] keep parse-sockaddr ; + GENERIC: establish-connection ( client-out remote -- ) GENERIC: ((client)) ( remote -- handle ) @@ -204,7 +209,7 @@ GENERIC: (accept) ( server addrspec -- handle ) [ dup addr>> [ (accept) ] keep - [ drop dup ] [ get-local-address ] 2bi + [ drop dup ] [ get-remote-address ] 2bi -rot ] keep encoding>> swap ; diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index fbeb25800c..9e7676a509 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -26,6 +26,10 @@ M: object (get-local-address) ( handle remote -- sockaddr ) >r handle-fd r> empty-sockaddr/size [ getsockname io-error ] 2keep drop ; +M: object (get-remote-address) ( handle local -- sockaddr ) + >r handle-fd r> empty-sockaddr/size + [ getpeername io-error ] 2keep drop ; + : init-client-socket ( fd -- ) SOL_SOCKET SO_OOBINLINE set-socket-option ; From fe155e69a32261aa545dff2ee1aaf76ec1463095 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 15 May 2008 19:08:32 -0500 Subject: [PATCH 04/10] Fix mmap tests --- extra/io/mmap/mmap-tests.factor | 5 ----- extra/io/windows/mmap/mmap-tests.factor | 8 ++++++++ 2 files changed, 8 insertions(+), 5 deletions(-) create mode 100644 extra/io/windows/mmap/mmap-tests.factor diff --git a/extra/io/mmap/mmap-tests.factor b/extra/io/mmap/mmap-tests.factor index d25097e2b0..57faca01c7 100755 --- a/extra/io/mmap/mmap-tests.factor +++ b/extra/io/mmap/mmap-tests.factor @@ -8,8 +8,3 @@ IN: io.mmap.tests [ 5 ] [ "mmap-test-file.txt" temp-file dup file-info size>> [ length ] with-mapped-file ] unit-test [ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors - -[ ] [ "a" "mmap-grow-test.txt" temp-file ascii set-file-contents ] unit-test -[ 1 ] [ "mmap-grow-test.txt" temp-file file-info size>> ] unit-test -[ ] [ "mmap-grow-test.txt" temp-file 100 [ drop ] with-mapped-file ] unit-test -[ 100 ] [ "mmap-grow-test.txt" temp-file file-info size>> ] unit-test diff --git a/extra/io/windows/mmap/mmap-tests.factor b/extra/io/windows/mmap/mmap-tests.factor new file mode 100644 index 0000000000..a8430108e8 --- /dev/null +++ b/extra/io/windows/mmap/mmap-tests.factor @@ -0,0 +1,8 @@ +USING: io io.mmap io.files kernel tools.test continuations +sequences io.encodings.ascii accessors ; +IN: io.windows.mmap.tests + +[ ] [ "a" "mmap-grow-test.txt" temp-file ascii set-file-contents ] unit-test +[ 1 ] [ "mmap-grow-test.txt" temp-file file-info size>> ] unit-test +[ ] [ "mmap-grow-test.txt" temp-file 100 [ [ ] change-each ] with-mapped-file ] unit-test +[ 100 ] [ "mmap-grow-test.txt" temp-file file-info size>> ] unit-test From 0fc4c99eb1266e00a7901f23b74a384f9c4fe59f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 15 May 2008 20:07:01 -0500 Subject: [PATCH 05/10] help.lint fixes --- extra/cocoa/application/application-docs.factor | 4 ++-- extra/io/sockets/sockets-docs.factor | 2 +- extra/io/sockets/sockets.factor | 6 +++--- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/extra/cocoa/application/application-docs.factor b/extra/cocoa/application/application-docs.factor index 01a79cf35a..55fa5e10b8 100644 --- a/extra/cocoa/application/application-docs.factor +++ b/extra/cocoa/application/application-docs.factor @@ -27,8 +27,8 @@ HELP: with-cocoa { $description "Sets up an autorelease pool, initializes the " { $snippet "NSApplication" } " singleton, and calls the quotation." } ; HELP: do-event -{ $values { "app" "an " { $snippet "NSApplication" } } } -{ $description "Processes any pending events in the queue. Does not block." } ; +{ $values { "app" "an " { $snippet "NSApplication" } } { "?" "a boolean" } } +{ $description "Processes a pending event in the queue, if any, returning a boolean indicating if there was one. Does not block." } ; HELP: add-observer { $values { "observer" "an " { $snippet "NSObject" } } { "selector" string } { "name" "an " { $snippet "NSString" } } { "object" "an " { $snippet "NSObject" } } } diff --git a/extra/io/sockets/sockets-docs.factor b/extra/io/sockets/sockets-docs.factor index 7ef08575c0..668312e3f1 100755 --- a/extra/io/sockets/sockets-docs.factor +++ b/extra/io/sockets/sockets-docs.factor @@ -130,7 +130,7 @@ HELP: { $errors "Throws an error if the address is already in use, or if it if the system forbids access." } ; HELP: accept -{ $values { "server" "a handle" } { "client" "a bidirectional stream" } { "addrspec" "an address specifier" } } +{ $values { "server" "a handle" } { "client" "a bidirectional stream" } { "remote" "an address specifier" } } { $description "Waits for a connection to a server socket created by " { $link } ", and outputs a bidirectional stream when the connection has been established. The encoding of this stream is the one that was passed to the server constructor." } { $errors "Throws an error if the server socket is closed or otherwise is unavailable." } ; diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index da10354261..031343351e 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -185,7 +185,7 @@ M: object (client) ( remote -- client-in client-out local ) SYMBOL: local-address -: with-client ( addrspec encoding quot -- ) +: with-client ( remote encoding quot -- ) >r [ local-address set ] curry r> compose with-stream ; inline @@ -217,7 +217,7 @@ TUPLE: datagram-port < port addr ; HOOK: (datagram) io-backend ( addr -- datagram ) -: ( addr -- datagram ) +: ( addrspec -- datagram ) dup (datagram) datagram-port swap >>addr ; : check-datagram-port ( port -- port ) @@ -226,7 +226,7 @@ HOOK: (datagram) io-backend ( addr -- datagram ) HOOK: (receive) io-backend ( datagram -- packet addrspec ) -: receive ( datagram -- packet sockaddr ) +: receive ( datagram -- packet addrspec ) check-datagram-port [ (receive) ] [ addr>> ] bi parse-sockaddr ; From 4787dc914d4a320d6d3ae4cbafffca8a1b436fb1 Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Thu, 15 May 2008 20:08:32 -0500 Subject: [PATCH 06/10] Fixing bugs in Windows sockets, add UDP tests --- extra/io/sockets/sockets-tests.factor | 20 +++++++++++++++++- extra/io/sockets/sockets.factor | 12 +++++++---- extra/io/unix/sockets/sockets.factor | 11 +++++----- extra/io/windows/nt/sockets/sockets.factor | 24 ++++++++++++++++------ extra/io/windows/sockets/sockets.factor | 4 ++++ extra/windows/winsock/winsock.factor | 1 + 6 files changed, 55 insertions(+), 17 deletions(-) mode change 100644 => 100755 extra/io/sockets/sockets-tests.factor diff --git a/extra/io/sockets/sockets-tests.factor b/extra/io/sockets/sockets-tests.factor old mode 100644 new mode 100755 index b4dd910004..c411e30ae6 --- a/extra/io/sockets/sockets-tests.factor +++ b/extra/io/sockets/sockets-tests.factor @@ -1,5 +1,6 @@ IN: io.sockets.tests -USING: io.sockets sequences math tools.test ; +USING: io.sockets sequences math tools.test namespaces accessors +kernel destructors ; [ B{ 1 2 3 4 } ] [ "1.2.3.4" T{ inet4 } inet-pton ] unit-test @@ -44,3 +45,20 @@ USING: io.sockets sequences math tools.test ; [ 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 + +! Smoke-test UDP +[ ] [ "127.0.0.1" 0 "datagram1" set ] unit-test +[ ] [ "datagram1" get addr>> "addr1" set ] unit-test +[ f ] [ "addr1" get port>> 0 = ] unit-test + +[ ] [ "127.0.0.1" 0 "datagram2" set ] unit-test +[ ] [ "datagram2" get addr>> "addr2" set ] unit-test +[ f ] [ "addr2" get port>> 0 = ] unit-test + +[ ] [ B{ 1 2 3 4 } "addr2" get "datagram1" get send ] unit-test +[ B{ 1 2 3 4 } ] [ "datagram2" get receive "from" set ] unit-test +[ ] [ B{ 4 3 2 1 } "from" get "datagram2" get send ] unit-test +[ B{ 4 3 2 1 } t ] [ "datagram1" get receive "addr2" get = ] unit-test + +[ ] [ "datagram1" get dispose ] unit-test +[ ] [ "datagram2" get dispose ] unit-test diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index da10354261..0f07c8f1f1 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -203,14 +203,14 @@ GENERIC: (server) ( addrspec -- handle ) [ drop server-port ] [ get-local-address ] 2bi >>addr r> >>encoding ; -GENERIC: (accept) ( server addrspec -- handle ) +GENERIC: (accept) ( server addrspec -- handle sockaddr ) : accept ( server -- client remote ) [ dup addr>> [ (accept) ] keep - [ drop dup ] [ get-remote-address ] 2bi - -rot + parse-sockaddr swap + dup ] keep encoding>> swap ; TUPLE: datagram-port < port addr ; @@ -218,7 +218,11 @@ TUPLE: datagram-port < port addr ; HOOK: (datagram) io-backend ( addr -- datagram ) : ( addr -- datagram ) - dup (datagram) datagram-port swap >>addr ; + [ + [ (datagram) |dispose ] keep + [ drop datagram-port ] [ get-local-address ] 2bi + >>addr + ] with-destructors ; : check-datagram-port ( port -- port ) dup check-disposed diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 9e7676a509..0cfead0483 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -73,16 +73,15 @@ M: object (server) ( addrspec -- handle ) : do-accept ( server addrspec -- fd ) [ handle>> handle-fd ] [ empty-sockaddr/size ] bi* accept ; inline -M: object (accept) ( server addrspec -- fd ) - 2dup do-accept +M:: object (accept) ( server addrspec -- fd sockaddr ) + server addrspec do-accept { - { [ dup 0 >= ] [ 2nip ] } + { [ dup 0 >= ] [ dup addrspec (get-remote-sockaddr) ] } { [ err_no EINTR = ] [ drop (accept) ] } { [ err_no EAGAIN = ] [ drop - [ drop +input+ wait-for-port ] - [ (accept) ] - 2bi + server +input+ wait-for-port + server addrspec (accept) ] } [ (io-error) ] } cond ; diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index fab50ecdd6..c680d18077 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -82,15 +82,27 @@ TUPLE: AcceptEx-args port AcceptEx-args >tuple*< AcceptEx drop winsock-error-string [ throw ] when* ; -M: object (accept) ( server addr -- handle ) +: extract-remote-address ( AcceptEx -- sockaddr ) + { + [ lpOutputBuffer*>> ] + [ dwReceiveDataLength*>> ] + [ dwLocalAddressLength*>> ] + [ dwRemoteAddressLength*>> ] + } cleave + f + 0 + f + [ 0 GetAcceptExSockaddrs ] keep *void* ; + +M: object (accept) ( server addr -- handle sockaddr ) [ - [ - + + { [ call-AcceptEx ] [ wait-for-socket drop ] - [ sAcceptSocket*>> opened-socket ] - tri - ] curry with-timeout + [ sAcceptSocket*>> ] + [ extract-remote-address ] + } cleave ] with-destructors ; TUPLE: WSARecvFrom-args port diff --git a/extra/io/windows/sockets/sockets.factor b/extra/io/windows/sockets/sockets.factor index 67d827aa95..359776d639 100755 --- a/extra/io/windows/sockets/sockets.factor +++ b/extra/io/windows/sockets/sockets.factor @@ -30,6 +30,10 @@ M: object (get-local-address) ( socket addrspec -- sockaddr ) >r handle>> r> empty-sockaddr/size [ getsockname socket-error ] 2keep drop ; +M: object (get-remote-address) ( socket addrspec -- sockaddr ) + >r handle>> r> empty-sockaddr/size + [ getpeername socket-error ] 2keep drop ; + : bind-socket ( win32-socket sockaddr len -- ) >r >r handle>> r> r> bind socket-error ; diff --git a/extra/windows/winsock/winsock.factor b/extra/windows/winsock/winsock.factor index 0699afc682..57181d2704 100755 --- a/extra/windows/winsock/winsock.factor +++ b/extra/windows/winsock/winsock.factor @@ -168,6 +168,7 @@ FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ; FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ; FUNCTION: int getsockname ( SOCKET s, sockaddr_in* address, int* addrlen ) ; +FUNCTION: int getpeername ( SOCKET s, sockaddr_in* address, int* addrlen ) ; TYPEDEF: uint SERVICETYPE TYPEDEF: OVERLAPPED WSAOVERLAPPED From 95aaf32373dab3bfa89e9ed2f4eec53d5dd5d53f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 16 May 2008 00:57:52 -0500 Subject: [PATCH 07/10] Fix conflict --- extra/io/unix/sockets/sockets.factor | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 0cfead0483..d4059c102a 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -70,18 +70,20 @@ M: object (server) ( addrspec -- handle ) dup handle-fd 10 listen io-error ] with-destructors ; -: do-accept ( server addrspec -- fd ) - [ handle>> handle-fd ] [ empty-sockaddr/size ] bi* accept ; inline +: do-accept ( server addrspec -- fd sockaddr ) + [ handle>> handle-fd ] [ empty-sockaddr/size ] bi* + [ accept ] 2keep drop ; inline -M:: object (accept) ( server addrspec -- fd sockaddr ) - server addrspec do-accept +M: object (accept) ( server addrspec -- fd sockaddr ) + 2dup do-accept { - { [ dup 0 >= ] [ dup addrspec (get-remote-sockaddr) ] } - { [ err_no EINTR = ] [ drop (accept) ] } + { [ over 0 >= ] [ >r 2nip r> ] } + { [ err_no EINTR = ] [ 2drop (accept) ] } { [ err_no EAGAIN = ] [ - drop - server +input+ wait-for-port - server addrspec (accept) + 2drop + [ drop +input+ wait-for-port ] + [ (accept) ] + 2bi ] } [ (io-error) ] } cond ; From f25c2e80f95ae4f1162ade4275e33e5fb578af8d Mon Sep 17 00:00:00 2001 From: slava Date: Fri, 16 May 2008 01:44:52 -0500 Subject: [PATCH 08/10] Fix Linux monitors --- core/debugger/debugger.factor | 4 +++- extra/io/monitors/monitors-tests.factor | 3 ++- extra/io/unix/linux/monitors/monitors.factor | 13 ++++++++----- 3 files changed, 13 insertions(+), 7 deletions(-) diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor index ad74889236..e6dfb79e07 100755 --- a/core/debugger/debugger.factor +++ b/core/debugger/debugger.factor @@ -7,7 +7,7 @@ splitting math.parser classes.tuple continuations continuations.private combinators generic.math classes.builtin classes compiler.units generic.standard vocabs threads threads.private init kernel.private libc io.encodings -mirrors accessors math.order ; +mirrors accessors math.order destructors ; IN: debugger GENERIC: error. ( error -- ) @@ -300,6 +300,8 @@ M: bad-create summary drop "Bad parameters to create" ; M: attempt-all-error summary drop "Nothing to attempt" ; +M: already-disposed summary drop "Attempting to operate on disposed object" ; + ] with-monitors dispose + [ ] [ [ "" resource-path f ] with-monitors dispose ] unit-test + [ ] [ [ "" resource-path t ] with-monitors dispose ] unit-test ] when diff --git a/extra/io/unix/linux/monitors/monitors.factor b/extra/io/unix/linux/monitors/monitors.factor index 17d3041aaf..136a892aa6 100644 --- a/extra/io/unix/linux/monitors/monitors.factor +++ b/extra/io/unix/linux/monitors/monitors.factor @@ -5,7 +5,7 @@ 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 -vocabs.loader accessors system hashtables ; +vocabs.loader accessors system hashtables destructors ; IN: io.unix.linux.monitors SYMBOL: watches @@ -23,9 +23,9 @@ TUPLE: linux-monitor < monitor wd inotify watches disposed ; : wd>monitor ( wd -- monitor ) watches get at ; : ( -- port/f ) - inotify_init dup 0 < [ drop f ] [ ] if ; + inotify_init dup 0 < [ drop f ] [ ] if ; -: inotify-fd inotify get handle>> ; +: inotify-fd inotify get handle>> handle-fd ; : check-existing ( wd -- ) watches get key? [ @@ -57,8 +57,10 @@ M: linux (monitor) ( path recursive? mailbox -- monitor ) M: linux-monitor dispose* ( monitor -- ) [ [ wd>> ] [ watches>> ] bi delete-at ] [ - [ inotify>> handle>> ] [ wd>> ] bi - inotify_rm_watch io-error + dup inotify>> disposed>> [ drop ] [ + [ inotify>> handle>> handle-fd ] [ wd>> ] bi + inotify_rm_watch io-error + ] if ] bi ; : ignore-flags? ( mask -- ? ) @@ -108,6 +110,7 @@ M: linux-monitor dispose* ( monitor -- ) ] if ; : inotify-read-loop ( port -- ) + dup check-disposed dup wait-to-read 0 over buffer>> parse-file-notifications 0 over buffer>> buffer-reset From 1124d7e6ea15f2bac738e147cd5dcf8da5a7d123 Mon Sep 17 00:00:00 2001 From: slava Date: Fri, 16 May 2008 05:01:11 -0500 Subject: [PATCH 09/10] Tweak http tests --- extra/http/http-tests.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/http/http-tests.factor b/extra/http/http-tests.factor index daac4d6dd9..89480b43ba 100755 --- a/extra/http/http-tests.factor +++ b/extra/http/http-tests.factor @@ -176,11 +176,11 @@ test-db [ main-responder set [ 1237 httpd ] "HTTPD test" spawn drop - - yield ] with-scope ] unit-test +[ ] [ 100 sleep ] unit-test + [ t ] [ "resource:extra/http/test/foo.html" ascii file-contents "http://localhost:1237/nested/foo.html" http-get = @@ -222,7 +222,7 @@ test-db [ ] with-scope ] unit-test -[ ] [ 1000 sleep ] unit-test +[ ] [ 100 sleep ] unit-test : 404? [ download-failed? ] [ response>> code>> 404 = ] bi and ; @@ -249,7 +249,7 @@ test-db [ ] with-scope ] unit-test -[ ] [ 1000 sleep ] unit-test +[ ] [ 100 sleep ] unit-test [ "Hi" ] [ "http://localhost:1237/" http-get ] unit-test From 7aa2bb3f302c46e6323bc29189b2ad629228f8b5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 16 May 2008 06:28:19 -0500 Subject: [PATCH 10/10] Fix Windows bootstrap --- extra/io/windows/nt/sockets/sockets.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index fcad915d94..c680d18077 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -131,9 +131,7 @@ TUPLE: WSARecvFrom-args port WSARecvFrom-args >tuple*< WSARecvFrom socket-error* ; : parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr ) - [ lpBuffers*>> WSABUF-buf swap memory>byte-array ] - [ lpFromLen*>> *int . ] - [ lpFrom*>> ] tri ; + [ lpBuffers*>> WSABUF-buf swap memory>byte-array ] [ lpFrom*>> ] bi ; M: winnt (receive) ( datagram -- packet addrspec ) [