Annotation of loncom/auth/switchserver.pm, revision 1.4
1.1 albertel 1: # The LearningOnline Network
2: # Switch Servers Handler
3: #
1.4 ! albertel 4: # $Id: switchserver.pm,v 1.3 2005/10/25 19:14:32 albertel Exp $
1.1 albertel 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::switchserver;
30:
31: use strict;
32: use Apache::Constants qw(:common);
33: use Apache::lonnet;
34: use Apache::lonmenu;
35: use CGI::Cookie();
36: use Apache::lonlocal;
37:
38: sub init_env {
39: my ($r) = @_;
40: my $requrl=$r->uri;
41: my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
42: my $lonid=$cookies{'lonID'};
43: my $cookie;
44: if (!$lonid) { return undef; }
45:
46: my $handle=$lonid->value;
47: $handle=~s/\W//g;
48: my $lonidsdir=$r->dir_config('lonIDsDir');
49: if ((!-e "$lonidsdir/$handle.id") || ($handle eq '')) {
50: $r->log_reason("Cookie $handle not valid", $r->filename);
51: return undef;
52: }
53:
54: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
55:
56: return $handle;
57: }
58:
59: sub handler {
60: my $r = shift;
61:
62:
63: my $handle=&init_env($r);
64: if (!defined($handle)) { return FORBIDDEN; }
65:
66: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
67: ['otherserver','role']);
1.4 ! albertel 68:
1.1 albertel 69: my $switch_to=$Apache::lonnet::hostname{$env{'form.otherserver'}};
1.4 ! albertel 70: if (!$env{'form.otherserver'}) {
! 71: $env{'form.otherserver'}=&Apache::lonnet::spareserver(30000,undef,1);
! 72: $switch_to=$Apache::lonnet::hostname{$env{'form.otherserver'}};
! 73: }
1.1 albertel 74: if (!defined($switch_to)) { return FORBIDDEN; }
1.4 ! albertel 75:
! 76: if ($env{'form.role'} &&
! 77: !exists($env{'user.role.'.$env{'form.role'}})) { return FORBIDDEN; }
1.1 albertel 78:
79: #remove session env, and log event
80: unlink($r->dir_config('lonIDsDir')."/$handle.id");
81: my %temp=('switchserver' => time.':'.$env{'form.otherserver'},
82: $env{'form.role'});
83: &Apache::lonnet::put('email_status',\%temp);
84: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
85: $env{'user.home'},
86: "Switch Server to $env{'form.otherserver'} with role $env{'form.role'} $ENV{'REMOTE_ADDR'}");
87:
88: &Apache::loncommon::content_type($r,'text/html');
89: $r->send_http_header;
90: return OK if $r->header_only;
91: # -------------------------------------------------------- Menu script and info
92:
93: my $windowinfo=&Apache::lonmenu::close();
94: $windowinfo.=&Apache::lonnavmaps::close();
95: # ---------------------------------------------------------------- Get handover
96:
1.3 albertel 97: my %info=('ip' => $ENV{'REMOTE_ADDR'},
98: 'domain' => $env{'user.domain'},
99: 'username' => $env{'user.name'},
100: 'role' => $env{'form.role'},
101: 'server' => $r->dir_config('lonHostID'));
102: my $token = &Apache::lonnet::tmpput(\%info,$env{'form.otherserver'});
1.1 albertel 103: my $switch='<meta HTTP-EQUIV="Refresh" CONTENT="0.5; url=http://'.$switch_to.'/adm/migrateuser?token='.$token.'">';
104: my $bodytag=&Apache::loncommon::bodytag('Switching Server ...');
105: # --------------------------------------------------------------- Screen Output
1.2 albertel 106: $r->print(<<ENDDOCUMENT);
1.1 albertel 107: <html>
108: <head><title>The LearningOnline Network with CAPA Logout</title>
109: $switch
110: </head>
111: $bodytag
112: $windowinfo
113: </body>
114: </html>
115: ENDDOCUMENT
1.2 albertel 116:
1.1 albertel 117: &Apache::lonnet::flushcourselogs();
118: return OK;
119: }
120:
121: 1;
122: __END__
123:
124:
125:
126:
127:
128:
129:
130:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>