| 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__ |