extra/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 ;
   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:extra/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 CONSULT: inet secure addrspec>> ;
  47
  48 M: secure resolve-host ( secure -- seq )
  49     addrspec>> resolve-host [ <secure> ] map ;
  50
  51 HOOK: check-certificate secure-socket-backend ( host handle -- )
  52
  53 <PRIVATE
  54
  55 PREDICATE: secure-inet < secure addrspec>> inet? ;
  56
  57 M: secure-inet (client)
  58     [
  59         [ resolve-host (client) [ |dispose ] dip ] keep
  60         addrspec>> host>> pick handle>> check-certificate
  61     ] with-destructors ;
  62
  63 PRIVATE>
  64
  65 ERROR: premature-close ;
  66
  67 M: premature-close summary
  68     drop "Connection closed prematurely - potential truncation attack" ;
  69
  70 ERROR: certificate-verify-error result ;
  71
  72 M: certificate-verify-error summary
  73     drop "Certificate verification failed" ;
  74
  75 ERROR: common-name-verify-error expected got ;
  76
  77 M: common-name-verify-error summary
  78     drop "Common name verification failed" ;
  79
  80 {
  81     { [ os unix? ] [ "io.unix.sockets.secure" require ] }
  82     { [ os windows? ] [ "openssl" require ] }
  83 } cond