--- loncom/cgi/userstatus.pl 2003/08/27 20:35:24 1.6 +++ loncom/cgi/userstatus.pl 2021/03/06 19:09:03 1.22 @@ -1,36 +1,57 @@ #!/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.22 2021/03/06 19:09: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; +# -------------------- 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 @actl=('Active','Moderately Active','Inactive'); - -print "Content-type: text/html\n\n"; - -# -------------------- Read loncapa.conf (and by default, loncapa_apache.conf). -&main(); +&main($perlvar); sub analyze_time { my ($since)=@_; my $color="#000000"; my $userclass=$actl[0]; - if ($since>300) { $color="#222222"; } + if ($since>300) { $color="#222222"; $userclass=$actl[1]; } if ($since>600) { $color="#444444"; } - if ($since>3600) { $color="#666666"; $userclass=$actl[1]; } + if ($since>1800) { $color="#666666"; } if ($since>7200) { $color="#888888"; } if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; } return ($color,$userclass); @@ -48,18 +69,76 @@ sub add_count { } sub main { - my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf'); + my ($perlvar) = @_; 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'); - my $justsummary=($ENV{'QUERY_STRING'} eq 'summary'); - unless ($oneline) { print "\n

User Status ".localtime()."

"; } + 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; + } + + 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 ''."\n". + ''."\n"."\n". + ''."\n". + ''."\n". + 'LON-CAPA '.$lt{'usrs'}.''."\n". + ''."\n". + ''."\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; } + if ($filename=~/^[a-f0-9]+_(linked|lti_\d+)\.id$/) { next; } my ($dev,$ino,$mode,$nlink, $uid,$gid,$rdev,$size, $atime,$mtime,$ctime, @@ -67,66 +146,88 @@ sub main { my $now=time; my $since=$now-$mtime; my $sinceacc=$now-$atime; - unless ($oneline || $justsummary) { print ("\n\n
"); } + #unless ($oneline || $justsummary) { print ("\n\n
"); } my %userinfo; - my $fh=IO::File->new($$perlvar{'lonIDsDir'}.'/'.$filename); - while (my $line=<$fh>) { - chomp($line); - my ($name,$value)=split(/\=/,$line); - $userinfo{$name}=$value; - } - $fh->close(); + ($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) { - print ''; - print '

'.$userinfo{'environment.lastname'}.', '. + $users{$userclass}{$filename} .= + '
'. + '

'.$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{'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) { print "Course: ".$coursename; } + if (!$justsummary) { + $users{$userclass}{$filename} .= + "$lt{'Course'}: ".$coursename; + } &add_count('Course',$coursename,$userclass); } else { - if (!$justsummary) { print "Not in a course."; } + if (!$justsummary) { + $users{$userclass}{$filename} .= $lt{'notc'}; + } &add_count('Course','No Course',$userclass); } if (!$justsummary) { - print "
Last Transaction: ".localtime($mtime). - " (".$since." secs ago)
Last Access: ". - localtime($atime)." (".$sinceacc." secs ago)"; - print (""); + $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 "

User Counts

"; + print "

$lt{'usrc'}

"; # print "
\n";
-	&showact('Overall',%usercount);
-	&showact('Domain',%usercount);
-	&showact('Course',%usercount);
-	&show('Browser',%usercount);
+	&showact('Overall',\%lt,%usercount);
+	&showact('Domain',\%lt,%usercount);
+	&showact('Course',\%lt,%usercount);
+	&show('Browser',\%lt,%usercount);
+	&show('OS',\%lt,%usercount);
 
 #	print "\n
"; - print "Load Average: ".$loadavg; + print "$lt{'load'}: ".$loadavg; print ""; } else { foreach my $l1 (sort keys %usercount) { @@ -145,8 +246,8 @@ sub main { } sub show { - my ($cat,%usercount)=@_; - print("

$cat

\n"); + my ($cat,$ltref,%usercount)=@_; + print("

$ltref->{$cat}

\n"); foreach my $type (sort(keys(%{$usercount{$cat}}))) { print("
$type"); print(join("",sort(keys(%{$usercount{$cat}{$type}})))); @@ -163,11 +264,11 @@ sub show { } sub showact { - my ($cat,%usercount)=@_; - print("

$cat

\n"); + my ($cat,$ltref,%usercount)=@_; + print("

$ltref->{$cat}

\n"); - print("
"); - print(join("",('Any',@actl))); + print(""); foreach my $type (sort(keys(%{$usercount{$cat}}))) { print(""); @@ -179,7 +280,8 @@ sub showact { } print(""); print($temp); + print(''); } - print("
 "); + print(join("",(map {$ltref->{$_}; {'Any',@actl))); print("
$type$count
\n"); + print("
\n"); }