| Filename | /usr/share/koha/lib/C4/Auth_with_cas.pm |
| Statements | Executed 41 statements in 1.96ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 2.66ms | 38.4ms | C4::Auth_with_cas::BEGIN@26 |
| 1 | 1 | 1 | 1.01ms | 1.69ms | C4::Auth_with_cas::BEGIN@28 |
| 1 | 1 | 1 | 652µs | 1.09ms | C4::Auth_with_cas::BEGIN@25 |
| 1 | 1 | 1 | 65µs | 73µs | C4::Auth_with_cas::BEGIN@20 |
| 1 | 1 | 1 | 43µs | 78µs | C4::Auth_with_cas::BEGIN@27 |
| 1 | 1 | 1 | 20µs | 58µs | C4::Auth_with_cas::BEGIN@21 |
| 1 | 1 | 1 | 17µs | 17µs | C4::Auth_with_cas::BEGIN@33 |
| 1 | 1 | 1 | 15µs | 19µs | C4::Auth_with_cas::BEGIN@24 |
| 1 | 1 | 1 | 15µs | 174µs | C4::Auth_with_cas::BEGIN@23 |
| 1 | 1 | 1 | 13µs | 166µs | C4::Auth_with_cas::BEGIN@31 |
| 1 | 1 | 1 | 9µs | 16µs | C4::Auth_with_cas::multipleAuth |
| 1 | 1 | 1 | 7µs | 7µs | C4::Auth_with_cas::CORE:ftis (opcode) |
| 0 | 0 | 0 | 0s | 0s | C4::Auth_with_cas::check_api_auth_cas |
| 0 | 0 | 0 | 0s | 0s | C4::Auth_with_cas::checkpw_cas |
| 0 | 0 | 0 | 0s | 0s | C4::Auth_with_cas::getMultipleAuth |
| 0 | 0 | 0 | 0s | 0s | C4::Auth_with_cas::login_cas |
| 0 | 0 | 0 | 0s | 0s | C4::Auth_with_cas::login_cas_url |
| 0 | 0 | 0 | 0s | 0s | C4::Auth_with_cas::logout_cas |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package C4::Auth_with_cas; | ||||
| 2 | |||||
| 3 | # Copyright 2009 BibLibre SARL | ||||
| 4 | # | ||||
| 5 | # This file is part of Koha. | ||||
| 6 | # | ||||
| 7 | # Koha is free software; you can redistribute it and/or modify it under the | ||||
| 8 | # terms of the GNU General Public License as published by the Free Software | ||||
| 9 | # Foundation; either version 2 of the License, or (at your option) any later | ||||
| 10 | # version. | ||||
| 11 | # | ||||
| 12 | # Koha is distributed in the hope that it will be useful, but WITHOUT ANY | ||||
| 13 | # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR | ||||
| 14 | # A PARTICULAR PURPOSE. See the GNU General Public License for more details. | ||||
| 15 | # | ||||
| 16 | # You should have received a copy of the GNU General Public License along | ||||
| 17 | # with Koha; if not, write to the Free Software Foundation, Inc., | ||||
| 18 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | ||||
| 19 | |||||
| 20 | 3 | 46µs | 2 | 80µs | # spent 73µs (65+8) within C4::Auth_with_cas::BEGIN@20 which was called:
# once (65µs+8µs) by C4::Auth::BEGIN@39 at line 20 # spent 73µs making 1 call to C4::Auth_with_cas::BEGIN@20
# spent 8µs making 1 call to strict::import |
| 21 | 3 | 43µs | 2 | 96µs | # spent 58µs (20+38) within C4::Auth_with_cas::BEGIN@21 which was called:
# once (20µs+38µs) by C4::Auth::BEGIN@39 at line 21 # spent 58µs making 1 call to C4::Auth_with_cas::BEGIN@21
# spent 38µs making 1 call to warnings::import |
| 22 | |||||
| 23 | 3 | 53µs | 2 | 332µs | # spent 174µs (15+159) within C4::Auth_with_cas::BEGIN@23 which was called:
# once (15µs+159µs) by C4::Auth::BEGIN@39 at line 23 # spent 174µs making 1 call to C4::Auth_with_cas::BEGIN@23
# spent 159µs making 1 call to Exporter::import |
| 24 | 3 | 35µs | 2 | 22µs | # spent 19µs (15+3) within C4::Auth_with_cas::BEGIN@24 which was called:
# once (15µs+3µs) by C4::Auth::BEGIN@39 at line 24 # spent 19µs making 1 call to C4::Auth_with_cas::BEGIN@24
# spent 3µs making 1 call to C4::Context::import |
| 25 | 3 | 160µs | 2 | 1.32ms | # spent 1.09ms (652µs+437µs) within C4::Auth_with_cas::BEGIN@25 which was called:
# once (652µs+437µs) by C4::Auth::BEGIN@39 at line 25 # spent 1.09ms making 1 call to C4::Auth_with_cas::BEGIN@25
# spent 234µs making 1 call to Exporter::import |
| 26 | 3 | 159µs | 2 | 38.4ms | # spent 38.4ms (2.66+35.7) within C4::Auth_with_cas::BEGIN@26 which was called:
# once (2.66ms+35.7ms) by C4::Auth::BEGIN@39 at line 26 # spent 38.4ms making 1 call to C4::Auth_with_cas::BEGIN@26
# spent 4µs making 1 call to UNIVERSAL::import |
| 27 | 3 | 52µs | 2 | 113µs | # spent 78µs (43+35) within C4::Auth_with_cas::BEGIN@27 which was called:
# once (43µs+35µs) by C4::Auth::BEGIN@39 at line 27 # spent 78µs making 1 call to C4::Auth_with_cas::BEGIN@27
# spent 35µs making 1 call to CGI::import |
| 28 | 3 | 218µs | 2 | 1.71ms | # spent 1.69ms (1.01+679µs) within C4::Auth_with_cas::BEGIN@28 which was called:
# once (1.01ms+679µs) by C4::Auth::BEGIN@39 at line 28 # spent 1.69ms making 1 call to C4::Auth_with_cas::BEGIN@28
# spent 24µs making 1 call to Exporter::import |
| 29 | |||||
| 30 | |||||
| 31 | 3 | 76µs | 2 | 319µs | # spent 166µs (13+153) within C4::Auth_with_cas::BEGIN@31 which was called:
# once (13µs+153µs) by C4::Auth::BEGIN@39 at line 31 # spent 166µs making 1 call to C4::Auth_with_cas::BEGIN@31
# spent 153µs making 1 call to vars::import |
| 32 | |||||
| 33 | # spent 17µs within C4::Auth_with_cas::BEGIN@33 which was called:
# once (17µs+0s) by C4::Auth::BEGIN@39 at line 39 | ||||
| 34 | 5 | 17µs | require Exporter; | ||
| 35 | $VERSION = 3.07.00.049; # set the version for version checking | ||||
| 36 | $debug = $ENV{DEBUG}; | ||||
| 37 | @ISA = qw(Exporter); | ||||
| 38 | @EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url); | ||||
| 39 | 1 | 1.05ms | 1 | 17µs | } # spent 17µs making 1 call to C4::Auth_with_cas::BEGIN@33 |
| 40 | 1 | 8µs | 1 | 686µs | my $context = C4::Context->new() or die 'C4::Context->new failed'; # spent 686µs making 1 call to C4::Context::new |
| 41 | 1 | 200ns | my $defaultcasserver; | ||
| 42 | 1 | 200ns | my $casservers; | ||
| 43 | 1 | 500ns | my $yamlauthfile = "../C4/Auth_cas_servers.yaml"; | ||
| 44 | |||||
| 45 | |||||
| 46 | # If there's a configuration for multiple cas servers, then we get it | ||||
| 47 | 3 | 12µs | 1 | 16µs | if (multipleAuth()) { # spent 16µs making 1 call to C4::Auth_with_cas::multipleAuth |
| 48 | ($defaultcasserver, $casservers) = YAML::LoadFile(qq($FindBin::Bin/$yamlauthfile)); | ||||
| 49 | $defaultcasserver = $defaultcasserver->{'default'}; | ||||
| 50 | } else { | ||||
| 51 | # Else, we fall back to casServerUrl syspref | ||||
| 52 | $defaultcasserver = 'default'; | ||||
| 53 | 1 | 1.95ms | $casservers = { 'default' => C4::Context->preference('casServerUrl') }; # spent 1.95ms making 1 call to C4::Context::preference | ||
| 54 | } | ||||
| 55 | |||||
| 56 | # Is there a configuration file for multiple cas servers? | ||||
| 57 | # spent 16µs (9+7) within C4::Auth_with_cas::multipleAuth which was called:
# once (9µs+7µs) by C4::Auth::BEGIN@39 at line 47 | ||||
| 58 | 1 | 19µs | 1 | 7µs | return (-e qq($FindBin::Bin/$yamlauthfile)); # spent 7µs making 1 call to C4::Auth_with_cas::CORE:ftis |
| 59 | } | ||||
| 60 | |||||
| 61 | # Returns configured CAS servers' list if multiple authentication is enabled | ||||
| 62 | sub getMultipleAuth { | ||||
| 63 | return $casservers; | ||||
| 64 | } | ||||
| 65 | |||||
| 66 | # Logout from CAS | ||||
| 67 | sub logout_cas { | ||||
| 68 | my ($query) = @_; | ||||
| 69 | my $uri = C4::Context->preference('OPACBaseURL') . $query->script_name(); | ||||
| 70 | my $casparam = $query->param('cas'); | ||||
| 71 | # FIXME: This should be more generic and handle whatever parameters there might be | ||||
| 72 | $uri .= "?cas=" . $casparam if (defined $casparam); | ||||
| 73 | $casparam = $defaultcasserver if (not defined $casparam); | ||||
| 74 | my $cas = Authen::CAS::Client->new($casservers->{$casparam}); | ||||
| 75 | print $query->redirect( $cas->logout_url($uri)); | ||||
| 76 | } | ||||
| 77 | |||||
| 78 | # Login to CAS | ||||
| 79 | sub login_cas { | ||||
| 80 | my ($query) = @_; | ||||
| 81 | my $uri = C4::Context->preference('OPACBaseURL') . $query->script_name(); | ||||
| 82 | my $casparam = $query->param('cas'); | ||||
| 83 | # FIXME: This should be more generic and handle whatever parameters there might be | ||||
| 84 | $uri .= "?cas=" . $casparam if (defined $casparam); | ||||
| 85 | $casparam = $defaultcasserver if (not defined $casparam); | ||||
| 86 | my $cas = Authen::CAS::Client->new($casservers->{$casparam}); | ||||
| 87 | print $query->redirect( $cas->login_url($uri)); | ||||
| 88 | } | ||||
| 89 | |||||
| 90 | # Returns CAS login URL with callback to the requesting URL | ||||
| 91 | sub login_cas_url { | ||||
| 92 | |||||
| 93 | my ($query, $key) = @_; | ||||
| 94 | my $uri = C4::Context->preference('OPACBaseURL') . $query->url( -absolute => 1, -query => 1 ); | ||||
| 95 | my $casparam = $query->param('cas'); | ||||
| 96 | $casparam = $defaultcasserver if (not defined $casparam); | ||||
| 97 | $casparam = $key if (defined $key); | ||||
| 98 | my $cas = Authen::CAS::Client->new($casservers->{$casparam}); | ||||
| 99 | return $cas->login_url($uri); | ||||
| 100 | } | ||||
| 101 | |||||
| 102 | # Checks for password correctness | ||||
| 103 | # In our case : is there a ticket, is it valid and does it match one of our users ? | ||||
| 104 | sub checkpw_cas { | ||||
| 105 | $debug and warn "checkpw_cas"; | ||||
| 106 | my ($dbh, $ticket, $query) = @_; | ||||
| 107 | my $retnumber; | ||||
| 108 | my $uri = C4::Context->preference('OPACBaseURL') . $query->script_name(); | ||||
| 109 | my $casparam = $query->param('cas'); | ||||
| 110 | # FIXME: This should be more generic and handle whatever parameters there might be | ||||
| 111 | $uri .= "?cas=" . $casparam if (defined $casparam); | ||||
| 112 | $casparam = $defaultcasserver if (not defined $casparam); | ||||
| 113 | my $cas = Authen::CAS::Client->new($casservers->{$casparam}); | ||||
| 114 | |||||
| 115 | # If we got a ticket | ||||
| 116 | if ($ticket) { | ||||
| 117 | $debug and warn "Got ticket : $ticket"; | ||||
| 118 | |||||
| 119 | # We try to validate it | ||||
| 120 | my $val = $cas->service_validate($uri, $ticket ); | ||||
| 121 | |||||
| 122 | # If it's valid | ||||
| 123 | if ( $val->is_success() ) { | ||||
| 124 | |||||
| 125 | my $userid = $val->user(); | ||||
| 126 | $debug and warn "User CAS authenticated as: $userid"; | ||||
| 127 | |||||
| 128 | # Does it match one of our users ? | ||||
| 129 | my $sth = $dbh->prepare("select cardnumber from borrowers where userid=?"); | ||||
| 130 | $sth->execute($userid); | ||||
| 131 | if ( $sth->rows ) { | ||||
| 132 | $retnumber = $sth->fetchrow; | ||||
| 133 | return ( 1, $retnumber, $userid ); | ||||
| 134 | } | ||||
| 135 | $sth = $dbh->prepare("select userid from borrowers where cardnumber=?"); | ||||
| 136 | $sth->execute($userid); | ||||
| 137 | if ( $sth->rows ) { | ||||
| 138 | $retnumber = $sth->fetchrow; | ||||
| 139 | return ( 1, $retnumber, $userid ); | ||||
| 140 | } | ||||
| 141 | |||||
| 142 | # If we reach this point, then the user is a valid CAS user, but not a Koha user | ||||
| 143 | $debug and warn "User $userid is not a valid Koha user"; | ||||
| 144 | |||||
| 145 | } else { | ||||
| 146 | $debug and warn "Problem when validating ticket : $ticket"; | ||||
| 147 | $debug and warn "Authen::CAS::Client::Response::Error: " . $val->error() if $val->is_error(); | ||||
| 148 | $debug and warn "Authen::CAS::Client::Response::Failure: " . $val->message() if $val->is_failure(); | ||||
| 149 | $debug and warn Data::Dumper::Dumper($@) if $val->is_error() or $val->is_failure(); | ||||
| 150 | return 0; | ||||
| 151 | } | ||||
| 152 | } | ||||
| 153 | return 0; | ||||
| 154 | } | ||||
| 155 | |||||
| 156 | # Proxy CAS auth | ||||
| 157 | sub check_api_auth_cas { | ||||
| 158 | $debug and warn "check_api_auth_cas"; | ||||
| 159 | my ($dbh, $PT, $query) = @_; | ||||
| 160 | my $retnumber; | ||||
| 161 | my $url = C4::Context->preference('OPACBaseURL') . $query->script_name(); | ||||
| 162 | |||||
| 163 | my $casparam = $query->param('cas'); | ||||
| 164 | $casparam = $defaultcasserver if (not defined $casparam); | ||||
| 165 | my $cas = Authen::CAS::Client->new($casservers->{$casparam}); | ||||
| 166 | |||||
| 167 | # If we have a Proxy Ticket | ||||
| 168 | if ($PT) { | ||||
| 169 | my $r = $cas->proxy_validate( $url, $PT ); | ||||
| 170 | |||||
| 171 | # If the PT is valid | ||||
| 172 | if ( $r->is_success ) { | ||||
| 173 | |||||
| 174 | # We've got a username ! | ||||
| 175 | $debug and warn "User authenticated as: ", $r->user, "\n"; | ||||
| 176 | $debug and warn "Proxied through:\n"; | ||||
| 177 | $debug and warn " $_\n" for $r->proxies; | ||||
| 178 | |||||
| 179 | my $userid = $r->user; | ||||
| 180 | |||||
| 181 | # Does it match one of our users ? | ||||
| 182 | my $sth = $dbh->prepare("select cardnumber from borrowers where userid=?"); | ||||
| 183 | $sth->execute($userid); | ||||
| 184 | if ( $sth->rows ) { | ||||
| 185 | $retnumber = $sth->fetchrow; | ||||
| 186 | return ( 1, $retnumber, $userid ); | ||||
| 187 | } | ||||
| 188 | $sth = $dbh->prepare("select userid from borrowers where cardnumber=?"); | ||||
| 189 | return $r->user; | ||||
| 190 | $sth->execute($userid); | ||||
| 191 | if ( $sth->rows ) { | ||||
| 192 | $retnumber = $sth->fetchrow; | ||||
| 193 | return ( 1, $retnumber, $userid ); | ||||
| 194 | } | ||||
| 195 | |||||
| 196 | # If we reach this point, then the user is a valid CAS user, but not a Koha user | ||||
| 197 | $debug and warn "User $userid is not a valid Koha user"; | ||||
| 198 | |||||
| 199 | } else { | ||||
| 200 | $debug and warn "Proxy Ticket authentication failed"; | ||||
| 201 | return 0; | ||||
| 202 | } | ||||
| 203 | } | ||||
| 204 | return 0; | ||||
| 205 | } | ||||
| 206 | |||||
| 207 | |||||
| 208 | 1 | 9µs | 1; | ||
| 209 | __END__ | ||||
# spent 7µs within C4::Auth_with_cas::CORE:ftis which was called:
# once (7µs+0s) by C4::Auth_with_cas::multipleAuth at line 58 |