You are viewing a plain text version of this content. The canonical link for it is here.
Posted to rivet-dev@tcl.apache.org by mx...@apache.org on 2012/09/17 12:23:42 UTC
svn commit: r1386543 - in /tcl/rivet/trunk: ./ doc/xml/ src/ src/apache-2/
src/librivet/ src/parser/
Author: mxmanghi
Date: Mon Sep 17 10:23:41 2012
New Revision: 1386543
URL: http://svn.apache.org/viewvc?rev=1386543&view=rev
Log:
* src/librivet/rivet[Crypt|WWW|List|pkgInit].c,src/parser/rivetParser.[c|h],
src/parser/parserPkgInit.c: files for librivet and the Rivet parser moved into
src/librivet and src/parser.
* src/Makefile.am,src/librivet/Makefile.am, src/parser/Makefile.am: new automake conf files
reflect libraries reorganization.
* src/apache-2/Makefile.am: mod_rivet builds from the newly located parser code. Is it
sensible to let the module depend on a real package (provided by libparser.c)?
* configure.ac: add variable substitution for newly created Makefile.am
Added:
tcl/rivet/trunk/src/librivet/
tcl/rivet/trunk/src/librivet/Makefile.am (with props)
tcl/rivet/trunk/src/librivet/rivetCrypt.c (with props)
tcl/rivet/trunk/src/librivet/rivetList.c (with props)
tcl/rivet/trunk/src/librivet/rivetPkgInit.c (with props)
tcl/rivet/trunk/src/librivet/rivetWWW.c (with props)
tcl/rivet/trunk/src/parser/
tcl/rivet/trunk/src/parser/Makefile.am
tcl/rivet/trunk/src/parser/parserPkgInit.c
- copied unchanged from r1385372, tcl/rivet/trunk/src/parserPkgInit.c
tcl/rivet/trunk/src/parser/rivetParser.c
- copied unchanged from r1385372, tcl/rivet/trunk/src/rivetParser.c
tcl/rivet/trunk/src/parser/rivetParser.h
- copied unchanged from r1385372, tcl/rivet/trunk/src/rivetParser.h
Removed:
tcl/rivet/trunk/src/parserPkgInit.c
tcl/rivet/trunk/src/rivetCrypt.c
tcl/rivet/trunk/src/rivetList.c
tcl/rivet/trunk/src/rivetParser.c
tcl/rivet/trunk/src/rivetParser.h
tcl/rivet/trunk/src/rivetPkgInit.c
tcl/rivet/trunk/src/rivetWWW.c
Modified:
tcl/rivet/trunk/ChangeLog
tcl/rivet/trunk/configure.ac
tcl/rivet/trunk/doc/xml/commands.xml
tcl/rivet/trunk/doc/xml/directives.xml
tcl/rivet/trunk/src/Makefile.am
tcl/rivet/trunk/src/apache-2/Makefile.am
Modified: tcl/rivet/trunk/ChangeLog
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/ChangeLog?rev=1386543&r1=1386542&r2=1386543&view=diff
==============================================================================
--- tcl/rivet/trunk/ChangeLog (original)
+++ tcl/rivet/trunk/ChangeLog Mon Sep 17 10:23:41 2012
@@ -1,3 +1,13 @@
+2012-09-17 Massimo Manghi <mx...@apache.org>
+ * src/librivet/rivet[Crypt|WWW|List|pkgInit].c,src/parser/rivetParser.[c|h],
+ src/parser/parserPkgInit.c: files for librivet and the Rivet parser moved into
+ src/librivet and src/parser.
+ * src/Makefile.am,src/librivet/Makefile.am, src/parser/Makefile.am: new automake conf files
+ reflect libraries reorganization.
+ * src/apache-2/Makefile.am: mod_rivet builds from the newly located parser code. Is it
+ sensible to let the module depend on a real package (provided by libparser.c)?
+ * configure.ac: add variable substitution for newly created Makefile.am
+
2012-09-16 Massimo Manghi <mx...@apache.org>
* tests/runtests.tcl,tests/apachetest.tcl: User and Group directives removed from conffile
template to make test suite independent from the output of command 'id' from which
Modified: tcl/rivet/trunk/configure.ac
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/configure.ac?rev=1386543&r1=1386542&r2=1386543&view=diff
==============================================================================
--- tcl/rivet/trunk/configure.ac (original)
+++ tcl/rivet/trunk/configure.ac Mon Sep 17 10:23:41 2012
@@ -399,14 +399,14 @@ AC_DEFUN([APACHE_VERSION],[
AC_MSG_CHECKING(for apache version)
if test "$with_apache_version" = "1"; then
- AC_MSG_ERROR([Apache 1.x no more supported starting with Rivet 2.1])
+ AC_MSG_ERROR([Rivet 2.1 is no more supporting Apache 1.x])
else
- AC_MSG_RESULT( building for apache 2.x )
+ AC_MSG_RESULT([building for apache 2.x])
AC_CONFIG_FILES([src/apache-2/Makefile])
apache_version_dir="apache-2"
AC_DEFINE(APACHE2,1,[APACHE2 definition in config.h])
fi
- MOD_RIVET_INCLUDES="-I ${apache_version_dir}"
+ MOD_RIVET_INCLUDES="-I${apache_version_dir}"
])
AC_DEFUN([HANDLE_TCL_PACKAGE_PATH],[
@@ -670,9 +670,9 @@ AC_SUBST(TCL_PACKAGE_PATH)
# Finally, substitute all of the various values into the Makefile.
# You may alternatively have a special pkgIndex.tcl.in or other files
-# which require substituting th AC variables in. Include these here.
+# which require substituting the AC variables in. Include these here.
#--------------------------------------------------------------------
-AC_CONFIG_FILES([Makefile src/Makefile doc/Makefile doc/convert_examples.tcl])
+AC_CONFIG_FILES([Makefile src/Makefile src/librivet/Makefile src/parser/Makefile doc/Makefile doc/convert_examples.tcl])
#case $apache_version_dir in
# apache-1) AC_CONFIG_FILES([Makefile src/Makefile src/apache-1/Makefile doc/Makefile]) ;;
Modified: tcl/rivet/trunk/doc/xml/commands.xml
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/doc/xml/commands.xml?rev=1386543&r1=1386542&r2=1386543&view=diff
==============================================================================
--- tcl/rivet/trunk/doc/xml/commands.xml (original)
+++ tcl/rivet/trunk/doc/xml/commands.xml Mon Sep 17 10:23:41 2012
@@ -14,8 +14,7 @@
to 'configure'. In the future we may change this option's default.
</para>
<para>
- Commands must be imported into another namespace with the
- command:
+ Commands must be imported into another namespace with the command:
</para>
<para>
<command>namespace import -force ::rivet::*</command>
@@ -461,8 +460,8 @@
Scans through each character in the specified string looking
for any special (with respect to SGML, and hence HTML) characters
from the specified string, and returns the result.
- For example, the right angle
- bracket is escaped to the corrected ampersand gt symbol.
+ For example, the right angle bracket is escaped to the corrected
+ ampersand gt symbol.
</para>
<!--note>
You must require the <command>rivetlib</command> package in order to gain access to this command
Modified: tcl/rivet/trunk/doc/xml/directives.xml
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/doc/xml/directives.xml?rev=1386543&r1=1386542&r2=1386543&view=diff
==============================================================================
--- tcl/rivet/trunk/doc/xml/directives.xml (original)
+++ tcl/rivet/trunk/doc/xml/directives.xml Mon Sep 17 10:23:41 2012
@@ -97,13 +97,10 @@
Tcl script which is to run when the master interpreter is created.
Namespaces, variables and packages loaded during this stage will
be copied later on in the startup process, when child
- processes are created. In general any sort of I/O channel
- that is opened during this stage must be closed before the
- execution of the script completes.
+ processes are created.
</para>
<para>
- This option is only available at the global level and has
- effect only if <command>SeparateVirtualInterps</command> is off
+ This option is only available at the global level.
</para>
</listitem>
</varlistentry>
@@ -116,15 +113,13 @@
</term>
<listitem>
<para>
- Tcl script that is run as part of a child process initialization.
+ Tcl script run as part of a child process initialization.
If the option <option>SeparateVirtualInterp</option> is not used this is
the right place where file handles, database connections or sockets can
be opened.
The argument <replaceable><option>script</option></replaceable>
is an actual Tcl script, so to run a file, you would
- do:
-
- <programlisting>RivetServerConf GlobalInitScript "source /var/www/foobar.tcl"</programlisting>
+ do: <programlisting>RivetServerConf GlobalInitScript "source /var/www/foobar.tcl"</programlisting>
</para>
<para>
This option is ignored in virtual hosts.
@@ -142,7 +137,7 @@
<listitem>
<para>
Script to be evaluated when each Apache child
- process is initialized. This is the recommended
+ process is initialized. This is the recommended
place to load modules, create global variables, open
connections to other facilities (such as databases)
and so on.
Modified: tcl/rivet/trunk/src/Makefile.am
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/src/Makefile.am?rev=1386543&r1=1386542&r2=1386543&view=diff
==============================================================================
--- tcl/rivet/trunk/src/Makefile.am (original)
+++ tcl/rivet/trunk/src/Makefile.am Mon Sep 17 10:23:41 2012
@@ -14,56 +14,7 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-# AM_CFLAGS = @TCL_INCLUDES@ @GM_CPPFLAGS@
-
-
-# The weird and wild magic of auto* associates these two.
-##apxs_libexecdir = @APXS_LIBEXECDIR@
-##apxs_libexec_LTLIBRARIES = mod_rivet.la
-
-INCLUDES = -I@apache_include@
-
-# ... and these two. We want to put the libs in the package path,
-# rather than the standard library location for the system.
-lib_libexecdir = @RIVET_TCL_TARGET@
-lib_libexec_LTLIBRARIES = librivetlib.la librivetparser.la
-
-#
-# Apache Rivet Module, mod_rivet.so / mod_rivet.dll
-#
-##mod_rivet_la_SOURCES = @apache_version_dir@/apache_request.c \
-## rivetChannel.c \
-## rivetChannel.h \
-## rivetParser.c \
-## rivetParser.h \
-## TclWeb.h \
-## rivet.h
-
-##mod_rivet_la_SOURCES = mod_rivet.c mod_rivet.h
-
-##mod_rivet_la_LDFLAGS = @TCL_LIB_SPEC@ @APXS_LDFLAGS@ -module -avoid-version
-##mod_rivet_la_LIBADD = @TCL_LIBS@ @APXS_LIBS@
-##mod_rivet_la_CPPFLAGS = @TCL_INCLUDES@ @APXS_CPPFLAGS@ @APXS_INCLUDES@ -DSTART_TAG='"<?"' -DEND_TAG='"?>"'
-
-# APXS_CPPFLAGS_SHLIB
-
-#
-# Rivet Library
-#
-librivetlib_la_SOURCES = rivetList.c rivetCrypt.c rivetWWW.c rivetPkgInit.c
-librivetlib_la_LDFLAGS = @TCL_STUB_LIB_SPEC@ @APXS_LDFLAGS@ @APR_LDFLAGS@ -module -avoid-version
-librivetlib_la_LIBADD = @APXS_LIBS@
-librivetlib_la_CPPFLAGS = @MOD_RIVET_INCLUDES@ @TCL_INCLUDES@ @APXS_CPPFLAGS@ @APXS_INCLUDES@ @APR_INCLUDES@ @APR_CPPFLAGS@ -DSTART_TAG='"<?"' -DEND_TAG='"?>"' -DUSE_TCL_STUBS
-
-#
-# Rivet Parser Library
-#
-librivetparser_la_SOURCES = rivetParser.c parserPkgInit.c
-librivetparser_la_LDFLAGS = @TCL_STUB_LIB_SPEC@ @APXS_LDFLAGS@ -module -avoid-version
-librivetparser_la_LIBADD = @APXS_LIBS@
-librivetparser_la_CPPFLAGS = @TCL_INCLUDES@ @APXS_CPPFLAGS@ @APXS_INCLUDES@ -DSTART_TAG='"<?"' -DEND_TAG='"?>"' -DUSE_TCL_STUBS
-
-SUBDIRS = @apache_version_dir@
+SUBDIRS = librivet parser @apache_version_dir@
# Removing libtool .la files from installation
Modified: tcl/rivet/trunk/src/apache-2/Makefile.am
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/src/apache-2/Makefile.am?rev=1386543&r1=1386542&r2=1386543&view=diff
==============================================================================
--- tcl/rivet/trunk/src/apache-2/Makefile.am (original)
+++ tcl/rivet/trunk/src/apache-2/Makefile.am Mon Sep 17 10:23:41 2012
@@ -21,7 +21,7 @@
apxs_libexecdir = @APXS_LIBEXECDIR@
apxs_libexec_LTLIBRARIES = mod_rivet.la
-INCLUDES = -I@apache_include@ -I@RIVET_BASE_INCLUDE@
+INCLUDES = @apache_include@ -I@RIVET_BASE_INCLUDE@ -I../parser
# ... and these two. We want to put the libs in the package path,
# rather than the standard library location for the system.
@@ -39,7 +39,7 @@ mod_rivet_la_SOURCES = \
rivetCore.c \
rivetConf.c \
../rivetChannel.c \
- ../rivetParser.c
+ ../parser/rivetParser.c
##mod_rivet_la_SOURCES = mod_rivet.c mod_rivet.h
Added: tcl/rivet/trunk/src/librivet/Makefile.am
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/src/librivet/Makefile.am?rev=1386543&view=auto
==============================================================================
--- tcl/rivet/trunk/src/librivet/Makefile.am (added)
+++ tcl/rivet/trunk/src/librivet/Makefile.am Mon Sep 17 10:23:41 2012
@@ -0,0 +1,34 @@
+# Makefile for Rivet
+
+# Copyright 2004-2005 The Apache Software Foundation
+
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+
+# http://www.apache.org/licenses/LICENSE-2.0
+
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+# $Id$
+
+INCLUDES = @apache_include@ -I../@apache_version_dir@ -I..
+
+# ... and these two. We want to put the libs in the package path,
+# rather than the standard library location for the system.
+lib_libexecdir = @RIVET_TCL_TARGET@
+lib_libexec_LTLIBRARIES = librivetlib.la
+
+#
+# Rivet Library
+#
+
+librivetlib_la_SOURCES = rivetList.c rivetCrypt.c rivetWWW.c rivetPkgInit.c
+librivetlib_la_LDFLAGS = @TCL_STUB_LIB_SPEC@ @APXS_LDFLAGS@ @APR_LDFLAGS@ -module -avoid-version
+librivetlib_la_LIBADD = @APXS_LIBS@
+librivetlib_la_CPPFLAGS = @TCL_INCLUDES@ @APXS_CPPFLAGS@ @APXS_INCLUDES@ @APR_INCLUDES@ @APR_CPPFLAGS@ -DSTART_TAG='"<?"' -DEND_TAG='"?>"' -DUSE_TCL_STUBS
+
Propchange: tcl/rivet/trunk/src/librivet/Makefile.am
------------------------------------------------------------------------------
svn:keywords = Id
Added: tcl/rivet/trunk/src/librivet/rivetCrypt.c
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/src/librivet/rivetCrypt.c?rev=1386543&view=auto
==============================================================================
--- tcl/rivet/trunk/src/librivet/rivetCrypt.c (added)
+++ tcl/rivet/trunk/src/librivet/rivetCrypt.c Mon Sep 17 10:23:41 2012
@@ -0,0 +1,170 @@
+/*
+ * rivetCrypt.c - Commands to do encryption and decryption.
+ */
+
+/* Copyright 2002-2004 The Apache Software Foundation
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/* Rivet config */
+#ifdef HAVE_CONFIG_H
+#include <rivet_config.h>
+#endif
+
+#include <tcl.h>
+#include <string.h>
+#include "rivet.h"
+#include "ap_config.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 ) );
+ Tcl_Free(resultBuffer);
+ 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 ) );
+ Tcl_Free(resultBuffer);
+ return TCL_OK;
+}
+
+TCL_CMD_HEADER( Rivet_CryptCmd )
+{
+#ifdef crypt
+ char *key, *salt;
+ const 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((const char *)key, (const char *)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;
+#else /* ! crypt */
+ Tcl_SetObjResult(interp,Tcl_NewStringObj("error: command not available", -1));
+ return TCL_ERROR;
+#endif /* ! crypt */
+}
+
+
+/*-----------------------------------------------------------------------------
+ * Rivet_initCrypt --
+ * Initialize the encrypt, decrypt and crypt commands in an interpreter.
+ *
+ * These routines have been examined and are believed to be safe in a safe
+ * interpreter, as they only manipulate and return Tcl strings.
+ *
+ * Parameters:
+ * o interp - Interpreter to add commands to.
+ *-----------------------------------------------------------------------------
+ */
+int
+Rivet_InitCrypt( Tcl_Interp *interp)
+{
+ RIVET_OBJ_CMD("encrypt", Rivet_EncryptCmd);
+ RIVET_OBJ_CMD("decrypt", Rivet_DecryptCmd);
+ RIVET_OBJ_CMD("crypt", Rivet_CryptCmd);
+ return TCL_OK;
+}
Propchange: tcl/rivet/trunk/src/librivet/rivetCrypt.c
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: tcl/rivet/trunk/src/librivet/rivetCrypt.c
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Added: tcl/rivet/trunk/src/librivet/rivetList.c
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/src/librivet/rivetList.c?rev=1386543&view=auto
==============================================================================
--- tcl/rivet/trunk/src/librivet/rivetList.c (added)
+++ tcl/rivet/trunk/src/librivet/rivetList.c Mon Sep 17 10:23:41 2012
@@ -0,0 +1,545 @@
+/*
+ * rivetList.c - Rivet commands that manipulate lists.
+ */
+
+/* Copyright 2002-2004 The Apache Software Foundation
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/* Code originally from TclX by Karl Lehenbauer and others. */
+
+/* Rivet config */
+#ifdef HAVE_CONFIG_H
+#include <rivet_config.h>
+#endif
+
+#include <tcl.h>
+#include <string.h>
+#include "rivet.h"
+
+static Tcl_ObjCmdProc Rivet_LremoveObjCmd;
+static Tcl_ObjCmdProc Rivet_CommaSplitObjCmd;
+static Tcl_ObjCmdProc Rivet_CommaJoinObjCmd;
+static Tcl_ObjCmdProc Rivet_LassignArrayObjCmd;
+
+/*-----------------------------------------------------------------------------
+ * Rivet_LremoveObjCmd --
+ * Implements the lremove command:
+ * lremove ?-exact|-glob|-regexp? -all list pattern ..?pattern?..?pattern?
+ *-----------------------------------------------------------------------------
+ */
+static int
+Rivet_LremoveObjCmd( clientData, interp, objc, objv )
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+#define EXACT 0
+#define GLOB 1
+#define REGEXP 2
+ int listObjc, i, j, match, mode, patternLen, valueLen;
+ int list, all, done, append;
+ char *modeStr, *pattern, *value;
+ Tcl_Obj **listObjv, *matchedListPtr = NULL;
+
+ if( objc < 3 ) {
+ Tcl_WrongNumArgs( interp, 1, objv,
+ "?mode? ?-all? list ?pattern?.. ?pattern?..");
+ return TCL_ERROR;
+ }
+
+ list = 1;
+ all = 0;
+ mode = GLOB;
+
+ /* Check arguments to see if they are switches.
+ * Switches: -glob, -regexp, -exact, -all
+ */
+ for( i = 1; i < objc; ++i )
+ {
+ modeStr = Tcl_GetStringFromObj(objv[i], NULL);
+ if( modeStr[0] != '-' ) break;
+
+ if( STREQU(modeStr, "-exact") ) {
+ mode = EXACT;
+ list++;
+ } else if( STREQU(modeStr, "-glob") ) {
+ mode = GLOB;
+ list++;
+ } else if( STREQU(modeStr, "-regexp") ) {
+ mode = REGEXP;
+ list++;
+ } else if( STREQU(modeStr, "-all") ) {
+ all = 1;
+ list++;
+ } else if( STREQU(modeStr, "--") ) {
+ list++;
+ break;
+ } else {
+ Tcl_AppendResult( interp, "bad switch \"", modeStr,
+ "\": must be -exact, -glob, -regexp or -all",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if( list >= objc - 1 ) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?mod? ?-all? list pattern");
+ return TCL_ERROR;
+ }
+
+ if( Tcl_ListObjGetElements(interp, objv[list],
+ &listObjc, &listObjv) != TCL_OK)
+ return TCL_ERROR;
+
+ done = 0;
+ for(i = 0; i < listObjc; i++)
+ {
+ match = 0;
+ value = Tcl_GetStringFromObj(listObjv[i], &valueLen);
+
+ /* We're done. Append the rest of the elements and return */
+ if( done ) {
+ if (matchedListPtr == NULL) {
+ matchedListPtr = Tcl_NewListObj(0, NULL);
+ }
+ if (Tcl_ListObjAppendElement(interp, matchedListPtr,
+ listObjv[i]) != TCL_OK) {
+ goto errorExit;
+ }
+ continue;
+ }
+
+ append = list + 1;
+ for( j = list + 1; j < objc; ++j )
+ {
+ pattern = Tcl_GetStringFromObj(objv[j], &patternLen);
+ if( (mode != EXACT) && (strlen(pattern) != (size_t)patternLen) ) {
+ goto binData;
+ }
+
+ switch(mode) {
+ case EXACT:
+ match = (valueLen == patternLen) &&
+ (memcmp(value, pattern, (unsigned)valueLen) == 0);
+ break;
+
+ case GLOB:
+ if( strlen(value) != (size_t)valueLen ) {
+ goto binData;
+ }
+ match = Tcl_StringMatch(value, pattern);
+ break;
+
+ case REGEXP:
+ if( strlen(value) != (size_t)valueLen ) {
+ goto binData;
+ }
+ match = Tcl_RegExpMatch(interp, value, pattern);
+ if( match < 0 ) {
+ goto errorExit;
+ }
+ break;
+ }
+ /* It's not in the pattern we're looking for.
+ * Check the next pattern.
+ */
+ if( !match ) {
+ append++;
+ continue;
+ }
+
+ /* We found a match, and we're not looking for anymore */
+ if( !all ) {
+ done = 1;
+ break;
+ }
+ }
+
+ /* We're done. Append the rest of the elements and return */
+ if( done ) continue;
+
+ /* If append is equal to j, the value made it through all the patterns
+ * without matching, so we append it to our return list.
+ */
+ if( append == j ) {
+ if (matchedListPtr == NULL) {
+ matchedListPtr = Tcl_NewListObj(0, NULL);
+ }
+ if (Tcl_ListObjAppendElement(interp, matchedListPtr,
+ listObjv[i]) != TCL_OK)
+ goto errorExit;
+ }
+ }
+
+ if( matchedListPtr != NULL ) {
+ Tcl_SetObjResult(interp, matchedListPtr);
+ }
+ return TCL_OK;
+
+ errorExit:
+ if(matchedListPtr != NULL)
+ Tcl_DecrRefCount(matchedListPtr);
+ return TCL_ERROR;
+
+ binData:
+ Tcl_AppendResult(interp, "Binary data is not supported in this mode.",
+ (char *) NULL);
+ 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("", -1);
+
+ 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 --
+ * Initialize the list commands in an interpreter.
+ *
+ * These routines have been examined and are believed to be safe in a safe
+ * interpreter, as they only manipulate Tcl lists, strings, and arrays.
+ *
+ * Parameters:
+ * o interp - Interpreter to add commands to.
+ * o rivet_ns - Tcl_Namespace pointer to the RIVET_NS namespace.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int
+Rivet_InitList( Tcl_Interp *interp)
+{
+ RIVET_OBJ_CMD("lremove",Rivet_LremoveObjCmd);
+ RIVET_OBJ_CMD("comma_split",Rivet_CommaSplitObjCmd);
+ RIVET_OBJ_CMD("comma_join",Rivet_CommaJoinObjCmd);
+ RIVET_OBJ_CMD("lassign_array",Rivet_LassignArrayObjCmd);
+
+ return TCL_OK;
+}
Propchange: tcl/rivet/trunk/src/librivet/rivetList.c
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: tcl/rivet/trunk/src/librivet/rivetList.c
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Added: tcl/rivet/trunk/src/librivet/rivetPkgInit.c
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/src/librivet/rivetPkgInit.c?rev=1386543&view=auto
==============================================================================
--- tcl/rivet/trunk/src/librivet/rivetPkgInit.c (added)
+++ tcl/rivet/trunk/src/librivet/rivetPkgInit.c Mon Sep 17 10:23:41 2012
@@ -0,0 +1,152 @@
+/*
+ * rivetPkgInit.c - Initialize all of the Rivet commands into a Tcl interp.
+ */
+
+/* Copyright 2002-2004 The Apache Software Foundation
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/* Rivet config */
+#ifdef HAVE_CONFIG_H
+#include <rivet_config.h>
+#endif
+
+#include <tcl.h>
+#include "rivet.h"
+#include "mod_rivet.h"
+
+/*-----------------------------------------------------------------------------
+ * Rivet_GetNamespace --
+ *
+ * Get the rivet namespace pointer. The procedure attempts to retrieve a
+ * pointer to the Tcl_Namespace structure for the ::rivet namespace. This
+ * pointer is stored in the interpreter's associated data (pointing to a
+ * rivet_interp_globals structure) if the interpreter is passed by mod_rivet.
+ * Otherwise a new ::rivet namespace is created and its Tcl_Namespace
+ * pointer is returned
+ *
+ * Parameters:
+ *
+ * o interp - Interpreter to add commands to.
+ *
+ * Returned value:
+ *
+ * o rivet_ns - Tcl_Namespace* pointer to the RIVET_NS (::rivet) namespace
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+#if RIVET_NAMESPACE_EXPORT == 1
+
+static Tcl_Namespace*
+Rivet_GetNamespace( Tcl_Interp* interp)
+{
+ rivet_interp_globals *globals;
+ Tcl_Namespace *rivet_ns;
+
+ globals = Tcl_GetAssocData(interp, "rivet", NULL);
+ if (globals != NULL)
+ {
+ rivet_ns = globals->rivet_ns;
+ }
+ else
+ {
+// fprintf(stderr,"no Associated data found, running standalone\n");
+ rivet_ns = Tcl_FindNamespace(interp, RIVET_NS, NULL, TCL_GLOBAL_ONLY);
+ if (rivet_ns == NULL) {
+ /* The namespace does not exist, create it */
+ rivet_ns = Tcl_CreateNamespace (interp, RIVET_NS, NULL,
+ (Tcl_NamespaceDeleteProc *)NULL);
+ }
+ }
+
+ return rivet_ns;
+}
+#endif
+
+/*-----------------------------------------------------------------------------
+ * Rivetlib_Init --
+ *
+ * Install the commands provided by librivet into an interpreter.
+ *
+ * Parameters:
+ *
+ * o interp - Interpreter to add commands to.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int
+Rivetlib_Init( Tcl_Interp *interp )
+{
+#if RIVET_NAMESPACE_EXPORT == 1
+ Tcl_Namespace *rivet_ns;
+#endif
+
+#ifdef USE_TCL_STUBS
+ if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+#else
+ if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
+#endif
+ return TCL_ERROR;
+ }
+
+ Rivet_InitList (interp);
+ Rivet_InitCrypt(interp);
+ Rivet_InitWWW (interp);
+#if RIVET_NAMESPACE_EXPORT == 1
+ rivet_ns = Rivet_GetNamespace(interp);
+ Tcl_Export(interp,rivet_ns,"*",0);
+#endif
+
+ return Tcl_PkgProvide( interp, RIVETLIB_TCL_PACKAGE, "1.2" );
+}
+
+/*-----------------------------------------------------------------------------
+ * Rivetlib_SafeInit --
+ * Install the commands provided by librivet that are believed to be
+ * safe for use in safe interpreters, into a safe interpreter.
+ *
+ * Parameters:
+ *
+ * o interp - Interpreter to add commands to.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int
+Rivetlib_SafeInit( Tcl_Interp *interp )
+{
+#if RIVET_NAMESPACE_EXPORT == 1
+ Tcl_Namespace *rivet_ns;
+#endif
+
+#ifdef USE_TCL_STUBS
+ if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+#else
+ if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
+#endif
+ return TCL_ERROR;
+ }
+
+ Rivet_InitList(interp);
+ Rivet_InitCrypt(interp);
+ Rivet_InitWWW(interp);
+
+#if RIVET_NAMESPACE_EXPORT == 1
+ rivet_ns = Rivet_GetNamespace(interp);
+ Tcl_Export(interp,rivet_ns,"*",0);
+#endif
+ return Tcl_PkgProvide( interp, RIVETLIB_TCL_PACKAGE, "1.2" );
+}
Propchange: tcl/rivet/trunk/src/librivet/rivetPkgInit.c
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: tcl/rivet/trunk/src/librivet/rivetPkgInit.c
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Added: tcl/rivet/trunk/src/librivet/rivetWWW.c
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/src/librivet/rivetWWW.c?rev=1386543&view=auto
==============================================================================
--- tcl/rivet/trunk/src/librivet/rivetWWW.c (added)
+++ tcl/rivet/trunk/src/librivet/rivetWWW.c Mon Sep 17 10:23:41 2012
@@ -0,0 +1,362 @@
+/*
+ * rivetWWW.c - Rivet commands designed for use with the world wide web.
+ */
+
+/* Copyright 2002-2004 The Apache Software Foundation
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+*/
+
+/* $Id$ */
+
+/* Rivet config */
+#ifdef HAVE_CONFIG_H
+#include <rivet_config.h>
+#endif
+
+#include <tcl.h>
+#include <ctype.h>
+#include "rivet.h"
+
+#ifdef WIN32
+#define snprintf _snprintf
+#endif
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * 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 ) );
+ Tcl_Free(newString);
+ 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 ((int)c)) {
+ *newStringP++ = c;
+ } else if (c == ' ') {
+ *newStringP++ = '+';
+ } 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 ) );
+ Tcl_Free(newString);
+ 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 ) );
+ Tcl_Free(newString);
+ 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 ) );
+ Tcl_Free(newString);
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ * Rivet_InitWWW --
+ *
+ * Initialize the WWW functions.
+ *
+ * These functions have been examined and are believed to be safe for use
+ * in safe interpreters, as they process strings only.
+ *-----------------------------------------------------------------------------
+ */
+
+int
+Rivet_InitWWW( Tcl_Interp *interp)
+{
+ RIVET_OBJ_CMD ("unescape_string",Rivet_UnescapeStringCmd);
+ RIVET_OBJ_CMD ("escape_string",Rivet_EscapeStringCmd);
+ RIVET_OBJ_CMD ("escape_sgml_chars",Rivet_EscapeSgmlCharsCmd);
+ RIVET_OBJ_CMD ("escape_shell_command",Rivet_EscapeShellCommandCmd);
+ return TCL_OK;
+}
Propchange: tcl/rivet/trunk/src/librivet/rivetWWW.c
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: tcl/rivet/trunk/src/librivet/rivetWWW.c
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Added: tcl/rivet/trunk/src/parser/Makefile.am
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/src/parser/Makefile.am?rev=1386543&view=auto
==============================================================================
--- tcl/rivet/trunk/src/parser/Makefile.am (added)
+++ tcl/rivet/trunk/src/parser/Makefile.am Mon Sep 17 10:23:41 2012
@@ -0,0 +1,31 @@
+# Makefile for Rivet
+
+# Copyright 2004-2005 The Apache Software Foundation
+
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+
+# http://www.apache.org/licenses/LICENSE-2.0
+
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+INCLUDES = @apache_include@ -I../@apache_version_dir@ -I..
+
+# ... and these two. We want to put the libs in the package path,
+# rather than the standard library location for the system.
+lib_libexecdir = @RIVET_TCL_TARGET@
+lib_libexec_LTLIBRARIES = librivetparser.la
+
+#
+# Rivet Parser Library
+#
+librivetparser_la_SOURCES = rivetParser.c parserPkgInit.c
+librivetparser_la_LDFLAGS = @TCL_STUB_LIB_SPEC@ @APXS_LDFLAGS@ -module -avoid-version
+librivetparser_la_LIBADD = @APXS_LIBS@
+librivetparser_la_CPPFLAGS = @TCL_INCLUDES@ @APXS_CPPFLAGS@ @APXS_INCLUDES@ -DSTART_TAG='"<?"' -DEND_TAG='"?>"' -DUSE_TCL_STUBS
+
---------------------------------------------------------------------
To unsubscribe, e-mail: rivet-cvs-unsubscribe@tcl.apache.org
For additional commands, e-mail: rivet-cvs-help@tcl.apache.org