Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file conduit_lwt_unix_ssl.ml
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697# 1 "lwt-unix/conduit_lwt_unix_ssl_real.ml"(*
* Copyright (c) 2012-2014 Anil Madhavapeddy <anil@recoil.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)openLwt.Infixlet()=Ssl.init()letchans_of_fdsock=letis_open=reftrueinletshutdown()=if!is_openthenLwt_ssl.ssl_shutdownsockelseLwt.return_unitinletclose()=is_open:=false;Lwt_ssl.closesockinletoc=Lwt_io.make~mode:Lwt_io.output~close:shutdown(Lwt_ssl.write_bytessock)inletic=Lwt_io.make~mode:Lwt_io.input~close(Lwt_ssl.read_bytessock)in((Lwt_ssl.get_fdsock),ic,oc)moduleClient=structletcreate_ctx?certfile?keyfile?password()=letctx=Ssl.create_contextSsl.SSLv23Ssl.Client_contextinSsl.disable_protocolsctx[Ssl.SSLv23];(* Use default CA certificates *)ignore(Ssl.set_default_verify_pathsctx);(* Enable peer verification *)Ssl.set_verifyctx[Ssl.Verify_peer]None;(matchcertfile,keyfilewith|Somecertfile,Somekeyfile->Ssl.use_certificatectxcertfilekeyfile|None,_|_,None->());(matchpasswordwith|Somepassword->Ssl.set_password_callbackctxpassword|None->());ctxletdefault_ctx=create_ctx()letconnect?(ctx=default_ctx)?src?hostnamesa=Conduit_lwt_server.with_socketsa(funfd->(matchsrcwith|None->Lwt.return_unit|Somesrc_sa->Lwt_unix.bindfdsrc_sa)>>=fun()->Lwt_unix.connectfdsa>>=fun()->beginmatchhostnamewith|Somehost->lets=Lwt_ssl.embed_uninitialized_socketfdctxinletssl=Lwt_ssl.ssl_socket_of_uninitialized_socketsinSsl.set_client_SNI_hostnamesslhost;(* Enable hostname verification *)Ssl.set_hostflagsssl[Ssl.No_partial_wildcards];Ssl.set_hostsslhost;Lwt_ssl.ssl_perform_handshakes|None->Lwt_ssl.ssl_connectfdctxend>>=funsock->Lwt.return(chans_of_fdsock))endmoduleServer=structletdefault_ctx=Ssl.create_contextSsl.SSLv23Ssl.Server_contextlet()=Ssl.disable_protocolsdefault_ctx[Ssl.SSLv23]letlisten?(ctx=default_ctx)?backlog?password~certfile~keyfilesa=letfd=Conduit_lwt_server.listen?backlogsain(matchpasswordwith|None->()|Somefn->Ssl.set_password_callbackctxfn);Ssl.use_certificatectxcertfilekeyfile;fdletinit?(ctx=default_ctx)?backlog?password~certfile~keyfile?stop?timeoutsacb=sa|>listen~ctx?backlog?password~certfile~keyfile>>=Conduit_lwt_server.init?stop(fun(fd,addr)->Lwt.try_bind(fun()->Lwt_ssl.ssl_acceptfdctx)(funsock->Lwt.return(chans_of_fdsock))(funexn->Lwt_unix.closefd>>=fun()->Lwt.failexn)>>=Conduit_lwt_server.process_accept?timeout(cbaddr))endletavailable=true