1: # The LearningOnline Network with CAPA
2: # Create a user
3: #
4: # $Id: loncreateuser.pm,v 1.157 2007/07/20 23:52:55 albertel 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:
30: package Apache::loncreateuser;
31:
32: =pod
33:
34: =head1 NAME
35:
36: Apache::loncreateuser - handler to create users and custom roles
37:
38: =head1 SYNOPSIS
39:
40: Apache::loncreateuser provides an Apache handler for creating users,
41: editing their login parameters, roles, and removing roles, and
42: also creating and assigning custom roles.
43:
44: =head1 OVERVIEW
45:
46: =head2 Custom Roles
47:
48: In LON-CAPA, roles are actually collections of privileges. "Teaching
49: Assistant", "Course Coordinator", and other such roles are really just
50: collection of privileges that are useful in many circumstances.
51:
52: Creating custom roles can be done by the Domain Coordinator through
53: the Create User functionality. That screen will show all privileges
54: that can be assigned to users. For a complete list of privileges,
55: please see C</home/httpd/lonTabs/rolesplain.tab>.
56:
57: Custom role definitions are stored in the C<roles.db> file of the role
58: author.
59:
60: =cut
61:
62: use strict;
63: use Apache::Constants qw(:common :http);
64: use Apache::lonnet;
65: use Apache::loncommon;
66: use Apache::lonlocal;
67: use Apache::longroup;
68: use lib '/home/httpd/lib/perl/';
69: use LONCAPA qw(:DEFAULT :match);
70:
71: my $loginscript; # piece of javascript used in two separate instances
72: my $generalrule;
73: my $authformnop;
74: my $authformkrb;
75: my $authformint;
76: my $authformfsys;
77: my $authformloc;
78:
79: sub initialize_authen_forms {
80: my ($krbdefdom)=( $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/);
81: $krbdefdom= uc($krbdefdom);
82: my %param = ( formname => 'document.cu',
83: kerb_def_dom => $krbdefdom
84: );
85: # no longer static due to configurable kerberos defaults
86: # $loginscript = &Apache::loncommon::authform_header(%param);
87: $generalrule = &Apache::loncommon::authform_authorwarning(%param);
88: $authformnop = &Apache::loncommon::authform_nochange(%param);
89: # no longer static due to configurable kerberos defaults
90: # $authformkrb = &Apache::loncommon::authform_kerberos(%param);
91: $authformint = &Apache::loncommon::authform_internal(%param);
92: $authformfsys = &Apache::loncommon::authform_filesystem(%param);
93: $authformloc = &Apache::loncommon::authform_local(%param);
94: }
95:
96:
97: # ======================================================= Existing Custom Roles
98:
99: sub my_custom_roles {
100: my %returnhash=();
101: my %rolehash=&Apache::lonnet::dump('roles');
102: foreach my $key (keys %rolehash) {
103: if ($key=~/^rolesdef\_(\w+)$/) {
104: $returnhash{$1}=$1;
105: }
106: }
107: return %returnhash;
108: }
109:
110: # ==================================================== Figure out author access
111:
112: sub authorpriv {
113: my ($auname,$audom)=@_;
114: unless ((&Apache::lonnet::allowed('cca',$audom.'/'.$auname))
115: || (&Apache::lonnet::allowed('caa',$audom.'/'.$auname))) { return ''; }
116: return 1;
117: }
118:
119: # ====================================================
120:
121: sub portfolio_quota {
122: my ($ccuname,$ccdomain) = @_;
123: my %lt = &Apache::lonlocal::texthash(
124: 'disk' => "Disk space allocated to user's portfolio files",
125: 'cuqu' => "Current quota",
126: 'cust' => "Custom quota",
127: 'defa' => "Default",
128: 'chqu' => "Change quota",
129: );
130: my ($currquota,$quotatype,$inststatus,$defquota) =
131: &Apache::loncommon::get_user_quota($ccuname,$ccdomain);
132: my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($ccdomain);
133: my ($longinsttype,$showquota,$custom_on,$custom_off,$defaultinfo);
134: if ($inststatus ne '') {
135: if ($usertypes->{$inststatus} ne '') {
136: $longinsttype = $usertypes->{$inststatus};
137: }
138: }
139: $custom_on = ' ';
140: $custom_off = ' checked="checked" ';
141: my $quota_javascript = <<"END_SCRIPT";
142: <script type="text/javascript">
143: function quota_changes(caller) {
144: if (caller == "custom") {
145: if (document.cu.customquota[0].checked) {
146: document.cu.portfolioquota.value = "";
147: }
148: }
149: if (caller == "quota") {
150: document.cu.customquota[1].checked = true;
151: }
152: }
153: </script>
154: END_SCRIPT
155: if ($quotatype eq 'custom') {
156: $custom_on = $custom_off;
157: $custom_off = ' ';
158: $showquota = $currquota;
159: if ($longinsttype eq '') {
160: $defaultinfo = &mt('For this user, the default quota would be [_1]
161: Mb.',$defquota);
162: } else {
163: $defaultinfo = &mt("For this user, the default quota would be [_1]
164: Mb, as determined by the user's institutional
165: affiliation ([_2]).",$defquota,$longinsttype);
166: }
167: } else {
168: if ($longinsttype eq '') {
169: $defaultinfo = &mt('For this user, the default quota is [_1]
170: Mb.',$defquota);
171: } else {
172: $defaultinfo = &mt("For this user, the default quota of [_1]
173: Mb, is determined by the user's institutional
174: affiliation ([_2]).",$defquota,$longinsttype);
175: }
176: }
177: my $output = $quota_javascript.
178: '<h3>'.$lt{'disk'}.'</h3>'.
179: $lt{'cuqu'}.': '.$currquota.' Mb. '.
180: $defaultinfo.'<br /><span class="LC_nobreak">'.$lt{'chqu'}.
181: ': <label>'.
182: '<input type="radio" name="customquota" value="0" '.
183: $custom_off.' onchange="javascript:quota_changes('."'custom'".')"
184: />'.$lt{'defa'}.' ('.$defquota.' Mb).</label> '.
185: ' <label><input type="radio" name="customquota" value="1" '.
186: $custom_on.' onchange="javascript:quota_changes('."'custom'".')" />'.
187: $lt{'cust'}.':</label> '.
188: '<input type="text" name="portfolioquota" size ="5" value="'.
189: $showquota.'" onfocus="javascript:quota_changes('."'quota'".')" '.
190: '/> Mb';
191: return $output;
192: }
193:
194: # =================================================================== Phase one
195:
196: sub print_username_entry_form {
197: my ($r) = @_;
198: my $defdom=$env{'request.role.domain'};
199: my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
200: my $selscript=&Apache::loncommon::studentbrowser_javascript();
201: my $start_page =
202: &Apache::loncommon::start_page('Create Users, Change User Privileges',
203: $selscript);
204:
205: my $sellink=&Apache::loncommon::selectstudent_link
206: ('crtuser','ccuname','ccdomain');
207: my %existingroles=&my_custom_roles();
208: my $choice=&Apache::loncommon::select_form('make new role','rolename',
209: ('make new role' => 'Generate new role ...',%existingroles));
210: my %lt=&Apache::lonlocal::texthash(
211: 'siur' => "Set Individual User Roles",
212: 'usr' => "Username",
213: 'dom' => "Domain",
214: 'usrr' => "User Roles",
215: 'ecrp' => "Edit Custom Role Privileges",
216: 'nr' => "Name of Role",
217: 'cre' => "Custom Role Editor"
218: );
219: my $help = &Apache::loncommon::help_open_menu(undef,undef,282,'Instructor Interface');
220: my $helpsiur=&Apache::loncommon::help_open_topic('Course_Change_Privileges');
221: my $helpecpr=&Apache::loncommon::help_open_topic('Course_Editing_Custom_Roles');
222: $r->print(<<"ENDDOCUMENT");
223: $start_page
224: <form action="/adm/createuser" method="post" name="crtuser">
225: <input type="hidden" name="phase" value="get_user_info" />
226: <h2>$lt{siur}$helpsiur</h2>
227: <table>
228: <tr><td>$lt{usr}:</td><td><input type="text" size="15" name="ccuname" />
229: </td><td rowspan="2">$sellink</td></tr><tr><td>
230: $lt{'dom'}:</td><td>$domform</td></tr>
231: </table>
232: <input name="userrole" type="submit" value="$lt{usrr}" />
233: </form>
234: ENDDOCUMENT
235: if (&Apache::lonnet::allowed('mcr','/')) {
236: $r->print(<<ENDCUSTOM);
237: <form action="/adm/createuser" method="post" name="docustom">
238: <input type="hidden" name="phase" value="selected_custom_edit" />
239: <h2>$lt{'ecrp'}$helpecpr</h2>
240: $lt{'nr'}: $choice <input type="text" size="15" name="newrolename" /><br />
241: <input name="customeditor" type="submit" value="$lt{'cre'}" />
242: </form>
243: ENDCUSTOM
244: }
245: $r->print(&Apache::loncommon::end_page());
246: }
247:
248:
249: sub user_modification_js {
250: my ($pjump_def,$dc_setcourse_code,$nondc_setsection_code,$groupslist)=@_;
251:
252: return <<END;
253: <script type="text/javascript" language="Javascript">
254:
255: function pclose() {
256: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
257: "height=350,width=350,scrollbars=no,menubar=no");
258: parmwin.close();
259: }
260:
261: $pjump_def
262: $dc_setcourse_code
263:
264: function dateset() {
265: eval("document.cu."+document.cu.pres_marker.value+
266: ".value=document.cu.pres_value.value");
267: pclose();
268: }
269:
270: $nondc_setsection_code
271:
272: </script>
273: END
274: }
275:
276: # =================================================================== Phase two
277: sub print_user_modification_page {
278: my $r=shift;
279: my $ccuname =&LONCAPA::clean_username($env{'form.ccuname'});
280: my $ccdomain=&LONCAPA::clean_domain($env{'form.ccdomain'});
281:
282: unless (($ccuname) && ($ccdomain)) {
283: &print_username_entry_form($r);
284: return;
285: }
286:
287: my $defdom=$env{'request.role.domain'};
288:
289: my ($krbdef,$krbdefdom) =
290: &Apache::loncommon::get_kerberos_defaults($defdom);
291:
292: my %param = ( formname => 'document.cu',
293: kerb_def_dom => $krbdefdom,
294: kerb_def_auth => $krbdef
295: );
296: $loginscript = &Apache::loncommon::authform_header(%param);
297: $authformkrb = &Apache::loncommon::authform_kerberos(%param);
298:
299: $ccuname =&LONCAPA::clean_username($ccuname);
300: $ccdomain=&LONCAPA::clean_domain($ccdomain);
301: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
302: my $dc_setcourse_code = '';
303: my $nondc_setsection_code = '';
304:
305: my %loaditem;
306:
307: my $groupslist;
308: my %curr_groups = &Apache::longroup::coursegroups();
309: if (%curr_groups) {
310: $groupslist = join('","',sort(keys(%curr_groups)));
311: $groupslist = '"'.$groupslist.'"';
312: }
313:
314: if ($env{'request.role'} =~ m-^dc\./($match_domain)/$-) {
315: my $dcdom = $1;
316: $loaditem{'onload'} = "document.cu.coursedesc.value='';";
317: my @rolevals = ('st','ta','ep','in','cc');
318: my (@crsroles,@grproles);
319: for (my $i=0; $i<@rolevals; $i++) {
320: $crsroles[$i]=&Apache::lonnet::plaintext($rolevals[$i],'Course');
321: $grproles[$i]=&Apache::lonnet::plaintext($rolevals[$i],'Group');
322: }
323: my $rolevalslist = join('","',@rolevals);
324: my $crsrolenameslist = join('","',@crsroles);
325: my $grprolenameslist = join('","',@grproles);
326: my $pickcrsfirst = '<--'.&mt('Pick course first');
327: my $pickgrpfirst = '<--'.&mt('Pick group first');
328: $dc_setcourse_code = <<"ENDSCRIPT";
329: function setCourse() {
330: var course = document.cu.dccourse.value;
331: if (course != "") {
332: if (document.cu.dcdomain.value != document.cu.origdom.value) {
333: alert("You must select a course in the current domain");
334: return;
335: }
336: var userrole = document.cu.role.options[document.cu.role.selectedIndex].value
337: var section="";
338: var numsections = 0;
339: var newsecs = new Array();
340: for (var i=0; i<document.cu.currsec.length; i++) {
341: if (document.cu.currsec.options[i].selected == true ) {
342: if (document.cu.currsec.options[i].value != "" && document.cu.currsec.options[i].value != null) {
343: if (numsections == 0) {
344: section = document.cu.currsec.options[i].value
345: numsections = 1;
346: }
347: else {
348: section = section + "," + document.cu.currsec.options[i].value
349: numsections ++;
350: }
351: }
352: }
353: }
354: if (document.cu.newsec.value != "" && document.cu.newsec.value != null) {
355: if (numsections == 0) {
356: section = document.cu.newsec.value
357: }
358: else {
359: section = section + "," + document.cu.newsec.value
360: }
361: newsecs = document.cu.newsec.value.split(/,/g);
362: numsections = numsections + newsecs.length;
363: }
364: if ((userrole == 'st') && (numsections > 1)) {
365: alert("In each course, each user may only have one student role at a time. You had selected "+numsections+" sections.\\nPlease modify your selections so they include no more than one section.")
366: return;
367: }
368: for (var j=0; j<newsecs.length; j++) {
369: if ((newsecs[j] == 'all') || (newsecs[j] == 'none')) {
370: alert("'"+newsecs[j]+"' may not be used as the name for a section, as it is a reserved word.\\nPlease choose a different section name.");
371: return;
372: }
373: if (document.cu.groups.value != '') {
374: var groups = document.cu.groups.value.split(/,/g);
375: for (var k=0; k<groups.length; k++) {
376: if (newsecs[j] == groups[k]) {
377: alert("'"+newsecs[j]+"' may not be used as the name for a section, as it is the name of a course group.\\nSection names and group names must be distinct. Please choose a different section name.");
378: return;
379: }
380: }
381: }
382: }
383: if ((userrole == 'cc') && (numsections > 0)) {
384: alert("Section designations do not apply to Course Coordinator roles.\\nA course coordinator role will be added with access to all sections.");
385: section = "";
386: }
387: var coursename = "_$dcdom"+"_"+course+"_"+userrole
388: var numcourse = getIndex(document.cu.dccourse);
389: if (numcourse == "-1") {
390: alert("There was a problem with your course selection");
391: return
392: }
393: else {
394: document.cu.elements[numcourse].name = "act"+coursename;
395: var numnewsec = getIndex(document.cu.newsec);
396: if (numnewsec != "-1") {
397: document.cu.elements[numnewsec].name = "sec"+coursename;
398: document.cu.elements[numnewsec].value = section;
399: }
400: var numstart = getIndex(document.cu.start);
401: if (numstart != "-1") {
402: document.cu.elements[numstart].name = "start"+coursename;
403: }
404: var numend = getIndex(document.cu.end);
405: if (numend != "-1") {
406: document.cu.elements[numend].name = "end"+coursename
407: }
408: }
409: }
410: document.cu.submit();
411: }
412:
413: function getIndex(caller) {
414: for (var i=0;i<document.cu.elements.length;i++) {
415: if (document.cu.elements[i] == caller) {
416: return i;
417: }
418: }
419: return -1;
420: }
421: ENDSCRIPT
422: } else {
423: $nondc_setsection_code = <<"ENDSECCODE";
424: function setSections() {
425: var re1 = /^currsec_/;
426: var groups = new Array($groupslist);
427: for (var i=0;i<document.cu.elements.length;i++) {
428: var str = document.cu.elements[i].name;
429: var checkcurr = str.match(re1);
430: if (checkcurr != null) {
431: if (document.cu.elements[i-1].checked == true) {
432: var re2 = /^currsec_[a-zA-Z0-9]+_[a-zA-Z0-9]+_(\\w+)\$/;
433: match = re2.exec(str);
434: var role = match[1];
435: if (role == 'cc') {
436: alert("Section designations do not apply to Course Coordinator roles.\\nA course coordinator role will be added with access to all sections.");
437: }
438: else {
439: var sections = '';
440: var numsec = 0;
441: var sections;
442: for (var j=0; j<document.cu.elements[i].length; j++) {
443: if (document.cu.elements[i].options[j].selected == true ) {
444: if (document.cu.elements[i].options[j].value != "") {
445: if (numsec == 0) {
446: if (document.cu.elements[i].options[j].value != "") {
447: sections = document.cu.elements[i].options[j].value;
448: numsec ++;
449: }
450: }
451: else {
452: sections = sections + "," + document.cu.elements[i].options[j].value
453: numsec ++;
454: }
455: }
456: }
457: }
458: if (numsec > 0) {
459: if (document.cu.elements[i+1].value != "" && document.cu.elements[i+1].value != null) {
460: sections = sections + "," + document.cu.elements[i+1].value;
461: }
462: }
463: else {
464: sections = document.cu.elements[i+1].value;
465: }
466: var newsecs = document.cu.elements[i+1].value;
467: var numsplit;
468: if (newsecs != null && newsecs != "") {
469: numsplit = newsecs.split(/,/g);
470: numsec = numsec + numsplit.length;
471: }
472:
473: if ((role == 'st') && (numsec > 1)) {
474: alert("In each course, each user may only have one student role at a time. You had selected "+numsec+" sections.\\nPlease modify your selections so they include no more than one section.")
475: return;
476: }
477: else if (numsplit != null) {
478: for (var j=0; j<numsplit.length; j++) {
479: if ((numsplit[j] == 'all') ||
480: (numsplit[j] == 'none')) {
481: alert("'"+numsplit[j]+"' may not be used as the name for a section, as it is a reserved word.\\nPlease choose a different section name.");
482: return;
483: }
484: for (var k=0; k<groups.length; k++) {
485: if (numsplit[j] == groups[k]) {
486: alert("'"+numsplit[j]+"' may not be used as a section name, as it is the name of a course group.\\nSection names and group names must be distinct. Please choose a different section name.");
487: return;
488: }
489: }
490: }
491: }
492: document.cu.elements[i+2].value = sections;
493: }
494: }
495: }
496: }
497: document.cu.submit();
498: }
499: ENDSECCODE
500: }
501: my $js = &user_modification_js($pjump_def,$dc_setcourse_code,
502: $nondc_setsection_code,$groupslist);
503: my $start_page =
504: &Apache::loncommon::start_page('Create Users, Change User Privileges',
505: $js,{'add_entries' => \%loaditem,});
506:
507: my $forminfo =<<"ENDFORMINFO";
508: <form action="/adm/createuser" method="post" name="cu">
509: <input type="hidden" name="phase" value="update_user_data" />
510: <input type="hidden" name="ccuname" value="$ccuname" />
511: <input type="hidden" name="ccdomain" value="$ccdomain" />
512: <input type="hidden" name="pres_value" value="" />
513: <input type="hidden" name="pres_type" value="" />
514: <input type="hidden" name="pres_marker" value="" />
515: ENDFORMINFO
516: my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
517: my %inccourses;
518: foreach my $key (keys(%env)) {
519: if ($key=~/^user\.priv\.cm\.\/($match_domain)\/($match_username)/) {
520: $inccourses{$1.'_'.$2}=1;
521: }
522: }
523: if ($uhome eq 'no_host') {
524: my $home_server_list=
525: '<option value="default" selected>default</option>'."\n".
526: &Apache::loncommon::home_server_option_list($ccdomain);
527:
528: my %lt=&Apache::lonlocal::texthash(
529: 'cnu' => "Create New User",
530: 'nu' => "New User",
531: 'id' => "in domain",
532: 'pd' => "Personal Data",
533: 'fn' => "First Name",
534: 'mn' => "Middle Name",
535: 'ln' => "Last Name",
536: 'gen' => "Generation",
537: 'idsn' => "ID/Student Number",
538: 'hs' => "Home Server",
539: 'lg' => "Login Data"
540: );
541: my $portfolioform;
542: if (&Apache::lonnet::allowed('mpq',$env{'request.role.domain'})) {
543: # Current user has quota modification privileges
544: $portfolioform = &portfolio_quota($ccuname,$ccdomain);
545: }
546: my $genhelp=&Apache::loncommon::help_open_topic('Generation');
547: &initialize_authen_forms();
548: $r->print(<<ENDNEWUSER);
549: $start_page
550: <h1>$lt{'cnu'}</h1>
551: $forminfo
552: <h2>$lt{'nu'} "$ccuname" $lt{'id'} $ccdomain</h2>
553: <script type="text/javascript" language="Javascript">
554: $loginscript
555: </script>
556: <input type='hidden' name='makeuser' value='1' />
557: <h3>$lt{'pd'}</h3>
558: <p>
559: <table>
560: <tr><td>$lt{'fn'} </td>
561: <td><input type='text' name='cfirst' size='15' /></td></tr>
562: <tr><td>$lt{'mn'} </td>
563: <td><input type='text' name='cmiddle' size='15' /></td></tr>
564: <tr><td>$lt{'ln'} </td>
565: <td><input type='text' name='clast' size='15' /></td></tr>
566: <tr><td>$lt{'gen'}$genhelp</td>
567: <td><input type='text' name='cgen' size='5' /></td></tr>
568: </table>
569: $lt{'idsn'} <input type='text' name='cstid' size='15' /></p>
570: $lt{'hs'}: <select name="hserver" size="1"> $home_server_list </select>
571: <hr />
572: <h3>$lt{'lg'}</h3>
573: <p>$generalrule </p>
574: <p>$authformkrb </p>
575: <p>$authformint </p>
576: <p>$authformfsys</p>
577: <p>$authformloc </p>
578: <hr />
579: $portfolioform
580: ENDNEWUSER
581: } else { # user already exists
582: my %lt=&Apache::lonlocal::texthash(
583: 'cup' => "Change User Privileges",
584: 'usr' => "User",
585: 'id' => "in domain",
586: 'fn' => "first name",
587: 'mn' => "middle name",
588: 'ln' => "last name",
589: 'gen' => "generation"
590: );
591: $r->print(<<ENDCHANGEUSER);
592: $start_page
593: <h1>$lt{'cup'}</h1>
594: $forminfo
595: <h2>$lt{'usr'} "$ccuname" $lt{'id'} "$ccdomain"</h2>
596: ENDCHANGEUSER
597: # Get the users information
598: my %userenv = &Apache::lonnet::get('environment',
599: ['firstname','middlename','lastname','generation',
600: 'portfolioquota'],$ccdomain,$ccuname);
601: my %rolesdump=&Apache::lonnet::dump('roles',$ccdomain,$ccuname);
602: $r->print('
603: <hr />'.
604: &Apache::loncommon::start_data_table().
605: &Apache::loncommon::start_data_table_header_row().
606: '<th>'.$lt{'fn'}.'</th><th>'.$lt{'mn'}.'</th><th>'.$lt{'ln'}.'</th><th>'.$lt{'gen'}.'</th>'.
607: &Apache::loncommon::end_data_table_header_row().
608: &Apache::loncommon::start_data_table_row());
609: foreach my $item ('firstname','middlename','lastname','generation') {
610: if (&Apache::lonnet::allowed('mau',$ccdomain)) {
611: $r->print(<<"END");
612: <td><input type="text" name="c$item" value="$userenv{$item}" size="15" /></td>
613: END
614: } else {
615: $r->print('<td>'.$userenv{$item}.'</td>');
616: }
617: }
618: $r->print(&Apache::loncommon::end_data_table_row().
619: &Apache::loncommon::end_data_table());
620: # Build up table of user roles to allow revocation of a role.
621: my ($tmp) = keys(%rolesdump);
622: unless ($tmp =~ /^(con_lost|error)/i) {
623: my $now=time;
624: my %lt=&Apache::lonlocal::texthash(
625: 'rer' => "Revoke Existing Roles",
626: 'rev' => "Revoke",
627: 'del' => "Delete",
628: 'ren' => "Re-Enable",
629: 'rol' => "Role",
630: 'ext' => "Extent",
631: 'sta' => "Start",
632: 'end' => "End"
633: );
634: my (%roletext,%sortrole,%roleclass,%rolepriv);
635: foreach my $area (sort { my $a1=join('_',(split('_',$a))[1,0]);
636: my $b1=join('_',(split('_',$b))[1,0]);
637: return $a1 cmp $b1;
638: } keys(%rolesdump)) {
639: next if ($area =~ /^rolesdef/);
640: my $envkey=$area;
641: my $role = $rolesdump{$area};
642: my $thisrole=$area;
643: $area =~ s/\_\w\w$//;
644: my ($role_code,$role_end_time,$role_start_time) =
645: split(/_/,$role);
646: # Is this a custom role? Get role owner and title.
647: my ($croleudom,$croleuname,$croletitle)=
648: ($role_code=~m{^cr/($match_domain)/($match_username)/(\w+)$});
649: my $allowed=0;
650: my $delallowed=0;
651: my $sortkey=$role_code;
652: my $class='Unknown';
653: if ($area =~ m{^/($match_domain)/($match_courseid)} ) {
654: $class='Course';
655: my ($coursedom,$coursedir) = ($1,$2);
656: $sortkey.="\0$coursedom";
657: # $1.'_'.$2 is the course id (eg. 103_12345abcef103l3).
658: my %coursedata=
659: &Apache::lonnet::coursedescription($1.'_'.$2);
660: my $carea;
661: if (defined($coursedata{'description'})) {
662: $carea=$coursedata{'description'}.
663: '<br />'.&mt('Domain').': '.$coursedom.(' 'x8).
664: &Apache::loncommon::syllabuswrapper('Syllabus',$coursedir,$coursedom);
665: $sortkey.="\0".$coursedata{'description'};
666: $class=$coursedata{'type'};
667: } else {
668: $carea=&mt('Unavailable course').': '.$area;
669: $sortkey.="\0".&mt('Unavailable course').': '.$area;
670: }
671: $sortkey.="\0$coursedir";
672: $inccourses{$1.'_'.$2}=1;
673: if ((&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) ||
674: (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
675: $allowed=1;
676: }
677: if ((&Apache::lonnet::allowed('dro',$1)) ||
678: (&Apache::lonnet::allowed('dro',$ccdomain))) {
679: $delallowed=1;
680: }
681: # - custom role. Needs more info, too
682: if ($croletitle) {
683: if (&Apache::lonnet::allowed('ccr',$1.'/'.$2)) {
684: $allowed=1;
685: $thisrole.='.'.$role_code;
686: }
687: }
688: # Compute the background color based on $area
689: if ($area=~m{^/($match_domain)/($match_courseid)/(\w+)}) {
690: $carea.='<br />Section: '.$3;
691: $sortkey.="\0$3";
692: }
693: $area=$carea;
694: } else {
695: $sortkey.="\0".$area;
696: # Determine if current user is able to revoke privileges
697: if ($area=~m{^/($match_domain)/}) {
698: if ((&Apache::lonnet::allowed('c'.$role_code,$1)) ||
699: (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
700: $allowed=1;
701: }
702: if (((&Apache::lonnet::allowed('dro',$1)) ||
703: (&Apache::lonnet::allowed('dro',$ccdomain))) &&
704: ($role_code ne 'dc')) {
705: $delallowed=1;
706: }
707: } else {
708: if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
709: $allowed=1;
710: }
711: }
712: if ($role_code eq 'ca' || $role_code eq 'au') {
713: $class='Construction Space';
714: } elsif ($role_code eq 'su') {
715: $class='System';
716: } else {
717: $class='Domain';
718: }
719: }
720: if (($role_code eq 'ca') || ($role_code eq 'aa')) {
721: $area=~m{/($match_domain)/($match_username)};
722: if (&authorpriv($2,$1)) {
723: $allowed=1;
724: } else {
725: $allowed=0;
726: }
727: }
728: my $row = '';
729: $row.= '<td>';
730: my $active=1;
731: $active=0 if (($role_end_time) && ($now>$role_end_time));
732: if (($active) && ($allowed)) {
733: $row.= '<input type="checkbox" name="rev:'.$thisrole.'" />';
734: } else {
735: if ($active) {
736: $row.=' ';
737: } else {
738: $row.=&mt('expired or revoked');
739: }
740: }
741: $row.='</td><td>';
742: if ($allowed && !$active) {
743: $row.= '<input type="checkbox" name="ren:'.$thisrole.'" />';
744: } else {
745: $row.=' ';
746: }
747: $row.='</td><td>';
748: if ($delallowed) {
749: $row.= '<input type="checkbox" name="del:'.$thisrole.'" />';
750: } else {
751: $row.=' ';
752: }
753: my $plaintext='';
754: if (!$croletitle) {
755: $plaintext=&Apache::lonnet::plaintext($role_code,$class)
756: } else {
757: $plaintext=
758: "Customrole '$croletitle' defined by $croleuname\@$croleudom";
759: }
760: $row.= '</td><td>'.$plaintext.
761: '</td><td>'.$area.
762: '</td><td>'.($role_start_time?localtime($role_start_time)
763: : ' ' ).
764: '</td><td>'.($role_end_time ?localtime($role_end_time)
765: : ' ' )
766: ."</td>";
767: $sortrole{$sortkey}=$envkey;
768: $roletext{$envkey}=$row;
769: $roleclass{$envkey}=$class;
770: $rolepriv{$envkey}=$allowed;
771: #$r->print($row);
772: } # end of foreach (table building loop)
773: my $rolesdisplay = 0;
774: my %output = ();
775: foreach my $type ('Construction Space','Course','Group','Domain','System','Unknown') {
776: $output{$type} = '';
777: foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) {
778: if ( ($roleclass{$sortrole{$which}} =~ /^\Q$type\E/ ) && ($rolepriv{$sortrole{$which}}) ) {
779: $output{$type}.=
780: &Apache::loncommon::start_data_table_row().
781: $roletext{$sortrole{$which}}.
782: &Apache::loncommon::end_data_table_row();
783: }
784: }
785: unless($output{$type} eq '') {
786: $output{$type} = '<tr class="LC_info_row">'.
787: "<td align='center' colspan='7'>".&mt($type)."</td></tr>".
788: $output{$type};
789: $rolesdisplay = 1;
790: }
791: }
792: if ($rolesdisplay == 1) {
793: $r->print('
794: <hr />
795: <h3>'.$lt{'rer'}.'</h3>'.
796: &Apache::loncommon::start_data_table("LC_createuser").
797: &Apache::loncommon::start_data_table_header_row().
798: '<th>'.$lt{'rev'}.'</th><th>'.$lt{'ren'}.'</th><th>'.$lt{'del'}.
799: '</th><th>'.$lt{'rol'}.'</th><th>'.$lt{'ext'}.
800: '</th><th>'.$lt{'sta'}.'</th><th>'.$lt{'end'}.'</th>'.
801: &Apache::loncommon::end_data_table_header_row());
802: foreach my $type ('Construction Space','Course','Group','Domain','System','Unknown') {
803: if ($output{$type}) {
804: $r->print($output{$type}."\n");
805: }
806: }
807: $r->print(&Apache::loncommon::end_data_table());
808: }
809: } # End of unless
810: my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
811: if ($currentauth=~/^krb(4|5):/) {
812: $currentauth=~/^krb(4|5):(.*)/;
813: my $krbdefdom=$2;
814: my %param = ( formname => 'document.cu',
815: kerb_def_dom => $krbdefdom
816: );
817: $loginscript = &Apache::loncommon::authform_header(%param);
818: }
819: # Check for a bad authentication type
820: unless ($currentauth=~/^krb(4|5):/ or
821: $currentauth=~/^unix:/ or
822: $currentauth=~/^internal:/ or
823: $currentauth=~/^localauth:/
824: ) { # bad authentication scheme
825: if (&Apache::lonnet::allowed('mau',$ccdomain)) {
826: &initialize_authen_forms();
827: my %lt=&Apache::lonlocal::texthash(
828: 'err' => "ERROR",
829: 'uuas' => "This user has an unrecognized authentication scheme",
830: 'sldb' => "Please specify login data below",
831: 'ld' => "Login Data"
832: );
833: $r->print(<<ENDBADAUTH);
834: <hr />
835: <script type="text/javascript" language="Javascript">
836: $loginscript
837: </script>
838: <font color='#ff0000'>$lt{'err'}:</font>
839: $lt{'uuas'} ($currentauth). $lt{'sldb'}.
840: <h3>$lt{'ld'}</h3>
841: <p>$generalrule</p>
842: <p>$authformkrb</p>
843: <p>$authformint</p>
844: <p>$authformfsys</p>
845: <p>$authformloc</p>
846: ENDBADAUTH
847: } else {
848: # This user is not allowed to modify the user's
849: # authentication scheme, so just notify them of the problem
850: my %lt=&Apache::lonlocal::texthash(
851: 'err' => "ERROR",
852: 'uuas' => "This user has an unrecognized authentication scheme",
853: 'adcs' => "Please alert a domain coordinator of this situation"
854: );
855: $r->print(<<ENDBADAUTH);
856: <hr />
857: <font color="#ff0000"> $lt{'err'}: </font>
858: $lt{'uuas'} ($currentauth). $lt{'adcs'}.
859: <hr />
860: ENDBADAUTH
861: }
862: } else { # Authentication type is valid
863: my $authformcurrent='';
864: my $authform_other='';
865: &initialize_authen_forms();
866: if ($currentauth=~/^krb(4|5):/) {
867: $authformcurrent=$authformkrb;
868: $authform_other="<p>$authformint</p>\n".
869: "<p>$authformfsys</p><p>$authformloc</p>";
870: }
871: elsif ($currentauth=~/^internal:/) {
872: $authformcurrent=$authformint;
873: $authform_other="<p>$authformkrb</p>".
874: "<p>$authformfsys</p><p>$authformloc</p>";
875: }
876: elsif ($currentauth=~/^unix:/) {
877: $authformcurrent=$authformfsys;
878: $authform_other="<p>$authformkrb</p>".
879: "<p>$authformint</p><p>$authformloc;</p>";
880: }
881: elsif ($currentauth=~/^localauth:/) {
882: $authformcurrent=$authformloc;
883: $authform_other="<p>$authformkrb</p>".
884: "<p>$authformint</p><p>$authformfsys</p>";
885: }
886: $authformcurrent.=' <i>(will override current values)</i><br />';
887: if (&Apache::lonnet::allowed('mau',$ccdomain)) {
888: # Current user has login modification privileges
889: my %lt=&Apache::lonlocal::texthash(
890: 'ccld' => "Change Current Login Data",
891: 'enld' => "Enter New Login Data"
892: );
893: $r->print(<<ENDOTHERAUTHS);
894: <hr />
895: <script type="text/javascript" language="Javascript">
896: $loginscript
897: </script>
898: <h3>$lt{'ccld'}</h3>
899: <p>$generalrule</p>
900: <p>$authformnop</p>
901: <p>$authformcurrent</p>
902: <h3>$lt{'enld'}</h3>
903: $authform_other
904: ENDOTHERAUTHS
905: } else {
906: if (&Apache::lonnet::allowed('mau',$env{'request.role.domain'})) {
907: my %lt=&Apache::lonlocal::texthash(
908: 'ccld' => "Change Current Login Data",
909: 'yodo' => "You do not have privileges to modify the authentication configuration for this user.",
910: 'ifch' => "If a change is required, contact a domain coordinator for the domain",
911: );
912: $r->print(<<ENDNOPRIV);
913: <hr />
914: <h3>$lt{'ccld'}</h3>
915: $lt{'yodo'} $lt{'ifch'}: $ccdomain
916: ENDNOPRIV
917: }
918: }
919: if (&Apache::lonnet::allowed('mpq',$env{'request.role.domain'})) {
920: # Current user has quota modification privileges
921: $r->print(&portfolio_quota($ccuname,$ccdomain));
922: }
923: } ## End of "check for bad authentication type" logic
924: } ## End of new user/old user logic
925: $r->print('<hr /><h3>'.&mt('Add Roles').'</h3>');
926: #
927: # Co-Author
928: #
929: if (&authorpriv($env{'user.name'},$env{'request.role.domain'}) &&
930: ($env{'user.name'} ne $ccuname || $env{'user.domain'} ne $ccdomain)) {
931: # No sense in assigning co-author role to yourself
932: my $cuname=$env{'user.name'};
933: my $cudom=$env{'request.role.domain'};
934: my %lt=&Apache::lonlocal::texthash(
935: 'cs' => "Construction Space",
936: 'act' => "Activate",
937: 'rol' => "Role",
938: 'ext' => "Extent",
939: 'sta' => "Start",
940: 'end' => "End",
941: 'cau' => "Co-Author",
942: 'caa' => "Assistant Co-Author",
943: 'ssd' => "Set Start Date",
944: 'sed' => "Set End Date"
945: );
946: $r->print('<h4>'.$lt{'cs'}.'</h4>'."\n".
947: &Apache::loncommon::start_data_table()."\n".
948: &Apache::loncommon::start_data_table_header_row()."\n".
949: '<th>'.$lt{'act'}.'</th><th>'.$lt{'rol'}.'</th>'.
950: '<th>'.$lt{'ext'}.'</th><th>'.$lt{'sta'}.'</th>'.
951: '<th>'.$lt{'end'}.'</th>'."\n".
952: &Apache::loncommon::end_data_table_header_row()."\n".
953: &Apache::loncommon::start_data_table_row()."\n".
954: '<td>
955: <input type=checkbox name="act_'.$cudom.'_'.$cuname.'_ca" />
956: </td>
957: <td>'.$lt{'cau'}.'</td>
958: <td>'.$cudom.'_'.$cuname.'</td>
959: <td><input type="hidden" name="start_'.$cudom.'_'.$cuname.'_ca" value="" />
960: <a href=
961: "javascript:pjump('."'date_start','Start Date Co-Author',document.cu.start_$cudom\_$cuname\_ca.value,'start_$cudom\_$cuname\_ca','cu.pres','dateset'".')">'.$lt{'ssd'}.'</a></td>
962: <td><input type=hidden name="end_'.$cudom.'_'.$cuname.'_ca" value="" />
963: <a href=
964: "javascript:pjump('."'date_end','End Date Co-Author',document.cu.end_$cudom\_$cuname\_ca.value,'end_$cudom\_$cuname\_ca','cu.pres','dateset'".')">'.$lt{'sed'}.'</a></td>'."\n".
965: &Apache::loncommon::end_data_table_row()."\n".
966: &Apache::loncommon::start_data_table_row()."\n".
967: '<td><input type=checkbox name="act_'.$cudom.'_'.$cuname.'_aa" /></td>
968: <td>'.$lt{'caa'}.'</td>
969: <td>'.$cudom.'_'.$cuname.'</td>
970: <td><input type=hidden name="start_'.$cudom.'_'.$cuname.'_aa" value="" />
971: <a href=
972: "javascript:pjump('."'date_start','Start Date Assistant Co-Author',document.cu.start_$cudom\_$cuname\_aa.value,'start_$cudom\_$cuname\_aa','cu.pres','dateset'".')">'.$lt{'ssd'}.'</a></td>
973: <td><input type=hidden name="end_'.$cudom.'_'.$cuname.'_aa" value="" />
974: <a href=
975: "javascript:pjump('."'date_end','End Date Assistant Co-Author',document.cu.end_$cudom\_$cuname\_aa.value,'end_$cudom\_$cuname\_aa','cu.pres','dateset'".')">'.$lt{'sed'}.'</a></td>'."\n".
976: &Apache::loncommon::end_data_table_row()."\n".
977: &Apache::loncommon::end_data_table());
978: }
979: #
980: # Domain level
981: #
982: my $num_domain_level = 0;
983: my $domaintext =
984: '<h4>'.&mt('Domain Level').'</h4>'.
985: &Apache::loncommon::start_data_table().
986: &Apache::loncommon::start_data_table_header_row().
987: '<th>'.&mt('Activate').'</th><th>'.&mt('Role').'</th><th>'.
988: &mt('Extent').'</th>'.
989: '<th>'.&mt('Start').'</th><th>'.&mt('End').'</th>'.
990: &Apache::loncommon::end_data_table_header_row();
991: foreach my $thisdomain (sort(&Apache::lonnet::all_domains())) {
992: foreach my $role ('dc','li','dg','au','sc') {
993: if (&Apache::lonnet::allowed('c'.$role,$thisdomain)) {
994: my $plrole=&Apache::lonnet::plaintext($role);
995: my %lt=&Apache::lonlocal::texthash(
996: 'ssd' => "Set Start Date",
997: 'sed' => "Set End Date"
998: );
999: $num_domain_level ++;
1000: $domaintext .=
1001: &Apache::loncommon::start_data_table_row().
1002: '<td><input type=checkbox name="act_'.$thisdomain.'_'.$role.'" /></td>
1003: <td>'.$plrole.'</td>
1004: <td>'.$thisdomain.'</td>
1005: <td><input type=hidden name="start_'.$thisdomain.'_'.$role.'" value="" />
1006: <a href=
1007: "javascript:pjump('."'date_start','Start Date $plrole',document.cu.start_$thisdomain\_$role.value,'start_$thisdomain\_$role','cu.pres','dateset'".')">'.$lt{'ssd'}.'</a></td>
1008: <td><input type=hidden name="end_'.$thisdomain.'_'.$role.'" value="" />
1009: <a href=
1010: "javascript:pjump('."'date_end','End Date $plrole',document.cu.end_$thisdomain\_$role.value,'end_$thisdomain\_$role','cu.pres','dateset'".')">'.$lt{'sed'}.'</a></td>'.
1011: &Apache::loncommon::end_data_table_row();
1012: }
1013: }
1014: }
1015: $domaintext.= &Apache::loncommon::end_data_table();
1016: if ($num_domain_level > 0) {
1017: $r->print($domaintext);
1018: }
1019: #
1020: # Course and group levels
1021: #
1022:
1023: if ($env{'request.role'} =~ m{^dc\./($match_domain)/$}) {
1024: $r->print(&course_level_dc($1,'Course'));
1025: $r->print('<hr /><input type="button" value="'.&mt('Modify User').'" onClick="setCourse()" />'."\n");
1026: } else {
1027: $r->print(&course_level_table(%inccourses));
1028: $r->print('<hr /><input type="button" value="'.&mt('Modify User').'" onClick="setSections()" />'."\n");
1029: }
1030: $r->print("</form>".&Apache::loncommon::end_page());
1031: }
1032:
1033: # ================================================================= Phase Three
1034: sub update_user_data {
1035: my $r=shift;
1036: my $uhome=&Apache::lonnet::homeserver($env{'form.ccuname'},
1037: $env{'form.ccdomain'});
1038: # Error messages
1039: my $error = '<font color="#ff0000">'.&mt('Error').':</font>';
1040: my $end = &Apache::loncommon::end_page();
1041:
1042: my $title;
1043: if (exists($env{'form.makeuser'})) {
1044: $title='Set Privileges for New User';
1045: } else {
1046: $title='Modify User Privileges';
1047: }
1048: $r->print(&Apache::loncommon::start_page($title));
1049: my %disallowed;
1050: # Check Inputs
1051: if (! $env{'form.ccuname'} ) {
1052: $r->print($error.&mt('No login name specified').'.'.$end);
1053: return;
1054: }
1055: if ( $env{'form.ccuname'} ne
1056: &LONCAPA::clean_username($env{'form.ccuname'}) ) {
1057: $r->print($error.&mt('Invalid login name').'. '.
1058: &mt('Only letters, numbers, and underscores are valid').'.'.
1059: $end);
1060: return;
1061: }
1062: if (! $env{'form.ccdomain'} ) {
1063: $r->print($error.&mt('No domain specified').'.'.$end);
1064: return;
1065: }
1066: if ( $env{'form.ccdomain'} ne
1067: &LONCAPA::clean_domain($env{'form.ccdomain'}) ) {
1068: $r->print($error.&mt ('Invalid domain name').'. '.
1069: &mt('Only letters, numbers, periods, dashes, and underscores are valid').'.'.
1070: $end);
1071: return;
1072: }
1073: if (! exists($env{'form.makeuser'})) {
1074: # Modifying an existing user, so check the validity of the name
1075: if ($uhome eq 'no_host') {
1076: $r->print($error.&mt('Unable to determine home server for ').
1077: $env{'form.ccuname'}.&mt(' in domain ').
1078: $env{'form.ccdomain'}.'.');
1079: return;
1080: }
1081: }
1082: # Determine authentication method and password for the user being modified
1083: my $amode='';
1084: my $genpwd='';
1085: if ($env{'form.login'} eq 'krb') {
1086: $amode='krb';
1087: $amode.=$env{'form.krbver'};
1088: $genpwd=$env{'form.krbarg'};
1089: } elsif ($env{'form.login'} eq 'int') {
1090: $amode='internal';
1091: $genpwd=$env{'form.intarg'};
1092: } elsif ($env{'form.login'} eq 'fsys') {
1093: $amode='unix';
1094: $genpwd=$env{'form.fsysarg'};
1095: } elsif ($env{'form.login'} eq 'loc') {
1096: $amode='localauth';
1097: $genpwd=$env{'form.locarg'};
1098: $genpwd=" " if (!$genpwd);
1099: } elsif (($env{'form.login'} eq 'nochange') ||
1100: ($env{'form.login'} eq '' )) {
1101: # There is no need to tell the user we did not change what they
1102: # did not ask us to change.
1103: # If they are creating a new user but have not specified login
1104: # information this will be caught below.
1105: } else {
1106: $r->print($error.&mt('Invalid login mode or password').$end);
1107: return;
1108: }
1109: if ($env{'form.makeuser'}) {
1110: # Create a new user
1111: my %lt=&Apache::lonlocal::texthash(
1112: 'cru' => "Creating user",
1113: 'id' => "in domain"
1114: );
1115: $r->print(<<ENDNEWUSERHEAD);
1116: <h3>$lt{'cru'} "$env{'form.ccuname'}" $lt{'id'} "$env{'form.ccdomain'}"</h3>
1117: ENDNEWUSERHEAD
1118: # Check for the authentication mode and password
1119: if (! $amode || ! $genpwd) {
1120: $r->print($error.&mt('Invalid login mode or password').$end);
1121: return;
1122: }
1123: # Determine desired host
1124: my $desiredhost = $env{'form.hserver'};
1125: if (lc($desiredhost) eq 'default') {
1126: $desiredhost = undef;
1127: } else {
1128: my %home_servers =
1129: &Apache::lonnet::get_servers($env{'form.ccdomain'},'library');
1130: if (! exists($home_servers{$desiredhost})) {
1131: $r->print($error.&mt('Invalid home server specified'));
1132: return;
1133: }
1134: }
1135: # Call modifyuser
1136: my $result = &Apache::lonnet::modifyuser
1137: ($env{'form.ccdomain'},$env{'form.ccuname'},$env{'form.cstid'},
1138: $amode,$genpwd,$env{'form.cfirst'},
1139: $env{'form.cmiddle'},$env{'form.clast'},$env{'form.cgen'},
1140: undef,$desiredhost
1141: );
1142: $r->print(&mt('Generating user').': '.$result);
1143: my $home = &Apache::lonnet::homeserver($env{'form.ccuname'},
1144: $env{'form.ccdomain'});
1145: $r->print('<br />'.&mt('Home server').': '.$home.' '.
1146: &Apache::lonnet::hostname($home));
1147: } elsif (($env{'form.login'} ne 'nochange') &&
1148: ($env{'form.login'} ne '' )) {
1149: # Modify user privileges
1150: my %lt=&Apache::lonlocal::texthash(
1151: 'usr' => "User",
1152: 'id' => "in domain"
1153: );
1154: $r->print(<<ENDMODIFYUSERHEAD);
1155: <h2>$lt{'usr'} "$env{'form.ccuname'}" $lt{'id'} "$env{'form.ccdomain'}"</h2>
1156: ENDMODIFYUSERHEAD
1157: if (! $amode || ! $genpwd) {
1158: $r->print($error.'Invalid login mode or password'.$end);
1159: return;
1160: }
1161: # Only allow authentification modification if the person has authority
1162: if (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'})) {
1163: $r->print('Modifying authentication: '.
1164: &Apache::lonnet::modifyuserauth(
1165: $env{'form.ccdomain'},$env{'form.ccuname'},
1166: $amode,$genpwd));
1167: $r->print('<br />'.&mt('Home server').': '.&Apache::lonnet::homeserver
1168: ($env{'form.ccuname'},$env{'form.ccdomain'}));
1169: } else {
1170: # Okay, this is a non-fatal error.
1171: $r->print($error.&mt('You do not have the authority to modify this users authentification information').'.');
1172: }
1173: }
1174: ##
1175: if (! $env{'form.makeuser'} ) {
1176: # Check for need to change
1177: my %userenv = &Apache::lonnet::get
1178: ('environment',['firstname','middlename','lastname','generation',
1179: 'portfolioquota','inststatus'],$env{'form.ccdomain'},
1180: $env{'form.ccuname'});
1181: my ($tmp) = keys(%userenv);
1182: if ($tmp =~ /^(con_lost|error)/i) {
1183: %userenv = ();
1184: }
1185: # Check to see if we need to change user information
1186: foreach my $item ('firstname','middlename','lastname','generation') {
1187: # Strip leading and trailing whitespace
1188: $env{'form.c'.$item} =~ s/(\s+$|^\s+)//g;
1189: }
1190: my ($quotachanged,$namechanged,$oldportfolioquota,$newportfolioquota,
1191: $inststatus,$isdefault,$defquotatext);
1192: my ($defquota,$settingstatus) =
1193: &Apache::loncommon::default_quota($env{'form.ccdomain'},$inststatus);
1194: my %changeHash;
1195: if ($userenv{'portfolioquota'} ne '') {
1196: $oldportfolioquota = $userenv{'portfolioquota'};
1197: if ($env{'form.customquota'} == 1) {
1198: if ($env{'form.portfolioquota'} eq '') {
1199: $newportfolioquota = 0;
1200: } else {
1201: $newportfolioquota = $env{'form.portfolioquota'};
1202: $newportfolioquota =~ s/[^\d\.]//g;
1203: }
1204: if ($newportfolioquota != $userenv{'portfolioquota'}) {
1205: $quotachanged = "a_admin($newportfolioquota,\%changeHash);
1206: }
1207: } else {
1208: $quotachanged = "a_admin('',\%changeHash);
1209: $newportfolioquota = $defquota;
1210: $isdefault = 1;
1211: }
1212: } else {
1213: $oldportfolioquota = $defquota;
1214: if ($env{'form.customquota'} == 1) {
1215: if ($env{'form.portfolioquota'} eq '') {
1216: $newportfolioquota = 0;
1217: } else {
1218: $newportfolioquota = $env{'form.portfolioquota'};
1219: $newportfolioquota =~ s/[^\d\.]//g;
1220: }
1221: $quotachanged = "a_admin($newportfolioquota,\%changeHash);
1222: } else {
1223: $newportfolioquota = $defquota;
1224: $isdefault = 1;
1225: }
1226: }
1227: if ($isdefault) {
1228: if ($settingstatus eq '') {
1229: $defquotatext = &mt('(default)');
1230: } else {
1231: my ($usertypes,$order) =
1232: &Apache::lonnet::retrieve_inst_usertypes($env{'form.ccdomain'});
1233: if ($usertypes->{$settingstatus} eq '') {
1234: $defquotatext = &mt('(default)');
1235: } else {
1236: $defquotatext = &mt('(default for [_1])',$usertypes->{$settingstatus});
1237: }
1238: }
1239: }
1240: if (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'}) &&
1241: ($env{'form.cfirstname'} ne $userenv{'firstname'} ||
1242: $env{'form.cmiddlename'} ne $userenv{'middlename'} ||
1243: $env{'form.clastname'} ne $userenv{'lastname'} ||
1244: $env{'form.cgeneration'} ne $userenv{'generation'} )) {
1245: $namechanged = 1;
1246: }
1247: if ($namechanged) {
1248: # Make the change
1249: $changeHash{'firstname'} = $env{'form.cfirstname'};
1250: $changeHash{'middlename'} = $env{'form.cmiddlename'};
1251: $changeHash{'lastname'} = $env{'form.clastname'};
1252: $changeHash{'generation'} = $env{'form.cgeneration'};
1253: my $putresult = &Apache::lonnet::put
1254: ('environment',\%changeHash,
1255: $env{'form.ccdomain'},$env{'form.ccuname'});
1256: if ($putresult eq 'ok') {
1257: # Tell the user we changed the name
1258: my %lt=&Apache::lonlocal::texthash(
1259: 'uic' => "User Information Changed",
1260: 'frst' => "first",
1261: 'mddl' => "middle",
1262: 'lst' => "last",
1263: 'gen' => "generation",
1264: 'disk' => "disk space allocated to portfolio files",
1265: 'prvs' => "Previous",
1266: 'chto' => "Changed To"
1267: );
1268: $r->print(<<"END");
1269: <table border="2">
1270: <caption>$lt{'uic'}</caption>
1271: <tr><th> </th>
1272: <th>$lt{'frst'}</th>
1273: <th>$lt{'mddl'}</th>
1274: <th>$lt{'lst'}</th>
1275: <th>$lt{'gen'}</th>
1276: <th>$lt{'disk'}<th></tr>
1277: <tr><td>$lt{'prvs'}</td>
1278: <td>$userenv{'firstname'} </td>
1279: <td>$userenv{'middlename'} </td>
1280: <td>$userenv{'lastname'} </td>
1281: <td>$userenv{'generation'} </td>
1282: <td>$oldportfolioquota Mb</td>
1283: </tr>
1284: <tr><td>$lt{'chto'}</td>
1285: <td>$env{'form.cfirstname'} </td>
1286: <td>$env{'form.cmiddlename'} </td>
1287: <td>$env{'form.clastname'} </td>
1288: <td>$env{'form.cgeneration'} </td>
1289: <td>$newportfolioquota Mb $defquotatext </td></tr>
1290: </table>
1291: END
1292: if (($env{'form.ccdomain'} eq $env{'user.domain'}) &&
1293: ($env{'form.ccuname'} eq $env{'user.name'})) {
1294: my %newenvhash;
1295: foreach my $key (keys(%changeHash)) {
1296: $newenvhash{'environment.'.$key} = $changeHash{$key};
1297: }
1298: &Apache::lonnet::appenv(%newenvhash);
1299: }
1300: } else { # error occurred
1301: $r->print("<h2>".&mt('Unable to successfully change environment for')." ".
1302: $env{'form.ccuname'}." ".&mt('in domain')." ".
1303: $env{'form.ccdomain'}."</h2>");
1304: }
1305: } else { # End of if ($env ... ) logic
1306: my $putresult;
1307: if ($quotachanged) {
1308: $putresult = &Apache::lonnet::put
1309: ('environment',\%changeHash,
1310: $env{'form.ccdomain'},$env{'form.ccuname'});
1311: }
1312: # They did not want to change the users name but we can
1313: # still tell them what the name is
1314: my %lt=&Apache::lonlocal::texthash(
1315: 'usr' => "User",
1316: 'id' => "in domain",
1317: 'gen' => "Generation",
1318: 'disk' => "Disk space allocated to user's portfolio files",
1319: );
1320: $r->print(<<"END");
1321: <h2>$lt{'usr'} "$env{'form.ccuname'}" $lt{'id'} "$env{'form.ccdomain'}"</h2>
1322: <h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4>
1323: <h4>$lt{'gen'}: $userenv{'generation'}</h4>
1324: END
1325: if ($putresult eq 'ok') {
1326: if ($oldportfolioquota != $newportfolioquota) {
1327: $r->print('<h4>'.$lt{'disk'}.': '.$newportfolioquota.' Mb '.
1328: $defquotatext.'</h4>');
1329: &Apache::lonnet::appenv('environment.portfolioquota' => $changeHash{'portfolioquota'});
1330: }
1331: }
1332: }
1333: }
1334: ##
1335: my $now=time;
1336: $r->print('<h3>'.&mt('Modifying Roles').'</h3>');
1337: foreach my $key (keys (%env)) {
1338: next if (! $env{$key});
1339: # Revoke roles
1340: if ($key=~/^form\.rev/) {
1341: if ($key=~/^form\.rev\:([^\_]+)\_([^\_\.]+)$/) {
1342: # Revoke standard role
1343: $r->print(&mt('Revoking').' '.$2.' in '.$1.': <b>'.
1344: &Apache::lonnet::revokerole($env{'form.ccdomain'},
1345: $env{'form.ccuname'},$1,$2).'</b><br />');
1346: if ($2 eq 'st') {
1347: $1=~m{^/($match_domain)/($match_courseid)};
1348: my $cid=$1.'_'.$2;
1349: $r->print(&mt('Drop from classlist').': <b>'.
1350: &Apache::lonnet::critical('put:'.
1351: $env{'course.'.$cid.'.domain'}.':'.
1352: $env{'course.'.$cid.'.num'}.':classlist:'.
1353: &escape($env{'form.ccuname'}.':'.
1354: $env{'form.ccdomain'}).'='.
1355: &escape($now.':'),
1356: $env{'course.'.$cid.'.home'}).'</b><br />');
1357: }
1358: }
1359: if ($key=~m{^form\.rev\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) {
1360: # Revoke custom role
1361: $r->print(&mt('Revoking custom role:').
1362: ' '.$4.' by '.$3.':'.$2.' in '.$1.': <b>'.
1363: &Apache::lonnet::revokecustomrole($env{'form.ccdomain'},
1364: $env{'form.ccuname'},$1,$2,$3,$4).
1365: '</b><br />');
1366: }
1367: } elsif ($key=~/^form\.del/) {
1368: if ($key=~/^form\.del\:([^\_]+)\_([^\_\.]+)$/) {
1369: # Delete standard role
1370: $r->print(&mt('Deleting').' '.$2.' in '.$1.': '.
1371: &Apache::lonnet::assignrole($env{'form.ccdomain'},
1372: $env{'form.ccuname'},$1,$2,$now,0,1).'<br />');
1373: if ($2 eq 'st') {
1374: $1=~m{^/($match_domain)/($match_courseid)};
1375: my $cid=$1.'_'.$2;
1376: $r->print(&mt('Drop from classlist').': <b>'.
1377: &Apache::lonnet::critical('put:'.
1378: $env{'course.'.$cid.'.domain'}.':'.
1379: $env{'course.'.$cid.'.num'}.':classlist:'.
1380: &escape($env{'form.ccuname'}.':'.
1381: $env{'form.ccdomain'}).'='.
1382: &escape($now.':'),
1383: $env{'course.'.$cid.'.home'}).'</b><br />');
1384: }
1385: }
1386: if ($key=~m{^form\.del\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) {
1387: my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4);
1388: # Delete custom role
1389: $r->print(&mt('Deleting custom role [_1] by [_2]@[_3] in [_4]',
1390: $rolename,$rnam,$rdom,$url).': <b>'.
1391: &Apache::lonnet::assigncustomrole($env{'form.ccdomain'},
1392: $env{'form.ccuname'},$url,$rdom,$rnam,$rolename,$now,
1393: 0,1).'</b><br />');
1394: }
1395: } elsif ($key=~/^form\.ren/) {
1396: my $udom = $env{'form.ccdomain'};
1397: my $uname = $env{'form.ccuname'};
1398: # Re-enable standard role
1399: if ($key=~/^form\.ren\:([^\_]+)\_([^\_\.]+)$/) {
1400: my $url = $1;
1401: my $role = $2;
1402: my $logmsg;
1403: my $output;
1404: if ($role eq 'st') {
1405: if ($url =~ m-^/($match_domain)/($match_courseid)/?(\w*)$-) {
1406: my $result = &Apache::loncommon::commit_studentrole(\$logmsg,$udom,$uname,$url,$role,$now,0,$1,$2,$3);
1407: if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course')) {
1408: $output = "Error: $result\n";
1409: } else {
1410: $output = &mt('Assigning').' '.$role.' in '.$url.
1411: &mt('starting').' '.localtime($now).
1412: ': <br />'.$logmsg.'<br />'.
1413: &mt('Add to classlist').': <b>ok</b><br />';
1414: }
1415: }
1416: } else {
1417: my $result=&Apache::lonnet::assignrole($env{'form.ccdomain'},
1418: $env{'form.ccuname'},$url,$role,0,$now);
1419: $output = &mt('Re-enabling [_1] in [_2]: <b>[_3]</b>',
1420: $role,$url,$result).'<br />';
1421: }
1422: $r->print($output);
1423: }
1424: # Re-enable custom role
1425: if ($key=~m{^form\.ren\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) {
1426: my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4);
1427: my $result = &Apache::lonnet::assigncustomrole(
1428: $env{'form.ccdomain'}, $env{'form.ccuname'},
1429: $url,$rdom,$rnam,$rolename,0,$now);
1430: $r->print(&mt('Re-enabling custom role [_1] by [_2]@[_3] in [_4] : <b>[_5]</b>',
1431: $rolename,$rnam,$rdom,$url,$result).'<br />');
1432: }
1433: } elsif ($key=~/^form\.act/) {
1434: my $udom = $env{'form.ccdomain'};
1435: my $uname = $env{'form.ccuname'};
1436: if ($key=~/^form\.act\_($match_domain)\_($match_courseid)\_cr_cr_($match_domain)_($match_username)_([^\_]+)$/) {
1437: # Activate a custom role
1438: my ($one,$two,$three,$four,$five)=($1,$2,$3,$4,$5);
1439: my $url='/'.$one.'/'.$two;
1440: my $full=$one.'_'.$two.'_cr_cr_'.$three.'_'.$four.'_'.$five;
1441:
1442: my $start = ( $env{'form.start_'.$full} ?
1443: $env{'form.start_'.$full} :
1444: $now );
1445: my $end = ( $env{'form.end_'.$full} ?
1446: $env{'form.end_'.$full} :
1447: 0 );
1448:
1449: # split multiple sections
1450: my %sections = ();
1451: my $num_sections = &build_roles($env{'form.sec_'.$full},\%sections,$5);
1452: if ($num_sections == 0) {
1453: $r->print(&Apache::loncommon::commit_customrole($udom,$uname,$url,$three,$four,$five,$start,$end));
1454: } else {
1455: my %curr_groups =
1456: &Apache::longroup::coursegroups($one,$two);
1457: foreach my $sec (sort {$a cmp $b} keys %sections) {
1458: if (($sec eq 'none') || ($sec eq 'all') ||
1459: exists($curr_groups{$sec})) {
1460: $disallowed{$sec} = $url;
1461: next;
1462: }
1463: my $securl = $url.'/'.$sec;
1464: $r->print(&Apache::loncommon::commit_customrole($udom,$uname,$securl,$three,$four,$five,$start,$end));
1465: }
1466: }
1467: } elsif ($key=~/^form\.act\_($match_domain)\_($match_name)\_([^\_]+)$/) {
1468: # Activate roles for sections with 3 id numbers
1469: # set start, end times, and the url for the class
1470: my ($one,$two,$three)=($1,$2,$3);
1471: my $start = ( $env{'form.start_'.$one.'_'.$two.'_'.$three} ?
1472: $env{'form.start_'.$one.'_'.$two.'_'.$three} :
1473: $now );
1474: my $end = ( $env{'form.end_'.$one.'_'.$two.'_'.$three} ?
1475: $env{'form.end_'.$one.'_'.$two.'_'.$three} :
1476: 0 );
1477: my $url='/'.$one.'/'.$two;
1478: my $type = 'three';
1479: # split multiple sections
1480: my %sections = ();
1481: my $num_sections = &build_roles($env{'form.sec_'.$one.'_'.$two.'_'.$three},\%sections,$three);
1482: if ($num_sections == 0) {
1483: $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$three,$start,$end,$one,$two,''));
1484: } else {
1485: my %curr_groups =
1486: &Apache::longroup::coursegroups($one,$two);
1487: my $emptysec = 0;
1488: foreach my $sec (sort {$a cmp $b} keys %sections) {
1489: $sec =~ s/\W//g;
1490: if ($sec ne '') {
1491: if (($sec eq 'none') || ($sec eq 'all') ||
1492: exists($curr_groups{$sec})) {
1493: $disallowed{$sec} = $url;
1494: next;
1495: }
1496: my $securl = $url.'/'.$sec;
1497: $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$securl,$three,$start,$end,$one,$two,$sec));
1498: } else {
1499: $emptysec = 1;
1500: }
1501: }
1502: if ($emptysec) {
1503: $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$three,$start,$end,$one,$two,''));
1504: }
1505: }
1506: } elsif ($key=~/^form\.act\_([^\_]+)\_([^\_]+)$/) {
1507: # Activate roles for sections with two id numbers
1508: # set start, end times, and the url for the class
1509: my $start = ( $env{'form.start_'.$1.'_'.$2} ?
1510: $env{'form.start_'.$1.'_'.$2} :
1511: $now );
1512: my $end = ( $env{'form.end_'.$1.'_'.$2} ?
1513: $env{'form.end_'.$1.'_'.$2} :
1514: 0 );
1515: my $url='/'.$1.'/';
1516: # split multiple sections
1517: my %sections = ();
1518: my $num_sections = &build_roles($env{'form.sec_'.$1.'_'.$2},\%sections,$2);
1519: if ($num_sections == 0) {
1520: $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$2,$start,$end,$1,undef,''));
1521: } else {
1522: my $emptysec = 0;
1523: foreach my $sec (sort {$a cmp $b} keys %sections) {
1524: if ($sec ne '') {
1525: my $securl = $url.'/'.$sec;
1526: $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$securl,$2,$start,$end,$1,undef,$sec));
1527: } else {
1528: $emptysec = 1;
1529: }
1530: }
1531: if ($emptysec) {
1532: $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$2,$start,$end,$1,undef,''));
1533: }
1534: }
1535: } else {
1536: $r->print('<p>'.&mt('ERROR').': '.&mt('Unknown command').' <tt>'.$key.'</tt></p><br />');
1537: }
1538: foreach my $key (sort(keys(%disallowed))) {
1539: if (($key eq 'none') || ($key eq 'all')) {
1540: $r->print('<p>'.&mt('[_1] may not be used as the name for a section, as it is a reserved word.',$key));
1541: } else {
1542: $r->print('<p>'.&mt('[_1] may not be used as the name for a section, as it is the name of a course group.',$key));
1543: }
1544: $r->print(' '.&mt('Please <a href="javascript:history.go(-1)">go back</a> and choose a different section name.').'</p><br />');
1545: }
1546: }
1547: } # End of foreach (keys(%env))
1548: # Flush the course logs so reverse user roles immediately updated
1549: &Apache::lonnet::flushcourselogs();
1550: $r->print('<p><a href="/adm/createuser">Create/Modify Another User</a></p>');
1551: $r->print(&Apache::loncommon::end_page());
1552: }
1553:
1554: sub quota_admin {
1555: my ($setquota,$changeHash) = @_;
1556: my $quotachanged;
1557: if (&Apache::lonnet::allowed('mpq',$env{'form.ccdomain'})) {
1558: # Current user has quota modification privileges
1559: $quotachanged = 1;
1560: $changeHash->{'portfolioquota'} = $setquota;
1561: }
1562: return $quotachanged;
1563: }
1564:
1565: sub build_roles {
1566: my ($sectionstr,$sections,$role) = @_;
1567: my $num_sections = 0;
1568: if ($sectionstr=~ /,/) {
1569: my @secnums = split/,/,$sectionstr;
1570: if ($role eq 'st') {
1571: $secnums[0] =~ s/\W//g;
1572: $$sections{$secnums[0]} = 1;
1573: $num_sections = 1;
1574: } else {
1575: foreach my $sec (@secnums) {
1576: $sec =~ ~s/\W//g;
1577: if (!($sec eq "")) {
1578: if (exists($$sections{$sec})) {
1579: $$sections{$sec} ++;
1580: } else {
1581: $$sections{$sec} = 1;
1582: $num_sections ++;
1583: }
1584: }
1585: }
1586: }
1587: } else {
1588: $sectionstr=~s/\W//g;
1589: unless ($sectionstr eq '') {
1590: $$sections{$sectionstr} = 1;
1591: $num_sections ++;
1592: }
1593: }
1594:
1595: return $num_sections;
1596: }
1597:
1598: # ========================================================== Custom Role Editor
1599:
1600: sub custom_role_editor {
1601: my $r=shift;
1602: my $rolename=$env{'form.rolename'};
1603:
1604: if ($rolename eq 'make new role') {
1605: $rolename=$env{'form.newrolename'};
1606: }
1607:
1608: $rolename=~s/[^A-Za-z0-9]//gs;
1609:
1610: if (!$rolename) {
1611: &print_username_entry_form($r);
1612: return;
1613: }
1614: # ------------------------------------------------------- What can be assigned?
1615: my %full=();
1616: my %courselevel=();
1617: my %courselevelcurrent=();
1618: my $syspriv='';
1619: my $dompriv='';
1620: my $coursepriv='';
1621: my $body_top;
1622: my ($disp_dummy,$disp_roles) = &Apache::lonnet::get('roles',["st"]);
1623: my ($rdummy,$roledef)=
1624: &Apache::lonnet::get('roles',["rolesdef_$rolename"]);
1625: # ------------------------------------------------------- Does this role exist?
1626: $body_top .= '<h2>';
1627: if (($rdummy ne 'con_lost') && ($roledef ne '')) {
1628: $body_top .= &mt('Existing Role').' "';
1629: # ------------------------------------------------- Get current role privileges
1630: ($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
1631: } else {
1632: $body_top .= &mt('New Role').' "';
1633: $roledef='';
1634: }
1635: $body_top .= $rolename.'"</h2>';
1636: foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
1637: my ($priv,$restrict)=split(/\&/,$item);
1638: if (!$restrict) { $restrict='F'; }
1639: $courselevel{$priv}=$restrict;
1640: if ($coursepriv=~/\:$priv/) {
1641: $courselevelcurrent{$priv}=1;
1642: }
1643: $full{$priv}=1;
1644: }
1645: my %domainlevel=();
1646: my %domainlevelcurrent=();
1647: foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
1648: my ($priv,$restrict)=split(/\&/,$item);
1649: if (!$restrict) { $restrict='F'; }
1650: $domainlevel{$priv}=$restrict;
1651: if ($dompriv=~/\:$priv/) {
1652: $domainlevelcurrent{$priv}=1;
1653: }
1654: $full{$priv}=1;
1655: }
1656: my %systemlevel=();
1657: my %systemlevelcurrent=();
1658: foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
1659: my ($priv,$restrict)=split(/\&/,$item);
1660: if (!$restrict) { $restrict='F'; }
1661: $systemlevel{$priv}=$restrict;
1662: if ($syspriv=~/\:$priv/) {
1663: $systemlevelcurrent{$priv}=1;
1664: }
1665: $full{$priv}=1;
1666: }
1667: my $button_code = "\n";
1668: my $head_script = "\n";
1669: $head_script .= '<script type="text/javascript">'."\n";
1670: my @template_roles = ("cc","in","ta","ep","st");
1671: foreach my $role (@template_roles) {
1672: $head_script .= &make_script_template($role);
1673: $button_code .= &make_button_code($role);
1674: }
1675: $head_script .= '</script>'."\n";
1676: $r->print(&Apache::loncommon::start_page('Custom Role Editor',$head_script));
1677: $r->print($body_top);
1678: my %lt=&Apache::lonlocal::texthash(
1679: 'prv' => "Privilege",
1680: 'crl' => "Course Level",
1681: 'dml' => "Domain Level",
1682: 'ssl' => "System Level");
1683: $r->print('Select a Template<br />');
1684: $r->print('<form action="">');
1685: $r->print($button_code);
1686: $r->print('</form>');
1687: $r->print(<<ENDCCF);
1688: <form name=form1 method="post">
1689: <input type="hidden" name="phase" value="set_custom_roles" />
1690: <input type="hidden" name="rolename" value="$rolename" />
1691: ENDCCF
1692: $r->print(&Apache::loncommon::start_data_table().
1693: &Apache::loncommon::start_data_table_header_row().
1694: '<th>'.$lt{'prv'}.'</th><th>'.$lt{'crl'}.'</th><th>'.$lt{'dml'}.
1695: '</th><th>'.$lt{'ssl'}.'</th>'.
1696: &Apache::loncommon::end_data_table_header_row());
1697: foreach my $priv (sort keys %full) {
1698: my $privtext = &Apache::lonnet::plaintext($priv);
1699: $r->print(&Apache::loncommon::start_data_table_row().
1700: '<td>'.$privtext.'</td><td>'.
1701: ($courselevel{$priv}?'<input type="checkbox" name="'.$priv.'_c" '.
1702: ($courselevelcurrent{$priv}?'checked="1"':'').' />':' ').
1703: '</td><td>'.
1704: ($domainlevel{$priv}?'<input type="checkbox" name="'.$priv.'_d" '.
1705: ($domainlevelcurrent{$priv}?'checked="1"':'').' />':' ').
1706: '</td><td>'.
1707: ($systemlevel{$priv}?'<input type="checkbox" name="'.$priv.'_s" '.
1708: ($systemlevelcurrent{$priv}?'checked="1"':'').' />':' ').
1709: '</td>'.
1710: &Apache::loncommon::end_data_table_row());
1711: }
1712: $r->print(&Apache::loncommon::end_data_table().
1713: '<input type="reset" value="'.&mt("Reset").'" /><input type="submit" value="'.&mt('Define Role').'" /></form>'.
1714: &Apache::loncommon::end_page());
1715: }
1716: # --------------------------------------------------------
1717: sub make_script_template {
1718: my ($role) = @_;
1719: my %full_c=();
1720: my %full_d=();
1721: my %full_s=();
1722: my $return_script;
1723: foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
1724: my ($priv,$restrict)=split(/\&/,$item);
1725: $full_c{$priv}=1;
1726: }
1727: foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
1728: my ($priv,$restrict)=split(/\&/,$item);
1729: $full_d{$priv}=1;
1730: }
1731: foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
1732: my ($priv,$restrict)=split(/\&/,$item);
1733: $full_s{$priv}=1;
1734: }
1735: $return_script .= 'function set_'.$role.'() {'."\n";
1736: my @temp = split(/:/,$Apache::lonnet::pr{$role.':c'});
1737: my %role_c;
1738: foreach my $priv (@temp) {
1739: my ($priv_item, $dummy) = split(/\&/,$priv);
1740: $role_c{$priv_item} = 1;
1741: }
1742: foreach my $priv_item (keys(%full_c)) {
1743: my ($priv, $dummy) = split(/\&/,$priv_item);
1744: if (exists($role_c{$priv})) {
1745: $return_script .= "document.form1.$priv"."_c.checked = true;\n";
1746: } else {
1747: $return_script .= "document.form1.$priv"."_c.checked = false;\n";
1748: }
1749: }
1750: my %role_d;
1751: @temp = split(/:/,$Apache::lonnet::pr{$role.':d'});
1752: foreach my $priv(@temp) {
1753: my ($priv_item, $dummy) = split(/\&/,$priv);
1754: $role_d{$priv_item} = 1;
1755: }
1756: foreach my $priv_item (keys(%full_d)) {
1757: my ($priv, $dummy) = split(/\&/,$priv_item);
1758: if (exists($role_d{$priv})) {
1759: $return_script .= "document.form1.$priv"."_d.checked = true;\n";
1760: } else {
1761: $return_script .= "document.form1.$priv"."_d.checked = false;\n";
1762: }
1763: }
1764: my %role_s;
1765: @temp = split(/:/,$Apache::lonnet::pr{$role.':s'});
1766: foreach my $priv(@temp) {
1767: my ($priv_item, $dummy) = split(/\&/,$priv);
1768: $role_s{$priv_item} = 1;
1769: }
1770: foreach my $priv_item (keys(%full_s)) {
1771: my ($priv, $dummy) = split(/\&/,$priv_item);
1772: if (exists($role_s{$priv})) {
1773: $return_script .= "document.form1.$priv"."_s.checked = true;\n";
1774: } else {
1775: $return_script .= "document.form1.$priv"."_s.checked = false;\n";
1776: }
1777: }
1778: $return_script .= '}'."\n";
1779: return ($return_script);
1780: }
1781: # ----------------------------------------------------------
1782: sub make_button_code {
1783: my ($role) = @_;
1784: my $label = &Apache::lonnet::plaintext($role);
1785: my $button_code = '<input type="button" onClick="set_'.$role.'()" value="'.$label.'" />';
1786: return ($button_code);
1787: }
1788: # ---------------------------------------------------------- Call to definerole
1789: sub set_custom_role {
1790: my ($r) = @_;
1791:
1792: my $rolename=$env{'form.rolename'};
1793:
1794: $rolename=~s/[^A-Za-z0-9]//gs;
1795:
1796: if (!$rolename) {
1797: &print_username_entry_form($r);
1798: return;
1799: }
1800:
1801: $r->print(&Apache::loncommon::start_page('Save Custom Role').'<h2>');
1802: my ($rdummy,$roledef)=
1803: &Apache::lonnet::get('roles',["rolesdef_$rolename"]);
1804:
1805: # ------------------------------------------------------- Does this role exist?
1806: if (($rdummy ne 'con_lost') && ($roledef ne '')) {
1807: $r->print(&mt('Existing Role').' "');
1808: } else {
1809: $r->print(&mt('New Role').' "');
1810: $roledef='';
1811: }
1812: $r->print($rolename.'"</h2>');
1813: # ------------------------------------------------------- What can be assigned?
1814: my $sysrole='';
1815: my $domrole='';
1816: my $courole='';
1817:
1818: foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
1819: my ($priv,$restrict)=split(/\&/,$item);
1820: if (!$restrict) { $restrict=''; }
1821: if ($env{'form.'.$priv.'_c'}) {
1822: $courole.=':'.$item;
1823: }
1824: }
1825:
1826: foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
1827: my ($priv,$restrict)=split(/\&/,$item);
1828: if (!$restrict) { $restrict=''; }
1829: if ($env{'form.'.$priv.'_d'}) {
1830: $domrole.=':'.$item;
1831: }
1832: }
1833:
1834: foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
1835: my ($priv,$restrict)=split(/\&/,$item);
1836: if (!$restrict) { $restrict=''; }
1837: if ($env{'form.'.$priv.'_s'}) {
1838: $sysrole.=':'.$item;
1839: }
1840: }
1841: $r->print('<br />Defining Role: '.
1842: &Apache::lonnet::definerole($rolename,$sysrole,$domrole,$courole));
1843: if ($env{'request.course.id'}) {
1844: my $url='/'.$env{'request.course.id'};
1845: $url=~s/\_/\//g;
1846: $r->print('<br />'.&mt('Assigning Role to Self').': '.
1847: &Apache::lonnet::assigncustomrole($env{'user.domain'},
1848: $env{'user.name'},
1849: $url,
1850: $env{'user.domain'},
1851: $env{'user.name'},
1852: $rolename));
1853: }
1854: $r->print('<p><a href="/adm/createuser">Create another role, or Create/Modify a user.</a></p>');
1855: $r->print(&Apache::loncommon::end_page());
1856: }
1857:
1858: # ================================================================ Main Handler
1859: sub handler {
1860: my $r = shift;
1861:
1862: if ($r->header_only) {
1863: &Apache::loncommon::content_type($r,'text/html');
1864: $r->send_http_header;
1865: return OK;
1866: }
1867:
1868: if ((&Apache::lonnet::allowed('cta',$env{'request.course.id'})) ||
1869: (&Apache::lonnet::allowed('cin',$env{'request.course.id'})) ||
1870: (&Apache::lonnet::allowed('ccr',$env{'request.course.id'})) ||
1871: (&Apache::lonnet::allowed('cep',$env{'request.course.id'})) ||
1872: (&authorpriv($env{'user.name'},$env{'request.role.domain'})) ||
1873: (&Apache::lonnet::allowed('mau',$env{'request.role.domain'}))) {
1874: &Apache::loncommon::content_type($r,'text/html');
1875: $r->send_http_header;
1876: if (!$env{'form.phase'}) {
1877: &print_username_entry_form($r);
1878: }
1879: if ($env{'form.phase'} eq 'get_user_info') {
1880: &print_user_modification_page($r);
1881: } elsif ($env{'form.phase'} eq 'update_user_data') {
1882: &update_user_data($r);
1883: } elsif ($env{'form.phase'} eq 'selected_custom_edit') {
1884: &custom_role_editor($r);
1885: } elsif ($env{'form.phase'} eq 'set_custom_roles') {
1886: &set_custom_role($r);
1887: }
1888: } else {
1889: $env{'user.error.msg'}=
1890: "/adm/createuser:mau:0:0:Cannot modify user data";
1891: return HTTP_NOT_ACCEPTABLE;
1892: }
1893: return OK;
1894: }
1895:
1896: #-------------------------------------------------- functions for &phase_two
1897: sub course_level_table {
1898: my (%inccourses) = @_;
1899: my $table = '';
1900: # Custom Roles?
1901:
1902: my %customroles=&my_custom_roles();
1903: my %lt=&Apache::lonlocal::texthash(
1904: 'exs' => "Existing sections",
1905: 'new' => "Define new section",
1906: 'ssd' => "Set Start Date",
1907: 'sed' => "Set End Date",
1908: 'crl' => "Course Level",
1909: 'act' => "Activate",
1910: 'rol' => "Role",
1911: 'ext' => "Extent",
1912: 'grs' => "Section",
1913: 'sta' => "Start",
1914: 'end' => "End"
1915: );
1916:
1917: foreach my $protectedcourse (sort( keys(%inccourses))) {
1918: my $thiscourse=$protectedcourse;
1919: $thiscourse=~s:_:/:g;
1920: my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
1921: my $area=$coursedata{'description'};
1922: my $type=$coursedata{'type'};
1923: if (!defined($area)) { $area=&mt('Unavailable course').': '.$protectedcourse; }
1924: my ($domain,$cnum)=split(/\//,$thiscourse);
1925: my %sections_count;
1926: if (defined($env{'request.course.id'})) {
1927: if ($env{'request.course.id'} eq $domain.'_'.$cnum) {
1928: %sections_count =
1929: &Apache::loncommon::get_sections($domain,$cnum);
1930: }
1931: }
1932: foreach my $role ('st','ta','ep','in','cc') {
1933: if (&Apache::lonnet::allowed('c'.$role,$thiscourse)) {
1934: my $plrole=&Apache::lonnet::plaintext($role);
1935: $table .= &Apache::loncommon::start_data_table_row().
1936: '<td><input type="checkbox" name="act_'.$protectedcourse.'_'.$role.'" /></td>
1937: <td>'.$plrole.'</td>
1938: <td>'.$area.'<br />Domain: '.$domain.'</td>'."\n";
1939: if ($role ne 'cc') {
1940: if (%sections_count) {
1941: my $currsec = &course_sections(\%sections_count,$protectedcourse.'_'.$role);
1942: $table .=
1943: '<td><table class="LC_createuser">'.
1944: '<tr class="LC_section_row">
1945: <td valign="top">'.$lt{'exs'}.'<br />'.
1946: $currsec.'</td>'.
1947: '<td> </td>'.
1948: '<td valign="top"> '.$lt{'new'}.'<br />'.
1949: '<input type="text" name="newsec_'.$protectedcourse.'_'.$role.'" value="" />'.
1950: '<input type="hidden" '.
1951: 'name="sec_'.$protectedcourse.'_'.$role.'" /></td>'.
1952: '</tr></table></td>';
1953: } else {
1954: $table .= '<td><input type="text" size="10" '.
1955: 'name="sec_'.$protectedcourse.'_'.$role.'" /></td>';
1956: }
1957: } else {
1958: $table .= '<td> </td>';
1959: }
1960: $table .= <<ENDTIMEENTRY;
1961: <td><input type=hidden name="start_$protectedcourse\_$role" value='' />
1962: <a href=
1963: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$role.value,'start_$protectedcourse\_$role','cu.pres','dateset')">$lt{'ssd'}</a></td>
1964: <td><input type=hidden name="end_$protectedcourse\_$role" value='' />
1965: <a href=
1966: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$role.value,'end_$protectedcourse\_$role','cu.pres','dateset')">$lt{'sed'}</a></td>
1967: ENDTIMEENTRY
1968: $table.= &Apache::loncommon::end_data_table_row();
1969: }
1970: }
1971: foreach my $cust (sort keys %customroles) {
1972: if (&Apache::lonnet::allowed('ccr',$thiscourse)) {
1973: my $plrole=$cust;
1974: my $customrole=$protectedcourse.'_cr_cr_'.$env{'user.domain'}.
1975: '_'.$env{'user.name'}.'_'.$plrole;
1976: $table .= &Apache::loncommon::start_data_table_row().
1977: '<td><input type="checkbox" name="act_'.$customrole.'" /></td>
1978: <td>'.$plrole.'</td>
1979: <td>'.$area.'</td>'."\n";
1980: if (%sections_count) {
1981: my $currsec = &course_sections(\%sections_count,$customrole);
1982: $table.=
1983: '<td><table border="0" cellspacing="0" cellpadding="0">'.
1984: '<tr><td valign="top">'.$lt{'exs'}.'<br />'.
1985: $currsec.'</td>'.
1986: '<td> </td>'.
1987: '<td valign="top"> '.$lt{'new'}.'<br />'.
1988: '<input type="text" name="newsec_'.$customrole.'" value="" /></td>'.
1989: '<input type="hidden" '.
1990: 'name="sec_'.$customrole.'" /></td>'.
1991: '</tr></table></td>';
1992: } else {
1993: $table .= '<td><input type="text" size="10" '.
1994: 'name="sec_'.$customrole.'" /></td>';
1995: }
1996: $table .= <<ENDENTRY;
1997: <td><input type=hidden name="start_$customrole" value='' />
1998: <a href=
1999: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$customrole.value,'start_$customrole','cu.pres','dateset')">$lt{'ssd'}</a></td>
2000: <td><input type=hidden name="end_$customrole" value='' />
2001: <a href=
2002: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$customrole.value,'end_$customrole','cu.pres','dateset')">$lt{'sed'}</a></td>
2003: ENDENTRY
2004: $table .= &Apache::loncommon::end_data_table_row();
2005: }
2006: }
2007: }
2008: return '' if ($table eq ''); # return nothing if there is nothing
2009: # in the table
2010: my $result = '
2011: <h4>'.$lt{'crl'}.'</h4>'.
2012: &Apache::loncommon::start_data_table().
2013: &Apache::loncommon::start_data_table_header_row().
2014: '<th>'.$lt{'act'}.'</th><th>'.$lt{'rol'}.'</th><th>'.$lt{'ext'}.'</th>
2015: <th>'.$lt{'grs'}.'</th><th>'.$lt{'sta'}.'</th><th>'.$lt{'end'}.'</th>'.
2016: &Apache::loncommon::end_data_table_header_row().
2017: $table.
2018: &Apache::loncommon::end_data_table();
2019: return $result;
2020: }
2021:
2022: sub course_sections {
2023: my ($sections_count,$role) = @_;
2024: my $output = '';
2025: my @sections = (sort {$a <=> $b} keys %{$sections_count});
2026: if (scalar(@sections) == 1) {
2027: $output = '<select name="currsec_'.$role.'" >'."\n".
2028: ' <option value="">Select</option>'."\n".
2029: ' <option value="">No section</option>'."\n".
2030: ' <option value="'.$sections[0].'" >'.$sections[0].'</option>'."\n";
2031: } else {
2032: $output = '<select name="currsec_'.$role.'" ';
2033: my $multiple = 4;
2034: if (scalar(@sections) < 4) { $multiple = scalar(@sections); }
2035: $output .= 'multiple="multiple" size="'.$multiple.'">'."\n";
2036: foreach my $sec (@sections) {
2037: $output .= '<option value="'.$sec.'">'.$sec."</option>\n";
2038: }
2039: }
2040: $output .= '</select>';
2041: return $output;
2042: }
2043:
2044: sub course_level_dc {
2045: my ($dcdom) = @_;
2046: my %customroles=&my_custom_roles();
2047: my $hiddenitems = '<input type="hidden" name="dcdomain" value="'.$dcdom.'" />'.
2048: '<input type="hidden" name="origdom" value="'.$dcdom.'" />'.
2049: '<input type="hidden" name="dccourse" value="" />';
2050: my $courseform='<b>'.&Apache::loncommon::selectcourse_link
2051: ('cu','dccourse','dcdomain','coursedesc',undef,undef,'Course').'</b>';
2052: my $cb_jscript = &Apache::loncommon::coursebrowser_javascript($dcdom,'currsec','cu');
2053: my %lt=&Apache::lonlocal::texthash(
2054: 'rol' => "Role",
2055: 'grs' => "Section",
2056: 'exs' => "Existing sections",
2057: 'new' => "Define new section",
2058: 'sta' => "Start",
2059: 'end' => "End",
2060: 'ssd' => "Set Start Date",
2061: 'sed' => "Set End Date"
2062: );
2063: my $header = '<h4>'.&mt('Course Level').'</h4>'.
2064: &Apache::loncommon::start_data_table().
2065: &Apache::loncommon::start_data_table_header_row().
2066: '<th>'.$courseform.'</th><th>'.$lt{'rol'}.'</th><th>'.$lt{'grs'}.'</th><th>'.$lt{'sta'}.'</th><th>'.$lt{'end'}.'</th>'.
2067: &Apache::loncommon::end_data_table_header_row();
2068: my $otheritems = &Apache::loncommon::start_data_table_row()."\n".
2069: '<td><input type="text" name="coursedesc" value="" onFocus="this.blur();opencrsbrowser('."'cu','dccourse','dcdomain','coursedesc',''".')" /></td>'."\n".
2070: '<td><select name="role">'."\n";
2071: foreach my $role ('st','ta','ep','in','cc') {
2072: my $plrole=&Apache::lonnet::plaintext($role);
2073: $otheritems .= ' <option value="'.$role.'">'.$plrole;
2074: }
2075: if ( keys %customroles > 0) {
2076: foreach my $cust (sort keys %customroles) {
2077: my $custrole='cr_cr_'.$env{'user.domain'}.
2078: '_'.$env{'user.name'}.'_'.$cust;
2079: $otheritems .= ' <option value="'.$custrole.'">'.$cust;
2080: }
2081: }
2082: $otheritems .= '</select></td><td>'.
2083: '<table border="0" cellspacing="0" cellpadding="0">'.
2084: '<tr><td valign="top"><b>'.$lt{'exs'}.'</b><br /><select name="currsec">'.
2085: ' <option value=""><--'.&mt('Pick course first').'</select></td>'.
2086: '<td> </td>'.
2087: '<td valign="top"> <b>'.$lt{'new'}.'</b><br />'.
2088: '<input type="text" name="newsec" value="" />'.
2089: '<input type="hidden" name="groups" value="" /></td>'.
2090: '</tr></table></td>';
2091: $otheritems .= <<ENDTIMEENTRY;
2092: <td><input type=hidden name="start" value='' />
2093: <a href=
2094: "javascript:pjump('date_start','Start Date',document.cu.start.value,'start','cu.pres','dateset')">$lt{'ssd'}</a></td>
2095: <td><input type=hidden name="end" value='' />
2096: <a href=
2097: "javascript:pjump('date_end','End Date',document.cu.end.value,'end','cu.pres','dateset')">$lt{'sed'}</a></td>
2098: ENDTIMEENTRY
2099: $otheritems .= &Apache::loncommon::end_data_table_row().
2100: &Apache::loncommon::end_data_table()."\n";
2101: return $cb_jscript.$header.$hiddenitems.$otheritems;
2102: }
2103:
2104: #---------------------------------------------- end functions for &phase_two
2105:
2106: #--------------------------------- functions for &phase_two and &phase_three
2107:
2108: #--------------------------end of functions for &phase_two and &phase_three
2109:
2110: 1;
2111: __END__
2112:
2113:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>