Initial commit

1 files changed, 292 insertions, 0 deletions

diff --git a/lib/Apache/Defaults.pm b/lib/Apache/Defaults.pm
new file mode 100644
index 0000000..13c729e
--- /dev/null
+++ b/lib/Apache/Defaults.pm
@@ -0,0 +1,292 @@
+package Apache::Defaults;
+use strict;
+use warnings;
+use File::Spec;
+use IPC::Open3;
+use Shell::GetEnv;
+use DateTime::Format::Strptime;
+use Symbol 'gensym';
+use Carp;
+
+our $VERSION = '0.10';
+
+sub new {
+    my $class = shift;
+    my $self = bless {}, $class;
+    local %_ = @_;
+    my $v;
+    my @servlist;
+    if ($v = delete $_{server}) {
+        if (ref($v) eq 'ARRAY') {
+            @servlist = @$v;
+        } else {
+            @servlist = ( $v );
+        }
+    } else {
+        @servlist = qw(/usr/sbin/httpd /usr/sbin/apache2);
+    }
+    
+    if (my @select = grep { -x $_ } @servlist) {
+        $self->{server} = shift @select;
+    } else {
+        croak "No suitable httpd binary found";
+    }
+
+    if ($v = delete $_{environ}) {
+        $self->{environ} = Shell::GetEnv->new('sh', ". $v", startup => 0)
+                                        ->envs;
+    }
+
+    croak "unrecognized arguments" if keys(%_);
+    return $self;
+}           
+
+sub server { shift->{server} }
+sub environ { shift->{environ} }
+
+sub probe {
+    my ($self, $cb, @opt) = @_;
+
+    open(my $nullout, '>', File::Spec->devnull);
+    open(my $nullin, '<', File::Spec->devnull);
+
+    my $fd = gensym;
+    local %ENV = %{$self->{environ}} if $self->{environ};
+    if (my $pid = open3($nullin, $fd, $nullout, $self->server, @opt)) {
+        while (<$fd>) {
+            chomp;
+            last unless &{$cb}($_);
+        }
+    }
+    close $fd;
+    close $nullin;
+    close $nullout;
+}    
+
+sub dequote {
+    my ($self, $arg) = @_;
+    if ($arg =~ s{^"(.*?)"$}{$1}) {
+        $arg =~ s{\\([\\"])}{$1}g;
+    }
+    return $arg;
+}
+
+sub _get_version_info {
+    my $self = shift;
+    unless ($self->{has_version_info}) {
+        $self->probe(sub {
+            local $_ = shift;
+            if (m{^Server version:\s+(.+?)/(\S+)\s+\((.*?)\)}) {
+                $self->{name} = $1;
+                $self->{version} = $2;
+                $self->{platform} = $3;
+            } elsif (/^Server built:\s+(.+)/) {
+                $self->{built} =
+                    DateTime::Format::Strptime->new(
+                        pattern => '%b %d %Y %H:%M%S',
+                        strict => 1,
+                        locale => 'en_US',
+                        time_zone => 'UTC',
+                        on_error => 'undef'
+                    )->parse_datetime($1);
+                        
+            } elsif (/^Server loaded:\s+(.+)$/) {
+                $self->{loaded_with} = $1;
+            } elsif (/^Compiled using:\s+(.+)$/) {
+                $self->{compiled_with} = $1;
+            } elsif (/^Architecture:\s+(.+)$/) {
+                $self->{architecture} = $1;
+            } elsif (/^Server MPM:\s+(.+)$/) {
+                $self->{MPM} = $1;
+            } elsif (/^\s+threaded:\s+(?<b>yes|no)/) {
+                $self->{MPM_threaded} = $+{b} eq 'yes';
+            } elsif (/^\s+forked:\s+(?<b>yes|no)/) {
+                $self->{MPM_forked} = $+{b} eq 'yes';
+            } elsif (/^\s+-D\s+(?<name>.+?)=(?<val>.+)$/) {
+                $self->{defines}{$+{name}} = $self->dequote($+{val});
+            } elsif (/^\s+-D\s+(?<name>.+?)(?:\s*(?<com>.+))?$/) {
+                $self->{defines}{$+{name}} = 1;
+            }
+            return 1;
+        }, '-V');
+    }
+    $self->{has_version_info} = 1;
+}
+
+my @ATTRIBUTES = qw(name
+                    version
+                    platform
+                    built
+                    loaded_with
+                    compiled_with
+                    architecture
+                    MPM
+                    MPM_threaded
+                    MPM_forked);
+{
+    no strict 'refs';
+    foreach my $attribute (@ATTRIBUTES) {
+        *{ __PACKAGE__ . '::' . $attribute } = sub {
+            my $self = shift;
+            $self->_get_version_info;
+            $self->{$attribute};
+        }
+    }
+}
+
+sub server_root { shift->defines('HTTPD_ROOT') }
+
+sub defines {
+    my $self = shift;
+    $self->_get_version_info;
+    return @{$self->{defines}}{@_};
+}
+
+# List of module sources and corresponding identifiers, obtained from the
+# httpd-2.4.6 source.
+my %modlist = (
+    'event.c' => 'mpm_event_module',
+    'prefork.c' => 'mpm_prefork_module',
+    'worker.c' => 'mpm_worker_module',
+    'mod_access_compat.c' => 'access_compat_module',
+    'mod_actions.c' => 'actions_module',
+    'mod_alias.c' => 'alias_module',
+    'mod_allowmethods.c' => 'allowmethods_module',
+    'mod_asis.c' => 'asis_module',
+    'mod_auth_basic.c' => 'auth_basic_module',
+    'mod_auth_digest.c' => 'auth_digest_module',
+    'mod_auth_form.c' => 'auth_form_module',
+    'mod_authn_anon.c' => 'authn_anon_module',
+    'mod_authn_core.c' => 'authn_core_module',
+    'mod_authn_dbd.c' => 'authn_dbd_module',
+    'mod_authn_dbm.c' => 'authn_dbm_module',
+    'mod_authn_file.c' => 'authn_file_module',
+    'mod_authn_socache.c' => 'authn_socache_module',
+    'mod_authnz_ldap.c' => 'authnz_ldap_module',
+    'mod_authz_core.c' => 'authz_core_module',
+    'mod_authz_dbd.c' => 'authz_dbd_module',
+    'mod_authz_dbm.c' => 'authz_dbm_module',
+    'mod_authz_groupfile.c' => 'authz_groupfile_module',
+    'mod_authz_host.c' => 'authz_host_module',
+    'mod_authz_owner.c' => 'authz_owner_module',
+    'mod_authz_user.c' => 'authz_user_module',
+    'mod_autoindex.c' => 'autoindex_module',
+    'mod_buffer.c' => 'buffer_module',
+    'mod_cache.c' => 'cache_module',
+    'mod_cache_disk.c' => 'cache_disk_module',
+    'mod_cache_socache.c' => 'cache_socache_module',
+    'mod_cern_meta.c' => 'cern_meta_module',
+    'mod_cgi.c' => 'cgi_module',
+    'mod_cgid.c' => 'cgid_module',
+    'mod_charset_lite.c' => 'charset_lite_module',
+    'mod_data.c' => 'data_module',
+    'mod_dav.c' => 'dav_module',
+    'mod_dav_fs.c' => 'dav_fs_module',
+    'mod_dav_lock.c' => 'dav_lock_module',
+    'mod_dbd.c' => 'dbd_module',
+    'mod_deflate.c' => 'deflate_module',
+    'mod_dialup.c' => 'dialup_module',
+    'mod_dir.c' => 'dir_module',
+    'mod_dumpio.c' => 'dumpio_module',
+    'mod_echo.c' => 'echo_module',
+    'mod_env.c' => 'env_module',
+    'mod_example.c' => 'example_module',
+    'mod_expires.c' => 'expires_module',
+    'mod_ext_filter.c' => 'ext_filter_module',
+    'mod_file_cache.c' => 'file_cache_module',
+    'mod_filter.c' => 'filter_module',
+    'mod_headers.c' => 'headers_module',
+    'mod_heartbeat' => 'heartbeat_module',
+    'mod_heartmonitor.c' => 'heartmonitor_module',
+    'mod_ident.c' => 'ident_module',
+    'mod_imagemap.c' => 'imagemap_module',
+    'mod_include.c' => 'include_module',
+    'mod_info.c' => 'info_module',
+    'mod_isapi.c' => 'isapi_module',
+    'mod_lbmethod_bybusyness.c' => 'lbmethod_bybusyness_module',
+    'mod_lbmethod_byrequests.c' => 'lbmethod_byrequests_module',
+    'mod_lbmethod_bytraffic.c' => 'lbmethod_bytraffic_module',
+    'mod_lbmethod_heartbeat.c' => 'lbmethod_heartbeat_module',
+    'util_ldap.c' => 'ldap_module',
+    'mod_log_config.c' => 'log_config_module',
+    'mod_log_debug.c' => 'log_debug_module',
+    'mod_log_forensic.c' => 'log_forensic_module',
+    'mod_logio.c' => 'logio_module',
+    'mod_lua.c' => 'lua_module',
+    'mod_macro.c' => 'macro_module',
+    'mod_mime.c' => 'mime_module',
+    'mod_mime_magic.c' => 'mime_magic_module',
+    'mod_negotiation.c' => 'negotiation_module',
+    'mod_nw_ssl.c' => 'nwssl_module',
+    'mod_privileges.c' => 'privileges_module',