From 39ee1a7e3f74b5936c35c13a1baff12f45d1c219 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 20 May 2008 21:59:29 -0500 Subject: [PATCH 1/6] Fix resource leak if flush on close fails --- extra/io/pipes/pipes-tests.factor | 13 ++++++++++++- extra/io/ports/ports.factor | 6 ++++-- extra/io/unix/backend/backend.factor | 3 ++- extra/io/windows/windows.factor | 3 +++ 4 files changed, 21 insertions(+), 4 deletions(-) diff --git a/extra/io/pipes/pipes-tests.factor b/extra/io/pipes/pipes-tests.factor index d1c2e54bb0..5ece6cfdf3 100755 --- a/extra/io/pipes/pipes-tests.factor +++ b/extra/io/pipes/pipes-tests.factor @@ -1,6 +1,7 @@ USING: io io.pipes io.streams.string io.encodings.utf8 io.streams.duplex io.encodings io.timeouts namespaces -continuations tools.test kernel calendar destructors ; +continuations tools.test kernel calendar destructors +accessors debugger math ; IN: io.pipes.tests [ "Hello" ] [ @@ -31,3 +32,13 @@ IN: io.pipes.tests stream-readln ] with-disposal ] must-fail + +[ ] [ + 1000 [ + utf8 [ + [ in>> dispose ] + [ out>> "hi" over stream-write dispose ] + bi + ] curry ignore-errors + ] times +] unit-test diff --git a/extra/io/ports/ports.factor b/extra/io/ports/ports.factor index e3c873e9d0..d8a99f81b8 100755 --- a/extra/io/ports/ports.factor +++ b/extra/io/ports/ports.factor @@ -108,7 +108,9 @@ M: output-port stream-flush ( port -- ) [ check-disposed ] [ port-flush ] bi ; M: output-port dispose* - [ port-flush ] [ call-next-method ] bi ; + [ + [ handle>> &dispose drop ] [ port-flush ] bi + ] with-destructors ; M: buffered-port dispose* [ call-next-method ] @@ -119,7 +121,7 @@ GENERIC: cancel-io ( handle -- ) M: port timed-out handle>> cancel-io ; -M: port dispose* handle>> [ cancel-io ] [ dispose ] bi ; +M: port dispose* handle>> dispose ; : ( read-handle write-handle -- input-port output-port ) [ diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 723ce8b255..70e5c9dd39 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -23,7 +23,8 @@ TUPLE: fd fd disposed ; [ f fd boa ] tri ; -M: fd dispose* fd>> close-file ; +M: fd dispose* + [ cancel-io ] [ fd>> close-file ] bi ; M: fd handle-fd dup check-disposed fd>> ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 30b72f3e2f..295a6119cb 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -24,6 +24,9 @@ TUPLE: win32-file < win32-handle ptr ; : ( handle -- win32-file ) win32-file new-win32-handle ; +M: win32-file dispose* + [ cancel-io ] [ call-next-method ] bi ; + HOOK: CreateFile-flags io-backend ( DWORD -- DWORD ) HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) HOOK: add-completion io-backend ( port -- ) From eec403d28191716b92559dfbad10b99abc899e1d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 May 2008 01:36:15 -0500 Subject: [PATCH 2/6] Fix write-gadget on style stream --- extra/ui/gadgets/panes/panes.factor | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/extra/ui/gadgets/panes/panes.factor b/extra/ui/gadgets/panes/panes.factor index 960c34118a..2b83e7db71 100755 --- a/extra/ui/gadgets/panes/panes.factor +++ b/extra/ui/gadgets/panes/panes.factor @@ -9,7 +9,7 @@ quotations math opengl combinators math.vectors sorting splitting io.streams.nested assocs ui.gadgets.presentations ui.gadgets.slots ui.gadgets.grids ui.gadgets.grid-lines classes.tuple models continuations -destructors ; +destructors accessors ; IN: ui.gadgets.panes TUPLE: pane output current prototype scrolls? @@ -114,6 +114,9 @@ GENERIC: write-gadget ( gadget stream -- ) M: pane-stream write-gadget pane-stream-pane pane-current add-gadget ; +M: style-stream write-gadget + stream>> write-gadget ; + : print-gadget ( gadget stream -- ) tuck write-gadget stream-nl ; From 70e89b5166f36b4dd8e55eb4e06fec05a4a3faba Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 May 2008 01:36:30 -0500 Subject: [PATCH 3/6] Fix SSL timeout support and clean up some timeout code --- extra/io/launcher/launcher.factor | 2 +- extra/io/ports/ports.factor | 20 +++-- extra/io/sockets/secure/secure.factor | 6 +- extra/io/timeouts/timeouts-docs.factor | 6 +- extra/io/timeouts/timeouts.factor | 15 ++-- extra/io/unix/backend/backend.factor | 23 +++-- .../unix/sockets/secure/secure-tests.factor | 85 ++++++++++++++++++- extra/io/unix/sockets/secure/secure.factor | 46 +++++----- extra/io/windows/nt/backend/backend.factor | 2 +- extra/io/windows/windows.factor | 2 +- extra/openssl/openssl.factor | 10 +-- 11 files changed, 156 insertions(+), 61 deletions(-) diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index 54715e23da..131cadfaf0 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -147,7 +147,7 @@ M: process timeout timeout>> ; M: process set-timeout set-process-timeout ; -M: process timed-out kill-process ; +M: process cancel-operation kill-process ; M: object run-pipeline-element [ >process swap >>stdout swap >>stdin run-detached ] diff --git a/extra/io/ports/ports.factor b/extra/io/ports/ports.factor index d8a99f81b8..b34d4b20ad 100755 --- a/extra/io/ports/ports.factor +++ b/extra/io/ports/ports.factor @@ -100,6 +100,10 @@ M: output-port stream-write HOOK: (wait-to-write) io-backend ( port -- ) +GENERIC: shutdown ( handle -- ) + +M: object shutdown drop ; + : port-flush ( port -- ) dup buffer>> buffer-empty? [ drop ] [ dup (wait-to-write) port-flush ] if ; @@ -109,7 +113,10 @@ M: output-port stream-flush ( port -- ) M: output-port dispose* [ - [ handle>> &dispose drop ] [ port-flush ] bi + [ handle>> &dispose drop ] + [ port-flush ] + [ [ handle>> shutdown ] with-timeout ] + tri ] with-destructors ; M: buffered-port dispose* @@ -117,11 +124,14 @@ M: buffered-port dispose* [ [ [ buffer-free ] when* f ] change-buffer drop ] bi ; -GENERIC: cancel-io ( handle -- ) +M: port cancel-operation handle>> cancel-operation ; -M: port timed-out handle>> cancel-io ; - -M: port dispose* handle>> dispose ; +M: port dispose* + [ + [ handle>> &dispose drop ] + [ [ handle>> shutdown ] with-timeout ] + bi + ] with-destructors ; : ( read-handle write-handle -- input-port output-port ) [ diff --git a/extra/io/sockets/secure/secure.factor b/extra/io/sockets/secure/secure.factor index 22265b9069..6439ced8ab 100644 --- a/extra/io/sockets/secure/secure.factor +++ b/extra/io/sockets/secure/secure.factor @@ -1,9 +1,13 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel symbols namespaces continuations -destructors io.sockets sequences inspector ; +destructors io.sockets sequences inspector calendar ; IN: io.sockets.secure +SYMBOL: secure-socket-timeout + +1 minutes secure-socket-timeout set-global + SYMBOL: secure-socket-backend SINGLETONS: SSLv2 SSLv23 SSLv3 TLSv1 ; diff --git a/extra/io/timeouts/timeouts-docs.factor b/extra/io/timeouts/timeouts-docs.factor index 64104083be..b2927af362 100755 --- a/extra/io/timeouts/timeouts-docs.factor +++ b/extra/io/timeouts/timeouts-docs.factor @@ -9,20 +9,20 @@ HELP: set-timeout { $values { "dt/f" "a " { $link duration } " or " { $link f } } { "obj" object } } { $contract "Sets an object's timeout." } ; -HELP: timed-out +HELP: cancel-operation { $values { "obj" object } } { $contract "Handles a timeout, usually by waking up all threads waiting on the object." } ; HELP: with-timeout { $values { "obj" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } } } -{ $description "Applies the quotation to the object. If the object's timeout expires before the quotation returns, " { $link timed-out } " is called on the object." } ; +{ $description "Applies the quotation to the object. If the object's timeout expires before the quotation returns, " { $link cancel-operation } " is called on the object." } ; ARTICLE: "io.timeouts" "I/O timeout protocol" "Streams, processes and monitors support optional timeouts, which impose an upper bound on the length of time for which an operation on these objects can block. Timeouts are used in network servers to prevent malicious clients from holding onto connections forever, and to ensure that runaway processes get killed." { $subsection timeout } { $subsection set-timeout } "The I/O timeout protocol can be implemented by any class wishing to support timeouts on blocking operations." -{ $subsection timed-out } +{ $subsection cancel-operation } "A combinator to be used in operations which can time out:" { $subsection with-timeout } { $see-also "stream-protocol" "io.launcher" "io.monitors" } ; diff --git a/extra/io/timeouts/timeouts.factor b/extra/io/timeouts/timeouts.factor index 816bfd1b19..029cf6cac0 100755 --- a/extra/io/timeouts/timeouts.factor +++ b/extra/io/timeouts/timeouts.factor @@ -11,17 +11,18 @@ M: decoder set-timeout stream>> set-timeout ; M: encoder set-timeout stream>> set-timeout ; -GENERIC: timed-out ( obj -- ) +GENERIC: cancel-operation ( obj -- ) : queue-timeout ( obj timeout -- alarm ) - >r [ timed-out ] curry r> later ; + >r [ cancel-operation ] curry r> later ; + +: with-timeout* ( obj timeout quot -- ) + 3dup drop queue-timeout >r nip call r> cancel-alarm ; + inline : with-timeout ( obj quot -- ) - over dup timeout dup [ - queue-timeout slip cancel-alarm - ] [ - 2drop call - ] if ; inline + over timeout [ >r dup timeout r> with-timeout* ] [ call ] if ; + inline : timeouts ( dt -- ) [ input-stream get set-timeout ] diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 70e5c9dd39..eecb0daf8f 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -24,7 +24,7 @@ TUPLE: fd fd disposed ; tri ; M: fd dispose* - [ cancel-io ] [ fd>> close-file ] bi ; + [ cancel-operation ] [ fd>> close-file ] bi ; M: fd handle-fd dup check-disposed fd>> ; @@ -63,7 +63,7 @@ GENERIC: wait-for-events ( ms mx -- ) : output-available ( fd mx -- ) remove-output-callbacks [ resume ] each ; -M: fd cancel-io ( fd -- ) +M: fd cancel-operation ( fd -- ) dup disposed>> [ drop ] [ fd>> mx get-global @@ -76,8 +76,12 @@ SYMBOL: +retry+ ! just try the operation again without blocking SYMBOL: +input+ SYMBOL: +output+ -: wait-for-fd ( handle event -- timeout? ) - dup +retry+ eq? [ 2drop f ] [ +ERROR: io-timeout ; + +M: io-timeout summary drop "I/O operation timed out" ; + +: wait-for-fd ( handle event -- ) + dup +retry+ eq? [ 2drop ] [ [ >r swap handle-fd @@ -86,18 +90,11 @@ SYMBOL: +output+ { +input+ [ add-input-callback ] } { +output+ [ add-output-callback ] } } case - ] curry "I/O" suspend nip + ] curry "I/O" suspend nip [ io-timeout ] when ] if ; -ERROR: io-timeout ; - -M: io-timeout summary drop "I/O operation timed out" ; - : wait-for-port ( port event -- ) - [ - >r handle>> r> wait-for-fd - [ io-timeout ] when - ] curry with-timeout ; + [ >r handle>> r> wait-for-fd ] curry with-timeout ; ! Some general stuff : file-mode OCT: 0666 ; diff --git a/extra/io/unix/sockets/secure/secure-tests.factor b/extra/io/unix/sockets/secure/secure-tests.factor index 5b8fd5ac23..0df3c3d96b 100644 --- a/extra/io/unix/sockets/secure/secure-tests.factor +++ b/extra/io/unix/sockets/secure/secure-tests.factor @@ -1,8 +1,8 @@ IN: io.sockets.secure.tests USING: accessors kernel namespaces io io.sockets io.sockets.secure io.encodings.ascii io.streams.duplex -classes words destructors threads tools.test -concurrency.promises byte-arrays locals ; +io.unix.backend classes words destructors threads tools.test +concurrency.promises byte-arrays locals calendar io.timeouts ; \ must-infer { 1 0 } [ [ ] with-secure-context ] must-infer-as @@ -63,3 +63,84 @@ concurrency.promises byte-arrays locals ; drop dispose ] with-secure-context ] [ certificate-verify-error? ] must-fail-with + +! Client-side handshake timeout +[ ] [ "port" set ] unit-test + +[ ] [ + [ + "127.0.0.1" 0 ascii [ + dup addr>> port>> "port" get fulfill + accept drop 1 minutes sleep dispose + ] with-disposal + ] "Silly server" spawn drop +] unit-test + +[ + 1 seconds secure-socket-timeout [ + client-test + ] with-variable +] [ io-timeout? ] must-fail-with + +! Server-side handshake timeout +[ ] [ "port" set ] unit-test + +[ ] [ + [ + "127.0.0.1" "port" get ?promise + ascii drop 1 minutes sleep dispose + ] "Silly client" spawn drop +] unit-test + +[ + 1 seconds secure-socket-timeout [ + [ + "127.0.0.1" 0 ascii [ + dup addr>> addrspec>> port>> "port" get fulfill + accept drop dispose + ] with-disposal + ] with-test-context + ] with-variable +] [ io-timeout? ] must-fail-with + +! Client socket shutdown timeout +[ ] [ "port" set ] unit-test + +[ ] [ + [ + [ + "127.0.0.1" 0 ascii [ + dup addr>> addrspec>> port>> "port" get fulfill + accept drop 1 minutes sleep dispose + ] with-disposal + ] with-test-context + ] "Silly server" spawn drop +] unit-test + +[ + [ + "127.0.0.1" "port" get ?promise + ascii drop 1 seconds over set-timeout dispose + ] with-secure-context +] [ io-timeout? ] must-fail-with + +! Server socket shutdown timeout +[ ] [ "port" set ] unit-test + +[ ] [ + [ + [ + "127.0.0.1" "port" get ?promise + ascii drop 1 minutes sleep dispose + ] with-test-context + ] "Silly client" spawn drop +] unit-test + +[ + [ + "127.0.0.1" 0 ascii [ + dup addr>> addrspec>> port>> "port" get fulfill + accept drop 1 seconds over set-timeout dispose + ] with-disposal + ] with-test-context +] [ io-timeout? ] must-fail-with diff --git a/extra/io/unix/sockets/secure/secure.factor b/extra/io/unix/sockets/secure/secure.factor index f3931ae397..4a99164acb 100755 --- a/extra/io/unix/sockets/secure/secure.factor +++ b/extra/io/unix/sockets/secure/secure.factor @@ -6,7 +6,7 @@ continuations destructors openssl openssl.libcrypto openssl.libssl io.files io.ports io.unix.backend io.unix.sockets io.encodings.ascii io.buffers io.sockets io.sockets.secure -unix system inspector ; +io.timeouts system inspector ; IN: io.unix.sockets.secure M: ssl-handle handle-fd file>> handle-fd ; @@ -64,8 +64,11 @@ M: ssl-handle drain SSL_write check-write-response ; -M: ssl-handle cancel-io - file>> cancel-io ; +M: ssl-handle cancel-operation + file>> cancel-operation ; + +M: ssl-handle timeout + drop secure-socket-timeout get ; ! Client sockets : ( fd -- ssl ) @@ -79,8 +82,8 @@ M: secure parse-sockaddr addrspec>> parse-sockaddr ; M: secure (get-local-address) addrspec>> (get-local-address) ; -: check-connect-response ( port r -- event ) - check-response +: check-connect-response ( ssl-handle r -- event ) + over handle>> over SSL_get_error { { SSL_ERROR_NONE [ 2drop f ] } { SSL_ERROR_WANT_READ [ 2drop +input+ ] } @@ -89,16 +92,18 @@ M: secure (get-local-address) addrspec>> (get-local-address) ; { SSL_ERROR_SSL [ (ssl-error) ] } } case ; -: do-ssl-connect ( port -- ) - dup dup handle>> handle>> SSL_connect - check-connect-response dup - [ dupd wait-for-port do-ssl-connect ] [ 2drop ] if ; +: do-ssl-connect ( ssl-handle -- ) + dup dup handle>> SSL_connect check-connect-response dup + [ dupd wait-for-fd do-ssl-connect ] [ 2drop ] if ; M: secure establish-connection ( client-out remote -- ) [ addrspec>> establish-connection ] - [ drop do-ssl-connect ] - [ drop handle>> t >>connected drop ] - 2tri ; + [ + drop handle>> + [ [ do-ssl-connect ] with-timeout ] + [ t >>connected drop ] + bi + ] 2bi ; M: secure (server) addrspec>> (server) ; @@ -114,13 +119,13 @@ M: secure (server) addrspec>> (server) ; : do-ssl-accept ( ssl-handle -- ) dup dup handle>> SSL_accept check-accept-response dup - [ >r dup file>> r> wait-for-fd drop do-ssl-accept ] [ 2drop ] if ; + [ >r dup file>> r> wait-for-fd do-ssl-accept ] [ 2drop ] if ; M: secure (accept) [ addrspec>> (accept) >r |dispose t >>connected |dispose - dup do-ssl-accept r> + dup [ do-ssl-accept ] with-timeout r> ] with-destructors ; : check-shutdown-response ( handle r -- event ) @@ -130,7 +135,7 @@ M: secure (accept) { 0 [ dup handle>> dup f 0 SSL_read 2dup SSL_get_error { - { SSL_ERROR_ZERO_RETURN [ 2drop dup handle>> SSL_shutdown check-shutdown-response ] } + { SSL_ERROR_ZERO_RETURN [ 3drop +retry+ ] } { SSL_ERROR_WANT_READ [ 3drop +input+ ] } { SSL_ERROR_WANT_WRITE [ 3drop +output+ ] } { SSL_ERROR_SYSCALL [ syscall-error ] } @@ -148,8 +153,9 @@ M: secure (accept) ] } } case ; -M: unix ssl-shutdown - dup connected>> [ - dup dup handle>> SSL_shutdown check-shutdown-response - dup [ dupd wait-for-fd drop ssl-shutdown ] [ 2drop ] if - ] [ drop ] if ; +: (shutdown) ( handle -- ) + dup dup handle>> SSL_shutdown check-shutdown-response + dup [ dupd wait-for-fd (shutdown) ] [ 2drop ] if ; + +M: ssl-handle shutdown USE: io.streams.c + dup connected>> [ f >>connected (shutdown) ] [ drop ] if ; diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor index 27fe558642..993aff5200 100755 --- a/extra/io/windows/nt/backend/backend.factor +++ b/extra/io/windows/nt/backend/backend.factor @@ -71,7 +71,7 @@ M: winnt add-completion ( win32-handle -- ) resume-callback t ] if ; -M: win32-handle cancel-io +M: win32-handle cancel-operation handle>> CancelIo drop ; M: winnt io-multiplex ( ms -- ) diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 295a6119cb..97349f5537 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -25,7 +25,7 @@ TUPLE: win32-file < win32-handle ptr ; win32-file new-win32-handle ; M: win32-file dispose* - [ cancel-io ] [ call-next-method ] bi ; + [ cancel-operation ] [ call-next-method ] bi ; HOOK: CreateFile-flags io-backend ( DWORD -- DWORD ) HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) diff --git a/extra/openssl/openssl.factor b/extra/openssl/openssl.factor index df285d26c2..bf00d64020 100755 --- a/extra/openssl/openssl.factor +++ b/extra/openssl/openssl.factor @@ -5,7 +5,8 @@ math.order combinators init alien alien.c-types alien.strings libc continuations destructors debugger inspector locals unicode.case openssl.libcrypto openssl.libssl -io.backend io.ports io.files io.encodings.8-bit io.sockets.secure ; +io.backend io.ports io.files io.encodings.8-bit io.sockets.secure +io.timeouts ; IN: openssl ! This code is based on http://www.rtfm.com/openssl-examples/ @@ -165,13 +166,8 @@ M: no-secure-context summary current-ssl-context handle>> SSL_new dup ssl-error f f ssl-handle boa ; -HOOK: ssl-shutdown io-backend ( handle -- ) - M: ssl-handle dispose* - [ ssl-shutdown ] - [ handle>> SSL_free ] - [ file>> dispose ] - tri ; + [ handle>> SSL_free ] [ file>> dispose ] bi ; : check-verify-result ( ssl-handle -- ) SSL_get_verify_result dup X509_V_OK = From bf01d85e12ffd066271a990d14497bdaad191e9c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 May 2008 15:54:02 -0500 Subject: [PATCH 4/6] Better Unix errors --- extra/unix/bsd/bsd.factor | 4 - extra/unix/bsd/freebsd/freebsd.factor | 95 +++++++++++++++++++++++ extra/unix/bsd/macosx/macosx.factor | 105 ++++++++++++++++++++++++++ extra/unix/bsd/netbsd/netbsd.factor | 99 ++++++++++++++++++++++++ extra/unix/bsd/openbsd/openbsd.factor | 90 ++++++++++++++++++++++ extra/unix/linux/linux.factor | 102 ++++++++++++++++++++++++- extra/unix/unix.factor | 31 ++++++-- 7 files changed, 511 insertions(+), 15 deletions(-) diff --git a/extra/unix/bsd/bsd.factor b/extra/unix/bsd/bsd.factor index 158dbeaddb..0c669d2258 100755 --- a/extra/unix/bsd/bsd.factor +++ b/extra/unix/bsd/bsd.factor @@ -48,10 +48,6 @@ C-STRUCT: sockaddr-un : max-un-path 104 ; inline -: EINTR HEX: 4 ; inline -: EAGAIN HEX: 23 ; inline -: EINPROGRESS HEX: 24 ; inline - : SOCK_STREAM 1 ; inline : SOCK_DGRAM 2 ; inline diff --git a/extra/unix/bsd/freebsd/freebsd.factor b/extra/unix/bsd/freebsd/freebsd.factor index f25cbd1537..34f0f0429c 100644 --- a/extra/unix/bsd/freebsd/freebsd.factor +++ b/extra/unix/bsd/freebsd/freebsd.factor @@ -12,3 +12,98 @@ C-STRUCT: addrinfo { "char*" "canonname" } { "void*" "addr" } { "addrinfo*" "next" } ; + +: EPERM 1 ; inline +: ENOENT 2 ; inline +: ESRCH 3 ; inline +: EINTR 4 ; inline +: EIO 5 ; inline +: ENXIO 6 ; inline +: E2BIG 7 ; inline +: ENOEXEC 8 ; inline +: EBADF 9 ; inline +: ECHILD 10 ; inline +: EDEADLK 11 ; inline +: ENOMEM 12 ; inline +: EACCES 13 ; inline +: EFAULT 14 ; inline +: ENOTBLK 15 ; inline +: EBUSY 16 ; inline +: EEXIST 17 ; inline +: EXDEV 18 ; inline +: ENODEV 19 ; inline +: ENOTDIR 20 ; inline +: EISDIR 21 ; inline +: EINVAL 22 ; inline +: ENFILE 23 ; inline +: EMFILE 24 ; inline +: ENOTTY 25 ; inline +: ETXTBSY 26 ; inline +: EFBIG 27 ; inline +: ENOSPC 28 ; inline +: ESPIPE 29 ; inline +: EROFS 30 ; inline +: EMLINK 31 ; inline +: EPIPE 32 ; inline +: EDOM 33 ; inline +: ERANGE 34 ; inline +: EAGAIN 35 ; inline +: EWOULDBLOCK EAGAIN ; inline +: EINPROGRESS 36 ; inline +: EALREADY 37 ; inline +: ENOTSOCK 38 ; inline +: EDESTADDRREQ 39 ; inline +: EMSGSIZE 40 ; inline +: EPROTOTYPE 41 ; inline +: ENOPROTOOPT 42 ; inline +: EPROTONOSUPPORT 43 ; inline +: ESOCKTNOSUPPORT 44 ; inline +: EOPNOTSUPP 45 ; inline +: ENOTSUP EOPNOTSUPP ; inline +: EPFNOSUPPORT 46 ; inline +: EAFNOSUPPORT 47 ; inline +: EADDRINUSE 48 ; inline +: EADDRNOTAVAIL 49 ; inline +: ENETDOWN 50 ; inline +: ENETUNREACH 51 ; inline +: ENETRESET 52 ; inline +: ECONNABORTED 53 ; inline +: ECONNRESET 54 ; inline +: ENOBUFS 55 ; inline +: EISCONN 56 ; inline +: ENOTCONN 57 ; inline +: ESHUTDOWN 58 ; inline +: ETOOMANYREFS 59 ; inline +: ETIMEDOUT 60 ; inline +: ECONNREFUSED 61 ; inline +: ELOOP 62 ; inline +: ENAMETOOLONG 63 ; inline +: EHOSTDOWN 64 ; inline +: EHOSTUNREACH 65 ; inline +: ENOTEMPTY 66 ; inline +: EPROCLIM 67 ; inline +: EUSERS 68 ; inline +: EDQUOT 69 ; inline +: ESTALE 70 ; inline +: EREMOTE 71 ; inline +: EBADRPC 72 ; inline +: ERPCMISMATCH 73 ; inline +: EPROGUNAVAIL 74 ; inline +: EPROGMISMATCH 75 ; inline +: EPROCUNAVAIL 76 ; inline +: ENOLCK 77 ; inline +: ENOSYS 78 ; inline +: EFTYPE 79 ; inline +: EAUTH 80 ; inline +: ENEEDAUTH 81 ; inline +: EIDRM 82 ; inline +: ENOMSG 83 ; inline +: EOVERFLOW 84 ; inline +: ECANCELED 85 ; inline +: EILSEQ 86 ; inline +: ENOATTR 87 ; inline +: EDOOFUS 88 ; inline +: EBADMSG 89 ; inline +: EMULTIHOP 90 ; inline +: ENOLINK 91 ; inline +: EPROTO 92 ; inline diff --git a/extra/unix/bsd/macosx/macosx.factor b/extra/unix/bsd/macosx/macosx.factor index 174dcbf632..6582d29687 100644 --- a/extra/unix/bsd/macosx/macosx.factor +++ b/extra/unix/bsd/macosx/macosx.factor @@ -25,3 +25,108 @@ C-STRUCT: passwd { "char*" "pw_shell" } { "time_t" "pw_expire" } { "int" "pw_fields" } ; + +: EPERM 1 ; inline +: ENOENT 2 ; inline +: ESRCH 3 ; inline +: EINTR 4 ; inline +: EIO 5 ; inline +: ENXIO 6 ; inline +: E2BIG 7 ; inline +: ENOEXEC 8 ; inline +: EBADF 9 ; inline +: ECHILD 10 ; inline +: EDEADLK 11 ; inline +: ENOMEM 12 ; inline +: EACCES 13 ; inline +: EFAULT 14 ; inline +: ENOTBLK 15 ; inline +: EBUSY 16 ; inline +: EEXIST 17 ; inline +: EXDEV 18 ; inline +: ENODEV 19 ; inline +: ENOTDIR 20 ; inline +: EISDIR 21 ; inline +: EINVAL 22 ; inline +: ENFILE 23 ; inline +: EMFILE 24 ; inline +: ENOTTY 25 ; inline +: ETXTBSY 26 ; inline +: EFBIG 27 ; inline +: ENOSPC 28 ; inline +: ESPIPE 29 ; inline +: EROFS 30 ; inline +: EMLINK 31 ; inline +: EPIPE 32 ; inline +: EDOM 33 ; inline +: ERANGE 34 ; inline +: EAGAIN 35 ; inline +: EWOULDBLOCK EAGAIN ; inline +: EINPROGRESS 36 ; inline +: EALREADY 37 ; inline +: ENOTSOCK 38 ; inline +: EDESTADDRREQ 39 ; inline +: EMSGSIZE 40 ; inline +: EPROTOTYPE 41 ; inline +: ENOPROTOOPT 42 ; inline +: EPROTONOSUPPORT 43 ; inline +: ESOCKTNOSUPPORT 44 ; inline +: ENOTSUP 45 ; inline +: EPFNOSUPPORT 46 ; inline +: EAFNOSUPPORT 47 ; inline +: EADDRINUSE 48 ; inline +: EADDRNOTAVAIL 49 ; inline +: ENETDOWN 50 ; inline +: ENETUNREACH 51 ; inline +: ENETRESET 52 ; inline +: ECONNABORTED 53 ; inline +: ECONNRESET 54 ; inline +: ENOBUFS 55 ; inline +: EISCONN 56 ; inline +: ENOTCONN 57 ; inline +: ESHUTDOWN 58 ; inline +: ETOOMANYREFS 59 ; inline +: ETIMEDOUT 60 ; inline +: ECONNREFUSED 61 ; inline +: ELOOP 62 ; inline +: ENAMETOOLONG 63 ; inline +: EHOSTDOWN 64 ; inline +: EHOSTUNREACH 65 ; inline +: ENOTEMPTY 66 ; inline +: EPROCLIM 67 ; inline +: EUSERS 68 ; inline +: EDQUOT 69 ; inline +: ESTALE 70 ; inline +: EREMOTE 71 ; inline +: EBADRPC 72 ; inline +: ERPCMISMATCH 73 ; inline +: EPROGUNAVAIL 74 ; inline +: EPROGMISMATCH 75 ; inline +: EPROCUNAVAIL 76 ; inline +: ENOLCK 77 ; inline +: ENOSYS 78 ; inline +: EFTYPE 79 ; inline +: EAUTH 80 ; inline +: ENEEDAUTH 81 ; inline +: EPWROFF 82 ; inline +: EDEVERR 83 ; inline +: EOVERFLOW 84 ; inline +: EBADEXEC 85 ; inline +: EBADARCH 86 ; inline +: ESHLIBVERS 87 ; inline +: EBADMACHO 88 ; inline +: ECANCELED 89 ; inline +: EIDRM 90 ; inline +: ENOMSG 91 ; inline +: EILSEQ 92 ; inline +: ENOATTR 93 ; inline +: EBADMSG 94 ; inline +: EMULTIHOP 95 ; inline +: ENODATA 96 ; inline +: ENOLINK 97 ; inline +: ENOSR 98 ; inline +: ENOSTR 99 ; inline +: EPROTO 100 ; inline +: ETIME 101 ; inline +: EOPNOTSUPP 102 ; inline +: ENOPOLICY 103 ; inline diff --git a/extra/unix/bsd/netbsd/netbsd.factor b/extra/unix/bsd/netbsd/netbsd.factor index 071daa682d..e646f87116 100644 --- a/extra/unix/bsd/netbsd/netbsd.factor +++ b/extra/unix/bsd/netbsd/netbsd.factor @@ -12,3 +12,102 @@ C-STRUCT: addrinfo { "char*" "canonname" } { "void*" "addr" } { "addrinfo*" "next" } ; + +: EPERM 1 ; inline +: ENOENT 2 ; inline +: ESRCH 3 ; inline +: EINTR 4 ; inline +: EIO 5 ; inline +: ENXIO 6 ; inline +: E2BIG 7 ; inline +: ENOEXEC 8 ; inline +: EBADF 9 ; inline +: ECHILD 10 ; inline +: EDEADLK 11 ; inline +: ENOMEM 12 ; inline +: EACCES 13 ; inline +: EFAULT 14 ; inline +: ENOTBLK 15 ; inline +: EBUSY 16 ; inline +: EEXIST 17 ; inline +: EXDEV 18 ; inline +: ENODEV 19 ; inline +: ENOTDIR 20 ; inline +: EISDIR 21 ; inline +: EINVAL 22 ; inline +: ENFILE 23 ; inline +: EMFILE 24 ; inline +: ENOTTY 25 ; inline +: ETXTBSY 26 ; inline +: EFBIG 27 ; inline +: ENOSPC 28 ; inline +: ESPIPE 29 ; inline +: EROFS 30 ; inline +: EMLINK 31 ; inline +: EPIPE 32 ; inline +: EDOM 33 ; inline +: ERANGE 34 ; inline +: EAGAIN 35 ; inline +: EWOULDBLOCK EAGAIN ; inline +: EINPROGRESS 36 ; inline +: EALREADY 37 ; inline +: ENOTSOCK 38 ; inline +: EDESTADDRREQ 39 ; inline +: EMSGSIZE 40 ; inline +: EPROTOTYPE 41 ; inline +: ENOPROTOOPT 42 ; inline +: EPROTONOSUPPORT 43 ; inline +: ESOCKTNOSUPPORT 44 ; inline +: EOPNOTSUPP 45 ; inline +: EPFNOSUPPORT 46 ; inline +: EAFNOSUPPORT 47 ; inline +: EADDRINUSE 48 ; inline +: EADDRNOTAVAIL 49 ; inline +: ENETDOWN 50 ; inline +: ENETUNREACH 51 ; inline +: ENETRESET 52 ; inline +: ECONNABORTED 53 ; inline +: ECONNRESET 54 ; inline +: ENOBUFS 55 ; inline +: EISCONN 56 ; inline +: ENOTCONN 57 ; inline +: ESHUTDOWN 58 ; inline +: ETOOMANYREFS 59 ; inline +: ETIMEDOUT 60 ; inline +: ECONNREFUSED 61 ; inline +: ELOOP 62 ; inline +: ENAMETOOLONG 63 ; inline +: EHOSTDOWN 64 ; inline +: EHOSTUNREACH 65 ; inline +: ENOTEMPTY 66 ; inline +: EPROCLIM 67 ; inline +: EUSERS 68 ; inline +: EDQUOT 69 ; inline +: ESTALE 70 ; inline +: EREMOTE 71 ; inline +: EBADRPC 72 ; inline +: ERPCMISMATCH 73 ; inline +: EPROGUNAVAIL 74 ; inline +: EPROGMISMATCH 75 ; inline +: EPROCUNAVAIL 76 ; inline +: ENOLCK 77 ; inline +: ENOSYS 78 ; inline +: EFTYPE 79 ; inline +: EAUTH 80 ; inline +: ENEEDAUTH 81 ; inline +: EIDRM 82 ; inline +: ENOMSG 83 ; inline +: EOVERFLOW 84 ; inline +: EILSEQ 85 ; inline +: ENOTSUP 86 ; inline +: ECANCELED 87 ; inline +: EBADMSG 88 ; inline +: ENODATA 89 ; inline +: ENOSR 90 ; inline +: ENOSTR 91 ; inline +: ETIME 92 ; inline +: ENOATTR 93 ; inline +: EMULTIHOP 94 ; inline +: ENOLINK 95 ; inline +: EPROTO 96 ; inline +: ELAST 96 ; inline diff --git a/extra/unix/bsd/openbsd/openbsd.factor b/extra/unix/bsd/openbsd/openbsd.factor index 29b44f7da6..31025a47e9 100644 --- a/extra/unix/bsd/openbsd/openbsd.factor +++ b/extra/unix/bsd/openbsd/openbsd.factor @@ -12,3 +12,93 @@ C-STRUCT: addrinfo { "void*" "addr" } { "char*" "canonname" } { "addrinfo*" "next" } ; + +: EPERM 1 ; inline +: ENOENT 2 ; inline +: ESRCH 3 ; inline +: EINTR 4 ; inline +: EIO 5 ; inline +: ENXIO 6 ; inline +: E2BIG 7 ; inline +: ENOEXEC 8 ; inline +: EBADF 9 ; inline +: ECHILD 10 ; inline +: EDEADLK 11 ; inline +: ENOMEM 12 ; inline +: EACCES 13 ; inline +: EFAULT 14 ; inline +: ENOTBLK 15 ; inline +: EBUSY 16 ; inline +: EEXIST 17 ; inline +: EXDEV 18 ; inline +: ENODEV 19 ; inline +: ENOTDIR 20 ; inline +: EISDIR 21 ; inline +: EINVAL 22 ; inline +: ENFILE 23 ; inline +: EMFILE 24 ; inline +: ENOTTY 25 ; inline +: ETXTBSY 26 ; inline +: EFBIG 27 ; inline +: ENOSPC 28 ; inline +: ESPIPE 29 ; inline +: EROFS 30 ; inline +: EMLINK 31 ; inline +: EPIPE 32 ; inline +: EDOM 33 ; inline +: ERANGE 34 ; inline +: EAGAIN 35 ; inline +: EWOULDBLOCK EAGAIN ; inline +: EINPROGRESS 36 ; inline +: EALREADY 37 ; inline +: ENOTSOCK 38 ; inline +: EDESTADDRREQ 39 ; inline +: EMSGSIZE 40 ; inline +: EPROTOTYPE 41 ; inline +: ENOPROTOOPT 42 ; inline +: EPROTONOSUPPORT 43 ; inline +: ESOCKTNOSUPPORT 44 ; inline +: EOPNOTSUPP 45 ; inline +: EPFNOSUPPORT 46 ; inline +: EAFNOSUPPORT 47 ; inline +: EADDRINUSE 48 ; inline +: EADDRNOTAVAIL 49 ; inline +: ENETDOWN 50 ; inline +: ENETUNREACH 51 ; inline +: ENETRESET 52 ; inline +: ECONNABORTED 53 ; inline +: ECONNRESET 54 ; inline +: ENOBUFS 55 ; inline +: EISCONN 56 ; inline +: ENOTCONN 57 ; inline +: ESHUTDOWN 58 ; inline +: ETOOMANYREFS 59 ; inline +: ETIMEDOUT 60 ; inline +: ECONNREFUSED 61 ; inline +: ELOOP 62 ; inline +: ENAMETOOLONG 63 ; inline +: EHOSTDOWN 64 ; inline +: EHOSTUNREACH 65 ; inline +: ENOTEMPTY 66 ; inline +: EPROCLIM 67 ; inline +: EUSERS 68 ; inline +: EDQUOT 69 ; inline +: ESTALE 70 ; inline +: EREMOTE 71 ; inline +: EBADRPC 72 ; inline +: ERPCMISMATCH 73 ; inline +: EPROGUNAVAIL 74 ; inline +: EPROGMISMATCH 75 ; inline +: EPROCUNAVAIL 76 ; inline +: ENOLCK 77 ; inline +: ENOSYS 78 ; inline +: EFTYPE 79 ; inline +: EAUTH 80 ; inline +: ENEEDAUTH 81 ; inline +: EIPSEC 82 ; inline +: ENOATTR 83 ; inline +: EILSEQ 84 ; inline +: ENOMEDIUM 85 ; inline +: EMEDIUMTYPE 86 ; inline +: EOVERFLOW 87 ; inline +: ECANCELED 88 ; inline diff --git a/extra/unix/linux/linux.factor b/extra/unix/linux/linux.factor index 9450663aaa..0d059d0374 100755 --- a/extra/unix/linux/linux.factor +++ b/extra/unix/linux/linux.factor @@ -59,10 +59,6 @@ C-STRUCT: sockaddr-un { "ushort" "family" } { { "char" max-un-path } "path" } ; -: EINTR HEX: 4 ; inline -: EAGAIN HEX: b ; inline -: EINPROGRESS HEX: 73 ; inline - : SOCK_STREAM 1 ; inline : SOCK_DGRAM 2 ; inline @@ -93,3 +89,101 @@ C-STRUCT: passwd { "char*" "pw_gecos" } { "char*" "pw_dir" } { "char*" "pw_shell" } ; + +: EDEADLK 35 ; inline +: ENAMETOOLONG 36 ; inline +: ENOLCK 37 ; inline +: ENOSYS 38 ; inline +: ENOTEMPTY 39 ; inline +: ELOOP 40 ; inline +: EWOULDBLOCK EAGAIN ; inline +: ENOMSG 42 ; inline +: EIDRM 43 ; inline +: ECHRNG 44 ; inline +: EL2NSYNC 45 ; inline +: EL3HLT 46 ; inline +: EL3RST 47 ; inline +: ELNRNG 48 ; inline +: EUNATCH 49 ; inline +: ENOCSI 50 ; inline +: EL2HLT 51 ; inline +: EBADE 52 ; inline +: EBADR 53 ; inline +: EXFULL 54 ; inline +: ENOANO 55 ; inline +: EBADRQC 56 ; inline +: EBADSLT 57 ; inline +: EDEADLOCK EDEADLK ; inline +: EBFONT 59 ; inline +: ENOSTR 60 ; inline +: ENODATA 61 ; inline +: ETIME 62 ; inline +: ENOSR 63 ; inline +: ENONET 64 ; inline +: ENOPKG 65 ; inline +: EREMOTE 66 ; inline +: ENOLINK 67 ; inline +: EADV 68 ; inline +: ESRMNT 69 ; inline +: ECOMM 70 ; inline +: EPROTO 71 ; inline +: EMULTIHOP 72 ; inline +: EDOTDOT 73 ; inline +: EBADMSG 74 ; inline +: EOVERFLOW 75 ; inline +: ENOTUNIQ 76 ; inline +: EBADFD 77 ; inline +: EREMCHG 78 ; inline +: ELIBACC 79 ; inline +: ELIBBAD 80 ; inline +: ELIBSCN 81 ; inline +: ELIBMAX 82 ; inline +: ELIBEXEC 83 ; inline +: EILSEQ 84 ; inline +: ERESTART 85 ; inline +: ESTRPIPE 86 ; inline +: EUSERS 87 ; inline +: ENOTSOCK 88 ; inline +: EDESTADDRREQ 89 ; inline +: EMSGSIZE 90 ; inline +: EPROTOTYPE 91 ; inline +: ENOPROTOOPT 92 ; inline +: EPROTONOSUPPORT 93 ; inline +: ESOCKTNOSUPPORT 94 ; inline +: EOPNOTSUPP 95 ; inline +: EPFNOSUPPORT 96 ; inline +: EAFNOSUPPORT 97 ; inline +: EADDRINUSE 98 ; inline +: EADDRNOTAVAIL 99 ; inline +: ENETDOWN 100 ; inline +: ENETUNREACH 101 ; inline +: ENETRESET 102 ; inline +: ECONNABORTED 103 ; inline +: ECONNRESET 104 ; inline +: ENOBUFS 105 ; inline +: EISCONN 106 ; inline +: ENOTCONN 107 ; inline +: ESHUTDOWN 108 ; inline +: ETOOMANYREFS 109 ; inline +: ETIMEDOUT 110 ; inline +: ECONNREFUSED 111 ; inline +: EHOSTDOWN 112 ; inline +: EHOSTUNREACH 113 ; inline +: EALREADY 114 ; inline +: EINPROGRESS 115 ; inline +: ESTALE 116 ; inline +: EUCLEAN 117 ; inline +: ENOTNAM 118 ; inline +: ENAVAIL 119 ; inline +: EISNAM 120 ; inline +: EREMOTEIO 121 ; inline +: EDQUOT 122 ; inline +: ENOMEDIUM 123 ; inline +: EMEDIUMTYPE 124 ; inline +: ECANCELED 125 ; inline +: ENOKEY 126 ; inline +: EKEYEXPIRED 127 ; inline +: EKEYREVOKED 128 ; inline +: EKEYREJECTED 129 ; inline +: EOWNERDEAD 130 ; inline +: ENOTRECOVERABLE 131 ; inline diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index f1f46fc184..07eb2950fa 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -5,7 +5,7 @@ USING: alien alien.c-types alien.syntax kernel libc structs sequences continuations byte-arrays strings math namespaces system combinators vocabs.loader qualified accessors inference macros locals shuffle arrays.lib - unix.types ; + unix.types debugger io prettyprint ; IN: unix @@ -23,9 +23,6 @@ TYPEDEF: uint socklen_t : MAP_FAILED -1 ; inline -: ESRCH 3 ; inline -: EEXIST 17 ; inline - : NGROUPS_MAX 16 ; inline C-STRUCT: group @@ -41,10 +38,30 @@ FUNCTION: int err_no ( ) ; LIBRARY: libc -ERROR: unix-system-call-error args message word ; - FUNCTION: char* strerror ( int errno ) ; +ERROR: unix-error errno message ; + +M: unix-error error. + "Unix system call failed:" print + nl + dup message>> write " (" write errno>> pprint ")" print ; + +: (io-error) ( -- * ) err_no dup strerror unix-error ; + +: io-error ( n -- ) 0 < [ (io-error) ] when ; + +ERROR: unix-system-call-error args errno message word ; + +M: unix-system-call-error error. + "Unix system call ``" write dup word>> pprint "'' failed:" print + nl + dup message>> write " (" write dup errno>> pprint ")" print + nl + "It was called with the following arguments:" print + nl + args>> stack. ; + MACRO:: unix-system-call ( quot -- ) [let | n [ quot infer in>> ] word [ quot first ] | @@ -52,7 +69,7 @@ MACRO:: unix-system-call ( quot -- ) n ndup quot call dup 0 < [ drop n narray - err_no strerror + err_no dup strerror word unix-system-call-error ] [ n nnip From f1c8f3c559e9ab9d8f5c934fbba116919c6c74f9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 May 2008 15:54:27 -0500 Subject: [PATCH 5/6] SSL context is now implicit --- extra/io/ports/ports.factor | 10 ++------ extra/io/sockets/sockets.factor | 9 +++++-- extra/io/unix/backend/backend.factor | 20 +++++----------- .../unix/sockets/secure/secure-tests.factor | 24 +++++++++++-------- extra/io/unix/sockets/secure/secure.factor | 10 ++++---- extra/openssl/openssl.factor | 17 ++++++++++--- 6 files changed, 49 insertions(+), 41 deletions(-) diff --git a/extra/io/ports/ports.factor b/extra/io/ports/ports.factor index b34d4b20ad..549362ad0c 100755 --- a/extra/io/ports/ports.factor +++ b/extra/io/ports/ports.factor @@ -115,7 +115,7 @@ M: output-port dispose* [ [ handle>> &dispose drop ] [ port-flush ] - [ [ handle>> shutdown ] with-timeout ] + [ handle>> shutdown ] tri ] with-destructors ; @@ -129,12 +129,6 @@ M: port cancel-operation handle>> cancel-operation ; M: port dispose* [ [ handle>> &dispose drop ] - [ [ handle>> shutdown ] with-timeout ] + [ handle>> shutdown ] bi ] with-destructors ; - -: ( read-handle write-handle -- input-port output-port ) - [ - [ |dispose ] - [ |dispose ] bi* - ] with-destructors ; diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 93185f50f6..c5dbded093 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -161,6 +161,11 @@ GENERIC: (get-remote-address) ( handle remote -- sockaddr ) : get-remote-address ( handle local -- remote ) [ (get-remote-address) ] keep parse-sockaddr ; +: ( handle -- input-port output-port ) + [ + [ |dispose ] [ |dispose ] bi + ] with-destructors ; + GENERIC: establish-connection ( client-out remote -- ) GENERIC: ((client)) ( remote -- handle ) @@ -173,7 +178,7 @@ M: object (client) ( remote -- client-in client-out local ) [ [ ((client)) ] keep [ - >r dup [ |dispose ] bi@ dup r> + >r [ |dispose ] bi@ dup r> establish-connection ] [ get-local-address ] @@ -210,7 +215,7 @@ GENERIC: (accept) ( server addrspec -- handle sockaddr ) dup addr>> [ (accept) ] keep parse-sockaddr swap - dup + ] keep encoding>> swap ; TUPLE: datagram-port < port addr ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index eecb0daf8f..2a85beac02 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -8,7 +8,6 @@ io.encodings.utf8 destructors accessors inspector combinators ; QUALIFIED: io IN: io.unix.backend -! I/O tasks GENERIC: handle-fd ( handle -- fd ) TUPLE: fd fd disposed ; @@ -18,10 +17,12 @@ TUPLE: fd fd disposed ; #! 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 ; + fd new + swap + [ F_SETFL O_NONBLOCK fcntl drop ] + [ F_SETFD FD_CLOEXEC fcntl drop ] + [ >>fd ] + tri ; M: fd dispose* [ cancel-operation ] [ fd>> close-file ] bi ; @@ -98,15 +99,6 @@ M: io-timeout summary drop "I/O operation timed out" ; ! Some general stuff : file-mode OCT: 0666 ; - -: (io-error) ( -- * ) err_no strerror throw ; - -: check-errno ( -- ) - err_no dup zero? [ drop ] [ strerror throw ] if ; - -: check-null ( n -- ) zero? [ (io-error) ] when ; - -: io-error ( n -- ) 0 < [ (io-error) ] when ; ! Readers : (refill) ( port -- n ) diff --git a/extra/io/unix/sockets/secure/secure-tests.factor b/extra/io/unix/sockets/secure/secure-tests.factor index 0df3c3d96b..a93a30379c 100644 --- a/extra/io/unix/sockets/secure/secure-tests.factor +++ b/extra/io/unix/sockets/secure/secure-tests.factor @@ -118,10 +118,12 @@ concurrency.promises byte-arrays locals calendar io.timeouts ; ] unit-test [ - [ - "127.0.0.1" "port" get ?promise - ascii drop 1 seconds over set-timeout dispose - ] with-secure-context + 1 seconds secure-socket-timeout [ + [ + "127.0.0.1" "port" get ?promise + ascii drop dispose + ] with-secure-context + ] with-variable ] [ io-timeout? ] must-fail-with ! Server socket shutdown timeout @@ -137,10 +139,12 @@ concurrency.promises byte-arrays locals calendar io.timeouts ; ] unit-test [ - [ - "127.0.0.1" 0 ascii [ - dup addr>> addrspec>> port>> "port" get fulfill - accept drop 1 seconds over set-timeout dispose - ] with-disposal - ] with-test-context + 1 seconds secure-socket-timeout [ + [ + "127.0.0.1" 0 ascii [ + dup addr>> addrspec>> port>> "port" get fulfill + accept drop dispose + ] with-disposal + ] with-test-context + ] with-variable ] [ io-timeout? ] must-fail-with diff --git a/extra/io/unix/sockets/secure/secure.factor b/extra/io/unix/sockets/secure/secure.factor index 4a99164acb..70e015ec8e 100755 --- a/extra/io/unix/sockets/secure/secure.factor +++ b/extra/io/unix/sockets/secure/secure.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors byte-arrays kernel debugger sequences namespaces math +USING: accessors unix 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 @@ -15,7 +15,7 @@ M: ssl-handle handle-fd file>> handle-fd ; ERR_get_error dup zero? [ drop { - { -1 [ (io-error) ] } + { -1 [ err_no ECONNRESET = [ premature-close ] [ (io-error) ] if ] } { 0 [ premature-close ] } } case ] [ @@ -157,5 +157,7 @@ M: secure (accept) dup dup handle>> SSL_shutdown check-shutdown-response dup [ dupd wait-for-fd (shutdown) ] [ 2drop ] if ; -M: ssl-handle shutdown USE: io.streams.c - dup connected>> [ f >>connected (shutdown) ] [ drop ] if ; +M: ssl-handle shutdown + dup connected>> [ + f >>connected [ (shutdown) ] with-timeout + ] [ drop ] if ; diff --git a/extra/openssl/openssl.factor b/extra/openssl/openssl.factor index bf00d64020..80274cdac5 100755 --- a/extra/openssl/openssl.factor +++ b/extra/openssl/openssl.factor @@ -159,11 +159,22 @@ ERROR: no-secure-context ; M: no-secure-context summary drop "Secure socket operations must be wrapped in calls to with-secure-context" ; -: current-ssl-context ( -- ctx ) - secure-context get [ no-secure-context ] unless* ; +SYMBOL: default-secure-context + +: context-expired? ( context -- ? ) + dup [ handle>> expired? ] [ drop t ] if ; + +: current-secure-context ( -- ctx ) + secure-context get [ + default-secure-context get dup context-expired? [ + drop + default-secure-context set-global + current-secure-context + ] when + ] unless* ; : ( fd -- ssl ) - current-ssl-context handle>> SSL_new dup ssl-error + current-secure-context handle>> SSL_new dup ssl-error f f ssl-handle boa ; M: ssl-handle dispose* From 5b321c2308ab6337635d270e11b9b404b87b3cb7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 May 2008 16:07:41 -0500 Subject: [PATCH 6/6] Dynamically loading libssl doesn't work on OpenBSD for some reason; link VM with it --- extra/openssl/libcrypto/libcrypto.factor | 11 ++++++----- extra/openssl/libssl/libssl.factor | 11 ++++++----- vm/Config.openbsd | 2 +- 3 files changed, 13 insertions(+), 11 deletions(-) diff --git a/extra/openssl/libcrypto/libcrypto.factor b/extra/openssl/libcrypto/libcrypto.factor index 20b606db66..80bf3b1772 100755 --- a/extra/openssl/libcrypto/libcrypto.factor +++ b/extra/openssl/libcrypto/libcrypto.factor @@ -10,11 +10,12 @@ USING: alien alien.syntax combinators kernel system ; IN: openssl.libcrypto << -"libcrypto" { - { [ os winnt? ] [ "libeay32.dll" "cdecl" ] } - { [ os macosx? ] [ "libcrypto.dylib" "cdecl" ] } - { [ os unix? ] [ "libcrypto.so" "cdecl" ] } -} cond add-library +{ + { [ os openbsd? ] [ ] } ! VM is linked with it + { [ os winnt? ] [ "libcrypto" "libeay32.dll" "cdecl" add-library ] } + { [ os macosx? ] [ "libcrypto" "libcrypto.dylib" "cdecl" add-library ] } + { [ os unix? ] [ "libcrypto" "libcrypto.so" "cdecl" add-library ] } +} cond >> C-STRUCT: bio-method diff --git a/extra/openssl/libssl/libssl.factor b/extra/openssl/libssl/libssl.factor index f5680972f3..6fa2e6fd77 100755 --- a/extra/openssl/libssl/libssl.factor +++ b/extra/openssl/libssl/libssl.factor @@ -10,11 +10,12 @@ assocs parser sequences words quotations ; IN: openssl.libssl -<< "libssl" { - { [ os winnt? ] [ "ssleay32.dll" "cdecl" ] } - { [ os macosx? ] [ "libssl.dylib" "cdecl" ] } - { [ os unix? ] [ "libssl.so" "cdecl" ] } -} cond add-library >> +<< { + { [ os openbsd? ] [ ] } ! VM is linked with it + { [ os winnt? ] [ "libssl" "ssleay32.dll" "cdecl" add-library ] } + { [ os macosx? ] [ "libssl" "libssl.dylib" "cdecl" add-library ] } + { [ os unix? ] [ "libssl" "libssl.so" "cdecl" add-library ] } +} cond >> : X509_FILETYPE_PEM 1 ; inline : X509_FILETYPE_ASN1 2 ; inline diff --git a/vm/Config.openbsd b/vm/Config.openbsd index 240adf8087..4b1ab88775 100644 --- a/vm/Config.openbsd +++ b/vm/Config.openbsd @@ -2,4 +2,4 @@ include vm/Config.unix PLAF_DLL_OBJS += vm/os-genunix.o vm/os-openbsd.o CC = egcc CFLAGS += -export-dynamic -LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz +LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz -lssl -lcrypto