File:  [LON-CAPA] / loncom / auth / lonlogin.pm
Revision 1.138: download - view: text, annotated - select for diffs
Fri May 21 15:54:34 2010 UTC (14 years ago) by bisitz
Branches: MAIN
CVS tags: HEAD
Bug 6271, Bug 5577:
Get rid of user authentication image on login page (always use text version)
including all corresponding configuration settings.
Although the user interface is cleaned up and functional, the internal domain configuration cleanup could be improved.

    1: # The LearningOnline Network
    2: # Login Screen
    3: #
    4: # $Id: lonlogin.pm,v 1.138 2010/05/21 15:54:34 bisitz 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: 
   29: package Apache::lonlogin;
   30: 
   31: use strict;
   32: use Apache::Constants qw(:common);
   33: use Apache::File ();
   34: use Apache::lonnet;
   35: use Apache::loncommon();
   36: use Apache::lonauth();
   37: use Apache::lonlocal;
   38: use Apache::migrateuser();
   39: use lib '/home/httpd/lib/perl/';
   40: use LONCAPA;
   41:  
   42: sub handler {
   43:     my $r = shift;
   44: 
   45:     &Apache::loncommon::get_unprocessed_cgi
   46: 	(join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
   47: 	      $ENV{'REDIRECT_QUERY_STRING'}),
   48: 	 ['interface','username','domain','firsturl','localpath','localres',
   49: 	  'token','role','symb']);
   50:     if (!defined($env{'form.firsturl'})) {
   51:         &Apache::lonacc::get_posted_cgi($r,['firsturl']);
   52:     }
   53: 
   54: # -- check if they are a migrating user
   55:     if (defined($env{'form.token'})) {
   56: 	return &Apache::migrateuser::handler($r);
   57:     }
   58: 
   59:     &Apache::loncommon::no_cache($r);
   60:     &Apache::lonlocal::get_language_handle($r);
   61:     &Apache::loncommon::content_type($r,'text/html');
   62:     $r->send_http_header;
   63:     return OK if $r->header_only;
   64: 
   65: 
   66: # Are we re-routing?
   67:     if (-e '/home/httpd/html/lon-status/reroute.txt') {
   68: 	&Apache::lonauth::reroute($r);
   69: 	return OK;
   70:     }
   71: 
   72: 
   73: # -------------------------------- Prevent users from attempting to login twice
   74:     my $handle = &Apache::lonnet::check_for_valid_session($r);
   75:     if ($handle ne '') {
   76:         my $lonidsdir=$r->dir_config('lonIDsDir');
   77:         if ($handle=~/^publicuser\_/) {
   78: # For "public user" - remove it, we apparently really want to login
   79: 	    unlink($r->dir_config('lonIDsDir')."/$handle.id");
   80:         } else {
   81: # Indeed, a valid token is found
   82:             &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
   83: 	    my $start_page = 
   84: 	        &Apache::loncommon::start_page('Already logged in');
   85: 	    my $end_page = 
   86: 	        &Apache::loncommon::end_page();
   87:             my $dest = '/adm/roles';
   88:             if ($env{'form.firsturl'} ne '') {
   89:                 $dest = $env{'form.firsturl'}; 
   90:             }
   91: 	    $r->print(
   92:                   $start_page
   93:                  .'<h1>'.&mt('You are already logged in!').'</h1>'
   94:                  .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].',
   95:                   '<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>').'</p>'
   96:                  .$end_page
   97:                  );
   98:             return OK;
   99:         }
  100:     }
  101: 
  102: # ---------------------------------------------------- No valid token, continue
  103: 
  104:  # ---------------------------- Not possible to really login to domain "public"
  105:     if ($env{'form.domain'} eq 'public') {
  106: 	$env{'form.domain'}='';
  107: 	$env{'form.username'}='';
  108:     }
  109: # ----------------------------------------------------------- Process Interface
  110:     $env{'form.interface'}=~s/\W//g;
  111: 
  112:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
  113: 
  114:     my $iconpath= 
  115: 	&Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));
  116: 
  117:     my $lonhost = $r->dir_config('lonHostID');
  118:     my $domain = &Apache::lonnet::default_login_domain();
  119:     if ($lonhost ne '') {
  120:         my $redirect = &check_loginvia($domain,$lonhost);
  121:         if ($redirect) {
  122:             $r->print($redirect);
  123:             return OK;
  124:         } 
  125:     }
  126: 
  127:     if (($env{'form.domain'}) && 
  128: 	(&Apache::lonnet::domain($env{'form.domain'},'description'))) {
  129: 	$domain=$env{'form.domain'};
  130:     }
  131:     my $role    = $r->dir_config('lonRole');
  132:     my $loadlim = $r->dir_config('lonLoadLim');
  133:     my $servadm = $r->dir_config('lonAdmEMail');
  134:     my $tabdir  = $r->dir_config('lonTabDir');
  135:     my $include = $r->dir_config('lonIncludes');
  136:     my $expire  = $r->dir_config('lonExpire');
  137:     my $version = $r->dir_config('lonVersion');
  138:     my $host_name = &Apache::lonnet::hostname($lonhost);
  139: 
  140: # --------------------------------------------- Default values for login fields
  141: 
  142:     my $authusername=($env{'form.username'}?$env{'form.username'}:'');
  143:     my $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain);
  144: 
  145: # ---------------------------------------------------------- Determine own load
  146:     my $loadavg;
  147:     {
  148: 	my $loadfile=Apache::File->new('/proc/loadavg');
  149: 	$loadavg=<$loadfile>;
  150:     }
  151:     $loadavg =~ s/\s.*//g;
  152:     my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);
  153:     my $userloadpercent=&Apache::lonnet::userload();
  154: 
  155: # ------------------------------------------------------- Do the load balancing
  156:     my $otherserver= &Apache::lonnet::absolute_url($host_name);
  157:     my $firsturl=
  158:     ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});
  159: # ---------------------------------------------------------- Are we overloaded?
  160:     if ((($userloadpercent>100.0)||($loadpercent>100.0))) {
  161:         my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent);
  162: 	if ($unloaded) { $otherserver=$unloaded; }
  163:     }
  164: 
  165: # ----------------------------------------------------------- Get announcements
  166:     my $announcements=&Apache::lonnet::getannounce();
  167: # -------------------------------------------------------- Set login parameters
  168: 
  169:     my @hexstr=('0','1','2','3','4','5','6','7',
  170:                 '8','9','a','b','c','d','e','f');
  171:     my $lkey='';
  172:     for (0..7) {
  173:         $lkey.=$hexstr[rand(15)];
  174:     }
  175: 
  176:     my $ukey='';
  177:     for (0..7) {
  178:         $ukey.=$hexstr[rand(15)];
  179:     }
  180: 
  181:     my $lextkey=hex($lkey);
  182:     if ($lextkey>2147483647) { $lextkey-=4294967296; }
  183: 
  184:     my $uextkey=hex($ukey);
  185:     if ($uextkey>2147483647) { $uextkey-=4294967296; }
  186: 
  187: # -------------------------------------------------------- Store away log token
  188:     my $tokenextras;
  189:     if ($env{'form.role'}) {
  190:         $tokenextras = '&role='.&escape($env{'form.role'});
  191:     }
  192:     if ($env{'form.symb'}) {
  193:         if (!$tokenextras) {
  194:             $tokenextras = '&';
  195:         }
  196:         $tokenextras .= '&symb='.&escape($env{'form.symb'});
  197:     }
  198:     my $logtoken=Apache::lonnet::reply(
  199:        'tmpput:'.$ukey.$lkey.'&'.$firsturl.$tokenextras,
  200:        $lonhost);
  201: 
  202: # ------------------- If we cannot talk to ourselves, we are in serious trouble
  203: 
  204:     if ($logtoken eq 'con_lost') {
  205:         my $spares='';
  206: 	my $last;
  207:         foreach my $hostid (sort
  208: 			    {
  209: 				&Apache::lonnet::hostname($a) cmp
  210: 				    &Apache::lonnet::hostname($b);
  211: 			    }
  212: 			    keys(%Apache::lonnet::spareid)) {
  213:             next if ($hostid eq $lonhost);
  214: 	    my $hostname = &Apache::lonnet::hostname($hostid);
  215: 	    next if ($last eq $hostname);
  216:             $spares.='<br /><font size="+1"><a href="http://'.
  217:                 $hostname.
  218:                 '/adm/login?domain='.$authdomain.'">'.
  219:                 $hostname.'</a>'.
  220:                 ' '.&mt('(preferred)').'</font>'.$/;
  221: 	    $last=$hostname;
  222:         }
  223: $spares.= '<br />';
  224: my %all_hostnames = &Apache::lonnet::all_hostnames();
  225: foreach my $hostid (sort
  226: 		    {
  227: 			&Apache::lonnet::hostname($a) cmp
  228: 			    &Apache::lonnet::hostname($b);
  229: 		    }
  230: 		    keys(%all_hostnames)) {
  231:     next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid});
  232:     my $hostname = &Apache::lonnet::hostname($hostid);
  233:     next if ($last eq $hostname);
  234:     $spares.='<br /><a href="http://'.
  235: 	$hostname.
  236: 	'/adm/login?domain='.$authdomain.'">'.
  237: 	$hostname.'</a>';
  238:     $last=$hostname;
  239: }
  240: $r->print(
  241:    '<html>'
  242:   .'<head><title>'
  243:   .&mt('The LearningOnline Network with CAPA')
  244:   .'</title></head>'
  245:   .'<body bgcolor="#FFFFFF">'
  246:   .'<h1>'.&mt('The LearningOnline Network with CAPA').'</h1>'
  247:   .'<img src="/adm/lonKaputt/lonlogo_broken.gif" align="right" />'
  248:   .'<h3>'.&mt('This LON-CAPA server is temporarily not available for login.').'</h3>'
  249:   .'<p>'.&mt('Please attempt to login to one of the following servers:').'</p>'
  250:   .$spares
  251:   .'</body>'
  252:   .'</html>'
  253: );
  254: return OK;
  255: }
  256: 
  257: # ----------------------------------------------- Apparently we are in business
  258: $servadm=~s/\,/\<br \/\>/g;
  259: 
  260: # ----------------------------------------------------------- Front page design
  261: my $pgbg=&Apache::loncommon::designparm('login.pgbg',$domain);
  262: my $font=&Apache::loncommon::designparm('login.font',$domain);
  263: my $link=&Apache::loncommon::designparm('login.link',$domain);
  264: my $vlink=&Apache::loncommon::designparm('login.vlink',$domain);
  265: my $alink=&Apache::loncommon::designparm('login.alink',$domain);
  266: my $mainbg=&Apache::loncommon::designparm('login.mainbg',$domain);
  267: my $loginbox_bg=&Apache::loncommon::designparm('login.sidebg',$domain);
  268: my $loginbox_header_bgcol=&Apache::loncommon::designparm('login.bgcol',$domain);
  269: my $loginbox_header_textcol=&Apache::loncommon::designparm('login.textcol',$domain);
  270: my $logo=&Apache::loncommon::designparm('login.logo',$domain);
  271: my $img=&Apache::loncommon::designparm('login.img',$domain);
  272: my $domainlogo='<div>'.&Apache::loncommon::domainlogo($domain).'</div>';
  273: my $showbanner = 1;
  274: my $showmainlogo = 1;
  275: if (defined(&Apache::loncommon::designparm('login.showlogo_img',$domain))) {
  276:     $showbanner = &Apache::loncommon::designparm('login.showlogo_img',$domain);
  277: }
  278: if (defined(&Apache::loncommon::designparm('login.showlogo_logo',$domain))) {
  279:     $showmainlogo = &Apache::loncommon::designparm('login.showlogo_logo',$domain);
  280: }
  281: my $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain);
  282: my $showcoursecat =
  283: &Apache::loncommon::designparm('login.coursecatalog',$domain);
  284: my $shownewuserlink = 
  285: &Apache::loncommon::designparm('login.newuser',$domain);
  286: my $now=time;
  287: my $js = (<<ENDSCRIPT);
  288: 
  289: <script type="text/javascript" language="JavaScript">
  290: // <![CDATA[
  291: function send()
  292: {
  293: this.document.server.elements.uname.value
  294: =this.document.client.elements.uname.value;
  295: 
  296: this.document.server.elements.udom.value
  297: =this.document.client.elements.udom.value;
  298: 
  299: uextkey=this.document.client.elements.uextkey.value;
  300: lextkey=this.document.client.elements.lextkey.value;
  301: initkeys();
  302: 
  303: this.document.server.elements.upass0.value
  304:     =crypted(this.document.client.elements.upass$now.value.substr(0,15));
  305: this.document.server.elements.upass1.value
  306:     =crypted(this.document.client.elements.upass$now.value.substr(15,15));
  307: this.document.server.elements.upass2.value
  308:     =crypted(this.document.client.elements.upass$now.value.substr(30,15));
  309: 
  310: this.document.client.elements.uname.value='';
  311: this.document.client.elements.upass$now.value='';
  312: 
  313: this.document.server.submit();
  314: return false;
  315: }
  316: // ]]>
  317: </script>
  318: 
  319: ENDSCRIPT
  320: 
  321: # --------------------------------------------------- Print login screen header
  322: 
  323: my %add_entries = (
  324: 	       bgcolor      => "$mainbg",
  325: 	       text         => "$font",
  326: 	       link         => "$link",
  327: 	       vlink        => "$vlink",
  328: 	       alink        => "$alink",);
  329: 
  330: $r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js,
  331: 			       { 'redirect'       => [$expire,'/adm/roles'], 
  332: 				 'add_entries' => \%add_entries,
  333: 				 'only_body'   => 1,}));
  334: 
  335: # ----------------------------------------------------------------------- Texts
  336: 
  337: my %lt=&Apache::lonlocal::texthash(
  338:           'un'       => 'Username',
  339:           'pw'       => 'Password',
  340:           'dom'      => 'Domain',
  341:           'perc'     => 'percent',
  342:           'load'     => 'Server Load',
  343:           'userload' => 'User Load',
  344:           'catalog'  => 'Course/Community Catalog',
  345:           'log'      => 'Log in',
  346:           'help'     => 'Log-in Help',
  347:           'serv'     => 'Server',
  348:           'servadm'  => 'Server Administration',
  349:           'helpdesk' => 'Contact Helpdesk',
  350:           'forgotpw' => 'Forgot password?',
  351:           'newuser'  => 'New User?',
  352:        );
  353: # -------------------------------------------------- Change password field name
  354: 
  355: my $forgotpw = &forgotpwdisplay(%lt);
  356: $forgotpw .= '<br />' if $forgotpw;
  357: my $loginhelp = &loginhelpdisplay($authdomain,%lt);
  358: $loginhelp .= '<br />' if $loginhelp;
  359: 
  360: # ---------------------------------------------------- Serve out DES JavaScript
  361: {
  362: my $jsh=Apache::File->new($include."/londes.js");
  363: $r->print(<$jsh>);
  364: }
  365: # ---------------------------------------------------------- Serve rest of page
  366: 
  367: $r->print(
  368:     '<div class="LC_Box"'
  369:    .' style="margin:0 auto; padding:10px; width:90%; height: auto; background-color:#FFFFFF;">'
  370: );
  371: 
  372: #
  373: #  If the loadbalancing yielded just http:// because perhaps there's no loadbalancing?
  374: #  then just us a relative link to authenticate:
  375: #
  376: 
  377: $r->print(<<ENDSERVERFORM);
  378: <form name="server" action="$otherserver/adm/authenticate" method="post" target="_top">
  379:    <input type="hidden" name="logtoken" value="$logtoken" />
  380:    <input type="hidden" name="serverid" value="$lonhost" />
  381:    <input type="hidden" name="uname" value="" />
  382:    <input type="hidden" name="upass0" value="" />
  383:    <input type="hidden" name="upass1" value="" />
  384:    <input type="hidden" name="upass2" value="" />
  385:    <input type="hidden" name="udom" value="" />
  386:    <input type="hidden" name="localpath" value="$env{'form.localpath'}" />
  387:    <input type="hidden" name="localres" value="$env{'form.localres'}" />
  388:   </form>
  389: ENDSERVERFORM
  390: my $coursecatalog;
  391: if (($showcoursecat eq '') || ($showcoursecat)) {
  392:     $coursecatalog = &coursecatalog_link($lt{'catalog'}).'<br />';
  393: }
  394: my $newuserlink;
  395: if ($shownewuserlink) {
  396:     $newuserlink = &newuser_link($lt{'newuser'}).'<br />';
  397: }
  398: my $logintitle =
  399:     '<h2 class="LC_hcell"'
  400:    .' style="background:'.$loginbox_header_bgcol.';'
  401:    .' color:'.$loginbox_header_textcol.'">'
  402:    .$lt{'log'}
  403:    .'</h2>';
  404: 
  405: my $noscript_warning='<noscript><span class="LC_warning"><b>'
  406:                      .&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.')
  407:                     .'</b></span></noscript>';
  408: my $helpdeskscript;
  409: my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,
  410:                                    $authdomain,\$helpdeskscript);
  411: 
  412: my $loginform=(<<LFORM);
  413: <form name="client" action="" onsubmit="return(send())">
  414:   <input type="hidden" name="lextkey" value="$lextkey" />
  415:   <input type="hidden" name="uextkey" value="$uextkey" />
  416:   <b><label for="uname">$lt{'un'}</label>:</b><br />
  417:   <input type="text" name="uname" id="uname" size="15" value="$authusername" /><br />
  418:   <b><label for="upass$now">$lt{'pw'}</label>:</b><br />
  419:   <input type="password" name="upass$now" id="upass$now" size="15" /><br />
  420:   <b><label for="udom">$lt{'dom'}</label>:</b><br />
  421:   <input type="text" name="udom" id="udom" size="15" value="$authdomain" /><br />
  422:   <input type="submit" value="$lt{'log'}" />
  423: </form>
  424: LFORM
  425: 
  426:     if ($showbanner) {
  427:         $r->print(<<HEADER);
  428: <!-- The LON-CAPA Header -->
  429: <div style="background:$pgbg;margin:0;width:100%;">
  430:   <img src="$img" border="0" alt="The Learning Online Network with CAPA" />
  431: </div>
  432: HEADER
  433:     }
  434:     $r->print(<<ENDTOP);
  435: <div style="float:left;">
  436: <div class="LC_Box" style="background:$loginbox_bg;">
  437:   $logintitle
  438:   $loginform
  439:   $noscript_warning
  440: </div>
  441:   
  442: <div class="LC_Box" style="padding-top: 10px;">
  443:   $loginhelp
  444:   $forgotpw
  445:   $contactblock
  446:   $newuserlink
  447:   $coursecatalog
  448: </div>
  449: </div>
  450: 
  451: <div>
  452: ENDTOP
  453:     if ($showmainlogo) {
  454:         $r->print(' <img src="'.$logo.'" alt="" />'."\n");
  455:     }
  456: $r->print(<<ENDTOP);
  457: $announcements
  458: $domainlogo
  459: </div>
  460: <hr style="clear:both;" />
  461: ENDTOP
  462: 
  463: $r->print(<<ENDDOCUMENT);
  464:      <table border="0" cellspacing="0" cellpadding="0">
  465:       <tr>
  466:        <td  align="left" valign="top">
  467:         <small><b>$lt{'dom'}:&nbsp;</b></small>
  468:        </td>
  469:        <td  align="left" valign="top">
  470:         <small><tt>&nbsp;$domain</tt></small>
  471:        </td>
  472:       </tr>
  473:       <tr>
  474:        <td  align="left" valign="top">
  475:         <small><b>$lt{'serv'}:&nbsp;</b></small>
  476:        </td>
  477:        <td align="left" valign="top">
  478:         <small><tt>&nbsp;$lonhost ($role)</tt></small>
  479:        </td>
  480:       </tr>
  481:       <tr>
  482:        <td align="left" valign="top">
  483:         <small><b>$lt{'load'}:&nbsp;</b></small>
  484:        </td>
  485:        <td align="left" valign="top">
  486:         <small><tt>&nbsp;$loadpercent $lt{'perc'}</tt></small>
  487:        </td>
  488:       </tr>
  489:       <tr>
  490:        <td align="left" valign="top">
  491:         <small><b>$lt{'userload'}:&nbsp;</b></small>
  492:        </td>
  493:        <td align="left" valign="top">
  494:         <small><tt>&nbsp;$userloadpercent $lt{'perc'}</tt></small>
  495:        </td>
  496:       </tr>
  497:       <tr>
  498:        <td colspan="2" align="left">
  499:         <small>$version</small>
  500:        </td>
  501:       </tr>
  502:      </table>
  503:  </div>
  504: 
  505: <script type="text/javascript">
  506: // <![CDATA[
  507: // the if prevents the script error if the browser can not handle this
  508: if ( document.client.uname ) { document.client.uname.focus(); }
  509: // ]]>
  510: </script>
  511: $helpdeskscript
  512: 
  513: ENDDOCUMENT
  514:     my %endargs = ( 'noredirectlink' => 1, );
  515:     $r->print(&Apache::loncommon::end_page(\%endargs));
  516:     return OK;
  517: }
  518: 
  519: sub check_loginvia {
  520:     my ($domain,$lonhost) = @_;
  521:     if ($domain eq '' || $lonhost eq '') {
  522:         return;
  523:     }
  524:     my %domconfhash = &Apache::loncommon::get_domainconf($domain);
  525:     my $loginvia = $domconfhash{$domain.'.login.loginvia_'.$lonhost};
  526:     my $loginvia_exempt = $domconfhash{$domain.'.login.loginvia_exempt_'.$lonhost};
  527:     my $output;
  528:     if ($loginvia ne '') {
  529:         my $noredirect;
  530:         my $ip = $ENV{'REMOTE_ADDR'};
  531:         if ($ip eq '127.0.0.1') {
  532:             $noredirect = 1;
  533:         } else {
  534:             if ($loginvia_exempt ne '') {
  535:                 my @exempt = split(',',$loginvia_exempt);
  536:                 if (grep(/^\Q$ip\E$/,@exempt)) {
  537:                     $noredirect = 1;
  538:                 }
  539:             }
  540:         }
  541:         unless ($noredirect) {
  542:             my ($newhost,$path);
  543:             if ($loginvia =~ /:/) {
  544:                 ($newhost,$path) = split(':',$loginvia);
  545:             } else {
  546:                 $newhost = $loginvia;
  547:             }
  548:             if ($newhost ne $lonhost) {
  549:                 if (&Apache::lonnet::hostname($newhost) ne '') {
  550:                     $output = &redirect_page($newhost,$path);
  551:                 }
  552:             }
  553:         }
  554:     }
  555:     return $output;
  556: }
  557: 
  558: sub redirect_page {
  559:     my ($desthost,$path) = @_;
  560:     my $protocol = $Apache::lonnet::protocol{$desthost};
  561:     $protocol = 'http' if ($protocol ne 'https');
  562:     unless ($path =~ m{^/}) {
  563:         $path = '/'.$path;
  564:     }
  565:     my $url = $protocol.'://'.&Apache::lonnet::hostname($desthost).$path;
  566:     if ($env{'form.firsturl'} ne '') {
  567:         $url .='?firsturl='.$env{'form.firsturl'};
  568:     }
  569:     my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
  570:                                                     {'redirect' => [0,$url],});
  571:     my $end_page   = &Apache::loncommon::end_page();
  572:     return $start_page.$end_page;
  573: }
  574: 
  575: sub contactdisplay {
  576:     my ($lt,$servadm,$showadminmail,$authdomain,$helpdeskscript) = @_;
  577:     my $contactblock;
  578:     my $showhelpdesk = 0;
  579:     my $requestmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
  580:     if ($requestmail =~ m/^[^\@]+\@[^\@]+$/) {
  581:         $showhelpdesk = 1;
  582:     }
  583:     if ($servadm && $showadminmail) {
  584:         $contactblock .= $$lt{'servadm'}.':<br />'.
  585:                          '<tt>'.$servadm.'</tt><br />';
  586:     }
  587:     if ($showhelpdesk) {
  588:         $contactblock .= '<a href="javascript:helpdesk()">'.$lt->{'helpdesk'}.'</a><br />';
  589:         my $thisurl = &escape('/adm/login');
  590:         $$helpdeskscript = <<"ENDSCRIPT";
  591: <script type="text/javascript">
  592: // <![CDATA[
  593: function helpdesk() {
  594:     var codedom = document.client.udom.value;
  595:     if (codedom == '') {
  596:         codedom = "$authdomain";
  597:     }
  598:     var querystr = "origurl=$thisurl&codedom="+codedom;
  599:     document.location.href = "/adm/helpdesk?"+querystr;
  600:     return;
  601: }
  602: // ]]>
  603: </script>
  604: ENDSCRIPT
  605:     }
  606:     return $contactblock;
  607: }
  608: 
  609: sub forgotpwdisplay {
  610:     my (%lt) = @_;
  611:     my $prompt_for_resetpw = 1; 
  612:     if ($prompt_for_resetpw) {
  613:         return '<a href="/adm/resetpw">'.$lt{'forgotpw'}.'</a>';
  614:     }
  615:     return;
  616: }
  617: 
  618: sub loginhelpdisplay {
  619:     my ($authdomain,%lt) = @_;
  620:     my $login_help = 1;
  621:     if ($login_help) {
  622:         my $dom = $authdomain;
  623:         if ($dom eq '') {
  624:             $dom = &Apache::lonnet::default_login_domain();
  625:         }
  626:         my %helpconfig = &Apache::lonnet::get_dom('configuration',['helpsettings'],$dom);
  627:         my $loginhelp_url = $helpconfig{'helpsettings'}{'loginhelpurl'};
  628:         if ($loginhelp_url ne '') {
  629:             return '<a href="'.$loginhelp_url.'">'.$lt{'help'}.'</a>';
  630:         } else {
  631:             return '<a href="/adm/loginproblems.html">'.$lt{'help'}.'</a>';
  632:         }
  633:     }
  634:     return;
  635: }
  636: 
  637: sub coursecatalog_link {
  638:     my ($linkname) = @_;
  639:     return <<"END";
  640:       <a href="/adm/coursecatalog">$linkname</a>
  641: END
  642: }
  643: 
  644: sub newuser_link {
  645:     my ($linkname) = @_;
  646:     return '<a href="/adm/createaccount">'.$linkname.'</a>';
  647: }
  648: 
  649: 1;
  650: __END__

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