TclTLS
Diff
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Annotate Patch Side-by-side Diff

Differences From Artifact [7a7ec2f3d3]:

To Artifact [1f1f2854e3]:

1
2

3


4
5

6
7
8
9
10
11
12

1
2
3

4
5
6

7
8
9
10
11
12
13
14



+
-
+
+

-
+








/*
 * Copyright (C) 1997-1999 Matt Newman <matt@novadigm.com>
 * some modifications:
 * Copyright (C) 2000 Ajuba Solutions
 *	Copyright (C) 2000 Ajuba Solutions
 *	Copyright (C) 2002 ActiveState Corporation
 *
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.13 2001/03/14 22:04:35 hobbs Exp $
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.14 2002/02/04 22:46:31 hobbs 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
 *
︙
376
377
378
379
380
381
382
383

384
385
386
387
388
389
390

378
379
380
381
382
383
384

385
386
387
388
389
390
391
392








-
+








#else
static int
PasswordCallback(char *buf, int size, int verify, void *udata)
{
    Tcl_Interp *interp = (Tcl_Interp*)udata;

    if (Tcl_Eval(interp, "tls::password") == TCL_OK) {
	char *ret = Tcl_GetStringResult(interp);
	CONST char *ret = Tcl_GetStringResult(interp);
        strncpy(buf, ret, size);
	return strlen(ret);
    } else {
	return -1;
    }
}
#endif
︙
408
409
410
411
412
413
414
415
416


417
418
419
420
421
422

423
424
425
426
427
428
429
430
431
432

410
411
412
413
414
415
416


417
418



419
420

421



422
423
424
425
426
427
428








-
-
+
+
-
-
-


-
+
-
-
-








static int
CiphersObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj	*CONST objv[];
{
    static char *protocols[] = {
	"ssl2",
    static CONST char *protocols[] = {
	"ssl2",	"ssl3",	"tls1",	NULL
	"ssl3",
	"tls1",
	NULL
    };
    enum protocol {
	TLS_SSL2,
	TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_NONE
	TLS_SSL3,
	TLS_TLS1,
	TLS_NONE
    };
    Tcl_Obj *objPtr;
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk;
    char *cp, buf[BUFSIZ];
    int index, verbose = 0;
︙
561
562
563
564
565
566
567
568

569
570
571
572
573
574
575

557
558
559
560
561
562
563

564
565
566
567
568
569
570
571








-
+








    }
    statePtr = (State *)Tcl_GetChannelInstanceData(chan);

    if (!SSL_is_init_finished(statePtr->ssl)) {
	int err;
	ret = Tls_WaitForConnect(statePtr, &err);
	if (ret < 0) {
	    char *errStr = statePtr->err;
	    CONST char *errStr = statePtr->err;
	    Tcl_ResetResult(interp);
	    Tcl_SetErrno(err);

	    if (!errStr || *errStr == 0) {
	        errStr = Tcl_PosixError(interp);
	    }
︙
822
823
824
825
826
827
828
829


830
831
832
833
834
835
836

818
819
820
821
822
823
824

825
826
827
828
829
830
831
832
833








-
+
+








    }
    SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio);
    BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_CLOSE);

    /*
     * End of SSL Init
     */
    Tcl_SetResult(interp, Tcl_GetChannelName(statePtr->self), TCL_VOLATILE);
    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self),
	    TCL_VOLATILE);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * CTX_Init -- construct a SSL_CTX instance
︙
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018














1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037

1038



1039
1040
1041
1042
1043




1044
1045
1046
1047
1048
1049
1050

1006
1007
1008
1009
1010
1011
1012



1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027

1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045

1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064








-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-

















+
-
+
+
+





+
+
+
+








    State *statePtr;
    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    char *channelName, *ciphers;
    int mode;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "channel");
        return TCL_ERROR;
    switch (objc) {
	case 2:
	    channelName = Tcl_GetStringFromObj(objv[1], NULL);
	    break;

	case 3:
	    if (!strcmp (Tcl_GetString (objv[1]), "-local")) {
		channelName = Tcl_GetStringFromObj(objv[2], NULL);
		break;
	    }
	    /* else fall... */
	default:
	    Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
	    return TCL_ERROR;
    }
    channelName = Tcl_GetStringFromObj(objv[1], NULL);

    chan = Tcl_GetChannel(interp, channelName, &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);
    }
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
        Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
                "\": not a TLS channel", NULL);
        return TCL_ERROR;
    }
    statePtr	= (State *) Tcl_GetChannelInstanceData(chan);
    if (objc == 2)
    peer	= SSL_get_peer_certificate(statePtr->ssl);
	peer	= SSL_get_peer_certificate(statePtr->ssl);
    else
	peer	= SSL_get_certificate(statePtr->ssl);
    if (peer) {
	objPtr = Tls_NewX509Obj(interp, peer);
    } else {
	objPtr = Tcl_NewListObj(0, NULL);
    }

    Tcl_ListObjAppendElement (interp, objPtr, Tcl_NewStringObj ("sbits", -1));
    Tcl_ListObjAppendElement (interp, objPtr,
	    Tcl_NewIntObj (SSL_get_cipher_bits (statePtr->ssl, NULL)));

    ciphers = (char*)SSL_get_cipher(statePtr->ssl);
    if (ciphers != NULL && strcmp(ciphers, "(NONE)")!=0) {
	Tcl_ListObjAppendElement(interp, objPtr,
		Tcl_NewStringObj("cipher", -1));
	Tcl_ListObjAppendElement(interp, objPtr,
		Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1));
︙
Powered by Fossil · RSS