File Coverage

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{
  • $legend
      $r
};
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 .= "
  • $uid
      ";
  • 222             foreach my $ip ( sort keys %{ $byUid->{$uid} } ) {
    223             $res .= "
  • $ip
      ";
  • 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             "
  • {id}\">{id}');\">"
  • 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 .= "
  • $ip
      ";
  • 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 .= "
  • $req
      ";
  • 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             '
  • ' . $_ . ': ' . $session{$_} . '
  • ';
    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 .= "
  • $user
      ";
  • 723             foreach my $session ( sort { $a->{startTime} <=> $b->{startTime} }
    724             @{ $byUser->{$user} } )
    725             {
    726             $res .=
    727             "
  • {id}\">{id}');\">"
  • 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 .= "
  • $ip
      ";
  • 760             foreach my $session ( sort { $a->{startTime} <=> $b->{startTime} }
    761             @{ $byIp->{$ip} } )
    762             {
    763             $res .=
    764             "
  • {id}\">{id}');\">"
  • 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/
    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             "
  • $text\n
    • {url:$ENV{SCRIPT_NAME}?$param}
  • \n";
    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__