loncom/auth/lonauth.pm - view

File: [LON-CAPA] / loncom / auth / lonauth.pm
Revision 1.35: download - view: text, annotated - select for diffs
Fri Jan 31 21:46:36 2003 UTC (21 years, 3 months ago) by www
Branches: MAIN
CVS tags: HEAD

Attempt to work on bug #1205 by changing the timing of events at login for the
remote. Also, trying to isolate remote-related code into lonmenu.pm so that
alternative remotes/navigation become easier to implement later.

1: # The LearningOnline Network 2: # User Authentication Module 3: # 4: # $Id: lonauth.pm,v 1.35 2003/01/31 21:46:36 www 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: # 5/21/99,5/22,5/25,5/26,5/27,5/29,6/2,6/11,6/14,6/15 29: # 16/11,12/16, 30: # 1/14,2/24,2/28,2/29,3/7,5/29,5/30,5/31,6/1,6/5,6/29, 31: # 7/1,7/10,10/2,10/5,10/9,10/26,10/30,11/10, 32: # 05/28,05/29 Gerd Kortemeyer 33: # 07/24 Scott Harrison 34: # 07/28,08/03 Gerd Kortemeyer 35: # 8/15 Scott Harrison 36: # 8/20 Gerd Kortemeyer 37: 38: package Apache::lonauth; 39: 40: use strict; 41: use Apache::Constants qw(:common); 42: use Apache::File; 43: use CGI qw(:standard); 44: use CGI::Cookie(); 45: use DynaLoader; # for Crypt::DES version 46: use Crypt::DES; 47: use Apache::lonnet(); 48: use Apache::lonmenu(); 49: use Fcntl qw(:flock); 50: # ------------------------------------------------------------ Successful login 51: 52: sub success { 53: my ($r, $username, $domain, $authhost,$lowerurl) = @_; 54: my $lonids=$r->dir_config('lonIDsDir'); 55: 56: # See if old ID present, if so, remove 57: 58: my $filename; 59: opendir(DIR,$lonids); 60: while ($filename=readdir(DIR)) { 61: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) { 62: unlink($lonids.'/'.$filename); 63: } 64: } 65: closedir(DIR); 66: 67: # Give them a new cookie 68: 69: my $cookie; 70: my $now=time; 71: $cookie="$username\_$now\_$domain\_$authhost"; 72: 73: # Initialize roles 74: 75: my $userroles=Apache::lonnet::rolesinit($domain,$username,$authhost); 76: 77: # ------------------------------------ Check browser type and MathML capability 78: 79: my @browsertype=split(/\&/,$r->dir_config("lonBrowsDet")); 80: my %mathcap=split(/\&/,$r->dir_config("lonMathML")); 81: my $httpbrowser=$ENV{"HTTP_USER_AGENT"}; 82: my $i; 83: my $clientbrowser='unknown'; 84: my $clientversion='0'; 85: my $clientmathml=''; 86: my $clientunicode='0'; 87: for ($i=0;$i<=$#browsertype;$i++) { 88: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]); 89: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) { 90: $clientbrowser=$bname; 91: $httpbrowser=~/$vreg/i; 92: $clientversion=$1; 93: $clientmathml=($clientversion>=$minv); 94: $clientunicode=($clientversion>=$univ); 95: } 96: } 97: my $clientos='unknown'; 98: if (($httpbrowser=~/linux/i) || 99: ($httpbrowser=~/unix/i) || 100: ($httpbrowser=~/ux/i) || 101: ($httpbrowser=~/solaris/i)) { $clientos='unix'; } 102: if (($httpbrowser=~/vax/i) || 103: ($httpbrowser=~/vms/i)) { $clientos='vms'; } 104: if ($httpbrowser=~/next/i) { $clientos='next'; } 105: if (($httpbrowser=~/mac/i) || 106: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; } 107: if ($httpbrowser=~/win/i) { $clientos='win'; } 108: if ($httpbrowser=~/embed/i) { $clientos='pda'; } 109: 110: # ------------------------------------------------------------- Get environment 111: 112: my $userenv; 113: my %userenv=Apache::lonnet::dump('environment',$domain,$username); 114: my ($tmp) = keys(%userenv); 115: if ($tmp !~ /^(con_lost|error|no_such_host)/i) { 116: foreach my $key (keys(%userenv)) { 117: $userenv.="environment.$key=$userenv{$key}\n"; 118: } 119: } 120: # --------------------------------------------------------- Write first profile 121: 122: { 123: my $idf=Apache::File->new(">$lonids/$cookie.id"); 124: unless (flock($idf,LOCK_EX)) { 125: &Apache::lonnet::logthis("<font color=blue>WARNING: ". 126: 'Could not obtain exclusive lock in lonauth: '.$!); 127: $idf->close(); 128: return 'error: '.$!; 129: } 130: if ($userenv ne '') { print $idf "$userenv\n"; } 131: print $idf "user.name=$username\n"; 132: print $idf "user.domain=$domain\n"; 133: print $idf "user.home=$authhost\n"; 134: print $idf "browser.type=$clientbrowser\n"; 135: print $idf "browser.version=$clientversion\n"; 136: print $idf "browser.mathml=$clientmathml\n"; 137: print $idf "browser.unicode=$clientunicode\n"; 138: print $idf "browser.os=$clientos\n"; 139: print $idf "request.course.fn=\n"; 140: print $idf "request.course.uri=\n"; 141: print $idf "request.course.sec=\n"; 142: print $idf "request.role=cm\n"; 143: print $idf "request.host=$ENV{'HTTP_HOST'}\n"; 144: if ($userroles ne '') { print $idf "$userroles"; } 145: $idf->close(); 146: } 147: $ENV{'request.role'}='cm'; 148: $ENV{'browser.type'}=$clientbrowser; 149: # -------------------------------------------------------------------- Log this 150: 151: &Apache::lonnet::log($domain,$username,$authhost, 152: "Login $ENV{'REMOTE_ADDR'}"); 153: 154: # ------------------------------------------------- Check for critical messages 155: 156: my @what=&Apache::lonnet::dump('critical',$domain,$username); 157: if ($what[0]) { 158: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) { 159: $lowerurl='/adm/email?critical=display'; 160: } 161: } 162: 163: # ------------------------------------------------------------ Get cookie ready 164: 165: $cookie="lonID=$cookie; path=/"; 166: # -------------------------------------------------------- Menu script and info 167: my $windowinfo=&Apache::lonmenu::open($clientos); 168: my $startupremote=&Apache::lonmenu::startupremote($lowerurl); 169: my $setflags=&Apache::lonmenu::setflags(); 170: my $maincall=&Apache::lonmenu::maincall(); 171: # ------------------------------------------------- Output for successful login 172: 173: $r->send_cgi_header(<<ENDHEADER); 174: Content-type: text/html 175: Set-cookie: $cookie 176: 177: ENDHEADER 178: $r->print(<<ENDSUCCESS); 179: <html> 180: <head> 181: <title>Successful Login to the LearningOnline Network with CAPA</title> 182: $startupremote 183: </head> 184: <body bgcolor="#FFFFFF"> 185: $setflags 186: $windowinfo 187: <h1>Welcome!</h1> 188: Welcome to the Learning<i>Online</i> Network with CAPA. 189: Please wait while your session 190: is being set up.<p> 191: <a href="/adm/loginproblems.html">Problems?</a></p> 192: $maincall 193: </body> 194: </html> 195: ENDSUCCESS 196: } 197: 198: # --------------------------------------------------------------- Failed login! 199: 200: sub failed { 201: my ($r,$message) = @_; 202: $r->send_cgi_header(<<ENDFHEADER); 203: Content-type: text/html 204: 205: ENDFHEADER 206: $r->print(<<ENDFAILED); 207: <html> 208: <head> 209: <title>Unsuccessful Login to the LearningOnline Network with CAPA</title> 210: </head> 211: <html> 212: <body bgcolor="#FFFFFF"> 213: <h1>Sorry ...</h1> 214: <h2>$message to use the Learning<i>Online</i> Network with CAPA</h2> 215: </body> 216: </html> 217: ENDFAILED 218: } 219: 220: # ---------------------------------------------------------------- Main handler 221: 222: sub handler { 223: my $r = shift; 224: 225: my $buffer; 226: $r->read($buffer,$r->header_in('Content-length')); 227: my @pairs=split(/&/,$buffer); 228: my $pair; my $name; my $value; my %FORM; 229: foreach $pair (@pairs) { 230: ($name,$value) = split(/=/,$pair); 231: $value =~ tr/+/ /; 232: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; 233: $FORM{$name}=$value; 234: } 235: 236: if ((!$FORM{'uname'}) || (!$FORM{'upass'}) || (!$FORM{'udom'})) { 237: failed($r,'Username, password and domain need to be specified'); 238: return OK; 239: } 240: $FORM{'uname'} =~ s/\W//g; 241: $FORM{'udom'} =~ s/\W//g; 242: 243: my $role = $r->dir_config('lonRole'); 244: my $domain = $r->dir_config('lonDefDomain'); 245: my $prodir = $r->dir_config('lonUsersDir'); 246: 247: # ---------------------------------------- Get the information from login token 248: 249: my $tmpinfo=Apache::lonnet::reply('tmpget:'.$FORM{'logtoken'}, 250: $FORM{'serverid'}); 251: 252: if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) { 253: failed($r,'Login token missing, inaccessible or expired'); 254: return OK; 255: } 256: 257: my ($key,$firsturl)=split(/&/,$tmpinfo); 258: 259: my $keybin=pack("H16",$key); 260: 261: my $cipher; 262: if ($Crypt::DES::VERSION>=2.03) { 263: $cipher=new Crypt::DES $keybin; 264: } 265: else { 266: $cipher=new DES $keybin; 267: } 268: 269: my $upass=$cipher->decrypt( 270: unpack("a8",pack("H16",substr($FORM{'upass'},0,16)))); 271: 272: $upass.=$cipher->decrypt( 273: unpack("a8",pack("H16",substr($FORM{'upass'},16,16)))); 274: 275: $upass=substr($upass,1,ord(substr($upass,0,1))); 276: 277: # ---------------------------------------------------------------- Authenticate 278: my $authhost=Apache::lonnet::authenticate($FORM{'uname'}, 279: $upass, 280: $FORM{'udom'}); 281: 282: # --------------------------------------------------------------------- Failed? 283: 284: if ($authhost eq 'no_host') { 285: failed($r,'Username and/or password could not be authenticated'); 286: return OK; 287: } 288: 289: if (($firsturl eq '') || ($firsturl eq '/adm/logout')) { 290: $firsturl='/adm/roles'; 291: } 292: 293: success($r,$FORM{'uname'},$FORM{'udom'},$authhost,$firsturl); 294: return OK; 295: } 296: 297: 1; 298: __END__ 299: 300: