From 6df45b864b991359aa43fd862342d4e107d9dda8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 May 2008 20:43:28 -0500 Subject: [PATCH 1/4] Fix potential DoS attack --- .../unix/sockets/secure/secure-tests.factor | 85 +++++++------------ extra/io/unix/sockets/secure/secure.factor | 14 +-- 2 files changed, 38 insertions(+), 61 deletions(-) diff --git a/extra/io/unix/sockets/secure/secure-tests.factor b/extra/io/unix/sockets/secure/secure-tests.factor index c68b497493..5b8fd5ac23 100644 --- a/extra/io/unix/sockets/secure/secure-tests.factor +++ b/extra/io/unix/sockets/secure/secure-tests.factor @@ -2,85 +2,60 @@ 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 ; +concurrency.promises byte-arrays locals ; \ must-infer { 1 0 } [ [ ] with-secure-context ] must-infer-as [ ] [ "port" set ] unit-test -[ ] [ +: with-test-context + + "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 -- ) [ - - "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 ascii [ dup addr>> addrspec>> port>> "port" get fulfill accept [ - class word-name write + quot call ] curry with-stream ] with-disposal - ] with-secure-context - ] "SSL server test" spawn drop -] unit-test + ] with-test-context + ] "SSL server test" spawn drop ; -[ "secure" ] [ +: client-test [ "127.0.0.1" "port" get ?promise ascii drop contents - ] with-secure-context -] unit-test + ] with-secure-context ; + +[ ] [ [ class word-name write ] server-test ] unit-test + +[ "secure" ] [ client-test ] unit-test ! Now, see what happens if the server closes the connection prematurely -! [ ] [ "port" set ] unit-test -! -! [ ] [ -! [ -! -! "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 ascii [ -! 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 +[ ] [ "port" set ] unit-test -! [ -! [ -! "127.0.0.1" "port" get ?promise ascii drop contents -! ] with-secure-context -! ] [ \ premature-close = ] must-fail-with +[ ] [ + [ + drop + input-stream get stream>> handle>> f >>connected drop + "hello" write flush + ] server-test +] unit-test + +[ client-test ] [ premature-close? ] must-fail-with ! Now, try validating the certificate. This should fail because its ! actually an invalid certificate [ ] [ "port" set ] unit-test -[ ] [ - [ - - "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 ascii [ - dup addr>> addrspec>> port>> "port" get fulfill - accept drop dispose - ] with-disposal - ] with-secure-context - ] "SSL server test" spawn drop -] unit-test +[ ] [ [ drop ] server-test ] unit-test [ [ diff --git a/extra/io/unix/sockets/secure/secure.factor b/extra/io/unix/sockets/secure/secure.factor index 9feeb90690..35f72a5d16 100755 --- a/extra/io/unix/sockets/secure/secure.factor +++ b/extra/io/unix/sockets/secure/secure.factor @@ -125,12 +125,14 @@ M: secure (accept) { { 1 [ drop f ] } { 0 [ - dup handle>> SSL_want - { - { SSL_NOTHING [ dup handle>> SSL_shutdown check-shutdown-response ] } - { SSL_READING [ drop +input+ ] } - { SSL_WRITING [ drop +output+ ] } - } case + 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_WANT_READ [ 3drop +input+ ] } + { SSL_ERROR_WANT_WRITE [ 3drop +output+ ] } + { SSL_ERROR_SYSCALL [ syscall-error ] } + { SSL_ERROR_SSL [ (ssl-error) ] } + } case ] } { -1 [ handle>> -1 SSL_get_error From e9ee2dc654fb55c8060696fb04f8e79d931b8892 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 19 May 2008 21:28:32 -0500 Subject: [PATCH 2/4] sequences-docs: Fix typo --- core/sequences/sequences-docs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 8b15f5b980..351ba89692 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -821,8 +821,8 @@ HELP: 3append HELP: subseq { $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" } "." } -{ $errors "Throws an error if " { $snippet "m" } " or " { $snippet "n" } " is out of bounds." } ; +{ $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 "from" } " or " { $snippet "to" } " is out of bounds." } ; HELP: clone-like { $values { "seq" sequence } { "exemplar" sequence } { "newseq" "a new sequence" } } From 75eded700dc4912a162204117db1fb6ee88b4cc0 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 19 May 2008 21:30:55 -0500 Subject: [PATCH 3/4] io.binary-docs: fix typo --- core/io/binary/binary-docs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/io/binary/binary-docs.factor b/core/io/binary/binary-docs.factor index edf65491fe..507571c044 100644 --- a/core/io/binary/binary-docs.factor +++ b/core/io/binary/binary-docs.factor @@ -6,12 +6,12 @@ ARTICLE: "stream-binary" "Working with binary data" $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." $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 { "Byte:" "1" "2" "3" "4" } { "Value:" { $snippet "be" } { $snippet "ba" } { $snippet "fe" } { $snippet "ca" } } } -"Compare this with little endian byte order:" +"Compare this with big endian byte order:" { $table { "Byte:" "1" "2" "3" "4" } { "Value:" { $snippet "ca" } { $snippet "fe" } { $snippet "ba" } { $snippet "be" } } From c988c6708959cf084a39a30c6de861968af73c05 Mon Sep 17 00:00:00 2001 From: erg Date: Mon, 19 May 2008 21:52:16 -0500 Subject: [PATCH 4/4] handle PASV --- extra/ftp/server/server.factor | 52 ++++++++++++++++++++++++---------- 1 file changed, 37 insertions(+), 15 deletions(-) diff --git a/extra/ftp/server/server.factor b/extra/ftp/server/server.factor index beec25b7a5..ef20885a5f 100644 --- a/extra/ftp/server/server.factor +++ b/extra/ftp/server/server.factor @@ -5,7 +5,7 @@ io.encodings io.encodings.binary io.encodings.utf8 io.files io.server io.sockets kernel math.parser namespaces sequences ftp io.unix.launcher.parser unicode.case splitting assocs classes io.server destructors calendar io.timeouts -io.streams.duplex threads continuations +io.streams.duplex threads continuations math concurrency.promises byte-arrays ; IN: ftp.server @@ -78,24 +78,34 @@ C: ftp-list ERROR: type-error type ; +: parse-type ( string -- string' ) + >upper { + { "IMAGE" [ "Binary" ] } + { "I" [ "Binary" ] } + [ type-error ] + } case ; + : handle-TYPE ( obj -- ) [ - tokenized>> second >upper { - { "IMAGE" [ "Binary" ] } - { "I" [ "Binary" ] } - [ type-error ] - } case + tokenized>> second parse-type 200 "Switching to " rot " mode" 3append server-response ] [ 2drop "TYPE is binary only" ftp-error ] recover ; +: random-local-server ( -- server ) + remote-address get class new 0 >>port binary ; + +: port>bytes ( port -- hi lo ) + [ -8 shift ] keep [ HEX: ff bitand ] bi@ ; + : handle-PWD ( obj -- ) drop 257 current-directory get "\"" swap "\"" 3append server-response ; -: random-local-server ( -- server ) - remote-address get class new 0 >>port binary ; +: handle-SYST ( obj -- ) + drop + 215 "UNIX Type: L8" server-response ; : handle-STOR ( obj -- ) [ @@ -156,7 +166,7 @@ M: ftp-put service-command ( stream obj -- ) 3drop "File transfer failed" ftp-error ] recover ; -: extended-passive-loop ( server -- ) +: passive-loop ( server -- ) [ [ |dispose @@ -191,16 +201,28 @@ M: ftp-put service-command ( stream obj -- ) [ tokenized>> second swap fulfill ] curry if-command-promise ; +: expect-connection ( -- port ) + random-local-server + client get >>command-promise drop + [ [ passive-loop ] curry in-thread ] + [ addr>> port>> ] bi ; + +: handle-PASV ( obj -- ) + drop client get passive >>mode drop + expect-connection + [ + "Entering Passive Mode (127,0,0,1," % + port>bytes [ number>string ] bi@ "," swap 3append % + ")" % + ] "" make 227 swap server-response ; + : handle-EPSV ( obj -- ) drop client get command-promise>> [ "You already have a passive stream" ftp-error ] [ 229 "Entering Extended Passive Mode (|||" - random-local-server - client get >>command-promise drop - [ [ B extended-passive-loop ] curry in-thread ] - [ addr>> port>> number>string ] bi + expect-connection number>string "|)" 3append server-response ] if ; @@ -241,7 +263,7 @@ ERROR: not-a-directory ; { "QUIT" [ handle-QUIT f ] } ! { "PORT" [ ] } - ! { "PASV" [ ] } + { "PASV" [ handle-PASV t ] } ! { "MODE" [ ] } { "TYPE" [ handle-TYPE t ] } ! { "STRU" [ ] } @@ -263,7 +285,7 @@ ERROR: not-a-directory ; { "PWD" [ handle-PWD t ] } ! { "ABOR" [ ] } - ! { "SYST" [ drop ] } + { "SYST" [ handle-SYST t ] } ! { "STAT" [ ] } ! { "HELP" [ ] }