blib/lib/Lemonldap/NG/Manager/Sessions.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 4 | 6 | 66.6 |
branch | n/a | ||
condition | n/a | ||
subroutine | 2 | 2 | 100.0 |
pod | n/a | ||
total | 6 | 8 | 75.0 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | ## @file | ||||||
2 | # Session explorer | ||||||
3 | |||||||
4 | ## @class | ||||||
5 | # Session explorer. | ||||||
6 | # Synopsis: | ||||||
7 | # * build a new Lemonldap::NG::Manager::Sessions object | ||||||
8 | # * insert tree() result in HTML | ||||||
9 | # | ||||||
10 | # tree() loads on of the tree methods. | ||||||
11 | # new() manage ajax requests (inserted in HTML tree) | ||||||
12 | package Lemonldap::NG::Manager::Sessions; | ||||||
13 | |||||||
14 | 1 | 1 | 1562 | use strict; | |||
1 | 1 | ||||||
1 | 47 | ||||||
15 | 1 | 1 | 188 | use Lemonldap::NG::Handler::CGI qw(:tsv); | |||
0 | |||||||
0 | |||||||
16 | use Lemonldap::NG::Common::Session; | ||||||
17 | use Lemonldap::NG::Common::Apache::Session; #inherits | ||||||
18 | use Lemonldap::NG::Common::Conf; #link protected conf Configuration | ||||||
19 | use Lemonldap::NG::Common::Conf::Constants; #inherits | ||||||
20 | require Lemonldap::NG::Manager::_i18n; #inherits | ||||||
21 | use utf8; | ||||||
22 | |||||||
23 | #inherits Apache::Session | ||||||
24 | |||||||
25 | #our $whatToTrace; | ||||||
26 | #*whatToTrace = \$Lemonldap::NG::Handler::_CGI::whatToTrace; | ||||||
27 | |||||||
28 | our $VERSION = '1.4.1'; | ||||||
29 | |||||||
30 | our @ISA = qw( | ||||||
31 | Lemonldap::NG::Handler::CGI | ||||||
32 | Lemonldap::NG::Manager::_i18n | ||||||
33 | ); | ||||||
34 | |||||||
35 | ## @cmethod Lemonldap::NG::Manager::Sessions new(hashRef args) | ||||||
36 | # Constructor. | ||||||
37 | # @param $args Arguments for Lemonldap::NG::Handler::CGI::new() | ||||||
38 | # @return New Lemonldap::NG::Manager::Sessions object | ||||||
39 | sub new { | ||||||
40 | my ( $class, $args ) = @_; | ||||||
41 | |||||||
42 | # Output UTF-8 | ||||||
43 | binmode( STDOUT, ':utf8' ); | ||||||
44 | |||||||
45 | # Try to get configuration values from global configuration | ||||||
46 | my $conf = Lemonldap::NG::Common::Conf->new( $args->{configStorage} ) | ||||||
47 | or Lemonldap::NG::Handler::CGI->abort( 'Unable to get configuration', | ||||||
48 | $Lemonldap::NG::Common::Conf::msg ); | ||||||
49 | |||||||
50 | if ( my $globalconf = $conf->getConf() ) { | ||||||
51 | $args->{$_} ||= $globalconf->{$_} | ||||||
52 | foreach (qw/portal hiddenAttributes /); | ||||||
53 | } | ||||||
54 | |||||||
55 | # Configuration from MANAGER section | ||||||
56 | if ( my $localconf = $conf->getLocalConf(MANAGERSECTION) ) { | ||||||
57 | $args->{$_} ||= $localconf->{$_} foreach ( keys %$localconf ); | ||||||
58 | } | ||||||
59 | |||||||
60 | # Configuration from SESSIONSEXPLORER section | ||||||
61 | if ( my $localconfse = $conf->getLocalConf(SESSIONSEXPLORERSECTION) ) { | ||||||
62 | $args->{$_} ||= $localconfse->{$_} foreach ( keys %$localconfse ); | ||||||
63 | } | ||||||
64 | |||||||
65 | my $self = $class->SUPER::new($args) | ||||||
66 | or $class->abort( 'Unable to start ' . __PACKAGE__, | ||||||
67 | 'See Apache logs for more' ); | ||||||
68 | |||||||
69 | # Local args prepends global args | ||||||
70 | $self->{$_} = $args->{$_} foreach ( keys %$args ); | ||||||
71 | |||||||
72 | # Load default skin if no other specified | ||||||
73 | $self->{managerSkin} ||= 'default'; | ||||||
74 | |||||||
75 | # IP field | ||||||
76 | $self->{ipField} = "ipAddr"; | ||||||
77 | |||||||
78 | # Multi values separator | ||||||
79 | $self->{multiValuesSeparator} ||= '; '; | ||||||
80 | |||||||
81 | # Attributes to hide | ||||||
82 | $self->{hiddenAttributes} = "_password" | ||||||
83 | unless defined $self->{hiddenAttributes}; | ||||||
84 | |||||||
85 | # Now we're ready to display sessions. Choose display type: | ||||||
86 | # case AJAX request | ||||||
87 | if ( my ($k) = grep /^(?:uid(?:ByIp)?|session|delete|letter|id|p)$/, | ||||||
88 | $self->param() ) | ||||||
89 | { | ||||||
90 | print $self->header( -type => 'text/html;charset=utf-8' ); | ||||||
91 | $self->lmLog( "Ajax request: $k", 'debug' ); | ||||||
92 | print $self->$k( $self->param($k) ); | ||||||
93 | $self->quit(); | ||||||
94 | } | ||||||
95 | |||||||
96 | # case else : store tree type choosen to use it later in tree() | ||||||
97 | ( $self->{_tree} ) = grep /^(?:full(?:uid|ip)|ipclasses|doubleIp)$/, | ||||||
98 | $self->param(); | ||||||
99 | |||||||
100 | # default display : list by uid | ||||||
101 | $self->{_tree} ||= 'list'; | ||||||
102 | $self->lmLog( "Session display type: $self->{_tree}", 'debug' ); | ||||||
103 | |||||||
104 | return $self; | ||||||
105 | } | ||||||
106 | |||||||
107 | ## @method string tree() | ||||||
108 | # Launch required tree builder. It can be one of : | ||||||
109 | # * doubleIp() | ||||||
110 | # * fullip() | ||||||
111 | # * fulluid() | ||||||
112 | # * ipclasses() | ||||||
113 | # * list() (default) | ||||||
114 | # @return string XML tree | ||||||
115 | sub tree { | ||||||
116 | my $self = shift; | ||||||
117 | |||||||
118 | my $sub = $self->{_tree}; | ||||||
119 | $self->lmLog( "Building chosen tree: $sub", 'debug' ); | ||||||
120 | my ( $r, $legend ) = $self->$sub( $self->param($sub) ); | ||||||
121 | return | ||||||
122 | qq{
|
||||||
123 | } | ||||||
124 | |||||||
125 | ################ | ||||||
126 | # TREE METHODS # | ||||||
127 | ################ | ||||||
128 | |||||||
129 | ## @method protected string list() | ||||||
130 | # Build default tree (by letter) | ||||||
131 | # @return string XML tree | ||||||
132 | sub list { | ||||||
133 | my $self = shift; | ||||||
134 | my ( $byUid, $count, $res ); | ||||||
135 | $count = 0; | ||||||
136 | |||||||
137 | # Parse all sessions to store first letter | ||||||
138 | my $moduleOptions = $tsv->{globalStorageOptions} || {}; | ||||||
139 | $moduleOptions->{backend} = $tsv->{globalStorage}; | ||||||
140 | my $module = "Lemonldap::NG::Common::Apache::Session"; | ||||||
141 | $res = | ||||||
142 | $module->get_key_from_all_sessions( $moduleOptions, | ||||||
143 | [ '_httpSessionType', $tsv->{whatToTrace} ] ); | ||||||
144 | while ( my ( $id, $entry ) = each %$res ) { | ||||||
145 | next if ( $entry->{_httpSessionType} ); | ||||||
146 | next unless $entry->{ $tsv->{whatToTrace} } =~ /^(\w)/; | ||||||
147 | $byUid->{$1}++; | ||||||
148 | $count++; | ||||||
149 | } | ||||||
150 | $res = ''; | ||||||
151 | |||||||
152 | # Build tree sorted by first letter | ||||||
153 | foreach my $letter ( sort keys %$byUid ) { | ||||||
154 | $res .= $self->ajaxNode( | ||||||
155 | |||||||
156 | # ID | ||||||
157 | "li_$letter", | ||||||
158 | |||||||
159 | # Legend | ||||||
160 | "$letter ($byUid->{$letter} " | ||||||
161 | . ( | ||||||
162 | $byUid->{$letter} == 1 | ||||||
163 | ? $self->translate('session') | ||||||
164 | : $self->translate('sessions') | ||||||
165 | ) | ||||||
166 | . ")", | ||||||
167 | |||||||
168 | # Next request | ||||||
169 | "letter=$letter" | ||||||
170 | ); | ||||||
171 | } | ||||||
172 | return ( | ||||||
173 | $res, | ||||||
174 | "$count " | ||||||
175 | . ( | ||||||
176 | $count == 1 | ||||||
177 | ? $self->translate('session') | ||||||
178 | : $self->translate('sessions') | ||||||
179 | ) | ||||||
180 | ); | ||||||
181 | } | ||||||
182 | |||||||
183 | ## @method protected string doubleIp() | ||||||
184 | # Build tree with users connected from more than 1 IP | ||||||
185 | # @return string XML tree | ||||||
186 | sub doubleIp { | ||||||
187 | my $self = shift; | ||||||
188 | my ( $byUid, $byIp, $res, $count ); | ||||||
189 | |||||||
190 | # Parse all sessions | ||||||
191 | my $moduleOptions = $tsv->{globalStorageOptions} || {}; | ||||||
192 | $moduleOptions->{backend} = $tsv->{globalStorage}; | ||||||
193 | my $module = "Lemonldap::NG::Common::Apache::Session"; | ||||||
194 | $res = $module->get_key_from_all_sessions( | ||||||
195 | $moduleOptions, | ||||||
196 | [ | ||||||
197 | '_httpSessionType', $tsv->{whatToTrace}, | ||||||
198 | $self->{ipField}, 'startTime' | ||||||
199 | ] | ||||||
200 | ); | ||||||
201 | while ( my ( $id, $entry ) = each %$res ) { | ||||||
202 | next if ( $entry->{_httpSessionType} ); | ||||||
203 | push @{ $byUid->{ $entry->{ $tsv->{whatToTrace} } } | ||||||
204 | ->{ $entry->{ $self->{ipField} } } }, | ||||||
205 | { id => $id, startTime => $entry->{startTime} }; | ||||||
206 | } | ||||||
207 | $res = ''; | ||||||
208 | |||||||
209 | # Build tree sorted by uid (or other field chosen in whatToTrace parameter) | ||||||
210 | foreach my $uid ( | ||||||
211 | sort { ( keys %{ $byUid->{$b} } ) <=> ( keys %{ $byUid->{$a} } ) } | ||||||
212 | keys %$byUid | ||||||
213 | ) | ||||||
214 | { | ||||||
215 | |||||||
216 | # Parse only uid that are connected from more than 1 IP | ||||||
217 | last if ( ( keys %{ $byUid->{$uid} } ) == 1 ); | ||||||
218 | $count++; | ||||||
219 | |||||||
220 | # Build UID node with IP as sub node | ||||||
221 | $res .= "
|
||||||
222 | foreach my $ip ( sort keys %{ $byUid->{$uid} } ) { | ||||||
223 | $res .= "
|
||||||
224 | |||||||
225 | # For each IP node, store sessions sorted by start time | ||||||
226 | foreach my $session ( sort { $a->{startTime} <=> $b->{startTime} } | ||||||
227 | @{ $byUid->{$uid}->{$ip} } ) | ||||||
228 | { | ||||||
229 | $res .= | ||||||
230 | " |
||||||
231 | . $self->_stToStr( $session->{startTime} ) | ||||||
232 | . ""; | ||||||
233 | } | ||||||
234 | $res .= ""; | ||||||
235 | } | ||||||
236 | $res .= ""; | ||||||
237 | } | ||||||
238 | |||||||
239 | return ( | ||||||
240 | $res, | ||||||
241 | "$count " | ||||||
242 | . ( | ||||||
243 | $count == 1 | ||||||
244 | ? $self->translate('user') | ||||||
245 | : $self->translate('users') | ||||||
246 | ) | ||||||
247 | ); | ||||||
248 | } | ||||||
249 | |||||||
250 | ## @method protected string fullip(string req) | ||||||
251 | # Build single IP tree | ||||||
252 | # @param $req Optional IP request (127* for example) | ||||||
253 | # @return string XML tree | ||||||
254 | sub fullip { | ||||||
255 | my ( $self, $req ) = splice @_; | ||||||
256 | my ( $byUid, $res ); | ||||||
257 | |||||||
258 | # Parse sessions and store only if IP match regexp | ||||||
259 | my $moduleOptions = $tsv->{globalStorageOptions} || {}; | ||||||
260 | $moduleOptions->{backend} = $tsv->{globalStorage}; | ||||||
261 | my $module = "Lemonldap::NG::Common::Apache::Session"; | ||||||
262 | $res = | ||||||
263 | $module->searchOnExpr( $moduleOptions, $self->{ipField}, $req, | ||||||
264 | $tsv->{whatToTrace}, 'startTime', $self->{ipField}, | ||||||
265 | '_httpSessionType' ); | ||||||
266 | while ( my ( $id, $entry ) = each %$res ) { | ||||||
267 | next if ( $entry->{_httpSessionType} ); | ||||||
268 | push @{ $byUid->{ $entry->{ $self->{ipField} } } | ||||||
269 | ->{ $entry->{ $tsv->{whatToTrace} } } }, | ||||||
270 | { id => $id, startTime => $entry->{startTime} }; | ||||||
271 | } | ||||||
272 | $res = ''; | ||||||
273 | |||||||
274 | # Build tree sorted by IP | ||||||
275 | foreach my $ip ( sort keys %$byUid ) { | ||||||
276 | $res .= "
|
||||||
277 | foreach my $uid ( sort keys %{ $byUid->{$ip} } ) { | ||||||
278 | $res .= $self->ajaxNode( | ||||||
279 | $uid, | ||||||
280 | $uid | ||||||
281 | . ( | ||||||
282 | @{ $byUid->{$ip}->{$uid} } > 1 | ||||||
283 | ? " (" | ||||||
284 | . @{ $byUid->{$ip}->{$uid} } | ||||||
285 | . " sessions)" | ||||||
286 | : '' | ||||||
287 | ), | ||||||
288 | "uid=$uid" | ||||||
289 | ); | ||||||
290 | } | ||||||
291 | $res .= ""; | ||||||
292 | } | ||||||
293 | return $res; | ||||||
294 | } | ||||||
295 | |||||||
296 | ## @method protected string fulluid(string req) | ||||||
297 | # Build single uid tree | ||||||
298 | # @param $req request (examples: foo*, foo.bar) | ||||||
299 | # @return string XML tree | ||||||
300 | sub fulluid { | ||||||
301 | my ( $self, $req ) = splice @_; | ||||||
302 | my ( $byUid, $res ); | ||||||
303 | |||||||
304 | # Parse sessions to find user that match regexp | ||||||
305 | my $moduleOptions = $tsv->{globalStorageOptions} || {}; | ||||||
306 | $moduleOptions->{backend} = $tsv->{globalStorage}; | ||||||
307 | my $module = "Lemonldap::NG::Common::Apache::Session"; | ||||||
308 | $res = $module->searchOnExpr( | ||||||
309 | $moduleOptions, $tsv->{whatToTrace}, | ||||||
310 | $req, $tsv->{whatToTrace}, | ||||||
311 | 'startTime', '_httpSessionType' | ||||||
312 | ); | ||||||
313 | while ( my ( $id, $entry ) = each %$res ) { | ||||||
314 | next if ( $entry->{_httpSessionType} ); | ||||||
315 | push @{ $byUid->{ $entry->{ $tsv->{whatToTrace} } } }, | ||||||
316 | { id => $id, startTime => $entry->{startTime} }; | ||||||
317 | } | ||||||
318 | $res = ''; | ||||||
319 | |||||||
320 | # Build tree sorted by uid | ||||||
321 | $res .= "
|
||||||
322 | foreach my $uid ( sort keys %$byUid ) { | ||||||
323 | $res .= $self->ajaxNode( | ||||||
324 | $uid, | ||||||
325 | $uid | ||||||
326 | . ( | ||||||
327 | @{ $byUid->{$uid} } > 1 | ||||||
328 | ? " (" | ||||||
329 | . @{ $byUid->{$uid} } | ||||||
330 | . " sessions)" | ||||||
331 | : '' | ||||||
332 | ), | ||||||
333 | "uid=$uid" | ||||||
334 | ); | ||||||
335 | } | ||||||
336 | $res .= ""; | ||||||
337 | } | ||||||
338 | |||||||
339 | ## @method protected string ipclasses() | ||||||
340 | # Build IP classes tree (call _ipclasses()) | ||||||
341 | # @return string XML tree | ||||||
342 | sub ipclasses { | ||||||
343 | my $self = shift; | ||||||
344 | return $self->_ipclasses(); | ||||||
345 | } | ||||||
346 | |||||||
347 | ################## | ||||||
348 | # AJAX RESPONSES # | ||||||
349 | ################## | ||||||
350 | |||||||
351 | ## @method protected string delete(string id) | ||||||
352 | # Delete a session | ||||||
353 | # @param id Session identifier | ||||||
354 | # @return string XML tree | ||||||
355 | sub delete { | ||||||
356 | my ( $self, $id ) = splice @_; | ||||||
357 | my ( %h, $res ); | ||||||
358 | |||||||
359 | # Try to read session | ||||||
360 | my $apacheSession = Lemonldap::NG::Common::Session->new( | ||||||
361 | { | ||||||
362 | storageModule => $tsv->{globalStorage}, | ||||||
363 | storageModuleOptions => $tsv->{globalStorageOptions}, | ||||||
364 | cacheModule => $tsv->{localSessionStorage}, | ||||||
365 | cacheModuleOptions => $tsv->{localSessionStorageOptions}, | ||||||
366 | id => $id, | ||||||
367 | kind => "SSO", | ||||||
368 | } | ||||||
369 | ); | ||||||
370 | |||||||
371 | if ( $apacheSession->error ) { | ||||||
372 | $self->lmLog( "Unable to open session $id", 'error' ); | ||||||
373 | $self->lmLog( $apacheSession->error, 'error' ); | ||||||
374 | $res .= '' |
||||||
375 | . $self->translate('error') . ''; | ||||||
376 | $res .= ' | ||||||
377 | $res .= "Apache::Session error"; | ||||||
378 | $res .= ''; | ||||||
379 | return $res; | ||||||
380 | } | ||||||
381 | |||||||
382 | else { | ||||||
383 | |||||||
384 | if ( my $id2 = $apacheSession->data->{_httpSession} ) { | ||||||
385 | my $apacheSession2 = Lemonldap::NG::Common::Session->new( | ||||||
386 | { | ||||||
387 | storageModule => $tsv->{globalStorage}, | ||||||
388 | storageModuleOptions => $tsv->{globalStorageOptions}, | ||||||
389 | cacheModule => $tsv->{localSessionStorage}, | ||||||
390 | cacheModuleOptions => $tsv->{localSessionStorageOptions}, | ||||||
391 | id => $id2, | ||||||
392 | kind => "SSO", | ||||||
393 | } | ||||||
394 | ); | ||||||
395 | |||||||
396 | if ( $apacheSession2->data ) { | ||||||
397 | unless ( $apacheSession2->remove ) { | ||||||
398 | $self->lmLog( "Unable to remove session $id2", 'error' ); | ||||||
399 | $self->lmLog( $apacheSession2->error, 'error' ); | ||||||
400 | } | ||||||
401 | } | ||||||
402 | else { | ||||||
403 | $self->lmLog( "Unable to open session $id2", 'error' ); | ||||||
404 | $self->lmLog( $apacheSession2->error, 'error' ); | ||||||
405 | } | ||||||
406 | } | ||||||
407 | |||||||
408 | if ( $apacheSession->remove ) { | ||||||
409 | $self->lmLog( "Session $id deleted", 'info' ); | ||||||
410 | $res .= '' |
||||||
411 | . $self->translate('sessionDeleted') . ''; | ||||||
412 | } | ||||||
413 | else { | ||||||
414 | $self->lmLog( "Unable to remove session $id", 'error' ); | ||||||
415 | $self->lmLog( $apacheSession->error, 'error' ); | ||||||
416 | $res .= '' |
||||||
417 | . $self->translate('error') . ''; | ||||||
418 | $res .= ' | ||||||
419 | $res .= "Apache::Session error"; | ||||||
420 | $res .= ''; | ||||||
421 | } | ||||||
422 | return $res; | ||||||
423 | } | ||||||
424 | } | ||||||
425 | |||||||
426 | ## @method protected string session() | ||||||
427 | # Build session dump. | ||||||
428 | # @return string XML tree | ||||||
429 | sub session { | ||||||
430 | my ( $self, $id ) = splice @_; | ||||||
431 | my ( %h, $res ); | ||||||
432 | |||||||
433 | # Try to read session | ||||||
434 | my $apacheSession = Lemonldap::NG::Common::Session->new( | ||||||
435 | { | ||||||
436 | storageModule => $tsv->{globalStorage}, | ||||||
437 | storageModuleOptions => $tsv->{globalStorageOptions}, | ||||||
438 | cacheModule => $tsv->{localSessionStorage}, | ||||||
439 | cacheModuleOptions => $tsv->{localSessionStorageOptions}, | ||||||
440 | id => $id, | ||||||
441 | kind => "SSO", | ||||||
442 | } | ||||||
443 | ); | ||||||
444 | |||||||
445 | if ( $apacheSession->error ) { | ||||||
446 | $self->lmLog( "Unable to open session $id", 'error' ); | ||||||
447 | $self->lmLog( $apacheSession->error, 'error' ); | ||||||
448 | $res .= '' |
||||||
449 | . $self->translate('error') . ''; | ||||||
450 | $res .= ' | ||||||
451 | $res .= "Apache::Session error"; | ||||||
452 | $res .= ''; | ||||||
453 | return $res; | ||||||
454 | } | ||||||
455 | |||||||
456 | # Session is available, print content | ||||||
457 | my %session = %{ $apacheSession->data }; | ||||||
458 | |||||||
459 | # General informations | ||||||
460 | |||||||
461 | $res .= ''; |
||||||
462 | $res .= $self->translate('sessionTitle'); | ||||||
463 | $res .= ''; | ||||||
464 | |||||||
465 | $res .= | ||||||
466 | " " |
||||||
467 | . $self->translate('sessionStartedAt') | ||||||
468 | . ": " | ||||||
469 | . $self->_stToStr( $session{startTime} ) . ""; | ||||||
470 | |||||||
471 | # Transform values | ||||||
472 | # -> split multiple values | ||||||
473 | # -> decode UTF8 | ||||||
474 | # -> Manage dates | ||||||
475 | # -> Hide password | ||||||
476 | # -> quote HTML | ||||||
477 | foreach ( keys %session ) { | ||||||
478 | |||||||
479 | # Don't touch references | ||||||
480 | next if ref $session{$_}; | ||||||
481 | |||||||
482 | # Remove empty value | ||||||
483 | delete $session{$_} unless ( length $session{$_} ); | ||||||
484 | |||||||
485 | # Quote HTML | ||||||
486 | my $value = htmlquote( $session{$_} ); | ||||||
487 | |||||||
488 | # Values in sessions are UTF8 | ||||||
489 | utf8::decode($value); | ||||||
490 | |||||||
491 | # Multiple values | ||||||
492 | if ( $value =~ m/$self->{multiValuesSeparator}/ ) { | ||||||
493 | my $newvalue = '
|
||||||
494 | $newvalue .= " |
||||||
495 | foreach ( split( $self->{multiValuesSeparator}, $value ) ); | ||||||
496 | $newvalue .= ''; | ||||||
497 | $value = $newvalue; | ||||||
498 | } | ||||||
499 | |||||||
500 | # Hide attributes | ||||||
501 | $value = '****' if ( $self->{hiddenAttributes} =~ /\b$_\b/ ); | ||||||
502 | |||||||
503 | # Manage timestamp | ||||||
504 | if ( $_ =~ /^(_utime|_lastAuthnUTime)$/ ) { | ||||||
505 | $value = "$value (" . localtime($value) . ")"; | ||||||
506 | } | ||||||
507 | |||||||
508 | # Manage dates | ||||||
509 | if ( $_ =~ /^(startTime|updateTime)$/ ) { | ||||||
510 | $value = "$value (" . $self->_stToStr($value) . ")"; | ||||||
511 | } | ||||||
512 | |||||||
513 | # Register value | ||||||
514 | $session{$_} = $value; | ||||||
515 | } | ||||||
516 | |||||||
517 | # Map attributes to categories | ||||||
518 | my $categories = { | ||||||
519 | 'dateTitle' => [qw(_utime startTime updateTime _lastAuthnUTime)], | ||||||
520 | 'connectionTitle' => [qw(ipAddr _timezone _url)], | ||||||
521 | 'authenticationTitle' => | ||||||
522 | [qw(_session_id _user _password authenticationLevel)], | ||||||
523 | 'modulesTitle' => [qw(_auth _userDB _passwordDB _issuerDB _authChoice)], | ||||||
524 | 'saml' => [ | ||||||
525 | qw(_idp _idpConfKey _samlToken _lassoSessionDump _lassoIdentityDump) | ||||||
526 | ], | ||||||
527 | 'groups' => [qw(groups)], | ||||||
528 | 'ldap' => [qw(dn)], | ||||||
529 | 'BrowserID' => [qw(_browserIdAnswer _browserIdAnswerRaw)], | ||||||
530 | }; | ||||||
531 | |||||||
532 | # Display categories | ||||||
533 | foreach my $category ( keys %$categories ) { | ||||||
534 | |||||||
535 | # Test if category is not empty | ||||||
536 | my $empty = 1; | ||||||
537 | foreach ( @{ $categories->{$category} } ) { | ||||||
538 | $empty = 0 if exists $session{$_}; | ||||||
539 | } | ||||||
540 | next if ($empty); | ||||||
541 | |||||||
542 | # Display category | ||||||
543 | $res .= ' | ||||||
544 | $res .= '' |
||||||
545 | . $self->translate($category) . ''; | ||||||
546 | $res .= '
|
||||||
547 | |||||||
548 | foreach my $attribute ( @{ $categories->{$category} } ) { | ||||||
549 | |||||||
550 | # Hide empty attributes | ||||||
551 | next unless exists $session{$attribute}; | ||||||
552 | |||||||
553 | # Display attribute | ||||||
554 | $res .= | ||||||
555 | ' |
||||||
556 | . $self->translate($attribute) | ||||||
557 | . ' ($' | ||||||
558 | . $attribute | ||||||
559 | . '): ' | ||||||
560 | . $session{$attribute} . ''; | ||||||
561 | |||||||
562 | # Delete attribute, to hide it | ||||||
563 | delete $session{$attribute}; | ||||||
564 | } | ||||||
565 | $res .= ''; | ||||||
566 | $res .= ''; | ||||||
567 | } | ||||||
568 | |||||||
569 | # OpenID | ||||||
570 | my $openidempty = 1; | ||||||
571 | foreach ( keys %session ) { | ||||||
572 | $openidempty = 0 if $_ =~ /^_openid/; | ||||||
573 | } | ||||||
574 | unless ($openidempty) { | ||||||
575 | $res .= ' | ||||||
576 | $res .= | ||||||
577 | '' . 'OpenID' . ''; |
||||||
578 | $res .= '
|
||||||
579 | |||||||
580 | foreach ( keys %session ) { | ||||||
581 | next if $_ !~ /^_openid/; | ||||||
582 | $res .= | ||||||
583 | ' |
||||||
584 | |||||||
585 | # Delete attribute, to hide it | ||||||
586 | delete $session{$_}; | ||||||
587 | } | ||||||
588 | |||||||
589 | $res .= ''; | ||||||
590 | $res .= ''; | ||||||
591 | } | ||||||
592 | |||||||
593 | # Notifications | ||||||
594 | my $notifempty = 1; | ||||||
595 | foreach ( keys %session ) { | ||||||
596 | $notifempty = 0 if $_ =~ /^notification_/; | ||||||
597 | } | ||||||
598 | unless ($notifempty) { | ||||||
599 | $res .= ' | ||||||
600 | $res .= '' |
||||||
601 | . ucfirst $self->translate('notificationsDone') . ''; | ||||||
602 | $res .= '
|
||||||
603 | |||||||
604 | foreach ( keys %session ) { | ||||||
605 | next if $_ !~ /^notification_(.+)/; | ||||||
606 | $res .= | ||||||
607 | ' |
||||||
608 | . $1 | ||||||
609 | . ': ' | ||||||
610 | . $session{$_} . " (" | ||||||
611 | . localtime( $session{$_} ) . ")"; | ||||||
612 | |||||||
613 | # Delete attribute, to hide it | ||||||
614 | delete $session{$_}; | ||||||
615 | } | ||||||
616 | |||||||
617 | $res .= ''; | ||||||
618 | $res .= ''; | ||||||
619 | } | ||||||
620 | |||||||
621 | # Login history | ||||||
622 | if ( defined $session{loginHistory} ) { | ||||||
623 | $res .= ' | ||||||
624 | $res .= '' |
||||||
625 | . ucfirst $self->translate('loginHistory') . ''; | ||||||
626 | $res .= '
|
||||||
627 | |||||||
628 | # Get all login records | ||||||
629 | my $loginRecords = {}; | ||||||
630 | |||||||
631 | if ( defined $session{loginHistory}->{successLogin} ) { | ||||||
632 | foreach ( @{ $session{loginHistory}->{successLogin} } ) { | ||||||
633 | $loginRecords->{ $_->{_utime} } = | ||||||
634 | "Success (IP " . $_->{ipAddr} . ")"; | ||||||
635 | } | ||||||
636 | } | ||||||
637 | |||||||
638 | if ( defined $session{loginHistory}->{failedLogin} ) { | ||||||
639 | foreach ( @{ $session{loginHistory}->{failedLogin} } ) { | ||||||
640 | $loginRecords->{ $_->{_utime} } = | ||||||
641 | $_->{error} . " (IP " . $_->{ipAddr} . ")"; | ||||||
642 | } | ||||||
643 | } | ||||||
644 | |||||||
645 | # Display records sorted by date | ||||||
646 | foreach my $utime ( sort keys %{$loginRecords} ) { | ||||||
647 | |||||||
648 | $res .= | ||||||
649 | " |
||||||
650 | . localtime($utime) | ||||||
651 | . ": " | ||||||
652 | . $loginRecords->{$utime} . ""; | ||||||
653 | } | ||||||
654 | |||||||
655 | delete $session{loginHistory}; | ||||||
656 | $res .= ''; | ||||||
657 | $res .= ''; | ||||||
658 | } | ||||||
659 | |||||||
660 | # Other attributes | ||||||
661 | $res .= ' | ||||||
662 | $res .= '' |
||||||
663 | . $self->translate('attributesAndMacros') . ''; | ||||||
664 | $res .= '
|
||||||
665 | |||||||
666 | foreach my $attribute ( | ||||||
667 | sort { | ||||||
668 | return $a cmp $b | ||||||
669 | if ( ( $a =~ /^_/ and $b =~ /^_/ ) | ||||||
670 | or ( $a !~ /^_/ and $b !~ /^_/ ) ); | ||||||
671 | return $b cmp $a | ||||||
672 | } keys %session | ||||||
673 | ) | ||||||
674 | { | ||||||
675 | |||||||
676 | # Display attribute | ||||||
677 | $res .= | ||||||
678 | ' |
||||||
679 | . $attribute | ||||||
680 | . ': ' | ||||||
681 | . $session{$attribute} . ''; | ||||||
682 | } | ||||||
683 | |||||||
684 | $res .= ''; | ||||||
685 | $res .= ''; | ||||||
686 | |||||||
687 | # Delete button | ||||||
688 | $res .= ' '; |
||||||
689 | $res .= | ||||||
690 | " | ||||||
691 | . ' class="ui-state-default ui-corner-all"' | ||||||
692 | . " value=\"" | ||||||
693 | . $self->translate('deleteSession') . "\" />"; | ||||||
694 | $res .= ''; | ||||||
695 | |||||||
696 | return $res; | ||||||
697 | } | ||||||
698 | |||||||
699 | ## @method protected string uidByIp() | ||||||
700 | # Build single IP tree | ||||||
701 | # @return string XML tree | ||||||
702 | sub uidByIp { | ||||||
703 | my ( $self, $ip ) = splice @_; | ||||||
704 | my ( $byUser, $res ); | ||||||
705 | |||||||
706 | my $moduleOptions = $tsv->{globalStorageOptions} || {}; | ||||||
707 | $moduleOptions->{backend} = $tsv->{globalStorage}; | ||||||
708 | my $module = "Lemonldap::NG::Common::Apache::Session"; | ||||||
709 | $res = | ||||||
710 | $module->searchOn( $moduleOptions, $self->{ipField}, $ip, | ||||||
711 | '_httpSessionType', $tsv->{whatToTrace}, $self->{ipField}, | ||||||
712 | 'startTime' ); | ||||||
713 | while ( my ( $id, $entry ) = each(%$res) ) { | ||||||
714 | next if ( $entry->{_httpSessionType} ); | ||||||
715 | if ( $entry->{ $self->{ipField} } eq $ip ) { | ||||||
716 | push @{ $byUser->{ $entry->{ $tsv->{whatToTrace} } } }, | ||||||
717 | { id => $id, startTime => $entry->{startTime} }; | ||||||
718 | } | ||||||
719 | } | ||||||
720 | $res = ''; | ||||||
721 | foreach my $user ( sort keys %$byUser ) { | ||||||
722 | $res .= "
|
||||||
723 | foreach my $session ( sort { $a->{startTime} <=> $b->{startTime} } | ||||||
724 | @{ $byUser->{$user} } ) | ||||||
725 | { | ||||||
726 | $res .= | ||||||
727 | " |
||||||
728 | . $self->_stToStr( $session->{startTime} ) | ||||||
729 | . ""; | ||||||
730 | } | ||||||
731 | $res .= ""; | ||||||
732 | } | ||||||
733 | return $res; | ||||||
734 | } | ||||||
735 | |||||||
736 | ## @method protected string uid() | ||||||
737 | # Build single UID tree part | ||||||
738 | # @return string XML tree | ||||||
739 | sub uid { | ||||||
740 | my ( $self, $uid ) = splice @_; | ||||||
741 | my ( $byIp, $res ); | ||||||
742 | |||||||
743 | my $moduleOptions = $tsv->{globalStorageOptions} || {}; | ||||||
744 | $moduleOptions->{backend} = $tsv->{globalStorage}; | ||||||
745 | my $module = "Lemonldap::NG::Common::Apache::Session"; | ||||||
746 | $res = | ||||||
747 | $module->searchOn( $moduleOptions, $tsv->{whatToTrace}, $uid, | ||||||
748 | '_httpSessionType', $tsv->{whatToTrace}, $self->{ipField}, | ||||||
749 | 'startTime' ); | ||||||
750 | while ( my ( $id, $entry ) = each(%$res) ) { | ||||||
751 | next if ( $entry->{_httpSessionType} ); | ||||||
752 | if ( $entry->{ $tsv->{whatToTrace} } eq $uid ) { | ||||||
753 | push @{ $byIp->{ $entry->{ $self->{ipField} } } }, | ||||||
754 | { id => $id, startTime => $entry->{startTime} }; | ||||||
755 | } | ||||||
756 | } | ||||||
757 | $res = ''; | ||||||
758 | foreach my $ip ( sort keys %$byIp ) { | ||||||
759 | $res .= "
|
||||||
760 | foreach my $session ( sort { $a->{startTime} <=> $b->{startTime} } | ||||||
761 | @{ $byIp->{$ip} } ) | ||||||
762 | { | ||||||
763 | $res .= | ||||||
764 | " |
||||||
765 | . $self->_stToStr( $session->{startTime} ) | ||||||
766 | . ""; | ||||||
767 | } | ||||||
768 | $res .= ""; | ||||||
769 | } | ||||||
770 | return $res; | ||||||
771 | } | ||||||
772 | |||||||
773 | # Ajax request to list users starting by a letter | ||||||
774 | ## @method protected string letter() | ||||||
775 | # Build letter XML part | ||||||
776 | # @return string XML tree | ||||||
777 | sub letter { | ||||||
778 | my $self = shift; | ||||||
779 | my $letter = $self->param('letter'); | ||||||
780 | my ( $byUid, $res ); | ||||||
781 | |||||||
782 | my $moduleOptions = $tsv->{globalStorageOptions} || {}; | ||||||
783 | $moduleOptions->{backend} = $tsv->{globalStorage}; | ||||||
784 | my $module = "Lemonldap::NG::Common::Apache::Session"; | ||||||
785 | $res = $module->searchOnExpr( | ||||||
786 | $moduleOptions, $tsv->{whatToTrace}, | ||||||
787 | "${letter}*", '_httpSessionType', | ||||||
788 | $tsv->{whatToTrace} | ||||||
789 | ); | ||||||
790 | while ( my ( $id, $entry ) = each %$res ) { | ||||||
791 | next if ( $entry->{_httpSessionType} ); | ||||||
792 | $byUid->{ $entry->{ $tsv->{whatToTrace} } }++; | ||||||
793 | } | ||||||
794 | $res = ''; | ||||||
795 | foreach my $uid ( sort keys %$byUid ) { | ||||||
796 | $res .= $self->ajaxNode( | ||||||
797 | $uid, | ||||||
798 | $uid | ||||||
799 | . ( | ||||||
800 | $byUid->{$uid} > 1 | ||||||
801 | ? " ($byUid->{$uid} " | ||||||
802 | . ( | ||||||
803 | $byUid->{$uid} == 1 | ||||||
804 | ? $self->translate('session') | ||||||
805 | : $self->translate('sessions') | ||||||
806 | ) | ||||||
807 | . ")" | ||||||
808 | : '' | ||||||
809 | ), | ||||||
810 | "uid=$uid" | ||||||
811 | ); | ||||||
812 | } | ||||||
813 | return $res; | ||||||
814 | } | ||||||
815 | |||||||
816 | ## @method protected string p() | ||||||
817 | # Build IP classes sub tree (call _ipclasses()) | ||||||
818 | # @return string XML tree | ||||||
819 | sub p { | ||||||
820 | my $self = shift; | ||||||
821 | my @t = $self->_ipclasses(@_); | ||||||
822 | return $t[0]; | ||||||
823 | } | ||||||
824 | |||||||
825 | ## @method private string _ipclasses() | ||||||
826 | # Build IP classes (sub) tree | ||||||
827 | # @return string XML tree | ||||||
828 | sub _ipclasses { | ||||||
829 | my ( $self, $p ) = splice @_; | ||||||
830 | my $partial = $p ? "$p." : ''; | ||||||
831 | my $repartial = quotemeta($partial); | ||||||
832 | my ( $byIp, $count, $res ); | ||||||
833 | |||||||
834 | my $moduleOptions = $tsv->{globalStorageOptions} || {}; | ||||||
835 | $moduleOptions->{backend} = $tsv->{globalStorage}; | ||||||
836 | my $module = "Lemonldap::NG::Common::Apache::Session"; | ||||||
837 | $res = $module->searchOnExpr( | ||||||
838 | $moduleOptions, $self->{ipField}, | ||||||
839 | "${partial}*", '_httpSessionType', | ||||||
840 | $self->{ipField} | ||||||
841 | ); | ||||||
842 | |||||||
843 | while ( my ( $id, $entry ) = each %$res ) { | ||||||
844 | next if ( $entry->{_httpSessionType} ); | ||||||
845 | $entry->{ $self->{ipField} } =~ /^$repartial(\d+)/ or next; | ||||||
846 | $byIp->{$1}++; | ||||||
847 | $count++; | ||||||
848 | } | ||||||
849 | $res = ''; | ||||||
850 | foreach my $ip ( sort { $a <=> $b } keys %$byIp ) { | ||||||
851 | $res .= $self->ajaxNode( | ||||||
852 | "$partial$ip", | ||||||
853 | "$partial$ip ($byIp->{$ip} " | ||||||
854 | . ( | ||||||
855 | $byIp->{$ip} == 1 ? $self->translate('session') | ||||||
856 | : $self->translate('sessions') | ||||||
857 | ) | ||||||
858 | . ")", | ||||||
859 | ( | ||||||
860 | $partial !~ /^\d+\.\d+\.\d+/ ? "ipclasses=1&p=$partial$ip" | ||||||
861 | : "uidByIp=$partial$ip" | ||||||
862 | ) | ||||||
863 | ); | ||||||
864 | } | ||||||
865 | return ( | ||||||
866 | $res, | ||||||
867 | "$count " | ||||||
868 | . ( | ||||||
869 | $count == 1 | ||||||
870 | ? $self->translate('session') | ||||||
871 | : $self->translate('sessions') | ||||||
872 | ) | ||||||
873 | ); | ||||||
874 | |||||||
875 | #return $res; | ||||||
876 | } | ||||||
877 | |||||||
878 | ## @fn protected string htmlquote(string s) | ||||||
879 | # Change <, > and & to HTML encoded values in the string | ||||||
880 | # @param $s HTML string | ||||||
881 | # @return HTML string | ||||||
882 | sub htmlquote { | ||||||
883 | my $s = shift; | ||||||
884 | $s =~ s/&/&/g; | ||||||
885 | $s =~ s/</g; | ||||||
886 | $s =~ s/>/>/g; | ||||||
887 | return $s; | ||||||
888 | } | ||||||
889 | |||||||
890 | ## @method private void ajaxnode(string id, string text, string param) | ||||||
891 | # Display tree node with Ajax functions inside for opening the node. | ||||||
892 | # @param $id HTML id of the element. | ||||||
893 | # @param $text text to display | ||||||
894 | # @param $param Parameters for the Ajax query | ||||||
895 | sub ajaxNode { | ||||||
896 | my ( $self, $id, $text, $param ) = @_; | ||||||
897 | return | ||||||
898 | "
|
||||||
899 | } | ||||||
900 | |||||||
901 | ## @method private string _stToStr(string) | ||||||
902 | # Transform a utime string into readeable string (ex: "2010-08-18 13:03:13") | ||||||
903 | # @return Formated string | ||||||
904 | sub _stToStr { | ||||||
905 | shift; | ||||||
906 | return | ||||||
907 | sprintf( '%d-%02d-%02d %d:%02d:%02d', unpack( 'a4a2a2a2a2a2', shift ) ); | ||||||
908 | } | ||||||
909 | |||||||
910 | 1; | ||||||
911 | __END__ |