Fixed https.tcl, specifically ns_httpsopen.
| 1 | /* |
| 2 | * The contents of this file are subject to the AOLserver Public License |
| 3 | * Version 1.1 (the "License"); you may not use this file except in |
| 4 | * compliance with the License. You may obtain a copy of the License at |
| 5 | * http://aolserver.com. |
| 6 | * |
| 7 | * Software distributed under the License is distributed on an "AS IS" |
| 8 | * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See |
| 9 | * the License for the specific language governing rights and limitations |
| 10 | * under the License. |
| 11 | * |
| 12 | * Alternatively, the contents of this file may be used under the terms |
| 13 | * of the GNU General Public License (the "GPL"), in which case the |
| 14 | * provisions of GPL are applicable instead of those above. If you wish |
| 15 | * to allow use of your version of this file only under the terms of the |
| 16 | * GPL and not to allow others to use your version of this file under the |
| 17 | * License, indicate your decision by deleting the provisions above and |
| 18 | * replace them with the notice and other provisions required by the GPL. |
| 19 | * If you do not delete the provisions above, a recipient may use your |
| 20 | * version of this file under either the License or the GPL. |
| 21 | * |
| 22 | * Copyright (C) 2000-2003 Scott S. Goodwin |
| 23 | * |
| 24 | * Module originally written by Stefan Arentz. Early contributions made by |
| 25 | * Freddie Mendoze and Rob Mayoff. |
| 26 | */ |
| 27 | |
| 28 | /* |
| 29 | * tclcmds.c -- |
| 30 | * |
| 31 | * Tcl API for nsopenssl |
| 32 | */ |
| 33 | |
| 34 | static const char *RCSID = |
| 35 | "@(#) $Header: /cvsroot-fuse/aolserver/nsopenssl/tclcmds.c,v 1.51 2004/06/13 04:21:31 scottg Exp $, compiled: " |
| 36 | __DATE__ " " __TIME__; |
| 37 | |
| 38 | #include "nsopenssl.h" |
| 39 | |
| 40 | /* |
| 41 | * Used to track both conn info and which chan to close. |
| 42 | */ |
| 43 | |
| 44 | typedef struct ChanInfo { |
| 45 | NsOpenSSLConn *sslconn; |
| 46 | SOCKET socket; |
| 47 | Tcl_Channel chan; |
| 48 | void *otherchaninfo; |
| 49 | } ChanInfo; |
| 50 | |
| 51 | static int |
| 52 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_CreateTclChannel">CreateTclChannel</a>(NsOpenSSLConn *sslconn, Tcl_Interp *interp); |
| 53 | |
| 54 | static int |
| 55 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanCloseProc">ChanCloseProc</a>(ClientData arg, Tcl_Interp *interp); |
| 56 | |
| 57 | static int |
| 58 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanInputProc">ChanInputProc</a>(ClientData arg, char *buf, int bufSize, int *errorCodePtr); |
| 59 | |
| 60 | static int |
| 61 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanOutputProc">ChanOutputProc</a>(ClientData arg, char *buf, int toWrite, int *errorCodePtr); |
| 62 | |
| 63 | static void |
| 64 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanWatchProc">ChanWatchProc</a>(ClientData arg, int mask); |
| 65 | |
| 66 | static int |
| 67 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanFlushProc">ChanFlushProc</a>(ClientData arg); |
| 68 | |
| 69 | static int |
| 70 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanGetHandleProc">ChanGetHandleProc</a>(ClientData arg, int direction, ClientData *handlePtr); |
| 71 | |
| 72 | static void |
| 73 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SetResultToX509Name">SetResultToX509Name</a>(Tcl_Interp *interp, X509_NAME *name); |
| 74 | |
| 75 | static void |
| 76 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SetResultToObjectName">SetResultToObjectName</a>(Tcl_Interp *interp, ASN1_OBJECT *obj); |
| 77 | |
| 78 | static char * |
| 79 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ValidTime">ValidTime</a>(ASN1_UTCTIME *tm); |
| 80 | |
| 81 | static char * |
| 82 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_PEMCertificate">PEMCertificate</a>(X509 *peercert); |
| 83 | |
| 84 | static int |
| 85 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterSock">EnterSock</a>(Tcl_Interp *interp, SOCKET sock); |
| 86 | |
| 87 | static int |
| 88 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterDup">EnterDup</a>(Tcl_Interp *interp, SOCKET sock); |
| 89 | |
| 90 | #if 0 |
| 91 | static int |
| 92 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterDupedSocks">EnterDupedSocks</a>(Tcl_Interp *interp, SOCKET sock); |
| 93 | #endif |
| 94 | |
| 95 | static int |
| 96 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_GetSet">GetSet</a>(Tcl_Interp *interp, char *flist, int write, fd_set **setPtrPtr, |
| 97 | fd_set *setPtr, SOCKET *maxPtr); |
| 98 | |
| 99 | static void |
| 100 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_AppendReadyFiles">AppendReadyFiles</a> (Tcl_Interp *interp, fd_set *setPtr, int write, |
| 101 | char *flist, Tcl_DString *dsPtr); |
| 102 | |
| 103 | static Ns_SockProc |
| 104 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SSLSockListenCallbackProc">SSLSockListenCallbackProc</a>; |
| 105 | |
| 106 | static Ns_SockProc |
| 107 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SSLSockCallbackProc">SSLSockCallbackProc</a>; |
| 108 | |
| 109 | /* |
| 110 | * Define a Tcl channel so we can use standard Tcl commands to read and write |
| 111 | * on the connection. |
| 112 | */ |
| 113 | |
| 114 | static Tcl_ChannelType opensslChannelType = { |
| 115 | "openssl", /* Type name. */ |
| 116 | TCL_CHANNEL_VERSION_2, /* channel version 2 */ |
| 117 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanCloseProc">ChanCloseProc</a>, /* Close proc. */ |
| 118 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanInputProc">ChanInputProc</a>, /* Input proc. */ |
| 119 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanOutputProc">ChanOutputProc</a>, /* Output proc. */ |
| 120 | NULL, /* Seek proc. */ |
| 121 | NULL, /* Set option proc. */ |
| 122 | NULL, /* Get option proc. */ |
| 123 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanWatchProc">ChanWatchProc</a>, /* Watch proc. (mandatory) */ |
| 124 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanGetHandleProc">ChanGetHandleProc</a>, /* Get Handle */ |
| 125 | NULL, /* Close2 proc */ |
| 126 | NULL, /* Set blocking/nonblocking mode. */ |
| 127 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanFlushProc">ChanFlushProc</a>, /* Flush proc */ |
| 128 | NULL, /* Handler proc */ |
| 129 | }; |
| 130 | |
| 131 | static Ns_TclInterpInitProc |
| 132 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_AddCmds">AddCmds</a>; |
| 133 | |
| 134 | extern Tcl_ObjCmdProc |
| 135 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLObjCmd">NsTclOpenSSLObjCmd</a>, |
| 136 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockAcceptObjCmd">NsTclOpenSSLSockAcceptObjCmd</a>, |
| 137 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockOpenObjCmd">NsTclOpenSSLSockOpenObjCmd</a>, |
| 138 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockListenObjCmd">NsTclOpenSSLSockListenObjCmd</a>, |
| 139 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockListenCallbackObjCmd">NsTclOpenSSLSockListenCallbackObjCmd</a>, |
| 140 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockCallbackObjCmd">NsTclOpenSSLSockCallbackObjCmd</a>, |
| 141 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLGetUrlObjCmd">NsTclOpenSSLGetUrlObjCmd</a>; |
| 142 | |
| 143 | extern Tcl_CmdProc |
| 144 | NsTclOpenSSLGetUrlCmd, |
| 145 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockCheckCmd">NsTclOpenSSLSockCheckCmd</a>, |
| 146 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockNReadCmd">NsTclOpenSSLSockNReadCmd</a>, |
| 147 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockSelectCmd">NsTclOpenSSLSockSelectCmd</a>; |
| 148 | |
| 149 | typedef struct Cmd { |
| 150 | char *name; |
| 151 | Tcl_CmdProc *proc; |
| 152 | Tcl_ObjCmdProc *objProc; |
| 153 | } Cmd; |
| 154 | |
| 155 | static Cmd nsopensslCmds[] = { |
| 156 | {"ns_openssl", NULL, <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLObjCmd">NsTclOpenSSLObjCmd</a> }, |
| 157 | {"ns_openssl_sockopen", NULL, <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockOpenObjCmd">NsTclOpenSSLSockOpenObjCmd</a> }, |
| 158 | {"ns_openssl_geturl", NULL, <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLGetUrlObjCmd">NsTclOpenSSLGetUrlObjCmd</a> }, |
| 159 | {"ns_openssl_sockaccept", NULL, <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockAcceptObjCmd">NsTclOpenSSLSockAcceptObjCmd</a> }, |
| 160 | {"ns_openssl_socklisten", NULL, <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockListenObjCmd">NsTclOpenSSLSockListenObjCmd</a> }, |
| 161 | {"ns_openssl_sockcallback", NULL, <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockCallbackObjCmd">NsTclOpenSSLSockCallbackObjCmd</a> }, |
| 162 | {"ns_openssl_socklistencallback", NULL, <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockListenCallbackObjCmd">NsTclOpenSSLSockListenCallbackObjCmd</a> }, |
| 163 | #if 0 /* these ns_openssl_sock* commands are not implemented */ |
| 164 | {"ns_openssl_socknread", <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockNReadCmd">NsTclOpenSSLSockNReadCmd</a>, NULL }, |
| 165 | {"ns_openssl_sockselect", <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockSelectCmd">NsTclOpenSSLSockSelectCmd</a>, NULL }, |
| 166 | {"ns_openssl_sockcheck", <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockCheckCmd">NsTclOpenSSLSockCheckCmd</a>, NULL }, |
| 167 | {"ns_openssl_socketpair", NsTclSSLSocketPairCmd, NULL }, |
| 168 | {"ns_openssl_hostbyaddr", NsTclSSLGetByCmd, NULL }, |
| 169 | {"ns_openssl_addrbyhost", NsTclSSLGetByCmd, (ClientData) 1 }, |
| 170 | #endif |
| 171 | {NULL, NULL, NULL} |
| 172 | }; |
| 173 | |
| 174 | typedef struct <a href="/cvs/aolserver/aolserver/nsd/tclsock.c#A_SockListenCallback">SockListenCallback</a> { |
| 175 | char *server; |
| 176 | NsOpenSSLContext *sslcontext; |
| 177 | char *script; |
| 178 | } <a href="/cvs/aolserver/aolserver/nsd/tclsock.c#A_SockListenCallback">SockListenCallback</a>; |
| 179 | |
| 180 | typedef struct SockCallback { |
| 181 | char *server; |
| 182 | int when; |
| 183 | char script[1]; |
| 184 | } SockCallback; |
| 185 | |
| 186 | |
| 187 | /* |
| 188 | *---------------------------------------------------------------------- |
| 189 | * |
| 190 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsOpenSSLTclInit">NsOpenSSLTclInit</a> -- |
| 191 | * |
| 192 | * Initialize Tcl API for a virtual server. The last argument of |
| 193 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInitInterps">Ns_TclInitInterps</a> is a pointer to a function that |
| 194 | * |
| 195 | * Results: |
| 196 | * None. |
| 197 | * |
| 198 | * Side effects: |
| 199 | * None. |
| 200 | * |
| 201 | *---------------------------------------------------------------------- |
| 202 | */ |
| 203 | |
| 204 | void |
| 205 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsOpenSSLTclInit">NsOpenSSLTclInit</a>(char *server) |
| 206 | { |
| 207 | Server *thisServer = <a href="/cvs/aolserver/nsopenssl/sslcontext.c#A_NsOpenSSLServerGet">NsOpenSSLServerGet</a>(server); |
| 208 | |
| 209 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInitInterps">Ns_TclInitInterps</a>(server, <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_AddCmds">AddCmds</a>, (void *) thisServer); |
| 210 | } |
| 211 | |
| 212 | |
| 213 | /* |
| 214 | *---------------------------------------------------------------------- |
| 215 | * |
| 216 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_AddCmds">AddCmds</a> -- |
| 217 | * |
| 218 | * Add nsopenssl commands to Tcl interpreter. |
| 219 | * |
| 220 | * Results: |
| 221 | * NS_OK or NS_ERROR. |
| 222 | * |
| 223 | * Side effects: |
| 224 | * None. |
| 225 | * |
| 226 | *---------------------------------------------------------------------- |
| 227 | */ |
| 228 | |
| 229 | static int |
| 230 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_AddCmds">AddCmds</a>(Tcl_Interp *interp, void *arg) |
| 231 | { |
| 232 | Cmd *cmd = (Cmd *) &nsopensslCmds; |
| 233 | |
| 234 | while (cmd->name != NULL) { |
| 235 | if (cmd->objProc != NULL) { |
| 236 | Tcl_CreateObjCommand(interp, cmd->name, cmd->objProc, arg, NULL); |
| 237 | } else { |
| 238 | Tcl_CreateCommand(interp, cmd->name, cmd->proc, arg, NULL); |
| 239 | } |
| 240 | ++cmd; |
| 241 | } |
| 242 | |
| 243 | return NS_OK; |
| 244 | } |
| 245 | |
| 246 | |
| 247 | /* |
| 248 | *---------------------------------------------------------------------- |
| 249 | * |
| 250 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLObjCmd">NsTclOpenSSLObjCmd</a> -- |
| 251 | * |
| 252 | * Implements ns_openssl command, which returns information about clients |
| 253 | * connected to the nsopenssl server, including client certificates. |
| 254 | * |
| 255 | * Results: |
| 256 | * Tcl string result. |
| 257 | * |
| 258 | * Side effects: |
| 259 | * None. |
| 260 | * |
| 261 | *---------------------------------------------------------------------- |
| 262 | */ |
| 263 | |
| 264 | int |
| 265 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLObjCmd">NsTclOpenSSLObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) |
| 266 | { |
| 267 | // XXX Server *thisServer = (Server *) arg; |
| 268 | NsOpenSSLConn *sslconn = NULL; |
| 269 | X509 *peercert = NULL; |
| 270 | SSL_CIPHER *cipher = NULL; |
| 271 | Ns_Conn *conn = NULL; |
| 272 | char *string = NULL; |
| 273 | char *name = NULL; |
| 274 | int integer = 0; |
| 275 | int status = TCL_OK; |
| 276 | |
| 277 | static CONST char *opts[] = { |
| 278 | "info", "module", "protocol", "port", "peerport", "cipher", |
| 279 | "clientcert" |
| 280 | }; |
| 281 | enum ISubCmdIdx { |
| 282 | CInfoIdx, CModuleIdx, CProtocolIdx, CPortIdx, CPeerPortIdx, CCipherIdx, |
| 283 | CClientCertIdx |
| 284 | } opt; |
| 285 | |
| 286 | if (objc < 2) { |
| 287 | Tcl_WrongNumArgs(interp, 1, objv, "option"); |
| 288 | return TCL_ERROR; |
| 289 | } |
| 290 | if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0, |
| 291 | (int *) &opt) != TCL_OK) { |
| 292 | return TCL_ERROR; |
| 293 | } |
| 294 | if (opt == CInfoIdx) { |
| 295 | Tcl_SetResult(interp, OPENSSL_VERSION_TEXT, TCL_STATIC); |
| 296 | return TCL_OK; |
| 297 | } |
| 298 | |
| 299 | /* |
| 300 | * AOLserver stashes a pointer to the conn in the interp. We then use that |
| 301 | * to get a pointer to our SSL conn through the core driver's context. If |
| 302 | * conn is NULL, it means our connection is not driver by the comm API, so |
| 303 | * we need to get the connection information back another way. |
| 304 | */ |
| 305 | |
| 306 | /* XXX needs rewiring to allow for reporting info on non-nsd-driven conns */ |
| 307 | conn = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclGetConn">Ns_TclGetConn</a>(interp); |
| 308 | if (conn == NULL) { |
| 309 | Tcl_AppendResult(interp, "this is not a connection thread", NULL); |
| 310 | return TCL_ERROR; |
| 311 | } else { |
| 312 | name = <a href="/cvs/aolserver/aolserver/nsd/conn.c#A_Ns_ConnDriverName">Ns_ConnDriverName</a>(conn); |
| 313 | if (name != NULL && STREQ(name, MODULE)) { |
| 314 | sslconn = (NsOpenSSLConn *) <a href="/cvs/aolserver/aolserver/nsd/conn.c#A_Ns_ConnDriverContext">Ns_ConnDriverContext</a>(conn); |
| 315 | } |
| 316 | if (sslconn == NULL) { |
| 317 | Tcl_AppendResult(interp, "this is a connection thread, but not an SSL connection thread", NULL); |
| 318 | return TCL_ERROR; |
| 319 | } |
| 320 | } |
| 321 | switch (opt) { |
| 322 | case CModuleIdx: |
| 323 | |
| 324 | /* |
| 325 | * Implement: |
| 326 | * ns_openssl module name |
| 327 | * ns_openssl module port |
| 328 | */ |
| 329 | |
| 330 | if (objc != 3) { |
| 331 | Tcl_WrongNumArgs(interp, 2, objv, "option"); |
| 332 | return TCL_ERROR; |
| 333 | } |
| 334 | if (STREQ(Tcl_GetString(objv[2]), "name")) { |
| 335 | Tcl_SetResult(interp, MODULE, TCL_VOLATILE); |
| 336 | } else if (STREQ(Tcl_GetString(objv[2]), "port")) { |
| 337 | /* XXX peerport is the port this conn came in on -- clean up */ |
| 338 | sprintf(interp->result, "%d", sslconn->peerport); |
| 339 | } |
| 340 | break; |
| 341 | case CProtocolIdx: |
| 342 | switch (sslconn->ssl->session->ssl_version) { |
| 343 | case SSL2_VERSION: |
| 344 | string = "SSLv2"; |
| 345 | break; |
| 346 | case SSL3_VERSION: |
| 347 | string = "SSLv3"; |
| 348 | break; |
| 349 | case TLS1_VERSION: |
| 350 | string = "TLSv1"; |
| 351 | break; |
| 352 | default: |
| 353 | string = "UNKNOWN"; |
| 354 | } |
| 355 | Tcl_SetResult(interp, string, TCL_VOLATILE); |
| 356 | break; |
| 357 | case CPortIdx: |
| 358 | case CPeerPortIdx: |
| 359 | sprintf(interp->result, "%d", sslconn->peerport); |
| 360 | break; |
| 361 | case CCipherIdx: |
| 362 | cipher = SSL_get_current_cipher(sslconn->ssl); |
| 363 | if (objc != 3) { |
| 364 | Tcl_WrongNumArgs(interp, 2, objv, "option"); |
| 365 | return TCL_ERROR; |
| 366 | } |
| 367 | if (STREQ(Tcl_GetString(objv[2]), "name")) { |
| 368 | string = |
| 369 | (sslconn->ssl != NULL ? (char *) SSL_CIPHER_get_name(cipher) : NULL); |
| 370 | Tcl_SetResult(interp, string, TCL_VOLATILE); |
| 371 | } else if (STREQ(Tcl_GetString(objv[2]), "strength")) { |
| 372 | integer = SSL_CIPHER_get_bits(cipher, &integer); |
| 373 | sprintf(interp->result, "%d", integer); |
| 374 | } |
| 375 | break; |
| 376 | case CClientCertIdx: |
| 377 | |
| 378 | /* |
| 379 | * Implement: |
| 380 | * ns_openssl clientcert exists |
| 381 | * ns_openssl clientcert version |
| 382 | * ns_openssl clientcert serial |
| 383 | * ns_openssl clientcert subject |
| 384 | * ns_openssl clientcert issuer |
| 385 | * ns_openssl clientcert notbefore |
| 386 | * ns_openssl clientcert notafter |
| 387 | * ns_openssl clientcert signaturealgorithm |
| 388 | * ns_openssl clientcert key_algorithm |
| 389 | * ns_openssl clientcert pem |
| 390 | * ns_openssl clientcert valid |
| 391 | */ |
| 392 | |
| 393 | if (objc != 3) { |
| 394 | Tcl_WrongNumArgs(interp, 2, objv, "option"); |
| 395 | return TCL_ERROR; |
| 396 | } |
| 397 | peercert = (sslconn == NULL) ? NULL : SSL_get_peer_certificate(sslconn->ssl); |
| 398 | if (STREQ(Tcl_GetString(objv[2]), "exists")) { |
| 399 | Tcl_SetResult(interp, peercert == NULL ? "0" : "1", TCL_STATIC); |
| 400 | } else if (STREQ(Tcl_GetString(objv[2]), "version")) { |
| 401 | sprintf(interp->result, "%lu", peercert == NULL ? 0 : X509_get_version(peercert) + 1); |
| 402 | } else if (STREQ(Tcl_GetString(objv[2]), "serial")) { |
| 403 | sprintf(interp->result, "%ld", peercert == NULL ? 0 : |
| 404 | ASN1_INTEGER_get(X509_get_serialNumber(peercert))); |
| 405 | } else if (STREQ(Tcl_GetString(objv[2]), "subject")) { |
| 406 | if (peercert != NULL) { |
| 407 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SetResultToX509Name">SetResultToX509Name</a>(interp, X509_get_subject_name(peercert)); |
| 408 | } |
| 409 | } else if (STREQ(Tcl_GetString(objv[2]), "issuer")) { |
| 410 | if (peercert != NULL) { |
| 411 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SetResultToX509Name">SetResultToX509Name</a>(interp, X509_get_issuer_name(peercert)); |
| 412 | } |
| 413 | } else if (STREQ(Tcl_GetString(objv[2]), "notbefore")) { |
| 414 | if (peercert != NULL) { |
| 415 | string = <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ValidTime">ValidTime</a>(X509_get_notBefore(peercert)); |
| 416 | if (string == NULL) { Tcl_SetResult(interp, "error getting notbefore", TCL_STATIC); |
| 417 | status = TCL_ERROR; |
| 418 | } else { |
| 419 | Tcl_SetResult(interp, string, TCL_DYNAMIC); |
| 420 | } |
| 421 | } |
| 422 | } else if (STREQ(Tcl_GetString(objv[2]), "notafter")) { |
| 423 | if (peercert != NULL) { |
| 424 | string = <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ValidTime">ValidTime</a>(X509_get_notAfter(peercert)); |
| 425 | if (string == NULL) { |
| 426 | Tcl_SetResult(interp, "error getting notafter", TCL_STATIC); |
| 427 | status = TCL_ERROR; |
| 428 | } else { |
| 429 | Tcl_SetResult(interp, string, TCL_DYNAMIC); |
| 430 | } |
| 431 | } |
| 432 | } else if (STREQ(Tcl_GetString(objv[2]), "signature_algorithm")) { |
| 433 | if (peercert != NULL) { |
| 434 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SetResultToObjectName">SetResultToObjectName</a>(interp, peercert->cert_info->signature-> algorithm); |
| 435 | } |
| 436 | } else if (STREQ(Tcl_GetString(objv[2]), "key_algorithm")) { |
| 437 | if (peercert != NULL) { |
| 438 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SetResultToObjectName">SetResultToObjectName</a>(interp, peercert->cert_info->key->algor-> algorithm); |
| 439 | } |
| 440 | } else if (STREQ(Tcl_GetString(objv[2]), "pem")) { |
| 441 | if (peercert != NULL) { |
| 442 | string = <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_PEMCertificate">PEMCertificate</a>(peercert); |
| 443 | if (string == NULL) { |
| 444 | Tcl_SetResult(interp, "error getting pem", TCL_STATIC); |
| 445 | status = TCL_ERROR; |
| 446 | } else { |
| 447 | Tcl_SetResult(interp, string, TCL_DYNAMIC); |
| 448 | } |
| 449 | } |
| 450 | } else if (STREQ(Tcl_GetString(objv[2]), "valid")) { |
| 451 | sprintf(interp->result, "%d", |
| 452 | peercert != NULL |
| 453 | && SSL_get_verify_result(sslconn->ssl) == X509_V_OK); |
| 454 | |
| 455 | } else { |
| 456 | /* XXX revalidate the list below (see if Tcl has a better library function for this) */ |
| 457 | Tcl_AppendResult(interp, "unknown command \"", Tcl_GetString(objv[2]), |
| 458 | "\": should be one of: exists version serial subject issuer notbefore notafter signature_algorithm key_algorithm pem valid", |
| 459 | NULL); |
| 460 | return TCL_ERROR; |
| 461 | } |
| 462 | break; |
| 463 | case CInfoIdx: |
| 464 | /* NEVER REACHED */ |
| 465 | break; |
| 466 | } |
| 467 | |
| 468 | return TCL_OK; |
| 469 | } |
| 470 | |
| 471 | |
| 472 | /* |
| 473 | *---------------------------------------------------------------------- |
| 474 | * |
| 475 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockOpenObjCmd">NsTclOpenSSLSockOpenObjCmd</a> -- |
| 476 | * |
| 477 | * Open a tcp connection to a host/port via SSL. |
| 478 | * |
| 479 | * Results: |
| 480 | * Tcl result. |
| 481 | * |
| 482 | * Side effects: |
| 483 | * Will open a connection and register a Tcl channel. |
| 484 | * |
| 485 | *---------------------------------------------------------------------- |
| 486 | */ |
| 487 | |
| 488 | int |
| 489 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockOpenObjCmd">NsTclOpenSSLSockOpenObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, |
| 490 | Tcl_Obj *CONST objv[]) |
| 491 | { |
| 492 | Server *thisServer = (Server *) arg; |
| 493 | NsOpenSSLConn *sslconn = NULL; |
| 494 | NsOpenSSLContext *sslcontext = NULL; |
| 495 | char *name = NULL; |
| 496 | int first = 1; |
| 497 | int async = 0; |
| 498 | int timeout = -1; |
| 499 | int sslctx = 0; |
| 500 | int port = 0; |
| 501 | CONST char *args = "?-nonblock|-timeout seconds? host port ?sslcontext?"; |
| 502 | |
| 503 | /* |
| 504 | * (3) ns_sockopen host port |
| 505 | * (4) ns_sockopen -nonblock host port |
| 506 | * (5) ns_sockopen -timeout seconds host port |
| 507 | |
| 508 | * (4) ns_sockopen host port sslcontext |
| 509 | * (5) ns_sockopen -nonblock host port sslcontext |
| 510 | * (6) ns_sockopen -timeout seconds host port sslcontext |
| 511 | */ |
| 512 | |
| 513 | /* |
| 514 | * Works out to this matrix where the # is the number of args: |
| 515 | * |
| 516 | * sslcontext? |
| 517 | * |
| 518 | * Y N |
| 519 | * --------- |
| 520 | * no '-' 4 3 |
| 521 | * -nonblock 5 4 |
| 522 | * -timeout 6 5 |
| 523 | */ |
| 524 | |
| 525 | if (objc < 3 || objc > 6) { |
| 526 | Tcl_WrongNumArgs(interp, 1, objv, "?-nonblock|-timeout seconds? host port ?sslcontext?"); |
| 527 | return TCL_ERROR; |
| 528 | } |
| 529 | if (STREQ(Tcl_GetString(objv[1]), "-nonblock")) { |
| 530 | if (objc == 4) { |
| 531 | sslctx = 0; |
| 532 | } else if (objc == 5) { |
| 533 | sslctx = 1; |
| 534 | } else { |
| 535 | Tcl_WrongNumArgs(interp, 1, objv, args); |
| 536 | return TCL_ERROR; |
| 537 | } |
| 538 | first = 2; |
| 539 | async = 1; |
| 540 | } else if (STREQ(Tcl_GetString(objv[1]), "-timeout")) { |
| 541 | if (objc == 5) { |
| 542 | sslctx = 0; |
| 543 | } else if (objc == 6) { |
| 544 | sslctx = 1; |
| 545 | } else { |
| 546 | Tcl_WrongNumArgs(interp, 1, objv, args); |
| 547 | return TCL_ERROR; |
| 548 | } |
| 549 | if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) { |
| 550 | return TCL_ERROR; |
| 551 | } |
| 552 | first = 3; |
| 553 | } else { |
| 554 | if (objc == 3) { |
| 555 | sslctx = 0; |
| 556 | } else if (objc == 4) { |
| 557 | sslctx = 1; |
| 558 | } else { |
| 559 | Tcl_WrongNumArgs(interp, 1, objv, args); |
| 560 | return TCL_ERROR; |
| 561 | } |
| 562 | } |
| 563 | |
| 564 | if (Tcl_GetIntFromObj(interp, objv[first + 1], &port) != TCL_OK) { |
| 565 | return TCL_ERROR; |
| 566 | } |
| 567 | |
| 568 | /* |
| 569 | * Get the named SSL context. If there is no named SSL context, attempt to |
| 570 | * use the default. |
| 571 | */ |
| 572 | |
| 573 | if (sslctx) { |
| 574 | name = (char *) Tcl_GetString(objv[first + 2]); |
| 575 | sslcontext = <a href="/cvs/aolserver/nsopenssl/sslcontext.c#A_Ns_OpenSSLServerSSLContextGet">Ns_OpenSSLServerSSLContextGet</a>(thisServer->server, name); |
| 576 | } else { |
| 577 | sslcontext = <a href="/cvs/aolserver/nsopenssl/sslcontext.c#A_NsOpenSSLContextClientDefaultGet">NsOpenSSLContextClientDefaultGet</a>(thisServer->server); |
| 578 | } |
| 579 | if (sslcontext == NULL) { |
| 580 | Tcl_SetResult(interp, "failed to use either named or default client SSL context", |
| 581 | TCL_STATIC); |
| 582 | return TCL_ERROR; |
| 583 | } |
| 584 | |
| 585 | /* |
| 586 | * Perform the connection. |
| 587 | */ |
| 588 | |
| 589 | sslconn = Ns_OpenSSLSockConnect( |
| 590 | thisServer->server, |
| 591 | Tcl_GetString(objv[first]), |
| 592 | port, |
| 593 | async, |
| 594 | timeout, |
| 595 | sslcontext |
| 596 | ); |
| 597 | if (sslconn == NULL) { |
| 598 | Tcl_AppendResult(interp, "could not connect to \"", |
| 599 | Tcl_GetString(objv[first]), ":", Tcl_GetString(objv[first + 1]), "\"", NULL); |
| 600 | return TCL_ERROR; |
| 601 | } |
| 602 | |
| 603 | /* |
| 604 | * Create the Tcl channel that let's us use gets, puts etc. and layer it on |
| 605 | * top of the conn. |
| 606 | */ |
| 607 | |
| 608 | if (<a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_CreateTclChannel">CreateTclChannel</a>(sslconn, interp) != NS_OK) { |
| 609 | <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Warning, "%s: %s: Tcl channel not available", |
| 610 | MODULE, sslconn->server); |
| 611 | //<a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Debug, "--->>> BEFORE ConnDestroy: SockOpen"); |
| 612 | NsOpenSSLConnDestroy(sslconn); |
| 613 | return TCL_ERROR; |
| 614 | } |
| 615 | |
| 616 | /* |
| 617 | * Append "1" as the third element returned if peer's certificate is valid; |
| 618 | * "0" otherwise. |
| 619 | */ |
| 620 | |
| 621 | if (Ns_OpenSSLX509CertVerify(sslconn->ssl)) { |
| 622 | Tcl_AppendElement(interp, "1"); |
| 623 | } else { |
| 624 | Tcl_AppendElement(interp, "0"); |
| 625 | } |
| 626 | |
| 627 | return TCL_OK; |
| 628 | } |
| 629 | |
| 630 | |
| 631 | /* |
| 632 | *---------------------------------------------------------------------- |
| 633 | * |
| 634 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockListenObjCmd">NsTclOpenSSLSockListenObjCmd</a> -- |
| 635 | * |
| 636 | * Listen on a TCP port. |
| 637 | * |
| 638 | * Results: |
| 639 | * Tcl result. |
| 640 | * |
| 641 | * Side effects: |
| 642 | * Will listen on a port. |
| 643 | * |
| 644 | *---------------------------------------------------------------------- |
| 645 | */ |
| 646 | |
| 647 | extern int |
| 648 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockListenObjCmd">NsTclOpenSSLSockListenObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, |
| 649 | Tcl_Obj *CONST objv[]) |
| 650 | { |
| 651 | Server *thisServer = (Server *) arg; |
| 652 | SOCKET socket = INVALID_SOCKET; |
| 653 | char *addr = NULL; |
| 654 | int port = 0; |
| 655 | |
| 656 | if (objc != 3) { |
| 657 | Tcl_WrongNumArgs(interp, 1, objv, "address port"); |
| 658 | return TCL_ERROR; |
| 659 | } |
| 660 | addr = Tcl_GetString(objv[1]); |
| 661 | if (STREQ(addr, "*")) { |
| 662 | addr = NULL; |
| 663 | } |
| 664 | if (Tcl_GetIntFromObj(interp, objv[2], &port) != TCL_OK) { |
| 665 | return TCL_ERROR; |
| 666 | } |
| 667 | socket = Ns_OpenSSLSockListen(addr, port); |
| 668 | if (socket == INVALID_SOCKET) { |
| 669 | Tcl_AppendResult(interp, "could not listen on \"", |
| 670 | addr, ":", Tcl_GetString(objv[2]), "\"", NULL); |
| 671 | return TCL_ERROR; |
| 672 | } |
| 673 | |
| 674 | return <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterSock">EnterSock</a>(interp, socket); |
| 675 | } |
| 676 | |
| 677 | |
| 678 | /* |
| 679 | *---------------------------------------------------------------------- |
| 680 | * |
| 681 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockAcceptObjCmd">NsTclOpenSSLSockAcceptObjCmd</a> -- |
| 682 | * |
| 683 | * Accept a connection from a listening socket. |
| 684 | * |
| 685 | * Results: |
| 686 | * Tcl result. |
| 687 | * |
| 688 | * Side effects: |
| 689 | * None. |
| 690 | * |
| 691 | *---------------------------------------------------------------------- |
| 692 | */ |
| 693 | |
| 694 | /* XXX SSL context needs to be passed */ |
| 695 | |
| 696 | extern int |
| 697 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockAcceptObjCmd">NsTclOpenSSLSockAcceptObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, |
| 698 | Tcl_Obj *CONST objv[]) |
| 699 | { |
| 700 | Server *thisServer = (Server *) arg; |
| 701 | NsOpenSSLConn *sslconn = NULL; |
| 702 | NsOpenSSLContext *sslcontext = NULL; |
| 703 | SOCKET socket = INVALID_SOCKET; |
| 704 | |
| 705 | if (objc != 2) { |
| 706 | Tcl_WrongNumArgs(interp, 1, objv, "sockId"); |
| 707 | return TCL_ERROR; |
| 708 | } |
| 709 | if (<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenFd">Ns_TclGetOpenFd</a>(interp, Tcl_GetString(objv[1]), 0, (int *) &socket) != TCL_OK) { |
| 710 | return TCL_ERROR; |
| 711 | } |
| 712 | |
| 713 | /* |
| 714 | * Perform normal socket accept |
| 715 | */ |
| 716 | |
| 717 | socket = <a href="/cvs/aolserver/aolserver/nsd/sock.c#A_Ns_SockAccept">Ns_SockAccept</a>(socket, NULL, 0); |
| 718 | if (socket == INVALID_SOCKET) { |
| 719 | Tcl_AppendResult(interp, "accept failed: ", SockError(interp), NULL); |
| 720 | return TCL_ERROR; |
| 721 | } |
| 722 | /* Figure out which SSL context to use in creating the SSL connection */ |
| 723 | /* XXX update API to accept last arg of sslcontext */ |
| 724 | //if (sslctx) { |
| 725 | // name = (char *) Tcl_GetString(objv[first + 2]); |
| 726 | // sslcontext = <a href="/cvs/aolserver/nsopenssl/sslcontext.c#A_Ns_OpenSSLServerSSLContextGet">Ns_OpenSSLServerSSLContextGet</a>(thisServer->server, module, name); |
| 727 | //} else { |
| 728 | sslcontext = <a href="/cvs/aolserver/nsopenssl/sslcontext.c#A_NsOpenSSLContextServerDefaultGet">NsOpenSSLContextServerDefaultGet</a>(thisServer->server); |
| 729 | //} |
| 730 | if (sslcontext == NULL) { |
| 731 | Tcl_SetResult(interp, "failed to use either named or default client SSL context", |
| 732 | TCL_STATIC); |
| 733 | return TCL_ERROR; |
| 734 | } |
| 735 | sslconn = Ns_OpenSSLSockAccept(socket, sslcontext); |
| 736 | if (sslconn == NULL) { |
| 737 | Tcl_SetResult(interp, "SSL accept failed", TCL_STATIC); |
| 738 | return TCL_ERROR; |
| 739 | } |
| 740 | if (<a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_CreateTclChannel">CreateTclChannel</a>(sslconn, interp) != NS_OK) { |
| 741 | <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Error, "%s (%s): Tcl channel not available", |
| 742 | MODULE, sslconn->server); |
| 743 | //<a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Debug, "--->>> BEFORE ConnDestroy: <a href="/cvs/aolserver/aolserver/nsd/driver.c#A_SockAccept">SockAccept</a>"); |
| 744 | NsOpenSSLConnDestroy(sslconn); |
| 745 | return TCL_ERROR; |
| 746 | } |
| 747 | |
| 748 | /* |
| 749 | * Append "1" as the third element returned if peer certificate |
| 750 | * is found to be valid; "0" otherwise. Is this the best way to do |
| 751 | * it? |
| 752 | */ |
| 753 | |
| 754 | if (Ns_OpenSSLX509CertVerify(sslconn)) { |
| 755 | Tcl_AppendElement(interp, "1"); |
| 756 | } else { |
| 757 | Tcl_AppendElement(interp, "0"); |
| 758 | } |
| 759 | |
| 760 | return TCL_OK; |
| 761 | } |
| 762 | |
| 763 | |
| 764 | /* |
| 765 | *---------------------------------------------------------------------- |
| 766 | * |
| 767 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLGetUrlObjCmd">NsTclOpenSSLGetUrlObjCmd</a> -- |
| 768 | * |
| 769 | * Implements ns_openssl_geturl. |
| 770 | * |
| 771 | * Results: |
| 772 | * Tcl result. |
| 773 | * |
| 774 | * Side effects: |
| 775 | * See docs. |
| 776 | * |
| 777 | *---------------------------------------------------------------------- |
| 778 | */ |
| 779 | |
| 780 | /* XXX SSL context needs to be passed */ |
| 781 | /* XXX restructure this function to not use the 'done' label */ |
| 782 | |
| 783 | extern int |
| 784 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLGetUrlObjCmd">NsTclOpenSSLGetUrlObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) |
| 785 | { |
| 786 | Server *thisServer = (Server *) arg; |
| 787 | NsOpenSSLContext *sslcontext = NULL; |
| 788 | Ns_DString ds; |
| 789 | Ns_Set *headers = NULL; |
| 790 | int status = TCL_ERROR; |
| 791 | char *url = NULL; |
| 792 | |
| 793 | <a href="/cvs/aolserver/aolserver/nsd/dstring.c#A_Ns_DStringInit">Ns_DStringInit</a>(&ds); |
| 794 | if ((objc != 3) && (objc != 2)) { |
| 795 | Tcl_WrongNumArgs(interp, 1, objv, " url ?headersSetIdVar?"); |
| 796 | goto done; |
| 797 | } |
| 798 | if (objc == 2) { |
| 799 | headers = NULL; |
| 800 | } else { |
| 801 | headers = <a href="/cvs/aolserver/aolserver/nsd/set.c#A_Ns_SetCreate">Ns_SetCreate</a>(NULL); |
| 802 | } |
| 803 | url = Tcl_GetString(objv[1]); |
| 804 | if (url[1] == '/') { |
| 805 | if (<a href="/cvs/aolserver/aolserver/nsd/urlopen.c#A_Ns_FetchPage">Ns_FetchPage</a>(&ds, url, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInterpServer">Ns_TclInterpServer</a>(interp)) != NS_OK) { |
| 806 | Tcl_AppendResult(interp, "Could not get contents of URL \"", |
| 807 | url, "\"", NULL); |
| 808 | goto done; |
| 809 | } |
| 810 | } else { |
| 811 | /* Figure out which SSL context to use in creating the SSL connection */ |
| 812 | /* XXX update API to accept last arg of sslcontext */ |
| 813 | //if (sslctx) { |
| 814 | // name = (char *) Tcl_GetString(objv[first + 2]); |
| 815 | // sslcontext = <a href="/cvs/aolserver/nsopenssl/sslcontext.c#A_Ns_OpenSSLServerSSLContextGet">Ns_OpenSSLServerSSLContextGet</a>(thisServer->server, module, name); |
| 816 | //} else { |
| 817 | sslcontext = <a href="/cvs/aolserver/nsopenssl/sslcontext.c#A_NsOpenSSLContextClientDefaultGet">NsOpenSSLContextClientDefaultGet</a>(thisServer->server); |
| 818 | //} |
| 819 | if (sslcontext == NULL) { |
| 820 | Tcl_SetResult(interp, |
| 821 | "failed to use either named or default client SSL context", |
| 822 | TCL_STATIC); |
| 823 | goto done; |
| 824 | } |
| 825 | if (Ns_OpenSSLFetchUrl(thisServer->server, &ds, url, headers, sslcontext) != NS_OK) { |
| 826 | Tcl_AppendResult(interp, "Could not get contents of URL \"", |
| 827 | url, "\"", NULL); |
| 828 | if (headers != NULL) { |
| 829 | <a href="/cvs/aolserver/aolserver/nsd/set.c#A_Ns_SetFree">Ns_SetFree</a>(headers); |
| 830 | } |
| 831 | goto done; |
| 832 | } |
| 833 | } |
| 834 | if (objc == 3) { |
| 835 | <a href="/cvs/aolserver/aolserver/nsd/tclset.c#A_Ns_TclEnterSet">Ns_TclEnterSet</a>(interp, headers, 1); |
| 836 | /* XXX there's probably a Tcl_Obj way of doing the following */ |
| 837 | Tcl_SetVar(interp, Tcl_GetString(objv[2]), interp->result, 0); |
| 838 | } |
| 839 | Tcl_SetResult(interp, ds.string, TCL_VOLATILE); |
| 840 | status = TCL_OK; |
| 841 | |
| 842 | done: |
| 843 | <a href="/cvs/aolserver/aolserver/nsd/dstring.c#A_Ns_DStringFree">Ns_DStringFree</a>(&ds); |
| 844 | |
| 845 | return status; |
| 846 | } |
| 847 | |
| 848 | |
| 849 | /* |
| 850 | *---------------------------------------------------------------------- |
| 851 | * |
| 852 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockNReadCmd">NsTclOpenSSLSockNReadCmd</a> -- |
| 853 | * |
| 854 | * Gets the number of bytes that a socket has waiting to be |
| 855 | * read. |
| 856 | * |
| 857 | * Results: |
| 858 | * Tcl result. |
| 859 | * |
| 860 | * Side effects: |
| 861 | * None. |
| 862 | * |
| 863 | *---------------------------------------------------------------------- |
| 864 | */ |
| 865 | |
| 866 | extern int |
| 867 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockNReadCmd">NsTclOpenSSLSockNReadCmd</a>(ClientData arg, Tcl_Interp *interp, |
| 868 | int argc, CONST char **argv) |
| 869 | { |
| 870 | Server *thisServer = (Server *) arg; |
| 871 | Tcl_Channel chan = NULL; |
| 872 | SOCKET socket = INVALID_SOCKET; |
| 873 | int nread = 0; |
| 874 | int status = TCL_ERROR; |
| 875 | |
| 876 | if (argc != 2) { |
| 877 | Tcl_AppendResult(interp, "wrong # args: should be \"", |
| 878 | argv[0], " sockId\"", NULL); |
| 879 | goto done; |
| 880 | } |
| 881 | chan = Tcl_GetChannel(interp, argv[1], NULL); |
| 882 | if ( |
| 883 | chan == NULL || |
| 884 | <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenFd">Ns_TclGetOpenFd</a>(interp, argv[1], 0, (int *) &socket) != TCL_OK |
| 885 | ) { |
| 886 | goto done; |
| 887 | } |
| 888 | if (ns_sockioctl(socket, FIONREAD, &nread) != 0) { |
| 889 | Tcl_AppendResult(interp, "ns_sockioctl failed: ", |
| 890 | SockError(interp), NULL); |
| 891 | goto done; |
| 892 | } |
| 893 | nread += Tcl_InputBuffered(chan); |
| 894 | sprintf(interp->result, "%d", nread); |
| 895 | status = TCL_OK; |
| 896 | |
| 897 | done: |
| 898 | return status; |
| 899 | } |
| 900 | |
| 901 | |
| 902 | /* |
| 903 | *---------------------------------------------------------------------- |
| 904 | * |
| 905 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockCheckCmd">NsTclOpenSSLSockCheckCmd</a> -- |
| 906 | * |
| 907 | * Check if a socket is still connected, useful for nonblocking. |
| 908 | * |
| 909 | * Results: |
| 910 | * Tcl result. |
| 911 | * |
| 912 | * Side effects: |
| 913 | * None. |
| 914 | * |
| 915 | *---------------------------------------------------------------------- |
| 916 | */ |
| 917 | |
| 918 | extern int |
| 919 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockCheckCmd">NsTclOpenSSLSockCheckCmd</a>(ClientData arg, Tcl_Interp *interp, int argc, CONST char **argv) |
| 920 | { |
| 921 | Server *thisServer = (Server *) arg; |
| 922 | SOCKET socket = INVALID_SOCKET; |
| 923 | int status = TCL_ERROR; |
| 924 | |
| 925 | if (argc != 2) { |
| 926 | Tcl_AppendResult(interp, "wrong # of args: should be \"", |
| 927 | argv[0], " sockId\"", NULL); |
| 928 | goto done; |
| 929 | } |
| 930 | if (<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenFd">Ns_TclGetOpenFd</a>(interp, argv[1], 1, (int *) &socket) != TCL_OK) { |
| 931 | goto done; |
| 932 | } |
| 933 | if (send(socket, NULL, 0, 0) != 0) { |
| 934 | interp->result = "0"; |
| 935 | } else { |
| 936 | interp->result = "1"; |
| 937 | } |
| 938 | status = TCL_OK; |
| 939 | |
| 940 | done: |
| 941 | return status; |
| 942 | } |
| 943 | |
| 944 | |
| 945 | /* |
| 946 | *---------------------------------------------------------------------- |
| 947 | * |
| 948 | * NsTclOpenSSLSelectCmd -- |
| 949 | * |
| 950 | * Imlements ns_sockselect: basically a tcl version of |
| 951 | * select(2). |
| 952 | * |
| 953 | * Results: |
| 954 | * Tcl result. |
| 955 | * |
| 956 | * Side effects: |
| 957 | * See docs. |
| 958 | * |
| 959 | *---------------------------------------------------------------------- |
| 960 | */ |
| 961 | |
| 962 | extern int |
| 963 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockSelectCmd">NsTclOpenSSLSockSelectCmd</a>(ClientData arg, Tcl_Interp *interp, |
| 964 | int argc, CONST char *argv[]) |
| 965 | { |
| 966 | Server *thisServer = (Server *) arg; |
| 967 | fd_set rset; |
| 968 | fd_set wset; |
| 969 | fd_set eset; |
| 970 | fd_set *rPtr = NULL; |
| 971 | fd_set *wPtr = NULL; |
| 972 | fd_set *ePtr = NULL; |
| 973 | SOCKET maxfd = INVALID_SOCKET; |
| 974 | Tcl_Channel chan = NULL; |
| 975 | Tcl_DString dsRfd; |
| 976 | Tcl_DString dsNbuf; |
| 977 | struct timeval tv; |
| 978 | struct timeval *tvPtr = NULL; |
| 979 | char **fargv = NULL; |
| 980 | int fargc = 0; |
| 981 | int i; |
| 982 | int status = TCL_ERROR; |
| 983 | int first; |
| 984 | |
| 985 | Tcl_DStringInit(&dsRfd); |
| 986 | Tcl_DStringInit(&dsNbuf); |
| 987 | if (argc != 6 && argc != 4) { |
| 988 | Tcl_AppendResult(interp, "wrong # args: should be \"", |
| 989 | argv[0], " ?-timeout sec? rfds wfds efds\"", NULL); |
| 990 | return TCL_ERROR; |
| 991 | } |
| 992 | if (argc == 4) { |
| 993 | tvPtr = NULL; |
| 994 | first = 1; |
| 995 | } else { |
| 996 | tvPtr = &tv; |
| 997 | if (strcmp(argv[1], "-timeout") != 0) { |
| 998 | Tcl_AppendResult(interp, "wrong # args: should be \"", |
| 999 | argv[0], " ?-timeout sec? rfds wfds efds\"", |
| 1000 | NULL); |
| 1001 | return TCL_ERROR; |
| 1002 | } |
| 1003 | tv.tv_usec = 0; |
| 1004 | if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) { |
| 1005 | return TCL_ERROR; |
| 1006 | } |
| 1007 | tv.tv_sec = i; |
| 1008 | first = 3; |
| 1009 | } |
| 1010 | |
| 1011 | /* |
| 1012 | * Readable fd's are treated differently because they may |
| 1013 | * have buffered input. Before doing a select, see if they |
| 1014 | * have any waiting data that's been buffered by the channel. |
| 1015 | */ |
| 1016 | |
| 1017 | if (Tcl_SplitList(interp, argv[first++], &fargc, &fargv) != TCL_OK) { |
| 1018 | return TCL_ERROR; |
| 1019 | } |
| 1020 | for (i = 0; i < fargc; ++i) { |
| 1021 | chan = Tcl_GetChannel(interp, fargv[i], NULL); |
| 1022 | if (chan == NULL) { |
| 1023 | goto done; |
| 1024 | } |
| 1025 | if (Tcl_InputBuffered(chan) > 0) { |
| 1026 | Tcl_DStringAppendElement(&dsNbuf, fargv[i]); |
| 1027 | } else { |
| 1028 | Tcl_DStringAppendElement(&dsRfd, fargv[i]); |
| 1029 | } |
| 1030 | } |
| 1031 | |
| 1032 | /* |
| 1033 | * Since at least one read fd had buffered input, |
| 1034 | * turn the select into a polling select just |
| 1035 | * to pick up anything else ready right now. |
| 1036 | */ |
| 1037 | |
| 1038 | if (dsNbuf.length > 0) { |
| 1039 | tv.tv_sec = 0; |
| 1040 | tv.tv_usec = 0; |
| 1041 | tvPtr = &tv; |
| 1042 | } |
| 1043 | maxfd = 0; |
| 1044 | if (<a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_GetSet">GetSet</a>(interp, dsRfd.string, 0, &rPtr, &rset, &maxfd) != TCL_OK) { |
| 1045 | goto done; |
| 1046 | } |
| 1047 | if (<a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_GetSet">GetSet</a>(interp, argv[first++], 1, &wPtr, &wset, &maxfd) != TCL_OK) { |
| 1048 | goto done; |
| 1049 | } |
| 1050 | if (<a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_GetSet">GetSet</a>(interp, argv[first++], 0, &ePtr, &eset, &maxfd) != TCL_OK) { |
| 1051 | goto done; |
| 1052 | } |
| 1053 | |
| 1054 | /* |
| 1055 | * Return immediately if we're not doing a select on anything. |
| 1056 | */ |
| 1057 | |
| 1058 | if (dsNbuf.length == 0 && |
| 1059 | rPtr == NULL && |
| 1060 | wPtr == NULL && |
| 1061 | ePtr == NULL && |
| 1062 | tvPtr == NULL) { |
| 1063 | status = TCL_OK; |
| 1064 | } else { |
| 1065 | |
| 1066 | /* |
| 1067 | * Actually perform the select. |
| 1068 | */ |
| 1069 | |
| 1070 | do { |
| 1071 | i = select(maxfd + 1, rPtr, wPtr, ePtr, tvPtr); |
| 1072 | } while (i < 0 && ns_sockerrno == EINTR); |
| 1073 | if (i == -1) { |
| 1074 | Tcl_AppendResult(interp, "select failed: ", |
| 1075 | SockError(interp), NULL); |
| 1076 | } else { |
| 1077 | if (i == 0) { |
| 1078 | |
| 1079 | /* |
| 1080 | * The sets can have any random value now |
| 1081 | */ |
| 1082 | |
| 1083 | if (rPtr != NULL) { |
| 1084 | FD_ZERO(rPtr); |
| 1085 | } |
| 1086 | if (wPtr != NULL) { |
| 1087 | FD_ZERO(wPtr); |
| 1088 | } |
| 1089 | if (ePtr != NULL) { |
| 1090 | FD_ZERO(ePtr); |
| 1091 | } |
| 1092 | } |
| 1093 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_AppendReadyFiles">AppendReadyFiles</a>(interp, rPtr, 0, dsRfd.string, &dsNbuf); |
| 1094 | first -= 2; |
| 1095 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_AppendReadyFiles">AppendReadyFiles</a>(interp, wPtr, 1, argv[first++], NULL); |
| 1096 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_AppendReadyFiles">AppendReadyFiles</a>(interp, ePtr, 0, argv[first++], NULL); |
| 1097 | status = TCL_OK; |
| 1098 | } |
| 1099 | } |
| 1100 | |
| 1101 | done: |
| 1102 | Tcl_DStringFree(&dsRfd); |
| 1103 | Tcl_DStringFree(&dsNbuf); |
| 1104 | ckfree((char *) fargv); |
| 1105 | |
| 1106 | return status; |
| 1107 | } |
| 1108 | |
| 1109 | |
| 1110 | /* |
| 1111 | *---------------------------------------------------------------------- |
| 1112 | * |
| 1113 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockCallbackObjCmd">NsTclOpenSSLSockCallbackObjCmd</a> -- |
| 1114 | * |
| 1115 | * Register a Tcl callback to be run when a certain state exists |
| 1116 | * on a socket. |
| 1117 | * |
| 1118 | * Results: |
| 1119 | * Tcl result. |
| 1120 | * |
| 1121 | * Side effects: |
| 1122 | * A callback will be registered. |
| 1123 | * |
| 1124 | *---------------------------------------------------------------------- |
| 1125 | */ |
| 1126 | |
| 1127 | extern int |
| 1128 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockCallbackObjCmd">NsTclOpenSSLSockCallbackObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, |
| 1129 | Tcl_Obj *CONST objv[]) |
| 1130 | { |
| 1131 | Server *thisServer = (Server *) arg; |
| 1132 | SockCallback *cbPtr = NULL; |
| 1133 | SOCKET socket = INVALID_SOCKET; |
| 1134 | int when = 0; |
| 1135 | char *s = NULL; |
| 1136 | |
| 1137 | if (objc != 4) { |
| 1138 | Tcl_WrongNumArgs(interp, 1, objv, "sockId script when"); |
| 1139 | return TCL_ERROR; |
| 1140 | } |
| 1141 | s = Tcl_GetString(objv[3]); |
| 1142 | while (*s != '\0') { |
| 1143 | if (*s == 'r') { |
| 1144 | when |= NS_SOCK_READ; |
| 1145 | } else if (*s == 'w') { |
| 1146 | when |= NS_SOCK_WRITE; |
| 1147 | } else if (*s == 'e') { |
| 1148 | when |= NS_SOCK_EXCEPTION; |
| 1149 | } else if (*s == 'x') { |
| 1150 | when |= NS_SOCK_EXIT; |
| 1151 | } else { |
| 1152 | Tcl_AppendResult(interp, "invalid when specification \"", |
| 1153 | Tcl_GetString(objv[3]), "\": should be one or more of r, w, e, or x", NULL); |
| 1154 | return TCL_ERROR; |
| 1155 | } |
| 1156 | ++s; |
| 1157 | } |
| 1158 | if (when == 0) { |
| 1159 | Tcl_AppendResult(interp, "invalid when specification \"", Tcl_GetString(objv[3]), |
| 1160 | "\": should be one or more of r, w, e, or x", NULL); |
| 1161 | return TCL_ERROR; |
| 1162 | } |
| 1163 | if (<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenFd">Ns_TclGetOpenFd</a>(interp, Tcl_GetString(objv[1]), (when & NS_SOCK_WRITE), |
| 1164 | (int *) &socket) != TCL_OK) { |
| 1165 | return TCL_ERROR; |
| 1166 | } |
| 1167 | socket = <a href="/cvs/aolserver/aolserver/nsd/nswin32.c#A_ns_sockdup">ns_sockdup</a>(socket); |
| 1168 | if (socket == INVALID_SOCKET) { |
| 1169 | Tcl_AppendResult(interp, "dup failed: ", SockError(interp), NULL); |
| 1170 | return TCL_ERROR; |
| 1171 | } |
| 1172 | cbPtr = ns_malloc(sizeof(SockCallback) + strlen(Tcl_GetString(objv[2]))); |
| 1173 | cbPtr->server = thisServer->server; |
| 1174 | cbPtr->when = when; |
| 1175 | strcpy(cbPtr->script, Tcl_GetString(objv[2])); |
| 1176 | if (<a href="/cvs/aolserver/aolserver/nsd/sockcallback.c#A_Ns_SockCallback">Ns_SockCallback</a>(socket, <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SSLSockCallbackProc">SSLSockCallbackProc</a>, cbPtr, when | NS_SOCK_EXIT) != NS_OK) { |
| 1177 | interp->result = "could not register callback"; |
| 1178 | ns_sockclose(socket); |
| 1179 | ns_free(cbPtr); |
| 1180 | return TCL_ERROR; |
| 1181 | } |
| 1182 | |
| 1183 | return TCL_OK; |
| 1184 | } |
| 1185 | |
| 1186 | |
| 1187 | /* |
| 1188 | *---------------------------------------------------------------------- |
| 1189 | * |
| 1190 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockListenCallbackObjCmd">NsTclOpenSSLSockListenCallbackObjCmd</a> -- |
| 1191 | * |
| 1192 | * Listen on a socket and register a callback to run when |
| 1193 | * connections arrive. |
| 1194 | * |
| 1195 | * Results: |
| 1196 | * Tcl result. |
| 1197 | * |
| 1198 | * Side effects: |
| 1199 | * Will register a callback and listen on a socket. |
| 1200 | * |
| 1201 | *---------------------------------------------------------------------- |
| 1202 | */ |
| 1203 | |
| 1204 | int |
| 1205 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_NsTclOpenSSLSockListenCallbackObjCmd">NsTclOpenSSLSockListenCallbackObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, |
| 1206 | Tcl_Obj *CONST objv[]) |
| 1207 | { |
| 1208 | Server *thisServer = (Server *) arg; |
| 1209 | <a href="/cvs/aolserver/aolserver/nsd/tclsock.c#A_SockListenCallback">SockListenCallback</a> *lcbPtr = NULL; |
| 1210 | int port = 0; |
| 1211 | char *addr = NULL; |
| 1212 | |
| 1213 | /* |
| 1214 | * ns_openssl_socklistencallback host port script |
| 1215 | * ns_openssl_socklistencallback host port script sslcontext |
| 1216 | */ |
| 1217 | |
| 1218 | if (objc != 4 && objc != 5) { |
| 1219 | Tcl_WrongNumArgs(interp, 1, objv, "address port script ?sslcontext?"); |
| 1220 | return TCL_ERROR; |
| 1221 | } |
| 1222 | if (Tcl_GetIntFromObj(interp, objv[2], &port) != TCL_OK) { |
| 1223 | return TCL_ERROR; |
| 1224 | } |
| 1225 | addr = Tcl_GetString(objv[1]); |
| 1226 | if (STREQ(addr, "*")) { |
| 1227 | addr = NULL; |
| 1228 | } |
| 1229 | lcbPtr = ns_malloc(sizeof(<a href="/cvs/aolserver/aolserver/nsd/tclsock.c#A_SockListenCallback">SockListenCallback</a>)); |
| 1230 | lcbPtr->server = thisServer->server; |
| 1231 | lcbPtr->script = strdup(Tcl_GetString(objv[3])); |
| 1232 | if (objc == 5) { |
| 1233 | lcbPtr->sslcontext = <a href="/cvs/aolserver/nsopenssl/sslcontext.c#A_Ns_OpenSSLServerSSLContextGet">Ns_OpenSSLServerSSLContextGet</a>(thisServer->server, (char *) Tcl_GetString(objv[5])); |
| 1234 | } else { |
| 1235 | lcbPtr->sslcontext = <a href="/cvs/aolserver/nsopenssl/sslcontext.c#A_NsOpenSSLContextServerDefaultGet">NsOpenSSLContextServerDefaultGet</a>(thisServer->server); |
| 1236 | } |
| 1237 | |
| 1238 | /* XXX check lcbPtr->sslcontext: if NULL, fail with error message !!! */ |
| 1239 | #if 0 |
| 1240 | if (sslcontext == NULL) { |
| 1241 | Tcl_SetResult(interp, "failed to use either named or default client SSL context", |
| 1242 | TCL_STATIC); |
| 1243 | return TCL_ERROR; |
| 1244 | } |
| 1245 | #endif |
| 1246 | |
| 1247 | if (<a href="/cvs/aolserver/aolserver/nsd/listen.c#A_Ns_SockListenCallback">Ns_SockListenCallback</a>(addr, port, <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SSLSockListenCallbackProc">SSLSockListenCallbackProc</a>, lcbPtr) != NS_OK) { |
| 1248 | <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Error, "NsTclOpenSSLSockListenCallbackCmd: COULD NOT REGISTER CALLBACK"); |
| 1249 | Tcl_SetResult(interp, "could not register callback", TCL_STATIC); |
| 1250 | ns_free(lcbPtr); |
| 1251 | return TCL_ERROR; |
| 1252 | } |
| 1253 | |
| 1254 | return TCL_OK; |
| 1255 | } |
| 1256 | |
| 1257 | |
| 1258 | /* |
| 1259 | *---------------------------------------------------------------------- |
| 1260 | * |
| 1261 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterSock">EnterSock</a>, <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterDup">EnterDup</a> -- |
| 1262 | * |
| 1263 | * Append a socket handle to the tcl result and register its |
| 1264 | * channel. |
| 1265 | * |
| 1266 | * Results: |
| 1267 | * Tcl result. |
| 1268 | * |
| 1269 | * Side effects: |
| 1270 | * Will create channel, append handle to result. |
| 1271 | * |
| 1272 | *---------------------------------------------------------------------- |
| 1273 | */ |
| 1274 | |
| 1275 | static int |
| 1276 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterSock">EnterSock</a>(Tcl_Interp *interp, SOCKET sock) |
| 1277 | { |
| 1278 | Tcl_Channel chan = NULL; |
| 1279 | |
| 1280 | chan = Tcl_MakeTcpClientChannel((ClientData) sock); |
| 1281 | if (chan == NULL) { |
| 1282 | Tcl_AppendResult(interp, "could not open socket", NULL); |
| 1283 | ns_sockclose(sock); |
| 1284 | return TCL_ERROR; |
| 1285 | } |
| 1286 | Tcl_SetChannelOption(interp, chan, "-translation", "binary"); |
| 1287 | Tcl_RegisterChannel(interp, chan); |
| 1288 | sprintf(interp->result, "%s", Tcl_GetChannelName(chan)); |
| 1289 | |
| 1290 | return TCL_OK; |
| 1291 | } |
| 1292 | |
| 1293 | static int |
| 1294 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterDup">EnterDup</a>(Tcl_Interp *interp, SOCKET sock) |
| 1295 | { |
| 1296 | sock = <a href="/cvs/aolserver/aolserver/nsd/nswin32.c#A_ns_sockdup">ns_sockdup</a>(sock); |
| 1297 | if (sock == INVALID_SOCKET) { |
| 1298 | Tcl_AppendResult(interp, "could not dup socket: ", |
| 1299 | ns_sockstrerror(ns_sockerrno), NULL); |
| 1300 | return TCL_ERROR; |
| 1301 | } |
| 1302 | |
| 1303 | return <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterSock">EnterSock</a>(interp, sock); |
| 1304 | } |
| 1305 | |
| 1306 | #if 0 |
| 1307 | static int |
| 1308 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterDupedSocks">EnterDupedSocks</a>(Tcl_Interp *interp, SOCKET sock) |
| 1309 | { |
| 1310 | if (<a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterSock">EnterSock</a>(interp, sock) != TCL_OK || |
| 1311 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterDup">EnterDup</a>(interp, sock) != TCL_OK) { |
| 1312 | return TCL_ERROR; |
| 1313 | } |
| 1314 | return TCL_OK; |
| 1315 | } |
| 1316 | #endif |
| 1317 | |
| 1318 | |
| 1319 | /* |
| 1320 | *---------------------------------------------------------------------- |
| 1321 | * |
| 1322 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SetResultToX509Name">SetResultToX509Name</a> -- |
| 1323 | * |
| 1324 | * Set the Tcl interpreter's result to the string form of the |
| 1325 | * specified X.509 name. |
| 1326 | * |
| 1327 | * Results: |
| 1328 | * None. |
| 1329 | * |
| 1330 | * Side effects: |
| 1331 | * None. |
| 1332 | * |
| 1333 | *---------------------------------------------------------------------- |
| 1334 | */ |
| 1335 | |
| 1336 | static void |
| 1337 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SetResultToX509Name">SetResultToX509Name</a>(Tcl_Interp *interp, X509_NAME *name) |
| 1338 | { |
| 1339 | char *string = NULL; |
| 1340 | |
| 1341 | string = X509_NAME_oneline(name, NULL, 0); |
| 1342 | Tcl_SetResult(interp, string, TCL_VOLATILE); |
| 1343 | OPENSSL_free(string); |
| 1344 | } |
| 1345 | |
| 1346 | |
| 1347 | /* |
| 1348 | *---------------------------------------------------------------------- |
| 1349 | * |
| 1350 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SetResultToObjectName">SetResultToObjectName</a> -- |
| 1351 | * |
| 1352 | * Set the Tcl interpreter's result to the string form of the |
| 1353 | * specified ASN.1 object name. |
| 1354 | * |
| 1355 | * Results: |
| 1356 | * None. |
| 1357 | * |
| 1358 | * Side effects: |
| 1359 | * None. |
| 1360 | * |
| 1361 | *---------------------------------------------------------------------- |
| 1362 | */ |
| 1363 | |
| 1364 | static void |
| 1365 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SetResultToObjectName">SetResultToObjectName</a>(Tcl_Interp *interp, ASN1_OBJECT *obj) |
| 1366 | { |
| 1367 | int nid = 0; |
| 1368 | char *string = NULL; |
| 1369 | |
| 1370 | nid = OBJ_obj2nid(obj); |
| 1371 | if (nid == NID_undef) { |
| 1372 | Tcl_SetResult(interp, "UNKNOWN", TCL_STATIC); |
| 1373 | } else { |
| 1374 | string = (char *) OBJ_nid2ln(nid); |
| 1375 | if (string == NULL) { |
| 1376 | Tcl_SetResult(interp, "ERROR", TCL_STATIC); |
| 1377 | } else { |
| 1378 | Tcl_SetResult(interp, string, TCL_VOLATILE); |
| 1379 | } |
| 1380 | } |
| 1381 | } |
| 1382 | |
| 1383 | |
| 1384 | /* |
| 1385 | *---------------------------------------------------------------------- |
| 1386 | * |
| 1387 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ValidTime">ValidTime</a> -- |
| 1388 | * |
| 1389 | * Takes an ASN1_UTCTIME value and converts it into a string of |
| 1390 | * the form "Aug 28 20:00:38 2002 GMT" |
| 1391 | * |
| 1392 | * Results: |
| 1393 | * Pointer to null-terminated string allocated by Tcl_Alloc. |
| 1394 | * |
| 1395 | * Side effects: |
| 1396 | * None. |
| 1397 | * |
| 1398 | *---------------------------------------------------------------------- */ |
| 1399 | |
| 1400 | static char * |
| 1401 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ValidTime">ValidTime</a>(ASN1_UTCTIME *tm) |
| 1402 | { |
| 1403 | char *result = NULL; |
| 1404 | BIO *bio = NULL; |
| 1405 | unsigned int n = 0; |
| 1406 | |
| 1407 | if ((bio = BIO_new(BIO_s_mem())) == NULL) { |
| 1408 | return NULL; |
| 1409 | } |
| 1410 | ASN1_UTCTIME_print(bio, tm); |
| 1411 | n = BIO_pending(bio); |
| 1412 | result = Tcl_Alloc(n + 1); |
| 1413 | n = BIO_read(bio, result, (signed int) n); |
| 1414 | result[n] = '\0'; |
| 1415 | BIO_free(bio); |
| 1416 | |
| 1417 | return result; |
| 1418 | } |
| 1419 | |
| 1420 | |
| 1421 | /* |
| 1422 | *---------------------------------------------------------------------- |
| 1423 | * |
| 1424 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_PEMCertificate">PEMCertificate</a> -- |
| 1425 | * |
| 1426 | * Retrieves the certificate in PEM format |
| 1427 | * |
| 1428 | * Results: |
| 1429 | * Pointer to null-terminated string that contains the PEM |
| 1430 | * certificate, allocated by Tcl_Alloc. |
| 1431 | * |
| 1432 | * Side effects: |
| 1433 | * None. |
| 1434 | * |
| 1435 | *---------------------------------------------------------------------- */ |
| 1436 | |
| 1437 | static char * |
| 1438 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_PEMCertificate">PEMCertificate</a>(X509 *peercert) |
| 1439 | { |
| 1440 | char *result = NULL; |
| 1441 | BIO *bio = NULL; |
| 1442 | unsigned int n = 0; |
| 1443 | |
| 1444 | if ((bio = BIO_new(BIO_s_mem())) == NULL) { |
| 1445 | return NULL; |
| 1446 | } |
| 1447 | PEM_write_bio_X509(bio, peercert); |
| 1448 | n = BIO_pending(bio); |
| 1449 | result = Tcl_Alloc(n + 1); |
| 1450 | n = BIO_read(bio, result, (signed int) n); |
| 1451 | result[n] = '\0'; |
| 1452 | BIO_free(bio); |
| 1453 | |
| 1454 | return result; |
| 1455 | } |
| 1456 | |
| 1457 | |
| 1458 | /* |
| 1459 | *---------------------------------------------------------------------- |
| 1460 | * |
| 1461 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_CreateTclChannel">CreateTclChannel</a> -- |
| 1462 | * |
| 1463 | * Dup connection sock and wrap read and write Tcl channels |
| 1464 | * around them. |
| 1465 | * |
| 1466 | * Results: |
| 1467 | * Tcl result. |
| 1468 | * |
| 1469 | * Side effects: |
| 1470 | * |
| 1471 | *---------------------------------------------------------------------- |
| 1472 | */ |
| 1473 | |
| 1474 | static int |
| 1475 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_CreateTclChannel">CreateTclChannel</a>(NsOpenSSLConn *sslconn, Tcl_Interp *interp) |
| 1476 | { |
| 1477 | ChanInfo *getschan = NULL; |
| 1478 | ChanInfo *putschan = NULL; |
| 1479 | Tcl_DString ds; |
| 1480 | char channelName[16 + TCL_INTEGER_SPACE]; |
| 1481 | |
| 1482 | Tcl_DStringInit(&ds); |
| 1483 | |
| 1484 | /* |
| 1485 | * The ns_sock API in AOLserver passes back a separate read and write fds |
| 1486 | * to work with. In our case, we're using the same socket underneath both, |
| 1487 | * but to maintain consistency we also create two separate channels and |
| 1488 | * pass back two separate fds to the caller. |
| 1489 | */ |
| 1490 | |
| 1491 | getschan = ns_calloc(1, sizeof(ChanInfo)); |
| 1492 | getschan->sslconn = sslconn; |
| 1493 | |
| 1494 | putschan = ns_calloc(1, sizeof(ChanInfo)); |
| 1495 | putschan->sslconn = sslconn; |
| 1496 | |
| 1497 | getschan->otherchaninfo = (void *) putschan; |
| 1498 | putschan->otherchaninfo = (void *) getschan; |
| 1499 | |
| 1500 | /* |
| 1501 | * Set up the read channel. |
| 1502 | */ |
| 1503 | |
| 1504 | getschan->socket = sslconn->socket; |
| 1505 | sprintf(channelName, "openssl%d", getschan->socket); |
| 1506 | getschan->chan = Tcl_CreateChannel( |
| 1507 | &opensslChannelType, |
| 1508 | channelName, |
| 1509 | (ClientData) getschan, |
| 1510 | (TCL_READABLE | TCL_WRITABLE) |
| 1511 | ); |
| 1512 | if (getschan->chan == (Tcl_Channel) NULL) { |
| 1513 | <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Error, "%s: %s: could not create new Tcl channel", |
| 1514 | MODULE, sslconn->server); |
| 1515 | Tcl_AppendResult (interp, "could not create new Tcl channel", NULL); |
| 1516 | return TCL_ERROR; |
| 1517 | } |
| 1518 | Tcl_SetChannelBufferSize(getschan->chan, BUFSIZ); |
| 1519 | Tcl_SetChannelOption(interp, getschan->chan, "-translation", "binary"); |
| 1520 | Tcl_RegisterChannel(interp, getschan->chan); |
| 1521 | |
| 1522 | /* |
| 1523 | * Set up the write channel. |
| 1524 | */ |
| 1525 | |
| 1526 | putschan->socket = <a href="/cvs/aolserver/aolserver/nsd/nswin32.c#A_ns_sockdup">ns_sockdup</a>(sslconn->socket); |
| 1527 | sprintf(channelName, "openssl%d", putschan->socket); |
| 1528 | putschan->chan = Tcl_CreateChannel( |
| 1529 | &opensslChannelType, |
| 1530 | channelName, |
| 1531 | (ClientData) putschan, |
| 1532 | (TCL_READABLE | TCL_WRITABLE) |
| 1533 | ); |
| 1534 | if (putschan->chan == (Tcl_Channel) NULL) { |
| 1535 | <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Error, "%s: %s: could not create new Tcl channel", |
| 1536 | MODULE, sslconn->server); |
| 1537 | Tcl_AppendResult (interp, "could not create new Tcl channel", NULL); |
| 1538 | return TCL_ERROR; |
| 1539 | } |
| 1540 | Tcl_SetChannelBufferSize(putschan->chan, BUFSIZ); |
| 1541 | Tcl_SetChannelOption(interp, putschan->chan, "-translation", "binary"); |
| 1542 | Tcl_RegisterChannel(interp, putschan->chan); |
| 1543 | |
| 1544 | /* |
| 1545 | * Append the fd names to the result. |
| 1546 | */ |
| 1547 | |
| 1548 | Tcl_DStringAppendElement(&ds, Tcl_GetChannelName(getschan->chan)); |
| 1549 | Tcl_DStringAppendElement(&ds, Tcl_GetChannelName(putschan->chan)); |
| 1550 | |
| 1551 | //<a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Debug, "*** CHAN CREATE: %s", Tcl_GetChannelName(getschan->chan)); |
| 1552 | //<a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Debug, "*** CHAN CREATE: %s", Tcl_GetChannelName(putschan->chan)); |
| 1553 | |
| 1554 | Tcl_DStringResult(interp, &ds); |
| 1555 | |
| 1556 | return TCL_OK; |
| 1557 | } |
| 1558 | |
| 1559 | |
| 1560 | /* |
| 1561 | *---------------------------------------------------------------------- |
| 1562 | * |
| 1563 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanOutputProc">ChanOutputProc</a> -- |
| 1564 | * |
| 1565 | * Callback activated by Tcl puts and write commands. Sends data |
| 1566 | * to the connected system. |
| 1567 | * |
| 1568 | * Results: |
| 1569 | * Tcl result. |
| 1570 | * |
| 1571 | * Side effects: |
| 1572 | * |
| 1573 | *---------------------------------------------------------------------- |
| 1574 | */ |
| 1575 | |
| 1576 | static int |
| 1577 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanOutputProc">ChanOutputProc</a>(ClientData arg, char *buf, int towrite, |
| 1578 | int *errorCodePtr) |
| 1579 | { |
| 1580 | ChanInfo *chaninfo = (ChanInfo *) arg; |
| 1581 | int rc = 0; |
| 1582 | |
| 1583 | rc = NsOpenSSLConnOp(chaninfo->sslconn->ssl, (void *) buf, towrite, NSOPENSSL_SEND); |
| 1584 | |
| 1585 | return rc; |
| 1586 | } |
| 1587 | |
| 1588 | |
| 1589 | /* |
| 1590 | *---------------------------------------------------------------------- |
| 1591 | * |
| 1592 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanInputProc">ChanInputProc</a> -- |
| 1593 | * |
| 1594 | * Callback activated by Tcl gets and read on the Tcl channel. Reads |
| 1595 | * data from the connected system. |
| 1596 | * |
| 1597 | * Results: |
| 1598 | * Number of bytes read. |
| 1599 | * |
| 1600 | * Side effects: |
| 1601 | * Places read data into buf, may set errorCodePtr, and adjusts |
| 1602 | * connection state's read buffer pointer. |
| 1603 | * |
| 1604 | *---------------------------------------------------------------------- |
| 1605 | */ |
| 1606 | |
| 1607 | static int |
| 1608 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanInputProc">ChanInputProc</a>(ClientData arg, char *buf, int bufSize, |
| 1609 | int *errorCodePtr) |
| 1610 | { |
| 1611 | ChanInfo *chaninfo = (ChanInfo *) arg; |
| 1612 | int rc = 0; |
| 1613 | |
| 1614 | rc = NsOpenSSLConnOp(chaninfo->sslconn->ssl, (void *) buf, bufSize, NSOPENSSL_RECV); |
| 1615 | |
| 1616 | return rc; |
| 1617 | } |
| 1618 | |
| 1619 | |
| 1620 | /* |
| 1621 | *---------------------------------------------------------------------- |
| 1622 | * |
| 1623 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanCloseProc">ChanCloseProc</a> -- |
| 1624 | * |
| 1625 | * Close down the Tcl channels and clean up the connection state |
| 1626 | * data. |
| 1627 | * |
| 1628 | * Results: |
| 1629 | * Tcl result. |
| 1630 | * |
| 1631 | * Side effects: |
| 1632 | * Will call functions to shutdown the SSL connection and free all |
| 1633 | * data associated with the connection. |
| 1634 | * |
| 1635 | * Note that this proc is called twice, once for the read channel |
| 1636 | * and once for the write channel, so we need to check and see if |
| 1637 | * conn has already been freed. |
| 1638 | * |
| 1639 | *---------------------------------------------------------------------- |
| 1640 | */ |
| 1641 | |
| 1642 | static int |
| 1643 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanCloseProc">ChanCloseProc</a>(ClientData arg, Tcl_Interp *interp) |
| 1644 | { |
| 1645 | ChanInfo *chaninfo = (ChanInfo *) arg; |
| 1646 | ChanInfo *otherchaninfo = NULL; |
| 1647 | |
| 1648 | //<a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Debug, "*** CHAN DESTROY: %s", Tcl_GetChannelName(chaninfo->chan)); |
| 1649 | Tcl_UnregisterChannel(interp, chaninfo->chan); |
| 1650 | ns_sockclose(chaninfo->socket); |
| 1651 | chaninfo->socket = INVALID_SOCKET; |
| 1652 | otherchaninfo = (ChanInfo *) chaninfo->otherchaninfo; |
| 1653 | |
| 1654 | if (otherchaninfo->socket == INVALID_SOCKET) { |
| 1655 | //<a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Debug, "*** SSL DESTROY"); |
| 1656 | ns_free(otherchaninfo); |
| 1657 | NsOpenSSLConnDestroy(chaninfo->sslconn); |
| 1658 | ns_free(chaninfo); |
| 1659 | } |
| 1660 | |
| 1661 | return TCL_OK; |
| 1662 | } |
| 1663 | |
| 1664 | |
| 1665 | /* |
| 1666 | *---------------------------------------------------------------------- |
| 1667 | * |
| 1668 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanFlushProc">ChanFlushProc</a> -- |
| 1669 | * |
| 1670 | * Flush the date in the connection buffers. |
| 1671 | * |
| 1672 | * Results: |
| 1673 | * TCL_OK. |
| 1674 | * |
| 1675 | * Side effects: |
| 1676 | * Will open a connection and register two Tcl channels. |
| 1677 | * |
| 1678 | *---------------------------------------------------------------------- |
| 1679 | */ |
| 1680 | |
| 1681 | static int |
| 1682 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanFlushProc">ChanFlushProc</a> (ClientData arg) |
| 1683 | { |
| 1684 | ChanInfo *chaninfo = (ChanInfo *) arg; |
| 1685 | |
| 1686 | //<a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Debug, "<a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanFlushProc">ChanFlushProc</a> %s", Tcl_GetChannelName(chaninfo->chan)); |
| 1687 | NsOpenSSLConnFlush(chaninfo->sslconn); |
| 1688 | |
| 1689 | return TCL_OK; |
| 1690 | } |
| 1691 | |
| 1692 | |
| 1693 | /* |
| 1694 | *---------------------------------------------------------------------- |
| 1695 | * |
| 1696 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanGetHandleProc">ChanGetHandleProc</a> -- |
| 1697 | * |
| 1698 | * Return the read or write socket. |
| 1699 | * |
| 1700 | * Results: |
| 1701 | * TCL_OK |
| 1702 | * |
| 1703 | * Side effects: |
| 1704 | * |
| 1705 | * |
| 1706 | *---------------------------------------------------------------------- |
| 1707 | */ |
| 1708 | |
| 1709 | static int |
| 1710 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanGetHandleProc">ChanGetHandleProc</a>(ClientData arg, int direction, ClientData *handlePtr) |
| 1711 | { |
| 1712 | ChanInfo *chaninfo = (ChanInfo *) arg; |
| 1713 | |
| 1714 | *handlePtr = (ClientData) chaninfo->sslconn->socket; |
| 1715 | |
| 1716 | return TCL_OK; |
| 1717 | } |
| 1718 | |
| 1719 | |
| 1720 | /* |
| 1721 | *---------------------------------------------------------------------- |
| 1722 | * |
| 1723 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanWatchProc">ChanWatchProc</a> -- |
| 1724 | * |
| 1725 | * Callback proc used by the Tcl channels. Doesn't do anything for us at |
| 1726 | * the moment, but it is still required to be defined. Not having it |
| 1727 | * causes a segfault when Tcl tries to work with it. Go read the |
| 1728 | * Tcl_CreateChannel man page for Tcl 8.3+. |
| 1729 | * |
| 1730 | * Results: |
| 1731 | * None. |
| 1732 | * |
| 1733 | *---------------------------------------------------------------------- |
| 1734 | */ |
| 1735 | |
| 1736 | static void |
| 1737 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_ChanWatchProc">ChanWatchProc</a>(ClientData arg, int mask) |
| 1738 | { |
| 1739 | return; |
| 1740 | } |
| 1741 | |
| 1742 | |
| 1743 | /* |
| 1744 | *---------------------------------------------------------------------- |
| 1745 | * |
| 1746 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SSLSockListenCallbackProc">SSLSockListenCallbackProc</a> -- |
| 1747 | * |
| 1748 | * This is the C wrapper callback that is registered from |
| 1749 | * ns_openssl_socklistencallback. |
| 1750 | * |
| 1751 | * Results: |
| 1752 | * NS_TRUE or NS_FALSE on error |
| 1753 | * |
| 1754 | * Side effects: |
| 1755 | * Will run Tcl script. |
| 1756 | * |
| 1757 | *---------------------------------------------------------------------- |
| 1758 | */ |
| 1759 | |
| 1760 | static int |
| 1761 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SSLSockListenCallbackProc">SSLSockListenCallbackProc</a>(SOCKET sock, void *arg, int why) |
| 1762 | { |
| 1763 | <a href="/cvs/aolserver/aolserver/nsd/tclsock.c#A_SockListenCallback">SockListenCallback</a> *lcbPtr = arg; |
| 1764 | NsOpenSSLConn *sslconn = NULL; |
| 1765 | Tcl_Interp *interp = NULL; |
| 1766 | Tcl_DString script; |
| 1767 | Tcl_Obj *listPtr = NULL; |
| 1768 | Tcl_Obj **objv = NULL; |
| 1769 | int result = TCL_ERROR; |
| 1770 | int objc = 0; |
| 1771 | |
| 1772 | //<a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Debug, "*** SockListenCallbackProc running"); |
| 1773 | |
| 1774 | interp = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a>(lcbPtr->server); |
| 1775 | sslconn = Ns_OpenSSLSockAccept(sock, lcbPtr->sslcontext); |
| 1776 | if (sslconn == NULL) { |
| 1777 | Tcl_AppendResult(interp, "SSL accept failed \"", NULL); |
| 1778 | return TCL_ERROR; |
| 1779 | } |
| 1780 | //<a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Debug, "*** SockListenCallbackProc running 2"); |
| 1781 | result = <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_CreateTclChannel">CreateTclChannel</a>(sslconn, interp); |
| 1782 | if (result == TCL_OK) { |
| 1783 | //<a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Debug, "*** SockListenCallbackProc running 3"); |
| 1784 | listPtr = Tcl_GetObjResult(interp); |
| 1785 | if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) == TCL_OK && objc == 1) { |
| 1786 | Tcl_DStringInit(&script); |
| 1787 | Tcl_DStringAppend(&script, lcbPtr->script, -1); |
| 1788 | Tcl_DStringAppendElement(&script, Tcl_GetString(objv[0])); |
| 1789 | result = Tcl_EvalEx(interp, script.string, script.length, 0); |
| 1790 | Tcl_DStringFree(&script); |
| 1791 | } |
| 1792 | //<a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Debug, "*** SockListenCallbackProc running 4"); |
| 1793 | } |
| 1794 | if (result != TCL_OK) { |
| 1795 | //<a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Debug, "*** SockListenCallbackProc running 5"); |
| 1796 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(interp); |
| 1797 | } |
| 1798 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDeAllocateInterp">Ns_TclDeAllocateInterp</a>(interp); |
| 1799 | |
| 1800 | return NS_TRUE; |
| 1801 | } |
| 1802 | |
| 1803 | |
| 1804 | /* |
| 1805 | *---------------------------------------------------------------------- |
| 1806 | * |
| 1807 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_AppendReadyFiles">AppendReadyFiles</a> -- |
| 1808 | * |
| 1809 | * Find files in an fd_set that are selected and append them to |
| 1810 | * the tcl result, and also an optional passed-in dstring. |
| 1811 | * |
| 1812 | * Results: |
| 1813 | * None. |
| 1814 | * |
| 1815 | * Side effects: |
| 1816 | * Ready files will be appended to pds if not null, and also |
| 1817 | * interp->result. |
| 1818 | * |
| 1819 | *---------------------------------------------------------------------- |
| 1820 | */ |
| 1821 | |
| 1822 | static void |
| 1823 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_AppendReadyFiles">AppendReadyFiles</a> (Tcl_Interp * interp, fd_set * setPtr, int write, |
| 1824 | char *flist, Tcl_DString * dsPtr) |
| 1825 | { |
| 1826 | int fargc = 0; |
| 1827 | char **fargv = NULL; |
| 1828 | SOCKET socket = INVALID_SOCKET; |
| 1829 | Tcl_DString ds; |
| 1830 | |
| 1831 | Tcl_DStringInit(&ds); |
| 1832 | if (dsPtr == NULL) { |
| 1833 | dsPtr = &ds; |
| 1834 | } |
| 1835 | Tcl_SplitList(interp, flist, &fargc, &fargv); |
| 1836 | while (fargc--) { |
| 1837 | <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenFd">Ns_TclGetOpenFd</a>(interp, fargv[fargc], write, (int *) &socket); |
| 1838 | if (FD_ISSET(socket, setPtr)) { |
| 1839 | Tcl_DStringAppendElement(dsPtr, fargv[fargc]); |
| 1840 | } |
| 1841 | } |
| 1842 | |
| 1843 | /* |
| 1844 | * Append the ready files to the tcl interp. |
| 1845 | */ |
| 1846 | |
| 1847 | Tcl_AppendElement(interp, dsPtr->string); |
| 1848 | ckfree((char *) fargv); |
| 1849 | Tcl_DStringFree(&ds); |
| 1850 | } |
| 1851 | |
| 1852 | |
| 1853 | /* |
| 1854 | *---------------------------------------------------------------------- |
| 1855 | * |
| 1856 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_GetSet">GetSet</a> -- |
| 1857 | * |
| 1858 | * Take a Tcl list of files and set bits for each in the list in |
| 1859 | * an fd_set. |
| 1860 | * |
| 1861 | * Results: |
| 1862 | * Tcl result. |
| 1863 | * |
| 1864 | * Side effects: |
| 1865 | * Will set bits in fd_set. ppset may be NULL on error, or |
| 1866 | * a valid fd_set on success. Max fd will be returned in *maxPtr. |
| 1867 | * |
| 1868 | *---------------------------------------------------------------------- |
| 1869 | */ |
| 1870 | |
| 1871 | static int |
| 1872 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_GetSet">GetSet</a>(Tcl_Interp * interp, char *flist, int write, fd_set ** setPtrPtr, |
| 1873 | fd_set * setPtr, SOCKET * maxPtr) |
| 1874 | { |
| 1875 | SOCKET socket = INVALID_SOCKET; |
| 1876 | int fargc = 0; |
| 1877 | char **fargv = NULL; |
| 1878 | int status = TCL_ERROR; |
| 1879 | |
| 1880 | if (Tcl_SplitList(interp, flist, &fargc, &fargv) != TCL_OK) { |
| 1881 | return TCL_ERROR; |
| 1882 | } |
| 1883 | if (fargc == 0) { |
| 1884 | |
| 1885 | /* |
| 1886 | * Tcl_SplitList failed, so abort. |
| 1887 | */ |
| 1888 | |
| 1889 | ckfree((char *) fargv); |
| 1890 | *setPtrPtr = NULL; |
| 1891 | return TCL_OK; |
| 1892 | } else { |
| 1893 | *setPtrPtr = setPtr; |
| 1894 | } |
| 1895 | |
| 1896 | FD_ZERO(setPtr); |
| 1897 | status = TCL_OK; |
| 1898 | |
| 1899 | /* |
| 1900 | * Loop over each file, try to get its FD, and set the bit in |
| 1901 | * the fd_set. |
| 1902 | */ |
| 1903 | |
| 1904 | while (fargc--) { |
| 1905 | if (<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenFd">Ns_TclGetOpenFd</a>(interp, fargv[fargc], write, |
| 1906 | (int *) &socket) != TCL_OK) { |
| 1907 | status = TCL_ERROR; |
| 1908 | break; |
| 1909 | } |
| 1910 | if (socket > *maxPtr) { |
| 1911 | *maxPtr = socket; |
| 1912 | } |
| 1913 | FD_SET(socket, setPtr); |
| 1914 | } |
| 1915 | ckfree((char *) fargv); |
| 1916 | |
| 1917 | return status; |
| 1918 | } |
| 1919 | |
| 1920 | |
| 1921 | /* |
| 1922 | *---------------------------------------------------------------------- |
| 1923 | * |
| 1924 | * <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SSLSockCallbackProc">SSLSockCallbackProc</a> -- |
| 1925 | * |
| 1926 | * Callback that is registered from ns_sockcallback. |
| 1927 | * |
| 1928 | * Results: |
| 1929 | * NS_TRUE or NS_FALSE on error |
| 1930 | * |
| 1931 | * Side effects: |
| 1932 | * Will run Tcl script. |
| 1933 | * |
| 1934 | *---------------------------------------------------------------------- |
| 1935 | */ |
| 1936 | |
| 1937 | static int |
| 1938 | <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_SSLSockCallbackProc">SSLSockCallbackProc</a>(SOCKET sock, void *arg, int why) |
| 1939 | { |
| 1940 | SockCallback *cbPtr = arg; |
| 1941 | Tcl_Interp *interp = NULL; |
| 1942 | /* XXX not initialized */ |
| 1943 | Tcl_DString script; |
| 1944 | char *w = NULL; |
| 1945 | int status = TCL_ERROR; |
| 1946 | |
| 1947 | if (why != NS_SOCK_EXIT || (cbPtr->when & NS_SOCK_EXIT)) { |
| 1948 | interp = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a>(cbPtr->server); |
| 1949 | status = <a href="/cvs/aolserver/nsopenssl/tclcmds.c#A_EnterDup">EnterDup</a>(interp, sock); |
| 1950 | if (status == TCL_OK) { |
| 1951 | Tcl_DStringInit (&script); |
| 1952 | Tcl_DStringAppend (&script, cbPtr->script, -1); |
| 1953 | Tcl_DStringAppendElement (&script, interp->result); |
| 1954 | if (why == NS_SOCK_READ) { |
| 1955 | w = "r"; |
| 1956 | } else if (why == NS_SOCK_WRITE) { |
| 1957 | w = "w"; |
| 1958 | } else if (why == NS_SOCK_EXCEPTION) { |
| 1959 | w = "e"; |
| 1960 | } else { |
| 1961 | w = "x"; |
| 1962 | } |
| 1963 | Tcl_DStringAppendElement(&script, w); |
| 1964 | status = Tcl_EvalEx(interp, script.string, script.length, 0); |
| 1965 | Tcl_DStringFree(&script); |
| 1966 | } |
| 1967 | if (status != TCL_OK) { |
| 1968 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(interp); |
| 1969 | } else if (!STREQ(interp->result, "1")) { |
| 1970 | why = NS_SOCK_EXIT; |
| 1971 | } |
| 1972 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDeAllocateInterp">Ns_TclDeAllocateInterp</a>(interp); |
| 1973 | } |
| 1974 | if (why == NS_SOCK_EXIT) { |
| 1975 | ns_sockclose(sock); |
| 1976 | ns_free(cbPtr); |
| 1977 | return NS_FALSE; |
| 1978 | } |
| 1979 | |
| 1980 | return NS_TRUE; |
| 1981 | } |
Copyright © 2010 Geeknet, Inc. All rights reserved. Terms of Use