Fixed https.tcl, specifically ns_httpsopen.
/*
* 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;
}
|
Back to SourceForge.net Powered by ViewCVS 1.0-dev |