From 917ba679115b9e3cd7b88f7e5081a1a2503a684e Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 21 Apr 2018 17:55:39 +0200 Subject: [PATCH] abort messages with http error code Fix success code for various exceptions. --- apl.plp | 2 +- chars.plp | 14 +++++++------- common.inc.plp | 14 ++++++++++++++ digits.plp | 2 +- digraphs.plp | 4 ++-- emoji.plp | 2 +- font.plp | 8 ++++---- sample.plp | 2 +- sc.plp | 4 ++-- source.plp | 4 ++-- termcol.plp | 2 +- unicode.plp | 2 +- 12 files changed, 37 insertions(+), 23 deletions(-) diff --git a/apl.plp b/apl.plp index 9ca9970..929c424 100644 --- a/apl.plp +++ b/apl.plp @@ -29,7 +29,7 @@ use Shiar_Sheet::FormatChar; my $glyphs = Shiar_Sheet::FormatChar->new; my @ops = do 'apl.inc.pl'; -@ops > 1 or die "cannot open operator include: $@\n"; +@ops > 1 or Abort("cannot open operator include", 500, $@ // $!); :>

APL Symbols

diff --git a/chars.plp b/chars.plp index 04420cd..6605ec8 100644 --- a/chars.plp +++ b/chars.plp @@ -62,8 +62,7 @@ my $query = eval { say "

$title

"; if (!$query) { - Alert('Unicode group not specified', $@); - exit; + Abort(["Unicode group not found", $@], '404 no matches'); }; for ($parent || 'Unicode range') { @@ -82,15 +81,16 @@ for ($parent || 'Unicode range') { my @chars; for (map { split /[^\d-]/ } $query) { my @range = split /-/, $_, 2; - m/^[0-9]+$/ or die "Invalid code point $_ in query $query\n" for @range; + m/^[0-9]+$/ or Abort("Invalid code point $_ in query $query", 400) + for @range; push @chars, chr $_ for $range[0] .. ($range[1] // $range[0]); } -@chars or die "No match for query $query\n"; +@chars or Abort("No match for query $query", '404 no results'); -@chars <= 1500 or die sprintf( - 'Too many matches (%d) for query %s'."\n", - scalar @chars, $query, +@chars <= 1500 or Abort( + sprintf('Too many matches (%d) for query %s', scalar @chars, $query), + '403 not allowed', ); # output character list diff --git a/common.inc.plp b/common.inc.plp index 9b61d52..7788049 100644 --- a/common.inc.plp +++ b/common.inc.plp @@ -20,6 +20,20 @@ sub Alert { say "
$body
\n"; } +sub Abort { + my ($html, $code, $debug) = @_; + unless ($PLP::sentheaders) { + $header{Status} = $code || 500; + } + elsif ($Dev) { + ref $html eq 'ARRAY' or $html = [$html]; + push @{$html}, "Also failed to set HTTP status $code" + . " after output!"; + } + Alert($html, $debug); + exit; +} + BEGIN { require Time::HiRes; our $Time = [Time::HiRes::gettimeofday()]; diff --git a/digits.plp b/digits.plp index a6a684e..163ee10 100644 --- a/digits.plp +++ b/digits.plp @@ -41,7 +41,7 @@ my $scriptname = do 'writing-script.inc.pl'; $_ = showlink($_, "/latin") for $scriptname->{latn} || (); my $table = do "writing-digits.inc.pl"; -die "Table data not found: $_\n" for $@ || $! || (); +Abort("Table data not found", 501, $_) for $@ || $! || (); sub printtable { say '
', $glyphs->tabletag; diff --git a/digraphs.plp b/digraphs.plp index af71630..7106c7f 100644 --- a/digraphs.plp +++ b/digraphs.plp @@ -39,7 +39,7 @@ say '

Unofficial proposals', <: my $di = do 'data/digraphs.inc.pl' - or die "Error loading digraphs data: ", $@ // $!; + or Abort("Error loading digraphs data", 501, $@ // $!); if (exists $get{v}) { # show characters for inverted mnemonics (vim alternatives) @@ -60,7 +60,7 @@ my @columns = !exists $get{split} ? \@chars2 : if ($mode) { my $xorg = do 'data/digraphs-xorg.inc.pl' - or die "Error loading Xorg data: ", $@ // $!; + or Abort("Error loading Xorg data", 501, $@ // $!); $_ = [ord $_] for values %{$xorg}; $xorg->{$_}->[2] = # class = compatibility $di->{$_} ? $di->{$_}->[0] != $xorg->{$_}->[0] ? 'l1' : # conflict diff --git a/emoji.plp b/emoji.plp index 2a546b4..1f4bf01 100644 --- a/emoji.plp +++ b/emoji.plp @@ -23,7 +23,7 @@ say '

'; for my $system (qw'gmail msn yahoo') { my @info = do "emoji-$system.inc.pl"; my $meta = shift @info or die $@; - ref $meta eq 'HASH' or die "invalid $system definitions"; + ref $meta eq 'HASH' or Abort("Invalid $system definitions", 404); my $title = $meta->{name} // $system; $title = showlink($title, $_) for $meta->{source} || (); diff --git a/font.plp b/font.plp index 3a39c2e..ec61202 100644 --- a/font.plp +++ b/font.plp @@ -15,7 +15,7 @@ Html({ if ($font) { my ($fontmeta, @cover) = do "data/font/$font.inc.pl"; - $fontmeta or die "Unknown font $font\n"; + $fontmeta or Abort("Unknown font $font", '404 font not found'); my $map = eval { $get{map} or return; @@ -39,7 +39,7 @@ if ($font) { } return \@map; }; - die $@ if $@; + Abort($@, '404 invalid query') if $@; require Unicode::UCD; @@ -52,7 +52,7 @@ if ($font) { return $_->[0]->[0] for Unicode::UCD::charblock(ucfirst) || (); # block die "Unknown offset query '$_'\n"; }; - die $@ if $@; + Abort($@, '400 invalid offset') if $@; say "

Font coverage

"; say "

$_

" for EscapeHTML($fontmeta->{name}); @@ -218,7 +218,7 @@ my @rows = ( if (my $group = $get{q}) { my $grouprows = $cover->{$group} - or die "Unknown character category $_\n"; + or Abort("Unknown character category $_", 404); @rows = map { "$group/$_" } sort keys %{$grouprows}; } diff --git a/sample.plp b/sample.plp index 33d06e9..f824e14 100644 --- a/sample.plp +++ b/sample.plp @@ -10,7 +10,7 @@ Html({ }); open my $source, '<', $textinc - or die "Could not open text at $textinc: $!\n"; + or Abort("Could not open text at $textinc", 501, $!); local $/ = "\n\n"; my $top = readline $source; diff --git a/sc.plp b/sc.plp index 3437f8f..a282ef4 100644 --- a/sc.plp +++ b/sc.plp @@ -43,9 +43,9 @@ Html({ say "

$scver{game} units

\n"; my $units = do $datafile; -die "Cannot open unit data: $_\n" for $@ || $! || (); +Abort("Cannot open unit data", 501, $_) for $@ || $! || (); my $patch = shift @{$units} - or die "Cannot open unit data: metadata not found\n"; + or Abort("Cannot open unit data: metadata not found", 501); say "

Unit properties as seen or measured in $scver{name}\n$patch."; say "Also see the $_ table." for join(', ', diff --git a/source.plp b/source.plp index 6d6057c..269e342 100644 --- a/source.plp +++ b/source.plp @@ -58,7 +58,7 @@ else { say "

Source of $href

"; if ($source =~ m{(?:/|^)\.}) { - die "File request not permitted\n"; + Abort("File request not permitted", '403 source not allowed'); } elsif ($source =~ s{::}{/}g or !-e $source) { $source .= '.pm'; @@ -68,7 +68,7 @@ else { last; } } - -r $source or die "Requested file not found\n"; + -r $source or Abort("Requested file not found", '404 source not found'); my $size = (stat $source)->[7]; if (my $hl = eval { diff --git a/termcol.plp b/termcol.plp index c510cd2..281d33c 100644 --- a/termcol.plp +++ b/termcol.plp @@ -45,7 +45,7 @@ use List::Util qw( min max ); use POSIX qw( ceil ); my $palettes = do 'termcol.inc.pl'; -die "Cannot open palette data: $_\n" for $@ || $! || (); +Abort("Cannot open palette data", 501, $_) for $@ || $! || (); sub colcell { my $name = shift // return "\n"; diff --git a/unicode.plp b/unicode.plp index 7949edc..ec10a67 100644 --- a/unicode.plp +++ b/unicode.plp @@ -144,7 +144,7 @@ $glyphs->print(map { $group = $1 if s{^([^/]+)/}{}; my @select = s/=(.*)// ? split(/=/, $1) : (); my $table = $tables->{$group}->{$_} - or die "Unknown table specified: $group/$_"; + or Abort("Unknown table specified: $group/$_", 404); if (@select) { my $rowlen; -- 2.30.0