<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
package Apache2::PerlSections;

use strict;
use warnings FATAL =&gt; 'all';

our $VERSION = '2.00';

use Apache2::CmdParms ();
use Apache2::Directive ();
use APR::Table ();
use Apache2::ServerRec ();
use Apache2::ServerUtil ();
use Apache2::Const -compile =&gt; qw(OK);

use constant SPECIAL_NAME =&gt; 'PerlConfig';
use constant SPECIAL_PACKAGE =&gt; 'Apache2::ReadConfig';

sub new {
    my ($package, @args) = @_;
    return bless { @args }, ref($package) || $package;
}

sub parms      { return shift-&gt;{'parms'} }
sub directives { return shift-&gt;{'directives'} ||= [] }
sub package    { return shift-&gt;{'args'}-&gt;{'package'} }

my @saved;
sub save       { return $Apache2::PerlSections::Save }
sub server     { return $Apache2::PerlSections::Server }
sub saved      { return @saved }

sub handler : method {
    my ($self, $parms, $args) = @_;

    unless (ref $self) {
        $self = $self-&gt;new('parms' =&gt; $parms, 'args' =&gt; $args);
    }

    if ($self-&gt;save) {
        push @saved, $self-&gt;package;
    }

    my $special = $self-&gt;SPECIAL_NAME;

    for my $entry ($self-&gt;symdump()) {
        if ($entry-&gt;[0] !~ /$special/) {
            $self-&gt;dump_any(@$entry);
        }
    }

    {
        no strict 'refs';
        foreach my $package ($self-&gt;package) {
            my @config = map { split /\n/ }
                            grep { defined }
                                (@{"${package}::$special"},
                                 ${"${package}::$special"});
            $self-&gt;dump_special(@config);
        }
    }

    $self-&gt;post_config();

    Apache2::Const::OK;
}

my %directives_seen_hack;

sub symdump {
    my ($self) = @_;

    unless ($self-&gt;{symbols}) {
        no strict;

        $self-&gt;{symbols} = [];

        #XXX: Here would be a good place to warn about NOT using
        #     Apache2::ReadConfig:: directly in &lt;Perl&gt; sections
        foreach my $pack ($self-&gt;package, $self-&gt;SPECIAL_PACKAGE) {
            #XXX: Shamelessly borrowed from Devel::Symdump;
            while (my ($key, $val) = each(%{ *{"$pack\::"} })) {
                #We don't want to pick up stashes...
                next if ($key =~ /::$/);
                local (*ENTRY) = $val;
                if (defined $val &amp;&amp; defined *ENTRY{SCALAR} &amp;&amp; defined $ENTRY) {
                    push @{$self-&gt;{symbols}}, [$key, $ENTRY];
                }
                if (defined $val &amp;&amp; defined *ENTRY{ARRAY}) {
                    unless (exists $directives_seen_hack{"$key$val"}) {
                        $directives_seen_hack{"$key$val"} = 1;
                        push @{$self-&gt;{symbols}}, [$key, \@ENTRY];
                    }
                }
                if (defined $val &amp;&amp; defined *ENTRY{HASH} &amp;&amp; $key !~ /::/) {
                    push @{$self-&gt;{symbols}}, [$key, \%ENTRY];
                }
            }
        }
    }

    return @{$self-&gt;{symbols}};
}

sub dump_special {
    my ($self, @data) = @_;
    $self-&gt;add_config(@data);
}

sub dump_any {
    my ($self, $name, $entry) = @_;
    my $type = ref $entry;

    if ($type eq 'ARRAY') {
        $self-&gt;dump_array($name, $entry);
    }
    elsif ($type eq 'HASH') {
        $self-&gt;dump_hash($name, $entry);
    }
    else {
        $self-&gt;dump_entry($name, $entry);
    }
}

sub dump_hash {
    my ($self, $name, $hash) = @_;

    for my $entry (keys %{ $hash || {} }) {
        my $item = $hash-&gt;{$entry};
        my $type = ref($item);

        if ($type eq 'HASH') {
            $self-&gt;dump_section($name, $entry, $item);
        }
        elsif ($type eq 'ARRAY') {
            for my $e (@$item) {
                $self-&gt;dump_section($name, $entry, $e);
            }
        }
    }
}

sub dump_section {
    my ($self, $name, $loc, $hash) = @_;

    $self-&gt;add_config("&lt;$name $loc&gt;\n");

    for my $entry (keys %{ $hash || {} }) {
        $self-&gt;dump_entry($entry, $hash-&gt;{$entry});
    }

    $self-&gt;add_config("&lt;/$name&gt;\n");
}

sub dump_array {
    my ($self, $name, $entries) = @_;

    for my $entry (@$entries) {
        $self-&gt;dump_entry($name, $entry);
    }
}

sub dump_entry {
    my ($self, $name, $entry) = @_;
    my $type = ref $entry;

    if ($type eq 'SCALAR') {
        $self-&gt;add_config("$name $$entry\n");
    }
    elsif ($type eq 'ARRAY') {
        if (grep {ref} @$entry) {
            $self-&gt;dump_entry($name, $_) for @$entry;
        }
        else {
            $self-&gt;add_config("$name @$entry\n");
        }
    }
    elsif ($type eq 'HASH') {
        $self-&gt;dump_hash($name, $entry);
    }
    elsif ($type) {
        #XXX: Could do $type-&gt;can('httpd_config') here on objects ???
        die "Unknown type '$type' for directive $name";
    }
    elsif (defined $entry) {
        $self-&gt;add_config("$name $entry\n");
    }
}

sub add_config {
    my ($self, @config) = @_;
    foreach my $config (@config) {
        return unless defined $config;
        chomp($config);
        push @{ $self-&gt;directives }, $config;
    }
}

sub post_config {
    my ($self) = @_;
    my $errmsg = $self-&gt;parms-&gt;add_config($self-&gt;directives);
    die $errmsg if $errmsg;
}

sub dump {
    my $class = shift;
    require Apache2::PerlSections::Dump;
    return Apache2::PerlSections::Dump-&gt;dump(@_);
}

sub store {
    my $class = shift;
    require Apache2::PerlSections::Dump;
    return Apache2::PerlSections::Dump-&gt;store(@_);
}

1;
__END__

=head1 NAME

Apache2::PerlSections - write Apache configuration files in Perl





=head1 Synopsis

  &lt;Perl&gt;
  @PerlModule = qw(Mail::Send Devel::Peek);
  
  #run the server as whoever starts it
  $User  = getpwuid(&gt;) || &gt;;
  $Group = getgrgid()) || );
  
  $ServerAdmin = $User;
  
  &lt;/Perl&gt;






=head1 Description

With C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt;...C&lt;E&lt;lt&gt;/PerlE&lt;gt&gt;&gt; sections, it is possible
to configure your server entirely in Perl.

C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; sections can contain I&lt;any&gt; and as much Perl code as
you wish. These sections are compiled into a special package whose
symbol table mod_perl can then walk and grind the names and values of
Perl variables/structures through the Apache core configuration gears.

Block sections such as C&lt;E&lt;lt&gt;LocationE&lt;gt&gt;&gt;..C&lt;E&lt;lt&gt;/LocationE&lt;gt&gt;&gt;
are represented in a C&lt;%Location&gt; hash, e.g.:

  &lt;Perl&gt;
  $Location{"/~dougm/"} = {
    AuthUserFile   =&gt; '/tmp/htpasswd',
    AuthType       =&gt; 'Basic',
    AuthName       =&gt; 'test',
    DirectoryIndex =&gt; [qw(index.html index.htm)],
    Limit          =&gt; {
        "GET POST"    =&gt; {
            require =&gt; 'user dougm',
        }
    },
  };
  &lt;/Perl&gt;

If an Apache directive can take two or three arguments you may push
strings (the lowest number of arguments will be shifted off the
C&lt;@list&gt;) or use an array reference to handle any number greater than
the minimum for that directive:

  push @Redirect, "/foo", "http://www.foo.com/";
  
  push @Redirect, "/imdb", "http://www.imdb.com/";
  
  push @Redirect, [qw(temp "/here" "http://www.there.com")];

Other section counterparts include C&lt;%VirtualHost&gt;, C&lt;%Directory&gt; and
C&lt;%Files&gt;.

To pass all environment variables to the children with a single
configuration directive, rather than listing each one via C&lt;PassEnv&gt;
or C&lt;PerlPassEnv&gt;, a C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; section could read in a file and:

  push @PerlPassEnv, [$key =&gt; $val];

or

  Apache2-&gt;httpd_conf("PerlPassEnv $key $val");

These are somewhat simple examples, but they should give you the basic
idea. You can mix in any Perl code you desire. See I&lt;eg/httpd.conf.pl&gt;
and I&lt;eg/perl_sections.txt&gt; in the mod_perl distribution for more
examples.

Assume that you have a cluster of machines with similar configurations
and only small distinctions between them: ideally you would want to
maintain a single configuration file, but because the configurations
aren't I&lt;exactly&gt; the same (e.g. the C&lt;ServerName&gt; directive) it's not
quite that simple.

C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; sections come to rescue. Now you have a single
configuration file and the full power of Perl to tweak the local
configuration. For example to solve the problem of the C&lt;ServerName&gt;
directive you might have this C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; section:

  &lt;Perl&gt;
  $ServerName = `hostname`;
  &lt;/Perl&gt;

For example if you want to allow personal directories on all machines
except the ones whose names start with I&lt;secure&gt;:

  &lt;Perl&gt;
  $ServerName = `hostname`;
  if ($ServerName !~ /^secure/) {
      $UserDir = "public.html";
  }
  else {
      $UserDir = "DISABLED";
  }
  &lt;/Perl&gt;





=head1 API

C&lt;Apache2::PerlSections&gt; provides the following functions and/or methods:


=head2 C&lt;server&gt;

Get the current server's object for the E&lt;lt&gt;PerlE&lt;gt&gt; section

  &lt;Perl&gt;
    $s = Apache2::PerlSections-&gt;server();
  &lt;/Perl&gt;

=over 4

=item obj: C&lt;Apache2::PerlSections&gt; (class name)

=item ret: C&lt;$s&gt;
( C&lt;L&lt;Apache2::ServerRec object|docs::2.0::api::Apache2::ServerRec&gt;&gt; )

=item since: 2.0.03

=back





=head1 C&lt;@PerlConfig&gt; and C&lt;$PerlConfig&gt;

This array and scalar can be used to introduce literal configuration
into the apache configuration. For example:

  push @PerlConfig, 'Alias /foo /bar';

Or:
  $PerlConfig .= "Alias /foo /bar\n";

See also
C&lt;L&lt;$r-E&lt;gt&gt;add_config|docs::2.0::api::Apache2::RequestUtil/C_add_config_&gt;&gt;





=head1 Configuration Variables

There are a few variables that can be set to change the default
behaviour of C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; sections.





=head2 C&lt;$Apache2::PerlSections::Save&gt;

Each C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; section is evaluated in its unique namespace,
by default residing in a sub-namespace of C&lt;Apache2::ReadConfig::&gt;,
therefore any local variables will end up in that namespace. For
example if a C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; section happened to be in file
F&lt;/tmp/httpd.conf&gt; starting on line 20, the namespace:
C&lt;Apache2::ReadConfig::tmp::httpd_conf::line_20&gt; will be used. Now if
it had:

  &lt;Perl&gt;
    $foo     = 5;
    my $bar  = 6;
    $My::tar = 7;
  &lt;/Perl&gt;

The local global variable C&lt;$foo&gt; becomes
C&lt;$Apache2::ReadConfig::tmp::httpd_conf::line_20::foo&gt;, the other
variable remain where they are.

By default, the namespace in which C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; sections are
evaluated is cleared after each block closes. In our example nuking
C&lt;$Apache2::ReadConfig::tmp::httpd_conf::line_20::foo&gt;, leaving the
rest untouched.

By setting C&lt;$Apache2::PerlSections::Save&gt; to a true value, the content
of those namespaces will be preserved and will be available for
inspection by C&lt;L&lt;Apache2::Status|docs::2.0::api::Apache2::Status&gt;&gt; and
C&lt;L&lt;Apache2::PerlSections-E&lt;gt&gt;dump|/C_Apache2__PerlSections_E_gt_dump_&gt;&gt;
In our example C&lt;$Apache2::ReadConfig::tmp::httpd_conf::line_20::foo&gt;
will still be accessible from other perl code, after the
C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; section was parsed.





=head1 PerlSections Dumping



=head2 C&lt;Apache2::PerlSections-E&lt;gt&gt;dump&gt;

This method will dump out all the configuration variables mod_perl
will be feeding to the apache config gears. The output is suitable to
read back in via C&lt;eval&gt;.

  my $dump = Apache2::PerlSections-&gt;dump;

=over 4

=item ret: C&lt;$dump&gt; ( string / C&lt;undef&gt; )

A string dump of all the Perl code encountered in E&lt;lt&gt;PerlE&lt;gt&gt; blocks,
suitable to be read back via C&lt;eval&gt;

=back

For example:

  &lt;Perl&gt;
  
  $Apache2::PerlSections::Save = 1;
  
  $Listen = 8529;
  
  $Location{"/perl"} = {
     SetHandler =&gt; "perl-script",
     PerlHandler =&gt; "ModPerl::Registry",
     Options =&gt; "ExecCGI",
  };
  
  @DirectoryIndex = qw(index.htm index.html);
  
  $VirtualHost{"www.foo.com"} = {
     DocumentRoot =&gt; "/tmp/docs",
     ErrorLog =&gt; "/dev/null",
     Location =&gt; {
       "/" =&gt; {
         Allowoverride =&gt; 'All',
         Order =&gt; 'deny,allow',
         Deny  =&gt; 'from all',
         Allow =&gt; 'from foo.com',
       },
     },
  };
  &lt;/Perl&gt;
  
  &lt;Perl&gt;
  print Apache2::PerlSections-&gt;dump;
  &lt;/Perl&gt;

This will print something like this:

  $Listen = 8529;
  
  @DirectoryIndex = (
    'index.htm',
    'index.html'
  );
  
  $Location{'/perl'} = (
      PerlHandler =&gt; 'Apache2::Registry',
      SetHandler =&gt; 'perl-script',
      Options =&gt; 'ExecCGI'
  );
  
  $VirtualHost{'www.foo.com'} = (
      Location =&gt; {
        '/' =&gt; {
          Deny =&gt; 'from all',
          Order =&gt; 'deny,allow',
          Allow =&gt; 'from foo.com',
          Allowoverride =&gt; 'All'
        }
      },
      DocumentRoot =&gt; '/tmp/docs',
      ErrorLog =&gt; '/dev/null'
  );
  
  1;
  __END__


It is important to put the call to C&lt;dump&gt; in it's own C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt;
section, otherwise the content of the current C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; section
will not be dumped.





=head2 C&lt;Apache2::PerlSections-E&lt;gt&gt;store&gt;

This method will call the C&lt;dump&gt; method, writing the output
to a file, suitable to be pulled in via C&lt;require&gt; or C&lt;do&gt;.

  Apache2::PerlSections-&gt;store($filename);

=over 4

=item arg1: C&lt;$filename&gt; (string)

The filename to save the dump output to

=item ret: no return value

=back





=head1 Advanced API

mod_perl 2.0 now introduces the same general concept of handlers to
C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; sections.  Apache2::PerlSections simply being the
default handler for them.

To specify a different handler for a given perl section, an extra
handler argument must be given to the section:

  &lt;Perl handler="My::PerlSection::Handler" somearg="test1"&gt;
    $foo = 1;
    $bar = 2;
  &lt;/Perl&gt;

And in My/PerlSection/Handler.pm:

  sub My::Handler::handler : handler {
      my ($self, $parms, $args) = @_;
      #do your thing!
  }

So, when that given C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; block in encountered, the code
within will first be evaluated, then the handler routine will be
invoked with 3 arguments:

=over

=item arg1: C&lt;$self&gt;

self-explanatory

=item arg2: C&lt;$parms&gt;
( C&lt;L&lt;Apache2::CmdParms|docs::2.0::api::Apache2::CmdParms&gt;&gt; )

C&lt;$parms&gt; is specific for the current Container, for example, you
might want to call C&lt;$parms-E&lt;gt&gt;server()&gt; to get the current server.

=item arg3: C&lt;$args&gt;
( C&lt;L&lt;APR::Table object|docs::2.0::api::APR::Table&gt;&gt;)

the table object of the section arguments. The 2 guaranteed ones will
be:

  $args-&gt;{'handler'} = 'My::PerlSection::Handler';
  $args-&gt;{'package'} = 'Apache2::ReadConfig';

Other C&lt;name="value"&gt; pairs given on the C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; line will
also be included.

=back

At this point, it's up to the handler routing to inspect the namespace
of the C&lt;$args&gt;-E&lt;gt&gt;{'package'} and chooses what to do.

The most likely thing to do is to feed configuration data back into
apache. To do that, use Apache2::Server-E&lt;gt&gt;add_config("directive"),
for example:

  $parms-&gt;server-&gt;add_config("Alias /foo /bar");

Would create a new alias. The source code of C&lt;Apache2::PerlSections&gt;
is a good place to look for a practical example.



=head1 Verifying C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; Sections

If the C&lt;E&lt;lt&gt;PerlE&lt;gt&gt;&gt; sections include no code requiring a running
mod_perl, it is possible to check those from the command line. But the
following trick should be used:

  # file: httpd.conf
  &lt;Perl&gt;
  #!perl
  
  # ... code here ...
  
  __END__
  &lt;/Perl&gt;

Now you can run:

  % perl -c httpd.conf





=head1 Bugs




=head2 E&lt;lt&gt;PerlE&lt;gt&gt; directive missing closing 'E&lt;gt&gt;'

httpd-2.0.47 had a bug in the configuration parser which caused the
startup failure with the following error:

  Starting httpd:
  Syntax error on line ... of /etc/httpd/conf/httpd.conf:
  &lt;Perl&gt; directive missing closing '&gt;'     [FAILED]

This has been fixed in httpd-2.0.48. If you can't upgrade to this or a
higher version, please add a space before the closing 'E&lt;gt&gt;' of the
opening tag as a workaround. So if you had:

  &lt;Perl&gt;
  # some code
  &lt;/Perl&gt;

change it to be:

  &lt;Perl &gt;
  # some code
  &lt;/Perl&gt;





=head2 E&lt;lt&gt;PerlE&lt;gt&gt;[...]E&lt;gt&gt; was not closed.

On encountering a one-line E&lt;lt&gt;PerlE&lt;gt&gt; block, 
httpd's configuration parser will cause a startup
failure with an error similar to this one:

  Starting httpd:
  Syntax error on line ... of /etc/httpd/conf/httpd.conf:
  &lt;Perl&gt;use&gt; was not closed.

If you have written a simple one-line E&lt;lt&gt;PerlE&lt;gt&gt;
section like this one :

  &lt;Perl&gt;use Apache::DBI;&lt;/Perl&gt;

change it to be:

   &lt;Perl&gt;
   use Apache::DBI;
   &lt;/Perl&gt;

This is caused by a limitation of httpd's configuration
parser and is not likely to be changed to allow one-line
block like the example above. Use multi-line blocks instead.




=head1 See Also

L&lt;mod_perl 2.0 documentation|docs::2.0::index&gt;.






=head1 Copyright

mod_perl 2.0 and its core modules are copyrighted under
The Apache Software License, Version 2.0.




=head1 Authors

L&lt;The mod_perl development team and numerous
contributors|about::contributors::people&gt;.

=cut

</pre></body></html>