summaryrefslogtreecommitdiff
path: root/lib/VN3/Validation.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/VN3/Validation.pm')
-rw-r--r--lib/VN3/Validation.pm201
1 files changed, 201 insertions, 0 deletions
diff --git a/lib/VN3/Validation.pm b/lib/VN3/Validation.pm
new file mode 100644
index 00000000..a0a59e44
--- /dev/null
+++ b/lib/VN3/Validation.pm
@@ -0,0 +1,201 @@
+# This module provides additional validations for tuwf->validate(), and exports
+# an easy wrapper to create a simple API that accepts JSON data on POST
+# requests. The CSRF token and the input data are validated before the
+# subroutine is called.
+#
+# Usage:
+#
+# json_api '/some/url', {
+# username => { maxlength => 10 },
+# }, sub {
+# my $validated_data = shift;
+# };
+package VN3::Validation;
+
+use strict;
+use warnings;
+use TUWF;
+use VNDBUtil;
+use VN3::DB;
+use VN3::Auth;
+use VN3::Types;
+use JSON::XS;
+use Exporter 'import';
+use Time::Local 'timegm';
+use Carp 'croak';
+our @EXPORT = ('form_compile', 'form_changed', 'json_api', 'validate_dbid', 'can_edit');
+
+
+TUWF::set custom_validations => {
+ id => { uint => 1, max => 1<<40 },
+ page => { uint => 1, min => 1, max => 1000, required => 0, default => 1 },
+ username => { regex => qr/^[a-z0-9-]{2,15}$/ },
+ password => { length => [ 4, 500 ] },
+ editsum => { required => 1, length => [ 2, 5000 ] },
+ vn_length => { required => 0, default => 0, uint => 1, range => [ 0, $#VN_LENGTHS ] },
+ vn_relation => { enum => \%VN_RELATIONS },
+ producer_relation => { enum => \%PRODUCER_RELATIONS },
+ staff_role => { enum => \%STAFF_ROLES },
+ char_role => { enum => \%CHAR_ROLES },
+ language => { enum => \%LANG },
+ platform => { enum => \%PLATFORMS },
+ medium => { enum => \%MEDIA },
+ resolution => { enum => \%RESOLUTIONS },
+ gender => { enum => \%GENDERS },
+ blood_type => { enum => \%BLOOD_TYPES },
+ gtin => { uint => 1, func => sub { $_[0] eq 0 || gtintype($_[0]) } },
+ minage => { uint => 1, enum => \@MINAGE },
+ animated => { uint => 1, range => [ 0, $#ANIMATED ] },
+ voiced => { uint => 1, range => [ 0, $#VOICED ] },
+ rdate => { uint => 1, func => \&_validate_rdate },
+ spoiler => { uint => 1, range => [ 0, 2 ] },
+ vnlist_status=>{ uint => 1, range => [ 0, $#VNLIST_STATUS ] },
+ # Accepts a user-entered vote string (or '-' or empty) and converts that into a DB vote number (or undef)
+ vnvote => { regex => qr/^(?:|-|[1-9]|10|[1-9]\.[0-9]|10\.0)$/, required => 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];
+ +{ type => 'array', sort => sub {
+ for(@keys) {
+ my $c = defined($_[0]{$_}) cmp defined($_[1]{$_}) || (defined($_[0]{$_}) && $_[0]{$_} cmp $_[1]{$_});
+ return $c if $c;
+ }
+ 0
+ } }
+ },
+ # 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] } } },
+};
+
+
+sub _validate_rdate {
+ return 0 if $_[0] ne 0 && $_[0] !~ /^([0-9]{4})([0-9]{2})([0-9]{2})$/;
+ my($y, $m, $d) = $_[0] eq 0 ? (0,0,0) : ($1, $2, $3);
+
+ # Re-normalize
+ ($m, $d) = (0, 0) if $y == 0;
+ $m = 99 if $y == 9999;
+ $d = 99 if $m == 99;
+ $_[0] = $y*10000 + $m*100 + $d;
+
+ return 0 if $y && $y != 9999 && ($y < 1980 || $y > 2100);
+ return 0 if $y && $m != 99 && (!$m || $m > 12);
+ return 0 if $y && $d != 99 && !eval { timegm(0, 0, 0, $d, $m-1, $y) };
+ return 1;
+}
+
+
+# Recursively remove keys from hashes that have a '_when' key that doesn't
+# match $when. This is a quick and dirty way to create multiple validation
+# schemas from a single schema. For example:
+#
+# {
+# title => { _when => 'input' },
+# name => { },
+# }
+#
+# If $when is 'input', then this function returns:
+# { title => {}, name => {} }
+# Otherwise, it returns:
+# { name => {} }
+sub stripwhen {
+ my($when, $o) = @_;
+ return $o if ref $o ne 'HASH';
+ +{ map $_ eq '_when' || (ref $o->{$_} eq 'HASH' && defined $o->{$_}{_when} && $o->{$_}{_when} !~ $when) ? () : ($_, stripwhen($when, $o->{$_})), keys %$o }
+}
+
+
+# Short-hand to compile a validation schema for a form. Usage:
+#
+# form_compile $when, {
+# title => { _when => 'input' },
+# name => { },
+# ..
+# };
+sub form_compile {
+ tuwf->compile({ type => 'hash', keys => stripwhen @_ });
+}
+
+
+sub eq_deep {
+ my($a, $b) = @_;
+ return 0 if ref $a ne ref $b;
+ return 0 if defined $a != defined $b;
+ return 1 if !defined $a;
+ return 1 if !ref $a && $a eq $b;
+ return 1 if ref $a eq 'ARRAY' && (@$a == @$b && !grep !eq_deep($a->[$_], $b->[$_]), 0..$#$a);
+ return 1 if ref $a eq 'HASH' && eq_deep([sort keys %$a], [sort keys %$b]) && !grep !eq_deep($a->{$_}, $b->{$_}), keys %$a;
+ 0
+}
+
+
+# Usage: form_changed $schema, $a, $b
+# Returns 1 if there is a difference between the data ($a) and the form input
+# ($b), using the normalization defined in $schema. The $schema must validate.
+sub form_changed {
+ my($schema, $a, $b) = @_;
+ my $na = $schema->validate($a)->data;
+ my $nb = $schema->validate($b)->data;
+
+ #warn "a=".JSON::XS->new->pretty->canonical->encode($na);
+ #warn "b=".JSON::XS->new->pretty->canonical->encode($nb);
+ !eq_deep $na, $nb;
+}
+
+
+sub json_api {
+ my($path, $keys, $sub) = @_;
+
+ my $schema = ref $keys eq 'HASH' ? tuwf->compile({ type => 'hash', keys => $keys }) : $keys;
+
+ TUWF::post $path => sub {
+ if(!auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) {
+ warn "Invalid CSRF token in request\n";
+ tuwf->resJSON({CSRF => 1});
+ return;
+ }
+
+ my $data = tuwf->validate(json => $schema);
+ if(!$data) {
+ warn "JSON validation failed\ninput: " . JSON::XS->new->allow_nonref->pretty->canonical->encode(tuwf->reqJSON) . "\nerror: " . JSON::XS->new->encode($data->err) . "\n";
+ tuwf->resJSON({Invalid => $data->err});
+ return;
+ }
+
+ $sub->($data->data);
+ };
+}
+
+
+# Validate identifiers against an SQL query. The query must end with a 'id IN'
+# clause, where the @ids array is appended. The query must return exactly 1
+# column, the id of each entry. This function throws an error if an id is
+# missing from the query. For example, to test for non-hidden VNs:
+#
+# validate_dbid 'SELECT id FROM vn WHERE NOT hidden AND id IN', 2,3,5,7,...;
+#
+# If any of those ids is hidden or not in the database, an error is thrown.
+sub validate_dbid {
+ my($sql, @ids) = @_;
+ return if !@ids;
+ $sql = ref $sql eq 'CODE' ? sql $sql->(\@ids) : sql $sql, \@ids;
+ my %dbids = map +((values %$_)[0],1), @{ tuwf->dbAlli($sql) };
+ my @missing = grep !$dbids{$_}, @ids;
+ croak "Invalid database IDs: ".join(',', @missing) if @missing;
+}
+
+
+# Returns whether the current user can edit the given database entry.
+sub can_edit {
+ my($type, $entry) = @_;
+
+ return auth->permUsermod || $entry->{id} == (auth->uid||0) if $type eq 'u';
+ return auth->permDbmod if $type eq 'd';
+
+ 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}));
+}
+
+1;