Silence minor compiler warnings.
1 | /* |
2 | * The contents of this file are subject to the AOLserver Public License |
3 | * Version 1.1 (the "License"); you may not use this file except in |
4 | * compliance with the License. You may obtain a copy of the License at |
5 | * http://aolserver.com/. |
6 | * |
7 | * Software distributed under the License is distributed on an "AS IS" |
8 | * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See |
9 | * the License for the specific language governing rights and limitations |
10 | * under the License. |
11 | * |
12 | * The Original Code is AOLserver Code and related documentation |
13 | * distributed by AOL. |
14 | * |
15 | * The Initial Developer of the Original Code is America Online, |
16 | * Inc. Portions created by AOL are Copyright (C) 1999 America Online, |
17 | * Inc. All Rights Reserved. |
18 | * |
19 | * Alternatively, the contents of this file may be used under the terms |
20 | * of the GNU General Public License (the "GPL"), in which case the |
21 | * provisions of GPL are applicable instead of those above. If you wish |
22 | * to allow use of your version of this file only under the terms of the |
23 | * GPL and not to allow others to use your version of this file under the |
24 | * License, indicate your decision by deleting the provisions above and |
25 | * replace them with the notice and other provisions required by the GPL. |
26 | * If you do not delete the provisions above, a recipient may use your |
27 | * version of this file under either the License or the GPL. |
28 | */ |
29 | |
30 | /* |
31 | * tclinit.c -- |
32 | * |
33 | * Initialization and resource management routines for Tcl. This |
34 | * code provides for three types of AOLserver extended Tcl |
35 | * interps: |
36 | * |
37 | * 1. First, basic interps created with <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclCreateInterp">Ns_TclCreateInterp</a> or |
38 | * initialized with <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a>. These interps include "core" Tcl |
39 | * and AOLserver commands and are normally used simply to |
40 | * evaluate the config file. |
41 | * |
42 | * 2. Next, virtual server interps allocated from per-thread |
43 | * caches using <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a> and returned via |
44 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDeAllocateInterp">Ns_TclDeAllocateInterp</a>. These interps include all the |
45 | * commands of the basic interp, commands useful for virtual |
46 | * server environments, and any commands added as a result of |
47 | * loadable module initialization callbacks. These interps are |
48 | * normally used during connection processing but can also be |
49 | * used outside a connection, e.g., in a scheduled procedure or |
50 | * detached background thread. |
51 | * |
52 | * 3. Finally, connection interps accessed with |
53 | * Ns_TclGetConnInterp. These interps are virtual server interps |
54 | * but managed along with a connection, having access to |
55 | * connection specific data structures (e.g., via ns_conn) and |
56 | * released automatically during connection cleanup. This type |
57 | * of interp is used for ns_register_filter and ns_register_proc |
58 | * callback scripts as well as for ADP pages. The same interp is |
59 | * used throughout the connection, for all filters, procs, and/or |
60 | * ADP pages. |
61 | * |
62 | * Note the need to initialize Tcl state (i.e., procs, vars, |
63 | * packages, etc.) specific to a virtual server, later to copy |
64 | * this state to new interps when created, and garbage collection |
65 | * and end-of-connection cleanup facilities add quite a bit of |
66 | * complexity and confusion to the code. See the comments in |
67 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a>, and <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclICtlObjCmd">NsTclICtlObjCmd</a> |
68 | * and review the code in init.tcl for more details. |
69 | * |
70 | * Note also the role of the NsInterp structure. This single |
71 | * structure provides storage necessary for all AOLserver |
72 | * commands, core or virtual-server. The structure is allocated |
73 | * for each new interp and passed as the ClientData argument to |
74 | * all AOLserver commands (see <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a> and <a href="/cvs/aolserver/aolserver/nsd/tclcmds.c#A_NsTclAddCmds">NsTclAddCmds</a> in |
75 | * tclcmds.c for details). Both for cases where the ClientData |
76 | * isn't available and to ensure proper cleanup of the structure |
77 | * when the interp is deleted, the NsInterp is managed by the |
78 | * interp via the Tcl assoc data interface under the name |
79 | * "ns:data" and accessible by <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>. |
80 | */ |
81 | |
82 | static const char *RCSID = "@(#) $Header: /cvsroot-fuse/aolserver/aolserver/nsd/tclinit.c,v 1.52 2006/06/02 18:51:49 jgdavidson Exp $, compiled: " __DATE__ " " __TIME__; |
83 | |
84 | #include "nsd.h" |
85 | |
86 | /* |
87 | * The following structure maintains per-thread context to support Tcl |
88 | * including a table of cached interps by server and a shared async |
89 | * cancel object. |
90 | */ |
91 | |
92 | typedef struct TclData { |
93 | Tcl_AsyncHandler cancel; |
94 | Tcl_HashEntry *hPtr; |
95 | Tcl_HashTable interps; |
96 | } TclData; |
97 | |
98 | /* |
99 | * The following structure maintains interp callback traces. The traces |
100 | * are normally registered during server startup and invoked later for |
101 | * virutal server interps at specific points in the lifetime of the |
102 | * interp. Initialization callbacks (create, alloc, getconn) are called |
103 | * in FIFO order while finalization callbacks (freeconn, dealloc, |
104 | * delete) are called in LIFO order. In addition, script callbacks are |
105 | * invoked after non-script callbacks. A |
106 | * common trace would be an "create" trace to add commands in a loadable |
107 | * C module, e.g., the "ns_accesslog" command in nslog. |
108 | */ |
109 | |
110 | typedef struct TclTrace { |
111 | struct TclTrace *prevPtr; |
112 | struct TclTrace *nextPtr; |
113 | Ns_TclTraceProc *proc; |
114 | void *arg; |
115 | int when; |
116 | } TclTrace; |
117 | |
118 | /* |
119 | * The following structure maintains Tcl-script based traces. |
120 | */ |
121 | |
122 | typedef struct ScriptTrace { |
123 | int length; |
124 | char script[1]; |
125 | } ScriptTrace; |
126 | |
127 | /* |
128 | * The following structure maintains callbacks registered with the |
129 | * Ns_TclRegisterDeffered rouinte to invoke during interp deallocation |
130 | * Unlike traces, these callbacks are one-shot events and invoked in |
131 | * FIFO order (LIFO would probably have been better). In practice this |
132 | * API is rarely used. Instead, more specific garbage collection schemes |
133 | * should be used with "ns_ictl trace deallocate". |
134 | */ |
135 | |
136 | typedef struct Defer { |
137 | struct Defer *nextPtr; |
138 | Ns_TclDeferProc *proc; |
139 | void *arg; |
140 | } Defer; |
141 | |
142 | /* |
143 | * The following structure maintains scripts registered via ns_atclose |
144 | * to invoke when the connection is closed. The scripts are invoked in |
145 | * LIFO order. As with the Ns_TclRegisteredDeferred callbacks, this |
146 | * interface is rarely used. |
147 | */ |
148 | |
149 | typedef struct AtClose { |
150 | struct AtClose *nextPtr; |
151 | Tcl_Obj *objPtr; |
152 | } AtClose; |
153 | |
154 | /* |
155 | * The following defines a multi-thread aware Tcl package. |
156 | */ |
157 | |
158 | typedef struct Package { |
159 | char *name; |
160 | int exact; |
161 | char version[1]; |
162 | } Package; |
163 | |
164 | /* |
165 | * Static functions defined in this file. |
166 | */ |
167 | |
168 | static TclData *<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetData">GetData</a>(void); |
169 | static Ns_TlsCleanup <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DeleteData">DeleteData</a>; |
170 | static Tcl_Interp *<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_CreateInterp">CreateInterp</a>(NsServer *server); |
171 | static int <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a>(Tcl_Interp *interp, NsServer *servPtr); |
172 | static Tcl_InterpDeleteProc <a href="/cvs/aolserver/aolserver/nsdb/dbtcl.c#A_FreeData">FreeData</a>; |
173 | static NsInterp *<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PopInterp">PopInterp</a>(char *server); |
174 | static void <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a>(NsInterp *itPtr); |
175 | static Tcl_HashEntry *<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetCacheEntry">GetCacheEntry</a>(NsServer *servPtr); |
176 | static void <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(NsInterp *itPtr, int why); |
177 | static void <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_ForeachTrace">ForeachTrace</a>(NsInterp *itPtr, int why, int append); |
178 | static void <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a>(Tcl_Interp *interp, TclTrace *tracePtr, int append); |
179 | static int <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a>(Tcl_Interp *interp, void *arg); |
180 | static int <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RegisterAt">RegisterAt</a>(Ns_TclTraceProc *proc, void *arg, int when); |
181 | static Tcl_AsyncProc <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_AsyncCancel">AsyncCancel</a>; |
182 | static Ns_TclTraceProc <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PkgRequire">PkgRequire</a>; |
183 | |
184 | /* |
185 | * Static variables defined in this file. |
186 | */ |
187 | |
188 | static Ns_Tls tls; /* Slot for per-thread Tcl interp cache. */ |
189 | static Tcl_HashTable threads; /* Table of threads with nsd-based interps. */ |
190 | static Ns_Mutex tlock; /* Lock around threads table. */ |
191 | |
192 | |
193 | /* |
194 | *---------------------------------------------------------------------- |
195 | * |
196 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsInitTcl">NsInitTcl</a> -- |
197 | * |
198 | * Initialize the Nsd Tcl package. |
199 | * |
200 | * Results: |
201 | * None. |
202 | * |
203 | * Side effects: |
204 | * None. |
205 | * |
206 | *---------------------------------------------------------------------- |
207 | */ |
208 | |
209 | void |
210 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsInitTcl">NsInitTcl</a>(void) |
211 | { |
212 | /* |
213 | * Allocate the thread storage slot for the table of interps |
214 | * per-thread. At thread exit, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DeleteData">DeleteData</a> will be called |
215 | * to free any interps remaining on the thread cache |
216 | * and remove the async cancel handler. |
217 | */ |
218 | |
219 | Ns_TlsAlloc(&tls, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DeleteData">DeleteData</a>); |
220 | |
221 | /* |
222 | * Initialize the table of all threads with active TclData |
223 | * and the one-time init table. |
224 | */ |
225 | |
226 | Tcl_InitHashTable(&threads, TCL_ONE_WORD_KEYS); |
227 | Ns_MutexSetName(&tlock, "ns:threads"); |
228 | } |
229 | |
230 | |
231 | /* |
232 | *---------------------------------------------------------------------- |
233 | * |
234 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclCreateInterp">Ns_TclCreateInterp</a> -- |
235 | * |
236 | * Create a new interp with basic Nsd package. |
237 | * |
238 | * Results: |
239 | * Pointer to new interp. |
240 | * |
241 | * Side effects: |
242 | * See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_CreateInterp">CreateInterp</a>. |
243 | * |
244 | *---------------------------------------------------------------------- |
245 | */ |
246 | |
247 | Tcl_Interp * |
248 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclCreateInterp">Ns_TclCreateInterp</a>(void) |
249 | { |
250 | return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a>(NULL); |
251 | } |
252 | |
253 | |
254 | /* |
255 | *---------------------------------------------------------------------- |
256 | * |
257 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a> -- |
258 | * |
259 | * Initialize an interp with the global server context. |
260 | * |
261 | * Results: |
262 | * TCL_OK or TCL_ERROR on init error. |
263 | * |
264 | * Side effects: |
265 | * See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a>. |
266 | * |
267 | *---------------------------------------------------------------------- |
268 | */ |
269 | |
270 | int |
271 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a>(Tcl_Interp *interp) |
272 | { |
273 | NsServer *servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetServer">NsGetServer</a>(NULL); |
274 | |
275 | return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a>(interp, servPtr); |
276 | } |
277 | |
278 | |
279 | /* |
280 | *---------------------------------------------------------------------- |
281 | * |
282 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Nsd_Init">Nsd_Init</a> -- |
283 | * |
284 | * Init routine called when libnsd is loaded via the Tcl |
285 | * load command. This simply calls <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a>. |
286 | * |
287 | * Results: |
288 | * See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a>. |
289 | * |
290 | * Side effects: |
291 | * See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a>. |
292 | * |
293 | *---------------------------------------------------------------------- |
294 | */ |
295 | |
296 | int |
297 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Nsd_Init">Nsd_Init</a>(Tcl_Interp *interp) |
298 | { |
299 | return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a>(interp); |
300 | } |
301 | |
302 | |
303 | /* |
304 | *---------------------------------------------------------------------- |
305 | * |
306 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclEval">Ns_TclEval</a> -- |
307 | * |
308 | * Execute a Tcl script in the context of the the given server. |
309 | * |
310 | * Results: |
311 | * Tcl return code. |
312 | * |
313 | * Side effects: |
314 | * String results or error are placed in dsPtr if not NULL. |
315 | * |
316 | *---------------------------------------------------------------------- |
317 | */ |
318 | |
319 | int |
320 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclEval">Ns_TclEval</a>(Ns_DString *dsPtr, char *server, char *script) |
321 | { |
322 | int retcode; |
323 | Tcl_Interp *interp; |
324 | CONST char *result; |
325 | |
326 | retcode = NS_ERROR; |
327 | interp = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a>(server); |
328 | if (interp != NULL) { |
329 | if (Tcl_EvalEx(interp, script, -1, 0) != TCL_OK) { |
330 | result = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(interp); |
331 | } else { |
332 | result = Tcl_GetStringResult(interp); |
333 | retcode = NS_OK; |
334 | } |
335 | if (dsPtr != NULL) { |
336 | <a href="/cvs/aolserver/aolserver/nsd/dstring.c#A_Ns_DStringAppend">Ns_DStringAppend</a>(dsPtr, result); |
337 | } |
338 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDeAllocateInterp">Ns_TclDeAllocateInterp</a>(interp); |
339 | } |
340 | return retcode; |
341 | } |
342 | |
343 | |
344 | /* |
345 | *---------------------------------------------------------------------- |
346 | * |
347 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a> -- |
348 | * |
349 | * Allocate an interpreter from the per-thread list. Note that a |
350 | * single thread can have multiple interps for multiple virtual |
351 | * servers. |
352 | * |
353 | * Results: |
354 | * Pointer to Tcl_Interp. |
355 | * |
356 | * Side effects: |
357 | * See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PopInterp">PopInterp</a> for details on various traces which may be |
358 | * called. |
359 | * |
360 | *---------------------------------------------------------------------- |
361 | */ |
362 | |
363 | Tcl_Interp * |
364 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a>(char *server) |
365 | { |
366 | NsInterp *itPtr; |
367 | |
368 | itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PopInterp">PopInterp</a>(server); |
369 | return (itPtr ? itPtr->interp : NULL); |
370 | } |
371 | |
372 | /* |
373 | *---------------------------------------------------------------------- |
374 | * |
375 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDeAllocateInterp">Ns_TclDeAllocateInterp</a> -- |
376 | * |
377 | * Get the NsInterp for the given interp and return the interp to |
378 | * the per-thread cache. If the interp is associated with a |
379 | * connection, silently do nothing as cleanup will occur later |
380 | * with connection cleanup. Also, if the interp is not actually |
381 | * an AOLserver interp, i.e., missing the NsInterp structure, |
382 | * simply delete the interp directly. |
383 | * |
384 | * Results: |
385 | * None. |
386 | * |
387 | * Side effects: |
388 | * See notes on garbage collection in <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a>. |
389 | * |
390 | *---------------------------------------------------------------------- |
391 | */ |
392 | |
393 | void |
394 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDeAllocateInterp">Ns_TclDeAllocateInterp</a>(Tcl_Interp *interp) |
395 | { |
396 | NsInterp *itPtr; |
397 | |
398 | itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp); |
399 | if (itPtr == NULL) { |
400 | Tcl_DeleteInterp(interp); |
401 | } else if (itPtr->conn == NULL) { |
402 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a>(itPtr); |
403 | } |
404 | } |
405 | |
406 | |
407 | /* |
408 | *---------------------------------------------------------------------- |
409 | * |
410 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_GetConnInterp">Ns_GetConnInterp</a> -- |
411 | * |
412 | * Get the interp for the given connection. When first called |
413 | * for a connection, the interp data is allocated and associated |
414 | * with the given connection. The interp will be automatically |
415 | * cleaned up at the end of the connection via a call to via |
416 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsFreeConnInterp">NsFreeConnInterp</a>(). |
417 | * |
418 | * Results: |
419 | * Pointer to Tcl interp data initialized for given connection. |
420 | * |
421 | * Side effects: |
422 | * See NsGetInputEncodings for details on connection encoding setup |
423 | * required to ensure proper UTF-8 input and output. |
424 | * |
425 | *---------------------------------------------------------------------- |
426 | */ |
427 | |
428 | Tcl_Interp * |
429 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_GetConnInterp">Ns_GetConnInterp</a>(Ns_Conn *conn) |
430 | { |
431 | Conn *connPtr = (Conn *) conn; |
432 | NsInterp *itPtr; |
433 | |
434 | if (connPtr->itPtr == NULL) { |
435 | itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PopInterp">PopInterp</a>(connPtr->server); |
436 | itPtr->conn = conn; |
437 | itPtr->nsconn.flags = 0; |
438 | connPtr->itPtr = itPtr; |
439 | Tcl_SetVar2(itPtr->interp, "conn", NULL, connPtr->idstr, |
440 | TCL_GLOBAL_ONLY); |
441 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(itPtr, NS_TCL_TRACE_GETCONN); |
442 | } |
443 | return connPtr->itPtr->interp; |
444 | } |
445 | |
446 | |
447 | /* |
448 | *---------------------------------------------------------------------- |
449 | * |
450 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_FreeConnInterp">Ns_FreeConnInterp</a> -- |
451 | * |
452 | * Release and cleanup the interp associated with given |
453 | * connection. This routine no longer does actual cleanup. The |
454 | * connection cleanup code will call <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsFreeConnInterp">NsFreeConnInterp</a> if needed. |
455 | * |
456 | * Results: |
457 | * None. |
458 | * |
459 | * Side effects: |
460 | * None. |
461 | * |
462 | *---------------------------------------------------------------------- |
463 | */ |
464 | |
465 | void |
466 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_FreeConnInterp">Ns_FreeConnInterp</a>(Ns_Conn *conn) |
467 | { |
468 | return; |
469 | } |
470 | |
471 | |
472 | /* |
473 | *---------------------------------------------------------------------- |
474 | * |
475 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclGetConn">Ns_TclGetConn</a> -- |
476 | * |
477 | * Get the Ns_Conn structure associated with this tcl interp. |
478 | * |
479 | * Results: |
480 | * An Ns_Conn. |
481 | * |
482 | * Side effects: |
483 | * None. |
484 | * |
485 | *---------------------------------------------------------------------- |
486 | */ |
487 | |
488 | Ns_Conn * |
489 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclGetConn">Ns_TclGetConn</a>(Tcl_Interp *interp) |
490 | { |
491 | NsInterp *itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp); |
492 | |
493 | return (itPtr ? itPtr->conn : NULL); |
494 | } |
495 | |
496 | |
497 | /* |
498 | *---------------------------------------------------------------------- |
499 | * |
500 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDestroyInterp">Ns_TclDestroyInterp</a> -- |
501 | * |
502 | * Delete an interp. |
503 | * |
504 | * Results: |
505 | * None. |
506 | * |
507 | * Side effects: |
508 | * None. |
509 | * |
510 | *---------------------------------------------------------------------- |
511 | */ |
512 | |
513 | void |
514 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDestroyInterp">Ns_TclDestroyInterp</a>(Tcl_Interp *interp) |
515 | { |
516 | NsInterp *itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp); |
517 | |
518 | if (itPtr != NULL) { |
519 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(itPtr, NS_TCL_TRACE_DELETE); |
520 | } |
521 | Tcl_DeleteInterp(interp); |
522 | } |
523 | |
524 | |
525 | /* |
526 | *---------------------------------------------------------------------- |
527 | * |
528 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclMarkForDelete">Ns_TclMarkForDelete</a> -- |
529 | * |
530 | * Mark the interp to be deleted at the next deallocation. This |
531 | * routine is useful to destory interps after they've been |
532 | * modified in weird ways, e.g., by the TclPro debugger. |
533 | * |
534 | * Results: |
535 | * None. |
536 | * |
537 | * Side effects: |
538 | * Interp will be deleted on next de-allocate. |
539 | * |
540 | *---------------------------------------------------------------------- |
541 | */ |
542 | |
543 | void |
544 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclMarkForDelete">Ns_TclMarkForDelete</a>(Tcl_Interp *interp) |
545 | { |
546 | NsInterp *itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp); |
547 | |
548 | if (itPtr != NULL) { |
549 | itPtr->delete = 1; |
550 | } |
551 | } |
552 | |
553 | |
554 | /* |
555 | *---------------------------------------------------------------------- |
556 | * |
557 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a> -- |
558 | * |
559 | * Add a Tcl trace. Traces are called in FIFO order. |
560 | * |
561 | * Results: |
562 | * NS_OK if called with a non-NULL server, NS_ERROR otherwise. |
563 | * |
564 | * Side effects: |
565 | * Will modify server trace list. |
566 | * |
567 | *---------------------------------------------------------------------- |
568 | */ |
569 | |
570 | int |
571 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>(char *server, Ns_TclTraceProc *proc, void *arg, int when) |
572 | { |
573 | TclTrace *tracePtr; |
574 | NsServer *servPtr; |
575 | |
576 | servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetServer">NsGetServer</a>(server); |
577 | if (servPtr == NULL) { |
578 | return NS_ERROR; |
579 | } |
580 | tracePtr = ns_malloc(sizeof(TclTrace)); |
581 | tracePtr->proc = proc; |
582 | tracePtr->arg = arg; |
583 | tracePtr->when = when; |
584 | tracePtr->nextPtr = NULL; |
585 | Ns_RWLockWrLock(&servPtr->tcl.tlock); |
586 | tracePtr->prevPtr = servPtr->tcl.lastTracePtr; |
587 | servPtr->tcl.lastTracePtr = tracePtr; |
588 | if (tracePtr->prevPtr != NULL) { |
589 | tracePtr->prevPtr->nextPtr = tracePtr; |
590 | } else { |
591 | servPtr->tcl.firstTracePtr = tracePtr; |
592 | } |
593 | Ns_RWLockUnlock(&servPtr->tcl.tlock); |
594 | return NS_OK; |
595 | } |
596 | |
597 | |
598 | /* |
599 | *---------------------------------------------------------------------- |
600 | * |
601 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterAtCreate">Ns_TclRegisterAtCreate</a>, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterAtCleanup">Ns_TclRegisterAtCleanup</a>, |
602 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterAtDelete">Ns_TclRegisterAtDelete</a> -- |
603 | * |
604 | * Register callbacks for interp create, cleanup, and delete at |
605 | * startup. These routines are deprecated in favor of the more |
606 | * general <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>. In particular, they do not take a |
607 | * virtual server argument so must assume the currently |
608 | * initializing server is the intended server. |
609 | * |
610 | * Results: |
611 | * See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>. |
612 | * |
613 | * Side effects: |
614 | * See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>. |
615 | * |
616 | *---------------------------------------------------------------------- |
617 | */ |
618 | |
619 | int |
620 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterAtCreate">Ns_TclRegisterAtCreate</a>(Ns_TclTraceProc *proc, void *arg) |
621 | { |
622 | return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RegisterAt">RegisterAt</a>(proc, arg, NS_TCL_TRACE_CREATE); |
623 | } |
624 | |
625 | int |
626 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterAtCleanup">Ns_TclRegisterAtCleanup</a>(Ns_TclTraceProc *proc, void *arg) |
627 | { |
628 | return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RegisterAt">RegisterAt</a>(proc, arg, NS_TCL_TRACE_DEALLOCATE); |
629 | } |
630 | |
631 | int |
632 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterAtDelete">Ns_TclRegisterAtDelete</a>(Ns_TclTraceProc *proc, void *arg) |
633 | { |
634 | return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RegisterAt">RegisterAt</a>(proc, arg, NS_TCL_TRACE_DELETE); |
635 | } |
636 | |
637 | static int |
638 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RegisterAt">RegisterAt</a>(Ns_TclTraceProc *proc, void *arg, int when) |
639 | { |
640 | NsServer *servPtr; |
641 | |
642 | servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetInitServer">NsGetInitServer</a>(); |
643 | if (servPtr == NULL) { |
644 | return NS_ERROR; |
645 | } |
646 | return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>(servPtr->server, proc, arg, when); |
647 | } |
648 | |
649 | |
650 | /* |
651 | *---------------------------------------------------------------------- |
652 | * |
653 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInitInterps">Ns_TclInitInterps</a> -- |
654 | * |
655 | * Arrange for the given proc to be called on newly created |
656 | * interps. This routine now simply uses the more general Tcl |
657 | * interp tracing facility. Earlier versions of AOLserver would |
658 | * invoke the given proc immediately on each interp in a shared |
659 | * pool which explains this otherwise misnamed API. |
660 | * |
661 | * Results: |
662 | * See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>. |
663 | * |
664 | * Side effects: |
665 | * See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>. |
666 | * |
667 | *---------------------------------------------------------------------- |
668 | */ |
669 | |
670 | int |
671 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInitInterps">Ns_TclInitInterps</a>(char *server, Ns_TclInterpInitProc *proc, void *arg) |
672 | { |
673 | return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>(server, proc, arg, NS_TCL_TRACE_CREATE); |
674 | } |
675 | |
676 | |
677 | /* |
678 | *---------------------------------------------------------------------- |
679 | * |
680 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterDeferred">Ns_TclRegisterDeferred</a> -- |
681 | * |
682 | * Register a procedure to be called when the interp is deallocated. |
683 | * This is on-shot FIFO order callback mechanism which is seldom |
684 | * used. |
685 | * |
686 | * Results: |
687 | * None. |
688 | * |
689 | * Side effects: |
690 | * Procedure will be called later. |
691 | * |
692 | *---------------------------------------------------------------------- |
693 | */ |
694 | |
695 | void |
696 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterDeferred">Ns_TclRegisterDeferred</a>(Tcl_Interp *interp, Ns_TclDeferProc *proc, void *arg) |
697 | { |
698 | NsInterp *itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp); |
699 | Defer *deferPtr, **nextPtrPtr; |
700 | |
701 | if (itPtr == NULL) { |
702 | return; |
703 | } |
704 | deferPtr = ns_malloc(sizeof(Defer)); |
705 | deferPtr->proc = proc; |
706 | deferPtr->arg = arg; |
707 | deferPtr->nextPtr = NULL; |
708 | nextPtrPtr = &itPtr->firstDeferPtr; |
709 | while (*nextPtrPtr != NULL) { |
710 | nextPtrPtr = &((*nextPtrPtr)->nextPtr); |
711 | } |
712 | *nextPtrPtr = deferPtr; |
713 | } |
714 | |
715 | |
716 | /* |
717 | *---------------------------------------------------------------------- |
718 | * |
719 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLibrary">Ns_TclLibrary</a> -- |
720 | * |
721 | * Return the name of the private tcl lib |
722 | * |
723 | * Results: |
724 | * Tcl lib name. |
725 | * |
726 | * Side effects: |
727 | * None. |
728 | * |
729 | *---------------------------------------------------------------------- |
730 | */ |
731 | |
732 | char * |
733 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLibrary">Ns_TclLibrary</a>(char *server) |
734 | { |
735 | NsServer *servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetServer">NsGetServer</a>(server); |
736 | |
737 | return (servPtr ? servPtr->tcl.library : NULL); |
738 | } |
739 | |
740 | |
741 | /* |
742 | *---------------------------------------------------------------------- |
743 | * |
744 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInterpServer">Ns_TclInterpServer</a> -- |
745 | * |
746 | * Return the name of the server. |
747 | * |
748 | * Results: |
749 | * Server name. |
750 | * |
751 | * Side effects: |
752 | * None. |
753 | * |
754 | *---------------------------------------------------------------------- |
755 | */ |
756 | |
757 | char * |
758 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInterpServer">Ns_TclInterpServer</a>(Tcl_Interp *interp) |
759 | { |
760 | NsInterp *itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp); |
761 | |
762 | return (itPtr ? itPtr->servPtr->server : NULL); |
763 | } |
764 | |
765 | |
766 | /* |
767 | *---------------------------------------------------------------------- |
768 | * |
769 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a> -- |
770 | * |
771 | * <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Log">Log</a> the global errorInfo variable to the server log. |
772 | * |
773 | * Results: |
774 | * Returns a pointer to the errorInfo. |
775 | * |
776 | * Side effects: |
777 | * None. |
778 | * |
779 | *---------------------------------------------------------------------- |
780 | */ |
781 | |
782 | char * |
783 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(Tcl_Interp *interp) |
784 | { |
785 | CONST char *errorInfo; |
786 | |
787 | errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); |
788 | if (errorInfo == NULL) { |
789 | errorInfo = Tcl_GetStringResult(interp); |
790 | } |
791 | <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Error, "Tcl exception:\n%s", errorInfo); |
792 | return (char *) errorInfo; |
793 | } |
794 | |
795 | |
796 | /* |
797 | *---------------------------------------------------------------------- |
798 | * |
799 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogErrorRequest">Ns_TclLogErrorRequest</a> -- |
800 | * |
801 | * <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Log">Log</a> both errorInfo and info about the HTTP request that led |
802 | * to it. |
803 | * |
804 | * Results: |
805 | * Returns a pointer to the errorInfo. |
806 | * |
807 | * Side effects: |
808 | * None. |
809 | * |
810 | *---------------------------------------------------------------------- |
811 | */ |
812 | |
813 | char * |
814 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogErrorRequest">Ns_TclLogErrorRequest</a>(Tcl_Interp *interp, Ns_Conn *conn) |
815 | { |
816 | char *agent; |
817 | CONST char *errorInfo; |
818 | |
819 | errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); |
820 | if (errorInfo == NULL) { |
821 | errorInfo = Tcl_GetStringResult(interp); |
822 | } |
823 | agent = <a href="/cvs/aolserver/aolserver/nsd/set.c#A_Ns_SetIGet">Ns_SetIGet</a>(conn->headers, "user-agent"); |
824 | if (agent == NULL) { |
825 | agent = "?"; |
826 | } |
827 | <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Error, "error for %s %s, " |
828 | "User-Agent: %s, PeerAddress: %s\n%s", |
829 | conn->request->method, conn->request->url, |
830 | agent, <a href="/cvs/aolserver/aolserver/nsd/conn.c#A_Ns_ConnPeer">Ns_ConnPeer</a>(conn), errorInfo); |
831 | return (char*)errorInfo; |
832 | } |
833 | |
834 | |
835 | /* |
836 | *---------------------------------------------------------------------- |
837 | * |
838 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInitModule">Ns_TclInitModule</a> -- |
839 | * |
840 | * Add a module name to the init list. |
841 | * |
842 | * Results: |
843 | * Always TCL_OK. |
844 | * |
845 | * Side effects: |
846 | * Module will be initialized by the init script later. |
847 | * |
848 | *---------------------------------------------------------------------- |
849 | */ |
850 | |
851 | int |
852 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInitModule">Ns_TclInitModule</a>(char *server, char *module) |
853 | { |
854 | NsServer *servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetServer">NsGetServer</a>(server); |
855 | |
856 | if (servPtr == NULL) { |
857 | return NS_ERROR; |
858 | } |
859 | Tcl_DStringAppendElement(&servPtr->tcl.modules, module); |
860 | return NS_OK; |
861 | } |
862 | |
863 | |
864 | /* |
865 | *---------------------------------------------------------------------- |
866 | * |
867 | * NsGetInterpServer -- |
868 | * |
869 | * Get server for given interp. |
870 | * |
871 | * Results: |
872 | * TCL_OK if interp has a server, TCL_ERROR otherwise. |
873 | * |
874 | * Side effects: |
875 | * Given serverPtr will be updated with pointer to server string. |
876 | * |
877 | *---------------------------------------------------------------------- |
878 | */ |
879 | |
880 | int |
881 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclGetServer">NsTclGetServer</a>(NsInterp *itPtr, char **serverPtr) |
882 | { |
883 | if (itPtr->servPtr->server == NULL) { |
884 | Tcl_SetResult(itPtr->interp, "no server", TCL_STATIC); |
885 | return TCL_ERROR; |
886 | } |
887 | *serverPtr = itPtr->servPtr->server; |
888 | return NS_OK; |
889 | } |
890 | |
891 | |
892 | /* |
893 | *---------------------------------------------------------------------- |
894 | * |
895 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclICtlObjCmd">NsTclICtlObjCmd</a> -- |
896 | * |
897 | * Implements ns_ictl command to control interp state for |
898 | * virtual server interps. This command provide internal control |
899 | * functions required by the init.tcl script and is not intended |
900 | * to be called by a user directly. It supports four activities: |
901 | * 1. Managing the list of "modules" to initialize. |
902 | * 2. Saving the init script for evaluation with new interps. |
903 | * 3. Checking for change of the init script. |
904 | * 4. Register script-level traces. |
905 | * |
906 | * See init.tcl for details. |
907 | * |
908 | * Results: |
909 | * Standard Tcl result. |
910 | * |
911 | * Side effects: |
912 | * May update current saved server Tcl state. |
913 | * |
914 | *---------------------------------------------------------------------- |
915 | */ |
916 | |
917 | int |
918 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclICtlObjCmd">NsTclICtlObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj **objv) |
919 | { |
920 | NsInterp *itPtr = arg; |
921 | NsServer *servPtr = itPtr->servPtr; |
922 | Defer *deferPtr; |
923 | ScriptTrace *stPtr; |
924 | Tcl_HashEntry *hPtr; |
925 | Tcl_HashSearch search; |
926 | TclData *dataPtr; |
927 | Tcl_Obj *objPtr, *listPtr; |
928 | Package *pkgPtr; |
929 | int when, length, result, tid, new, exact; |
930 | char *script, *name, *pattern, *version; |
931 | static CONST char *opts[] = { |
932 | "addmodule", "cleanup", "epoch", "get", "getmodules", "save", |
933 | "update", "oncreate", "oncleanup", "oninit", "ondelete", "trace", |
934 | "threads", "cancel", "runtraces", "gettraces", "package", "once", |
935 | NULL |
936 | }; |
937 | enum { |
938 | IAddModuleIdx, ICleanupIdx, IEpochIdx, IGetIdx, IGetModulesIdx, |
939 | ISaveIdx, IUpdateIdx, IOnCreateIdx, IOnCleanupIdx, IOnInitIdx, |
940 | IOnDeleteIdx, ITraceIdx, IThreadsIdx, ICancelIdx, IRunIdx, |
941 | IGetTracesIdx, IPackageIdx, IOnceIdx |
942 | } opt; |
943 | static CONST char *popts[] = { |
944 | "require", "names", NULL |
945 | }; |
946 | enum { |
947 | PRequireIdx, PNamesIdx |
948 | } _nsmayalias popt; |
949 | static CONST char *topts[] = { |
950 | "create", "delete", "allocate", |
951 | "deallocate", "getconn", "freeconn", NULL |
952 | }; |
953 | static int twhen[] = { |
954 | NS_TCL_TRACE_CREATE, NS_TCL_TRACE_DELETE, NS_TCL_TRACE_ALLOCATE, |
955 | NS_TCL_TRACE_DEALLOCATE, NS_TCL_TRACE_GETCONN, NS_TCL_TRACE_FREECONN |
956 | }; |
957 | enum { |
958 | TCreateIdx, TDeleteIdx, TAllocateIdx, |
959 | TDeAllocateIdx, TGetConnIdx, TFreeConnIdx |
960 | } _nsmayalias topt; |
961 | |
962 | if (objc < 2) { |
963 | Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); |
964 | return TCL_ERROR; |
965 | } |
966 | if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0, |
967 | (int *) &opt) != TCL_OK) { |
968 | return TCL_ERROR; |
969 | } |
970 | |
971 | result = TCL_OK; |
972 | switch (opt) { |
973 | case IAddModuleIdx: |
974 | /* |
975 | * Add a Tcl module to the list of for later initialization. |
976 | */ |
977 | |
978 | if (objc != 3) { |
979 | Tcl_WrongNumArgs(interp, 2, objv, "module"); |
980 | return TCL_ERROR; |
981 | } |
982 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInitModule">Ns_TclInitModule</a>(servPtr->server, Tcl_GetString(objv[2])); |
983 | break; |
984 | |
985 | case IGetModulesIdx: |
986 | /* |
987 | * Get the list of modules for initialization. See init.tcl |
988 | * for expected use. |
989 | */ |
990 | |
991 | if (objc != 2) { |
992 | Tcl_WrongNumArgs(interp, 2, objv, NULL); |
993 | return TCL_ERROR; |
994 | } |
995 | Tcl_SetResult(interp, servPtr->tcl.modules.string, TCL_VOLATILE); |
996 | break; |
997 | |
998 | case IGetIdx: |
999 | /* |
1000 | * Get the current init script to evaluate in new interps. |
1001 | */ |
1002 | |
1003 | if (objc != 2) { |
1004 | Tcl_WrongNumArgs(interp, 2, objv, NULL); |
1005 | return TCL_ERROR; |
1006 | } |
1007 | Ns_RWLockRdLock(&servPtr->tcl.slock); |
1008 | objPtr = Tcl_NewStringObj(servPtr->tcl.script, servPtr->tcl.length); |
1009 | Ns_RWLockUnlock(&servPtr->tcl.slock); |
1010 | Tcl_SetObjResult(interp, objPtr); |
1011 | break; |
1012 | |
1013 | case IEpochIdx: |
1014 | /* |
1015 | * Check the version of this interp against current init script. |
1016 | */ |
1017 | |
1018 | if (objc != 2) { |
1019 | Tcl_WrongNumArgs(interp, 2, objv, NULL); |
1020 | return TCL_ERROR; |
1021 | } |
1022 | Ns_RWLockRdLock(&servPtr->tcl.slock); |
1023 | Tcl_SetIntObj(Tcl_GetObjResult(interp), servPtr->tcl.epoch); |
1024 | Ns_RWLockUnlock(&servPtr->tcl.slock); |
1025 | break; |
1026 | |
1027 | case ISaveIdx: |
1028 | /* |
1029 | * Save the init script. |
1030 | */ |
1031 | |
1032 | if (objc != 3) { |
1033 | Tcl_WrongNumArgs(interp, 2, objv, "script"); |
1034 | return TCL_ERROR; |
1035 | } |
1036 | script = ns_strdup(Tcl_GetStringFromObj(objv[2], &length)); |
1037 | Ns_RWLockWrLock(&servPtr->tcl.slock); |
1038 | ns_free(servPtr->tcl.script); |
1039 | servPtr->tcl.script = script; |
1040 | servPtr->tcl.length = length; |
1041 | if (++servPtr->tcl.epoch == 0) { |
1042 | /* NB: Epoch zero reserved for new interps. */ |
1043 | ++servPtr->tcl.epoch; |
1044 | } |
1045 | Ns_RWLockUnlock(&servPtr->tcl.slock); |
1046 | break; |
1047 | |
1048 | case IUpdateIdx: |
1049 | /* |
1050 | * Check for and process possible change in the init script. |
1051 | */ |
1052 | |
1053 | if (objc != 2) { |
1054 | Tcl_WrongNumArgs(interp, 2, objv, NULL); |
1055 | return TCL_ERROR; |
1056 | } |
1057 | Ns_RWLockRdLock(&servPtr->tcl.slock); |
1058 | if (itPtr->epoch != servPtr->tcl.epoch) { |
1059 | result = Tcl_EvalEx(itPtr->interp, servPtr->tcl.script, |
1060 | servPtr->tcl.length, TCL_EVAL_GLOBAL); |
1061 | itPtr->epoch = servPtr->tcl.epoch; |
1062 | } |
1063 | Ns_RWLockUnlock(&servPtr->tcl.slock); |
1064 | break; |
1065 | |
1066 | case ICleanupIdx: |
1067 | /* |
1068 | * Invoke the legacy defer callbacks. |
1069 | */ |
1070 | |
1071 | if (objc != 2) { |
1072 | Tcl_WrongNumArgs(interp, 2, objv, NULL); |
1073 | return TCL_ERROR; |
1074 | } |
1075 | while ((deferPtr = itPtr->firstDeferPtr) != NULL) { |
1076 | itPtr->firstDeferPtr = deferPtr->nextPtr; |
1077 | (*deferPtr->proc)(interp, deferPtr->arg); |
1078 | ns_free(deferPtr); |
1079 | } |
1080 | break; |
1081 | |
1082 | case IPackageIdx: |
1083 | if (objc < 3) { |
1084 | Tcl_WrongNumArgs(interp, 2, objv, "option ?args?"); |
1085 | return TCL_ERROR; |
1086 | } |
1087 | if (Tcl_GetIndexFromObj(interp, objv[2], popts, "option", 0, |
1088 | (int *) &popt) != TCL_OK) { |
1089 | return TCL_ERROR; |
1090 | } |
1091 | switch (popt) { |
1092 | case PNamesIdx: |
1093 | if (objc > 3) { |
1094 | pattern = Tcl_GetString(objv[3]); |
1095 | } else { |
1096 | pattern = NULL; |
1097 | } |
1098 | listPtr = Tcl_NewObj(); |
1099 | Ns_MutexLock(&servPtr->tcl.plock); |
1100 | hPtr = Tcl_FirstHashEntry(&servPtr->tcl.packages, &search); |
1101 | while (hPtr != NULL) { |
1102 | name = Tcl_GetHashKey(&servPtr->tcl.packages, hPtr); |
1103 | if (pattern == NULL || Tcl_StringMatch(name, pattern)) { |
1104 | Tcl_ListObjAppendElement(interp, listPtr, |
1105 | Tcl_NewStringObj(name, -1)); |
1106 | } |
1107 | hPtr = Tcl_NextHashEntry(&search); |
1108 | } |
1109 | Ns_MutexUnlock(&servPtr->tcl.plock); |
1110 | Tcl_SetObjResult(interp, listPtr); |
1111 | break; |
1112 | |
1113 | case PRequireIdx: |
1114 | if (objc < 4 || objc > 6) { |
1115 | badargs: |
1116 | Tcl_WrongNumArgs(interp, 3, objv, "?-exact? package ?version?"); |
1117 | return TCL_ERROR; |
1118 | } |
1119 | exact = 0; |
1120 | name = Tcl_GetString(objv[3]); |
1121 | if (STREQ(name, "-exact")) { |
1122 | if (objc < 5) { |
1123 | goto badargs; |
1124 | } |
1125 | --objc; |
1126 | ++objv; |
1127 | exact = 1; |
1128 | name = Tcl_GetString(objv[3]); |
1129 | } |
1130 | if (objc < 5) { |
1131 | version = NULL; |
1132 | } else { |
1133 | version = Tcl_GetString(objv[4]); |
1134 | } |
1135 | |
1136 | /* |
1137 | * Confirm the package can be loaded and determine version. |
1138 | */ |
1139 | |
1140 | version = Tcl_PkgRequire(interp, name, version, exact); |
1141 | if (version == NULL) { |
1142 | return TCL_ERROR; |
1143 | } |
1144 | Ns_MutexLock(&servPtr->tcl.plock); |
1145 | hPtr = Tcl_CreateHashEntry(&servPtr->tcl.packages, name, &new); |
1146 | if (!new) { |
1147 | /* |
1148 | * Confirm current registered package is the same version. |
1149 | */ |
1150 | |
1151 | pkgPtr = Tcl_GetHashValue(hPtr); |
1152 | if (!STREQ(pkgPtr->version, version)) { |
1153 | Tcl_AppendResult(interp, "version conflict for package \"", |
1154 | name, "\": have ", pkgPtr->version, ", need ", |
1155 | version, NULL); |
1156 | pkgPtr = NULL; |
1157 | } |
1158 | } else { |
1159 | /* |
1160 | * Register new package. |
1161 | */ |
1162 | pkgPtr = ns_malloc(sizeof(Package) + strlen(version)); |
1163 | strcpy(pkgPtr->version, version); |
1164 | pkgPtr->name = Tcl_GetHashKey(&servPtr->tcl.packages, hPtr); |
1165 | pkgPtr->exact = exact; |
1166 | Tcl_SetHashValue(hPtr, pkgPtr); |
1167 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>(servPtr->server, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PkgRequire">PkgRequire</a>, pkgPtr, |
1168 | NS_TCL_TRACE_ALLOCATE); |
1169 | } |
1170 | Ns_MutexUnlock(&servPtr->tcl.plock); |
1171 | if (pkgPtr == NULL) { |
1172 | return TCL_ERROR; |
1173 | } |
1174 | Tcl_SetResult(interp, pkgPtr->version, TCL_STATIC); |
1175 | break; |
1176 | } |
1177 | break; |
1178 | |
1179 | case IOnceIdx: |
1180 | if (objc < 4) { |
1181 | Tcl_WrongNumArgs(interp, 3, objv, "name script"); |
1182 | return TCL_ERROR; |
1183 | } |
1184 | name = Tcl_GetString(objv[2]); |
1185 | Ns_CsEnter(&servPtr->tcl.olock); |
1186 | hPtr = Tcl_CreateHashEntry(&servPtr->tcl.once, name, &new); |
1187 | if (new) { |
1188 | result = Tcl_EvalObjEx(interp, objv[3], TCL_EVAL_DIRECT); |
1189 | if (result != TCL_OK) { |
1190 | Tcl_DeleteHashEntry(hPtr); |
1191 | } |
1192 | } |
1193 | Ns_CsLeave(&servPtr->tcl.olock); |
1194 | if (result != TCL_OK) { |
1195 | return TCL_ERROR; |
1196 | } |
1197 | Tcl_SetBooleanObj(Tcl_GetObjResult(interp), new); |
1198 | break; |
1199 | |
1200 | case IOnInitIdx: |
1201 | case IOnCreateIdx: |
1202 | case IOnCleanupIdx: |
1203 | case IOnDeleteIdx: |
1204 | /* |
1205 | * Register script-level interp traces. |
1206 | */ |
1207 | |
1208 | if (objc != 3) { |
1209 | Tcl_WrongNumArgs(interp, 2, objv, "script"); |
1210 | return TCL_ERROR; |
1211 | } |
1212 | switch (opt) { |
1213 | case IOnInitIdx: |
1214 | case IOnCreateIdx: |
1215 | when = NS_TCL_TRACE_CREATE; |
1216 | break; |
1217 | case IOnCleanupIdx: |
1218 | when = NS_TCL_TRACE_DEALLOCATE; |
1219 | break; |
1220 | case IOnDeleteIdx: |
1221 | when = NS_TCL_TRACE_DELETE; |
1222 | break; |
1223 | default: |
1224 | /* NB: Silence compiler. */ |
1225 | when = 0; |
1226 | break; |
1227 | } |
1228 | goto trace; |
1229 | break; |
1230 | |
1231 | case ITraceIdx: |
1232 | if (objc != 4) { |
1233 | Tcl_WrongNumArgs(interp, 2, objv, "when script"); |
1234 | return TCL_ERROR; |
1235 | } |
1236 | if (Tcl_GetIndexFromObj(interp, objv[2], topts, "when", 0, |
1237 | (int *) &topt) != TCL_OK) { |
1238 | return TCL_ERROR; |
1239 | } |
1240 | when = twhen[topt]; |
1241 | trace: |
1242 | script = Tcl_GetString(objv[objc-1]); |
1243 | length = strlen(script); |
1244 | stPtr = ns_malloc(sizeof(ScriptTrace) + length); |
1245 | stPtr->length = length; |
1246 | strcpy(stPtr->script, script); |
1247 | (void) <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>(servPtr->server, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a>, stPtr, when); |
1248 | break; |
1249 | |
1250 | case IGetTracesIdx: |
1251 | case IRunIdx: |
1252 | if (objc != 3) { |
1253 | Tcl_WrongNumArgs(interp, 2, objv, "which"); |
1254 | return TCL_ERROR; |
1255 | } |
1256 | if (Tcl_GetIndexFromObj(interp, objv[2], topts, "traces", 0, |
1257 | (int *) &topt) != TCL_OK) { |
1258 | return TCL_ERROR; |
1259 | } |
1260 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_ForeachTrace">ForeachTrace</a>(itPtr, twhen[topt], (opt == IGetTracesIdx)); |
1261 | break; |
1262 | |
1263 | case IThreadsIdx: |
1264 | if (objc > 2) { |
1265 | Tcl_WrongNumArgs(interp, 2, objv, NULL); |
1266 | return TCL_ERROR; |
1267 | } |
1268 | listPtr = Tcl_NewObj(); |
1269 | Ns_MutexLock(&tlock); |
1270 | hPtr = Tcl_FirstHashEntry(&threads, &search); |
1271 | while (hPtr != NULL) { |
1272 | tid = (int) Tcl_GetHashKey(&threads, hPtr); |
1273 | objPtr = Tcl_NewIntObj(tid); |
1274 | Tcl_ListObjAppendElement(interp, listPtr, objPtr); |
1275 | hPtr = Tcl_NextHashEntry(&search); |
1276 | } |
1277 | Ns_MutexUnlock(&tlock); |
1278 | Tcl_SetObjResult(interp, listPtr); |
1279 | break; |
1280 | |
1281 | case ICancelIdx: |
1282 | if (objc != 3) { |
1283 | Tcl_WrongNumArgs(interp, 2, objv, "tid"); |
1284 | return TCL_ERROR; |
1285 | } |
1286 | if (Tcl_GetIntFromObj(interp, objv[2], &tid) != TCL_OK) { |
1287 | return TCL_ERROR; |
1288 | } |
1289 | Ns_MutexLock(&tlock); |
1290 | hPtr = Tcl_FindHashEntry(&threads, (char *) tid); |
1291 | if (hPtr != NULL) { |
1292 | dataPtr = Tcl_GetHashValue(hPtr); |
1293 | Tcl_AsyncMark(dataPtr->cancel); |
1294 | } |
1295 | Ns_MutexUnlock(&tlock); |
1296 | if (hPtr == NULL) { |
1297 | Tcl_AppendResult(interp, "no such active thread: ", |
1298 | Tcl_GetString(objv[2]), NULL); |
1299 | return TCL_ERROR; |
1300 | } |
1301 | break; |
1302 | } |
1303 | return result; |
1304 | } |
1305 | |
1306 | |
1307 | /* |
1308 | *---------------------------------------------------------------------- |
1309 | * |
1310 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclAtCloseObjCmd">NsTclAtCloseObjCmd</a> -- |
1311 | * |
1312 | * Implements ns_atclose. |
1313 | * |
1314 | * Results: |
1315 | * Tcl result. |
1316 | * |
1317 | * Side effects: |
1318 | * Script will be invoked when the connection is closed. Note |
1319 | * the connection may continue execution, e.g., with continued |
1320 | * ADP code, traces, etc. |
1321 | * |
1322 | *---------------------------------------------------------------------- |
1323 | */ |
1324 | |
1325 | int |
1326 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclAtCloseObjCmd">NsTclAtCloseObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, |
1327 | CONST Tcl_Obj **objv) |
1328 | { |
1329 | NsInterp *itPtr = arg; |
1330 | AtClose *atPtr; |
1331 | |
1332 | if (objc < 2) { |
1333 | Tcl_WrongNumArgs(interp, 1, objv, "script ?args?"); |
1334 | return TCL_ERROR; |
1335 | } |
1336 | if (<a href="/cvs/aolserver/aolserver/nsd/tclresp.c#A_NsTclGetConn">NsTclGetConn</a>(itPtr, NULL) != TCL_OK) { |
1337 | return TCL_ERROR; |
1338 | } |
1339 | atPtr = ns_malloc(sizeof(AtClose)); |
1340 | atPtr->nextPtr = itPtr->firstAtClosePtr; |
1341 | itPtr->firstAtClosePtr = atPtr; |
1342 | atPtr->objPtr = Tcl_ConcatObj(objc-1, objv+1); |
1343 | Tcl_IncrRefCount(atPtr->objPtr); |
1344 | return TCL_OK; |
1345 | } |
1346 | |
1347 | |
1348 | /* |
1349 | *---------------------------------------------------------------------- |
1350 | * |
1351 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclMarkForDeleteObjCmd">NsTclMarkForDeleteObjCmd</a> -- |
1352 | * |
1353 | * Implements ns_markfordelete. |
1354 | * |
1355 | * Results: |
1356 | * Tcl result. |
1357 | * |
1358 | * Side effects: |
1359 | * See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclMarkForDelete">Ns_TclMarkForDelete</a>. |
1360 | * |
1361 | *---------------------------------------------------------------------- |
1362 | */ |
1363 | |
1364 | int |
1365 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclMarkForDeleteObjCmd">NsTclMarkForDeleteObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj **objv) |
1366 | { |
1367 | NsInterp *itPtr = arg; |
1368 | |
1369 | if (objc != 1) { |
1370 | Tcl_WrongNumArgs(interp, 1, objv, ""); |
1371 | return TCL_ERROR; |
1372 | } |
1373 | itPtr->delete = 1; |
1374 | return TCL_OK; |
1375 | } |
1376 | |
1377 | |
1378 | /* |
1379 | *---------------------------------------------------------------------- |
1380 | * |
1381 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclInitServer">NsTclInitServer</a> -- |
1382 | * |
1383 | * Evaluate server initialization script at startup. |
1384 | * |
1385 | * Results: |
1386 | * None. |
1387 | * |
1388 | * Side effects: |
1389 | * See init script (normally init.tcl). |
1390 | * |
1391 | *---------------------------------------------------------------------- |
1392 | */ |
1393 | |
1394 | void |
1395 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclInitServer">NsTclInitServer</a>(char *server) |
1396 | { |
1397 | NsServer *servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetServer">NsGetServer</a>(server); |
1398 | Tcl_Interp *interp; |
1399 | |
1400 | if (servPtr != NULL) { |
1401 | interp = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a>(server); |
1402 | if (Tcl_EvalFile(interp, servPtr->tcl.initfile) != TCL_OK) { |
1403 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(interp); |
1404 | } |
1405 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDeAllocateInterp">Ns_TclDeAllocateInterp</a>(interp); |
1406 | } |
1407 | } |
1408 | |
1409 | |
1410 | /* |
1411 | *---------------------------------------------------------------------- |
1412 | * |
1413 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a> -- |
1414 | * |
1415 | * Return the interp's NsInterp structure from assoc data. |
1416 | * This routine is used when the NsInterp is needed and |
1417 | * not available as command ClientData. |
1418 | * |
1419 | * Results: |
1420 | * Pointer to NsInterp or NULL if none. |
1421 | * |
1422 | * Side effects: |
1423 | * None. |
1424 | * |
1425 | *---------------------------------------------------------------------- |
1426 | */ |
1427 | |
1428 | NsInterp * |
1429 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(Tcl_Interp *interp) |
1430 | { |
1431 | return (interp ? Tcl_GetAssocData(interp, "ns:data", NULL) : NULL); |
1432 | } |
1433 | |
1434 | |
1435 | /* |
1436 | *---------------------------------------------------------------------- |
1437 | * |
1438 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsFreeConnInterp">NsFreeConnInterp</a> -- |
1439 | * |
1440 | * Free the interp data, if any, for given connection. This |
1441 | * routine is called at the end of connection processing. |
1442 | * |
1443 | * Results: |
1444 | * None. |
1445 | * |
1446 | * Side effects: |
1447 | * See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a>. |
1448 | * |
1449 | *---------------------------------------------------------------------- |
1450 | */ |
1451 | |
1452 | void |
1453 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsFreeConnInterp">NsFreeConnInterp</a>(Conn *connPtr) |
1454 | { |
1455 | NsInterp *itPtr = connPtr->itPtr; |
1456 | |
1457 | if (itPtr != NULL) { |
1458 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(itPtr, NS_TCL_TRACE_FREECONN); |
1459 | itPtr->conn = NULL; |
1460 | itPtr->nsconn.flags = 0; |
1461 | connPtr->itPtr = NULL; |
1462 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a>(itPtr); |
1463 | } |
1464 | } |
1465 | |
1466 | |
1467 | /* |
1468 | *---------------------------------------------------------------------- |
1469 | * |
1470 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclRunAtClose">NsTclRunAtClose</a> -- |
1471 | * |
1472 | * Run any registered connection at-close scripts. |
1473 | * |
1474 | * Results: |
1475 | * None. |
1476 | * |
1477 | * Side effects: |
1478 | * None. |
1479 | * |
1480 | *---------------------------------------------------------------------- |
1481 | */ |
1482 | |
1483 | void |
1484 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclRunAtClose">NsTclRunAtClose</a>(NsInterp *itPtr) |
1485 | { |
1486 | Tcl_Interp *interp = itPtr->interp; |
1487 | AtClose *atPtr; |
1488 | |
1489 | while ((atPtr = itPtr->firstAtClosePtr) != NULL) { |
1490 | itPtr->firstAtClosePtr = atPtr->nextPtr; |
1491 | if (Tcl_EvalObjEx(interp, atPtr->objPtr, TCL_EVAL_DIRECT) != TCL_OK) { |
1492 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(interp); |
1493 | } |
1494 | Tcl_DecrRefCount(atPtr->objPtr); |
1495 | ns_free(atPtr); |
1496 | } |
1497 | } |
1498 | |
1499 | |
1500 | /* |
1501 | *---------------------------------------------------------------------- |
1502 | * |
1503 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PopInterp">PopInterp</a> -- |
1504 | * |
1505 | * Pop next avaialble virtual-server interp from the per-thread |
1506 | * cache, allocating a new interp if necessary. |
1507 | * |
1508 | * Results: |
1509 | * Pointer to next available NsInterp. |
1510 | * |
1511 | * Side effects: |
1512 | * Will invoke alloc traces and, if the interp is new, create |
1513 | * traces. |
1514 | * |
1515 | *---------------------------------------------------------------------- |
1516 | */ |
1517 | |
1518 | static NsInterp * |
1519 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PopInterp">PopInterp</a>(char *server) |
1520 | { |
1521 | static Ns_Cs lock; |
1522 | NsServer *servPtr; |
1523 | NsInterp *itPtr; |
1524 | Tcl_HashEntry *hPtr; |
1525 | Tcl_Interp *interp; |
1526 | int epoch; |
1527 | |
1528 | /* |
1529 | * Verify the server. NULL (i.e., no server) is valid but |
1530 | * a non-null, unknown server is an error and get the current |
1531 | * epoch. |
1532 | */ |
1533 | |
1534 | servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetServer">NsGetServer</a>(server); |
1535 | if (servPtr == NULL) { |
1536 | return NULL; |
1537 | } |
1538 | Ns_RWLockRdLock(&servPtr->tcl.slock); |
1539 | epoch = servPtr->tcl.epoch; |
1540 | Ns_RWLockUnlock(&servPtr->tcl.slock); |
1541 | |
1542 | /* |
1543 | * Dump any interps with an invalid epoch and then pop the first |
1544 | * available interp or create a new interp. |
1545 | */ |
1546 | |
1547 | hPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetCacheEntry">GetCacheEntry</a>(servPtr); |
1548 | if (epoch == 0) { |
1549 | /* NB: Epoch 0 indicates legacy module config disabled. */ |
1550 | itPtr = Tcl_GetHashValue(hPtr); |
1551 | } else { |
1552 | NsInterp *validPtr = NULL; |
1553 | while ((itPtr = Tcl_GetHashValue(hPtr)) != NULL) { |
1554 | Tcl_SetHashValue(hPtr, itPtr->nextPtr); |
1555 | if (itPtr->epoch != epoch) { |
1556 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDestroyInterp">Ns_TclDestroyInterp</a>(itPtr->interp); |
1557 | } else { |
1558 | itPtr->nextPtr = validPtr; |
1559 | validPtr = itPtr; |
1560 | } |
1561 | } |
1562 | itPtr = validPtr; |
1563 | } |
1564 | if (itPtr != NULL) { |
1565 | Tcl_SetHashValue(hPtr, itPtr->nextPtr); |
1566 | } else { |
1567 | if (nsconf.tcl.lockoninit) { |
1568 | Ns_CsEnter(&lock); |
1569 | } |
1570 | interp = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_CreateInterp">CreateInterp</a>(servPtr); |
1571 | itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp); |
1572 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(itPtr, NS_TCL_TRACE_CREATE); |
1573 | if (nsconf.tcl.lockoninit) { |
1574 | Ns_CsLeave(&lock); |
1575 | } |
1576 | } |
1577 | itPtr->nextPtr = NULL; |
1578 | interp = itPtr->interp; |
1579 | |
1580 | /* |
1581 | * Clear any pending async cancel message, run the traces and |
1582 | * set the epoch if a create and/or allocate traces hasn't |
1583 | * already done so. |
1584 | */ |
1585 | |
1586 | (void) Tcl_AsyncInvoke(interp, TCL_OK); |
1587 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(itPtr, NS_TCL_TRACE_ALLOCATE); |
1588 | if (itPtr->epoch != epoch) { |
1589 | itPtr->epoch = epoch; |
1590 | } |
1591 | return itPtr; |
1592 | } |
1593 | |
1594 | |
1595 | /* |
1596 | *---------------------------------------------------------------------- |
1597 | * |
1598 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a> -- |
1599 | * |
1600 | * Return a virtual-server interp to the per-thread interp |
1601 | * |
1602 | * Results: |
1603 | * None. |
1604 | * |
1605 | * Side effects: |
1606 | * Will invoke de-alloc traces. |
1607 | * |
1608 | *---------------------------------------------------------------------- |
1609 | */ |
1610 | |
1611 | static void |
1612 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a>(NsInterp *itPtr) |
1613 | { |
1614 | Tcl_Interp *interp = itPtr->interp; |
1615 | Tcl_HashEntry *hPtr; |
1616 | |
1617 | /* |
1618 | * Evaluate the cleanup script to perform various garbage collection |
1619 | * and then either delete the interp or push it back on the |
1620 | * per-thread list. |
1621 | */ |
1622 | |
1623 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(itPtr, NS_TCL_TRACE_DEALLOCATE); |
1624 | if (itPtr->delete) { |
1625 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDestroyInterp">Ns_TclDestroyInterp</a>(interp); |
1626 | } else { |
1627 | hPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetCacheEntry">GetCacheEntry</a>(itPtr->servPtr); |
1628 | itPtr->nextPtr = Tcl_GetHashValue(hPtr); |
1629 | Tcl_SetHashValue(hPtr, itPtr); |
1630 | } |
1631 | } |
1632 | |
1633 | |
1634 | /* |
1635 | *---------------------------------------------------------------------- |
1636 | * |
1637 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetCacheEntry">GetCacheEntry</a> -- |
1638 | * |
1639 | * Get hash entry in per-thread interp cache for given virtual |
1640 | * server |
1641 | * |
1642 | * Results: |
1643 | * Pointer to hash entry. |
1644 | * |
1645 | * Side effects: |
1646 | * None. |
1647 | * |
1648 | *---------------------------------------------------------------------- |
1649 | */ |
1650 | |
1651 | static Tcl_HashEntry * |
1652 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetCacheEntry">GetCacheEntry</a>(NsServer *servPtr) |
1653 | { |
1654 | TclData *dataPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetData">GetData</a>(); |
1655 | int new; |
1656 | |
1657 | return Tcl_CreateHashEntry(&dataPtr->interps, (char *) servPtr, &new); |
1658 | } |
1659 | |
1660 | |
1661 | /* |
1662 | *---------------------------------------------------------------------- |
1663 | * |
1664 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a> -- |
1665 | * |
1666 | * Eval the given script from being called as a Tcl Init callback. |
1667 | * |
1668 | * Results: |
1669 | * Status from script eval. |
1670 | * |
1671 | * Side effects: |
1672 | * Depends on script. |
1673 | * |
1674 | *---------------------------------------------------------------------- |
1675 | */ |
1676 | |
1677 | static int |
1678 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a>(Tcl_Interp *interp, void *arg) |
1679 | { |
1680 | ScriptTrace *stPtr = arg; |
1681 | |
1682 | return Tcl_EvalEx(interp, stPtr->script, stPtr->length, 0); |
1683 | } |
1684 | |
1685 | |
1686 | /* |
1687 | *---------------------------------------------------------------------- |
1688 | * |
1689 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_CreateInterp">CreateInterp</a> -- |
1690 | * |
1691 | * Create a new interp with the Nsd package. |
1692 | * |
1693 | * Results: |
1694 | * Pointer to new Tcl_Interp. |
1695 | * |
1696 | * Side effects: |
1697 | * Will log an error message on core Tcl and/or Nsd package init |
1698 | * failure. |
1699 | * |
1700 | *---------------------------------------------------------------------- |
1701 | */ |
1702 | |
1703 | static Tcl_Interp * |
1704 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_CreateInterp">CreateInterp</a>(NsServer *servPtr) |
1705 | { |
1706 | Tcl_Interp *interp; |
1707 | |
1708 | interp = Tcl_CreateInterp(); |
1709 | Tcl_InitMemory(interp); |
1710 | if (Tcl_Init(interp) != TCL_OK || <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a>(interp, servPtr) != TCL_OK) { |
1711 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(interp); |
1712 | } |
1713 | return interp; |
1714 | } |
1715 | |
1716 | |
1717 | /* |
1718 | *---------------------------------------------------------------------- |
1719 | * |
1720 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a> -- |
1721 | * |
1722 | * Initialize and provide the Nsd package for given interp, |
1723 | * associating it with a specific virtual server, if any. |
1724 | * |
1725 | * Results: |
1726 | * Return code of Tcl_PkgProvide. |
1727 | * |
1728 | * Side effects: |
1729 | * Will add Nsd package commands to given interp. |
1730 | * |
1731 | *---------------------------------------------------------------------- |
1732 | */ |
1733 | |
1734 | static int |
1735 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a>(Tcl_Interp *interp, NsServer *servPtr) |
1736 | { |
1737 | static volatile int initialized = 0; |
1738 | NsInterp *itPtr; |
1739 | |
1740 | /* |
1741 | * Core one-time AOLserver initialization to add a few Tcl_Obj |
1742 | * types. These calls cannot be in NsTclInit above because |
1743 | * Tcl is not fully initialized at libnsd load time. |
1744 | */ |
1745 | |
1746 | if (!initialized) { |
1747 | <a href="/cvs/aolserver/aolserver/nsd/init.c#A_Ns_LibInit">Ns_LibInit</a>(); |
1748 | Ns_MasterLock(); |
1749 | if (!initialized) { |
1750 | <a href="/cvs/aolserver/aolserver/nsd/tcljob.c#A_NsTclInitQueueType">NsTclInitQueueType</a>(); |
1751 | <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclInitAddrType">NsTclInitAddrType</a>(); |
1752 | <a href="/cvs/aolserver/aolserver/nsd/tclobj.c#A_NsTclInitTimeType">NsTclInitTimeType</a>(); |
1753 | <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NsTclInitCacheType">NsTclInitCacheType</a>(); |
1754 | NsTclInitKeylistType(); |
1755 | initialized = 1; |
1756 | } |
1757 | Ns_MasterUnlock(); |
1758 | } |
1759 | |
1760 | /* |
1761 | * Allocate and initialize a new NsInterp struct. |
1762 | */ |
1763 | |
1764 | itPtr = ns_calloc(1, sizeof(NsInterp)); |
1765 | itPtr->interp = interp; |
1766 | itPtr->servPtr = servPtr; |
1767 | Tcl_InitHashTable(&itPtr->sets, TCL_STRING_KEYS); |
1768 | Tcl_InitHashTable(&itPtr->chans, TCL_STRING_KEYS); |
1769 | Tcl_InitHashTable(&itPtr->https, TCL_STRING_KEYS); |
1770 | <a href="/cvs/aolserver/aolserver/nsd/adpeval.c#A_NsAdpInit">NsAdpInit</a>(itPtr); |
1771 | itPtr->adp.cwd = <a href="/cvs/aolserver/aolserver/nsd/fastpath.c#A_Ns_PageRoot">Ns_PageRoot</a>(servPtr->server); |
1772 | |
1773 | /* |
1774 | * Associate the new NsInterp with this interp. At interp delete |
1775 | * time, Tcl will call <a href="/cvs/aolserver/aolserver/nsdb/dbtcl.c#A_FreeData">FreeData</a> to cleanup the struct. |
1776 | */ |
1777 | |
1778 | Tcl_SetAssocData(interp, "ns:data", <a href="/cvs/aolserver/aolserver/nsdb/dbtcl.c#A_FreeData">FreeData</a>, itPtr); |
1779 | |
1780 | /* |
1781 | * Ensure the per-thread data with async cancel handle is allocated. |
1782 | */ |
1783 | |
1784 | (void) <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetData">GetData</a>(); |
1785 | |
1786 | /* |
1787 | * Add core AOLserver commands. |
1788 | */ |
1789 | |
1790 | <a href="/cvs/aolserver/aolserver/nsd/tclcmds.c#A_NsTclAddCmds">NsTclAddCmds</a>(interp, itPtr); |
1791 | return Tcl_PkgProvide(interp, "Nsd", NS_VERSION); |
1792 | } |
1793 | |
1794 | |
1795 | /* |
1796 | *---------------------------------------------------------------------- |
1797 | * |
1798 | * <a href="/cvs/aolserver/aolserver/nsdb/dbtcl.c#A_FreeData">FreeData</a> -- |
1799 | * |
1800 | * Tcl assoc data callback to destroy the per-interp NsInterp |
1801 | * structure at interp delete time. |
1802 | * |
1803 | * Results: |
1804 | * None. |
1805 | * |
1806 | * Side effects: |
1807 | * None. |
1808 | * |
1809 | *---------------------------------------------------------------------- |
1810 | */ |
1811 | |
1812 | static void |
1813 | <a href="/cvs/aolserver/aolserver/nsdb/dbtcl.c#A_FreeData">FreeData</a>(ClientData arg, Tcl_Interp *interp) |
1814 | { |
1815 | NsInterp *itPtr = arg; |
1816 | |
1817 | <a href="/cvs/aolserver/aolserver/nsd/adpeval.c#A_NsAdpFree">NsAdpFree</a>(itPtr); |
1818 | Tcl_DeleteHashTable(&itPtr->sets); |
1819 | Tcl_DeleteHashTable(&itPtr->chans); |
1820 | Tcl_DeleteHashTable(&itPtr->https); |
1821 | ns_free(itPtr); |
1822 | } |
1823 | |
1824 | |
1825 | /* |
1826 | *---------------------------------------------------------------------- |
1827 | * |
1828 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetData">GetData</a> -- |
1829 | * |
1830 | * Return the per-thread Tcl data structure for current thread. |
1831 | * |
1832 | * Results: |
1833 | * Pointer to TclData structure. |
1834 | * |
1835 | * Side effects: |
1836 | * Will allocate and initialize TclData struct if necessary. |
1837 | * |
1838 | *---------------------------------------------------------------------- |
1839 | */ |
1840 | |
1841 | static TclData * |
1842 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetData">GetData</a>(void) |
1843 | { |
1844 | TclData *dataPtr; |
1845 | int tid, new; |
1846 | |
1847 | dataPtr = Ns_TlsGet(&tls); |
1848 | if (dataPtr == NULL) { |
1849 | dataPtr = ns_malloc(sizeof(TclData)); |
1850 | dataPtr->cancel = Tcl_AsyncCreate(<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_AsyncCancel">AsyncCancel</a>, NULL); |
1851 | Tcl_InitHashTable(&dataPtr->interps, TCL_ONE_WORD_KEYS); |
1852 | tid = Ns_ThreadId(); |
1853 | Ns_MutexLock(&tlock); |
1854 | dataPtr->hPtr = Tcl_CreateHashEntry(&threads, (char *) tid, &new); |
1855 | Tcl_SetHashValue(dataPtr->hPtr, dataPtr); |
1856 | Ns_MutexUnlock(&tlock); |
1857 | Ns_TlsSet(&tls, dataPtr); |
1858 | } |
1859 | return dataPtr; |
1860 | } |
1861 | |
1862 | |
1863 | /* |
1864 | *---------------------------------------------------------------------- |
1865 | * |
1866 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DeleteData">DeleteData</a> -- |
1867 | * |
1868 | * Delete all per-thread data at thread exit time. |
1869 | * |
1870 | * Results: |
1871 | * None. |
1872 | * |
1873 | * Side effects: |
1874 | * None. |
1875 | * |
1876 | *---------------------------------------------------------------------- |
1877 | */ |
1878 | |
1879 | static void |
1880 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DeleteData">DeleteData</a>(void *arg) |
1881 | { |
1882 | TclData *dataPtr = arg; |
1883 | Tcl_HashEntry *hPtr; |
1884 | Tcl_HashSearch search; |
1885 | NsInterp *itPtr; |
1886 | |
1887 | Ns_MutexLock(&tlock); |
1888 | Tcl_DeleteHashEntry(dataPtr->hPtr); |
1889 | Ns_MutexUnlock(&tlock); |
1890 | hPtr = Tcl_FirstHashEntry(&dataPtr->interps, &search); |
1891 | while (hPtr != NULL) { |
1892 | while ((itPtr = Tcl_GetHashValue(hPtr)) != NULL) { |
1893 | Tcl_SetHashValue(hPtr, itPtr->nextPtr); |
1894 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDestroyInterp">Ns_TclDestroyInterp</a>(itPtr->interp); |
1895 | } |
1896 | hPtr = Tcl_NextHashEntry(&search); |
1897 | } |
1898 | Tcl_DeleteHashTable(&dataPtr->interps); |
1899 | Tcl_AsyncDelete(dataPtr->cancel); |
1900 | ns_free(dataPtr); |
1901 | } |
1902 | |
1903 | |
1904 | /* |
1905 | *---------------------------------------------------------------------- |
1906 | * |
1907 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a> -- |
1908 | * |
1909 | * Execute script and C-level trace callbacks |
1910 | * |
1911 | * Results: |
1912 | * None. |
1913 | * |
1914 | * Side effects: |
1915 | * Depeneds on callbacks. |
1916 | * |
1917 | *---------------------------------------------------------------------- |
1918 | */ |
1919 | |
1920 | static void |
1921 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(NsInterp *itPtr, int why) |
1922 | { |
1923 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_ForeachTrace">ForeachTrace</a>(itPtr, why, 0); |
1924 | } |
1925 | |
1926 | static void |
1927 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_ForeachTrace">ForeachTrace</a>(NsInterp *itPtr, int why, int append) |
1928 | { |
1929 | Tcl_Interp *interp = itPtr->interp; |
1930 | TclTrace *tracePtr; |
1931 | |
1932 | /* |
1933 | * Finalization traces are invoked in LIFO order with script-traces |
1934 | * before C-level traces. Otherwise, traces are invoked in FIFO |
1935 | * order, with C-level traces before script-traces. |
1936 | */ |
1937 | |
1938 | Tcl_ResetResult(interp); |
1939 | Ns_RWLockRdLock(&itPtr->servPtr->tcl.tlock); |
1940 | switch (why) { |
1941 | case NS_TCL_TRACE_FREECONN: |
1942 | case NS_TCL_TRACE_DEALLOCATE: |
1943 | case NS_TCL_TRACE_DELETE: |
1944 | tracePtr = itPtr->servPtr->tcl.lastTracePtr; |
1945 | while (tracePtr != NULL) { |
1946 | if (tracePtr->proc == <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a> && (tracePtr->when & why)) { |
1947 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a>(interp, tracePtr, append); |
1948 | } |
1949 | tracePtr = tracePtr->prevPtr; |
1950 | } |
1951 | tracePtr = itPtr->servPtr->tcl.lastTracePtr; |
1952 | while (tracePtr != NULL) { |
1953 | if (tracePtr->proc != <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a> && (tracePtr->when & why)) { |
1954 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a>(interp, tracePtr, append); |
1955 | } |
1956 | tracePtr = tracePtr->prevPtr; |
1957 | } |
1958 | break; |
1959 | |
1960 | default: |
1961 | tracePtr = itPtr->servPtr->tcl.firstTracePtr; |
1962 | while (tracePtr != NULL) { |
1963 | if (tracePtr->proc != <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a> && (tracePtr->when & why)) { |
1964 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a>(interp, tracePtr, append); |
1965 | } |
1966 | tracePtr = tracePtr->nextPtr; |
1967 | } |
1968 | tracePtr = itPtr->servPtr->tcl.firstTracePtr; |
1969 | while (tracePtr != NULL) { |
1970 | if (tracePtr->proc == <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a> && (tracePtr->when & why)) { |
1971 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a>(interp, tracePtr, append); |
1972 | } |
1973 | tracePtr = tracePtr->nextPtr; |
1974 | } |
1975 | break; |
1976 | } |
1977 | Ns_RWLockUnlock(&itPtr->servPtr->tcl.tlock); |
1978 | if (!append) { |
1979 | Tcl_ResetResult(interp); |
1980 | } |
1981 | } |
1982 | |
1983 | |
1984 | /* |
1985 | *---------------------------------------------------------------------- |
1986 | * |
1987 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a> -- |
1988 | * |
1989 | * Invoke or append a trace, logging any error message. |
1990 | * |
1991 | * Results: |
1992 | * None. |
1993 | * |
1994 | * Side effects: |
1995 | * None. |
1996 | * |
1997 | *---------------------------------------------------------------------- |
1998 | */ |
1999 | |
2000 | static void |
2001 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a>(Tcl_Interp *interp, TclTrace *tracePtr, int append) |
2002 | { |
2003 | Tcl_Obj *procPtr; |
2004 | ScriptTrace *stPtr; |
2005 | char buf[100]; |
2006 | int result; |
2007 | |
2008 | if (!append) { |
2009 | result = (*tracePtr->proc)(interp, tracePtr->arg); |
2010 | if (result != TCL_OK) { |
2011 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(interp); |
2012 | } |
2013 | } else { |
2014 | if (tracePtr->proc == <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a>) { |
2015 | stPtr = tracePtr->arg; |
2016 | procPtr = Tcl_NewStringObj(stPtr->script, stPtr->length); |
2017 | } else { |
2018 | sprintf(buf, "C {p:%p a:%p}", tracePtr->proc, tracePtr->arg); |
2019 | procPtr = Tcl_NewStringObj(buf, -1); |
2020 | } |
2021 | Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), procPtr); |
2022 | } |
2023 | } |
2024 | |
2025 | |
2026 | /* |
2027 | *---------------------------------------------------------------------- |
2028 | * |
2029 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PkgRequire">PkgRequire</a> -- |
2030 | * |
2031 | * Trace callback to add a registered package to given interp. |
2032 | * |
2033 | * Results: |
2034 | * TCL_OK if package added, TCL_ERROR otherwise. |
2035 | * |
2036 | * Side effects: |
2037 | * Depends on package, typically new namespaces and/or commands. |
2038 | * |
2039 | *---------------------------------------------------------------------- |
2040 | */ |
2041 | |
2042 | static int |
2043 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PkgRequire">PkgRequire</a>(Tcl_Interp *interp, void *arg) |
2044 | { |
2045 | Package *pkgPtr = arg; |
2046 | |
2047 | if (Tcl_PkgRequire(interp, pkgPtr->name, pkgPtr->version, |
2048 | pkgPtr->exact) == NULL) { |
2049 | return TCL_ERROR; |
2050 | } |
2051 | return TCL_OK; |
2052 | } |
2053 | |
2054 | |
2055 | /* |
2056 | *---------------------------------------------------------------------- |
2057 | * |
2058 | * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_AsyncCancel">AsyncCancel</a> -- |
2059 | * |
2060 | * Callback which cancels Tcl execution in the given thread. |
2061 | * |
2062 | * Results: |
2063 | * TCL_ERROR. |
2064 | * |
2065 | * Side effects: |
2066 | * None. |
2067 | * |
2068 | *---------------------------------------------------------------------- |
2069 | */ |
2070 | |
2071 | static int |
2072 | <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_AsyncCancel">AsyncCancel</a>(ClientData ignored, Tcl_Interp *interp, int code) |
2073 | { |
2074 | Tcl_ResetResult(interp); |
2075 | Tcl_SetResult(interp, "async cancel", TCL_STATIC); |
2076 | return TCL_ERROR; |
2077 | } |
Copyright © 2010 Geeknet, Inc. All rights reserved. Terms of Use