You are viewing a plain text version of this content. The canonical link for it is here.
Posted to rivet-dev@tcl.apache.org by da...@apache.org on 2001/09/19 15:12:59 UTC
cvs commit: tcl-rivet/src Makefile apache_cookie.c apache_cookie.h apache_multipart_buffer.c apache_multipart_buffer.h apache_request.c apache_request.h channel.c channel.h make.tcl mod_rivet.c mod_rivet.h parser.c parser.h tcl_commands.c tcl_commands.h
davidw 01/09/19 06:12:59
Added: . TODO
doc README.hpux TODO asf_logo.gif commands.html
directives.html documentation.html dtcl.gif
example.tcl examples.ttml help.html index.html
install.html logoLarge.gif nav.html other.html
split.tcl style.css top.html
src Makefile apache_cookie.c apache_cookie.h
apache_multipart_buffer.c apache_multipart_buffer.h
apache_request.c apache_request.h channel.c
channel.h make.tcl mod_rivet.c mod_rivet.h parser.c
parser.h tcl_commands.c tcl_commands.h
Log:
Initial commit - get stuff uploaded and available.
Revision Changes Path
1.1 tcl-rivet/TODO
Index: TODO
===================================================================
* Kill 'old style vars and use only command'.
1.1 tcl-rivet/doc/README.hpux
Index: README.hpux
===================================================================
A bit of information from Craig Huckabee (huck@nosc.mil) regarding
building mod_dtcl on HPUX:
I had to tweak the makefile to get everything to build (adding some
include and library paths and -DEAPI) Apparently that mod_dtcl_module
[this is from an error he was getting - davidw] came from one of the
steps described in the Apache documentation for installing a DSO. I
rebuilt and redid the steps and now it appears to work OK. My next
test will be using some of the tcl extensions and seeing how well they
work.
I also have to track down and beat out a linker problem with Tcl
itself. I had to add -lm to your makefile to include the math
libraries when linking against my Tcl build which is wrong. Somewhere
along the way, while building Tcl, that library isn't being linked in
correctly (at least that's what I think). Just one of the joys of
building on HP-UX I guess.
1.1 tcl-rivet/doc/TODO
Index: TODO
===================================================================
To do:
* Security review: I would like someone with security background to
thoroughly go over the code.
* Script timeouts: set limits on the length of time a script will run
before it returns or dies.
* General resource limits?
* More commands available for scripters (see PHP for examples).
* Possible configuration options: possible safe mode.
* Further internationalization (multibyte languages such as Japanese).
* Nicer logo - artists welcome!
1.1 tcl-rivet/doc/asf_logo.gif
<<Binary file>>
1.1 tcl-rivet/doc/commands.html
Index: commands.html
===================================================================
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<!-- $Id: commands.html,v 1.1 2001/09/19 13:12:58 davidw Exp $ -->
<html>
<head>
<title>mod_dtcl tcl commands</title>
<link rel="stylesheet" href="style.css">
</head>
<body>
<h2 align="center">mod_dtcl specific Tcl commands and variables</h2>
<ul>
<li>
<code><b>buffer_add <i>string</i></b></code><br>
Add text to output_buffer for later printing. Used
internally.
</li>
<li>
<code><b>hputs <i>?-error? text</i></b></code><br>
The mod_dtcl version of "puts". Outputs to the
client, instead of to stdout.
The error option permits you to send an 'error message' to the
apache log file, at the NOTICE level.
</li>
<li><code><b>var</b></code><br> These commands retrieve or
retrieve information about "CGI" variables that are passed to
the dtcl script via GET or POST operations.
</li>
<li>
<code><b>var get <i>varname</i></b></code><br> Returns the
value of variable 'varname' as a string (even if there are
multiple values).
</li>
<li>
<code><b>var list <i>varname</i></b></code><br>
Returns the value of variable 'varname' as a list, if there
are multiple values.
</li>
<li>
<code><b>var exists <i>varname</i></b></code><br>
Returns 1 if <i>varname</i> exists, 0 if it doesn't.
</li>
<li>
<code><b>var number</b></code><br>
Returns the number of variables.
</li>
<li>
<code><b>var all</b></code><br>
Return a list of variable names and values.
</li>
<li><code><b>upload</b></code><br> These commands retrieve or
retrieve information about files that have been uploaded to
the server. They replace the <code>UPLOAD</code> variable.
</li>
<li>
<code><b>upload get <i>varname</i> channel</b></code><br>
Returns a Tcl channel that can be used to access the uploaded file.
</li>
<li>
<code><b>upload get <i>varname</i> save <i>name</i></b></code><br>
Moves the uploaded file to the give name.
</li>
<li>
<code><b>upload get <i>varname</i> data</b></code><br>
Returns data uploaded to the server. This is binary clean.
</li>
<li>
<code><b>upload info <i>varname</i> exists</b></code><br>
Returns 1 if the variable exists, 0 if not.
</li>
<li>
<code><b>upload info <i>varname</i> size</b></code><br>
Returns the size of the file uploaded.
</li>
<li>
<code><b>upload info <i>varname</i> type</b></code><br>If the
Content-type is set, it is returned, otherwise, an empty
string.
</li>
<li>
<code><b>upload info <i>varname</i> filename</b></code><br>
Returns the filename on the remote host that uploaded the file.
</li>
<li>
<code><b>upload names</b></code><br> Returns the variable
names, as a list, of all the files uploaded.
</li>
<li>
<code><b>hgetvars</b></code><br> Get environmental, and Cookie
variables. This is in a seperate command so as not to make the
server do this every time you load a .ttml file. <code>ENVS</code> and
<code>COOKIES</code> are the associative arrays created. <code>ENVS</code> contains
environmental variables, and <code>COOKIES</code> contains any cookies
recieved from the client.
</li>
<li>
<code><b>include <i>filename</i></b></code><br>
Include a file without parsing it. This is the best
way to include an HTML file or any other static content.
</li>
<li>
<code><b>parse <i>filename</i></b></code><br>
"Source" a .ttml file. This is the way to include
other .ttml files.
</li>
<li>
<code><b>hflush</b></code><br>
Flush the output buffers to the client. Use this if
you want to incrementally update a page.
</li>
<li>
<code><b>headers redirect <i>uri</i></b></code><br>
Redirect from the current page to a new
URI. <b>Must</b> be done in the first block of TCL code.
</li>
<li>
<code><b>headers setcookie <i>-name cookie-name
-value cookie-value ?-expires date/time? ?-domain domain?
?-path path? ?-secure?</i></b></code><br>
This command is for setting cookies. Cookie-name is
the name of the cookie, cookie-value is the data
associated with the variable. Expires sets an
expiration date for the cookie, and must be in the
format 'DD-Mon-YY HH:MM:SS', path sets the path for
which the cookie is valid, and secure specifies that
the cookie is only to be transmitted if the connection
is secure (HTTPS).
</li>
<li>
<code><b>headers type
<i>content-type</i></b></code><br>
This command sets the "Content-type:" header returned
by the script, which is useful if you wish to create a
PNG (image), for example, with mod_dtcl.
</li>
<li>
<code><b>headers set <i>headername value</i></b></code><br>
Set arbitrary header names and values.
</li>
<li>
<code><b>dtcl_info</b></code><br>
Prints information on the internals of the module in
HTML. Currently, only the PID and size of the object
cache are reported.
</li>
<!--
<li>
Note that these variables may be lists if more than one file
is uploaded at a time.<br>
<code><b>$::request::UPLOAD(filename)</b></code><br>
The filename of the uploaded file.<br>
<code><b>$::request::UPLOAD(name)</b></code><br>
The form variable name of the upload.<br>
<code><b>$::request::UPLOAD(size)</b></code><br>
The size of the uploaded file.<br>
<code><b>$::request::UPLOAD(type)</b></code><br>
The content type of the file upload. <i>Not always available!</i><br>
<code><b>$::request::UPLOAD(channelname)</b></code><br> The
name of a Tcl channel which may be used to manipulate the
uploaded file. If Dtcl_UploadFilesToVar is set, this
variable doesn't get created. If no file is passed to the
server, this variable does not exist! Be sure to check for
this.<br>
<code><b>$::request::UPLOAD(data)</b></code><br>
Contents of the uploaded file, if Dtcl_UploadFilesToVar is
set.<br>
</li>
-->
</ul>
</body>
</html>
1.1 tcl-rivet/doc/directives.html
Index: directives.html
===================================================================
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<!-- $Id: directives.html,v 1.1 2001/09/19 13:12:58 davidw Exp $ -->
<html>
<head>
<title>mod_dtcl Apache directives</title>
<link rel="stylesheet" href="style.css">
</head>
<body>
<h2 align="center">mod_dtcl Apache directives</h2>
<ul>
<li>
<code><b>Dtcl_Script GlobalInitScript <i>"script"</i></code></b><br>
Tcl script that is run when each interpreter is
initialized. <code>"script"</code> is actual Tcl
script, so to run a file, you would do
<code>Dtcl_Script GlobalInitScript "source /var/www/foobar.tcl"</code>.
</li>
<li>
<code><b>Dtcl_Script ChildInitScript <i>"script"</i></b></code><br>
Script to be evaluated when each apache child is
initialized. This is the best place to load modules.
</li>
<li>
<code><b>Dtcl_Script ChildExitScript <i>"script"</i></b></code><br>
Script to be evaluated when each apache child exits.
</li>
<li>
<code><b>Dtcl_Script BeforeScript <i>"script"</i></b></code><br>
Script to be evaluated before each .ttml page.
<strong>Note</strong> that you cannot use
<code>hputs</code> in the BeforeScript, but must
instead use <code>buffer_add</code>.
</li>
<li>
<code><b>Dtcl_Script AfterScript <i>"script"</i></b></code><br>
Script to be called after each .ttml page.
</li>
<li>
<code><b>Dtcl_Script ErrorScript <i>"script"</i></b></code><br>
This code is called in place of the standard 'error' pages
generated for mod_dtcl. This directive may be useful if you
have sensitive logic that you wish to protect.
</li>
<li>
<code><b>Dtcl_CacheSize <i>cachesize</i></b></code><br>
Number of ttml scripts to cache as Tcl Objects.
Default is MaxRequestsPerChild / 2, or 50, if
MaxRequestsPerChild is 0.
</li>
<li>
<code><b>Dtcl_UploadFilesToVar <i>on/off</i></b></code><br> If
on, files will be uploaded to the variable UPLOAD(data). Be
careful with this, as large files could use up your memory.
</li>
<li>
<code><b>Dtcl_SeperateVirtualInterps
<i>on/off</i></b></code><br> If on, each VirtualHost will have
its own Tcl interpreter.
</li>
</ul>
</body>
</html>
1.1 tcl-rivet/doc/documentation.html
Index: documentation.html
===================================================================
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title></title>
<link rel="stylesheet" href="style.css">
</head>
<body>
<!-- $Id: documentation.html,v 1.1 2001/09/19 13:12:58 davidw Exp $ -->
<h2 align="center">mod_dtcl Installation</h2>
<ol>
<li><b>Check dependencies</b><br>
To install mod_dtcl, you will need <b>Tcl 8.2</b> or greater
and <b>Apache 1.3.xx</b>. It is known to run on Linux,
FreeBSD, OpenBSD, and Solaris and HPUX. NT is also possible -
please see the directions in the distribution.
</li>
<li><b>Get mod_dtcl</b><br>
If you are running a Debian or FreeBSD system, there
are pre-built packages available at:
<a target="_top" href="http://www.debian.org/Packages/unstable/web/libapache-mod-dtcl.html">http://www.debian.org/Packages/unstable/web/libapache-mod-dtcl.html</a>
or
<a
target="_top" href="http://www.freebsd.org/cgi/ports.cgi?query=mod_dtcl">http://www.freebsd.org/cgi/ports.cgi?query=mod_dtcl</a>.<br>
Otherwise, download the sources at <a target="_top"
href="download/">http://tcl.apache.org/mod_dtcl/download/</a>.
<br>
</li>
<li><b>Uncompress the sources</b><br>
<code>
gunzip apache-1.3.X.tar.gz<br>
tar -xvf apache-1.3.X.tar.gz<br>
</code>
You don't need the Apache sources if you are building a shared
object module. You do, however, need the header files.
Some systems, such as Debian GNU/Linux, provide these
independently - otherwise, you probably still need the sources.<br>
<code>
gunzip mod_dtcl-X.X.X.tar.gz<br>
tar -xvf mod_dtcl-X.X.X.tar.gz<br>
</code>
</li>
<li><b>Configuring, builddtcl.sh, etc...</b><br>
Do you want to build mod_dtcl as a shared object (such as a
.so file on Linux, or a .dll on windows), or compile it
directly as a part of the Apache executable? The Apache
Software Foundation has put together a nice <a target="_top"
href="http://httpd.apache.org/docs/dso.html">manual</a> which
explains things in detail.
<ul>
<li><b>For shared objects</b><br>
<code>cd ../mod_dtcl/<br></code>
Edit the <code>builddtcl.sh</code> script. The 3
variables you may need to change are:
<ul>
<li><code>TCLSH</code><br>
Name of the tclsh program on your computer.
</li>
<li><code>APACHE</code><br>
Location of the Apache sources (for static builds only).
</li>
<li><code>INC</code><br>
Location of the Apache headers (you will need this even
for building shared objects).
</li>
</ul>
<code>
./builddtcl.sh shared
</code><br>
<code>
cp mod_dtcl.so
/usr/lib/apache/wherever/the/other/shared/objects/reside
</code> For shared object builds, you need to copy the
object into the directory where the other shared
objects are kept for your Apache build. On Debian
GNU/Linux systems, for instance, this is in
<code>/usr/lib/apache/1.3/</code>.
</li>
<li><b>For static builds</b><br>
<code>
cd apache-1.3.X/<br>
./configure<br>
</code>
<code>cd ../mod_dtcl/<br></code>
Edit the <code>builddtcl.sh</code> script. The 3
variables you may need to change are:
<ul>
<li><code>TCLSH</code><br>
Name of the tclsh program on your computer.
</li>
<li><code>APACHE</code><br>
Location of the Apache sources (for static builds only).
</li>
<li><code>INC</code><br>
Location of the Apache headers (you will need this even
for building shared objects).
</li>
</ul>
<code>
./builddtcl.sh static
</code><br>
<code>
./builddtcl.sh install
</code><br>
<code>cd ../apache-1.3.X<br></code>
<code>./configure
--activate-module=src/modules/mod_dtcl/mod_dtcl.a [ other configure
options ]<br></code>
<code>export EXTRA_LIBS="-ltcl8.X -lm"</code><br>
<code>make -e<br></code>
<code>make install<br></code>
</li>
</ul>
</li>
<li><b>Configure Apache<br></b>
<ul>
<li>
<b>http.conf</b><br> <code>LoadModule dtcl_module
/usr/lib/apache/1.3/mod_dtcl.so</code><br>
This points Apache to the shared object if
mod_dtcl is being used as a loadable module.
</li>
<li>
<b>srm.conf</b><br>
<code>AddType application/x-httpd-tcl .ttml</code><br>
<code>AddType application/x-dtcl-tcl .tcl</code>
(optional)<br>
These add the .ttml and .tcl (if desired) types to
Apache, so that they are processed by mod_dtcl.
</li>
</ul>
</li>
</ol>
<h2 align="center">mod_dtcl Apache directives</h2>
<ul>
<li>
<code><b>Dtcl_Script GlobalInitScript <i>"script"</i></code></b><br>
Tcl script that is run when each interpreter is
initialized. <code>"script"</code> is actual Tcl
script, so to run a file, you would do
<code>Dtcl_Script GlobalInitScript "source /var/www/foobar.tcl"</code>.
</li>
<li>
<code><b>Dtcl_Script ChildInitScript <i>"script"</i></b></code><br>
Script to be evaluated when each apache child is
initialized. This is the best place to load modules.
</li>
<li>
<code><b>Dtcl_Script ChildExitScript <i>"script"</i></b></code><br>
Script to be evaluated when each apache child exits.
</li>
<li>
<code><b>Dtcl_Script BeforeScript <i>"script"</i></b></code><br>
Script to be evaluated before each .ttml page.
<strong>Note</strong> that you cannot use
<code>hputs</code> in the BeforeScript, but must
instead use <code>buffer_add</code>.
</li>
<li>
<code><b>Dtcl_Script AfterScript <i>"script"</i></b></code><br>
Script to be called after each .ttml page.
</li>
<li>
<code><b>Dtcl_Script ErrorScript <i>"script"</i></b></code><br>
This code is called in place of the standard 'error' pages
generated for mod_dtcl. This directive may be useful if you
have sensitive logic that you wish to protect.
</li>
<li>
<code><b>Dtcl_CacheSize <i>cachesize</i></b></code><br>
Number of ttml scripts to cache as Tcl Objects.
Default is MaxRequestsPerChild / 2, or 50, if
MaxRequestsPerChild is 0.
</li>
<li>
<code><b>Dtcl_UploadFilesToVar <i>on/off</i></b></code><br> If
on, files will be uploaded to the variable UPLOAD(data). Be
careful with this, as large files could use up your memory.
</li>
<li>
<code><b>Dtcl_SeperateVirtualInterps
<i>on/off</i></b></code><br> If on, each VirtualHost will have
its own Tcl interpreter.
</li>
</ul>
<h2 align="center">mod_dtcl specific Tcl commands and variables</h2>
<ul>
<li>
<code><b>buffer_add <i>string</i></b></code><br>
Add text to output_buffer for later printing. Used
internally.
</li>
<li>
<code><b>hputs <i>?-error? text</i></b></code><br>
The mod_dtcl version of "puts". Outputs to the
client, instead of to stdout.
The error option permits you to send an 'error message' to the
apache log file, at the NOTICE level.
</li>
<li><code><b>var</b></code><br> These commands retrieve or
retrieve information about "CGI" variables that are passed to
the dtcl script via GET or POST operations.
</li>
<li>
<code><b>var get <i>varname</i></b></code><br> Returns the
value of variable 'varname' as a string (even if there are
multiple values).
</li>
<li>
<code><b>var list <i>varname</i></b></code><br>
Returns the value of variable 'varname' as a list, if there
are multiple values.
</li>
<li>
<code><b>var exists <i>varname</i></b></code><br>
Returns 1 if <i>varname</i> exists, 0 if it doesn't.
</li>
<li>
<code><b>var number</b></code><br>
Returns the number of variables.
</li>
<li>
<code><b>var all</b></code><br>
Return a list of variable names and values.
</li>
<li><code><b>upload</b></code><br> These commands retrieve or
retrieve information about files that have been uploaded to
the server. They replace the <code>UPLOAD</code> variable.
</li>
<li>
<code><b>upload get <i>varname</i> channel</b></code><br>
Returns a Tcl channel that can be used to access the uploaded file.
</li>
<li>
<code><b>upload get <i>varname</i> save <i>name</i></b></code><br>
Moves the uploaded file to the give name.
</li>
<li>
<code><b>upload get <i>varname</i> data</b></code><br>
Returns data uploaded to the server. This is binary clean.
</li>
<li>
<code><b>upload info <i>varname</i> exists</b></code><br>
Returns 1 if the variable exists, 0 if not.
</li>
<li>
<code><b>upload info <i>varname</i> size</b></code><br>
Returns the size of the file uploaded.
</li>
<li>
<code><b>upload info <i>varname</i> type</b></code><br>If the
Content-type is set, it is returned, otherwise, an empty
string.
</li>
<li>
<code><b>upload info <i>varname</i> filename</b></code><br>
Returns the filename on the remote host that uploaded the file.
</li>
<li>
<code><b>upload names</b></code><br> Returns the variable
names, as a list, of all the files uploaded.
</li>
<li>
<code><b>hgetvars</b></code><br> Get environmental, and Cookie
variables. This is in a seperate command so as not to make the
server do this every time you load a .ttml file. <code>ENVS</code> and
<code>COOKIES</code> are the associative arrays created. <code>ENVS</code> contains
environmental variables, and <code>COOKIES</code> contains any cookies
recieved from the client.
</li>
<li>
<code><b>include <i>filename</i></b></code><br>
Include a file without parsing it. This is the best
way to include an HTML file or any other static content.
</li>
<li>
<code><b>parse <i>filename</i></b></code><br>
"Source" a .ttml file. This is the way to include
other .ttml files.
</li>
<li>
<code><b>hflush</b></code><br>
Flush the output buffers to the client. Use this if
you want to incrementally update a page.
</li>
<li>
<code><b>headers redirect <i>uri</i></b></code><br>
Redirect from the current page to a new
URI. <b>Must</b> be done in the first block of TCL code.
</li>
<li>
<code><b>headers setcookie <i>-name cookie-name
-value cookie-value ?-expires date/time? ?-domain domain?
?-path path? ?-secure?</i></b></code><br>
This command is for setting cookies. Cookie-name is
the name of the cookie, cookie-value is the data
associated with the variable. Expires sets an
expiration date for the cookie, and must be in the
format 'DD-Mon-YY HH:MM:SS', path sets the path for
which the cookie is valid, and secure specifies that
the cookie is only to be transmitted if the connection
is secure (HTTPS).
</li>
<li>
<code><b>headers type
<i>content-type</i></b></code><br>
This command sets the "Content-type:" header returned
by the script, which is useful if you wish to create a
PNG (image), for example, with mod_dtcl.
</li>
<li>
<code><b>headers set <i>headername value</i></b></code><br>
Set arbitrary header names and values.
</li>
<li>
<code><b>dtcl_info</b></code><br>
Prints information on the internals of the module in
HTML. Currently, only the PID and size of the object
cache are reported.
</li>
<!--
<li>
Note that these variables may be lists if more than one file
is uploaded at a time.<br>
<code><b>$::request::UPLOAD(filename)</b></code><br>
The filename of the uploaded file.<br>
<code><b>$::request::UPLOAD(name)</b></code><br>
The form variable name of the upload.<br>
<code><b>$::request::UPLOAD(size)</b></code><br>
The size of the uploaded file.<br>
<code><b>$::request::UPLOAD(type)</b></code><br>
The content type of the file upload. <i>Not always available!</i><br>
<code><b>$::request::UPLOAD(channelname)</b></code><br> The
name of a Tcl channel which may be used to manipulate the
uploaded file. If Dtcl_UploadFilesToVar is set, this
variable doesn't get created. If no file is passed to the
server, this variable does not exist! Be sure to check for
this.<br>
<code><b>$::request::UPLOAD(data)</b></code><br>
Contents of the uploaded file, if Dtcl_UploadFilesToVar is
set.<br>
</li>
-->
</ul>
<h2>Other mod_dtcl Documentation</h2>
<h3>Internals</h3>
<ul>
<li><b>Read the code!</b></li>
<li>
<b>Initialization</b><br>
When Apache is started, (or when child Apache
processes are started if a threaded Tcl is used),
<code>tcl_init_stuff</code> is called, which creates
a new interpreter, and initializes various things,
like the <code>apache_channel</code> channel system.
The caching system is also set up, and if there is a
GlobalScript, it is run.
</li>
<li><b>Achan/apache_channel</b><br>
The "Apache Channel" system was created so that it is
possible to have an actual Tcl channel that we could
redirect standard output to. This lets us use, for
instance, the regular "puts" command in .ttml pages.
It works by creating commands that write to memory
that is slated to be sent to the client.
</li>
<li><b>Page parsing/execution</b><br>
In <code>send_parsed_file</code> Each .ttml file is
loaded and run within its own namespace. No new
interpreter is created for each page. This lets you
share variables, and most importantly, loaded modules,
from a common parent (such as one of the InitScripts).
When a file is loaded, it is transformed into a Tcl
script by putting everything outside of <? and
?> into large hputs statements. When the script is
complete, it is then inserted into the cache, for
future use. In fact, if the file modification
information doesn't change, mod_dtcl will execute the
cached version of the script the next time it is
encountered.
</li>
<li><b>Binary data</b><br>
mod_dtcl is capable of outputing binary data, such as
images, or loading binary data with 'include'.
</li>
</ul>
<h3>Upgrading From Older (< 0.9.3) Versions</h3>
<ul>
<li><b>New tags</b><br> As of version 0.9.4, mod_dtcl uses
<? and ?> instead of <+ and +> to delimit
sections of Tcl code. By default, dtcl is still compiled
with code to parse the <? ?> tags, but it will run
faster if <code>USE_OLD_TAGS</code> is set to 0 in
<code>mod_dtcl.h</code>. You can automatically change your
.ttml files to the new format by using the
<code>newtags.sh</code> script in the contrib/ directory.
Run it at the top level of your DocumentRoot.
</li>
<li><b>headers setcookie</b><br>
The <code>headers setcookie</code> command now uses the
<code>-name</code> and <code>-value</code> flags for those
arguments, whereas this was not necessary in the past.
</li>
</ul>
</body>
</html>
1.1 tcl-rivet/doc/dtcl.gif
<<Binary file>>
1.1 tcl-rivet/doc/example.tcl
Index: example.tcl
===================================================================
# we have complete access to the interpreter here, so it is best to
# run per-page code in a namespace, just like we do with .ttml pages.
proc getcode { filename } {
set fl [ open $filename r ]
set sourcecode [ read $fl ]
close $fl
regsub -all "&" "$sourcecode" "\\&" sourcecode
regsub -all "<" "$sourcecode" "\\<" sourcecode
regsub -all ">" "$sourcecode" "\\>" sourcecode
return $sourcecode
}
if { ! [ info exists header ] } {
set header {
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>.tcl example</title>
</head>
<body bgcolor="#ffffff">
}
}
if { ! [ info exists footer ] } {
set footer {
</body>
</html>
}
}
namespace eval request {
hgetvars
hputs $header
hputs {
<p>This is an example of a .tcl file being processed in mod_dtcl</p>
<p>Here is the source code:</p>
<hr>
<pre>
}
hputs [ getcode $ENVS(SCRIPT_FILENAME) ]
hputs {
</pre>
<hr>
}
hputs $footer
}
1.1 tcl-rivet/doc/examples.ttml
Index: examples.ttml
===================================================================
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 3.0//EN">
<html>
<!-- $Id: examples.ttml,v 1.1 2001/09/19 13:12:58 davidw Exp $ -->
<title>mod_dtcl examples</title>
<body bgcolor=white>
<table bgcolor=black width=100%>
<tr>
<td align=center>
<font size=40 color=#ffffff>
<b>mod_dtcl examples</b>
</font>
</td>
</tr>
</table>
<p>
These are some examples, rather limited ones, of what can be done with mod_dtcl.
<p>
<table>
<tr><td><hr><b>Hello world</b></td></tr>
<tr><td bgcolor=gray><pre>
<?
headers setcookie "foo" "bar" # we have to put this before any 'hputs' statements
# once buffering is switched off, it is no longer possible to
# maninuplate headers
buffered off
hputs "Hello world"
?>
</pre>
</td></tr>
<tr><td>
Produces:
<p>
<?
headers setcookie "foo" "bar"
# once buffering is switched off, it is no longer possible to
# maninuplate headers
buffered off
hputs "hello world"
?>
<p>
</td></tr>
<tr><td><hr>
<b>Conditionals:</b>
</td></tr>
<tr><td bgcolor=gray><pre>
<? if { 1 } { ?>
<h2> True </h2>
<? } ?>
</td></tr></pre>
<tr><td>
Produces:
<p>
<? if { 1 } { ?>
<h2> True </h2>
<? } ?>
</td></tr>
<tr><td><hr><b>Loops:</b>
</td></tr>
<tr><td bgcolor=gray><pre>
<?
set x 0
while { $x < 5 } {
hputs "\$x = $x<br>"
incr x
?>
LOOP<br>
<? } ?>
</pre>
</td></tr>
<tr><td>Produces:<p>
<?
set x 0
while { $x < 5 } {
hputs "\$x = $x<br>"
incr x
?>
LOOP<BR>
<? } ?>
</td></tr>
<tr><td><hr><b>Variables (environmental as well as those passed to the script)</b><p>
</td></tr>
<tr><td bgcolor=gray><pre>
<?
hgetvars
if { [ array exists VARS ] } {
hputs "< ul>"
foreach { vr } [ array names VARS ] {
hputs "<li>(VARS) $vr = $VARS($vr)"
}
hputs "</ul>"
}
if { [ array exists ENVS ] } {
hputs "<ul>"
foreach { vr } [ array names ENVS ] {
hputs "<li>(ENVS) $vr = $ENVS($vr)"
}
hputs "</ul>"
}
if { [ array exists COOKIES ] } {
hputs "<ul>"
foreach { vr } [ array names COOKIES ] {
hputs "<li>(COOKIES) $vr = $COOKIES($vr)"
}
hputs "</ul>"
}
?>
</pre>
</td></tr>
<tr><td>Produces:<p>
<?
hgetvars
if { [ array exists VARS ] } {
hputs "<ul>"
foreach { vr } [ array names VARS ] {
hputs "<li>(VARS) $vr = $VARS($vr)"
}
hputs "</ul>"
}
if { [ array exists ENVS ] } {
hputs "<ul>"
foreach { vr } [ array names ENVS ] {
hputs "<li>(ENVS) $vr = $ENVS($vr)"
}
hputs "</ul>"
}
if { [ array exists COOKIES ] } {
hputs "<ul>"
foreach { vr } [ array names COOKIES ] {
hputs "<li>(COOKIES) $vr = $COOKIES($vr)"
}
hputs "</ul>"
}
?>
</td></tr>
<tr><td><hr><b>Create a table on the fly</b><p>
</td></tr>
<tr><td bgcolor=gray><pre>
<?
set i 1
hputs "<table>\n"
while { $i <= 8 } {
hputs "<tr>\n"
for {set j 1} {$j <= 8} {incr j} {
set num [ expr $i * $j * 4 - 1]
hputs [ format "<td bgcolor=%2x%2x%2x > $num $num $num </td>\n" $num $num $num ]
}
incr i
hputs "</tr>\n"
}
hputs "</table>\n"
?>
</pre>
</td></tr>
<tr><td>Produces:<p>
<?
set i 1
hputs "<table>\n"
while { $i <= 8 } {
hputs "<tr>\n"
for {set j 1} {$j <= 8} {incr j} {
set num [ expr {$i * $j * 4 - 1} ]
hputs [ format "<td bgcolor=%2x%2x%2x > $num $num $num </td>\n" $num $num $num ]
}
incr i
hputs "</tr>\n"
}
hputs "</table>\n"
?>
</td></tr>
<tr><td><hr> <b>In addition</b><br>
There are many, many other things you can do with mod_dtcl. You can,
if everything is compiled right, load tcl modules, like libpgtcl.so
(the Postgresql interface), so that you can interact with a database!
<p>
</td></tr>
</table>
<? dtcl_info ?>
<p>
<a href="index.ttml">Return to the mod_dtcl homepage</a>
</p>
</body>
</html>
1.1 tcl-rivet/doc/help.html
Index: help.html
===================================================================
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>miscellaneous mod_dtcl documentation</title>
<link rel="stylesheet" href="style.css">
</head>
<body>
<h2>Where to get help with mod_dtcl</h2>
<ul>
<li><b>Mailing list</b><br>
<p>
The mod_dtcl mailing list is the best place to go for help
when you have problems.
</p>
<p>
<a
href="mailto:mod_dtcl@tcl.apache.org">mod_dtcl@tcl.apache.org</a>
is the mailing list address.
<p>To subscribe to the mailing list, send an empty email
to <a
href="mailto:mod_dtcl-subscribe@tcl.apache.org">mod_dtcl-subscribe@tcl.apache.org</a>.</p>
</p>
<p>
Currently, lists are not archived. If you'd like to help
out, let us know.
</p>
</li>
</ul>
</body>
</html>
<!-- $Id: help.html,v 1.1 2001/09/19 13:12:58 davidw Exp $ -->
1.1 tcl-rivet/doc/index.html
Index: index.html
===================================================================
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN">
<html>
<head>
<title>mod_dtcl documentation</title>
<link rel="stylesheet" href="style.css">
</head>
<frameset rows="80,*">
<frame frameborder=0 src="top.html">
<frameset cols="120,*">
<frame frameborder=0 src="nav.html">
<frame frameborder=0 name="right" src="commands.html">
</frameset>
</frameset>
</html>
<!-- $Id: index.html,v 1.1 2001/09/19 13:12:58 davidw Exp $ -->
1.1 tcl-rivet/doc/install.html
Index: install.html
===================================================================
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>mod_dtcl installation</title>
<link rel="stylesheet" href="style.css">
</head>
<body>
<!-- $Id: install.html,v 1.1 2001/09/19 13:12:58 davidw Exp $ -->
<h2 align="center">mod_dtcl Installation</h2>
<ol>
<li><b>Check dependencies</b><br>
To install mod_dtcl, you will need <b>Tcl 8.2</b> or greater
and <b>Apache 1.3.xx</b>. It is known to run on Linux,
FreeBSD, OpenBSD, and Solaris and HPUX. NT is also possible -
please see the directions in the distribution.
</li>
<li><b>Get mod_dtcl</b><br>
If you are running a Debian or FreeBSD system, there
are pre-built packages available at:
<a target="_top" href="http://www.debian.org/Packages/unstable/web/libapache-mod-dtcl.html">http://www.debian.org/Packages/unstable/web/libapache-mod-dtcl.html</a>
or
<a
target="_top" href="http://www.freebsd.org/cgi/ports.cgi?query=mod_dtcl">http://www.freebsd.org/cgi/ports.cgi?query=mod_dtcl</a>.<br>
Otherwise, download the sources at <a target="_top"
href="download/">http://tcl.apache.org/mod_dtcl/download/</a>.
<br>
</li>
<li><b>Uncompress the sources</b><br>
<code>
gunzip apache-1.3.X.tar.gz<br>
tar -xvf apache-1.3.X.tar.gz<br>
</code>
You don't need the Apache sources if you are building a shared
object module. You do, however, need the header files.
Some systems, such as Debian GNU/Linux, provide these
independently - otherwise, you probably still need the sources.<br>
<code>
gunzip mod_dtcl-X.X.X.tar.gz<br>
tar -xvf mod_dtcl-X.X.X.tar.gz<br>
</code>
</li>
<li><b>Configuring, builddtcl.sh, etc...</b><br>
Do you want to build mod_dtcl as a shared object (such as a
.so file on Linux, or a .dll on windows), or compile it
directly as a part of the Apache executable? The Apache
Software Foundation has put together a nice <a target="_top"
href="http://httpd.apache.org/docs/dso.html">manual</a> which
explains things in detail.
<ul>
<li><b>For shared objects</b><br>
<code>cd ../mod_dtcl/<br></code>
Edit the <code>builddtcl.sh</code> script. The 3
variables you may need to change are:
<ul>
<li><code>TCLSH</code><br>
Name of the tclsh program on your computer.
</li>
<li><code>APACHE</code><br>
Location of the Apache sources (for static builds only).
</li>
<li><code>INC</code><br>
Location of the Apache headers (you will need this even
for building shared objects).
</li>
</ul>
<code>
./builddtcl.sh shared
</code><br>
<code>
cp mod_dtcl.so
/usr/lib/apache/wherever/the/other/shared/objects/reside
</code> For shared object builds, you need to copy the
object into the directory where the other shared
objects are kept for your Apache build. On Debian
GNU/Linux systems, for instance, this is in
<code>/usr/lib/apache/1.3/</code>.
</li>
<li><b>For static builds</b><br>
<code>
cd apache-1.3.X/<br>
./configure<br>
</code>
<code>cd ../mod_dtcl/<br></code>
Edit the <code>builddtcl.sh</code> script. The 3
variables you may need to change are:
<ul>
<li><code>TCLSH</code><br>
Name of the tclsh program on your computer.
</li>
<li><code>APACHE</code><br>
Location of the Apache sources (for static builds only).
</li>
<li><code>INC</code><br>
Location of the Apache headers (you will need this even
for building shared objects).
</li>
</ul>
<code>
./builddtcl.sh static
</code><br>
<code>
./builddtcl.sh install
</code><br>
<code>cd ../apache-1.3.X<br></code>
<code>./configure
--activate-module=src/modules/mod_dtcl/mod_dtcl.a [ other configure
options ]<br></code>
<code>export EXTRA_LIBS="-ltcl8.X -lm"</code><br>
<code>make -e<br></code>
<code>make install<br></code>
</li>
</ul>
</li>
<li><b>Configure Apache<br></b>
<ul>
<li>
<b>http.conf</b><br> <code>LoadModule dtcl_module
/usr/lib/apache/1.3/mod_dtcl.so</code><br>
This points Apache to the shared object if
mod_dtcl is being used as a loadable module.
</li>
<li>
<b>srm.conf</b><br>
<code>AddType application/x-httpd-tcl .ttml</code><br>
<code>AddType application/x-dtcl-tcl .tcl</code>
(optional)<br>
These add the .ttml and .tcl (if desired) types to
Apache, so that they are processed by mod_dtcl.
</li>
</ul>
</li>
</ol>
</body>
</html>
1.1 tcl-rivet/doc/logoLarge.gif
<<Binary file>>
1.1 tcl-rivet/doc/nav.html
Index: nav.html
===================================================================
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title></title>
<link rel="stylesheet" href="style.css">
<style type="text/css">
div.box {
border: solid;
border-width: medium;
border-color: #cc3300;
padding: 0.25em;
}
</style>
</head>
<body>
<div class="box">
<table>
<tbody>
<tr>
<td>
<a target="right" href="install.html">Installation</a>
</td>
</tr>
<tr>
<td>
<a target="right" href="directives.html">Apache Directives</a>
</td>
</tr>
<tr>
<td><a target="right" href="commands.html">Dtcl Tcl
commands</a></td>
</tr>
<tr>
<td><a target="right" href="other.html">Other</a></td>
</tr>
<tr>
<td><a target="right" href="help.html">Getting Help</a></td>
</tr>
<tr>
<td><a target="_top" href="http://tcl.apache.org/mod_dtcl/">mod_dtcl
web site</a></td>
</tr>
<tr>
<td><a target="_top" href="http://tcl.activestate.com/">Tcl
web site</a></td>
</tr>
<tr>
<td><a target="_top"
href="http://www.apache.org/">Apache web site</a></td>
</tr>
</tbody>
</table>
</div>
</body>
</html>
1.1 tcl-rivet/doc/other.html
Index: other.html
===================================================================
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>miscellaneous mod_dtcl documentation</title>
<link rel="stylesheet" href="style.css">
</head>
<body>
<h2>Other mod_dtcl Documentation</h2>
<h3>Internals</h3>
<ul>
<li><b>Read the code!</b></li>
<li>
<b>Initialization</b><br>
When Apache is started, (or when child Apache
processes are started if a threaded Tcl is used),
<code>tcl_init_stuff</code> is called, which creates
a new interpreter, and initializes various things,
like the <code>apache_channel</code> channel system.
The caching system is also set up, and if there is a
GlobalScript, it is run.
</li>
<li><b>Achan/apache_channel</b><br>
The "Apache Channel" system was created so that it is
possible to have an actual Tcl channel that we could
redirect standard output to. This lets us use, for
instance, the regular "puts" command in .ttml pages.
It works by creating commands that write to memory
that is slated to be sent to the client.
</li>
<li><b>Page parsing/execution</b><br>
In <code>send_parsed_file</code> Each .ttml file is
loaded and run within its own namespace. No new
interpreter is created for each page. This lets you
share variables, and most importantly, loaded modules,
from a common parent (such as one of the InitScripts).
When a file is loaded, it is transformed into a Tcl
script by putting everything outside of <? and
?> into large hputs statements. When the script is
complete, it is then inserted into the cache, for
future use. In fact, if the file modification
information doesn't change, mod_dtcl will execute the
cached version of the script the next time it is
encountered.
</li>
<li><b>Binary data</b><br>
mod_dtcl is capable of outputing binary data, such as
images, or loading binary data with 'include'.
</li>
</ul>
<h3>Upgrading From Older (< 0.9.3) Versions</h3>
<ul>
<li><b>New tags</b><br> As of version 0.9.4, mod_dtcl uses
<? and ?> instead of <+ and +> to delimit
sections of Tcl code. By default, dtcl is still compiled
with code to parse the <? ?> tags, but it will run
faster if <code>USE_OLD_TAGS</code> is set to 0 in
<code>mod_dtcl.h</code>. You can automatically change your
.ttml files to the new format by using the
<code>newtags.sh</code> script in the contrib/ directory.
Run it at the top level of your DocumentRoot.
</li>
<li><b>headers setcookie</b><br>
The <code>headers setcookie</code> command now uses the
<code>-name</code> and <code>-value</code> flags for those
arguments, whereas this was not necessary in the past.
</li>
</ul>
</body>
</html>
<!-- $Id: other.html,v 1.1 2001/09/19 13:12:58 davidw Exp $ -->
1.1 tcl-rivet/doc/split.tcl
Index: split.tcl
===================================================================
# Simple routine that takes files and spits out everything inside the
# <body></body> tags.
proc main { } {
global argv
puts {
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title></title>
<link rel="stylesheet" href="style.css">
</head>
<body>
}
foreach fl $argv {
set ofl [ open $fl r ]
set dump [ read $ofl ]
set lines [ split $dump "\n" ]
set inbody 0
foreach ln $lines {
if { [ string first "<body>" $ln ] != -1 } {
set inbody 1
} elseif { [ string first "</body>" $ln ] != -1 } {
set inbody 0
} else {
if { $inbody == 1 } { puts $ln }
}
}
}
puts {
</body>
</html>
}
}
main
1.1 tcl-rivet/doc/style.css
Index: style.css
===================================================================
body {
font-family: Arial, sans-serif;
font-style: normal;
color: #000000;
background-color: #FFFFFF;
}
A:link { color: #cc3300 }
A:visited { color : #003399; }
A:hover { color : #000000 ; background-color : #aaaaaa }
h1 {
font-family: Arial, sans-serif;
color: #000000;
}
h2 {
font-family: Arial, sans-serif;
}
h3 {
font-family: Arial, sans-serif;
}
b {
font-weight: bold;
}
td {
font-family: Arial, sans-serif;
color: #000000;
padding: 0.25em;
}
code {
color: #006600;
}
div.box {
border-width: medium;
padding: 0.25em;
background-color: #dddddd;
}
li {
}
1.1 tcl-rivet/doc/top.html
Index: top.html
===================================================================
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title></title>
<link rel="stylesheet" href="style.css">
<style type="text/css">
body {
color: #cc3300;
background-color: #003399;
}
h1 { color: #cc3300 }
</style>
</head>
<body>
<h1 align="center">mod_dtcl documentation</h1>
</body>
</html>
1.1 tcl-rivet/src/Makefile
Index: Makefile
===================================================================
# $Id: Makefile,v 1.1 2001/09/19 13:12:58 davidw Exp $
# Changed to use the Tcl variables from tclConfig.sh
# You may have to change these if 'builddtcl.sh' and 'findconfig.tcl'
# don't work.
# You must change the following line unless you have the Debian
# apache-dev package
INC=$(INCLUDES) -I$(TCL_PREFIX)/include
STATICLIB=mod_rivet.a
SHLIB=mod_rivet$(TCL_SHLIB_SUFFIX)
APREQ_OBJECTS=apache_cookie.o apache_multipart_buffer.o apache_request.o
OBJECTS=mod_rivet.o tcl_commands.o parser.o channel.o $(APREQ_OBJECTS)
# The following TCL_* variables are all exported from builddtcl.sh
COMPILE=$(TCL_CC) $(TCL_CFLAGS_DEBUG) $(TCL_CFLAGS_OPTIMIZE) $(TCL_CFLAGS_WARNING) $(TCL_SHLIB_CFLAGS) -c $(INC) $(CFLAGS) $(TCL_EXTRA_CFLAGS) $(EXTRA_FLAGS) $<
all: builddtcl_test shared
static: $(OBJECTS) docs/documentation.html
$(TCL_STLIB_LD) $(STATICLIB) $(OBJECTS)
shared: $(OBJECTS) docs/documentation.html
$(TCL_SHLIB_LD) -o $(SHLIB) $(OBJECTS) $(TCL_LIB_SPEC) $(TCL_LIBS)
# I don't have too many C files, so it's just clearer to do things by
# hand
apache_cookie.o: apache_cookie.c apache_cookie.h
$(COMPILE)
apache_multipart_buffer.o: apache_multipart_buffer.c apache_multipart_buffer.h
$(COMPILE)
apache_request.o: apache_request.c apache_request.h
$(COMPILE)
mod_rivet.o: mod_rivet.c mod_rivet.h tcl_commands.h apache_request.h parser.h parser.h
$(COMPILE) -DDTCL_VERSION=`cat VERSION`
tcl_commands.o: tcl_commands.c tcl_commands.h mod_rivet.h
$(COMPILE)
parser.o: parser.c mod_rivet.h parser.h
$(COMPILE)
channel.o: channel.c mod_rivet.h channel.h
$(COMPILE)
clean:
-rm -f $(STATICLIB) $(SHLIB) *.o *~ docs/documentation.txt docs/documentation.html
version:
./cvsversion.tcl
docs/documentation.html:
$(TCLSH) ./docs/split.tcl docs/install.html docs/directives.html docs/commands.html docs/other.html > docs/documentation.html
docs/documentation.txt: docs/documentation.html
if test -x `which html2text` ; then html2text ./docs/documentation.html > ./docs/documentation.txt ; else echo "You need html2text to create documentation.txt from documentation.html" ; fi
dist: clean docs/documentation.txt version
(cd .. ; tar -czvf mod_rivet-`cat mod_rivet/VERSION`.tar.gz mod_rivet/ ; )
install: static
-mkdir $(APACHE)src/modules/mod_rivet/
cp $(STATICLIB) $(APACHE)src/modules/mod_rivet/
cp Makefile.dummy $(APACHE)src/modules/mod_rivet/Makefile
# This forces mod_rivet to be built with the shell script, so please
# comment it out if you need to.
.SILENT: builddtcl_test
builddtcl_test:
if [ "$(BUILDDTCL)" != "YES" ] ; then echo "You should use builddtcl.sh to build mod_rivet"; exit 1 ; fi
1.1 tcl-rivet/src/apache_cookie.c
Index: apache_cookie.c
===================================================================
/* ====================================================================
* Copyright (c) 1995-1999 The Apache Group. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
*
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in
* the documentation and/or other materials provided with the
* distribution.
*
* 3. All advertising materials mentioning features or use of this
* software must display the following acknowledgment:
* "This product includes software developed by the Apache Group
* for use in the Apache HTTP server project (http://www.apache.org/)."
*
* 4. The names "Apache Server" and "Apache Group" must not be used to
* endorse or promote products derived from this software without
* prior written permission. For written permission, please contact
* apache@apache.org.
*
* 5. Products derived from this software may not be called "Apache"
* nor may "Apache" appear in their names without prior written
* permission of the Apache Group.
*
* 6. Redistributions of any form whatsoever must retain the following
* acknowledgment:
* "This product includes software developed by the Apache Group
* for use in the Apache HTTP server project (http://www.apache.org/)."
*
* THIS SOFTWARE IS PROVIDED BY THE APACHE GROUP ``AS IS'' AND ANY
* EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE APACHE GROUP OR
* ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
* OF THE POSSIBILITY OF SUCH DAMAGE.
* ====================================================================
*
* This software consists of voluntary contributions made by many
* individuals on behalf of the Apache Group and was originally based
* on public domain software written at the National Center for
* Supercomputing Applications, University of Illinois, Urbana-Champaign.
* For more information on the Apache Group and the Apache HTTP server
* project, please see <http://www.apache.org/>.
*
*/
#include "apache_cookie.h"
char *ApacheCookie_expires(ApacheCookie *c, char *time_str)
{
char *expires;
expires = ApacheUtil_expires(c->r->pool, time_str, EXPIRES_COOKIE);
if (expires) {
c->expires = expires;
}
return c->expires;
}
#define cookie_get_set(thing,val) \
retval = thing; \
if(val) thing = ap_pstrdup(c->r->pool, val)
char *ApacheCookie_attr(ApacheCookie *c, char *key, char *val)
{
char *retval = NULL;
int ix = key[0] == '-' ? 1 : 0;
switch (key[ix]) {
case 'n':
cookie_get_set(c->name, val);
break;
case 'v':
ApacheCookieAdd(c, val);
break;
case 'e':
retval = ApacheCookie_expires(c, val);
break;
case 'd':
cookie_get_set(c->domain, val);
break;
case 'p':
cookie_get_set(c->path, val);
break;
case 's':
if(val) {
c->secure =
!strcaseEQ(val, "off") &&
!strcaseEQ(val, "0");
}
retval = c->secure ? "on" : "";
break;
default:
ap_log_rerror(APC_ERROR,
"[libapreq] unknown cookie pair: `%s' => `%s'", key, val);
};
return retval;
}
ApacheCookie *ApacheCookie_new(request_rec *r, ...)
{
va_list args;
ApacheRequest req;
ApacheCookie *c =
ap_pcalloc(r->pool, sizeof(ApacheCookie));
req.r = r;
c->r = r;
c->values = ap_make_array(r->pool, 1, sizeof(char *));
c->secure = 0;
c->name = c->expires = NULL;
c->domain = NULL;
c->path = ApacheRequest_script_path(&req);
va_start(args, r);
for(;;) {
char *key, *val;
key = va_arg(args, char *);
if (key == NULL) {
break;
}
val = va_arg(args, char *);
(void)ApacheCookie_attr(c, key, val);
}
va_end(args);
return c;
}
ApacheCookieJar *ApacheCookie_parse(request_rec *r, const char *data)
{
const char *pair;
ApacheCookieJar *retval =
ap_make_array(r->pool, 1, sizeof(ApacheCookie *));
if (!data) {
if (!(data = ap_table_get(r->headers_in, "Cookie"))) {
return retval;
}
}
while (*data && (pair = ap_getword(r->pool, &data, ';'))) {
const char *key, *val;
ApacheCookie *c;
while (ap_isspace(*data)) {
++data;
}
key = ap_getword(r->pool, &pair, '=');
ap_unescape_url((char *)key);
c = ApacheCookie_new(r, "-name", key, NULL);
if (c->values) {
c->values->nelts = 0;
}
else {
c->values = ap_make_array(r->pool, 4, sizeof(char *));
}
if (!*pair) {
ApacheCookieAdd(c, "");
}
while (*pair && (val = ap_getword(r->pool, &pair, '&'))) {
ap_unescape_url((char *)val);
ApacheCookieAdd(c, val);
}
ApacheCookieJarAdd(retval, c);
}
return retval;
}
#define cookie_push_arr(arr, val) \
*(char **)ap_push_array(arr) = (char *)val
#define cookie_push_named(arr, name, val) \
if(val) { \
cookie_push_arr(arr, ap_pstrcat(p, name, "=", val, NULL)); \
}
static char * escape_url(pool *p, char *val)
{
char *result = ap_os_escape_path(p, val?val:"", 1);
char *end = result + strlen(result);
char *seek;
for ( seek = end-1; seek >= result; --seek) {
char *ptr, *replacement;
switch (*seek) {
case '&':
replacement = "%26";
break;
case '=':
replacement = "%3d";
break;
/* additional cases here */
default:
continue; /* next for() */
}
for (ptr = end; ptr > seek; --ptr) {
ptr[2] = ptr[0];
}
strncpy(seek, replacement, 3);
end += 2;
}
return(result);
}
char *ApacheCookie_as_string(ApacheCookie *c)
{
array_header *values;
pool *p = c->r->pool;
char *cookie, *retval;
int i;
if (!c->name) {
return "";
}
values = ap_make_array(p, 6, sizeof(char *));
cookie_push_named(values, "domain", c->domain);
cookie_push_named(values, "path", c->path);
cookie_push_named(values, "expires", c->expires);
if (c->secure) {
cookie_push_arr(values, "secure");
}
cookie = ap_pstrcat(p, escape_url(p, c->name), "=", NULL);
for (i=0; i<c->values->nelts; i++) {
cookie = ap_pstrcat(p, cookie,
escape_url(p, ((char**)c->values->elts)[i]),
(i < (c->values->nelts-1) ? "&" : NULL),
NULL);
}
retval = cookie;
for (i=0; i<values->nelts; i++) {
retval = ap_pstrcat(p, retval, "; ",
((char**)values->elts)[i], NULL);
}
return retval;
}
void ApacheCookie_bake(ApacheCookie *c)
{
ap_table_add(c->r->err_headers_out, "Set-Cookie",
ApacheCookie_as_string(c));
}
1.1 tcl-rivet/src/apache_cookie.h
Index: apache_cookie.h
===================================================================
#include "apache_request.h"
typedef array_header ApacheCookieJar;
typedef struct {
request_rec *r;
char *name;
array_header *values;
char *domain;
char *expires;
char *path;
int secure;
} ApacheCookie;
#define ApacheCookieJarItems(arr) arr->nelts
#define ApacheCookieJarFetch(arr,i) \
((ApacheCookie *)(((ApacheCookie **)arr->elts)[i]))
#define ApacheCookieJarAdd(arr,c) \
*(ApacheCookie **)ap_push_array(arr) = c
#define ApacheCookieItems(c) c->values->nelts
#define ApacheCookieFetch(c,i) \
((char *)(((char **)c->values->elts)[i]))
#define ApacheCookieAddn(c,val) \
if(val) *(char **)ap_push_array(c->values) = (char *)val
#define ApacheCookieAdd(c,val) \
ApacheCookieAddn(c, ap_pstrdup(c->r->pool, val))
#define ApacheCookieAddLen(c,val,len) \
ApacheCookieAddn(c, ap_pstrndup(c->r->pool, val, len))
ApacheCookie *ApacheCookie_new(request_rec *r, ...);
ApacheCookieJar *ApacheCookie_parse(request_rec *r, const char *data);
char *ApacheCookie_as_string(ApacheCookie *c);
char *ApacheCookie_attr(ApacheCookie *c, char *key, char *val);
char *ApacheCookie_expires(ApacheCookie *c, char *time_str);
void ApacheCookie_bake(ApacheCookie *c);
#define APC_ERROR APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, c->r
1.1 tcl-rivet/src/apache_multipart_buffer.c
Index: apache_multipart_buffer.c
===================================================================
/* ====================================================================
* Copyright (c) 1995-1999 The Apache Group. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
*
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in
* the documentation and/or other materials provided with the
* distribution.
*
* 3. All advertising materials mentioning features or use of this
* software must display the following acknowledgment:
* "This product includes software developed by the Apache Group
* for use in the Apache HTTP server project (http://www.apache.org/)."
*
* 4. The names "Apache Server" and "Apache Group" must not be used to
* endorse or promote products derived from this software without
* prior written permission. For written permission, please contact
* apache@apache.org.
*
* 5. Products derived from this software may not be called "Apache"
* nor may "Apache" appear in their names without prior written
* permission of the Apache Group.
*
* 6. Redistributions of any form whatsoever must retain the following
* acknowledgment:
* "This product includes software developed by the Apache Group
* for use in the Apache HTTP server project (http://www.apache.org/)."
*
* THIS SOFTWARE IS PROVIDED BY THE APACHE GROUP ``AS IS'' AND ANY
* EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE APACHE GROUP OR
* ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
* OF THE POSSIBILITY OF SUCH DAMAGE.
* ====================================================================
*
* This software consists of voluntary contributions made by many
* individuals on behalf of the Apache Group and was originally based
* on public domain software written at the National Center for
* Supercomputing Applications, University of Illinois, Urbana-Champaign.
* For more information on the Apache Group and the Apache HTTP server
* project, please see <http://www.apache.org/>.
*
*/
#include "apache_multipart_buffer.h"
/*********************** internal functions *********************/
/*
search for a string in a fixed-length byte string.
if partial is true, partial matches are allowed at the end of the buffer.
returns NULL if not found, or a pointer to the start of the first match.
*/
void* my_memstr(char* haystack, int haystacklen, const char* needle,
int partial)
{
int needlen = strlen(needle);
int len = haystacklen;
char *ptr = haystack;
/* iterate through first character matches */
while( (ptr = memchr(ptr, needle[0], len)) ) {
/* calculate length after match */
len = haystacklen - (ptr - (char *)haystack);
/* done if matches up to capacity of buffer */
if(memcmp(needle, ptr, needlen < len ? needlen : len) == 0 &&
(partial || len >= needlen))
break;
/* next character */
ptr++; len--;
}
return ptr;
}
/*
fill up the buffer with client data.
returns number of bytes added to buffer.
*/
int fill_buffer(multipart_buffer *self)
{
int bytes_to_read, actual_read = 0;
/* shift the existing data if necessary */
if(self->bytes_in_buffer > 0 && self->buf_begin != self->buffer)
memmove(self->buffer, self->buf_begin, self->bytes_in_buffer);
self->buf_begin = self->buffer;
/* calculate the free space in the buffer */
bytes_to_read = self->bufsize - self->bytes_in_buffer;
/* read the required number of bytes */
if(bytes_to_read > 0) {
char *buf = self->buffer + self->bytes_in_buffer;
ap_hard_timeout("[libapreq] multipart_buffer.c:fill_buffer", self->r);
actual_read = ap_get_client_block(self->r, buf, bytes_to_read);
ap_kill_timeout(self->r);
/* update the buffer length */
if(actual_read > 0)
self->bytes_in_buffer += actual_read;
}
return actual_read;
}
/*
gets the next CRLF terminated line from the input buffer.
if it doesn't find a CRLF, and the buffer isn't completely full, returns
NULL; otherwise, returns the beginning of the null-terminated line,
minus the CRLF.
note that we really just look for LF terminated lines. this works
around a bug in internet explorer for the macintosh which sends mime
boundaries that are only LF terminated when you use an image submit
button in a multipart/form-data form.
*/
char* next_line(multipart_buffer *self)
{
/* look for LF in the data */
char* line = self->buf_begin;
char* ptr = memchr(self->buf_begin, '\n', self->bytes_in_buffer);
/* LF found */
if(ptr) {
/* terminate the string, remove CRLF */
if((ptr - line) > 0 && *(ptr-1) == '\r') *(ptr-1) = 0;
else *ptr = 0;
/* bump the pointer */
self->buf_begin = ptr + 1;
self->bytes_in_buffer -= (self->buf_begin - line);
}
/* no LF found */
else {
/* buffer isn't completely full, fail */
if(self->bytes_in_buffer < self->bufsize)
return NULL;
/* return entire buffer as a partial line */
line[self->bufsize] = 0;
self->buf_begin = ptr;
self->bytes_in_buffer = 0;
}
return line;
}
/* returns the next CRLF terminated line from the client */
char* get_line(multipart_buffer *self)
{
char* ptr = next_line(self);
if(!ptr) {
fill_buffer(self);
ptr = next_line(self);
}
#ifdef DEBUG
ap_log_rerror(MPB_ERROR, "get_line: '%s'", ptr);
#endif
return ptr;
}
/* finds a boundary */
int find_boundary(multipart_buffer *self, char *boundary)
{
char *line;
/* loop thru lines */
while( (line = get_line(self)) ) {
#ifdef DEBUG
ap_log_rerror(MPB_ERROR, "find_boundary: '%s' ?= '%s'",
line, boundary);
#endif
/* finished if we found the boundary */
if(strEQ(line, boundary))
return 1;
}
/* didn't find the boundary */
return 0;
}
/*********************** external functions *********************/
/* create new multipart_buffer structure */
multipart_buffer *multipart_buffer_new(char *boundary, long length, request_rec *r)
{
multipart_buffer *self = (multipart_buffer *)
ap_pcalloc(r->pool, sizeof(multipart_buffer));
int minsize = strlen(boundary)+6;
if(minsize < FILLUNIT) minsize = FILLUNIT;
self->r = r;
self->buffer = (char *) ap_pcalloc(r->pool, minsize+1);
self->bufsize = minsize;
self->request_length = length;
self->boundary = ap_pstrcat(r->pool, "--", boundary, NULL);
self->boundary_next = ap_pstrcat(r->pool, "\n", self->boundary, NULL);
self->buf_begin = self->buffer;
self->bytes_in_buffer = 0;
return self;
}
/* parse headers and return them in an apache table */
table *multipart_buffer_headers(multipart_buffer *self)
{
table *tab;
char *line;
/* didn't find boundary, abort */
if(!find_boundary(self, self->boundary)) return NULL;
/* get lines of text, or CRLF_CRLF */
tab = ap_make_table(self->r->pool, 10);
while( (line = get_line(self)) && strlen(line) > 0 ) {
/* add header to table */
char *key = line;
char *value = strchr(line, ':');
if(value) {
*value = 0;
do { value++; } while(ap_isspace(*value));
#ifdef DEBUG
ap_log_rerror(MPB_ERROR,
"multipart_buffer_headers: '%s' = '%s'",
key, value);
#endif
ap_table_add(tab, key, value);
}
else {
#ifdef DEBUG
ap_log_rerror(MPB_ERROR,
"multipart_buffer_headers: '%s' = ''", key);
#endif
ap_table_add(tab, key, "");
}
}
return tab;
}
/* read until a boundary condition */
int multipart_buffer_read(multipart_buffer *self, char *buf, int bytes)
{
int len, max;
char *bound;
/* fill buffer if needed */
if(bytes > self->bytes_in_buffer) fill_buffer(self);
/* look for a potential boundary match, only read data up to that point */
if( (bound = my_memstr(self->buf_begin, self->bytes_in_buffer,
self->boundary_next, 1)) )
max = bound - self->buf_begin;
else
max = self->bytes_in_buffer;
/* maximum number of bytes we are reading */
len = max < bytes-1 ? max : bytes-1;
/* if we read any data... */
if(len > 0) {
/* copy the data */
memcpy(buf, self->buf_begin, len);
buf[len] = 0;
if(bound && len > 0 && buf[len-1] == '\r') buf[--len] = 0;
/* update the buffer */
self->bytes_in_buffer -= len;
self->buf_begin += len;
}
#ifdef DEBUG
ap_log_rerror(MPB_ERROR, "multipart_buffer_read: %d bytes", len);
#endif
return len;
}
/*
XXX: this is horrible memory-usage-wise, but we only expect
to do this on small pieces of form data.
*/
char *multipart_buffer_read_body(multipart_buffer *self)
{
char buf[FILLUNIT], *out = "";
while(multipart_buffer_read(self, buf, sizeof(buf)))
out = ap_pstrcat(self->r->pool, out, buf, NULL);
#ifdef DEBUG
ap_log_rerror(MPB_ERROR, "multipart_buffer_read_body: '%s'", out);
#endif
return out;
}
/* eof if we are out of bytes, or if we hit the final boundary */
int multipart_buffer_eof(multipart_buffer *self)
{
if( (self->bytes_in_buffer == 0 && fill_buffer(self) < 1) )
return 1;
else
return 0;
}
1.1 tcl-rivet/src/apache_multipart_buffer.h
Index: apache_multipart_buffer.h
===================================================================
#include "apache_request.h"
/*#define DEBUG 1*/
#define FILLUNIT (1024 * 5)
#define MPB_ERROR APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, self->r
typedef struct {
/* request info */
request_rec *r;
long request_length;
/* read buffer */
char *buffer;
char *buf_begin;
int bufsize;
int bytes_in_buffer;
/* boundary info */
char *boundary;
char *boundary_next;
char *boundary_end;
} multipart_buffer;
multipart_buffer *
multipart_buffer_new(char *boundary, long length, request_rec *r);
table *multipart_buffer_headers(multipart_buffer *self);
int multipart_buffer_read(multipart_buffer *self, char *buf, int bytes);
char *multipart_buffer_read_body(multipart_buffer *self);
int multipart_buffer_eof(multipart_buffer *self);
1.1 tcl-rivet/src/apache_request.c
Index: apache_request.c
===================================================================
/* ====================================================================
* Copyright (c) 1995-1999 The Apache Group. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
*
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in
* the documentation and/or other materials provided with the
* distribution.
*
* 3. All advertising materials mentioning features or use of this
* software must display the following acknowledgment:
* "This product includes software developed by the Apache Group
* for use in the Apache HTTP server project (http://www.apache.org/)."
*
* 4. The names "Apache Server" and "Apache Group" must not be used to
* endorse or promote products derived from this software without
* prior written permission. For written permission, please contact
* apache@apache.org.
*
* 5. Products derived from this software may not be called "Apache"
* nor may "Apache" appear in their names without prior written
* permission of the Apache Group.
*
* 6. Redistributions of any form whatsoever must retain the following
* acknowledgment:
* "This product includes software developed by the Apache Group
* for use in the Apache HTTP server project (http://www.apache.org/)."
*
* THIS SOFTWARE IS PROVIDED BY THE APACHE GROUP ``AS IS'' AND ANY
* EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE APACHE GROUP OR
* ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
* OF THE POSSIBILITY OF SUCH DAMAGE.
* ====================================================================
*
* This software consists of voluntary contributions made by many
* individuals on behalf of the Apache Group and was originally based
* on public domain software written at the National Center for
* Supercomputing Applications, University of Illinois, Urbana-Champaign.
* For more information on the Apache Group and the Apache HTTP server
* project, please see <http://www.apache.org/>.
*
*/
#include "apache_request.h"
#include "apache_multipart_buffer.h"
static void req_plustospace(char *str)
{
register int x;
for(x=0;str[x];x++) if(str[x] == '+') str[x] = ' ';
}
static int util_read(ApacheRequest *req, const char **rbuf)
{
request_rec *r = req->r;
int rc = OK;
if ((rc = ap_setup_client_block(r, REQUEST_CHUNKED_ERROR))) {
return rc;
}
if (ap_should_client_block(r)) {
char buff[HUGE_STRING_LEN];
int rsize, len_read, rpos=0;
long length = r->remaining;
if (length > req->post_max && req->post_max > 0) {
ap_log_rerror(REQ_ERROR, "[libapreq] entity too large (%d, max=%d)",
(int)length, req->post_max);
return HTTP_REQUEST_ENTITY_TOO_LARGE;
}
*rbuf = ap_pcalloc(r->pool, length + 1);
ap_hard_timeout("[libapreq] util_read", r);
while ((len_read =
ap_get_client_block(r, buff, sizeof(buff))) > 0) {
if ((rpos + len_read) > length) {
rsize = length - rpos;
}
else {
rsize = len_read;
}
memcpy((char*)*rbuf + rpos, buff, rsize);
rpos += rsize;
}
ap_kill_timeout(r);
}
return rc;
}
char *ApacheRequest_script_name(ApacheRequest *req)
{
request_rec *r = req->r;
char *tmp;
if (r->path_info && *r->path_info) {
int path_info_start = ap_find_path_info(r->uri, r->path_info);
tmp = ap_pstrndup(r->pool, r->uri, path_info_start);
}
else {
tmp = r->uri;
}
return tmp;
}
char *ApacheRequest_script_path(ApacheRequest *req)
{
return ap_make_dirstr_parent(req->r->pool, ApacheRequest_script_name(req));
}
const char *ApacheRequest_param(ApacheRequest *req, const char *key)
{
ApacheRequest_parse(req);
return ap_table_get(req->parms, key);
}
static int make_params(void *data, const char *key, const char *val)
{
array_header *arr = (array_header *)data;
*(char **)ap_push_array(arr) = (char *)val;
return 1;
}
array_header *ApacheRequest_params(ApacheRequest *req, const char *key)
{
array_header *values = ap_make_array(req->r->pool, 4, sizeof(char *));
ApacheRequest_parse(req);
ap_table_do(make_params, (void*)values, req->parms, key, NULL);
return values;
}
char *ApacheRequest_params_as_string(ApacheRequest *req, const char *key)
{
char *retval = NULL;
array_header *values = ApacheRequest_params(req, key);
int i;
for (i=0; i<values->nelts; i++) {
retval = ap_pstrcat(req->r->pool,
retval ? retval : "",
((char **)values->elts)[i],
(i == (values->nelts - 1)) ? NULL : ", ",
NULL);
}
return retval;
}
ApacheUpload *ApacheUpload_new(ApacheRequest *req)
{
ApacheUpload *upload = (ApacheUpload *)
ap_pcalloc(req->r->pool, sizeof(ApacheUpload));
upload->next = NULL;
upload->name = NULL;
upload->info = NULL;
upload->fp = NULL;
upload->size = 0;
upload->req = req;
return upload;
}
ApacheUpload *ApacheUpload_find(ApacheUpload *upload, char *name)
{
ApacheUpload *uptr;
for (uptr = upload; uptr; uptr = uptr->next) {
if (strEQ(uptr->name, name)) {
return uptr;
}
}
return NULL;
}
ApacheRequest *ApacheRequest_new(request_rec *r)
{
ApacheRequest *req = (ApacheRequest *)
ap_pcalloc(r->pool, sizeof(ApacheRequest));
req->status = OK;
req->parms = ap_make_table(r->pool, DEFAULT_TABLE_NELTS);
req->upload = NULL;
req->post_max = -1;
req->disable_uploads = 0;
req->upload_hook = NULL;
req->hook_data = NULL;
req->temp_dir = NULL;
req->parsed = 0;
req->r = r;
return req;
}
static int urlword_dlm[] = {'&', ';', 0};
static char *my_urlword(pool *p, const char **line)
{
int i;
for (i = 0; urlword_dlm[i]; i++) {
int stop = urlword_dlm[i];
char *pos = strchr(*line, stop);
char *res;
if (!pos) {
if (!urlword_dlm[i+1]) {
int len = strlen(*line);
res = ap_pstrndup(p, *line, len);
*line += len;
return res;
}
continue;
}
res = ap_pstrndup(p, *line, pos - *line);
while (*pos == stop) {
++pos;
}
*line = pos;
return res;
}
return NULL;
}
static void split_to_parms(ApacheRequest *req, const char *data)
{
request_rec *r = req->r;
const char *val;
while (*data && (val = my_urlword(r->pool, &data))) {
const char *key = ap_getword(r->pool, &val, '=');
req_plustospace((char*)key);
ap_unescape_url((char*)key);
req_plustospace((char*)val);
ap_unescape_url((char*)val);
ap_table_add(req->parms, key, val);
}
}
int ApacheRequest___parse(ApacheRequest *req)
{
request_rec *r = req->r;
int result;
if (r->args) {
split_to_parms(req, r->args);
}
if (r->method_number == M_POST) {
const char *ct = ap_table_get(r->headers_in, "Content-type");
if (ct && strncaseEQ(ct, DEFAULT_ENCTYPE, DEFAULT_ENCTYPE_LENGTH)) {
result = ApacheRequest_parse_urlencoded(req);
}
else if (ct && strncaseEQ(ct, MULTIPART_ENCTYPE, MULTIPART_ENCTYPE_LENGTH)) {
result = ApacheRequest_parse_multipart(req);
}
else {
ap_log_rerror(REQ_ERROR,
"[libapreq] unknown content-type: `%s'", ct);
result = HTTP_INTERNAL_SERVER_ERROR;
}
}
else {
result = ApacheRequest_parse_urlencoded(req);
}
req->parsed = 1;
return result;
}
int ApacheRequest_parse_urlencoded(ApacheRequest *req)
{
request_rec *r = req->r;
int rc = OK;
if (r->method_number == M_POST) {
const char *data = NULL, *type;
type = ap_table_get(r->headers_in, "Content-Type");
if (!strncaseEQ(type, DEFAULT_ENCTYPE, DEFAULT_ENCTYPE_LENGTH)) {
return DECLINED;
}
if ((rc = util_read(req, &data)) != OK) {
return rc;
}
if (data) {
split_to_parms(req, data);
}
}
return OK;
}
static void remove_tmpfile(void *data) {
ApacheUpload *upload = (ApacheUpload *) data;
ApacheRequest *req = upload->req;
if( ap_pfclose(req->r->pool, upload->fp) )
ap_log_rerror(REQ_ERROR,
"[libapreq] close error on '%s'", upload->tempname);
#ifndef DEBUG
if( remove(upload->tempname) )
ap_log_rerror(REQ_ERROR,
"[libapreq] remove error on '%s'", upload->tempname);
#endif
free(upload->tempname);
}
FILE *ApacheRequest_tmpfile(ApacheRequest *req, ApacheUpload *upload)
{
request_rec *r = req->r;
FILE *fp;
char prefix[] = "apreq";
char *name = NULL;
int fd = 0;
int tries = 100;
while (--tries > 0) {
if ( (name = tempnam(req->temp_dir, prefix)) == NULL )
continue;
fd = ap_popenf(r->pool, name, O_CREAT|O_EXCL|O_RDWR|O_BINARY, 0600);
if ( fd >= 0 )
break; /* success */
else
free(name);
}
if ( tries == 0 || (fp = ap_pfdopen(r->pool, fd, "w+" "b") ) == NULL ) {
ap_log_rerror(REQ_ERROR, "[libapreq] could not create/open temp file");
if ( fd >= 0 ) { remove(name); free(name); }
return NULL;
}
upload->fp = fp;
upload->tempname = name;
ap_register_cleanup(r->pool, (void *)upload,
remove_tmpfile, ap_null_cleanup);
return fp;
}
int ApacheRequest_parse_multipart(ApacheRequest *req)
{
request_rec *r = req->r;
int rc = OK;
const char *ct = ap_table_get(r->headers_in, "Content-Type");
long length;
char *boundary;
multipart_buffer *mbuff;
ApacheUpload *upload = NULL;
if (req->disable_uploads) {
ap_log_rerror(REQ_ERROR, "[libapreq] file upload forbidden");
return HTTP_FORBIDDEN;
}
if (!ct) {
ap_log_rerror(REQ_ERROR, "[libapreq] no Content-type header!");
return HTTP_INTERNAL_SERVER_ERROR;
}
if ((rc = ap_setup_client_block(r, REQUEST_CHUNKED_ERROR))) {
return rc;
}
if (!ap_should_client_block(r)) {
return rc;
}
if ((length = r->remaining) > req->post_max && req->post_max > 0) {
ap_log_rerror(REQ_ERROR, "[libapreq] entity too large (%d, max=%d)",
(int)length, req->post_max);
return HTTP_REQUEST_ENTITY_TOO_LARGE;
}
(void)ap_getword(r->pool, &ct, '=');
boundary = ap_getword_conf(r->pool, &ct);
if (!(mbuff = multipart_buffer_new(boundary, length, r))) {
return DECLINED;
}
while (!multipart_buffer_eof(mbuff)) {
table *header = multipart_buffer_headers(mbuff);
const char *cd, *param=NULL, *filename=NULL;
char buff[FILLUNIT];
int blen, wlen;
if (!header) {
return OK;
}
if ((cd = ap_table_get(header, "Content-Disposition"))) {
const char *pair;
while (*cd && (pair = ap_getword(r->pool, &cd, ';'))) {
const char *key;
while (ap_isspace(*cd)) {
++cd;
}
if (ap_ind(pair, '=')) {
key = ap_getword(r->pool, &pair, '=');
if(strEQ(key, "name")) {
param = ap_getword_conf(r->pool, &pair);
}
else if(strEQ(key, "filename")) {
filename = ap_getword_conf(r->pool, &pair);
}
}
}
if (!filename) {
char *value = multipart_buffer_read_body(mbuff);
ap_table_add(req->parms, param, value);
continue;
}
if (!param) continue; /* shouldn't happen, but just in case. */
ap_table_add(req->parms, param, filename);
if (upload) {
upload->next = ApacheUpload_new(req);
upload = upload->next;
}
else {
upload = ApacheUpload_new(req);
req->upload = upload;
}
if (! req->upload_hook && ! ApacheRequest_tmpfile(req, upload) ) {
return HTTP_INTERNAL_SERVER_ERROR;
}
upload->info = header;
upload->filename = ap_pstrdup(req->r->pool, filename);
upload->name = ap_pstrdup(req->r->pool, param);
while ((blen = multipart_buffer_read(mbuff, buff, sizeof(buff)))) {
if (req->upload_hook != NULL) {
wlen = req->upload_hook(req->hook_data, buff, blen, upload);
} else {
wlen = fwrite(buff, 1, blen, upload->fp);
}
if (wlen != blen) {
return HTTP_INTERNAL_SERVER_ERROR;
}
upload->size += wlen;
}
if (upload->size > 0 && (upload->fp != NULL)) {
fseek(upload->fp, 0, 0);
}
}
}
return OK;
}
#define Mult_s 1
#define Mult_m 60
#define Mult_h (60*60)
#define Mult_d (60*60*24)
#define Mult_M (60*60*24*30)
#define Mult_y (60*60*24*365)
static int expire_mult(char s)
{
switch (s) {
case 's':
return Mult_s;
case 'm':
return Mult_m;
case 'h':
return Mult_h;
case 'd':
return Mult_d;
case 'M':
return Mult_M;
case 'y':
return Mult_y;
default:
return 1;
};
}
static time_t expire_calc(char *time_str)
{
int is_neg = 0, offset = 0;
char buf[256];
int ix = 0;
if (*time_str == '-') {
is_neg = 1;
++time_str;
}
else if (*time_str == '+') {
++time_str;
}
else if (strcaseEQ(time_str, "now")) {
/*ok*/
}
else {
return 0;
}
/* wtf, ap_isdigit() returns false for '1' !? */
while (*time_str && (ap_isdigit(*time_str) || (*time_str == '1'))) {
buf[ix++] = *time_str++;
}
buf[ix] = '\0';
offset = atoi(buf);
return time(NULL) +
(expire_mult(*time_str) * (is_neg ? (0 - offset) : offset));
}
char *ApacheUtil_expires(pool *p, char *time_str, int type)
{
time_t when;
struct tm *tms;
int sep = (type == EXPIRES_HTTP) ? ' ' : '-';
if (!time_str) {
return NULL;
}
when = expire_calc(time_str);
if (!when) {
return ap_pstrdup(p, time_str);
}
tms = gmtime(&when);
return ap_psprintf(p,
"%s, %.2d%c%s%c%.2d %.2d:%.2d:%.2d GMT",
ap_day_snames[tms->tm_wday],
tms->tm_mday, sep, ap_month_snames[tms->tm_mon], sep,
tms->tm_year + 1900,
tms->tm_hour, tms->tm_min, tms->tm_sec);
}
char *ApacheRequest_expires(ApacheRequest *req, char *time_str)
{
return ApacheUtil_expires(req->r->pool, time_str, EXPIRES_HTTP);
}
1.1 tcl-rivet/src/apache_request.h
Index: apache_request.h
===================================================================
#ifndef _APACHE_REQUEST_H
#define _APACHE_REQUEST_H
#include "httpd.h"
#include "http_config.h"
#include "http_core.h"
#include "http_log.h"
#include "http_main.h"
#include "http_protocol.h"
#include "util_script.h"
#ifdef SFIO
#include "sfio.h"
/* sfio 2000 changed _stdopen to _stdfdopen */
#if SFIO_VERSION >= 20000101L
#define _stdopen _stdfdopen
#endif
extern Sfio_t* _stdopen _ARG_((int, const char*)); /*1999*/
#undef FILE
#define FILE Sfio_t
#undef fwrite
#define fwrite(p,s,n,f) sfwrite((f),(p),(s)*(n))
#undef fseek
#define fseek(f,a,b) sfseek((f),(a),(b))
#undef ap_pfdopen
#define ap_pfdopen(p,q,r) _stdopen((q),(r))
#undef ap_pfclose
#define ap_pfclose(p,q) sfclose(q)
#endif /*SFIO*/
typedef struct ApacheUpload ApacheUpload;
typedef struct {
table *parms;
ApacheUpload *upload;
int status;
int parsed;
int post_max;
int disable_uploads;
int (*upload_hook)(void *ptr, char *buf, int len, ApacheUpload *upload);
void *hook_data;
char* temp_dir;
request_rec *r;
} ApacheRequest;
struct ApacheUpload {
ApacheUpload *next;
char *filename;
char *name;
char *tempname;
table *info;
FILE *fp;
long size;
ApacheRequest *req;
};
#ifndef strEQ
#define strEQ(s1,s2) (!strcmp(s1,s2))
#endif
#ifndef strEQN
#define strEQN(s1,s2,n) (!strncmp(s1,s2,n))
#endif
#ifndef strcaseEQ
#define strcaseEQ(s1,s2) (!strcasecmp(s1,s2))
#endif
#ifndef strncaseEQ
#define strncaseEQ(s1,s2,n) (!strncasecmp(s1,s2,n))
#endif
#define DEFAULT_TABLE_NELTS 10
#define DEFAULT_ENCTYPE "application/x-www-form-urlencoded"
#define DEFAULT_ENCTYPE_LENGTH 33
#define MULTIPART_ENCTYPE "multipart/form-data"
#define MULTIPART_ENCTYPE_LENGTH 19
#ifdef __cplusplus
extern "C" {
#endif
ApacheRequest *ApacheRequest_new(request_rec *r);
int ApacheRequest_parse_multipart(ApacheRequest *req);
int ApacheRequest_parse_urlencoded(ApacheRequest *req);
char *ApacheRequest_script_name(ApacheRequest *req);
char *ApacheRequest_script_path(ApacheRequest *req);
const char *ApacheRequest_param(ApacheRequest *req, const char *key);
array_header *ApacheRequest_params(ApacheRequest *req, const char *key);
char *ApacheRequest_params_as_string(ApacheRequest *req, const char *key);
int ApacheRequest___parse(ApacheRequest *req);
#define ApacheRequest_parse(req) \
(req->status = req->parsed ? req->status : ApacheRequest___parse(req))
FILE *ApacheRequest_tmpfile(ApacheRequest *req, ApacheUpload *upload);
ApacheUpload *ApacheUpload_new(ApacheRequest *req);
ApacheUpload *ApacheUpload_find(ApacheUpload *upload, char *name);
#define ApacheRequest_upload(req) \
((req->parsed || (ApacheRequest_parse(req) == OK)) ? req->upload : NULL)
#define ApacheUpload_FILE(upload) (upload->fp)
#define ApacheUpload_size(upload) (upload->size)
#define ApacheUpload_info(upload, key) \
ap_table_get(upload->info, key)
#define ApacheUpload_type(upload) \
ApacheUpload_info(upload, "Content-Type")
#define ApacheRequest_set_post_max(req, max) (req->post_max = max)
#define ApacheRequest_set_temp_dir(req, dir) (req->temp_dir = dir)
char *ApacheUtil_expires(pool *p, char *time_str, int type);
#define EXPIRES_HTTP 1
#define EXPIRES_COOKIE 2
char *ApacheRequest_expires(ApacheRequest *req, char *time_str);
#ifdef __cplusplus
}
#endif
#define REQ_ERROR APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, req->r
#ifdef REQDEBUG
#define REQ_DEBUG(a) a
#else
#define REQ_DEBUG(a)
#endif
#endif /* _APACHE_REQUEST_H */
1.1 tcl-rivet/src/channel.c
Index: channel.c
===================================================================
#include "httpd.h"
#include "http_config.h"
#include "http_request.h"
#include <tcl.h>
#include <errno.h>
#include "apache_request.h"
#include "mod_rivet.h"
/* This file describes the mod_rivet Tcl output channel. */
static int inputproc(ClientData instancedata, char *buf, int toRead, int *errorCodePtr)
{
return EINVAL;
}
/* This is the output 'method' for the Memory Buffer Tcl 'File'
Channel that we create to divert stdout to */
static int outputproc(ClientData instancedata, char *buf, int toWrite, int *errorCodePtr)
{
rivet_server_conf *rsc = (rivet_server_conf *)instancedata;
Tcl_DStringAppend(rsc->buffer, buf, toWrite);
return toWrite;
}
static int closeproc(ClientData instancedata, Tcl_Interp *interp)
{
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
print_headers(globals->r);
flush_output_buffer(globals->r);
return 0;
}
static int setoptionproc(ClientData instancedata, Tcl_Interp *interp,
char *optionname, char *value)
{
return TCL_OK;
}
/*
int getoptionproc(ClientData instancedata, Tcl_Interp *intepr,
char *optionname, Tcl_DString *dsPtr)
{
return TCL_OK;
}
*/
static void watchproc(ClientData instancedata, int mask)
{
/* not much to do here */
return;
}
static int gethandleproc(ClientData instancedata, int direction, ClientData *handlePtr)
{
return TCL_ERROR;
}
Tcl_ChannelType ApacheChan = {
"apache_channel",
NULL,
closeproc,
inputproc,
outputproc,
NULL,
setoptionproc,
NULL,
watchproc,
gethandleproc,
NULL
};
1.1 tcl-rivet/src/channel.h
Index: channel.h
===================================================================
/* Functions for mod_dtcl Tcl output channel .*/
#include "mod_rivet.h"
extern int closeproc(ClientData, Tcl_Interp *);
extern int inputproc(ClientData, char *, int, int *);
extern int outputproc(ClientData, char *, int, int *);
extern int setoptionproc(ClientData, Tcl_Interp *, char *, char *);
/* extern int getoptionproc(ClientData, Tcl_Interp *, char *, Tcl_DString *); */
extern void watchproc(ClientData, int);
extern int gethandleproc(ClientData, int, ClientData *);
extern Tcl_ChannelType ApacheChan;
1.1 tcl-rivet/src/make.tcl
Index: make.tcl
===================================================================
#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
# $Id: make.tcl,v 1.1 2001/09/19 13:12:58 davidw Exp $
# this file actually runs things, making use of the aardvark build
# system.
# get aardvark build system
source [ file join . buildscripts aardvark.tcl ]
namespace import ::aardvark::*
# add in variables from tclConfig.sh
source [ file join . buildscripts parsetclConfig.tcl ]
# add variables
set INC "-I /usr/include/apache-1.3/"
set STATICLIB mod_rivet.a
set SHLIB "mod_rivet[ info sharedlibextension ]"
set COMPILE "$TCL_CC $TCL_CFLAGS_DEBUG $TCL_CFLAGS_OPTIMIZE $TCL_CFLAGS_WARNING $TCL_SHLIB_CFLAGS $INC $TCL_EXTRA_CFLAGS -c"
set OBJECTS "apache_cookie.o apache_request.o mod_rivet.o tcl_commands.o apache_multipart_buffer.o channel.o parser.o"
# ------------
Verbose
AddNode apache_cookie.o {
depends "apache_cookie.c apache_cookie.h"
command {$COMPILE apache_cookie.c}
}
AddNode apache_multipart_buffer.o {
depends "apache_multipart_buffer.c apache_multipart_buffer.h"
command {$COMPILE apache_multipart_buffer.c}
}
AddNode apache_request.o {
depends "apache_request.c apache_request.h"
command {$COMPILE apache_request.c}
}
AddNode mod_rivet.o {
depends "mod_rivet.c mod_rivet.h tcl_commands.h apache_request.h parser.h parser.h"
command {$COMPILE mod_rivet.c}
}
AddNode tcl_commands.o {
depends "tcl_commands.c tcl_commands.h mod_rivet.h"
command {$COMPILE tcl_commands.c}
}
AddNode parser.o {
depends "parser.c mod_rivet.h parser.h"
command {$COMPILE parser.c}
}
AddNode channel.o {
depends "channel.c mod_rivet.h channel.h"
command {$COMPILE channel.c}
}
AddNode all {
depends shared
}
AddNode shared {
depends $OBJECTS
command {$TCL_SHLIB_LD -o $SHLIB $OBJECTS $TCL_LIB_SPEC $TCL_LIBS}
}
AddNode static {
depends $OBJECTS
command {$TCL_STLIB_LD $STATICLIB $OBJECTS}
}
AddNode clean {
command {rm [glob *.o]}
command {rm [glob *.so]}
command {rm mod_rivet.a}
}
AddNode install {
depends static
command {./cvsversion.tcl}
}
Run
1.1 tcl-rivet/src/mod_rivet.c
Index: mod_rivet.c
===================================================================
/* Copyright David Welton 1998, 1999 */
/* ====================================================================
* The Apache Software License, Version 1.1
*
* Copyright (c) 2000, 2001 The Apache Software Foundation. All rights
* reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
*
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in
* the documentation and/or other materials provided with the
* distribution.
*
* 3. The end-user documentation included with the redistribution,
* if any, must include the following acknowledgment:
* "This product includes software developed by the
* Apache Software Foundation (http://www.apache.org/)."
* Alternately, this acknowledgment may appear in the software itself,
* if and wherever such third-party acknowledgments normally appear.
*
* 4. The names "Apache" and "Apache Software Foundation" must
* not be used to endorse or promote products derived from this
* software without prior written permission. For written
* permission, please contact apache@apache.org.
*
* 5. Products derived from this software may not be called "mod_rivet"
* or "rivet", nor may "rivet" appear in their name, without prior
* written permission of the Apache Software Foundation.
*
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
* WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
* OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL THE APACHE SOFTWARE FOUNDATION OR
* ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
* USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
* OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
* ====================================================================
*
* This software consists of voluntary contributions made by many
* individuals on behalf of the Apache Software Foundation. For more
* information on the Apache Software Foundation, please see
* <http://www.apache.org/>.
*
* Portions of this software are based upon public domain software
* originally written at the National Center for Supercomputing Applications,
* University of Illinois, Urbana-Champaign. */
/* $Id: mod_rivet.c,v 1.1 2001/09/19 13:12:58 davidw Exp $ */
/* mod_rivet.c by David Welton <da...@apache.org> - originally mod_include. */
/* See http://tcl.apache.org/mod_rivet/credits.ttml for additional credits. */
#include "httpd.h"
#include "http_config.h"
#include "http_request.h"
#include "http_core.h"
#include "http_protocol.h"
#include "http_log.h"
#include "http_main.h"
#include "util_script.h"
#include "http_conf_globals.h"
#include <tcl.h>
#include <string.h>
#include "tcl_commands.h"
#include "parser.h"
#include "channel.h"
#include "apache_request.h"
#include "mod_rivet.h"
module MODULE_VAR_EXPORT rivet_module;
static void tcl_init_stuff(server_rec *s, pool *p);
static void copy_rivet_config(pool *p, rivet_server_conf *oldrsc, rivet_server_conf *newrsc);
static int get_ttml_file(request_rec *r, rivet_server_conf *rsc,
Tcl_Interp *interp, char *filename, int toplevel, Tcl_Obj *outbuf);
static int send_content(request_rec *);
static int execute_and_check(Tcl_Interp *interp, Tcl_Obj *outbuf, request_rec *r);
/* just need some arbitrary non-NULL pointer which can't also be a request_rec */
#define NESTED_INCLUDE_MAGIC (&rivet_module)
/* Set up the content type header */
int set_header_type(request_rec *r, char *header)
{
rivet_server_conf *rsc = rivet_get_conf(r);
if (*(rsc->headers_set) == 0)
{
r->content_type = header;
*(rsc->headers_set) = 1;
return 1;
} else {
return 0;
}
}
/* Printer headers if they haven't been printed yet */
int print_headers(request_rec *r)
{
rivet_server_conf *rsc = rivet_get_conf(r);
if (*(rsc->headers_printed) == 0)
{
if (*(rsc->headers_set) == 0)
set_header_type(r, DEFAULT_HEADER_TYPE);
ap_send_http_header(r);
*(rsc->headers_printed) = 1;
return 1;
} else {
return 0;
}
}
/* Print nice HTML formatted errors */
int print_error(request_rec *r, int htmlflag, char *errstr)
{
set_header_type(r, DEFAULT_HEADER_TYPE);
print_headers(r);
if (htmlflag != 1)
ap_rputs(ER1, r);
if (errstr != NULL)
{
if (htmlflag != 1)
{
ap_rputs(ap_escape_html(r->pool, errstr), r);
} else {
ap_rputs(errstr, r);
}
}
if (htmlflag != 1)
ap_rputs(ER2, r);
return 0;
}
/* Make sure that everything in the output buffer has been flushed. */
int flush_output_buffer(request_rec *r)
{
rivet_server_conf *rsc = rivet_get_conf(r);
if (Tcl_DStringLength(rsc->buffer) != 0)
{
ap_rwrite(Tcl_DStringValue(rsc->buffer), Tcl_DStringLength(rsc->buffer), r);
Tcl_DStringInit(rsc->buffer);
}
*(rsc->content_sent) = 1;
return 0;
}
/* Function to convert strings to UTF encoding */
char *StringToUtf(char *input, ap_pool *pool)
{
char *temp;
Tcl_DString dstr;
Tcl_DStringInit(&dstr);
Tcl_ExternalToUtfDString(NULL, input, strlen(input), &dstr);
temp = ap_pstrdup(pool, Tcl_DStringValue(&dstr));
Tcl_DStringFree(&dstr);
return temp;
}
/* Function to be used should we desire to upload files to a variable */
#if 0
int rivet_upload_hook(void *ptr, char *buf, int len, ApacheUpload *upload)
{
Tcl_Interp *interp = ptr;
static int usenum = 0;
static int uploaded = 0;
if (oldptr != upload)
{
} else {
}
#if USE_ONLY_UPLOAD_COMMAND == 0
Tcl_ObjSetVar2(interp,
Tcl_NewStringObj("::request::UPLOAD", -1),
Tcl_NewStringObj("data", -1),
Tcl_DuplicateObj(uploadstorage[usenum]),
0);
#endif /* USE_ONLY_UPLOAD_COMMAND */
return len;
}
#endif /* 0 */
/* Load, cache and eval a Tcl file */
static int get_tcl_file(request_rec *r, Tcl_Interp *interp, char *filename, Tcl_Obj *outbuf)
{
int result = 0;
#if 1
/* Taken, in part, from tclIOUtil.c out of the Tcl
distribution, and modified */
/* Basically, what we are doing here is a Tcl_EvalFile, but
with the addition of caching code. */
Tcl_Channel chan = Tcl_OpenFileChannel(interp, r->filename, "r", 0644);
if (chan == (Tcl_Channel) NULL)
{
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't read file \"", r->filename,
"\": ", Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
result = Tcl_ReadChars(chan, outbuf, r->finfo.st_size, 1);
if (result < 0)
{
Tcl_Close(interp, chan);
Tcl_AppendResult(interp, "couldn't read file \"", r->filename,
"\": ", Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
if (Tcl_Close(interp, chan) != TCL_OK)
return TCL_ERROR;
return TCL_OK;
#else
Tcl_EvalFile(interp, r->filename);
#endif /* 1 */
}
/* Parse and execute a ttml file */
static int get_ttml_file(request_rec *r, rivet_server_conf *rsc, Tcl_Interp *interp,
char *filename, int toplevel, Tcl_Obj *outbuf)
{
/* BEGIN PARSER */
int inside = 0; /* are we inside the starting/ending delimiters */
FILE *f = NULL;
if (!(f = ap_pfopen(r->pool, filename, "r")))
{
ap_log_error(APLOG_MARK, APLOG_ERR, r->server,
"file permissions deny server access: %s", filename);
return HTTP_FORBIDDEN;
}
if (toplevel)
{
Tcl_SetStringObj(outbuf, "namespace eval request {\n", -1);
if (rsc->rivet_before_script) {
Tcl_AppendObjToObj(outbuf, rsc->rivet_before_script);
}
Tcl_AppendToObj(outbuf, "buffer_add \"", -1);
}
else
Tcl_SetStringObj(outbuf, "hputs \"\n", -1);
/* if inside < 0, it's an error */
inside = rivet_parser(outbuf, f);
if (inside < 0)
{
if (ferror(f))
{
ap_log_error(APLOG_MARK, APLOG_ERR, r->server,
"Encountered error in mod_rivet getchar routine while reading %s",
r->uri);
ap_pfclose( r->pool, f);
}
}
ap_pfclose(r->pool, f);
if (inside == 0)
{
Tcl_AppendToObj(outbuf, "\"\n", 2);
}
if (toplevel)
{
if (rsc->rivet_after_script)
Tcl_AppendObjToObj(outbuf, rsc->rivet_after_script);
/* Tcl_AppendToObj(outbuf, "\n}\nnamespace delete request\n", -1); seems redundant */
Tcl_AppendToObj(outbuf, "\n}\n", -1);
}
else
Tcl_AppendToObj(outbuf, "\n", -1);
/* END PARSER */
return TCL_OK;
}
/* Calls Tcl_EvalObj() and checks for errors; prints the error buffer if any. */
static int execute_and_check(Tcl_Interp *interp, Tcl_Obj *outbuf, request_rec *r)
{
char *errorinfo;
rivet_server_conf *conf = NULL;
conf = rivet_get_conf(r);
if (Tcl_EvalObj(interp, outbuf) == TCL_ERROR)
{
Tcl_Obj *errscript = conf->rivet_error_script ? conf->rivet_error_script :
conf->rivet_error_script ? conf->rivet_error_script : NULL;
print_headers(r);
flush_output_buffer(r);
if (errscript)
{
if (Tcl_EvalObj(interp, errscript) == TCL_ERROR)
print_error(r, 1, "<b>Tcl_ErrorScript failed!</b>");
} else {
/* default action */
errorinfo = Tcl_GetVar(interp, "errorInfo", 0);
print_error(r, 0, errorinfo);
print_error(r, 1, "<p><b>OUTPUT BUFFER:</b></p>");
print_error(r, 0, Tcl_GetStringFromObj(outbuf, (int *)NULL));
}
/* "</pre><b>OUTPUT BUFFER</b><pre>\n",
Tcl_GetStringFromObj(outbuf, (int *)NULL)); */
} else {
/* We make sure to flush the output if buffer_add was the only output */
print_headers(r);
flush_output_buffer(r);
}
return OK;
}
/* This is a seperate function so that it may be called from 'Parse' */
int get_parse_exec_file(request_rec *r, rivet_server_conf *rsc, int toplevel)
{
char *hashKey = NULL;
int isNew = 0;
int result = 0;
Tcl_Obj *outbuf = NULL;
Tcl_HashEntry *entry = NULL;
Tcl_Interp *interp = rsc->server_interp;
/* Look for the script's compiled version. If it's not found,
create it. */
if (*(rsc->cache_size))
{
hashKey = ap_psprintf(r->pool, "%s%lx%lx%d", r->filename,
r->finfo.st_mtime, r->finfo.st_ctime, toplevel);
entry = Tcl_CreateHashEntry(rsc->objCache, hashKey, &isNew);
}
if (isNew || *(rsc->cache_size) == 0)
{
outbuf = Tcl_NewObj();
Tcl_IncrRefCount(outbuf);
if(!strcmp(r->content_type, "application/x-httpd-tcl"))
{
/* It's a TTML file */
result = get_ttml_file(r, rsc, interp, r->filename, 1, outbuf);
} else {
/* It's a plain Tcl file */
result = get_tcl_file(r, interp, r->filename, outbuf);
}
if (result != TCL_OK)
return result;
if (*(rsc->cache_size))
Tcl_SetHashValue(entry, (ClientData)outbuf);
if (*(rsc->cache_free)) {
rsc->objCacheList[-- *(rsc->cache_free) ] = strdup(hashKey);
} else if (*(rsc->cache_size)) { /* if it's zero, we just skip this... */
Tcl_HashEntry *delEntry;
delEntry = Tcl_FindHashEntry(rsc->objCache,
rsc->objCacheList[*(rsc->cache_size) - 1]);
Tcl_DecrRefCount((Tcl_Obj *)Tcl_GetHashValue(delEntry));
Tcl_DeleteHashEntry(delEntry);
free(rsc->objCacheList[*(rsc->cache_size) - 1]);
memmove((rsc->objCacheList) + 1, rsc->objCacheList,
sizeof(char *) * (*(rsc->cache_size) -1));
rsc->objCacheList[0] = strdup(hashKey);
}
} else {
outbuf = (Tcl_Obj *)Tcl_GetHashValue(entry);
}
execute_and_check(interp, outbuf, r);
return TCL_OK;
}
/* Set things up to execute a file, then execute */
static int send_content(request_rec *r)
{
char error[MAX_STRING_LEN];
char timefmt[MAX_STRING_LEN];
int errstatus;
Tcl_Interp *interp;
rivet_interp_globals *globals = NULL;
rivet_server_conf *rsc = NULL;
rsc = rivet_get_conf(r);
globals = ap_pcalloc(r->pool, sizeof(rivet_interp_globals));
globals->r = r;
interp = rsc->server_interp;
Tcl_SetAssocData(interp, "rivet", NULL, globals);
r->allowed |= (1 << M_GET);
r->allowed |= (1 << M_POST);
if (r->method_number != M_GET && r->method_number != M_POST)
return DECLINED;
if (r->finfo.st_mode == 0)
{
ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_ERR, r->server,
"File does not exist: %s",
(r->path_info
? ap_pstrcat(r->pool, r->filename, r->path_info, NULL)
: r->filename));
return HTTP_NOT_FOUND;
}
if ((errstatus = ap_meets_conditions(r)) != OK)
return errstatus;
/* We need to send it as html */
/* r->content_type = DEFAULT_HEADER_TYPE; */
if (r->header_only)
{
set_header_type(r, DEFAULT_HEADER_TYPE);
print_headers(r);
return OK;
}
ap_cpystrn(error, DEFAULT_ERROR_MSG, sizeof(error));
ap_cpystrn(timefmt, DEFAULT_TIME_FORMAT, sizeof(timefmt));
ap_chdir_file(r->filename);
if (Tcl_EvalObj(interp, rsc->namespacePrologue) == TCL_ERROR)
{
ap_log_error(APLOG_MARK, APLOG_ERR, r->server, "Could not create request namespace\n");
return HTTP_BAD_REQUEST;
}
/* Apache Request stuff */
globals->req = ApacheRequest_new(r);
ApacheRequest_set_post_max(globals->req, rsc->upload_max);
ApacheRequest_set_temp_dir(globals->req, rsc->upload_dir);
#if 0
if (upload_files_to_var)
{
globals->req->hook_data = interp;
globals->req->upload_hook = rivet_upload_hook;
}
#endif
ApacheRequest___parse(globals->req);
/* take results and create tcl variables from them */
#if USE_ONLY_VAR_COMMAND == 0
if (globals->req->parms)
{
int i;
array_header *parmsarray = ap_table_elts(globals->req->parms);
table_entry *parms = (table_entry *)parmsarray->elts;
Tcl_Obj *varsobj = Tcl_NewStringObj("::request::VARS", -1);
for (i = 0; i < parmsarray->nelts; ++i)
{
if (!parms[i].key)
continue;
else {
/* All this is so that a query like x=1&x=2&x=3 will
produce a variable that is a list */
Tcl_Obj *newkey = STRING_TO_UTF_TO_OBJ(parms[i].key, r->pool);
Tcl_Obj *newval = STRING_TO_UTF_TO_OBJ(parms[i].val, r->pool);
Tcl_Obj *oldval = Tcl_ObjGetVar2(interp, varsobj, newkey, 0);
if (oldval == NULL)
{
Tcl_ObjSetVar2(interp, varsobj, newkey, newval, 0);
} else {
Tcl_Obj *concat[2];
concat[0] = oldval;
concat[1] = newval;
Tcl_ObjSetVar2(interp, varsobj, newkey, Tcl_ConcatObj(2, concat), 0);
}
}
}
}
#endif
#if USE_ONLY_UPLOAD_COMMAND == 1
upload = req->upload;
/* Loop through uploaded files */
while (upload)
{
char *type = NULL;
char *channelname = NULL;
Tcl_Channel chan;
/* The name of the file uploaded */
Tcl_ObjSetVar2(interp,
Tcl_NewStringObj("::request::UPLOAD", -1),
Tcl_NewStringObj("filename", -1),
Tcl_NewStringObj(upload->filename, -1),
TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
/* The variable name of the file upload */
Tcl_ObjSetVar2(interp,
Tcl_NewStringObj("::request::UPLOAD", -1),
Tcl_NewStringObj("name", -1),
Tcl_NewStringObj(upload->name, -1),
TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
Tcl_ObjSetVar2(interp,
Tcl_NewStringObj("::request::UPLOAD", -1),
Tcl_NewStringObj("size", -1),
Tcl_NewIntObj(upload->size),
TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
type = (char *)ap_table_get(upload->info, "Content-type");
if (type)
{
Tcl_ObjSetVar2(interp,
Tcl_NewStringObj("::request::UPLOAD", -1),
Tcl_NewStringObj("type", -1),
Tcl_NewStringObj(type, -1), /* kill end of line */
TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
}
if (!upload_files_to_var)
{
if (upload->fp != NULL)
{
chan = Tcl_MakeFileChannel((ClientData)fileno(upload->fp), TCL_READABLE);
Tcl_RegisterChannel(interp, chan);
channelname = Tcl_GetChannelName(chan);
Tcl_ObjSetVar2(interp,
Tcl_NewStringObj("::request::UPLOAD", -1),
Tcl_NewStringObj("channelname", -1),
Tcl_NewStringObj(channelname, -1), /* kill end of line */
TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
}
}
upload = upload->next;
}
#endif /* USE_ONLY_UPLOAD_COMMAND == 1 */
get_parse_exec_file(r, rsc, 1);
/* reset globals */
*(rsc->buffer_output) = 0;
*(rsc->headers_printed) = 0;
*(rsc->headers_set) = 0;
*(rsc->content_sent) = 0;
return OK;
}
/* This is done in two places, so I decided to group the creates in
one function */
static void tcl_create_commands(rivet_server_conf *rsc)
{
Tcl_Interp *interp = rsc->server_interp;
Tcl_CreateObjCommand(interp, "hputs", Hputs, NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "buffer_add", Buffer_Add, NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "buffered", Buffered, NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "headers", Headers, NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "hgetvars", HGetVars, NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "var", Var, NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "upload", Upload, NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "include", Include, NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "parse", Parse, NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "hflush", HFlush, NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "rivet_info", Rivet_Info, NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "no_body", No_Body, NULL, (Tcl_CmdDeleteProc *)NULL);
}
static void tcl_init_stuff(server_rec *s, pool *p)
{
int rslt;
Tcl_Interp *interp;
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(s->module_config, &rivet_module);
server_rec *sr;
/* Initialize TCL stuff */
Tcl_FindExecutable(NULL);
interp = Tcl_CreateInterp();
rsc->server_interp = interp; /* root interpreter */
/* Create TCL commands to deal with Apache's BUFFs. */
*(rsc->outchannel) = Tcl_CreateChannel(&ApacheChan, "apacheout", rsc, TCL_WRITABLE);
Tcl_SetStdChannel(*(rsc->outchannel), TCL_STDOUT);
Tcl_SetChannelOption(interp, *(rsc->outchannel), "-buffering", "none");
Tcl_RegisterChannel(interp, *(rsc->outchannel));
if (interp == NULL)
{
ap_log_error(APLOG_MARK, APLOG_ERR, s, "Error in Tcl_CreateInterp, aborting\n");
exit(1);
}
#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
Tcl_FindExecutable(""); /* Needed for locating init.tcl */
#endif
if (Tcl_Init(interp) == TCL_ERROR)
{
ap_log_error(APLOG_MARK, APLOG_ERR, s, Tcl_GetStringResult(interp));
exit(1);
}
tcl_create_commands(rsc);
rsc->namespacePrologue = Tcl_NewStringObj(
"catch { namespace delete request }\n"
"namespace eval request { }\n"
"proc ::request::global { args } { foreach arg $args { uplevel \"::global ::request::$arg\" } }\n", -1);
Tcl_IncrRefCount(rsc->namespacePrologue);
#if DBG
ap_log_error(APLOG_MARK, APLOG_ERR, s, "Config string = \"%s\"",
Tcl_GetStringFromObj(rsc->rivet_global_init_script, NULL)); /* XXX */
ap_log_error(APLOG_MARK, APLOG_ERR, s, "Cache size = \"%d\"", *(rsc->cache_size)); /* XXX */
#endif
if (rsc->rivet_global_init_script != NULL)
{
rslt = Tcl_EvalObjEx(interp, rsc->rivet_global_init_script, 0);
if (rslt != TCL_OK)
{
ap_log_error(APLOG_MARK, APLOG_ERR, s, "%s",
Tcl_GetVar(interp, "errorInfo", 0));
}
}
/* This is what happens if it is not set by the user */
if(*(rsc->cache_size) < 0)
{
if (ap_max_requests_per_child != 0)
*(rsc->cache_size) = ap_max_requests_per_child / 2;
else
*(rsc->cache_size) = 10; /* Arbitrary number FIXME */
*(rsc->cache_free) = *(rsc->cache_size);
} else if (*(rsc->cache_size) > 0) {
*(rsc->cache_free) = *(rsc->cache_size);
}
/* Initializing cache structures */
rsc->objCacheList = ap_pcalloc(p, *(rsc->cache_size) * sizeof(char *));
Tcl_InitHashTable(rsc->objCache, TCL_STRING_KEYS);
sr = s;
while (sr)
{
rivet_server_conf *myrsc = NULL;
/* This should set up slave interpreters for other virtual
hosts */
if (sr != s) /* not the first one */
{
myrsc = ap_pcalloc(p, sizeof(rivet_server_conf));
ap_set_module_config(sr->module_config, &rivet_module, myrsc);
copy_rivet_config(p, rsc, myrsc);
if (rsc->seperate_virtual_interps != 0)
myrsc->server_interp = NULL;
} else {
myrsc = (rivet_server_conf *) ap_get_module_config(sr->module_config, &rivet_module);
}
if (!myrsc->server_interp)
{
myrsc->server_interp = Tcl_CreateSlave(interp, sr->server_hostname, 0);
tcl_create_commands(myrsc);
Tcl_SetChannelOption(myrsc->server_interp, *(rsc->outchannel), "-buffering", "none");
Tcl_RegisterChannel(myrsc->server_interp, *(rsc->outchannel));
}
myrsc->server_name = ap_pstrdup(p, sr->server_hostname);
sr = sr->next;
}
}
MODULE_VAR_EXPORT void rivet_init_handler(server_rec *s, pool *p)
{
#if THREADED_TCL == 0
tcl_init_stuff(s, p);
#endif
#ifndef HIDE_RIVET_VERSION
ap_add_version_component("mod_rivet/"RIVET_VERSION);
#else
ap_add_version_component("mod_rivet");
#endif /* !HIDE_RIVET_VERSION */
}
static const char *set_script(cmd_parms *cmd, rivet_server_conf *rdc, char *arg, char *arg2)
{
Tcl_Obj *objarg;
server_rec *s = cmd->server;
rivet_server_conf *rsc = (rivet_server_conf *)ap_get_module_config(s->module_config, &rivet_module);
if (arg == NULL || arg2 == NULL)
return "Mod_Rivet Error: Rivet_Script requires two arguments";
objarg = Tcl_NewStringObj(arg2, -1);
Tcl_IncrRefCount(objarg);
Tcl_AppendToObj(objarg, "\n", 1);
if (strcmp(arg, "GlobalInitScript") == 0) {
rsc->rivet_global_init_script = objarg;
} else if (strcmp(arg, "ChildInitScript") == 0) {
rsc->rivet_child_init_script = objarg;
} else if (strcmp(arg, "ChildExitScript") == 0) {
rsc->rivet_child_exit_script = objarg;
} else if (strcmp(arg, "BeforeScript") == 0) {
if (rdc == NULL) {
rsc->rivet_before_script = objarg;
} else {
rdc->rivet_before_script = objarg;
}
} else if (strcmp(arg, "AfterScript") == 0) {
if (rdc == NULL) {
rsc->rivet_after_script = objarg;
} else {
rdc->rivet_after_script = objarg;
}
} else if (strcmp(arg, "ErrorScript") == 0) {
if (rdc == NULL)
rsc->rivet_error_script = objarg;
else
rdc->rivet_error_script = objarg;
} else {
return "Mod_Rivet Error: Rivet_Script must have a second argument, which is one of: GlobalInitScript, ChildInitScript, ChildExitScript, BeforeScript, AfterScript, ErrorScript";
}
return NULL;
}
static const char *set_cachesize(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(s->module_config, &rivet_module);
*(rsc->cache_size) = strtol(arg, NULL, 10);
return NULL;
}
static const char *set_uploaddir(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(s->module_config, &rivet_module);
rsc->upload_dir = arg;
return NULL;
}
static const char *set_uploadmax(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(s->module_config, &rivet_module);
rsc->upload_max = strtol(arg, NULL, 10);
return NULL;
}
static const char *set_filestovar(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(s->module_config, &rivet_module);
if (!strcmp(arg, "on"))
rsc->upload_files_to_var = 1;
else
rsc->upload_files_to_var = 0;
return NULL;
}
static const char *set_seperatevirtinterps(cmd_parms *cmd, void *dummy, char *arg)
{
server_rec *s = cmd->server;
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(s->module_config, &rivet_module);
if (!strcmp(arg, "on"))
rsc->seperate_virtual_interps = 1;
else
rsc->seperate_virtual_interps = 0;
return NULL;
}
/* function to get a config, and merge the directory/server options */
rivet_server_conf *rivet_get_conf(request_rec *r)
{
rivet_server_conf *newconfig = NULL;
rivet_server_conf *rsc = NULL; /* server config */
void *dconf = r->per_dir_config;
rsc = (rivet_server_conf *) ap_get_module_config(r->server->module_config, &rivet_module);
if (dconf != NULL)
{
rivet_server_conf *rdc = (rivet_server_conf *)
ap_get_module_config(dconf, &rivet_module); /* per directory config */
newconfig = (rivet_server_conf *) ap_pcalloc(r->pool, sizeof(rivet_server_conf));
newconfig->server_interp = rsc->server_interp;
copy_rivet_config(r->pool, rsc, newconfig);
/* list here things that can be per-directory */
newconfig->rivet_before_script = rdc->rivet_before_script ?
rdc->rivet_before_script : rsc->rivet_before_script;
newconfig->rivet_after_script = rdc->rivet_after_script ?
rdc->rivet_after_script : rsc->rivet_after_script;
newconfig->rivet_error_script = rdc->rivet_error_script ?
rdc->rivet_error_script : rsc->rivet_error_script;
return newconfig;
}
return rsc; /* if there is no per dir config, just return the
server config */
}
static void copy_rivet_config(pool *p, rivet_server_conf *oldrsc, rivet_server_conf *newrsc)
{
newrsc->server_interp = oldrsc->server_interp;
newrsc->rivet_global_init_script = oldrsc->rivet_global_init_script;
newrsc->rivet_child_init_script = oldrsc->rivet_child_init_script;
newrsc->rivet_child_exit_script = oldrsc->rivet_child_exit_script;
newrsc->rivet_before_script = oldrsc->rivet_before_script;
newrsc->rivet_after_script = oldrsc->rivet_after_script;
newrsc->rivet_error_script = oldrsc->rivet_error_script;
/* these are pointers so that they can be passed around... */
newrsc->cache_size = oldrsc->cache_size;
newrsc->cache_free = oldrsc->cache_free;
newrsc->cache_size = oldrsc->cache_size;
newrsc->cache_free = oldrsc->cache_free;
newrsc->upload_max = oldrsc->upload_max;
newrsc->upload_files_to_var = oldrsc->upload_files_to_var;
newrsc->seperate_virtual_interps = oldrsc->seperate_virtual_interps;
newrsc->server_name = oldrsc->server_name;
newrsc->upload_dir = oldrsc->upload_dir;
newrsc->objCacheList = oldrsc->objCacheList;
newrsc->objCache = oldrsc->objCache;
newrsc->namespacePrologue = oldrsc->namespacePrologue;
newrsc->buffer_output = oldrsc->buffer_output;
newrsc->headers_printed = oldrsc->headers_printed;
newrsc->headers_set = oldrsc->headers_set;
newrsc->content_sent = oldrsc->content_sent;
newrsc->buffer = oldrsc->buffer;
newrsc->outchannel = oldrsc->outchannel;
}
static void *create_rivet_config(pool *p, server_rec *s)
{
rivet_server_conf *rsc = (rivet_server_conf *) ap_pcalloc(p, sizeof(rivet_server_conf));
rsc->server_interp = NULL;
rsc->rivet_global_init_script = NULL;
rsc->rivet_child_init_script = NULL;
rsc->rivet_child_exit_script = NULL;
rsc->rivet_before_script = NULL;
rsc->rivet_after_script = NULL;
rsc->rivet_error_script = NULL;
/* these are pointers so that they can be passed around... */
rsc->cache_size = ap_pcalloc(p, sizeof(int));
rsc->cache_free = ap_pcalloc(p, sizeof(int));
*(rsc->cache_size) = -1;
*(rsc->cache_free) = 0;
rsc->upload_max = 0;
rsc->upload_files_to_var = 0;
rsc->seperate_virtual_interps = 0;
rsc->server_name = NULL;
rsc->upload_dir = "/tmp";
rsc->objCacheList = NULL;
rsc->objCache = ap_pcalloc(p, sizeof(Tcl_HashTable));
rsc->namespacePrologue = NULL;
rsc->buffer_output = ap_pcalloc(p, sizeof(int));
rsc->headers_printed = ap_pcalloc(p, sizeof(int));
rsc->headers_set = ap_pcalloc(p, sizeof(int));
rsc->content_sent = ap_pcalloc(p, sizeof(int));
*(rsc->buffer_output) = 0;
*(rsc->headers_printed) = 0;
*(rsc->headers_set) = 0;
*(rsc->content_sent) = 0;
rsc->buffer = ap_pcalloc(p, sizeof(Tcl_DString));
Tcl_DStringInit(rsc->buffer);
rsc->outchannel = ap_pcalloc(p, sizeof(Tcl_Channel));
return rsc;
}
void *create_rivet_dir_config(pool *p, char *dir)
{
rivet_server_conf *rdc = (rivet_server_conf *) ap_pcalloc(p, sizeof(rivet_server_conf));
return rdc;
}
void *merge_rivet_config(pool *p, void *basev, void *overridesv)
{
rivet_server_conf *rsc = (rivet_server_conf *) ap_pcalloc(p, sizeof(rivet_server_conf));
rivet_server_conf *base = (rivet_server_conf *) basev;
rivet_server_conf *overrides = (rivet_server_conf *) overridesv;
rsc->server_interp = overrides->server_interp ?
overrides->server_interp : base->server_interp;
#if 0 /* this stuff should only be done once at the top level */
rsc->rivet_global_init_script = overrides->rivet_global_init_script ?
overrides->rivet_global_init_script : base->rivet_global_init_script;
rsc->rivet_child_init_script = overrides->rivet_child_init_script ?
overrides->rivet_child_init_script : base->rivet_child_init_script;
rsc->rivet_child_exit_script = overrides->rivet_child_exit_script ?
overrides->rivet_child_exit_script : base->rivet_child_exit_script;
#endif
rsc->rivet_before_script = overrides->rivet_before_script ?
overrides->rivet_before_script : base->rivet_before_script;
rsc->rivet_after_script = overrides->rivet_after_script ?
overrides->rivet_after_script : base->rivet_after_script;
rsc->rivet_error_script = overrides->rivet_error_script ?
overrides->rivet_error_script : base->rivet_error_script;
/* rsc->cache_size = overrides->cache_size ?
overrides->cache_size : base->cache_size;
rsc->cache_free = overrides->cache_free ?
overrides->cache_free : base->cache_free; */
rsc->upload_max = overrides->upload_max ?
overrides->upload_max : base->upload_max;
rsc->server_name = overrides->server_name ?
overrides->server_name : base->server_name;
rsc->upload_dir = overrides->upload_dir ?
overrides->upload_dir : base->upload_dir;
return rsc;
}
void rivet_child_init(server_rec *s, pool *p)
{
server_rec *sr;
rivet_server_conf *rsc;
#if THREADED_TCL == 1
tcl_init_stuff(s, p);
#endif
sr = s;
while(sr)
{
rsc = (rivet_server_conf *) ap_get_module_config(sr->module_config, &rivet_module);
if (rsc->rivet_child_init_script != NULL)
if (Tcl_EvalObjEx(rsc->server_interp, rsc->rivet_child_init_script, 0) != TCL_OK)
ap_log_error(APLOG_MARK, APLOG_ERR, s,
"Problem running child init script: %s",
Tcl_GetString(rsc->rivet_child_init_script));
sr = sr->next;
}
}
void rivet_child_exit(server_rec *s, pool *p)
{
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(s->module_config, &rivet_module);
if (rsc->rivet_child_exit_script != NULL)
if (Tcl_EvalObjEx(rsc->server_interp, rsc->rivet_child_exit_script, 0) != TCL_OK)
ap_log_error(APLOG_MARK, APLOG_ERR, s,
"Problem running child exit script: %s",
Tcl_GetStringFromObj(rsc->rivet_child_exit_script, NULL));
}
const handler_rec rivet_handlers[] =
{
{"application/x-httpd-tcl", send_content},
{"application/x-rivet-tcl", send_content},
{NULL}
};
const command_rec rivet_cmds[] =
{
{"Rivet_Script", set_script, NULL, OR_FILEINFO, TAKE2, "Rivet_Script GlobalInitScript|ChildInitScript|ChildExitScript|BeforeScript|AfterScript|ErrorScript \"tcl source code\""},
{"Rivet_CacheSize", set_cachesize, NULL, RSRC_CONF, TAKE1, "Rivet_Cachesize cachesize"},
{"Rivet_UploadDirectory", set_uploaddir, NULL, RSRC_CONF, TAKE1, "Rivet_UploadDirectory dirname"},
{"Rivet_UploadMaxSize", set_uploadmax, NULL, RSRC_CONF, TAKE1, "Rivet_UploadMaxSize size"},
{"Rivet_UploadFilesToVar", set_filestovar, NULL, RSRC_CONF, TAKE1, "Rivet_UploadFilesToVar on/off"},
{"Rivet_SeperateVirtualInterps", set_seperatevirtinterps, NULL, RSRC_CONF, TAKE1, "Rivet_SeperateVirtualInterps on/off"},
{NULL}
};
module MODULE_VAR_EXPORT rivet_module =
{
STANDARD_MODULE_STUFF,
rivet_init_handler, /* initializer */
create_rivet_dir_config, /* dir config creater */
NULL, /* dir merger --- default is to override */
create_rivet_config, /* server config */
merge_rivet_config, /* merge server config */
rivet_cmds, /* command table */
rivet_handlers, /* handlers */
NULL, /* filename translation */
NULL, /* check_user_id */
NULL, /* check auth */
NULL, /* check access */
NULL, /* type_checker */
NULL, /* fixups */
NULL, /* logger */
NULL, /* header parser */
rivet_child_init, /* child_init */
rivet_child_exit, /* child_exit */
NULL /* post read-request */
};
/*
Local Variables: ***
compile-command: "./make.tcl" ***
End: ***
*/
1.1 tcl-rivet/src/mod_rivet.h
Index: mod_rivet.h
===================================================================
#ifndef MOD_RIVET_H
#define MOD_RIVET_H 1
#include <tcl.h>
#include "apache_request.h"
/* Error wrappers */
#define ER1 "<hr><p><code><pre>\n"
#define ER2 "</pre></code><hr>\n"
/* Enable debugging */
#define DBG 0
/* Configuration options */
/* If you do not have a threaded Tcl, you can define this to 0. This
has the effect of running Tcl Init code in the main parent init
handler, instead of in child init handlers. */
#ifdef __MINGW32__
#define THREADED_TCL 1
#else
#define THREADED_TCL 0 /* Unless you have MINGW32, modify this one! */
#endif
/* If you want to show the mod_rivet version, you can define this to 0.
Otherwise, set this to 1 to hide the version from potential
troublemakers. */
#define HIDE_RIVET_VERSION 1
/* Turn off 'old-style' $UPLOAD variable, and use only the 'upload'
command. */
#define USE_ONLY_UPLOAD_COMMAND 0
/* End Configuration options */
#define STARTING_SEQUENCE "<?"
#define ENDING_SEQUENCE "?>"
#define DEFAULT_ERROR_MSG "[an error occurred while processing this directive]"
#define DEFAULT_TIME_FORMAT "%A, %d-%b-%Y %H:%M:%S %Z"
#define DEFAULT_HEADER_TYPE "text/html"
#define MULTIPART_FORM_DATA 1
/* #define RIVET_VERSION "X.X.X" */
typedef struct {
Tcl_Interp *server_interp; /* per server Tcl interpreter */
Tcl_Obj *rivet_global_init_script; /* run once when apache is first started */
Tcl_Obj *rivet_child_init_script;
Tcl_Obj *rivet_child_exit_script;
Tcl_Obj *rivet_before_script; /* script run before each page */
Tcl_Obj *rivet_after_script; /* after */
Tcl_Obj *rivet_error_script; /* for errors */
int *cache_size;
int *cache_free;
int upload_max;
int upload_files_to_var;
int seperate_virtual_interps;
char *server_name;
char *upload_dir;
char **objCacheList; /* Array of cached objects (for priority handling) */
Tcl_HashTable *objCache; /* Objects cache - the key is the script name */
Tcl_Obj *namespacePrologue; /* initial bit of Tcl for namespace creation */
/* stuff for buffering output */
int *buffer_output; /* Start with output buffering off */
int *headers_printed; /* has the header been printed yet? */
int *headers_set; /* has the header been set yet? */
int *content_sent; /* make sure something gets sent */
Tcl_DString *buffer;
Tcl_Channel *outchannel;
} rivet_server_conf;
/* eventually we will transfer 'global' variables in here and
'de-globalize' them */
typedef struct {
request_rec *r; /* request rec */
ApacheRequest *req; /* libapreq request */
} rivet_interp_globals;
int get_parse_exec_file(request_rec *r, rivet_server_conf *rsc, int toplevel);
int set_header_type(request_rec *, char *);
int print_headers(request_rec *);
int print_error(request_rec *, int, char *);
int flush_output_buffer(request_rec *);
char *StringToUtf(char *input, ap_pool *pool);
rivet_server_conf *rivet_get_conf(request_rec *r);
/* Macro to Tcl Objectify StringToUtf stuff */
#define STRING_TO_UTF_TO_OBJ(string, pool) Tcl_NewStringObj(StringToUtf(string, pool), -1)
#endif
1.1 tcl-rivet/src/parser.c
Index: parser.c
===================================================================
/* $Id: parser.c,v 1.1 2001/09/19 13:12:58 davidw Exp $
Rivet parser - doesn't really need any of the includes besides
tcl.h.
*/
#include <tcl.h>
#include "httpd.h"
#include "apache_request.h"
#include "mod_rivet.h"
/*
accepts an 'outbuf' to be filled, and an open file descritptor
returns 'inside', letting the caller know whether the parser was
inside a block of Tcl or not when it stopped.
*/
int rivet_parser(Tcl_Obj *outbuf, FILE *openfile)
{
const char *strstart = STARTING_SEQUENCE;
const char *strend = ENDING_SEQUENCE;
char c;
int ch;
int endseqlen = strlen(ENDING_SEQUENCE), startseqlen = strlen(STARTING_SEQUENCE), p = 0;
int inside = 0;
Tcl_DString dstr;
Tcl_DString convdstr;
Tcl_DStringInit(&dstr);
while ((ch = getc(openfile)) != EOF)
{
if (ch == -1)
return -1;
c = ch;
if (!inside)
{
/* OUTSIDE */
#if USE_OLD_TAGS == 1
if (c == '<')
{
int nextchar = getc(openfile);
if (nextchar == '+')
{
Tcl_DStringAppend(&dstr, "\"\n", 2);
inside = 1;
p = 0;
continue;
} else {
ungetc(nextchar, openfile);
}
}
#endif
if (c == strstart[p])
{
if ((++p) == endseqlen)
{
/* ok, we have matched the whole ending sequence - do something */
Tcl_DStringAppend(&dstr, "\"\n", 2);
inside = 1;
p = 0;
continue;
}
} else {
if (p > 0)
Tcl_DStringAppend(&dstr, (char *)strstart, p);
/* or else just put the char in outbuf */
switch (c)
{
case '$':
Tcl_DStringAppend(&dstr, "\\$", -1);
break;
case '[':
Tcl_DStringAppend(&dstr, "\\[", -1);
break;
case ']':
Tcl_DStringAppend(&dstr, "\\]", -1);
break;
case '"':
Tcl_DStringAppend(&dstr, "\\\"", -1);
break;
case '\\':
Tcl_DStringAppend(&dstr, "\\\\", -1);
break;
default:
Tcl_DStringAppend(&dstr, &c, 1);
break;
}
p = 0;
continue;
}
} else {
/* INSIDE */
#if USE_OLD_TAGS == 1
if (c == '+')
{
int nextchar = getc(openfile);
if (nextchar == '>')
{
Tcl_DStringAppend(&dstr, "\n hputs \"", -1);
inside = 0;
p = 0;
continue;
} else {
ungetc(nextchar, openfile);
}
}
#endif
if (c == strend[p])
{
if ((++p) == startseqlen)
{
Tcl_DStringAppend(&dstr, "\n hputs \"", -1);
inside = 0;
p = 0;
continue;
}
}
else
{
/* plop stuff into outbuf, which we will then eval */
if (p > 0)
Tcl_DStringAppend(&dstr, (char *)strend, p);
Tcl_DStringAppend(&dstr, &c, 1);
p = 0;
}
}
}
Tcl_ExternalToUtfDString(NULL,
Tcl_DStringValue(&dstr),
Tcl_DStringLength(&dstr),
&convdstr);
Tcl_AppendToObj(outbuf, Tcl_DStringValue(&convdstr),
Tcl_DStringLength(&convdstr));
Tcl_DStringFree(&dstr);
Tcl_DStringFree(&convdstr);
return inside;
}
1.1 tcl-rivet/src/parser.h
Index: parser.h
===================================================================
int rivet_parser(Tcl_Obj *outbuf, FILE *openfile);
1.1 tcl-rivet/src/tcl_commands.c
Index: tcl_commands.c
===================================================================
#include "httpd.h"
#include "http_config.h"
#include "http_request.h"
#include "http_core.h"
#include "http_protocol.h"
#include "http_log.h"
#include "http_main.h"
#include "util_script.h"
#include "http_conf_globals.h"
#include <tcl.h>
#include <string.h>
#include "tcl_commands.h"
#include "apache_request.h"
#include "apache_cookie.h"
#include "mod_rivet.h"
#define BUFSZ 4096
extern module rivet_module;
extern Tcl_Obj *uploadstorage[];
#define POOL (globals->r->pool)
/* Include and parse a file */
int Parse(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *filename;
struct stat finfo;
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(globals->r->server->module_config, &rivet_module);
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "filename");
return TCL_ERROR;
}
filename = Tcl_GetStringFromObj (objv[1], (int *)NULL);
if (!strcmp(filename, globals->r->filename))
{
Tcl_AddErrorInfo(interp, "Cannot recursively call the same file!");
return TCL_ERROR;
}
if (stat(filename, &finfo))
{
Tcl_AddErrorInfo(interp, Tcl_PosixError(interp));
return TCL_ERROR;
}
if (get_parse_exec_file(globals->r, rsc, 0) == OK)
return TCL_OK;
else
return TCL_ERROR;
}
/* Tcl command to include flat files */
int Include(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
Tcl_Channel fd;
int sz;
char buf[BUFSZ];
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
rivet_server_conf *rsc =
(rivet_server_conf *)ap_get_module_config(globals->r->server->module_config,
&rivet_module);
Tcl_Obj *outobj;
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "filename");
return TCL_ERROR;
}
fd = Tcl_OpenFileChannel(interp,
Tcl_GetStringFromObj(objv[1], (int *)NULL), "r", 0664);
if (fd == NULL)
{
return TCL_ERROR;
} else {
Tcl_SetChannelOption(interp, fd, "-translation", "lf");
}
/* print_headers(globals->r);
flush_output_buffer(globals->r); */
outobj = Tcl_NewObj();
Tcl_IncrRefCount(outobj);
while ((sz = Tcl_ReadChars(fd, outobj, BUFSZ - 1, 0)))
{
if (sz == -1)
{
Tcl_AddErrorInfo(interp, Tcl_PosixError(interp));
Tcl_DecrRefCount(outobj);
return TCL_ERROR;
}
buf[sz] = '\0';
/* we could include code to either ap_pwrite this or memwrite
it, depending on buffering */
Tcl_WriteObj(*(rsc->outchannel), outobj);
if (sz < BUFSZ - 1)
break;
}
Tcl_DecrRefCount(outobj);
return Tcl_Close(interp, fd);
}
/* Command to *only* add to the output buffer */
int Buffer_Add(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(globals->r->server->module_config, &rivet_module);
if (objc < 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
Tcl_WriteObj(*(rsc->outchannel), objv[1]);
*(rsc->content_sent) = 0;
return TCL_OK;
}
/* Tcl command to output some text to the web server */
int Hputs(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *arg1;
int length;
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(globals->r->server->module_config, &rivet_module);
if (objc < 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "?-error? string");
return TCL_ERROR;
}
arg1 = Tcl_GetStringFromObj(objv[1], &length);
if (!strncmp("-error", arg1, 6))
{
if (objc != 3)
{
Tcl_WrongNumArgs(interp, 1, objv, "?-error? string");
return TCL_ERROR;
}
ap_log_error(APLOG_MARK, APLOG_NOERRNO|APLOG_NOTICE,
globals->r->server, "Mod_Rivet Error: %s",
Tcl_GetStringFromObj (objv[2], (int *)NULL));
} else {
Tcl_DString outstring;
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "?-error? string");
return TCL_ERROR;
}
/* transform it from UTF to External representation */
Tcl_UtfToExternalDString(NULL, arg1, length, &outstring);
arg1 = Tcl_DStringValue(&outstring);
length = Tcl_DStringLength(&outstring);
if (*(rsc->buffer_output) == 1)
{
Tcl_DStringAppend(rsc->buffer, arg1, length);
} else {
print_headers(globals->r);
flush_output_buffer(globals->r);
ap_rwrite(arg1, length, globals->r);
}
Tcl_DStringFree(&outstring);
}
return TCL_OK;
}
/* Tcl command to manipulate headers */
int Headers(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *opt;
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(globals->r->server->module_config, &rivet_module);
if (objc < 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
if (*(rsc->headers_printed) != 0)
{
Tcl_AddObjErrorInfo(interp, "Cannot manipulate headers - already sent", -1);
return TCL_ERROR;
}
opt = Tcl_GetStringFromObj(objv[1], NULL);
if (!strcmp("setcookie", opt)) /* ### setcookie ### */
{
int i;
ApacheCookie *cookie;
char *stringopts[12] = {NULL, NULL, NULL, NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL, NULL};
if (objc < 4 || objc > 14)
{
Tcl_WrongNumArgs(interp, 2, objv,
"-name cookie-name -value cookie-value ?-expires expires? ?-domain domain? ?-path path? ?-secure on/off?");
return TCL_ERROR;
}
/* SetCookie: foo=bar; EXPIRES=DD-Mon-YY HH:MM:SS; DOMAIN=domain; PATH=path; SECURE */
for (i = 0; i < objc - 2; i++)
{
stringopts[i] = Tcl_GetString(objv[i + 2]);
}
cookie = ApacheCookie_new(globals->r,
stringopts[0], stringopts[1],
stringopts[2], stringopts[3],
stringopts[4], stringopts[5],
stringopts[6], stringopts[7],
stringopts[8], stringopts[9],
stringopts[10], stringopts[11],
NULL);
ApacheCookie_bake(cookie);
}
else if (!strcmp("redirect", opt)) /* ### redirect ### */
{
if (objc != 3)
{
Tcl_WrongNumArgs(interp, 2, objv, "new-url");
return TCL_ERROR;
}
ap_table_set(globals->r->headers_out, "Location",
Tcl_GetStringFromObj (objv[2], (int *)NULL));
globals->r->status = 301;
return TCL_RETURN;
}
else if (!strcmp("set", opt)) /* ### set ### */
{
if (objc != 4)
{
Tcl_WrongNumArgs(interp, 2, objv, "headername value");
return TCL_ERROR;
}
ap_table_set(globals->r->headers_out,
Tcl_GetStringFromObj (objv[2], (int *)NULL),
Tcl_GetStringFromObj (objv[3], (int *)NULL));
}
else if (!strcmp("type", opt)) /* ### set ### */
{
if (objc != 3)
{
Tcl_WrongNumArgs(interp, 2, objv, "mime/type");
return TCL_ERROR;
}
set_header_type(globals->r, Tcl_GetStringFromObj(objv[2], (int *)NULL));
} else if (!strcmp("numeric", opt)) /* ### numeric ### */
{
int st = 200;
if (objc != 3)
{
Tcl_WrongNumArgs(interp, 2, objv, "response code");
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, objv[2], &st) != TCL_ERROR)
globals->r->status = st;
else
return TCL_ERROR;
} else {
/* XXX Tcl_WrongNumArgs(interp, 1, objv, "headers option arg ?arg ...?"); */
return TCL_ERROR;
}
return TCL_OK;
}
/* turn buffering on and off */
int Buffered(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *opt = NULL;
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(globals->r->server->module_config, &rivet_module);
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "on/off");
return TCL_ERROR;
}
opt = Tcl_GetStringFromObj(objv[1], NULL);
if (!strncmp(opt, "on", 2))
{
*(rsc->buffer_output) = 1;
} else if (!strncmp(opt, "off", 3)) {
*(rsc->buffer_output) = 0;
print_headers(globals->r);
flush_output_buffer(globals->r);
} else {
return TCL_ERROR;
}
return TCL_OK;
}
/* Tcl command to flush the output stream */
int HFlush(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
if (objc != 1)
{
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
print_headers(globals->r);
flush_output_buffer(globals->r);
ap_rflush(globals->r);
return TCL_OK;
}
/* Tcl command to get and parse any CGI and environmental variables */
/* Get the environmental variables, but do it from a tcl function, so
we can decide whether we wish to or not */
int HGetVars(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *timefmt = DEFAULT_TIME_FORMAT;
#ifndef WIN32
struct passwd *pw;
#endif /* ndef WIN32 */
char *t;
char *authorization = NULL;
time_t date;
int i;
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
array_header *hdrs_arr;
table_entry *hdrs;
array_header *env_arr;
table_entry *env;
Tcl_Obj *EnvsObj = NULL;
EnvsObj = Tcl_NewStringObj("::request::ENVS", -1);
Tcl_IncrRefCount(EnvsObj);
date = globals->r->request_time;
/* ensure that the system area which holds the cgi variables is empty */
ap_clear_table(globals->r->subprocess_env);
/* retrieve cgi variables */
ap_add_cgi_vars(globals->r);
ap_add_common_vars(globals->r);
hdrs_arr = ap_table_elts(globals->r->headers_in);
hdrs = (table_entry *) hdrs_arr->elts;
env_arr = ap_table_elts(globals->r->subprocess_env);
env = (table_entry *) env_arr->elts;
/* Get the user/pass info for Basic authentication */
(const char*)authorization = ap_table_get(globals->r->headers_in, "Authorization");
if (authorization && !strcasecmp(ap_getword_nc(POOL, &authorization, ' '), "Basic"))
{
char *tmp;
char *user;
char *pass;
tmp = ap_pbase64decode(POOL, authorization);
user = ap_getword_nulls_nc(POOL, &tmp, ':');
pass = tmp;
Tcl_ObjSetVar2(interp, Tcl_NewStringObj("::request::USER", -1),
Tcl_NewStringObj("user", -1),
STRING_TO_UTF_TO_OBJ(user, POOL),
0);
Tcl_ObjSetVar2(interp, Tcl_NewStringObj("::request::USER", -1),
Tcl_NewStringObj("pass", -1),
STRING_TO_UTF_TO_OBJ(pass, POOL),
0);
}
/* These were the "include vars" */
Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DATE_LOCAL", -1),
STRING_TO_UTF_TO_OBJ(ap_ht_time(POOL, date, timefmt, 0), POOL), 0);
Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DATE_GMT", -1),
STRING_TO_UTF_TO_OBJ(ap_ht_time(POOL, date, timefmt, 1), POOL), 0);
Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("LAST_MODIFIED", -1),
STRING_TO_UTF_TO_OBJ(ap_ht_time(POOL, globals->r->finfo.st_mtime, timefmt, 0), POOL), 0);
Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DOCUMENT_URI", -1),
STRING_TO_UTF_TO_OBJ(globals->r->uri, POOL), 0);
Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DOCUMENT_PATH_INFO", -1),
STRING_TO_UTF_TO_OBJ(globals->r->path_info, POOL), 0);
#ifndef WIN32
pw = getpwuid(globals->r->finfo.st_uid);
if (pw)
Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("USER_NAME", -1),
STRING_TO_UTF_TO_OBJ(ap_pstrdup(POOL, pw->pw_name), POOL), 0);
else
Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("USER_NAME", -1),
STRING_TO_UTF_TO_OBJ(
ap_psprintf(POOL, "user#%lu",
(unsigned long) globals->r->finfo.st_uid), POOL), 0);
#endif
if ((t = strrchr(globals->r->filename, '/')))
Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DOCUMENT_NAME", -1),
STRING_TO_UTF_TO_OBJ(++t, POOL), 0);
else
Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("DOCUMENT_NAME", -1),
STRING_TO_UTF_TO_OBJ(globals->r->uri, POOL), 0);
if (globals->r->args)
{
char *arg_copy = ap_pstrdup(POOL, globals->r->args);
ap_unescape_url(arg_copy);
Tcl_ObjSetVar2(interp, EnvsObj, Tcl_NewStringObj("QUERY_STRING_UNESCAPED", -1),
STRING_TO_UTF_TO_OBJ(ap_escape_shell_cmd(POOL, arg_copy), POOL), 0);
}
/* ---------------------------- */
/* transfer client request headers to TCL request namespace */
for (i = 0; i < hdrs_arr->nelts; ++i)
{
if (!hdrs[i].key)
continue;
else {
Tcl_ObjSetVar2(interp, EnvsObj, STRING_TO_UTF_TO_OBJ(hdrs[i].key, POOL),
STRING_TO_UTF_TO_OBJ(hdrs[i].val, POOL), 0);
}
}
/* transfer apache internal cgi variables to TCL request namespace */
for (i = 0; i < env_arr->nelts; ++i)
{
if (!env[i].key)
continue;
Tcl_ObjSetVar2(interp, EnvsObj, STRING_TO_UTF_TO_OBJ(env[i].key, POOL),
STRING_TO_UTF_TO_OBJ(env[i].val, POOL), 0);
}
do { /* I do this because I want some 'local' variables */
ApacheCookieJar *cookies = ApacheCookie_parse(globals->r, NULL);
Tcl_Obj *cookieobj = Tcl_NewStringObj("::request::COOKIES", -1);
for (i = 0; i < ApacheCookieJarItems(cookies); i++) {
ApacheCookie *c = ApacheCookieJarFetch(cookies, i);
int j;
for (j = 0; j < ApacheCookieItems(c); j++) {
char *name = c->name;
char *value = ApacheCookieFetch(c, j);
Tcl_ObjSetVar2(interp, cookieobj,
Tcl_NewStringObj(name, -1),
Tcl_NewStringObj(value, -1), 0);
/* STRING_TO_UTF_TO_OBJ(name, POOL),
STRING_TO_UTF_TO_OBJ(value, POOL), 0); */
}
}
} while (0);
/* cleanup system cgi variables */
ap_clear_table(globals->r->subprocess_env);
return TCL_OK;
}
/* Tcl command to return a particular variable. */
/* Use:
var get foo
var list foo
var names
var number
var all
*/
int Var(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *command;
int i;
Tcl_Obj *result = NULL;
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
array_header *parmsarray = ap_table_elts(globals->req->parms);
table_entry *parms = (table_entry *)parmsarray->elts;
if (objc < 2 || objc > 3)
{
Tcl_WrongNumArgs(interp, 1, objv,
"(get varname|list varname|exists varname|names|number|all)");
return TCL_ERROR;
}
command = Tcl_GetString(objv[1]);
if (!strcmp(command, "get"))
{
char *key = NULL;
if (objc != 3)
{
Tcl_WrongNumArgs(interp, 2, objv, "variablename");
return TCL_ERROR;
}
key = Tcl_GetStringFromObj(objv[2], NULL);
/* This isn't real efficient - move to hash table later
on... */
for (i = 0; i < parmsarray->nelts; ++i)
{
if (!strncmp(key, StringToUtf(parms[i].key, POOL), strlen(key)))
{
/* The following makes sure that we get one string,
with no sub lists. */
if (result == NULL)
{
result = STRING_TO_UTF_TO_OBJ(parms[i].val, POOL);
Tcl_IncrRefCount(result);
} else {
Tcl_Obj *tmpobjv[2];
tmpobjv[0] = result;
tmpobjv[1] = STRING_TO_UTF_TO_OBJ(parms[i].val, POOL);
result = Tcl_ConcatObj(2, tmpobjv);
}
}
}
if (result == NULL)
Tcl_AppendResult(interp, "", NULL);
else
Tcl_SetObjResult(interp, result);
} else if(!strcmp(command, "exists")) {
char *key;
if (objc != 3)
{
Tcl_WrongNumArgs(interp, 2, objv, "variablename");
return TCL_ERROR;
}
key = Tcl_GetString(objv[2]);
/* This isn't real efficient - move to hash table later on. */
for (i = 0; i < parmsarray->nelts; ++i)
{
if (!strncmp(key, StringToUtf(parms[i].key, POOL), strlen(key)))
{
result = Tcl_NewIntObj(1);
Tcl_IncrRefCount(result);
}
}
if (result == NULL)
Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
else
Tcl_SetObjResult(interp, result);
} else if(!strcmp(command, "list")) {
char *key;
if (objc != 3)
{
Tcl_WrongNumArgs(interp, 2, objv, "variablename");
return TCL_ERROR;
}
key = Tcl_GetStringFromObj(objv[2], NULL);
/* This isn't real efficient - move to hash table later on. */
for (i = 0; i < parmsarray->nelts; ++i)
{
if (!strncmp(key, StringToUtf(parms[i].key, POOL), strlen(key)))
{
if (result == NULL)
{
result = Tcl_NewObj();
Tcl_IncrRefCount(result);
}
Tcl_ListObjAppendElement(interp, result,
STRING_TO_UTF_TO_OBJ(parms[i].val, POOL));
}
}
if (result == NULL)
Tcl_AppendResult(interp, "", NULL);
else
Tcl_SetObjResult(interp, result);
} else if(!strcmp(command, "names")) {
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
result = Tcl_NewObj();
Tcl_IncrRefCount(result);
for (i = 0; i < parmsarray->nelts; ++i)
{
Tcl_ListObjAppendElement(interp, result,
STRING_TO_UTF_TO_OBJ(parms[i].key, POOL));
}
if (result == NULL)
Tcl_AppendResult(interp, "", NULL);
else
Tcl_SetObjResult(interp, result);
} else if(!strcmp(command, "number")) {
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
result = Tcl_NewIntObj(parmsarray->nelts);
Tcl_IncrRefCount(result);
Tcl_SetObjResult(interp, result);
} else if(!strcmp(command, "all")) {
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
result = Tcl_NewObj();
Tcl_IncrRefCount(result);
for (i = 0; i < parmsarray->nelts; ++i)
{
Tcl_ListObjAppendElement(interp, result,
STRING_TO_UTF_TO_OBJ(parms[i].key, POOL));
Tcl_ListObjAppendElement(interp, result,
STRING_TO_UTF_TO_OBJ(parms[i].val, POOL));
}
if (result == NULL)
Tcl_AppendResult(interp, "", NULL);
else
Tcl_SetObjResult(interp, result);
} else {
/* bad command */
Tcl_AddErrorInfo(interp, "bad option: must be one of 'get, list, names, number, all'");
return TCL_ERROR;
}
return TCL_OK;
}
/*
upload get XYZ
channel # returns channel
save (name) # returns name?
data # returns data
with the third one reporting an error if this hasn't been enabled, or
the first two if it has.
upload info XYZ
exists
size
type
filename
upload names
gets all the upload names.
*/
int Upload(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *command = NULL;
Tcl_Obj *result = NULL;
ApacheUpload *upload;
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(globals->r->server->module_config, &rivet_module);
if (objc < 2 || objc > 5)
{
Tcl_WrongNumArgs(interp, 1, objv, "get ...|info ...|names");
return TCL_ERROR;
}
command = Tcl_GetString(objv[1]);
result = Tcl_NewObj();
if (!strcmp(command, "get"))
{
char *varname = NULL;
if (objc < 4)
{
Tcl_WrongNumArgs(interp, 2, objv, "varname channel|save filename|var varname");
return TCL_ERROR;
}
varname = Tcl_GetString(objv[2]);
upload = ApacheUpload_find(globals->req->upload, varname);
if (upload != NULL) /* make sure we have an upload */
{
Tcl_Channel chan;
char *method = Tcl_GetString(objv[3]);
if (!strcmp(method, "channel"))
{
if (ApacheUpload_FILE(upload) != NULL)
{
/* create and return a file channel */
char *channelname = NULL;
chan = Tcl_MakeFileChannel((ClientData)fileno(
ApacheUpload_FILE(upload)), TCL_READABLE);
Tcl_RegisterChannel(interp, chan);
channelname = Tcl_GetChannelName(chan);
Tcl_SetStringObj(result, channelname, -1);
}
} else if (!strcmp(method, "save")) {
/* save data to a specified filename */
int sz;
char savebuffer[BUFSZ];
Tcl_Channel savechan = NULL;
Tcl_Channel chan = NULL;
if (objc != 5)
{
Tcl_WrongNumArgs(interp, 4, objv, "filename");
return TCL_ERROR;
}
savechan = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[4]), "w", 0600);
if (savechan == NULL)
return TCL_ERROR;
else
Tcl_SetChannelOption(interp, savechan, "-translation", "binary");
chan = Tcl_MakeFileChannel((ClientData)fileno(
ApacheUpload_FILE(upload)), TCL_READABLE);
Tcl_SetChannelOption(interp, chan, "-translation", "binary");
while ((sz = Tcl_Read(chan, savebuffer, BUFSZ)))
{
if (sz == -1)
{
Tcl_AddErrorInfo(interp, Tcl_PosixError(interp));
return TCL_ERROR;
}
Tcl_Write(savechan, savebuffer, sz);
if (sz < 4096)
break;
}
Tcl_Close(interp, savechan);
Tcl_SetIntObj(result, 1);
} else if (!strcmp(method, "data")) {
/* this sucks - we should use the hook, but I want to
get everything fixed and working first */
if (rsc->upload_files_to_var)
{
char *bytes = NULL;
Tcl_Channel chan = NULL;
bytes = Tcl_Alloc(ApacheUpload_size(upload));
chan = Tcl_MakeFileChannel((ClientData)fileno(
ApacheUpload_FILE(upload)), TCL_READABLE);
Tcl_SetChannelOption(interp, chan, "-translation", "binary");
Tcl_SetChannelOption(interp, chan, "-encoding", "binary");
/* put data in a variable */
Tcl_ReadChars(chan, result, ApacheUpload_size(upload), 0);
} else {
Tcl_AppendResult(interp, "Rivet_UploadFilesToVar is not set", NULL);
return TCL_ERROR;
}
}
} else {
/* no variable found */
Tcl_SetStringObj(result, "", -1);
}
} else if (!strcmp(command, "info")) {
char *varname = NULL;
char *infotype = NULL;
if (objc != 4)
{
Tcl_WrongNumArgs(interp, 2, objv, "varname exists|size|type|filename");
return TCL_ERROR;
}
varname = Tcl_GetString(objv[2]);
infotype = Tcl_GetString(objv[3]);
upload = ApacheUpload_find(globals->req->upload, varname);
if (upload != NULL)
{
if (!strcmp(infotype, "exists"))
{
Tcl_SetIntObj(result, 1);
} else if (!strcmp(infotype, "size")) {
Tcl_SetIntObj(result, ApacheUpload_size(upload));
} else if (!strcmp(infotype, "type")) {
char *type = NULL;
type = (char *)ApacheUpload_type(upload);
if (type)
Tcl_SetStringObj(result, type, -1);
else
Tcl_SetStringObj(result, "", -1);
} else if (!strcmp(infotype, "filename")) {
Tcl_SetStringObj(result, StringToUtf(upload->filename, POOL), -1);
} else {
Tcl_AddErrorInfo(interp, "unknown upload info command, should be exists|size|type|filename");
return TCL_ERROR;
}
} else {
if (!strcmp(infotype, "exists")) {
Tcl_SetIntObj(result, 0);
} else {
Tcl_AddErrorInfo(interp, "variable doesn't exist");
return TCL_ERROR;
}
}
} else if (!strcmp(command, "names")) {
upload = ApacheRequest_upload(globals->req);
while (upload)
{
Tcl_ListObjAppendElement(interp, result,
STRING_TO_UTF_TO_OBJ(upload->name, POOL));
upload = upload->next;
}
} else {
Tcl_WrongNumArgs(interp, 1, objv, "upload get|info|names");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, result);
return TCL_OK;
}
/* Tcl command to get, and print some information about the current
state of affairs */
int Rivet_Info(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *tble;
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
rivet_server_conf *rsc = (rivet_server_conf *)ap_get_module_config(globals->r->server->module_config, &rivet_module);
tble = ap_psprintf(POOL,
"<table border=0 bgcolor=green><tr><td>\n"
"<table border=0 bgcolor=\"#000000\">\n"
"<tr><td align=center bgcolor=blue><font color=\"#ffffff\" size=\"+2\">rivet_info</font><br></td></tr>\n"
"<tr><td><font color=\"#ffffff\">Free cache size: %d</font><br></td></tr>\n"
"<tr><td><font color=\"#ffffff\">PID: %d</font><br></td></tr>\n"
"</table>\n"
"</td></tr></table>\n", *(rsc->cache_free), getpid());
/* print_headers(globals->r);
flush_output_buffer(globals->r); */
Tcl_WriteObj(*(rsc->outchannel), Tcl_NewStringObj(tble, -1));
return TCL_OK;
}
/* Tcl command to erase body, so that only header is returned.
Necessary for 304 responses */
int No_Body(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
rivet_interp_globals *globals = Tcl_GetAssocData(interp, "rivet", NULL);
rivet_server_conf *rsc = (rivet_server_conf *)
ap_get_module_config(globals->r->server->module_config, &rivet_module);
if (*(rsc->content_sent) == 1)
return TCL_ERROR;
print_headers(globals->r);
Tcl_DStringInit(rsc->buffer);
return TCL_OK;
}
1.1 tcl-rivet/src/tcl_commands.h
Index: tcl_commands.h
===================================================================
int Parse(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int Include(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int Buffer_Add(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int Hputs(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int Headers(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int Buffered(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int HFlush(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int HGetVars(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int Var(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int Upload(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int Rivet_Info(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
int No_Body(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);