There are no available options for this view.
Parent Directory Parent Directory | Revision <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Log">Log</a> Revision <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Log">Log</a>
Revision 1.51 - (show annotations) (download) (as text)
Sun Jun 13 04:21:31 2004 UTC (7 years, 7 months ago) by scottg
Branch: MAIN
CVS Tags: v3_0beta26, v3_0beta27, v3_0beta24, v3_0beta25, v3_0beta22, v3_0beta23, v3_0beta21, HEAD
Changes since 1.50: +11 -11 lines
File MIME type: text/x-chdr 
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 }

SourceForge Help
ViewVC Help
Powered by ViewVC 1.1.6

Copyright © 2010 Geeknet, Inc. All rights reserved. Terms of Use