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,
