basis/io/sockets/secure/windows/windows.factor

   1 USING: accessors alien alien.c-types alien.data alien.strings
   2 calendar combinators combinators.short-circuit destructors io
   3 io.encodings.utf8 io.ports io.sockets.private io.sockets.secure
   4 io.sockets.secure.openssl io.sockets.windows kernel libc locals
   5 math math.order openssl openssl.libcrypto openssl.libssl system
   6 windows.crypt32 windows.errors windows.time windows.winsock ;
   7 IN: io.sockets.secure.windows
   8
   9 M: openssl ssl-supported? t ;
  10 M: openssl ssl-certificate-verification-supported? f ;
  11
  12 : close-windows-cert-store ( HCERTSTORE -- )
  13     0 CertCloseStore win32-error=0/f ;
  14
  15 : load-windows-cert-store ( string -- HCERTSTORE )
  16     [ f ] dip CertOpenSystemStore
  17     [ win32-error-string throw ] when-zero ;
  18
  19 : X509-NAME. ( X509_NAME -- )
  20     f 0 X509_NAME_oneline
  21     [ utf8 alien>string print ] [ (free) ] bi ;
  22
  23 : X509. ( X509 -- )
  24     {
  25         [ X509_get_subject_name "subject: " write X509-NAME. ]
  26         [ X509_get_issuer_name "issuer: " write X509-NAME. ]
  27     } cleave ;
  28
  29 : add-cert-to-store ( cert-store cert -- )
  30     X509_STORE_add_cert ssl-error ;
  31
  32 :: set-windows-certs-for ( name -- )
  33     [
  34         name load-windows-cert-store :> cs
  35         X509_STORE_new :> x509-store
  36         f :> ctx!
  37         [ ctx ]
  38         [
  39             cs ctx CertEnumCertificatesInStore ctx!
  40             ctx [
  41                 f ctx [ pbCertEncoded>> void* <ref> ]
  42                 [ cbCertEncoded>> ] bi d2i_X509
  43                 {
  44                     [ ssl-error ]
  45                     ! [ X509. ]
  46                     [ x509-store swap X509_STORE_add_cert ssl-error ]
  47                 } cleave
  48             ] when
  49         ] do while
  50     ] with-destructors ;
  51
  52 ! XXX: the MSFT cert is in "CA" twice, and throws an error
  53 ! when loading the second time.
  54 : set-windows-certs ( -- )
  55     ! "CA" set-windows-certs-for
  56     "ROOT" set-windows-certs-for ;
  57
  58 M: windows socket-handle handle>> alien-address ;
  59
  60 M: secure remote>handle ( addrspec -- handle )
  61     [ addrspec>> remote>handle ] [ hostname>> ] bi <ssl-socket> ;
  62
  63 GENERIC: windows-socket-handle ( obj -- handle )
  64 M: ssl-handle windows-socket-handle file>> ;
  65 M: win32-socket windows-socket-handle ;
  66
  67 M: secure (get-local-address) ( handle remote -- sockaddr )
  68     [ windows-socket-handle ] [ addrspec>> ] bi* (get-local-address) ;
  69
  70 M: secure parse-sockaddr addrspec>> parse-sockaddr f <secure> ;
  71
  72 M:: secure establish-connection ( client-out addrspec -- )
  73     client-out handle>> file>> :> socket
  74     socket FIONBIO 1 set-ioctl-socket
  75     socket <output-port> addrspec addrspec>> establish-connection
  76     client-out addrspec secure-connection
  77     socket FIONBIO 0 set-ioctl-socket ;
  78
  79 M: windows non-ssl-socket? win32-socket? ;