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

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" } }

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" } "." }
+{ $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
 { $values { "seq" sequence } { "exemplar" sequence } { "newseq" "a new sequence" } }

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> ftp-list
 
 ERROR: type-error type ;
 
-: handle-TYPE ( obj -- )
+: parse-type ( string -- string' )
-    [
+    >upper {
-        tokenized>> second >upper {
         { "IMAGE" [ "Binary" ] }
         { "I" [ "Binary" ] }
         [ type-error ]
-        } case
+    } case ;
+
+: handle-TYPE ( obj -- )
+    [
+        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 <server> ;
+
+: 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 )
+: handle-SYST ( obj -- )
-    remote-address get class new 0 >>port binary <server> ;
+    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 <ftp-get> swap fulfill ]
     curry if-command-promise ;
 
+: expect-connection ( -- port )
+    random-local-server
+    client get <promise> >>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
+        expect-connection number>string
-        client get <promise> >>command-promise drop
-        [ [ B extended-passive-loop ] curry in-thread ]
-        [ addr>> port>> number>string ] bi
         "|)" 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" [ ] }
 

extra/io/unix/sockets/secure/secure-tests.factor

@@ -2,86 +2,61 @@ 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" >byte-array >>password
-        [
-            "127.0.0.1" 0 <inet4> <secure> ascii <server> [
-                dup addr>> addrspec>> port>> "port" get fulfill
-                accept [
-                    class word-name write
-                ] curry with-stream
-            ] with-disposal
-        ] with-secure-context
-    ] "SSL server test" spawn drop
-] unit-test
-
-[ "secure" ] [
-    <secure-config> [
-        "127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> drop contents
-    ] with-secure-context
-] 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
-
-! [
-!     <secure-config> [
-!         "127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> drop contents
-!     ] with-secure-context
-! ] [ \ 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
+    swap with-secure-context ;
+
+:: server-test ( quot -- )
+    [
         [
             "127.0.0.1" 0 <inet4> <secure> ascii <server> [
                 dup addr>> addrspec>> port>> "port" get fulfill
-                accept drop dispose
+                accept [
+                    quot call
+                ] curry with-stream
             ] with-disposal
-        ] with-secure-context
+        ] with-test-context
-    ] "SSL server test" spawn drop
+    ] "SSL server test" spawn drop ;
+
+: client-test
+    <secure-config> [
+        "127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> drop contents
+    ] 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
+
+[ ] [
+    [
+        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
+
+[ ] [ [ drop ] server-test ] unit-test
+
 [
     <secure-config> [
         "localhost" "port" get ?promise <inet> <secure> ascii

extra/io/unix/sockets/secure/secure.factor

@@ -125,11 +125,13 @@ M: secure (accept)
     {
         { 1 [ drop f ] }
         { 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+ ] }
+                { SSL_ERROR_SYSCALL [ syscall-error ] }
+                { SSL_ERROR_SSL [ (ssl-error) ] }
             } case
         ] }
         { -1 [