File:  [LON-CAPA] / loncom / misc / rebuild_lastlogin.pl
Revision 1.1: download - view: text, annotated - select for diffs
Sat Oct 26 20:19:56 2013 UTC (11 years, 2 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, version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0, HEAD
rebuild_lastlogin.pl is run on a library server and gathers
last login information for users in course(s) for which the current
server is the home server.

For each selected course a hash containing keys of:
username:domain:section:role with values: UNIX timestamp of
most recent role/section selection, i.e., "last log-in" will
be stored in a nohist_crslastlogin.db file for the course.

This script is intended to be run after installation of LON-CAPA
2.11.0 on a library server to populate nohist_crslastlogin.db files
for the domain's courses. (Thereafter role selection after log-in
on a server running 2.11.0 will update nohist_crslastlogin.db
when a course role is selected.)

This script might be run at other times. For example:

(a) if course user sessions are being routinely hosted on pre-2.11.0 servers.
(b) if nohist_crslastlogin.db is lost or corrupted, and needs to be rebuilt.

#!/usr/bin/perl
# The LearningOnline Network
#
# $Id: rebuild_lastlogin.pl,v 1.1 2013/10/26 20:19:56 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/
#
#################################################

=pod

=head1 NAME

rebuild_lastlogin.pl

=head1 SYNOPSIS

rebuild_lastlogin.pl is run on a library server and gathers
last login information for users in course(s) for which the current 
server is the home server.

=head1 DESCRIPTION

For each selected course a hash containing keys of: 
username:domain:section:role with values: UNIX timestamp of
most recent role/section selection, i.e., "last log-in" will
be stored in a nohist_crslastlogin.db file for the course.

usage: either enter the script name followed by at least one argument:
the time interval prior to now, i.e., day, week, month, year or
all for which last log-in activity is to be retrieved  or enter the 
script name followed by at least two arguments:
1. a specific courseID and 2. a specific course domain.

Both cases support an additional, optional, final argument: 
a two letter code for the desired language.

                 ar => ﺎﻠﻋﺮﺒﻳﺓ
                 de => Deutsch
                 en => English
                 es => español
                 fa => ﺍیﺭﺎﻧی
                 fr => français
                 he => עברית
                 ja => 日本語
                 pt => Português
                 ru => Русский
                 tr => türkçe
                 zh => 简体中文

The default language is en.  If a translation exists for the language
specified as the final argument, then if a time interval is being used
that will be specified in that language, in the first argument when 
calling the script. 

The script must be run as the user www.

Because the script will attempt to retrieve user activity log from
the home server of each student or course personnel, the LON-CAPA
daemons need to be running in case that person's home server is not
the same as the course's home server.

=cut

#################################################

#! /usr/bin/perl

use strict;
use lib '/home/httpd/lib/perl/';
use Apache::lonnet;
use Apache::loncommon;
use Apache::loncoursedata;
use Apache::lonlocal;
use LONCAPA qw(:DEFAULT :match);

my %languages = (
                  ar => 'ﺎﻠﻋﺮﺒﻳﺓ',
                  de => 'Deutsch',
                  en => 'English',
                  es => 'español',
                  fa => 'ﺍیﺭﺎﻧی',
                  fr => 'français',
                  he => 'עברית',
                  ja => '日本語',
                  pt => 'Português',
                  ru => 'Русский',
                  tr => 'türkçe',
                  zh => '简体中文',
                );
my $langchoices = "\n";
foreach my $key (sort(keys(%languages))) {
    $langchoices .= '                 '.$key.' => '.$languages{$key}."\n";
}
my $lang = 'en';
my @args = @ARGV;

my @domains = sort(&Apache::lonnet::current_machine_domains());
my @ids=&Apache::lonnet::current_machine_ids();
my ($domfilter,$possdomstr);
my $crsfilter = '.';
if (@domains > 1) {
    $possdomstr = join('|',@domains);
} else {
    $possdomstr = $domains[0];
}
if (@args>3) {
    if (exists($languages{$args[2]})) {
        $lang = $args[2];
    }
    &Apache::lonlocal::get_language_handle(undef,$lang);
    print &mt('[_1] takes a maximum of 3 arguments.','rebuild_lastlogin.pl')."\n";
    exit; 
} elsif ((@args==3) && exists($languages{$args[2]})) {
    $lang = pop(@args);
} elsif ((@args==2) && exists($languages{$args[1]})) {
    $lang = pop(@args);
}
&Apache::lonlocal::get_language_handle(undef,$lang);
if (@args == 2) { 
    my ($cnum,$cdom) = @args;
    my $invalid;
    if ($cnum =~ /^$match_courseid$/ && $cdom =~ /^$match_domain$/) {
        if (grep(/^\Q$cdom\E$/,@domains)) {
            my %crshash = &Apache::lonnet::coursedescription("$cdom/$cnum",{'one_time' => 1});
            if ($crshash{'num'} eq $cnum) {
                $crsfilter = $cnum;
                $domfilter = $cdom;
            } else {
                $invalid = 1;
            }
        } else {
            $invalid = 1;
        }
    } else {
        $invalid = 1;
    }
    if ($invalid) {
        print "\n".&mt('usage for a single course: [_1] where [_2] is an optional two letter code.',
                  'rebuild_lastlogin.pl [COURSEID] [COURSEDOMAIN] <LANG>',
                  '<LANG>')."\n";
        exit;
    }
}
if ($crsfilter eq '.') {
    if (!@args || ($args[0] ne &mt('all') && $args[0] ne &mt('year') && $args[0] ne &mt('month') &&
                   $args[0] ne &mt('week') && $args[0] ne &mt('day'))) {
        print "\n".
              &mt('usage: either enter the script name followed by at least one argument')."\n".
                  '       -- 1. '.&mt('the time interval from prior to now, i.e., day, week etc., for which log-in activity is to be checked')."\n\n".
                  '      '.&mt('or enter the script name followed by at least two arguments')."\n".
                  '        -- 1. '.&mt('a specific courseID')."\n".
                  '        -- 2. '.&mt('a specific course domain')."\n\n".
                  '              '.&mt('Both cases support an additional, optional, final argument: a two letter code for the desired language')."\n".
                  '              '.&mt('-- one of: [_1]').$langchoices."\n".
                  '      '.&mt('Accordingly use one of the following:')."\n\n".
                  '      rebuild_lastlogin.pl '.&mt('all').' <LANG>'."\n".
                  '      rebuild_lastlogin.pl '.&mt('year').' <LANG>'."\n".
                  '      rebuild_lastlogin.pl '.&mt('month').' <LANG>'."\n".
                  '      rebuild_lastlogin.pl '.&mt('week').' <LANG>'."\n".
                  '      rebuild_lastlogin.pl '.&mt('day').' <LANG>'."\n".
                  '      rebuild_lastlogin.pl [COURSEID] [COURSEDOMAIN] <LANG> '."\n";
        exit;
    }
}

#  Make sure this process is running from user=www
my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
    my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'}}";
    my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch";
    my $msg=&mt('User ID mismatch.').' '.&mt('[_1] must be run as user www.','rebuild_lastlogin.pl');
    system("echo '$msg' | mail -s '$subj' $emailto > /dev/null");
    exit 1;
}

if ($Apache::lonnet::perlvar{'lonRole'} ne 'library') {
    print &mt('[_1] only runs on a LON-CAPA library server.','rebuild_lastlogin.pl')."\n";
    exit;  
}

# Log script run
open(my $fh,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/buildlastlogin.log');
print $fh "==== buildlastlogindb.pl Run ".localtime()."====\n";

my %users;
my $timefilter = 1;
my $now = time;
if ($crsfilter eq '.') {
    if ($ARGV[0] eq &mt('year')) {
        $timefilter = $now-31536000;
    } elsif ($ARGV[0] eq &mt('month')) {
        $timefilter = $now-2592000;
    } elsif ($ARGV[0] eq &mt('week')) {
        $timefilter = $now-604800;
    } elsif ($ARGV[0] eq &mt('day')) {
        $timefilter = $now-86400;
    }
}

foreach my $dom (@domains) {
    if ($domfilter) {
        next if ($dom ne $domfilter);
    }
    my %courseshash;
    my %currhash = &Apache::lonnet::courseiddump($dom,'.',$timefilter,'.','.',$crsfilter,1,\@ids,'.');
    foreach my $cid (sort(keys(%currhash))) {
        my ($cdom,$cnum) = split(/_/,$cid);
        my $path = &propath($cdom,$cnum);
        my %advrolehash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,
                              ['previous','active','future']);
        my %coursehash = &Apache::lonnet::coursedescription("$cdom/$cnum",{'one_time' => 1});
        my %nothidden;
        if ($coursehash{'nothideprivileged'}) {
            foreach my $item (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                my $user;
                if ($item =~ /:/) {
                    $user = $item;
                } else {
                    $user = join(':',split(/[\@]/,$item));
                }
                $nothidden{$user} = 1;
            }
        }
        foreach my $user (keys(%advrolehash)) {
            my ($uname,$udom,$rest) = split(/:/,$user,3);
            next if ($users{$uname.':'.$udom});
            my @privdoms = ($cdom);
            if ($udom ne $cdom) {
                @privdoms = ($udom,$cdom);
            }
            if (&Apache::lonnet::privileged($uname,$udom,\@privdoms)) {
                unless ($nothidden{$uname.':'.$udom}) {
                    next;
                }
            }
            $users{$uname.':'.$udom} = 1;
        }
        my $classlist=&Apache::loncoursedata::get_classlist($cdom,$cnum);
        if (ref($classlist) eq 'HASH') {
            foreach my $student (keys(%{$classlist})) {
                next if ($users{$student});
                if ($student =~/^($match_username)\:($match_domain)$/) {
                    my ($tuname,$tudom)=($1,$2);
                    my @privdoms = ($cdom);
                    if ($tudom ne $cdom) {
                        @privdoms = ($tudom,$cdom);
                    }
                    if (&Apache::lonnet::privileged($tuname,$tudom,\@privdoms)) {
                        unless ($nothidden{$student}) {
                            next;
                        }
                    }
                    $users{$student} = 1;
                }
            }
        }
    }
}

my %lastlogin;
my (%numlib,%domservers,%filter);
$filter{'action'} = 'Role';
my $possdom;
if ($domfilter) {
    $possdom = $domfilter;
} else {
    $possdom = $possdomstr;
}
foreach my $dom (@domains) {
    my %servers = &Apache::lonnet::get_servers($dom,'library');
    $numlib{$dom} = scalar(keys(%servers));
    if ($numlib{$dom} > 1) {
        $domservers{$dom} = %servers;
    }
}
foreach my $user (sort(keys(%users))) {
    my ($uname,$udom) = split(/:/,$user);
    if (grep(/^\Q$udom\E$/,@domains)) {
        if ($numlib{$udom} == 1) {
            &readlocalactivitylog($uname,$udom,$possdom,$timefilter,$crsfilter,\%lastlogin);
        } else {
            if (ref($domservers{$udom}) eq 'HASH') {
                my $uhome = &Apache::lonnet::homeserver($uname,$udom);
                if ($uhome ne 'no_host') {
                    if ($domservers{$udom}{$uhome}) {
                        &readlocalactivitylog($uname,$udom,$possdom,$timefilter,$crsfilter,\%lastlogin);
                    } else {
                        &readremoteactivitylog($uname,$udom,$possdom,$timefilter,$crsfilter,\%filter,
                                               \%lastlogin);
                    }
                }
            }
        }
    } else {
        my $uhome = &Apache::lonnet::homeserver($uname,$udom);
        if ($uhome ne 'no_host') {
            &readremoteactivitylog($uname,$udom,$possdom,$timefilter,$crsfilter,\%filter,\%lastlogin);
        }
    }
}

foreach my $key (sort(keys(%lastlogin))) {
    if (ref($lastlogin{$key}) eq 'HASH') {
        if ($key =~ /^($match_domain)_($match_courseid)$/) {
            my $cdom = $1;
            my $cnum = $2;
            my $putresult = &Apache::lonnet::put('nohist_crslastlogin',$lastlogin{$key},
                                                 $cdom,$cnum);
            if ($putresult eq 'ok') {
                print $fh "stored last login data for $key\n";
            }
        }
    }
}

## Finished!
print $fh "==== buildlastlogindb.pl completed ".localtime()." ====\n";
close($fh);
exit;

sub readlocalactivitylog {
    my($uname,$udom,$possdomstr,$timefilter,$crsfilter,$lastlogin) = @_;
    my $path = &propath($udom,$uname);
    my $posscnum;
    if ($crsfilter eq '.') {
        $posscnum = $match_courseid;
    } else {
        $posscnum = $crsfilter;
    } 
    if (-e "$path/activity.log") {
        if (open(my $fh,"<$path/activity.log")) {
            my @lines = <$fh>;
            @lines = reverse(@lines);
            foreach my $line (@lines) {
                chomp($line);
                if ($line =~ m{^(\d+):\w+:Role\s+(cc|in|ta|ep|st|ad)\./($possdomstr)/($posscnum)/?([^/]*)}) {
                    if (($timefilter > 1) && ($1<$timefilter)) {
                        last;
                    }
                    if (ref($lastlogin->{$3.'_'.$4}) eq 'HASH') {
                        if ($lastlogin->{$3.'_'.$4}{$uname.':'.$udom.':'.$5.':'.$2}) {
                            if ($crsfilter ne '.') {
                                last;
                            } else {
                                next;
                            }
                        }
                    }
                    $lastlogin->{$3.'_'.$4}{$uname.':'.$udom.':'.$5.':'.$2} = $1;
                }
            }
            close($fh);
        }
    }
    return;
}

sub readremoteactivitylog {
    my ($uname,$udom,$possdomstr,$timefilter,$crsfilter,$filter,$lastlogin) = @_;
    if (ref($filter) eq 'HASH') {
        my %filters = %{$filter};
        my $result = &Apache::lonnet::userlog_query($uname,$udom,%filters);
        my $posscnum;
        if ($crsfilter eq '.') {
            $posscnum = $match_courseid;
        } else {
            $posscnum = $crsfilter;
        }
        my $now = time;
        if (($result ne 'file_error') && ($result ne 'error: reply_file_error') && ($result !~ /^timeout:/)) {
            my $now = time;
            foreach my $item (map { &unescape($_); } (split(/&/,$result))) {
                if ($item =~ m{^(\d+):\w+:Role\s+(cc|in|ta|ep|st|ad)\./($possdomstr)/($posscnum)/?([^/]*)}) {
                    if (($timefilter > 1) && ($1<$timefilter)) {
                        last;
                    }
                    if (ref($lastlogin->{$3.'_'.$4}) eq 'HASH') {
                        if ($lastlogin->{$3.'_'.$4}{$uname.':'.$udom.':'.$5.':'.$2}) {
                            if ($crsfilter ne '.') {
                                last;
                            } else {
                                next;
                            }
                        }
                    }
                    $lastlogin->{$3.'_'.$4}{$uname.':'.$udom.':'.$5.':'.$2} = $1;
                }
            }
        }
    }
    return;
}


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>