1package App::Netdisco::Web::Auth::Provider::DBIC;
2
3use strict;
4use warnings;
5
6use base 'Dancer::Plugin::Auth::Extensible::Provider::Base';
7
8# with thanks to yanick's patch at
9# https://github.com/bigpresh/Dancer-Plugin-Auth-Extensible/pull/24
10
11use Dancer ':syntax';
12use Dancer::Plugin::DBIC;
13use Dancer::Plugin::Passphrase;
14use Digest::MD5;
15use Net::LDAP;
16use Authen::Radius;
17use Authen::TacacsPlus;
18use Try::Tiny;
19
20sub authenticate_user {
21    my ($self, $username, $password) = @_;
22    return unless defined $username;
23
24    my $user = $self->get_user_details($username) or return;
25    return unless $user->in_storage;
26    return $self->match_password($password, $user);
27}
28
29sub get_user_details {
30    my ($self, $username) = @_;
31
32    my $settings = $self->realm_settings;
33    my $database = schema($settings->{schema_name})
34        or die "No database connection";
35
36    my $users_table     = $settings->{users_resultset}       || 'User';
37    my $username_column = $settings->{users_username_column} || 'username';
38
39    my $user = try {
40      $database->resultset($users_table)->find({
41          $username_column => { -ilike => quotemeta($username) },
42      });
43    };
44
45    # each of these settings permits no user in the database
46    # so create a pseudo user entry instead
47    if (not $user and not setting('validate_remote_user')
48                  and (setting('trust_remote_user')
49                    or setting('trust_x_remote_user')
50                    or setting('no_auth'))) {
51        $user = $database->resultset($users_table)
52          ->new_result({username => $username});
53    }
54
55    return $user;
56}
57
58sub validate_api_token {
59    my ($self, $token) = @_;
60    return unless defined $token;
61
62    my $settings = $self->realm_settings;
63    my $database = schema($settings->{schema_name})
64        or die "No database connection";
65
66    my $users_table  = $settings->{users_resultset}    || 'User';
67    my $token_column = $settings->{users_token_column} || 'token';
68
69    $token =~ s/^Apikey //i; # should be there but swagger-ui doesn't add it
70    my $user = try {
71      $database->resultset($users_table)->find({ $token_column => $token });
72    };
73
74    return $user->username
75      if $user and $user->in_storage and $user->token_from
76        and $user->token_from > (time - setting('api_token_lifetime'));
77    return undef;
78}
79
80sub get_user_roles {
81    my ($self, $username) = @_;
82    return unless defined $username;
83
84    my $settings = $self->realm_settings;
85    my $database = schema($settings->{schema_name})
86        or die "No database connection";
87
88    # Get details of the user first; both to check they exist, and so we have
89    # their ID to use.
90    my $user = $self->get_user_details($username)
91        or return;
92
93    my $roles       = $settings->{roles_relationship} || 'roles';
94    my $role_column = $settings->{role_column}        || 'role';
95
96    return [ try {
97      $user->$roles->search({}, { bind => [setting('api_token_lifetime')] })
98        ->get_column( $role_column )->all;
99    } ];
100}
101
102sub match_password {
103    my($self, $password, $user) = @_;
104    return unless $user;
105
106    my $settings = $self->realm_settings;
107    my $username_column = $settings->{users_username_column} || 'username';
108
109    my $pwmatch_result = 0;
110    my $username = $user->$username_column;
111
112    if ($user->ldap) {
113      $pwmatch_result = $self->match_with_ldap($password, $username);
114    }
115    elsif ($user->radius) {
116      $pwmatch_result = $self->match_with_radius($password, $username);
117    }
118    elsif ($user->tacacs) {
119      $pwmatch_result = $self->match_with_tacacs($password, $username);
120    }
121    else {
122      $pwmatch_result = $self->match_with_local_pass($password, $user);
123    }
124
125    return $pwmatch_result;
126}
127
128sub match_with_local_pass {
129    my($self, $password, $user) = @_;
130
131    my $settings = $self->realm_settings;
132    my $password_column = $settings->{users_password_column} || 'password';
133
134    return unless $password and $user->$password_column;
135
136    if ($user->$password_column !~ m/^{[A-Z]+}/) {
137        my $sum = Digest::MD5::md5_hex($password);
138
139        if ($sum eq $user->$password_column) {
140            if (setting('safe_password_store')) {
141                # upgrade password if successful, and permitted
142                $user->update({password => passphrase($password)->generate});
143            }
144            return 1;
145        }
146        else {
147            return 0;
148        }
149    }
150    else {
151        return passphrase($password)->matches($user->$password_column);
152    }
153}
154
155sub match_with_ldap {
156    my($self, $pass, $user) = @_;
157
158    return unless setting('ldap') and ref {} eq ref setting('ldap');
159    my $conf = setting('ldap');
160
161    my $ldapuser = $conf->{user_string};
162    $ldapuser =~ s/\%USER\%?/$user/egi;
163
164    # If we can bind as anonymous or proxy user,
165    # search for user's distinguished name
166    if ($conf->{proxy_user}) {
167        my $user   = $conf->{proxy_user};
168        my $pass   = $conf->{proxy_pass};
169        my $attrs  = ['distinguishedName'];
170        my $result = _ldap_search($ldapuser, $attrs, $user, $pass);
171        $ldapuser  = $result->[0] if ($result->[0]);
172    }
173    # otherwise, if we can't search and aren't using AD and then construct DN
174    # by appending base
175    elsif ($ldapuser =~ m/=/) {
176        $ldapuser = "$ldapuser,$conf->{base}";
177    }
178
179    foreach my $server (@{$conf->{servers}}) {
180        my $opts = $conf->{opts} || {};
181        my $ldap = Net::LDAP->new($server, %$opts) or next;
182        my $msg  = undef;
183
184        if ($conf->{tls_opts} ) {
185            $msg = $ldap->start_tls(%{$conf->{tls_opts}});
186        }
187
188        $msg = $ldap->bind($ldapuser, password => $pass);
189        $ldap->unbind(); # take down session
190
191        return 1 unless $msg->code();
192    }
193
194    return undef;
195}
196
197sub _ldap_search {
198    my ($filter, $attrs, $user, $pass) = @_;
199    my $conf = setting('ldap');
200
201    return undef unless defined($filter);
202    return undef if (defined $attrs and ref [] ne ref $attrs);
203
204    foreach my $server (@{$conf->{servers}}) {
205        my $opts = $conf->{opts} || {};
206        my $ldap = Net::LDAP->new($server, %$opts) or next;
207        my $msg  = undef;
208
209        if ($conf->{tls_opts}) {
210            $msg = $ldap->start_tls(%{$conf->{tls_opts}});
211        }
212
213        if ( $user and $user ne 'anonymous' ) {
214            $msg = $ldap->bind($user, password => $pass);
215        }
216        else {
217            $msg = $ldap->bind();
218        }
219
220        $msg = $ldap->search(
221          base   => $conf->{base},
222          filter => "($filter)",
223          attrs  => $attrs,
224        );
225
226        $ldap->unbind(); # take down session
227
228        my $entries = [$msg->entries];
229        return $entries unless $msg->code();
230    }
231
232    return undef;
233}
234
235sub match_with_radius {
236  my($self, $pass, $user) = @_;
237  return unless setting('radius') and ref [] eq ref setting('radius');
238
239  my $conf = setting('radius');
240  my $radius = Authen::Radius->new(@$conf);
241  # my $dict_dir = Path::Class::Dir->new( dist_dir('App-Netdisco') )
242  #   ->subdir('radius_dictionaries')->stringify;
243  Authen::Radius->load_dictionary(); # put $dict_dir in here once it's useful
244
245  $radius->add_attributes(
246     { Name => 'User-Name',         Value => $user },
247     { Name => 'User-Password',     Value => $pass },
248     { Name => 'h323-return-code',  Value => '0' }, # Cisco AV pair
249     { Name => 'Digest-Attributes', Value => { Method => 'REGISTER' } }
250  );
251  $radius->send_packet(ACCESS_REQUEST);
252
253  my $type = $radius->recv_packet();
254  my $radius_return = ($type eq ACCESS_ACCEPT) ? 1 : 0;
255
256  return $radius_return;
257}
258
259sub match_with_tacacs {
260  my($self, $pass, $user) = @_;
261  return unless setting('tacacs') and ref [] eq ref setting('tacacs');
262
263  my $conf = setting('tacacs');
264  my $tacacs = new Authen::TacacsPlus(@$conf);
265  if (not $tacacs) {
266      debug sprintf('auth error: Authen::TacacsPlus: %s', Authen::TacacsPlus::errmsg());
267      return undef;
268  }
269
270  my $tacacs_return = $tacacs->authen($user,$pass);
271  if (not $tacacs_return) {
272      debug sprintf('error: Authen::TacacsPlus: %s', Authen::TacacsPlus::errmsg());
273  }
274  $tacacs->close();
275
276  return $tacacs_return;
277}
278
2791;
280