TclTLS
Check-in [b3f0973a4c]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA
Overview
Comment:Updated unimport channel so it restores channel config after unstack. Will now work on any stacked channel.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tls-1.8
Files: files | file ages | folders
SHA3-256: b3f0973a4ce8fd172e9676b8054a9d5a6aba7fce64521223aa2d3dbea671a369
User & Date: bohagan on 2024-05-19 17:16:07
Other Links: branch diff | manifest | tags
Context
2024-05-27
22:45
Make error message a const string check-in: c5a4009f73 user: bohagan tags: tls-1.8
2024-05-19
18:50
Merge in changes from master check-in: 911e1b65a9 user: bohagan tags: crypto
17:16
Updated unimport channel so it restores channel config after unstack. Will now work on any stacked channel. check-in: b3f0973a4c user: bohagan tags: tls-1.8
15:59
Fixed memory leak in unimport channel check-in: 262ec2d5d9 user: bohagan tags: tls-1.8
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified generic/tls.c from [94f84a44e7] to [cd25c54305].

︙︙
1675
1676
1677
1678
1679
1680
1681
1682


1683
1684
1685
1686
1687
1688
1689
1690
1691

1692
1693
1694
1695
1696
1697
1698

1699
1700

1701
1702
1703
1704
1705
1706
1707
















1708














1709
1710
1711
1712
1713
1714
1715

 * Side effects:
 *	May modify the behavior of an IO channel.
 *
 *-------------------------------------------------------------------
 */
static int
UnimportObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Channel chan;		/* The channel to set a mode on. */


    (void) clientData;

    dprintf("Called");

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return TCL_ERROR;
    }


    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* 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", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *) NULL);
	return TCL_ERROR;
    }

    /* Flush and pop channel from stack */
















    return Tcl_UnstackChannel(interp, chan);














}

/*
 *-------------------------------------------------------------------
 *
 * CTX_Init -- construct a SSL_CTX instance
 *








|
>
>









>







>

|
>

|




|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750

 * Side effects:
 *	May modify the behavior of an IO channel.
 *
 *-------------------------------------------------------------------
 */
static int
UnimportObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Channel chan, child;	/* The stacked and underlying channels */
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
    int res = TCL_OK;
    (void) clientData;

    dprintf("Called");

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return TCL_ERROR;
    }

    /* Validate channel name */
    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);
    child = Tcl_GetStackedChannel(chan);

    /* Verify is a stacked channel */
    if (child == NULL) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a stacked channel", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *) NULL);
	return TCL_ERROR;
    }

    /* Flush any pending data */
    if (Tcl_Flush(chan) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_DStringInit(&upperChannelTranslation);
    Tcl_DStringInit(&upperChannelBlocking);
    Tcl_DStringInit(&upperChannelEOFChar);
    Tcl_DStringInit(&upperChannelEncoding);

    /* Get current config - EOL translation, encoding and buffering options are shared between all channels in the stack */
    Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking);
    Tcl_GetChannelOption(interp, chan, "-encoding", &upperChannelEncoding);
    Tcl_GetChannelOption(interp, chan, "-eofchar", &upperChannelEOFChar);
    Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation);

    /* Unstack the channel and restore underlying channel config */
    if (Tcl_UnstackChannel(interp, chan) == TCL_OK) {
	Tcl_SetChannelOption(interp, child, "-encoding", Tcl_DStringValue(&upperChannelEncoding));
	Tcl_SetChannelOption(interp, child, "-eofchar", Tcl_DStringValue(&upperChannelEOFChar));
	Tcl_SetChannelOption(interp, child, "-translation", Tcl_DStringValue(&upperChannelTranslation));
	Tcl_SetChannelOption(interp, child, "-blocking", Tcl_DStringValue(&upperChannelBlocking));
    } else {
	res = TCL_ERROR;
    }

    /* Clean-up */
    Tcl_DStringFree(&upperChannelTranslation);
    Tcl_DStringFree(&upperChannelEncoding);
    Tcl_DStringFree(&upperChannelEOFChar);
    Tcl_DStringFree(&upperChannelBlocking);
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * CTX_Init -- construct a SSL_CTX instance
 *
︙︙
2905
2906
2907
2908
2909
2910
2911

2912
2913
2914
2915
2916
2917
2918

    }

    Tcl_CreateObjCommand(interp, "::tls::ciphers", CiphersObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::connection", ConnectionInfoObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::handshake", HandshakeObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::import", ImportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::unimport", UnimportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateObjCommand(interp, "::tls::status", StatusObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::version", VersionObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::misc", MiscObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::protocols", ProtocolsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

    BuildInfoCommand(interp);









>








2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954

    }

    Tcl_CreateObjCommand(interp, "::tls::ciphers", CiphersObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::connection", ConnectionInfoObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::handshake", HandshakeObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::import", ImportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::unimport", UnimportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::unstack", UnimportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::status", StatusObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::version", VersionObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::misc", MiscObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::protocols", ProtocolsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

    BuildInfoCommand(interp);
︙︙

Powered by Fossil · RSS