Легенда:
новое сообщение
закрытая нитка
новое сообщение
в закрытой нитке
старое сообщение
|
- Напоминаю, что масса вопросов по функционированию форума снимается после прочтения его описания.
- Новичкам также крайне полезно ознакомиться с данным документом.
inetd тоже не пойдет, к сожалению =( 04.10.06 18:47 Число просмотров: 2258
Автор: whiletrue <Роман> Статус: Elderman Отредактировано 04.10.06 19:07 Количество правок: 1
|
Ладно расскажу задачу подробно, а то че-то вопросов много возникает...
Значит есть такая Информиксовая штука - DataBlade. На самом деле это модуль прикручиваемый к Апачу, который анализирует в хтмл-нике свои специфичные тэги и подставляет вместо них че там нужно... очень похоже на SSI.
Задача вобщем-то просто запустить некую прогу на серваке (шелл-скрипт), где запущен Апач с этим ДейтаБлейдом и ее аутпут положить в страничку, вот и все... =)
Сам SSI тоже юзать нельзя, т.к он не срабатывает после ДейтаБлейда.
Ну вот, есть там такой тэг MIEXEC, для которого написано:
The MIEXEC tag enables you to execute a Perl program in your AppPage.
Однако ж он не просто запущает эту перловую прогу и выкладывает ее аутпут, как было бы логичнее всего, а делает это через задницу, т.е. как все в информиксе =) Он запущает некую [перловую] прогу, которая должна задемонизироваться и начать слушать на порту, который ей передаст MIEXEC, а вот после этого он передаст ей некие параметры по этому порту и получит от нее ответ, который таки выложит. ГЫ!
Перл юзать нельзя, т.к. потом будет сложнее обслуживание сервака...
Однако ниже есть приписка:
Important: All the examples in the description of the MIEXEC tag use Perl. However,
any program that can communicate via sockets can be used, including Python and
Rexx.
А пример его использования такой:
<?MIVAR NAME=SRVC>cd /local/perlscripts ;
/usr/local/bin/perl ./SERVE.pl<?/MIVAR>
<?MIEXEC SERVICE=$SRVC REQUEST=UPPER>
This text, when part of the MIEXEC tag, is in MiXeD cAsE.
<?/MIEXEC>
а SERVE.pl вот такая:
#
# This is a SAMPLE perl program that fields requests generated
# within the Web DataBlade module using the MIEXEC tag.
# To run on NT, comment out the line: $UNIX_OS = 1;
#
require 5.002;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin'} ;
#
# Specify modules
use Socket;
use Carp;
use FileHandle;
use English;
#
#
# Forward references
sub REAPER;
sub executeCommand;
sub processRequest;
#
# Comment out the next line to run correctly on NT
$UNIX_OS = 1;
# Setup exit handler
$SIG{CHLD} = \&REAPER;# set exit handler
#
# Declare and
my ($iaddr,$paddr,$proto,$line);
my $port = shift|@ARGV;
# note: Had one system where this value
# had to be hardwired to the node name.
my $remote = shift|'localhost';
if ($port =~ /\D/) {
$port = getservbyname($port,'tcp');
}
if (!$port) {
print "NO PORT : To use as service use :\n\t\tSERVE.pl <portNum>\n";
die "No port" ;
}
#
# Time to fork for the parent can return to database
# server and processing can continue.
#
if (defined($UNIX_OS)) {
my $pid ;
if (!defined($pid = fork)) {
exit;
} elsif ($pid) {
exit; # # parent must leave
}
}
# this is the child
$iaddr = inet_aton($remote);
$paddr = sockaddr_in($port, $iaddr);
#$proto = getprotobyname('name');
$proto = getprotobyname('tcp');
socket(SOCK,PF_INET,SOCK_STREAM,$proto) or die "socket: $!";
connect(SOCK,$paddr) or die "connect: $!";
SOCK->autoflush();
print SOCK "This is the first message from the child client\n";
SOCK->autoflush();
$continue = 1;
#
# Main processing loop
# Fetch Request :
# - get length of request attributes
# - get request attributes
# - get length of body
# - get body
# Process Request :
# - do someing based upon $attributes{'REQUEST'}
# - Put value we want to appear as variables into %results
# a hash type.
# - Put the value that we want in appear in the 'body'
# in the variable ($bodyResult).
# Generate Response :
# - convert the %result hash to string -> $stagedResults
# The hash is converted to name value pairs
# - send length($stageResults) + ':' + $stagedResults
# - send length($bodyResult) : ':' + $bodyResult
#
while ($continue) {
undef($results);
undef(%results);
$attrHead=<SOCK>; # get length of input
defined($attrHead)|die "Connection to server dropped";
$attrHead =~ /([0-9]*):/| print "Could not derive length from header : $attrHead\n" ;
$attrLen = $1; # put length in a reasonible place
my $attr;
while (<SOCK> ) {
$attr .= $_;
if (length($attr) >= $attrLen) {
last;
}
}
$attributes = $attr;
$bodyHead=<SOCK>;
defined($bodyHead)|die "Connection to server dropped";
$bodyHead =~ /([0-9]*):/| die "Could not derive length from header : $bodyHeader" ;
$bodyLen = $1; # put lenght in a reasonible place
my $body;
while (<SOCK> ) {
$body .= $_;
if (length($body) >= $bodyLen) {
last;
}
}
chop($body); # remove terminating CR sender added
$execute = $body;
%vec = split /&/, $attributes;
foreach (%vec) {
($name,$value) = /()=(./;
$attributes{$name}=$value;
}
undef($results); # clear out return data region
##
## got the request : execute the request
##
processRequest();
##
## send the results : execution is finished
##
if (defined(%results)) { # convert results vector back
undef($stagedResults);
while (($name, $value) = each(%results)) {
$stagedResults .= $name . "=" . $value . "&";
}
chop($stagedResults);
$results = length($stagedResults) . ":" . $stagedResults . ":";
} else {
$results = '0::';
}
print SOCK "$results\n";
$results = length($bodyResult) . ":" . $bodyResult;
print SOCK "$results\n";
} # end of infinite loop.
close(LOG);
close(SOCK);
# end of child code.
1;
#
# The support routines
#
sub executeCommand {
my $fileName = shift; # shift off of @_
my $attr = shift;
my $cmd = shift; #
%vec = split /&/, $attr; # variable to hash
foreach (%vec) {
($name,$value) = /()=(./;
$attributes{$name}=$value;
}
my $fileCreate = "+>".$fileName; # create the file
open(TMPFIL,$fileCreate)|die "open failed $fileName";
my $oldHandle = select(TMPFIL);#
$|=1;
eval " $cmd \n";# executes command use quotes # execute
select($oldHandle);
seek(TMPFIL,0, 0)|die "seek failed";
TMPFIL;
}
sub REAPER {
$waitedpid = wait;
$SIG{CHLD} = \&REAPER;
}
# processRequest
# INPUT :
# %attributes : variables/attributes passed in
# $body : the body of the tag
# OUTPUT :
# %results : variables to return
# $body : bodyResutl
# NOTE : input and output are going through global name space.
sub processRequest {
$_ = $attributes{"REQUEST"};
undef($bodyResult);
SWITCH: {
/^UPPER/ && do {
$bodyResult = uc($execute);
last SWITCH;
};
/^RAWPERL/ && do {
$fileName = '/tmp/' . $port . '.tmp';
$execute .= "\n";
undef(%results);# $execute string may create results
$fileHandle = &executeCommand($fileName, $attributes,
$execute);
while ( <$fileHandle> ) { # # send back results
$bodyResult .= $_;
}
close $fileHandle;
last SWITCH;
};
$bodyResult = " REQUEST \"$_\" is unknown";
}
}
|
|
|