steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
erg 2008-05-21 16:09:47 -05:00
parent 5b0d7bb3b7 ebc860ec4b
commit 15ac39bc7b
24 changed files with 732 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/io/launcher/launcher.factor
View File

@ -147,7 +147,7 @@ M: process timeout timeout>> ;
M: process set-timeout set-process-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 M: object run-pipeline-element
[ >process swap >>stdout swap >>stdin run-detached ] [ >process swap >>stdout swap >>stdin run-detached ]

13
extra/io/pipes/pipes-tests.factor
View File

@ -1,6 +1,7 @@
USING: io io.pipes io.streams.string io.encodings.utf8 USING: io io.pipes io.streams.string io.encodings.utf8
io.streams.duplex io.encodings io.timeouts namespaces 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 IN: io.pipes.tests
[ "Hello" ] [ [ "Hello" ] [
@ -31,3 +32,13 @@ IN: io.pipes.tests
stream-readln stream-readln
] with-disposal ] with-disposal
] must-fail ] must-fail
[ ] [
1000 [
utf8 <pipe> [
[ in>> dispose ]
[ out>> "hi" over stream-write dispose ]
bi
] curry ignore-errors
] times
] unit-test

24
extra/io/ports/ports.factor
View File

@ -100,6 +100,10 @@ M: output-port stream-write
HOOK: (wait-to-write) io-backend ( port -- ) HOOK: (wait-to-write) io-backend ( port -- )
GENERIC: shutdown ( handle -- )
M: object shutdown drop ;
: port-flush ( port -- ) : port-flush ( port -- )
dup buffer>> buffer-empty? dup buffer>> buffer-empty?
[ drop ] [ dup (wait-to-write) port-flush ] if ; [ drop ] [ dup (wait-to-write) port-flush ] if ;
@ -108,21 +112,23 @@ M: output-port stream-flush ( port -- )
[ check-disposed ] [ port-flush ] bi ; [ check-disposed ] [ port-flush ] bi ;
M: output-port dispose* M: output-port dispose*
[ port-flush ] [ call-next-method ] bi ; [
[ handle>> &dispose drop ]
[ port-flush ]
[ handle>> shutdown ]
tri
] with-destructors ;
M: buffered-port dispose* M: buffered-port dispose*
[ call-next-method ] [ call-next-method ]
[ [ [ buffer-free ] when* f ] change-buffer drop ] [ [ [ buffer-free ] when* f ] change-buffer drop ]
bi ; bi ;
GENERIC: cancel-io ( handle -- ) M: port cancel-operation handle>> cancel-operation ;
M: port timed-out handle>> cancel-io ; M: port dispose*
M: port dispose* handle>> [ cancel-io ] [ dispose ] bi ;
: <ports> ( read-handle write-handle -- input-port output-port )
[ [
[ <input-port> |dispose ] [ handle>> &dispose drop ]
[ <output-port> |dispose ] bi* [ handle>> shutdown ]
bi
] with-destructors ; ] with-destructors ;

6
extra/io/sockets/secure/secure.factor
View File

@ -1,9 +1,13 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel symbols namespaces continuations USING: accessors kernel symbols namespaces continuations
destructors io.sockets sequences inspector ; destructors io.sockets sequences inspector calendar ;
IN: io.sockets.secure IN: io.sockets.secure
SYMBOL: secure-socket-timeout
1 minutes secure-socket-timeout set-global
SYMBOL: secure-socket-backend SYMBOL: secure-socket-backend
SINGLETONS: SSLv2 SSLv23 SSLv3 TLSv1 ; SINGLETONS: SSLv2 SSLv23 SSLv3 TLSv1 ;

9
extra/io/sockets/sockets.factor
View File

@ -161,6 +161,11 @@ GENERIC: (get-remote-address) ( handle remote -- sockaddr )
: get-remote-address ( handle local -- remote ) : get-remote-address ( handle local -- remote )
[ (get-remote-address) ] keep parse-sockaddr ; [ (get-remote-address) ] keep parse-sockaddr ;
: <ports> ( handle -- input-port output-port )
[
[ <input-port> |dispose ] [ <output-port> |dispose ] bi
] with-destructors ;
GENERIC: establish-connection ( client-out remote -- ) GENERIC: establish-connection ( client-out remote -- )
GENERIC: ((client)) ( remote -- handle ) GENERIC: ((client)) ( remote -- handle )
@ -173,7 +178,7 @@ M: object (client) ( remote -- client-in client-out local )
[ [
[ ((client)) ] keep [ ((client)) ] keep
[ [
>r dup <ports> [ |dispose ] bi@ dup r> >r <ports> [ |dispose ] bi@ dup r>
establish-connection establish-connection
] ]
[ get-local-address ] [ get-local-address ]
@ -210,7 +215,7 @@ GENERIC: (accept) ( server addrspec -- handle sockaddr )
dup addr>> dup addr>>
[ (accept) ] keep [ (accept) ] keep
parse-sockaddr swap parse-sockaddr swap
dup <ports> <ports>
] keep encoding>> <encoder-duplex> swap ; ] keep encoding>> <encoder-duplex> swap ;
TUPLE: datagram-port < port addr ; TUPLE: datagram-port < port addr ;

6
extra/io/timeouts/timeouts-docs.factor
View File

@ -9,20 +9,20 @@ HELP: set-timeout
{ $values { "dt/f" "a " { $link duration } " or " { $link f } } { "obj" object } } { $values { "dt/f" "a " { $link duration } " or " { $link f } } { "obj" object } }
{ $contract "Sets an object's timeout." } ; { $contract "Sets an object's timeout." } ;
HELP: timed-out HELP: cancel-operation
{ $values { "obj" object } } { $values { "obj" object } }
{ $contract "Handles a timeout, usually by waking up all threads waiting on the object." } ; { $contract "Handles a timeout, usually by waking up all threads waiting on the object." } ;
HELP: with-timeout HELP: with-timeout
{ $values { "obj" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } } } { $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" 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." "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 timeout }
{ $subsection set-timeout } { $subsection set-timeout }
"The I/O timeout protocol can be implemented by any class wishing to support timeouts on blocking operations." "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:" "A combinator to be used in operations which can time out:"
{ $subsection with-timeout } { $subsection with-timeout }
{ $see-also "stream-protocol" "io.launcher" "io.monitors" } ; { $see-also "stream-protocol" "io.launcher" "io.monitors" } ;

15
extra/io/timeouts/timeouts.factor
View File

@ -11,17 +11,18 @@ M: decoder set-timeout stream>> set-timeout ;
M: encoder 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 ) : 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 -- ) : with-timeout ( obj quot -- )
over dup timeout dup [ over timeout [ >r dup timeout r> with-timeout* ] [ call ] if ;
queue-timeout slip cancel-alarm inline
] [
2drop call
] if ; inline
: timeouts ( dt -- ) : timeouts ( dt -- )
[ input-stream get set-timeout ] [ input-stream get set-timeout ]

44
extra/io/unix/backend/backend.factor
View File

@ -8,7 +8,6 @@ io.encodings.utf8 destructors accessors inspector combinators ;
QUALIFIED: io QUALIFIED: io
IN: io.unix.backend IN: io.unix.backend
! I/O tasks
GENERIC: handle-fd ( handle -- fd ) GENERIC: handle-fd ( handle -- fd )
TUPLE: fd fd disposed ; TUPLE: fd fd disposed ;
@ -18,12 +17,15 @@ TUPLE: fd fd disposed ;
#! since on OS X 10.3, this operation fails from init-io #! since on OS X 10.3, this operation fails from init-io
#! when running the Factor.app (presumably because fd 0 and #! when running the Factor.app (presumably because fd 0 and
#! 1 are closed). #! 1 are closed).
[ F_SETFL O_NONBLOCK fcntl drop ] fd new
[ F_SETFD FD_CLOEXEC fcntl drop ] swap
[ f fd boa ] [ F_SETFL O_NONBLOCK fcntl drop ]
tri ; [ F_SETFD FD_CLOEXEC fcntl drop ]
[ >>fd ]
tri ;
M: fd dispose* fd>> close-file ; M: fd dispose*
[ cancel-operation ] [ fd>> close-file ] bi ;
M: fd handle-fd dup check-disposed fd>> ; M: fd handle-fd dup check-disposed fd>> ;
@ -62,7 +64,7 @@ GENERIC: wait-for-events ( ms mx -- )
: output-available ( fd mx -- ) : output-available ( fd mx -- )
remove-output-callbacks [ resume ] each ; remove-output-callbacks [ resume ] each ;
M: fd cancel-io ( fd -- ) M: fd cancel-operation ( fd -- )
dup disposed>> [ drop ] [ dup disposed>> [ drop ] [
fd>> fd>>
mx get-global mx get-global
@ -75,8 +77,12 @@ SYMBOL: +retry+ ! just try the operation again without blocking
SYMBOL: +input+ SYMBOL: +input+
SYMBOL: +output+ SYMBOL: +output+
: wait-for-fd ( handle event -- timeout? ) ERROR: io-timeout ;
dup +retry+ eq? [ 2drop f ] [
M: io-timeout summary drop "I/O operation timed out" ;
: wait-for-fd ( handle event -- )
dup +retry+ eq? [ 2drop ] [
[ [
>r >r
swap handle-fd swap handle-fd
@ -85,30 +91,14 @@ SYMBOL: +output+
{ +input+ [ add-input-callback ] } { +input+ [ add-input-callback ] }
{ +output+ [ add-output-callback ] } { +output+ [ add-output-callback ] }
} case } case
] curry "I/O" suspend nip ] curry "I/O" suspend nip [ io-timeout ] when
] if ; ] if ;
ERROR: io-timeout ;
M: io-timeout summary drop "I/O operation timed out" ;
: wait-for-port ( port event -- ) : wait-for-port ( port event -- )
[ [ >r handle>> r> wait-for-fd ] curry with-timeout ;
>r handle>> r> wait-for-fd
[ io-timeout ] when
] curry with-timeout ;
! Some general stuff ! Some general stuff
: file-mode OCT: 0666 ; : 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 ! Readers
: (refill) ( port -- n ) : (refill) ( port -- n )

89
extra/io/unix/sockets/secure/secure-tests.factor
View File

@ -1,8 +1,8 @@
IN: io.sockets.secure.tests IN: io.sockets.secure.tests
USING: accessors kernel namespaces io io.sockets USING: accessors kernel namespaces io io.sockets
io.sockets.secure io.encodings.ascii io.streams.duplex io.sockets.secure io.encodings.ascii io.streams.duplex
classes words destructors threads tools.test io.unix.backend classes words destructors threads tools.test
concurrency.promises byte-arrays locals ; concurrency.promises byte-arrays locals calendar io.timeouts ;
\ <secure-config> must-infer \ <secure-config> must-infer
{ 1 0 } [ [ ] with-secure-context ] must-infer-as { 1 0 } [ [ ] with-secure-context ] must-infer-as
@ -63,3 +63,88 @@ concurrency.promises byte-arrays locals ;
<client> drop dispose <client> drop dispose
] with-secure-context ] with-secure-context
] [ certificate-verify-error? ] must-fail-with ] [ certificate-verify-error? ] must-fail-with
! Client-side handshake timeout
[ ] [ <promise> "port" set ] unit-test
[ ] [
[
"127.0.0.1" 0 <inet4> ascii <server> [
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
[ ] [ <promise> "port" set ] unit-test
[ ] [
[
"127.0.0.1" "port" get ?promise
<inet4> ascii <client> drop 1 minutes sleep dispose
] "Silly client" spawn drop
] unit-test
[
1 seconds secure-socket-timeout [
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
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
[ ] [ <promise> "port" set ] unit-test
[ ] [
[
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill
accept drop 1 minutes sleep dispose
] with-disposal
] with-test-context
] "Silly server" spawn drop
] unit-test
[
1 seconds secure-socket-timeout [
<secure-config> [
"127.0.0.1" "port" get ?promise <inet4> <secure>
ascii <client> drop dispose
] with-secure-context
] with-variable
] [ io-timeout? ] must-fail-with
! Server socket shutdown timeout
[ ] [ <promise> "port" set ] unit-test
[ ] [
[
[
"127.0.0.1" "port" get ?promise
<inet4> <secure> ascii <client> drop 1 minutes sleep dispose
] with-test-context
] "Silly client" spawn drop
] unit-test
[
1 seconds secure-socket-timeout [
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill
accept drop dispose
] with-disposal
] with-test-context
] with-variable
] [ io-timeout? ] must-fail-with

48
extra/io/unix/sockets/secure/secure.factor
View File

@ -1,12 +1,12 @@
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI. ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license. ! 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 math.order combinators init alien alien.c-types alien.strings libc
continuations destructors continuations destructors
openssl openssl.libcrypto openssl.libssl openssl openssl.libcrypto openssl.libssl
io.files io.ports 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 io.encodings.ascii io.buffers io.sockets io.sockets.secure
unix system inspector ; io.timeouts system inspector ;
IN: io.unix.sockets.secure IN: io.unix.sockets.secure
M: ssl-handle handle-fd file>> handle-fd ; M: ssl-handle handle-fd file>> handle-fd ;
@ -15,7 +15,7 @@ M: ssl-handle handle-fd file>> handle-fd ;
ERR_get_error dup zero? [ ERR_get_error dup zero? [
drop drop
{ {
{ -1 [ (io-error) ] } { -1 [ err_no ECONNRESET = [ premature-close ] [ (io-error) ] if ] }
{ 0 [ premature-close ] } { 0 [ premature-close ] }
} case } case
] [ ] [
@ -64,8 +64,11 @@ M: ssl-handle drain
SSL_write SSL_write
check-write-response ; check-write-response ;
M: ssl-handle cancel-io M: ssl-handle cancel-operation
file>> cancel-io ; file>> cancel-operation ;
M: ssl-handle timeout
drop secure-socket-timeout get ;
! Client sockets ! Client sockets
: <ssl-socket> ( fd -- ssl ) : <ssl-socket> ( fd -- ssl )
@ -79,8 +82,8 @@ M: secure parse-sockaddr addrspec>> parse-sockaddr <secure> ;
M: secure (get-local-address) addrspec>> (get-local-address) ; M: secure (get-local-address) addrspec>> (get-local-address) ;
: check-connect-response ( port r -- event ) : check-connect-response ( ssl-handle r -- event )
check-response over handle>> over SSL_get_error
{ {
{ SSL_ERROR_NONE [ 2drop f ] } { SSL_ERROR_NONE [ 2drop f ] }
{ SSL_ERROR_WANT_READ [ 2drop +input+ ] } { SSL_ERROR_WANT_READ [ 2drop +input+ ] }
@ -89,16 +92,18 @@ M: secure (get-local-address) addrspec>> (get-local-address) ;
{ SSL_ERROR_SSL [ (ssl-error) ] } { SSL_ERROR_SSL [ (ssl-error) ] }
} case ; } case ;
: do-ssl-connect ( port -- ) : do-ssl-connect ( ssl-handle -- )
dup dup handle>> handle>> SSL_connect dup dup handle>> SSL_connect check-connect-response dup
check-connect-response dup [ dupd wait-for-fd do-ssl-connect ] [ 2drop ] if ;
[ dupd wait-for-port do-ssl-connect ] [ 2drop ] if ;
M: secure establish-connection ( client-out remote -- ) M: secure establish-connection ( client-out remote -- )
[ addrspec>> establish-connection ] [ addrspec>> establish-connection ]
[ drop do-ssl-connect ] [
[ drop handle>> t >>connected drop ] drop handle>>
2tri ; [ [ do-ssl-connect ] with-timeout ]
[ t >>connected drop ]
bi
] 2bi ;
M: secure (server) addrspec>> (server) ; M: secure (server) addrspec>> (server) ;
@ -114,13 +119,13 @@ M: secure (server) addrspec>> (server) ;
: do-ssl-accept ( ssl-handle -- ) : do-ssl-accept ( ssl-handle -- )
dup dup handle>> SSL_accept check-accept-response dup 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) M: secure (accept)
[ [
addrspec>> (accept) >r addrspec>> (accept) >r
|dispose <ssl-socket> t >>connected |dispose |dispose <ssl-socket> t >>connected |dispose
dup do-ssl-accept r> dup [ do-ssl-accept ] with-timeout r>
] with-destructors ; ] with-destructors ;
: check-shutdown-response ( handle r -- event ) : check-shutdown-response ( handle r -- event )
@ -130,7 +135,7 @@ M: secure (accept)
{ 0 [ { 0 [
dup handle>> dup f 0 SSL_read 2dup SSL_get_error 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_READ [ 3drop +input+ ] }
{ SSL_ERROR_WANT_WRITE [ 3drop +output+ ] } { SSL_ERROR_WANT_WRITE [ 3drop +output+ ] }
{ SSL_ERROR_SYSCALL [ syscall-error ] } { SSL_ERROR_SYSCALL [ syscall-error ] }
@ -148,8 +153,11 @@ M: secure (accept)
] } ] }
} case ; } case ;
M: unix ssl-shutdown : (shutdown) ( handle -- )
dup dup handle>> SSL_shutdown check-shutdown-response
dup [ dupd wait-for-fd (shutdown) ] [ 2drop ] if ;
M: ssl-handle shutdown
dup connected>> [ dup connected>> [
dup dup handle>> SSL_shutdown check-shutdown-response f >>connected [ (shutdown) ] with-timeout
dup [ dupd wait-for-fd drop ssl-shutdown ] [ 2drop ] if
] [ drop ] if ; ] [ drop ] if ;

2
extra/io/windows/nt/backend/backend.factor
View File

@ -71,7 +71,7 @@ M: winnt add-completion ( win32-handle -- )
resume-callback t resume-callback t
] if ; ] if ;
M: win32-handle cancel-io M: win32-handle cancel-operation
handle>> CancelIo drop ; handle>> CancelIo drop ;
M: winnt io-multiplex ( ms -- ) M: winnt io-multiplex ( ms -- )

3
extra/io/windows/windows.factor
View File

@ -24,6 +24,9 @@ TUPLE: win32-file < win32-handle ptr ;
: <win32-file> ( handle -- win32-file ) : <win32-file> ( handle -- win32-file )
win32-file new-win32-handle ; win32-file new-win32-handle ;
M: win32-file dispose*
[ cancel-operation ] [ call-next-method ] bi ;
HOOK: CreateFile-flags io-backend ( DWORD -- DWORD ) HOOK: CreateFile-flags io-backend ( DWORD -- DWORD )
HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
HOOK: add-completion io-backend ( port -- ) HOOK: add-completion io-backend ( port -- )

11
extra/openssl/libcrypto/libcrypto.factor
View File

@ -10,11 +10,12 @@ USING: alien alien.syntax combinators kernel system ;
IN: openssl.libcrypto IN: openssl.libcrypto
<< <<
"libcrypto" { {
{ [ os winnt? ] [ "libeay32.dll" "cdecl" ] } { [ os openbsd? ] [ ] } ! VM is linked with it
{ [ os macosx? ] [ "libcrypto.dylib" "cdecl" ] } { [ os winnt? ] [ "libcrypto" "libeay32.dll" "cdecl" add-library ] }
{ [ os unix? ] [ "libcrypto.so" "cdecl" ] } { [ os macosx? ] [ "libcrypto" "libcrypto.dylib" "cdecl" add-library ] }
} cond add-library { [ os unix? ] [ "libcrypto" "libcrypto.so" "cdecl" add-library ] }
} cond
>> >>
C-STRUCT: bio-method C-STRUCT: bio-method

11
extra/openssl/libssl/libssl.factor
View File

@ -10,11 +10,12 @@ assocs parser sequences words quotations ;
IN: openssl.libssl IN: openssl.libssl
<< "libssl" { << {
{ [ os winnt? ] [ "ssleay32.dll" "cdecl" ] } { [ os openbsd? ] [ ] } ! VM is linked with it
{ [ os macosx? ] [ "libssl.dylib" "cdecl" ] } { [ os winnt? ] [ "libssl" "ssleay32.dll" "cdecl" add-library ] }
{ [ os unix? ] [ "libssl.so" "cdecl" ] } { [ os macosx? ] [ "libssl" "libssl.dylib" "cdecl" add-library ] }
} cond add-library >> { [ os unix? ] [ "libssl" "libssl.so" "cdecl" add-library ] }
} cond >>
: X509_FILETYPE_PEM 1 ; inline : X509_FILETYPE_PEM 1 ; inline
: X509_FILETYPE_ASN1 2 ; inline : X509_FILETYPE_ASN1 2 ; inline

27
extra/openssl/openssl.factor
View File

@ -5,7 +5,8 @@ math.order combinators init alien alien.c-types alien.strings libc
continuations destructors debugger inspector continuations destructors debugger inspector
locals unicode.case locals unicode.case
openssl.libcrypto openssl.libssl 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 IN: openssl
! This code is based on http://www.rtfm.com/openssl-examples/ ! This code is based on http://www.rtfm.com/openssl-examples/
@ -158,20 +159,26 @@ ERROR: no-secure-context ;
M: no-secure-context summary M: no-secure-context summary
drop "Secure socket operations must be wrapped in calls to with-secure-context" ; drop "Secure socket operations must be wrapped in calls to with-secure-context" ;
: current-ssl-context ( -- ctx ) SYMBOL: default-secure-context
secure-context get [ no-secure-context ] unless* ;
: context-expired? ( context -- ? )
dup [ handle>> expired? ] [ drop t ] if ;
: current-secure-context ( -- ctx )
secure-context get [
default-secure-context get dup context-expired? [
drop
<secure-config> <secure-context> default-secure-context set-global
current-secure-context
] when
] unless* ;
: <ssl-handle> ( fd -- ssl ) : <ssl-handle> ( 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 ; f f ssl-handle boa ;
HOOK: ssl-shutdown io-backend ( handle -- )
M: ssl-handle dispose* M: ssl-handle dispose*
[ ssl-shutdown ] [ handle>> SSL_free ] [ file>> dispose ] bi ;
[ handle>> SSL_free ]
[ file>> dispose ]
tri ;
: check-verify-result ( ssl-handle -- ) : check-verify-result ( ssl-handle -- )
SSL_get_verify_result dup X509_V_OK = SSL_get_verify_result dup X509_V_OK =

5
extra/ui/gadgets/panes/panes.factor
View File

@ -9,7 +9,7 @@ quotations math opengl combinators math.vectors
sorting splitting io.streams.nested assocs sorting splitting io.streams.nested assocs
ui.gadgets.presentations ui.gadgets.slots ui.gadgets.grids ui.gadgets.presentations ui.gadgets.slots ui.gadgets.grids
ui.gadgets.grid-lines classes.tuple models continuations ui.gadgets.grid-lines classes.tuple models continuations
destructors ; destructors accessors ;
IN: ui.gadgets.panes IN: ui.gadgets.panes
TUPLE: pane output current prototype scrolls? TUPLE: pane output current prototype scrolls?
@ -114,6 +114,9 @@ GENERIC: write-gadget ( gadget stream -- )
M: pane-stream write-gadget M: pane-stream write-gadget
pane-stream-pane pane-current add-gadget ; pane-stream-pane pane-current add-gadget ;
M: style-stream write-gadget
stream>> write-gadget ;
: print-gadget ( gadget stream -- ) : print-gadget ( gadget stream -- )
tuck write-gadget stream-nl ; tuck write-gadget stream-nl ;

4
extra/unix/bsd/bsd.factor
View File

@ -48,10 +48,6 @@ C-STRUCT: sockaddr-un
: max-un-path 104 ; inline : max-un-path 104 ; inline
: EINTR HEX: 4 ; inline
: EAGAIN HEX: 23 ; inline
: EINPROGRESS HEX: 24 ; inline
: SOCK_STREAM 1 ; inline : SOCK_STREAM 1 ; inline
: SOCK_DGRAM 2 ; inline : SOCK_DGRAM 2 ; inline

95
extra/unix/bsd/freebsd/freebsd.factor
View File

@ -12,3 +12,98 @@ C-STRUCT: addrinfo
{ "char*" "canonname" } { "char*" "canonname" }
{ "void*" "addr" } { "void*" "addr" }
{ "addrinfo*" "next" } ; { "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

105
extra/unix/bsd/macosx/macosx.factor
View File

@ -25,3 +25,108 @@ C-STRUCT: passwd
{ "char*" "pw_shell" } { "char*" "pw_shell" }
{ "time_t" "pw_expire" } { "time_t" "pw_expire" }
{ "int" "pw_fields" } ; { "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

99
extra/unix/bsd/netbsd/netbsd.factor
View File

@ -12,3 +12,102 @@ C-STRUCT: addrinfo
{ "char*" "canonname" } { "char*" "canonname" }
{ "void*" "addr" } { "void*" "addr" }
{ "addrinfo*" "next" } ; { "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

90
extra/unix/bsd/openbsd/openbsd.factor
View File

@ -12,3 +12,93 @@ C-STRUCT: addrinfo
{ "void*" "addr" } { "void*" "addr" }
{ "char*" "canonname" } { "char*" "canonname" }
{ "addrinfo*" "next" } ; { "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

102
extra/unix/linux/linux.factor
View File

@ -59,10 +59,6 @@ C-STRUCT: sockaddr-un
{ "ushort" "family" } { "ushort" "family" }
{ { "char" max-un-path } "path" } ; { { "char" max-un-path } "path" } ;
: EINTR HEX: 4 ; inline
: EAGAIN HEX: b ; inline
: EINPROGRESS HEX: 73 ; inline
: SOCK_STREAM 1 ; inline : SOCK_STREAM 1 ; inline
: SOCK_DGRAM 2 ; inline : SOCK_DGRAM 2 ; inline
@ -93,3 +89,101 @@ C-STRUCT: passwd
{ "char*" "pw_gecos" } { "char*" "pw_gecos" }
{ "char*" "pw_dir" } { "char*" "pw_dir" }
{ "char*" "pw_shell" } ; { "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

31
extra/unix/unix.factor
View File

@ -5,7 +5,7 @@ USING: alien alien.c-types alien.syntax kernel libc structs sequences
continuations byte-arrays strings continuations byte-arrays strings
math namespaces system combinators vocabs.loader qualified math namespaces system combinators vocabs.loader qualified
accessors inference macros locals shuffle arrays.lib accessors inference macros locals shuffle arrays.lib
unix.types ; unix.types debugger io prettyprint ;
IN: unix IN: unix
@ -23,9 +23,6 @@ TYPEDEF: uint socklen_t
: MAP_FAILED -1 <alien> ; inline : MAP_FAILED -1 <alien> ; inline
: ESRCH 3 ; inline
: EEXIST 17 ; inline
: NGROUPS_MAX 16 ; inline : NGROUPS_MAX 16 ; inline
C-STRUCT: group C-STRUCT: group
@ -41,10 +38,30 @@ FUNCTION: int err_no ( ) ;
LIBRARY: libc LIBRARY: libc
ERROR: unix-system-call-error args message word ;
FUNCTION: char* strerror ( int errno ) ; 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 -- ) MACRO:: unix-system-call ( quot -- )
[let | n [ quot infer in>> ] [let | n [ quot infer in>> ]
word [ quot first ] | word [ quot first ] |
@ -52,7 +69,7 @@ MACRO:: unix-system-call ( quot -- )
n ndup quot call dup 0 < [ n ndup quot call dup 0 < [
drop drop
n narray n narray
err_no strerror err_no dup strerror
word unix-system-call-error word unix-system-call-error
] [ ] [
n nnip n nnip

2
vm/Config.openbsd
View File

@ -2,4 +2,4 @@ include vm/Config.unix
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-openbsd.o PLAF_DLL_OBJS += vm/os-genunix.o vm/os-openbsd.o
CC = egcc CC = egcc
CFLAGS += -export-dynamic 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