diff options
Diffstat (limited to 'tclxml/tclxslt-libxslt.c')
-rw-r--r-- | tclxml/tclxslt-libxslt.c | 1872 |
1 files changed, 1872 insertions, 0 deletions
diff --git a/tclxml/tclxslt-libxslt.c b/tclxml/tclxslt-libxslt.c new file mode 100644 index 0000000..9155f0e --- /dev/null +++ b/tclxml/tclxslt-libxslt.c @@ -0,0 +1,1872 @@ +/* + * tclxslt.c -- + * + * Interface to Gnome libxslt. + * + * Copyright (c) 2005-2007 Explain + * http://www.explain.com.au/ + * Copyright (c) 2001-2004 Zveno Pty Ltd + * http://www.zveno.com/ + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: tclxslt-libxslt.c,v 1.2 2016/01/15 21:06:01 joye Exp $ + * + */ + +#include <tclxslt/tclxslt.h> +#include <string.h> +#include <libxslt/imports.h> +#include <libxslt/security.h> + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT + +#ifdef __WIN32__ +/*# include "win/win32config.h"*/ +#endif + +/* + * Manage stylesheet objects + */ + +typedef struct TclXSLT_Stylesheet { + Tcl_Interp *interp; + char *name; + xsltStylesheetPtr stylesheet; + Tcl_HashEntry *entryPtr; + + Tcl_Obj *resulturi; + Tcl_Obj *profilechannelObj; + + Tcl_Obj *messagecommand; +} TclXSLT_Stylesheet; + +/* + * Extension management + */ + +typedef struct TclXSLT_Extension { + Tcl_Interp *interp; + Tcl_Obj *nsuri; + Tcl_Obj *tclns; + xsltTransformContextPtr xformCtxt; +} TclXSLT_Extension; + +typedef struct ThreadSpecificData { + int initialised; + Tcl_Interp *interp; + int ssheetCntr; + Tcl_HashTable *stylesheets; + Tcl_HashTable *extensions; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* + * Prototypes for procedures defined later in this file: + */ + +/* + * Forward declarations for private functions. + */ + +static void TclXSLTGenericError _ANSI_ARGS_((void *ctx, const char *msg, ...)); + +static int TclXSLTCompileCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static int TclXSLTInstanceCommand _ANSI_ARGS_((ClientData ssheet, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static void TclXSLTDeleteStylesheet _ANSI_ARGS_((ClientData ssheet)); +static int TclXSLTExtensionCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); + +static Tcl_Obj * GetParameters _ANSI_ARGS_((Tcl_Interp *interp, + xsltStylesheetPtr stylesheet)); +static int TclXSLTTransform _ANSI_ARGS_((TclXSLT_Stylesheet *stylesheet, + Tcl_Obj *source, + int paramc, + Tcl_Obj *CONST paramv[])); + +static void TclXSLT_RegisterAll _ANSI_ARGS_((TclXSLT_Extension *extinfo, + const xmlChar *nsuri)); + +/* static xsltExtInitFunction TclXSLTExtInit; */ +static void *TclXSLTExtInit _ANSI_ARGS_((xsltTransformContextPtr ctxt, + const xmlChar *URI)); +/* static xsltExtShutdownFunction TclXSLTExtShutdown; */ +static void TclXSLTExtShutdown _ANSI_ARGS_((xsltTransformContextPtr ctxt, + const xmlChar *URI, + void *userdata)); +/* static xmlXPathEvalFunc TclXSLTExtFunction; */ +static void TclXSLTExtFunction _ANSI_ARGS_((xmlXPathParserContextPtr xpathCtxt, + int nargs)); +/* static xsltPreComputeFunction TclXSLTExtElementPreComp; */ +static void TclXSLTExtElementPreComp _ANSI_ARGS_((xsltStylesheetPtr style, + xmlNodePtr inst, + xsltTransformFunction function)); +/* static xsltTransformFunction TclXSLTExtElementTransform; */ +static void TclXSLTExtElementTransform _ANSI_ARGS_((xsltTransformContextPtr ctxt, + xmlNodePtr node, + xmlNodePtr inst, + xsltStylePreCompPtr comp)); +/* static xsltSecurityCheck TclXSLTSecurityReadFile; */ +static int TclXSLTSecurityReadFile _ANSI_ARGS_((xsltSecurityPrefsPtr sec, + xsltTransformContextPtr ctxt, + const char *value)); +/* static xsltSecurityCheck TclXSLTSecurityWriteFile; */ +static int TclXSLTSecurityWriteFile _ANSI_ARGS_((xsltSecurityPrefsPtr sec, + xsltTransformContextPtr ctxt, + const char *value)); +/* static xsltSecurityCheck TclXSLTSecurityCreateDirectory; */ +static int TclXSLTSecurityCreateDirectory _ANSI_ARGS_((xsltSecurityPrefsPtr sec, + xsltTransformContextPtr ctxt, + const char *value)); +/* static xsltSecurityCheck TclXSLTSecurityReadNetwork; */ +static int TclXSLTSecurityReadNetwork _ANSI_ARGS_((xsltSecurityPrefsPtr sec, + xsltTransformContextPtr ctxt, + const char *value)); +/* static xsltSecurityCheck TclXSLTSecurityWriteNetwork; */ +static int TclXSLTSecurityWriteNetwork _ANSI_ARGS_((xsltSecurityPrefsPtr sec, + xsltTransformContextPtr ctxt, + const char *value)); + +static Tcl_Obj * TclXSLT_ConvertXPathObjToTclObj _ANSI_ARGS_((Tcl_Interp *interp, + xmlXPathObjectPtr xpobj)); +static xmlXPathObjectPtr TclXSLT_ConvertTclObjToXPathObj _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); + +/* + * Error context for passing error result back to caller. + */ + +typedef struct GenericError_Info { + Tcl_Interp *interp; + TclXSLT_Stylesheet *stylesheet; + int code; + Tcl_Obj *msg; +} GenericError_Info; + +/* + * Switch tables + */ + +#ifndef CONST84 +#define CONST84 /* Before 8.4 no 'const' required */ +#endif + +static CONST84 char *instanceCommandMethods[] = { + "cget", + "configure", + "get", + "transform", + (char *) NULL +}; +enum instanceCommandMethods { + TCLXSLT_CGET, + TCLXSLT_CONFIGURE, + TCLXSLT_GET, + TCLXSLT_TRANSFORM +}; +static CONST84 char *instanceCommandOptions[] = { + "-messagecommand", + "-method", + "-indent", + "-resulturi", + "-profilechannel", + "-encoding", + "-omitxmldeclaration", + (char *) NULL +}; +enum instanceCommandOptions { + TCLXSLT_OPTION_MESSAGECOMMAND, + TCLXSLT_OPTION_METHOD, + TCLXSLT_OPTION_INDENT, + TCLXSLT_OPTION_RESULTURI, + TCLXSLT_OPTION_PROFILECHANNEL, + TCLXSLT_OPTION_ENCODING, + TCLXSLT_OPTION_OMITXMLDECLARATION +}; + +static CONST84 char *instanceGetMethods[] = { + "parameters", + (char *) NULL +}; +enum instanceGetMethods { + TCLXSLT_GET_PARAMETERS +}; + +static CONST84 char *extensionCommandMethods[] = { + "add", + "remove", + (char *) NULL +}; +enum extensionCommandMethods { + TCLXSLT_EXT_ADD, + TCLXSLT_EXT_REMOVE +}; + +/* + * libxml2 and libxslt are mostly thread-safe, + * but there are issues with error callbacks. + */ + +TCL_DECLARE_MUTEX(libxslt) + +/* + *---------------------------------------------------------------------------- + * + * Tclxslt_libxslt_Init -- + * + * Initialisation routine for loadable module + * + * Results: + * None. + * + * Side effects: + * Creates commands in the interpreter, + * + *---------------------------------------------------------------------------- + */ + +int +Tclxslt_libxslt_Init (interp) + Tcl_Interp *interp; /* Interpreter to initialise */ +{ + ThreadSpecificData *tsdPtr; + xsltSecurityPrefsPtr sec; + + tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + if (!tsdPtr->initialised) { + tsdPtr->initialised = 1; + tsdPtr->interp = interp; + tsdPtr->ssheetCntr = 0; + tsdPtr->stylesheets = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(tsdPtr->stylesheets, TCL_ONE_WORD_KEYS); + tsdPtr->extensions = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(tsdPtr->extensions, TCL_STRING_KEYS); + } /* only need to init the library once per process */ + + Tcl_CreateObjCommand(interp, "xslt::compile", TclXSLTCompileCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "xslt::extension", TclXSLTExtensionCommand, NULL, NULL); + + Tcl_MutexLock(&libxslt); +#ifndef TCLXML_STATIC_TCLXSLT + exsltRegisterAll(); +#endif /* TCLXML_STATIC_TCLXSLT */ + + /* + * Setup security preferences + */ + sec = xsltNewSecurityPrefs(); + if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_READ_FILE, + TclXSLTSecurityReadFile)) { + Tcl_SetResult(interp, "unable to set readfile security", NULL); + return TCL_ERROR; + } + if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_WRITE_FILE, + TclXSLTSecurityWriteFile)) { + Tcl_SetResult(interp, "unable to set writefile security", NULL); + return TCL_ERROR; + } + if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_CREATE_DIRECTORY, + TclXSLTSecurityCreateDirectory)) { + Tcl_SetResult(interp, "unable to set createdirectory security", NULL); + return TCL_ERROR; + } + if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_READ_NETWORK, + TclXSLTSecurityReadNetwork)) { + Tcl_SetResult(interp, "unable to set readnetwork security", NULL); + return TCL_ERROR; + } + if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_WRITE_NETWORK, + TclXSLTSecurityWriteNetwork)) { + Tcl_SetResult(interp, "unable to set writenetwork security", NULL); + return TCL_ERROR; + } + /* xsltSetCtxtSecurityPrefs(sec, userCtxt); */ + xsltSetDefaultSecurityPrefs(sec); + + Tcl_MutexUnlock(&libxslt); + + Tcl_SetVar2Ex(interp, "::xslt::libxsltversion", NULL, Tcl_NewStringObj(xsltEngineVersion, -1), 0); + Tcl_SetVar2Ex(interp, "::xslt::libexsltversion", NULL, Tcl_NewStringObj(exsltLibraryVersion, -1), 0); + + return TCL_OK; +} + +/* + * XSLT is not safe due to the document(), xsl:include and xsl:import functions/elements. + * However, libxslt checks whether access is permitted to external resources. + * + * NOTE: need to make sure decision to allow access to resources is made by a trusted interpreter, not the untrusted slave. Even better, use a mechanism similar to TclXML/libxml2 to access external resources. + */ + +int +Tclxslt_libxslt_SafeInit (interp) + Tcl_Interp *interp; /* Interpreter to initialise */ +{ + return Tclxslt_libxslt_Init(interp); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTCompileCommand -- + * + * Class creation command for xslt stylesheet objects. + * + * Results: + * Compiles the XSLT stylesheet. + * Creates a Tcl command associated with that stylesheet. + * + * Side effects: + * Memory allocated, stylesheet is compiled. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXSLTCompileCommand(dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXSLT_Stylesheet *info; + xmlDocPtr origDoc, doc; + xsltStylesheetPtr ssheetPtr = NULL; + void *oldxsltErrorCtx, *oldxmlErrorCtx; + xmlGenericErrorFunc old_xsltGenericError, old_xmlGenericError; + GenericError_Info *errorInfoPtr; + Tcl_Obj *errObjPtr = NULL; + int new; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "stylesheet-doc"); + return TCL_ERROR; + } + + if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &origDoc) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_MutexLock(&libxslt); + doc = xmlCopyDoc(origDoc, 1); + /* + * xmlCopyDoc doesn't copy some of the fields. + */ + if (origDoc->URL) { + doc->URL = (const xmlChar *) Tcl_Alloc(strlen((char *) origDoc->URL) + 1); + strcpy((char *) doc->URL, (char *) origDoc->URL); + } + + /* + * Prepare for compiling stylesheet + */ + + TclXML_libxml2_ResetError(interp); + + errorInfoPtr = (GenericError_Info *) Tcl_Alloc(sizeof(GenericError_Info)); + errorInfoPtr->interp = interp; + errorInfoPtr->stylesheet = NULL; + errorInfoPtr->code = TCL_OK; + errorInfoPtr->msg = NULL; + xmlSetGenericErrorFunc((void *) errorInfoPtr, + TclXSLTGenericError); + + /* + * Save the previous error context so that it can + * be restored upon completion of the operation. + */ + old_xsltGenericError = xsltGenericError; + oldxsltErrorCtx = xsltGenericErrorContext; + old_xmlGenericError = xmlGenericError; + oldxmlErrorCtx = xmlGenericErrorContext; + + xmlSetGenericErrorFunc((void *) errorInfoPtr, + TclXSLTGenericError); + xsltSetGenericErrorFunc((void *) errorInfoPtr, TclXSLTGenericError); + + /* + * Compile stylesheet + */ + + ssheetPtr = xsltParseStylesheetDoc(doc); + + xmlSetGenericErrorFunc((void *) oldxmlErrorCtx, old_xmlGenericError); + xsltSetGenericErrorFunc((void *) oldxsltErrorCtx, old_xsltGenericError); + + Tcl_MutexUnlock(&libxslt); + + errObjPtr = TclXML_libxml2_GetErrorObj(interp); + + if (ssheetPtr == NULL) { + Tcl_SetResult(interp, "error compiling stylesheet", NULL); + goto error; + } + + if (ssheetPtr->errors > 0) { + Tcl_SetResult(interp, "error compiling XSLT stylesheet", NULL); + goto error; + } + + if (errorInfoPtr->code != TCL_OK) { + goto error; + } + + /* TODO: notify app of any warnings */ + + info = (TclXSLT_Stylesheet *) Tcl_Alloc(sizeof(TclXSLT_Stylesheet)); + info->interp = interp; + info->name = Tcl_Alloc(20); + sprintf(info->name, "style%d", tsdPtr->ssheetCntr++); + info->stylesheet = ssheetPtr; + info->messagecommand = NULL; + info->resulturi = NULL; + info->profilechannelObj = NULL; + + /* + * Create reverse mapping of stylesheet to name of stylesheet command. + */ + info->entryPtr = Tcl_CreateHashEntry(tsdPtr->stylesheets, (ClientData) ssheetPtr, &new); + /* sanity check: new == 1 */ + Tcl_SetHashValue(info->entryPtr, (ClientData) info->name); + + Tcl_CreateObjCommand(interp, info->name, TclXSLTInstanceCommand, (ClientData) info, TclXSLTDeleteStylesheet); + + Tcl_SetObjResult(interp, Tcl_NewStringObj(info->name, -1)); + + return TCL_OK; + +error: + + if (errObjPtr) { + Tcl_SetObjResult(interp, errObjPtr); + } else if (errorInfoPtr->msg) { + Tcl_SetObjResult(interp, errorInfoPtr->msg); + Tcl_DecrRefCount(errorInfoPtr->msg); + } + Tcl_Free((char *) errorInfoPtr); + + Tcl_MutexLock(&libxslt); + if (ssheetPtr) { + xsltFreeStylesheet(ssheetPtr); + } else { + xmlFreeDoc(doc); + } + Tcl_MutexUnlock(&libxslt); + + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTDeleteStylesheet -- + * + * Class destruction command for xslt stylesheet objects. + * + * Results: + * Frees memory associated with a stylesheet. + * + * Side effects: + * Memory deallocated. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXSLTDeleteStylesheet(clientData) + ClientData clientData; +{ + TclXSLT_Stylesheet *ssheet = (TclXSLT_Stylesheet *) clientData; + + Tcl_DeleteHashEntry(ssheet->entryPtr); + + Tcl_Free(ssheet->name); + if (ssheet->messagecommand) { + Tcl_DecrRefCount(ssheet->messagecommand); + } + if (ssheet->resulturi) { + Tcl_DecrRefCount(ssheet->resulturi); + } + if (ssheet->profilechannelObj) { + Tcl_DecrRefCount(ssheet->profilechannelObj); + } + Tcl_MutexLock(&libxslt); + xsltFreeStylesheet(ssheet->stylesheet); /* Also frees document */ + Tcl_MutexUnlock(&libxslt); + Tcl_Free((char *) ssheet); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTInstanceCommand -- + * + * Handles the stylesheet object command. + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXSLTInstanceCommand(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + TclXSLT_Stylesheet *ssheet = (TclXSLT_Stylesheet *) clientData; + int method, option, indent = 0, theOmitXMLDeclaration = 0; + const xmlChar *theMethod, *theEncoding; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "method ?args ...?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], instanceCommandMethods, + "method", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum instanceCommandMethods) method) { + case TCLXSLT_CGET: + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[2], instanceCommandOptions, + "option", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum instanceCommandOptions) option) { + + case TCLXSLT_OPTION_METHOD: + XSLT_GET_IMPORT_PTR(theMethod, ssheet->stylesheet, method); + if (theMethod != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) theMethod, -1)); + } /* theMethod == NULL means XML method; result should be empty. + EXCEPTION: if the result document is of type XML_HTML_DOCUMENT_NODE + then the method should be "html". + */ + break; + + case TCLXSLT_OPTION_ENCODING: + XSLT_GET_IMPORT_PTR(theEncoding, ssheet->stylesheet, encoding); + if (theEncoding != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) theEncoding, -1)); + } /* theEncoding == NULL means default (UTF-8) encoding; result should be empty. + */ + break; + + case TCLXSLT_OPTION_OMITXMLDECLARATION: + XSLT_GET_IMPORT_INT(theOmitXMLDeclaration, ssheet->stylesheet, omitXmlDeclaration); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(theOmitXMLDeclaration == 1)); + break; + + case TCLXSLT_OPTION_INDENT: + XSLT_GET_IMPORT_INT(indent, ssheet->stylesheet, indent); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(indent)); + break; + + case TCLXSLT_OPTION_MESSAGECOMMAND: + if (ssheet->messagecommand != NULL) { + Tcl_SetObjResult(interp, ssheet->messagecommand); + } + break; + + case TCLXSLT_OPTION_RESULTURI: + if (ssheet->resulturi != NULL) { + Tcl_SetObjResult(interp, ssheet->resulturi); + } + break; + + case TCLXSLT_OPTION_PROFILECHANNEL: + if (ssheet->profilechannelObj != NULL) { + Tcl_SetObjResult(interp, ssheet->profilechannelObj); + } + break; + + default: + Tcl_SetResult(interp, "unknown option", NULL); + return TCL_ERROR; + } + + break; + + case TCLXSLT_CONFIGURE: + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "option value"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[2], instanceCommandOptions, + "option", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum instanceCommandOptions) option) { + + case TCLXSLT_OPTION_METHOD: + case TCLXSLT_OPTION_INDENT: + case TCLXSLT_OPTION_ENCODING: + case TCLXSLT_OPTION_OMITXMLDECLARATION: + Tcl_SetResult(interp, "read-only option", NULL); + return TCL_ERROR; + break; + + case TCLXSLT_OPTION_MESSAGECOMMAND: + if (ssheet->messagecommand != NULL) { + Tcl_DecrRefCount(ssheet->messagecommand); + } + ssheet->messagecommand = objv[3]; + Tcl_IncrRefCount(ssheet->messagecommand); + break; + + case TCLXSLT_OPTION_RESULTURI: + if (ssheet->resulturi != NULL) { + Tcl_DecrRefCount(ssheet->resulturi); + } + ssheet->resulturi = objv[3]; + Tcl_IncrRefCount(ssheet->resulturi); + break; + + case TCLXSLT_OPTION_PROFILECHANNEL: + if (ssheet->profilechannelObj != NULL) { + Tcl_DecrRefCount(ssheet->profilechannelObj); + } +#ifdef __WIN32__ + Tcl_SetResult(interp, "profiling not available", NULL); + return TCL_ERROR; +#else + ssheet->profilechannelObj = objv[3]; + Tcl_IncrRefCount(ssheet->profilechannelObj); +#endif + break; + + default: + Tcl_SetResult(interp, "unknown option", NULL); + return TCL_ERROR; + } + + break; + + case TCLXSLT_GET: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "name"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[2], instanceGetMethods, + "name", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum instanceGetMethods) option) { + case TCLXSLT_GET_PARAMETERS: + + Tcl_SetObjResult(interp, GetParameters(interp, ssheet->stylesheet)); + break; + + default: + Tcl_SetResult(interp, "unknown name", NULL); + return TCL_ERROR; + } + + break; + + case TCLXSLT_TRANSFORM: + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "source ?param value...?"); + return TCL_ERROR; + } + + return TclXSLTTransform(ssheet, objv[2], objc - 3, &objv[3]); + + break; + + default: + Tcl_SetResult(interp, "unknown method", NULL); + return TCL_OK; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTTransform -- + * + * Performs an XSL transformation. + * + * Results: + * Result document created. + * + * Side effects: + * Memory allocated for result document. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXSLTTransform(stylesheet, source, paramc, paramv) + TclXSLT_Stylesheet *stylesheet; + Tcl_Obj *source; + int paramc; + Tcl_Obj *CONST paramv[]; +{ + xmlDocPtr doc, result; + char **params = NULL; + int nbparams = 0, i; + GenericError_Info *errorInfoPtr; + void *oldxsltErrorCtx, *oldxmlErrorCtx; + xmlGenericErrorFunc old_xsltGenericError, old_xmlGenericError; + Tcl_Obj *resultObjPtr, *errObjPtr = NULL; + char *resulturi = NULL; + FILE *profile = NULL; + xsltTransformContextPtr userCtxt = NULL; + + errorInfoPtr = (GenericError_Info *) Tcl_Alloc(sizeof(GenericError_Info)); + errorInfoPtr->interp = stylesheet->interp; + errorInfoPtr->stylesheet = stylesheet; + errorInfoPtr->code = TCL_OK; + errorInfoPtr->msg = NULL; + + if (TclXML_libxml2_GetDocFromObj(stylesheet->interp, source, &doc) != TCL_OK) { + goto error; + } + + TclXML_libxml2_ResetError(stylesheet->interp); + + params = (char **) Tcl_Alloc(sizeof(char **) * (paramc + 1)); + for (i = 0; i < paramc; i++) { + params[nbparams++] = Tcl_GetStringFromObj(paramv[i++], NULL); + params[nbparams++] = Tcl_GetStringFromObj(paramv[i], NULL); + } + params[nbparams] = NULL; + + if (stylesheet->resulturi) { + resulturi = Tcl_GetStringFromObj(stylesheet->resulturi, NULL); + } +#ifdef __WIN32__ + /* Tcl_GetOpenFile not available on Windows */ +#else + if (stylesheet->profilechannelObj) { + if (Tcl_GetOpenFile(stylesheet->interp, + Tcl_GetStringFromObj(stylesheet->profilechannelObj, NULL), + 1, 1, + (ClientData *) &profile) != TCL_OK) { + goto error; + } + } +#endif + + /* + * Perform the transformation + */ + + Tcl_MutexLock(&libxslt); + + /* + * Save the previous error context so that it can + * be restored upon completion of the transformation. + * This is necessary because transformations may occur + * recursively (usually due to extensions). + */ + old_xsltGenericError = xsltGenericError; + oldxsltErrorCtx = xsltGenericErrorContext; + old_xmlGenericError = xmlGenericError; + oldxmlErrorCtx = xmlGenericErrorContext; + + xmlSetGenericErrorFunc((void *) errorInfoPtr, + TclXSLTGenericError); + xsltSetGenericErrorFunc((void *) errorInfoPtr, TclXSLTGenericError); + + userCtxt = xsltNewTransformContext(stylesheet->stylesheet, doc); + if (userCtxt == NULL) { + xmlSetGenericErrorFunc((void *) oldxmlErrorCtx, old_xmlGenericError); + xsltSetGenericErrorFunc((void *) oldxsltErrorCtx, old_xsltGenericError); + + Tcl_MutexUnlock(&libxslt); + Tcl_SetResult(stylesheet->interp, "unable to create transformation context", NULL); + goto error; + } + + result = xsltApplyStylesheetUser(stylesheet->stylesheet, + doc, + (const char **)params, + resulturi, + profile, + userCtxt); + + xsltFreeTransformContext(userCtxt); + + xmlSetGenericErrorFunc((void *) oldxmlErrorCtx, old_xmlGenericError); + xsltSetGenericErrorFunc((void *) oldxsltErrorCtx, old_xsltGenericError); + + Tcl_MutexUnlock(&libxslt); + + errObjPtr = TclXML_libxml2_GetErrorObj(stylesheet->interp); + + if (result == NULL) { + Tcl_Obj *resultPtr = Tcl_NewStringObj("no result document: ", -1); + + if (errObjPtr) { + Tcl_AppendObjToObj(resultPtr, errObjPtr); + Tcl_SetObjResult(stylesheet->interp, resultPtr); + goto error; + } else { + if (errorInfoPtr->msg) { + Tcl_AppendObjToObj(resultPtr, errorInfoPtr->msg); + } + + Tcl_SetObjResult(stylesheet->interp, resultPtr); + goto error; + } + } + + if ((errObjPtr || (errorInfoPtr->code != TCL_OK && errorInfoPtr->msg)) && stylesheet->messagecommand) { + + /* We have produced a result, but there may possibly + * have been errors. Trouble is, there might also + * have been some completely innocent messages. + * -messageCommand is the only way to find out about these. + */ + + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(stylesheet->messagecommand); + if (errObjPtr) { + if (Tcl_ListObjAppendElement(stylesheet->interp, cmdPtr, errObjPtr) != TCL_OK) { + goto error; + } + } else { + if (Tcl_ListObjAppendElement(stylesheet->interp, cmdPtr, errorInfoPtr->msg) != TCL_OK) { + goto error; + } + } + if (Tcl_GlobalEvalObj(stylesheet->interp, cmdPtr) != TCL_OK) { + Tcl_Obj *resultPtr = Tcl_NewStringObj("message command failed: ", -1); + + Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(stylesheet->interp)); + Tcl_SetObjResult(stylesheet->interp, resultPtr); + goto error; + } + + } + + resultObjPtr = TclDOM_libxml2_CreateObjFromDoc(stylesheet->interp, result); + Tcl_SetObjResult(stylesheet->interp, resultObjPtr); + + if (errorInfoPtr->msg) { + Tcl_DecrRefCount(errorInfoPtr->msg); + } + Tcl_Free((char *) errorInfoPtr); + Tcl_Free((char *) params); + + return TCL_OK; + + error: + + if (errorInfoPtr->msg) { + Tcl_DecrRefCount(errorInfoPtr->msg); + } + if (params) { + Tcl_Free((char *) params); + } + Tcl_Free((char *) errorInfoPtr); + + return TCL_ERROR; +} + +void +ListObjAppendUniqueList(interp, tablePtr, listPtr, newElementsPtr) + Tcl_Interp *interp; + Tcl_HashTable *tablePtr; + Tcl_Obj *listPtr; + Tcl_Obj *newElementsPtr; +{ + int len, idx; + Tcl_Obj *elementPtr, *keyPtr, *namePtr, *nameURIPtr; + Tcl_HashEntry *entryPtr; + + Tcl_ListObjLength(interp, newElementsPtr, &len); + for (idx = 0; idx < len; idx++) { + Tcl_ListObjIndex(interp, newElementsPtr, idx, &elementPtr); + Tcl_ListObjIndex(interp, elementPtr, 0, &namePtr); + Tcl_ListObjIndex(interp, elementPtr, 1, &nameURIPtr); + + keyPtr = Tcl_NewObj(); + Tcl_AppendStringsToObj(keyPtr, + Tcl_GetStringFromObj(nameURIPtr, NULL), + "^", + Tcl_GetStringFromObj(namePtr, NULL), + NULL); + entryPtr = Tcl_FindHashEntry(tablePtr, (CONST char *) keyPtr); + if (entryPtr == NULL) { + Tcl_ListObjAppendElement(interp, listPtr, elementPtr); + } + Tcl_DecrRefCount(keyPtr); + } +} + +/* + *---------------------------------------------------------------------------- + * + * GetParameters -- + * + * Retrieves the parameters for a stylesheet. + * + * Results: + * Returns a Tcl list object. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static Tcl_Obj * +GetParameters(interp, stylesheet) + Tcl_Interp *interp; + xsltStylesheetPtr stylesheet; +{ + Tcl_Obj *resultPtr, *objPtr, *keyPtr; + xsltStackElemPtr varPtr; + Tcl_HashTable entries; /* to keep track of parameter qnames */ + int new; + + if (stylesheet == NULL) { + return NULL; + } + + resultPtr = Tcl_NewListObj(0, NULL); + Tcl_InitObjHashTable(&entries); + + for (varPtr = stylesheet->variables; varPtr; varPtr = varPtr->next) { + Tcl_Obj *listPtr; + + if (strcmp((char *) varPtr->comp->inst->name, "param") == 0) { + listPtr = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((CONST char *) varPtr->name, -1)); + Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((CONST char *) varPtr->nameURI, -1)); + Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((CONST char *) varPtr->select, -1)); + + Tcl_ListObjAppendElement(interp, resultPtr, listPtr); + + keyPtr = Tcl_NewStringObj((CONST char *) varPtr->nameURI, -1); + Tcl_AppendStringsToObj(keyPtr, "^", varPtr->name, NULL); + Tcl_CreateHashEntry(&entries, (CONST char *) keyPtr, &new); + } + } + + objPtr = GetParameters(interp, stylesheet->next); + if (objPtr) { + ListObjAppendUniqueList(interp, &entries, resultPtr, objPtr); + } + objPtr = GetParameters(interp, stylesheet->imports); + if (objPtr) { + ListObjAppendUniqueList(interp, &entries, resultPtr, objPtr); + } + + Tcl_DeleteHashTable(&entries); + + return resultPtr; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTGenericError -- + * + * Handler for stylesheet errors. + * + * NB. Cannot distinguish between errors and use of xsl:message element. + * + * Results: + * Stores error message. + * + * Side effects: + * Transform will return error condition. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXSLTGenericError (void *ctx, const char *msg, ...) +{ + va_list args; + char buf[2048]; + int len; + GenericError_Info *errorInfoPtr = (GenericError_Info *) ctx; + + if (ctx < (void *) 0x1000) { + fprintf(stderr, "TclXSLT: bad context\n"); + va_start(args,msg); + vfprintf(stderr, msg, args); + va_end(args); + return; + } + + va_start(args,msg); + len = vsnprintf(buf, 2047, msg, args); + va_end(args); + + if (!errorInfoPtr->interp) { + return; + } + + if (errorInfoPtr->stylesheet && errorInfoPtr->stylesheet->messagecommand) { + + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(errorInfoPtr->stylesheet->messagecommand); + if (Tcl_ListObjAppendElement(errorInfoPtr->interp, cmdPtr, Tcl_NewStringObj(buf, len)) != TCL_OK) { + Tcl_BackgroundError(errorInfoPtr->interp); + return; + } + if (Tcl_GlobalEvalObj(errorInfoPtr->interp, cmdPtr) != TCL_OK) { + Tcl_BackgroundError(errorInfoPtr->interp); + return; + } + + } else { + + if (!errorInfoPtr->msg) { + errorInfoPtr->msg = Tcl_NewObj(); + Tcl_IncrRefCount(errorInfoPtr->msg); + } + + errorInfoPtr->code = TCL_ERROR; + + Tcl_AppendToObj(errorInfoPtr->msg, buf, len); + + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTExtensionCommand -- + * + * Command for xslt::extension command. + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method + * + *---------------------------------------------------------------------------- + */ + +static int +TclXSLTExtensionCommand(dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int method, new; + TclXSLT_Extension *extinfo; + Tcl_HashEntry *entry; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "method ?args ...?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], extensionCommandMethods, + "method", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum extensionCommandMethods) method) { + + case TCLXSLT_EXT_ADD: + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "nsuri tcl-namespace"); + return TCL_ERROR; + } + + Tcl_MutexLock(&libxslt); + + if (xsltRegisterExtModule((const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL), + TclXSLTExtInit, + TclXSLTExtShutdown)) { + Tcl_MutexUnlock(&libxslt); + Tcl_SetResult(interp, "cannot register extension module", NULL); + } + + Tcl_MutexUnlock(&libxslt); + + extinfo = (TclXSLT_Extension *) Tcl_Alloc(sizeof(TclXSLT_Extension)); + extinfo->interp = interp; + extinfo->nsuri = objv[2]; + Tcl_IncrRefCount(objv[2]); + extinfo->tclns = objv[3]; + Tcl_IncrRefCount(objv[3]); + + extinfo->xformCtxt = NULL; + + entry = Tcl_CreateHashEntry(tsdPtr->extensions, Tcl_GetStringFromObj(objv[2], NULL), &new); + + if (!new) { + Tcl_SetResult(interp, "extension already exists", NULL); + Tcl_Free((char *) extinfo); + return TCL_ERROR; + } + + Tcl_SetHashValue(entry, extinfo); + + TclXSLT_RegisterAll(extinfo, (const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL)); + + Tcl_ResetResult(interp); + + break; + + case TCLXSLT_EXT_REMOVE: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "nsuri"); + return TCL_ERROR; + } + + /* + * TODO: Remove previously registered elements and functions. + */ + + entry = Tcl_FindHashEntry(tsdPtr->extensions, Tcl_GetStringFromObj(objv[2], NULL)); + if (entry == NULL) { + Tcl_SetResult(interp, "unknown XML Namespace URI", NULL); + return TCL_ERROR; + } + + extinfo = (TclXSLT_Extension *) Tcl_GetHashValue(entry); + Tcl_DecrRefCount(extinfo->nsuri); + Tcl_DecrRefCount(extinfo->tclns); + Tcl_Free((char *) extinfo); + + Tcl_DeleteHashEntry(entry); + + break; + + default: + Tcl_SetResult(interp, "unknown method", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTExtInit -- + * + * Load extensions into a transformation context. + * + * Results: + * Returns pointer to extension data. + * Elements and functions are pre-registered. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static void * +TclXSLTExtInit(ctxt, URI) + xsltTransformContextPtr ctxt; + const xmlChar *URI; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_HashEntry *entry; + TclXSLT_Extension *extinfo; + + entry = Tcl_FindHashEntry(tsdPtr->extensions, (CONST char *) URI); + if (entry == NULL) { + /* Extension module was removed */ + return NULL; + } + + extinfo = (TclXSLT_Extension *) Tcl_GetHashValue(entry); + extinfo->xformCtxt = ctxt; + + return (void *) extinfo; +} + +void +TclXSLT_RegisterAll(extinfo, nsuri) + TclXSLT_Extension *extinfo; + const xmlChar *nsuri; +{ + Tcl_Obj *cmdPtr, *objPtr; + Tcl_Obj **reg; + int ret, i, len; + + /* + * Q: How to distinguish between extension elements and functions? + * A: Use the formal parameters. If the command can accept + * a variable argument list, then it is registered as a function. + * Otherwise it will be registered as an extension (and expected + * to accept certain arguments). + */ + + cmdPtr = Tcl_NewStringObj("::xslt::getprocs ", -1); + Tcl_IncrRefCount(cmdPtr); + Tcl_AppendObjToObj(cmdPtr, extinfo->tclns); + ret = Tcl_EvalObjEx(extinfo->interp, cmdPtr, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT); + objPtr = Tcl_GetObjResult(extinfo->interp); + Tcl_IncrRefCount(objPtr); + Tcl_DecrRefCount(cmdPtr); + + if (ret != TCL_OK || objPtr == NULL) { + /* + * Something went wrong, therefore nothing to register. + */ + return; + } + + ret = Tcl_ListObjGetElements(extinfo->interp, objPtr, &len, ®); + if (ret != TCL_OK || len != 2) { + /* + * Something went wrong, therefore nothing to register. + */ + return; + } + + /* + * reg[0] contains extension elements + * reg[1] contains extension functions + */ + + Tcl_MutexLock(&libxslt); + + /* + * First register the extension elements. + */ + + ret = Tcl_ListObjLength(extinfo->interp, reg[0], &len); + if (ret == TCL_OK && len > 0) { + for (i = 0; i < len; i++) { + + if (Tcl_ListObjIndex(extinfo->interp, reg[0], i, &objPtr) != TCL_OK) { + continue; + } + + xsltRegisterExtModuleElement((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL), + nsuri, + (xsltPreComputeFunction) TclXSLTExtElementPreComp, + (xsltTransformFunction) TclXSLTExtElementTransform); + } + } + + /* + * Now register the extension functions. + */ + + ret = Tcl_ListObjLength(extinfo->interp, reg[1], &len); + if (ret != TCL_OK || len == 0) { + Tcl_MutexUnlock(&libxslt); + return; + } + + for (i = 0; i < len; i++) { + + if (Tcl_ListObjIndex(extinfo->interp, reg[1], i, &objPtr) != TCL_OK) { + continue; + } + + xsltRegisterExtModuleFunction((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL), + nsuri, + TclXSLTExtFunction); + } + + Tcl_MutexUnlock(&libxslt); + + Tcl_DecrRefCount(objPtr); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTExtElementPreComp -- + * + * Compilation step for extension element. + * + * Results: + * Not currently used. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXSLTExtElementPreComp(style, inst, function) + xsltStylesheetPtr style; + xmlNodePtr inst; + xsltTransformFunction function; +{ + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTExtElementTransform -- + * + * Implements extension element. + * + * Results: + * Returns string returned by Tcl command evaluation. + * + * Side effects: + * Depends on Tcl command evaluated. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXSLTExtElementTransform(ctxt, node, inst, comp) + xsltTransformContextPtr ctxt; /* unused */ + xmlNodePtr node; + xmlNodePtr inst; + xsltStylePreCompPtr comp; /* unused */ +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXSLT_Extension *extinfo; + Tcl_HashEntry *entry; + Tcl_Obj *cmdPtr; + int ret; + + if (inst == NULL) { + return; + } + + entry = Tcl_FindHashEntry(tsdPtr->extensions, (CONST char *) inst->ns->href); + if (entry == NULL) { + /* + * Cannot find extension module. + * Must have been removed. + */ + return; + } + + extinfo = (TclXSLT_Extension *) Tcl_GetHashValue(entry); + + /* + * Start constructing the script by first defining the command. + */ + + cmdPtr = Tcl_DuplicateObj(extinfo->tclns); + Tcl_AppendStringsToObj(cmdPtr, "::", inst->name, NULL); + + if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, TclDOM_libxml2_CreateObjFromNode(extinfo->interp, node)) != TCL_OK) { + Tcl_DecrRefCount(cmdPtr); + return; + } + + /* + * Converting the stylesheet node to a TclDOM node may clobber the + * _private pointer. It would be nice to find the equivalent node + * in the original DOM tree, but it may not even exist anymore :-( + * + * TODO: make extension elements more effective, and allow + * pre-computation. + */ + + /* + * Now evaluate the complete command. + * Can't propagqte a return error result to + * XSLT, so flag background error instead. + */ + ret = Tcl_EvalObjEx(extinfo->interp, cmdPtr, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); + if (ret != TCL_OK) { + Tcl_BackgroundError(extinfo->interp); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTExtFunction -- + * + * Handles evaluation of an extension function. + * + * Results: + * Returns string returned by Tcl command evaluation. + * + * Side effects: + * Depends on Tcl command evaluated. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXSLTExtFunction(xpathCtxt, nargs) + xmlXPathParserContextPtr xpathCtxt; + int nargs; +{ + xsltTransformContextPtr xformCtxt; + TclXSLT_Extension *extinfo; + Tcl_Obj *cmdPtr, *resultPtr; + xmlXPathObjectPtr obj; + int ret; + + Tcl_MutexLock(&libxslt); + + xformCtxt = xsltXPathGetTransformContext(xpathCtxt); + + /* + * In order to find the instance data we need the + * XML Namespace URI of this function. + */ + + extinfo = (TclXSLT_Extension *) xsltGetExtData(xformCtxt, + xpathCtxt->context->functionURI); + + /* + * Start constructing the script by first defining the command. + */ + + cmdPtr = Tcl_DuplicateObj(extinfo->tclns); + Tcl_IncrRefCount(cmdPtr); + Tcl_AppendStringsToObj(cmdPtr, "::", xpathCtxt->context->function, NULL); + + /* + * Each argument on the stack is converted to a Tcl_Obj + * of an appropriate type and passed as an argument to the Tcl command. + */ + + while (nargs) { + Tcl_Obj *objv[2]; + + obj = (xmlXPathObjectPtr) valuePop(xpathCtxt); + if (obj == NULL) { + xmlXPathSetError(xpathCtxt, XPATH_INVALID_OPERAND); + Tcl_DecrRefCount(cmdPtr); + Tcl_MutexUnlock(&libxslt); + return; + } + + objv[0] = TclXSLT_ConvertXPathObjToTclObj(extinfo->interp, obj); + objv[1] = NULL; + if (Tcl_ListObjReplace(extinfo->interp, cmdPtr, 1, 0, 1, objv) != TCL_OK) { + Tcl_BackgroundError(extinfo->interp); + Tcl_DecrRefCount(objv[0]); + Tcl_DecrRefCount(cmdPtr); + Tcl_MutexUnlock(&libxslt); + return; + } + + /* When should this XPath object be freed? + * Immediately before returning from the function call? + * What if the application retains a pointer to it? + * If the application destroys the contents, then memory + * will leak because the XPath object is not freed. + * + * TODO: take a copy of the object's content and pass that + * to the application callback. That would allow this object + * to be freed and allow the application to manage the copy. + + xmlXPathFreeObject(obj); + */ + + nargs--; + } + + ret = Tcl_EvalObjEx(extinfo->interp, cmdPtr, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); + resultPtr = Tcl_GetObjResult(extinfo->interp); + Tcl_DecrRefCount(cmdPtr); + Tcl_IncrRefCount(resultPtr); + + if (ret == TCL_OK) { + obj = TclXSLT_ConvertTclObjToXPathObj(extinfo->interp, resultPtr); + valuePush(xpathCtxt, obj); + } else { + xmlGenericError(xmlGenericErrorContext, + Tcl_GetStringFromObj(resultPtr, NULL)); + /* Need to define a new error code - this is the closest in meaning */ + xpathCtxt->error = XPATH_UNKNOWN_FUNC_ERROR; + } + + Tcl_MutexUnlock(&libxslt); + + Tcl_DecrRefCount(resultPtr); + +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLT_ConvertTclObjToXPathObj -- + * + * Convert a Tcl Object to an XPath object. + * Data type is preserved, with nodesets being + * mapped from a list of nodes. + * + * NB. Mutex is assumed to be locked when invoking this routine. + * + * Results: + * XPath Object. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static xmlXPathObjectPtr +TclXSLT_ConvertTclObjToXPathObj(interp, objPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; +{ + xmlNodePtr nodePtr; + xmlDocPtr docPtr; + + if (TclDOM_libxml2_GetNodeFromObj(interp, objPtr, &nodePtr) == TCL_OK) { + return xmlXPathNewNodeSet(nodePtr); + } + + if (TclXML_libxml2_GetDocFromObj(interp, objPtr, &docPtr) == TCL_OK) { + return xmlXPathNewNodeSet((xmlNodePtr) docPtr); + + } + + if (objPtr->typePtr == Tcl_GetObjType("int") || + objPtr->typePtr == Tcl_GetObjType("double")) { + double number; + + if (Tcl_GetDoubleFromObj(interp, objPtr, &number) == TCL_OK) { + return xmlXPathNewFloat(number); + } else { + return NULL; + } + } else if (objPtr->typePtr == Tcl_GetObjType("boolean")) { + int bool; + + if (Tcl_GetBooleanFromObj(interp, objPtr, &bool) == TCL_OK) { + return xmlXPathNewBoolean(bool); + } else { + return NULL; + } + } else if (objPtr->typePtr == Tcl_GetObjType("list")) { + /* + * If each of the elements can be converted to a node, + * then return a nodeset. + */ + + int i, len; + Tcl_Obj **listPtr; + xmlNodeSetPtr nset; + + Tcl_ListObjGetElements(interp, objPtr, &len, &listPtr); + if (len == 0) { + return xmlXPathNewNodeSet(NULL); + } + + /* + * First pass: check that the elements are all nodes. + */ + for (i = 0; i < len; i++) { + if (TclXML_libxml2_GetDocFromObj(interp, listPtr[i], &docPtr) == TCL_OK) { + continue; + } + if (TclDOM_libxml2_GetNodeFromObj(interp, listPtr[i], &nodePtr) != TCL_OK) { + return xmlXPathNewString((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL)); + } + } + /* + * Now go ahead and create the nodeset (we already did the hard + * work to create internal reps in pass 1). + */ + if (TclXML_libxml2_GetDocFromObj(interp, listPtr[0], &docPtr) == TCL_OK) { + nset = xmlXPathNodeSetCreate((xmlNodePtr) docPtr); + } else { + TclDOM_libxml2_GetNodeFromObj(interp, listPtr[0], &nodePtr); + nset = xmlXPathNodeSetCreate(nodePtr); + } + for (i = 1; i < len; i++) { + if (TclXML_libxml2_GetDocFromObj(interp, listPtr[i], &docPtr) == TCL_OK) { + xmlXPathNodeSetAdd(nset, (xmlNodePtr) docPtr); + } else { + TclDOM_libxml2_GetNodeFromObj(interp, listPtr[i], &nodePtr); + xmlXPathNodeSetAdd(nset, nodePtr); + } + } + return xmlXPathWrapNodeSet(nset); + + } else { + return xmlXPathNewString((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL)); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLT_ConvertXPathObjToTclObj -- + * + * Convert an XPath object to a Tcl Object. + * Data type is preserved, with nodesets being + * mapped to a list of nodes. + * + * Results: + * Tcl Object. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static Tcl_Obj * +TclXSLT_ConvertXPathObjToTclObj(interp, xpobj) + Tcl_Interp *interp; + xmlXPathObjectPtr xpobj; +{ + Tcl_Obj *objPtr; + int i; + + switch (xpobj->type) { + case XPATH_XSLT_TREE: + case XPATH_NODESET: + + objPtr = Tcl_NewListObj(0, NULL); + if (xpobj->nodesetval) { + for (i = 0; i < xpobj->nodesetval->nodeNr; i++) { + Tcl_Obj *nodeObjPtr = NULL; + if (xpobj->nodesetval->nodeTab[i] && + xpobj->nodesetval->nodeTab[i]->type == XML_DOCUMENT_NODE) { + nodeObjPtr = TclXML_libxml2_CreateObjFromDoc((xmlDocPtr) xpobj->nodesetval->nodeTab[i]); + } else if (xpobj->nodesetval->nodeTab[i]) { + nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, xpobj->nodesetval->nodeTab[i]); + } + Tcl_ListObjAppendElement(interp, objPtr, nodeObjPtr); + } + } + + break; + + case XPATH_BOOLEAN: + objPtr = Tcl_NewBooleanObj(xpobj->boolval); + break; + + case XPATH_NUMBER: + objPtr = Tcl_NewDoubleObj(xpobj->floatval); + break; + + case XPATH_STRING: + case XPATH_UNDEFINED: + case XPATH_POINT: + case XPATH_RANGE: + case XPATH_LOCATIONSET: + case XPATH_USERS: + default: + objPtr = Tcl_NewStringObj((CONST char *) xmlXPathCastToString(xpobj), -1); + + break; + } + + return objPtr; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTExtShutdown -- + * + * Clean up. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXSLTExtShutdown(ctxt, URI, userdata) + xsltTransformContextPtr ctxt; + const xmlChar *URI; + void *userdata; +{ + /* Nothing to do */ +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTSecurity -- + * TclXSLTSecurityReadFile -- + * TclXSLTSecurityWriteFile -- + * TclXSLTSecurityCreateDirectory -- + * TclXSLTSecurityReadNetwork -- + * TclXSLTSecurityWriteNetwork -- + * + * Check if external operations are permitted. + * + * Results: + * Returns boolean value. + * + * Side effects: + * Depends on callback. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXSLTSecurity(name, method, value) + Tcl_Obj *name; + const char *method; + const char *value; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_Interp *master; + Tcl_Obj *cmdPtr, *pathPtr; + int result, permitted; + + if (Tcl_IsSafe(tsdPtr->interp)) { + + /* + * Invoke hidden command + */ + + master = Tcl_GetMaster(tsdPtr->interp); + + if (!Tcl_IsSafe(master)) { + return 0; + } + + if (Tcl_GetInterpPath(master, tsdPtr->interp) != TCL_OK) { + return 0; + } + pathPtr = Tcl_GetObjResult(master); + + cmdPtr = Tcl_NewListObj(0, NULL); + Tcl_IncrRefCount(cmdPtr); + Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("interp", -1)); + Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("invokehidden", -1)); + Tcl_ListObjAppendElement(master, cmdPtr, pathPtr); + Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("-global", -1)); + Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("::xslt::security", -1)); + Tcl_ListObjAppendElement(master, cmdPtr, name); + Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj(method, -1)); + Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj(value, -1)); + + result = Tcl_EvalObjEx(master, cmdPtr, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT); + + Tcl_DecrRefCount(cmdPtr); + } else { + + /* + * Invoke command normally + */ + + cmdPtr = Tcl_NewListObj(0, NULL); + Tcl_IncrRefCount(cmdPtr); + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewStringObj("::xslt::security", -1)); + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, name); + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewStringObj(method, -1)); + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewStringObj(value, -1)); + + result = Tcl_EvalObjEx(tsdPtr->interp, cmdPtr, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT); + + Tcl_DecrRefCount(cmdPtr); + } + + if (result == TCL_OK) { + if (Tcl_GetBooleanFromObj(tsdPtr->interp, Tcl_GetObjResult(tsdPtr->interp), &permitted) == TCL_OK) { + return permitted; + } else if (Tcl_IsSafe(tsdPtr->interp)) { + return 0; + } else { + return 1; + } + } else if (Tcl_IsSafe(tsdPtr->interp)) { + return 0; + } else { + return 1; + } +} +static Tcl_Obj * +TclXSLTSecurityGetName(ctxt) + xsltTransformContextPtr ctxt; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_HashEntry *entryPtr; + + if (ctxt) { + entryPtr = Tcl_FindHashEntry(tsdPtr->stylesheets, (ClientData) ctxt->style); + if (entryPtr) { + return Tcl_NewStringObj((char *) Tcl_GetHashValue(entryPtr), -1); + } else { + return Tcl_NewObj(); + } + } else { + return Tcl_NewObj(); + } +} +static int +TclXSLTSecurityReadFile(sec, ctxt, value) + xsltSecurityPrefsPtr sec; + xsltTransformContextPtr ctxt; + const char *value; +{ + return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "readfile", value); +} +static int +TclXSLTSecurityWriteFile(sec, ctxt, value) + xsltSecurityPrefsPtr sec; + xsltTransformContextPtr ctxt; + const char *value; +{ + return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "writefile", value); +} +static int +TclXSLTSecurityCreateDirectory(sec, ctxt, value) + xsltSecurityPrefsPtr sec; + xsltTransformContextPtr ctxt; + const char *value; +{ + return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "createdirectory", value); +} +static int +TclXSLTSecurityReadNetwork(sec, ctxt, value) + xsltSecurityPrefsPtr sec; + xsltTransformContextPtr ctxt; + const char *value; +{ + return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "readnetwork", value); +} +static int +TclXSLTSecurityWriteNetwork(sec, ctxt, value) + xsltSecurityPrefsPtr sec; + xsltTransformContextPtr ctxt; + const char *value; +{ + return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "writenetwork", value); +} |