| Filename | /usr/share/koha/lib/C4/Auth_with_cas.pm |
| Statements | Executed 41 statements in 2.56ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 3.36ms | 8.59ms | C4::Auth_with_cas::BEGIN@26 |
| 1 | 1 | 1 | 1.12ms | 1.75ms | C4::Auth_with_cas::BEGIN@28 |
| 1 | 1 | 1 | 602µs | 1.04ms | C4::Auth_with_cas::BEGIN@25 |
| 1 | 1 | 1 | 31µs | 88µs | C4::Auth_with_cas::BEGIN@27 |
| 1 | 1 | 1 | 25µs | 33µs | C4::Auth_with_cas::BEGIN@20 |
| 1 | 1 | 1 | 23µs | 23µs | C4::Auth_with_cas::BEGIN@33 |
| 1 | 1 | 1 | 17µs | 119µs | C4::Auth_with_cas::BEGIN@31 |
| 1 | 1 | 1 | 16µs | 16µs | C4::Auth_with_cas::CORE:ftis (opcode) |
| 1 | 1 | 1 | 15µs | 39µs | C4::Auth_with_cas::BEGIN@21 |
| 1 | 1 | 1 | 14µs | 18µs | C4::Auth_with_cas::BEGIN@24 |
| 1 | 1 | 1 | 14µs | 173µs | C4::Auth_with_cas::BEGIN@23 |
| 1 | 1 | 1 | 13µs | 29µs | C4::Auth_with_cas::multipleAuth |
| 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 | 36µs | 2 | 40µs | # spent 33µs (25+8) within C4::Auth_with_cas::BEGIN@20 which was called:
# once (25µs+8µs) by C4::Auth::BEGIN@39 at line 20 # spent 33µs making 1 call to C4::Auth_with_cas::BEGIN@20
# spent 8µs making 1 call to strict::import |
| 21 | 3 | 36µs | 2 | 63µs | # spent 39µs (15+24) within C4::Auth_with_cas::BEGIN@21 which was called:
# once (15µs+24µs) by C4::Auth::BEGIN@39 at line 21 # spent 39µs making 1 call to C4::Auth_with_cas::BEGIN@21
# spent 24µs making 1 call to warnings::import |
| 22 | |||||
| 23 | 3 | 41µs | 2 | 333µs | # spent 173µs (14+160) within C4::Auth_with_cas::BEGIN@23 which was called:
# once (14µs+160µs) by C4::Auth::BEGIN@39 at line 23 # spent 173µs making 1 call to C4::Auth_with_cas::BEGIN@23
# spent 160µs making 1 call to Exporter::import |
| 24 | 3 | 34µs | 2 | 22µs | # spent 18µs (14+4) within C4::Auth_with_cas::BEGIN@24 which was called:
# once (14µs+4µs) by C4::Auth::BEGIN@39 at line 24 # spent 18µs making 1 call to C4::Auth_with_cas::BEGIN@24
# spent 4µs making 1 call to C4::Context::import |
| 25 | 3 | 182µs | 2 | 1.21ms | # spent 1.04ms (602µs+442µs) within C4::Auth_with_cas::BEGIN@25 which was called:
# once (602µs+442µs) by C4::Auth::BEGIN@39 at line 25 # spent 1.04ms making 1 call to C4::Auth_with_cas::BEGIN@25
# spent 169µs making 1 call to Exporter::import |
| 26 | 3 | 166µs | 1 | 8.59ms | # spent 8.59ms (3.36+5.23) within C4::Auth_with_cas::BEGIN@26 which was called:
# once (3.36ms+5.23ms) by C4::Auth::BEGIN@39 at line 26 # spent 8.59ms making 1 call to C4::Auth_with_cas::BEGIN@26 |
| 27 | 3 | 55µs | 2 | 145µs | # spent 88µs (31+57) within C4::Auth_with_cas::BEGIN@27 which was called:
# once (31µs+57µs) by C4::Auth::BEGIN@39 at line 27 # spent 88µs making 1 call to C4::Auth_with_cas::BEGIN@27
# spent 57µs making 1 call to CGI::import |
| 28 | 3 | 216µs | 2 | 1.78ms | # spent 1.75ms (1.12+637µs) within C4::Auth_with_cas::BEGIN@28 which was called:
# once (1.12ms+637µs) by C4::Auth::BEGIN@39 at line 28 # spent 1.75ms making 1 call to C4::Auth_with_cas::BEGIN@28
# spent 25µs making 1 call to Exporter::import |
| 29 | |||||
| 30 | |||||
| 31 | 3 | 74µs | 2 | 220µs | # spent 119µs (17+101) within C4::Auth_with_cas::BEGIN@31 which was called:
# once (17µs+101µs) by C4::Auth::BEGIN@39 at line 31 # spent 119µs making 1 call to C4::Auth_with_cas::BEGIN@31
# spent 102µs making 1 call to vars::import |
| 32 | |||||
| 33 | # spent 23µs within C4::Auth_with_cas::BEGIN@33 which was called:
# once (23µs+0s) by C4::Auth::BEGIN@39 at line 39 | ||||
| 34 | 1 | 500ns | require Exporter; | ||
| 35 | 1 | 1µs | $VERSION = 3.07.00.049; # set the version for version checking | ||
| 36 | 1 | 1µs | $debug = $ENV{DEBUG}; | ||
| 37 | 1 | 11µs | @ISA = qw(Exporter); | ||
| 38 | 1 | 12µs | @EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url); | ||
| 39 | 1 | 1.63ms | 1 | 23µs | } # spent 23µs making 1 call to C4::Auth_with_cas::BEGIN@33 |
| 40 | 1 | 13µs | 1 | 43.3ms | my $context = C4::Context->new() or die 'C4::Context->new failed'; # spent 43.3ms making 1 call to C4::Context::new |
| 41 | 1 | 500ns | my $defaultcasserver; | ||
| 42 | 1 | 300ns | my $casservers; | ||
| 43 | 1 | 1µs | my $yamlauthfile = "../C4/Auth_cas_servers.yaml"; | ||
| 44 | |||||
| 45 | |||||
| 46 | # If there's a configuration for multiple cas servers, then we get it | ||||
| 47 | 1 | 5µs | 1 | 29µs | if (multipleAuth()) { # spent 29µ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 | 1 | 900ns | $defaultcasserver = 'default'; | ||
| 53 | 1 | 9µs | 1 | 2.05ms | $casservers = { 'default' => C4::Context->preference('casServerUrl') }; # spent 2.05ms making 1 call to C4::Context::preference |
| 54 | } | ||||
| 55 | |||||
| 56 | # Is there a configuration file for multiple cas servers? | ||||
| 57 | # spent 29µs (13+16) within C4::Auth_with_cas::multipleAuth which was called:
# once (13µs+16µs) by C4::Auth::BEGIN@39 at line 47 | ||||
| 58 | 1 | 30µs | 1 | 16µs | return (-e qq($FindBin::Bin/$yamlauthfile)); # spent 16µ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 | 8µs | 1; | ||
| 209 | __END__ | ||||
# spent 16µs within C4::Auth_with_cas::CORE:ftis which was called:
# once (16µs+0s) by C4::Auth_with_cas::multipleAuth at line 58 |