1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
-
+
-
+
|
/*
* Copyright (C) 1997-1999 Matt Newman <[email protected]>
* some modifications:
* Copyright (C) 2000 Ajuba Solutions
* Copyright (C) 2002 ActiveState Corporation
* Copyright (C) 2003 Starfish Systems
* Copyright (C) 2004 Starfish Systems
*
* $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.19 2004/02/04 04:02:19 razzell Exp $
* $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.20 2004/02/13 02:09:21 razzell Exp $
*
* TLS (aka SSL) Channel - can be layered on any bi-directional
* Tcl_Channel (Note: Requires Trf Core Patch)
*
* This was built (almost) from scratch based upon observation of
* OpenSSL 0.9.2B
*
|
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
|
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
|
-
+
-
+
-
+
+
+
+
-
-
+
+
+
|
}
/*
*-------------------------------------------------------------------
*
* VerifyCallback --
*
* monitors SSL cerificate validation process
* Monitors SSL certificate validation process.
* This is called whenever a certificate is inspected
* or decided invalid
* or decided invalid.
*
* Results:
* ok - let SSL handle it
* A callback bound to the socket may return one of:
* 0 - the certificate is deemed invalid
* 1 - the certificate is deemed valid
* empty string - no change to certificate validation
*
* Side effects:
* The err field of the currently operative State is set
* to a string describing the SSL negotiation failure reason
*-------------------------------------------------------------------
*/
static int
VerifyCallback(int ok, X509_STORE_CTX *ctx)
{
Tcl_Obj *cmdPtr;
char *errStr;
Tcl_Obj *cmdPtr, *result;
char *errStr, *string;
int length;
SSL *ssl = (SSL*)X509_STORE_CTX_get_app_data(ctx);
X509 *cert = X509_STORE_CTX_get_current_cert(ctx);
State *statePtr = (State*)SSL_get_app_data(ssl);
int depth = X509_STORE_CTX_get_error_depth(ctx);
int err = X509_STORE_CTX_get_error(ctx);
dprintf(stderr, "Verify: %d\n", ok);
|
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
|
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
|
-
+
+
+
+
+
-
+
-
-
-
+
+
+
-
+
-
-
-
|
Tcl_NewStringObj( errStr ? errStr : "", -1) );
Tcl_Preserve( (ClientData) statePtr->interp);
Tcl_Preserve( (ClientData) statePtr);
Tcl_IncrRefCount( cmdPtr);
if (Tcl_GlobalEvalObj(statePtr->interp, cmdPtr) != TCL_OK) {
/* it got an error - reject the certificate */
/* It got an error - reject the certificate. */
Tcl_BackgroundError( statePtr->interp);
ok = 0;
} else {
result = Tcl_GetObjResult(statePtr->interp);
string = Tcl_GetStringFromObj(result, &length);
/* An empty result leaves verification unchanged. */
if (length > 0) {
if (Tcl_GetIntFromObj( statePtr->interp,
if (Tcl_GetIntFromObj(statePtr->interp, result, &ok) != TCL_OK) {
Tcl_GetObjResult( statePtr->interp), &ok) != TCL_OK) {
Tcl_BackgroundError( statePtr->interp);
ok = 0;
Tcl_BackgroundError(statePtr->interp);
ok = 0;
}
}
}
Tcl_DecrRefCount( cmdPtr);
Tcl_Release( (ClientData) statePtr);
Tcl_Release( (ClientData) statePtr->interp);
return(ok); /* leave the disposition as SSL set it */
return(ok); /* By default, leave verification unchanged. */
}
/*
*-------------------------------------------------------------------
*
* Tls_Error --
*
* Calls callback with $fd and $msg - so the callback can decide
* what to do with errors.
*
* Results:
* ok - let SSL handle it
*
* Side effects:
* The err field of the currently operative State is set
* to a string describing the SSL negotiation failure reason
*-------------------------------------------------------------------
*/
void
Tls_Error(State *statePtr, char *msg)
|