[LON-CAPA-cvs] cvs: modules /msu/sentinel sentinelonly.pm

raeburn lon-capa-cvs@mail.lon-capa.org
Mon, 08 Jan 2007 22:41:18 -0000

This is a MIME encoded message

Content-Type: text/plain

raeburn		Mon Jan  8 17:41:18 2007 EDT

  Added files:                 
    /modules/msu/sentinel	sentinelonly.pm 
  Display informative page to MSU users when SSO-based authentication is successful but there is no corresponding account in the MSU LON-CAPA domain.
  Username of successfully authenticated user from SSOUserUnknown in $r->subprocess_env set by lonacc which does an internal redirect to load this page. 
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20070108174118.txt"

Index: modules/msu/sentinel/sentinelonly.pm
+++ modules/msu/sentinel/sentinelonly.pm
# Display informative page to MSU users when SSO-based authentication
# is successful but there is no corresponding account in the 
# MSU LON-CAPA domain.
# 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
# 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/
package Apache::sentinelonly;

use strict;
use lib qw(/home/httpd/lib/perl);
use Apache::Constants qw(:common);
use Apache::loncommon;
use Apache::lonnet;
use Apache::lonlocal;
use Apache::lonacc;
use Apache::coursecatalog;
use HTTP::Request::Common;
use LWP::UserAgent;

sub handler {
    my ($r) = @_;
    if ($r->header_only) {
        return OK;


    my $username = $r->subprocess_env->get('REDIRECT_SSOUserUnknown');
    my $domain = $r->subprocess_env->get('REDIRECT_SSOUserDomain');
    my $domdesc = $Apache::lonnet::domaindescription{$domain};

    my %add_entries = (topmargin    => "0",
                       marginheight => "0",);
    my $start_page =
        &Apache::loncommon::start_page("MSU Single SignOn",'',
                                        'add_entries' => \%add_entries,
                                        'no_inline_link'   => 1,});
    $r->print(&mt("You successfully logged in via <b>Sentinel</b>, the MSUNet ID login service at <b>[_1]</b>, with a username of <b>[_2]</b>.",$domdesc,$username).'<br />'.&mt('However, LON-CAPA does <b>not</b> recognize your username as valid.').'<br /><br />'.&mt('If you are MSU <b>faculty</b> or <b>staff</b> this may be because you use a LON-CAPA account which is different from your MSUNet ID.').' '.&mt('If so, please login <a href="[_1]">here</a>.','/adm/login').'<br /><br />'.&mt('If you are an MSU <b>student</b> ...').'<br />');

    my $usercourses = &query_LC_classlists($username,$domain);
    if ($usercourses != -1) {
        if ($usercourses eq '') {
            $r->print(&mt('You are <b>not</b> a registered student in any official [_1] courses from the last two years which are using LON-CAPA.',$domdesc).'<br />'.&mt('As a result a LON-CAPA user account has <b>not</b> been created for you.'));
        } else {
            $usercourses =~tr/A-Z/a-z/;
            my $output = &check_courses($domain,$usercourses);
            if ($output) {
                $r->print(&mt('The following is a list of your section affiliation in all official courses which used LON-CAPA in the last two years in which you were a registered student.').'<br /><br />');
            } else {
                $r->print(&mt('You are not currently in any sections of courses for which automatic enrollment in the corresponding LON-CAPA course is configured.').'<br />'.&mt('As a result a LON-CAPA user account has <b>not</b> yet been created for you.')); 
        $r->print('<br /><br />');
    &Apache::lonnet::logthis("No LON-CAPA account for $username:$domain authenticated by SSO");
    my $catalogurl = '/adm/coursecatalog';
    my $ssologout = 'https://login.msu.edu/Logout.asp';
    $r->print(&mt('If you are registered in a course at MSU which will be using LON-CAPA, an account for your MSUNet ID may be lacking for one of the following reasons:').'
     <li>'.&mt('The course has yet to be created.').'</li>
     <li>'.&mt('Automatic enrollment of registered students has not been enabled for the course.').'</li>
     <li>'.&mt('You are in a section of course for which automatic enrollment in the corresponding LON-CAPA course is not active.').'</li>  
     <li>'.&mt('The start date for automated enrollment has yet to be reached.').'</li>
     <li>'.&mt('You registered for the course within the last 48 hours - there is a time lag between the time you register, and the time this information becomes available for the nightly update of LON-CAPA course rosters.').'</li>
     </ul>'.&mt("The <a href=\"[_1]\"/>Course Catalog</a> provides information about all MSU courses for which LON-CAPA courses have been created.",$catalogurl));
    $r->print('<br /><br />'.&mt("<a href=\"[_1]\">Logout from MSU Single SignOn</a>?",$ssologout)); 
    return OK;

sub query_LC_classlists {
    my ($user,$domain) = @_;
    my $server =$Apache::lonnet::hostname{$Apache::lonnet::domain_primary{$domain}};
    my $url='http://'.$server.'/cgi-bin/LC_classlist_check.pl?username='.$user;
    my $request = new HTTP::Request;
    $request = GET $url;
    my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');
    my $dir = $perlvarref->{'lonDaemons'};
    my $buffer = <FILE>;
    my ($admuser,$admpass) = split(/:/,$buffer);
    my $res = LWP::UserAgent->new->request($request);
    if ($res->is_success) {
        my $dump = $res->content;
        return $dump;
    } else {
        &Apache::lonnet::logthis("An error occurred checking the classlist database: $res->error"); 
        return -1;

sub check_courses {
    my ($dom,$usercourses) = @_;
    my ($output,%matches,%stucourse,@lines,%matchedsec);
    my ($instcodes,$allcourses);
    if ($usercourses =~ /\n/s) {
        @lines = split/\n/,$usercourses;
    } else {
        @lines = ($usercourses);
    if (@lines > 0) {
        ($instcodes,$allcourses) = &get_official_courses($dom);
        foreach my $item (@lines) {
            my ($code,$seclist) = split(/=/,$item);
            my @sections = split(/:/,$seclist);
            if (defined($instcodes->{$code})) {
                my @sections = split(/:/,$seclist);
                if (ref($stucourse{$code}) eq 'ARRAY') {
                    foreach my $sec (@sections) {
                        if (!grep(/^\Q$sec\E$/,@{$stucourse{$code}{sections}})) {
                } else {
                    @{$stucourse{$code}{sections}} = @sections;
    if (keys(%stucourse) > 0) {
        foreach my $code (keys(%stucourse)) {
            if (ref($instcodes) eq 'HASH') {  
                foreach my $cid (@{$instcodes->{$code}}) {
                    my %courseinfo =
                        &Apache::lonnet::coursedescription($cid,{'one_time' => 1});
                    my ($instseclist,$numsec) = 
                    my @instsecs = split(/, /,$instseclist);
                    foreach my $stusec (@{$stucourse{$code}{sections}}) {
                        if (grep(/^\Q$stusec\E$/,@instsecs)) {  
                            $matches{$cid} = $allcourses->{$cid};
    if (keys(%matches) > 0) {
        $output = &Apache::coursecatalog::construct_data_table(1,\%matches,1,\%matchedsec);
    return $output;

sub get_official_courses {
    my ($dom) = @_;
    my %allcourses = 
    my %instcodes;
    foreach my $cid (keys(%allcourses)) {
        my ($description,$code,$other) = split(/:/,$allcourses{$cid},3);
        if ($code ne '') {
    return (\%instcodes,\%allcourses);