1 /* -- mod_rivet_common.c - functions likely to be shared among different
2  *                         components of mod_rivet.c
3  */
4 
5 /*
6     Licensed to the Apache Software Foundation (ASF) under one
7     or more contributor license agreements.  See the NOTICE file
8     distributed with this work for additional information
9     regarding copyright ownership.  The ASF licenses this file
10     to you under the Apache License, Version 2.0 (the
11     "License"); you may not use this file except in compliance
12     with the License.  You may obtain a copy of the License at
13 
14       http://www.apache.org/licenses/LICENSE-2.0
15 
16     Unless required by applicable law or agreed to in writing,
17     software distributed under the License is distributed on an
18     "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
19     KIND, either express or implied.  See the License for the
20     specific language governing permissions and limitations
21     under the License.
22 */
23 
24 #include <httpd.h>
25 #include <apr_strings.h>
26 #include <apr_env.h>
27 #include <apr_file_io.h>
28 #include <apr_file_info.h>
29 #include <ap_mpm.h>
30 
31 #include "mod_rivet.h"
32 #include "rivetChannel.h"
33 #include "TclWeb.h"
34 #include "rivetParser.h"
35 #include "rivet.h"
36 #include "apache_config.h"
37 
38 /* as long as we need to emulate ap_chdir_file we need to include unistd.h */
39 #ifdef RIVET_HAVE_UNISTD_H
40 #include <unistd.h>
41 #endif /* RIVET_HAVE_UNISTD_H */
42 #ifdef WIN32
43 #include <direct.h> // provides POSIX _chdir
44 #endif /* WIN32 */
45 
46 /* Function prototypes are defined with EXTERN. Since we are in the same DLL,
47  * no need to keep this extern... */
48 #ifdef EXTERN
49 #   undef EXTERN
50 #   define EXTERN DLLEXPORT
51 #endif /* EXTERN */
52 #include "rivetCore.h"
53 #include "mod_rivet_common.h"
54 #include "mod_rivet_cache.h"
55 
56 extern apr_threadkey_t*   rivet_thread_key;
57 extern mod_rivet_globals* module_globals;
58 extern module rivet_module;
59 
60 /*
61  * -- Rivet_ReadFile
62  *
63  */
64 
65 int
Rivet_ReadFile(apr_pool_t * pool,char * filename,char ** buffer,int * nbytes)66 Rivet_ReadFile (apr_pool_t* pool,char* filename,
67                 char** buffer,int* nbytes)
68 {
69     apr_finfo_t*        file_info;
70     apr_file_t*         apr_fp;
71     apr_size_t          buffer_size;
72 
73     *nbytes = 0;
74 
75     file_info = (apr_finfo_t*) apr_palloc(pool,sizeof(apr_finfo_t));
76     if (apr_stat(file_info,filename,APR_FINFO_SIZE,pool) != APR_SUCCESS)
77     {
78         return 1;
79     }
80 
81     if (apr_file_open(&apr_fp,filename,APR_FOPEN_READ,
82                                        APR_FPROT_OS_DEFAULT,
83                                        pool) != APR_SUCCESS)
84     {
85         return 1;
86     }
87 
88     buffer_size = file_info->size;
89     *buffer = (char*) apr_palloc(pool,buffer_size);
90 
91     if (apr_file_read(apr_fp,*buffer,&buffer_size) != APR_SUCCESS)
92     {
93         return 2;
94     }
95 
96     apr_file_close(apr_fp);
97 
98     *nbytes = (int)buffer_size;
99     return 0;
100 }
101 
102 /*-----------------------------------------------------------------------------
103  * Rivet_CreateTclInterp --
104  *
105  * Arguments:
106  *  server_rec* s: pointer to a server_rec structure
107  *
108  * Results:
109  *  pointer to a Tcl_Interp structure
110  *
111  * Side Effects:
112  *
113  *-----------------------------------------------------------------------------
114  */
115 
116 static Tcl_Interp*
Rivet_CreateTclInterp(apr_pool_t * pool)117 Rivet_CreateTclInterp (apr_pool_t* pool)
118 {
119     Tcl_Interp* interp;
120 
121     /* Initialize TCL stuff  */
122     Tcl_FindExecutable(RIVET_NAMEOFEXECUTABLE);
123     interp = Tcl_CreateInterp();
124 
125     if (interp == NULL)
126     {
127         ap_log_perror(APLOG_MARK, APLOG_ERR, APR_EGENERAL, pool,
128                      MODNAME ": Error in Tcl_CreateInterp, aborting\n");
129         exit(1);
130     }
131 
132     if (Tcl_Init(interp) == TCL_ERROR)
133     {
134         ap_log_perror(APLOG_MARK, APLOG_ERR, APR_EGENERAL, pool,
135                      MODNAME ": Error in Tcl_Init: %s, aborting\n",
136                      Tcl_GetStringResult(interp));
137         exit(1);
138     }
139 
140     return interp;
141 }
142 
143 /*---------------------------------------------------------------------
144  * -- Rivet_RunningScripts
145  *
146  *
147  *
148  *---------------------------------------------------------------------
149  */
150 
Rivet_RunningScripts(apr_pool_t * pool,running_scripts * scripts,rivet_server_conf * rivet_conf)151 running_scripts* Rivet_RunningScripts ( apr_pool_t* pool,
152                                         running_scripts* scripts,
153                                         rivet_server_conf* rivet_conf )
154 {
155     RIVET_SCRIPT_INIT (pool,scripts,rivet_conf,rivet_before_script);
156     RIVET_SCRIPT_INIT (pool,scripts,rivet_conf,rivet_after_script);
157     RIVET_SCRIPT_INIT (pool,scripts,rivet_conf,rivet_error_script);
158     RIVET_SCRIPT_INIT (pool,scripts,rivet_conf,rivet_abort_script);
159     RIVET_SCRIPT_INIT (pool,scripts,rivet_conf,after_every_script);
160 
161     if (rivet_conf->request_handler != NULL)
162     {
163 		char* request_handler;
164 		int	  handler_size;
165 
166 		ap_assert(Rivet_ReadFile(pool,rivet_conf->request_handler,
167 		                        &request_handler,&handler_size) == 0);
168 
169         scripts->request_processing =
170 				 Tcl_NewStringObj(request_handler,handler_size);
171 
172     } else {
173         scripts->request_processing =
174 				 Tcl_NewStringObj(module_globals->default_handler,
175                                   module_globals->default_handler_size);
176     }
177     Tcl_IncrRefCount(scripts->request_processing);
178 
179     return scripts;
180 }
181 
182 /*
183  *  -- Rivet_ReleaseRunningScripts
184  *
185  */
186 
Rivet_ReleaseRunningScripts(running_scripts * scripts)187 void Rivet_ReleaseRunningScripts (running_scripts* scripts)
188 {
189     RIVET_SCRIPT_DISPOSE(scripts,rivet_before_script);
190     RIVET_SCRIPT_DISPOSE(scripts,rivet_after_script);
191     RIVET_SCRIPT_DISPOSE(scripts,rivet_error_script);
192     RIVET_SCRIPT_DISPOSE(scripts,rivet_abort_script);
193     RIVET_SCRIPT_DISPOSE(scripts,after_every_script);
194     RIVET_SCRIPT_DISPOSE(scripts,request_processing);
195 }
196 
197 /*
198  * -- Rivet_ReleasePerDirScripts
199  *
200  */
201 
Rivet_ReleasePerDirScripts(rivet_thread_interp * rivet_interp)202 void Rivet_ReleasePerDirScripts(rivet_thread_interp* rivet_interp)
203 {
204     apr_hash_t*         ht = rivet_interp->per_dir_scripts;
205     apr_hash_index_t*   hi;
206     Tcl_Obj*            script;
207     apr_pool_t*         p = rivet_interp->pool;
208 
209     for (hi = apr_hash_first(p,ht); hi; hi = apr_hash_next(hi))
210     {
211         apr_hash_this(hi, NULL, NULL, (void*)(&script));
212         Tcl_DecrRefCount(script);
213     }
214 
215     apr_hash_clear(ht);
216 }
217 
218 
219 /*
220  *---------------------------------------------------------------------
221  *
222  * Rivet_PerInterpInit --
223  *
224  *  Do the initialization that needs to happen to every interpreter.
225  *
226  * Results:
227  *  None.
228  *
229  * Side Effects:
230  *  None.
231  *
232  *---------------------------------------------------------------------
233  */
Rivet_PerInterpInit(rivet_thread_interp * interp_obj,rivet_thread_private * private,server_rec * s,apr_pool_t * p)234 void Rivet_PerInterpInit(rivet_thread_interp* interp_obj,
235 						 rivet_thread_private* private,
236 						 server_rec *s,
237 						 apr_pool_t *p)
238 {
239     rivet_interp_globals*   globals     = NULL;
240     Tcl_Obj*                auto_path   = NULL;
241     Tcl_Obj*                rivet_tcl   = NULL;
242     Tcl_Interp*             interp      = interp_obj->interp;
243 
244     ap_assert (interp != (Tcl_Interp *)NULL);
245     Tcl_Preserve (interp);
246 
247     /* Set up interpreter associated data */
248 
249     globals = ckalloc(sizeof(rivet_interp_globals));
250     Tcl_SetAssocData (interp,"rivet",NULL,globals);
251 
252     /*
253      * the ::rivet namespace is the only information still stored
254      * in the interpreter global data
255      */
256 
257     /* Rivet commands namespace is created */
258 
259     globals->rivet_ns = Tcl_CreateNamespace (interp,RIVET_NS,NULL,
260                                             (Tcl_NamespaceDeleteProc *)NULL);
261 
262     /* We put in front the auto_path list the path to the directory where
263      * init.tcl is located (provides package Rivet, previously RivetTcl)
264      */
265 
266     auto_path = Tcl_GetVar2Ex(interp,"auto_path",NULL,TCL_GLOBAL_ONLY);
267 
268     rivet_tcl = Tcl_NewStringObj(RIVET_DIR,-1);
269     Tcl_IncrRefCount(rivet_tcl);
270 
271     if (Tcl_IsShared(auto_path)) {
272         auto_path = Tcl_DuplicateObj(auto_path);
273     }
274 
275     if (Tcl_ListObjReplace(interp,auto_path,0,0,1,&rivet_tcl) == TCL_ERROR)
276     {
277         ap_log_error(APLOG_MARK, APLOG_ERR, APR_EGENERAL, s,
278                      MODNAME ": error setting auto_path: %s",
279                      Tcl_GetStringFromObj(auto_path,NULL));
280     } else {
281         Tcl_SetVar2Ex(interp,"auto_path",NULL,auto_path,TCL_GLOBAL_ONLY);
282     }
283 
284     Tcl_DecrRefCount(rivet_tcl);
285 
286     /* If the thread has private data we stuff the server conf
287      * pointer in the 'running_conf' field.
288      * Commands running ouside a request processing must figure out
289      * themselves how get a pointer to the configuration from the
290      * context (e.g. ::rivet::inspect)
291      */
292 
293     if (private != NULL) private->running_conf = RIVET_SERVER_CONF (s->module_config);
294 
295     /* Initialize the interpreter with Rivet's Tcl commands. */
296     Rivet_InitCore(interp,private);
297 
298     /* Create a global array with information about the server. */
299     Rivet_InitServerVariables(interp,p);
300 
301     /* Eval Rivet's init.tcl file to load in the Tcl-level commands. */
302 
303     /* Watch out! Calling Tcl_PkgRequire with a version number binds this module to
304      * the Rivet package revision number in rivet/init.tcl
305      *
306      * RIVET_TCL_PACKAGE_VERSION is defined by configure.ac as the combination
307      * "MAJOR_VERSION.MINOR_VERSION". We don't expect to change rivet/init.tcl
308      * across patchlevel releases
309      */
310 
311     if (Tcl_PkgRequire(interp, "Rivet", RIVET_INIT_VERSION, 1) == NULL)
312     {
313         ap_log_error (APLOG_MARK, APLOG_ERR, APR_EGENERAL, s,
314                       MODNAME ": init.tcl must be installed correctly for Apache Rivet to function: %s (%s)",
315                       Tcl_GetStringResult(interp), RIVET_DIR );
316         exit(1);
317     }
318 
319     Tcl_Release(interp);
320     interp_obj->flags |= RIVET_INTERP_INITIALIZED;
321 }
322 
323  /* -- Rivet_NewVHostInterp
324   *
325   * Returns a new rivet_thread_interp object with a new Tcl interpreter
326   * configuration scripts and cache. The pool passed to Rivet_NewVHostInterp
327   *
328   * Arguments:
329   *     apr_pool_t* pool: a memory pool, it must be the private pool of a
330   *                         rivet_thread_private object (thread private)
331   *
332   * Returned value:
333   *     a rivet_thread_interp* record object
334   *
335   */
336 
Rivet_NewVHostInterp(apr_pool_t * pool,int default_cache_size)337 rivet_thread_interp* Rivet_NewVHostInterp(apr_pool_t *pool,int default_cache_size)
338 {
339     rivet_thread_interp*    interp_obj = apr_pcalloc(pool,sizeof(rivet_thread_interp));
340 
341     /* This calls needs the root server_rec just for logging purposes */
342 
343     interp_obj->interp = Rivet_CreateTclInterp(pool);
344 
345     /* we now create memory from the cache pool as subpool of the thread private pool */
346 
347     if (apr_pool_create(&interp_obj->pool, pool) != APR_SUCCESS)
348     {
349         ap_log_perror(APLOG_MARK, APLOG_ERR, APR_EGENERAL, pool,
350                      MODNAME ": could not initialize cache private pool");
351         return NULL;
352     }
353 
354     /* We now read from the pointers to the cache_size and cache_free conf parameters
355      * for compatibility with mod_rivet current version, but these values must become
356      * integers not pointers
357      */
358 
359     if (default_cache_size < 0) {
360         interp_obj->cache_size = RivetCache_DefaultSize();
361     } else if (default_cache_size > 0) {
362         interp_obj->cache_size = default_cache_size;
363     }
364 
365     interp_obj->cache_free = interp_obj->cache_size;
366 
367     // Initialize cache structures
368 
369     if (interp_obj->cache_size) {
370         RivetCache_Create(pool,interp_obj);
371     }
372 
373     interp_obj->flags           = 0;
374     interp_obj->scripts         = (running_scripts *) apr_pcalloc(pool,sizeof(running_scripts));
375     interp_obj->per_dir_scripts = apr_hash_make(pool);
376 
377     return interp_obj;
378 }
379 
380 
381 /*
382  *-----------------------------------------------------------------------------
383  *
384  * -- Rivet_CreateRivetChannel
385  *
386  * Creates a channel and registers with to the interpreter
387  *
388  *  Arguments:
389  *
390  *     - apr_pool_t*        pPool: a pointer to an APR memory pool
391  *
392  *  Returned value:
393  *
394  *     the pointer to the Tcl_Channel object
395  *
396  *  Side Effects:
397  *
398  *     a Tcl channel is created allocating memory from the pool
399  *
400  *-----------------------------------------------------------------------------
401  */
402 
403 Tcl_Channel*
Rivet_CreateRivetChannel(apr_pool_t * pPool,apr_threadkey_t * rivet_thread_key)404 Rivet_CreateRivetChannel(apr_pool_t* pPool, apr_threadkey_t* rivet_thread_key)
405 {
406     Tcl_Channel* outchannel;
407 
408     outchannel  = apr_pcalloc (pPool, sizeof(Tcl_Channel));
409     *outchannel = Tcl_CreateChannel(&RivetChan, "apacheout", rivet_thread_key, TCL_WRITABLE);
410 
411     /* The channel we have just created replaces Tcl's stdout */
412 
413     Tcl_SetStdChannel (*(outchannel), TCL_STDOUT);
414 
415     /* Set the output buffer size to the largest allowed value, so that we
416      * won't send any result packets to the browser unless the Rivet
417      * programmer does a "flush stdout" or the page is completed.
418      */
419 
420     Tcl_SetChannelBufferSize (*outchannel, TCL_MAX_CHANNEL_BUFFER_SIZE);
421 
422     return outchannel;
423 }
424 
425 /*-----------------------------------------------------------------------------
426  *
427  * -- Rivet_ReleaseRivetChannel
428  *
429  * Tcl_UnregisterChannel wrapper with the purpose of introducing a control
430  * variables that might help debugging
431  *
432  * Arguments:
433  *
434  *     - Tcl_Interp*    interp
435  *     - Tcl_Channel*   channel
436  *
437  * Returned value
438  *
439  *     none
440  *
441  * Side Effects:
442  *
443  *     channel debug counter decremented (TODO)
444  *
445  *-----------------------------------------------------------------------------
446  */
447 
448 void
Rivet_ReleaseRivetChannel(Tcl_Interp * interp,Tcl_Channel * channel)449 Rivet_ReleaseRivetChannel (Tcl_Interp* interp, Tcl_Channel* channel)
450 {
451     Tcl_UnregisterChannel(interp,*channel);
452 }
453 
454 
455 /*-----------------------------------------------------------------------------
456  *
457  *  -- Rivet_CreatePrivateData
458  *
459  * Creates a thread private data object
460  *
461  *  Arguments:
462  *
463  *    - apr_threadkey_t*  rivet_thread_key
464  *
465  *  Returned value:
466  *
467  *    - rivet_thread_private*   private data object
468  *
469  *-----------------------------------------------------------------------------
470  */
471 
Rivet_CreatePrivateData(void)472 rivet_thread_private* Rivet_CreatePrivateData (void)
473 {
474     rivet_thread_private*   private;
475 
476     ap_assert (apr_threadkey_private_get ((void **)&private,rivet_thread_key) == APR_SUCCESS);
477 
478     apr_thread_mutex_lock(module_globals->pool_mutex);
479     private = apr_pcalloc (module_globals->pool,sizeof(*private));
480     apr_thread_mutex_unlock(module_globals->pool_mutex);
481 
482     if (apr_pool_create (&private->pool, NULL) != APR_SUCCESS)
483     {
484         ap_log_error(APLOG_MARK, APLOG_ERR, APR_EGENERAL, module_globals->server,
485                      MODNAME ": could not create thread private pool");
486         return NULL;
487     }
488     private->req_cnt        = 0;
489     private->r              = NULL;
490     private->req            = TclWeb_NewRequestObject(private->pool);
491     private->page_aborting  = 0;
492     private->thread_exit    = 0;
493     private->exit_status    = 0;
494     private->abort_code     = NULL;
495 
496     apr_threadkey_private_set (private,rivet_thread_key);
497     return private;
498 }
499 
500 /*
501  * -- Rivet_ExecutionThreadInit
502  *
503  * We keep here the basic initilization each execution thread should undergo
504  *
505  *  - create the thread private data
506  *  - create a Tcl channel
507  *  - set up the Panic procedure
508  */
509 
Rivet_ExecutionThreadInit(void)510 rivet_thread_private* Rivet_ExecutionThreadInit (void)
511 {
512     rivet_thread_private* private = Rivet_CreatePrivateData();
513     ap_assert(private != NULL);
514     private->channel = Rivet_CreateRivetChannel(private->pool,rivet_thread_key);
515     Rivet_SetupTclPanicProc();
516 
517     return private;
518 }
519 
520 /*
521  *-----------------------------------------------------------------------------
522  *
523  * -- Rivet_SetupTclPanicProc
524  *
525  * initialize Tcl panic procedure data in a rivet_thread_private object
526  *
527  *  Arguments:
528  *
529  *    - none
530  *
531  *  Returned value:
532  *
533  *    - initialized rivet_thread_private* data record
534  *
535  *-----------------------------------------------------------------------------
536  */
537 
538 rivet_thread_private*
Rivet_SetupTclPanicProc(void)539 Rivet_SetupTclPanicProc (void)
540 {
541     rivet_thread_private*   private;
542 
543     ap_assert (apr_threadkey_private_get ((void **)&private,rivet_thread_key) == APR_SUCCESS);
544 
545     private->rivet_panic_pool        = private->pool;
546     private->rivet_panic_server_rec  = module_globals->server;
547     private->rivet_panic_request_rec = NULL;
548 
549     return private;
550 }
551 
552 /*
553  *-----------------------------------------------------------------------------
554  *
555  * Rivet_PanicProc --
556  *
557  *  Called when Tcl panics, usually because of memory problems.
558  *  We log the request, in order to be able to determine what went
559  *  wrong later.
560  *
561  * Results:
562  *  None.
563  *
564  * Side Effects:
565  *  Calls abort(), which does not return - the child exits.
566  *
567  *-----------------------------------------------------------------------------
568  */
TCL_VARARGS_DEF(CONST char *,arg1)569 void Rivet_Panic TCL_VARARGS_DEF(CONST char *, arg1)
570 {
571     va_list                 argList;
572     char*                   buf;
573     char*                   format;
574     rivet_thread_private*   private;
575 
576     ap_assert (apr_threadkey_private_get ((void **)&private,rivet_thread_key) == APR_SUCCESS);
577 
578     format = (char *) TCL_VARARGS_START(char *,arg1,argList);
579     buf    = (char *) apr_pvsprintf(private->rivet_panic_pool, format, argList);
580 
581     if (private->rivet_panic_request_rec != NULL) {
582         ap_log_error(APLOG_MARK, APLOG_CRIT, APR_EGENERAL,
583                      private->rivet_panic_server_rec,
584                      MODNAME ": Critical error in request: %s",
585                      private->rivet_panic_request_rec->unparsed_uri);
586     }
587 
588     ap_log_error(APLOG_MARK, APLOG_CRIT, APR_EGENERAL,
589                  private->rivet_panic_server_rec, "%s", buf);
590 
591     abort();
592 }
593 
594 /*
595  * -- Rivet_CleanupRequest
596  *
597  * This function is meant to release memory and resorces
598  * owned by a thread.
599  * The handler in general is not guaranteed to be called
600  * within the same thread that created the resources to
601  + release. As such it's useless to release any Tcl
602  * related resorces (e.g. a Tcl_Interp* object) as
603  * any threaded build of Tcl uses its own thread private
604  * data. We leave the function as a placeholder
605  * in case we want to stuff into it something else to do.
606  *
607  *  Arguments:
608  *
609  *      request_rec*    request object pointer
610  *
611  *  Returned value:
612  *
613  *      None
614  */
615 
Rivet_CleanupRequest(request_rec * r)616 void Rivet_CleanupRequest( request_rec *r )
617 {
618 }
619 
620 /*
621  * -- Rivet_InitServerVariables
622  *
623  * Setup an array in each interpreter to tell us things about Apache.
624  * This saves us from having to do any real call to load an entire
625  * environment.  This routine only gets called once, when the child process
626  * is created.
627  *
628  *  Arguments:
629  *
630  *      Tcl_Interp* interp: pointer to the Tcl interpreter
631  *      apr_pool_t* pool: pool used for calling Apache framework functions
632  *
633  * Returned value:
634  *      none
635  *
636  * Side effects:
637  *
638  *      within the global scope of the interpreter passed as first
639  *      argument a 'server' array is created and the variable associated
640  *      to the following keys are defined
641  *
642  *          SERVER_ROOT - Apache's root location
643  *          SERVER_CONF - Apache's configuration file
644  *          RIVET_DIR   - Rivet's Tcl source directory
645  *          RIVET_INIT  - Rivet's init.tcl file
646  *          RIVET_VERSION - Rivet version (only when RIVET_DISPLAY_VERSION is 1)
647  *          MPM_THREADED - It should contain the string 'unsupported' for a prefork MPM
648  *          MPM_FORKED - String describing the forking model of the MPM
649  *          RIVET_MPM_BRIDGE - Filename of the running MPM bridge
650  *
651  */
652 
Rivet_InitServerVariables(Tcl_Interp * interp,apr_pool_t * pool)653 void Rivet_InitServerVariables( Tcl_Interp *interp, apr_pool_t *pool )
654 {
655     int     ap_mpm_result;
656     Tcl_Obj *obj;
657 
658     obj = Tcl_NewStringObj(ap_server_root, -1);
659     Tcl_IncrRefCount(obj);
660     Tcl_SetVar2Ex(interp,
661             "server",
662             "SERVER_ROOT",
663             obj,
664             TCL_GLOBAL_ONLY);
665     Tcl_DecrRefCount(obj);
666 
667     obj = Tcl_NewStringObj(ap_server_root_relative(pool,SERVER_CONFIG_FILE), -1);
668     Tcl_IncrRefCount(obj);
669     Tcl_SetVar2Ex(interp,
670             "server",
671             "SERVER_CONF",
672             obj,
673             TCL_GLOBAL_ONLY);
674     Tcl_DecrRefCount(obj);
675 
676     obj = Tcl_NewStringObj(ap_server_root_relative(pool, RIVET_DIR), -1);
677     Tcl_IncrRefCount(obj);
678     Tcl_SetVar2Ex(interp,
679             "server",
680             "RIVET_DIR",
681             obj,
682             TCL_GLOBAL_ONLY);
683     Tcl_DecrRefCount(obj);
684 
685     obj = Tcl_NewStringObj(ap_server_root_relative(pool, RIVET_INIT), -1);
686     Tcl_IncrRefCount(obj);
687     Tcl_SetVar2Ex(interp,
688             "server",
689             "RIVET_INIT",
690             obj,
691             TCL_GLOBAL_ONLY);
692     Tcl_DecrRefCount(obj);
693 
694 #if RIVET_DISPLAY_VERSION
695     obj = Tcl_NewStringObj(RIVET_VERSION, -1);
696     Tcl_IncrRefCount(obj);
697     Tcl_SetVar2Ex(interp,
698             "server",
699             "RIVET_VERSION",
700             obj,
701             TCL_GLOBAL_ONLY);
702     Tcl_DecrRefCount(obj);
703 #endif
704 
705     if (ap_mpm_query(AP_MPMQ_IS_THREADED,&ap_mpm_result) == APR_SUCCESS)
706     {
707         switch (ap_mpm_result)
708         {
709             case AP_MPMQ_STATIC:
710                 obj = Tcl_NewStringObj("static", -1);
711                 break;
712             case AP_MPMQ_NOT_SUPPORTED:
713                 obj = Tcl_NewStringObj("unsupported", -1);
714                 break;
715             default:
716                 obj = Tcl_NewStringObj("undefined", -1);
717                 break;
718         }
719         Tcl_IncrRefCount(obj);
720         Tcl_SetVar2Ex(interp,"server","MPM_THREADED",obj,TCL_GLOBAL_ONLY);
721         Tcl_DecrRefCount(obj);
722     }
723 
724     if (ap_mpm_query(AP_MPMQ_IS_FORKED,&ap_mpm_result) == APR_SUCCESS)
725     {
726         switch (ap_mpm_result)
727         {
728             case AP_MPMQ_STATIC:
729                 obj = Tcl_NewStringObj("static", -1);
730                 break;
731             case AP_MPMQ_DYNAMIC:
732                 obj = Tcl_NewStringObj("dynamic", -1);
733                 break;
734             default:
735                 obj = Tcl_NewStringObj("undefined", -1);
736                 break;
737         }
738         Tcl_IncrRefCount(obj);
739         Tcl_SetVar2Ex(interp,"server","MPM_FORKED",obj,TCL_GLOBAL_ONLY);
740         Tcl_DecrRefCount(obj);
741     }
742 
743     obj = Tcl_NewStringObj(module_globals->rivet_mpm_bridge, -1);
744     Tcl_IncrRefCount(obj);
745     Tcl_SetVar2Ex(interp,
746             "server",
747             "RIVET_MPM_BRIDGE",
748             obj,
749             TCL_GLOBAL_ONLY);
750     Tcl_DecrRefCount(obj);
751 
752     obj = Tcl_NewStringObj(RIVET_CONFIGURE_CMD,-1);
753     Tcl_IncrRefCount(obj);
754     Tcl_SetVar2Ex(interp,
755             "server",
756             "RIVET_CONFIGURE_CMD",
757             obj,
758             TCL_GLOBAL_ONLY);
759     Tcl_DecrRefCount(obj);
760 
761 }
762 
763 /*
764  * -- Rivet_chdir_file (const char* filename)
765  *
766  * Determines the directory name from the filename argument
767  * and sets it as current working directory
768  *
769  * Argument:
770  *
771  *   const char* filename:  file name to be used for determining
772  *                          the current directory (URI style path)
773  *                          the directory name is everything comes
774  *                          before the last '/' (slash) character
775  *
776  * This snippet of code came from the mod_ruby project,
777  * which is under a BSD license.
778  */
779 
Rivet_chdir_file(const char * file)780 int Rivet_chdir_file (const char *file)
781 {
782     const char  *x;
783     int         chdir_retval = 0;
784     char        chdir_buf[HUGE_STRING_LEN];
785 
786     x = strrchr(file, '/');
787     if (x == NULL) {
788 #ifdef WIN32
789         chdir_retval = _chdir(file);
790 #else
791         chdir_retval = chdir(file);
792 #endif
793     } else if (x - file < sizeof(chdir_buf) - 1) {
794         memcpy(chdir_buf, file, x - file);
795         chdir_buf[x - file] = '\0';
796 #ifdef WIN32
797         chdir_retval = _chdir(chdir_buf);
798 #else
799         chdir_retval = chdir(chdir_buf);
800 #endif
801     }
802 
803     return chdir_retval;
804 }
805 
806