damonc 02/01/10 22:47:48
Modified: . ChangeLog
src make.tcl rivet.h rivetCore.c rivetList.c
Added: src rivetCrypt.c rivetPkgInit.c rivetWWW.c
Removed: src rivetInit.c
Log:
* src/rivet.h
Added macro 'TCL_CMD_HEADER'. Prints the default command header
for Tcl commands in Rivet.
Added macro 'TCL_OBJ_CMD'. Prints the default object command
creation for Tcl commands in Rivet.
* src/rivetInit.c
Renamed to rivetPkgInit.c
* src/rivetCrypt.c
Added. Contains commands for encryption and decryption.
encrypt
decrypt
crypt
* src/rivetWWW.c
Added. Contains commands for the world wide web.
escape_string
unescape_string
escape_sgml_chars
escape_shell_command
* src/rivetList.c
Added the following commands:
comma_split
comma_join
lassign_array
* src/make.tcl
Moved all of the Rivet Tcl commands into their own library
called librivet. This will be automatically loaded into Rivet
as the default configuration. Anyone who wants can take it
out if they choose.
Revision Changes Path
1.17 +36 -0 tcl-rivet/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /home/cvs/tcl-rivet/ChangeLog,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- ChangeLog 10 Jan 2002 01:05:01 -0000 1.16
+++ ChangeLog 11 Jan 2002 06:47:48 -0000 1.17
@@ -1,3 +1,39 @@
+2002-01-10 Damon J. Courtney <[EMAIL PROTECTED]>
+ * src/rivet.h
+ Added macro 'TCL_CMD_HEADER'. Prints the default command header
+ for Tcl commands in Rivet.
+
+ Added macro 'TCL_OBJ_CMD'. Prints the default object command
+ creation for Tcl commands in Rivet.
+
+ * src/rivetInit.c
+ Renamed to rivetPkgInit.c
+
+ * src/rivetCrypt.c
+ Added. Contains commands for encryption and decryption.
+ encrypt
+ decrypt
+ crypt
+
+ * src/rivetWWW.c
+ Added. Contains commands for the world wide web.
+ escape_string
+ unescape_string
+ escape_sgml_chars
+ escape_shell_command
+
+ * src/rivetList.c
+ Added the following commands:
+ comma_split
+ comma_join
+ lassign_array
+
+ * src/make.tcl
+ Moved all of the Rivet Tcl commands into their own library
+ called librivet. This will be automatically loaded into Rivet
+ as the default configuration. Anyone who wants can take it
+ out if they choose.
+
2002-01-10 David N. Welton <[EMAIL PROTECTED]>
* tests/template.conf.tcl: Re-add srm.conf and access.conf - if
1.9 +42 -17 tcl-rivet/src/make.tcl
Index: make.tcl
===================================================================
RCS file: /home/cvs/tcl-rivet/src/make.tcl,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- make.tcl 9 Jan 2002 21:42:44 -0000 1.8
+++ make.tcl 11 Jan 2002 06:47:48 -0000 1.9
@@ -2,7 +2,7 @@
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
-# $Id: make.tcl,v 1.8 2002/01/09 21:42:44 damonc Exp $
+# $Id: make.tcl,v 1.9 2002/01/11 06:47:48 damonc Exp $
# this file actually runs things, making use of the aardvark build
# system.
@@ -17,11 +17,21 @@
# add variables
set APACHE "/usr/include/apache-1.3"
-set INC "-I$APACHE/include"
-set STATICLIB mod_rivet.a
-set SHLIB "mod_rivet[ info sharedlibextension ]"
+set INC "-I $APACHE/include"
+
+set APACHE "/usr/local/apache"
+set INC "-I $APACHE/include -I /usr/local/TclPro1.4/include"
+
set COMPILE "$TCL_CC $TCL_CFLAGS_DEBUG $TCL_CFLAGS_OPTIMIZE
$TCL_CFLAGS_WARNING $TCL_SHLIB_CFLAGS $INC $TCL_EXTRA_CFLAGS -c"
-set OBJECTS "apache_cookie.o apache_multipart_buffer.o apache_request.o
channel.o parser.o rivetCore.o rivetList.o rivetInit.o mod_rivet.o"
+
+set MOD_STATICLIB mod_rivet.a
+set MOD_SHLIB "mod_rivet[info sharedlibextension]"
+set MOD_OBJECTS "apache_cookie.o apache_multipart_buffer.o apache_request.o
channel.o parser.o rivetCore.o mod_rivet.o"
+
+set LIB_SHLIB "librivet[info sharedlibextension]"
+set LIB_OBJECTS "rivetList.o rivetCrypt.o rivetWWW.o rivetPkgInit.o"
+
+set TCL_LIBS "$TCL_LIBS -lcrypt"
# ------------
@@ -47,12 +57,12 @@
}
AddNode channel.o {
- depends "channel.c mod_rivet.h channel.h"
+ depends "channel.c channel.h mod_rivet.h"
command {$COMPILE channel.c}
}
AddNode parser.o {
- depends "parser.c mod_rivet.h parser.h"
+ depends "parser.c parser.h mod_rivet.h"
command {$COMPILE parser.c}
}
@@ -61,33 +71,48 @@
command {$COMPILE rivetCore.c}
}
+AddNode rivetCrypt.o {
+ depends "rivetCrypt.c"
+ command {$COMPILE rivetCrypt.c}
+}
+
AddNode rivetList.o {
- depends "rivetList.c rivetList.h mod_rivet.h"
+ depends "rivetList.c rivetList.h rivetList.h"
command {$COMPILE rivetList.c}
}
-AddNode rivetInit.o {
- depends "rivetInit.c rivetInit.h mod_rivet.h"
- command {$COMPILE rivetInit.c}
+AddNode rivetWWW.o {
+ depends "rivetWWW.c"
+ command {$COMPILE rivetWWW.c}
+}
+
+AddNode rivetPkgInit.o {
+ depends "rivetPkgInit.c mod_rivet.h"
+ command {$COMPILE rivetPkgInit.c}
}
AddNode mod_rivet.o {
- depends "mod_rivet.c mod_rivet.h rivetCore.h apache_request.h parser.h
parser.h"
+ depends "mod_rivet.c mod_rivet.h apache_request.h parser.h"
command {$COMPILE mod_rivet.c}
}
+AddNode librivet.so {
+ depends $LIB_OBJECTS
+ command {$TCL_SHLIB_LD -o $LIB_SHLIB $LIB_OBJECTS $TCL_LIB_SPEC
$TCL_LIBS}
+}
+
AddNode all {
- depends shared
+ depends {librivet.so shared}
}
AddNode shared {
- depends $OBJECTS
- command {$TCL_SHLIB_LD -o $SHLIB $OBJECTS $TCL_LIB_SPEC $TCL_LIBS}
+ depends $MOD_OBJECTS
+ command {$TCL_SHLIB_LD -o $MOD_SHLIB $MOD_OBJECTS $TCL_LIB_SPEC
$TCL_LIBS}
}
AddNode static {
- depends $OBJECTS
- command {$TCL_STLIB_LD $STATICLIB $OBJECTS}
+ depends $MOD_OBJECTS
+ command {$TCL_STLIB_LD $MOD_STATICLIB $MOD_OBJECTS}
}
AddNode clean {
1.3 +16 -0 tcl-rivet/src/rivet.h
Index: rivet.h
===================================================================
RCS file: /home/cvs/tcl-rivet/src/rivet.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- rivet.h 9 Jan 2002 21:42:44 -0000 1.2
+++ rivet.h 11 Jan 2002 06:47:48 -0000 1.3
@@ -1,5 +1,21 @@
#define STREQU(s1, s2) (s1[0] == s2[0] && strcmp(s1, s2) == 0)
+#define TCL_CMD_HEADER(cmd) \
+static int cmd(\
+ ClientData clientData,\
+ Tcl_Interp *interp,\
+ int objc,\
+ Tcl_Obj *CONST objv[])
+
+#define TCL_OBJ_CMD( name, func ) \
+Tcl_CreateObjCommand( interp, /* Tcl interpreter */\
+ name, /* Function name in Tcl */\
+ func, /* C function name */\
+ NULL, /* Client Data */\
+ (Tcl_CmdDeleteProc *)NULL /* Tcl Delete Prov */)
+
int Rivet_Init( Tcl_Interp *interp );
int Rivet_InitList( Tcl_Interp *interp );
+int Rivet_InitCrypt( Tcl_Interp *interp );
+int Rivet_InitWWW( Tcl_Interp *interp );
int Rivet_InitCore( Tcl_Interp *interp );
1.3 +4 -0 tcl-rivet/src/rivetCore.c
Index: rivetCore.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/rivetCore.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- rivetCore.c 9 Jan 2002 21:42:44 -0000 1.2
+++ rivetCore.c 11 Jan 2002 06:47:48 -0000 1.3
@@ -1,3 +1,7 @@
+/*
+ * rivetCore.c - Core commands which are compiled into mod_rivet itself.
+ */
+
#include "httpd.h"
#include "http_config.h"
#include "http_request.h"
1.2 +330 -6 tcl-rivet/src/rivetList.c
Index: rivetList.c
===================================================================
RCS file: /home/cvs/tcl-rivet/src/rivetList.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- rivetList.c 9 Jan 2002 21:42:44 -0000 1.1
+++ rivetList.c 11 Jan 2002 06:47:48 -0000 1.2
@@ -1,3 +1,7 @@
+/*
+ * rivetList.c - Rivet commands that manipulate lists.
+ */
+
#include <tcl.h>
#include "rivet.h"
@@ -103,7 +107,7 @@
switch(mode) {
case EXACT:
match = (valueLen == patternLen) &&
- (memcmp(value, pattern, valueLen) == 0);
+ (memcmp(value, pattern, (unsigned)valueLen) == 0);
break;
case GLOB:
@@ -170,6 +174,326 @@
return TCL_ERROR;
}
+static void
+Rivet_ListObjAppendString (interp, targetList, string, length)
+ Tcl_Interp *interp;
+ Tcl_Obj *targetList;
+ char *string;
+ int length;
+{
+ Tcl_Obj *elementObj;
+
+ elementObj = Tcl_NewStringObj (string, length);
+ Tcl_ListObjAppendElement (interp, targetList, elementObj);
+ /* Tcl_DecrRefCount (elementObj); */
+}
+
+
+/*
+
*-----------------------------------------------------------------------------
+ *
+ * Rivet_CommaObjSplitCmd --
+ *
+ * Implements the `comma_split' Tcl command:
+ * comma_split $line
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+
*-----------------------------------------------------------------------------
+ */
+static int
+Rivet_CommaSplitObjCmd (notUsed, interp, objc, objv)
+ ClientData notUsed;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ char *first, *next;
+ char c;
+ int stringLength;
+ Tcl_Obj *resultList;
+
+ /* ??? need a way to set this */
+ /* true if two quotes ("") in the body of a field maps to one (") */
+ int quotequoteQuotesQuote = 1;
+
+ /* true if quotes within strings not followed by a comma are allowed */
+ int quotePairsWithinStrings = 1;
+
+ if( objc != 2 ) {
+ Tcl_WrongNumArgs( interp, 1, objv, "string" );
+ return TCL_ERROR;
+ }
+
+ /* get access to a textual representation of the object */
+ first = Tcl_GetStringFromObj (objv [1], &stringLength);
+
+ /* handle the trivial case... if the string is empty, so is the result */
+ if (stringLength == 0) return TCL_OK;
+
+ next = first;
+ resultList = Tcl_GetObjResult (interp);
+
+ /* this loop walks through the comma-separated string we've been passed
*/
+ while (1) {
+
+ /* grab the next character in the buffer */
+ c = *next;
+
+ /* if we've got a quote at this point, it is at the start
+ * of a field, scan to the closing quote, make that a field,
+ * and update */
+
+ if (c == '"') {
+ next = ++first;
+ while (1) {
+ c = *next;
+ /*
+ * if we're at the end, we've got an unterminated quoted string
+ */
+ if (c == '\0') goto format_error;
+
+ /*
+ * If we get a double quote, first see if it's a pair of double
+ * quotes, i.e. a quoted quote, and handle that.
+ */
+ if (c == '"') {
+ /* if consecutive pairs of quotes as quotes of quotes
+ * is enabled and the following char is a double quote,
+ * turn the pair into a single by zooming on down */
+ if (quotequoteQuotesQuote && (*(next + 1) == '"')) {
+ next += 2;
+ continue;
+ }
+
+ /* If double quotes within strings is enabled and the
+ * char following this quote is not a comma, scan forward
+ * for a quote */
+ if (quotePairsWithinStrings && (*(next + 1) != ',')) {
+ next++;
+ continue;
+ }
+ /* It's a solo double-quote, not a pair of double-quotes,
+ * so terminate the element
+ * at the current quote (the closing quote).
+ */
+ Rivet_ListObjAppendString (interp,
+ resultList, first, next - first);
+
+ /* skip the closing quote that we overwrote, and the
+ * following comma if there is one.
+ */
+
+ ++next;
+ c = *next;
+
+ /*
+ *if we get end-of-line here, it's fine... and we're done
+ */
+
+ if (c == '\0')
+ return TCL_OK;
+
+ /*
+ * It's not end-of-line. If the next character is
+ * not a comma, it's an error.
+ */
+ if (c != ',') {
+ format_error:
+ Tcl_ResetResult (interp);
+ Tcl_AppendResult (interp,
+ "format error in string: \"",
+ first, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* We're done with that field. The next one starts one
+ * character past the current one, which is (was) a
+ * comma */
+ first = ++next;
+ break;
+ }
+ /* It wasn't a quote, look at the next character. */
+ next++;
+ }
+ continue;
+ }
+
+ /* If we get here, we're at the start of a field that didn't
+ * start with a quote */
+ next = first;
+ while (1) {
+ c = *next;
+
+ /* If we reach end of the string, append the last element
+ * and return to our caller. */
+ if (c == '\0') {
+ Rivet_ListObjAppendString (interp, resultList, first, -1);
+ return TCL_OK;
+ }
+
+ /* If we get a comma, that's the end of this piece,
+ * stick it into the list.
+ */
+ if (c == ',') {
+ Rivet_ListObjAppendString (interp,
+ resultList,
+ first, next - first);
+ first = ++next;
+ break;
+ }
+ next++;
+ }
+ }
+ Rivet_ListObjAppendString (interp, resultList, first, -1);
+ return TCL_OK;
+}
+
+
+/*
+
*-----------------------------------------------------------------------------
+ *
+ * Rivet_CommaJoinCmd --
+ *
+ * Implements the `comma_join' Tcl command:
+ * comma_join $list
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+
*-----------------------------------------------------------------------------
+ */
+static int
+Rivet_CommaJoinObjCmd (notUsed, interp, objc, objv)
+ ClientData notUsed;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ int listObjc;
+ Tcl_Obj **listObjv;
+ int listIdx, didField;
+ Tcl_Obj *resultPtr;
+ char *walkPtr;
+ char *strPtr;
+ int stringLength;
+
+ if( objc != 2 ) {
+ Tcl_WrongNumArgs( interp, 1, objv,
+ "list arrayName elementName ?elementName..?" );
+ return TCL_ERROR;
+ }
+
+ resultPtr = Tcl_GetObjResult (interp);
+
+ if (Tcl_ListObjGetElements (interp,
+ objv[1],
+ &listObjc,
+ &listObjv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ didField = 0;
+ for (listIdx = 0; listIdx < listObjc; listIdx++) {
+ /* If it's the first thing we've output, start it out
+ * with a double quote. If not, terminate the last
+ * element with a double quote, then put out a comma,
+ * then open the next element with a double quote
+ */
+ if (didField) {
+ Tcl_AppendToObj (resultPtr, "\",\"", 3);
+ } else {
+ Tcl_AppendToObj (resultPtr, "\"", 1);
+ didField = 1;
+ }
+ walkPtr = strPtr = Tcl_GetStringFromObj (listObjv[listIdx],
&stringLength);
+ /* Walk the string of the list element that we're about to
+ * append to the result object.
+ *
+ * For each character, if it isn't a double quote, move on to
+ * the next character until the string is exhausted.
+ */
+ for (;stringLength; stringLength--) {
+ if (*walkPtr++ != '"') continue;
+
+ /* OK, we saw a double quote. Emit everything up to and
+ * including the double quote, then reset the string to
+ * start at the same double quote (to issue it twice and
+ * pick up where we left off. Be sure to get the length
+ * calculations right!
+ */
+
+ Tcl_AppendToObj (resultPtr, strPtr, walkPtr - strPtr);
+ strPtr = walkPtr - 1;
+ }
+ Tcl_AppendToObj (resultPtr, strPtr, walkPtr - strPtr);
+ }
+ Tcl_AppendToObj (resultPtr, "\"", 1);
+ return TCL_OK;
+}
+
+
+/*
+
*-----------------------------------------------------------------------------
+ *
+ * Rivet_LassignArrayCmd --
+ * Implements the TCL lassign_array command:
+ * lassign_array list arrayname elementname ?elementname...?
+ *
+ * Results:
+ * Standard TCL results.
+ *
+
*-----------------------------------------------------------------------------
+ */
+TCL_CMD_HEADER( Rivet_LassignArrayObjCmd )
+{
+ int listObjc, listIdx, idx;
+ Tcl_Obj **listObjv;
+ Tcl_Obj *varValue;
+
+ if( objc < 4 ) {
+ Tcl_WrongNumArgs( interp, 1, objv,
+ "list arrayName elementName ?elementName..?");
+ return TCL_ERROR;
+ }
+
+ if( Tcl_ListObjGetElements(interp, objv[1],
+ &listObjc, &listObjv) != TCL_OK)
+ return TCL_ERROR;
+
+ for (idx = 3, listIdx = 0; idx < objc; idx++, listIdx++) {
+ varValue = (listIdx < listObjc) ?
+ listObjv[listIdx] : Tcl_NewStringObj( "", NULL );
+
+ if( Tcl_ObjSetVar2( interp, objv[2], objv[idx],
+ varValue, TCL_LEAVE_ERR_MSG ) == NULL ) {
+ return TCL_ERROR;
+ }
+ }
+
+ /* We have some left over items. Return them in a list. */
+ if( listIdx < listObjc ) {
+ Tcl_Obj *list = Tcl_NewListObj( 0, NULL );
+ int i;
+
+ for( i = listIdx; i < listObjc; ++i )
+ {
+ if (Tcl_ListObjAppendElement(interp, list, listObjv[i]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ Tcl_SetObjResult( interp, list );
+ }
+ return TCL_OK;
+}
+
/*-----------------------------------------------------------------------------
* Rivet_initList --
@@ -183,10 +507,10 @@
Rivet_InitList( interp )
Tcl_Interp *interp;
{
- Tcl_CreateObjCommand(interp,
- "lremove",
- Rivet_LremoveObjCmd,
- (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
+ TCL_OBJ_CMD( "lremove", Rivet_LremoveObjCmd );
+ TCL_OBJ_CMD( "comma_split", Rivet_CommaSplitObjCmd );
+ TCL_OBJ_CMD( "comma_join", Rivet_CommaJoinObjCmd );
+ TCL_OBJ_CMD( "lassign_array", Rivet_LassignArrayObjCmd );
+
return TCL_OK;
}
1.1 tcl-rivet/src/rivetCrypt.c
Index: rivetCrypt.c
===================================================================
/*
* rivetCrypt.c - Commands to do encryption and decryption.
*/
#include <tcl.h>
#include "rivet.h"
#include <unistd.h>
#define MODE_DECRYPT 0
#define MODE_ENCRYPT 1
/* encrypt/decrypt string in place using key,
* mode = 1 to encrypt and 0 to decrypt
*/
static void
Rivet_Crypt(char *string, const char *key, long offset, int mode)
{
const char *kp = key;
offset = offset % strlen(key);
while (offset--) kp++;
/* printf("encrypt '%s' with key '%s', mode %d\n",string,key,mode); */
while (*string != '\0')
{
if (*string >= 32 && *string <= 126)
{
if (mode)
*string = (((*string - 32) + (*kp - 32)) % 94) + 32;
else
*string = (((*string - 32) - (*kp - 32) + 94) % 94) + 32;
}
string++;
kp++;
if (*kp == '\0') {
kp = key;
}
}
}
TCL_CMD_HEADER( Rivet_EncryptCmd )
{
char *data, *key;
char *resultBuffer;
int dataLen;
int keyIndex;
if( objc < 3 ) {
Tcl_WrongNumArgs( interp, 1, objv, "data key" );
return TCL_ERROR;
}
data = Tcl_GetStringFromObj( objv[1], &dataLen );
resultBuffer = (char *)Tcl_Alloc( (unsigned)dataLen + 1 );
strcpy ( resultBuffer, data );
for( keyIndex = 2; keyIndex < objc; keyIndex++ )
{
key = Tcl_GetStringFromObj( objv[keyIndex], NULL );
Rivet_Crypt( resultBuffer, key, 0L, MODE_ENCRYPT );
}
Tcl_SetObjResult( interp, Tcl_NewStringObj( resultBuffer, -1 ) );
return TCL_OK;
}
TCL_CMD_HEADER( Rivet_DecryptCmd )
{
char *data, *key;
char *resultBuffer;
int dataLen;
int keyIndex;
if( objc < 3 ) {
Tcl_WrongNumArgs( interp, 1, objv, "data key" );
return TCL_ERROR;
}
data = Tcl_GetStringFromObj( objv[1], &dataLen );
resultBuffer = (char *)Tcl_Alloc( (unsigned)dataLen + 1 );
strcpy ( resultBuffer, data );
for( keyIndex = 2; keyIndex < objc; keyIndex++ )
{
key = Tcl_GetStringFromObj( objv[keyIndex], NULL );
Rivet_Crypt( resultBuffer, key, 0L, MODE_DECRYPT );
}
Tcl_SetObjResult( interp, Tcl_NewStringObj( resultBuffer, -1 ) );
return TCL_OK;
}
TCL_CMD_HEADER( Rivet_CryptCmd )
{
char *key, *salt;
char *resultBuffer;
if( objc != 3 ) {
Tcl_WrongNumArgs( interp, 1, objv, "key salt" );
return TCL_ERROR;
}
key = Tcl_GetStringFromObj( objv[1], NULL );
salt = Tcl_GetStringFromObj( objv[2], NULL );
resultBuffer = crypt( key, salt );
if( resultBuffer == NULL ) {
Tcl_AppendResult (interp,
"crypt function failed: ",
Tcl_GetStringFromObj(objv[1], NULL),
(char *)NULL );
return TCL_ERROR;
}
Tcl_SetObjResult( interp, Tcl_NewStringObj( resultBuffer, -1 ) );
return TCL_OK;
}
int
Rivet_InitCrypt( Tcl_Interp *interp )
{
TCL_OBJ_CMD( "encrypt", Rivet_EncryptCmd );
TCL_OBJ_CMD( "decrypt", Rivet_DecryptCmd );
TCL_OBJ_CMD( "crypt", Rivet_CryptCmd );
return TCL_OK;
}
1.1 tcl-rivet/src/rivetPkgInit.c
Index: rivetPkgInit.c
===================================================================
/*
* rivetPkgInit.c - Initialize all of the Rivet commands into a Tcl interp.
*/
#include <tcl.h>
#include "rivet.h"
int
Rivet_Init( Tcl_Interp *interp )
{
Rivet_InitList( interp );
Rivet_InitCrypt( interp );
Rivet_InitWWW( interp );
return Tcl_PkgProvide( interp, "Rivet", "1.0" );
}
1.1 tcl-rivet/src/rivetWWW.c
Index: rivetWWW.c
===================================================================
/*
* rivetWWW.c - Rivet commands designed for use with the world wide web.
*/
#include <tcl.h>
#include <ctype.h>
#include "rivet.h"
/*
*-----------------------------------------------------------------------------
*
* Rivet_HexToDigit --
* Helper function to convert a hex character into the equivalent integer.
*
* Results:
* The integer, or -1 if an illegal hex character is encountered.
*
*-----------------------------------------------------------------------------
*/
static int
Rivet_HexToDigit(int c) {
if (c >= 'a' && c <= 'f') {
return (c - 'a' + 10);
}
if (c >= 'A' && c <= 'F') {
return (c - 'A' + 10);
}
if (c >= '0' && c <= '9') {
return (c - '0');
}
return (-1);
}
/*
*-----------------------------------------------------------------------------
*
* Rivet_UnescapeStringCmd --
* Implements the TCL unescape_string command:
* unescape_string string
*
* Results:
* Standard TCL results.
*
*-----------------------------------------------------------------------------
*/
TCL_CMD_HEADER( Rivet_UnescapeStringCmd )
{
char *origString, *newString, *origStringP, *newStringP;
int origLength;
int digit1, digit2;
if ( objc != 2 ) {
Tcl_WrongNumArgs( interp, 1, objv, "string" );
return TCL_ERROR;
}
origString = Tcl_GetStringFromObj( objv[1], &origLength );
newString = Tcl_Alloc( (unsigned)origLength + 1);
/* for all the characters in the source string */
for (origStringP = origString, newStringP = newString;
*origStringP != '\0';
origStringP++) {
char c = *origStringP;
char c2;
/* map plus to space */
if (c == '+') {
*newStringP++ = ' ';
continue;
}
/* if there's a percent sign, decode the two-character
* hex sequence that follows and copy it to the target
* string */
if (c == '%') {
digit1 = Rivet_HexToDigit(c = *++origStringP);
digit2 = Rivet_HexToDigit(c2 = *++origStringP);
if (digit1 == -1 || digit2 == -1) {
char buf[2];
snprintf( buf, 2, "%c%c", c, c2 );
Tcl_AppendResult( interp,
Tcl_GetStringFromObj( objv[0], NULL ),
": bad char in hex sequence %", buf, (char *)NULL );
return TCL_ERROR;
}
*newStringP++ = (digit1 * 16 + digit2);
continue;
}
/* it wasn't a plus or percent, just copy the char across */
*newStringP++ = c;
}
/* Don't forget to null-terminate the target string */
*newStringP = '\0';
Tcl_SetObjResult( interp, Tcl_NewStringObj( newString, -1 ) );
return TCL_OK;
}
/*
*-----------------------------------------------------------------------------
*
* Rivet_DigitToHex
* Helper function to convert a number 0 - 15 into the equivalent hex
* character.
*
* Results:
* The integer, or -1 if an illegal hex character is encountered.
*
*-----------------------------------------------------------------------------
*/
static int
Rivet_DigitToHex(int c) {
if (c < 10) {
return c + '0';
}
return c - 10 + 'a';
}
/*
*-----------------------------------------------------------------------------
*
* Rivet_EscapeStringCmd --
* Implements the TCL escape_string command:
* escape_string string
*
* Results:
* Standard TCL results.
*
*-----------------------------------------------------------------------------
*/
TCL_CMD_HEADER( Rivet_EscapeStringCmd )
{
char *origString, *newString, *origStringP, *newStringP;
int origLength;
if ( objc != 2 ) {
Tcl_WrongNumArgs( interp, 1, objv, "string" );
return TCL_ERROR;
}
origString = Tcl_GetStringFromObj( objv[1], &origLength );
/* If they sent us an empty string, we're done */
if (origLength == 0) return TCL_OK;
newString = (char *)Tcl_Alloc( (unsigned)origLength * 3 + 1 );
/* for all the characters in the source string */
for (origStringP = origString, newStringP = newString;
*origStringP != '\0';
origStringP++) {
char c = *origStringP;
if (isalnum (c)) {
*newStringP++ = c;
} else {
*newStringP++ = '%';
*newStringP++ = Rivet_DigitToHex((c >> 4) & 0x0f);
*newStringP++ = Rivet_DigitToHex(c & 0x0f);
}
}
/* Don't forget to null-terminate the target string */
*newStringP = '\0';
Tcl_SetObjResult( interp, Tcl_NewStringObj( newString, -1 ) );
return TCL_OK;
}
/*
*-----------------------------------------------------------------------------
*
* Rivet_EscapeSgmlCharsCmd --
* Implements the TCL escape_sgml_chars command:
* escape_sgml_chars string
*
* Results:
* Standard TCL results.
*
*-----------------------------------------------------------------------------
*/
TCL_CMD_HEADER( Rivet_EscapeSgmlCharsCmd )
{
char *origString, *newString, *origStringP, *newStringP;
int origLength;
if( objc != 2 ) {
Tcl_WrongNumArgs( interp, 1, objv, "string" );
return TCL_ERROR;
}
origString = Tcl_GetStringFromObj( objv[1], &origLength );
/* If they sent us an empty string, we're done */
if (origLength == 0) return TCL_OK;
newString = (char *)Tcl_Alloc( (unsigned)origLength * 3 + 1 );
/* for all the characters in the source string */
for (origStringP = origString, newStringP = newString;
*origStringP != '\0';
origStringP++) {
char c = *origStringP;
switch(c) {
case '&':
*newStringP++ = '&';
*newStringP++ = 'a';
*newStringP++ = 'm';
*newStringP++ = 'p';
*newStringP++ = ';';
break;
case '<':
*newStringP++ = '&';
*newStringP++ = 'l';
*newStringP++ = 't';
*newStringP++ = ';';
break;
case '>':
*newStringP++ = '&';
*newStringP++ = 'g';
*newStringP++ = 't';
*newStringP++ = ';';
break;
case '\'':
*newStringP++ = '&';
*newStringP++ = '#';
*newStringP++ = '3';
*newStringP++ = '9';
*newStringP++ = ';';
break;
case '"':
*newStringP++ = '&';
*newStringP++ = 'q';
*newStringP++ = 'u';
*newStringP++ = 'o';
*newStringP++ = 't';
*newStringP++ = ';';
break;
default:
*newStringP++ = c;
break;
}
}
/* Don't forget to null-terminate the target string */
*newStringP = '\0';
Tcl_SetObjResult( interp, Tcl_NewStringObj( newString, -1 ) );
return TCL_OK;
}
/*
*-----------------------------------------------------------------------------
*
* Rivet_EscapeShellCommandCmd --
* Implements the TCL www_escape_shell_command command:
* www_escape_shell_command string
*
* Results:
* Standard TCL results.
*
*-----------------------------------------------------------------------------
*/
TCL_CMD_HEADER( Rivet_EscapeShellCommandCmd )
{
char *origString, *newString, *origStringP, *newStringP, *checkP;
int origLength;
if( objc != 2) {
Tcl_WrongNumArgs( interp, 1, objv, "string" );
return TCL_ERROR;
}
origString = Tcl_GetStringFromObj( objv[1], &origLength );
newString = Tcl_Alloc( (unsigned)origLength * 2 + 1 );
/* for all the characters in the source string */
for (origStringP = origString, newStringP = newString;
*origStringP != '\0';
origStringP++) {
char c = *origStringP;
/* if the character is a shell metacharacter, quote it */
for (checkP = "&;`'|*?-~<>^()[]{}$\\"; *checkP != '\0'; checkP++) {
if (c == *checkP) {
*newStringP++ = '\\';
break;
}
}
*newStringP++ = c;
}
/* Don't forget to null-terminate the target string */
*newStringP = '\0';
Tcl_SetObjResult( interp, Tcl_NewStringObj( newString, -1 ) );
return TCL_OK;
}
/*
*-----------------------------------------------------------------------------
* Rivet_InitWWW --
*
* Initialize the WWW functions.
*-----------------------------------------------------------------------------
*/
int
Rivet_InitWWW( interp )
Tcl_Interp *interp;
{
Tcl_CreateObjCommand(interp,
"unescape_string",
Rivet_UnescapeStringCmd,
NULL,
(Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
"escape_string",
Rivet_EscapeStringCmd,
NULL,
(Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
"escape_sgml_chars",
Rivet_EscapeSgmlCharsCmd,
NULL,
(Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp,
"escape_shell_command",
Rivet_EscapeShellCommandCmd,
NULL,
(Tcl_CmdDeleteProc *)NULL);
return TCL_OK;
}
