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 kernel namespaces continuations destructors io
   4 debugger io.sockets io.sockets.private sequences summary
   5 calendar delegate system vocabs combinators present ;
   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
  16 M: object ssl-supported? f ;
  17
  18 SINGLETONS: SSLv2 SSLv23 SSLv3 TLSv1 ;
  19
  20 TUPLE: secure-config
  21 method
  22 key-file password
  23 verify
  24 verify-depth
  25 ca-file ca-path
  26 dh-file
  27 ephemeral-key-bits ;
  28
  29 : <secure-config> ( -- config )
  30     secure-config new
  31         SSLv23 >>method
  32         1024 >>ephemeral-key-bits
  33         t >>verify ;
  34
  35 TUPLE: secure-context < disposable config handle ;
  36
  37 HOOK: <secure-context> secure-socket-backend ( config -- context )
  38
  39 : with-secure-context ( config quot -- )
  40     [
  41         [ <secure-context> ] [ [ secure-context set ] prepose ] bi*
  42         with-disposal
  43     ] with-scope ; inline
  44
  45 TUPLE: secure { addrspec read-only } ;
  46
  47 C: <secure> secure
  48
  49 M: secure present addrspec>> present " (secure)" append ;
  50
  51 CONSULT: inet secure addrspec>> ;
  52
  53 M: secure resolve-host ( secure -- seq )
  54     addrspec>> resolve-host [ <secure> ] map ;
  55
  56 HOOK: check-certificate secure-socket-backend ( host handle -- )
  57
  58 PREDICATE: secure-inet < secure addrspec>> inet? ;
  59
  60 <PRIVATE
  61
  62 M: secure-inet (client)
  63     [
  64         [ resolve-host (client) [ |dispose ] dip ] keep
  65         addrspec>> host>> pick handle>> check-certificate
  66     ] with-destructors ;
  67
  68 PRIVATE>
  69
  70 ERROR: premature-close ;
  71
  72 M: premature-close summary
  73     drop "Connection closed prematurely - potential truncation attack" ;
  74
  75 ERROR: certificate-verify-error result ;
  76
  77 M: certificate-verify-error summary
  78     drop "Certificate verification failed" ;
  79
  80 ERROR: common-name-verify-error expected got ;
  81
  82 M: common-name-verify-error summary
  83     drop "Common name verification failed" ;
  84
  85 ERROR: upgrade-on-non-socket ;
  86
  87 M: upgrade-on-non-socket summary
  88     drop
  89     "send-secure-handshake can only be used if input-stream and" print
  90     "output-stream are a socket" ;
  91
  92 ERROR: upgrade-buffers-full ;
  93
  94 M: upgrade-buffers-full summary
  95     drop
  96     "send-secure-handshake can only be used if buffers are empty" ;
  97
  98 HOOK: send-secure-handshake secure-socket-backend ( -- )
  99
 100 HOOK: accept-secure-handshake secure-socket-backend ( -- )
 101
 102 {
 103     { [ os unix? ] [ "io.sockets.secure.unix" require ] }
 104     { [ os windows? ] [ "openssl" require ] }
 105 } cond