diff options
Diffstat (limited to 'gmi.pl')
| -rwxr-xr-x | gmi.pl | 99 |
1 files changed, 76 insertions, 23 deletions
@@ -7,7 +7,7 @@ use warnings; use 5.010; #use diagnostics; -our $VERSION = 'v0.17.2'; +our $VERSION = 'v0.18.0'; # Modules use IO::Socket::SSL; # CPAN @@ -65,10 +65,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 redirection redirect/; + unix redirection redirect gone/; const our @VALID_VHOST_SETTINGS => qw/auto_cert assume_index dir_listing root cert key default_mime bind ports - unix redirection redirect cert_req/; + unix redirection redirect cert_req gone/; my ($config, $err) = from_toml(_slurp('./config.toml')); if ($err) { @@ -247,11 +247,20 @@ sub respond_to_client { } } + if (check_for_gone($vhost, $path)) { + goto DOC_GONE; + } + if (not $doc_loc = get_request_in_vhost_root($vhost, $path)) { - goto FAILURE; + goto FAILURE; } ### $doc_loc + # checking if the path already has .gone for 'some reason' + if (substr($doc_loc, -5, 5) eq '.gone') { ## no critic (MagicNumbers) + goto DOC_GONE; + } + # not a directory if (! -d $doc_loc) { goto DOC_ASSIGNED; @@ -291,6 +300,10 @@ sub respond_to_client { speak($cl, 'success', 'text/gemini', $doc_loc, $path); return; + DOC_GONE: + speak($cl, 'gone'); + return; + FAILURE: speak($cl, 'failure'); return; @@ -386,25 +399,7 @@ sub get_request_in_vhost_root { } } ### $r - - if (exists $config->{$vhost}{root}) { - my $p = accurate_path($config->{$vhost}{root}, $working_dir); - if (file_exists_and_readable("$p/$r")) { - return "$p/$r"; - } - } - # try default's root - elsif (exists $config->{default}{root}) { - my $p = accurate_path($config->{default}{root}, $working_dir); - if (file_exists_and_readable("$p/$r")) { - return "$p/$r"; - } - } - else { - serr("default and $vhost have improper root settings."); - return; - } - return; + return path_in_vhost_root_translated($vhost, $r); } sub file_exists_and_readable { @@ -1220,3 +1215,61 @@ sub cert_req { } return; } + +sub check_for_gone { + my ($vhost, $path) = @_; + $path ? ($path = "/$path") : ($path = '/'); + + if (exists $config->{$vhost}{gone}) { + if (exists $config->{$vhost}{gone}{append} and $config->{$vhost}{gone}{append} eq 'true') { + if (path_in_vhost_root_translated($vhost, "$path.gone")) { + return 1; + } + } + } + elsif (exists $config->{default}{gone}) { + if (exists $config->{default}{gone}{append} and $config->{default}{gone}{append} eq 'true') { + if (path_in_vhost_root_translated($vhost, "$path.gone")) { + return 1; + } + } + } + + ### check regex (default shouldn't have path) + if (exists $config->{$vhost}{gone}{path}) { + for my $gone (@{ $config->{$vhost}{gone}{path} }) { + ### $gone + my $gone_regex; + eval { + $gone_regex = qr{$gone}; + } or serr("$vhost: gone ($gone): $EVAL_ERROR") and return 0; + + if ($path =~ m/$gone_regex/) { + return 1; + } + } + } + return; +} + +sub path_in_vhost_root_translated { + my ($vhost, $request) = @_; + + if (exists $config->{$vhost}{root}) { + my $p = accurate_path($config->{$vhost}{root}, $working_dir); + if (file_exists_and_readable("$p/$request")) { + return "$p/$request"; + } + } + # try default's root + elsif (exists $config->{default}{root}) { + my $p = accurate_path($config->{default}{root}, $working_dir); + if (file_exists_and_readable("$p/$request")) { + return "$p/$request"; + } + } + else { + serr("default and $vhost have improper root settings."); + return; + } +} |