summaryrefslogtreecommitdiff
path: root/lib/VNWeb/Validation.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/VNWeb/Validation.pm')
-rw-r--r--lib/VNWeb/Validation.pm232
1 files changed, 210 insertions, 22 deletions
diff --git a/lib/VNWeb/Validation.pm b/lib/VNWeb/Validation.pm
index 4d398aac..a79a0441 100644
--- a/lib/VNWeb/Validation.pm
+++ b/lib/VNWeb/Validation.pm
@@ -2,7 +2,6 @@ package VNWeb::Validation;
use v5.26;
use TUWF 'uri_escape';
-use PWLookup;
use VNDB::Types;
use VNDB::Config;
use VNWeb::Auth;
@@ -13,7 +12,11 @@ use Carp 'croak';
use Exporter 'import';
our @EXPORT = qw/
- is_insecurepass
+ %RE
+ samesite
+ is_api
+ is_unique_username
+ ipinfo
form_compile
form_changed
validate_dbid
@@ -22,27 +25,63 @@ our @EXPORT = qw/
/;
+# Regular expressions for use in path registration
+my $num = qr{[1-9][0-9]{0,6}}; # Allow up to 10 mil, SQL vndbid type can't handle more than 2^26-1 (~ 67 mil).
+my $rev = qr{(?:\.(?<rev>$num))};
+our %RE = (
+ num => qr{(?<num>$num)},
+ uid => qr{(?<id>u$num)},
+ vid => qr{(?<id>v$num)},
+ rid => qr{(?<id>r$num)},
+ sid => qr{(?<id>s$num)},
+ cid => qr{(?<id>c$num)},
+ pid => qr{(?<id>p$num)},
+ iid => qr{(?<id>i$num)},
+ did => qr{(?<id>d$num)},
+ tid => qr{(?<id>t$num)},
+ gid => qr{(?<id>g$num)},
+ wid => qr{(?<id>w$num)},
+ imgid=> qr{(?<id>(?:ch|cv|sf)$num)},
+ vrev => qr{(?<id>v$num)$rev?},
+ rrev => qr{(?<id>r$num)$rev?},
+ prev => qr{(?<id>p$num)$rev?},
+ srev => qr{(?<id>s$num)$rev?},
+ crev => qr{(?<id>c$num)$rev?},
+ drev => qr{(?<id>d$num)$rev?},
+ grev => qr{(?<id>g$num)$rev?},
+ irev => qr{(?<id>i$num)$rev?},
+ postid => qr{(?<id>t$num)\.(?<num>$num)},
+);
+
+
TUWF::set custom_validations => {
id => { uint => 1, max => (1<<26)-1 },
# 'vndbid' SQL type, accepts an arrayref with accepted prefixes.
+ # If only one prefix is supported, it will also take integers and normalizes them into the formatted form.
vndbid => sub {
- my $types = ref $_[0] ? join '|', $_[0]->@* : $_[0];
- +{ regex => qr/^(?:$types)[1-9][0-9]{0,6}$/ }
+ my $multi = ref $_[0];
+ my $types = $multi ? join '|', $_[0]->@* : $_[0];
+ my $re = qr/^(?:$types)[1-9][0-9]{0,6}$/;
+ +{ _analyze_regex => $re, func => sub { $_[0] = "${types}$_[0]" if !$multi && $_[0] =~ /^[1-9][0-9]{0,6}$/; return $_[0] =~ $re } }
},
- editsum => { required => 1, length => [ 2, 5000 ] },
- page => { uint => 1, min => 1, max => 1000, required => 0, default => 1, onerror => 1 },
- upage => { uint => 1, min => 1, required => 0, default => 1, onerror => 1 }, # pagination without a maximum
- username => { regex => qr/^(?!-*[a-z][0-9]+-*$)[a-z0-9-]*$/, minlength => 2, maxlength => 15 },
+ sl => { regex => qr/^[^\t\r\n]+$/ }, # "Single line", also excludes tabs because they're weird.
+ editsum => { length => [ 2, 5000 ] },
+ page => { uint => 1, min => 1, max => 1000, default => 1, onerror => 1 },
+ upage => { uint => 1, min => 1, default => 1, onerror => 1 }, # pagination without a maximum
+ username => { regex => qr/^(?!-*[a-zA-Z][0-9]+-*$)[a-zA-Z0-9-]*$/, minlength => 2, maxlength => 15 },
password => { length => [ 4, 500 ] },
language => { enum => \%LANGUAGE },
- gtin => { required => 0, default => 0, func => sub { $_[0] = 0 if !length $_[0]; $_[0] eq 0 || gtintype($_[0]) } },
+ gtin => { default => 0, func => sub { $_[0] = 0 if !length $_[0]; $_[0] eq 0 || gtintype($_[0]) } },
rdate => { uint => 1, func => \&_validate_rdate },
- # A tri-state bool, returns undef if not present or empty, normalizes to 0/1 otherwise
- undefbool => { required => 0, default => undef, func => sub { $_[0] = $_[0] ? 1 : 0; 1 } },
+ fuzzyrdate => { default => 0, func => \&_validate_fuzzyrdate },
+ searchquery => { onerror => bless([],'VNWeb::Validate::SearchQuery'), func => sub { $_[0] = bless([$_[0]], 'VNWeb::Validate::SearchQuery'); 1 } },
+ # Calendar date, limited to 1970 - 2099 for sanity.
+ # TODO: Should also validate whether the day exists, currently "2022-11-31" is accepted, but that's a bug.
+ caldate => { regex => qr/^(?:19[7-9][0-9]|20[0-9][0-9])-(?:0[1-9]|1[0-2])-(?:0[1-9]|[12][0-9]|3[01])$/ },
# An array that may be either missing (returns undef), a single scalar (returns single-element array) or a proper array
- undefarray => sub { +{ required => 0, default => undef, type => 'array', scalar => 1, values => $_[0] } },
+ undefarray => sub { +{ default => undef, type => 'array', scalar => 1, values => $_[0] } },
# Accepts a user-entered vote string (or '-' or empty) and converts that into a DB vote number (or undef) - opposite of fmtvote()
- vnvote => { required => 0, default => undef, regex => qr/^(?:|-|[1-9]|10|[1-9]\.[0-9]|10\.0)$/, func => sub { $_[0] = $_[0] eq '-' ? undef : 10*$_[0]; 1 } },
+ vnvote => { default => undef, regex => qr/^(?:|-|[1-9]|10|[1-9]\.[0-9]|10\.0)$/, func => sub { $_[0] = $_[0] eq '-' ? undef : 10*$_[0]; 1 } },
# Sort an array by the listed hash keys, using string comparison on each key
sort_keys => sub {
my @keys = ref $_[0] eq 'ARRAY' ? @{$_[0]} : $_[0];
@@ -56,6 +95,16 @@ TUWF::set custom_validations => {
},
# Sorted and unique array-of-hashes (default order is sort_keys on the sorted keys...)
aoh => sub { +{ type => 'array', unique => 1, sort_keys => [sort keys %{$_[0]}], values => { type => 'hash', keys => $_[0] } } },
+ # Fields query parameter for the API, supports multiple values or comma-delimited list, returns a hash.
+ fields => sub {
+ my %keys = map +($_,1), ref $_[0] eq 'ARRAY' ? @{$_[0]} : $_[0];
+ +{ default => {}, type => 'array', values => {}, scalar => 1, func => sub {
+ my @l = map split(/\s*,\s*/,$_), @{$_[0]};
+ return 0 if grep !$keys{$_}, @l;
+ $_[0] = { map +($_,1), @l };
+ 1;
+ } }
+ },
};
sub _validate_rdate {
@@ -75,8 +124,56 @@ sub _validate_rdate {
}
-sub is_insecurepass {
- config->{password_db} && PWLookup::lookup(config->{password_db}, shift)
+sub _validate_fuzzyrdate {
+ $_[0] = 0 if $_[0] =~ /^unknown$/i;
+ $_[0] = 1 if $_[0] =~ /^today$/i;
+ $_[0] = 99999999 if $_[0] =~ /^tba$/i;
+ $_[0] = "${1}9999" if $_[0] =~ /^([0-9]{4})$/;
+ $_[0] = "${1}${2}99" if $_[0] =~ /^([0-9]{4})-([0-9]{2})$/;
+ $_[0] = "${1}${2}$3" if $_[0] =~ /^([0-9]{4})-([0-9]{2})-([0-9]{2})$/;
+ return 1 if $_[0] eq 1;
+ VNWeb::Validation::_validate_rdate($_[0]);
+}
+
+
+# returns true if this request originated from the same site, i.e. not an external referer.
+sub samesite { !!tuwf->reqCookie('samesite') }
+
+# returns true if this request is for an /api/ URL.
+sub is_api { !$main::NOAPI && ($main::ONLYAPI || tuwf->reqPath =~ /^\/api\//) }
+
+# Test uniqueness of a username in the database. Usernames with similar
+# homographs are considered duplicate.
+# (Would be much faster and safer to do this normalization in the DB and put a
+# unique constraint on the normalized name, but we have a bunch of existing
+# username clashes that I can't just change)
+sub is_unique_username {
+ my($name, $excludeid) = @_;
+ my sub norm {
+ # lowercase, normalize 'i1l' and '0o'
+ sql "regexp_replace(regexp_replace(lower(", $_[0], "), '[1l]', 'i', 'g'), '0', 'o', 'g')";
+ };
+ !tuwf->dbVali('SELECT 1 FROM users WHERE', norm('username'), '=', norm(\$name),
+ $excludeid ? ('AND id <>', \$excludeid) : ());
+}
+
+
+# Lookup IP and return an 'ipinfo' DB string.
+sub ipinfo {
+ my $ip = shift || tuwf->reqIP;
+ state $db = config->{location_db} && do {
+ require Location;
+ Location::init(config->{location_db});
+ };
+ sub esc { ($_[0]//'') =~ s/([,()\\'"])/\\$1/rg }
+ return sprintf "(%s,,,,,,,)", esc $ip if !$db;
+
+ my sub f { Location::lookup_network_has_flag($db, $ip, "LOC_NETWORK_FLAG_$_[0]") ? 't' : 'f' }
+ my $asn = Location::lookup_asn($db, $ip);
+ sprintf "(%s,%s,%d,%s,%s,%s,%s,%s)", esc($ip),
+ esc(Location::lookup_country_code($db,$ip)),
+ $asn, esc(Location::get_as_name($db,$asn)),
+ f('ANONYMOUS_PROXY'), f('SATELLITE_PROVIDER'), f('ANYCAST'), f('DROP');
}
@@ -182,6 +279,10 @@ sub validate_dbid {
# Otherwise, checks if the user can edit the review.
# Requires the 'uid' field.
#
+# g/i:
+# If no 'id' field, checks if the user can create a new tag/trait.
+# Otherwise, checks if the user can edit the entry.
+#
# 'dbentry_type's:
# If no 'id' field, checks whether the user can create a new entry.
# Otherwise, requires 'entry_hidden' and 'entry_locked' fields.
@@ -189,12 +290,12 @@ sub validate_dbid {
sub can_edit {
my($type, $entry) = @_;
- return auth->permUsermod || auth->permDbmod || auth->permImgmod || auth->permBoardmod || auth->permTagmod || (auth && $entry->{id} == auth->uid) if $type eq 'u';
+ return auth->permUsermod || (auth && $entry->{id} eq auth->uid) if $type eq 'u';
return auth->permDbmod if $type eq 'd';
if($type eq 't') {
- return 0 if !auth->permBoard;
return 1 if auth->permBoardmod;
+ return 0 if !auth->permBoard || (global_settings->{lockdown_board} && !auth->isMod);
if(!$entry->{id}) {
# Allow at most 5 new threads per day per user.
return auth && tuwf->dbVali('SELECT count(*) < ', \5, 'FROM threads_posts WHERE num = 1 AND date > NOW()-\'1 day\'::interval AND uid =', \auth->uid);
@@ -204,20 +305,31 @@ sub can_edit {
} else {
die "Can't do authorization test when hidden/date/user_id fields aren't present"
if !exists $entry->{hidden} || !exists $entry->{date} || !exists $entry->{user_id};
- return auth && $entry->{user_id} == auth->uid && !$entry->{hidden} && $entry->{date} > time-config->{board_edit_time};
+ # beware: for threads the 'hidden' field is a non-undef boolean flag, for posts it is a possibly-undef text field.
+ my $hidden = $entry->{id} =~ /^t/ && $entry->{num} == 1 ? $entry->{hidden} : defined $entry->{hidden};
+ return auth && $entry->{user_id} eq auth->uid && !$hidden && $entry->{date} > time-config->{board_edit_time};
}
}
if($type eq 'w') {
return 1 if auth->permBoardmod;
- return auth->permReview if !$entry->{id};
- return auth && auth->uid == $entry->{user_id};
+ return auth->permReview && (!global_settings->{lockdown_board} || auth->isMod) if !$entry->{id};
+ return auth && auth->uid eq $entry->{user_id};
+ }
+
+ if($type eq 'g' || $type eq 'i') {
+ return 1 if auth->permTagmod;
+ return auth->permEdit if !$entry->{id};
+ die if !exists $entry->{entry_hidden} || !exists $entry->{entry_locked};
+ # Let users edit their own tags/traits while it's still pending approval.
+ return auth && $entry->{entry_hidden} && !$entry->{entry_locked}
+ && tuwf->dbVali('SELECT 1 FROM changes WHERE itemid =', \$entry->{id}, 'AND rev = 1 AND requester =', \auth->uid);
}
die "Can't do authorization test when entry_hidden/entry_locked fields aren't present"
if $entry->{id} && (!exists $entry->{entry_hidden} || !exists $entry->{entry_locked});
- auth->permDbmod || (auth->permEdit && !($entry->{entry_hidden} || $entry->{entry_locked}));
+ auth->permDbmod || (auth->permEdit && !global_settings->{lockdown_edit} && !($entry->{entry_hidden} || $entry->{entry_locked}));
}
@@ -246,7 +358,7 @@ sub viewget {
my($view, $token) = tuwf->reqGet('view') =~ /^([^-]*)-(.+)$/;
# Abort this request and redirect if the token is invalid.
- if(length($view) && (!tuwf->samesite || !length($token) || !auth->csrfcheck($token, 'view'))) {
+ if(length($view) && (!samesite || !length($token) || !auth->csrfcheck($token, 'view'))) {
my $qs = join '&', map { my $k=$_; my @l=tuwf->reqGets($k); map uri_escape($k).'='.uri_escape($_), @l } grep $_ ne 'view', tuwf->reqGets();
tuwf->resInit;
tuwf->resRedirect(tuwf->reqPath().($qs?"?$qs":''), 'temp');
@@ -274,4 +386,80 @@ sub viewset {
'-'.auth->csrftoken(0, 'view');
}
+
+# Object returned by the 'searchquery' validation, has some handy methods for generating SQL.
+package VNWeb::Validate::SearchQuery {
+ use TUWF;
+ use VNWeb::DB;
+
+ sub query_encode { $_[0][0] }
+ sub TO_JSON { $_[0][0] }
+
+ sub words {
+ $_[0][1] //= length $_[0][0]
+ ? [ map s/%//rg, tuwf->dbVali('SELECT search_query(', \$_[0][0], ')')->@* ]
+ : []
+ }
+
+ use overload bool => sub { $_[0]->words->@* > 0 };
+ use overload '""' => sub { $_[0][0]//'' };
+
+ sub _isvndbid { my $l = $_[0]->words; @$l == 1 && $l->[0] =~ /^[vrpcsgi]$num$/ }
+
+ sub where {
+ my($self, $type) = @_;
+ my $lst = $self->words;
+ my @keywords = map sql('sc.label LIKE', \('%'.sql_like($_).'%')), @$lst;
+ +(
+ $type ? "sc.id BETWEEN '${type}1' AND vndbid_max('$type')" : (),
+ $self->_isvndbid()
+ ? (sql 'sc.id =', \$lst->[0], 'OR', sql_and(@keywords))
+ : @keywords
+ )
+ }
+
+ sub sql_where {
+ my($self, $type, $id, $subid) = @_;
+ return '1=1' if !$self;
+ sql 'EXISTS(SELECT 1 FROM search_cache sc WHERE', sql_and(
+ sql('sc.id =', $id), $subid ? sql('sc.subid =', $subid) : (),
+ $self->where($type),
+ ), ')';
+ }
+
+ # Returns a subquery that can be joined to get the search score.
+ # Columns (id, subid, score)
+ sub sql_score {
+ my($self, $type) = @_;
+ my $lst = $self->words;
+ my $q = join '', @$lst;
+ sql '(SELECT id, subid, max(sc.prio * (', VNWeb::DB::sql_join('+',
+ $self->_isvndbid() ? sql('CASE WHEN sc.id =', \$q, 'THEN 1+1 ELSE 0 END') : (),
+ sql('CASE WHEN sc.label LIKE', \(sql_like($q).'%'), 'THEN 1::float/(1+1) ELSE 0 END'),
+ sql('similarity(sc.label,', \$q, ')'),
+ ), ')) AS score
+ FROM search_cache sc
+ WHERE', sql_and($self->where($type)), '
+ GROUP BY id, subid
+ )';
+ }
+
+ # Optionally returns a JOIN clause for sql_score, aliassed 'sc'
+ sub sql_join {
+ my($self, $type, $id, $subid) = @_;
+ return '' if !$self;
+ sql 'JOIN', $self->sql_score($type), 'sc ON sc.id =', $id, $subid ? ('AND sc.subid =', $subid) : ();
+ }
+
+ # Same as sql_join(), but accepts an array of SearchQuery objects that are OR'ed together.
+ sub sql_joina {
+ my($lst, $type, $id, $subid) = @_;
+ sql 'JOIN (
+ SELECT id, subid, max(score) AS score
+ FROM (', VNWeb::DB::sql_join('UNION ALL', map sql('SELECT * FROM', $_->sql_score($type), 'x'), @$lst), ') x
+ GROUP BY id, subid
+ ) sc ON sc.id =', $id, $subid ? ('AND sc.subid =', $subid) : ();
+ }
+};
+
1;
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-20 12:10:03 +0000