loncom/cgi/userstatus.pl - view

File: [LON-CAPA] / loncom / cgi / userstatus.pl
Revision 1.17: download - view: text, annotated - select for diffs
Fri Nov 28 20:45:21 2008 UTC (15 years, 5 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Add localization
- Use routines in LONCAPA::loncgi for access control.

1: #!/usr/bin/perl 2: $|=1; 3: # User Status 4: # $Id: userstatus.pl,v 1.17 2008/11/28 20:45:21 raeburn Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: 29: use strict; 30: 31: use lib '/home/httpd/lib/perl/'; 32: use Apache::lonlocal; 33: use LONCAPA::Configuration; 34: use LONCAPA::loncgi; 35: use HTTP::Headers; 36: use GDBM_File; 37: 38: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf). 39: my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf'); 40: 41: print "Content-type: text/html\n\n"; 42: my %usercount; 43: my @actl=('Active','Moderately Active','Inactive'); 44: 45: &main($perlvar); 46: 47: sub analyze_time { 48: my ($since)=@_; 49: my $color="#000000"; 50: my $userclass=$actl[0]; 51: if ($since>300) { $color="#222222"; $userclass=$actl[1]; } 52: if ($since>600) { $color="#444444"; } 53: if ($since>1800) { $color="#666666"; } 54: if ($since>7200) { $color="#888888"; } 55: if ($since>21600) { $color="#AAAAAA"; $userclass=$actl[2]; } 56: return ($color,$userclass); 57: } 58: 59: sub add_count { 60: my ($cat,$scope,$class)=@_; 61: if (!defined($usercount{$cat})) { 62: $usercount{$cat}={}; 63: } 64: if (!defined($usercount{$cat}{$scope})) { 65: $usercount{$cat}{$scope}={}; 66: } 67: $usercount{$cat}{$scope}{$class}++; 68: } 69: 70: sub main { 71: my ($perlvar) = @_; 72: delete $$perlvar{'lonReceipt'}; # remove since sensitive and not needed 73: delete $$perlvar{'lonSqlAccess'}; # remove since sensitive and not needed 74: 75: if (!&LONCAPA::loncgi::check_ipbased_access()) { 76: if (!&LONCAPA::loncgi::check_cookie_and_load_env()) { 77: &Apache::lonlocal::get_language_handle(); 78: print &LONCAPA::loncgi::missing_cookie_msg(); 79: return; 80: } 81: 82: if (!&LONCAPA::loncgi::can_view('userstatus')) { 83: &Apache::lonlocal::get_language_handle(); 84: print &LONCAPA::loncgi::unauthorized_msg('userstatus'); 85: return; 86: } 87: } 88: 89: &Apache::lonlocal::get_language_handle(); 90: my (%gets,$dom,$oneline,$justsummary); 91: &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets); 92: if (defined($gets{'simple'})) { 93: $oneline = 'simple'; 94: } 95: if (defined($gets{'summary'})) { 96: $justsummary = 'summary'; 97: } 98: 99: my %lt = &Apache::lonlocal::texthash( 100: usrs => 'User Status', 101: login => 'Login time', 102: on => 'on', 103: Client => 'Client', 104: role => 'Role', 105: notc => 'Not in a course', 106: ltra => 'Last Transaction', 107: lacc => 'Last Access', 108: secs => 'secs ago', 109: usrc => 'User Counts', 110: load => 'Load Average', 111: Overall => 'Overall', 112: Domain => 'Domain', 113: Course => 'Course', 114: Browser => 'Browser', 115: OS => 'OS', 116: Active => 'Active', 117: 'Moderately Active' => 'Moderately Active', 118: Inactive => 'Inactive', 119: ); 120: 121: unless ($oneline) { 122: my $now = time(); 123: print '<html><body bgcolor="#FFFFFF">'."\n". 124: "<h1>$lt{'usrs'} ".&Apache::lonlocal::locallocaltime($now).'</h1>'; 125: } 126: 127: opendir(DIR,$$perlvar{'lonIDsDir'}); 128: my @allfiles=(sort(readdir(DIR))); 129: my %users; 130: foreach my $filename (@allfiles) { 131: if ($filename=~/^\./) { next; } 132: if ($filename=~/^publicuser_/) { next; } 133: my ($dev,$ino,$mode,$nlink, 134: $uid,$gid,$rdev,$size, 135: $atime,$mtime,$ctime, 136: $blksize,$blocks)=stat($$perlvar{'lonIDsDir'}.'/'.$filename); 137: my $now=time; 138: my $since=$now-$mtime; 139: my $sinceacc=$now-$atime; 140: #unless ($oneline || $justsummary) { print ("\n\n<hr />"); } 141: my %userinfo; 142: ($userinfo{'user.name'},undef,$userinfo{'user.domain'})= 143: split('_',$filename); 144: my ($color,$userclass)=&analyze_time($since); 145: &add_count('Overall','all',$userclass); 146: &add_count('Domain',$userinfo{'user.domain'},$userclass); 147: 148: unless ($oneline) { 149: if (!tie(%userinfo,'GDBM_File', 150: $$perlvar{'lonIDsDir'}.'/'.$filename, 151: &GDBM_READER(),0640)) { 152: next; 153: } 154: if (!$justsummary) { 155: $users{$userclass}{$filename} .= 156: '<font color="'.$color.'">'. 157: '<h3>'.$userinfo{'environment.lastname'}.', '. 158: $userinfo{'environment.firstname'}.' '. 159: $userinfo{'environment.middlename'}.' '. 160: $userinfo{'environment.generation'}." (". 161: $userinfo{'user.name'}."\@".$userinfo{'user.domain'}. 162: ")</h3>\n". 163: "<p><tt>$filename</tt></p>". 164: "<b>$lt{'login'}:</b> ". 165: &Apache::lonlocal::locallocaltime($userinfo{'user.login.time'}). 166: " <b>$lt{'Browser'}</b>: ".$userinfo{'browser.type'}. 167: " $lt{'on'} ".$userinfo{'browser.os'}."<b>$lt{'Client'}:</b>". 168: $userinfo{'request.host'}."<br />\n<b>$lt{'role'}: </b>". 169: $userinfo{'request.role'}." "; 170: } 171: &add_count('Browser',$userinfo{'browser.type'},$userinfo{'browser.version'}); 172: &add_count('OS',$userinfo{'browser.os'},$userinfo{'browser.type'}); 173: if ($userinfo{'request.course.id'}) { 174: my $cid=$userinfo{'request.course.id'}; 175: my $coursename= $userinfo{'course.'.$cid.'.description'}. 176: ' ('.$cid.')'; 177: if (!$justsummary) { 178: $users{$userclass}{$filename} .= 179: "<b>$lt{'Course'}:</b> ".$coursename; 180: } 181: &add_count('Course',$coursename,$userclass); 182: } else { 183: if (!$justsummary) { 184: $users{$userclass}{$filename} .= $lt{'notc'}; 185: } 186: &add_count('Course','No Course',$userclass); 187: } 188: if (!$justsummary) { 189: $users{$userclass}{$filename} .= 190: "<br /><b>$lt{'ltra'}:</b> ".&Apache::lonlocal::locallocaltime($mtime). 191: " (".$since." $lt{'secs'}) <br /><b>$lt{'lacc'}:</b> ". 192: &Apache::lonlocal::locallocaltime($atime)." (".$sinceacc." $lt{'secs'})". 193: "</font>"; 194: } 195: } 196: untie(%userinfo); 197: } 198: if (!$oneline && !$justsummary) { 199: foreach my $class (@actl) { 200: print("\n\n<hr /><h1>$lt{$class}</h1>"); 201: foreach my $filename (sort(keys(%{$users{$class}}))) { 202: print("\n\n".$users{$class}{$filename}."\n\n<hr />"); 203: } 204: } 205: } 206: 207: closedir(DIR); 208: open (LOADAVGH,"/proc/loadavg"); 209: my $loadavg=<LOADAVGH>; 210: close(LOADAVGH); 211: unless ($oneline) { 212: print "<hr /><h2>$lt{'usrc'}</h2>"; 213: # print "<pre>\n"; 214: &showact('Overall',\%lt,%usercount); 215: &showact('Domain',\%lt,%usercount); 216: &showact('Course',\%lt,%usercount); 217: &show('Browser',\%lt,%usercount); 218: &show('OS',\%lt,%usercount); 219: 220: # print "\n</pre>"; 221: print "<b>$lt{'load'}:<b> ".$loadavg; 222: print "</body></html>"; 223: } else { 224: foreach my $l1 (sort keys %usercount) { 225: foreach my $l2 (sort keys %{$usercount{$l1}}) { 226: foreach my $l3 (sort keys %{$usercount{$l1}{$l2}}) { 227: print $l1.'_'.$l2.'_'.$l3.'='.$usercount{$l1}{$l2}{$l3}.'&'; 228: } 229: } 230: } 231: #clusterstatus values 232: foreach my $act (@actl) { 233: print "$act=".$usercount{'Overall'}{'all'}{$act}.'&'; 234: } 235: print 'loadavg='.$loadavg; 236: } 237: } 238: 239: sub show { 240: my ($cat,$ltref,%usercount)=@_; 241: print("<h3>$ltref->{$cat}</h3>\n"); 242: foreach my $type (sort(keys(%{$usercount{$cat}}))) { 243: print("<table border='1'><tr><th>$type</th><th>"); 244: print(join("</th><th>",sort(keys(%{$usercount{$cat}{$type}})))); 245: my $temp; 246: my $count=0; 247: foreach my $version (sort(keys(%{$usercount{$cat}{$type}}))) { 248: $temp.="<td>".$usercount{$cat}{$type}{$version}. 249: "</td>"; 250: $count+=$usercount{$cat}{$type}{$version}; 251: } 252: print("</th></tr><tr><td>$count</td>"); 253: print($temp."</tr></table>\n"); 254: } 255: } 256: 257: sub showact { 258: my ($cat,$ltref,%usercount)=@_; 259: print("<h3>$ltref->{$cat}</h3>\n"); 260: 261: print("<table border='1'><tr><th></th><th>"); 262: print(join("</th><th>",('Any',@actl))); 263: print("</th></tr>"); 264: foreach my $type (sort(keys(%{$usercount{$cat}}))) { 265: print("<tr><td>$type</td>"); 266: my $temp; 267: my $count=0; 268: foreach my $activity (@actl) { 269: $temp.="<td> ".$usercount{$cat}{$type}{$activity}."</td>"; 270: $count+=$usercount{$cat}{$type}{$activity}; 271: } 272: print("<td>$count</td>"); 273: print($temp); 274: } 275: print("</tr></table>\n"); 276: } 277: