Koha/Auth/Client.pm

   1 package Koha::Auth::Client;
   2
   3 # Copyright Theke Solutions 2022
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21
  22 use Koha::Exceptions::Auth;
  23 use Koha::Auth::Identity::Providers;
  24
  25 =head1 NAME
  26
  27 Koha::Auth::Client - Base Koha auth client
  28
  29 =head1 API
  30
  31 =head2 Methods
  32
  33 =head3 new
  34
  35     my $auth_client = Koha::Auth::Client->new();
  36
  37 =cut
  38
  39 sub new {
  40     my ($class) = @_;
  41     my $self = {};
  42
  43     bless( $self, $class );
  44 }
  45
  46 =head3 get_user
  47
  48     $auth_client->get_user($provider, $data)
  49
  50 Get user data according to provider's mapping configuration
  51
  52 =cut
  53
  54 sub get_user {
  55     my ( $self, $params ) = @_;
  56     my $provider_code = $params->{provider};
  57     my $data          = $params->{data};
  58     my $interface     = $params->{interface};
  59     my $config        = $params->{config};
  60
  61     my $provider = Koha::Auth::Identity::Providers->search({ code => $provider_code })->next;
  62
  63     my ( $mapped_data, $patron ) = $self->_get_data_and_patron({ provider => $provider, data => $data, config => $config });
  64
  65     $mapped_data //= {};
  66
  67     my $domain = $self->has_valid_domain_config({ provider => $provider, email => $mapped_data->{email}, interface => $interface});
  68
  69     $patron->set($mapped_data)->store if $patron && $domain->update_on_auth;
  70
  71     $mapped_data->{categorycode} = $domain->default_category_id;
  72     $mapped_data->{branchcode}   = $domain->default_library_id;
  73
  74     return ( $patron, $mapped_data, $domain );
  75 }
  76
  77 =head3 get_valid_domain_config
  78
  79     my $domain = Koha::Auth::Client->get_valid_domain_config(
  80         {   provider  => $provider,
  81             email     => $user_email,
  82             interface => $interface
  83         }
  84     );
  85
  86 Gets the best suited valid domain configuration for the given provider.
  87
  88 =cut
  89
  90 sub get_valid_domain_config {
  91     # FIXME: Should be a hashref param
  92     my ( $self, $params ) = @_;
  93     my $provider   = $params->{provider};
  94     my $user_email = $params->{email};
  95     my $interface  = $params->{interface};
  96
  97     my $domains = $provider->domains;
  98     my $allow   = "allow_$interface";
  99     my @subdomain_matches;
 100     my $perfect_match;
 101     my $response;
 102
 103     while ( my $domain = $domains->next ) {
 104
 105         my $pattern = '@';
 106         my $domain_text = $domain->domain;
 107         unless ( defined $domain_text && $domain_text ne '') {
 108             $response = $domain;
 109             next;
 110         }
 111         my ( $asterisk, $domain_name ) = ( $domain_text =~ /^(\*)?(.+)$/ );
 112         if ( defined $asterisk && $asterisk eq '*' ) {
 113             $pattern .= '.*';
 114         }
 115         $domain_name =~ s/\./\\\./g;
 116         $pattern .= $domain_name . '$';
 117         if ( $user_email =~ /$pattern/ ) {
 118             if ( defined $asterisk && $asterisk eq '*' ) {
 119                 push @subdomain_matches, { domain => $domain, match_length => length $domain_name };
 120             } else {
 121                 $perfect_match = $domain;
 122             }
 123         }
 124     }
 125
 126     if ( !$perfect_match && @subdomain_matches ) {
 127         @subdomain_matches = sort { $b->{match_length} <=> $a->{match_length} } @subdomain_matches
 128           unless scalar @subdomain_matches == 1;
 129         $response = $subdomain_matches[0]->{domain};
 130     } elsif ($perfect_match) {
 131         $response = $perfect_match;
 132     }
 133
 134     return unless $response && $response->$allow;
 135
 136     return $response;
 137 }
 138
 139 =head3 has_valid_domain_config
 140
 141     my $has_valid_domain = Koha::Auth::Client->has_valid_domain_config(
 142         {   provider  => $provider,
 143             email     => $user_email,
 144             interface => $interface
 145         }
 146     );
 147
 148 Checks if provider has a valid domain for user email. If has, returns that domain.
 149
 150 =cut
 151
 152 sub has_valid_domain_config {
 153     # FIXME: Should be a hashref param
 154     my ( $self, $params ) = @_;
 155     my $domain = $self->get_valid_domain_config( $params );
 156
 157     Koha::Exceptions::Auth::NoValidDomain->throw( code => 401 )
 158       unless $domain;
 159
 160     return $domain;
 161 }
 162
 163 =head3 _get_data_and_patron
 164
 165     my $mapping = $auth_client->_get_data_and_patron(
 166         {   provider => $provider,
 167             data     => $data,
 168             config   => $config
 169         }
 170     );
 171
 172 Generic method that maps raw data to patron schema, and returns a patron if it can.
 173
 174 Note: this only returns an empty I<hashref>. Each class should have its
 175 own mapping returned.
 176
 177 =cut
 178
 179 sub _get_data_and_patron {
 180     return {};
 181 }
 182
 183 =head3 _traverse_hash
 184
 185     my $value = $auth_client->_traverse_hash( { base => $base_hash, keys => $key_string } );
 186
 187 Get deep nested value in a hash.
 188
 189 =cut
 190
 191 sub _traverse_hash {
 192     my ($self, $params) = @_;
 193     my $base = $params->{base};
 194     my $keys = $params->{keys};
 195     my ($key, $rest) = ($keys =~ /^([^.]+)(?:\.(.*))?/);
 196     return unless defined $key;
 197     my $value = ref $base eq 'HASH' ? $base->{$key} : $base->[$key];
 198     return $value unless $rest;
 199     return $self->_traverse_hash({ base => $value, keys => $rest });
 200 }
 201
 202 1;