view release on metacpan or  search on metacpan

Citrix/SessionSet.pm  view on Meta::CPAN

our $ctxcols = "iSupd"; #  t
# Arributes to use in the session collection (mapping to tab output format
# specifiers above). Notice col format specifiers in $ctxcols and this should match.
my @ctxattr = ('HOST_SID','STATE','USERNAME','APPID','DEVICE',); #'TYPE'
# OLD Unused: Legacy Default Citrix Query Timeout
#our $tout = 5;

# Provide a better alias (to use in API)
*Citrix::SessionSet::usersessions = \&Citrix::SessionSet::mysess;


=head1 METHODS

=head2 my $ss = Citrix::SessionSet->new($farmctx);

Construct a new Citrix session collection.
Indicate Farm context of query by $fc (See L<Citrix::Farm>).
Return empty session set (to be queried later)

=cut

sub new {
   my ($class, $fc) = @_;
   #OLD:my $ss = [];
   if (!%$fc) {print("Session::new() : NO FC");return(undef);}
   my $ss = {'sarr' => [], 'fc' => $fc};
   bless($ss, $class);
   return($ss);
}

=head2 $err = $ss->gethostsess('the-cx-host-67');

Get all sessions for a single host (passed as $host) and load the sessions (adding them) into
session set instance.
Return 1 for errors, 0 on success.

=cut
sub gethostsess {
   my ($ss, $host) = @_;
   my $sarr = $ss->getsessions();
   my $fh;
   my $ap = '';
   my $fc = $ss->farmctx();
   my $mh = $ss->getmh(); # $fc->masterhost();
   my $ds = $fc->domainsuffix(); # OLD: {'ds'}
   my $cnt = scalar(@$sarr);
   my $usehost; # Final Host to use for query
   my $tout = $Citrix::touts->{'host'}; # 10;
   my @times = ();
   my $trace = debug($ss);
   if ($trace && $ENV{'HTTP_HOST'}) {print("<pre>");}
   #if ($host =~ /\./) {die("Expecting bare hostname (got: $host)");}
   if (!$host) {$usehost = $mh;$ap = ' -S';}
   elsif ($ds) {$usehost = "$host.$ds";} 
   my $cmd = "rsh $usehost $Citrix::binpath/ctxquery -f $ctxcols $ap"; # -S
   # Added loading of Net::Ping to circumvent
   eval {require(Net::Ping);};
   if ($@) {} # print("Dont have Net::Ping (risk hanging)");
   else {
      my $p = Net::Ping->new();
      if ($p->ping($usehost)) {if ($trace) {print("$usehost is alive (reachable by PING).\n");}}
      # Reuse $tout as state variable
      else {$tout = 0;}
      $p->close();
      if (!$tout) {$ss->{'msg'} = "$usehost NOT Alive.\n";return(1);}
   }
   if ($trace) {print("Launch Query: $cmd\n");$times[0] = time();}
   eval {
      local $SIG{'ALRM'} = sub {
      	 die("RSH Timeout ($usehost)\n");
      	 die("Host '$usehost' was unable to return session within $tout\n");
      };
      #local $SIG{'CHLD'} = sub {die("Child ($usehost)\n");};
      alarm($tout);
      if ($trace) {print("Opening Pipe ...\n");}
      my $ok = open($fh, "$cmd |");
      if (!$ok) {die("Failed to open the pipe");}
      if ($trace) {print("Opened: '$cmd' (as $< / $>)\n");}
      
   };
   # Enforce reset in a place which is always visited
   alarm(0);
   if ($trace) {$times[1] = time();print("Done Trying (Success, ",($times[1]-$times[0])," s.)\n");}
   
   if ($trace) {print("Reset Timeout ($tout => 0)\n");}
   if ($@) {$ss->{'msg'} = $@;return(2);}
   if ($trace) {print("Parse Query (From: $fh)\n");}
   parse($fh, $sarr, \@ctxattr);
   my $cnt2 = scalar(@$sarr);
   if ($host) {
      my $cd = ($cnt2 - $cnt);
      $ss->{'stat'}->{$host}->{'cnt'} = $cd;
      #if (!$cd) {$ss->{'stat'}->{$host}->{'out'} = "$!";}
   }
   if ($trace && $ENV{'HTTP_HOST'}) {print("</pre>\n");}
   return(0);
}

=head2 $err = $ss->getsession('the-cx-host-67:5234');

Get a session identified by $hostsess string (HOST:SESSID) from session set
(Involves sequential search within session set as sessions are not
indexed in current version).
The composite key of form "HOST:SESSID" is required, because session set may contain
sessions from multiple hosts (With single farm context though).
Return the single identified session (as hash) or undef if no session by SESSID
is found.

=cut

sub getsession {
   my ($ss, $hostsess) = @_;
   my $sarr = $ss->getsessions();
   my (@s) = grep({$_->{'HOST_SID'} eq $hostsess} @$sarr);
   if (@s < 1) {$ss->errstr("No Sessions for $hostsess'' ");return(undef);}
   if (@s > 1) {$ss->errstr("Multiple session for Identified session '$hostsess'");return(undef);}
   #ORG:return((@s == 1) ? $s[0] : undef);
   return($s[0]);
}

=head2 $err = $ss->mysess('joecitrix');