[BACK]Return to userstatus.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / cgi

Diff for /loncom/cgi/userstatus.pl between versions 1.8 and 1.22

version 1.8, 2003/10/30 22:52:25 version 1.22, 2021/03/06 19:09:03
Line 26  $|=1; Line 26  $|=1;
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
   
 use strict;  use strict;
   
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
   use Apache::lonlocal;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   use LONCAPA::loncgi;
   use LONCAPA::lonauthcgi;
 use HTTP::Headers;  use HTTP::Headers;
 use IO::File;  use GDBM_File;
   
   # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
   my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf');
   
   print "Content-type: text/html\n\n";
 my %usercount;  my %usercount;
 my @actl=('Active','Moderately Active','Inactive');  my @actl=('Active','Moderately Active','Inactive');
   
    &main($perlvar);
 print "Content-type: text/html\n\n";  
         
 # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).  
 &main();  
   
 sub analyze_time {  sub analyze_time {
     my ($since)=@_;      my ($since)=@_;
     my $color="#000000";      my $color="#000000";
     my $userclass=$actl[0];      my $userclass=$actl[0];
     if ($since>300) { $color="#222222"; }      if ($since>300) { $color="#222222"; $userclass=$actl[1]; }
     if ($since>600) { $color="#444444"; }      if ($since>600) { $color="#444444"; }
     if ($since>1800) { $color="#666666"; $userclass=$actl[1]; }      if ($since>1800) { $color="#666666"; }
     if ($since>7200) { $color="#888888"; }      if ($since>7200) { $color="#888888"; }
     if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; }      if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; }
     return ($color,$userclass);      return ($color,$userclass);
Line 68  sub add_count { Line 69  sub add_count {
 }  }
   
 sub main {  sub main {
     my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');      my ($perlvar) = @_;
     delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed      delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed
     delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed      delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
   
     my $oneline=($ENV{'QUERY_STRING'} eq 'simple');      if (!&LONCAPA::lonauthcgi::check_ipbased_access('userstatus')) {
     my $justsummary=($ENV{'QUERY_STRING'} eq 'summary');          if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
     unless ($oneline) { print "<html><body bgcolor=#FFFFFF>\n<h1>User Status ".localtime()."</h1>"; }              &Apache::lonlocal::get_language_handle();
               print &LONCAPA::loncgi::missing_cookie_msg();
               return;
           }
   
           if (!&LONCAPA::lonauthcgi::can_view('userstatus')) {
               &Apache::lonlocal::get_language_handle();
               print &LONCAPA::lonauthcgi::unauthorized_msg('userstatus');
               return;
           }
       }
   
       &Apache::lonlocal::get_language_handle();
       my (%gets,$dom,$oneline,$justsummary);
       &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets);
       if (defined($gets{'simple'})) { 
           $oneline = 'simple'; 
       } 
       if (defined($gets{'summary'})) { 
           $justsummary = 'summary'; 
       }
    
       my %lt = &Apache::lonlocal::texthash(
                     usrs                => 'User Status',
                     login               => 'Login time',
                     on                  => 'on',
                     Client              => 'Client',
                     role                => 'Role',
                     notc                => 'Not in a course',
                     ltra                => 'Last Transaction',
                     lacc                => 'Last Access',
                     secs                => 'secs ago',
                     usrc                => 'User Counts',
                     load                => 'Load Average',
                     Overall             => 'Overall',
                     Domain              => 'Domain',
                     Course              => 'Course',
                     Browser             => 'Browser',
                     OS                  => 'OS',
                     Any                 => 'Any',
                     Active              => 'Active',
                     'Moderately Active' => 'Moderately Active',
                     Inactive            => 'Inactive',
               );
       
       unless ($oneline) {
           my $now = time();
           print '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n"."\n".
                 '<head>'."\n".
                 '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'."\n".
                 '<title>LON-CAPA '.$lt{'usrs'}.'</title>'."\n".
                 '</head>'."\n".
                 '<body style="background-color:#FFFFFF">'."\n".
                 "<h1>$lt{'usrs'} ".&Apache::lonlocal::locallocaltime($now).'</h1>';
       }
   
     opendir(DIR,$$perlvar{'lonIDsDir'});      opendir(DIR,$$perlvar{'lonIDsDir'});
     my @allfiles=(sort(readdir(DIR)));      my @allfiles=(sort(readdir(DIR)));
       my %users;
     foreach my $filename (@allfiles) {      foreach my $filename (@allfiles) {
  if ($filename=~/^\./) { next; }   if ($filename=~/^\./) { next; }
    if ($filename=~/^publicuser_/) { next; }
           if ($filename=~/^[a-f0-9]+_(linked|lti_\d+)\.id$/) { next; }
  my ($dev,$ino,$mode,$nlink,   my ($dev,$ino,$mode,$nlink,
     $uid,$gid,$rdev,$size,      $uid,$gid,$rdev,$size,
     $atime,$mtime,$ctime,      $atime,$mtime,$ctime,
Line 87  sub main { Line 146  sub main {
  my $now=time;   my $now=time;
  my $since=$now-$mtime;   my $since=$now-$mtime;
  my $sinceacc=$now-$atime;   my $sinceacc=$now-$atime;
  unless ($oneline || $justsummary) { print ("\n\n<hr />"); }   #unless ($oneline || $justsummary) { print ("\n\n<hr />"); }
  my %userinfo;   my %userinfo;
  my $fh=IO::File->new($$perlvar{'lonIDsDir'}.'/'.$filename);   ($userinfo{'user.name'},undef,$userinfo{'user.domain'})=
  while (my $line=<$fh>) {      split('_',$filename);
     chomp($line);  
     my ($name,$value)=split(/\=/,$line);  
     $userinfo{$name}=$value;  
  }  
  $fh->close();  
  my ($color,$userclass)=&analyze_time($since);   my ($color,$userclass)=&analyze_time($since);
  &add_count('Overall','all',$userclass);   &add_count('Overall','all',$userclass);
  &add_count('Domain',$userinfo{'user.domain'},$userclass);   &add_count('Domain',$userinfo{'user.domain'},$userclass);
   
  unless ($oneline) {   unless ($oneline) {
       if (!tie(%userinfo,'GDBM_File',
        $$perlvar{'lonIDsDir'}.'/'.$filename,
        &GDBM_READER(),0640)) {
    next;
       }
     if (!$justsummary) {      if (!$justsummary) {
  print '<font color="'.$color.'">';   $users{$userclass}{$filename} .=
  print '<h3>'.$userinfo{'environment.lastname'}.', '.      '<div style="color:'.$color.'">'.
       '<h3>'.$userinfo{'environment.lastname'}.', '.
     $userinfo{'environment.firstname'}.' '.      $userinfo{'environment.firstname'}.' '.
     $userinfo{'environment.middlename'}.' '.      $userinfo{'environment.middlename'}.' '.
     $userinfo{'environment.generation'}." (".      $userinfo{'environment.generation'}." (".
     $userinfo{'user.name'}."\@".$userinfo{'user.domain'}.      $userinfo{'user.name'}.":".$userinfo{'user.domain'}.
     ")</h3>\n<b>Login time:</b> ".      ")</h3>\n".
     localtime($userinfo{'user.login.time'}).      "<p><tt>$filename</tt></p>".
     ' <b>Browser</b>: '.$userinfo{'browser.type'}." <b>Client:</b> ".      "<b>$lt{'login'}:</b> ".
     $userinfo{'request.host'}."<br />\n<b>Role: </b>".      &Apache::lonlocal::locallocaltime($userinfo{'user.login.time'}).
       " <b>$lt{'Browser'}</b>: ".$userinfo{'browser.type'}.
       " $lt{'on'} ".$userinfo{'browser.os'}." <b>$lt{'Client'}:</b>".
       $userinfo{'request.host'}."<br />\n<b>$lt{'role'}: </b>".
     $userinfo{'request.role'}." ";      $userinfo{'request.role'}." ";
     }      }
     &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});      &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'});
       &add_count('OS',$userinfo{'browser.os'},$userinfo{'browser.type'});
     if ($userinfo{'request.course.id'}) {      if ($userinfo{'request.course.id'}) {
  my $cid=$userinfo{'request.course.id'};   my $cid=$userinfo{'request.course.id'};
  my $coursename= $userinfo{'course.'.$cid.'.description'}.   my $coursename= $userinfo{'course.'.$cid.'.description'}.
     ' ('.$cid.')';      ' ('.$cid.')';
  if (!$justsummary) { print "<b>Course:</b> ".$coursename; }   if (!$justsummary) { 
       $users{$userclass}{$filename} .= 
    "<b>$lt{'Course'}:</b> ".$coursename; 
    }
  &add_count('Course',$coursename,$userclass);   &add_count('Course',$coursename,$userclass);
     } else {      } else {
  if (!$justsummary) { print "Not in a course."; }   if (!$justsummary) {
       $users{$userclass}{$filename} .= $lt{'notc'}; 
    }
  &add_count('Course','No Course',$userclass);   &add_count('Course','No Course',$userclass);
     }      }
     if (!$justsummary) {      if (!$justsummary) {
  print "<br /><b>Last Transaction:</b> ".localtime($mtime).   $users{$userclass}{$filename} .=
     " (".$since." secs ago) <br /><b>Last Access:</b> ".      "<br /><b>$lt{'ltra'}:</b> ".&Apache::lonlocal::locallocaltime($mtime).
     localtime($atime)." (".$sinceacc." secs ago)";      " (".$since." $lt{'secs'}) <br /><b>$lt{'lacc'}:</b> ".
  print ("</font>");       &Apache::lonlocal::locallocaltime($atime)." (".$sinceacc." $lt{'secs'})".
       "</div>";
     }      }
  }   }
    untie(%userinfo);
     }      }
       if (!$oneline && !$justsummary) {
           foreach my $class (@actl) {
       print("\n\n<hr /><h1>$lt{$class}</h1>");    
       foreach my $filename (sort(keys(%{$users{$class}}))) {
    print("\n\n".$users{$class}{$filename}."\n\n<hr />");    
       }
    }
       }
   
     closedir(DIR);      closedir(DIR);
     open (LOADAVGH,"/proc/loadavg");      open (LOADAVGH,"/proc/loadavg");
     my $loadavg=<LOADAVGH>;      my $loadavg=<LOADAVGH>;
     close(LOADAVGH);      close(LOADAVGH);
     unless ($oneline) {       unless ($oneline) { 
  print "<hr /><h2>User Counts</h2>";   print "<hr /><h2>$lt{'usrc'}</h2>";
 # print "<pre>\n";  # print "<pre>\n";
  &showact('Overall',%usercount);   &showact('Overall',\%lt,%usercount);
  &showact('Domain',%usercount);   &showact('Domain',\%lt,%usercount);
  &showact('Course',%usercount);   &showact('Course',\%lt,%usercount);
  &show('Browser',%usercount);   &show('Browser',\%lt,%usercount);
    &show('OS',\%lt,%usercount);
   
 # print "\n</pre>";  # print "\n</pre>";
  print "<b>Load Average:<b> ".$loadavg;   print "<b>$lt{'load'}:</b> ".$loadavg;
  print "</body></html>";   print "</body></html>";
     } else {      } else {
  foreach my $l1 (sort keys %usercount) {   foreach my $l1 (sort keys %usercount) {
Line 165  sub main { Line 246  sub main {
 }  }
   
 sub show {  sub show {
     my ($cat,%usercount)=@_;      my ($cat,$ltref,%usercount)=@_;
     print("<h3>$cat</h3>\n");      print("<h3>$ltref->{$cat}</h3>\n");
     foreach my $type (sort(keys(%{$usercount{$cat}}))) {      foreach my $type (sort(keys(%{$usercount{$cat}}))) {
  print("<table border='1'><tr><th>$type</th><th>");   print("<table border='1'><tr><th>$type</th><th>");
  print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}}))));   print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}}))));
Line 183  sub show { Line 264  sub show {
 }  }
   
 sub showact {  sub showact {
     my ($cat,%usercount)=@_;      my ($cat,$ltref,%usercount)=@_;
     print("<h3>$cat</h3>\n");      print("<h3>$ltref->{$cat}</h3>\n");
           
     print("<table border='1'><tr><th></th><th>");      print("<table border='1'><tr><th>&nbsp;</th><th>");
     print(join("</th><th>",('Any',@actl)));      print(join("</th><th>",(map {$ltref->{$_}; {'Any',@actl)));
     print("</th></tr>");      print("</th></tr>");
     foreach my $type (sort(keys(%{$usercount{$cat}}))) {      foreach my $type (sort(keys(%{$usercount{$cat}}))) {
  print("<tr><td>$type</td>");   print("<tr><td>$type</td>");
Line 199  sub showact { Line 280  sub showact {
  }   }
  print("<td>$count</td>");   print("<td>$count</td>");
  print($temp);   print($temp);
    print('</tr>');
     }          }    
     print("</tr></table>\n");      print("</table>\n");
 }  }
   
Removed from v.1.8  
changed lines
  Added in v.1.22

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>