You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@hyperreal.org on 1998/07/30 17:37:32 UTC
cvs commit: modperl/t/net config.pl.dist
dougm 98/07/30 08:37:32
Modified: . Changes MANIFEST Makefile.PL
Apache Apache.pm
Constants Constants.pm
apaci Makefile.tmpl
lib/Apache Opcode.pm Registry.pm RegistryLoader.pm
lib/Apache/Constants Exports.pm
src/modules/ApacheModulePerl ApacheModulePerl.dsp
src/modules/perl Apache.xs Makefile PerlRunXS.xs mod_perl.c
mod_perl.h mod_perl_opmask.c perl_PL.h
perl_config.c perl_util.c
t/conf httpd.conf-dist httpd.conf.pl
t/docs startup.pl
t/net config.pl.dist
Log:
new experimental options PERL_SAFE_STARTUP and PERL_DEFAULT_OPMASK
when httpd is starting, opcodes will be disabled during PerlModule,
PerlRequire and <Perl></Perl>
-PERL_SAFE_STARTUP=1 enables PerlOpmask directive
if PerlOpmask is "default", use mask generated from src/opcodes.txt
else it's a file to create the mask in the format of src/opcodes.txt
if no PerlOpmask, no opcodes are disabled
- 'make update_op_mask OPCODE_FILE=my_opcodes.txt && make'
changes the default opmask generated from OPCODE_FILE
-PERL_DEFAULT_OPMASK=1 disables PerlOpmask directive, forces default
opmask on
Revision Changes Path
1.97 +13 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /export/home/cvs/modperl/Changes,v
retrieving revision 1.96
retrieving revision 1.97
diff -u -r1.96 -r1.97
--- Changes 1998/07/30 01:35:25 1.96
+++ Changes 1998/07/30 15:37:12 1.97
@@ -8,6 +8,19 @@
=item 1.15_01-dev
+new experimental options PERL_SAFE_STARTUP and PERL_DEFAULT_OPMASK
+when httpd is starting, opcodes will be disabled during PerlModule,
+PerlRequire and <Perl></Perl>
+
+ -PERL_SAFE_STARTUP=1 enables PerlOpmask directive
+ if PerlOpmask is "default", use mask generated from src/opcodes.txt
+ else it's a file to create the mask in the format of src/opcodes.txt
+ if no PerlOpmask, no opcodes are disabled
+ - 'make update_op_mask OPCODE_FILE=my_opcodes.txt && make'
+ changes the default opmask generated from OPCODE_FILE
+ -PERL_DEFAULT_OPMASK=1 disables PerlOpmask directive, forces default
+ opmask on
+
Fixed Apache::Util::ht_time test (util.t) so it doesn't fail without
any reason
1.33 +5 -0 modperl/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /export/home/cvs/modperl/MANIFEST,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- MANIFEST 1998/07/28 17:09:06 1.32
+++ MANIFEST 1998/07/30 15:37:12 1.33
@@ -45,6 +45,7 @@
lib/Apache/Debug.pm
lib/Apache/ExtUtils.pm
lib/Apache/FakeRequest.pm
+lib/Apache/Opcode.pm
lib/Apache/Options.pm
lib/Apache/PerlRun.pm
lib/Apache/PerlSections.pm
@@ -78,6 +79,8 @@
src/modules/perl/ldopts
src/modules/perl/mod_perl.c
src/modules/perl/mod_perl.h
+src/modules/perl/op_mask.c
+src/modules/perl/mod_perl_opmask.c
src/modules/perl/mod_perl_xs.h
src/modules/perl/perl_util.c
src/modules/perl/perlio.c
@@ -85,6 +88,7 @@
src/modules/perl/Makefile
src/modules/ApacheModulePerl/ApacheModulePerl.dsp
src/modules/ApacheModulePerl/ApacheModulePerl.mak
+src/opcodes.txt
t/report.PL
t/README
t/TEST
@@ -169,6 +173,7 @@
t/docs/test.html
t/docs/rgy-include.shtml
t/docs/startup.pl
+t/docs/rl.pl
t/docs/stacked.pl
t/docs/LoadClass.pm
t/docs/content.html
1.81 +26 -3 modperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /export/home/cvs/modperl/Makefile.PL,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -r1.80 -r1.81
--- Makefile.PL 1998/07/28 17:09:06 1.80
+++ Makefile.PL 1998/07/30 15:37:12 1.81
@@ -192,6 +192,8 @@
PERL_TIE_SCRIPTNAME
PERL_STASH_POST_DATA
XS_IMPORT
+PERL_SAFE_STARTUP
+PERL_DEFAULT_OPMASK
};
my @mp_args =
@@ -269,6 +271,11 @@
$callback_hooks{$k} = $v if exists $callback_hooks{$k};
}
+if($experimental{PERL_DEFAULT_OPMASK} > 1) {
+ $experimental{PERL_SAFE_STARTUP} = 2;
+ $PERL_EXTRA_CFLAGS .= " -DPERL_SAFE_STARTUP=1";
+}
+
$USE_APACI = 1 if $USE_DSO;
if($USE_APXS) {
@@ -779,7 +786,11 @@
iedit "t/conf/httpd.conf", "s/^(Port) .*/\$1 $PORT/";
iedit "t/net/config.pl", "s/$Port/$PORT/;";
}
-
+ if($experimental{PERL_SAFE_STARTUP} > 1) {
+ if($experimental{PERL_DEFAULT_OPMASK} < 2) {
+ iedit "t/conf/httpd.conf", "s/^#(PerlOpmask)/\$1/";
+ }
+ }
{
my $mmn = magic_number($APACHE_SRC) || 0;
@@ -789,13 +800,16 @@
my $apaci_cfg = APACI->init;
my($k,$v);
+ my(%all) = %callback_hooks;
+ while(($k,$v) = each %experimental) {
+ $all{$k} = ($experimental{$k} > 1) ? 1 : 0;
+ }
print $hf "%callback_hooks = (\n";
- while(($k,$v) = each %callback_hooks) {
+ while(($k,$v) = each %all) {
print $hf " $k => $v,\n";
my $yes_no = $v ? "yes" : "no";
print $apaci_cfg "$k = $yes_no\n" if $apaci_cfg;
}
- print $hf " PERL_RUN_XS => $PERL_RUN_XS,\n";
print $hf " MMN => $mmn,\n";
print $hf ");\n1;\n";
$hf->close;
@@ -1017,6 +1031,7 @@
#CCDLFLAGS => "$Config{ccdlflags} $EXTRA_CFLAGS",
DEFINE => $EXTRA_CFLAGS,
macro => {
+ OPCODE_FILE => "src/opcodes.txt",
APACHE_ROOT => $APACHE_ROOT,
APACHE_SRC => $APACHE_SRC,
ARCHNAME => $Config{archname},
@@ -1105,6 +1120,14 @@
gen_exports:
$(PERL) -MExtUtils::testlib -MApache::Constants::Exports \
-e 'Apache::Constants::Exports->gen_ctags' > Exports.c
+
+gen_op_mask:
+ $(PERL) -MExtUtils::testlib -MApache::Opcode \
+ -e 'Apache::Opcode->gen_op_mask' -- $(OPCODE_FILE) > op_mask.c
+
+update_op_mask: gen_op_mask
+ @$(RM_F) $(APACHE_SRC)/modules/perl/mod_perl_opmask.o
+ $(CP) op_mask.c $(APACHE_SRC)/modules/perl/op_mask.c
apxs_distclean:
(cd ./apaci && $(MAKE) distclean)
1.13 +3 -6 modperl/Apache/Apache.pm
Index: Apache.pm
===================================================================
RCS file: /export/home/cvs/modperl/Apache/Apache.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- Apache.pm 1998/07/28 17:09:11 1.12
+++ Apache.pm 1998/07/30 15:37:14 1.13
@@ -4,8 +4,8 @@
use Apache::Constants qw(OK DECLINED);
use Apache::SIG ();
-@Apache::EXPORT_OK = qw(system exit warn fork forkoption);
-$Apache::VERSION = "1.22";
+@Apache::EXPORT_OK = qw(exit warn fork forkoption);
+$Apache::VERSION = "1.23";
*import = \&Exporter::import;
@@ -161,15 +161,12 @@
my $fmt = shift;
$r->print(sprintf($fmt, @_));
}
+*printf = \&PRINTF;
sub WRITE {
my($r, $buff, $length, $offset) = @_;
my $send = substr($buff, $offset, $length);
$r->print($send);
-}
-
-sub system {
- print `@_`;
}
sub send_cgi_header {
1.9 +1 -0 modperl/Constants/Constants.pm
Index: Constants.pm
===================================================================
RCS file: /export/home/cvs/modperl/Constants/Constants.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- Constants.pm 1998/07/14 14:57:06 1.8
+++ Constants.pm 1998/07/30 15:37:15 1.9
@@ -167,6 +167,7 @@
MODULE_MAGIC_NUMBER
SERVER_VERSION
+ SERVER_BUILT
=back
1.6 +2 -2 modperl/apaci/Makefile.tmpl
Index: Makefile.tmpl
===================================================================
RCS file: /export/home/cvs/modperl/apaci/Makefile.tmpl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- Makefile.tmpl 1998/06/08 01:01:28 1.5
+++ Makefile.tmpl 1998/07/30 15:37:15 1.6
@@ -40,10 +40,10 @@
# the objects to use
MP_OBJS=\
- mod_perl.o perlxsi.o perl_config.o perl_util.o perlio.o \
+ mod_perl.o perlxsi.o perl_config.o perl_util.o perlio.o mod_perl_opmask.o \
$(MP_STATIC_OBJS)
MP_OBJS_PIC=\
- mod_perl.lo perlxsi.lo perl_config.lo perl_util.lo perlio.lo \
+ mod_perl.lo perlxsi.lo perl_config.lo perl_util.lo perlio.lo mod_perl_opmask.lo \
$(MP_STATIC_OBJS_PIC)
all: lib
1.2 +0 -1 modperl/lib/Apache/Opcode.pm
Index: Opcode.pm
===================================================================
RCS file: /export/home/cvs/modperl/lib/Apache/Opcode.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Opcode.pm 1998/07/30 05:07:50 1.1
+++ Opcode.pm 1998/07/30 15:37:16 1.2
@@ -2,7 +2,6 @@
use strict;
use Opcode ();
-use MIME::Base64 ();
my $Mask = read_opmask(\*DATA);
1.15 +3 -9 modperl/lib/Apache/Registry.pm
Index: Registry.pm
===================================================================
RCS file: /export/home/cvs/modperl/lib/Apache/Registry.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- Registry.pm 1998/07/28 17:09:15 1.14
+++ Registry.pm 1998/07/30 15:37:18 1.15
@@ -93,14 +93,8 @@
} else {
$r->log_error("Apache::Registry::handler reading $filename")
if $Debug && $Debug & 4;
- my($sub);
- {
- my $fh = Apache::gensym(__PACKAGE__);
- open $fh, $filename;
- local $/;
- $sub = <$fh>;
- $sub = parse_cmdline($sub);
- }
+ my $sub = $r->slurp_filename;
+ $sub = parse_cmdline($$sub);
# compile this subroutine into the uniq package name
$r->log_error("Apache::Registry::handler eval-ing") if $Debug && $Debug & 4;
@@ -138,7 +132,7 @@
my $cv = \&{"$package\::handler"};
eval { &{$cv}($r, @_) } if $r->seqno;
- chdir $Apache::Server::CWD;
+ $r->chdir_file($Apache::Server::CWD);
$^W = $oldwarn;
my $errsv = "";
1.11 +9 -0 modperl/lib/Apache/RegistryLoader.pm
Index: RegistryLoader.pm
===================================================================
RCS file: /export/home/cvs/modperl/lib/Apache/RegistryLoader.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- RegistryLoader.pm 1998/07/28 17:13:05 1.10
+++ RegistryLoader.pm 1998/07/30 15:37:18 1.11
@@ -36,6 +36,15 @@
#override Apache class methods called by Apache::Registry
#normally only available at request-time via blessed request_rec pointer
+sub slurp_filename {
+ my $r = shift;
+ my $filename = $r->filename;
+ my $fh = Apache::gensym(__PACKAGE__);
+ open $fh, $filename;
+ local $/;
+ my $code = <$fh>;
+ return \$code;
+}
sub get_server_name {}
sub filename { shift->{filename} }
1.2 +1 -1 modperl/lib/Apache/Constants/Exports.pm
Index: Exports.pm
===================================================================
RCS file: /export/home/cvs/modperl/lib/Apache/Constants/Exports.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Exports.pm 1998/07/14 14:57:07 1.1
+++ Exports.pm 1998/07/30 15:37:19 1.2
@@ -10,7 +10,7 @@
OPT_SYM_LINKS OPT_EXECCGI OPT_UNSET OPT_INCNOEXEC
OPT_SYM_OWNER OPT_MULTI OPT_ALL);
my(@server) = qw(MODULE_MAGIC_NUMBER
- SERVER_VERSION SERVER_SUBVERSION SERVER_BUILT);
+ SERVER_VERSION SERVER_BUILT);
my(@response) = qw(DOCUMENT_FOLLOWS MOVED REDIRECT
USE_LOCAL_COPY
BAD_REQUEST
1.3 +5 -0 modperl/src/modules/ApacheModulePerl/ApacheModulePerl.dsp
Index: ApacheModulePerl.dsp
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/ApacheModulePerl/ApacheModulePerl.dsp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- ApacheModulePerl.dsp 1998/07/28 17:09:17 1.2
+++ ApacheModulePerl.dsp 1998/07/30 15:37:20 1.3
@@ -116,6 +116,11 @@
# End Source File
# Begin Source File
+SOURCE=..\perl\mod_perl_opmask.c
+# End Source File
+
+# Begin Source File
+
SOURCE=..\perl\mod_perl.h
# End Source File
# Begin Source File
1.45 +4 -0 modperl/src/modules/perl/Apache.xs
Index: Apache.xs
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/Apache.xs,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- Apache.xs 1998/07/28 17:09:18 1.44
+++ Apache.xs 1998/07/30 15:37:21 1.45
@@ -502,6 +502,10 @@
mod_perl_gensym(pack="Apache::Symbol")
char *pack
+SV *
+mod_perl_slurp_filename(r)
+ Apache r
+
char *
unescape_url(string)
char *string
1.10 +2 -2 modperl/src/modules/perl/Makefile
Index: Makefile
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/Makefile,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- Makefile 1998/07/23 02:59:37 1.9
+++ Makefile 1998/07/30 15:37:21 1.10
@@ -50,7 +50,7 @@
#
# Makefile for the Apache mod_perl library
#
-# $Id: Makefile,v 1.9 1998/07/23 02:59:37 dougm Exp $
+# $Id: Makefile,v 1.10 1998/07/30 15:37:21 dougm Exp $
#
#__ORIGINAL__
@@ -126,7 +126,7 @@
.xs.c:
$(PERL) $(PERL5LIB)/ExtUtils/xsubpp -typemap $(PERL5LIB)/ExtUtils/typemap $*.xs > $@
-PERLSRC=mod_perl.c perlxsi.c perl_config.c perl_util.c perlio.c $(STATIC_SRC)
+PERLSRC=mod_perl_opmask.c mod_perl.c perlxsi.c perl_config.c perl_util.c perlio.c $(STATIC_SRC)
OBJS=$(PERLSRC:.c=.o)
1.4 +1 -17 modperl/src/modules/perl/PerlRunXS.xs
Index: PerlRunXS.xs
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/PerlRunXS.xs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- PerlRunXS.xs 1998/07/28 17:09:18 1.3
+++ PerlRunXS.xs 1998/07/30 15:37:21 1.4
@@ -212,23 +212,7 @@
* }
*/
-SV *ApachePerlRun_readscript(request_rec *r)
-{
- dTHR;
- PerlIO *fp;
- SV *insv;
-
- ENTER;
- save_item(rs);
- sv_setsv(rs, &sv_undef);
-
- fp = PerlIO_open(r->filename, "r");
- insv = newSV(r->finfo.st_size);
- sv_gets(insv, fp, 0); /*slurp*/
- PerlIO_close(fp);
- LEAVE;
- return newRV_noinc(insv);
-}
+#define ApachePerlRun_readscript mod_perl_slurp_filename
SV *ApachePerlRun_parse_cmdline(request_rec *r, SV *code)
{
1.36 +18 -12 modperl/src/modules/perl/mod_perl.c
Index: mod_perl.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.c,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -r1.35 -r1.36
--- mod_perl.c 1998/07/28 17:09:18 1.35
+++ mod_perl.c 1998/07/30 15:37:21 1.36
@@ -96,6 +96,11 @@
{ "PerlTaintCheck", perl_cmd_tainting,
NULL,
RSRC_CONF, FLAG, "Turn on -T switch" },
+#ifdef PERL_SAFE_STARTUP
+ { "PerlOpmask", perl_cmd_opmask,
+ NULL,
+ RSRC_CONF, TAKE1, "Opmask File" },
+#endif
{ "PerlWarn", perl_cmd_warn,
NULL,
RSRC_CONF, FLAG, "Turn on -w switch" },
@@ -516,8 +521,6 @@
mod_perl_tie_scriptname();
MP_TRACE_g(fprintf(stderr, "running perl interpreter..."));
- ENTER;
-
pool_rv = perl_get_sv("Apache::__POOL", TRUE);
sv_setref_pv(pool_rv, Nullch, (void*)p);
server_rv = perl_get_sv("Apache::__SERVER", TRUE);
@@ -568,6 +571,9 @@
GvIMPORTED_CV_on(exitgp);
}
+ ENTER_SAFE(s,p);
+ MP_TRACE_g(mod_perl_dump_opmask());
+
list = (char **)cls->PerlRequire->elts;
for(i = 0; i < cls->PerlRequire->nelts; i++) {
if(perl_load_startup_script(s, p, list[i], TRUE) != OK) {
@@ -577,16 +583,6 @@
}
}
- MP_TRACE_g(fprintf(stderr,
- "mod_perl: %d END blocks encountered during server startup\n",
- endav ? (int)AvFILL(endav)+1 : 0));
-#if MODULE_MAGIC_NUMBER < 19970728
- if(endav)
- MP_TRACE_g(fprintf(stderr, "mod_perl: cannot run END blocks encoutered at server startup without apache_1.3b2+\n"));
-#endif
-
- LEAVE;
-
if (status != OK) {
MP_TRACE_g(fprintf(stderr,"not ok, status=%d\n", status));
perror("run");
@@ -602,6 +598,16 @@
exit(1);
}
}
+
+ LEAVE_SAFE;
+
+ MP_TRACE_g(fprintf(stderr,
+ "mod_perl: %d END blocks encountered during server startup\n",
+ endav ? (int)AvFILL(endav)+1 : 0));
+#if MODULE_MAGIC_NUMBER < 19970728
+ if(endav)
+ MP_TRACE_g(fprintf(stderr, "mod_perl: cannot run END blocks encoutered at server startup without apache_1.3.0+\n"));
+#endif
orig_inc = av_copy_array(GvAV(incgv));
1.39 +29 -0 modperl/src/modules/perl/mod_perl.h
Index: mod_perl.h
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.h,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- mod_perl.h 1998/07/28 17:09:19 1.38
+++ mod_perl.h 1998/07/30 15:37:22 1.39
@@ -376,6 +376,9 @@
/* once 1.3.0 is here, we can toss most of this junk */
#define MMN_130 19980527
+#if MODULE_MAGIC_NUMBER >= MMN_130
+#define HAVE_APACHE_V_130
+#endif
#define APACHE_SSL_12X (defined(APACHE_SSL) && (MODULE_MAGIC_NUMBER < MMN_130))
#if MODULE_MAGIC_NUMBER >= 19980627
@@ -878,6 +881,7 @@
PERL_CMD_TYPE *PerlChildInitHandler;
PERL_CMD_TYPE *PerlChildExitHandler;
PERL_CMD_TYPE *PerlRestartHandler;
+ char *PerlOpmask;
} perl_server_config;
typedef struct {
@@ -982,6 +986,7 @@
table *hvrv2table(SV *rv);
void mod_perl_untaint(SV *sv);
SV *mod_perl_gensym (char *pack);
+SV *mod_perl_slurp_filename(request_rec *r);
SV *mod_perl_tie_table(table *t);
SV *perl_hvrv_magic_obj(SV *rv);
void perl_tie_hash(HV *hv, char *class, SV *sv);
@@ -1045,6 +1050,7 @@
CHAR_P perl_cmd_env (cmd_parms *cmd, perl_dir_config *rec, int arg);
CHAR_P perl_cmd_pass_env (cmd_parms *parms, void *dummy, char *arg);
CHAR_P perl_cmd_sendheader (cmd_parms *cmd, perl_dir_config *rec, int arg);
+CHAR_P perl_cmd_opmask (cmd_parms *parms, void *dummy, char *arg);
CHAR_P perl_cmd_tainting (cmd_parms *parms, void *dummy, int arg);
CHAR_P perl_cmd_warn (cmd_parms *parms, void *dummy, int arg);
CHAR_P perl_cmd_fresh_restart (cmd_parms *parms, void *dummy, int arg);
@@ -1091,3 +1097,26 @@
/* PerlRunXS.xs */
#define ApachePerlRun_name_with_virtualhost() \
perl_get_sv("Apache::Registry::NameWithVirtualHost", FALSE)
+
+void mod_perl_init_opmask(server_rec *s, pool *p);
+void mod_perl_dump_opmask(void);
+#define dOPMask \
+if(!op_mask) Newz(0, op_mask, maxo, char); \
+else Zero(op_mask, maxo, char)
+
+#ifdef PERL_SAFE_STARTUP
+
+#define ENTER_SAFE(s,p) \
+ dOPMask; \
+ ENTER; \
+ SAVEPPTR(op_mask); \
+ mod_perl_init_opmask(s,p)
+
+#define LEAVE_SAFE \
+ Zero(op_mask, maxo, char); \
+ LEAVE
+
+#else
+#define ENTER_SAFE(s,p)
+#define LEAVE_SAFE
+#endif
1.2 +46 -29 modperl/src/modules/perl/mod_perl_opmask.c
Index: mod_perl_opmask.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl_opmask.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- mod_perl_opmask.c 1998/07/30 05:09:13 1.1
+++ mod_perl_opmask.c 1998/07/30 15:37:22 1.2
@@ -10,6 +10,7 @@
#define op_names_init()
#define get_op_bitspec(op,f) Nullsv
#define set_opset_bits(bitmap, bitspec, on, op)
+#define read_opmask(s,p,f) NULL
#else
@@ -57,30 +58,11 @@
croak("mod_perl: invalid bitspec for \"%s\" (type %u)",
opname, (unsigned)SvTYPE(bitspec));
}
-#endif /*PERL_DEFAULT_OPMASK*/
-
-static void opmask_add(char *bitmask)
-{
- int i,j;
- int myopcode = 0;
- if(!opset_len)
- opset_len = (maxo + 7) / 8;
- for (i=0; i < opset_len; i++) {
- U16 bits = bitmask[i];
- if (!bits) {
- myopcode += 8;
- continue;
- }
- for (j=0; j < 8 && myopcode < maxo; )
- op_mask[myopcode++] |= bits & (1 << j++);
- }
-}
-
static char *read_opmask(server_rec *s, pool *p, char *file)
{
#ifdef HAVE_APACHE_V_130
- char line[MAX_STRING_LEN];
+ char opname[MAX_STRING_LEN];
char *mask = (char *)ap_pcalloc(p, maxo);
configfile_t *cfg = ap_pcfg_openfile(p, file);
@@ -91,18 +73,38 @@
}
op_names_init();
- while (!(ap_cfg_getline(line, MAX_STRING_LEN, cfg))) {
+ while (!(ap_cfg_getline(opname, MAX_STRING_LEN, cfg))) {
SV *bitspec;
- if(*line == '#') continue;
- if((bitspec = get_op_bitspec(line, TRUE))
- set_opset_bits(mask, bitspec, TRUE, line);
- /*fprintf(stderr, "Opmask |= `%s'\n", line);*/
+ if(*opname == '#') continue;
+ if((bitspec = get_op_bitspec(opname, TRUE))) {
+ set_opset_bits(mask, bitspec, TRUE, opname);
+ }
}
return mask;
#else
croak("Need Apache 1.3.0+ to use PerlOpmask directive");
-#endif /*MMN_130*/
+#endif /*HAVE_APACHE_V_130*/
+}
+
+#endif /*PERL_DEFAULT_OPMASK*/
+
+static void opmask_add(char *bitmask)
+{
+ int i,j;
+ int myopcode = 0;
+ if(!opset_len)
+ opset_len = (maxo + 7) / 8;
+
+ for (i=0; i < opset_len; i++) {
+ U16 bits = bitmask[i];
+ if (!bits) {
+ myopcode += 8;
+ continue;
+ }
+ for (j=0; j < 8 && myopcode < maxo; )
+ op_mask[myopcode++] |= bits & (1 << j++);
+ }
}
#include "op_mask.c"
@@ -117,6 +119,12 @@
#define MP_DEFAULT_OPMASK !strcasecmp(cls->PerlOpmask, "default")
#endif
+static void reset_default_opmask(void *data)
+{
+ char *mask = (char *)data;
+ mask = NULL;
+}
+
void mod_perl_init_opmask(server_rec *s, pool *p)
{
dPSRV(s);
@@ -126,11 +134,20 @@
return;
if(MP_DEFAULT_OPMASK) {
- if(!default_opmask)
+#if 0
+ if(!default_opmask) {
default_opmask = uudecode(p, MP_op_mask);
- local_opmask = default_opmask;
+ register_cleanup(p, (void*)default_opmask,
+ reset_default_opmask, mod_perl_noop);
+ }
+#endif
+ local_opmask = uudecode(p, MP_op_mask);
+ MP_TRACE_g(fprintf(stderr, "mod_perl: using PerlOpmask %s\n",
+ cls->PerlOpmask ? cls->PerlOpmask : "__DEFAULT__"));
}
else {
+ MP_TRACE_g(fprintf(stderr, "mod_perl: using PerlOpmask %s\n",
+ cls->PerlOpmask));
local_opmask = read_opmask(s, p,
server_root_relative(p, cls->PerlOpmask));
}
@@ -153,7 +170,7 @@
#else
-void mod_perl_init_opmask(pool *p)
+void mod_perl_init_opmask(server_rec *s, pool *p)
{
}
1.4 +12 -0 modperl/src/modules/perl/perl_PL.h
Index: perl_PL.h
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/perl_PL.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- perl_PL.h 1998/07/28 17:09:19 1.3
+++ perl_PL.h 1998/07/30 15:37:22 1.4
@@ -1,3 +1,15 @@
+#ifndef maxo
+#define maxo PL_maxo
+#endif
+#ifndef op_mask
+#define op_mask PL_op_mask
+#endif
+#ifndef op_name
+#define op_name PL_op_name
+#endif
+#ifndef op_desc
+#define op_desc PL_op_desc
+#endif
#ifndef statcache
#define statcache PL_statcache
#endif
1.26 +18 -0 modperl/src/modules/perl/perl_config.c
Index: perl_config.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/perl_config.c,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- perl_config.c 1998/07/22 22:59:34 1.25
+++ perl_config.c 1998/07/30 15:37:23 1.26
@@ -322,6 +322,7 @@
cls->PerlTaintCheck = 0;
cls->PerlWarn = 0;
cls->FreshRestart = 0;
+ cls->PerlOpmask = NULL;
PERL_POST_READ_REQUEST_CREATE(cls);
PERL_TRANS_CREATE(cls);
PERL_CHILD_INIT_CREATE(cls);
@@ -507,6 +508,20 @@
return NULL;
}
+#ifdef PERL_SAFE_STARTUP
+CHAR_P perl_cmd_opmask (cmd_parms *parms, void *dummy, char *arg)
+{
+ dPSRV(parms->server);
+ MP_TRACE_d(fprintf(stderr, "perl_cmd_opmask: %s\n", arg));
+ cls->PerlOpmask = arg;
+#ifdef PERL_DEFAULT_MASK
+ return "Default Opmask is on, cannot re-configure";
+#else
+ return NULL;
+#endif
+}
+#endif
+
CHAR_P perl_cmd_tainting (cmd_parms *parms, void *dummy, int arg)
{
dPSRV(parms->server);
@@ -1333,7 +1348,10 @@
sv_setpv(perl_get_sv("0", TRUE), cmd_filename);
+ ENTER_SAFE(parms->server, parms->pool);
+ MP_TRACE_g(mod_perl_dump_opmask());
perl_eval_sv(code, G_DISCARD);
+ LEAVE_SAFE;
{
dTHR;
1.16 +18 -0 modperl/src/modules/perl/perl_util.c
Index: perl_util.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/perl_util.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- perl_util.c 1998/07/12 19:54:17 1.15
+++ perl_util.c 1998/07/30 15:37:23 1.16
@@ -123,6 +123,24 @@
return rv;
}
+SV *mod_perl_slurp_filename(request_rec *r)
+{
+ dTHR;
+ PerlIO *fp;
+ SV *insv;
+
+ ENTER;
+ save_item(rs);
+ sv_setsv(rs, &sv_undef);
+
+ fp = PerlIO_open(r->filename, "r");
+ insv = newSV(r->finfo.st_size);
+ sv_gets(insv, fp, 0); /*slurp*/
+ PerlIO_close(fp);
+ LEAVE;
+ return newRV_noinc(insv);
+}
+
SV *mod_perl_tie_table(table *t)
{
HV *hv;
1.11 +1 -0 modperl/t/conf/httpd.conf-dist
Index: httpd.conf-dist
===================================================================
RCS file: /export/home/cvs/modperl/t/conf/httpd.conf-dist,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- httpd.conf-dist 1998/07/23 23:06:51 1.10
+++ httpd.conf-dist 1998/07/30 15:37:28 1.11
@@ -1,3 +1,4 @@
+#PerlOpmask default
=pod
1.14 +6 -5 modperl/t/conf/httpd.conf.pl
Index: httpd.conf.pl
===================================================================
RCS file: /export/home/cvs/modperl/t/conf/httpd.conf.pl,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- httpd.conf.pl 1998/07/23 23:06:52 1.13
+++ httpd.conf.pl 1998/07/30 15:37:28 1.14
@@ -1,3 +1,5 @@
+#PerlOpmask default
+
<IfModule mod_dll.c>
LoadModule perl_module modules/ApacheModulePerl.dll
</IfModule>
@@ -27,6 +29,8 @@
<Perl>
#!perl
+use Apache ();
+use Apache::Registry ();
if($ENV{TEST_PERL_DIRECTIVES}) {
#t/TestDirectives/TestDirectives.pm
@@ -67,12 +71,9 @@
$My::config_is_perl = 1;
-#use Apache::Constants qw(MODULE_MAGIC_NUMBER);
-use IO::Handle ();
-use Cwd qw(fastcwd);
-my $dir = join "/", fastcwd, "t";
+my $dir = $Apache::Server::CWD;
+$dir .= "/t" if -d "t";
my $Is_Win32 = ($^O eq "MSWin32");
-#my $mmn = MODULE_MAGIC_NUMBER;
sub prompt ($;$) {
my($mess,$def) = @_;
1.16 +12 -22 modperl/t/docs/startup.pl
Index: startup.pl
===================================================================
RCS file: /export/home/cvs/modperl/t/docs/startup.pl,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- startup.pl 1998/07/28 17:09:22 1.15
+++ startup.pl 1998/07/30 15:37:29 1.16
@@ -7,6 +7,9 @@
$Apache::ServerStarting or warn "Server is not starting !?\n";
}
+use Apache ();
+use Apache::Registry ();
+
#no mod_perl qw(Connection Server);
eval {
@@ -49,30 +52,17 @@
$ENV{KeyForPerlSetEnv} eq "OK" or warn "PerlSetEnv is broken\n";
-#test Apache::RegistryLoader
-{
- use Apache::RegistryLoader ();
- use DirHandle ();
- use strict;
-
- my $rl = Apache::RegistryLoader->new(trans => sub {
- my $uri = shift;
- $Apache::Server::CWD."/t/net${uri}";
- });
-
- my $d = DirHandle->new("t/net/perl");
-
- for my $file ($d->read) {
- next if $file eq "hooks.pl";
- next unless $file =~ /\.pl$/;
- Apache->untaint($file);
- my $status = $rl->handler("/perl/$file");
- unless($status == 200) {
- die "pre-load of `/perl/$file' failed, status=$status\n";
- }
+%net::callback_hooks = ();
+require "./t/net/config.pl";
+if($net::callback_hooks{PERL_SAFE_STARTUP}) {
+ eval "open \$0";
+ unless ($@ =~ /open trapped by operation mask/) {
+ die "opmask not set";
}
}
-
+else {
+ require "./t/docs/rl.pl";
+}
#for testing perl mod_include's
$Access::Cnt = 0;
1.2 +0 -1 modperl/t/net/config.pl.dist
Index: config.pl.dist
===================================================================
RCS file: /export/home/cvs/modperl/t/net/config.pl.dist,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- config.pl.dist 1997/12/06 17:57:30 1.1
+++ config.pl.dist 1998/07/30 15:37:31 1.2
@@ -16,7 +16,6 @@
{
package main;
- require LWP::UserAgent;
# avoid -w warnings
sub dummy_sub {