view release on metacpan or  search on metacpan

lib/Apache/TestConfig.pm  view on Meta::CPAN

            next unless -x $httpd;
            $vars->{httpd} = $httpd;
            last;
        }

        $vars->{httpd} ||= $self->default_httpd;
    }

    if ($vars->{httpd}) {
        my @chunks = splitdir $vars->{httpd};
        #handle both $prefix/bin/httpd and $prefix/Apache.exe
        for (1,2) {
            pop @chunks;
            last unless @chunks;
            $self->{httpd_basedir} = catfile @chunks;
            last if -d "$self->{httpd_basedir}/bin";
        }
    }

    #cleanup httpd droppings
    my $sem = catfile $vars->{t_logs}, 'apache_runtime_status.sem';
    unless (-e $sem) {
        $self->clean_add_file($sem);
    }
}

sub configure_httpd_eapi {
    my $self = shift;
    my $vars = $self->{vars};

    #deal with EAPI_MM_CORE_PATH if defined.
    if (defined($self->{httpd_defines}->{EAPI_MM_CORE_PATH})) {
        my $path = $self->{httpd_defines}->{EAPI_MM_CORE_PATH};

        #ensure the directory exists
        my @chunks = splitdir $path;
        pop @chunks; #the file component of the path
        $path = catdir @chunks;
        unless (file_name_is_absolute $path) {
            $path = catdir $vars->{serverroot}, $path;
        }
        $self->gendir($path);
    }
}

sub configure_proxy {
    my $self = shift;
    my $vars = $self->{vars};

    #if we proxy to ourselves, must bump the maxclients
    if ($vars->{proxy} =~ /^on$/i) {
        unless ($vars->{maxclients_preset}) {
            $vars->{minclients}++;
            $vars->{maxclients}++;
            $vars->{maxspare}++;
            $vars->{startserversthreadedmpm} ++;
            $vars->{minclientsthreadedmpm} += $vars->{threadsperchild};
            $vars->{maxclientsthreadedmpm} += $vars->{threadsperchild};
            $vars->{maxsparethreadedmpm} += $vars->{threadsperchild};
            #In addition allow for some backend processes
            #in keep-alive state. For threaded MPMs we
            #already should be fine.
            $vars->{maxclients} += 3;
        }
        $vars->{proxy} = $self->{vhosts}->{'mod_proxy'}->{hostport};
        return $vars->{proxy};
    }

    return undef;
}

# adds the config to the head of the group instead of the tail
# XXX: would be even better to add to a different sub-group
# (e.g. preamble_first) of only those that want to be first and then,
# make sure that they are dumped to the config file first in the same
# group (e.g. preamble)
sub add_config_first {
    my $self = shift;
    my $where = shift;
    unshift @{ $self->{$where} }, $self->massage_config_args(@_);
}

sub add_config_last {
    my $self = shift;
    my $where = shift;
    push @{ $self->{$where} }, $self->massage_config_args(@_);
}

sub massage_config_args {
    my $self = shift;
    my($directive, $arg, $data) = @_;
    my $args = "";

    if ($data) {
        $args = "<$directive $arg>\n";
        if (ref($data) eq 'HASH') {
            while (my($k,$v) = each %$data) {
                $args .= "    $k $v\n";
            }
        }
        elsif (ref($data) eq 'ARRAY') {
            # balanced (key=>val) list
            my $pairs = @$data / 2;
            for my $i (0..($pairs-1)) {
                $args .= sprintf "    %s %s\n", $data->[$i*2], $data->[$i*2+1];
            }
        }
        else {
            $data=~s/\n(?!\z)/\n    /g;
            $args .= "    $data";
        }
        $args .= "</$directive>\n";
    }
    elsif (ref($directive) eq 'ARRAY') {
        $args = join "\n", @$directive;
    }
    else {
        $args = join " ", grep length($_), $directive,
          (ref($arg) && (ref($arg) eq 'ARRAY') ? "@$arg" : $arg || "");
    }

lib/Apache/TestConfig.pm  view on Meta::CPAN

    # but wasn't included in the system-wide httpd.conf
    $self->find_and_load_module('mod_mime.so');

    unless ($self->{inherit_config}->{TypesConfig}) {
        my $types = catfile $self->{vars}->{t_conf}, 'mime.types';
        unless (-e $types) {
            my $fh = $self->genfile($types);
            print $fh $self->types_config_template;
            close $fh;
        }
        $self->postamble(<<EOI);
<IfModule mod_mime.c>
    TypesConfig "$types"
</IfModule>
EOI
    }
}

# various dup bugs in older perl and perlio in perl < 5.8.4 need a
# workaround to explicitly rewind the dupped DATA fh before using it
my $DATA_pos = tell DATA;
sub httpd_conf_template {
    my($self, $try) = @_;

    my $in = Symbol::gensym();
    if (open $in, $try) {
        return $in;
    }
    else {
        my $dup = Symbol::gensym();
        open $dup, "<&DATA" or die "Can't dup DATA: $!";
        seek $dup, $DATA_pos, 0; # rewind to the beginning
        return $dup; # so we don't close DATA
    }
}

#certain variables may not be available until certain config files
#are generated.  for example, we don't know the ssl port until ssl.conf.in
#is parsed.  ssl port is needed for proxyssl testing

sub check_vars {
    my $self = shift;
    my $vars = $self->{vars};

    unless ($vars->{proxyssl_url}) {
        my $ssl = $self->{vhosts}->{ $vars->{ssl_module_name} };
        if ($ssl) {
            $vars->{proxyssl_url} ||= $ssl->{hostport};
        }

        if ($vars->{proxyssl_url}) {
            unless ($vars->{maxclients_preset}) {
                $vars->{minclients}++;
                $vars->{maxclients}++;
                $vars->{maxspare}++;
                $vars->{startserversthreadedmpm} ++;
                $vars->{minclientsthreadedmpm} += $vars->{threadsperchild};
                $vars->{maxclientsthreadedmpm} += $vars->{threadsperchild};
                $vars->{maxsparethreadedmpm} += $vars->{threadsperchild};
                #In addition allow for some backend processes
                #in keep-alive state. For threaded MPMs we
                #already should be fine.
                $vars->{maxclients} += 3;
            }
        }
    }
}

sub extra_conf_files_needing_update {
    my $self = shift;

    my @need_update = ();
    finddepth(sub {
        return unless /\.in$/;
        (my $generated = $File::Find::name) =~ s/\.in$//;
        push @need_update, $generated
            unless -e $generated && -M $generated < -M $File::Find::name;
    }, $self->{vars}->{t_conf});

    return @need_update;
}

sub generate_extra_conf {
    my $self = shift;

    my(@extra_conf, @conf_in, @conf_files);

    finddepth(sub {
        return unless /\.in$/;
        push @conf_in, catdir $File::Find::dir, $_;
    }, $self->{vars}->{t_conf});

    #make ssl port always be 8530 when available
    for my $file (@conf_in) {
        if (basename($file) =~ /^ssl/) {
            unshift @conf_files, $file;
        }
        else {
            push @conf_files, $file;
        }
    }

    for my $file (@conf_files) {
        (my $generated = $file) =~ s/\.in$//;
        debug "Will 'Include' $generated config file";
        push @extra_conf, $generated;
    }

    # regenerate .conf files
    for my $file (@conf_files) {
        local $Apache::TestConfig::File = $file;

        my $in = Symbol::gensym();
        open($in, $file) or next;

        (my $generated = $file) =~ s/\.in$//;
        my $out = $self->genfile($generated, $file);
        $self->replace_vars($in, $out);

        close $in;
        close $out;