/* * The contents of this file are subject to the AOLserver Public License * Version 1.1 (the "License"); you may not use this file except in * compliance with the License. You may obtain a copy of the License at * http://aolserver.com. * * Software distributed under the License is distributed on an "AS IS" * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See * the License for the specific language governing rights and limitations * under the License. * * Alternatively, the contents of this file may be used under the terms * of the GNU General Public License (the "GPL"), in which case the * provisions of GPL are applicable instead of those above. If you wish * to allow use of your version of this file only under the terms of the * GPL and not to allow others to use your version of this file under the * License, indicate your decision by deleting the provisions above and * replace them with the notice and other provisions required by the GPL. * If you do not delete the provisions above, a recipient may use your * version of this file under either the License or the GPL. * * Copyright (C) 2000-2003 Scott S. Goodwin * * Module originally written by Stefan Arentz. Early contributions made by * Freddie Mendoze and Rob Mayoff. */ /* * tclcmds.c -- * * Tcl API for nsopenssl */ static const char *RCSID = "@(#) $Header: /cvsroot/aolserver/nsopenssl/tclcmds.c,v 1.51 2004/06/13 04:21:31 scottg Exp $, compiled: " __DATE__ " " __TIME__; #include "nsopenssl.h" /* * Used to track both conn info and which chan to close. */ typedef struct ChanInfo { NsOpenSSLConn *sslconn; SOCKET socket; Tcl_Channel chan; void *otherchaninfo; } ChanInfo; static int CreateTclChannel(NsOpenSSLConn *sslconn, Tcl_Interp *interp); static int ChanCloseProc(ClientData arg, Tcl_Interp *interp); static int ChanInputProc(ClientData arg, char *buf, int bufSize, int *errorCodePtr); static int ChanOutputProc(ClientData arg, char *buf, int toWrite, int *errorCodePtr); static void ChanWatchProc(ClientData arg, int mask); static int ChanFlushProc(ClientData arg); static int ChanGetHandleProc(ClientData arg, int direction, ClientData *handlePtr); static void SetResultToX509Name(Tcl_Interp *interp, X509_NAME *name); static void SetResultToObjectName(Tcl_Interp *interp, ASN1_OBJECT *obj); static char * ValidTime(ASN1_UTCTIME *tm); static char * PEMCertificate(X509 *peercert); static int EnterSock(Tcl_Interp *interp, SOCKET sock); static int EnterDup(Tcl_Interp *interp, SOCKET sock); #if 0 static int EnterDupedSocks(Tcl_Interp *interp, SOCKET sock); #endif static int GetSet(Tcl_Interp *interp, char *flist, int write, fd_set **setPtrPtr, fd_set *setPtr, SOCKET *maxPtr); static void AppendReadyFiles (Tcl_Interp *interp, fd_set *setPtr, int write, char *flist, Tcl_DString *dsPtr); static Ns_SockProc SSLSockListenCallbackProc; static Ns_SockProc SSLSockCallbackProc; /* * Define a Tcl channel so we can use standard Tcl commands to read and write * on the connection. */ static Tcl_ChannelType opensslChannelType = { "openssl", /* Type name. */ TCL_CHANNEL_VERSION_2, /* channel version 2 */ ChanCloseProc, /* Close proc. */ ChanInputProc, /* Input proc. */ ChanOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ ChanWatchProc, /* Watch proc. (mandatory) */ ChanGetHandleProc, /* Get Handle */ NULL, /* Close2 proc */ NULL, /* Set blocking/nonblocking mode. */ ChanFlushProc, /* Flush proc */ NULL, /* Handler proc */ }; static Ns_TclInterpInitProc AddCmds; extern Tcl_ObjCmdProc NsTclOpenSSLObjCmd, NsTclOpenSSLSockAcceptObjCmd, NsTclOpenSSLSockOpenObjCmd, NsTclOpenSSLSockListenObjCmd, NsTclOpenSSLSockListenCallbackObjCmd, NsTclOpenSSLSockCallbackObjCmd, NsTclOpenSSLGetUrlObjCmd; extern Tcl_CmdProc NsTclOpenSSLGetUrlCmd, NsTclOpenSSLSockCheckCmd, NsTclOpenSSLSockNReadCmd, NsTclOpenSSLSockSelectCmd; typedef struct Cmd { char *name; Tcl_CmdProc *proc; Tcl_ObjCmdProc *objProc; } Cmd; static Cmd nsopensslCmds[] = { {"ns_openssl", NULL, NsTclOpenSSLObjCmd }, {"ns_openssl_sockopen", NULL, NsTclOpenSSLSockOpenObjCmd }, {"ns_openssl_geturl", NULL, NsTclOpenSSLGetUrlObjCmd }, {"ns_openssl_sockaccept", NULL, NsTclOpenSSLSockAcceptObjCmd }, {"ns_openssl_socklisten", NULL, NsTclOpenSSLSockListenObjCmd }, {"ns_openssl_sockcallback", NULL, NsTclOpenSSLSockCallbackObjCmd }, {"ns_openssl_socklistencallback", NULL, NsTclOpenSSLSockListenCallbackObjCmd }, #if 0 /* these ns_openssl_sock* commands are not implemented */ {"ns_openssl_socknread", NsTclOpenSSLSockNReadCmd, NULL }, {"ns_openssl_sockselect", NsTclOpenSSLSockSelectCmd, NULL }, {"ns_openssl_sockcheck", NsTclOpenSSLSockCheckCmd, NULL }, {"ns_openssl_socketpair", NsTclSSLSocketPairCmd, NULL }, {"ns_openssl_hostbyaddr", NsTclSSLGetByCmd, NULL }, {"ns_openssl_addrbyhost", NsTclSSLGetByCmd, (ClientData) 1 }, #endif {NULL, NULL, NULL} }; typedef struct SockListenCallback { char *server; NsOpenSSLContext *sslcontext; char *script; } SockListenCallback; typedef struct SockCallback { char *server; int when; char script[1]; } SockCallback; /* *---------------------------------------------------------------------- * * NsOpenSSLTclInit -- * * Initialize Tcl API for a virtual server. The last argument of * Ns_TclInitInterps is a pointer to a function that * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void NsOpenSSLTclInit(char *server) { Server *thisServer = NsOpenSSLServerGet(server); Ns_TclInitInterps(server, AddCmds, (void *) thisServer); } /* *---------------------------------------------------------------------- * * AddCmds -- * * Add nsopenssl commands to Tcl interpreter. * * Results: * NS_OK or NS_ERROR. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int AddCmds(Tcl_Interp *interp, void *arg) { Cmd *cmd = (Cmd *) &nsopensslCmds; while (cmd->name != NULL) { if (cmd->objProc != NULL) { Tcl_CreateObjCommand(interp, cmd->name, cmd->objProc, arg, NULL); } else { Tcl_CreateCommand(interp, cmd->name, cmd->proc, arg, NULL); } ++cmd; } return NS_OK; } /* *---------------------------------------------------------------------- * * NsTclOpenSSLObjCmd -- * * Implements ns_openssl command, which returns information about clients * connected to the nsopenssl server, including client certificates. * * Results: * Tcl string result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int NsTclOpenSSLObjCmd(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { // XXX Server *thisServer = (Server *) arg; NsOpenSSLConn *sslconn = NULL; X509 *peercert = NULL; SSL_CIPHER *cipher = NULL; Ns_Conn *conn = NULL; char *string = NULL; char *name = NULL; int integer = 0; int status = TCL_OK; static CONST char *opts[] = { "info", "module", "protocol", "port", "peerport", "cipher", "clientcert" }; enum ISubCmdIdx { CInfoIdx, CModuleIdx, CProtocolIdx, CPortIdx, CPeerPortIdx, CCipherIdx, CClientCertIdx } opt; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0, (int *) &opt) != TCL_OK) { return TCL_ERROR; } if (opt == CInfoIdx) { Tcl_SetResult(interp, OPENSSL_VERSION_TEXT, TCL_STATIC); return TCL_OK; } /* * AOLserver stashes a pointer to the conn in the interp. We then use that * to get a pointer to our SSL conn through the core driver's context. If * conn is NULL, it means our connection is not driver by the comm API, so * we need to get the connection information back another way. */ /* XXX needs rewiring to allow for reporting info on non-nsd-driven conns */ conn = Ns_TclGetConn(interp); if (conn == NULL) { Tcl_AppendResult(interp, "this is not a connection thread", NULL); return TCL_ERROR; } else { name = Ns_ConnDriverName(conn); if (name != NULL && STREQ(name, MODULE)) { sslconn = (NsOpenSSLConn *) Ns_ConnDriverContext(conn); } if (sslconn == NULL) { Tcl_AppendResult(interp, "this is a connection thread, but not an SSL connection thread", NULL); return TCL_ERROR; } } switch (opt) { case CModuleIdx: /* * Implement: * ns_openssl module name * ns_openssl module port */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "option"); return TCL_ERROR; } if (STREQ(Tcl_GetString(objv[2]), "name")) { Tcl_SetResult(interp, MODULE, TCL_VOLATILE); } else if (STREQ(Tcl_GetString(objv[2]), "port")) { /* XXX peerport is the port this conn came in on -- clean up */ sprintf(interp->result, "%d", sslconn->peerport); } break; case CProtocolIdx: switch (sslconn->ssl->session->ssl_version) { case SSL2_VERSION: string = "SSLv2"; break; case SSL3_VERSION: string = "SSLv3"; break; case TLS1_VERSION: string = "TLSv1"; break; default: string = "UNKNOWN"; } Tcl_SetResult(interp, string, TCL_VOLATILE); break; case CPortIdx: case CPeerPortIdx: sprintf(interp->result, "%d", sslconn->peerport); break; case CCipherIdx: cipher = SSL_get_current_cipher(sslconn->ssl); if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "option"); return TCL_ERROR; } if (STREQ(Tcl_GetString(objv[2]), "name")) { string = (sslconn->ssl != NULL ? (char *) SSL_CIPHER_get_name(cipher) : NULL); Tcl_SetResult(interp, string, TCL_VOLATILE); } else if (STREQ(Tcl_GetString(objv[2]), "strength")) { integer = SSL_CIPHER_get_bits(cipher, &integer); sprintf(interp->result, "%d", integer); } break; case CClientCertIdx: /* * Implement: * ns_openssl clientcert exists * ns_openssl clientcert version * ns_openssl clientcert serial * ns_openssl clientcert subject * ns_openssl clientcert issuer * ns_openssl clientcert notbefore * ns_openssl clientcert notafter * ns_openssl clientcert signaturealgorithm * ns_openssl clientcert key_algorithm * ns_openssl clientcert pem * ns_openssl clientcert valid */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "option"); return TCL_ERROR; } peercert = (sslconn == NULL) ? NULL : SSL_get_peer_certificate(sslconn->ssl); if (STREQ(Tcl_GetString(objv[2]), "exists")) { Tcl_SetResult(interp, peercert == NULL ? "0" : "1", TCL_STATIC); } else if (STREQ(Tcl_GetString(objv[2]), "version")) { sprintf(interp->result, "%lu", peercert == NULL ? 0 : X509_get_version(peercert) + 1); } else if (STREQ(Tcl_GetString(objv[2]), "serial")) { sprintf(interp->result, "%ld", peercert == NULL ? 0 : ASN1_INTEGER_get(X509_get_serialNumber(peercert))); } else if (STREQ(Tcl_GetString(objv[2]), "subject")) { if (peercert != NULL) { SetResultToX509Name(interp, X509_get_subject_name(peercert)); } } else if (STREQ(Tcl_GetString(objv[2]), "issuer")) { if (peercert != NULL) { SetResultToX509Name(interp, X509_get_issuer_name(peercert)); } } else if (STREQ(Tcl_GetString(objv[2]), "notbefore")) { if (peercert != NULL) { string = ValidTime(X509_get_notBefore(peercert)); if (string == NULL) { Tcl_SetResult(interp, "error getting notbefore", TCL_STATIC); status = TCL_ERROR; } else { Tcl_SetResult(interp, string, TCL_DYNAMIC); } } } else if (STREQ(Tcl_GetString(objv[2]), "notafter")) { if (peercert != NULL) { string = ValidTime(X509_get_notAfter(peercert)); if (string == NULL) { Tcl_SetResult(interp, "error getting notafter", TCL_STATIC); status = TCL_ERROR; } else { Tcl_SetResult(interp, string, TCL_DYNAMIC); } } } else if (STREQ(Tcl_GetString(objv[2]), "signature_algorithm")) { if (peercert != NULL) { SetResultToObjectName(interp, peercert->cert_info->signature-> algorithm); } } else if (STREQ(Tcl_GetString(objv[2]), "key_algorithm")) { if (peercert != NULL) { SetResultToObjectName(interp, peercert->cert_info->key->algor-> algorithm); } } else if (STREQ(Tcl_GetString(objv[2]), "pem")) { if (peercert != NULL) { string = PEMCertificate(peercert); if (string == NULL) { Tcl_SetResult(interp, "error getting pem", TCL_STATIC); status = TCL_ERROR; } else { Tcl_SetResult(interp, string, TCL_DYNAMIC); } } } else if (STREQ(Tcl_GetString(objv[2]), "valid")) { sprintf(interp->result, "%d", peercert != NULL && SSL_get_verify_result(sslconn->ssl) == X509_V_OK); } else { /* XXX revalidate the list below (see if Tcl has a better library function for this) */ Tcl_AppendResult(interp, "unknown command \"", Tcl_GetString(objv[2]), "\": should be one of: exists version serial subject issuer notbefore notafter signature_algorithm key_algorithm pem valid", NULL); return TCL_ERROR; } break; case CInfoIdx: /* NEVER REACHED */ break; } return TCL_OK; } /* *---------------------------------------------------------------------- * * NsTclOpenSSLSockOpenObjCmd -- * * Open a tcp connection to a host/port via SSL. * * Results: * Tcl result. * * Side effects: * Will open a connection and register a Tcl channel. * *---------------------------------------------------------------------- */ int NsTclOpenSSLSockOpenObjCmd(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Server *thisServer = (Server *) arg; NsOpenSSLConn *sslconn = NULL; NsOpenSSLContext *sslcontext = NULL; char *name = NULL; int first = 1; int async = 0; int timeout = -1; int sslctx = 0; int port = 0; CONST char *args = "?-nonblock|-timeout seconds? host port ?sslcontext?"; /* * (3) ns_sockopen host port * (4) ns_sockopen -nonblock host port * (5) ns_sockopen -timeout seconds host port * (4) ns_sockopen host port sslcontext * (5) ns_sockopen -nonblock host port sslcontext * (6) ns_sockopen -timeout seconds host port sslcontext */ /* * Works out to this matrix where the # is the number of args: * * sslcontext? * * Y N * --------- * no '-' 4 3 * -nonblock 5 4 * -timeout 6 5 */ if (objc < 3 || objc > 6) { Tcl_WrongNumArgs(interp, 1, objv, "?-nonblock|-timeout seconds? host port ?sslcontext?"); return TCL_ERROR; } if (STREQ(Tcl_GetString(objv[1]), "-nonblock")) { if (objc == 4) { sslctx = 0; } else if (objc == 5) { sslctx = 1; } else { Tcl_WrongNumArgs(interp, 1, objv, args); return TCL_ERROR; } first = 2; async = 1; } else if (STREQ(Tcl_GetString(objv[1]), "-timeout")) { if (objc == 5) { sslctx = 0; } else if (objc == 6) { sslctx = 1; } else { Tcl_WrongNumArgs(interp, 1, objv, args); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) { return TCL_ERROR; } first = 3; } else { if (objc == 3) { sslctx = 0; } else if (objc == 4) { sslctx = 1; } else { Tcl_WrongNumArgs(interp, 1, objv, args); return TCL_ERROR; } } if (Tcl_GetIntFromObj(interp, objv[first + 1], &port) != TCL_OK) { return TCL_ERROR; } /* * Get the named SSL context. If there is no named SSL context, attempt to * use the default. */ if (sslctx) { name = (char *) Tcl_GetString(objv[first + 2]); sslcontext = Ns_OpenSSLServerSSLContextGet(thisServer->server, name); } else { sslcontext = NsOpenSSLContextClientDefaultGet(thisServer->server); } if (sslcontext == NULL) { Tcl_SetResult(interp, "failed to use either named or default client SSL context", TCL_STATIC); return TCL_ERROR; } /* * Perform the connection. */ sslconn = Ns_OpenSSLSockConnect( thisServer->server, Tcl_GetString(objv[first]), port, async, timeout, sslcontext ); if (sslconn == NULL) { Tcl_AppendResult(interp, "could not connect to \"", Tcl_GetString(objv[first]), ":", Tcl_GetString(objv[first + 1]), "\"", NULL); return TCL_ERROR; } /* * Create the Tcl channel that let's us use gets, puts etc. and layer it on * top of the conn. */ if (CreateTclChannel(sslconn, interp) != NS_OK) { Ns_Log(Warning, "%s: %s: Tcl channel not available", MODULE, sslconn->server); //Ns_Log(Debug, "--->>> BEFORE ConnDestroy: SockOpen"); NsOpenSSLConnDestroy(sslconn); return TCL_ERROR; } /* * Append "1" as the third element returned if peer's certificate is valid; * "0" otherwise. */ if (Ns_OpenSSLX509CertVerify(sslconn->ssl)) { Tcl_AppendElement(interp, "1"); } else { Tcl_AppendElement(interp, "0"); } return TCL_OK; } /* *---------------------------------------------------------------------- * * NsTclOpenSSLSockListenObjCmd -- * * Listen on a TCP port. * * Results: * Tcl result. * * Side effects: * Will listen on a port. * *---------------------------------------------------------------------- */ extern int NsTclOpenSSLSockListenObjCmd(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Server *thisServer = (Server *) arg; SOCKET socket = INVALID_SOCKET; char *addr = NULL; int port = 0; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "address port"); return TCL_ERROR; } addr = Tcl_GetString(objv[1]); if (STREQ(addr, "*")) { addr = NULL; } if (Tcl_GetIntFromObj(interp, objv[2], &port) != TCL_OK) { return TCL_ERROR; } socket = Ns_OpenSSLSockListen(addr, port); if (socket == INVALID_SOCKET) { Tcl_AppendResult(interp, "could not listen on \"", addr, ":", Tcl_GetString(objv[2]), "\"", NULL); return TCL_ERROR; } return EnterSock(interp, socket); } /* *---------------------------------------------------------------------- * * NsTclOpenSSLSockAcceptObjCmd -- * * Accept a connection from a listening socket. * * Results: * Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ /* XXX SSL context needs to be passed */ extern int NsTclOpenSSLSockAcceptObjCmd(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Server *thisServer = (Server *) arg; NsOpenSSLConn *sslconn = NULL; NsOpenSSLContext *sslcontext = NULL; SOCKET socket = INVALID_SOCKET; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "sockId"); return TCL_ERROR; } if (Ns_TclGetOpenFd(interp, Tcl_GetString(objv[1]), 0, (int *) &socket) != TCL_OK) { return TCL_ERROR; } /* * Perform normal socket accept */ socket = Ns_SockAccept(socket, NULL, 0); if (socket == INVALID_SOCKET) { Tcl_AppendResult(interp, "accept failed: ", SockError(interp), NULL); return TCL_ERROR; } /* Figure out which SSL context to use in creating the SSL connection */ /* XXX update API to accept last arg of sslcontext */ //if (sslctx) { // name = (char *) Tcl_GetString(objv[first + 2]); // sslcontext = Ns_OpenSSLServerSSLContextGet(thisServer->server, module, name); //} else { sslcontext = NsOpenSSLContextServerDefaultGet(thisServer->server); //} if (sslcontext == NULL) { Tcl_SetResult(interp, "failed to use either named or default client SSL context", TCL_STATIC); return TCL_ERROR; } sslconn = Ns_OpenSSLSockAccept(socket, sslcontext); if (sslconn == NULL) { Tcl_SetResult(interp, "SSL accept failed", TCL_STATIC); return TCL_ERROR; } if (CreateTclChannel(sslconn, interp) != NS_OK) { Ns_Log(Error, "%s (%s): Tcl channel not available", MODULE, sslconn->server); //Ns_Log(Debug, "--->>> BEFORE ConnDestroy: SockAccept"); NsOpenSSLConnDestroy(sslconn); return TCL_ERROR; } /* * Append "1" as the third element returned if peer certificate * is found to be valid; "0" otherwise. Is this the best way to do * it? */ if (Ns_OpenSSLX509CertVerify(sslconn)) { Tcl_AppendElement(interp, "1"); } else { Tcl_AppendElement(interp, "0"); } return TCL_OK; } /* *---------------------------------------------------------------------- * * NsTclOpenSSLGetUrlObjCmd -- * * Implements ns_openssl_geturl. * * Results: * Tcl result. * * Side effects: * See docs. * *---------------------------------------------------------------------- */ /* XXX SSL context needs to be passed */ /* XXX restructure this function to not use the 'done' label */ extern int NsTclOpenSSLGetUrlObjCmd(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Server *thisServer = (Server *) arg; NsOpenSSLContext *sslcontext = NULL; Ns_DString ds; Ns_Set *headers = NULL; int status = TCL_ERROR; char *url = NULL; Ns_DStringInit(&ds); if ((objc != 3) && (objc != 2)) { Tcl_WrongNumArgs(interp, 1, objv, " url ?headersSetIdVar?"); goto done; } if (objc == 2) { headers = NULL; } else { headers = Ns_SetCreate(NULL); } url = Tcl_GetString(objv[1]); if (url[1] == '/') { if (Ns_FetchPage(&ds, url, Ns_TclInterpServer(interp)) != NS_OK) { Tcl_AppendResult(interp, "Could not get contents of URL \"", url, "\"", NULL); goto done; } } else { /* Figure out which SSL context to use in creating the SSL connection */ /* XXX update API to accept last arg of sslcontext */ //if (sslctx) { // name = (char *) Tcl_GetString(objv[first + 2]); // sslcontext = Ns_OpenSSLServerSSLContextGet(thisServer->server, module, name); //} else { sslcontext = NsOpenSSLContextClientDefaultGet(thisServer->server); //} if (sslcontext == NULL) { Tcl_SetResult(interp, "failed to use either named or default client SSL context", TCL_STATIC); goto done; } if (Ns_OpenSSLFetchUrl(thisServer->server, &ds, url, headers, sslcontext) != NS_OK) { Tcl_AppendResult(interp, "Could not get contents of URL \"", url, "\"", NULL); if (headers != NULL) { Ns_SetFree(headers); } goto done; } } if (objc == 3) { Ns_TclEnterSet(interp, headers, 1); /* XXX there's probably a Tcl_Obj way of doing the following */ Tcl_SetVar(interp, Tcl_GetString(objv[2]), interp->result, 0); } Tcl_SetResult(interp, ds.string, TCL_VOLATILE); status = TCL_OK; done: Ns_DStringFree(&ds); return status; } /* *---------------------------------------------------------------------- * * NsTclOpenSSLSockNReadCmd -- * * Gets the number of bytes that a socket has waiting to be * read. * * Results: * Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ extern int NsTclOpenSSLSockNReadCmd(ClientData arg, Tcl_Interp *interp, int argc, CONST char **argv) { Server *thisServer = (Server *) arg; Tcl_Channel chan = NULL; SOCKET socket = INVALID_SOCKET; int nread = 0; int status = TCL_ERROR; if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " sockId\"", NULL); goto done; } chan = Tcl_GetChannel(interp, argv[1], NULL); if ( chan == NULL || Ns_TclGetOpenFd(interp, argv[1], 0, (int *) &socket) != TCL_OK ) { goto done; } if (ns_sockioctl(socket, FIONREAD, &nread) != 0) { Tcl_AppendResult(interp, "ns_sockioctl failed: ", SockError(interp), NULL); goto done; } nread += Tcl_InputBuffered(chan); sprintf(interp->result, "%d", nread); status = TCL_OK; done: return status; } /* *---------------------------------------------------------------------- * * NsTclOpenSSLSockCheckCmd -- * * Check if a socket is still connected, useful for nonblocking. * * Results: * Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ extern int NsTclOpenSSLSockCheckCmd(ClientData arg, Tcl_Interp *interp, int argc, CONST char **argv) { Server *thisServer = (Server *) arg; SOCKET socket = INVALID_SOCKET; int status = TCL_ERROR; if (argc != 2) { Tcl_AppendResult(interp, "wrong # of args: should be \"", argv[0], " sockId\"", NULL); goto done; } if (Ns_TclGetOpenFd(interp, argv[1], 1, (int *) &socket) != TCL_OK) { goto done; } if (send(socket, NULL, 0, 0) != 0) { interp->result = "0"; } else { interp->result = "1"; } status = TCL_OK; done: return status; } /* *---------------------------------------------------------------------- * * NsTclOpenSSLSelectCmd -- * * Imlements ns_sockselect: basically a tcl version of * select(2). * * Results: * Tcl result. * * Side effects: * See docs. * *---------------------------------------------------------------------- */ extern int NsTclOpenSSLSockSelectCmd(ClientData arg, Tcl_Interp *interp, int argc, CONST char *argv[]) { Server *thisServer = (Server *) arg; fd_set rset; fd_set wset; fd_set eset; fd_set *rPtr = NULL; fd_set *wPtr = NULL; fd_set *ePtr = NULL; SOCKET maxfd = INVALID_SOCKET; Tcl_Channel chan = NULL; Tcl_DString dsRfd; Tcl_DString dsNbuf; struct timeval tv; struct timeval *tvPtr = NULL; char **fargv = NULL; int fargc = 0; int i; int status = TCL_ERROR; int first; Tcl_DStringInit(&dsRfd); Tcl_DStringInit(&dsNbuf); if (argc != 6 && argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ?-timeout sec? rfds wfds efds\"", NULL); return TCL_ERROR; } if (argc == 4) { tvPtr = NULL; first = 1; } else { tvPtr = &tv; if (strcmp(argv[1], "-timeout") != 0) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ?-timeout sec? rfds wfds efds\"", NULL); return TCL_ERROR; } tv.tv_usec = 0; if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) { return TCL_ERROR; } tv.tv_sec = i; first = 3; } /* * Readable fd's are treated differently because they may * have buffered input. Before doing a select, see if they * have any waiting data that's been buffered by the channel. */ if (Tcl_SplitList(interp, argv[first++], &fargc, &fargv) != TCL_OK) { return TCL_ERROR; } for (i = 0; i < fargc; ++i) { chan = Tcl_GetChannel(interp, fargv[i], NULL); if (chan == NULL) { goto done; } if (Tcl_InputBuffered(chan) > 0) { Tcl_DStringAppendElement(&dsNbuf, fargv[i]); } else { Tcl_DStringAppendElement(&dsRfd, fargv[i]); } } /* * Since at least one read fd had buffered input, * turn the select into a polling select just * to pick up anything else ready right now. */ if (dsNbuf.length > 0) { tv.tv_sec = 0; tv.tv_usec = 0; tvPtr = &tv; } maxfd = 0; if (GetSet(interp, dsRfd.string, 0, &rPtr, &rset, &maxfd) != TCL_OK) { goto done; } if (GetSet(interp, argv[first++], 1, &wPtr, &wset, &maxfd) != TCL_OK) { goto done; } if (GetSet(interp, argv[first++], 0, &ePtr, &eset, &maxfd) != TCL_OK) { goto done; } /* * Return immediately if we're not doing a select on anything. */ if (dsNbuf.length == 0 && rPtr == NULL && wPtr == NULL && ePtr == NULL && tvPtr == NULL) { status = TCL_OK; } else { /* * Actually perform the select. */ do { i = select(maxfd + 1, rPtr, wPtr, ePtr, tvPtr); } while (i < 0 && ns_sockerrno == EINTR); if (i == -1) { Tcl_AppendResult(interp, "select failed: ", SockError(interp), NULL); } else { if (i == 0) { /* * The sets can have any random value now */ if (rPtr != NULL) { FD_ZERO(rPtr); } if (wPtr != NULL) { FD_ZERO(wPtr); } if (ePtr != NULL) { FD_ZERO(ePtr); } } AppendReadyFiles(interp, rPtr, 0, dsRfd.string, &dsNbuf); first -= 2; AppendReadyFiles(interp, wPtr, 1, argv[first++], NULL); AppendReadyFiles(interp, ePtr, 0, argv[first++], NULL); status = TCL_OK; } } done: Tcl_DStringFree(&dsRfd); Tcl_DStringFree(&dsNbuf); ckfree((char *) fargv); return status; } /* *---------------------------------------------------------------------- * * NsTclOpenSSLSockCallbackObjCmd -- * * Register a Tcl callback to be run when a certain state exists * on a socket. * * Results: * Tcl result. * * Side effects: * A callback will be registered. * *---------------------------------------------------------------------- */ extern int NsTclOpenSSLSockCallbackObjCmd(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Server *thisServer = (Server *) arg; SockCallback *cbPtr = NULL; SOCKET socket = INVALID_SOCKET; int when = 0; char *s = NULL; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "sockId script when"); return TCL_ERROR; } s = Tcl_GetString(objv[3]); while (*s != '\0') { if (*s == 'r') { when |= NS_SOCK_READ; } else if (*s == 'w') { when |= NS_SOCK_WRITE; } else if (*s == 'e') { when |= NS_SOCK_EXCEPTION; } else if (*s == 'x') { when |= NS_SOCK_EXIT; } else { Tcl_AppendResult(interp, "invalid when specification \"", Tcl_GetString(objv[3]), "\": should be one or more of r, w, e, or x", NULL); return TCL_ERROR; } ++s; } if (when == 0) { Tcl_AppendResult(interp, "invalid when specification \"", Tcl_GetString(objv[3]), "\": should be one or more of r, w, e, or x", NULL); return TCL_ERROR; } if (Ns_TclGetOpenFd(interp, Tcl_GetString(objv[1]), (when & NS_SOCK_WRITE), (int *) &socket) != TCL_OK) { return TCL_ERROR; } socket = ns_sockdup(socket); if (socket == INVALID_SOCKET) { Tcl_AppendResult(interp, "dup failed: ", SockError(interp), NULL); return TCL_ERROR; } cbPtr = ns_malloc(sizeof(SockCallback) + strlen(Tcl_GetString(objv[2]))); cbPtr->server = thisServer->server; cbPtr->when = when; strcpy(cbPtr->script, Tcl_GetString(objv[2])); if (Ns_SockCallback(socket, SSLSockCallbackProc, cbPtr, when | NS_SOCK_EXIT) != NS_OK) { interp->result = "could not register callback"; ns_sockclose(socket); ns_free(cbPtr); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * NsTclOpenSSLSockListenCallbackObjCmd -- * * Listen on a socket and register a callback to run when * connections arrive. * * Results: * Tcl result. * * Side effects: * Will register a callback and listen on a socket. * *---------------------------------------------------------------------- */ int NsTclOpenSSLSockListenCallbackObjCmd(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Server *thisServer = (Server *) arg; SockListenCallback *lcbPtr = NULL; int port = 0; char *addr = NULL; /* * ns_openssl_socklistencallback host port script * ns_openssl_socklistencallback host port script sslcontext */ if (objc != 4 && objc != 5) { Tcl_WrongNumArgs(interp, 1, objv, "address port script ?sslcontext?"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[2], &port) != TCL_OK) { return TCL_ERROR; } addr = Tcl_GetString(objv[1]); if (STREQ(addr, "*")) { addr = NULL; } lcbPtr = ns_malloc(sizeof(SockListenCallback)); lcbPtr->server = thisServer->server; lcbPtr->script = strdup(Tcl_GetString(objv[3])); if (objc == 5) { lcbPtr->sslcontext = Ns_OpenSSLServerSSLContextGet(thisServer->server, (char *) Tcl_GetString(objv[5])); } else { lcbPtr->sslcontext = NsOpenSSLContextServerDefaultGet(thisServer->server); } /* XXX check lcbPtr->sslcontext: if NULL, fail with error message !!! */ #if 0 if (sslcontext == NULL) { Tcl_SetResult(interp, "failed to use either named or default client SSL context", TCL_STATIC); return TCL_ERROR; } #endif if (Ns_SockListenCallback(addr, port, SSLSockListenCallbackProc, lcbPtr) != NS_OK) { Ns_Log(Error, "NsTclOpenSSLSockListenCallbackCmd: COULD NOT REGISTER CALLBACK"); Tcl_SetResult(interp, "could not register callback", TCL_STATIC); ns_free(lcbPtr); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * EnterSock, EnterDup -- * * Append a socket handle to the tcl result and register its * channel. * * Results: * Tcl result. * * Side effects: * Will create channel, append handle to result. * *---------------------------------------------------------------------- */ static int EnterSock(Tcl_Interp *interp, SOCKET sock) { Tcl_Channel chan = NULL; chan = Tcl_MakeTcpClientChannel((ClientData) sock); if (chan == NULL) { Tcl_AppendResult(interp, "could not open socket", NULL); ns_sockclose(sock); return TCL_ERROR; } Tcl_SetChannelOption(interp, chan, "-translation", "binary"); Tcl_RegisterChannel(interp, chan); sprintf(interp->result, "%s", Tcl_GetChannelName(chan)); return TCL_OK; } static int EnterDup(Tcl_Interp *interp, SOCKET sock) { sock = ns_sockdup(sock); if (sock == INVALID_SOCKET) { Tcl_AppendResult(interp, "could not dup socket: ", ns_sockstrerror(ns_sockerrno), NULL); return TCL_ERROR; } return EnterSock(interp, sock); } #if 0 static int EnterDupedSocks(Tcl_Interp *interp, SOCKET sock) { if (EnterSock(interp, sock) != TCL_OK || EnterDup(interp, sock) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } #endif /* *---------------------------------------------------------------------- * * SetResultToX509Name -- * * Set the Tcl interpreter's result to the string form of the * specified X.509 name. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void SetResultToX509Name(Tcl_Interp *interp, X509_NAME *name) { char *string = NULL; string = X509_NAME_oneline(name, NULL, 0); Tcl_SetResult(interp, string, TCL_VOLATILE); OPENSSL_free(string); } /* *---------------------------------------------------------------------- * * SetResultToObjectName -- * * Set the Tcl interpreter's result to the string form of the * specified ASN.1 object name. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void SetResultToObjectName(Tcl_Interp *interp, ASN1_OBJECT *obj) { int nid = 0; char *string = NULL; nid = OBJ_obj2nid(obj); if (nid == NID_undef) { Tcl_SetResult(interp, "UNKNOWN", TCL_STATIC); } else { string = (char *) OBJ_nid2ln(nid); if (string == NULL) { Tcl_SetResult(interp, "ERROR", TCL_STATIC); } else { Tcl_SetResult(interp, string, TCL_VOLATILE); } } } /* *---------------------------------------------------------------------- * * ValidTime -- * * Takes an ASN1_UTCTIME value and converts it into a string of * the form "Aug 28 20:00:38 2002 GMT" * * Results: * Pointer to null-terminated string allocated by Tcl_Alloc. * * Side effects: * None. * *---------------------------------------------------------------------- */ static char * ValidTime(ASN1_UTCTIME *tm) { char *result = NULL; BIO *bio = NULL; unsigned int n = 0; if ((bio = BIO_new(BIO_s_mem())) == NULL) { return NULL; } ASN1_UTCTIME_print(bio, tm); n = BIO_pending(bio); result = Tcl_Alloc(n + 1); n = BIO_read(bio, result, (signed int) n); result[n] = '\0'; BIO_free(bio); return result; } /* *---------------------------------------------------------------------- * * PEMCertificate -- * * Retrieves the certificate in PEM format * * Results: * Pointer to null-terminated string that contains the PEM * certificate, allocated by Tcl_Alloc. * * Side effects: * None. * *---------------------------------------------------------------------- */ static char * PEMCertificate(X509 *peercert) { char *result = NULL; BIO *bio = NULL; unsigned int n = 0; if ((bio = BIO_new(BIO_s_mem())) == NULL) { return NULL; } PEM_write_bio_X509(bio, peercert); n = BIO_pending(bio); result = Tcl_Alloc(n + 1); n = BIO_read(bio, result, (signed int) n); result[n] = '\0'; BIO_free(bio); return result; } /* *---------------------------------------------------------------------- * * CreateTclChannel -- * * Dup connection sock and wrap read and write Tcl channels * around them. * * Results: * Tcl result. * * Side effects: * *---------------------------------------------------------------------- */ static int CreateTclChannel(NsOpenSSLConn *sslconn, Tcl_Interp *interp) { ChanInfo *getschan = NULL; ChanInfo *putschan = NULL; Tcl_DString ds; char channelName[16 + TCL_INTEGER_SPACE]; Tcl_DStringInit(&ds); /* * The ns_sock API in AOLserver passes back a separate read and write fds * to work with. In our case, we're using the same socket underneath both, * but to maintain consistency we also create two separate channels and * pass back two separate fds to the caller. */ getschan = ns_calloc(1, sizeof(ChanInfo)); getschan->sslconn = sslconn; putschan = ns_calloc(1, sizeof(ChanInfo)); putschan->sslconn = sslconn; getschan->otherchaninfo = (void *) putschan; putschan->otherchaninfo = (void *) getschan; /* * Set up the read channel. */ getschan->socket = sslconn->socket; sprintf(channelName, "openssl%d", getschan->socket); getschan->chan = Tcl_CreateChannel( &opensslChannelType, channelName, (ClientData) getschan, (TCL_READABLE | TCL_WRITABLE) ); if (getschan->chan == (Tcl_Channel) NULL) { Ns_Log(Error, "%s: %s: could not create new Tcl channel", MODULE, sslconn->server); Tcl_AppendResult (interp, "could not create new Tcl channel", NULL); return TCL_ERROR; } Tcl_SetChannelBufferSize(getschan->chan, BUFSIZ); Tcl_SetChannelOption(interp, getschan->chan, "-translation", "binary"); Tcl_RegisterChannel(interp, getschan->chan); /* * Set up the write channel. */ putschan->socket = ns_sockdup(sslconn->socket); sprintf(channelName, "openssl%d", putschan->socket); putschan->chan = Tcl_CreateChannel( &opensslChannelType, channelName, (ClientData) putschan, (TCL_READABLE | TCL_WRITABLE) ); if (putschan->chan == (Tcl_Channel) NULL) { Ns_Log(Error, "%s: %s: could not create new Tcl channel", MODULE, sslconn->server); Tcl_AppendResult (interp, "could not create new Tcl channel", NULL); return TCL_ERROR; } Tcl_SetChannelBufferSize(putschan->chan, BUFSIZ); Tcl_SetChannelOption(interp, putschan->chan, "-translation", "binary"); Tcl_RegisterChannel(interp, putschan->chan); /* * Append the fd names to the result. */ Tcl_DStringAppendElement(&ds, Tcl_GetChannelName(getschan->chan)); Tcl_DStringAppendElement(&ds, Tcl_GetChannelName(putschan->chan)); //Ns_Log(Debug, "*** CHAN CREATE: %s", Tcl_GetChannelName(getschan->chan)); //Ns_Log(Debug, "*** CHAN CREATE: %s", Tcl_GetChannelName(putschan->chan)); Tcl_DStringResult(interp, &ds); return TCL_OK; } /* *---------------------------------------------------------------------- * * ChanOutputProc -- * * Callback activated by Tcl puts and write commands. Sends data * to the connected system. * * Results: * Tcl result. * * Side effects: * *---------------------------------------------------------------------- */ static int ChanOutputProc(ClientData arg, char *buf, int towrite, int *errorCodePtr) { ChanInfo *chaninfo = (ChanInfo *) arg; int rc = 0; rc = NsOpenSSLConnOp(chaninfo->sslconn->ssl, (void *) buf, towrite, NSOPENSSL_SEND); return rc; } /* *---------------------------------------------------------------------- * * ChanInputProc -- * * Callback activated by Tcl gets and read on the Tcl channel. Reads * data from the connected system. * * Results: * Number of bytes read. * * Side effects: * Places read data into buf, may set errorCodePtr, and adjusts * connection state's read buffer pointer. * *---------------------------------------------------------------------- */ static int ChanInputProc(ClientData arg, char *buf, int bufSize, int *errorCodePtr) { ChanInfo *chaninfo = (ChanInfo *) arg; int rc = 0; rc = NsOpenSSLConnOp(chaninfo->sslconn->ssl, (void *) buf, bufSize, NSOPENSSL_RECV); return rc; } /* *---------------------------------------------------------------------- * * ChanCloseProc -- * * Close down the Tcl channels and clean up the connection state * data. * * Results: * Tcl result. * * Side effects: * Will call functions to shutdown the SSL connection and free all * data associated with the connection. * * Note that this proc is called twice, once for the read channel * and once for the write channel, so we need to check and see if * conn has already been freed. * *---------------------------------------------------------------------- */ static int ChanCloseProc(ClientData arg, Tcl_Interp *interp) { ChanInfo *chaninfo = (ChanInfo *) arg; ChanInfo *otherchaninfo = NULL; //Ns_Log(Debug, "*** CHAN DESTROY: %s", Tcl_GetChannelName(chaninfo->chan)); Tcl_UnregisterChannel(interp, chaninfo->chan); ns_sockclose(chaninfo->socket); chaninfo->socket = INVALID_SOCKET; otherchaninfo = (ChanInfo *) chaninfo->otherchaninfo; if (otherchaninfo->socket == INVALID_SOCKET) { //Ns_Log(Debug, "*** SSL DESTROY"); ns_free(otherchaninfo); NsOpenSSLConnDestroy(chaninfo->sslconn); ns_free(chaninfo); } return TCL_OK; } /* *---------------------------------------------------------------------- * * ChanFlushProc -- * * Flush the date in the connection buffers. * * Results: * TCL_OK. * * Side effects: * Will open a connection and register two Tcl channels. * *---------------------------------------------------------------------- */ static int ChanFlushProc (ClientData arg) { ChanInfo *chaninfo = (ChanInfo *) arg; //Ns_Log(Debug, "ChanFlushProc %s", Tcl_GetChannelName(chaninfo->chan)); NsOpenSSLConnFlush(chaninfo->sslconn); return TCL_OK; } /* *---------------------------------------------------------------------- * * ChanGetHandleProc -- * * Return the read or write socket. * * Results: * TCL_OK * * Side effects: * * *---------------------------------------------------------------------- */ static int ChanGetHandleProc(ClientData arg, int direction, ClientData *handlePtr) { ChanInfo *chaninfo = (ChanInfo *) arg; *handlePtr = (ClientData) chaninfo->sslconn->socket; return TCL_OK; } /* *---------------------------------------------------------------------- * * ChanWatchProc -- * * Callback proc used by the Tcl channels. Doesn't do anything for us at * the moment, but it is still required to be defined. Not having it * causes a segfault when Tcl tries to work with it. Go read the * Tcl_CreateChannel man page for Tcl 8.3+. * * Results: * None. * *---------------------------------------------------------------------- */ static void ChanWatchProc(ClientData arg, int mask) { return; } /* *---------------------------------------------------------------------- * * SSLSockListenCallbackProc -- * * This is the C wrapper callback that is registered from * ns_openssl_socklistencallback. * * Results: * NS_TRUE or NS_FALSE on error * * Side effects: * Will run Tcl script. * *---------------------------------------------------------------------- */ static int SSLSockListenCallbackProc(SOCKET sock, void *arg, int why) { SockListenCallback *lcbPtr = arg; NsOpenSSLConn *sslconn = NULL; Tcl_Interp *interp = NULL; Tcl_DString script; Tcl_Obj *listPtr = NULL; Tcl_Obj **objv = NULL; int result = TCL_ERROR; int objc = 0; //Ns_Log(Debug, "*** SockListenCallbackProc running"); interp = Ns_TclAllocateInterp(lcbPtr->server); sslconn = Ns_OpenSSLSockAccept(sock, lcbPtr->sslcontext); if (sslconn == NULL) { Tcl_AppendResult(interp, "SSL accept failed \"", NULL); return TCL_ERROR; } //Ns_Log(Debug, "*** SockListenCallbackProc running 2"); result = CreateTclChannel(sslconn, interp); if (result == TCL_OK) { //Ns_Log(Debug, "*** SockListenCallbackProc running 3"); listPtr = Tcl_GetObjResult(interp); if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) == TCL_OK && objc == 1) { Tcl_DStringInit(&script); Tcl_DStringAppend(&script, lcbPtr->script, -1); Tcl_DStringAppendElement(&script, Tcl_GetString(objv[0])); result = Tcl_EvalEx(interp, script.string, script.length, 0); Tcl_DStringFree(&script); } //Ns_Log(Debug, "*** SockListenCallbackProc running 4"); } if (result != TCL_OK) { //Ns_Log(Debug, "*** SockListenCallbackProc running 5"); Ns_TclLogError(interp); } Ns_TclDeAllocateInterp(interp); return NS_TRUE; } /* *---------------------------------------------------------------------- * * AppendReadyFiles -- * * Find files in an fd_set that are selected and append them to * the tcl result, and also an optional passed-in dstring. * * Results: * None. * * Side effects: * Ready files will be appended to pds if not null, and also * interp->result. * *---------------------------------------------------------------------- */ static void AppendReadyFiles (Tcl_Interp * interp, fd_set * setPtr, int write, char *flist, Tcl_DString * dsPtr) { int fargc = 0; char **fargv = NULL; SOCKET socket = INVALID_SOCKET; Tcl_DString ds; Tcl_DStringInit(&ds); if (dsPtr == NULL) { dsPtr = &ds; } Tcl_SplitList(interp, flist, &fargc, &fargv); while (fargc--) { Ns_TclGetOpenFd(interp, fargv[fargc], write, (int *) &socket); if (FD_ISSET(socket, setPtr)) { Tcl_DStringAppendElement(dsPtr, fargv[fargc]); } } /* * Append the ready files to the tcl interp. */ Tcl_AppendElement(interp, dsPtr->string); ckfree((char *) fargv); Tcl_DStringFree(&ds); } /* *---------------------------------------------------------------------- * * GetSet -- * * Take a Tcl list of files and set bits for each in the list in * an fd_set. * * Results: * Tcl result. * * Side effects: * Will set bits in fd_set. ppset may be NULL on error, or * a valid fd_set on success. Max fd will be returned in *maxPtr. * *---------------------------------------------------------------------- */ static int GetSet(Tcl_Interp * interp, char *flist, int write, fd_set ** setPtrPtr, fd_set * setPtr, SOCKET * maxPtr) { SOCKET socket = INVALID_SOCKET; int fargc = 0; char **fargv = NULL; int status = TCL_ERROR; if (Tcl_SplitList(interp, flist, &fargc, &fargv) != TCL_OK) { return TCL_ERROR; } if (fargc == 0) { /* * Tcl_SplitList failed, so abort. */ ckfree((char *) fargv); *setPtrPtr = NULL; return TCL_OK; } else { *setPtrPtr = setPtr; } FD_ZERO(setPtr); status = TCL_OK; /* * Loop over each file, try to get its FD, and set the bit in * the fd_set. */ while (fargc--) { if (Ns_TclGetOpenFd(interp, fargv[fargc], write, (int *) &socket) != TCL_OK) { status = TCL_ERROR; break; } if (socket > *maxPtr) { *maxPtr = socket; } FD_SET(socket, setPtr); } ckfree((char *) fargv); return status; } /* *---------------------------------------------------------------------- * * SSLSockCallbackProc -- * * Callback that is registered from ns_sockcallback. * * Results: * NS_TRUE or NS_FALSE on error * * Side effects: * Will run Tcl script. * *---------------------------------------------------------------------- */ static int SSLSockCallbackProc(SOCKET sock, void *arg, int why) { SockCallback *cbPtr = arg; Tcl_Interp *interp = NULL; /* XXX not initialized */ Tcl_DString script; char *w = NULL; int status = TCL_ERROR; if (why != NS_SOCK_EXIT || (cbPtr->when & NS_SOCK_EXIT)) { interp = Ns_TclAllocateInterp(cbPtr->server); status = EnterDup(interp, sock); if (status == TCL_OK) { Tcl_DStringInit (&script); Tcl_DStringAppend (&script, cbPtr->script, -1); Tcl_DStringAppendElement (&script, interp->result); if (why == NS_SOCK_READ) { w = "r"; } else if (why == NS_SOCK_WRITE) { w = "w"; } else if (why == NS_SOCK_EXCEPTION) { w = "e"; } else { w = "x"; } Tcl_DStringAppendElement(&script, w); status = Tcl_EvalEx(interp, script.string, script.length, 0); Tcl_DStringFree(&script); } if (status != TCL_OK) { Ns_TclLogError(interp); } else if (!STREQ(interp->result, "1")) { why = NS_SOCK_EXIT; } Ns_TclDeAllocateInterp(interp); } if (why == NS_SOCK_EXIT) { ns_sockclose(sock); ns_free(cbPtr); return NS_FALSE; } return NS_TRUE; }