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 21:09:18 UTC
cvs commit: modperl/src/modules/perl Apache.xs mod_perl.h mod_perl_opmask.c
dougm 98/07/30 12:09:17
Modified: . Changes Makefile.PL
lib/Apache Opcode.pm
src/modules/perl Apache.xs mod_perl.h mod_perl_opmask.c
Log:
PERL_ORALL_OPMASK=1 enables $r->set_opmask method for per-directory masks
Revision Changes Path
1.98 +2 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /export/home/cvs/modperl/Changes,v
retrieving revision 1.97
retrieving revision 1.98
diff -u -r1.97 -r1.98
--- Changes 1998/07/30 15:37:12 1.97
+++ Changes 1998/07/30 19:09:13 1.98
@@ -20,6 +20,8 @@
changes the default opmask generated from OPCODE_FILE
-PERL_DEFAULT_OPMASK=1 disables PerlOpmask directive, forces default
opmask on
+ -PERL_ORALL_OPMASK=1 enables $r->set_opmask method for per-directory masks
+ -new module Apache::Opcode for generating op_mask
Fixed Apache::Util::ht_time test (util.t) so it doesn't fail without
any reason
1.82 +1 -0 modperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /export/home/cvs/modperl/Makefile.PL,v
retrieving revision 1.81
retrieving revision 1.82
diff -u -r1.81 -r1.82
--- Makefile.PL 1998/07/30 15:37:12 1.81
+++ Makefile.PL 1998/07/30 19:09:14 1.82
@@ -194,6 +194,7 @@
XS_IMPORT
PERL_SAFE_STARTUP
PERL_DEFAULT_OPMASK
+PERL_ORALL_OPMASK
};
my @mp_args =
1.3 +20 -1 modperl/lib/Apache/Opcode.pm
Index: Opcode.pm
===================================================================
RCS file: /export/home/cvs/modperl/lib/Apache/Opcode.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Opcode.pm 1998/07/30 15:37:16 1.2
+++ Opcode.pm 1998/07/30 19:09:15 1.3
@@ -1,11 +1,30 @@
package Apache::Opcode;
use strict;
-use Opcode ();
my $Mask = read_opmask(\*DATA);
+sub __NOTYET__handler {
+ my $r = shift;
+ my $mask;
+ if(my $opcodes = $r->dir_config("Opcodes")) {
+ my $file = $r->server_root_relative($opcodes);
+ if(-e $file) {
+ $mask = $file;
+ }
+ else {
+ my @opnames = split /\s+/, $opcodes;
+ $mask = \@opnames;
+ }
+ }
+ else {
+ $mask = \$Mask;
+ }
+ return -1; #DECLINED
+}
+
sub read_opmask {
+ require Opcode;
my $fh = shift;
my $mask;
while (<$fh>) {
1.46 +5 -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.45
retrieving revision 1.46
diff -u -r1.45 -r1.46
--- Apache.xs 1998/07/30 15:37:21 1.45
+++ Apache.xs 1998/07/30 19:09:16 1.46
@@ -420,6 +420,11 @@
OUTPUT:
RETVAL
+char *
+mod_perl_set_opmask(r, sv)
+ Apache r
+ SV *sv
+
void
untaint(...)
1.40 +1 -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.39
retrieving revision 1.40
diff -u -r1.39 -r1.40
--- mod_perl.h 1998/07/30 15:37:22 1.39
+++ mod_perl.h 1998/07/30 19:09:16 1.40
@@ -1098,6 +1098,7 @@
#define ApachePerlRun_name_with_virtualhost() \
perl_get_sv("Apache::Registry::NameWithVirtualHost", FALSE)
+char *mod_perl_set_opmask(request_rec *r, SV *sv);
void mod_perl_init_opmask(server_rec *s, pool *p);
void mod_perl_dump_opmask(void);
#define dOPMask \
1.3 +75 -17 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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mod_perl_opmask.c 1998/07/30 15:37:22 1.2
+++ mod_perl_opmask.c 1998/07/30 19:09:16 1.3
@@ -4,6 +4,24 @@
static IV opset_len = 0;
+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++);
+ }
+}
+
#ifdef PERL_DEFAULT_OPMASK
/*PerlOpmask directive is disabled*/
@@ -11,7 +29,10 @@
#define get_op_bitspec(op,f) Nullsv
#define set_opset_bits(bitmap, bitspec, on, op)
#define read_opmask(s,p,f) NULL
-
+char *mod_perl_set_opmask(request_rec *r, SV *sv)
+{
+ croak("Can't override Opmask");
+}
#else
static HV *op_named_bits = Nullhv;
@@ -86,31 +107,60 @@
croak("Need Apache 1.3.0+ to use PerlOpmask directive");
#endif /*HAVE_APACHE_V_130*/
}
-
-#endif /*PERL_DEFAULT_OPMASK*/
-static void opmask_add(char *bitmask)
+static char *av2opmask(pool *p, AV *av)
{
- int i,j;
- int myopcode = 0;
- if(!opset_len)
- opset_len = (maxo + 7) / 8;
+ I32 i;
+ char *mask;
- for (i=0; i < opset_len; i++) {
- U16 bits = bitmask[i];
- if (!bits) {
- myopcode += 8;
- continue;
+ mask = (char *)ap_pcalloc(p, maxo);
+ op_names_init();
+ for(i=0; i<=AvFILL(av); i++) {
+ SV *sv = *av_fetch(av, i, FALSE);
+ char *opname = SvPV(sv,na);
+ SV *bitspec;
+
+ if((bitspec = get_op_bitspec(opname, TRUE))) {
+ set_opset_bits(mask, bitspec, TRUE, opname);
}
- for (j=0; j < 8 && myopcode < maxo; )
- op_mask[myopcode++] |= bits & (1 << j++);
}
+ return mask;
}
-#include "op_mask.c"
+/*
+ * $Mask ||= $r->set_opmask([qw(system backtick)]);
+ * $r->set_opmask(\$Mask) if $Mask;
+ * $r->set_opmask($filename)
+ */
+char *mod_perl_set_opmask(request_rec *r, SV *sv)
+{
+ char *mask;
+#ifndef PERL_ORALL_OPMASK
+ croak("Can't override Opmask");
+#endif
+ dOPMask;
+ SAVEPPTR(op_mask);
-static char *default_opmask = NULL;
+ if(SvROK(sv)) {
+ if(SvTYPE(SvRV(sv)) == SVt_PVAV)
+ mask = av2opmask(r->pool, (AV*)SvRV(sv));
+ else
+ mask = SvPV((SV*)SvRV(sv),na);
+ }
+ else {
+ mask = read_opmask(r->server, r->pool, SvPV(sv,na));
+ }
+
+ opmask_add(mask);
+ MP_TRACE_g(mod_perl_dump_opmask());
+ return mask;
+}
+
+#endif /*PERL_DEFAULT_OPMASK*/
+
+#include "op_mask.c"
+
#ifdef PERL_DEFAULT_OPMASK
#define MP_HAS_OPMASK cls
#define MP_DEFAULT_OPMASK 1
@@ -119,11 +169,15 @@
#define MP_DEFAULT_OPMASK !strcasecmp(cls->PerlOpmask, "default")
#endif
+#if 0
+static char *default_opmask = NULL;
+
static void reset_default_opmask(void *data)
{
char *mask = (char *)data;
mask = NULL;
}
+#endif
void mod_perl_init_opmask(server_rec *s, pool *p)
{
@@ -178,4 +232,8 @@
{
}
+char *mod_perl_set_opmask(request_rec *r, SV *sv)
+{
+ croak("Can't override Opmask");
+}
#endif /*PERL_SAFE_STARTUP*/