perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@locus.apache.org
Subject cvs commit: modperl-2.0/src/modules/perl mod_perl.c mod_perl.h modperl_callback.c modperl_config.c modperl_config.h modperl_types.h
Date Tue, 13 Jun 2000 21:05:56 GMT
dougm       00/06/13 14:05:55

  Modified:    lib/ModPerl Code.pm
               pod      modperl_dev.pod
               src/modules/perl mod_perl.c mod_perl.h modperl_callback.c
                        modperl_config.c modperl_config.h modperl_types.h
  Log:
  first cut of PerlOptions directive
  
  Revision  Changes    Path
  1.30      +46 -15    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.29
  retrieving revision 1.30
  diff -u -r1.29 -r1.30
  --- Code.pm	2000/06/12 19:37:25	1.29
  +++ Code.pm	2000/06/13 21:05:35	1.30
  @@ -81,15 +81,17 @@
       $directive_proto{$k}->{ret} = 'const char *';
   }
   
  +#XXX: allow disabling of PerDir hooks on a PerDir basis
  +my @hook_flags = (map { canon_uc($_) } keys %hooks);
   my %flags = (
  -    Srv => [qw(NONE PERL_TAINT_CHECK PERL_WARN FRESH_RESTART
  -               PERL_CLONE PERL_ALLOC PERL_OFF UNSET)],
  -    Dir => [qw(NONE INCPUSH SENDHDR SENTHDR ENV CLEANUP RCLEANUP)],
  +    Srv => [qw(NONE CLONE PARENT ENABLED), @hook_flags, 'UNSET'],
  +    Dir => [qw(NONE SEND_HEADER SETUP_ENV UNSET)],
       Interp => [qw(NONE IN_USE PUTBACK CLONED BASE)],
       Handler => [qw(NONE PARSED METHOD OBJECT ANON)],
   );
   
  -my %flags_lookup = map { $_,1 } qw(Srv);
  +my %flags_lookup = map { $_,1 } qw(Srv Dir);
  +my %flags_options = map { $_,1 } qw(Srv);
   
   sub new {
       my $class = shift;
  @@ -201,10 +203,11 @@
           my $i = 0;
   
           for my $h (@$handlers) {
  +            my $h_name = join $h, qw(Perl Handler);
               my $name = canon_func('cmd', $h, 'handlers');
               my $cmd_name = canon_define('cmd', $h, 'entry');
               my $protostr = canon_proto($prototype, $name);
  -
  +            my $flag = 'MpSrv' . canon_uc($h);
               my $ix = $self->{handler_index}->{$class}->[$i++];
               my $av = "$prototype->{cfg}->{name}->handlers[$ix]";
   
  @@ -215,7 +218,7 @@
               print $h_fh <<EOF;
   
   #define $cmd_name \\
  -{"Perl${h}Handler", $name, NULL, \\
  +{"$h_name", $name, NULL, \\
    $prototype->{scope}, ITERATE, "Subroutine name"}
   
   EOF
  @@ -223,11 +226,16 @@
   $protostr
   {
       $prototype->{cfg}->{get};
  -    if (MpSrvPERL_OFF(scfg)) {
  +    if (!MpSrvENABLED(scfg)) {
           return ap_pstrcat(parms->pool,
                             "Perl is disabled for server ",
                             parms->server->server_hostname, NULL);
       }
  +    if (!$flag(scfg)) {
  +        return ap_pstrcat(parms->pool,
  +                          "$h_name is disabled for server ",
  +                          parms->server->server_hostname, NULL);
  +    }
       MP_TRACE_d(MP_FUNC, "push \@%s, %s\\n", parms->cmd->name, arg);
       return modperl_cmd_push_handlers(&($av), arg, parms->pool);
   }
  @@ -243,24 +251,34 @@
   sub generate_flags {
       my($self, $h_fh, $c_fh) = @_;
   
  +    my $n = 1;
  +
       while (my($class, $opts) = each %{ $self->{flags} }) {
           my $i = 0;
           my @lookup = ();
           my $lookup_proto = "";
  +        my @dumper;
           if ($flags_lookup{$class}) {
               $lookup_proto = join canon_func('flags', 'lookup', $class),
  -              'int ', '(const char *str)';
  +              'U32 ', '(const char *str)';
               push @lookup, "$lookup_proto {";
           }
  +
  +        my $flags = join $class, qw(Mp FLAGS);
   
  -        print $h_fh "\n#define Mp${class}FLAGS(p) p->flags\n";
  +        print $h_fh "\n#define $flags(p) ",
  +          ($flags_options{$class} ? '(p)->flags->opts' : '(p)->flags'), "\n";
  +
           $class = "Mp$class";
  +        print $h_fh "\n#define ${class}Type $n\n";
  +        $n++;
   
           for my $f (@$opts) {
               my $flag = "${class}_f_$f";
               my $cmd  = $class . $f;
  +            my $name = canon_name($f);
  +
               if (@lookup) {
  -                my $name = canon_name($f);
                   push @lookup, qq(   if (strEQ(str, "$name")) return $flag;);
               }
   
  @@ -268,19 +286,32 @@
   
   /* $f */
   #define $flag $i
  -#define $cmd(p)  ((p)->flags & $flag)
  -#define ${cmd}_On(p)  ((p)->flags |= $flag)
  -#define ${cmd}_Off(p) ((p)->flags &= ~$flag)
  +#define $cmd(p)  ($flags(p) & $flag)
  +#define ${cmd}_On(p)  ($flags(p) |= $flag)
  +#define ${cmd}_Off(p) ($flags(p) &= ~$flag)
   
   EOF
  +            push @dumper,
  +              qq{fprintf(stderr, " $name %s\\n", \\
  +                         ($flags(p) & $i) ? "On " : "Off");};
  +
               $i += $i || 1;
           }
           if (@lookup) {
  -            print $c_fh join "\n", @lookup, "   return -1;\n}\n";
  +            print $c_fh join "\n", @lookup, "   return 0;\n}\n";
               print $h_fh "$lookup_proto;\n";
           }
  +
  +        shift @dumper; #NONE
  +        print $h_fh join ' \\'."\n", 
  +          "#define ${class}_dump_flags(p, str)",
  +                     qq{fprintf(stderr, "$class flags dump (%s):\\n", str);},
  +                     @dumper;
       }
   
  +    print $h_fh "\n#define MpSrvHOOKS_ALL_On(p) MpSrvFLAGS(p) |= (",
  +      (join '|', map { 'MpSrv_f_' . $_ } @hook_flags), ")\n";
  +
       ();
   }
   
  @@ -408,7 +439,7 @@
      generate_trace              => {h => 'modperl_trace.h'},
   );
   
  -my @c_src_names = qw(interp tipool log config callback gtop);
  +my @c_src_names = qw(interp tipool log config options callback gtop);
   my @g_c_names = map { "modperl_$_" } qw(hooks directives flags xsinit);
   my @c_names   = ('mod_perl', (map "modperl_$_", @c_src_names));
   sub c_files { [map { "$_.c" } @c_names, @g_c_names] }
  
  
  
  1.3       +58 -0     modperl-2.0/pod/modperl_dev.pod
  
  Index: modperl_dev.pod
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/pod/modperl_dev.pod,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- modperl_dev.pod	2000/06/09 07:58:25	1.2
  +++ modperl_dev.pod	2000/06/13 21:05:36	1.3
  @@ -176,3 +176,61 @@
   Max number of requests per Perl interpreters
   
   =back
  +
  +=head2 PerlOptions Directive
  +
  +Enable/Disable Options.  Options include:
  +
  +=over 4
  +
  +=item Parent
  +
  +Create a new parent Perl interpreter for the given VirtualHost
  +(implies Clone).
  +
  +=item Clone
  +
  +Give the VirtualHost its own interpreter pool.
  +
  +=item Enabled
  +
  +On by default, used to disable mod_perl for a given VirtualHost.
  +
  +=item Perl*Handler
  +
  +Disable Perl*Handlers, all compiled in handlers are enabled by default.
  +
  +=back
  +
  +Examples:
  +
  + #disable mod_perl for this host
  + <VirtualHost ...>
  + PerlOptions -Enable
  + </VirtualHost>
  +
  + #create 2 Parent Perls,
  + #each pointing to a different developer library tree
  + <VirtualHost ...>
  +  ServerName dev1
  +  PerlOptions +Parent
  +  PerlSwitches -Mblib=/home/dev1/lib/perl
  + </VirtualHost>
  +
  + <VirtualHost ...>
  +  ServerName dev2
  +  PerlOptions +Parent
  +  PerlSwitches -Mblib=/home/dev2/lib/perl
  + </VirtualHost>
  +
  + #give VirtualHost its own interpreter pool
  + <VirtualHost ...>
  +  PerlOptions +Clone
  +  PerlInterpStart 2
  +  PerlInterpMax 2
  + </VirtualHost>
  +
  + #disable handlers
  + <VirtualHost ...>
  +  PerlOptions -Authen -Authz -Access
  + </VirtualHost>
  \ No newline at end of file
  
  
  
  1.18      +10 -20    modperl-2.0/src/modules/perl/mod_perl.c
  
  Index: mod_perl.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
  retrieving revision 1.17
  retrieving revision 1.18
  diff -u -r1.17 -r1.18
  --- mod_perl.c	2000/06/12 19:37:26	1.17
  +++ mod_perl.c	2000/06/13 21:05:39	1.18
  @@ -50,7 +50,10 @@
           ap_get_module_config(base_server->module_config, &perl_module);
       PerlInterpreter *base_perl;
   
  -    if (MpSrvPERL_OFF(base_scfg)) {
  +    MP_TRACE_d_do(MpSrv_dump_flags(base_scfg,
  +                                   base_server->server_hostname));
  +
  +    if (!MpSrvENABLED(base_scfg)) {
           /* how silly */
           return;
       }
  @@ -63,30 +66,16 @@
           MP_dSCFG(s);
           PerlInterpreter *perl = base_perl;
   
  -        if (1) {
  -            /* XXX: using getenv() just for testing here */
  -            char *do_alloc = getenv("MP_SRV_ALLOC_TEST");
  -            char *do_clone = getenv("MP_SRV_CLONE_TEST");
  -            char *do_off = getenv("MP_SRV_OFF_TEST");
  -            if (do_alloc && strEQ(do_alloc, s->server_hostname)) {
  -                MpSrvPERL_ALLOC_On(scfg);
  -            }
  -            if (do_clone && strEQ(do_clone, s->server_hostname)) {
  -                MpSrvPERL_CLONE_On(scfg);
  -            }
  -            if (do_off && strEQ(do_off, s->server_hostname)) {
  -                MpSrvPERL_OFF_On(scfg);
  -            }
  -        }
  +        MP_TRACE_d_do(MpSrv_dump_flags(scfg, s->server_hostname));
   
           /* if alloc flags is On, virtual host gets its own parent perl */
  -        if (MpSrvPERL_ALLOC(scfg)) {
  +        if (MpSrvPARENT(scfg)) {
               perl = modperl_startup(s, p);
               MP_TRACE_i(MP_FUNC, "modperl_startup() server=%s\n",
                          s->server_hostname);
           }
   
  -        if (MpSrvPERL_OFF(scfg)) {
  +        if (!MpSrvENABLED(scfg)) {
               scfg->mip = NULL;
               continue;
           }
  @@ -95,14 +84,14 @@
           /* if alloc flags is On or clone flag is On,
            *  virtual host gets its own mip
            */
  -        if (MpSrvPERL_ALLOC(scfg) || MpSrvPERL_CLONE(scfg)) {
  +        if (MpSrvPARENT(scfg) || MpSrvCLONE(scfg)) {
               MP_TRACE_i(MP_FUNC, "modperl_interp_init() server=%s\n",
                          s->server_hostname);
               modperl_interp_init(s, p, perl);
           }
   
           /* if we allocated a parent perl, mark it to be destroyed */
  -        if (MpSrvPERL_ALLOC(scfg)) {
  +        if (MpSrvPARENT(scfg)) {
               MpInterpBASE_On(scfg->mip->parent);
           }
   
  @@ -137,6 +126,7 @@
   
   static command_rec modperl_cmds[] = {  
       MP_SRV_CMD_ITERATE("PerlSwitches", switches, "Perl Switches"),
  +    MP_SRV_CMD_ITERATE("PerlOptions", options, "Perl Options"),
   #ifdef MP_TRACE
       MP_SRV_CMD_TAKE1("PerlTrace", trace, "Trace level"),
   #endif
  
  
  
  1.15      +1 -1      modperl-2.0/src/modules/perl/mod_perl.h
  
  Index: mod_perl.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.h,v
  retrieving revision 1.14
  retrieving revision 1.15
  diff -u -r1.14 -r1.15
  --- mod_perl.h	2000/05/23 20:54:44	1.14
  +++ mod_perl.h	2000/06/13 21:05:39	1.15
  @@ -37,7 +37,7 @@
   #include "modperl_tipool.h"
   #include "modperl_interp.h"
   #include "modperl_log.h"
  -
  +#include "modperl_options.h"
   #include "modperl_directives.h"
   
   void modperl_init(server_rec *s, ap_pool_t *p);
  
  
  
  1.12      +1 -1      modperl-2.0/src/modules/perl/modperl_callback.c
  
  Index: modperl_callback.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
  retrieving revision 1.11
  retrieving revision 1.12
  diff -u -r1.11 -r1.12
  --- modperl_callback.c	2000/06/12 19:37:27	1.11
  +++ modperl_callback.c	2000/06/13 21:05:39	1.12
  @@ -316,7 +316,7 @@
       int i, status = OK;
       const char *desc = NULL;
   
  -    if (MpSrvPERL_OFF(scfg)) {
  +    if (!MpSrvENABLED(scfg)) {
           MP_TRACE_h(MP_FUNC, "PerlOff for server %s\n",
                      s->server_hostname);
           return DECLINED;
  
  
  
  1.12      +24 -0     modperl-2.0/src/modules/perl/modperl_config.c
  
  Index: modperl_config.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
  retrieving revision 1.11
  retrieving revision 1.12
  diff -u -r1.11 -r1.12
  --- modperl_config.c	2000/06/12 03:30:52	1.11
  +++ modperl_config.c	2000/06/13 21:05:39	1.12
  @@ -56,6 +56,10 @@
       modperl_srv_config_t *scfg = (modperl_srv_config_t *)
           ap_pcalloc(p, sizeof(*scfg));
   
  +    scfg->flags = modperl_options_new(p, MpSrvType);
  +    MpSrvENABLED_On(scfg); /* mod_perl enabled by default */
  +    MpSrvHOOKS_ALL_On(scfg); /* all hooks enabled by default */
  +
       scfg->argv = ap_make_array(p, 2, sizeof(char *));
   
       scfg_push_argv((char *)ap_server_argv0);
  @@ -154,17 +158,21 @@
       merge_item(perl);
   #endif
   
  +    merge_item(argv);
       merge_item(files_cfg);
       merge_item(process_cfg);
       merge_item(connection_cfg);
   
       { /* XXX: should do a proper merge of the arrays */
  +      /* XXX: and check if Perl*Handler is disabled */
           int i;
           for (i=0; i<MP_PER_SRV_NUM_HANDLERS; i++) {
               merge_item(handlers[i]);
           }
       }
   
  +    mrg->flags = modperl_options_merge(p, base->flags, add->flags);
  +
       return mrg;
   }
   
  @@ -192,6 +200,22 @@
   {
       MP_dSCFG(parms->server);
       scfg_push_argv(arg);
  +    return NULL;
  +}
  +
  +MP_DECLARE_SRV_CMD(options)
  +{
  +    MP_dSCFG(parms->server);
  +    ap_pool_t *p = parms->pool;
  +    const char *error;
  +
  +    MP_TRACE_d(MP_FUNC, "arg = %s\n", arg);
  +    error = modperl_options_set(p, scfg->flags, arg);
  +
  +    if (error) {
  +        return error;
  +    }
  +
       return NULL;
   }
   
  
  
  
  1.11      +1 -0      modperl-2.0/src/modules/perl/modperl_config.h
  
  Index: modperl_config.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.h,v
  retrieving revision 1.10
  retrieving revision 1.11
  diff -u -r1.10 -r1.11
  --- modperl_config.h	2000/05/23 20:54:44	1.10
  +++ modperl_config.h	2000/06/13 21:05:39	1.11
  @@ -24,6 +24,7 @@
                                  void *dummy, char *arg)
   MP_DECLARE_SRV_CMD(trace);
   MP_DECLARE_SRV_CMD(switches);
  +MP_DECLARE_SRV_CMD(options);
   
   #ifdef USE_ITHREADS
   MP_DECLARE_SRV_CMD(interp_start);
  
  
  
  1.14      +11 -1     modperl-2.0/src/modules/perl/modperl_types.h
  
  Index: modperl_types.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_types.h,v
  retrieving revision 1.13
  retrieving revision 1.14
  diff -u -r1.13 -r1.14
  --- modperl_types.h	2000/05/26 20:34:50	1.13
  +++ modperl_types.h	2000/06/13 21:05:39	1.14
  @@ -102,7 +102,17 @@
       MpAV *handlers[MP_FILES_NUM_HANDLERS];
   } modperl_files_config_t;
   
  +typedef U32 modperl_opts_t;
  +
   typedef struct {
  +    modperl_opts_t opts;
  +    modperl_opts_t opts_add;
  +    modperl_opts_t opts_remove;
  +    modperl_opts_t opts_override;
  +    int unset;
  +} modperl_options_t;
  +
  +typedef struct {
       MpHV *SetVars;
       MpAV *PassEnv;
       MpAV *PerlRequire, *PerlModule;
  @@ -120,7 +130,7 @@
       modperl_gtop_t *gtop;
   #endif
       MpAV *argv;
  -    int flags;
  +    modperl_options_t *flags;
   } modperl_srv_config_t;
   
   typedef struct {
  
  
  

Mime
View raw message