| WeSQL documentation | Contained in the WeSQL distribution. |
Apache::WeSQL - Apache mod_perl module for WeSQL
PerlSetVar WeSQLConfig /var/www/WeSQL/somesite/conf/WeSQL.pl
PerlModule Apache::WeSQL::AppHandler
<FilesMatch "*.wsql">
SetHandler perl-script
PerlHandler Apache::WeSQL::AppHandler
</FilesMatch>
DocumentRoot "/var/www/WeSQL/somesite/public_html"
DirectoryIndex index.wsql
The Web-enabled SQL (WeSQL) Apache mod_perl module is an extension to HTML, acting as a glue between HTML and SQL. It allows the use of pure SQL queries directly in HTML files, embedded in a special tag. WeSQL translates the special tags into pure HTML, so using WeSQL is transparant for the browser. WeSQL is aimed at rapid web-database integration. WeSQL is written entirely in Perl and currently supports both MySQL and PostgreSQL as backend SQL databases.
Prerequisites for an easy installation: a unix system with working Apache, perl, mod_perl, and MySQL or PostgreSQL. We want to interface to a database, so we need several Perl modules. Do yourself a favour and get the latest versions of:
But if you are brave, there is no reason why WeSQL should not run on any system with any webserver that can execute Perl code as cgi-scripts, and can connect to a MySQL or PostgreSQL server.
The following tags are supported: LIST, EVAL, PARAMCHECK, CUTFILE, INCLUDE and LAYOUT.
In addition, the following features are implemented:
You can run multiple WeSQL websites (possibly accessing different databases) on the same web server. Here's how:
NameVirtualHost YOURIPHERE
<VirtualHost YOURIPHERE>
ServerAdmin someone@somewhere.org
ServerName somesite.somewhere.org
ErrorLog logs/somesite.somewhere.org-error_log
CustomLog logs/somesite.somewhere.org-access_log combined
PerlSetVar WeSQLConfig /var/www/WeSQL/somesite/conf/WeSQL.pl
PerlModule Apache::WeSQL::AppHandler
<FilesMatch "*.wsql">
SetHandler perl-script
PerlHandler Apache::WeSQL::AppHandler
</FilesMatch>
DocumentRoot "/var/www/WeSQL/somesite/public_html"
DirectoryIndex index.wsql
</VirtualHost>
This is a little complicated, and the reason for that is a namespace problem. The power of WeSQL is that it makes 1 database connection per server thread and keeps it, which means that you can intermix SQL and html in your WeSQL files. But if you want to run several applications on the same server, you will want a separate database connection for each application. That is why the AppHandler module needs to be duplicated and renamed, as the persistent database connection lives in that module. I have thought long and hard about this but have not found a better solution. If you have one, let me know!!
All files you want to be parsed by WeSQL should have the .wsql extension. Files with other extensions will be dealt with in the normal way by Apache.
There are a number of 'virtual' files that you can call, but don't exist on your hard-drive, the calls are intercepted by WeSQL. These are found in the display sub in WeSQL.pm, they are:
jadd.wsql jupdate.wsql jdelete.wsql jform.wsql jdeleteform.wsql jdetails.wsql jlist.wsql jloginform.wsql jlogin.wsql jlogout.wsql
These files are used by the journalling code and can be controlled by the form.cf, details.cf, list.cf and permissions.cf files, as explained in the Apache::WeSQL::Display man page.
If you don't want WeSQL to print HTTP headers before sending the result of your parsed wesql file to the browser, for instance because you want to generate it yourself, or because you want to redirect to another url, just make sure the name of the file ends in redirect.wsql, e.g. like this: file1redirect.wsql (this feature was introduced in WeSQL v0.52).
You will have noticed the PerlSetVar statement in the httpd.conf configuration:
PerlSetVar WeSQLConfig /var/www/WeSQL/somesite/conf/WeSQL.pl
This line sets the parameter 'WeSQLConfig', and gives it the value '/var/www/WeSQL/somesite/conf/WeSQL.pl'. This value is the position of the WeSQL config file for your application.
Please note that this file lives outside your documentroot by default. Even though it is possible, I don't recommend putting this file under your document root, as it contains sensitive information like the username and password to connect to your database.
Any changes to the WeSQL.pl file will require a restart of Apache.
This file is website-specific, and it defines the following parameters for the website:
WeSQL files are html files with special tags that are understood by WeSQL. They are processed in several steps, and the result is a clean HTML file that is delivered to the browser of the client.
You can decide which parsing steps you want WeSQL to use, by changing the @commandlist array. This is the default array:
@commandlist = ( 'dolayouttags($body)', 'dolanguages($body)', 'dosubst($body,"PR_",%params)', 'dosubst($body,"ENV_",%ENV)', 'dosubst($body,"COOKIE_",%cookies)', 'doeval($body,"PRE")', 'doinsert($body)', 'doeval($body,"POSTINSERT")', 'doparamcheck($body)', 'docutcheck($body)', 'doeval($body,"PRELIST")', 'dolist($body,$dbh)', 'doeval($body,"POST")', 'docutcheck($body)'
);
These default steps process the WeSQL file in the following order:
Since version 0.52, WeSQL supports 'content negotiation' for languages, as defined in the HTTP/1.1 standard. Compliant browsers (Mozilla, Opera 6.0 and higher, Netscape, ...) add an 'Accept-Language' header to the requests for files. WeSQL now understands those headers, and can serve the content in the correct language to the browser - provided, of course, that the content is available in this language.
Examples of language strings are 'en', 'nl', 'fr', 'de', etc.
In order to create content in other languages than the default language, for instance Dutch, you need to create a 'layout.nl.cf' file. If there is no need for a specific language version of your layout.cf file, just create a symlink to layout.cf.
In your .wsql files, you can now put text between <nl> and </nl> tags, which will make this text be sent to the browser _only_ if the browser asks for a version of the language in Dutch. This is done with the call to the 'dolanguages' sub in WeSQL.pm. If you forget to create a layout.nl.cf file, you will see the content between the <nl> and </nl> tags for requests in all languages.
If you are upgrading from an earlier WeSQL installation, you will need to add a line to the @commandlist in conf/WeSQL.pl. Preferably just after the dolayouttags call, like this:
@commandlist = (
'dolayouttags($body)',
'dolanguages($body)', <<<<<< Add this line
'dosubst($body,"PR_",%params)',
Here is the WeSQL decision path for which language to serve the requested document in:
1. Is there a language requested in the URI?
In order to get a specific language version of a file, for instance English, you can requests 'index.en.wsql'. This file does not exist on disk, but WeSQL will determine from this request that you really want the index.wsql file in English, and honour that request, provided the layout.en.cf file exists. If not, the layout.cf file will be used.
The side effect of this request, is that the default session language (see below) will be set to English. This has the effect of switching languages in the site, without having to worry about subsequent URLs.
Else: 2. Is there a language stored in the session?
If there is a session variable with name 'language' and a value different from '', WeSQL will serve the document in the language specified in the session variable.
This session variable is set after a call to a page requesting a specific language in the URI, as described under 1.
Else: 3. Is there a content negotiation 'Accept-Language' header?
If the browser sends an Accept-Language header, it will be respected, provided the corresponding layout.xx.cf file exists.
Else: 4. Fallback to layout.cf
Reducing the number of steps will improve performance, and disabling a particular step can be very useful for debugging - e.g. when LIST tags are being built dynamically in EVAL blocks.
You can add your own steps. Create a sub (preferably in your own module that you include in the Apache::WeSQL module - this will minimize problems if you upgrade your WeSQL) that takes some text as input (the $body parameter will be the input text) and returns the parsed $body. Then insert a call to your sub somewhere in the @commandlist. Don't forget to restart Apache for the changes to have effect.
This parameter determines whether you are using a MySQL or a PostgreSQL database. Set it to 0 for MySQL, and to 1 for PostgreSQL.
Example: $dbtype = 0;
Your database dsn.
Example: $dsn = "DBI:mysql:database=addressbook;host=localhost";
The user to connect to the database as.
Example: $dbuser = "milk";
The password to connect to the database with.
Example: $dbuser = "yoghurt";
These are parameters for the Apache::WeSQL::Auth module. See Apache::WeSQL::Auth for more information.
Say we have a HTML file that looks like this:
<html>
<body>
I have a parameter with the name 'beautiful' and value 'PR_BEAUTIFUL'.
</body>
</html>
And assume that we call this wesql file test.wsql, on a server http://www.somewhere.org.
A user comes along and requests: http://www.somewhere.org/test.wsql?beautiful=me
In this case, the resulting wsql file will become:
<html>
<body>
I have a parameter with the name 'beautiful' and value 'me'.
</body>
</html>
In general, PR_NAME is substituted with the value of the 'name' parameter (case-insensitive, could be 'NaMe' or 'naME' or ...) passed via GET or POST. If no parameter is provided, PR_NAME will be left untouched.
You can also specify a default value, for when the parameter is not defined, like this:
<html>
<body>
I have a parameter with the name 'beautiful' and value '[PR_BEAUTIFUL|people]'.
</body>
</html>
So when another user comes along, requesting just http://www.somewhere.org/test.wsql without parameters, (s)he will see:
<html>
<body>
I have a parameter with the name 'beautiful' and value 'people'.
</body>
</html>
And finally look at this:
<html>
<body>
I have a parameter with the name 'beautiful'[ and value 'PR_BEAUTIFUL'|, but it is not defined now].
</body>
</html>
Without the parameter beautiful defined, the user will see:
<html>
<body>
I have a parameter with the name 'beautiful', but it is not defined now.
</body>
</html>
Note that you can use a closing right bracket (]) in the alternative value by just escaping it with a backslash (\). Similarly, you can escape the pipe symbol with a backslash (\).
In a similar fashion, COOKIE_ and ENV_ style strings will be replaced by respectively the cookie or environment variable with the corresponding name.
There are 2 special ENV_ variables available for your use:
ENV_FILE_SIZE
ENV_FILE_LAST_MODIFIED
These two respectively hold the size and the last modification time (in seconds since EPOCH) of the current WeSQL document. Of course you can also access them through the %ENV hash in EVAL blocks.
Syntax:
<!-- INCLUDE [prefix] file -->
The include tag includes another WeSQL file. You should provide a prefix, which can be used to have a different set of variables available to the included WeSQL file. An example might clarify things a bit more. Let's assume we have a script called yoghurt.wsql, which - amongst other interesting stuff - contains the following line:
<!-- INCLUDE I1_ milk.wsql -->
Our yoghurt.wsql script is called as follows: http://diary.org/yoghurt.wsql?type=strawberry&I1_type=skimmed
When yoghurt.wsql is processed, there will be 2 parameters available to it: type and I1_type, just like you would expect. When the include tag is processed, WeSQL will see that the I1_type parameter starts with the prefix mentioned in the include tag, and pass the parameter I1_type to the milk.wsql file - but after translating it to type. So the milk.wsql file will see only one parameter, with the name type and the value skimmed.
If you want to use the same parameters for the included file as for the 'parent' file, just omit the 'prefix' parameter.
Say we have a WeSQL file that looks like this:
<html>
<body>
<!-- PARAMCHECK
<paramcheckhead>
<center>Below are the problems that have been encountered:<p>
</paramcheckhead>
PR_ONE /STOP/ <font color=#FF0000>Parameter 'one' must contain the word 'STOP'</font><br>
PR_TWO /^\d+$/ <font color=#FF0000>Parameter 'two' must be a number and may not be empty</font><br>
PR_THREE // <font color=#FF0000>Parameter 'three' must be defined!</font><br>
PR_THREE !/^$/ <font color=#FF0000>Parameter 'three' may not be empty!</font><br>
PR_THREE !/%/ <font color=#FF0000>Parameter 'three' can not contain a %-sign!</font><br>
PR_FOUR !/[\/ ]/ <font color=#FF0000>Parameter 'four' can not contain a forward slash or a space!</font><br>
PR_FIVE !// <font color=#FF0000>Parameter 'five' may not be defined!</font><br>
<paramcheckfoot>
</center>
<!-- INCLUDE footer.wsql -->
<!-- CUTFILE -->
</paramcheckfoot>
/PARAMCHECK -->
<p>
If you can read this, all parameters conform with the conditions.
</body>
</html>
The syntax of the PARAMCHECK tag is as follows:
<!-- PARAMCHECK
<PARAMCHECKHEAD>
header
</PARAMCHECKHEAD>
ParameterRegular expressionError text
<PARAMCHECKFOOT>
footer
</PARAMCHECKFOOT>
/PARAMCHECK -->
A set of conditions are defined, which should be matched by the parameters passed to the script. If one of the conditions is not met, the 'header' is printed, then the 'Error text' of all the conditions that are not met, followed by the 'footer'.
In the above example, the footer consists of an INCLUDE tag, followed by the CUTFILE tag, so that the rest of the file will not be parsed nor printed if one of the conditions is not met.
Standard perl regular expressions may be used, and an exclamation mark (!) can be used to inverse the condition.
Syntax:
<!-- CUTFILE -->
When this tag is encountered, parsing of the html is stopped, and anything following the tag is simply discarded. So this is a tag that you probably want to generate during one of the other steps. A typical example is during the PARAMCHECK step. Note that the CUTFILE tag must start on the first character of the line, and that it must be the only thing present on the line. This is the only tag with this kind of restriction. The restriction is deliberate, to make it easier to build a CUTFILE tag in an EVAL statement for instance.
Syntax:
<!-- LAYOUT header -->
This tag will be substituted by the block of html with name 'header' from the layout.cf file. For more information, see Apache::WeSQL::Journalled.
Syntax:
<!-- LIST _IDENTIFIER_ _SQLSTATEMENT_ -->
Statements that will be repeated for every resulting line from the _SQLSTATEMENT_
<!-- /LIST _IDENTIFIER_ _NOMATCHTEXT_ -->
_IDENTIFIER_ can be any word of at least 1 character, but can not contain any spaces. This identifier is used to distinguish list tags from each other when they are nested. That's right, LIST tags can be nested as deep as you like. The tags are expanded from the outside to the inside.
You can use several LIST A statements in one html file, as long as no LIST A statement is nested within another one.
_SQLSTATEMENT_ is any SQL statement that can be executed by your backend SQL database.
_NOMATCHTEXT_ is the text that is displayed - just once - if there are no matches to your query. You can use html in _NOMATCHTEXT_.
Consider this example, loosely based on the sampleapp application that comes with WeSQL.
<html>
<body>
<!-- LIST A SELECT name,id FROM somethings WHERE name like "%PR_NAME%" ORDER BY name -->
<a href="/modify?id=A_ID">A_NAME</a><br>
<!-- /LIST A <font color="#FF0000">No things that satisfy the search fields were found.</font> -->
</body>
</html>
If the table 'somethings' would contain the following data:
And if the 'name' parameter passed to the above piece of html would have the value 'over', then the above html would be expanded to:
<html>
<body>
<a href="/modify?id=2">cover</a><br>
<a href="/modify?id=1">Lover</a><br>
</body>
</html>
If the 'name' parameter would be 'perl', then the output would be:
<html>
<body>
<font color="#FF0000">No things that satisfy the search fields were found.</font>
</body>
</html>
EVAL tags can be either a quick one-line tag, or a longer multi-line tag. One-liner:
<!-- EVAL XXX return "Hello World!"; -->
Multi-line tag:
<!-- EVAL XXX
return "Hello World!";
/EVAL XXX -->
XXX is the identifier that will determine in which parsing step this EVAL block will be executed. XXX can be any word of at least 1 character, not containing any whitespace.
As specified higher, the XXX identifier determines when in the parsing steps this EVAL block will be evaluated. It is a good idea to choose a descriptive name for these identifiers, referring to their position in the execution chain. The default @commandlist will execute PRE, POSTINSERT, PRELIST and POST EVAL blocks. Of course you can modify the @commandlist to suit your needs.
EVAL-tags of the same identifier can not be nested for now, but you can generate one within one of another type (i.e., with another identifier).
Adding your own EVAL steps is very straightforward - choose an identifier, add the step somewhere in the @commandlist array, and you're in business!
Code example:
<html>
<body>
<!-- EVAL PRELIST
my $result; if ("PR_NAME" eq "") {
$result = "<!-- LIST A SELECT count(*) FROM somethings -->";
} else {
$result = "<!-- LIST A SELECT count(*) FROM somethings WHERE name LIKE \"%[PR_NAME%|]\" -->";
}
return $result;
/EVAL PRELIST -->
A_COUNT(*)
<!-- /LIST A -->
</body>
</html>
The following code snippet demonstrates the use of the EVAL syntax.
First, parameters passed via GET or POST are substituted. In this case, PR_NAME is replaced by the value of the parameter 'name' (case insensitive), or by an empty string if that parameter is not available. Let's assume that there was no 'name' parameter. In this case, the resulting html would look like this:
<html>
<body>
<!-- LIST A SELECT count(*) FROM somethings -->
A_COUNT(*)
<!-- /LIST A -->
</body>
</html>
But if the parameter 'name' exists, and had the value 'love', then the resulting html would look like:
<html>
<body>
<!-- LIST A SELECT count(*) FROM somethings WHERE name LIKE "%love%" -->
A_COUNT(*)
<!-- /LIST A -->
</body>
</html>
The next step is the evaluation of the LIST statement. Maybe by now you start to wonder about the usefulness of this example. After all, check out this html block, without the use of an EVAL statement:
<html>
<body>
<!-- LIST A SELECT count(*) FROM somethings WHERE name LIKE "%[PR_NAME%|]" -->
A_COUNT(*)
<!-- /LIST A -->
</body>
</html>
If 'name' is supplied, PR_NAME would be substitued by the value of 'name'. If not, an empty string would be substituted, and the result would be:
<html>
<body>
<!-- LIST A SELECT count(*) FROM somethings WHERE name LIKE "%" -->
A_COUNT(*)
<!-- /LIST A -->
</body>
</html>
Which has exactly the same results as:
<html>
<body>
<!-- LIST A SELECT count(*) FROM somethings -->
A_COUNT(*)
<!-- /LIST A -->
</body>
</html>
Yes. But, of course, the latter is lots faster, especially on large tables... So, fully using the WeSQL syntax, we could also write the following, and do away with the whole EVAL block:
<html>
<body>
<!-- LIST A SELECT count(*) FROM somethings [WHERE name LIKE "%PR_NAME%"|] -->
A_COUNT(*)
<!-- /LIST A -->
</body>
</html>
And this would have the desired results, depending on whether name is defined as a parameter or not.
This module is part of the WeSQL package, version 0.53
(c) 2000-2002 by Ward Vandewege
None by default. Possible: %params %cookies &redirect &error &readLayoutFile
I would like to thank my employer, Better Access, for allowing me to develop the early WeSQL versions (up to 0.28.02) partly in their time.
Parts of the early WeSQL library were written by Kristof Verniers, and many ideas came from Jan Jansen. I am very grateful to the both of them.
Ward Vandewege, <ward@pong.be>
Copyright (c) 2000-2002 Ward Vandewege. This program is free software; you can redistribute it and/or modify it under the terms of the GPL.
| WeSQL documentation | Contained in the WeSQL distribution. |
package Apache::WeSQL; use 5.006; use strict; use warnings; use lib("."); use lib("./WeSQL/"); use POSIX qw(strftime); use Apache::WeSQL::SqlFunc qw( :all ); use Apache::WeSQL::Journalled qw( :all ); use Apache::WeSQL::Display qw( :all ); use Apache::WeSQL::Auth qw( :all ); use Apache::Constants qw(:common); require Exporter; # We have to define $VERSION as follows instead of a simpler 'our $VERSION', because perl 5.005_03 # can not cope with this in MakeMaker (the perl Makefile.PL doesn't execute) use vars qw($VERSION); our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use Apache::WeSQL ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. # $dbh $r our %EXPORT_TAGS = ( 'all' => [ qw( %params %cookies redirect error readLayoutFile DEBUG ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); $VERSION = '0.53'; our $DEBUGTYPE = 'apache'; # Preloaded methods go here. # Some global variables our ($r); our ($dbh, %params, %cookies, $errorcode); #CHECK IF NECESSARY!! our $DEBUG = 1; ############################################################ # log_error # Log an error, in different ways depending on the value of $DEBUGTYPE ############################################################ sub log_error { my $message = shift; if ($DEBUGTYPE eq 'text') { print STDERR "$message\n"; } else { # Apache style is default! my $r = Apache->request; $r->log_error($message); } } ############################################################ # display # Process a WeSQL file ############################################################ sub display { $dbh = shift; $r = shift; my $authsuperuserdir = shift; my $cookieheader = shift; my @commandlist = @_; # These requests are special, and might want to use a HTTP redirect, so we can't # print the standard HTTP header just yet! They will have to take care of that # themselves. my ($result,$errorcode) = ("",0); my $uri = $r->uri; # Note that the next line will make requests ending in a slash look for a index.wsql file... # So if you want to link to a index.html file, you'll have to put the file name in the request! $uri .= "index.wsql" if ($uri =~ /\/$/); # Multi-language support $uri =~ s/\.[\w\-]{2,5}\.wsql$/\.wsql/; for ($uri) { /\/jadd.wsql$/ && do { ($result,$errorcode) = &jAddPrepare($dbh,$cookieheader); last; }; /\/jupdate.wsql$/ && do { ($result,$errorcode) = &jUpdatePrepare($dbh,$cookieheader); last; }; /\/jdelete.wsql$/ && do { ($result,$errorcode) = &jDeletePrepare($dbh,$cookieheader); last; }; /\/jform.wsql$/ && do { ($result,$errorcode) = &jForm($dbh,$cookieheader); last; }; /\/jdeleteform.wsql$/ && do { ($result,$errorcode) = &jDetails($dbh,$cookieheader); last; }; /\/jdetails.wsql$/ && do { ($result,$errorcode) = &jDetails($dbh,$cookieheader); last; }; /\/jlist.wsql$/ && do { ($result,$errorcode) = &jList($dbh,0,$cookieheader); last; }; /\/jloginform.wsql$/ && do { ($result,$errorcode) = &jLoginForm($dbh,$cookieheader); last; }; /\/jlogin.wsql$/ && do { ($result,$errorcode) = &jLogin($dbh,$authsuperuserdir); last; }; /\/jlogout.wsql$/ && do { ($result,$errorcode) = &jLogout($dbh); last; }; } if ($result eq "") { my $dd = localtime(); unless ($uri =~ /redirect\.wsql$/) { # Print a proper HTTP header print <<EOF; HTTP/1.1 200 OK Date: $dd Server: Apache EOF print "$cookieheader\r\n" if (defined($cookieheader) && ($cookieheader ne '')); print <<EOF; Connection: close Content-type: text/html EOF } my $doc_root = $r->document_root; $result = &readWeSQLFile($doc_root . $uri); } # Now only parse files as WeSQL if they have a .wsql suffix!! This allows easy mixing of HTML and WeSQL files... ($result,$errorcode) = &dolayout($result,@commandlist) if ($uri =~ /\.wsql$/); if ($errorcode) { print "An error has occured: errorcode $errorcode. Please contact the webmaster!!"; } else { print $result; } } ############################################################ # error # Builds & logs an error message ############################################################ sub error { my ($message,$logmessage) = @_; &log_error("$$: WeSQL.pm: $logmessage"); my $dd = localtime(); return <<"EOF"; <html> <head><title>Error</title></head> <body bgcolor=#FFFFFF> <h1>Error</h1> $message <hr> This page was dynamically generated by <a href=http://wesql.org>WeSQL $VERSION</a> </body> </html> EOF } ######################################################## sub readWeSQLFile { my ($layoutfile) = shift; unless (defined(open(LAYOUTFILE,$layoutfile))) { print &error("File not found.","$$: WeSQL.pm: dolayout: file '$layoutfile' not found!"); exit; } my $body = join("",<LAYOUTFILE>); close(LAYOUTFILE); my @stat = stat($layoutfile); $ENV{FILE_SIZE} = $stat[7]; $ENV{FILE_LAST_MODIFIED} = $stat[9]; return ($body); } sub dolayout { my $body = shift; my $errorcode = 0; my (@commandlist) = @_; foreach (@commandlist) { &log_error("$$: WeSQL.pm: dolayout: executing $_") if ($DEBUG > 1); $body = eval($_); # The following will log errors from the eval() &log_error("$$: WeSQL.pm: dolayout: eval error: " . $@) if $@; }; return ($body,$errorcode); } ############################################################ # dolist, printlist & printlist_inline deal with the <!-- LIST PREFIX SQL-STATEMENT --> # ... <!-- /LIST PREFIX (no-match-text) --> tag ############################################################ sub dolist { my $body = shift; my $dbh = shift; $body =~ s/<!--\s*LIST\s*(.*?)\s+(.*?)-->(.*?)<!--\s*\/LIST\s*\1\s*(.*?)\s*-->/&printlist($dbh,$1,$2,$3,$4)/sieg; return $body; } sub printlist { my $dbh = shift; my $returnval = ""; my $prefix = shift; $prefix .= "_" if ($prefix ne ""); my $query = shift; my $layout = shift; my $nomatchtext = shift; my $c = sqlSelectMany($dbh,$query); my %data; my $colnameref = $c->{NAME_uc}; foreach (@{$colnameref}) { $data{$_} = ""; } if (defined($c) && ($query =~ /^(SELECT|SHOW|DESC)/i)) { # Non-select queries will result in a defined $c, but cause a typical # "fetch() without execute()' warning in the logs, hence the checking for # SELECT, SHOW and DESC above! while(my $data=$c->fetchrow_hashref()) { #This is a bit less efficient than fetchrow_arrayref... foreach(sort keys %{$data}) { #Make column-names case-insensitive $data->{lc($_)} = $data->{$_}; } my $output = $layout; $output =~ s/([^\w]*?)$prefix([A-Z()\[\]0-9\._]*)\|\[(.*?)(?<!\\)\]/&printlist_inline($1,$3,$2,%data)/eg; $output =~ s/([^\w]*?)$prefix([A-Z()0-9\._]*)/(defined($data->{lc($2)})?"$1$data->{lc($2)}":(exists $data->{lc($2)}?"$1NULL":"$1$prefix$2"))/eg; $returnval .= $output; } if ($returnval eq "") { $returnval = "<tr><td>Your query returned no results.</td></tr>"; $returnval = $nomatchtext unless $nomatchtext eq ""; # if nomatchtext is the html equivalent of a space, just throw it away: # The user doesn't want anything in the html. $returnval = "" if $nomatchtext eq " "; }; $c->finish(); $errorcode = 0; #Recursively parse the rest of the file! $returnval =~ s/<!--\s*LIST\s*(.*?)\s+(.*?)-->(.*?)<!--\s*\/LIST\s*\1\s*(.*?)\s*-->/&printlist($dbh,$1,$2,$3,$4)/sieg; } elsif (!defined($c)) { #upon error ($c is not defined), errorcode will be set to 1, and $returnval will stay empty # -> no more recursive invocations of this sub. $errorcode is a global variable (aargh, I know!) #that is initialised and checked in dolayout, our caller sub! &log_error("$$: c not defined in printlist!"); $errorcode = 1; } return $returnval; } sub printlist_inline { my ($pre, $alt, $value, %data2) = @_; $alt =~ s/\\\]/\]/g; if (defined($value)) { if ($data2{lc($value)} eq "") { return "$pre$alt"; } else { return "$pre$value"; } } else { if (exists($data2{lc($value)})) { return "$pre\LNULL"; } else { return "$pre$alt"; } } } ############################################################ # end of <!-- LIST PREFIX SQL-STATEMENT --> # ... <!-- /LIST PREFIX (no-match-text) --> tag code ############################################################ ############################################################ # readLayoutFile # Reads the layout information from the file 'layout.cf' ############################################################ sub readLayoutFile { my $file = shift; my $nestlevel = shift; $nestlevel ||= 0; my %aliases; my $r = Apache->request; # Get the 'base-uri' from the request: for instance, for /admin/jlist.wsql that would be /admin/, and for /jlist.wsql that would just be / my $uri = $r->uri; my ($baseuri) = ($uri =~ /^(.+)\//); my $doc_root = $r->document_root; $baseuri .= '/'; if (!defined(open(LAYOUT,$doc_root . $baseuri . "$file"))) { &log_error("$$: WeSQL.pm: readLayoutFile: file '" . $doc_root . $baseuri . "$file' not found!"); &jErrorMessage("Configuration file not found! Please contact the webmaster.","Can't read $file!",0); exit; } my $layoutinfo = join("",<LAYOUT>); close(LAYOUT); if ($layoutinfo =~ /^inherit:(.*?)\n/) { if ($nestlevel < 10) { # Protect people from eternal loops... &log_error("$$: WeSQL.pm: readLayoutFile: detected inheritance level " . ++$nestlevel . ", reading $1!"); %aliases = &readLayoutFile($1,$nestlevel); } else { &log_error("$$: WeSQL.pm: readLayoutFile: detected 10 levels of inheritance, aborting inheritance here!"); } } my @aliases = split(/\n\n/,$layoutinfo); foreach (@aliases) { my @lines = split(/\n/,$_); my $name = ""; while (($name eq "") && ($#lines > -1)) { $name = shift @lines; #First line should contain nothing but the name of the layoutalias } $aliases{$name} = join("\n",@lines); } &log_error("$$: WeSQL.pm: readLayoutFile: file '$file' succesfully read") if ($DEBUG); return %aliases; } ############################################################ # dolayouttags deals with the <!-- LAYOUT TAG --> tag ############################################################ sub dolayouttags { my $body = shift; my %layout = (); if ($cookies{WeSQL_language} ne '') { %layout = &readLayoutFile("layout.$cookies{WeSQL_language}.cf"); } else { %layout = &readLayoutFile("layout.cf"); } $body =~ s/<!--\s*LAYOUT\s+(.*?)\s+-->/&log_error("$$: WeSQL.pm: dolayouttags: no layout key '$1' found") if (!defined($layout{$1}));$layout{$1}||="";$layout{$1}/sieg; return $body; } ############################################################ # end of <!-- LAYOUT TAG --> tag code ############################################################ ############################################################ # dolanguages deals with the <LANG>text</LANG> tag ############################################################ sub dolanguages { my $body = shift; my $uri = $r->uri; my ($baseuri) = ($uri =~ /^(.+)\//); my $doc_root = $r->document_root; $baseuri .= '/'; opendir(DIR, $doc_root . $baseuri) || die "can't opendir $doc_root . $baseuri: $!"; my @layoutfiles = grep { /^layout\..*?\.cf$/ && -f $doc_root . "$baseuri/$_" } readdir(DIR); closedir DIR; # Now deal with the language tags, that could look like <en>stuff</en> or <en 454>stuff</en> foreach (@layoutfiles) { my ($lang) = (/^layout\.(.*?)\.cf$/); $body =~ s/<$lang( *\d*|)>(.*?)<\/$lang>/($lang eq $cookies{WeSQL_language})?$2:''/sieg; } return $body; } ############################################################ # end of <LANG>text</LANG> tag code ############################################################ ############################################################ # doinsert & insertfile deal with the <!-- INCLUDE (PREFIX) FILE --> tag ############################################################ sub doinsert { my $body = shift; $body =~ s/<!--\s*INCLUDE\s*(.*?)\s+(.*?)-->/&dosubst(&dosubst(&dosubst(&insertfile($1,$2),"PR_",%params),"ENV_",%ENV),"COOKIE_",%cookies)/sieg; return $body; } sub insertfile { my $prefix = shift; my $file = shift; # Setting PREFIX in the INCLUDE tag to "" was the old trick to have no prefix # Depreciated. Now you can just omit the PREFIX parameter. if ($prefix eq "\"\"") { $prefix = ""; } # Allow shorthand when no prefix is necessary for the included file: # <!-- INCLUDE FILE --> if (!defined($file) || ($file eq "")) { $file = $prefix; $prefix = ""; } unless(defined(open(LFILE,$r->document_root . "/$file"))) { &log_error("$$: insertfile: file '$file' not found!"); return "<center>File not found !</center>"; } my $body = join("",<LFILE>); close(LFILE); #Now make sure that this inserted file has its separate set of parameters. #First make sure that references in perl code get the right values by rewriting the #getparams call if ($prefix ne "") { $body =~ s/WeSQL\:\:getparams\(\)/WeSQL\:\:getparams\(\$dbh,\"$prefix\"\)/g; #Secondly rewrite all the PR_ references to include the prefix $body =~ s/PR_([A-Z()\[\]0-9\._]*)/PR_$prefix$1/g; } return $body; } ############################################################ # end of <!-- INCLUDE PREFIX FILE --> tag code ############################################################ ############################################################ # dosubst & dosubst_inline deal with the PREFIX style parameters (e.g. PR_PARAM1) ############################################################ sub dosubst { my $body = shift; my $prefix = shift; my %hash = @_; my %uchash; foreach (keys %hash) { $uchash{uc($_)}= $hash{$_}; }; #First match occurrences with alternative (after a | character) # Example: [PR_WHAT|super] will result in the value of the 'what' parameter if defined, # or else in the word 'super'. You can escape ] and | with a backslash. $body =~ s/\[(.*?)$prefix([A-Z()\[\]0-9\._]*)(.*?)(?<!\\)\|(.*?)(?<!\\)\]/&dosubst_inline($1,$2,$3,$4,%uchash)/eg; #Then match the ones without! $body =~ s/([^\w]*)$prefix([A-Z()\[\]0-9\._]*)/(defined($uchash{$2})?"$1$uchash{$2}":"$1$prefix$2")/eg; return $body; } sub dosubst_inline { my ($pre, $value, $post, $alt,%uchash) = @_; if (defined($uchash{$value})) { $post =~ s/\\\|/\|/g; return "$pre$uchash{$value}$post"; } else { $alt =~ s/\\\]/\]/g; return "$pre$alt"; } } ############################################################ # end of parameter substitution code ############################################################ ############################################################ # doeval deals with the <!-- EVAL FLAG ... /EVAL FLAG --> tag ############################################################ # We need evalinline to be able to trap the eval errors... # $@ gets lost in the s//eval()/ statement in doeval. sub evalinline { my $eval = eval($_[0]); &log_error("$$: DOEVAL EVAL ERROR: " . $@) if ($@ || !defined($eval)); #This will log errors from the eval() return $eval; } sub doeval { my $body = shift; my $param = shift; # First do the single-line style evals (e.g. <!-- EVAL POST (some_perl_code) -->) $body =~ s/<!-- EVAL $param (.+?) -->/&evalinline($1)/emg; # And then the multi-line evals $body =~ s/<!-- EVAL $param\s*\n(.*?)^\/EVAL $param -->/&evalinline($1)/esmg; return $body; } ############################################################ # end <!-- EVAL FLAG ... /EVAL FLAG --> tag code ############################################################ ############################################################ # docutcheck deals with the <!-- CUTFILE --> tag ############################################################ sub docutcheck { my $body = shift; # $body =~ s/(.*?)^<!--\s*CUTFILE\s*-->\n.*/$1/sm; #If you run perl 5.6.0, you will find that the above re is ridiculously slow. #This is a Perl bug, fixed in 5.6.1. You can enable the above line if you run #Perl 5.6.1. $body =~ s/(.*?)^<!-- CUTFILE -->\n.*/$1/sm; return $body; } ############################################################ # end <!-- CUTFILE --> tag code ############################################################ ############################################################ # doparamcheck deals with the <!-- PARAMCHECK ... /PARAMCHECK <fail-text> --> tag ############################################################ # SYNTAX example (new from version 0.50) # <!-- PARAMCHECK # <paramcheckhead> # <center>Below are the problems that have been encountered:<p> # </paramcheckhead> # PR_WHAT // <font color=#FF0000>I need more parameters (what)...</font><br> # <paramcheckfoot> # </center> # <!-- INCLUDE footer.wsql --> # <!-- CUTFILE --> # </paramcheckfoot> # /PARAMCHECK --> sub doparamcheck { my $body = shift; $body =~ s/<!--\s*PARAMCHECK\s*\n(.*?)^\/PARAMCHECK\s*-->/¶mcheck($1)/esmg; return $body; } sub paramcheck { my $body = shift; my $headertext = "<center>Below are the problems that have been encountered:<p"; ($headertext) = ($body =~ /<paramcheckhead>(.*?)<\/paramcheckhead>/ism); my $footertext = "\n<!-- CUTFILE -->\n"; ($footertext) = ($body =~ /<paramcheckfoot>(.*?)<\/paramcheckfoot>/ism); $body =~ s/<paramcheckhead>.*?<\/paramcheckhead>\n//ismg; $body =~ s/<paramcheckfoot>.*?<\/paramcheckfoot>\n//ismg; $body =~ s/^\n//smg; #Remove any empty lines! $body =~ s/^(.*?)\s+(\/|!\/)(.*?)(?<!\\)\/\s+(.*?)\n/&check_one_param($1,$2,$3,$4)/emg; $body = $headertext . $body . "\n" . $footertext if ($body ne ''); return $body; } sub check_one_param { my $param = shift; my $negation = shift; my $regexp = shift; my $wrong_string = shift; $param = '' if (!defined($param)); $negation = '' if (!defined($negation)); $regexp = '' if (!defined($regexp)); $wrong_string = '' if (!defined($wrong_string)); chop($negation); if ($negation =~ /^!/) { if ($regexp eq '') { # !// means that the parameter should be defined if (!($param =~ /PR_(.*)/)) { return "$wrong_string\n"; } } if ($param =~ /$regexp/) { return "$wrong_string\n"; } } else { #if parameter is defined, complain if it does not match the condition if ($regexp eq '') { if ($param =~ /PR_(.*)/) { return "$wrong_string\n"; } return ""; } if ((!($param =~ /PR_(.*)/)) && (!($param =~ /$regexp/))) { return "$wrong_string\n"; } } return ""; } ############################################################ # end <!-- PARAMCHECK ... /PARAMCHECK <fail-text> --> tag code ############################################################ ############################################################ # getparams # Prepare & secure the parameters & cookies passed to us from the user # These parameters & cookies are available in the rest of the module # as the global hashes %params and %cookies ############################################################ sub getparams { # Sometimes we only want to see a subset of the parameters! # (used for the INSERT statement) # For this we need a 'prefix' parameter my $dbh = shift; my $prefix = shift; my $cookieheader = shift; my $defaultlanguage = shift; undef $r if $r; undef %params if %params; undef %cookies if %cookies; $r = Apache->request; require CGI; my $q = new CGI; &log_error("$$: WeSQL.pm: getparams: entering!") if ($DEBUG); # Set our %cookies hash foreach ($q->cookie) { $cookies{$_} = $q->cookie($_); $cookies{$_} =~ s/\'/\\\'/sg; $cookies{$_} =~ s/\"/\\\"/sg; # The NULL character terminates strings in C. Hence all sorts of nasty things can happen when a NULL is passed to a C program like MySQL... # The ; character terminates sql statements. Let's nuke that one too. $cookies{$_} =~ s/#0|%0|%3B//sg; &log_error("$$: WeSQL.pm: getparams: cookie: $_ -> " . $q->cookie($_)) if ($DEBUG); } # $cookieheader is used to pass values of cookies that have been set while processing this page, and hence # are not passed by the browser yet! Used from AppHandler.pm, to pass the session hash when that is first # set. if (defined($cookieheader) && ($cookieheader ne '')) { if ($cookieheader =~ /Set-Cookie: (.*?)=(.*)/) { $cookies{$1} = $2; &log_error("$$: WeSQL.pm: getparams: cookie: $1 -> $2") if ($DEBUG); } } undef($cookies{su}) if (defined($cookies{su})); #Nonono, this cookie should NEVER be on your hard-drive :-) if (defined($cookies{id}) && defined($cookies{hash})) { #This is - probably - a logged in user # my @sucheck = sqlSelect("superuser","users","uid='$WeSQL::cookies{id}' and status='1'"); # Lookup the hash on the users hard-drive. If this hash matches a super-user login, set the su cookie to the id of that superuser # We don't touch the id cookie, thus allowing superusers to 'cloak' as someone else, while maintaining their superuser powers! my @sucheck = sqlSelect($dbh,"select u.superuser,u.id from users as u,logins as l where u.id=l.uid and l.hash='$cookies{hash}' and u.status='1' and l.status='1'"); if (defined($sucheck[0]) && ($sucheck[0] > 0)) { $cookies{su} = $sucheck[1]; &log_error("$$: WeSQL.pm: getparams: updated cookie: su -> $cookies{su}") if ($DEBUG); } } # $q->param should not be used beyond this sub, instead use the %params hash that does away # with all sorts of dangerous input! foreach ($q->param) { my $tmp = $_; if (defined($prefix) && ($prefix ne '')) { next if (!($_ =~ /^$prefix/)); $tmp =~ s/^$prefix//g; } # If multiple parameters have the same name, append them together, separated by a pipe symbol $params{$tmp} = join("|",$q->param($_)); # The NULL character terminates strings in C. Hence all sorts of nasty things can happen when a NULL is passed to a C program like MySQL... # The ; character terminates sql statements. Let's nuke that one too. $params{$tmp} =~ s/#0|%0|%3B//sg; # The following lines are CRUCIAL FOR SECURITY - REMOVE AT YOUR OWN RISK! # Anyone trying to insert a WeSQL-style command (e.g. <!-- EVAL POST), will be # stopped by this :-) And inserting a PR_ style parameter, which could then contain a WeSQL-style command, to fool the second pass # won't work either :-) $params{$tmp} =~ s/<!--/<!---/g; $params{$tmp} =~ s/PR_/PR/g; } # Check out the language situation - we set a fake, server-side only cookie with the name of the preferred language my $uri = $r->uri; my ($baseuri) = ($uri =~ /^(.+)\//); my $doc_root = $r->document_root; $baseuri .= '/'; my $sessionlang = &Apache::WeSQL::Session::sRead($dbh,'language'); # Priority: # Check if a specific language uri was requested, and if the corresponding language file exists. # If so, serve the right file, and store the language in the session. # Second: # Check if a language is stored in the session. # Third: # Check if the browser specified a 'preferred' language # Finally: # Check if a default language has been set, if not look for layout.xx.cf files and take the one # that comes first in the alphabet. If there are none, just fall back to a single-language site. if (($r->uri =~ /\.([\w\-]{2,5})\.wsql$/) && (-f $doc_root . $baseuri . "layout.$1.cf")) { &log_error("$$: WeSQL.pm: getparams: a page in the language $1 was requested") if ($DEBUG); &log_error("$$: WeSQL.pm: getparams: setting session language to $1") if ($DEBUG); &Apache::WeSQL::Session::sOverWrite($dbh,'language',$1); $cookies{'WeSQL_language'} = $1; } elsif (defined($sessionlang) && (-f $doc_root . $baseuri . "layout.$sessionlang.cf")) { &log_error("$$: WeSQL.pm: getparams: reading layout in session language $sessionlang") if ($DEBUG); $cookies{'WeSQL_language'} = $sessionlang; } elsif (defined($r->header_in('Accept-Language'))) { &log_error("$$: WeSQL.pm: getparams: Accept-Language: " . $r->header_in('Accept-Language')) if ($DEBUG); # Example header: # Mozilla 0.99: Accept-Language: nl, en;q=0.66, en-us;q=0.33 # Opera for Linux 6.0 Beta 2: Accept-Language: nl,en my @langs = split(/\,/,$r->header_in('Accept-Language')); for (my $cnt=0;$cnt<=$#langs;$cnt++) { $langs[$cnt] =~ s/^\s*//; $langs[$cnt] =~ s/;.*$//; } # Now select the correct language. Languages are defined for the site if a layout.cf file # exists for them. This is typically just a symlink to layout.cf, with a name like layout.nl.cf. foreach (@langs) { my $lang = $_; if (-f $doc_root . $baseuri . "layout.$lang.cf") { $cookies{'WeSQL_language'} = $lang; last; } } # Some languages look like this: fr-ch. In those cases, if no language has been selected by # the mechanism above, we will try to match the 'base' language, that is the part before the # hyphen, in this case 'fr'. if (!defined($cookies{'WeSQL_language'})) { foreach (@langs) { my $lang = $_; my ($shortlang) = ($lang =~ /^(.*?)-.*$/); $shortlang ||= ''; if (($shortlang ne '') && (-f $doc_root . $baseuri . "layout.$shortlang.cf")) { $cookies{'WeSQL_language'} = $shortlang; last; } } } $cookies{'WeSQL_language'} = '' if (!defined($cookies{'WeSQL_language'})); } else { # First check for the default language setting if (defined($defaultlanguage) && ($defaultlanguage ne '') && (-f $doc_root . $baseuri . "layout.$defaultlanguage.cf")) { &log_error("$$: WeSQL.pm: getparams: setting language to defaultlanguage $defaultlanguage as set in the WeSQL.pl file") if ($DEBUG); $cookies{'WeSQL_language'} = $defaultlanguage; } else { # Then just see if any layout.xx.cf files are available, and take the first one (alphabetically) &log_error("$$: WeSQL.pm: getparams: no default language set in the WeSQL.pl file, looking for language specific layout.cf files") if ($DEBUG); opendir(DIR, $doc_root . $baseuri) || die "can't opendir $doc_root" . $baseuri . ": $!"; my @layoutfiles = grep { /^layout\..{2,}?\.cf$/ } readdir(DIR); closedir DIR; foreach (sort @layoutfiles) { if (/^layout\.(.{2,})\.cf$/) { $cookies{'WeSQL_language'} = $1; last; } } } # Finally fall back to single-language site if (!defined($cookies{'WeSQL_language'})) { $cookies{'WeSQL_language'} = ''; &log_error("$$: WeSQL.pm: getparams: falling back to single language site") if ($DEBUG); } } return (\%params,\%cookies); } ############################################################ # redirect # redirect redirects a browser to a new location. Parameters: # destination (required), and any number of valid header lines (optional) ############################################################ sub redirect { my $dest = shift; print "HTTP/1.0 302 Redirect\r\n"; print "Location: $dest\r\n"; foreach (@_) { print "$_\r\n"; } print "Content-type:text/html\r\n\r\n"; print << "EOF"; <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN"> <HTML><HEAD> <TITLE>302 Found</TITLE> </HEAD><BODY> <H1>Found</H1> The document has moved <A HREF="$dest">here</A>.<P> <HR> <ADDRESS>Apache Server</ADDRESS> </BODY></HTML> EOF exit; } 1; __END__