Annotation of loncom/auth/lonauth.pm, revision 1.1

1.1     ! albertel    1: # The LearningOnline Network
        !             2: # User Authentication Module
        !             3: # 5/21/99,5/22,5/25,5/26,5/27,5/29,6/2,6/11,6/14,6/15 Gerd Kortemeyer
        !             4: 
        !             5: package Apache::lonauth;
        !             6: 
        !             7: use Apache::Constants qw(:common);
        !             8: use Apache::File;
        !             9: use CGI qw(:standard);
        !            10: use CGI::Cookie();
        !            11: use Apache::lonnet();
        !            12: 
        !            13: # ------------------------------------------------------------ Successful login
        !            14: 
        !            15: sub success {
        !            16:     my ($r, $lowerurl, $username, $domain, $authhost) = @_;
        !            17:     my $lonids=$r->dir_config('lonIDsDir');
        !            18: # See if old ID present, but overlooked
        !            19:     my $cookie;
        !            20:     if ($cookie=<$lonids/$username\_*\_$domain\_$authhost.id>) {
        !            21: 	$cookie=~s/\.id//;
        !            22:         $cookie=~s/$lonids\///;
        !            23:     } else {
        !            24:         my $now=time;
        !            25:         $cookie="$username\_$now\_$domain\_$authhost";
        !            26:         {
        !            27: 	    my $idf=Apache::File->new(">$lonids/$cookie.id");
        !            28:             print $idf "Name: $username\n";
        !            29:         }
        !            30:     }
        !            31:     $cookie="lonID=$cookie; path=/";
        !            32:     $r->send_cgi_header(<<ENDHEADER);
        !            33: Content-type: text/html
        !            34: Set-cookie: $cookie
        !            35: 
        !            36: ENDHEADER
        !            37:     $r->print(<<ENDSUCCESS);
        !            38: <html>
        !            39: <head>
        !            40: <title>Successful Login to the LearningOnline Network</title>
        !            41: </head>
        !            42: <frameset rows="80,*" border=0>
        !            43: <frame scrolling="no" name="loncontrol" src="/adm/menu">
        !            44: <frame name="loncontent" src="$lowerurl">
        !            45: </frameset>
        !            46: </html>
        !            47: ENDSUCCESS
        !            48: }
        !            49: 
        !            50: # --------------------------------------------------------------- Failed login!
        !            51: 
        !            52: sub failed {
        !            53:     my ($r,$message) = @_;
        !            54:     $r->send_cgi_header(<<ENDFHEADER);
        !            55: Content-type: text/html
        !            56: 
        !            57: ENDFHEADER
        !            58:     $r->print(<<ENDFAILED);
        !            59: <html>
        !            60: <head>
        !            61: <title>Unsuccessful Login to the LearningOnline Network</title>
        !            62: </head>
        !            63: <html>
        !            64: <body bgcolor="#FFFFFF">
        !            65: <h1>Sorry ...</h1>
        !            66: <h2>$message to use the Learning<i>Online</i> Network</h2>
        !            67: </body>
        !            68: </html>
        !            69: ENDFAILED
        !            70: }
        !            71: 
        !            72: # ---------------------------------------------------------------- Main handler
        !            73: 
        !            74: sub handler {
        !            75:     my $r = shift;
        !            76: 
        !            77:     my $buffer;
        !            78:     $r->read($buffer,$r->header_in('Content-length'));
        !            79:     my @pairs=split(/&/,$buffer);
        !            80:     my $pair; my $name; my $value; my %FORM;
        !            81:     foreach $pair (@pairs) {
        !            82:        ($name,$value) = split(/=/,$pair);
        !            83:        $FORM{$name}=$value;
        !            84:     } 
        !            85: 
        !            86:     if ((!$FORM{'uname'}) || (!$FORM{'upass'}) || (!$FORM{'udom'})) {
        !            87: 	failed($r,'Username, password and domain need to be specified');
        !            88:         return OK;
        !            89:     }
        !            90:     $FORM{'uname'} =~ s/\W//g;
        !            91:     $FORM{'upass'} =~ s/\W//g;
        !            92:     $FORM{'udom'}  =~ s/\W//g;
        !            93: 
        !            94:     my $role   = $r->dir_config('lonRole');
        !            95:     my $domain = $r->dir_config('lonDefDomain');
        !            96:     my $prodir = $r->dir_config('lonUsersDir');
        !            97: 
        !            98: # ---------------------------------------------------------------- Authenticate
        !            99:     my $authhost=Apache::lonnet::authenticate($FORM{'uname'},
        !           100:                                               $FORM{'upass'},
        !           101:                                               $FORM{'udom'});
        !           102:     
        !           103: # --------------------------------------------------------------------- Failed?
        !           104: 
        !           105:     if ($authhost eq 'no_host') {
        !           106: 	failed($r,'Username and/or password could not be authenticated');
        !           107:         return OK;
        !           108:     }
        !           109: 
        !           110:     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
        !           111:     my $lonurl=$cookies{'lonURL'};
        !           112:     if (!$lonurl) { failed($r,'Cookies need to be activated'); return OK; }
        !           113:     my $lowerurl=$lonurl->value;
        !           114: 
        !           115:     success($r,$lowerurl,$FORM{'uname'},$FORM{'udom'},$authhost);
        !           116:     return OK;
        !           117: }
        !           118: 
        !           119: 1;
        !           120: __END__

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