loncom/auth/lonauth.pm - view

File: [LON-CAPA] / loncom / auth / lonauth.pm
Revision 1.43: download - view: text, annotated - select for diffs
Sun Mar 2 02:16:53 2003 UTC (21 years, 3 months ago) by www
Branches: MAIN
CVS tags: HEAD

Bug #1285
loncron cleans login tokens after a day.
* lonauth now give better error messages
* lonlogin refreshes the login page after a day
  (so the "expired" error should never happen anyway)
* loginproblems was adapted

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