Tcl Source Code

2012-11-20  Donal K. Fellows  <[email protected]>

	* generic/tclBinary.c (BinaryDecode64): [Bug 3033307]: Corrected
	handling of trailing whitespace when decoding base64. Thanks to Anton
	Kovalenko for reporting, and Andy Goth for the fix and tests.

2012-11-19  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (INST_STR_RANGE_IMM): [Bug 3588366]: Corrected
	implementation of bounds restriction for end-indexed compiled [string
	range]. Thanks to Emiliano Gavilan for diagnosis and fix.

2012-11-15  Jan Nijtmans  <[email protected]>

BinaryDecode64(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend, c = '\0';
    unsigned char *begin = NULL;
    unsigned char *cursor = NULL;
    int strict = 0;
    int i, index, size, cut = 0, count = 0;
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; ++i) {

	    TclGetStringFromObj(objv[objc-1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	unsigned long value = 0;

	/*
	 * Decode the current block. Each base64 block consists of four input
	 * characters A-Z, a-z, 0-9, +, or /. Each character supplies six bits
	 * of output data, so each block's output is 24 bits (three bytes) in
	 * length. The final block can be shorter by one or two bytes, denoted
	 * by the input ending with one or two ='s, respectively.
	 */

	for (i = 0; i < 4; i++) {
	    /*
	     * Get the next input character. At end of input, pad with at most
	     * two ='s. If more than two ='s would be needed, instead discard
	     * the block read thus far.
	     */

	    if (data < dataend) {
		c = *data++;
	    } else if (i > 1) {
		c = '=';
	    } else {
		cut += 3;
		break;
	    }

	    /*
	     * Load the character into the block value. Handle ='s specially
	     * because they're only valid as the last character or two of the
	     * final block of input. Unless strict mode is enabled, skip any
	     * input whitespace characters.
	     */

	    if (cut) {
		if (c == '=' && i > 1) {
		     value <<= 6;
		     cut++;
		} else if (!strict && isspace(c)) {
		     i--;
		} else {
		    goto bad64;
		}
	    } else if (c >= 'A' && c <= 'Z') {
		value = (value << 6) | ((c - 'A') & 0x3f);
	    } else if (c >= 'a' && c <= 'z') {
		value = (value << 6) | ((c - 'a' + 26) & 0x3f);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3f);
	    } else if (c == '+') {
		value = (value << 6) | 0x3e;
	    } else if (c == '/') {
		value = (value << 6) | 0x3f;
	    } else if (c == '=') {
		value <<= 6;

		cut++;


	    } else if (strict || !isspace(c)) {
		goto bad64;
	    } else {
		i--;





	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xff);
	*cursor++ = UCHAR((value >> 8) & 0xff);
	*cursor++ = UCHAR(value & 0xff);

	/*
	 * Since = is only valid within the final block, if it was encountered
	 * but there are still more input characters, confirm that strict mode
	 * is off and all subsequent characters are whitespace.
	 */

	if (cut && data < dataend) {
	    if (strict) {
		goto bad64;
	    }
	    for (; data < dataend; data++) {
		if (!isspace(*data)) {
		    goto bad64;
		}
	    }
	}
    }
    Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

  bad64:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(

test binary-73.23 {binary decode base64} -body {
    set r [binary decode base64 YWJj]
    list [string length $r] $r
} -result {3 abc}
test binary-73.24 {binary decode base64} -body {
    string length [binary decode base64 " "]
} -result 0
test binary-73.25 {binary decode base64} -body {
    list [string length [set r [binary decode base64 WA==\n]]] $r
} -result {1 X}
test binary-73.26 {binary decode base64} -body {
    list [string length [set r [binary decode base64 WFk=\n]]] $r
} -result {2 XY}
test binary-73.27 {binary decode base64} -body {
    list [string length [set r [binary decode base64 WFla\n]]] $r
} -result {3 XYZ}
test binary-73.28 {binary decode base64} -body {
    list [string length [set r [binary decode base64 -strict WA==\n]]] $r
} -returnCodes error -match glob -result {invalid base64 character *}
test binary-73.29 {binary decode base64} -body {
    list [string length [set r [binary decode base64 -strict WFk=\n]]] $r
} -returnCodes error -match glob -result {invalid base64 character *}
test binary-73.30 {binary decode base64} -body {
    list [string length [set r [binary decode base64 -strict WFla\n]]] $r
} -returnCodes error -match glob -result {invalid base64 character *}
test binary-73.31 {binary decode base64} -body {
    list [string length [set r [binary decode base64 WA==WFla]]] $r
} -returnCodes error -match glob -result {invalid base64 character *}

test binary-74.1 {binary encode uuencode} -body {
    binary encode uuencode
} -returnCodes error -match glob -result "wrong # args: *"
test binary-74.2 {binary encode uuencode} -body {
    binary encode uuencode abc
} -result {86)C}