testconfig.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

# Copyright 2001-2005 The Apache Software Foundation or its licensors, as
# applicable.
#
# Licensed 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 Apache::TestConfig;

use strict;
use warnings FATAL => 'all';

use constant WIN32   => $^O eq 'MSWin32';
use constant OSX     => $^O eq 'darwin';
use constant CYGWIN  => $^O eq 'cygwin';
use constant NETWARE => $^O eq 'NetWare';
use constant SOLARIS => $^O eq 'solaris';
use constant WINFU   => WIN32 || CYGWIN || NETWARE;
use constant COLOR   => ($ENV{APACHE_TEST_COLOR} && -t STDOUT) ? 1 : 0;

use constant DEFAULT_PORT => 8529;

use constant IS_MOD_PERL_2       =>
    eval { require mod_perl2 } || 0;

use constant IS_MOD_PERL_2_BUILD => IS_MOD_PERL_2 &&
    require Apache2::Build && Apache2::Build::IS_MOD_PERL_BUILD();

use constant IS_APACHE_TEST_BUILD =>
    grep { -e "$_/lib/Apache/TestConfig.pm" } qw(Apache-Test . ..);

use constant CUSTOM_CONFIG_FILE => 'Apache/TestConfigData.pm';

use lib ();
use File::Copy ();
use File::Find qw(finddepth);
use File::Basename qw(dirname);
use File::Path ();
use File::Spec::Functions qw(catfile abs2rel splitdir canonpath
                             catdir file_name_is_absolute devnull);
use Cwd qw(fastcwd);
use Socket ();
use Symbol ();

use Apache::TestConfigPerl ();
use Apache::TestConfigParse ();
use Apache::TestTrace;
use Apache::TestServer ();
use Apache::TestRun ();

use vars qw(%Usage);

# variables stored in $Apache::TestConfigData::vars
my @data_vars_must = qw(httpd apxs);
my @data_vars_opt  = qw(user group port);
# mapping from $Apache::TestConfigData::vars to $ENV settings
my %vars_to_env = (
    httpd => 'APACHE_TEST_HTTPD',
    apxs  => 'APACHE_TEST_APXS',
    user  => 'APACHE_TEST_USER',
    group => 'APACHE_TEST_GROUP',
    port  => 'APACHE_TEST_PORT',
);

%Usage = (
   top_dir         => 'top-level directory (default is $PWD)',
   t_dir           => 'the t/ test directory (default is $top_dir/t)',
   t_conf          => 'the conf/ test directory (default is $t_dir/conf)',
   t_logs          => 'the logs/ test directory (default is $t_dir/logs)',
   t_conf_file     => 'test httpd.conf file (default is $t_conf/httpd.conf)',
   src_dir         => 'source directory to look for mod_foos.so',
   serverroot      => 'ServerRoot (default is $t_dir)',
   documentroot    => 'DocumentRoot (default is $ServerRoot/htdocs',
   port            => 'Port [port_number|select] (default ' . DEFAULT_PORT . ')',
   servername      => 'ServerName (default is localhost)',
   user            => 'User to run test server as (default is $USER)',
   group           => 'Group to run test server as (default is $GROUP)',
   bindir          => 'Apache bin/ dir (default is apxs -q BINDIR)',
   sbindir         => 'Apache sbin/ dir (default is apxs -q SBINDIR)',
   httpd           => 'server to use for testing (default is $bindir/httpd)',
   target          => 'name of server binary (default is apxs -q TARGET)',
   apxs            => 'location of apxs (default is from Apache2::BuildConfig)',
   startup_timeout => 'seconds to wait for the server to start (default is 60)',
   httpd_conf      => 'inherit config from this file (default is apxs derived)',
   httpd_conf_extra=> 'inherit additional config from this file',
   minclients      => 'minimum number of concurrent clients (default is 1)',
   maxclients      => 'maximum number of concurrent clients (default is minclients+1)',
   perlpod         => 'location of perl pod documents (for testing downloads)',
   proxyssl_url    => 'url for testing ProxyPass / https (default is localhost)',
   sslca           => 'location of SSL CA (default is $t_conf/ssl/ca)',
   sslcaorg        => 'SSL CA organization to use for tests (default is asf)',
   libmodperl      => 'path to mod_perl\'s .so (full or relative to LIBEXECDIR)',
   defines         => 'values to add as -D defines (for example, "VAR1 VAR2")',
   (map { $_ . '_module_name', "$_ module name"} qw(cgi ssl thread access auth php)),
);

my %filepath_conf_opts = map { $_ => 1 }
    qw(top_dir t_dir t_conf t_logs t_conf_file src_dir serverroot
       documentroot bindir sbindir httpd apxs httpd_conf httpd_conf_extra
       perlpod sslca libmodperl);

sub conf_opt_is_a_filepath {
    my $opt = shift;
    $opt && exists $filepath_conf_opts{$opt};
}

sub usage {
    for my $hash (\%Usage) {
        for (sort keys %$hash){
            printf "  -%-18s %s\n", $_, $hash->{$_};
        }
    }
}

sub filter_args {
    my($args, $wanted_args) = @_;
    my(@pass, %keep);

    my @filter = @$args;

    if (ref($filter[0])) {
        push @pass, shift @filter;
    }

    while (@filter) {
        my $key = shift @filter;
        # optinal - or -- prefix
        if (defined $key && $key =~ /^-?-?(.+)/ && exists $wanted_args->{$1}) {
            if (@filter) {
                $keep{$1} = shift @filter;
            }
            else {
                die "key $1 requires a matching value";
            }
        }
        else {
            push @pass, $key;
        }
    }

    return (\@pass, \%keep);
}

my %passenv = map { $_,1 } qw{
    APACHE_TEST_APXS
    APACHE_TEST_HTTPD
    APACHE_TEST_GROUP
    APACHE_TEST_USER
    APACHE_TEST_PORT
};

sub passenv {
    \%passenv;
}

sub passenv_makestr {
    my @vars;

    for (keys %passenv) {
        push @vars, "$_=\$($_)";
    }

    "@vars";
}

sub server { shift->{server} }

sub modperl_build_config {

    my $self = shift;

    my $server = ref $self ? $self->server : new_test_server();

    # we don't want to get mp2 preconfigured data in order to be able
    # to get the interactive tests running.
    return undef if $ENV{APACHE_TEST_INTERACTIVE_CONFIG_TEST};

    # we can't do this if we're using httpd 1.3.X
    # even if mod_perl2 is installed on the box
    # similarly, we shouldn't be loading mp2 if we're not
    # absolutely certain we're in a 2.X environment yet
    # (such as mod_perl's own build or runtime environment)
    if (($server->{rev} && $server->{rev} == 2) ||
        IS_MOD_PERL_2_BUILD || $ENV{MOD_PERL_API_VERSION}) {
        eval {
            require Apache2::Build;
        } or return;
        return Apache2::Build->build_config;
    }

    return;
}

sub new_test_server {
    my($self, $args) = @_;
    Apache::TestServer->new($args || $self)
}

# setup httpd-independent components
# for httpd-specific call $self->httpd_config()
sub new {
    my $class = shift;

    my $args;

    $args = shift if $_[0] and ref $_[0];

    $args = $args ? {%$args} : {@_}; #copy

    #see Apache::TestMM::{filter_args,generate_script}
    #we do this so 'perl Makefile.PL' can be passed options such as apxs
    #without forcing regeneration of configuration and recompilation of c-modules
    #as 't/TEST apxs /path/to/apache/bin/apxs' would do
    while (my($key, $val) = each %Apache::TestConfig::Argv) {
        $args->{$key} = $val;
    }

    my $top_dir = fastcwd;
    $top_dir = pop_dir($top_dir, 't');
    # untaint as we are going to use it a lot later on in -T sensitive
    # operations (.e.g @INC)
    $top_dir = $1 if $top_dir =~ /(.*)/;

    # make sure that t/conf/apache_test_config.pm is found
    # (unfortunately sometimes we get thrown into / by Apache so we
    # can't just rely on $top_dir
    lib->import($top_dir);

    my $thaw = {};
    #thaw current config
    for (qw(conf t/conf)) {
        last if eval {
            require "$_/apache_test_config.pm";
            $thaw = 'apache_test_config'->new;
            delete $thaw->{save};
            #incase class that generated the config was
            #something else, which we can't be sure how to load
            bless $thaw, 'Apache::TestConfig';
        };
    }

    if ($args->{thaw} and ref($thaw) ne 'HASH') {
        #dont generate any new config
        $thaw->{vars}->{$_} = $args->{$_} for keys %$args;
        $thaw->{server} = $thaw->new_test_server;
        $thaw->add_inc;
        return $thaw;
    }

    #regenerating config, so forget old
    if ($args->{save}) {
        for (qw(vhosts inherit_config modules inc cmodules)) {
            delete $thaw->{$_} if exists $thaw->{$_};
        }
    }

    # custom config options from Apache::TestConfigData
    # again, this should force reconfiguration
    custom_config_add_conf_opts($args);

    my $self = bless {
        clean => {},
        vhosts => {},
        inherit_config => {},
        modules => {},
        inc => [],
        %$thaw,
        mpm => "",
        httpd_defines => {},
        vars => $args,
        postamble => [],
        preamble => [],
        postamble_hooks => [],
        preamble_hooks => [],
    }, ref($class) || $class;

    my $vars = $self->{vars}; #things that can be overridden

    for (qw(save verbose)) {
        next unless exists $args->{$_};
        $self->{$_} = delete $args->{$_};
    }

    $vars->{top_dir} ||= $top_dir;

    $self->add_inc;

    #help to find libmodperl.so
    my $src_dir = catfile $vars->{top_dir}, qw(src modules perl);
    $vars->{src_dir}      ||= $src_dir if -d $src_dir;

    $vars->{t_dir}        ||= catfile $vars->{top_dir}, 't';
    $vars->{serverroot}   ||= $vars->{t_dir};
    $vars->{documentroot} ||= catfile $vars->{serverroot}, 'htdocs';
    $vars->{perlpod}      ||= $self->find_in_inc('pods') ||
                              $self->find_in_inc('pod');
    $vars->{perl}         ||= $^X;
    $vars->{t_conf}       ||= catfile $vars->{serverroot}, 'conf';
    $vars->{sslca}        ||= catfile $vars->{t_conf}, 'ssl', 'ca';
    $vars->{sslcaorg}     ||= 'asf';
    $vars->{t_logs}       ||= catfile $vars->{serverroot}, 'logs';
    $vars->{t_conf_file}  ||= catfile $vars->{t_conf},   'httpd.conf';

    if (WINFU) {
        for (keys %$vars) {
            $vars->{$_} =~ s|\\|\/|g if defined $vars->{$_};
        }
    }

    $vars->{scheme}       ||= 'http';
    $vars->{servername}   ||= $self->default_servername;
    $vars->{port}           = $self->select_first_port;
    $vars->{remote_addr}  ||= $self->our_remote_addr;

    $vars->{user}         ||= $self->default_user;
    $vars->{group}        ||= $self->default_group;
    $vars->{serveradmin}  ||= $self->default_serveradmin;

    $vars->{minclients}   ||= 1;
    $vars->{maxclients_preset} = $vars->{maxclients} || 0;
    # if maxclients wasn't explicitly passed try to
    # prevent 'server reached MaxClients setting' errors
    $vars->{maxclients}   ||= $vars->{minclients} + 1;

    # if a preset maxclients valus is smaller than minclients,
    # maxclients overrides minclients
    if ($vars->{maxclients_preset} &&
        $vars->{maxclients_preset} < $vars->{minclients}) {
        $vars->{minclients} = $vars->{maxclients_preset};
    }

    # for threaded mpms MaxClients must be a multiple of
    # ThreadsPerChild (i.e. maxclients % minclients == 0)
    # so unless -maxclients was explicitly specified use a double of
    # minclients
    $vars->{maxclientsthreadedmpm} =
        $vars->{maxclients_preset} || $vars->{minclients} * 2;

    $vars->{proxy}        ||= 'off';
    $vars->{proxyssl_url} ||= '';
    $vars->{defines}      ||= '';

    $self->{hostport} = $self->hostport;
    $self->{server} = $self->new_test_server;

    return $self;

}

# figure out where httpd is and run extra config hooks which require
# knowledge of where httpd is
sub httpd_config {
    my $self = shift;

    $self->configure_apxs;
    $self->configure_httpd;

    my $vars = $self->{vars};
    unless ($vars->{httpd} or $vars->{apxs}) {

        # mod_perl 2.0 build (almost) always knows the right httpd

        # location (and optionally apxs). if we get here we can't
        # continue because the interactive config can't work with
        # mod_perl 2.0 build (by design)
        if (IS_MOD_PERL_2_BUILD){
            my $mp2_build = $self->modperl_build_config();
            # if mod_perl 2 was built against the httpd source it
            # doesn't know where to find apxs/httpd, so in this case
            # fall back to interactive config
            unless ($mp2_build->{MP_APXS}) {
                die "mod_perl 2 was built against Apache sources, we " .
                "don't know where httpd/apxs executables are, therefore " .
                "skipping the test suite execution"
            }

            # not sure what else could go wrong but we can't continue
            die "something is wrong, mod_perl 2.0 build should have " .
                "supplied all the needed information to run the tests. " .
                "Please post lib/Apache/BuildConfig.pm along with the " .
                "bug report";
        }

        if ($ENV{APACHE_TEST_NO_STICKY_PREFERENCES}) {
            error "You specified APACHE_TEST_NO_STICKY_PREFERENCES=1 " .
                "in which case you must explicitly specify -httpd " .
                "and/or -apxs options";
            Apache::TestRun::exit_perl(0);
        }

        $self->clean(1);
        # this method restarts the whole program via exec
        # so it never returns
        $self->custom_config_first_time($self->{vars});
    }
    else {
        debug "Using httpd: $vars->{httpd}";
    }

    # if we have gotten that far we know at least about the location
    # of httpd and or apxs, so let's save it if we haven't saved any
    # custom configs yet
    unless (custom_config_exists()) {
        $self->custom_config_save($self->{vars});
    }

    $self->inherit_config; #see TestConfigParse.pm
    $self->configure_httpd_eapi; #must come after inherit_config

    $self->default_module(cgi    => [qw(mod_cgi mod_cgid)]);
    $self->default_module(thread => [qw(worker threaded)]);
    $self->default_module(ssl    => [qw(mod_ssl)]);
    $self->default_module(access => [qw(mod_access mod_authz_host)]);
    $self->default_module(auth   => [qw(mod_auth mod_auth_basic)]);
    $self->default_module(php    => [qw(sapi_apache2 mod_php4 mod_php5)]);

    $self->{server}->post_config;

    $self;
}

sub default_module {
    my($self, $name, $choices) = @_;

    my $mname = $name . '_module_name';

    unless ($self->{vars}->{$mname}) {
        ($self->{vars}->{$mname}) = grep {
            $self->{modules}->{"$_.c"};
        } @$choices;

        $self->{vars}->{$mname} ||= $choices->[0];
    }

    $self->{vars}->{$name . '_module'} =
      $self->{vars}->{$mname} . '.c'
}

sub configure_apxs {
    my $self = shift;

    $self->{APXS} = $self->default_apxs;

    return unless $self->{APXS};

    $self->{APXS} =~ s{/}{\\}g if WIN32;

    my $vars = $self->{vars};

    $vars->{bindir}   ||= $self->apxs('BINDIR', 1);
    $vars->{sbindir}  ||= $self->apxs('SBINDIR');
    $vars->{target}   ||= $self->apxs('TARGET');
    $vars->{conf_dir} ||= $self->apxs('SYSCONFDIR');

    if ($vars->{conf_dir}) {
        $vars->{httpd_conf} ||= catfile $vars->{conf_dir}, 'httpd.conf';