Diff

Differences From Artifact [03763b15bf]:

To Artifact [5957db2945]:


217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
217
218
219
220
221
222
223

224
225
226
227
228
229
230







-







 *	to error message.
 *
 * Side effects:
 *	Sets result to message digest for hash function or an error message.
 *
 *-------------------------------------------------------------------
 */

int Tls_DigestFinialize(Tcl_Interp *interp, DigestState *statePtr) {
    unsigned char md_buf[EVP_MAX_MD_SIZE];
    unsigned int md_len;
    int res = 0;

    /* Finalize hash function and calculate message digest */
    if (statePtr->format & TYPE_MD) {
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
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
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343

344
345
346
347
348
349
350
259
260
261
262
263
264
265









































































266
267
268

269
270
271
272
273
274
275
276







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+







}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestFile --
 *
 *	Return message digest for file using user specified hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Result is message digest or error message
 *
 *-------------------------------------------------------------------
 */
int Tls_DigestFile(Tcl_Interp *interp, Tcl_Obj *filename, const EVP_MD *md,
	const EVP_CIPHER *cipher, int format, Tcl_Obj *keyObj) {
    DigestState *statePtr;
    Tcl_Channel chan = NULL;
    unsigned char buf[BUFFER_SIZE];
    int res = TCL_OK, len;

    /* Open file channel */
    chan = Tcl_FSOpenFileChannel(interp, filename, "rb", 0444);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Configure channel */
    if ((res = Tcl_SetChannelOption(interp, chan, "-translation", "binary")) == TCL_ERROR) {
	goto done;
    }
    Tcl_SetChannelBufferSize(chan, BUFFER_SIZE);

    /* Create state data struct */
    if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	res = TCL_ERROR;
	goto done;
    }

    /* Initialize hash function */
    if ((res = Tls_DigestInit(interp, statePtr, md, cipher, keyObj)) != TCL_OK) {
	goto done;
    }

    /* Read file data and update hash function */
    while (!Tcl_Eof(chan)) {
	len = Tcl_ReadRaw(chan, (char *) buf, BUFFER_SIZE);
	if (len > 0) {
	    if (!Tls_DigestUpdate(statePtr, &buf[0], (size_t) len, 1)) {
		res = TCL_ERROR;
		goto done;
	    }
	}
    }

    /* Finalize hash function and calculate message digest */
    res = Tls_DigestFinialize(interp, statePtr);

done:
    /* Close channel */
    if (Tcl_Close(interp, chan) == TCL_ERROR) {
	res = TCL_ERROR;
    }

    /* Clean-up */
    Tls_DigestFree(statePtr);
    return res;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * DigestBlockModeProc --
 *
 *	This function is invoked by the generic IO level
 *       to set blocking and nonblocking modes.
 *	to set blocking and nonblocking modes.
 *
 * Returns:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *	Can call Tcl_SetChannelError.
443
444
445
446
447
448
449
450

451
452
453
454
455
456
457
369
370
371
372
373
374
375

376
377
378
379
380
381
382
383







-
+







	    Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", REASON()));
	    *errorCodePtr = EINVAL;
	    return -1;
	}
	/* This is correct */
	read = -1;
	*errorCodePtr = EAGAIN;
	    

    } else if (read < 0) {
	/* Error */
	*errorCodePtr = Tcl_GetErrno();

    } else if (!(statePtr->flags & CHAN_EOF)) {
	/* EOF */
	unsigned char md_buf[EVP_MAX_MD_SIZE];
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
1065
1066
951
952
953
954
955
956
957

958
959
960
961
962
963
964
965
966
967
968


969
970
971
972
973
974
975
976

977
978
979
980
981
982
983
984

985
986
987
988
989
990
991
992







-
+










-
-
+
+






-
+







-
+







 *
 *-------------------------------------------------------------------
 */
int
Tls_DigestData(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
	const EVP_MD *md, const EVP_CIPHER *cipher, int format, Tcl_Obj *keyObj) {
    char *data;
    int len, res;
    int data_len, res;
    unsigned int md_len;
    unsigned char md_buf[EVP_MAX_MD_SIZE];

    /* Validate arg count */
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "data");
	return TCL_ERROR;
    }

    /* Get data */
    data = Tcl_GetByteArrayFromObj(objv[1], &len);
    if (data == NULL || len == 0) {
    data = Tcl_GetByteArrayFromObj(objv[1], &data_len);
    if (data == NULL || data_len == 0) {
	Tcl_SetResult(interp, "No data", NULL);
	return TCL_ERROR;
    }

    /* Calculate digest based on hash function */
    if (format & TYPE_MD) {
	res = EVP_Digest(data, (size_t) len, md_buf, &md_len, md, NULL);
	res = EVP_Digest(data, (size_t) data_len, md_buf, &md_len, md, NULL);

    } else if (format & TYPE_HMAC) {
	unsigned char *key, *hmac = NULL;
	int key_len;

	key = Tcl_GetByteArrayFromObj(keyObj, &key_len);
	hmac = HMAC(md, (const void *) key, key_len, (const unsigned char *) data,
	    (size_t) len, md_buf, &md_len);
	    (size_t) data_len, md_buf, &md_len);
	res = (hmac != NULL);

    } else if (format & TYPE_CMAC) {
	DigestState *statePtr;

	if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
	    Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
1085
1086
1087
1088
1089
1090
1091
1092

1093
1094
1095
1096
1097
1098
1099
1100
1101








































































1102
1103
1104
1105
1106
1107
1108
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
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106







-
+









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    Tcl_Obj *resultObj = Tcl_NewObj();
	    unsigned char *ptr = Tcl_SetByteArrayLength(resultObj, md_len*2);

	    for (unsigned int i = 0; i < md_len; i++) {
		*ptr++ = hex[(md_buf[i] >> 4) & 0x0F];
		*ptr++ = hex[md_buf[i] & 0x0F];
	    }
	Tcl_SetObjResult(interp, resultObj);
	    Tcl_SetObjResult(interp, resultObj);
	}

    } else {
	Tcl_AppendResult(interp, "Hash calculation error:", REASON(), (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestFile --
 *
 *	Return message digest for file using user specified hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Result is message digest or error message
 *
 *-------------------------------------------------------------------
 */
int Tls_DigestFile(Tcl_Interp *interp, Tcl_Obj *filename, const EVP_MD *md,
	const EVP_CIPHER *cipher, int format, Tcl_Obj *keyObj) {
    DigestState *statePtr;
    Tcl_Channel chan = NULL;
    unsigned char buf[BUFFER_SIZE];
    int res = TCL_OK, len;

    /* Open file channel */
    chan = Tcl_FSOpenFileChannel(interp, filename, "rb", 0444);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Configure channel */
    if ((res = Tcl_SetChannelOption(interp, chan, "-translation", "binary")) == TCL_ERROR) {
	goto done;
    }
    Tcl_SetChannelBufferSize(chan, BUFFER_SIZE);

    /* Create state data struct */
    if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	res = TCL_ERROR;
	goto done;
    }

    /* Initialize hash function */
    if ((res = Tls_DigestInit(interp, statePtr, md, cipher, keyObj)) != TCL_OK) {
	goto done;
    }

    /* Read file data and update hash function */
    while (!Tcl_Eof(chan)) {
	len = Tcl_ReadRaw(chan, (char *) buf, BUFFER_SIZE);
	if (len > 0) {
	    if (!Tls_DigestUpdate(statePtr, &buf[0], (size_t) len, 1)) {
		res = TCL_ERROR;
		goto done;
	    }
	}
    }

    /* Finalize hash function and calculate message digest */
    res = Tls_DigestFinialize(interp, statePtr);

done:
    /* Close channel */
    if (Tcl_Close(interp, chan) == TCL_ERROR) {
	res = TCL_ERROR;
    }

    /* Clean-up */
    Tls_DigestFree(statePtr);
    return res;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * DigestObjCmd --
1118
1119
1120
1121
1122
1123
1124
1125

1126
1127
1128
1129
1130
1131
1132
1133


1134
1135
1136
1137
1138
1139
1140
1141
1142









1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165

1166
1167
1168
1169
1170

1171
1172
1173
1174
1175
1176
1177
1116
1117
1118
1119
1120
1121
1122

1123
1124
1125
1126
1127
1128
1129


1130
1131
1132
1133
1134






1135
1136
1137
1138
1139
1140
1141
1142
1143




1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167

1168
1169
1170
1171
1172
1173
1174
1175







-
+






-
-
+
+



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



















+




-
+







 *-------------------------------------------------------------------
 */
static int DigestMain(int type, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    int idx, len, format = HEX_FORMAT, res = TCL_OK, flags = 0;
    const char *digestName, *channel = NULL;
    Tcl_Obj *cmdObj = NULL, *dataObj = NULL, *fileObj = NULL, *keyObj = NULL;
    unsigned char *cipherName = NULL;
    const EVP_MD *md;
    const EVP_MD *md = NULL;
    const EVP_CIPHER *cipher = NULL;

    /* Clear interp result */
    Tcl_ResetResult(interp);

    /* Validate arg count */
    if (objc < 3 || objc > 9) {
	Tcl_WrongNumArgs(interp, 1, objv, "digest ?-bin|-hex? ?-cipher name? ?-key hmac_key? [-channel chan | -command cmdName | -file filename | ?-data? data]");
    if (objc < 3 || objc > 12) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? [-channel chan | -command cmdName | -file filename | ?-data? data]");
	return TCL_ERROR;
    }

    /* Get digest */
    digestName = Tcl_GetStringFromObj(objv[1], &len);
    if (digestName == NULL || (md = EVP_get_digestbyname(digestName)) == NULL) {
	Tcl_AppendResult(interp, "Invalid digest \"", digestName, "\"", NULL);
	return TCL_ERROR;
    }
    /* Optimal case for a digest and blob of data */
    if (objc == 3 && type == TYPE_MD) {
	digestName = Tcl_GetStringFromObj(objv[1],NULL);
	if ((md = EVP_get_digestbyname(digestName)) != NULL) {
	    return Tls_DigestData(interp, --objc, ++objv, md, NULL, HEX_FORMAT | TYPE_MD, NULL);
	} else {
	    Tcl_AppendResult(interp, "Invalid digest \"", digestName, "\"", NULL);
	    return TCL_ERROR;
	}

    /* Optimal case for blob of data */
    if (objc == 3 && type == TYPE_MD) {
	return Tls_DigestData(interp, --objc, ++objv, md, NULL, HEX_FORMAT | TYPE_MD, NULL);
    }

    /* Get options */
    for (idx = 2; idx < objc-1; idx++) {
	char *opt = Tcl_GetStringFromObj(objv[idx], NULL);

	if (opt[0] != '-') {
	    break;
	}

	OPTFLAG("-bin", format, BIN_FORMAT);
	OPTFLAG("-binary", format, BIN_FORMAT);
	OPTFLAG("-hex", format, HEX_FORMAT);
	OPTFLAG("-hexadecimal", format, HEX_FORMAT);
	OPTSTR("-chan", channel);
	OPTSTR("-channel", channel);
	OPTSTR("-cipher", cipherName);
	OPTOBJ("-command", cmdObj);
	OPTOBJ("-data", dataObj);
	OPTSTR("-digest", digestName);
	OPTOBJ("-file", fileObj);
	OPTOBJ("-filename", fileObj);
	OPTOBJ("-key", keyObj);

	OPTBAD("option", "-bin, -channel, -cipher, -command, -data, -file, -filename, -hex, or -key");
	OPTBAD("option", "-bin, -channel, -cipher, -command, -data, -digest, -file, -filename, -hex, or -key");
	return TCL_ERROR;
    }

    /* If no option for last arg, then its the data */
    if (idx < objc) {
	dataObj = objv[idx];
    }
1185
1186
1187
1188
1189
1190
1191












1192
1193
1194
1195
1196
1197
1198
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208







+
+
+
+
+
+
+
+
+
+
+
+







	    return TCL_ERROR;
	}

    } else if (type == TYPE_CMAC) {
	Tcl_AppendResult(interp, "No cipher specified", NULL);
	return TCL_ERROR;
    }

    /* Get digest */
    if (digestName != NULL) {
	md = EVP_get_digestbyname(digestName);
	if (md == NULL) {
	    Tcl_AppendResult(interp, "Invalid digest \"", digestName, "\"", NULL);
	    return TCL_ERROR;
	}
    } else if (type == TYPE_MD || type == TYPE_HMAC) {
	Tcl_AppendResult(interp, "No digest specified", NULL);
	return TCL_ERROR;
    }

    /* Get key */
    if (keyObj != NULL) {
	if (type == TYPE_MD) {
	    type = TYPE_HMAC;
	}
    } else if (type != TYPE_MD) {