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