EmbedIT-WebIT
view release on metacpan or search on metacpan
lib/EmbedIT/WebIT.pm view on Meta::CPAN
exit 0;
}
# --------------------------------------------------------------------------------------
# Report configuration
#
sub __report {
my ($conf) = @_;
my $logging = $conf->{"LOG_METHOD"};
&$logging("Staring " . $conf->{"SOFTWARE"} . " web server on " .
$conf->{"SERVER_IP"} . ":" . $conf->{"SERVER_PORT"} .
" with " . $conf->{"QUEUE_SIZE"} . " connection queue limit");
if ($conf->{"USE_SSL"}) {
&$logging("SSL will be used on all connections");
}
if ($conf->{"SERVERS"} > 0) {
&$logging("PREFORKING " . $conf->{"SERVERS"} . " servers");
} else {
&$logging("SINGLE process server");
}
if ($conf->{"FORK_CONN"}) {
&$logging("REQUESTS are forked");
} else {
&$logging("REQUESTS are multiplexed");
if ($conf->{"WORKERS"} > 0) {
&$logging("PREFORKING " . $conf->{"WORKERS"} . " page workers");
} else {
&$logging("WORKERS are embeded into SERVERS");
}
}
if ($conf->{"WAIT_RESPONSE"}) {
&$logging("RESPONSE will be sent normaly");
if ($conf->{"IMMED_CLOSE"}) {
&$logging("CONNECTION will close immediatelly regardless of client request");
} else {
&$logging("CONNECTION will remain open per client request");
}
} else {
if (defined $conf->{"NO_WAIT_REPLY"}) {
&$logging("RESPONSE " . $conf->{"NO_WAIT_REPLY"} . " will be sent before page load");
} else {
&$logging("RESPONSE 204 will be sent before page load");
}
&$logging("CONNECTION will close immediatelly regardless of client request");
}
if ($conf->{'LOG_PACKETS'}) {
&$logging("PACKET contents will be logged");
} elsif ($conf->{'LOG_HEADERS'}) {
&$logging("HEADERS will be logged");
}
if (defined $conf->{"DOCUMENTS"}) {
if (defined $conf->{"DOCUMENT_ROOT"}) {
&$logging("EMBEDED pages with EXTERNAL pages on (" . $conf->{"DOCUMENT_ROOT"} . ")");
} else {
&$logging("EMBEDED pages");
}
} else {
&$logging("EXTERNAL pages on (" . $conf->{"DOCUMENT_ROOT"} . ")");
}
if (defined $conf->{"CGI_PATH"}) {
if ($conf->{"EMBED_PERL"}) {
&$logging("CGI pages on (" . $conf->{"CGI_PATH_PRINT"} . ") with PERL embeded");
} else {
&$logging("CGI pages on (" . $conf->{"CGI_PATH_PRINT"} . ")");
}
}
if (defined $conf->{"AUTH_PATH"}) {
if (not defined $conf->{"AUTH_METHOD"}) {
&$logging("AUTHENTICATION will always fail");
} else {
&$logging("AUTHENTICATION on (" . $conf->{"AUTH_PATH_PRINT"} . ")");
}
} else {
&$logging("AUTHENTICATION is not defined for any path");
}
if (defined $conf->{"STARTUP"}) {
&$logging("STARTUP script can be found in (" . $conf->{"STARTUP"}. ")");
}
}
# --------------------------------------------------------------------------------------
# Start a single web server
#
sub __start_server_socket {
my ($conf) = @_;
return new IO::Socket::INET( LocalAddr => $conf->{"SERVER_IP"},
LocalPort => $conf->{"SERVER_PORT"},
Proto => 'tcp',
Reuse => 1,
Listen => $conf->{"QUEUE_SIZE"}) || return undef;
}
# --------------------------------------------------------------------------------------
# Start a single SSL web server
#
sub __start_server_ssl {
my ($conf) = @_;
return new IO::Socket::INET( LocalAddr => $conf->{"SERVER_IP"},
LocalPort => $conf->{"SERVER_PORT"},
Proto => 'tcp',
Reuse => 1,
Listen => $conf->{"QUEUE_SIZE"}) || return undef;
}
# --------------------------------------------------------------------------------------
# Start accepting connecitons
#
sub __multiplex_connections {
my ($self, $id) = @_;
my $conf = $self->{CONF};
my $d = $self->{SERVER};
$d->blocking(0);
my %buffers = ();
lib/EmbedIT/WebIT.pm view on Meta::CPAN
}
if (exists $conf->{"DOCUMENTS"}{$path}) {
$embed = 1;
} else {
if (defined $conf->{"DOCUMENT_ROOT"}) {
my $fname = $conf->{"DOCUMENT_ROOT"} . $path;
$fname =~ s/\/\//\//gco;
if (! -e $fname) {
if (exists $conf->{"DOCUMENTS"}{'*'}) {
$embed = 1;
} else {
if ($path =~ /$conf->{"CGI_PATH"}/) {
if ($conf->{"SETUP_ENV"}) {
$script = 1;
$ENV{"SCRIPT_NAME"} = $path;
$ENV{"SCRIPT_FILENAME"} = $fname;
$ENV{"QUERY_STRING"} = "";
}
}
}
} else {
if ($path =~ /$conf->{"CGI_PATH"}/) {
if ($conf->{"SETUP_ENV"}) {
$script = 1;
$ENV{"SCRIPT_NAME"} = $path;
$ENV{"SCRIPT_FILENAME"} = $fname;
$ENV{"QUERY_STRING"} = "";
}
}
}
} else {
if (exists $conf->{"DOCUMENTS"}{'*'}) {
$embed = 1;
}
}
}
# &$logging("[$id] Request was \n" . $r->as_string());
$ENV{"REQUEST_URI"} = $path;
my $pmeth = sprintf("%-4s", $r->{METHOD});
my ($auth_ok, $page) = $self->__is_auth_ok($id, $rhost, $rport, $r, $path, $inauth_space, $err);
if ($auth_ok) {
if ($conf->{"SETUP_ENV"}) {
$self->__fix_env($r);
}
$ENV{"REMOTE_PORT"} = $rport;
$ENV{"REMOTE_ADDR"} = $rhost;
my $retval = undef;
my $reterr = undef;
my $type = '';
if ($r->{METHOD} =~ /GET|HEAD|POST/o) {
if ($script) {
if (($conf->{"EMBED_PERL"} == 1) && ($path =~ /\.pl$/o)) {
$type = 'PERL ';
($retval, $reterr, $page) = $self->__do_perl($id, $path, $r, $inauth_space);
if (!$retval) {
&$logging2("[$id] Script error ($reterr) on (" . $r->{URI} . ")");
if ($err) {
$page = $self->__make_error($reterr, $inauth_space, $id, $rhost, $rport, $r);
}
}
} else {
$type = 'CGI ';
($retval, $reterr, $page) = $self->__do_cgi($id, $path, $r, $inauth_space);
if (!$retval) {
&$logging2("[$id] Script error ($reterr) on (" . $r->{URI} . ")");
if ($err) {
$page = $self->__make_error($reterr, $inauth_space, $id, $rhost, $rport, $r);
}
}
}
} elsif ($embed) {
$type = 'EMBED';
($retval, $reterr, $page) = $self->__do_embeded($id, $path, $r, $inauth_space);
if (!$retval) {
&$logging2("[$id] Embeded function error ($reterr) on ($path)");
if ($err) {
$page = $self->__make_error($reterr, $inauth_space, $id, $rhost, $rport, $r);
}
}
} else {
$type = 'FILE ';
($retval, $reterr, $page) = $self->__do_file($path, $r, $inauth_space);
if (!$retval) {
&$logging2("[$id] FILE (" . $r->{URI} . ") not found");
if ($err) {
$page = $self->__make_error($reterr, $inauth_space, $id, $rhost, $rport, $r);
}
}
}
} else {
$type = 'FAIL ';
&$logging2("[$id] Method $pmeth for (" . $r->{URI} . ") is not implemented");
if ($err) {
$reterr = 405;
$page = $self->__make_error($reterr, $inauth_space, $id, $rhost, $rport, $r);
}
}
&$logging("[$id] $pmeth [$type] from $rhost:$rport ($path) got ($reterr " . $conf->{'HTML_CODES'}{$reterr}. ")");
} else {
&$logging("[$id] $pmeth from $rhost:$rport ($path) failed authentication");
}
return $page;
}
# --------------------------------------------------------------------------------------
# Get the authorization from the packet -- packet
#
sub __get_authorization {
my ($self, $r, $log) = @_;
my $h = $r->{HEADERS}->{'AUTHORIZATION'};
if (defined $h) {
$h =~ s/^\s*Basic\s+//gco;
require MIME::Base64;
my $val = MIME::Base64::decode_base64($h);
return $val unless wantarray;
return split(/:/, $val, 2);
}
return;
}
# --------------------------------------------------------------------------------------
# Check if we are in a path with authentication and authentication data exists
#
sub __is_auth_ok {
my ($self, $id, $rhost, $rport, $r, $path, $inauth_space, $err) = @_;
lib/EmbedIT/WebIT.pm view on Meta::CPAN
my $evalerr;
eval {
&$f($data);
$evalerr = $@;
};
close STDOUT;
open STDOUT, ">&OLDOUT";
close OLDOUT;
close STDERR;
open STDERR, ">&OLDERR";
close OLDERR;
$errs .= $evalerr;
if (length($errs) > 0) {
&$logging("[$id] (Child end) \n$errs");
}
&$logging2("[$id] Child finished\n");
}
return;
}
# --------------------------------------------------------------------------------------
# Patch configuration for our needs
#
sub __fix_conf {
my ($rconf) = @_;
if (not defined $rconf->{"SERVER_NAME"}) {
$rconf->{"SERVER_NAME"} = "localhost"
}
if (not defined $rconf->{"SERVER_IP"}) {
$rconf->{"SERVER_IP"} = "127.0.0.1";
}
if (not defined $rconf->{"SERVER_PORT"}) {
$rconf->{"SERVER_PORT"} = 80;
}
if (not defined $rconf->{"WAIT_RESPONSE"}) {
$rconf->{"WAIT_RESPONSE"} = 1;
}
if (not defined $rconf->{"NO_WAIT_REPLY"}) {
$rconf->{"NO_WAIT_REPLY"} = 204;
}
if (not defined $rconf->{"IMMED_CLOSE"}) {
$rconf->{"IMMED_CLOSE"} = 0;
}
if (not defined $rconf->{"SOFTWARE"}) {
$rconf->{"SOFTWARE"} = "WebIT/$VERSION";
}
if (not defined $rconf->{"SIGNATURE"}) {
$rconf->{"SIGNATURE"} = "<br/>WebIT/$VERSION for Perl<br/>";
}
if (not defined $rconf->{"PROC_PREFIX"}) {
$rconf->{"PROC_PREFIX"} = 'WebIT';
}
$rconf->{"PROC_PREFIX"} =~ s/\s\s/\s/go;
if (not defined $rconf->{"EMBED_PERL"}) {
$rconf->{"EMBED_PERL"} = 1;
}
if (not defined $rconf->{"QUEUE_SIZE"}) {
$rconf->{"QUEUE_SIZE"} = 5;
}
if (defined $rconf->{"DOCUMENT_ROOT"}) {
if ($rconf->{"DOCUMENT_ROOT"} !~ /\/$/) {
$rconf->{"DOCUMENT_ROOT"} .= "/";
}
} else {
$rconf->{"DOCUMENT_ROOT"} = undef;
}
if (not defined $rconf->{"SETUP_ENV"}) {
$rconf->{"SETUP_ENV"} = 1;
}
if (length($rconf->{"STARTUP"}) > 0) {
$rconf->{"STARTUP"} =~ s/\/\//\//gco;
}
if (not defined $rconf->{"ENV_KEEP"}) {
push(@{$rconf->{"ENV_KEEP"}}, 'PATH');
}
if (not defined $rconf->{"ENV_ADD"}) {
$rconf->{"ENV_ADD"} = ();
}
if (not defined $rconf->{"MIME_TYPES"}) {
$rconf->{"MIME_TYPES"} = '/etc/mime.types';
}
if (not defined $rconf->{"SERVERS"}) {
$rconf->{"SERVERS"} = 0;
}
if (not defined $rconf->{"WORKERS"}) {
$rconf->{"WORKERS"} = 0;
}
if (not defined $rconf->{"FORK_CONN"}) {
$rconf->{"FORK_CONN"} = 0;
}
if ($rconf->{"FORK_CONN"}) {
$rconf->{"WORKERS"} = 0;
}
if (not defined $rconf->{"USE_SSL"}) {
$rconf->{"USE_SSL"} = 0;
$rconf->{"SSL_CERTIFICATE"} = undef;
$rconf->{"SSL_KEY"} = undef;
}
if (not defined $rconf->{"LOG_METHOD"}) {
if ($rconf->{"NO_LOGGING"}) {
$rconf->{"LOG_METHOD"} = 'EmbedIT::WebIT::__no_logging';
} else {
$rconf->{"LOG_METHOD"} = 'EmbedIT::WebIT::__logging';
}
lib/EmbedIT/WebIT.pm view on Meta::CPAN
300 => "Multiple Choices",
301 => "Moved Permanently",
302 => "Found",
303 => "See Other",
304 => "Not Modified",
305 => "Use Proxy",
306 => "No Longer Used",
307 => "Temporary Redirect",
400 => "Bad Request",
401 => "Not Authorised",
402 => "Payment Required",
403 => "Forbidden",
404 => "Not Found",
405 => "Method Not Allowed",
406 => "Not Acceptable",
407 => "Proxy Authentication Required",
408 => "Request Timeout",
409 => "Conflict",
410 => "Gone",
411 => "Length Required",
412 => "Precondition Failed",
413 => "Request Entity Too Large",
414 => "Request URI Too Long",
415 => "Unsupported Media Type",
416 => "Requested Range Not Satisfiable",
417 => "Expectation Failed",
500 => "Internal Server Error",
501 => "Not Implemented",
502 => "Bad Gateway",
503 => "Service Unavailable",
504 => "Gateway Timeout",
505 => "HTTP Version Not Supported",
};
}
}
# --------------------------------------------------------------------------------------
# Clean up the process environment variables
#
sub __clean_env {
my ($conf) = @_;
foreach my $k (keys %ENV) {
my $found = 0;
foreach my $w (@{$conf->{"ENV_KEEP"}}) {
if ($k eq $w) { $found = 1; }
}
if (!$found) { delete $ENV{$k} };
}
if ($conf->{"SETUP_ENV"}) {
$ENV{"SERVER_NAME"} = $conf->{"SERVER_NAME"};
$ENV{"SERVER_PORT"} = $conf->{"SERVER_PORT"};
$ENV{"SERVER_ADMIN"} = $conf->{"SERVER_ADMIN"};
$ENV{"DOCUMENT_ROOT"} = $conf->{"DOCUMENT_ROOT"};
$ENV{"SERVER_PROTOCOL"} = "HTTP/1.1";
$ENV{"SERVER_SOFTWARE"} = $conf->{"SOFTWARE"};
$ENV{"SERVER_SIGNATURE"} = $conf->{"SIGNATURE"};
$ENV{"GATEWAY_INTERFACE"} = "CGI/1.1 WebIT for Perl";
if ($conf->{"EMBED_PERL"}) {
$ENV{"WEBIT_DATA"} = "INTERNAL";
}
}
foreach my $k (keys %{$conf->{"ENV_ADD"}}) {
$ENV{$k} = $conf->{"ENV_ADD"}->{$k};
}
}
# --------------------------------------------------------------------------------------
# Fix environment variables for current request
#
sub __fix_env {
my ($self, $r) = @_;
for my $k (keys %{ $r->{HEADERS} }) {
if ($k !~ /CONTENT-LENGTH|COOKIE/) {
my $l = $k;
$l =~ s/[^A-Za-z0-9_]/_/gco;
$l = 'HTTP_' . $l;
$ENV{$l} = $r->{HEADERS}{$k};
}
}
if (exists $r->{HEADERS}{'COOKIE'}) {
$ENV{'COOKIE'} = $r->{HEADERS}{'COOKIE'};
} else {
delete $ENV{'COOKIE'};
}
}
# --------------------------------------------------------------------------------------
# Load a file a return its contents or undef on error
#
sub __load_file {
my ($self, $f) = @_;
open FILE, $f || return undef;
binmode FILE;
my @l = <FILE>;
close FILE;
return join('',@l);
}
# --------------------------------------------------------------------------------------
# Load startup file to fix server environment
#
sub __load_startup {
my ($self) = @_;
my $conf = $self->{CONF};
my $logging = $conf->{"DEBLOG_METHOD"};
my $scr = $self->__load_file($conf->{"STARTUP"});
if (not defined $scr) {
&$logging("Startup file cannot be loaded");
return 0;
}
lib/EmbedIT/WebIT.pm view on Meta::CPAN
}
# --------------------------------------------------------------------------------------
# get group id from given id or name
#
sub __get_gid {
my ($i_id) = @_;
my ($n, $p, $gid, $members) = getgrnam($i_id);
if (not defined $gid) {
($n, $p, $gid, $members) = getgrgid($i_id);
if (not defined $gid) {
return 0;
}
}
return $gid;
}
# --------------------------------------------------------------------------------------
# Empty logger
#
sub __no_logging {
}
# --------------------------------------------------------------------------------------
# Elementary log
#
sub __logging {
my ($self, $str) = @_;
if (ref($self) eq '') {
print STDERR time2iso(time) . " - $self\n";
} else {
print STDERR time2iso(time) . " - $str\n";
}
}
# --------------------------------------------------------------------------------------
1;
=head1 NAME
EmbedIT::WebIT - A small yet very effective embeded web server for any perl application
=head1 Synopsis
use EmbedIT::WebIT;
$server = new EmbedIT::WebIT( SERVER_NAME => 'www.my.org',
SERVER_IP => '127.0.0.1',
SERVER_PORT => 8080,
SOFTWARE => 'MyApp web server',
QUEUE_SIZE => 100,
RUN_AS_USER => nobody,
RUN_AS_GROUP => nogroup,
WAIT_RESPONSE => 1,
IMMED_CLOSE => 1,
EMBED_PERL => 1,
FORK_CONN => 0,
SETUP_ENV => 1,
SERVER_ADMIN => 'info@my.org',
SERVERS => 3,
WORKERS => 1,
DOCUMENT_ROOT => '/opt/my/web',
DOCUMENTS => {
'/index.html' => 'WPages::index',
'/error.html' => 'WPages::error',
'/style.css' => 'WPages::style',
'/print.css' => 'WPages::print',
'/404.html' => 'WPages::error404',
'*' => 'WPages::pageHandle',
},
ERROR_PAGES => {
'404' => '/404.html', # embeded subroutine error
'ALL' => '/error.html', # simple html file error
},
EXPIRATIONS => {
'image/jpg' => 86400,
'ALL' => 3600,
},
PROC_PREFIX => 'my:',
CHILD_START => 'WControl::start_db',
CHILD_END => 'WControl::stop_db',
LOG_METHOD => 'WControl::logInfo',
DEBLOG_METHOD => 'WControl::logDebug',
LOG_HEADERS => 0,
LOG_PACKETS => 0,
CGI_PATH => '/cgi',
ENV_KEEP => [ 'PERL5LIB', 'LD_LIBRARY_PATH' ],
NO_LOGGING => 0,
);
$server->execute();
=head1 Description
The WebIT embeded web server was created a long time ago to make a pure perl application that will interact
directly with I<Kannel>. The need was to relieve I<Kannel> from the need to wait for the web server to run
its scripts before going back to serve another SMS message. In this respect WebIT is a hack and can be
configured to behave in a manner which is not according to the RFC's for HTTP. Yet, creating Perl applications
with WebIT using embeded html pages as perl functions outperforms Apache with mod_perl installations.
For this reason I was asked by a few to release this code so that they can use it for their applications.
So even though WebIT is not complete (Workers and SSL not implemented yet) WebIT is already used by
14 perl applications that I know of excluding my personal work.
To work with WebIT all you need to do is to create a new server object by giving to it the parameters
that you want, and then at any point in time call the execute method to run the server. The execute method
returns only when the server has finished execution, and that can only be done by sending a TERM signal to
the process.
Once the server has started it will fork the predefined number of servers and workers. Since workers are not
implemented yet you are advised to ask for 0 workers on startup. From then on, WebIT will serve HTTP requests
by using external files in a configured directory and/or internal pages served by perl subroutines. The code
of the cgi pages and subroutines is as you already know by Apache and mod_perl. You can use the CGI module to
get the request parameters, print on the standard output to form the response to the caller, and print to
standard error to log text to the logger of the server.
lib/EmbedIT/WebIT.pm view on Meta::CPAN
The servers SSL certificate path and file. If not defined no certificate file will be
used for the connection. You can pass the actual certificate here as is. The value is
first tested to see if it matches an existing file, and if not it will be used as an
actual certificate. (default is undef)
B<This feature is not implemented yet>
=item SSL_KEY
The servers SSL key path and file. If not defined no key will be used for the
connection. You can pass the actual key here as is. The value is first tested
to see if it matches an existing file, and if not it will be used as an
actual key. (default is undef).
B<This feature is not implemented yet>
=item WAIT_RESPONSE
Directs the server to wait until a response is generated. If 0 server will
close connection before running scripts or getting pages and returns 204
(No Content) to client (default is 1 and the server will wait for responses)
=item NO_WAIT_REPLY
The code to send when WAIT_RESPONCE is 0. (default is undef and 204 is returned)
=item IMMED_CLOSE
Close connection immediately after serving request. Ignored if WAIT_RESPONSE is 0. (default is 0)
If it is set to 0 the server will respect the client's request about the handling of the connection (might be
immediate close or keep open)
=item RUN_AS_USER
The user under which the server should run as
=item RUN_AS_GROUP
The group under which the server should run as
=item SETUP_ENV
Allow the server to setup the children environment. This requires some milliseconds for each request
served since the server will have to contruct the environment for each call. If you are not using the CGI
module and you know what you are doing you can set this to 0-false and save some time for running requests
(default is 1)
=item ENV_KEEP
List of environment variables to keep for scripts. For normal execution all environment variables are cleared
and CGI and embeded pages run in a clean environment. If however you need to preserve some, like database variables
you can specify their names here in an array, and they will be preserved for your scripts.
=item ENV_ADD
Hash with environment variables and values to set for scripts. These environment variables and their values will be
added to the environment of your CGI and embeded pages.
=item MIME_TYPES
Path and file where the server can find valid mimetypes. (default is /etc/mime.types)
=item EMBED_PERL
Run perl CGI scripts inside the server, not in a separate process. Faster than Apache and mod_perl. (default is 0)
=item SERVER_ADMIN
The email of the server administrator. This text will appear in the environment variables of the CGI / embeded pages (default is empty)
=item DOCUMENT_ROOT
The path where the site documents and scripts are stored. (default is undef)
=item DOCUMENTS
A hash of documents and their subroutines to execute within the server. This is
used to create fully embeded web servers that respond to specific URL's using
specific subroutines. A special page name '*' can be used to direct all unknown
page requests to be directed to the subroutine of this special page.
Can be used in conjunction with and has precedence over DOCUMENT_ROOT (default is undef)
=item ERROR_PAGES
A hash with the site supplied error pages. It contains the error code as a key and
the page path within DOCUMENT_ROOT or DOCUMENTS of the page for the error. Alternatevly there can
be an entry with keyword ALL where all errors without a specific entry in the hash
will find their error pages. Error pages can be cgi's or plain html. (default is undef)
For all error pages the server sets 4 extra environment variables. These are:
=over 4
=item ERROR_CODE
This contains the numeric value of the error, eg 404.
=item ERROR_TEXT
This contains the text value of the error, eg Page not found.
=item ERROR_URI
This contains the URI that generated the error.
=item ERROR_METHOD
This contains the method used to access the URI, eg POST
=back
Along with all other environment variables used you can track all errors to their fullest detail, and handle
them not just for display but for administrator notifications as well.
=item EXPIRATIONS
A hash with expiration times. It contains the content type as a key and the expiration
time in seconds. A special entry called ALL specifies the expiration time of any type NOT
already defined in the hash.
=item SERVERS
Number of servers to prefork. Default is 0 where only the master instance exists
( run in 1.339 second using v1.01-cache-2.11-cpan-71847e10f99 )