Someone asked about Loadsharing
May be this can help the ring,. http://www.stanford.edu/~schemers/docs/lbnamed/lbnamed.h tml With Regards, Anand Ratnasabapathy, DSM Soft(P)Ltd, No:25,Nungambakkam High Road, Chennai - 600 034.
Fwd: Someone asked about Loadbalancing
- Forwarded message from anandr [EMAIL PROTECTED] - Date: Mon, 17 Dec 2001 03:06:05 -0800 (PST) From: anandr [EMAIL PROTECTED] Reply-To: anandr [EMAIL PROTECTED] Subject: Someone asked about Loadsharing To: [EMAIL PROTECTED] May be this can help the ring,. http://www.stanford.edu/~schemers/docs/lbnamed/lbnamed.h tml With Regards, Anand Ratnasabapathy, DSM Soft(P)Ltd, No:25,Nungambakkam High Road, Chennai - 600 034. - End forwarded message - With Regards, Anand Ratnasabapathy, DSM Soft(P)Ltd, No:25,Nungambakkam High Road, Chennai - 600 034.
OT RE: load balancing on apache by IP CHAINING
I don't know how many of you read SysAdmin (http://www.samag.com), but there is an interesting article on running IPChains at runlevel 0. --Joe Breeden What to do... if you get a phone call from Mars: Speak slowly and be sure to enunciate your words properly. Limit your vocabulary to simple words. Try to determine if you are speaking to someone in a leadership capacity, or an ordinary citizen. if he, she or it doesn't speak English? Hang up. There's no sense in trying to learn Martian over the phone. If your Martian really had something important to say to you, he, she or it would have taken the trouble to learn the language before calling. if you get a phone call from Jupiter? Explain to your caller, politely but firmly, that being from Jupiter, he, she or it is not life as we know it. Try to terminate the conversation as soon as possible. It will not profit you, and the charges may have been reversed. -Original Message- From: David Young [mailto:[EMAIL PROTECTED]] Sent: Sunday, December 16, 2001 10:45 AM To: [EMAIL PROTECTED] Subject: Re: load balancing on apache by IP CHAINING Servlet chaining is what the Java web server will do, and it has nothing to do with load balancing (that I can think of). ipchains is the command to enable firewall/packet filter/packet masquerading capability in linux. I would suppose that it can be used to round-robin requests or something, but I don't know how to set that up. From: Medi Montaseri [EMAIL PROTECTED] Date: Sat, 15 Dec 2001 20:57:19 -0800 (PST) To: Anand R [EMAIL PROTECTED] Cc: [EMAIL PROTECTED], [EMAIL PROTECTED] Subject: Re: load balancing on apache by IP CHAINING I'm confused'IP chainging' as the name says is at the IP (or Network) layer, what does that have to do with Apache or any HTTP server at the application level. I think any such IP based load balancing technologies are inherently unaware of the total system issues and are simply making a jugdment based on the IP level or perhaps a specific protocol on top of IP to route the next packet (or next session). Having said that a Perl HTTP would/could benefit from it just as well... On Sat, 15 Dec 2001, Anand R wrote: IP chaining can be done in Java Webserver, How to do it in Apache Webserver. Please let the Ring know this, Thanks in advance, Regards, Anand - Original Message - From: Derek Jones To: Hemant Singh ; [EMAIL PROTECTED] Cc: Derek G Jones Sent: Friday, December 14, 2001 7:29 PM Subject: RE: load balancing on apache Hi all, You can do load balancing using ipchains as well. Can't remember the program name offhand, but if I have time I'll look it up and let the list know. Only works if your servers are Linux of course. Kind regards Derek. -- Derek Jones 1051, Bollinger Road, Tel:717 359 8817 Littlestown, Mobile: 717 977 4556PA, 17340, USA Email: [EMAIL PROTECTED] AIM: scunacc -- -- --- Medi Montaseri [EMAIL PROTECTED] Unix Distributed Systems Engineer HTTP://www.CyberShell.com CyberShell Engineering -- ---
How to check the return status?
Hello everyone,
I have a question that i can not resolve. The module dynamicaly
loads other modules to handle specific urls like this:
[snip]
my $handle = 'My::Module';
eval {
(my $h = $handle) =~ s!::!/!ig;
require $h . .pm;
};
if (!$@) {
if ($handle-can( handler )) {
$r-handler( perl-script );
$r-push_handlers( PerlHandler = \{${handle}::handler} );
??
}
}
[snip]
In this way the control is passed to another module. The module can
return OK, SERVER_ERROR, etc... How can i check the return status so
i can handle it (cache the output for example if the module returned
OK)
Thanks for any advice.
---
Best regards,
Alexei V. Alexandrov
Re: submit-data and chained handlers
Perrin Harkins wrote:
Apache::RequestNotes don't work because Apache::Registry expect to
read the
POST/PUT-data from STDIN.
It's important that the cgi-scripts run unmodified and without any
notice of
their unnaturally environment.
I don't think there's any way around the fact that you can only read the
content once. That means you need to read and store it for other
handlers to use, which is what Apache::RequestNotes does.
Alternatively, you could add something to your Registry script that
stuffs the parsed values into pnotes yourself after using them. If you
put that inside a block that checks for $ENV{'MOD_PERL'}, you'll still
be able to run the script safely under standard CGI.
It also looks like you're re-inventing Apache::Filter or
Apache::OutputChain. Have you tried them?
I agree - Apache::Filter is really the defacto standard here. no
reason to reinvent the wheel...
anyway, I'm really loving Apache::RegistryNG and ties these days... go
figure, I had to search for weeks for a decent Apache::RegistryNG
subclassing example for the book, but in two weeks the list provides
two examples that are probably better (though not as illustrative and
harder to explain).
anyway, I'm sure this is incomplete, but someone else around here can
hack it up more - the READ interface is pretty much stolen from
Apache::Filter, so I assume it works...
package My::CachePOSTRegistry;
use Apache::Constants qw(DONE);
use Apache::RegistryNG;
use Apache::Request;
use strict;
@My::CachePOSTRegistry::ISA = qw(Apache::RegistryNG);
sub new {
my ($class, $r) = @_;
$r = Apache::Request-instance($r || Apache-request);
tie *STDIN, $class, $r;
return tied *STDIN;
}
sub READ {
my $self = shift;
my $buf = \($_[0]); shift;
my $len = shift;
my $offset = shift || 0;
my @args = ();
$self-{r}-param-do(sub {
push @args, join '=', @_;
1;
});
my $input = join '', @args;
substr($$buf, $offset) = substr($input, 0, $len);
substr($input, 0, $len) = '';
return length substr($$buf, $offset);
}
sub TIEHANDLE {
my ($class, $r) = @_;
return bless { r = $r }, $class;
}
1;
I did a quick test with
#!/usr/bin/perl
my $posted;
read(STDIN, $posted, $ENV{'CONTENT_LENGTH'});
my $again;
read(STDIN, $again, $ENV{'CONTENT_LENGTH'});
print Content-type: text/plain\n\n;
print posted: $posted\nagain: $again\n;
--Geoff
RE: How to check the return status?
Perhaps something along the lines of :
$r-push_handlers(
PerlHandler = sub {
my $r = shift;
my $return = $handle-handler( $r );
if ( $return == Apache::Constants::OK ) {
??
}
}
);
-Original Message-
From: Alexei V. Alexandrov [mailto:[EMAIL PROTECTED]]
Sent: Monday, December 17, 2001 9:45 AM
To: [EMAIL PROTECTED]
Subject: How to check the return status?
Hello everyone,
I have a question that i can not resolve. The module dynamicaly
loads other modules to handle specific urls like this:
[snip]
my $handle = 'My::Module';
eval {
(my $h = $handle) =~ s!::!/!ig;
require $h . .pm;
};
if (!$@) {
if ($handle-can( handler )) {
$r-handler( perl-script );
$r-push_handlers( PerlHandler =
\{${handle}::handler} );
??
}
}
[snip]
In this way the control is passed to another module. The module can
return OK, SERVER_ERROR, etc... How can i check the return status so
i can handle it (cache the output for example if the module returned
OK)
Thanks for any advice.
---
Best regards,
Alexei V. Alexandrov
RE: mod_perl vs. C for high performance Apache modules
On Fri, 2001-12-14 at 14:27, Thomas Moore wrote: I spoke to the technical lead at Yahoo who said mod_perl will not scale as well as c++ when you get to their level of traffic, but for a large Isn't that coming from a company using Python? I see that most of their URLs include a tell-tale .py. Of course, whether that's really Python or not Matt
Re: mod_perl vs. C for high performance Apache modules
On Mon, Dec 17, 2001 at 10:32:58AM -0600, Matthew Kennedy wrote: On Fri, 2001-12-14 at 14:27, Thomas Moore wrote: I spoke to the technical lead at Yahoo who said mod_perl will not scale as well as c++ when you get to their level of traffic, but for a large Isn't that coming from a company using Python? I see that most of their URLs include a tell-tale .py. Of course, whether that's really Python or not searching join.yahoo.com I notice 12 job descriptions contain the word perl, and only 2 that contain the word python.. FWIW, the only place I notice the .py extension is maps.yahoo.com. -- Paul Lindner [EMAIL PROTECTED]| | | | | | | | | | mod_perl Developer's Cookbook http://www.modperlcookbook.org Human Rights Declaration http://www.unhchr.ch/udhr/index.htm
OT: Perl of Wisdom
On another Perl list someone offered some advice on ruining the perl from the command line. To be fair, the entire quote was The most problem is, that if you are ruinning the perl from the command line, you are definitly in the direaction you want. I think I have my mantra for the New Year. Grant BabbEmail: [EMAIL PROTECTED] Data Junction Corporation Phone: (512) 459-1308 2201 Northland Dr. Fax: (512) 459-1309 Austin, TX 78756-1117 Web: http://www.datajunction.com
mod_perl site challenge: proposal to use ASF site design
Hi, I've been watching the mod_perl site issue as it has progressed. Just last week Stas mentioned that voting at the online booth has been poor. (Low turnout.) I think I know why voting has been poor. And in my off-list conversation with Stas he's mentioned that other people have had the same opinions. I also think I have some constructive ideas. So, without further introduction, lets get into the thick of things. :-) I almost didn't vote for a site design. I went and looked at the three options: Allan Juul's design has navigation that doesn't help very much: it doesn't give top level links from every page and doesn't let you know where you are inside the site. The leaf pages don't even mention mod_perl anywhere, which is really weird and somewhat broken IMO. Carlos Ramirez's design is broken: broken navigation and pages that don't even exist. The page look is somewhat nice, but I can't really evaluate the navigation because it's so broken. Thomas Klausner's isn't broken in anyway and acceptable, but I don't really *like* the page look very much. So, because I liked none of the options and felt straight-jacketed with only one choice that was minimally functional, I almost didn't vote at all! In the end I voted for Klausner's in a simple defensive move to prevent a broken design from winning. I wish I had the time to create my own site and enter it into the competition. I'm think that others probably feel this way. However, the cause is not lost. We are not *required* as a community to pick one of these three proposed designs. This competition is just a tool to get a working site design. The mod_perl site needs a new design because: (a) it looks crummy and we are probably loosing users, (b) Stas is in the process of integrating the documentation into the site and therefore needs a new site design (and he's not a web designer). We can really do whatever we want. OK, now for the CONSTRUCTIVE PROPOSAL. :-) I propose that we simply use a site design that is the uniform psudo-standard for the Apache Software Foundation. A number of ASF projects are using this site design: http://www.apache.org/ http://httpd.apache.org/ http://jakarta.apache.org/ http://www.apache.org/foundation/ I used to think that this site design used by the ASF looked really dumb and plain. Now I think it rocks compared to these other three sites. It's simple and effective. Best of all, most of the design choices have already been made for us! Stas has pointed out the ASF site design uses different navigational features than the boilerplate site that he published back on 11/13/2001. This is true, but I think that we have some flexibility in changing the navigation. (I have some issues with the navigation in Stas' boilerplate, anyway.) I also suspect that one of the reasons that we've only had three sites contributed (and a couple of them broken) is because of the learning curve for learning Yet Another Publishing Tool (DocSet) that Stas is using. Additionally, we are a list mainly of programmers, not graphic designers. Perhaps having the graphic design issues solved by using the ASF site design, more people will be willing to volunteer to solve the programming issues of merging the existing DocSet boilerplate and the ASF design. OK. Now what to do with this? First what NOT to do: Please DO NOT respond and say Oh, well, that's nice but please integrate some of the ideas from some other website that I like. This causes endless discussion that GOES NOWHERE. We need concrete proposals. This e-mail is not intended to cause a general discussion of what people would like to see in a website. This has happened before and resulted in no forward progress. (So you ask: why is David allowed to propose a new idea? What I'm proposing is that we just wholesale copy an existing site design -- one that already exists, is related to us through Apache, and we can copy without any shame. So, in effect, what I'm proposing is as concrete as the example sites already posted for voting.) The purpose of this e-mail is as follows: (a) See if others also think that the three alternatives for a mod_perl site are not very desirable. If you agree, please speak up and say that you agree. (b) See if others also think that using the ASF generic site design (even though it's not cool and distinctive) would be a good idea. If you agree, please speak up and say that you agree. (c) Perhaps elicit a volunteer to design an example site that includes Stas' content and the ASF generic design. If enough people agree with the first two points, someone may be willing to volunteer to do this.. perhaps even one of the existing contributors who have already figured out DocSet. Perhaps even Stas! Lets try to keep this constructive, focused, and concrete. :-) Also, lets keep in mind something that Stas pointed out to me: most anything is a step up from our existing site design. So, if we go with one of the three existing options it's still a step up. David
Re: mod_perl site challenge: proposal to use ASF site design
At 4:17 PM -0500 12/17/01, David Harris wrote: The purpose of this e-mail is as follows: (a) See if others also think that the three alternatives for a mod_perl site are not very desirable. If you agree, please speak up and say that you agree. I agree. (b) See if others also think that using the ASF generic site design (even though it's not cool and distinctive) would be a good idea. If you agree, please speak up and say that you agree. I agree. (c) Perhaps elicit a volunteer to design an example site that includes Stas' content and the ASF generic design. If enough people agree with the first two points, someone may be willing to volunteer to do this.. perhaps even one of the existing contributors who have already figured out DocSet. Perhaps even Stas! Not me, sorry. A little too busy right now. Lets try to keep this constructive, focused, and concrete. :-) Concrete isn't used when building websites. Also, lets keep in mind something that Stas pointed out to me: most anything is a step up from our existing site design. So, if we go with one of the three existing options it's still a step up. So long as most anything doesn't include designs that are broken. Rob -- When I used a Mac, they laughed because I had no command prompt. When I used Linux, they laughed because I had no GUI.
Re: mod_perl site challenge: proposal to use ASF site design
On Mon, 17 Dec 2001, David Harris wrote: (a) See if others also think that the three alternatives for a mod_perl site are not very desirable. If you agree, please speak up and say that you agree. I thought Thomas' was fine but I think I actually prefer the ASF one. (b) See if others also think that using the ASF generic site design (even though it's not cool and distinctive) would be a good idea. If you agree, please speak up and say that you agree. I agree. Also, lets keep in mind something that Stas pointed out to me: most anything is a step up from our existing site design. So, if we go with one of the three existing options it's still a step up. Damn straight. -dave /*== www.urth.org We await the New Sun ==*/
[ANNOUNCE] Module::Require
Module::Require allows regular expressions or globs to be used for loading modules. For example: require_regex qw[ DBD::.* ]; OR require_glob qw[ DBD::* ]; will both load all of the available DBD:: modules, returning a list of existing files that could not be loaded. Both functions take multiple arguments, working on each in turn and returning a combined list of failed loads. I thought this might be useful if someone wrote an application framework that imported certain modules but didn't want to know what they were beforehand. file: $CPAN/authors/id/J/JS/JSMITH/Module-Require-0.02.tar.gz size: 2362 bytes md5: 9202900c90fed83e5722575566a26eba Version 0.01 forgot to set @ISA :/ -- James Smith [EMAIL PROTECTED], 979-862-3725 Texas AM CIS Operating Systems Group, Unix
Re: mod_perl site challenge: proposal to use ASF site design
Hi! On Mon, Dec 17, 2001 at 04:17:02PM -0500, David Harris wrote: As one of the three contributers I'd like to reply to some points you made: Thomas Klausner's isn't broken in anyway and acceptable, but I don't really *like* the page look very much. The main goal of my proposial wasn't really to /look/ good (as I am not a designer), but to be standard compiliant and fast loading and to make future /design/ changes easy by strictly seperating structure (HTML) from style (CSS). I propose that we simply use a site design that is the uniform psudo-standard for the Apache Software Foundation. A number of ASF projects are using this site design: http://www.apache.org/ http://httpd.apache.org/ http://jakarta.apache.org/ http://www.apache.org/foundation/ I just took a brief look at those sites, and I think that they are structurally somewhat different from the (new) mod_perl site. All those sites are rather flat, i.e. there are no deep nested hierarchies like at the mod_perl site (e.g.: Home / Documentation / mod_perl Developer's guide / ) We could maybe adopt their color scheme etc, but I think the mod_perl site /will/ need some more navigational tools. (a) See if others also think that the three alternatives for a mod_perl site are not very desirable. If you agree, please speak up and say that you agree. Just to defend my submission: All coloring, positioning, fonts, box layout etc is done in one CSS file that can easily be made nicer-looking. I basically just separated the structure from the styling, so that anybody who feels so inclined can do a nicer styling more easily. (c) Perhaps elicit a volunteer to design an example site that includes Stas' content and the ASF generic design. If enough people agree with the first two points, someone may be willing to volunteer to do this.. perhaps even one of the existing contributors who have already figured out DocSet. Perhaps even Stas! I think it would be quite easy to modify my submission to look like the ASF sites, but some navigational issues will have to be solved. For Example, I think that the NavBar on the top of the page, that shows where in the site you currently are and provides links to the upper levels is absolutely necessery. The prev/next links are quite nice, but not that important IMO. -- D_OMM + http://domm.zsi.at -+ O_xyderkes | neu: Arbeitsplatz | M_echanen | http://domm.zsi.at/d/d162.html | M_asteuei ++
Re: mod_perl site challenge: proposal to use ASF site design
On Mon, 17 Dec 2001, Thomas Klausner wrote: I propose that we simply use a site design that is the uniform psudo-standard for the Apache Software Foundation. A number of ASF projects are using this site design: http://www.apache.org/ http://httpd.apache.org/ http://jakarta.apache.org/ http://www.apache.org/foundation/ I just took a brief look at those sites, and I think that they are structurally somewhat different from the (new) mod_perl site. All those sites are rather flat, i.e. there are no deep nested hierarchies like at the mod_perl site (e.g.: Home / Documentation / mod_perl Developer's guide / ) Interestingly this has come up on the Cocoon-dev list also, who are looking to update the design of xml.apache.org, in such a way to allow deep navigation. Interested parties should probably check that list (try marc.theaimsgroup.com, subject Forrest). -- !-- Matt -- :-Get a smart net/:-
Apache::Cooke reserved chars
Hi all,
I'm recording a url at the beginning of an app to restore the
entrance url:
sub set_referer {
my $self = shift;
if ($self-{R}) {
require Apache::Cookie;
my $cookie = Apache::Cookie-new($self-{R},
-name= REFERER,
-value = $self-{R}-header_in('Referer'),
-expires = '2d',
-domain = .$NFN::sites{$ENV{SITE}}{domain},
-path= '/'
);
$cookie-bake;
}
}
Which stores the cookie portion like so:
REFERER=http://www.newsfactor.com/x.pl%3faction=reply_form_htmlboard=nfntalkbackid=3288
However when I pull this back in with Apache::Cookie-fetch,
the data then reads:
http://www.newsfactor.com/x.pl?action=reply_form_html
Apache::Cookie seems to be stripping out the portion after the first
ampersand.
Anybody know what do do here?
Thanks in advance,
--
--
Daniel Bohling
NewsFactor Network
cvs commit: modperl-2.0/xs/APR/PerlIO - New directory
stas01/12/17 08:18:17 modperl-2.0/xs/APR/PerlIO - New directory
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c apr_perlio.h Makefile.PL PerlIO.xs PerlIO.pm
stas01/12/17 08:20:27
Added: t/response/TestAPR perlio.pm
xs/APR/PerlIO apr_perlio.c apr_perlio.h Makefile.PL
PerlIO.xs PerlIO.pm
Log:
- implements APR::PerlIO layer
- implements apr_file_t to APR::PerlIO conversion hooks (one way) (two
different sets for 5.6.1 and 5.7.2+)
- tests (conversion hooks are tested in Apache::SubProcess)
Revision ChangesPath
1.1 modperl-2.0/t/response/TestAPR/perlio.pm
Index: perlio.pm
===
package TestAPR::perlio;
use strict;
use warnings;# FATAL = 'all';
use Apache::Const -compile = 'OK';
use Apache::Test;
use Apache::TestUtil;
use APR::PerlIO ();
use Fcntl ();
use File::Spec::Functions qw(catfile);
sub handler {
my $r = shift;
plan $r, tests = 9, todo = [5], have_perl 'iolayers';
my $vars = Apache::Test::config()-{vars};
my $dir = catfile $vars-{documentroot}, perlio;
t_mkdir($dir);
# write file
my $file = catfile $dir, test;
t_debug open file $file;
my $foo = bar;
open my $fh, :APR, $file, $r
or die Cannot open $file for writing: $!;
ok ref($fh) eq 'GLOB';
my $expected = This is a test: $$;
t_debug write to a file: $expected;
print $fh $expected;
close $fh;
# open() other tests
{
# non-existant file
my $file = /this/file/does/not/exist;
t_write_file(/tmp/testing, some stuff);
if (open my $fh, :APR, $file, $r) {
t_debug must not be able to open $file!;
ok 0;
close $fh;
}
else {
t_debug good! cannot open/doesn't exist: $!;
ok 1;
}
}
# read() test
{
open my $fh, :APR, $file, $r
or die Cannot open $file for reading: $!;
ok ref($fh) eq 'GLOB';
my $received = $fh;
close $fh;
ok t_cmp($expected,
$received,
read/write file);
}
# seek/tell() tests
{
open my $fh, :APR, $file, $r
or die Cannot open $file for reading: $!;
my $pos = 3;
seek $fh, $pos, Fcntl::SEEK_SET();
# XXX: broken
my $got = tell($fh);
ok t_cmp($pos,
$got,
seek/tell the file);
# XXX: test Fcntl::SEEK_CUR() Fcntl::SEEK_END()
close $fh;
}
# eof() tests
{
open my $fh, :APR, $file, $r
or die Cannot open $file for reading: $!;
ok t_cmp(0,
int eof($fh), # returns false, not 0
not end of file);
# go to the end and read
seek $fh, 0, Fcntl::SEEK_END();
my $received = $fh;
ok t_cmp(1,
eof($fh),
end of file);
close $fh;
}
# dup() test
{
open my $fh, :APR, $file, $r
or die Cannot open $file for reading: $!;
open my $dup_fh, :APR, $fh
or die Cannot dup $file for reading: $!;
close $fh;
ok ref($dup_fh) eq 'GLOB';
my $received = $dup_fh;
close $dup_fh;
ok t_cmp($expected,
$received,
read/write a dupped file);
}
# XXX: need tests
# - for stdin/out/err as they are handled specially
# - unbuffered read $|=1?
# XXX: tmpfile is missing:
# consider to use 5.8's syntax:
# open $fh, +, undef;
# cleanup: t_mkdir will remove the whole tree including the file
Apache::OK;
}
1;
1.1 modperl-2.0/xs/APR/PerlIO/apr_perlio.c
Index: apr_perlio.c
===
#include mod_perl.h
#include apr_perlio.h
/* XXX: prerequisites to have things working
* open(): perl 5.7.2 patch 13534 is required
* dup() : apr cvs date: 2001/12/06 13:43:45
* tell(): the patch isn't in yet.
*
* XXX: it's not enough to check for PERLIO_LAYERS, some functionality
* and bug fixes were added only in the late 5.7.2, whereas
* PERLIO_LAYERS is available in 5.7.1
*/
#ifdef PERLIO_LAYERS /* 5.7.2+ */
/**
* The PerlIO APR layer.
* The PerlIO API is documented in perliol.pod.
**/
typedef struct {
PerlIOBuf base;/* PerlIOBuf stuff */
apr_file_t *file;
apr_pool_t *pool;
} PerlIOAPR;
/* clean up any structures linked from PerlIOAPR. a layer can be
* popped without being closed if the program is
cvs commit: modperl-2.0/xs/Apache/SubProcess - New directory
stas01/12/17 08:20:51 modperl-2.0/xs/Apache/SubProcess - New directory
cvs commit: modperl-2.0/xs/maps modperl_functions.map
stas01/12/17 08:22:07
Modified:xs/maps modperl_functions.map
Added: t/response/TestApache subprocess.pm
xs/Apache/SubProcess Apache__SubProcess.h SubProcess_pm
Log:
- implement Apache::SubProcess::spawn_proc_prog (which allows to run a
program in a spawned process and provides in/out/err pipes to it)
Revision ChangesPath
1.1 modperl-2.0/t/response/TestApache/subprocess.pm
Index: subprocess.pm
===
package TestApache::subprocess;
use strict;
use warnings FATAL = 'all';
use Apache::Const -compile = 'OK';
use Apache::Test;
use Apache::TestUtil;
use File::Spec::Functions qw(catfile catdir);
use Apache::SubProcess ();
my %scripts = (
argv = 'print STDOUT @ARGV;',
env= 'print STDOUT $ENV{SubProcess}',
in_out = 'print STDOUT scalar STDIN;',
in_err = 'print STDERR scalar STDIN;',
);
sub APACHE_TEST_CONFIGURE {
my ($class, $self) = @_;
my $vars = $self-{vars};
my $target_dir = catdir $vars-{documentroot}, util;
while (my($file, $code) = each %scripts) {
$file = catfile $target_dir, $file.pl;
$self-write_perlscript($file, $code\n);
}
}
sub handler {
my $r = shift;
my $cfg = Apache::Test::config();
my $vars = $cfg-{vars};
# XXX: these tests randomly fail under 5.6.1
plan $r, todo = [1..4], tests = 4;
my $target_dir = catfile $vars-{documentroot}, util;
{
# test: passing argv + scalar context
my $command = catfile $target_dir, argv.pl;
my @argv = qw(foo bar);
my $out = Apache::SubProcess::spawn_proc_prog($r, $command, \@argv);
ok t_cmp(\@argv,
[split / /, $out],
passing ARGV
);
}
{
# test: passing env to subprocess through subprocess_env
my $command = catfile $target_dir, env.pl;
my $value = my cool proc;
$r-subprocess_env-set(SubProcess = $value);
my $out = Apache::SubProcess::spawn_proc_prog($r, $command);
ok t_cmp($value,
$out,
passing env via subprocess_env
);
}
{
# test: subproc's stdin - stdout + list context
my $command = catfile $target_dir, in_out.pl;
my $value = my cool proc\n; # must have \n for IN
my ($in, $out, $err) =
Apache::SubProcess::spawn_proc_prog($r, $command);
print $in $value;
ok t_cmp($value,
$out,
testing subproc's stdin - stdout + list context
);
}
{
# test: subproc's stdin - stderr + list context
my $command = catfile $target_dir, in_err.pl;
my $value = my stderr\n; # must have \n for IN
my ($in, $out, $err) =
Apache::SubProcess::spawn_proc_prog($r, $command);
print $in $value;
ok t_cmp($value,
$err,
testing subproc's stdin - stderr + list context
);
}
# could test send_fd($out), send_fd($err), but currently it's only in
# compat.pm.
# these are wannabe's
#ok t_cmp(
# Apache::SUCCESS,
# Apache::SubProcess::spawn_proc_sub($r, $sub, \@args),
# spawn a subprocess and run a subroutine in it
#);
#ok t_cmp(
# Apache::SUCCESS,
# Apache::SubProcess::spawn_thread_prog($r, $command, \@argv),
# spawn thread and run a program in it
#);
# ok t_cmp(
# Apache::SUCCESS,
# Apache::SubProcess::spawn_thread_sub($r, $sub, \@args),
# spawn thread and run a subroutine in it
#);
Apache::OK;
}
1;
__DATA__
PerlModule Apache::SubProcess
1.1 modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h
Index: Apache__SubProcess.h
===
#include ../../APR/PerlIO/apr_perlio.h
#ifndef MP_SOURCE_SCAN
#include apr_optional.h
#endif
#ifndef MP_SOURCE_SCAN
static APR_OPTIONAL_FN_TYPE(apr_perlio_apr_file_to_glob) *apr_file_to_glob;
#endif
/* XXX: probably needs a lot more error checkings */
typedef struct {
apr_int32_tin_pipe;
apr_int32_tout_pipe;
apr_int32_terr_pipe;
apr_cmdtype_e cmd_type;
} exec_info;
#define FAILED(command) ((rc = command) != APR_SUCCESS)
static int modperl_spawn_proc_prog(request_rec *r,
const char *command,
const char ***argv,
apr_file_t
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
stas01/12/17 08:55:46
Modified:xs/APR/PerlIO apr_perlio.c
Log:
- maintainer mode cleanups
Revision ChangesPath
1.2 +3 -4 modperl-2.0/xs/APR/PerlIO/apr_perlio.c
Index: apr_perlio.c
===
RCS file: /home/cvs/modperl-2.0/xs/APR/PerlIO/apr_perlio.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- apr_perlio.c 2001/12/17 16:20:27 1.1
+++ apr_perlio.c 2001/12/17 16:55:46 1.2
@@ -31,7 +31,7 @@
*/
static IV PerlIOAPR_popped(PerlIO *f)
{
-PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
+//PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
return 0;
}
@@ -41,12 +41,10 @@
const char *mode, int fd, int imode,
int perm, PerlIO *f, int narg, SV **args)
{
-AV *av_arg;
SV *arg = (narg 0) ? *args : PerlIOArg;
PerlIOAPR *st;
const char *path;
apr_int32_t apr_flag;
-int len;
apr_status_t rc;
SV *sv;
@@ -105,7 +103,6 @@
static PerlIO *PerlIOAPR_dup(pTHX_ PerlIO *f, PerlIO *o,
CLONE_PARAMS *param, int flags)
{
-Size_t count;
apr_status_t rc;
if ( (f = PerlIOBase_dup(aTHX_ f, o, param, flags)) ) {
@@ -264,6 +261,8 @@
return 0;
case APR_EOF:
return 1;
+ default:
+return -1;
}
}
cvs commit: modperl-2.0/t/response/TestApache subprocess.pm
dougm 01/12/17 16:21:02 Modified:t/response/TestApache subprocess.pm Log: do not attempt to preload Apache::SubProcess Revision ChangesPath 1.2 +2 -2 modperl-2.0/t/response/TestApache/subprocess.pm Index: subprocess.pm === RCS file: /home/cvs/modperl-2.0/t/response/TestApache/subprocess.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -u -r1.1 -r1.2 --- subprocess.pm 2001/12/17 16:22:07 1.1 +++ subprocess.pm 2001/12/18 00:21:02 1.2 @@ -118,5 +118,5 @@ 1; -__DATA__ -PerlModule Apache::SubProcess + +
cvs commit: modperl-2.0/t/response/TestApache subprocess.pm
dougm 01/12/17 16:23:03
Modified:t/response/TestApache subprocess.pm
Log:
skip subprocess test unless Apache::SubProcess is available
Revision ChangesPath
1.3 +2 -2 modperl-2.0/t/response/TestApache/subprocess.pm
Index: subprocess.pm
===
RCS file: /home/cvs/modperl-2.0/t/response/TestApache/subprocess.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- subprocess.pm 2001/12/18 00:21:02 1.2
+++ subprocess.pm 2001/12/18 00:23:03 1.3
@@ -9,7 +9,7 @@
use Apache::TestUtil;
use File::Spec::Functions qw(catfile catdir);
-use Apache::SubProcess ();
+eval { require Apache::SubProcess };
my %scripts = (
argv = 'print STDOUT @ARGV;',
@@ -38,7 +38,7 @@
my $vars = $cfg-{vars};
# XXX: these tests randomly fail under 5.6.1
-plan $r, todo = [1..4], tests = 4;
+plan $r, todo = [1..4], tests = 4, have_module 'Apache::SubProcess';
my $target_dir = catfile $vars-{documentroot}, util;
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
dougm 01/12/17 16:37:01
Modified:xs/APR/PerlIO apr_perlio.c
Log:
allow to compile with older bleedperls
Revision ChangesPath
1.3 +9 -2 modperl-2.0/xs/APR/PerlIO/apr_perlio.c
Index: apr_perlio.c
===
RCS file: /home/cvs/modperl-2.0/xs/APR/PerlIO/apr_perlio.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- apr_perlio.c 2001/12/17 16:55:46 1.2
+++ apr_perlio.c 2001/12/18 00:37:01 1.3
@@ -12,7 +12,7 @@
* PERLIO_LAYERS is available in 5.7.1
*/
-#ifdef PERLIO_LAYERS /* 5.7.2+ */
+#if defined(PERLIO_LAYERS) defined(PERLIO_K_MULTIARG) /* 5.7.2+ */
/**
* The PerlIO APR layer.
@@ -377,7 +377,7 @@
type);
}
-#else /* NOT PERLIO_LAYERS (5.6.1) */
+#elif !defined(PERLIO_LAYERS) /* NOT PERLIO_LAYERS (5.6.1) */
FILE *apr_perlio_apr_file_to_FILE(pTHX_ apr_file_t *file, int type)
{
@@ -445,6 +445,13 @@
void apr_perlio_init(pTHX)
{
APR_REGISTER_OPTIONAL_FN(apr_perlio_apr_file_to_glob);
+}
+
+#else
+
+void apr_perlio_init(pTHX)
+{
+Perl_croak(aTHX_ APR::PerlIO not usable with this version of Perl);
}
#endif /* PERLIO_LAYERS */
cvs commit: modperl-2.0/t/response/TestAPR perlio.pm
dougm 01/12/17 16:43:37
Modified:t/response/TestAPR perlio.pm
Log:
we do want have_perl iolayers in the plan for 5.6.1
Revision ChangesPath
1.3 +1 -1 modperl-2.0/t/response/TestAPR/perlio.pm
Index: perlio.pm
===
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/perlio.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- perlio.pm 2001/12/18 00:36:22 1.2
+++ perlio.pm 2001/12/18 00:43:37 1.3
@@ -23,7 +23,7 @@
return Apache::OK;
}
-plan $r, tests = 9, todo = [5];
+plan $r, tests = 9, todo = [5], have_perl 'iolayers';
my $vars = Apache::Test::config()-{vars};
my $dir = catfile $vars-{documentroot}, perlio;
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
dougm 01/12/17 17:13:15
Modified:xs/APR/PerlIO apr_perlio.c
Log:
style nits:
- no //comments
- no else branch where if returns a value
- whitespace--
make note that modperl_* functions cannot be used outside of httpd
Revision ChangesPath
1.4 +33 -36modperl-2.0/xs/APR/PerlIO/apr_perlio.c
Index: apr_perlio.c
===
RCS file: /home/cvs/modperl-2.0/xs/APR/PerlIO/apr_perlio.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- apr_perlio.c 2001/12/18 00:37:01 1.3
+++ apr_perlio.c 2001/12/18 01:13:15 1.4
@@ -31,7 +31,7 @@
*/
static IV PerlIOAPR_popped(PerlIO *f)
{
-//PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
+/* PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR); */
return 0;
}
@@ -48,7 +48,7 @@
apr_status_t rc;
SV *sv;
-if ( !(SvROK(arg) || SvPOK(arg)) ) {
+if (!(SvROK(arg) || SvPOK(arg))) {
return NULL;
}
@@ -78,6 +78,7 @@
st = PerlIOSelf(f, PerlIOAPR);
sv = args[narg-1];
+/* XXX: modperl_sv2pool cannot be used outside of httpd */
st-pool = modperl_sv2pool(aTHX_ sv);
rc = apr_file_open(st-file, path, apr_flag, APR_OS_DEFAULT, st-pool);
@@ -85,10 +86,9 @@
PerlIOBase(f)-flags |= PERLIO_F_ERROR;
return NULL;
}
-else {
-PerlIOBase(f)-flags |= PERLIO_F_OPEN;
-return f;
-}
+
+PerlIOBase(f)-flags |= PERLIO_F_OPEN;
+return f;
}
static IV PerlIOAPR_fileno(PerlIO *f)
@@ -105,7 +105,7 @@
{
apr_status_t rc;
-if ( (f = PerlIOBase_dup(aTHX_ f, o, param, flags)) ) {
+if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
PerlIOAPR *fst = PerlIOSelf(f, PerlIOAPR);
PerlIOAPR *ost = PerlIOSelf(o, PerlIOAPR);
@@ -117,10 +117,8 @@
}
return NULL;
-
}
-
/* currrently read is very not-optimized, since in many cases the read
* process happens a char by char. Need to find a way to snoop on APR
* read buffer from PerlIO, or implement our own buffering layer here
@@ -129,33 +127,33 @@
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
apr_status_t rc;
-dTHX;
+dTHX; /* XXX: change Perl so this function has a pTHX_ prototype */
-//fprintf(stderr, in read: count %d, %s\n, (int)count, (char*) vbuf);
+/* fprintf(stderr, in read: count %d, %s\n,
+ (int)count, (char*) vbuf); */
rc = apr_file_read(st-file, vbuf, count);
-//fprintf(stderr, out read: count %d, %s\n, (int)count, (char*) vbuf);
+/* fprintf(stderr, out read: count %d, %s\n,
+ (int)count, (char*) vbuf); */
if (rc == APR_SUCCESS) {
return (SSize_t) count;
}
-else {
-return (SSize_t) -1;
-}
-}
+return (SSize_t) -1;
+}
static SSize_t PerlIOAPR_write(PerlIO *f, const void *vbuf, Size_t count)
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
apr_status_t rc;
-//fprintf(stderr, in write: count %d, %s\n, (int)count, (char*) vbuf);
+/* fprintf(stderr, in write: count %d, %s\n,
+ (int)count, (char*) vbuf); */
rc = apr_file_write(st-file, vbuf, count);
if (rc == APR_SUCCESS) {
return (SSize_t) count;
}
-else {
-return (SSize_t) -1;
-}
+
+return (SSize_t) -1;
}
static IV PerlIOAPR_seek(PerlIO *f, Off_t offset, int whence)
@@ -186,9 +184,8 @@
if (rc == APR_SUCCESS) {
return 0;
}
-else {
-return -1;
-}
+
+return -1;
}
static Off_t PerlIOAPR_tell(PerlIO *f)
@@ -202,10 +199,9 @@
rc = apr_file_seek(st-file, APR_CUR, offset);
if (rc == APR_SUCCESS) {
return (Off_t) offset;
-}
-else {
-return (Off_t) -1;
}
+
+return (Off_t) -1;
}
static IV PerlIOAPR_close(PerlIO *f)
@@ -216,7 +212,7 @@
const char *new_path;
apr_file_name_get(new_path, st-file);
-//fprintf(stderr, closing file %s\n, new_path);
+/* fprintf(stderr, closing file %s\n, new_path); */
rc = apr_file_flush(st-file);
if (rc != APR_SUCCESS) {
@@ -240,9 +236,8 @@
if (rc == APR_SUCCESS) {
return 0;
}
-else {
-return -1;
-}
+
+return -1;
}
static IV PerlIOAPR_fill(PerlIO *f)
@@ -262,8 +257,9 @@
case APR_EOF:
return 1;
default:
-return -1;
}
+
+return -1;
}
static PerlIO_funcs PerlIO_APR = {
@@ -338,10 +334,9 @@
PerlIOBase(f)-flags |= PERLIO_F_OPEN;
return f;
-}
-else {
-return NULL;
}
+
+return NULL;
}
/*
@@ -349,6
cvs commit: modperl-2.0/xs/tables/current/ModPerl FunctionTable.pm
dougm 01/12/17 17:55:52
Modified:xs/tables/current/ModPerl FunctionTable.pm
Log:
sync
Revision ChangesPath
1.54 +34 -1 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
Index: FunctionTable.pm
===
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -r1.53 -r1.54
--- FunctionTable.pm 2001/12/15 23:51:43 1.53
+++ FunctionTable.pm 2001/12/18 01:55:52 1.54
@@ -2,7 +2,7 @@
# !!
# ! WARNING: generated by ModPerl::ParseSource/0.01
-# ! Sat Dec 15 15:39:57 2001
+# ! Mon Dec 17 17:56:17 2001
# ! do NOT edit, any changes will be lost !
# !!
@@ -3335,6 +3335,39 @@
{
'type' = 'void *',
'name' = 'cfg'
+ }
+]
+ },
+ {
+'return_type' = 'int',
+'name' = 'modperl_spawn_proc_prog',
+'attr' = [
+ 'static'
+],
+'args' = [
+ {
+'type' = 'request_rec *',
+'name' = 'r'
+ },
+ {
+'type' = 'const char *',
+'name' = 'command'
+ },
+ {
+'type' = 'const char ***',
+'name' = 'argv'
+ },
+ {
+'type' = 'apr_file_t **',
+'name' = 'script_in'
+ },
+ {
+'type' = 'apr_file_t **',
+'name' = 'script_out'
+ },
+ {
+'type' = 'apr_file_t **',
+'name' = 'script_err'
}
]
},
cvs commit: modperl-2.0/t/apr .cvsignore
dougm 01/12/17 17:56:47 Modified:t/apache .cvsignore t/apr.cvsignore Log: ignores Revision ChangesPath 1.3 +1 -0 modperl-2.0/t/apache/.cvsignore Index: .cvsignore === RCS file: /home/cvs/modperl-2.0/t/apache/.cvsignore,v retrieving revision 1.2 retrieving revision 1.3 diff -u -r1.2 -r1.3 --- .cvsignore2001/09/12 17:11:47 1.2 +++ .cvsignore2001/12/18 01:56:47 1.3 @@ -6,3 +6,4 @@ read.t scanhdrs.t write.t +subprocess.t 1.3 +1 -0 modperl-2.0/t/apr/.cvsignore Index: .cvsignore === RCS file: /home/cvs/modperl-2.0/t/apr/.cvsignore,v retrieving revision 1.2 retrieving revision 1.3 diff -u -r1.2 -r1.3 --- .cvsignore2001/09/12 17:11:48 1.2 +++ .cvsignore2001/12/18 01:56:47 1.3 @@ -5,3 +5,4 @@ pool.t table.t uuid.t +perlio.t
cvs commit: modperl-2.0/xs/APR/PerlIO .cvsignore
dougm 01/12/17 17:57:55 Added: xs/APR/PerlIO .cvsignore Log: ignore Revision ChangesPath 1.1 modperl-2.0/xs/APR/PerlIO/.cvsignore Index: .cvsignore === PerlIO.bs PerlIO.c Makefile pm_to_blib
cvs commit: modperl-2.0/xs/Apache/SubProcess Apache__SubProcess.h
dougm 01/12/17 19:21:22
Modified:xs/Apache/SubProcess Apache__SubProcess.h
Log:
a few style fixups and comments
Revision ChangesPath
1.2 +46 -45modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h
Index: Apache__SubProcess.h
===
RCS file: /home/cvs/modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Apache__SubProcess.h 2001/12/17 16:22:07 1.1
+++ Apache__SubProcess.h 2001/12/18 03:21:22 1.2
@@ -2,9 +2,7 @@
#ifndef MP_SOURCE_SCAN
#include apr_optional.h
-#endif
-#ifndef MP_SOURCE_SCAN
static APR_OPTIONAL_FN_TYPE(apr_perlio_apr_file_to_glob) *apr_file_to_glob;
#endif
@@ -17,9 +15,12 @@
apr_cmdtype_e cmd_type;
} exec_info;
-
#define FAILED(command) ((rc = command) != APR_SUCCESS)
+#define SET_TIMEOUT(fp) \
+apr_file_pipe_timeout_set(fp, \
+ (int)(r-server-timeout * APR_USEC_PER_SEC))
+
static int modperl_spawn_proc_prog(request_rec *r,
const char *command,
const char ***argv,
@@ -34,27 +35,26 @@
apr_procattr_t *procattr;
apr_proc_t *procnew;
apr_status_t rc = APR_SUCCESS;
-
+
e_info.in_pipe = APR_CHILD_BLOCK;
e_info.out_pipe = APR_CHILD_BLOCK;
e_info.err_pipe = APR_CHILD_BLOCK;
e_info.cmd_type = APR_PROGRAM;
-
+
p = r-main ? r-main-pool : r-pool;
+
+*script_out = *script_in = *script_err = NULL;
+
+env = (const char * const *)ap_create_environment(p, r-subprocess_env);
-*script_out = NULL;
-*script_in = NULL;
-*script_err = NULL;
-
-env = (const char* const*)ap_create_environment(p, r-subprocess_env);
-
-if ( FAILED(apr_procattr_create(procattr, p)) ||
- FAILED(apr_procattr_io_set(procattr, e_info.in_pipe,
-e_info.out_pipe, e_info.err_pipe)) ||
- FAILED(apr_procattr_dir_set(procattr,
- ap_make_dirstr_parent(r-pool,
- r-filename))) ||
- FAILED(apr_procattr_cmdtype_set(procattr, e_info.cmd_type))) {
+if (FAILED(apr_procattr_create(procattr, p)) ||
+FAILED(apr_procattr_io_set(procattr, e_info.in_pipe,
+ e_info.out_pipe, e_info.err_pipe)) ||
+FAILED(apr_procattr_dir_set(procattr,
+ap_make_dirstr_parent(r-pool,
+ r-filename))) ||
+FAILED(apr_procattr_cmdtype_set(procattr, e_info.cmd_type)))
+{
/* Something bad happened, tell the world. */
ap_log_rerror(APLOG_MARK, APLOG_ERR, rc, r,
couldn't set child process attributes: %s,
@@ -63,49 +63,47 @@
}
procnew = apr_pcalloc(p, sizeof(*procnew));
-if FAILED(ap_os_create_privileged_process(r, procnew, command,
- *argv, env, procattr, p)) {
+if (FAILED(ap_os_create_privileged_process(r, procnew, command,
+ *argv, env, procattr, p)))
+{
/* Bad things happened. Everyone should have cleaned up. */
ap_log_rerror(APLOG_MARK, APLOG_ERR, rc, r,
- couldn't create child process: %d: %s, rc, r-filename);
+ couldn't create child process: %d: %s,
+ rc, r-filename);
return rc;
}
apr_pool_note_subprocess(p, procnew, kill_after_timeout);
-*script_in = procnew-in;
-if (!*script_in) {
+if (!(*script_in = procnew-in)) {
+/* XXX: this needs to be Perl_croak(aTHX_ ...)
+ * or go away so we can compile with -DPERL_CORE
+ */
croak(broken program-in stream);
return APR_EBADF;
}
-apr_file_pipe_timeout_set(*script_in,
- (int)(r-server-timeout * APR_USEC_PER_SEC));
+SET_TIMEOUT(*script_in);
-*script_out = procnew-out;
-if (!*script_out) {
+if (!(*script_out = procnew-out)) {
croak(broken program-out stream);
return APR_EBADF;
}
-apr_file_pipe_timeout_set(*script_out,
- (int)(r-server-timeout * APR_USEC_PER_SEC));
+SET_TIMEOUT(*script_in);
-*script_err = procnew-err;
-if (!*script_err) {
+if (!(*script_err = procnew-err)) {
croak(broken program-err stream);
return APR_EBADF;
}
-apr_file_pipe_timeout_set(*script_err,
- (int)(r-server-timeout *
cvs commit: modperl-2.0/xs/Apache/SubProcess Apache__SubProcess.h
dougm 01/12/17 19:24:49
Modified:xs/Apache/SubProcess Apache__SubProcess.h
Log:
plug av_argv memory leak
Revision ChangesPath
1.3 +3 -1 modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h
Index: Apache__SubProcess.h
===
RCS file: /home/cvs/modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Apache__SubProcess.h 2001/12/18 03:21:22 1.2
+++ Apache__SubProcess.h 2001/12/18 03:24:49 1.3
@@ -120,7 +120,7 @@
if (items == 3) {
if (SvROK(ST(2)) SvTYPE(SvRV(ST(2))) == SVt_PVAV) {
-av_argv = (AV*)SvRV(ST(2));
+av_argv = (AV*)SvREFCNT_inc(SvRV(ST(2)));
}
else {
Perl_croak(aTHX_ usage);
@@ -149,6 +149,8 @@
rc = modperl_spawn_proc_prog(r, command, argv,
script_in, script_out,
script_err);
+
+SvREFCNT_dec(av_argv);
if (rc == APR_SUCCESS) {
/* XXX: apr_file_to_glob should be set once in the BOOT: section */
cvs commit: modperl-2.0/xs/Apache/SubProcess Apache__SubProcess.h
dougm 01/12/17 19:40:02
Modified:xs/Apache/SubProcess Apache__SubProcess.h
Log:
avoid calling av_len() more than once.
switch from using av_len() to AvFILLp
add av_items variable to avoid (-1 + 2) when there is no av_argv
Revision ChangesPath
1.4 +9 -6 modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h
Index: Apache__SubProcess.h
===
RCS file: /home/cvs/modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Apache__SubProcess.h 2001/12/18 03:24:49 1.3
+++ Apache__SubProcess.h 2001/12/18 03:40:02 1.4
@@ -115,12 +115,15 @@
const char **argv;
int i;
AV *av_argv;
+I32 len=-1, av_items=0;
request_rec *r = modperl_xs_sv2request_rec(aTHX_ ST(0), NULL, cv);
const char *command = (const char *)SvPV_nolen(ST(1));
if (items == 3) {
if (SvROK(ST(2)) SvTYPE(SvRV(ST(2))) == SVt_PVAV) {
av_argv = (AV*)SvREFCNT_inc(SvRV(ST(2)));
+len = AvFILLp(av_argv);
+av_items = len+1;
}
else {
Perl_croak(aTHX_ usage);
@@ -129,21 +132,21 @@
else {
av_argv = newAV();
}
-
+
/* ap_os_create_privileged_process expects ARGV as char
* **argv, with terminating NULL and the program itself as a
* first item.
*/
-argv = apr_palloc(r-pool,
- (3 + av_len(av_argv)) * sizeof(char *));
+argv = apr_palloc(r-pool, (av_items + 2) * sizeof(char *));
argv[0] = command;
-for (i = 0; i = av_len(av_argv); i++) {
+for (i = 0; i = len; i++) {
argv[i+1] = (const char *)SvPV_nolen(AvARRAY(av_argv)[i]);
}
argv[i+1] = NULL;
#if 0
-for (i=0; i=av_len(av_argv)+2; i++) {
-Perl_warn(aTHX_ arg: %d %s\n, i, argv[i]);
+for (i=0; i=len+2; i++) {
+Perl_warn(aTHX_ arg: %d %s\n,
+ i, argv[i] ? argv[i] : NULL);
}
#endif
rc = modperl_spawn_proc_prog(r, command, argv,
cvs commit: modperl-2.0/xs/Apache/SubProcess Apache__SubProcess.h
dougm 01/12/17 19:44:33
Modified:xs/Apache/SubProcess Apache__SubProcess.h
Log:
dont bother creating an empty av_argv if no args are passed into spawn_proc_prog
Revision ChangesPath
1.5 +7 -10 modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h
Index: Apache__SubProcess.h
===
RCS file: /home/cvs/modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- Apache__SubProcess.h 2001/12/18 03:40:02 1.4
+++ Apache__SubProcess.h 2001/12/18 03:44:33 1.5
@@ -113,15 +113,15 @@
apr_file_t *script_in, *script_out, *script_err;
apr_status_t rc;
const char **argv;
-int i;
-AV *av_argv;
+int i=0;
+AV *av_argv = Nullav;
I32 len=-1, av_items=0;
request_rec *r = modperl_xs_sv2request_rec(aTHX_ ST(0), NULL, cv);
const char *command = (const char *)SvPV_nolen(ST(1));
if (items == 3) {
if (SvROK(ST(2)) SvTYPE(SvRV(ST(2))) == SVt_PVAV) {
-av_argv = (AV*)SvREFCNT_inc(SvRV(ST(2)));
+av_argv = (AV*)SvRV(ST(2));
len = AvFILLp(av_argv);
av_items = len+1;
}
@@ -129,9 +129,6 @@
Perl_croak(aTHX_ usage);
}
}
-else {
-av_argv = newAV();
-}
/* ap_os_create_privileged_process expects ARGV as char
* **argv, with terminating NULL and the program itself as a
@@ -139,8 +136,10 @@
*/
argv = apr_palloc(r-pool, (av_items + 2) * sizeof(char *));
argv[0] = command;
-for (i = 0; i = len; i++) {
-argv[i+1] = (const char *)SvPV_nolen(AvARRAY(av_argv)[i]);
+if (av_argv) {
+for (i = 0; i = len; i++) {
+argv[i+1] = (const char *)SvPV_nolen(AvARRAY(av_argv)[i]);
+}
}
argv[i+1] = NULL;
#if 0
@@ -152,8 +151,6 @@
rc = modperl_spawn_proc_prog(r, command, argv,
script_in, script_out,
script_err);
-
-SvREFCNT_dec(av_argv);
if (rc == APR_SUCCESS) {
/* XXX: apr_file_to_glob should be set once in the BOOT: section */
cvs commit: modperl-2.0/xs/Apache/SubProcess Apache__SubProcess.h
dougm 01/12/17 19:54:49
Modified:xs/Apache/SubProcess Apache__SubProcess.h
Log:
cut down some duplication with PUSH_FILE_GLOB_* macros
Revision ChangesPath
1.6 +15 -9 modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h
Index: Apache__SubProcess.h
===
RCS file: /home/cvs/modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- Apache__SubProcess.h 2001/12/18 03:44:33 1.5
+++ Apache__SubProcess.h 2001/12/18 03:54:49 1.6
@@ -99,6 +99,15 @@
return rc;
}
+#define PUSH_FILE_GLOB(fp, type) \
+PUSHs(apr_file_to_glob(aTHX_ fp, r-pool, type))
+
+#define PUSH_FILE_GLOB_READ(fp) \
+PUSH_FILE_GLOB(fp, APR_PERLIO_HOOK_READ)
+
+#define PUSH_FILE_GLOB_WRITE(fp) \
+PUSH_FILE_GLOB(fp, APR_PERLIO_HOOK_WRITE)
+
static XS(MPXS_modperl_spawn_proc_prog)
{
dXSARGS;
@@ -161,9 +170,8 @@
/* XXX: need to do lots of error checking before
* putting the object on the stack
*/
-SV *out = apr_file_to_glob(aTHX_ script_out, r-pool,
- APR_PERLIO_HOOK_READ);
-XPUSHs(out);
+EXTEND(SP, 1);
+PUSH_FILE_GLOB_READ(script_out);
rc = apr_file_close(script_in);
if (rc != APR_SUCCESS) {
@@ -176,12 +184,10 @@
}
}
else {
-XPUSHs(apr_file_to_glob(aTHX_ script_in,
-r-pool, APR_PERLIO_HOOK_WRITE));
-XPUSHs(apr_file_to_glob(aTHX_ script_out,
-r-pool, APR_PERLIO_HOOK_READ));
-XPUSHs(apr_file_to_glob(aTHX_ script_err,
-r-pool, APR_PERLIO_HOOK_READ));
+EXTEND(SP, 3);
+PUSH_FILE_GLOB_WRITE(script_in);
+PUSH_FILE_GLOB_READ(script_out);
+PUSH_FILE_GLOB_READ(script_err);
}
}
else {
cvs commit: modperl-2.0/xs/Apache/Filter Apache__Filter.h
dougm 01/12/17 19:56:44
Modified:xs/Apache/Filter Apache__Filter.h
Log:
s/croak/Perl_croak/ so we compile with -DPERL_CORE
Submitted by: stas
Reviewed by: dougm
Revision ChangesPath
1.16 +2 -2 modperl-2.0/xs/Apache/Filter/Apache__Filter.h
Index: Apache__Filter.h
===
RCS file: /home/cvs/modperl-2.0/xs/Apache/Filter/Apache__Filter.h,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- Apache__Filter.h 2001/10/07 19:22:49 1.15
+++ Apache__Filter.h 2001/12/18 03:56:44 1.16
@@ -26,7 +26,7 @@
mpxs_write_loop(modperl_output_filter_write, modperl_filter);
}
else {
-croak(input filters not yet supported);
+Perl_croak(aTHX_ input filters not yet supported);
}
/* XXX: ap_rflush if $| */
@@ -54,7 +54,7 @@
len = modperl_output_filter_read(aTHX_ modperl_filter, buffer, wanted);
}
else {
-croak(input filters not yet supported);
+Perl_croak(aTHX_ input filters not yet supported);
}
return len;
cvs commit: modperl-2.0/xs/Apache/SubProcess Apache__SubProcess.h
stas01/12/17 21:44:16
Modified:xs/Apache/SubProcess Apache__SubProcess.h
Log:
- fix copy-n-paste error, which broke a few sub-tests
Revision ChangesPath
1.8 +1 -1 modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h
Index: Apache__SubProcess.h
===
RCS file: /home/cvs/modperl-2.0/xs/Apache/SubProcess/Apache__SubProcess.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- Apache__SubProcess.h 2001/12/18 04:29:04 1.7
+++ Apache__SubProcess.h 2001/12/18 05:44:16 1.8
@@ -86,7 +86,7 @@
Perl_croak(aTHX_ broken program-out stream);
return APR_EBADF;
}
-SET_TIMEOUT(*script_in);
+SET_TIMEOUT(*script_out);
if (!(*script_err = procnew-err)) {
Perl_croak(aTHX_ broken program-err stream);
cvs commit: modperl-2.0/lib/ModPerl Code.pm
dougm 01/12/17 21:58:54
Modified:lib/ModPerl Code.pm
Log:
generate a modperl_largefiles.h include file with the
$Config{ccflags_uselargefiles} we have ripped out when compiling
modperl.
Revision ChangesPath
1.74 +16 -0 modperl-2.0/lib/ModPerl/Code.pm
Index: Code.pm
===
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/Code.pm,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -r1.73 -r1.74
--- Code.pm 2001/12/05 02:22:24 1.73
+++ Code.pm 2001/12/18 05:58:54 1.74
@@ -466,6 +466,21 @@
();
}
+sub generate_largefiles {
+my($self, $h_fh) = @_;
+
+my $flags = $self-perl_config('ccflags_uselargefiles');
+
+return unless $flags;
+
+for my $flag (split /\s+/, $flags) {
+my($name, $val) = split '=', $flag;
+$val ||= '';
+$name =~ s/^-D//;
+print $h_fh #define $name $val\n;
+}
+}
+
sub ins_underscore {
$_[0] =~ s/([a-z])([A-Z])/$1_$2/g;
}
@@ -526,6 +541,7 @@
generate_flags = {h = 'modperl_flags.h',
c = 'modperl_flags.c'},
generate_trace = {h = 'modperl_trace.h'},
+ generate_largefiles = {h = 'modperl_largefiles.h'},
generate_constants = {h = 'modperl_constants.h',
c = 'modperl_constants.c'},
);
cvs commit: modperl-2.0/t/response/TestAPR perlio.pm
dougm 01/12/17 22:01:43
Modified:t/response/TestAPR perlio.pm
Log:
tell works now; remove todo
Revision ChangesPath
1.4 +1 -1 modperl-2.0/t/response/TestAPR/perlio.pm
Index: perlio.pm
===
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/perlio.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- perlio.pm 2001/12/18 00:43:37 1.3
+++ perlio.pm 2001/12/18 06:01:43 1.4
@@ -23,7 +23,7 @@
return Apache::OK;
}
-plan $r, tests = 9, todo = [5], have_perl 'iolayers';
+plan $r, tests = 9, have_perl 'iolayers';
my $vars = Apache::Test::config()-{vars};
my $dir = catfile $vars-{documentroot}, perlio;
cvs commit: modperl-2.0/t/response/TestAPR perlio.pm
dougm 01/12/17 22:02:29 Modified:t/response/TestAPR perlio.pm Log: tell works now; XXX broken comment Revision ChangesPath 1.5 +1 -1 modperl-2.0/t/response/TestAPR/perlio.pm Index: perlio.pm === RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/perlio.pm,v retrieving revision 1.4 retrieving revision 1.5 diff -u -r1.4 -r1.5 --- perlio.pm 2001/12/18 06:01:43 1.4 +++ perlio.pm 2001/12/18 06:02:29 1.5 @@ -80,7 +80,7 @@ my $pos = 3; seek $fh, $pos, Fcntl::SEEK_SET(); -# XXX: broken + my $got = tell($fh); ok t_cmp($pos, $got,
