Annotation of loncom/interface/loncreateuser.pm, revision 1.2
1.1 www 1: # The LearningOnline Network
2: # Create a user
3: #
4: # (Create a course
5: # (My Desk
6: #
7: # (Internal Server Error Handler
8: #
9: # (Login Screen
10: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
11: # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
12: #
13: # 3/1/1 Gerd Kortemeyer)
14: #
15: # 3/1 Gerd Kortemeyer)
16: #
17: # 2/14 Gerd Kortemeyer)
18: #
1.2 ! www 19: # 2/14,2/17,2/19 Gerd Kortemeyer
1.1 www 20: #
21: package Apache::loncreateuser;
22:
23: use strict;
24: use Apache::Constants qw(:common :http);
25: use Apache::lonnet;
26:
1.2 ! www 27: # =================================================================== Phase one
1.1 www 28:
1.2 ! www 29: sub phase_one {
! 30: my $r=shift;
! 31: my $defdom=$ENV{'user.domain'};
1.1 www 32: $r->print(<<ENDDOCUMENT);
33: <html>
34: <head>
35: <title>The LearningOnline Network with CAPA</title>
36: </head>
37: <body bgcolor="#FFFFFF">
38: <h1>Create User, Change User Privileges</h1>
1.2 ! www 39: <form action=/adm/createuser method=post>
! 40: <input type=hidden name=phase value=two>
! 41: Username: <input type=text size=15 name=ccuname><br>
! 42: Domain: <input type=text size=15 name=ccdomain value=$defdom><p>
! 43: <input type=submit value="Continue">
! 44: </form>
1.1 www 45: </body>
46: </html>
47: ENDDOCUMENT
1.2 ! www 48: }
! 49:
! 50: # =================================================================== Phase two
! 51:
! 52: sub phase_two {
! 53: my $r=shift;
! 54: my $ccuname=$ENV{'form.ccuname'};
! 55: my $ccdomain=$ENV{'form.ccdomain'};
! 56: $ccuname=~s/\W//g;
! 57: $ccdomain=~s/\W//g;
! 58: $r->print(<<ENDENHEAD);
! 59: <html>
! 60: <head>
! 61: <title>The LearningOnline Network with CAPA</title>
! 62: </head>
! 63: <body bgcolor="#FFFFFF">
! 64: <img align=right src=/adm/lonIcons/lonlogos.gif>
! 65: <h1>Create User, Change User Privileges</h1>
! 66: <form action=/adm/createuser method=post>
! 67: <input type=hidden name=phase value=three>
! 68: <input type=hidden name=ccuname value=$ccuname>
! 69: <input type=hidden name=ccdomain value=$ccdomain>
! 70: ENDENHEAD
! 71: my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
! 72: my %incdomains;
! 73: my %inccourses;
! 74: $incdomains{$ENV{'user.domain'}}=1;
! 75: map {
! 76: if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {
! 77: $inccourses{$1.'_'.$2}=1;
! 78: }
! 79: } %ENV;
! 80: if ($uhome eq 'no_host') {
! 81: $r->print('<h3>New user '.$ccuname.' at '.$ccdomain.'</h3>');
! 82: } else {
! 83: $r->print('<h3>Existing user '.$ccuname.' at '.$ccdomain.'</h3>');
! 84: my $rolesdump=&Apache::lonnet::reply(
! 85: "dump:$ccdomain:$ccuname:roles",$uhome);
! 86: unless ($rolesdump eq 'con_lost') {
! 87: my $now=time;
! 88: $r->print('<h4>Revoke Existing Roles</h4>'.
! 89: '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.
! 90: '<th>Start</th><th>End</th>');
! 91: map {
! 92: if ($_!~/^rolesdef\&/) {
! 93:
! 94: my ($area,$role)=split(/=/,$_);
! 95: my $thisrole=$area;
! 96: $area=~s/\_\w\w$//;
! 97: my ($trole,$tend,$tstart)=split(/_/,$role);
! 98:
! 99: my $allows=0;
! 100: if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
! 101: my %coursedata=&Apache::lonnet::coursedescription($1.'_'.$2);
! 102: $area='Course: '.
! 103: $coursedata{'description'}.'<br>Section/Group: '.$3;
! 104: $inccourses{$1.'_'.$2}=1;
! 105: if (&Apache::lonnet::allowed('c'.$trole,$1.'_'.$2)) {
! 106: $allows=1;
! 107: }
! 108: } else {
! 109: if ($1) {
! 110: $incdomains{$1}=1;
! 111: if (&Apache::lonnet::allowed('c'.$trole,$1)) {
! 112: $allows=1;
! 113: }
! 114: }
! 115: }
! 116:
! 117: my $active=1;
! 118: if (($tend) && ($now>$tend)) { $active=0; }
! 119:
! 120: $r->print('<tr><td>');
! 121: if ($active) {
! 122: if ($allows) {
! 123: $r->print(
! 124: '<input type=checkbox name="rev:'.$thisrole.'">');
! 125: } else {
! 126: $r->print(' ');
! 127: }
! 128: } else {
! 129: $r->print(' ');
! 130: }
! 131: $r->print('</td><td>'.&Apache::lonnet::plaintext($trole).
! 132: '</td><td>'.$area.'</td><td>'.
! 133: ($tstart?localtime($tstart):' ').'</td><td>'.
! 134: ($tend?localtime($tend):' ')."</td></tr>\n");
! 135: }
! 136: } split(/&/,$rolesdump);
! 137: $r->print('</table>');
! 138: }
! 139: }
! 140: $r->print('<hr><h4>Add Roles</h4><h5>System Level</h5>');
! 141: $r->print('<h5>Domain Level</h5>');
! 142: map {
! 143: my $thisdomain=$_;
! 144: map {
! 145: if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {
! 146: $r->print($_.' - '.$thisdomain.'<br>');
! 147: }
! 148: } ('dc','cc','li','dg','au');
! 149: } sort keys %incdomains;
! 150: $r->print('<h5>Course Level</h5>');
! 151: map {
! 152: my $thiscourse=$_;
! 153: map {
! 154: if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
! 155: $r->print($_.' - '.$thiscourse.'<br>');
! 156: }
! 157: } ('st','ta','ep','ad','in');
! 158: } sort keys %inccourses;
! 159: $r->print('</form></body></html>');
! 160: }
1.1 www 161:
1.2 ! www 162: # ================================================================ Main Handler
! 163: sub handler {
! 164: my $r = shift;
! 165:
! 166: if ($r->header_only) {
! 167: $r->content_type('text/html');
! 168: $r->send_http_header;
! 169: return OK;
! 170: }
! 171:
! 172: if ((&Apache::lonnet::allowed('cta',$ENV{'request.course.id'})) ||
! 173: (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) ||
! 174: (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) ||
! 175: (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||
! 176: (&Apache::lonnet::allowed('mau',$ENV{'user.domain'}))) {
! 177: $r->content_type('text/html');
! 178: $r->send_http_header;
! 179: unless ($ENV{'form.phase'}) {
! 180: &phase_one($r);
! 181: }
! 182: if ($ENV{'form.phase'} eq 'two') {
! 183: &phase_two($r);
! 184: }
1.1 www 185: } else {
186: $ENV{'user.error.msg'}=
1.2 ! www 187: "/adm/createcourse:mau:0:0:Cannot modify user data";
1.1 www 188: return HTTP_NOT_ACCEPTABLE;
189: }
190: return OK;
191: }
192:
193: 1;
194: __END__
1.2 ! www 195:
! 196:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncreateuser.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface