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

db4
erg 2008-05-19 21:52:54 -05:00
commit e486ce8a0f
7 changed files with 46 additions and 68 deletions

View File

@ -6,12 +6,12 @@ ARTICLE: "stream-binary" "Working with binary data"
$nl $nl
"There are two ways to order the bytes making up an integer; " { $emphasis "little endian" } " byte order outputs the least significant byte first, and the most significant byte last, whereas " { $emphasis "big endian" } " is the other way around." "There are two ways to order the bytes making up an integer; " { $emphasis "little endian" } " byte order outputs the least significant byte first, and the most significant byte last, whereas " { $emphasis "big endian" } " is the other way around."
$nl $nl
"Consider the hexadecimal integer "{ $snippet "HEX: cafebabe" } ". Big endian byte order yields the following sequence of bytes:" "Consider the hexadecimal integer "{ $snippet "HEX: cafebabe" } ". Little endian byte order yields the following sequence of bytes:"
{ $table { $table
{ "Byte:" "1" "2" "3" "4" } { "Byte:" "1" "2" "3" "4" }
{ "Value:" { $snippet "be" } { $snippet "ba" } { $snippet "fe" } { $snippet "ca" } } { "Value:" { $snippet "be" } { $snippet "ba" } { $snippet "fe" } { $snippet "ca" } }
} }
"Compare this with little endian byte order:" "Compare this with big endian byte order:"
{ $table { $table
{ "Byte:" "1" "2" "3" "4" } { "Byte:" "1" "2" "3" "4" }
{ "Value:" { $snippet "ca" } { $snippet "fe" } { $snippet "ba" } { $snippet "be" } } { "Value:" { $snippet "ca" } { $snippet "fe" } { $snippet "ba" } { $snippet "be" } }

View File

@ -821,8 +821,8 @@ HELP: 3append
HELP: subseq HELP: subseq
{ $values { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq" sequence } { "subseq" "a new sequence" } } { $values { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq" sequence } { "subseq" "a new sequence" } }
{ $description "Outputs a new sequence consisting of all elements starting from and including " { $snippet "m" } ", and up to but not including " { $snippet "n" } "." } { $description "Outputs a new sequence consisting of all elements starting from and including " { $snippet "from" } ", and up to but not including " { $snippet "to" } "." }
{ $errors "Throws an error if " { $snippet "m" } " or " { $snippet "n" } " is out of bounds." } ; { $errors "Throws an error if " { $snippet "from" } " or " { $snippet "to" } " is out of bounds." } ;
HELP: clone-like HELP: clone-like
{ $values { "seq" sequence } { "exemplar" sequence } { "newseq" "a new sequence" } } { $values { "seq" sequence } { "exemplar" sequence } { "newseq" "a new sequence" } }

View File

@ -2,85 +2,60 @@ 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 classes words destructors threads tools.test
concurrency.promises byte-arrays ; concurrency.promises byte-arrays locals ;
\ <secure-config> must-infer \ <secure-config> must-infer
{ 1 0 } [ [ ] with-secure-context ] must-infer-as { 1 0 } [ [ ] with-secure-context ] must-infer-as
[ ] [ <promise> "port" set ] unit-test [ ] [ <promise> "port" set ] unit-test
[ ] [ : with-test-context
<secure-config>
"resource:extra/openssl/test/server.pem" >>key-file
"resource:extra/openssl/test/root.pem" >>ca-file
"resource:extra/openssl/test/dh1024.pem" >>dh-file
"password" >>password
swap with-secure-context ;
:: server-test ( quot -- )
[ [
<secure-config>
"resource:extra/openssl/test/server.pem" >>key-file
"resource:extra/openssl/test/root.pem" >>ca-file
"resource:extra/openssl/test/dh1024.pem" >>dh-file
"password" >byte-array >>password
[ [
"127.0.0.1" 0 <inet4> <secure> ascii <server> [ "127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill dup addr>> addrspec>> port>> "port" get fulfill
accept [ accept [
class word-name write quot call
] curry with-stream ] curry with-stream
] with-disposal ] with-disposal
] with-secure-context ] with-test-context
] "SSL server test" spawn drop ] "SSL server test" spawn drop ;
] unit-test
[ "secure" ] [ : client-test
<secure-config> [ <secure-config> [
"127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> drop contents "127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> drop contents
] with-secure-context ] with-secure-context ;
] unit-test
[ ] [ [ class word-name write ] server-test ] unit-test
[ "secure" ] [ client-test ] unit-test
! Now, see what happens if the server closes the connection prematurely ! Now, see what happens if the server closes the connection prematurely
! [ ] [ <promise> "port" set ] unit-test [ ] [ <promise> "port" set ] unit-test
!
! [ ] [
! [
! <secure-config>
! "resource:extra/openssl/test/server.pem" >>key-file
! "resource:extra/openssl/test/root.pem" >>ca-file
! "resource:extra/openssl/test/dh1024.pem" >>dh-file
! "password" >byte-array >>password
! [
! "127.0.0.1" 0 <inet4> <secure> ascii <server> [
! dup addr>> addrspec>> port>> "port" get fulfill
! accept drop
! [
! dup in>> stream>> handle>> f >>connected drop
! "hello" over stream-write dup stream-flush
! ] with-disposal
! ] with-disposal
! ] with-secure-context
! ] "SSL server test" spawn drop
! ] unit-test
! [ [ ] [
! <secure-config> [ [
! "127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> drop contents drop
! ] with-secure-context input-stream get stream>> handle>> f >>connected drop
! ] [ \ premature-close = ] must-fail-with "hello" write flush
] server-test
] unit-test
[ client-test ] [ premature-close? ] must-fail-with
! Now, try validating the certificate. This should fail because its ! Now, try validating the certificate. This should fail because its
! actually an invalid certificate ! actually an invalid certificate
[ ] [ <promise> "port" set ] unit-test [ ] [ <promise> "port" set ] unit-test
[ ] [ [ ] [ [ drop ] server-test ] unit-test
[
<secure-config>
"resource:extra/openssl/test/server.pem" >>key-file
"resource:extra/openssl/test/root.pem" >>ca-file
"resource:extra/openssl/test/dh1024.pem" >>dh-file
"password" >>password
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill
accept drop dispose
] with-disposal
] with-secure-context
] "SSL server test" spawn drop
] unit-test
[ [
<secure-config> [ <secure-config> [

View File

@ -125,12 +125,14 @@ M: secure (accept)
{ {
{ 1 [ drop f ] } { 1 [ drop f ] }
{ 0 [ { 0 [
dup handle>> SSL_want dup handle>> dup f 0 SSL_read 2dup SSL_get_error
{ {
{ SSL_NOTHING [ dup handle>> SSL_shutdown check-shutdown-response ] } { SSL_ERROR_ZERO_RETURN [ 2drop dup handle>> SSL_shutdown check-shutdown-response ] }
{ SSL_READING [ drop +input+ ] } { SSL_ERROR_WANT_READ [ 3drop +input+ ] }
{ SSL_WRITING [ drop +output+ ] } { SSL_ERROR_WANT_WRITE [ 3drop +output+ ] }
} case { SSL_ERROR_SYSCALL [ syscall-error ] }
{ SSL_ERROR_SSL [ (ssl-error) ] }
} case
] } ] }
{ -1 [ { -1 [
handle>> -1 SSL_get_error handle>> -1 SSL_get_error

2
extra/windows/com/com-tests.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
USING: kernel windows.com windows.com.syntax windows.ole32 USING: kernel windows.com windows.com.syntax windows.ole32
alien alien.syntax tools.test libc alien.c-types arrays.lib alien alien.syntax tools.test libc alien.c-types arrays.lib
namespaces arrays continuations accessors math windows.com.wrapper namespaces arrays continuations accessors math windows.com.wrapper
windows.com.wrapper.private ; windows.com.wrapper.private destructors ;
IN: windows.com.tests IN: windows.com.tests
COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc} COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc}

3
extra/windows/com/wrapper/wrapper-docs.factor Normal file → Executable file
View File

@ -1,5 +1,6 @@
USING: help.markup help.syntax io kernel math quotations USING: help.markup help.syntax io kernel math quotations
multiline alien windows.com windows.com.syntax continuations ; multiline alien windows.com windows.com.syntax continuations
destructors ;
IN: windows.com.wrapper IN: windows.com.wrapper
HELP: <com-wrapper> HELP: <com-wrapper>

View File

@ -2,7 +2,7 @@ USING: alien alien.c-types windows.com.syntax
windows.com.syntax.private windows.com continuations kernel windows.com.syntax.private windows.com continuations kernel
sequences.lib namespaces windows.ole32 libc sequences.lib namespaces windows.ole32 libc
assocs accessors arrays sequences quotations combinators assocs accessors arrays sequences quotations combinators
math combinators.lib words compiler.units ; math combinators.lib words compiler.units destructors ;
IN: windows.com.wrapper IN: windows.com.wrapper
TUPLE: com-wrapper vtbls freed? ; TUPLE: com-wrapper vtbls freed? ;