View | Details | Raw Unified | Return to bug 28935
Collapse All | Expand All

(-)a/Koha/Allowlist.pm (-39 / +62 lines)
Lines 1-7 Link Here
1
package Koha::Allowlist;
1
package Koha::Allowlist;
2
2
3
use Modern::Perl;
3
use Modern::Perl;
4
use Array::Utils qw( array_minus );
5
4
6
=head1 NAME
5
=head1 NAME
7
6
Lines 11-23 Koha::Allowlist - Allowlist implementation base class Link Here
11
10
12
=head2 Class Methods
11
=head2 Class Methods
13
12
14
    my $allow_list Koha::Allowlist->new({ interface => 'staff' });
15
16
=head3 new
13
=head3 new
17
14
18
Constructor.
15
    my $allow_list = Koha::Allowlist->new({ interface => 'staff' });
16
17
    Constructor.
19
18
20
Interface must be 'staff' or 'opac' - default to 'opac'
19
    Interface must be 'staff' or 'opac' - defaults to 'opac'
21
20
22
=cut
21
=cut
23
22
Lines 29-93 sub new { Link Here
29
      ( $args->{interface} && $args->{interface} eq 'staff' )
28
      ( $args->{interface} && $args->{interface} eq 'staff' )
30
      ? 'staff'
29
      ? 'staff'
31
      : 'opac';
30
      : 'opac';
31
    $self->{_entries} = {};
32
    return $self;
32
    return $self;
33
}
33
}
34
34
35
=head3 apply
35
=head3 add
36
37
    $list->add( 'column1', 'column2' );
36
38
37
    my $ui_fields = Koha::Allowlist->new({ interface => 'staff' })->apply({ input => $hashref, additional_deny_list => [qw( list of fields )] });
39
=cut
40
41
sub add {
42
    my ( $self, @args ) = @_;
43
    # TODO Could be extended by passing things like column3 => { staff => 1 }
44
    foreach my $arg ( @args ) {
45
        $self->{_entries}->{$arg} = 1;
46
    }
47
}
38
48
49
=head3 remove
39
50
40
Apply an allowlist to input data.
51
    $list->remove( 'column3', 'column4' );
41
52
42
=cut
53
=cut
43
54
44
sub apply {
55
sub remove {
45
    my ( $self, $params ) = @_;
56
    my ( $self, @args ) = @_;
57
    foreach my $arg ( @args ) {
58
        delete $self->{_entries}->{$arg};
59
    }
60
}
46
61
47
    my $input = $params->{input};
62
=head3 apply
48
    my $additional_deny_list = $params->{additional_deny_list} || [];
49
63
50
    my $blocked = {};
64
    my $blocked = $allowlist->apply({ input => $hashref, verbose => 1 });
51
    my $ui_fields = { map { $_ => 1 } $self->get_ui_fields() };
52
    return unless $ui_fields and %$ui_fields;
53
65
54
    delete $ui_fields->{$_} for @$additional_deny_list;
66
    Apply an allowlist to input data. Note that we modify the $hashref argument!
67
    The verbose flag controls the warn statement.
55
68
56
    return unless $input  and %$input;
69
    Returns a hash of blocked entries. Might be useful for logging purposes?
70
71
=cut
57
72
58
    my @keys = keys %$input;
73
sub apply {
59
    foreach my $key (@keys){
74
    my ( $self, $params ) = @_;
60
        unless ( exists $ui_fields->{ $key } ) {
75
    my $input = $params->{input} or return;
61
            #NOTE: We capture the deleted data so that it can be used for logging purposes
76
77
    my $blocked = {};
78
    foreach my $key ( keys %$input ){
79
        unless ( $self->{_entries}->{$key} ) {
62
            $blocked->{$key} = delete $input->{ $key };
80
            $blocked->{$key} = delete $input->{ $key };
63
        }
81
        }
64
    }
82
    }
83
    warn 'Koha::Allowlist: apply blocked one or more keys' if keys %$blocked && $params->{verbose};
84
    return $blocked;
85
}
65
86
66
    if ( %$blocked ) {
87
=head3 load
67
        while ( my ($k, $v)=each %$blocked){
68
            # FIXME We should raise an exception from here
69
            my @c = caller;
70
            warn sprintf "Forbidden - Tried to modify '%s' with '%s' from %s", $k, $v, "@c";
71
        }
72
    }
73
88
74
    return $blocked;
89
    my $fields = $self->load;
90
91
    Loads default allow list entries.
92
93
    This routine should be overridden when subclassing.
94
95
=cut
96
97
sub load {
98
    my ( $self ) = @_;
99
    # You could do something here like:
100
    # $self->add( 'myfield' );
75
}
101
}
76
102
77
=head3 get_ui_fields
103
=head3 unload
104
105
    $allowlist->unload;
78
106
79
    my $ui_fields = $self->get_ui_fields();
107
    Clear all entries.
80
    my $ui_fields = Koha::Patron::Allowlist::Public->new->get_ui_fields
81
108
82
=cut
109
=cut
83
110
84
sub get_ui_fields {
111
sub unload {
85
    my ($self)           = @_;
112
    my ( $self ) = @_;
86
    my @all_fields       = $self->_get_all_fields();
113
    $self->{_entries} = {};
87
    my @global_deny_list = $self->_global_deny_list();
88
    my @deny_list        = ( $self->{interface} eq 'staff' ) ? $self->_deny_list_staff() : $self->_deny_list_opac();
89
    my @global_allow_list = array_minus @all_fields, @global_deny_list;
90
    return array_minus @global_allow_list, @deny_list;
91
}
114
}
92
115
93
1;
116
1;
(-)a/Koha/Patron/Allowlist.pm (-57 / +7 lines)
Lines 1-12 Link Here
1
package Koha::Patron::Allowlist;
1
package Koha::Patron::Allowlist;
2
2
3
use Modern::Perl;
3
use parent 'Koha::Allowlist';
4
use parent 'Koha::Allowlist';
4
5
5
# This must not be replaced by Koha::Patrons->columns
6
sub load {
6
# We want developper to not forget to adjust it manually and add new attribute to the deny list if needed
7
    my ( $self ) = @_;
7
sub _get_all_fields {
8
    my @allowed = qw(
8
    return qw(
9
      borrowernumber
10
      cardnumber
9
      cardnumber
11
      surname
10
      surname
12
      firstname
11
      firstname
Lines 40-65 sub _get_all_fields { Link Here
40
      dateofbirth
39
      dateofbirth
41
      branchcode
40
      branchcode
42
      categorycode
41
      categorycode
43
      dateenrolled
44
      dateexpiry
45
      date_renewed
46
      gonenoaddress
47
      lost
48
      debarred
49
      debarredcomment
50
      contactname
42
      contactname
51
      contactfirstname
43
      contactfirstname
52
      contacttitle
44
      contacttitle
53
      borrowernotes
54
      relationship
55
      sex
45
      sex
56
      password
46
      password
57
      flags
58
      userid
47
      userid
59
      opacnote
60
      contactnote
48
      contactnote
61
      sort1
62
      sort2
63
      altcontactfirstname
49
      altcontactfirstname
64
      altcontactsurname
50
      altcontactsurname
65
      altcontactaddress1
51
      altcontactaddress1
Lines 70-113 sub _get_all_fields { Link Here
70
      altcontactcountry
56
      altcontactcountry
71
      altcontactphone
57
      altcontactphone
72
      smsalertnumber
58
      smsalertnumber
73
      sms_provider_id
74
      privacy
75
      privacy_guarantor_fines
76
      privacy_guarantor_checkouts
77
      checkprevcheckout
78
      updated_on
79
      lastseen
80
      lang
81
      login_attempts
82
      overdrive_auth_token
83
      anonymized
84
      autorenew_checkouts
85
      primary_contact_method
59
      primary_contact_method
86
    );
60
    );
87
}
61
    $self->add( @allowed );
88
89
sub _global_deny_list {
90
    return qw(
91
      borrowernumber
92
      date_renewed
93
      debarred
94
      debarredcomment
95
      flags
96
      privacy
97
      privacy_guarantor_fines
98
      privacy_guarantor_checkouts
99
      checkprevcheckout
100
      updated_on
101
      lastseen
102
      lang
103
      login_attempts
104
      overdrive_auth_token
105
      anonymized
106
    );
107
}
108
62
109
sub _deny_list_opac {
63
    my @allowed_staff = qw(
110
    return qw(
111
      dateenrolled
64
      dateenrolled
112
      dateexpiry
65
      dateexpiry
113
      gonenoaddress
66
      gonenoaddress
Lines 120-129 sub _deny_list_opac { Link Here
120
      sms_provider_id
73
      sms_provider_id
121
      autorenew_checkouts
74
      autorenew_checkouts
122
    );
75
    );
123
}
76
    $self->add( @allowed_staff ) if $self->{interface} eq 'staff';
124
125
sub _deny_list_staff {
126
    return qw();
127
}
77
}
128
78
129
1;
79
1;
(-)a/t/Koha/Allowlist.t (+73 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use Modern::Perl;
19
use Test::More tests => 2;
20
21
use Koha::Allowlist;
22
use Koha::Patron::Allowlist;
23
24
subtest 'Allowlist' => sub {
25
    plan tests => 7;
26
27
    my $allowlist = Koha::Allowlist->new;
28
    $allowlist->load;
29
    is( $allowlist->apply, undef, 'No input returns undef' );
30
    is( %{$allowlist->apply({ input => {} })}, 0, 'Empty hash returns nothing blocked' );
31
32
    my @input = ( col1 => 1, col2 => 2, col3 => 3, col4 => 4 );
33
    my $blocked = $allowlist->apply({ input => { @input } });
34
    is( keys %$blocked, 4, 'Empty list blocks all' );
35
    $allowlist->add( 'col1' );
36
    $blocked = $allowlist->apply({ input => { @input } });
37
    is( keys %$blocked, 3, 'One field allowed' );
38
    is( $blocked->{col1}, undef, 'And that is col1' );
39
    $allowlist->remove( 'col1' );
40
    $blocked = $allowlist->apply({ input => { @input } });
41
    is( keys %$blocked, 4, 'Back to 4 after removing col1' );
42
    $allowlist->add( 'col2' );
43
    $allowlist->unload;
44
    $blocked = $allowlist->apply({ input => { @input } });
45
    is( keys %$blocked, 4, 'Same after unloading' );
46
};
47
48
subtest 'Patron::Allowlist' => sub {
49
    plan tests => 12;
50
51
    my $input = { firstname => 'test firstname', surname => 'test surname', flags => '1', gonenoaddress => 1, unexist => 2 };
52
    my $allowlist = Koha::Patron::Allowlist->new({ interface => 'staff' });
53
    $allowlist->load;
54
    my $blocked = $allowlist->apply({ input => $input });
55
56
    is( $blocked->{unexist}, 2, "Unexist got blocked" );
57
    is( $input->{unexist}, undef, 'unexist filtered' );
58
    is( $blocked->{flags}, 1, "Flags got blocked" );
59
    is( $input->{flags}, undef, 'flags filtered' );
60
    is( $input->{firstname}, 'test firstname', 'firstname preserved' );
61
    is( $input->{surname}, 'test surname', 'surname preserved' );
62
    is( $input->{gonenoaddress}, 1, 'gonenoaddress preserved on staff' );
63
64
    $input = { firstname => 'test firstname', surname => 'test surname', flags => '1', gonenoaddress => 1, unexist => 2 };
65
    my $opacallowlist = Koha::Patron::Allowlist->new;
66
    $opacallowlist->load;
67
    $blocked = $opacallowlist->apply({ input => $input });
68
    is( $blocked->{unexist}, 2, "Unexist got blocked on opac too");
69
    is( $blocked->{flags}, 1, "Flags got blocked on opac too" );
70
    is( $blocked->{gonenoaddress}, 1, "Gonenoaddress got blocked on opac now" );
71
    is( $input->{gonenoaddress}, undef, 'gonenoaddress filtered, opac' );
72
    is( $input->{surname}, 'test surname', 'surname preserved, opac' );
73
};
(-)a/t/db_dependent/Koha/Patron/Allowlist.t (-102 lines)
Lines 1-101 Link Here
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use Modern::Perl;
19
20
use Test::More tests => 4;
21
22
use Test::MockModule;
23
use Test::Exception;
24
use Test::Warn;
25
26
use Koha::Patrons;
27
use Koha::Patron::Allowlist;
28
29
use t::lib::Mocks;
30
31
subtest '_get_all_fields' => sub {
32
    my @columns = Koha::Patrons->columns;
33
    is_deeply(
34
        \@columns,
35
        [ Koha::Patron::Allowlist->_get_all_fields ],
36
        'All DB columns must be listed in _get_all_fields'
37
    );
38
};
39
40
subtest 'Staff Allowlist' => sub {
41
    plan tests => 4;
42
    my $input = { firstname => 'test firstname', surname => 'test surname', flags => '1' };
43
    my $allowlist = Koha::Patron::Allowlist->new({ interface => 'staff' });
44
    warning_like {
45
        $allowlist->apply({ input => $input, });
46
    } qr{Forbidden - Tried to modify 'flags' with '1' from};
47
    is( $input->{firstname}, 'test firstname', 'firstname preserved' );
48
    is( $input->{surname}, 'test surname', 'surname preserved' );
49
    is( $input->{flags}, undef, 'flags filtered' );
50
};
51
52
subtest 'Public Allowlist' => sub {
53
    plan tests => 4;
54
    my $input = { firstname => 'test firstname', surname => 'test surname', flags => '1' };
55
    my $allowlist = Koha::Patron::Allowlist->new();
56
    warning_like {
57
        $allowlist->apply({ input => $input, });
58
    } qr{Forbidden - Tried to modify 'flags' with '1' from};
59
60
    is( $input->{firstname}, 'test firstname', 'firstname preserved' );
61
    is( $input->{surname},  'test surname', 'surname preserved' );
62
    is( $input->{flags}, undef, 'flags filtered' );
63
};
64
65
subtest 'additional_deny_list' => sub {
66
    plan tests => 10;
67
68
    my $input = { firstname => 'test firstname', surname => 'test surname' };
69
    my $allowlist = Koha::Patron::Allowlist->new();
70
71
    $allowlist->apply({
72
        input => $input,
73
        additional_deny_list => [],
74
    });
75
76
    is( $input->{firstname}, 'test firstname', 'firstname preserved' );
77
    is( $input->{surname},   'test surname',   'surname filtered' );
78
    is( $input->{flags},     undef,            'flags filtered' );
79
80
    $allowlist->apply({
81
        input => $input,
82
        additional_deny_list => ['not_here'],
83
    });
84
85
    is( $input->{firstname}, 'test firstname', 'firstname preserved' );
86
    is( $input->{surname},   'test surname',   'surname filtered' );
87
    is( $input->{flags},     undef,            'flags filtered' );
88
89
    warning_like {
90
        $allowlist->apply({
91
            input => $input,
92
            additional_deny_list => ['surname'],
93
        });
94
    }
95
    qr{Forbidden - Tried to modify 'surname' with 'test surname' from};
96
97
    is( $input->{firstname}, 'test firstname', 'firstname preserved' );
98
    is( $input->{surname},   undef,            'surname filtered' );
99
    is( $input->{flags},     undef,            'flags filtered' );
100
101
};
102
- 

Return to bug 28935