basis/io/sockets/secure/openssl/openssl-tests.factor

   1 USING: accessors alien continuations http.client http.server io.servers
   2 io.sockets io.sockets.private io.sockets.secure io.sockets.secure.openssl
   3 kernel openssl.libcrypto openssl.libssl sequences system tools.test urls
   4 unix.ffi ;
   5 IN: io.sockets.secure.openssl.tests
   6
   7 : new-ssl ( -- ssl )
   8     SSLv23_client_method SSL_CTX_new SSL_new ;
   9
  10 ! This word creates blocking sockets for testing purposes. Factor by
  11 ! default prefers to use non-blocking ones.
  12 : inet-socket ( -- socket )
  13     AF_INET SOCK_STREAM IPPROTO_TCP socket ;
  14
  15 : socket-connect ( remote -- socket )
  16     inet-socket swap dupd make-sockaddr/size connect drop ;
  17
  18 : ssl-socket-connect ( remote -- ssl-socket )
  19     socket-connect os windows? [ alien-address ] when
  20     BIO_NOCLOSE BIO_new_socket ;
  21
  22 : remote ( -- remote )
  23     URL" https://www.google.com" url-addr addrspec>> resolve-host first ;
  24
  25 [ 200 ] [ "https://www.google.se" http-get drop code>> ] unit-test
  26
  27 [ "www.google.com" ] [
  28     new-ssl dup remote ssl-socket-connect dup SSL_set_bio
  29     dup SSL_connect drop SSL_get_peer_certificate subject-name
  30 ] unit-test
  31
  32 [ t ] [
  33     <http-server> 8887 >>insecure f >>secure [
  34         [
  35             "https://localhost:8887" http-get
  36         ] [ certificate-missing-error? ] recover
  37     ] with-threaded-server
  38 ] unit-test
  39
  40 [ t ] [
  41     [
  42         "test" 33 <ssl-handle> handle>> check-subject-name
  43     ] [ certificate-missing-error? ] recover
  44 ] unit-test