Hi,
I've finished cleanup my patch.
I believe web::putx and web::htmlify probrem are solved.
Now, They can deal not only single byte string, but also
multi byte string.
Sorry, I still have confuse about parseUrlEncodedFormData().
Is this 'Tcl_Channel channel' used as output channel?
'output' means web::putx or web::put write to this channel.
If yes, its encoding option should be backuped.
Because,
Tcl_SetChannelOption(interp, channel, "-translation", "binary");
also sets its encoding option as its side-effects.
If no, please forget this parts.
All data from apache is ascii encoding. But output from mod_websh
to apache might be other encoding includes mutibyte one.
I'd forgot this, Sorry.
Additionaly, This patch is still darty. Actuary, I'm not good at C
language. I hate pointer. So I love Tcl ;-)
Thanks,
Taguchi,T.
---
diff -ur tcl-websh.orig/src/generic/htmlify.c tcl-websh/src/generic/htmlify.c
--- tcl-websh.orig/src/generic/htmlify.c Mon Aug 29 13:24:13 2005
+++ tcl-websh/src/generic/htmlify.c Fri Sep 2 22:15:27 2005
@@ -71,13 +71,17 @@
if (unic == 0)
break;
+ /*
+ This code delete multibyte string!!
if (unic > WEBENC_LATIN_TABLE_LENGTH)
continue;
+ */
/* --------------------------------------------------------------------
* translation needed ?
* ----------------------------------------------------------------- */
- if (convData->need[unic] == TCL_OK) {
+ if (unic <= WEBENC_LATIN_TABLE_LENGTH &&
+ convData->need[unic] == TCL_OK) {
/* yes */
diff -ur tcl-websh.orig/src/generic/weboutint.c
tcl-websh/src/generic/weboutint.c
--- tcl-websh.orig/src/generic/weboutint.c Wed Aug 31 14:53:36 2005
+++ tcl-websh/src/generic/weboutint.c Fri Sep 2 22:02:48 2005
@@ -368,174 +368,121 @@
return TCL_OK;
}
-/* --------------------------------------------------------------------------
- * quote_append (quote Tcl syntax characters and append to Tcl_DString)
- * ----------------------------------------------------------------------- */
-
-int quote_append(Tcl_DString *str, char *in, int len)
-{
- int i = 0;
- while (i < len) {
- switch (*in)
- {
- case '{':
- Tcl_DStringAppend(str, "\\{", -1);
- break;
- case '}':
- Tcl_DStringAppend(str, "\\}", -1);
- break;
- case '$':
- Tcl_DStringAppend(str, "\\$", -1);
- break;
- case '[':
- Tcl_DStringAppend(str, "\\[", -1);
- break;
- case ']':
- Tcl_DStringAppend(str, "\\]", -1);
- break;
- case '"':
- Tcl_DStringAppend(str, "\\\"", -1);
- break;
-/* case '\\':
- Tcl_DStringAppend(str, "\\\\", -1);
- break; */
- default:
- Tcl_DStringAppend(str, in, 1);
- break;
- }
- in ++;
- i ++;
- }
- return 0;
-}
-
-
/* ----------------------------------------------------------------------------
* webout_eval_tag (code in <? ?>)
* ------------------------------------------------------------------------- */
int webout_eval_tag(Tcl_Interp * interp, ResponseObj * responseObj,
Tcl_Obj * in, const char *strstart, const char *strend)
{
- Tcl_DString dstr;
- Tcl_Obj *tclo = NULL;
-
- int inLen;
- char *cur = NULL;
- char *prev = NULL;
- int cntOpen = 0;
- int res = 0;
- int startmatch = 0;
- int endmatch = 0;
-
- int begin = 1;
- char *start;
-
-/* const char *strstart = START_TAG;
- const char *strend = END_TAG; */
-/* int endseqlen = strlen(END_TAG);
- int startseqlen = strlen(START_TAG);
- */
- int endseqlen = strlen(strstart);
- int startseqlen = strlen(strend);
-
- if ((responseObj == NULL) || (in == NULL))
- return TCL_ERROR;
-
- Tcl_DStringInit(&dstr);
-
- cur = Tcl_GetStringFromObj(in, &inLen);
- prev = cur;
- start = cur;
+ Tcl_Obj *outbuf;
+ Tcl_Obj *tclo;
+ char *next;
+ char *cur;
+
+ int endseqlen = strlen(strend);
+ int startseqlen = strlen(strstart);
+ int begin = 1;
+ int firstScan = 1;
+ int inside = 0, p = 0;
+ int inLen = 0;
+ int res = 0;
- if (inLen == 0)
- return TCL_OK;
+ next = Tcl_GetStringFromObj(in, &inLen);
+ outbuf = Tcl_NewStringObj("", -1);
- printf("DEBUG: cur = %s\n", cur);
+ if (inLen == 0)
+ return 0;
- while (*cur != 0) {
- if (*cur == strstart[startmatch])
- {
- if (*prev == '\\') {
- Tcl_DStringAppend(&dstr, cur, 1);
- } else if ((++startmatch) == startseqlen) {
- /* We have matched the starting sequence. */
- if (cntOpen < 1) {
- if (!((cur - (startseqlen - 1)) - start)) {
- begin = 0;
- } else {
- Tcl_DStringAppend(&dstr, "\"\n", 2);
- }
- } else {
- Tcl_DStringAppend(&dstr, strstart, -1);
- }
- cntOpen ++;
- startmatch = 0;
- }
- prev = cur;
- cur ++;
- continue;
- } else if (*cur == strend[endmatch] && (cntOpen > 0 || *prev == '\\')) {
- if (*prev == '\\') {
- Tcl_DStringAppend(&dstr, cur, 1);
- } else if ((++endmatch) == endseqlen)
- {
- /* We have matched the ending sequence. */
- if (cntOpen == 1) {
- /* build up the command with the name of the channel. */
- Tcl_DStringAppend(&dstr, "\n web::put \"", -1);
- } else {
- Tcl_DStringAppend(&dstr, strend, -1);
- }
- cntOpen --;
- endmatch = 0;
- }
- prev = cur;
- cur ++;
- continue;
- } else if (startmatch) {
- if (cntOpen < 1) {
- quote_append(&dstr, (char *)strstart, startmatch);
- } else {
- Tcl_DStringAppend(&dstr, (char *)strstart, startmatch);
- }
- startmatch = 0;
- } else if (endmatch) {
- if (cntOpen < 1) {
- quote_append(&dstr, (char *)strend, endmatch);
- } else {
- Tcl_DStringAppend(&dstr, (char *)strend, endmatch);
- }
- endmatch = 0;
- }
- /* Put the current character in the output. If we are in Tcl
- code, then don't escape Tcl characters. */
- if (cntOpen < 1) {
- quote_append(&dstr, cur, 1);
+ while (*next != 0) {
+ cur = next;
+ next = (char *)Tcl_UtfNext(cur);
+
+ if (strncmp("\\", cur, 1) == 0) {
+ if (firstScan == 1) { firstScan = 0; }
+ if (strncmp(strstart, next, startseqlen) == 0) {
+ Tcl_AppendToObj(outbuf, "\\", 1);
+ Tcl_AppendToObj(outbuf, strstart, startseqlen);
+ next += startseqlen;
+ } else if (strncmp(strend, next, endseqlen) == 0) {
+ Tcl_AppendToObj(outbuf, "\\", 1);
+ Tcl_AppendToObj(outbuf, strend, endseqlen);
+ next += endseqlen;
+ } else if (inside < 1) {
+ Tcl_AppendToObj(outbuf, "\\\\", 2);
+ } else {
+ Tcl_AppendToObj(outbuf, "\\", 1);
+ }
+ } else if (strncmp(strstart, cur, startseqlen) == 0) {
+ if ((++inside) == 1) {
+ if (firstScan == 1) {
+ begin = 0;
+ firstScan = 0;
+ Tcl_AppendToObj(outbuf, "\n", 1);
} else {
- Tcl_DStringAppend(&dstr, cur, 1);
+ Tcl_AppendToObj(outbuf, "\"\n", 2);
}
- prev = cur;
- cur ++;
- }
-
- /* build up the web::put with the name of the channel. */
- if (begin) {
- tclo = Tcl_NewStringObj("web::put \"", -1);
+ if (startseqlen > 1) {
+ next += startseqlen - 1;
+ }
+ } else {
+ Tcl_AppendToObj(outbuf, cur, startseqlen);
+ if (startseqlen > 1) {
+ next += startseqlen - 1;
+ }
+ }
+ } else if (strncmp(strend, cur, endseqlen) == 0) {
+ if (firstScan == 1) { firstScan = 0; }
+ if ((--inside) == 0) {
+ Tcl_AppendToObj(outbuf, "\nweb::put \"", -1);
+ if (endseqlen > 1) {
+ next += endseqlen - 1;
+ }
+ } else {
+ Tcl_AppendToObj(outbuf, cur, endseqlen);
+ if (endseqlen > 1) {
+ next += endseqlen - 1;
+ }
+ }
+ if (inside < 0) { inside = 0; }
+ } else if (inside < 1) {
+ if (firstScan == 1) { firstScan = 0; }
+ switch (*cur) {
+ case '{':
+ Tcl_AppendToObj(outbuf, "\\{", -1);
+ break;
+ case '}':
+ Tcl_AppendToObj(outbuf, "\\}", -1);
+ break;
+ case '$':
+ Tcl_AppendToObj(outbuf, "\\$", -1);
+ break;
+ case '[':
+ Tcl_AppendToObj(outbuf, "\\[", -1);
+ break;
+ case ']':
+ Tcl_AppendToObj(outbuf, "\\]", -1);
+ break;
+ case '"':
+ Tcl_AppendToObj(outbuf, "\\\"", -1);
+ break;
+ default:
+ Tcl_AppendToObj(outbuf, cur, next - cur);
+ break;
+ }
} else {
- tclo = Tcl_NewStringObj("", -1);
- }
-
- Tcl_AppendToObj(tclo, Tcl_DStringValue(&dstr),
- Tcl_DStringLength(&dstr));
-
- if (cntOpen < 1) {
- Tcl_AppendToObj(tclo, "\"\n", 2);
+ if (firstScan == 1) { firstScan = 0; }
+ Tcl_AppendToObj(outbuf, cur, next - cur);
}
-
- Tcl_DStringFree(&dstr);
- printf("DEBUG: tclo = %s\n", Tcl_GetString(tclo));
- res = Tcl_EvalObjEx(interp, tclo, TCL_EVAL_DIRECT);
- return res;
+ }
+ if (begin) {
+ tclo = Tcl_NewStringObj("web::put \"", -1);
+ Tcl_AppendObjToObj(tclo, outbuf);
+ } else {
+ tclo = outbuf;
+ }
+ Tcl_AppendToObj(tclo, "\"", -1);
+ res = Tcl_EvalObjEx(interp, tclo, TCL_EVAL_DIRECT);
+ return res;
}
/* ----------------------------------------------------------------------------
diff -ur tcl-websh.orig/src/tests/mintest.test tcl-websh/src/tests/mintest.test
--- tcl-websh.orig/src/tests/mintest.test Mon Aug 29 13:24:13 2005
+++ tcl-websh/src/tests/mintest.test Mon Aug 29 13:49:40 2005
@@ -36,7 +36,7 @@
set res ""
catch {
## fixme: use variable for tclsh8.3
- set res [exec tclsh8.3 $fn]
+ set res [exec tclsh8.4 $fn]
}
file delete -force $fn
set res
diff -ur tcl-websh.orig/src/unix/Makefile.in tcl-websh/src/unix/Makefile.in
--- tcl-websh.orig/src/unix/Makefile.in Mon Aug 29 13:24:13 2005
+++ tcl-websh/src/unix/Makefile.in Mon Aug 29 13:52:43 2005
@@ -175,7 +175,7 @@
INCLUDES = @TCL_INCLUDES@ $(HTTPD_INCLUDES)
-EXTRA_CFLAGS = $(TCL_DEFS) $(PROTO_FLAGS) $(SECURITY_FLAGS) $(MEM_DEBUG_FLAGS)
$(KEYSYM_FLAGS) $(NO_DEPRECATED_FLAGS)
+EXTRA_CFLAGS = $(TCL_DEFS) $(PROTO_FLAGS) $(SECURITY_FLAGS) $(MEM_DEBUG_FLAGS)
$(KEYSYM_FLAGS) $(NO_DEPRECATED_FLAGS) $(TCL_EXTRA_CFLAGS)
DEFS = @DEFS@ $(EXTRA_CFLAGS)
@@ -290,7 +290,7 @@
websh$(VERSION): tclAppInit.$(OBJEXT) $(web_OBJECTS)
$(CC) @LDFLAGS@ tclAppInit.$(OBJEXT) $(web_OBJECTS) \
- $(TCL_LIB_SPEC) $(TCL_LIBS) -o websh$(VERSION)
+ $(TCL_LIB_SPEC) $(TCL_LIBS) $(TCL_LD_FLAGS) -o websh$(VERSION)
mod_websh$(SHARED_LIB_SUFFIX): $(web_ap_OBJECTS)
@@ -385,15 +385,35 @@
# =============================================================================
install-doc: doc
- $(mkinstalldirs) $(DESTDIR)/doc
- @for i in quickref.html quickref.txt ; \
+ $(mkinstalldirs) $(DESTDIR)/doc/html
+ @for i in Apache_module_specific_commands.html \
+ command_dispatching_and_session_management.html \
+ configuration.html \
+ context_handling.html \
+ data_encryption.html \
+ file_handling_and_file_IO.html \
+ index.html \
+ inter-process_and_-system_communication.html \
+ logging.html \
+ misc_commands.html \
+ request_data_handling.html \
+ response_data_handling.html \
+ uri-html-_en-decoding.html ; \
+ do \
+ echo "Installing $$i"; \
+ rm -f $(DESTDIR)/doc/html/$$i; \
+ $(INSTALL_DATA) ../../doc/html/$$i $(DESTDIR)/doc/html/$$i ; \
+ chmod 444 $(DESTDIR)/doc/html/$$i; \
+ done
+ @for i in INSTALL README ; \
+
do \
echo "Installing $$i"; \
rm -f $(DESTDIR)/doc/$$i; \
- $(INSTALL_DATA) ../../doc/$$i $(DESTDIR)/doc/$$i ; \
+ $(INSTALL_DATA) ../../$$i $(DESTDIR)/doc/$$i ; \
chmod 444 $(DESTDIR)/doc/$$i; \
done
- @for i in README license.terms ChangeLog changes ; \
+ @for i in ChangeLog license.terms ; \
do \
echo "Installing $$i"; \
rm -f $(DESTDIR)/doc/$$i; \
diff -ur tcl-websh.orig/src/generic/formdata.c tcl-websh/src/generic/formdata.c
--- tcl-websh.orig/src/generic/formdata.c Mon Aug 29 13:24:13 2005
+++ tcl-websh/src/generic/formdata.c Fri Sep 2 22:28:47 2005
@@ -41,6 +41,7 @@
int readToEnd = 0;
int content_length = 0;
Tcl_DString translation;
+ Tcl_DString encoding;
channel = Web_GetChannelOrVarChannel(interp, channelName, &mode);
if (channel == NULL) {
@@ -63,7 +64,9 @@
}
Tcl_DStringInit(&translation);
+ Tcl_DStringInit(&encoding);
Tcl_GetChannelOption(interp, channel, "-translation", &translation);
+ Tcl_GetChannelOption(interp, channel, "-encoding", &encoding);
Tcl_SetChannelOption(interp, channel, "-translation", "binary");
/* ------------------------------------------------------------------------
@@ -88,7 +91,9 @@
if (Tcl_GetIntFromObj(interp, len, &content_length) != TCL_OK) {
Tcl_SetChannelOption(interp, channel, "-translation",
Tcl_DStringValue(&translation));
+ Tcl_SetChannelOption(interp, channel, "-encoding",
Tcl_DStringValue(&encoding));
Tcl_DStringFree(&translation);
+ Tcl_DStringFree(&encoding);
/* unregister if was a varchannel */
Web_UnregisterVarChannel(interp, channelName, channel);
return TCL_ERROR;
@@ -122,7 +127,9 @@
Tcl_DecrRefCount(formData);
Tcl_SetChannelOption(interp, channel, "-translation",
Tcl_DStringValue(&translation));
+ Tcl_SetChannelOption(interp, channel, "-encoding",
Tcl_DStringValue(&encoding));
Tcl_DStringFree(&translation);
+ Tcl_DStringFree(&encoding);
/* unregister if was a varchannel */
Web_UnregisterVarChannel(interp, channelName, channel);
@@ -131,10 +138,15 @@
}
Tcl_SetChannelOption(interp, channel, "-translation",
Tcl_DStringValue(&translation));
+ Tcl_SetChannelOption(interp, channel, "-encoding",
Tcl_DStringValue(&encoding));
Tcl_DStringFree(&translation);
+ Tcl_DStringFree(&encoding);
/* unregister if was a varchannel */
Web_UnregisterVarChannel(interp, channelName, channel);
+ LOG_MSG(interp, WRITE_LOG, __FILE__, __LINE__,
+ "parseUrlEncodedFormData()", WEBLOG_WARNING,
+ "formData \"", Tcl_GetString(formData), "\"", NULL);
cmdList[0] = Tcl_NewStringObj("web::uri2list", -1);
cmdList[1] = Tcl_DuplicateObj(formData);
Tcl_IncrRefCount(cmdList[0]);
@@ -199,6 +211,7 @@
char *boundary = mimeGetParamFromContDisp(content_type, "boundary");
int res = 0;
Tcl_DString translation;
+ Tcl_DString encoding;
/* printf("DBG parseMultipartFormData - starting\n"); fflush(stdout); */
@@ -230,13 +243,17 @@
}
Tcl_DStringInit(&translation);
+ Tcl_DStringInit(&encoding);
Tcl_GetChannelOption(interp, channel, "-translation", &translation);
+ Tcl_GetChannelOption(interp, channel, "-encoding", &encoding);
Tcl_SetChannelOption(interp, channel, "-translation", "binary");
res = mimeSplitMultipart(interp, channel, boundary, requestData);
Tcl_SetChannelOption(interp, channel, "-translation",
Tcl_DStringValue(&translation));
+ Tcl_SetChannelOption(interp, channel, "-encoding",
Tcl_DStringValue(&encoding));
Tcl_DStringFree(&translation);
+ Tcl_DStringFree(&encoding);
/* unregister if was a varchannel */
Web_UnregisterVarChannel(interp, channelName, channel);
@@ -560,7 +577,7 @@
* open file
* -----------------------------------------------------------------------
*/
if ((out = Tcl_OpenFileChannel(NULL, Tcl_GetString(tmpFileName),
- "w", 0644)) == NULL)
+ "w", 0600)) == NULL)
return 0;
/*
--------------------------------------------------------------------------
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
