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) 2004 Starfish Systems
*
* $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.29 2008/03/19 21:31:24 hobbs2 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
*
|
|
|
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) 2004 Starfish Systems
*
* $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.30 2008/03/19 22:06:13 hobbs2 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
*
|
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int VersionObjCmd _ANSI_ARGS_ ((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int MiscObjCmd _ANSI_ARGS_ ((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static SSL_CTX *CTX_Init _ANSI_ARGS_((State *statePtr, int proto, char *key,
char *cert, char *CAdir, char *CAfile, char *ciphers));
#define TLS_PROTO_SSL2 0x01
#define TLS_PROTO_SSL3 0x02
#define TLS_PROTO_TLS1 0x04
|
>
>
>
|
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int VersionObjCmd _ANSI_ARGS_ ((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int MiscObjCmd _ANSI_ARGS_ ((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int UnimportObjCmd _ANSI_ARGS_ ((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static SSL_CTX *CTX_Init _ANSI_ARGS_((State *statePtr, int proto, char *key,
char *cert, char *CAdir, char *CAfile, char *ciphers));
#define TLS_PROTO_SSL2 0x01
#define TLS_PROTO_SSL3 0x02
#define TLS_PROTO_TLS1 0x04
|
873
874
875
876
877
878
879
880
881
882
883
884
885
886
|
TCL_VOLATILE);
return TCL_OK;
}
/*
*-------------------------------------------------------------------
*
* CTX_Init -- construct a SSL_CTX instance
*
* Results:
* A valid SSL_CTX instance or NULL.
*
* Side effects:
* constructs SSL context (CTX)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
|
TCL_VOLATILE);
return TCL_OK;
}
/*
*-------------------------------------------------------------------
*
* UnimportObjCmd --
*
* This procedure is invoked to remove the topmost channel filter.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* May modify the behavior of an IO channel.
*
*-------------------------------------------------------------------
*/
static int
UnimportObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan; /* The channel to set a mode on. */
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;
}
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;
}
if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) {
return TCL_ERROR;
}
return TCL_OK;
}
/*
*-------------------------------------------------------------------
*
* CTX_Init -- construct a SSL_CTX instance
*
* Results:
* A valid SSL_CTX instance or NULL.
*
* Side effects:
* constructs SSL context (CTX)
|
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
|
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
|
>
>
>
|
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
|
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
|