basis/io/sockets/secure/secure.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel symbols namespaces continuations
   4 destructors io.sockets sequences summary calendar delegate
   5 system vocabs.loader 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 SINGLETONS: SSLv2 SSLv23 SSLv3 TLSv1 ;
  15
  16 TUPLE: secure-config
  17 method
  18 key-file password
  19 verify
  20 verify-depth
  21 ca-file ca-path
  22 dh-file
  23 ephemeral-key-bits ;
  24
  25 : <secure-config> ( -- config )
  26     secure-config new
  27         SSLv23 >>method
  28         1024 >>ephemeral-key-bits
  29         "resource:basis/openssl/cacert.pem" >>ca-file
  30         t >>verify ;
  31
  32 TUPLE: secure-context config handle disposed ;
  33
  34 HOOK: <secure-context> secure-socket-backend ( config -- context )
  35
  36 : with-secure-context ( config quot -- )
  37     [
  38         [ <secure-context> ] [ [ secure-context set ] prepose ] bi*
  39         with-disposal
  40     ] with-scope ; inline
  41
  42 TUPLE: secure addrspec ;
  43
  44 C: <secure> secure
  45
  46 M: secure present addrspec>> present " (secure)" append ;
  47
  48 CONSULT: inet secure addrspec>> ;
  49
  50 M: secure resolve-host ( secure -- seq )
  51     addrspec>> resolve-host [ <secure> ] map ;
  52
  53 HOOK: check-certificate secure-socket-backend ( host handle -- )
  54
  55 <PRIVATE
  56
  57 PREDICATE: secure-inet < secure addrspec>> inet? ;
  58
  59 M: secure-inet (client)
  60     [
  61         [ resolve-host (client) [ |dispose ] dip ] keep
  62         addrspec>> host>> pick handle>> check-certificate
  63     ] with-destructors ;
  64
  65 PRIVATE>
  66
  67 ERROR: premature-close ;
  68
  69 M: premature-close summary
  70     drop "Connection closed prematurely - potential truncation attack" ;
  71
  72 ERROR: certificate-verify-error result ;
  73
  74 M: certificate-verify-error summary
  75     drop "Certificate verification failed" ;
  76
  77 ERROR: common-name-verify-error expected got ;
  78
  79 M: common-name-verify-error summary
  80     drop "Common name verification failed" ;
  81
  82 {
  83     { [ os unix? ] [ "io.unix.sockets.secure" require ] }
  84     { [ os windows? ] [ "openssl" require ] }
  85 } cond