basis/io/sockets/secure/secure.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.libraries calendar combinators delegate
   4 destructors io io.sockets io.sockets.private kernel namespaces
   5 present sequences summary system vocabs.platforms ;
   6 USE: openssl.libssl
   7 IN: io.sockets.secure
   8
   9 SYMBOL: secure-socket-timeout
  10
  11 1 minutes secure-socket-timeout set-global
  12
  13 SYMBOL: secure-socket-backend
  14
  15 HOOK: ssl-supported? secure-socket-backend ( -- ? )
  16 HOOK: ssl-certificate-verification-supported? secure-socket-backend ( -- ? )
  17
  18 M: object ssl-supported? f ;
  19 M: object ssl-certificate-verification-supported? f ;
  20
  21 SINGLETONS: TLSv1 TLSv1.1 TLSv1.2 ;
  22
  23 ERROR: no-tls-supported ;
  24
  25 MEMO: best-tls-method ( -- class )
  26     {
  27         { [ "TLSv1_2_method" "libssl" dlsym? ] [ TLSv1.2 ] }
  28         { [ "TLSv1_1_method" "libssl" dlsym? ] [ TLSv1.1 ] }
  29         { [ "TLSv1_method" "libssl" dlsym? ] [ TLSv1 ] }
  30         [ no-tls-supported ]
  31     } cond ;
  32
  33 TUPLE: secure-config
  34 method
  35 key-file password
  36 verify
  37 verify-depth
  38 ca-file ca-path
  39 dh-file
  40 ephemeral-key-bits
  41 alpn-supported-protocols ;
  42
  43 : <secure-config> ( -- config )
  44     secure-config new
  45         best-tls-method >>method
  46         1024 >>ephemeral-key-bits
  47         ssl-certificate-verification-supported? >>verify ;
  48
  49 TUPLE: secure-context < disposable config handle ;
  50
  51 HOOK: <secure-context> secure-socket-backend ( config -- context )
  52
  53 : with-secure-context ( config quot -- )
  54     [
  55         [ <secure-context> ] [ [ secure-context set ] prepose ] bi*
  56         with-disposal
  57     ] with-scope ; inline
  58
  59 TUPLE: secure
  60     { addrspec read-only }
  61     { hostname read-only } ;
  62
  63 C: <secure> secure
  64
  65 M: secure present addrspec>> present " (secure)" append ;
  66
  67 M: secure (server) addrspec>> (server) ;
  68
  69 CONSULT: inet secure addrspec>> ;
  70
  71 M: secure resolve-host
  72     [ addrspec>> resolve-host ] [ hostname>> ] bi
  73     [ <secure> ] curry map ;
  74
  75 HOOK: check-certificate secure-socket-backend ( host handle -- )
  76
  77 PREDICATE: secure-inet < secure addrspec>> inet? ;
  78
  79 <PRIVATE
  80
  81 M: secure-inet (client)
  82     [
  83         [ resolve-host (client) [ |dispose ] dip ] keep
  84         addrspec>> host>> pick handle>> check-certificate
  85     ] with-destructors ;
  86
  87 PRIVATE>
  88
  89 ERROR: premature-close-error ;
  90
  91 M: premature-close-error summary
  92     drop "Connection closed prematurely" ;
  93
  94 ERROR: certificate-verify-error result ;
  95
  96 M: certificate-verify-error summary
  97     drop "Certificate verification failed" ;
  98
  99 ERROR: subject-name-verify-error expected got ;
 100
 101 M: subject-name-verify-error summary
 102     drop "Subject name verification failed" ;
 103
 104 ERROR: certificate-missing-error ;
 105
 106 M: certificate-missing-error summary
 107     drop "Host did not present any certificate" ;
 108
 109 ERROR: upgrade-on-non-socket ;
 110
 111 M: upgrade-on-non-socket summary
 112     drop
 113     "send-secure-handshake can only be used if input-stream and" print
 114     "output-stream are a socket" ;
 115
 116 ERROR: upgrade-buffers-full ;
 117
 118 M: upgrade-buffers-full summary
 119     drop
 120     "send-secure-handshake can only be used if buffers are empty" ;
 121
 122 HOOK: non-ssl-socket? os ( obj -- ? )
 123
 124 HOOK: socket-handle os ( obj -- ? )
 125
 126 HOOK: send-secure-handshake secure-socket-backend ( -- )
 127
 128 HOOK: accept-secure-handshake secure-socket-backend ( -- )
 129
 130 USE-UNIX: io.sockets.secure.unix
 131 USE-WINDOWS: io.sockets.secure.windows