--- loncom/cgi/userstatus.pl 2003/07/29 20:17:52 1.3 +++ loncom/cgi/userstatus.pl 2008/12/25 01:56:03 1.18 @@ -1,100 +1,278 @@ #!/usr/bin/perl $|=1; -# The LearningOnline Network with CAPA # User Status -# (Versions -# (Running loncron -# 09/06/01 Gerd Kortemeyer) -# 02/18/02,02/19/02 Gerd Kortemeyer) +# $Id: userstatus.pl,v 1.18 2008/12/25 01:56:03 raeburn Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# 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 Apache::lonlocal; use LONCAPA::Configuration; - +use LONCAPA::loncgi; +use LONCAPA::lonauthcgi; 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). -my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); -my %perlvar=%{$perlvarref}; -undef $perlvarref; # remove since sensitive and not needed -delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed -delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed - -my $oneline=($ENV{'QUERY_STRING'} eq 'simple'); -unless ($oneline) { print "\n

User Status ".localtime()."

"; } - -my $filename; -opendir(DIR,$perlvar{'lonIDsDir'}); -%usercounts=(); -while ($filename=readdir(DIR)) { - unless ($filename=~/^\./) { - my ($dev,$ino,$mode,$nlink, - $uid,$gid,$rdev,$size, - $atime,$mtime,$ctime, - $blksize,$blocks)=stat($perlvar{'lonIDsDir'}.'/'.$filename); - $now=time; - $since=$now-$mtime; - $sinceacc=$now-$atime; - unless ($oneline) { print ("\n\n
"); } - my %userinfo=(); - undef $userinfo; - my $fh=IO::File->new($perlvar{'lonIDsDir'}.'/'.$filename); - while ($line=<$fh>) { - chomp($line); - my ($name,$value)=split(/\=/,$line); - $userinfo{$name}=$value; +my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf'); + +print "Content-type: text/html\n\n"; +my %usercount; +my @actl=('Active','Moderately Active','Inactive'); + +&main($perlvar); + +sub analyze_time { + my ($since)=@_; + my $color="#000000"; + my $userclass=$actl[0]; + if ($since>300) { $color="#222222"; $userclass=$actl[1]; } + if ($since>600) { $color="#444444"; } + if ($since>1800) { $color="#666666"; } + if ($since>7200) { $color="#888888"; } + if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; } + return ($color,$userclass); +} + +sub add_count { + my ($cat,$scope,$class)=@_; + if (!defined($usercount{$cat})) { + $usercount{$cat}={}; + } + if (!defined($usercount{$cat}{$scope})) { + $usercount{$cat}{$scope}={}; + } + $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()) { + if (!&LONCAPA::loncgi::check_cookie_and_load_env()) { + &Apache::lonlocal::get_language_handle(); + print &LONCAPA::loncgi::missing_cookie_msg(); + return; } - $fh->close(); - $color="#000000"; - $userclass="Active"; - if ($since>300) { $color="#222222"; } - if ($since>600) { $color="#444444"; } - 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 ''; - print '

'.$userinfo{'environment.lastname'}.', '. - $userinfo{'environment.firstname'}.' '. - $userinfo{'environment.middlename'}.' '. - $userinfo{'environment.generation'}." (". - $userinfo{'user.name'}."\@".$userinfo{'user.domain'}. - ")

\nLogin time: ". - localtime($userinfo{'user.login.time'}). - ' Browser: '.$userinfo{'browser.type'}." Client: ". - $userinfo{'request.host'}."
\nRole: ". - $userinfo{'request.role'}." "; - if ($userinfo{'request.course.id'}) { - print "Course: ". - $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."; + + if (!&LONCAPA::lonauthcgi::can_view('userstatus')) { + &Apache::lonlocal::get_language_handle(); + print &LONCAPA::lonauthcgi::unauthorized_msg('userstatus'); + return; } - print "
Last Transaction: ".localtime($mtime). - " (".$since." secs ago)
Last Access: ".localtime($atime). - " (".$sinceacc." secs ago)"; - print (""); - } + } + + &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', + Active => 'Active', + 'Moderately Active' => 'Moderately Active', + Inactive => 'Inactive', + ); + + unless ($oneline) { + my $now = time(); + print ''."\n". + "

$lt{'usrs'} ".&Apache::lonlocal::locallocaltime($now).'

'; + } + + 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
"); } + 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} .= + ''. + '

'.$userinfo{'environment.lastname'}.', '. + $userinfo{'environment.firstname'}.' '. + $userinfo{'environment.middlename'}.' '. + $userinfo{'environment.generation'}." (". + $userinfo{'user.name'}."\@".$userinfo{'user.domain'}. + ")

\n". + "

$filename

". + "$lt{'login'}: ". + &Apache::lonlocal::locallocaltime($userinfo{'user.login.time'}). + " $lt{'Browser'}: ".$userinfo{'browser.type'}. + " $lt{'on'} ".$userinfo{'browser.os'}."$lt{'Client'}:". + $userinfo{'request.host'}."
\n$lt{'role'}: ". + $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} .= + "$lt{'Course'}: ".$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} .= + "
$lt{'ltra'}: ".&Apache::lonlocal::locallocaltime($mtime). + " (".$since." $lt{'secs'})
$lt{'lacc'}: ". + &Apache::lonlocal::locallocaltime($atime)." (".$sinceacc." $lt{'secs'})". + ""; + } + } + untie(%userinfo); + } + if (!$oneline && !$justsummary) { + foreach my $class (@actl) { + print("\n\n

$lt{$class}

"); + foreach my $filename (sort(keys(%{$users{$class}}))) { + print("\n\n".$users{$class}{$filename}."\n\n
"); + } + } + } + + closedir(DIR); + open (LOADAVGH,"/proc/loadavg"); + my $loadavg=; + close(LOADAVGH); + unless ($oneline) { + print "

$lt{'usrc'}

"; +# print "
\n";
+	&showact('Overall',\%lt,%usercount);
+	&showact('Domain',\%lt,%usercount);
+	&showact('Course',\%lt,%usercount);
+	&show('Browser',\%lt,%usercount);
+	&show('OS',\%lt,%usercount);
+
+#	print "\n
"; + print "$lt{'load'}: ".$loadavg; + print ""; + } 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) { -print "

User Count

"; -foreach (sort keys %usercount) { - print "".$_.": ".$usercount{$_}."
"; -} -print ""; -} else { -foreach (sort keys %usercount) { - print $_.'='.$usercount{$_}.'&'; + +sub show { + my ($cat,$ltref,%usercount)=@_; + print("

$ltref->{$cat}

\n"); + foreach my $type (sort(keys(%{$usercount{$cat}}))) { + print(""; + $count+=$usercount{$cat}{$type}{$version}; + } + print(""); + print($temp."
$type"); + print(join("",sort(keys(%{$usercount{$cat}{$type}})))); + my $temp; + my $count=0; + foreach my $version (sort(keys(%{$usercount{$cat}{$type}}))) { + $temp.="".$usercount{$cat}{$type}{$version}. + "
$count
\n"); + } } + +sub showact { + my ($cat,$ltref,%usercount)=@_; + print("

$ltref->{$cat}

\n"); + + print(""); + foreach my $type (sort(keys(%{$usercount{$cat}}))) { + print(""); + my $temp; + my $count=0; + foreach my $activity (@actl) { + $temp.=""; + $count+=$usercount{$cat}{$type}{$activity}; + } + print(""); + print($temp); + } + print("
"); + print(join("",('Any',@actl))); + print("
$type ".$usercount{$cat}{$type}{$activity}."$count
\n"); } +