This is an old revision of the document!
Perl fastcgi daemon
Поставил nginx вместо lighttpd и долго мучался с подключением perl. Не нашёл ничего чтобы работало демоном для перла по fast-cgi. Зато было две модификации перлового скрипта, который как раз и работал по fast-cgi. Пришлось самому его дописывать и делать обёртку стартового скрипта. chroot не тестировал, но работать должно, потому что за основу брался рабочий скрипт от spawn-fcgi из соседней ветки: http://www.netlab.linkpc.net/forum/index.php?topic=6.0
Пример настроек в rc.conf:
perl_fcgi_enable="YES"
perl_fcgi_pidfile=“/var/run/perl-fcgi.pid” perl_fcgi_user=“www” perl_fcgi_group=“www” perl_fcgi_chdir=“/” perl_fcgi_chroot=“” perl_fcgi_socket=“/tmp/perl-fcgi.sock” perl_fcgi_socketbacklog=“100” perl_fcgi_socketmode=“0777” perl_fcgi_children=“2” perl_fcgi_childrentimeout=“10” perl_fcgi_max_requests=“10000” perl_fcgi_path_env=“/bin:/usr/bin”[/code]
стартовый скрипт perl-fcgi (на FreeBSD ложить в /usr/local/etc/rc.d):
#!/bin/sh
### Rozhuk Ivan 2009.05 ### startup script file for perl-fcgi ###
# PROVIDE: perl_fcgi # REQUIRE: DAEMON # BEFORE: LOGIN # KEYWORD: shutdown
. /etc/rc.subr
name=“perl_fcgi” rcvar=`set_rcvar`
load_rc_config $name
: ${perl_fcgi_enable=“NO”} : ${perl_fcgi_pidfile=“/var/run/perl-fcgi.pid”} : ${perl_fcgi_user=“www”} : ${perl_fcgi_group=“www”} : ${perl_fcgi_chdir=“”} : ${perl_fcgi_chroot=“”} : ${perl_fcgi_socket=“127.0.0.1:9001”} : ${perl_fcgi_socketbacklog=“10”} : ${perl_fcgi_socketmode=“0777”} : ${perl_fcgi_children=“5”} : ${perl_fcgi_childrentimeout=“30”} : ${perl_fcgi_max_requests=“1000”} : ${perl_fcgi_path_env=“/bin:/usr/bin”}
command=“/usr/local/etc/perl-fcgi.pl” command_args=“-d ${perl_fcgi_chdir} -s ${perl_fcgi_socket} -sb ${perl_fcgi_socket} -M ${perl_fcgi_socketmode} -F ${perl_fcgi_children} -Ft ${perl_fcgi_childrentimeout} -Fm ${perl_fcgi_max_requests} -P ${perl_fcgi_pidfile} -e ${perl_fcgi_path_env}” procname=“perl-fcgi-pm” pidfile=“${perl_fcgi_chroot}${perl_fcgi_pidfile}” required_dirs=${perl_fcgi_chroot}
start_precmd=“${name}_start_precmd” stop_postcmd=“${name}_stop_postcmd”
perl_fcgi_start_precmd() {
touch ${perl_fcgi_chroot}${pidfile}
chown ${perl_fcgi_user}:${perl_fcgi_group} ${perl_fcgi_chroot}${pidfile}
}
perl_fcgi_stop_postcmd() {
rm -f ${pidfile}
}
run_rc_command “$1” [/code]
Демонический скрипт perl-fcgi.pl (ложить в /usr/local/etc/ - можно поменять в стартовом скрипте, см выше):
#!/usr/bin/perl -w
### Rozhuk Ivan, 2009 ### fast cgi for perl scripts ### mod version 1.2
### origin: http://wiki.nginx.org//NginxSimpleCGI ### mod by Denis S. Filimonov (Guest) on 13.03.2008 18:37 http://www.ruby-forum.com/attachment/1583/fastcgi-wrapper.pl ### mod by mark: http://www.linux.org.ru/view-message.jsp?msgid=3532327 ### final: http://wiki.nginx.org//NginxSimpleCGI ### additional: http://www.opennet.ru/base/dev/fastcgi_perl.txt.html
use strict; use warnings; use FCGI; # /usr/ports/www/p5-FastCGI use FCGI::ProcManager qw(pm_manage pm_pre_dispatch pm_post_dispatch); # /usr/ports/www/p5-FCGI-ProcManager use Socket; use POSIX qw(setsid setuid); use Getopt::Long; require 'sys/syscall.ph';
# settings my ($CURRENT_DIR,$SOCKET_ADDRESS,$SOCKET_BACKLOG,$SOCKET_MODE,$CHILDRENS_COUNT,$CHILDRENS_TIMEOUT,$CHILDRENS_MAX_REQ,$PIDFILE,$PATHENV);
# global variables
&startpoint();
#this keeps the program alive or something after exec'ing perl scripts END() { } BEGIN() { } {no warnings; *CORE::GLOBAL::exit = sub { die “fakeexit\nrc=”.shift().“\n”; }; }; eval q{exit}; if ($@) { exit unless $@ =~ /^fakeexit/; };
sub startpoint() {
if ($#ARGV!=-1)
{
$CURRENT_DIR ='/';
#$SOCKET_ADDRESS ='';
$SOCKET_BACKLOG =10;
$SOCKET_MODE =0777;
$CHILDRENS_COUNT =2;
$CHILDRENS_TIMEOUT =30;
$CHILDRENS_MAX_REQ =100;
#$PIDFILE ='';
#$PATHENV ='/bin:/usr/bin';
GetOptions( 'd:s' => \$CURRENT_DIR, 's=s' => \$SOCKET_ADDRESS, 'sb:i' => \$SOCKET_BACKLOG, 'M:i' => \$SOCKET_MODE, 'F:i' => \$CHILDRENS_COUNT, 'Ft:i' => \$CHILDRENS_TIMEOUT, 'Fm:i' => \$CHILDRENS_MAX_REQ, 'P:s' => \$PIDFILE, 'e:s' => \$PATHENV, );
if (!defined($SOCKET_ADDRESS)) {usage();}
# untainte input
if ($SOCKET_ADDRESS =~ /^(.*)$/) {$SOCKET_ADDRESS = $1;}
if (defined($PIDFILE)) {if ($PIDFILE =~ /^(.*)$/) {$PIDFILE = $1;}}
if (defined($PATHENV))
{
if ($PIDFILE =~ /^(.*)$/) {$PIDFILE = $1;}
}else{
$PATHENV='/bin:/usr/bin';
}
#print "SOCKET_ADDRESS: $SOCKET_ADDRESS SOCKET_BACKLOG: $SOCKET_BACKLOG CHILDRENS_COUNT: $CHILDRENS_COUNT CHILDRENS_TIMEOUT: $CHILDRENS_TIMEOUT PIDFILE: $PIDFILE\n";
daemonize();
}else{
usage();
}
}
sub usage {
print "Usage: perl-fcgi [options]\n\n"; print " -d <directory> chdir to directory before spawning (default /)\n"; print " -s <address/path> unix socket or tcp address:port\n"; print " -sb <size> socket backlog size (default 10)\n"; print " -M <mode> change Unix domain socket mode (default 0777)\n"; print " -F <children> number of children to fork (default 2)\n"; print " -Ft <timeout> children process timeout (default 30)\n"; print " -Fm <num> children process max requests (default 100)\n"; print " -P <path> name of PID-file for spawned process\n"; print " -e <path> set new PATH environment (default /bin:/usr/bin)\n"; #print "(root only)\n"; #print " -c <directory> chroot to directory (default /)\n"; #print " -S create socket before chroot() (default is to create the socket in the chroot)\n"; #print " -u <user> change to user-id\n"; #print " -g <group> change to group-id (default: primary group of user if -u is given)\n"; #print " -U <user> change Unix domain socket owner to user-id\n"; #print " -G <group> change Unix domain socket group to group-id\n";
exit;
}
sub daemonize() {
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer
$ENV{'PATH'} = $PATHENV; # set new path environment
chdir $CURRENT_DIR or die "Can't chdir to $CURRENT_DIR: $!\n";
#setuid(65534) or die "Can't set uid: $!\n"; # nobody
open(STDIN, "+>/dev/null") or die "Can't open STDIN: $!\n"; open(STDOUT, "+>&STDIN") or die "Can't open STDOUT: $!\n"; open(STDERR, "+>&STDIN") or die "Can't open STDERR: $!\n"; defined(my $tm = fork) or die "Can't fork: $!\n"; exit if $tm; setsid or die "Can't start a new session: $!\n"; umask 0;
main();
}
sub main {
my ($ListenSocket); my ($proc_manager,$request,%req_params);
$ListenSocket = FCGI::OpenSocket( $SOCKET_ADDRESS, $SOCKET_BACKLOG );
if (defined($ListenSocket))
{
if (defined($PIDFILE))
{
open FILE, "> $PIDFILE" or die $!;
print FILE "$$\n";
close FILE;
}
if (substr($SOCKET_ADDRESS,0,1) eq '/')
{
print "chmod($SOCKET_MODE,$SOCKET_ADDRESS)\n";
chmod(oct($SOCKET_MODE),$SOCKET_ADDRESS);
}
$proc_manager = FCGI::ProcManager->new({ n_processes => $CHILDRENS_COUNT, die_timeout => $CHILDRENS_TIMEOUT });
$request = FCGI::Request( \*STDIN, \*STDOUT, \*STDERR, \%req_params, $ListenSocket, &FCGI::FAIL_ACCEPT_ON_INTR );
$proc_manager->pm_manage();
if ($request) { request_loop(\$proc_manager,\$request,\%req_params) };
FCGI::CloseSocket( $ListenSocket );
if (substr($SOCKET_ADDRESS,0,1) eq '/') {unlink($SOCKET_ADDRESS);}
if (defined($PIDFILE)) {unlink($PIDFILE);}
}
}
sub request_loop() {
my ($proc_manager_ref)=$_[0]; my ($request_ref)=$_[1]; my ($req_params_ref)=$_[2]; my ($stdin_passthrough,$req_len,$key,$pid_child,$req_count);
$req_count=1;
while( $$request_ref->Accept() >= 0 )
{
$$proc_manager_ref->pm_pre_dispatch();
#processing any STDIN input from WebServer (for CGI-POST actions)
$stdin_passthrough ='';
{ no warnings; $req_len = 0 + $$req_params_ref{'CONTENT_LENGTH'}; };
if (($$req_params_ref{'REQUEST_METHOD'} eq 'POST') && ($req_len != 0) )
{
my $bytes_read = 0;
while ($bytes_read < $req_len)
{
my $data = '';
my $bytes = read(STDIN, $data, ($req_len - $bytes_read));
last if ($bytes == 0 || !defined($bytes));
$stdin_passthrough .= $data;
$bytes_read += $bytes;
}
}
#running the cgi app
if ( (-x $$req_params_ref{SCRIPT_FILENAME}) && #can I execute this?
(-s $$req_params_ref{SCRIPT_FILENAME}) && #Is this file empty?
(-r $$req_params_ref{SCRIPT_FILENAME}) #can I read this file?
){
pipe(CHILD_RD, PARENT_WR);
$pid_child = open(KID_TO_READ, "-|");
unless(defined($pid_child))
{
print("Content-type: text/plain\r\n\r\n");
print "Error: CGI app returned no output - Executing $$req_params_ref{SCRIPT_FILENAME} failed !\n";
next;
}
if ($pid_child > 0)
{
close(CHILD_RD);
print PARENT_WR $stdin_passthrough;
close(PARENT_WR);
while(my $s = <KID_TO_READ>) { print $s; }
close KID_TO_READ;
waitpid($pid_child, 0);
}else{
foreach $key ( keys %{$req_params_ref}){ $ENV{$key} = $$req_params_ref{$key}; }
# cd to the script's local directory
if ($$req_params_ref{SCRIPT_FILENAME} =~ /^(.*)\/[^\/]+$/) { chdir $1;}
close(PARENT_WR);
close(STDIN);
#fcntl(CHILD_RD, F_DUPFD, 0);
syscall(&SYS_dup2, fileno(CHILD_RD), 0);
#open(STDIN, "<&CHILD_RD");
exec($$req_params_ref{SCRIPT_FILENAME});
die("exec failed");
}
}else{
print("Content-type: text/plain\r\n\r\n");
print "Error: No such CGI app - $$req_params_ref{SCRIPT_FILENAME} may not exist or is not executable by this process.\n";
}
$req_count++; exit if $req_count > $CHILDRENS_MAX_REQ;
$$proc_manager_ref->pm_post_dispatch(); }
} [/code]
Постарался проследить историю развития скрипта, может что то и напутал. Версию с более продвинутой логикой внутри мне не удалось заставить работать, поэтому я взял версию немного по проще, судя по описанию она не возвращает сообщений об ошибках в скриптах.
В коде видно часть не реализованных опций - часть из них реализуется стартовым скриптом (chroot, смена пользователя и группы), часть нет (смена владельца и группы на сокете).
