--- loncom/cgi/userstatus.pl 2006/06/02 21:39:02 1.12.2.1 +++ loncom/cgi/userstatus.pl 2009/01/09 07:06:27 1.19 @@ -1,7 +1,7 @@ #!/usr/bin/perl $|=1; # User Status -# $Id: userstatus.pl,v 1.12.2.1 2006/06/02 21:39:02 albertel Exp $ +# $Id: userstatus.pl,v 1.19 2009/01/09 07:06:27 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,31 +26,32 @@ $|=1; # 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>1800) { $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); @@ -68,16 +69,65 @@ 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', + 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; } @@ -88,7 +138,7 @@ 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; ($userinfo{'user.name'},undef,$userinfo{'user.domain'})= split('_',$filename); @@ -97,27 +147,26 @@ sub main { &add_count('Domain',$userinfo{'user.domain'},$userclass); unless ($oneline) { - my $fh=IO::File->new($$perlvar{'lonIDsDir'}.'/'.$filename); - while (my $line=<$fh>) { - chomp($line); - my ($name,$value)=split(/\=/,$line); - $name = &unescape($name); - $value = &unescape($value); - $userinfo{$name}=$value; + if (!tie(%userinfo,'GDBM_File', + $$perlvar{'lonIDsDir'}.'/'.$filename, + &GDBM_READER(),0640)) { + next; } - $fh->close(); 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'}. - " on ".$userinfo{'browser.os'}."Client: ". - $userinfo{'request.host'}."
\nRole: ". + ")

\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'}); @@ -126,35 +175,51 @@ sub main { 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);
-	&show('OS',%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) { @@ -173,8 +238,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}})))); @@ -191,8 +256,8 @@ sub show { } sub showact { - my ($cat,%usercount)=@_; - print("

$cat

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

$ltref->{$cat}

\n"); print("
"); print(join("",('Any',@actl))); @@ -211,18 +276,3 @@ sub showact { print("
\n"); } -# -------------------------------------------------------- Escape Special Chars - -sub escape { - my $str=shift; - $str =~ s/(\W)/"%".unpack('H2',$1)/eg; - return $str; -} - -# ----------------------------------------------------- Un-Escape Special Chars - -sub unescape { - my $str=shift; - $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - return $str; -}