summaryrefslogtreecommitdiff
path: root/gmi.pl
diff options
context:
space:
mode:
Diffstat (limited to 'gmi.pl')
-rwxr-xr-xgmi.pl164
1 files changed, 101 insertions, 63 deletions
diff --git a/gmi.pl b/gmi.pl
index f8d97c9..2ccb072 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -7,7 +7,7 @@ use warnings;
use 5.010;
#use diagnostics;
-our $VERSION = 'v0.0.3b';
+our $VERSION = 'v0.0.4';
# Modules
use IO::Socket::SSL; # CPAN
@@ -49,10 +49,10 @@ our %GEM_RES_CODES = (
);
our @VALID_DEFAULT_SETTINGS =
- qw/bind ports tls assume_index dir_listing root root_relative working_dir cert_key_dir
- log_file log_to_stdout default_mime/;
+ qw/bind ports tls assume_index dir_listing root working_dir cert_key_dir
+ log_file log_to_stdout default_mime cert_key_dir_write_warning/;
our @VALID_VHOST_SETTINGS =
- qw/auto_cert assume_index dir_listing root root_relative cert key default_mime/;
+ qw/auto_cert assume_index dir_listing root cert key default_mime/;
my $ft = File::Type->new();
@@ -139,26 +139,38 @@ else {
my $cert_key_dir;
if (exists $config->{default}{cert_key_dir}) {
+ my $p = abs_or_rel($config->{default}{cert_key_dir});
# Absolute
- if (substr($config->{default}{cert_key_dir},0,1) eq '/') {
+ if ($p eq 'abs') {
$cert_key_dir = $config->{default}{cert_key_dir};
}
# Relative
- else {
+ elsif ($p eq 'rel') {
$cert_key_dir = "$working_dir/$config->{default}{cert_key_dir}";
}
+ else {
+ die "cert_key_dir: neither absolute or relative.";
+ }
}
else {
$cert_key_dir = "$working_dir/certs";
}
# Create $cert_key_dir if needed
-if (-d $cert_key_dir and -r $cert_key_dir and -w $cert_key_dir and -x $cert_key_dir) {
- ;
+if (-d $cert_key_dir and -r $cert_key_dir and -x $cert_key_dir) {
+ if (! -w $cert_key_dir) {
+ if (! (exists $config->{default}{cert_key_dir_write_warning}
+ and $config->{default}{cert_key_dir_write_warning} eq 'false'))
+ {
+ say STDERR "cert_key_dir ($cert_key_dir) not writable, generating cert/key pair will cause crash.\n".
+ "(cert_key_dir_write_warning = 'false' to hide this warning.)";
+ }
+ }
} elsif (! -e $cert_key_dir) {
- mkdir $cert_key_dir;
+ mkdir $cert_key_dir
+ or die "Could not create cert_key_dir ($cert_key_dir) - $!";
} else {
- die "cert_key_dir option ($cert_key_dir) is not all of these: ".
- "directory, readable, writable or executeable.";
+ die "cert_key_dir ($cert_key_dir) is not all of these: ".
+ "directory, readable, or executeable.";
}
# Logging
@@ -177,80 +189,89 @@ $| = 1; # Making the *current* Filehandle 'hot' so Perl flushes the buffer immed
my $log;
# VirtualHosts
-for my $item (keys %{ $config }) {
- next if ($item eq 'default');
+for my $vhost (keys %{ $config }) {
+ next if ($vhost eq 'default');
my $error_free = 1;
my $cert_loc;
my $key_loc;
- if (exists $config->{$item}{cert} and exists $config->{$item}{key}) {
+ if (exists $config->{$vhost}{cert} and exists $config->{$vhost}{key}) {
- # checking if absolute location
- if (substr($config->{$item}{cert},0,1) eq '/') {
- if (-e $config->{$item}{cert}) {
- $cert_loc = $config->{$item}{cert};
+ my $p_c = abs_or_rel($config->{$vhost}{cert});
+ if ($p_c eq 'abs') {
+ if (-e $config->{$vhost}{cert}) {
+ $cert_loc = $config->{$vhost}{cert};
}
else {
- say "'$config->{$item}{cert}' does not exist.";
+ say STDERR "'$config->{$vhost}{cert}' for '$vhost' does not exist.";
$error_free = 0;
}
}
- if (substr($config->{$item}{key},0,1) eq '/') {
- if (-e $config->{$item}{key}) {
- $key_loc = $config->{$item}{key};
- }
+ elsif ($p_c eq 'rel') {
+ if (-e "$cert_key_dir/$config->{$vhost}{cert}") {
+ $cert_loc = "$cert_key_dir/$config->{$vhost}{cert}";
+ }
else {
- say "'$config->{$item}{key}' does not exist.";
+ say STDERR "'$cert_key_dir/$config->{$vhost}{cert}' does not exist.";
$error_free = 0;
}
}
+ else {
+ warn "'$config->{$vhost}{cert}' for '$vhost' cert option is neither absolute or relative.";
+ $error_free = 0;
+ }
- # Is it relative?
- if (! $cert_loc or ! $key_loc) {
- if (-e "$cert_key_dir/$config->{$item}{cert}") {
- $cert_loc = "$cert_key_dir/$config->{$item}{cert}";
- }
+ my $p_k = abs_or_rel($config->{$vhost}{key});
+ if ($p_k eq 'abs') {
+ if (-e $config->{$vhost}{key}) {
+ $key_loc = $config->{$vhost}{key};
+ }
else {
- say STDERR "'$cert_key_dir/$config->{$item}{cert}' does not exist.";
+ say STDERR "'$config->{$vhost}{key}' does not exist.";
$error_free = 0;
}
-
- if (-e "$cert_key_dir/$config->{$item}{key}") {
- $key_loc = "$cert_key_dir/$config->{$item}{key}";
+ }
+ elsif ($p_k eq 'rel') {
+ if (-e "$cert_key_dir/$config->{$vhost}{key}") {
+ $key_loc = "$cert_key_dir/$config->{$vhost}{key}";
}
else {
- say STDERR "'$cert_key_dir/$config->{$item}{key}' does not exist.";
+ say STDERR "'$cert_key_dir/$config->{$vhost}{key}' does not exist.";
$error_free = 0;
}
}
+ else {
+ warn "'$config->{$vhost}{key}' for '$vhost' key option is neither absolute or relative.";
+ $error_free = 0;
+ }
}
else {
- if (exists $config->{$item}{auto_cert} and $config->{$item}{auto_cert} ne 'false') {
+ if (exists $config->{$vhost}{auto_cert} and $config->{$vhost}{auto_cert} eq 'true') {
# manage cert for user
- $cert_loc = "$cert_key_dir/$item". '_cert.pem';
- $key_loc = "$cert_key_dir/$item". '_key.pem';
+ $cert_loc = "$cert_key_dir/$vhost". '_cert.pem';
+ $key_loc = "$cert_key_dir/$vhost". '_key.pem';
if (! -e $cert_loc or ! -e $key_loc) {
- say $out "$item cert/key pair generated in '$cert_key_dir'.";
- gen_cert($item, $cert_key_dir)
+ gen_cert($vhost, $cert_key_dir);
+ say $out "$vhost cert/key pair generated in '$cert_key_dir'.";
}
else {
# TODO: make sure cert is valid, otherwise re-generate them
}
}
else {
- say STDERR "$item only has one part of a cert/key pair and/or auto_cert is not enabled.";
+ say STDERR "$vhost only has one part of a cert/key pair and/or auto_cert is not true.";
$error_free = 0;
}
}
if ($error_free) {
- $ssl_config{SSL_cert_file}{$item} = $cert_loc;
- $ssl_config{SSL_key_file}{$item} = $key_loc;
+ $ssl_config{SSL_cert_file}{$vhost} = $cert_loc;
+ $ssl_config{SSL_key_file}{$vhost} = $key_loc;
}
else {
- say STDERR "Will not use cert/key for $item";
+ say STDERR "$vhost: Will will not be listening for incoming requests.";
}
}
@@ -532,30 +553,40 @@ sub get_request_in_vhost_root {
}
### $r
- # relative to working_dir
- if (exists $config->{$vhost}{root} and exists $config->{$vhost}{root_relative} and
- $config->{$vhost}{root_relative} eq 'true')
- {
- my $work_loc = "$working_dir/$config->{$vhost}{root}";
- is_exists_and_readable("$work_loc/$r") ? return "$work_loc/$r" : return undef;
- }
-
- # not relative to working_dir
- elsif (exists $config->{$vhost}{root} and (not exists $config->{$vhost}{root_relative} or
- $config->{$vhost}{root_relative} eq 'false'))
- {
- my $work_loc = "$config->{$vhost}{root}";
- is_exists_and_readable("$work_loc/$r") ? return "$work_loc/$r" : return undef;
+ if (exists $config->{$vhost}{root}) {
+ my $p = abs_or_rel($config->{$vhost}{root});
+ if ($p eq 'abs') {
+ is_exists_and_readable("$config->{$vhost}{root}/$r")
+ ? return "$config->{$vhost}{root}/$r" : return undef;
+ }
+ elsif ($p eq 'rel') {
+ is_exists_and_readable("$working_dir/$config->{$vhost}{root}/$r")
+ ? return "$working_dir/$config->{$vhost}{root}/$r" : return undef;
+ }
+ else {
+ return undef;
+ }
}
-
- # use default's root
- elsif (not exists $config->{$vhost}{root}) {
- my $work_loc = "$working_dir/$config->{default}{root}";
- is_exists_and_readable("$work_loc/$r") ? return "$work_loc/$r" : return undef;
+
+ # try default's root
+ elsif (not exists $config->{$vhost}{root} and exists $config->{default}{root}) {
+ my $p = abs_or_rel($config->{default}{root});
+ if ($p eq 'abs') {
+ is_exists_and_readable("$config->{default}{root}/$r")
+ ? return "$config->{default}{root}/$r" : return undef;
+ }
+ elsif ($p eq 'rel') {
+ is_exists_and_readable("$working_dir/$config->{default}{root}/$r")
+ ? return "$working_dir/$config->{default}{root}/$r" : return undef;
+ }
+ else {
+ say $out "$vhost does not have a valid root and neither does default.";
+ return undef;
+ }
}
else {
- warn "$vhost has improper root/root_relative settings.";
+ say STDERR "default has improper root settings.";
return 0;
}
}
@@ -675,3 +706,10 @@ sub check_vhost_settings {
}
}
+
+sub abs_or_rel {
+ my ($p) = @_;
+ return undef unless (defined $p);
+
+ substr($p,0,1) eq '/' ? return 'abs' : return 'rel';
+}