diff options
| -rw-r--r-- | TO_FIX.md | 2 | ||||
| -rw-r--r-- | config.toml.sample | 23 | ||||
| -rwxr-xr-x | gmi.pl | 86 |
3 files changed, 103 insertions, 8 deletions
@@ -20,6 +20,4 @@ check if loaded cert/keys are actually valid check values for keys in config file -redirection via config - handle signals like interrupt better diff --git a/config.toml.sample b/config.toml.sample index cdbe8bf..3f22149 100644 --- a/config.toml.sample +++ b/config.toml.sample @@ -51,6 +51,11 @@ assume_index = true dir_listing = false # otherwise the fallback is 'application/octet-stream' (gemini is primary text based so 'octet-stream' probably not wanted) default_mime = 'text/plain' +# redirection allows this program to check for vhost redirect values. +# 'no' meaning, no redirection. +# 'simple', which is simply "if 'x' key exist, return the value for it" +# 'regex' which is a bit more complex and uses Perl's built in regualar expression. See the vhost for an example of one. +redirection = 'simple' ### Not implimented yet # similar to .htaccess, .gmiaccess @@ -75,7 +80,7 @@ assume_index = true # bind can be set to a string or a list or 'no' which will not be accessible via IP address. #bind = ['172.16.0.53', '10.43.14.32'] #ports = [10000,10001,10002] -# example.com can only be accesed through this socket, other vhost +# example.com can only be accesed through this socket, other vhost can use it too. # unix can be set to some path or to 'no' which will not include it in default's unix path if it is set. #unix = '/some/other/path/to/unix.sock' #auto_cert = false @@ -91,3 +96,19 @@ assume_index = true #assume_index = true #dir_listing = true #default_mime = 'text/plain' +# +#redirection = 'regex' +#redirect = { +# # note the beginning '/'. +# # The regex is complied like so: qr{^...$} (^ = beginning of line, $ = end of line) +# # In other words, the entire key value MUST match. +# # this one would be a simple redirection +# '/redirect' = 'gemini://my-other-example.com', +# +# # these are Perl's regular expression. +# '/share/some_(.*)' = "/share/", +# # $1 +# '/blog/2022/dec/(.+)' = '/blog/2022/jul/$1', +# # $1 $2 $3 +# '/blog/(20..)/(.+)/(.+)' = '/newsgroup/$1-$2/$3', +# } @@ -7,7 +7,7 @@ use warnings; use 5.010; #use diagnostics; -our $VERSION = 'v0.15.2'; +our $VERSION = 'v0.16.1'; # Modules use IO::Socket::SSL; # CPAN @@ -27,6 +27,7 @@ use File::Type; use English qw( -no_match_vars ); use Const::Fast; use Carp; +use String::Substitution qw( gsub_modify ); #$IO::Socket::SSL::DEBUG = 15; @@ -63,10 +64,10 @@ const our %GEM_RES_CODES => ( const our @VALID_DEFAULT_SETTINGS => 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 fork timeout - unix/; + unix redirection redirect/; const our @VALID_VHOST_SETTINGS => qw/auto_cert assume_index dir_listing root cert key default_mime bind ports - unix/; + unix redirection redirect/; my ($config, $err) = from_toml(_slurp('./config.toml')); if ($err) { @@ -223,6 +224,15 @@ while (my @ready = $sel->can_read) { sub respond_to_client { my ($cl, $vhost, $doc_loc, $path) = @_; + my $redirection = redirection_parameter($vhost); + if ($redirection) { + my $redirect = check_for_config_redirection($vhost, $path, $redirection); + if ($redirect) { + speak($cl, 'redirect', $redirect); + goto CLOSE; + } + } + if (not $doc_loc = get_request_in_vhost_root($vhost, $path)) { goto FAILURE; } @@ -1003,12 +1013,78 @@ sub select_add_listen { ## no critic (DoubleSigil) if (exists $lsn->{LocalAddr}) { $sell->add(IO::Socket::IP->new(%$lsn)) - or die "$ERRNO"; + or die "$ERRNO ($lsn->{LocalAddr}:$lsn->{LocalPort})"; } elsif (exists $lsn->{Local}) { $sell->add(IO::Socket::UNIX->new(%$lsn)) - or die "$ERRNO"; + or die "$ERRNO ($lsn->{Local})"; } } return; } + +sub check_for_config_redirection { + my ($vhost, $path, $redirection) = @_; + + if (! $path) { + $path = '/'; + } + else { + $path = "/$path"; + } + + + if (exists $config->{$vhost}{redirect}) { + # 'simple' + if ($redirection >= 1 and exists $config->{$vhost}{redirect}{$path}) { + return $config->{$vhost}{redirect}{$path}; + } + + if ($redirection >= 2) { + # regular expression compiling + for my $redirect (keys %{ $config->{$vhost}{redirect} }) { + ### $redirect + my $redirect_replace = $config->{$vhost}{redirect}{$redirect}; + ### $redirect_replace + + my $regex_match; + #my $regex_replace; + eval { + $regex_match = qr/$redirect$/; + } or serr($EVAL_ERROR) and return; + + if ($path =~ m/$regex_match/) { + gsub_modify($path, $regex_match, $redirect_replace); + return $path; + } + } + } + } + return; +} + +sub redirection_parameter { + my ($vhost) = @_; + my $r; + if (exists $config->{$vhost}{redirection}) { + $r = $config->{$vhost}{redirection}; + } + elsif (exists $config->{default}{redirection}) { + $r = $config->{default}{redirection}; + $vhost = 'default'; + } + + if ($r eq 'no') { + return 0; + } + elsif ($r eq 'simple') { + return 1; + } + elsif ($r eq 'regex') { + return 2; + } + else { + serr("'$vhost': Given redirection parameter is invalid: $r"); + } + return; +} |