version 1.3, 2003/07/29 20:17:52
|
version 1.19, 2009/01/09 07:06:27
|
Line 1
|
Line 1
|
#!/usr/bin/perl |
#!/usr/bin/perl |
$|=1; |
$|=1; |
# The LearningOnline Network with CAPA |
|
# User Status |
# User Status |
# (Versions |
# $Id$ |
# (Running loncron |
# |
# 09/06/01 Gerd Kortemeyer) |
# Copyright Michigan State University Board of Trustees |
# 02/18/02,02/19/02 Gerd Kortemeyer) |
# |
|
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
|
# |
|
# LON-CAPA is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
|
# |
|
# LON-CAPA is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with LON-CAPA; if not, write to the Free Software |
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
# |
|
# /home/httpd/html/adm/gpl.txt |
|
# |
|
# http://www.lon-capa.org/ |
|
# |
|
|
|
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; |
|
|
|
|
print "Content-type: text/html\n\n"; |
|
|
|
# -------------------- Read loncapa.conf (and by default, loncapa_apache.conf). |
# -------------------- Read loncapa.conf (and by default, loncapa_apache.conf). |
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf'); |
my %perlvar=%{$perlvarref}; |
|
undef $perlvarref; # remove since sensitive and not needed |
print "Content-type: text/html\n\n"; |
delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed |
my %usercount; |
delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed |
my @actl=('Active','Moderately Active','Inactive'); |
|
|
my $oneline=($ENV{'QUERY_STRING'} eq 'simple'); |
&main($perlvar); |
unless ($oneline) { print "<html><body bgcolor=#FFFFFF>\n<h1>User Status ".localtime()."</h1>"; } |
|
|
sub analyze_time { |
my $filename; |
my ($since)=@_; |
opendir(DIR,$perlvar{'lonIDsDir'}); |
my $color="#000000"; |
%usercounts=(); |
my $userclass=$actl[0]; |
while ($filename=readdir(DIR)) { |
if ($since>300) { $color="#222222"; $userclass=$actl[1]; } |
unless ($filename=~/^\./) { |
if ($since>600) { $color="#444444"; } |
my ($dev,$ino,$mode,$nlink, |
if ($since>1800) { $color="#666666"; } |
$uid,$gid,$rdev,$size, |
if ($since>7200) { $color="#888888"; } |
$atime,$mtime,$ctime, |
if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; } |
$blksize,$blocks)=stat($perlvar{'lonIDsDir'}.'/'.$filename); |
return ($color,$userclass); |
$now=time; |
} |
$since=$now-$mtime; |
|
$sinceacc=$now-$atime; |
sub add_count { |
unless ($oneline) { print ("\n\n<hr />"); } |
my ($cat,$scope,$class)=@_; |
my %userinfo=(); |
if (!defined($usercount{$cat})) { |
undef $userinfo; |
$usercount{$cat}={}; |
my $fh=IO::File->new($perlvar{'lonIDsDir'}.'/'.$filename); |
} |
while ($line=<$fh>) { |
if (!defined($usercount{$cat}{$scope})) { |
chomp($line); |
$usercount{$cat}{$scope}={}; |
my ($name,$value)=split(/\=/,$line); |
} |
$userinfo{$name}=$value; |
$usercount{$cat}{$scope}{$class}++; |
|
} |
|
|
|
sub main { |
|
my ($perlvar) = @_; |
|
delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed |
|
delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed |
|
|
|
if (!&LONCAPA::lonauthcgi::check_ipbased_access('userstatus')) { |
|
if (!&LONCAPA::loncgi::check_cookie_and_load_env()) { |
|
&Apache::lonlocal::get_language_handle(); |
|
print &LONCAPA::loncgi::missing_cookie_msg(); |
|
return; |
} |
} |
$fh->close(); |
|
$color="#000000"; |
if (!&LONCAPA::lonauthcgi::can_view('userstatus')) { |
$userclass="Active"; |
&Apache::lonlocal::get_language_handle(); |
if ($since>300) { $color="#222222"; } |
print &LONCAPA::lonauthcgi::unauthorized_msg('userstatus'); |
if ($since>600) { $color="#444444"; } |
return; |
if ($since>3600) { $color="#666666"; $userclass="Moderately Active"; } |
|
if ($since>7200) { $color="#888888"; } |
|
if ($since>21600) { $color="#AAAAAA"; $userclass="Inactive"; } |
|
$usercount{$userclass}++; |
|
$usercount{'in Domain '.$userinfo{'user.domain'}}++; |
|
unless ($oneline) { |
|
print '<font color="'.$color.'">'; |
|
print '<h3>'.$userinfo{'environment.lastname'}.', '. |
|
$userinfo{'environment.firstname'}.' '. |
|
$userinfo{'environment.middlename'}.' '. |
|
$userinfo{'environment.generation'}." (". |
|
$userinfo{'user.name'}."\@".$userinfo{'user.domain'}. |
|
")</h3>\n<b>Login time:</b> ". |
|
localtime($userinfo{'user.login.time'}). |
|
' <b>Browser</b>: '.$userinfo{'browser.type'}." <b>Client:</b> ". |
|
$userinfo{'request.host'}."<br />\n<b>Role: </b>". |
|
$userinfo{'request.role'}." "; |
|
if ($userinfo{'request.course.id'}) { |
|
print "<b>Course:</b> ". |
|
$userinfo{'course.'.$userinfo{'request.course.id'}.'.description'}. |
|
' ('.$userinfo{'request.course.id'}.')'; |
|
$usercount{'in Course '. |
|
$userinfo{'course.'.$userinfo{'request.course.id'}.'.description'}. |
|
' ('.$userinfo{'request.course.id'}.')'}++; |
|
} else { |
|
print "Not in a course."; |
|
} |
} |
print "<br /><b>Last Transaction:</b> ".localtime($mtime). |
} |
" (".$since." secs ago) <br /><b>Last Access:</b> ".localtime($atime). |
|
" (".$sinceacc." secs ago)"; |
&Apache::lonlocal::get_language_handle(); |
print ("</font>"); |
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', |
|
Active => 'Active', |
|
'Moderately Active' => 'Moderately Active', |
|
Inactive => 'Inactive', |
|
); |
|
|
|
unless ($oneline) { |
|
my $now = time(); |
|
print '<html><body bgcolor="#FFFFFF">'."\n". |
|
"<h1>$lt{'usrs'} ".&Apache::lonlocal::locallocaltime($now).'</h1>'; |
|
} |
|
|
|
opendir(DIR,$$perlvar{'lonIDsDir'}); |
|
my @allfiles=(sort(readdir(DIR))); |
|
my %users; |
|
foreach my $filename (@allfiles) { |
|
if ($filename=~/^\./) { next; } |
|
if ($filename=~/^publicuser_/) { next; } |
|
my ($dev,$ino,$mode,$nlink, |
|
$uid,$gid,$rdev,$size, |
|
$atime,$mtime,$ctime, |
|
$blksize,$blocks)=stat($$perlvar{'lonIDsDir'}.'/'.$filename); |
|
my $now=time; |
|
my $since=$now-$mtime; |
|
my $sinceacc=$now-$atime; |
|
#unless ($oneline || $justsummary) { print ("\n\n<hr />"); } |
|
my %userinfo; |
|
($userinfo{'user.name'},undef,$userinfo{'user.domain'})= |
|
split('_',$filename); |
|
my ($color,$userclass)=&analyze_time($since); |
|
&add_count('Overall','all',$userclass); |
|
&add_count('Domain',$userinfo{'user.domain'},$userclass); |
|
|
|
unless ($oneline) { |
|
if (!tie(%userinfo,'GDBM_File', |
|
$$perlvar{'lonIDsDir'}.'/'.$filename, |
|
&GDBM_READER(),0640)) { |
|
next; |
|
} |
|
if (!$justsummary) { |
|
$users{$userclass}{$filename} .= |
|
'<font color="'.$color.'">'. |
|
'<h3>'.$userinfo{'environment.lastname'}.', '. |
|
$userinfo{'environment.firstname'}.' '. |
|
$userinfo{'environment.middlename'}.' '. |
|
$userinfo{'environment.generation'}." (". |
|
$userinfo{'user.name'}."\@".$userinfo{'user.domain'}. |
|
")</h3>\n". |
|
"<p><tt>$filename</tt></p>". |
|
"<b>$lt{'login'}:</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'}." "; |
|
} |
|
&add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'}); |
|
&add_count('OS',$userinfo{'browser.os'},$userinfo{'browser.type'}); |
|
if ($userinfo{'request.course.id'}) { |
|
my $cid=$userinfo{'request.course.id'}; |
|
my $coursename= $userinfo{'course.'.$cid.'.description'}. |
|
' ('.$cid.')'; |
|
if (!$justsummary) { |
|
$users{$userclass}{$filename} .= |
|
"<b>$lt{'Course'}:</b> ".$coursename; |
|
} |
|
&add_count('Course',$coursename,$userclass); |
|
} else { |
|
if (!$justsummary) { |
|
$users{$userclass}{$filename} .= $lt{'notc'}; |
|
} |
|
&add_count('Course','No Course',$userclass); |
|
} |
|
if (!$justsummary) { |
|
$users{$userclass}{$filename} .= |
|
"<br /><b>$lt{'ltra'}:</b> ".&Apache::lonlocal::locallocaltime($mtime). |
|
" (".$since." $lt{'secs'}) <br /><b>$lt{'lacc'}:</b> ". |
|
&Apache::lonlocal::locallocaltime($atime)." (".$sinceacc." $lt{'secs'})". |
|
"</font>"; |
|
} |
|
} |
|
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); |
|
open (LOADAVGH,"/proc/loadavg"); |
|
my $loadavg=<LOADAVGH>; |
|
close(LOADAVGH); |
|
unless ($oneline) { |
|
print "<hr /><h2>$lt{'usrc'}</h2>"; |
|
# print "<pre>\n"; |
|
&showact('Overall',\%lt,%usercount); |
|
&showact('Domain',\%lt,%usercount); |
|
&showact('Course',\%lt,%usercount); |
|
&show('Browser',\%lt,%usercount); |
|
&show('OS',\%lt,%usercount); |
|
|
|
# print "\n</pre>"; |
|
print "<b>$lt{'load'}:<b> ".$loadavg; |
|
print "</body></html>"; |
|
} else { |
|
foreach my $l1 (sort keys %usercount) { |
|
foreach my $l2 (sort keys %{$usercount{$l1}}) { |
|
foreach my $l3 (sort keys %{$usercount{$l1}{$l2}}) { |
|
print $l1.'_'.$l2.'_'.$l3.'='.$usercount{$l1}{$l2}{$l3}.'&'; |
|
} |
|
} |
|
} |
|
#clusterstatus values |
|
foreach my $act (@actl) { |
|
print "$act=".$usercount{'Overall'}{'all'}{$act}.'&'; |
|
} |
|
print 'loadavg='.$loadavg; |
} |
} |
} |
} |
closedir(DIR); |
|
unless ($oneline) { |
sub show { |
print "<hr /><h2>User Count</h2>"; |
my ($cat,$ltref,%usercount)=@_; |
foreach (sort keys %usercount) { |
print("<h3>$ltref->{$cat}</h3>\n"); |
print "<b>".$_.":</b> ".$usercount{$_}."<br />"; |
foreach my $type (sort(keys(%{$usercount{$cat}}))) { |
} |
print("<table border='1'><tr><th>$type</th><th>"); |
print "</body></html>"; |
print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}})))); |
} else { |
my $temp; |
foreach (sort keys %usercount) { |
my $count=0; |
print $_.'='.$usercount{$_}.'&'; |
foreach my $version (sort(keys(%{$usercount{$cat}{$type}}))) { |
|
$temp.="<td>".$usercount{$cat}{$type}{$version}. |
|
"</td>"; |
|
$count+=$usercount{$cat}{$type}{$version}; |
|
} |
|
print("</th></tr><tr><td>$count</td>"); |
|
print($temp."</tr></table>\n"); |
|
} |
} |
} |
|
|
|
sub showact { |
|
my ($cat,$ltref,%usercount)=@_; |
|
print("<h3>$ltref->{$cat}</h3>\n"); |
|
|
|
print("<table border='1'><tr><th></th><th>"); |
|
print(join("</th><th>",('Any',@actl))); |
|
print("</th></tr>"); |
|
foreach my $type (sort(keys(%{$usercount{$cat}}))) { |
|
print("<tr><td>$type</td>"); |
|
my $temp; |
|
my $count=0; |
|
foreach my $activity (@actl) { |
|
$temp.="<td> ".$usercount{$cat}{$type}{$activity}."</td>"; |
|
$count+=$usercount{$cat}{$type}{$activity}; |
|
} |
|
print("<td>$count</td>"); |
|
print($temp); |
|
} |
|
print("</tr></table>\n"); |
} |
} |
|
|