diff --git a/basis/io/servers/servers.factor b/basis/io/servers/servers.factor index a2911b1f2c..af1923ddde 100755 --- a/basis/io/servers/servers.factor +++ b/basis/io/servers/servers.factor @@ -81,7 +81,7 @@ M: array >insecure [ >insecure ] map ; M: f >insecure ; : >secure ( addrspec -- addrspec' ) - >insecure [ dup secure? [ ] unless ] map ; + >insecure [ dup secure? [ f ] unless ] map ; : configurable-addrspecs ( addrspecs -- addrspecs' ) [ inet6? not ipv6-supported? or ] filter ; @@ -230,7 +230,7 @@ M: inet4 connect-addr [ "127.0.0.1" ] dip port>> ; M: inet6 connect-addr [ "::1" ] dip port>> ; -M: secure connect-addr addrspec>> connect-addr ; +M: secure connect-addr addrspec>> connect-addr f ; M: local connect-addr ; diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor index e2f169997a..b87e3951c9 100644 --- a/basis/io/sockets/secure/openssl/openssl.factor +++ b/basis/io/sockets/secure/openssl/openssl.factor @@ -171,11 +171,16 @@ SYMBOL: default-secure-context swap >>file ] with-destructors ; -: ( winsock -- ssl ) - [ - socket-handle BIO_NOCLOSE BIO_new_socket dup ssl-error - ] keep - [ handle>> swap dup SSL_set_bio ] keep ; +:: ( winsock hostname -- ssl ) + winsock socket-handle BIO_NOCLOSE BIO_new_socket dup ssl-error :> bio + winsock :> handle + handle handle>> :> native-handle + hostname [ + utf8 string>alien + native-handle swap SSL_set_tlsext_host_name ssl-error + ] when* + native-handle bio bio SSL_set_bio + handle ; ! Error handling : syscall-error ( r -- event ) @@ -330,7 +335,7 @@ M: openssl check-certificate ( host ssl -- ) : make-input/output-secure ( input output -- ) dup handle>> non-ssl-socket? [ upgrade-on-non-socket ] unless - [ ] change-handle + [ f ] change-handle handle>> >>handle drop ; : (send-secure-handshake) ( output -- ) diff --git a/basis/io/sockets/secure/secure-docs.factor b/basis/io/sockets/secure/secure-docs.factor index fdf2503d56..fe911466d9 100644 --- a/basis/io/sockets/secure/secure-docs.factor +++ b/basis/io/sockets/secure/secure-docs.factor @@ -1,4 +1,4 @@ -USING: io help.markup help.syntax calendar quotations io.sockets ; +USING: io help.markup help.syntax calendar quotations strings io.sockets ; IN: io.sockets.secure HELP: secure-socket-timeout @@ -74,7 +74,7 @@ HELP: secure { $class-description "The class of secure socket addresses." } ; HELP: -{ $values { "addrspec" "an address specifier" } { "secure" secure } } +{ $values { "addrspec" "an address specifier" } { "hostname" { $maybe string } } { "secure" secure } } { $description "Creates a new secure socket address, which can then be passed to " { $link } " or " { $link } "." } ; ARTICLE: "ssl-addresses" "Secure socket addresses" diff --git a/basis/io/sockets/secure/secure-tests.factor b/basis/io/sockets/secure/secure-tests.factor index d591ac15e7..65ca8abcd1 100644 --- a/basis/io/sockets/secure/secure-tests.factor +++ b/basis/io/sockets/secure/secure-tests.factor @@ -2,7 +2,7 @@ IN: io.sockets.secure.tests USING: accessors io.sockets io.sockets.secure io.sockets.secure.debug kernel system tools.test ; -{ "hello" 24 } [ "hello" 24 [ host>> ] [ port>> ] bi ] unit-test +{ "hello" 24 } [ "hello" 24 "hello" [ host>> ] [ port>> ] bi ] unit-test { } [ [ ] with-secure-context diff --git a/basis/io/sockets/secure/secure.factor b/basis/io/sockets/secure/secure.factor index 8f4678fd6c..2ef50a07a1 100644 --- a/basis/io/sockets/secure/secure.factor +++ b/basis/io/sockets/secure/secure.factor @@ -44,7 +44,9 @@ HOOK: secure-socket-backend ( config -- context ) with-disposal ] with-scope ; inline -TUPLE: secure { addrspec read-only } ; +TUPLE: secure + { addrspec read-only } + { hostname read-only } ; C: secure @@ -53,7 +55,8 @@ M: secure present addrspec>> present " (secure)" append ; CONSULT: inet secure addrspec>> ; M: secure resolve-host ( secure -- seq ) - addrspec>> resolve-host [ ] map ; + [ addrspec>> resolve-host ] [ hostname>> ] bi + [ ] curry map ; HOOK: check-certificate secure-socket-backend ( host handle -- ) diff --git a/basis/io/sockets/secure/unix/unix-tests.factor b/basis/io/sockets/secure/unix/unix-tests.factor index 6611c854fc..6d06db2c4f 100644 --- a/basis/io/sockets/secure/unix/unix-tests.factor +++ b/basis/io/sockets/secure/unix/unix-tests.factor @@ -12,7 +12,7 @@ io.sockets.secure.debug ; :: server-test ( quot -- ) [ [ - "127.0.0.1" 0 ascii [ + "127.0.0.1" 0 f ascii [ dup addr>> addrspec>> port>> "port" get fulfill accept [ quot call @@ -23,7 +23,7 @@ io.sockets.secure.debug ; : client-test ( -- string ) [ - "127.0.0.1" "port" get ?promise ascii drop stream-contents + "127.0.0.1" "port" get ?promise f ascii drop stream-contents ] with-secure-context ; { } [ [ class-of name>> write ] server-test ] unit-test @@ -55,7 +55,7 @@ io.sockets.secure.debug ; [ [ - "localhost" "port" get ?promise ascii + "localhost" "port" get ?promise f ascii drop dispose ] with-secure-context ] [ certificate-verify-error? ] must-fail-with @@ -95,7 +95,7 @@ io.sockets.secure.debug ; 1 seconds secure-socket-timeout [ [ [ - "127.0.0.1" 0 ascii [ + "127.0.0.1" 0 f ascii [ dup addr>> addrspec>> port>> "port" get fulfill accept drop &dispose dup stream-read1 drop ] with-disposal @@ -114,7 +114,7 @@ io.sockets.secure.debug ; [ [ [ - "127.0.0.1" 0 ascii [ + "127.0.0.1" 0 f ascii [ dup addr>> addrspec>> port>> "port" get fulfill accept drop &dispose 1 minutes sleep ] with-disposal @@ -126,7 +126,7 @@ io.sockets.secure.debug ; [ 1 seconds secure-socket-timeout [ [ - "127.0.0.1" "port" get ?promise + "127.0.0.1" "port" get ?promise f ascii drop dispose ] with-secure-context ] with-variable @@ -140,7 +140,7 @@ io.sockets.secure.debug ; [ [ "127.0.0.1" "port" get ?promise - ascii drop &dispose 1 minutes sleep + f ascii drop &dispose 1 minutes sleep ] with-test-context ] with-destructors ] "Silly client" spawn drop @@ -150,7 +150,7 @@ io.sockets.secure.debug ; [ 1 seconds secure-socket-timeout [ [ - "127.0.0.1" 0 ascii [ + "127.0.0.1" 0 f ascii [ dup addr>> addrspec>> port>> "port" get fulfill accept drop &dispose ] with-disposal diff --git a/basis/io/sockets/secure/unix/unix.factor b/basis/io/sockets/secure/unix/unix.factor index 8ccc61a63a..e1c5a5032a 100644 --- a/basis/io/sockets/secure/unix/unix.factor +++ b/basis/io/sockets/secure/unix/unix.factor @@ -14,10 +14,10 @@ M: ssl-handle handle-fd file>> handle-fd ; M: unix socket-handle fd>> ; -M: secure ((client)) ( addrspec -- handle ) - addrspec>> ((client)) ; +M: secure ((client)) ( secure -- handle ) + [ addrspec>> ((client)) ] [ hostname>> ] bi ; -M: secure parse-sockaddr addrspec>> parse-sockaddr ; +M: secure parse-sockaddr addrspec>> parse-sockaddr f ; M: secure (get-local-address) addrspec>> (get-local-address) ; @@ -28,7 +28,8 @@ M: secure (server) addrspec>> (server) ; M: secure (accept) [ - addrspec>> (accept) [ |dispose ] dip + [ hostname>> ] [ addrspec>> ] bi (accept) + [ |dispose ] dip ] with-destructors ; : check-shutdown-response ( handle r -- event ) diff --git a/basis/io/sockets/secure/windows/windows.factor b/basis/io/sockets/secure/windows/windows.factor index 95525a170e..af39da72b7 100644 --- a/basis/io/sockets/secure/windows/windows.factor +++ b/basis/io/sockets/secure/windows/windows.factor @@ -14,7 +14,7 @@ M: secure ((client)) ( addrspec -- handle ) M: secure (get-local-address) ( handle remote -- sockaddr ) [ file>> ] [ addrspec>> ] bi* (get-local-address) ; -M: secure parse-sockaddr addrspec>> parse-sockaddr ; +M: secure parse-sockaddr addrspec>> parse-sockaddr f ; M:: secure establish-connection ( client-out addrspec -- ) client-out handle>> file>> :> socket diff --git a/basis/openssl/libssl/libssl.factor b/basis/openssl/libssl/libssl.factor index 8393a3eb6c..e9c101dc6f 100644 --- a/basis/openssl/libssl/libssl.factor +++ b/basis/openssl/libssl/libssl.factor @@ -392,7 +392,6 @@ FUNCTION: int SSL_connect ( SSL* ssl ) FUNCTION: int SSL_read ( SSL* ssl, void* buf, int num ) FUNCTION: int SSL_write ( SSL* ssl, void* buf, int num ) FUNCTION: long SSL_ctrl ( SSL* ssl, int cmd, long larg, void* parg ) -! FUNCTION: long SSL_callback_ctrl ( SSL* ssl, int cmd, long larg, void* parg ) FUNCTION: int SSL_shutdown ( SSL* ssl ) @@ -468,6 +467,10 @@ FUNCTION: void SSL_CTX_set_tmp_rsa_callback ( SSL_CTX* ctx, void* rsa ) FUNCTION: void* BIO_f_ssl ( ) +: SSL_set_tlsext_host_name ( ctx hostname -- n ) + [ SSL_CTRL_SET_TLSEXT_HOSTNAME TLSEXT_NAMETYPE_host_name ] dip + SSL_ctrl ; + : SSL_CTX_need_tmp_rsa ( ctx -- n ) SSL_CTRL_NEED_TMP_RSA 0 f SSL_CTX_ctrl ; diff --git a/basis/urls/secure/secure.factor b/basis/urls/secure/secure.factor index 1c9b925641..6961a8ec25 100644 --- a/basis/urls/secure/secure.factor +++ b/basis/urls/secure/secure.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: urls urls.private io.sockets io.sockets.secure ; +USING: kernel urls urls.private io.sockets io.sockets.secure ; IN: urls.secure UNION: abstract-inet inet inet4 inet6 ; diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index f50e3ee9e0..1d52fc5adf 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -172,7 +172,7 @@ PRIVATE> secure-addr ( addrspec -- addrspec' ) +GENERIC# >secure-addr 1 ( addrspec host -- addrspec' ) PRIVATE> @@ -182,8 +182,10 @@ PRIVATE> [ port>> ] [ protocol>> protocol-port ] tri or - ] [ protocol>> ] bi - secure-protocol? [ >secure-addr ] when ; + ] + [ host>> ] + [ protocol>> ] tri + secure-protocol? [ >secure-addr ] [ drop ] if ; : set-url-addr ( url addr -- url ) [ host>> >>host ] [ port>> >>port ] bi ; diff --git a/extra/imap/imap.factor b/extra/imap/imap.factor index 2436af9b32..e3a9b4fc4b 100644 --- a/extra/imap/imap.factor +++ b/extra/imap/imap.factor @@ -108,7 +108,7 @@ PRIVATE> ! Constructor : ( host -- imap4 ) - IMAP4_SSL_PORT binary drop + IMAP4_SSL_PORT f binary drop ! Read the useless welcome message. dup [ "\\*" read-response drop ] with-stream* ;