[BACK]Return to userstatus.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / cgi
File:  [LON-CAPA] / loncom / cgi / userstatus.pl
Revision 1.23: download - view: text, annotated - select for diffs
Sun Mar 7 02:34:25 2021 UTC (3 years, 8 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, version_2_11_X, version_2_11_5_msu, version_2_11_5, version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, HEAD
- Typo in rev. 1.22

#!/usr/bin/perl
$|=1;
# User Status
# $Id: userstatus.pl,v 1.23 2021/03/07 02:34:25 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 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');

&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('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 '<!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'});
    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,
	    $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} .=
		    '<div style="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'})".
		    "</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);
    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;
    }
}

sub show {
    my ($cat,$ltref,%usercount)=@_;
    print("<h3>$ltref->{$cat}</h3>\n");
    foreach my $type (sort(keys(%{$usercount{$cat}}))) {
	print("<table border='1'><tr><th>$type</th><th>");
	print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}}))));
	my $temp;
	my $count=0;
	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>&nbsp;</th><th>");
    print(join("</th><th>",map {$ltref->{$_};} ('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>&nbsp;".$usercount{$cat}{$type}{$activity}."</td>";
	    $count+=$usercount{$cat}{$type}{$activity};
	}
	print("<td>$count</td>");
	print($temp);
	print('</tr>');
    }    
    print("</table>\n");
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>