Merge branch 'master' of git://factorcode.org/git/factor
commit
e486ce8a0f
|
@ -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" } }
|
||||||
|
|
|
@ -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" } }
|
||||||
|
|
|
@ -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> [
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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}
|
||||||
|
|
|
@ -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>
|
||||||
|
|
|
@ -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? ;
|
||||||
|
|
Loading…
Reference in New Issue