From 6df45b864b991359aa43fd862342d4e107d9dda8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 19 May 2008 20:43:28 -0500
Subject: [PATCH] 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 ;
 
 \ <secure-config> must-infer
 { 1 0 } [ [ ] with-secure-context ] must-infer-as
 
 [ ] [ <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> [
                 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
     <secure-config> [
         "127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> 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
-! [ ] [ <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
+[ ] [ <promise> "port" set ] unit-test
 
-! [
-!     <secure-config> [
-!         "127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> 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
 [ ] [ <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" >>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
+[ ] [ [ drop ] server-test ] unit-test
 
 [
     <secure-config> [
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