1 /*
2 * tclxslt.c --
3 *
4 * Interface to Gnome libxslt.
5 *
6 * Copyright (c) 2005-2009 Explain
7 * http://www.explain.com.au/
8 * Copyright (c) 2001-2004 Zveno Pty Ltd
9 * http://www.zveno.com/
10 *
11 * See the file "LICENSE" for information on usage and
12 * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 *
14 * $Id: tclxslt.c,v 1.30.2.2 2005/12/30 02:40:41 balls Exp $
15 *
16 */
17
18 #include <tclxslt/tclxslt.h>
19 #include <string.h>
20 #include <libxml/parserInternals.h>
21 #include <libxslt/namespaces.h>
22 #include <libxslt/imports.h>
23 #include <libxslt/security.h>
24 #include <libxslt/preproc.h>
25 #include <libxslt/variables.h>
26 #include <libxslt/templates.h>
27
28 #undef TCL_STORAGE_CLASS
29 #define TCL_STORAGE_CLASS DLLEXPORT
30
31 /*#ifdef __WIN32__
32 *# include "win/win32config.h"
33 #endif
34 */
35
36 /*
37 * Manage stylesheet objects
38 */
39
40 typedef struct TclXSLT_Stylesheet {
41 Tcl_Interp *interp;
42 char *name;
43 xsltStylesheetPtr stylesheet;
44 Tcl_HashEntry *entryPtr;
45
46 Tcl_Obj *resulturi;
47 Tcl_Obj *profilechannelObj;
48
49 Tcl_Obj *messagecommand;
50 } TclXSLT_Stylesheet;
51
52 /*
53 * Extension management
54 */
55
56 typedef struct TclXSLT_Extension {
57 Tcl_Interp *interp;
58 Tcl_Obj *nsuri;
59 Tcl_Obj *tclns;
60 xsltTransformContextPtr xformCtxt;
61 } TclXSLT_Extension;
62
63 typedef struct ThreadSpecificData {
64 int initialised;
65 Tcl_Interp *interp;
66 int ssheetCntr;
67 Tcl_HashTable *stylesheets;
68 Tcl_HashTable *extensions;
69 } ThreadSpecificData;
70 static Tcl_ThreadDataKey dataKey;
71
72 /*
73 * Prototypes for procedures defined later in this file:
74 */
75
76 /*
77 * Forward declarations for private functions.
78 */
79
80 static void TclXSLTGenericError _ANSI_ARGS_((void *ctx, const char *msg, ...));
81
82 static int TclXSLTCompileCommand _ANSI_ARGS_((ClientData dummy,
83 Tcl_Interp *interp,
84 int objc,
85 Tcl_Obj *CONST objv[]));
86 static int TclXSLTInstanceCommand _ANSI_ARGS_((ClientData ssheet,
87 Tcl_Interp *interp,
88 int objc,
89 Tcl_Obj *CONST objv[]));
90 static void TclXSLTDeleteStylesheet _ANSI_ARGS_((ClientData ssheet));
91 static int TclXSLTExtensionCommand _ANSI_ARGS_((ClientData dummy,
92 Tcl_Interp *interp,
93 int objc,
94 Tcl_Obj *CONST objv[]));
95
96 static Tcl_Obj * GetParameters _ANSI_ARGS_((Tcl_Interp *interp,
97 xsltStylesheetPtr stylesheet));
98 static int TclXSLTTransform _ANSI_ARGS_((TclXSLT_Stylesheet *stylesheet,
99 Tcl_Obj *source,
100 int paramc,
101 Tcl_Obj *CONST paramv[]));
102
103 static void TclXSLT_RegisterAll _ANSI_ARGS_((TclXSLT_Extension *extinfo,
104 const xmlChar *nsuri));
105
106 /* static xsltExtInitFunction TclXSLTExtInit; */
107 static void *TclXSLTExtInit _ANSI_ARGS_((xsltTransformContextPtr ctxt,
108 const xmlChar *URI));
109 /* static xsltExtShutdownFunction TclXSLTExtShutdown; */
110 static void TclXSLTExtShutdown _ANSI_ARGS_((xsltTransformContextPtr ctxt,
111 const xmlChar *URI,
112 void *userdata));
113 /* static xmlXPathEvalFunc TclXSLTExtFunction; */
114 static void TclXSLTExtFunction _ANSI_ARGS_((xmlXPathParserContextPtr xpathCtxt,
115 int nargs));
116 /* static xsltPreComputeFunction TclXSLTExtElementPreComp; */
117 static xsltElemPreCompPtr TclXSLTExtElementPreComp _ANSI_ARGS_((xsltStylesheetPtr style,
118 xmlNodePtr inst,
119 xsltTransformFunction function));
120 /* static xsltTransformFunction TclXSLTExtElementTransform; */
121 static void TclXSLTExtElementTransform _ANSI_ARGS_((xsltTransformContextPtr ctxt,
122 xmlNodePtr node,
123 xmlNodePtr inst,
124 xsltStylePreCompPtr comp));
125 /* static xsltSecurityCheck TclXSLTSecurityReadFile; */
126 static int TclXSLTSecurityReadFile _ANSI_ARGS_((xsltSecurityPrefsPtr sec,
127 xsltTransformContextPtr ctxt,
128 const char *value));
129 /* static xsltSecurityCheck TclXSLTSecurityWriteFile; */
130 static int TclXSLTSecurityWriteFile _ANSI_ARGS_((xsltSecurityPrefsPtr sec,
131 xsltTransformContextPtr ctxt,
132 const char *value));
133 /* static xsltSecurityCheck TclXSLTSecurityCreateDirectory; */
134 static int TclXSLTSecurityCreateDirectory _ANSI_ARGS_((xsltSecurityPrefsPtr sec,
135 xsltTransformContextPtr ctxt,
136 const char *value));
137 /* static xsltSecurityCheck TclXSLTSecurityReadNetwork; */
138 static int TclXSLTSecurityReadNetwork _ANSI_ARGS_((xsltSecurityPrefsPtr sec,
139 xsltTransformContextPtr ctxt,
140 const char *value));
141 /* static xsltSecurityCheck TclXSLTSecurityWriteNetwork; */
142 static int TclXSLTSecurityWriteNetwork _ANSI_ARGS_((xsltSecurityPrefsPtr sec,
143 xsltTransformContextPtr ctxt,
144 const char *value));
145
146 static Tcl_Obj * TclXSLT_ConvertXPathObjToTclObj _ANSI_ARGS_((Tcl_Interp *interp,
147 xmlXPathObjectPtr xpobj));
148 static xmlXPathObjectPtr TclXSLT_ConvertTclObjToXPathObj _ANSI_ARGS_((Tcl_Interp *interp,
149 Tcl_Obj *objPtr));
150
151 /* Copied from libxslt-1.1.24 transform.c */
152
153 static void
154 xsltApplySequenceConstructor(xsltTransformContextPtr ctxt,
155 xmlNodePtr contextNode, xmlNodePtr list,
156 xsltTemplatePtr templ);
157
158 /*
159 * Error context for passing error result back to caller.
160 */
161
162 typedef struct GenericError_Info {
163 Tcl_Interp *interp;
164 TclXSLT_Stylesheet *stylesheet;
165 int code;
166 Tcl_Obj *msg;
167 } GenericError_Info;
168
169 /*
170 * Switch tables
171 */
172
173 #ifndef CONST84
174 #define CONST84 /* Before 8.4 no 'const' required */
175 #endif
176
177 static CONST84 char *instanceCommandMethods[] = {
178 "cget",
179 "configure",
180 "get",
181 "transform",
182 (char *) NULL
183 };
184 enum instanceCommandMethods {
185 TCLXSLT_CGET,
186 TCLXSLT_CONFIGURE,
187 TCLXSLT_GET,
188 TCLXSLT_TRANSFORM
189 };
190 static CONST84 char *instanceCommandOptions[] = {
191 "-messagecommand",
192 "-method",
193 "-indent",
194 "-resulturi",
195 "-profilechannel",
196 "-encoding",
197 "-omitxmldeclaration",
198 (char *) NULL
199 };
200 enum instanceCommandOptions {
201 TCLXSLT_OPTION_MESSAGECOMMAND,
202 TCLXSLT_OPTION_METHOD,
203 TCLXSLT_OPTION_INDENT,
204 TCLXSLT_OPTION_RESULTURI,
205 TCLXSLT_OPTION_PROFILECHANNEL,
206 TCLXSLT_OPTION_ENCODING,
207 TCLXSLT_OPTION_OMITXMLDECLARATION
208 };
209
210 static CONST84 char *instanceGetMethods[] = {
211 "parameters",
212 (char *) NULL
213 };
214 enum instanceGetMethods {
215 TCLXSLT_GET_PARAMETERS
216 };
217
218 static CONST84 char *extensionCommandMethods[] = {
219 "add",
220 "remove",
221 (char *) NULL
222 };
223 enum extensionCommandMethods {
224 TCLXSLT_EXT_ADD,
225 TCLXSLT_EXT_REMOVE
226 };
227
228 /*
229 * libxml2 and libxslt are mostly thread-safe,
230 * but there are issues with error callbacks.
231 */
232
233 TCL_DECLARE_MUTEX(libxslt)
234
235 /*
236 *----------------------------------------------------------------------------
237 *
238 * Tclxslt_libxslt_Init --
239 *
240 * Initialisation routine for loadable module
241 *
242 * Results:
243 * None.
244 *
245 * Side effects:
246 * Creates commands in the interpreter,
247 *
248 *----------------------------------------------------------------------------
249 */
250
251 int
252 Tclxslt_libxslt_Init (interp)
253 Tcl_Interp *interp; /* Interpreter to initialise */
254 {
255 ThreadSpecificData *tsdPtr;
256 xsltSecurityPrefsPtr sec;
257
258 tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
259 if (!tsdPtr->initialised) {
260 tsdPtr->initialised = 1;
261 tsdPtr->interp = interp;
262 tsdPtr->ssheetCntr = 0;
263 tsdPtr->stylesheets = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
264 Tcl_InitHashTable(tsdPtr->stylesheets, TCL_ONE_WORD_KEYS);
265 tsdPtr->extensions = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
266 Tcl_InitHashTable(tsdPtr->extensions, TCL_STRING_KEYS);
267 } /* only need to init the library once per process */
268
269 Tcl_CreateObjCommand(interp, "xslt::compile", TclXSLTCompileCommand, NULL, NULL);
270 Tcl_CreateObjCommand(interp, "xslt::extension", TclXSLTExtensionCommand, NULL, NULL);
271
272 Tcl_MutexLock(&libxslt);
273 #ifndef TCLXML_STATIC_TCLXSLT
274 exsltRegisterAll();
275 #endif /* TCLXML_STATIC_TCLXSLT */
276
277 /*
278 * Setup security preferences
279 */
280 sec = xsltNewSecurityPrefs();
281 if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_READ_FILE,
282 TclXSLTSecurityReadFile)) {
283 Tcl_SetResult(interp, "unable to set readfile security", NULL);
284 return TCL_ERROR;
285 }
286 if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_WRITE_FILE,
287 TclXSLTSecurityWriteFile)) {
288 Tcl_SetResult(interp, "unable to set writefile security", NULL);
289 return TCL_ERROR;
290 }
291 if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_CREATE_DIRECTORY,
292 TclXSLTSecurityCreateDirectory)) {
293 Tcl_SetResult(interp, "unable to set createdirectory security", NULL);
294 return TCL_ERROR;
295 }
296 if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_READ_NETWORK,
297 TclXSLTSecurityReadNetwork)) {
298 Tcl_SetResult(interp, "unable to set readnetwork security", NULL);
299 return TCL_ERROR;
300 }
301 if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_WRITE_NETWORK,
302 TclXSLTSecurityWriteNetwork)) {
303 Tcl_SetResult(interp, "unable to set writenetwork security", NULL);
304 return TCL_ERROR;
305 }
306 /* xsltSetCtxtSecurityPrefs(sec, userCtxt); */
307 xsltSetDefaultSecurityPrefs(sec);
308
309 Tcl_MutexUnlock(&libxslt);
310
311 Tcl_SetVar2Ex(interp, "::xslt::libxsltversion", NULL, Tcl_NewStringObj(xsltEngineVersion, -1), 0);
312 Tcl_SetVar2Ex(interp, "::xslt::libexsltversion", NULL, Tcl_NewStringObj(exsltLibraryVersion, -1), 0);
313
314 return TCL_OK;
315 }
316
317 /*
318 * XSLT is not safe due to the document(), xsl:include and xsl:import functions/elements.
319 * However, libxslt checks whether access is permitted to external resources.
320 *
321 * 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.
322 */
323
324 int
Tclxslt_libxslt_SafeInit(interp)325 Tclxslt_libxslt_SafeInit (interp)
326 Tcl_Interp *interp; /* Interpreter to initialise */
327 {
328 return Tclxslt_libxslt_Init(interp);
329 }
330
331 /*
332 *----------------------------------------------------------------------------
333 *
334 * TclXSLTCompileCommand --
335 *
336 * Class creation command for xslt stylesheet objects.
337 *
338 * Results:
339 * Compiles the XSLT stylesheet.
340 * Creates a Tcl command associated with that stylesheet.
341 *
342 * Side effects:
343 * Memory allocated, stylesheet is compiled.
344 *
345 *----------------------------------------------------------------------------
346 */
347
348 static int
TclXSLTCompileCommand(dummy,interp,objc,objv)349 TclXSLTCompileCommand(dummy, interp, objc, objv)
350 ClientData dummy;
351 Tcl_Interp *interp;
352 int objc;
353 Tcl_Obj *CONST objv[];
354 {
355 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
356 TclXSLT_Stylesheet *info;
357 xmlDocPtr origDoc, doc;
358 xsltStylesheetPtr ssheetPtr = NULL;
359 void *oldxsltErrorCtx, *oldxmlErrorCtx;
360 xmlGenericErrorFunc old_xsltGenericError, old_xmlGenericError;
361 GenericError_Info *errorInfoPtr;
362 Tcl_Obj *errObjPtr = NULL;
363 int new;
364
365 if (objc != 2) {
366 Tcl_WrongNumArgs(interp, 1, objv, "stylesheet-doc");
367 return TCL_ERROR;
368 }
369
370 if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &origDoc) != TCL_OK) {
371 return TCL_ERROR;
372 }
373
374 Tcl_MutexLock(&libxslt);
375 doc = xmlCopyDoc(origDoc, 1);
376 /*
377 * xmlCopyDoc doesn't copy some of the fields.
378 */
379 if (origDoc->URL) {
380 doc->URL = (const xmlChar *) xmlMalloc(strlen((char *) origDoc->URL) + 1);
381 strcpy((char *) doc->URL, (char *) origDoc->URL);
382 }
383
384 /*
385 * Prepare for compiling stylesheet
386 */
387
388 TclXML_libxml2_ResetError(interp);
389
390 errorInfoPtr = (GenericError_Info *) Tcl_Alloc(sizeof(GenericError_Info));
391 errorInfoPtr->interp = interp;
392 errorInfoPtr->stylesheet = NULL;
393 errorInfoPtr->code = TCL_OK;
394 errorInfoPtr->msg = NULL;
395 xmlSetGenericErrorFunc((void *) errorInfoPtr,
396 TclXSLTGenericError);
397
398 /*
399 * Save the previous error context so that it can
400 * be restored upon completion of the operation.
401 */
402 old_xsltGenericError = xsltGenericError;
403 oldxsltErrorCtx = xsltGenericErrorContext;
404 old_xmlGenericError = xmlGenericError;
405 oldxmlErrorCtx = xmlGenericErrorContext;
406
407 xmlSetGenericErrorFunc((void *) errorInfoPtr,
408 TclXSLTGenericError);
409 xsltSetGenericErrorFunc((void *) errorInfoPtr, TclXSLTGenericError);
410
411 /*
412 * Compile stylesheet
413 */
414
415 ssheetPtr = xsltParseStylesheetDoc(doc);
416
417 xmlSetGenericErrorFunc((void *) oldxmlErrorCtx, old_xmlGenericError);
418 xsltSetGenericErrorFunc((void *) oldxsltErrorCtx, old_xsltGenericError);
419
420 Tcl_MutexUnlock(&libxslt);
421
422 errObjPtr = TclXML_libxml2_GetErrorObj(interp);
423
424 if (ssheetPtr == NULL) {
425 Tcl_SetResult(interp, "error compiling stylesheet", NULL);
426 goto error;
427 }
428
429 if (ssheetPtr->errors > 0) {
430 Tcl_SetResult(interp, "error compiling XSLT stylesheet", NULL);
431 goto error;
432 }
433
434 if (errorInfoPtr->code != TCL_OK) {
435 goto error;
436 }
437
438 /* TODO: notify app of any warnings */
439
440 info = (TclXSLT_Stylesheet *) Tcl_Alloc(sizeof(TclXSLT_Stylesheet));
441 info->interp = interp;
442 info->name = Tcl_Alloc(20);
443 sprintf(info->name, "style%d", tsdPtr->ssheetCntr++);
444 info->stylesheet = ssheetPtr;
445 info->messagecommand = NULL;
446 info->resulturi = NULL;
447 info->profilechannelObj = NULL;
448
449 /*
450 * Create reverse mapping of stylesheet to name of stylesheet command.
451 */
452 info->entryPtr = Tcl_CreateHashEntry(tsdPtr->stylesheets, (ClientData) ssheetPtr, &new);
453 /* sanity check: new == 1 */
454 Tcl_SetHashValue(info->entryPtr, (ClientData) info->name);
455
456 Tcl_CreateObjCommand(interp, info->name, TclXSLTInstanceCommand, (ClientData) info, TclXSLTDeleteStylesheet);
457
458 Tcl_SetObjResult(interp, Tcl_NewStringObj(info->name, -1));
459
460 return TCL_OK;
461
462 error:
463
464 if (errObjPtr) {
465 Tcl_SetObjResult(interp, errObjPtr);
466 } else if (errorInfoPtr->msg) {
467 Tcl_SetObjResult(interp, errorInfoPtr->msg);
468 Tcl_DecrRefCount(errorInfoPtr->msg);
469 }
470 Tcl_Free((char *) errorInfoPtr);
471
472 Tcl_MutexLock(&libxslt);
473 if (ssheetPtr) {
474 xsltFreeStylesheet(ssheetPtr);
475 } else {
476 xmlFreeDoc(doc);
477 }
478 Tcl_MutexUnlock(&libxslt);
479
480 return TCL_ERROR;
481 }
482
483 /*
484 *----------------------------------------------------------------------------
485 *
486 * TclXSLTDeleteStylesheet --
487 *
488 * Class destruction command for xslt stylesheet objects.
489 *
490 * Results:
491 * Frees memory associated with a stylesheet.
492 *
493 * Side effects:
494 * Memory deallocated.
495 *
496 *----------------------------------------------------------------------------
497 */
498
499 static void
TclXSLTDeleteStylesheet(clientData)500 TclXSLTDeleteStylesheet(clientData)
501 ClientData clientData;
502 {
503 TclXSLT_Stylesheet *ssheet = (TclXSLT_Stylesheet *) clientData;
504
505 Tcl_DeleteHashEntry(ssheet->entryPtr);
506
507 Tcl_Free(ssheet->name);
508 if (ssheet->messagecommand) {
509 Tcl_DecrRefCount(ssheet->messagecommand);
510 }
511 if (ssheet->resulturi) {
512 Tcl_DecrRefCount(ssheet->resulturi);
513 }
514 if (ssheet->profilechannelObj) {
515 Tcl_DecrRefCount(ssheet->profilechannelObj);
516 }
517 Tcl_MutexLock(&libxslt);
518 xsltFreeStylesheet(ssheet->stylesheet); /* Also frees document */
519 Tcl_MutexUnlock(&libxslt);
520 Tcl_Free((char *) ssheet);
521 }
522
523 /*
524 *----------------------------------------------------------------------------
525 *
526 * TclXSLTInstanceCommand --
527 *
528 * Handles the stylesheet object command.
529 *
530 * Results:
531 * Depends on method.
532 *
533 * Side effects:
534 * Depends on method.
535 *
536 *----------------------------------------------------------------------------
537 */
538
539 static int
TclXSLTInstanceCommand(clientData,interp,objc,objv)540 TclXSLTInstanceCommand(clientData, interp, objc, objv)
541 ClientData clientData;
542 Tcl_Interp *interp;
543 int objc;
544 Tcl_Obj *CONST objv[];
545 {
546 TclXSLT_Stylesheet *ssheet = (TclXSLT_Stylesheet *) clientData;
547 int method, option, indent = 0, theOmitXMLDeclaration = 0;
548 const xmlChar *theMethod, *theEncoding;
549
550 if (objc < 3) {
551 Tcl_WrongNumArgs(interp, 1, objv, "method ?args ...?");
552 return TCL_ERROR;
553 }
554
555 if (Tcl_GetIndexFromObj(interp, objv[1], instanceCommandMethods,
556 "method", 0, &method) != TCL_OK) {
557 return TCL_ERROR;
558 }
559
560 switch ((enum instanceCommandMethods) method) {
561 case TCLXSLT_CGET:
562
563 if (objc != 3) {
564 Tcl_WrongNumArgs(interp, 2, objv, "option");
565 return TCL_ERROR;
566 }
567
568 if (Tcl_GetIndexFromObj(interp, objv[2], instanceCommandOptions,
569 "option", 0, &option) != TCL_OK) {
570 return TCL_ERROR;
571 }
572
573 switch ((enum instanceCommandOptions) option) {
574
575 case TCLXSLT_OPTION_METHOD:
576 XSLT_GET_IMPORT_PTR(theMethod, ssheet->stylesheet, method);
577 if (theMethod != NULL) {
578 Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) theMethod, -1));
579 } /* theMethod == NULL means XML method; result should be empty.
580 EXCEPTION: if the result document is of type XML_HTML_DOCUMENT_NODE
581 then the method should be "html".
582 */
583 break;
584
585 case TCLXSLT_OPTION_ENCODING:
586 XSLT_GET_IMPORT_PTR(theEncoding, ssheet->stylesheet, encoding);
587 if (theEncoding != NULL) {
588 Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) theEncoding, -1));
589 } /* theEncoding == NULL means default (UTF-8) encoding; result should be empty.
590 */
591 break;
592
593 case TCLXSLT_OPTION_OMITXMLDECLARATION:
594 XSLT_GET_IMPORT_INT(theOmitXMLDeclaration, ssheet->stylesheet, omitXmlDeclaration);
595 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(theOmitXMLDeclaration == 1));
596 break;
597
598 case TCLXSLT_OPTION_INDENT:
599 XSLT_GET_IMPORT_INT(indent, ssheet->stylesheet, indent);
600 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(indent));
601 break;
602
603 case TCLXSLT_OPTION_MESSAGECOMMAND:
604 if (ssheet->messagecommand != NULL) {
605 Tcl_SetObjResult(interp, ssheet->messagecommand);
606 }
607 break;
608
609 case TCLXSLT_OPTION_RESULTURI:
610 if (ssheet->resulturi != NULL) {
611 Tcl_SetObjResult(interp, ssheet->resulturi);
612 }
613 break;
614
615 case TCLXSLT_OPTION_PROFILECHANNEL:
616 if (ssheet->profilechannelObj != NULL) {
617 Tcl_SetObjResult(interp, ssheet->profilechannelObj);
618 }
619 break;
620
621 default:
622 Tcl_SetResult(interp, "unknown option", NULL);
623 return TCL_ERROR;
624 }
625
626 break;
627
628 case TCLXSLT_CONFIGURE:
629
630 if (objc != 4) {
631 Tcl_WrongNumArgs(interp, 2, objv, "option value");
632 return TCL_ERROR;
633 }
634
635 if (Tcl_GetIndexFromObj(interp, objv[2], instanceCommandOptions,
636 "option", 0, &option) != TCL_OK) {
637 return TCL_ERROR;
638 }
639
640 switch ((enum instanceCommandOptions) option) {
641
642 case TCLXSLT_OPTION_METHOD:
643 case TCLXSLT_OPTION_INDENT:
644 case TCLXSLT_OPTION_ENCODING:
645 case TCLXSLT_OPTION_OMITXMLDECLARATION:
646 Tcl_SetResult(interp, "read-only option", NULL);
647 return TCL_ERROR;
648 break;
649
650 case TCLXSLT_OPTION_MESSAGECOMMAND:
651 if (ssheet->messagecommand != NULL) {
652 Tcl_DecrRefCount(ssheet->messagecommand);
653 }
654 ssheet->messagecommand = objv[3];
655 Tcl_IncrRefCount(ssheet->messagecommand);
656 break;
657
658 case TCLXSLT_OPTION_RESULTURI:
659 if (ssheet->resulturi != NULL) {
660 Tcl_DecrRefCount(ssheet->resulturi);
661 }
662 ssheet->resulturi = objv[3];
663 Tcl_IncrRefCount(ssheet->resulturi);
664 break;
665
666 case TCLXSLT_OPTION_PROFILECHANNEL:
667 if (ssheet->profilechannelObj != NULL) {
668 Tcl_DecrRefCount(ssheet->profilechannelObj);
669 }
670 #ifdef __WIN32__
671 Tcl_SetResult(interp, "profiling not available", NULL);
672 return TCL_ERROR;
673 #else
674 ssheet->profilechannelObj = objv[3];
675 Tcl_IncrRefCount(ssheet->profilechannelObj);
676 #endif
677 break;
678
679 default:
680 Tcl_SetResult(interp, "unknown option", NULL);
681 return TCL_ERROR;
682 }
683
684 break;
685
686 case TCLXSLT_GET:
687 if (objc != 3) {
688 Tcl_WrongNumArgs(interp, 2, objv, "name");
689 return TCL_ERROR;
690 }
691
692 if (Tcl_GetIndexFromObj(interp, objv[2], instanceGetMethods,
693 "name", 0, &option) != TCL_OK) {
694 return TCL_ERROR;
695 }
696
697 switch ((enum instanceGetMethods) option) {
698 case TCLXSLT_GET_PARAMETERS:
699
700 Tcl_SetObjResult(interp, GetParameters(interp, ssheet->stylesheet));
701 break;
702
703 default:
704 Tcl_SetResult(interp, "unknown name", NULL);
705 return TCL_ERROR;
706 }
707
708 break;
709
710 case TCLXSLT_TRANSFORM:
711 if (objc < 3) {
712 Tcl_WrongNumArgs(interp, 2, objv, "source ?param value...?");
713 return TCL_ERROR;
714 }
715
716 return TclXSLTTransform(ssheet, objv[2], objc - 3, &objv[3]);
717
718 break;
719
720 default:
721 Tcl_SetResult(interp, "unknown method", NULL);
722 return TCL_OK;
723 }
724
725 return TCL_OK;
726 }
727
728 /*
729 *----------------------------------------------------------------------------
730 *
731 * TclXSLTTransform --
732 *
733 * Performs an XSL transformation.
734 *
735 * Results:
736 * Result document created.
737 *
738 * Side effects:
739 * Memory allocated for result document.
740 *
741 *----------------------------------------------------------------------------
742 */
743
744 static int
TclXSLTTransform(stylesheet,source,paramc,paramv)745 TclXSLTTransform(stylesheet, source, paramc, paramv)
746 TclXSLT_Stylesheet *stylesheet;
747 Tcl_Obj *source;
748 int paramc;
749 Tcl_Obj *CONST paramv[];
750 {
751 xmlDocPtr doc, result;
752 char **params = NULL;
753 int nbparams = 0, i;
754 GenericError_Info *errorInfoPtr;
755 void *oldxsltErrorCtx, *oldxmlErrorCtx;
756 xmlGenericErrorFunc old_xsltGenericError, old_xmlGenericError;
757 Tcl_Obj *resultObjPtr, *errObjPtr = NULL;
758 char *resulturi = NULL;
759 FILE *profile = NULL;
760 xsltTransformContextPtr userCtxt = NULL;
761
762 errorInfoPtr = (GenericError_Info *) Tcl_Alloc(sizeof(GenericError_Info));
763 errorInfoPtr->interp = stylesheet->interp;
764 errorInfoPtr->stylesheet = stylesheet;
765 errorInfoPtr->code = TCL_OK;
766 errorInfoPtr->msg = NULL;
767
768 if (TclXML_libxml2_GetDocFromObj(stylesheet->interp, source, &doc) != TCL_OK) {
769 goto error;
770 }
771
772 TclXML_libxml2_ResetError(stylesheet->interp);
773
774 params = (char **) Tcl_Alloc(sizeof(char **) * (paramc + 1));
775 for (i = 0; i < paramc; i++) {
776 params[nbparams++] = Tcl_GetStringFromObj(paramv[i++], NULL);
777 params[nbparams++] = Tcl_GetStringFromObj(paramv[i], NULL);
778 }
779 params[nbparams] = NULL;
780
781 if (stylesheet->resulturi) {
782 resulturi = Tcl_GetStringFromObj(stylesheet->resulturi, NULL);
783 }
784 #ifdef __WIN32__
785 /* Tcl_GetOpenFile not available on Windows */
786 #else
787 if (stylesheet->profilechannelObj) {
788 if (Tcl_GetOpenFile(stylesheet->interp,
789 Tcl_GetStringFromObj(stylesheet->profilechannelObj, NULL),
790 1, 1,
791 (ClientData *) &profile) != TCL_OK) {
792 goto error;
793 }
794 }
795 #endif
796
797 /*
798 * Perform the transformation
799 */
800
801 Tcl_MutexLock(&libxslt);
802
803 /*
804 * Save the previous error context so that it can
805 * be restored upon completion of the transformation.
806 * This is necessary because transformations may occur
807 * recursively (usually due to extensions).
808 */
809 old_xsltGenericError = xsltGenericError;
810 oldxsltErrorCtx = xsltGenericErrorContext;
811 old_xmlGenericError = xmlGenericError;
812 oldxmlErrorCtx = xmlGenericErrorContext;
813
814 xmlSetGenericErrorFunc((void *) errorInfoPtr,
815 TclXSLTGenericError);
816 xsltSetGenericErrorFunc((void *) errorInfoPtr, TclXSLTGenericError);
817
818 userCtxt = xsltNewTransformContext(stylesheet->stylesheet, doc);
819 if (userCtxt == NULL) {
820 xmlSetGenericErrorFunc((void *) oldxmlErrorCtx, old_xmlGenericError);
821 xsltSetGenericErrorFunc((void *) oldxsltErrorCtx, old_xsltGenericError);
822
823 Tcl_MutexUnlock(&libxslt);
824 Tcl_SetResult(stylesheet->interp, "unable to create transformation context", NULL);
825 goto error;
826 }
827
828 result = xsltApplyStylesheetUser(stylesheet->stylesheet,
829 doc,
830 (const char **)params,
831 resulturi,
832 profile,
833 userCtxt);
834
835 xsltFreeTransformContext(userCtxt);
836
837 xmlSetGenericErrorFunc((void *) oldxmlErrorCtx, old_xmlGenericError);
838 xsltSetGenericErrorFunc((void *) oldxsltErrorCtx, old_xsltGenericError);
839
840 Tcl_MutexUnlock(&libxslt);
841
842 errObjPtr = TclXML_libxml2_GetErrorObj(stylesheet->interp);
843
844 if (result == NULL) {
845 Tcl_Obj *resultPtr = Tcl_NewStringObj("no result document: ", -1);
846
847 if (errObjPtr) {
848 Tcl_AppendObjToObj(resultPtr, errObjPtr);
849 Tcl_SetObjResult(stylesheet->interp, resultPtr);
850 goto error;
851 } else {
852 if (errorInfoPtr->msg) {
853 Tcl_AppendObjToObj(resultPtr, errorInfoPtr->msg);
854 }
855
856 Tcl_SetObjResult(stylesheet->interp, resultPtr);
857 goto error;
858 }
859 }
860
861 if ((errObjPtr || (errorInfoPtr->code != TCL_OK && errorInfoPtr->msg)) && stylesheet->messagecommand) {
862
863 /* We have produced a result, but there may possibly
864 * have been errors. Trouble is, there might also
865 * have been some completely innocent messages.
866 * -messageCommand is the only way to find out about these.
867 */
868
869 Tcl_Obj *cmdPtr = Tcl_DuplicateObj(stylesheet->messagecommand);
870 if (errObjPtr) {
871 if (Tcl_ListObjAppendElement(stylesheet->interp, cmdPtr, errObjPtr) != TCL_OK) {
872 goto error;
873 }
874 } else {
875 if (Tcl_ListObjAppendElement(stylesheet->interp, cmdPtr, errorInfoPtr->msg) != TCL_OK) {
876 goto error;
877 }
878 }
879 if (Tcl_GlobalEvalObj(stylesheet->interp, cmdPtr) != TCL_OK) {
880 Tcl_Obj *resultPtr = Tcl_NewStringObj("message command failed: ", -1);
881
882 Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(stylesheet->interp));
883 Tcl_SetObjResult(stylesheet->interp, resultPtr);
884 goto error;
885 }
886
887 }
888
889 resultObjPtr = TclDOM_libxml2_CreateObjFromDoc(stylesheet->interp, result);
890 Tcl_SetObjResult(stylesheet->interp, resultObjPtr);
891
892 if (errorInfoPtr->msg) {
893 Tcl_DecrRefCount(errorInfoPtr->msg);
894 }
895 Tcl_Free((char *) errorInfoPtr);
896 Tcl_Free((char *) params);
897
898 return TCL_OK;
899
900 error:
901
902 if (errorInfoPtr->msg) {
903 Tcl_DecrRefCount(errorInfoPtr->msg);
904 }
905 if (params) {
906 Tcl_Free((char *) params);
907 }
908 Tcl_Free((char *) errorInfoPtr);
909
910 return TCL_ERROR;
911 }
912
913 void
ListObjAppendUniqueList(interp,tablePtr,listPtr,newElementsPtr)914 ListObjAppendUniqueList(interp, tablePtr, listPtr, newElementsPtr)
915 Tcl_Interp *interp;
916 Tcl_HashTable *tablePtr;
917 Tcl_Obj *listPtr;
918 Tcl_Obj *newElementsPtr;
919 {
920 int len, idx;
921 Tcl_Obj *elementPtr, *keyPtr, *namePtr, *nameURIPtr;
922 Tcl_HashEntry *entryPtr;
923
924 Tcl_ListObjLength(interp, newElementsPtr, &len);
925 for (idx = 0; idx < len; idx++) {
926 Tcl_ListObjIndex(interp, newElementsPtr, idx, &elementPtr);
927 Tcl_ListObjIndex(interp, elementPtr, 0, &namePtr);
928 Tcl_ListObjIndex(interp, elementPtr, 1, &nameURIPtr);
929
930 keyPtr = Tcl_NewObj();
931 Tcl_AppendStringsToObj(keyPtr,
932 Tcl_GetStringFromObj(nameURIPtr, NULL),
933 "^",
934 Tcl_GetStringFromObj(namePtr, NULL),
935 NULL);
936 entryPtr = Tcl_FindHashEntry(tablePtr, (CONST char *) keyPtr);
937 if (entryPtr == NULL) {
938 Tcl_ListObjAppendElement(interp, listPtr, elementPtr);
939 }
940 Tcl_DecrRefCount(keyPtr);
941 }
942 }
943
944 /*
945 *----------------------------------------------------------------------------
946 *
947 * GetParameters --
948 *
949 * Retrieves the parameters for a stylesheet.
950 *
951 * Results:
952 * Returns a Tcl list object.
953 *
954 * Side effects:
955 * None.
956 *
957 *----------------------------------------------------------------------------
958 */
959
960 static Tcl_Obj *
GetParameters(interp,stylesheet)961 GetParameters(interp, stylesheet)
962 Tcl_Interp *interp;
963 xsltStylesheetPtr stylesheet;
964 {
965 Tcl_Obj *resultPtr, *objPtr, *keyPtr;
966 xsltStackElemPtr varPtr;
967 Tcl_HashTable entries; /* to keep track of parameter qnames */
968 int new;
969
970 if (stylesheet == NULL) {
971 return NULL;
972 }
973
974 resultPtr = Tcl_NewListObj(0, NULL);
975 Tcl_InitObjHashTable(&entries);
976
977 for (varPtr = stylesheet->variables; varPtr; varPtr = varPtr->next) {
978 Tcl_Obj *listPtr;
979
980 if (strcmp((char *) varPtr->comp->inst->name, "param") == 0) {
981 listPtr = Tcl_NewListObj(0, NULL);
982 Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((CONST char *) varPtr->name, -1));
983 Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((CONST char *) varPtr->nameURI, -1));
984 Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((CONST char *) varPtr->select, -1));
985
986 Tcl_ListObjAppendElement(interp, resultPtr, listPtr);
987
988 keyPtr = Tcl_NewStringObj((CONST char *) varPtr->nameURI, -1);
989 Tcl_AppendStringsToObj(keyPtr, "^", varPtr->name, NULL);
990 Tcl_CreateHashEntry(&entries, (CONST char *) keyPtr, &new);
991 }
992 }
993
994 objPtr = GetParameters(interp, stylesheet->next);
995 if (objPtr) {
996 ListObjAppendUniqueList(interp, &entries, resultPtr, objPtr);
997 }
998 objPtr = GetParameters(interp, stylesheet->imports);
999 if (objPtr) {
1000 ListObjAppendUniqueList(interp, &entries, resultPtr, objPtr);
1001 }
1002
1003 Tcl_DeleteHashTable(&entries);
1004
1005 return resultPtr;
1006 }
1007
1008 /*
1009 *----------------------------------------------------------------------------
1010 *
1011 * TclXSLTGenericError --
1012 *
1013 * Handler for stylesheet errors.
1014 *
1015 * NB. Cannot distinguish between errors and use of xsl:message element.
1016 *
1017 * Results:
1018 * Stores error message.
1019 *
1020 * Side effects:
1021 * Transform will return error condition.
1022 *
1023 *----------------------------------------------------------------------------
1024 */
1025
1026 static void
TclXSLTGenericError(void * ctx,const char * msg,...)1027 TclXSLTGenericError (void *ctx, const char *msg, ...)
1028 {
1029 va_list args;
1030 char buf[2048];
1031 int len;
1032 GenericError_Info *errorInfoPtr = (GenericError_Info *) ctx;
1033
1034 if (ctx < (void *) 0x1000) {
1035 fprintf(stderr, "TclXSLT: bad context\n");
1036 va_start(args,msg);
1037 vfprintf(stderr, msg, args);
1038 va_end(args);
1039 return;
1040 }
1041
1042 va_start(args,msg);
1043 len = vsnprintf(buf, 2047, msg, args);
1044 va_end(args);
1045
1046 if (!errorInfoPtr->interp) {
1047 return;
1048 }
1049
1050 if (errorInfoPtr->stylesheet && errorInfoPtr->stylesheet->messagecommand) {
1051
1052 Tcl_Obj *cmdPtr = Tcl_DuplicateObj(errorInfoPtr->stylesheet->messagecommand);
1053 if (Tcl_ListObjAppendElement(errorInfoPtr->interp, cmdPtr, Tcl_NewStringObj(buf, len)) != TCL_OK) {
1054 Tcl_BackgroundError(errorInfoPtr->interp);
1055 return;
1056 }
1057 if (Tcl_GlobalEvalObj(errorInfoPtr->interp, cmdPtr) != TCL_OK) {
1058 Tcl_BackgroundError(errorInfoPtr->interp);
1059 return;
1060 }
1061
1062 } else {
1063
1064 if (!errorInfoPtr->msg) {
1065 errorInfoPtr->msg = Tcl_NewObj();
1066 Tcl_IncrRefCount(errorInfoPtr->msg);
1067 }
1068
1069 errorInfoPtr->code = TCL_ERROR;
1070
1071 Tcl_AppendToObj(errorInfoPtr->msg, buf, len);
1072
1073 }
1074 }
1075
1076 /*
1077 *----------------------------------------------------------------------------
1078 *
1079 * TclXSLTExtensionCommand --
1080 *
1081 * Command for xslt::extension command.
1082 *
1083 * Results:
1084 * Depends on method.
1085 *
1086 * Side effects:
1087 * Depends on method
1088 *
1089 *----------------------------------------------------------------------------
1090 */
1091
1092 static int
TclXSLTExtensionCommand(dummy,interp,objc,objv)1093 TclXSLTExtensionCommand(dummy, interp, objc, objv)
1094 ClientData dummy;
1095 Tcl_Interp *interp;
1096 int objc;
1097 Tcl_Obj *CONST objv[];
1098 {
1099 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1100 int method, new;
1101 TclXSLT_Extension *extinfo;
1102 Tcl_HashEntry *entry;
1103
1104 if (objc < 2) {
1105 Tcl_WrongNumArgs(interp, 1, objv, "method ?args ...?");
1106 return TCL_ERROR;
1107 }
1108
1109 if (Tcl_GetIndexFromObj(interp, objv[1], extensionCommandMethods,
1110 "method", 0, &method) != TCL_OK) {
1111 return TCL_ERROR;
1112 }
1113
1114 switch ((enum extensionCommandMethods) method) {
1115
1116 case TCLXSLT_EXT_ADD:
1117 if (objc != 4) {
1118 Tcl_WrongNumArgs(interp, 2, objv, "nsuri tcl-namespace");
1119 return TCL_ERROR;
1120 }
1121
1122 Tcl_MutexLock(&libxslt);
1123
1124 if (xsltRegisterExtModule((const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL),
1125 TclXSLTExtInit,
1126 TclXSLTExtShutdown)) {
1127 Tcl_MutexUnlock(&libxslt);
1128 Tcl_SetResult(interp, "cannot register extension module", NULL);
1129 }
1130
1131 Tcl_MutexUnlock(&libxslt);
1132
1133 extinfo = (TclXSLT_Extension *) Tcl_Alloc(sizeof(TclXSLT_Extension));
1134 extinfo->interp = interp;
1135 extinfo->nsuri = objv[2];
1136 Tcl_IncrRefCount(objv[2]);
1137 extinfo->tclns = objv[3];
1138 Tcl_IncrRefCount(objv[3]);
1139
1140 extinfo->xformCtxt = NULL;
1141
1142 entry = Tcl_CreateHashEntry(tsdPtr->extensions, Tcl_GetStringFromObj(objv[2], NULL), &new);
1143
1144 if (!new) {
1145 Tcl_SetResult(interp, "extension already exists", NULL);
1146 Tcl_Free((char *) extinfo);
1147 return TCL_ERROR;
1148 }
1149
1150 Tcl_SetHashValue(entry, extinfo);
1151
1152 TclXSLT_RegisterAll(extinfo, (const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL));
1153
1154 Tcl_ResetResult(interp);
1155
1156 break;
1157
1158 case TCLXSLT_EXT_REMOVE:
1159 if (objc != 3) {
1160 Tcl_WrongNumArgs(interp, 2, objv, "nsuri");
1161 return TCL_ERROR;
1162 }
1163
1164 /*
1165 * TODO: Remove previously registered elements and functions.
1166 */
1167
1168 entry = Tcl_FindHashEntry(tsdPtr->extensions, Tcl_GetStringFromObj(objv[2], NULL));
1169 if (entry == NULL) {
1170 Tcl_SetResult(interp, "unknown XML Namespace URI", NULL);
1171 return TCL_ERROR;
1172 }
1173
1174 extinfo = (TclXSLT_Extension *) Tcl_GetHashValue(entry);
1175 Tcl_DecrRefCount(extinfo->nsuri);
1176 Tcl_DecrRefCount(extinfo->tclns);
1177 Tcl_Free((char *) extinfo);
1178
1179 Tcl_DeleteHashEntry(entry);
1180
1181 break;
1182
1183 default:
1184 Tcl_SetResult(interp, "unknown method", NULL);
1185 return TCL_ERROR;
1186 }
1187
1188 return TCL_OK;
1189 }
1190
1191 /*
1192 *----------------------------------------------------------------------------
1193 *
1194 * TclXSLTExtInit --
1195 *
1196 * Load extensions into a transformation context.
1197 *
1198 * Results:
1199 * Returns pointer to extension data.
1200 * Elements and functions are pre-registered.
1201 *
1202 * Side effects:
1203 * None.
1204 *
1205 *----------------------------------------------------------------------------
1206 */
1207
1208 static void *
TclXSLTExtInit(ctxt,URI)1209 TclXSLTExtInit(ctxt, URI)
1210 xsltTransformContextPtr ctxt;
1211 const xmlChar *URI;
1212 {
1213 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1214 Tcl_HashEntry *entry;
1215 TclXSLT_Extension *extinfo;
1216
1217 entry = Tcl_FindHashEntry(tsdPtr->extensions, (CONST char *) URI);
1218 if (entry == NULL) {
1219 /* Extension module was removed */
1220 return NULL;
1221 }
1222
1223 extinfo = (TclXSLT_Extension *) Tcl_GetHashValue(entry);
1224 extinfo->xformCtxt = ctxt;
1225
1226 return (void *) extinfo;
1227 }
1228
1229 void
TclXSLT_RegisterAll(extinfo,nsuri)1230 TclXSLT_RegisterAll(extinfo, nsuri)
1231 TclXSLT_Extension *extinfo;
1232 const xmlChar *nsuri;
1233 {
1234 Tcl_Obj *cmdPtr, *objPtr;
1235 Tcl_Obj **reg;
1236 int ret, i, len;
1237
1238 /*
1239 * Q: How to distinguish between extension elements and functions?
1240 * A: Use the formal parameters. If the command can accept
1241 * a variable argument list, then it is registered as a function.
1242 * Otherwise it will be registered as an extension (and expected
1243 * to accept certain arguments).
1244 */
1245
1246 cmdPtr = Tcl_NewStringObj("::xslt::getprocs ", -1);
1247 Tcl_IncrRefCount(cmdPtr);
1248 Tcl_AppendObjToObj(cmdPtr, extinfo->tclns);
1249 ret = Tcl_EvalObjEx(extinfo->interp, cmdPtr, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
1250 objPtr = Tcl_GetObjResult(extinfo->interp);
1251 Tcl_IncrRefCount(objPtr);
1252 Tcl_DecrRefCount(cmdPtr);
1253
1254 if (ret != TCL_OK || objPtr == NULL) {
1255 /*
1256 * Something went wrong, therefore nothing to register.
1257 */
1258 return;
1259 }
1260
1261 ret = Tcl_ListObjGetElements(extinfo->interp, objPtr, &len, ®);
1262 if (ret != TCL_OK || len != 2) {
1263 /*
1264 * Something went wrong, therefore nothing to register.
1265 */
1266 return;
1267 }
1268
1269 /*
1270 * reg[0] contains extension elements
1271 * reg[1] contains extension functions
1272 */
1273
1274 Tcl_MutexLock(&libxslt);
1275
1276 /*
1277 * First register the extension elements.
1278 */
1279
1280 ret = Tcl_ListObjLength(extinfo->interp, reg[0], &len);
1281 if (ret == TCL_OK && len > 0) {
1282 for (i = 0; i < len; i++) {
1283
1284 if (Tcl_ListObjIndex(extinfo->interp, reg[0], i, &objPtr) != TCL_OK) {
1285 continue;
1286 }
1287
1288 xsltRegisterExtModuleElement((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL),
1289 nsuri,
1290 (xsltPreComputeFunction) TclXSLTExtElementPreComp,
1291 (xsltTransformFunction) TclXSLTExtElementTransform);
1292 }
1293 }
1294
1295 /*
1296 * Now register the extension functions.
1297 */
1298
1299 ret = Tcl_ListObjLength(extinfo->interp, reg[1], &len);
1300 if (ret != TCL_OK || len == 0) {
1301 Tcl_MutexUnlock(&libxslt);
1302 return;
1303 }
1304
1305 for (i = 0; i < len; i++) {
1306
1307 if (Tcl_ListObjIndex(extinfo->interp, reg[1], i, &objPtr) != TCL_OK) {
1308 continue;
1309 }
1310
1311 xsltRegisterExtModuleFunction((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL),
1312 nsuri,
1313 TclXSLTExtFunction);
1314 }
1315
1316 Tcl_MutexUnlock(&libxslt);
1317
1318 Tcl_DecrRefCount(objPtr);
1319
1320 return;
1321 }
1322
1323 /*
1324 *----------------------------------------------------------------------------
1325 *
1326 * TclXSLTExtElementPreComp --
1327 *
1328 * Compilation step for extension element.
1329 *
1330 * Results:
1331 * Not currently used.
1332 *
1333 * Side effects:
1334 * None.
1335 *
1336 *----------------------------------------------------------------------------
1337 */
1338
1339 static xsltElemPreCompPtr
TclXSLTExtElementPreComp(style,inst,function)1340 TclXSLTExtElementPreComp(style, inst, function)
1341 xsltStylesheetPtr style;
1342 xmlNodePtr inst;
1343 xsltTransformFunction function;
1344 {
1345 return NULL;
1346 }
1347
1348 /*
1349 *----------------------------------------------------------------------------
1350 *
1351 * TclXSLTExtElementTransform --
1352 *
1353 * Implements extension element.
1354 *
1355 * Results:
1356 * Returns string returned by Tcl command evaluation.
1357 *
1358 * Side effects:
1359 * Depends on Tcl command evaluated.
1360 *
1361 *----------------------------------------------------------------------------
1362 */
1363
1364 /*
1365 * xsltAddTextString --
1366 * Copied from libxslt-1.1.24 transform.c
1367 * (without the debugging code)
1368 */
1369
1370 static xmlNodePtr
xsltAddTextString(xsltTransformContextPtr ctxt,xmlNodePtr target,const xmlChar * string,int len)1371 xsltAddTextString(xsltTransformContextPtr ctxt, xmlNodePtr target,
1372 const xmlChar *string, int len) {
1373 if ((len <= 0) || (string == NULL) || (target == NULL))
1374 return(target);
1375
1376 if (ctxt->lasttext == target->content) {
1377
1378 if (ctxt->lasttuse + len >= ctxt->lasttsize) {
1379 xmlChar *newbuf;
1380 int size;
1381
1382 size = ctxt->lasttsize + len + 100;
1383 size *= 2;
1384 newbuf = (xmlChar *) xmlRealloc(target->content,size);
1385 if (newbuf == NULL) {
1386 xsltTransformError(ctxt, NULL, target,
1387 "xsltCopyText: text allocation failed\n");
1388 return(NULL);
1389 }
1390 ctxt->lasttsize = size;
1391 ctxt->lasttext = newbuf;
1392 target->content = newbuf;
1393 }
1394 memcpy(&(target->content[ctxt->lasttuse]), string, len);
1395 ctxt->lasttuse += len;
1396 target->content[ctxt->lasttuse] = 0;
1397 } else {
1398 xmlNodeAddContent(target, string);
1399 ctxt->lasttext = target->content;
1400 len = xmlStrlen(target->content);
1401 ctxt->lasttsize = len;
1402 ctxt->lasttuse = len;
1403 }
1404 return(target);
1405 }
1406
1407 /*
1408 * xsltCopyNamespaceListInternal --
1409 * Copied from libxslt-1.1.24 transform.c
1410 * (without the debugging code)
1411 */
1412
1413 static xmlNsPtr
xsltCopyNamespaceListInternal(xmlNodePtr elem,xmlNsPtr ns)1414 xsltCopyNamespaceListInternal(xmlNodePtr elem, xmlNsPtr ns) {
1415 xmlNsPtr ret = NULL;
1416 xmlNsPtr p = NULL, q, luNs;
1417
1418 if (ns == NULL)
1419 return(NULL);
1420 if ((elem != NULL) && (elem->type != XML_ELEMENT_NODE))
1421 elem = NULL;
1422
1423 do {
1424 if (ns->type != XML_NAMESPACE_DECL)
1425 break;
1426 if (elem != NULL) {
1427 if ((elem->ns != NULL) &&
1428 xmlStrEqual(elem->ns->prefix, ns->prefix) &&
1429 xmlStrEqual(elem->ns->href, ns->href))
1430 {
1431 ns = ns->next;
1432 continue;
1433 }
1434 luNs = xmlSearchNs(elem->doc, elem, ns->prefix);
1435 if ((luNs != NULL) && (xmlStrEqual(luNs->href, ns->href)))
1436 {
1437 ns = ns->next;
1438 continue;
1439 }
1440 }
1441 q = xmlNewNs(elem, ns->href, ns->prefix);
1442 if (p == NULL) {
1443 ret = p = q;
1444 } else if (q != NULL) {
1445 p->next = q;
1446 p = q;
1447 }
1448 ns = ns->next;
1449 } while (ns != NULL);
1450 return(ret);
1451 }
1452
1453 /*
1454 * xsltCopyText --
1455 * Copied from libxslt-1.1.24 transform.c
1456 * (without the debugging code)
1457 */
1458
1459 static xmlNodePtr
xsltCopyText(xsltTransformContextPtr ctxt,xmlNodePtr target,xmlNodePtr cur,int interned)1460 xsltCopyText(xsltTransformContextPtr ctxt, xmlNodePtr target,
1461 xmlNodePtr cur, int interned)
1462 {
1463 xmlNodePtr copy;
1464
1465 if ((cur->type != XML_TEXT_NODE) &&
1466 (cur->type != XML_CDATA_SECTION_NODE))
1467 return(NULL);
1468 if (cur->content == NULL)
1469 return(NULL);
1470
1471 if ((target == NULL) || (target->children == NULL)) {
1472 ctxt->lasttext = NULL;
1473 }
1474
1475 if ((ctxt->style->cdataSection != NULL) &&
1476 (ctxt->type == XSLT_OUTPUT_XML) &&
1477 (target != NULL) &&
1478 (target->type == XML_ELEMENT_NODE) &&
1479 (((target->ns == NULL) &&
1480 (xmlHashLookup2(ctxt->style->cdataSection,
1481 target->name, NULL) != NULL)) ||
1482 ((target->ns != NULL) &&
1483 (xmlHashLookup2(ctxt->style->cdataSection,
1484 target->name, target->ns->href) != NULL))))
1485 {
1486 if ((target->last != NULL) &&
1487 (target->last->type == XML_CDATA_SECTION_NODE))
1488 {
1489 copy = xsltAddTextString(ctxt, target->last, cur->content,
1490 xmlStrlen(cur->content));
1491 goto exit;
1492 } else {
1493 unsigned int len;
1494
1495 len = xmlStrlen(cur->content);
1496 copy = xmlNewCDataBlock(ctxt->output, cur->content, len);
1497 if (copy == NULL)
1498 goto exit;
1499 ctxt->lasttext = copy->content;
1500 ctxt->lasttsize = len;
1501 ctxt->lasttuse = len;
1502 }
1503 } else if ((target != NULL) &&
1504 (target->last != NULL) &&
1505 (((target->last->type == XML_TEXT_NODE) &&
1506 (target->last->name == cur->name)) ||
1507 (((target->last->type == XML_CDATA_SECTION_NODE) &&
1508 (cur->name == xmlStringTextNoenc)))))
1509 {
1510 copy = xsltAddTextString(ctxt, target->last, cur->content,
1511 xmlStrlen(cur->content));
1512 goto exit;
1513 } else if ((interned) && (target != NULL) &&
1514 (target->doc != NULL) &&
1515 (target->doc->dict == ctxt->dict))
1516 {
1517 copy = xmlNewTextLen(NULL, 0);
1518 if (copy == NULL)
1519 goto exit;
1520 if (cur->name == xmlStringTextNoenc)
1521 copy->name = xmlStringTextNoenc;
1522
1523 if (xmlDictOwns(ctxt->dict, cur->content))
1524 copy->content = cur->content;
1525 else {
1526 if ((copy->content = xmlStrdup(cur->content)) == NULL)
1527 return NULL;
1528 }
1529 } else {
1530 unsigned int len;
1531
1532 len = xmlStrlen(cur->content);
1533 copy = xmlNewTextLen(cur->content, len);
1534 if (copy == NULL)
1535 goto exit;
1536 if (cur->name == xmlStringTextNoenc)
1537 copy->name = xmlStringTextNoenc;
1538 ctxt->lasttext = copy->content;
1539 ctxt->lasttsize = len;
1540 ctxt->lasttuse = len;
1541 }
1542 if (copy != NULL) {
1543 if (target != NULL) {
1544 copy->doc = target->doc;
1545 xmlAddChild(target, copy);
1546 }
1547 } else {
1548 xsltTransformError(ctxt, NULL, target,
1549 "xsltCopyText: text copy failed\n");
1550 }
1551
1552 exit:
1553 if ((copy == NULL) || (copy->content == NULL)) {
1554 xsltTransformError(ctxt, NULL, target,
1555 "Internal error in xsltCopyText(): "
1556 "Failed to copy the string.\n");
1557 ctxt->state = XSLT_STATE_STOPPED;
1558 }
1559 return(copy);
1560 }
1561
1562 /*
1563 * xsltShallowCopyElem --
1564 * Copied from libxslt-1.1.24 transform.c
1565 * (without the debugging code)
1566 */
1567
1568 static xmlNodePtr
xsltShallowCopyElem(xsltTransformContextPtr ctxt,xmlNodePtr node,xmlNodePtr insert,int isLRE)1569 xsltShallowCopyElem(xsltTransformContextPtr ctxt, xmlNodePtr node,
1570 xmlNodePtr insert, int isLRE)
1571 {
1572 xmlNodePtr copy;
1573
1574 if ((node->type == XML_DTD_NODE) || (insert == NULL))
1575 return(NULL);
1576 if ((node->type == XML_TEXT_NODE) ||
1577 (node->type == XML_CDATA_SECTION_NODE))
1578 return(xsltCopyText(ctxt, insert, node, 0));
1579
1580 copy = xmlDocCopyNode(node, insert->doc, 0);
1581 if (copy != NULL) {
1582 copy->doc = ctxt->output;
1583 xmlAddChild(insert, copy);
1584
1585 if (node->type == XML_ELEMENT_NODE) {
1586 if (node->nsDef != NULL) {
1587 if (isLRE)
1588 xsltCopyNamespaceList(ctxt, copy, node->nsDef);
1589 else
1590 xsltCopyNamespaceListInternal(copy, node->nsDef);
1591 }
1592
1593 if (node->ns != NULL) {
1594 if (isLRE) {
1595 copy->ns = xsltGetNamespace(ctxt, node, node->ns, copy);
1596 } else {
1597 copy->ns = xsltGetSpecialNamespace(ctxt,
1598 node, node->ns->href, node->ns->prefix, copy);
1599
1600 }
1601 } else if ((insert->type == XML_ELEMENT_NODE) &&
1602 (insert->ns != NULL))
1603 {
1604 xsltGetSpecialNamespace(ctxt, node, NULL, NULL, copy);
1605 }
1606 }
1607 } else {
1608 xsltTransformError(ctxt, NULL, node,
1609 "xsltShallowCopyElem: copy %s failed\n", node->name);
1610 }
1611 return(copy);
1612 }
1613
1614 /*
1615 * xsltApplyFallbacks --
1616 * Copied from libxslt-1.1.24 transform.c
1617 * (without the debugging code)
1618 */
1619
1620 static int
xsltApplyFallbacks(xsltTransformContextPtr ctxt,xmlNodePtr node,xmlNodePtr inst)1621 xsltApplyFallbacks(xsltTransformContextPtr ctxt, xmlNodePtr node,
1622 xmlNodePtr inst) {
1623
1624 xmlNodePtr child;
1625 int ret = 0;
1626
1627 if ((ctxt == NULL) || (node == NULL) || (inst == NULL) ||
1628 (inst->children == NULL))
1629 return(0);
1630
1631 child = inst->children;
1632 while (child != NULL) {
1633 if ((IS_XSLT_ELEM(child)) &&
1634 (xmlStrEqual(child->name, BAD_CAST "fallback"))) {
1635 ret++;
1636 xsltApplySequenceConstructor(ctxt, node, child->children,
1637 NULL);
1638 }
1639 child = child->next;
1640 }
1641 return(ret);
1642 }
1643
1644 /*
1645 * xsltReleaseLocalRVTs --
1646 * Copied from libxslt-1.1.24 transform.c
1647 * (without the debugging code)
1648 */
1649
1650 static void
xsltReleaseLocalRVTs(xsltTransformContextPtr ctxt,xmlDocPtr base)1651 xsltReleaseLocalRVTs(xsltTransformContextPtr ctxt, xmlDocPtr base)
1652 {
1653 xmlDocPtr cur = ctxt->localRVT, tmp;
1654
1655 while ((cur != NULL) && (cur != base)) {
1656 if (cur->psvi == (void *) ((long) 1)) {
1657 cur = (xmlDocPtr) cur->next;
1658 } else {
1659 tmp = cur;
1660 cur = (xmlDocPtr) cur->next;
1661
1662 if (tmp == ctxt->localRVT)
1663 ctxt->localRVT = cur;
1664
1665 if (tmp == ctxt->localRVTBase)
1666 ctxt->localRVTBase = cur;
1667
1668 if (tmp->prev)
1669 tmp->prev->next = (xmlNodePtr) cur;
1670 if (cur)
1671 cur->prev = tmp->prev;
1672 xsltReleaseRVT(ctxt, tmp);
1673 }
1674 }
1675 }
1676
1677 /*
1678 * xsltApplySequenceConstructor --
1679 * Copied from libxslt-1.1.24 transform.c
1680 * (without the debugging code)
1681 */
1682
1683 static void
xsltApplySequenceConstructor(xsltTransformContextPtr ctxt,xmlNodePtr contextNode,xmlNodePtr list,xsltTemplatePtr templ)1684 xsltApplySequenceConstructor(xsltTransformContextPtr ctxt,
1685 xmlNodePtr contextNode, xmlNodePtr list,
1686 xsltTemplatePtr templ)
1687 {
1688 xmlNodePtr oldInsert, oldInst, oldCurInst, oldContextNode;
1689 xmlNodePtr cur, insert, copy = NULL;
1690 int level = 0, oldVarsNr;
1691 xmlDocPtr oldLocalFragmentTop, oldLocalFragmentBase;
1692 #ifdef XSLT_REFACTORED
1693 xsltStylePreCompPtr info;
1694 #endif
1695
1696 if (ctxt == NULL)
1697 return;
1698 if (list == NULL)
1699 return;
1700 CHECK_STOPPED;
1701
1702
1703 oldLocalFragmentTop = ctxt->localRVT;
1704 oldInsert = insert = ctxt->insert;
1705 oldInst = oldCurInst = ctxt->inst;
1706 oldContextNode = ctxt->node;
1707
1708 oldVarsNr = ctxt->varsNr;
1709
1710 cur = list;
1711 while (cur != NULL) {
1712 ctxt->inst = cur;
1713
1714 if (insert == NULL) {
1715 goto error;
1716 }
1717 #ifdef XSLT_REFACTORED
1718 if (cur->type == XML_ELEMENT_NODE) {
1719 info = (xsltStylePreCompPtr) cur->psvi;
1720 if (info == NULL) {
1721 if (IS_XSLT_ELEM_FAST(cur) && IS_XSLT_NAME(cur, "message")) {
1722 xsltMessage(ctxt, contextNode, cur);
1723 goto skip_children;
1724 }
1725 /*
1726 * Something really went wrong:
1727 */
1728 xsltTransformError(ctxt, NULL, cur,
1729 "Internal error in xsltApplySequenceConstructor(): "
1730 "The element '%s' in the stylesheet has no compiled "
1731 "representation.\n",
1732 cur->name);
1733 goto skip_children;
1734 }
1735
1736 if (info->type == XSLT_FUNC_LITERAL_RESULT_ELEMENT) {
1737 xsltStyleItemLRElementInfoPtr lrInfo =
1738 (xsltStyleItemLRElementInfoPtr) info;
1739 copy = xmlDocCopyNode(cur, insert->doc, 0);
1740 if (copy == NULL) {
1741 xsltTransformError(ctxt, NULL, cur,
1742 "Internal error in xsltApplySequenceConstructor(): "
1743 "Failed to copy literal result element '%s'.\n",
1744 cur->name);
1745 goto error;
1746 } else {
1747 copy->doc = ctxt->output;
1748 xmlAddChild(insert, copy);
1749 if (lrInfo->effectiveNs != NULL) {
1750 xsltEffectiveNsPtr effNs = lrInfo->effectiveNs;
1751 xmlNsPtr ns, lastns = NULL;
1752
1753 while (effNs != NULL) {
1754 ns = xmlSearchNs(copy->doc, copy, effNs->prefix);
1755 if ((ns != NULL) &&
1756 (xmlStrEqual(ns->href, effNs->nsName)))
1757 {
1758 effNs = effNs->next;
1759 continue;
1760 }
1761 ns = xmlNewNs(copy, effNs->nsName, effNs->prefix);
1762 if (ns == NULL) {
1763 xsltTransformError(ctxt, NULL, cur,
1764 "Internal error in "
1765 "xsltApplySequenceConstructor(): "
1766 "Failed to copy a namespace "
1767 "declaration.\n");
1768 goto error;
1769 }
1770
1771 if (lastns == NULL)
1772 copy->nsDef = ns;
1773 else
1774 lastns->next =ns;
1775 lastns = ns;
1776
1777 effNs = effNs->next;
1778 }
1779
1780 }
1781 if (cur->ns != NULL) {
1782 copy->ns = xsltGetSpecialNamespace(ctxt, cur,
1783 cur->ns->href, cur->ns->prefix, copy);
1784 } else {
1785 if (copy->nsDef ||
1786 ((insert != NULL) &&
1787 (insert->type == XML_ELEMENT_NODE) &&
1788 (insert->ns != NULL)))
1789 {
1790 xsltGetSpecialNamespace(ctxt, cur,
1791 NULL, NULL, copy);
1792 }
1793 }
1794 }
1795 if (cur->properties != NULL) {
1796 xsltAttrListTemplateProcess(ctxt, copy, cur->properties);
1797 }
1798 } else if (IS_XSLT_ELEM_FAST(cur)) {
1799 if (info->type == XSLT_FUNC_UNKOWN_FORWARDS_COMPAT) {
1800 ctxt->insert = insert;
1801 if (!xsltApplyFallbacks(ctxt, contextNode, cur)) {
1802 xsltTransformError(ctxt, NULL, cur,
1803 "The is no fallback behaviour defined for "
1804 "the unknown XSLT element '%s'.\n",
1805 cur->name);
1806 }
1807 ctxt->insert = oldInsert;
1808 } else if (info->func != NULL) {
1809 ctxt->insert = insert;
1810
1811 info->func(ctxt, contextNode, cur,
1812 (xsltElemPreCompPtr) info);
1813
1814 if (oldLocalFragmentTop != ctxt->localRVT)
1815 xsltReleaseLocalRVTs(ctxt, oldLocalFragmentTop);
1816
1817 ctxt->insert = oldInsert;
1818 } else if (info->type == XSLT_FUNC_VARIABLE) {
1819 xsltStackElemPtr tmpvar = ctxt->vars;
1820
1821 xsltParseStylesheetVariable(ctxt, cur);
1822
1823 if (tmpvar != ctxt->vars) {
1824 ctxt->vars->level = level;
1825 }
1826 } else if (info->type == XSLT_FUNC_MESSAGE) {
1827 xsltMessage(ctxt, contextNode, cur);
1828 } else {
1829 xsltTransformError(ctxt, NULL, cur,
1830 "Unexpected XSLT element '%s'.\n", cur->name);
1831 }
1832 goto skip_children;
1833
1834 } else {
1835 xsltTransformFunction func;
1836 if (cur->psvi == xsltExtMarker) {
1837 func = (xsltTransformFunction)
1838 xsltExtElementLookup(ctxt, cur->name, cur->ns->href);
1839 } else
1840 func = ((xsltElemPreCompPtr) cur->psvi)->func;
1841
1842 if (func == NULL) {
1843 ctxt->insert = insert;
1844 if (!xsltApplyFallbacks(ctxt, contextNode, cur)) {
1845 xsltTransformError(ctxt, NULL, cur,
1846 "Unknown extension instruction '{%s}%s'.\n",
1847 cur->ns->href, cur->name);
1848 }
1849 ctxt->insert = oldInsert;
1850 } else {
1851 ctxt->insert = insert;
1852 oldLocalFragmentBase = ctxt->localRVTBase;
1853 ctxt->localRVTBase = NULL;
1854
1855 func(ctxt, contextNode, cur, cur->psvi);
1856
1857 ctxt->localRVTBase = oldLocalFragmentBase;
1858 if (oldLocalFragmentTop != ctxt->localRVT)
1859 xsltReleaseLocalRVTs(ctxt, oldLocalFragmentTop);
1860
1861 ctxt->insert = oldInsert;
1862 }
1863 goto skip_children;
1864 }
1865
1866 } else if (XSLT_IS_TEXT_NODE(cur)) {
1867 if (xsltCopyText(ctxt, insert, cur, ctxt->internalized) == NULL)
1868 goto error;
1869 }
1870
1871 #else /* XSLT_REFACTORED */
1872
1873 if (IS_XSLT_ELEM(cur)) {
1874 xsltStylePreCompPtr info = (xsltStylePreCompPtr) cur->psvi;
1875
1876 if (info == NULL) {
1877 if (IS_XSLT_NAME(cur, "message")) {
1878 xsltMessage(ctxt, contextNode, cur);
1879 } else {
1880 ctxt->insert = insert;
1881 if (!xsltApplyFallbacks(ctxt, contextNode, cur)) {
1882 xsltGenericError(xsltGenericErrorContext,
1883 "xsltApplySequenceConstructor: %s was not compiled\n",
1884 cur->name);
1885 }
1886 ctxt->insert = oldInsert;
1887 }
1888 goto skip_children;
1889 }
1890
1891 if (info->func != NULL) {
1892 oldCurInst = ctxt->inst;
1893 ctxt->inst = cur;
1894 ctxt->insert = insert;
1895 oldLocalFragmentBase = ctxt->localRVTBase;
1896 ctxt->localRVTBase = NULL;
1897
1898 info->func(ctxt, contextNode, cur, (xsltElemPreCompPtr) info);
1899
1900 ctxt->localRVTBase = oldLocalFragmentBase;
1901 if (oldLocalFragmentTop != ctxt->localRVT)
1902 xsltReleaseLocalRVTs(ctxt, oldLocalFragmentTop);
1903
1904 ctxt->insert = oldInsert;
1905 ctxt->inst = oldCurInst;
1906 goto skip_children;
1907 }
1908
1909 if (IS_XSLT_NAME(cur, "variable")) {
1910 xsltStackElemPtr tmpvar = ctxt->vars;
1911
1912 oldCurInst = ctxt->inst;
1913 ctxt->inst = cur;
1914
1915 xsltParseStylesheetVariable(ctxt, cur);
1916
1917 ctxt->inst = oldCurInst;
1918
1919 if (tmpvar != ctxt->vars) {
1920 ctxt->vars->level = level;
1921 }
1922 } else if (IS_XSLT_NAME(cur, "message")) {
1923 xsltMessage(ctxt, contextNode, cur);
1924 } else {
1925 xsltTransformError(ctxt, NULL, cur,
1926 "Unexpected XSLT element '%s'.\n", cur->name);
1927 }
1928 goto skip_children;
1929 } else if ((cur->type == XML_TEXT_NODE) ||
1930 (cur->type == XML_CDATA_SECTION_NODE)) {
1931
1932 if (xsltCopyText(ctxt, insert, cur, ctxt->internalized) == NULL)
1933 goto error;
1934 } else if ((cur->type == XML_ELEMENT_NODE) &&
1935 (cur->ns != NULL) && (cur->psvi != NULL)) {
1936 xsltTransformFunction function;
1937
1938 oldCurInst = ctxt->inst;
1939 ctxt->inst = cur;
1940 if (cur->psvi == xsltExtMarker)
1941 function = (xsltTransformFunction)
1942 xsltExtElementLookup(ctxt, cur->name, cur->ns->href);
1943 else
1944 function = ((xsltElemPreCompPtr) cur->psvi)->func;
1945
1946 if (function == NULL) {
1947 xmlNodePtr child;
1948 int found = 0;
1949
1950 child = cur->children;
1951 while (child != NULL) {
1952 if ((IS_XSLT_ELEM(child)) &&
1953 (IS_XSLT_NAME(child, "fallback")))
1954 {
1955 found = 1;
1956 xsltApplySequenceConstructor(ctxt, contextNode,
1957 child->children, NULL);
1958 }
1959 child = child->next;
1960 }
1961
1962 if (!found) {
1963 xsltTransformError(ctxt, NULL, cur,
1964 "xsltApplySequenceConstructor: failed to find extension %s\n",
1965 cur->name);
1966 }
1967 } else {
1968
1969 ctxt->insert = insert;
1970 oldLocalFragmentBase = ctxt->localRVTBase;
1971 ctxt->localRVTBase = NULL;
1972
1973 function(ctxt, contextNode, cur, cur->psvi);
1974 if (oldLocalFragmentTop != ctxt->localRVT)
1975 xsltReleaseLocalRVTs(ctxt, oldLocalFragmentTop);
1976
1977 ctxt->localRVTBase = oldLocalFragmentBase;
1978 ctxt->insert = oldInsert;
1979
1980 }
1981 ctxt->inst = oldCurInst;
1982 goto skip_children;
1983 } else if (cur->type == XML_ELEMENT_NODE) {
1984 oldCurInst = ctxt->inst;
1985 ctxt->inst = cur;
1986
1987 if ((copy = xsltShallowCopyElem(ctxt, cur, insert, 1)) == NULL)
1988 goto error;
1989 if ((templ != NULL) && (oldInsert == insert) &&
1990 (ctxt->templ != NULL) && (ctxt->templ->inheritedNs != NULL)) {
1991 int i;
1992 xmlNsPtr ns, ret;
1993
1994 for (i = 0; i < ctxt->templ->inheritedNsNr; i++) {
1995 const xmlChar *URI = NULL;
1996 xsltStylesheetPtr style;
1997 ns = ctxt->templ->inheritedNs[i];
1998
1999 style = ctxt->style;
2000 while (style != NULL) {
2001 if (style->nsAliases != NULL)
2002 URI = (const xmlChar *)
2003 xmlHashLookup(style->nsAliases, ns->href);
2004 if (URI != NULL)
2005 break;
2006
2007 style = xsltNextImport(style);
2008 }
2009 if (URI == UNDEFINED_DEFAULT_NS)
2010 continue;
2011 if (URI == NULL)
2012 URI = ns->href;
2013 ret = xmlSearchNs(copy->doc, copy, ns->prefix);
2014 if ((ret == NULL) || (!xmlStrEqual(ret->href, URI)))
2015 {
2016 xmlNewNs(copy, URI, ns->prefix);
2017 }
2018 }
2019 if (copy->ns != NULL) {
2020 copy->ns = xsltGetNamespace(ctxt, cur, copy->ns, copy);
2021 }
2022 }
2023 if (cur->properties != NULL) {
2024 xsltAttrListTemplateProcess(ctxt, copy, cur->properties);
2025 }
2026 ctxt->inst = oldCurInst;
2027 }
2028 #endif /* else of XSLT_REFACTORED */
2029
2030 if (cur->children != NULL) {
2031 if (cur->children->type != XML_ENTITY_DECL) {
2032 cur = cur->children;
2033 level++;
2034 if (copy != NULL)
2035 insert = copy;
2036 continue;
2037 }
2038 }
2039
2040 skip_children:
2041 if (ctxt->state == XSLT_STATE_STOPPED)
2042 break;
2043 if (cur->next != NULL) {
2044 cur = cur->next;
2045 continue;
2046 }
2047
2048 do {
2049 cur = cur->parent;
2050 level--;
2051 if ((ctxt->varsNr > oldVarsNr) && (ctxt->vars->level > level)) {
2052 xsltLocalVariablePop(ctxt, oldVarsNr, level);
2053 }
2054
2055 insert = insert->parent;
2056 if (cur == NULL)
2057 break;
2058 if (cur == list->parent) {
2059 cur = NULL;
2060 break;
2061 }
2062 if (cur->next != NULL) {
2063 cur = cur->next;
2064 break;
2065 }
2066 } while (cur != NULL);
2067 }
2068
2069 error:
2070 if (ctxt->varsNr > oldVarsNr)
2071 xsltLocalVariablePop(ctxt, oldVarsNr, -1);
2072
2073 ctxt->node = oldContextNode;
2074 ctxt->inst = oldInst;
2075 ctxt->insert = oldInsert;
2076 }
2077
2078 static void
TclXSLTExtElementTransform(ctxt,node,inst,comp)2079 TclXSLTExtElementTransform(ctxt, node, inst, comp)
2080 xsltTransformContextPtr ctxt; /* unused */
2081 xmlNodePtr node;
2082 xmlNodePtr inst;
2083 xsltStylePreCompPtr comp; /* unused */
2084 {
2085 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
2086 TclXSLT_Extension *extinfo;
2087 Tcl_HashEntry *entry;
2088 Tcl_Obj *cmdPtr, *objPtr, *avtObjPtr, *elemObj;
2089 xsltStylesheetPtr style = NULL;
2090 xmlDocPtr oldOutput, res = NULL;
2091 xmlNodePtr oldInsert;
2092 xsltOutputType oldType;
2093 xmlAttrPtr attr;
2094 int ret;
2095
2096 if (inst == NULL) {
2097 return;
2098 }
2099
2100 entry = Tcl_FindHashEntry(tsdPtr->extensions, (CONST char *) inst->ns->href);
2101 if (entry == NULL) {
2102 /*
2103 * Cannot find extension module.
2104 * Must have been removed.
2105 */
2106 return;
2107 }
2108
2109 extinfo = (TclXSLT_Extension *) Tcl_GetHashValue(entry);
2110
2111 /*
2112 * Evaluate every attribute as an AVT.
2113 * Pass these values on to the callback as a list.
2114 * Each list element is (name, ns, value)
2115 */
2116
2117 avtObjPtr = Tcl_NewListObj(0, NULL);
2118 for (attr = inst->properties; attr != NULL; attr = attr->next) {
2119 elemObj = Tcl_NewListObj(0, NULL);
2120 if (Tcl_ListObjAppendElement(extinfo->interp, elemObj, Tcl_NewStringObj((CONST char *) attr->name, -1))) {
2121 goto error;
2122 }
2123 if (attr->ns != NULL) {
2124 if (Tcl_ListObjAppendElement(extinfo->interp, elemObj, Tcl_NewStringObj((CONST char *) attr->ns->href, -1))) {
2125 goto error;
2126 }
2127 } else {
2128 if (Tcl_ListObjAppendElement(extinfo->interp, elemObj, Tcl_NewObj())) {
2129 goto error;
2130 }
2131 }
2132 if (Tcl_ListObjAppendElement(extinfo->interp, elemObj, Tcl_NewStringObj((char *) xsltEvalAttrValueTemplate(ctxt, inst, attr->name, NULL), -1))) {
2133 goto error;
2134 }
2135
2136 if (Tcl_ListObjAppendElement(extinfo->interp, avtObjPtr, elemObj)) {
2137 goto error;
2138 }
2139 }
2140
2141 /*
2142 * Evaluate the element content.
2143 */
2144
2145 oldOutput = ctxt->output;
2146 oldInsert = ctxt->insert;
2147 oldType = ctxt->type;
2148
2149 style = xsltNewStylesheet();
2150 if (style == NULL) {
2151 xsltTransformError(ctxt, NULL, inst,
2152 "TclXSLT: out of memory\n");
2153 goto error;
2154 }
2155 res = xmlNewDoc(style->version);
2156 res->charset = XML_CHAR_ENCODING_UTF8;
2157 ctxt->output = res;
2158 ctxt->insert = (xmlNodePtr) res;
2159
2160 xsltApplySequenceConstructor(ctxt, node, inst->children, NULL);
2161
2162 /*
2163 * Start constructing the script by first defining the command.
2164 */
2165
2166 cmdPtr = Tcl_DuplicateObj(extinfo->tclns);
2167 Tcl_AppendStringsToObj(cmdPtr, "::", inst->name, NULL);
2168
2169 if (res != NULL) {
2170 objPtr = TclDOM_libxml2_CreateObjFromDoc(extinfo->interp, res);
2171 if (objPtr == NULL) {
2172 Tcl_DecrRefCount(cmdPtr);
2173 Tcl_BackgroundError(extinfo->interp);
2174 goto error;
2175 }
2176 if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, objPtr) != TCL_OK) {
2177 Tcl_DecrRefCount(cmdPtr);
2178 Tcl_BackgroundError(extinfo->interp);
2179 goto error;
2180 }
2181 } else {
2182 if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, Tcl_NewObj()) != TCL_OK) {
2183 Tcl_DecrRefCount(cmdPtr);
2184 Tcl_BackgroundError(extinfo->interp);
2185 goto error;
2186 }
2187 }
2188
2189 if (node != NULL) {
2190 objPtr = TclDOM_libxml2_CreateObjFromNode(extinfo->interp, node);
2191 if (objPtr == NULL) {
2192 Tcl_DecrRefCount(cmdPtr);
2193 Tcl_BackgroundError(extinfo->interp);
2194 goto error;
2195 }
2196 if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, objPtr) != TCL_OK) {
2197 Tcl_DecrRefCount(cmdPtr);
2198 Tcl_BackgroundError(extinfo->interp);
2199 goto error;
2200 }
2201 } else {
2202 if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, Tcl_NewObj()) != TCL_OK) {
2203 Tcl_DecrRefCount(cmdPtr);
2204 Tcl_BackgroundError(extinfo->interp);
2205 goto error;
2206 }
2207 }
2208
2209 if (inst != NULL) {
2210 objPtr = TclDOM_libxml2_CreateObjFromNode(extinfo->interp, inst);
2211 if (objPtr == NULL) {
2212 Tcl_DecrRefCount(cmdPtr);
2213 Tcl_BackgroundError(extinfo->interp);
2214 goto error;
2215 }
2216 if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, objPtr) != TCL_OK) {
2217 Tcl_DecrRefCount(cmdPtr);
2218 Tcl_BackgroundError(extinfo->interp);
2219 goto error;
2220 }
2221 } else {
2222 if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, Tcl_NewObj()) != TCL_OK) {
2223 Tcl_DecrRefCount(cmdPtr);
2224 Tcl_BackgroundError(extinfo->interp);
2225 goto error;
2226 }
2227 }
2228
2229 if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, avtObjPtr) != TCL_OK) {
2230 Tcl_DecrRefCount(cmdPtr);
2231 Tcl_BackgroundError(extinfo->interp);
2232 goto error;
2233 }
2234
2235 /*
2236 * Converting the stylesheet node to a TclDOM node may clobber the
2237 * _private pointer. It would be nice to find the equivalent node
2238 * in the original DOM tree, but it may not even exist anymore :-(
2239 *
2240 * TODO: make extension elements more effective, and allow
2241 * pre-computation.
2242 */
2243
2244 /*
2245 * Now evaluate the complete command.
2246 */
2247 ret = Tcl_EvalObjEx(extinfo->interp, cmdPtr, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
2248 if (ret != TCL_OK) {
2249 xsltTransformError(ctxt, NULL, NULL, "TclXSLT extension failed: \"%s\"", Tcl_GetStringFromObj(Tcl_GetObjResult(extinfo->interp), NULL));
2250 Tcl_BackgroundError(extinfo->interp);
2251 }
2252
2253 /*
2254 * TODO:
2255 * If the script evaluation is successful, then the return
2256 * result is either a DOM node to be inserted into the result tree
2257 * or a string to be added as a text node.
2258 */
2259
2260 error:
2261 ctxt->output = oldOutput;
2262 ctxt->insert = oldInsert;
2263 ctxt->type = oldType;
2264 }
2265
2266 /*
2267 *----------------------------------------------------------------------------
2268 *
2269 * TclXSLTExtFunction --
2270 *
2271 * Handles evaluation of an extension function.
2272 *
2273 * Results:
2274 * Returns string returned by Tcl command evaluation.
2275 *
2276 * Side effects:
2277 * Depends on Tcl command evaluated.
2278 *
2279 *----------------------------------------------------------------------------
2280 */
2281
2282 static void
TclXSLTExtFunction(xpathCtxt,nargs)2283 TclXSLTExtFunction(xpathCtxt, nargs)
2284 xmlXPathParserContextPtr xpathCtxt;
2285 int nargs;
2286 {
2287 xsltTransformContextPtr xformCtxt;
2288 TclXSLT_Extension *extinfo;
2289 Tcl_Obj *cmdPtr, *resultPtr;
2290 xmlXPathObjectPtr obj;
2291 int ret;
2292
2293 Tcl_MutexLock(&libxslt);
2294
2295 xformCtxt = xsltXPathGetTransformContext(xpathCtxt);
2296
2297 /*
2298 * In order to find the instance data we need the
2299 * XML Namespace URI of this function.
2300 */
2301
2302 extinfo = (TclXSLT_Extension *) xsltGetExtData(xformCtxt,
2303 xpathCtxt->context->functionURI);
2304
2305 /*
2306 * Start constructing the script by first defining the command.
2307 */
2308
2309 cmdPtr = Tcl_DuplicateObj(extinfo->tclns);
2310 Tcl_IncrRefCount(cmdPtr);
2311 Tcl_AppendStringsToObj(cmdPtr, "::", xpathCtxt->context->function, NULL);
2312
2313 /*
2314 * Each argument on the stack is converted to a Tcl_Obj
2315 * of an appropriate type and passed as an argument to the Tcl command.
2316 */
2317
2318 while (nargs) {
2319 Tcl_Obj *objv[2];
2320
2321 obj = (xmlXPathObjectPtr) valuePop(xpathCtxt);
2322 if (obj == NULL) {
2323 xmlXPathSetError(xpathCtxt, XPATH_INVALID_OPERAND);
2324 Tcl_DecrRefCount(cmdPtr);
2325 Tcl_MutexUnlock(&libxslt);
2326 return;
2327 }
2328
2329 objv[0] = TclXSLT_ConvertXPathObjToTclObj(extinfo->interp, obj);
2330 objv[1] = NULL;
2331 if (Tcl_ListObjReplace(extinfo->interp, cmdPtr, 1, 0, 1, objv) != TCL_OK) {
2332 Tcl_BackgroundError(extinfo->interp);
2333 Tcl_DecrRefCount(objv[0]);
2334 Tcl_DecrRefCount(cmdPtr);
2335 Tcl_MutexUnlock(&libxslt);
2336 return;
2337 }
2338
2339 /* When should this XPath object be freed?
2340 * Immediately before returning from the function call?
2341 * What if the application retains a pointer to it?
2342 * If the application destroys the contents, then memory
2343 * will leak because the XPath object is not freed.
2344 *
2345 * TODO: take a copy of the object's content and pass that
2346 * to the application callback. That would allow this object
2347 * to be freed and allow the application to manage the copy.
2348
2349 xmlXPathFreeObject(obj);
2350 */
2351
2352 nargs--;
2353 }
2354
2355 ret = Tcl_EvalObjEx(extinfo->interp, cmdPtr, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
2356 resultPtr = Tcl_GetObjResult(extinfo->interp);
2357 Tcl_DecrRefCount(cmdPtr);
2358 Tcl_IncrRefCount(resultPtr);
2359
2360 if (ret == TCL_OK) {
2361 obj = TclXSLT_ConvertTclObjToXPathObj(extinfo->interp, resultPtr);
2362 valuePush(xpathCtxt, obj);
2363 } else {
2364 xmlGenericError(xmlGenericErrorContext,
2365 Tcl_GetStringFromObj(resultPtr, NULL));
2366 /* Need to define a new error code - this is the closest in meaning */
2367 xpathCtxt->error = XPATH_UNKNOWN_FUNC_ERROR;
2368 }
2369
2370 Tcl_MutexUnlock(&libxslt);
2371
2372 Tcl_DecrRefCount(resultPtr);
2373
2374 }
2375
2376 /*
2377 *----------------------------------------------------------------------------
2378 *
2379 * TclXSLT_ConvertTclObjToXPathObj --
2380 *
2381 * Convert a Tcl Object to an XPath object.
2382 * Data type is preserved, with nodesets being
2383 * mapped from a list of nodes.
2384 *
2385 * NB. Mutex is assumed to be locked when invoking this routine.
2386 *
2387 * Results:
2388 * XPath Object.
2389 *
2390 * Side effects:
2391 * None.
2392 *
2393 *----------------------------------------------------------------------------
2394 */
2395
2396 static xmlXPathObjectPtr
TclXSLT_ConvertTclObjToXPathObj(interp,objPtr)2397 TclXSLT_ConvertTclObjToXPathObj(interp, objPtr)
2398 Tcl_Interp *interp;
2399 Tcl_Obj *objPtr;
2400 {
2401 xmlNodePtr nodePtr;
2402 xmlDocPtr docPtr;
2403
2404 if (TclDOM_libxml2_GetNodeFromObj(interp, objPtr, &nodePtr) == TCL_OK) {
2405 return xmlXPathNewNodeSet(nodePtr);
2406 }
2407
2408 if (TclXML_libxml2_GetDocFromObj(interp, objPtr, &docPtr) == TCL_OK) {
2409 return xmlXPathNewNodeSet((xmlNodePtr) docPtr);
2410
2411 }
2412
2413 if (objPtr->typePtr == Tcl_GetObjType("int") ||
2414 objPtr->typePtr == Tcl_GetObjType("double")) {
2415 double number;
2416
2417 if (Tcl_GetDoubleFromObj(interp, objPtr, &number) == TCL_OK) {
2418 return xmlXPathNewFloat(number);
2419 } else {
2420 return NULL;
2421 }
2422 } else if (objPtr->typePtr == Tcl_GetObjType("boolean")) {
2423 int bool;
2424
2425 if (Tcl_GetBooleanFromObj(interp, objPtr, &bool) == TCL_OK) {
2426 return xmlXPathNewBoolean(bool);
2427 } else {
2428 return NULL;
2429 }
2430 } else if (objPtr->typePtr == Tcl_GetObjType("list")) {
2431 /*
2432 * If each of the elements can be converted to a node,
2433 * then return a nodeset.
2434 */
2435
2436 int i, len;
2437 Tcl_Obj **listPtr;
2438 xmlNodeSetPtr nset;
2439
2440 Tcl_ListObjGetElements(interp, objPtr, &len, &listPtr);
2441 if (len == 0) {
2442 return xmlXPathNewNodeSet(NULL);
2443 }
2444
2445 /*
2446 * First pass: check that the elements are all nodes.
2447 */
2448 for (i = 0; i < len; i++) {
2449 if (TclXML_libxml2_GetDocFromObj(interp, listPtr[i], &docPtr) == TCL_OK) {
2450 continue;
2451 }
2452 if (TclDOM_libxml2_GetNodeFromObj(interp, listPtr[i], &nodePtr) != TCL_OK) {
2453 return xmlXPathNewString((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL));
2454 }
2455 }
2456 /*
2457 * Now go ahead and create the nodeset (we already did the hard
2458 * work to create internal reps in pass 1).
2459 */
2460 if (TclXML_libxml2_GetDocFromObj(interp, listPtr[0], &docPtr) == TCL_OK) {
2461 nset = xmlXPathNodeSetCreate((xmlNodePtr) docPtr);
2462 } else {
2463 TclDOM_libxml2_GetNodeFromObj(interp, listPtr[0], &nodePtr);
2464 nset = xmlXPathNodeSetCreate(nodePtr);
2465 }
2466 for (i = 1; i < len; i++) {
2467 if (TclXML_libxml2_GetDocFromObj(interp, listPtr[i], &docPtr) == TCL_OK) {
2468 xmlXPathNodeSetAdd(nset, (xmlNodePtr) docPtr);
2469 } else {
2470 TclDOM_libxml2_GetNodeFromObj(interp, listPtr[i], &nodePtr);
2471 xmlXPathNodeSetAdd(nset, nodePtr);
2472 }
2473 }
2474 return xmlXPathWrapNodeSet(nset);
2475
2476 } else {
2477 return xmlXPathNewString((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL));
2478 }
2479 }
2480
2481 /*
2482 *----------------------------------------------------------------------------
2483 *
2484 * TclXSLT_ConvertXPathObjToTclObj --
2485 *
2486 * Convert an XPath object to a Tcl Object.
2487 * Data type is preserved, with nodesets being
2488 * mapped to a list of nodes.
2489 *
2490 * Results:
2491 * Tcl Object.
2492 *
2493 * Side effects:
2494 * None.
2495 *
2496 *----------------------------------------------------------------------------
2497 */
2498
2499 static Tcl_Obj *
TclXSLT_ConvertXPathObjToTclObj(interp,xpobj)2500 TclXSLT_ConvertXPathObjToTclObj(interp, xpobj)
2501 Tcl_Interp *interp;
2502 xmlXPathObjectPtr xpobj;
2503 {
2504 Tcl_Obj *objPtr;
2505 int i;
2506
2507 switch (xpobj->type) {
2508 case XPATH_XSLT_TREE:
2509 case XPATH_NODESET:
2510
2511 objPtr = Tcl_NewListObj(0, NULL);
2512 if (xpobj->nodesetval) {
2513 for (i = 0; i < xpobj->nodesetval->nodeNr; i++) {
2514 Tcl_Obj *nodeObjPtr = NULL;
2515 if (xpobj->nodesetval->nodeTab[i] &&
2516 xpobj->nodesetval->nodeTab[i]->type == XML_DOCUMENT_NODE) {
2517 nodeObjPtr = TclXML_libxml2_CreateObjFromDoc((xmlDocPtr) xpobj->nodesetval->nodeTab[i]);
2518 } else if (xpobj->nodesetval->nodeTab[i]) {
2519 nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, xpobj->nodesetval->nodeTab[i]);
2520 }
2521 Tcl_ListObjAppendElement(interp, objPtr, nodeObjPtr);
2522 }
2523 }
2524
2525 break;
2526
2527 case XPATH_BOOLEAN:
2528 objPtr = Tcl_NewBooleanObj(xpobj->boolval);
2529 break;
2530
2531 case XPATH_NUMBER:
2532 objPtr = Tcl_NewDoubleObj(xpobj->floatval);
2533 break;
2534
2535 case XPATH_STRING:
2536 case XPATH_UNDEFINED:
2537 case XPATH_POINT:
2538 case XPATH_RANGE:
2539 case XPATH_LOCATIONSET:
2540 case XPATH_USERS:
2541 default:
2542 objPtr = Tcl_NewStringObj((CONST char *) xmlXPathCastToString(xpobj), -1);
2543
2544 break;
2545 }
2546
2547 return objPtr;
2548 }
2549
2550 /*
2551 *----------------------------------------------------------------------------
2552 *
2553 * TclXSLTExtShutdown --
2554 *
2555 * Clean up.
2556 *
2557 * Results:
2558 * None.
2559 *
2560 * Side effects:
2561 * None.
2562 *
2563 *----------------------------------------------------------------------------
2564 */
2565
2566 static void
TclXSLTExtShutdown(ctxt,URI,userdata)2567 TclXSLTExtShutdown(ctxt, URI, userdata)
2568 xsltTransformContextPtr ctxt;
2569 const xmlChar *URI;
2570 void *userdata;
2571 {
2572 /* Nothing to do */
2573 }
2574
2575 /*
2576 *----------------------------------------------------------------------------
2577 *
2578 * TclXSLTSecurity --
2579 * TclXSLTSecurityReadFile --
2580 * TclXSLTSecurityWriteFile --
2581 * TclXSLTSecurityCreateDirectory --
2582 * TclXSLTSecurityReadNetwork --
2583 * TclXSLTSecurityWriteNetwork --
2584 *
2585 * Check if external operations are permitted.
2586 *
2587 * Results:
2588 * Returns boolean value.
2589 *
2590 * Side effects:
2591 * Depends on callback.
2592 *
2593 *----------------------------------------------------------------------------
2594 */
2595
2596 static int
TclXSLTSecurity(name,method,value)2597 TclXSLTSecurity(name, method, value)
2598 Tcl_Obj *name;
2599 const char *method;
2600 const char *value;
2601 {
2602 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
2603 Tcl_Interp *master;
2604 Tcl_Obj *cmdPtr, *pathPtr;
2605 int result, permitted;
2606
2607 if (Tcl_IsSafe(tsdPtr->interp)) {
2608
2609 /*
2610 * Invoke hidden command
2611 */
2612
2613 master = Tcl_GetMaster(tsdPtr->interp);
2614
2615 if (!Tcl_IsSafe(master)) {
2616 return 0;
2617 }
2618
2619 if (Tcl_GetInterpPath(master, tsdPtr->interp) != TCL_OK) {
2620 return 0;
2621 }
2622 pathPtr = Tcl_GetObjResult(master);
2623
2624 cmdPtr = Tcl_NewListObj(0, NULL);
2625 Tcl_IncrRefCount(cmdPtr);
2626 Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("interp", -1));
2627 Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("invokehidden", -1));
2628 Tcl_ListObjAppendElement(master, cmdPtr, pathPtr);
2629 Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("-global", -1));
2630 Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("::xslt::security", -1));
2631 Tcl_ListObjAppendElement(master, cmdPtr, name);
2632 Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj(method, -1));
2633 Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj(value, -1));
2634
2635 result = Tcl_EvalObjEx(master, cmdPtr, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
2636
2637 Tcl_DecrRefCount(cmdPtr);
2638 } else {
2639
2640 /*
2641 * Invoke command normally
2642 */
2643
2644 cmdPtr = Tcl_NewListObj(0, NULL);
2645 Tcl_IncrRefCount(cmdPtr);
2646 Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewStringObj("::xslt::security", -1));
2647 Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, name);
2648 Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewStringObj(method, -1));
2649 Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewStringObj(value, -1));
2650
2651 result = Tcl_EvalObjEx(tsdPtr->interp, cmdPtr, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
2652
2653 Tcl_DecrRefCount(cmdPtr);
2654 }
2655
2656 if (result == TCL_OK) {
2657 if (Tcl_GetBooleanFromObj(tsdPtr->interp, Tcl_GetObjResult(tsdPtr->interp), &permitted) == TCL_OK) {
2658 return permitted;
2659 } else if (Tcl_IsSafe(tsdPtr->interp)) {
2660 return 0;
2661 } else {
2662 return 1;
2663 }
2664 } else if (Tcl_IsSafe(tsdPtr->interp)) {
2665 return 0;
2666 } else {
2667 return 1;
2668 }
2669 }
2670 static Tcl_Obj *
TclXSLTSecurityGetName(ctxt)2671 TclXSLTSecurityGetName(ctxt)
2672 xsltTransformContextPtr ctxt;
2673 {
2674 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
2675 Tcl_HashEntry *entryPtr;
2676
2677 if (ctxt) {
2678 entryPtr = Tcl_FindHashEntry(tsdPtr->stylesheets, (ClientData) ctxt->style);
2679 if (entryPtr) {
2680 return Tcl_NewStringObj((char *) Tcl_GetHashValue(entryPtr), -1);
2681 } else {
2682 return Tcl_NewObj();
2683 }
2684 } else {
2685 return Tcl_NewObj();
2686 }
2687 }
2688 static int
TclXSLTSecurityReadFile(sec,ctxt,value)2689 TclXSLTSecurityReadFile(sec, ctxt, value)
2690 xsltSecurityPrefsPtr sec;
2691 xsltTransformContextPtr ctxt;
2692 const char *value;
2693 {
2694 return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "readfile", value);
2695 }
2696 static int
TclXSLTSecurityWriteFile(sec,ctxt,value)2697 TclXSLTSecurityWriteFile(sec, ctxt, value)
2698 xsltSecurityPrefsPtr sec;
2699 xsltTransformContextPtr ctxt;
2700 const char *value;
2701 {
2702 return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "writefile", value);
2703 }
2704 static int
TclXSLTSecurityCreateDirectory(sec,ctxt,value)2705 TclXSLTSecurityCreateDirectory(sec, ctxt, value)
2706 xsltSecurityPrefsPtr sec;
2707 xsltTransformContextPtr ctxt;
2708 const char *value;
2709 {
2710 return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "createdirectory", value);
2711 }
2712 static int
TclXSLTSecurityReadNetwork(sec,ctxt,value)2713 TclXSLTSecurityReadNetwork(sec, ctxt, value)
2714 xsltSecurityPrefsPtr sec;
2715 xsltTransformContextPtr ctxt;
2716 const char *value;
2717 {
2718 return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "readnetwork", value);
2719 }
2720 static int
TclXSLTSecurityWriteNetwork(sec,ctxt,value)2721 TclXSLTSecurityWriteNetwork(sec, ctxt, value)
2722 xsltSecurityPrefsPtr sec;
2723 xsltTransformContextPtr ctxt;
2724 const char *value;
2725 {
2726 return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "writenetwork", value);
2727 }
2728