--- loncom/interface/domainprefs.pm 2009/12/04 14:33:52 1.123 +++ loncom/interface/domainprefs.pm 2011/11/07 03:27:23 1.138.2.12 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.123 2009/12/04 14:33:52 jms Exp $ +# $Id: domainprefs.pm,v 1.138.2.12 2011/11/07 03:27:23 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -140,7 +140,7 @@ autolimit =over -- course requests will be processed autoatically up to a limit of +- course requests will be processed automatically up to a limit of N requests for the course type for the particular requestor. If N is undefined, there is no limit to the number of course requests which a course owner may submit and have processed automatically. @@ -171,6 +171,9 @@ use Locale::Language; use DateTime::TimeZone; use DateTime::Locale; +my $registered_cleanup; +my $modified_urls; + sub handler { my $r=shift; if ($r->header_only) { @@ -190,6 +193,10 @@ sub handler { "/adm/domainprefs:mau:0:0:Cannot modify domain settings"; return HTTP_NOT_ACCEPTABLE; } + + $registered_cleanup=0; + @{$modified_urls}=(); + &Apache::lonhtmlcommon::clear_breadcrumbs(); &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['phase','actions']); @@ -199,15 +206,16 @@ sub handler { } my %domconfig = &Apache::lonnet::get_dom('configuration',['login','rolecolors', - 'quotas','autoenroll','autoupdate','directorysrch', - 'usercreation','usermodification','contacts','defaults', - 'scantron','coursecategories','serverstatuses', - 'requestcourses','helpsettings','coursedefaults'],$dom); + 'quotas','autoenroll','autoupdate','autocreate', + 'directorysrch','usercreation','usermodification', + 'contacts','defaults','scantron','coursecategories', + 'serverstatuses','requestcourses','coursedefaults', + 'usersessions'],$dom); my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll', - 'autoupdate','directorysrch','contacts', + 'autoupdate','autocreate','directorysrch','contacts', 'usercreation','usermodification','scantron', - 'requestcourses','coursecategories','serverstatuses','helpsettings', - 'coursedefaults'); + 'requestcourses','coursecategories','serverstatuses', + 'coursedefaults','usersessions'); my %prefs = ( 'rolecolors' => { text => 'Default color schemes', @@ -229,13 +237,13 @@ sub handler { }, 'defaults' => - { text => 'Default authentication/language/timezone', + { text => 'Default authentication/language/timezone/portal', help => 'Domain_Configuration_LangTZAuth', header => [{col1 => 'Setting', col2 => 'Value'}], }, 'quotas' => - { text => 'User blogs, personal information pages and portfolios', + { text => 'User blogs, personal information pages, portfolios', help => 'Domain_Configuration_Quotas', header => [{col1 => 'User affiliation', col2 => 'Available tools', @@ -252,8 +260,16 @@ sub handler { help => 'Domain_Configuration_Auto_Updates', header => [{col1 => 'Setting', col2 => 'Value',}, + {col1 => 'Setting', + col2 => 'Affiliation'}, {col1 => 'User population', - col2 => 'Updataeable user data'}], + col2 => 'Updateable user data'}], + }, + 'autocreate' => + { text => 'Auto-course creation settings', + help => 'Domain_Configuration_Auto_Creation', + header => [{col1 => 'Configuration Setting', + col2 => 'Value',}], }, 'directorysrch' => { text => 'Institutional directory searches', @@ -328,10 +344,10 @@ sub handler { {col1 => 'Unauthenticated Help Settings', col2 => ''}], }, - 'coursedefaults' => + 'coursedefaults' => {text => 'Course/Community defaults', help => 'Domain_Configuration_Course_Defaults', - header => [{col1 => 'Setting', + header => [{col1 => 'Defaults which can be overridden for each course by a DC', col2 => 'Value',}], }, 'privacy' => @@ -340,6 +356,14 @@ sub handler { header => [{col1 => 'Setting', col2 => 'Value',}], }, + 'usersessions' => + {text => 'User session hosting', + help => 'Domain_Configuration_User_Sessions', + header => [{col1 => 'Hosting of users from other domains', + col2 => 'Rules'}, + {col1 => "Hosting domain's own users elsewhere", + col2 => 'Rules'}], + }, ); my %servers = &dom_servers($dom); if (keys(%servers) > 1) { @@ -355,7 +379,7 @@ sub handler { my @actions = &Apache::loncommon::get_env_multiple('form.actions'); &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:changePage(document.$phase,'pickactions')", - text=>"Pick functionality"}); + text=>"Settings to display/modify"}); my $confname = $dom.'-domainconfig'; if ($phase eq 'process') { &Apache::lonconfigsettings::make_changes($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,\@roles); @@ -418,6 +442,8 @@ sub process_changes { $output = &modify_autoenroll($dom,%domconfig); } elsif ($action eq 'autoupdate') { $output = &modify_autoupdate($dom,%domconfig); + } elsif ($action eq 'autocreate') { + $output = &modify_autocreate($dom,%domconfig); } elsif ($action eq 'directorysrch') { $output = &modify_directorysrch($dom,%domconfig); } elsif ($action eq 'usercreation') { @@ -436,10 +462,10 @@ sub process_changes { $output = &modify_serverstatuses($dom,%domconfig); } elsif ($action eq 'requestcourses') { $output = &modify_quotas($dom,$action,%domconfig); - } elsif ($action eq 'helpsettings') { - $output = &modify_helpsettings($r,$dom,$confname,%domconfig); } elsif ($action eq 'coursedefaults') { $output = &modify_coursedefaults($dom,%domconfig); + } elsif ($action eq 'usersessions') { + $output = &modify_usersessions($dom,%domconfig); } return $output; } @@ -492,6 +518,8 @@ sub print_config_box { $output .= &print_quotas($dom,$settings,\$rowtotal,$action); } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal); + } elsif ($action eq 'usersessions') { + $output .= &print_usersessions('top',$dom,$settings,\$rowtotal); } elsif ($action eq 'rolecolors') { $output .= &print_rolecolors($phase,'student',$dom,$confname,$settings,\$rowtotal); } @@ -509,7 +537,18 @@ sub print_config_box { '; $rowtotal ++; if ($action eq 'autoupdate') { - $output .= &print_autoupdate('bottom',$dom,$settings,\$rowtotal); + $output .= &print_autoupdate('middle',$dom,$settings,\$rowtotal).' + + + + + + + + + '. + &print_autoupdate('bottom',$dom,$settings,\$rowtotal); + $rowtotal ++; } elsif ($action eq 'usercreation') { $output .= &print_usercreation('middle',$dom,$settings,\$rowtotal).'
'.&mt($item->{'header'}->[2]->{'col1'}).''.&mt($item->{'header'}->[2]->{'col2'}).'
@@ -534,7 +573,6 @@ sub print_config_box { '.&mt($item->{'header'}->[2]->{'col1'}).' '.&mt($item->{'header'}->[2]->{'col2'}).' '. - &print_usermodification('bottom',$dom,$settings,\$rowtotal); $rowtotal ++; } elsif ($action eq 'coursecategories') { @@ -545,6 +583,8 @@ sub print_config_box { $output .= &print_courserequestmail($dom,$settings,\$rowtotal); } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('bottom',$dom,$confname,$settings,\$rowtotal); + } elsif ($action eq 'usersessions') { + $output .= &print_usersessions('bottom',$dom,$settings,\$rowtotal); } elsif ($action eq 'rolecolors') { $output .= &print_rolecolors($phase,'coordinator',$dom,$confname,$settings,\$rowtotal).' @@ -619,6 +659,8 @@ sub print_config_box { $output .= &print_quotas($dom,$settings,\$rowtotal,$action); } elsif ($action eq 'autoenroll') { $output .= &print_autoenroll($dom,$settings,\$rowtotal); + } elsif ($action eq 'autocreate') { + $output .= &print_autocreate($dom,$settings,\$rowtotal); } elsif ($action eq 'directorysrch') { $output .= &print_directorysrch($dom,$settings,\$rowtotal); } elsif ($action eq 'contacts') { @@ -629,10 +671,8 @@ sub print_config_box { $output .= &print_scantronformat($r,$dom,$confname,$settings,\$rowtotal); } elsif ($action eq 'serverstatuses') { $output .= &print_serverstatuses($dom,$settings,\$rowtotal); - } elsif ($action eq 'helpsettings') { - $output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal); - } elsif ($action eq 'coursedefaults') { - $output .= &print_coursedefaults($dom,$settings,\$rowtotal); + } elsif ($action eq 'coursedefaults') { + $output .= &print_coursedefaults('bottom',$dom,$settings,\$rowtotal); } } $output .= ' @@ -647,15 +687,17 @@ sub print_login { my ($position,$dom,$confname,$phase,$settings,$rowtotal) = @_; my ($css_class,$datatable); my %choices = &login_choices(); - my $itemcount = 1; if ($position eq 'top') { my %servers = &dom_servers($dom); my $choice = $choices{'disallowlogin'}; $css_class = ' class="LC_odd_row"'; - $datatable .= ''.$choices{'disallowlogin'}.''. + $datatable .= ''.$choice.''. ''. - ''."\n"; + ''. + ''. + ''. + ''."\n"; my %disallowed; if (ref($settings) eq 'HASH') { if (ref($settings->{'loginvia'}) eq 'HASH') { @@ -664,23 +706,52 @@ sub print_login { } foreach my $lonhost (sort(keys(%servers))) { my $direct = 'selected="selected"'; - if ($disallowed{$lonhost} eq '') { - $direct = ''; + if (ref($disallowed{$lonhost}) eq 'HASH') { + if ($disallowed{$lonhost}{'server'} ne '') { + $direct = ''; + } } $datatable .= ''. - ''; + $datatable .= ''. + ''; + my ($custom,$exempt); + if (ref($disallowed{$lonhost}) eq 'HASH') { + $custom = $disallowed{$lonhost}{'custompath'}; + $exempt = $disallowed{$lonhost}{'exempt'}; + } + $datatable .= ''. + ''. + ''; } $datatable .= '
'.$choices{'hostid'}.''.$choices{'serverurl'}.'
'.$choices{'server'}.''.$choices{'serverpath'}.''.$choices{'custompath'}.''.$choices{'exempt'}.'
'.$servers{$lonhost}.'
'; return $datatable; @@ -702,7 +773,6 @@ sub print_login { $checkedon{$item} = ' '; } } - my $loginheader = 'image'; my @images = ('img','logo','domlogo','login'); my @logintext = ('textcol','bgcol'); my @bgs = ('pgbg','mainbg','sidebg'); @@ -751,9 +821,6 @@ sub print_login { $is_custom{$item} = 1; } } - if ($settings->{'loginheader'} ne '') { - $loginheader = $settings->{'loginheader'}; - } if ($settings->{'font'} ne '') { $designs{'font'} = $settings->{'font'}; $is_custom{'font'} = 1; @@ -799,7 +866,6 @@ sub print_login { domlogo => 'Domain Logo', login => 'Login box'); my $itemcount = 1; - my ($css_class,$datatable); foreach my $item (@toggles) { $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= @@ -812,7 +878,7 @@ sub print_login { ''; $itemcount ++; } - $datatable .= &display_color_options($dom,$confname,$phase,'login',$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text,$rowtotal,\@logintext,$loginheader); + $datatable .= &display_color_options($dom,$confname,$phase,'login',$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text,$rowtotal,\@logintext); $datatable .= ''; return $datatable; } @@ -824,7 +890,10 @@ sub login_choices { adminmail => "Display Administrator's E-mail Address?", disallowlogin => "Login page requests redirected", hostid => "Server", - serverurl => "Redirect to log-in via:", + server => "Redirect to:", + serverpath => "Path", + custompath => "Custom", + exempt => "Exempt IP(s)", directlogin => "No redirect", newuser => "Link to create a user account", img => "Header", @@ -929,9 +998,9 @@ sub print_rolecolors { sub display_color_options { my ($dom,$confname,$phase,$role,$itemcount,$choices,$is_custom,$defaults,$designs, - $images,$bgs,$links,$alt_text,$rowtotal,$logintext,$loginheader) = @_; + $images,$bgs,$links,$alt_text,$rowtotal,$logintext) = @_; my $css_class = $itemcount%2?' class="LC_odd_row"':''; - my $datatable = ''. + my $datatable = ''. ''.$choices->{'font'}.''; if (!$is_custom->{'font'}) { $datatable .= ''.&mt('Default in use:').' '.$defaults->{'font'}.''; @@ -971,8 +1040,7 @@ sub display_color_options { if ($role eq 'login') { if ($img eq 'login') { $login_hdr_pick = - &login_header_options($img,$role,$defaults,$is_custom,$choices, - $loginheader); + &login_header_options($img,$role,$defaults,$is_custom,$choices); $logincolors = &login_text_colors($img,$role,$logintext,$phase,$choices, $designs); @@ -1049,8 +1117,8 @@ sub display_color_options { } $datatable .= ''; if ($img eq 'login') { - $datatable .= $login_hdr_pick; - } + $datatable .= $login_hdr_pick; + } $datatable .= &image_changes($is_custom->{$img},$alt_text->{$img},$img_import, $showfile,$fullsize,$role,$img,$imgfile,$logincolors); } else { @@ -1064,7 +1132,9 @@ sub display_color_options { if ($switchserver) { $datatable .= &mt('Upload to library server: [_1]',$switchserver); } else { - $datatable .=' '; + if ($img ne 'login') { # suppress file selection for Log-in header + $datatable .=' '; + } } $datatable .= ''; } @@ -1153,20 +1223,10 @@ sub logo_display_options { } sub login_header_options { - my ($img,$role,$defaults,$is_custom,$choices,$loginheader) = @_; - my $image_checked = ' checked="checked" '; - my $text_checked = ' '; - if ($loginheader eq 'text') { - $image_checked = ' '; - $text_checked = ' checked="checked" '; - } - my $output = '   '. - '
'."\n"; + my ($img,$role,$defaults,$is_custom,$choices) = @_; + my $output = ''; if ((!$is_custom->{'textcol'}) || (!$is_custom->{'bgcol'})) { - $output .= &mt('Text default(s)').':
'; + $output .= &mt('Text default(s):').'
'; if (!$is_custom->{'textcol'}) { $output .= $choices->{'textcol'}.': '.$defaults->{'logintext'}{'textcol'}. '   '; @@ -1202,25 +1262,31 @@ sub login_text_colors { sub image_changes { my ($is_custom,$alt_text,$img_import,$showfile,$fullsize,$role,$img,$imgfile,$logincolors) = @_; my $output; - if (!$is_custom) { + if ($img eq 'login') { + # suppress image for Log-in header + } elsif (!$is_custom) { if ($img ne 'domlogo') { $output .= &mt('Default image:').'
'; } else { $output .= &mt('Default in use:').'
'; } } - if ($img_import) { - $output .= ''; - } - $output .= ''.$alt_text.''; - if ($is_custom) { - $output .= ''.$logincolors.' '.&mt('Replace:').'
'; + if ($img eq 'login') { # suppress image for Log-in header + $output .= ''.$logincolors; } else { - $output .= ''.$logincolors.&mt('Upload:').'
'; + if ($img_import) { + $output .= ''; + } + $output .= ''.$alt_text.''; + if ($is_custom) { + $output .= ''.$logincolors.' '.&mt('Replace:').'
'; + } else { + $output .= ''.$logincolors.&mt('Upload:').'
'; + } } return $output; } @@ -1316,15 +1382,15 @@ sub print_quotas { $cell{$item} .= ' '; + $titles{$option}.''; if ($option eq 'autolimit') { - $cell{$item} .= ''; } - $cell{$item} .= '  '; + $cell{$item} .= '
'; if ($option eq 'autolimit') { - $cell{$item} .= $titles{'unlimited'} + $cell{$item} .= $titles{'unlimited'}; } } } else { @@ -1424,13 +1490,13 @@ sub print_quotas { '_default" value="'.$val.'"'.$checked.' />'. $titles{$option}.''; if ($option eq 'autolimit') { - $defcell{$item} .= ''; } - $defcell{$item} .= '  '; + $defcell{$item} .= ' '; if ($option eq 'autolimit') { - $defcell{$item} .= $titles{'unlimited'} + $defcell{$item} .= $titles{'unlimited'}; } } } else { @@ -1527,13 +1593,13 @@ sub print_quotas { '__LC_adv" value="'.$val.'"'.$checked.' />'. $titles{$option}.''; if ($option eq 'autolimit') { - $advcell{$item} .= ''; } - $advcell{$item} .= '  '; + $advcell{$item} .= ' '; if ($option eq 'autolimit') { - $advcell{$item} .= $titles{'unlimited'} + $advcell{$item} .= $titles{'unlimited'}; } } } else { @@ -1646,7 +1712,7 @@ sub print_courserequestmail { sub print_autoenroll { my ($dom,$settings,$rowtotal) = @_; my $autorun = &Apache::lonnet::auto_run(undef,$dom), - my ($defdom,$runon,$runoff); + my ($defdom,$runon,$runoff,$coownerson,$coownersoff); if (ref($settings) eq 'HASH') { if (exists($settings->{'run'})) { if ($settings->{'run'} eq '0') { @@ -1665,6 +1731,18 @@ sub print_autoenroll { $runon = ' '; } } + if (exists($settings->{'co-owners'})) { + if ($settings->{'co-owners'} eq '0') { + $coownersoff = ' checked="checked" '; + $coownerson = ' '; + } else { + $coownerson = ' checked="checked" '; + $coownersoff = ' '; + } + } else { + $coownersoff = ' checked="checked" '; + $coownerson = ' '; + } if (exists($settings->{'sender_domain'})) { $defdom = $settings->{'sender_domain'}; } @@ -1695,8 +1773,16 @@ sub print_autoenroll { &mt('username').': '. '  '.&mt('domain'). - ': '.$domform.''; - $$rowtotal += 2; + ': '.$domform.''. + ''. + ''.&mt('Automatically assign co-ownership').''. + ' '. + ''. + ''; + $$rowtotal += 3; return $datatable; } @@ -1738,9 +1824,17 @@ sub print_autoupdate { $classlistsoff.'value="0" />'.&mt('No').''. ''; $$rowtotal += 2; + } elsif ($position eq 'middle') { + my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); + my $numinrow = 3; + my $locknamesettings; + $datatable .= &insttypes_row($settings,$types,$usertypes, + $dom,$numinrow,$othertitle, + 'lockablenames'); + $$rowtotal ++; } else { my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); - my @fields = ('lastname','firstname','middlename','gen', + my @fields = ('lastname','firstname','middlename','generation', 'permanentemail','id'); my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); my $numrows = 0; @@ -1761,6 +1855,56 @@ sub print_autoupdate { return $datatable; } +sub print_autocreate { + my ($dom,$settings,$rowtotal) = @_; + my (%createon,%createoff); + my $curr_dc; + my @types = ('xml','req'); + if (ref($settings) eq 'HASH') { + foreach my $item (@types) { + $createoff{$item} = ' checked="checked" '; + $createon{$item} = ' '; + if (exists($settings->{$item})) { + if ($settings->{$item}) { + $createon{$item} = ' checked="checked" '; + $createoff{$item} = ' '; + } + } + } + $curr_dc = $settings->{'xmldc'}; + } else { + foreach my $item (@types) { + $createoff{$item} = ' checked="checked" '; + $createon{$item} = ' '; + } + } + $$rowtotal += 2; + my $datatable=''. + ''.&mt('Create pending official courses from XML files').''. + ' '. + ''. + ''. + ''.&mt('Create pending requests for official courses (if validated)').''. + ' '. + ''; + my ($numdc,$dctable) = &active_dc_picker($dom,$curr_dc); + if ($numdc > 1) { + $datatable .= ''. + &mt('Course creation processed as: (choose Dom. Coord.)'). + ''.$dctable.''; + $$rowtotal ++ ; + } else { + $datatable .= $dctable.''; + } + return $datatable; +} + sub print_directorysrch { my ($dom,$settings,$rowtotal) = @_; my $srchon = ' '; @@ -1878,12 +2022,13 @@ sub print_contacts { my ($dom,$settings,$rowtotal) = @_; my $datatable; my @contacts = ('adminemail','supportemail'); - my (%checked,%to,%otheremails); + my (%checked,%to,%otheremails,%bccemails); my @mailings = ('errormail','packagesmail','lonstatusmail','helpdeskmail', 'requestsmail'); foreach my $type (@mailings) { $otheremails{$type} = ''; } + $bccemails{'helpdeskmail'} = ''; if (ref($settings) eq 'HASH') { foreach my $item (@contacts) { if (exists($settings->{$item})) { @@ -1899,6 +2044,9 @@ sub print_contacts { } } $otheremails{$type} = $settings->{$type}{'others'}; + if ($type eq 'helpdeskmail') { + $bccemails{$type} = $settings->{$type}{'bcc'}; + } } } elsif ($type eq 'lonstatusmail') { $checked{'lonstatusmail'}{'adminemail'} = ' checked="checked" '; @@ -1942,8 +2090,13 @@ sub print_contacts { } $datatable .= '
'.&mt('Others').':  '. ''. - ''."\n"; + 'value="'.$otheremails{$type}.'" />'; + if ($type eq 'helpdeskmail') { + $datatable .= '
'.&mt('Bcc:').(' 'x6). + ''; + } + $datatable .= ''."\n"; } $$rowtotal += $rownum; return $datatable; @@ -2088,22 +2241,216 @@ sub radiobutton_prefs { } sub print_coursedefaults { - my ($dom,$settings,$rowtotal) = @_; + my ($position,$dom,$settings,$rowtotal) = @_; my ($css_class,$datatable); my $itemcount = 1; - my (%checkedon,%checkedoff,%choices,%defaultchecked,@toggles); - %choices = - &Apache::lonlocal::texthash ( - canuse_pdfforms => 'Course/Community users can create/upload PDF forms', - ); - %defaultchecked = ('canuse_pdfforms' => 'off'); - @toggles = ('canuse_pdfforms',); - ($datatable,$itemcount) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked, + if ($position eq 'top') { + my (%checkedon,%checkedoff,%choices,%defaultchecked,@toggles); + %choices = + &Apache::lonlocal::texthash ( + canuse_pdfforms => 'Course/Community users can create/upload PDF forms', + ); + %defaultchecked = ('canuse_pdfforms' => 'off'); + @toggles = ('canuse_pdfforms',); + ($datatable,$itemcount) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked, \%choices,$itemcount); + $$rowtotal += $itemcount; + } else { + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + my %choices = + &Apache::lonlocal::texthash ( + anonsurvey_threshold => 'Responder count needed before showing submissions for anonymous surveys', + ); + my $currdefresponder; + if (ref($settings) eq 'HASH') { + $currdefresponder = $settings->{'anonsurvey_threshold'}; + } + if (!$currdefresponder) { + $currdefresponder = 10; + } elsif ($currdefresponder < 1) { + $currdefresponder = 1; + } + $datatable .= + ''.$choices{'anonsurvey_threshold'}. + ''. + ''. + ''. + ''; + } + return $datatable; +} + +sub print_usersessions { + my ($position,$dom,$settings,$rowtotal) = @_; + my ($css_class,$datatable,%checked,%choices); + my (%by_ip,%by_location,@intdoms); + &build_location_hashes(\@intdoms,\%by_ip,\%by_location); + if (keys(%by_location) == 0) { + if ($position eq 'top') { + $datatable .= ''. + &mt('Nothing to set here, as the cluster to which this domain belongs only contains this institution.'); + } + } + my %lt = &usersession_titles(); + my $itemcount = 1; + my $numinrow = 5; + my $prefix; + my @types; + if ($position eq 'top') { + $prefix = 'hosted'; + @types = ('excludedomain','includedomain'); + } else { + $prefix = 'remote'; + @types = ('version','excludedomain','includedomain'); + } + my (%current,%checkedon,%checkedoff); + my @lcversions = &Apache::lonnet::all_loncaparevs(); + my @locations = sort(keys(%by_location)); + foreach my $type (@types) { + $checkedon{$type} = ''; + $checkedoff{$type} = ' checked="checked"'; + } + if (ref($settings) eq 'HASH') { + if (ref($settings->{$prefix}) eq 'HASH') { + foreach my $key (keys(%{$settings->{$prefix}})) { + $current{$key} = $settings->{$prefix}{$key}; + if ($key eq 'version') { + if ($current{$key} ne '') { + $checkedon{$key} = ' checked="checked"'; + $checkedoff{$key} = ''; + } + } elsif (ref($current{$key}) eq 'ARRAY') { + $checkedon{$key} = ' checked="checked"'; + $checkedoff{$key} = ''; + } + } + } + } + foreach my $type (@types) { + next if ($type ne 'version' && !@locations); + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + $datatable .= ' + '.$lt{$type}.'
+   +   + '; + if ($type eq 'version') { + my $selector = ' '; + $datatable .= &mt('remote server must be version: [_1] or later',$selector); + } else { + $datatable.= '
'.(' 'x2). + ''. + "\n". + '
'; + my $rem; + for (my $i=0; $i<@locations; $i++) { + my ($showloc,$value,$checkedtype); + if (ref($by_location{$locations[$i]}) eq 'ARRAY') { + my $ip = $by_location{$locations[$i]}->[0]; + if (ref($by_ip{$ip}) eq 'ARRAY') { + $value = join(':',@{$by_ip{$ip}}); + $showloc = join(', ',@{$by_ip{$ip}}); + if (ref($current{$type}) eq 'ARRAY') { + foreach my $loc (@{$by_ip{$ip}}) { + if (grep(/^\Q$loc\E$/,@{$current{$type}})) { + $checkedtype = ' checked="checked"'; + last; + } + } + } + } + } + $rem = $i%($numinrow); + if ($rem == 0) { + if ($i > 0) { + $datatable .= ''; + } + $datatable .= ''; + } + $datatable .= ''; + } + $rem = @locations%($numinrow); + my $colsleft = $numinrow - $rem; + if ($colsleft > 1 ) { + $datatable .= ''; + } elsif ($colsleft == 1) { + $datatable .= ''; + } + $datatable .= '
'. + ''. + '  
'; + } + $datatable .= ''; + $itemcount ++; + } $$rowtotal += $itemcount; return $datatable; } +sub build_location_hashes { + my ($intdoms,$by_ip,$by_location) = @_; + return unless((ref($intdoms) eq 'ARRAY') && (ref($by_ip) eq 'HASH') && + (ref($by_location) eq 'HASH')); + my %iphost = &Apache::lonnet::get_iphost(); + my $primary_id = &Apache::lonnet::domain($env{'request.role.domain'},'primary'); + my $primary_ip = &Apache::lonnet::get_host_ip($primary_id); + if (ref($iphost{$primary_ip}) eq 'ARRAY') { + foreach my $id (@{$iphost{$primary_ip}}) { + my $intdom = &Apache::lonnet::internet_dom($id); + unless(grep(/^\Q$intdom\E$/,@{$intdoms})) { + push(@{$intdoms},$intdom); + } + } + } + foreach my $ip (keys(%iphost)) { + if (ref($iphost{$ip}) eq 'ARRAY') { + foreach my $id (@{$iphost{$ip}}) { + my $location = &Apache::lonnet::internet_dom($id); + if ($location) { + next if (grep(/^\Q$location\E$/,@{$intdoms})); + if (ref($by_ip->{$ip}) eq 'ARRAY') { + unless(grep(/^\Q$location\E$/,@{$by_ip->{$ip}})) { + push(@{$by_ip->{$ip}},$location); + } + } else { + $by_ip->{$ip} = [$location]; + } + } + } + } + } + foreach my $ip (sort(keys(%{$by_ip}))) { + if (ref($by_ip->{$ip}) eq 'ARRAY') { + @{$by_ip->{$ip}} = sort(@{$by_ip->{$ip}}); + my $first = $by_ip->{$ip}->[0]; + if (ref($by_location->{$first}) eq 'ARRAY') { + unless (grep(/^\Q$ip\E$/,@{$by_location->{$first}})) { + push(@{$by_location->{$first}},$ip); + } + } else { + $by_location->{$first} = [$ip]; + } + } + } + return; +} + sub contact_titles { my %titles = &Apache::lonlocal::texthash ( 'supportemail' => 'Support E-mail address', @@ -2475,9 +2822,9 @@ sub print_usermodification { sub print_defaults { my ($dom,$rowtotal) = @_; my @items = ('auth_def','auth_arg_def','lang_def','timezone_def', - 'datelocale_def'); + 'datelocale_def','portal_def'); my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); - my $titles = &defaults_titles(); + my $titles = &defaults_titles($dom); my $rownum = 0; my ($datatable,$css_class); foreach my $item (@items) { @@ -2514,8 +2861,12 @@ sub print_defaults { my $includeempty = 1; $datatable .= &Apache::loncommon::select_datelocale($item,$domdefaults{$item},undef,$includeempty); } else { + my $size; + if ($item eq 'portal_def') { + $size = ' size="25"'; + } $datatable .= ''; + $domdefaults{$item}.'"'.$size.' />'; } $datatable .= ''; $rownum ++; @@ -2525,13 +2876,25 @@ sub print_defaults { } sub defaults_titles { + my ($dom) = @_; my %titles = &Apache::lonlocal::texthash ( 'auth_def' => 'Default authentication type', 'auth_arg_def' => 'Default authentication argument', 'lang_def' => 'Default language', 'timezone_def' => 'Default timezone', 'datelocale_def' => 'Default locale for dates', + 'portal_def' => 'Portal/Default URL', ); + if ($dom) { + my $uprimary_id = &Apache::lonnet::domain($dom,'primary'); + my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id); + my $protocol = $Apache::lonnet::protocol{$uprimary_id}; + $protocol = 'http' if ($protocol ne 'https'); + if ($uint_dom) { + $titles{'portal_def'} .= ' '.&mt('(for example: [_1])',$protocol.'://loncapa.'. + $uint_dom); + } + } return (\%titles); } @@ -2645,7 +3008,7 @@ sub print_scantronformat { ''; if ($scantronurl) { $datatable .= ''. - &mt('Default scantron format file').''; + &mt('Default bubblesheet format file').''; } else { $datatable = &mt('File unavailable for display'); } @@ -2672,7 +3035,7 @@ sub print_scantronformat { } elsif ($scantronurl) { $datatable .= ''. ''. - &mt('Custom scantron format file').''. ' '. @@ -2701,7 +3064,7 @@ sub legacy_scantronformat { &publishlogo($r,'copy',$legacyfile,$dom,$confname,'scantron', '','',$newfile); if ($result ne 'ok') { - $error = &mt("An error occurred publishing the [_1] scantron format file in RES space. Error was: [_2].",$newfile,$result); + $error = &mt("An error occurred publishing the [_1] bubblesheet format file in RES space. Error was: [_2].",$newfile,$result); } } return ($url,$error); @@ -2973,7 +3336,7 @@ sub print_serverstatuses { sub serverstatus_pages { return ('userstatus','lonstatus','loncron','server-status','codeversions', 'clusterstatus','metadata_keywords','metadata_harvest', - 'takeoffline','takeonline','showenv','toggledebug'); + 'takeoffline','takeonline','showenv','toggledebug','ping','domconf'); } sub coursecategories_javascript { @@ -3281,6 +3644,7 @@ sub insttypes_row { my %lt = &Apache::lonlocal::texthash ( cansearch => 'Users allowed to search', statustocreate => 'Institutional affiliation(s) able to create own account (login/SSO)', + lockablenames => 'User preference to lock name', ); my $showdom; if ($context eq 'cansearch') { @@ -3317,10 +3681,12 @@ sub insttypes_row { $usertypes->{$types->[$i]}.''; } } - $rem = @{$types}%($numinrow); } my $colsleft = $numinrow - $rem; + if (($rem == 0) && (@{$types} > 0)) { + $output .= ''; + } if ($colsleft > 1) { $output .= ''; } else { @@ -3444,19 +3810,86 @@ sub modify_login { } my %servers = &dom_servers($dom); + my @loginvia_attribs = ('serverpath','custompath','exempt'); if (keys(%servers) > 1) { foreach my $lonhost (keys(%servers)) { - next if ($env{'form.'.$lonhost.'_serverurl'} eq $lonhost); - if ($env{'form.'.$lonhost.'_serverurl'} eq $curr_loginvia{$lonhost}) { - $loginhash{login}{loginvia}{$lonhost} = $curr_loginvia{$lonhost}; next; - } - if ($curr_loginvia{$lonhost} ne '') { - $loginhash{login}{loginvia}{$lonhost} = $env{'form.'.$lonhost.'_serverurl'}; - $changes{'loginvia'}{$lonhost} = 1; + next if ($env{'form.'.$lonhost.'_server'} eq $lonhost); + if (ref($curr_loginvia{$lonhost}) eq 'HASH') { + if ($env{'form.'.$lonhost.'_server'} eq $curr_loginvia{$lonhost}{'server'}) { + $loginhash{login}{loginvia}{$lonhost}{'server'} = $curr_loginvia{$lonhost}{'server'}; + } elsif ($curr_loginvia{$lonhost}{'server'} ne '') { + if (defined($servers{$env{'form.'.$lonhost.'_server'}})) { + $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'}; + $changes{'loginvia'}{$lonhost} = 1; + } else { + $loginhash{login}{loginvia}{$lonhost}{'server'} = ''; + $changes{'loginvia'}{$lonhost} = 1; + } + } else { + if (defined($servers{$env{'form.'.$lonhost.'_server'}})) { + $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'}; + $changes{'loginvia'}{$lonhost} = 1; + } + } + if ($loginhash{login}{loginvia}{$lonhost}{'server'} eq '') { + foreach my $item (@loginvia_attribs) { + $loginhash{login}{loginvia}{$lonhost}{$item} = ''; + } + } else { + foreach my $item (@loginvia_attribs) { + my $new = $env{'form.'.$lonhost.'_'.$item}; + if (($item eq 'serverpath') && ($new eq 'custom')) { + $env{'form.'.$lonhost.'_custompath'} =~ s/\s+//g; + if ($env{'form.'.$lonhost.'_custompath'} eq '') { + $new = '/'; + } + } + if (($item eq 'custompath') && + ($env{'form.'.$lonhost.'_serverpath'} ne 'custom')) { + $new = ''; + } + if ($new ne $curr_loginvia{$lonhost}{$item}) { + $changes{'loginvia'}{$lonhost} = 1; + } + if ($item eq 'exempt') { + $new =~ s/^\s+//; + $new =~ s/\s+$//; + my @poss_ips = split(/\s*[,:]\s*/,$new); + my @okips; + foreach my $ip (@poss_ips) { + if ($ip =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) { + if (($1 <= 255) && ($2 <= 255) && ($3 <= 255) && ($4 <= 255)) { + push(@okips,$ip); + } + } + } + if (@okips > 0) { + $new = join(',',@okips); + } else { + $new = ''; + } + } + + $loginhash{login}{loginvia}{$lonhost}{$item} = $new; + } + } } else { - if (defined($servers{$env{'form.'.$lonhost.'_serverurl'}})) { - $loginhash{login}{loginvia}{$lonhost} = $env{'form.'.$lonhost.'_serverurl'}; + if (defined($servers{$env{'form.'.$lonhost.'_server'}})) { + $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'}; $changes{'loginvia'}{$lonhost} = 1; + foreach my $item (@loginvia_attribs) { + my $new = $env{'form.'.$lonhost.'_'.$item}; + if (($item eq 'serverpath') && ($new eq 'custom')) { + if ($env{'form.'.$lonhost.'_custompath'} eq '') { + $new = '/'; + } + } + if (($item eq 'custompath') && + ($env{'form.'.$lonhost.'_serverpath'} ne 'custom')) { + $new = ''; + } + $loginhash{login}{loginvia}{$lonhost}{$item} = $new; + } } } } @@ -3493,32 +3926,39 @@ sub modify_login { } } } - if (($domconfig{'login'}{'loginheader'} eq 'text') && - ($env{'form.loginheader'} eq 'image')) { - $changes{'loginheader'} = 1; - } elsif (($domconfig{'login'}{'loginheader'} eq '' || - $domconfig{'login'}{'loginheader'} eq 'image') && - ($env{'form.loginheader'} eq 'text')) { - $changes{'loginheader'} = 1; - } } if (keys(%changes) > 0 || $colchgtext) { &Apache::loncommon::devalidate_domconfig_cache($dom); $resulttext = &mt('Changes made:').'
    '; foreach my $item (sort(keys(%changes))) { - if ($item eq 'loginheader') { - $resulttext .= '
  • '.&mt("$title{$item} set to $env{'form.loginheader'}").'
  • '; - } elsif ($item eq 'loginvia') { + if ($item eq 'loginvia') { if (ref($changes{$item}) eq 'HASH') { $resulttext .= '
  • '.&mt('Log-in page availability:').'
      '; foreach my $lonhost (sort(keys(%{$changes{$item}}))) { - if ($servers{$env{'form.'.$lonhost.'_serverurl'}} ne '') { - $resulttext .= '
    • '.&mt('Server: [_1] log-in page now redirects to [_2]',$lonhost,$servers{$env{'form.'.$lonhost.'_serverurl'}}).'
    • '; + if (defined($servers{$loginhash{login}{loginvia}{$lonhost}{'server'}})) { + if (ref($loginhash{login}{loginvia}{$lonhost}) eq 'HASH') { + my $protocol = $Apache::lonnet::protocol{$env{'form.'.$lonhost.'_server'}}; + $protocol = 'http' if ($protocol ne 'https'); + my $target = $protocol.'://'.$servers{$env{'form.'.$lonhost.'_server'}}; + + if ($loginhash{login}{loginvia}{$lonhost}{'serverpath'} eq 'custom') { + $target .= $loginhash{login}{loginvia}{$lonhost}{'custompath'}; + } else { + $target .= $loginhash{login}{loginvia}{$lonhost}{'serverpath'}; + } + $resulttext .= '
    • '.&mt('Server: [_1] log-in page redirects to [_2].',$servers{$lonhost},''.$target.''); + if ($loginhash{login}{loginvia}{$lonhost}{'exempt'} ne '') { + $resulttext .= ' '.&mt('No redirection for clients from following IPs:').' '.$loginhash{login}{loginvia}{$lonhost}{'exempt'}; + } + $resulttext .= '
    • '; + } else { + $resulttext .= '
    • '.&mt('Server: [_1] has standard log-in page.',$lonhost).'
    • '; + } } else { - $resulttext .= '
    • '.&mt('Server: [_1] now has standard log-in page.',$lonhost).'
    • '; + $resulttext .= '
    • '.&mt('Server: [_1] has standard log-in page.',$servers{$lonhost}).'
    • '; } } - $resulttext .= '
  • '; + $resulttext .= '
'; } } else { $resulttext .= '
  • '.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").'
  • '; @@ -4042,8 +4482,15 @@ $env{'user.name'}.':'.$env{'user.domain' if (copy($source,$copyfile)) { print $logfile "\nCopied original source to ".$copyfile."\n"; $output = 'ok'; - &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile); $logourl = '/res/'.$dom.'/'.$confname.'/'.$fname; + push(@{$modified_urls},[$copyfile,$source]); + my $metaoutput = + &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile); + unless ($registered_cleanup) { + my $handlers = $r->get_handlers('PerlCleanupHandler'); + $r->set_handlers('PerlCleanupHandler' => [\¬ifysubscribed,@{$handlers}]); + $registered_cleanup=1; + } } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; $output = &mt('Failed to copy file to RES space').", $!"; @@ -4061,8 +4508,15 @@ $env{'user.name'}.':'.$env{'user.domain' my $copyfile=$targetdir.'/tn-'.$file; if (copy($outfile,$copyfile)) { print $logfile "\nCopied source to ".$copyfile."\n"; - &write_metadata($dom,$confname,$formname, - $targetdir,'tn-'.$file,$logfile); + my $thumb_metaoutput = + &write_metadata($dom,$confname,$formname, + $targetdir,'tn-'.$file,$logfile); + push(@{$modified_urls},[$copyfile,$outfile]); + unless ($registered_cleanup) { + my $handlers = $r->get_handlers('PerlCleanupHandler'); + $r->set_handlers('PerlCleanupHandler' => [\¬ifysubscribed,@{$handlers}]); + $registered_cleanup=1; + } } else { print $logfile "\nUnable to write ".$copyfile. ':'.$!."\n"; @@ -4127,30 +4581,79 @@ sub write_metadata { { print $logfile "\nWrite metadata file for ".$targetdir.'/'.$file; my $mfh; - unless (open($mfh,'>'.$targetdir.'/'.$file.'.meta')) { + if (open($mfh,'>'.$targetdir.'/'.$file.'.meta')) { + foreach (sort keys %metadatafields) { + unless ($_=~/\./) { + my $unikey=$_; + $unikey=~/^([A-Za-z]+)/; + my $tag=$1; + $tag=~tr/A-Z/a-z/; + print $mfh "\n\<$tag"; + foreach (split(/\,/,$metadatakeys{$unikey})) { + my $value=$metadatafields{$unikey.'.'.$_}; + $value=~s/\"/\'\'/g; + print $mfh ' '.$_.'="'.$value.'"'; + } + print $mfh '>'. + &HTML::Entities::encode($metadatafields{$unikey},'<>&"') + .''; + } + } + $output = 'ok'; + print $logfile "\nWrote metadata"; + close($mfh); + } else { + print $logfile "\nFailed to open metadata file"; $output = &mt('Could not write metadata'); } - foreach (sort keys %metadatafields) { - unless ($_=~/\./) { - my $unikey=$_; - $unikey=~/^([A-Za-z]+)/; - my $tag=$1; - $tag=~tr/A-Z/a-z/; - print $mfh "\n\<$tag"; - foreach (split(/\,/,$metadatakeys{$unikey})) { - my $value=$metadatafields{$unikey.'.'.$_}; - $value=~s/\"/\'\'/g; - print $mfh ' '.$_.'="'.$value.'"'; - } - print $mfh '>'. - &HTML::Entities::encode($metadatafields{$unikey},'<>&"') - .''; - } - } - $output = 'ok'; - print $logfile "\nWrote metadata"; - close($mfh); } + return $output; +} + +sub notifysubscribed { + foreach my $targetsource (@{$modified_urls}){ + next unless (ref($targetsource) eq 'ARRAY'); + my ($target,$source)=@{$targetsource}; + if ($source ne '') { + if (open(my $logfh,'>>'.$source.'.log')) { + print $logfh "\nCleanup phase: Notifications\n"; + my @subscribed=&subscribed_hosts($target); + foreach my $subhost (@subscribed) { + print $logfh "\nNotifying host ".$subhost.':'; + my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); + print $logfh $reply; + } + my @subscribedmeta=&subscribed_hosts("$target.meta"); + foreach my $subhost (@subscribedmeta) { + print $logfh "\nNotifying host for metadata only ".$subhost.':'; + my $reply=&Apache::lonnet::critical('update:'.$target.'.meta', + $subhost); + print $logfh $reply; + } + print $logfh "\n============ Done ============\n"; + close(logfh); + } + } + } + return OK; +} + +sub subscribed_hosts { + my ($target) = @_; + my @subscribed; + if (open(my $fh,"<$target.subscription")) { + while (my $subline=<$fh>) { + if ($subline =~ /^($match_lonid):/) { + my $host = $1; + if ($host ne $Apache::lonnet::perlvar{'lonHostID'}) { + unless (grep(/^\Q$host\E$/,@subscribed)) { + push(@subscribed,$host); + } + } + } + } + } + return @subscribed; } sub check_switchserver { @@ -4220,12 +4723,12 @@ sub modify_quotas { $changes{'notify'}{'approval'} = 1; } } else { - if ($domconfig{$action}{'notify'}{'approval'}) { + if ($confhash{'notify'}{'approval'}) { $changes{'notify'}{'approval'} = 1; } } } else { - if ($domconfig{$action}{'notify'}{'approval'}) { + if ($confhash{'notify'}{'approval'}) { $changes{'notify'}{'approval'} = 1; } } @@ -4454,7 +4957,8 @@ sub modify_autoenroll { } my $autorun = &Apache::lonnet::auto_run(undef,$dom), my %title = ( run => 'Auto-enrollment active', - sender => 'Sender for notification messages'); + sender => 'Sender for notification messages', + coowners => 'Automatic assignment of co-ownership to instructors of record (institutional data)'); my @offon = ('off','on'); my $sender_uname = $env{'form.sender_uname'}; my $sender_domain = $env{'form.sender_domain'}; @@ -4463,11 +4967,12 @@ sub modify_autoenroll { } elsif ($sender_uname eq '') { $sender_domain = ''; } + my $coowners = $env{'form.autoassign_coowners'}; my %autoenrollhash = ( - autoenroll => { run => $env{'form.autoenroll_run'}, - sender_uname => $sender_uname, - sender_domain => $sender_domain, - + autoenroll => { 'run' => $env{'form.autoenroll_run'}, + 'sender_uname' => $sender_uname, + 'sender_domain' => $sender_domain, + 'co-owners' => $coowners, } ); my $putresult = &Apache::lonnet::put_dom('configuration',\%autoenrollhash, @@ -4488,6 +4993,13 @@ sub modify_autoenroll { if ($currautoenroll{'sender_domain'} ne $sender_domain) { $changes{'sender'} = 1; } + if ($currautoenroll{'co-owners'} ne '') { + if ($currautoenroll{'co-owners'} ne $coowners) { + $changes{'coowners'} = 1; + } + } elsif ($coowners) { + $changes{'coowners'} = 1; + } if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; if ($changes{'run'}) { @@ -4500,6 +5012,10 @@ sub modify_autoenroll { $resulttext .= '
    • '.&mt("$title{'sender'} set to [_1]",$sender_uname.':'.$sender_domain).'
    • '; } } + if ($changes{'coowners'}) { + $resulttext .= '
    • '.&mt("$title{'coowners'} set to $offon[$env{'form.autoassign_coowners'}]").'
    • '; + &Apache::loncommon::devalidate_domconfig_cache($dom); + } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to auto-enrollment settings'); @@ -4531,21 +5047,43 @@ sub modify_autoupdate { lastname => 'Last Name', firstname => 'First Name', middlename => 'Middle Name', - gen => 'Generation', + generation => 'Generation', ); - my $othertitle = &mt('All users'); + $othertitle = &mt('All users'); if (keys(%{$usertypes}) > 0) { $othertitle = &mt('Other users'); } foreach my $key (keys(%env)) { if ($key =~ /^form\.updateable_(.+)_([^_]+)$/) { - push(@{$fields{$1}},$2); + my ($usertype,$item) = ($1,$2); + if (grep(/^\Q$item\E$/,keys(%fieldtitles))) { + if ($usertype eq 'default') { + push(@{$fields{$1}},$2); + } elsif (ref($types) eq 'ARRAY') { + if (grep(/^\Q$usertype\E$/,@{$types})) { + push(@{$fields{$1}},$2); + } + } + } + } + } + my @lockablenames = &Apache::loncommon::get_env_multiple('form.lockablenames'); + @lockablenames = sort(@lockablenames); + if (ref($currautoupdate{'lockablenames'}) eq 'ARRAY') { + my @changed = &Apache::loncommon::compare_arrays($currautoupdate{'lockablenames'},\@lockablenames); + if (@changed) { + $changes{'lockablenames'} = 1; + } + } else { + if (@lockablenames) { + $changes{'lockablenames'} = 1; } } my %updatehash = ( autoupdate => { run => $env{'form.autoupdate_run'}, classlists => $env{'form.classlists'}, fields => {%fields}, + lockablenames => \@lockablenames, } ); foreach my $key (keys(%currautoupdate)) { @@ -4563,9 +5101,11 @@ sub modify_autoupdate { foreach my $type (@{$currautoupdate{$key}{$item}}) { if (!exists($fields{$item})) { $change = 1; + last; } elsif (ref($fields{$item}) eq 'ARRAY') { if (!grep(/^\Q$type\E$/,@{$fields{$item}})) { $change = 1; + last; } } } @@ -4575,12 +5115,41 @@ sub modify_autoupdate { } } } + } elsif ($key eq 'lockablenames') { + if (ref($currautoupdate{$key}) eq 'ARRAY') { + my @changed = &Apache::loncommon::compare_arrays($currautoupdate{'lockablenames'},\@lockablenames); + if (@changed) { + $changes{'lockablenames'} = 1; + } + } else { + if (@lockablenames) { + $changes{'lockablenames'} = 1; + } + } + } + } + unless (grep(/^\Qlockablenames\E$/,keys(%currautoupdate))) { + if (@lockablenames) { + $changes{'lockablenames'} = 1; } } foreach my $item (@{$types},'default') { if (defined($fields{$item})) { if (ref($currautoupdate{'fields'}) eq 'HASH') { - if (!exists($currautoupdate{'fields'}{$item})) { + if (ref($currautoupdate{'fields'}{$item}) eq 'ARRAY') { + my $change = 0; + if (ref($fields{$item}) eq 'ARRAY') { + foreach my $type (@{$fields{$item}}) { + if (!grep(/^\Q$type\E$/,@{$currautoupdate{'fields'}{$item}})) { + $change = 1; + last; + } + } + } + if ($change) { + push(@{$changes{'fields'}},$item); + } + } else { push(@{$changes{'fields'}},$item); } } else { @@ -4594,7 +5163,17 @@ sub modify_autoupdate { if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; foreach my $key (sort(keys(%changes))) { - if (ref($changes{$key}) eq 'ARRAY') { + if ($key eq 'lockablenames') { + $resulttext .= '
    • '; + if (@lockablenames) { + $usertypes->{'default'} = $othertitle; + $resulttext .= &mt("User preference to disable replacement of user's name with institutional data (by auto-update), available for the following affiliations:").' '. + join(', ', map { $usertypes->{$_}; } @lockablenames).'
    • '; + } else { + $resulttext .= &mt("User preference to disable replacement of user's name with institutional data (by auto-update) is unavailable."); + } + $resulttext .= ''; + } elsif (ref($changes{$key}) eq 'ARRAY') { foreach my $item (@{$changes{$key}}) { my @newvalues; foreach my $type (@{$fields{$item}}) { @@ -4633,6 +5212,78 @@ sub modify_autoupdate { return $resulttext; } +sub modify_autocreate { + my ($dom,%domconfig) = @_; + my ($resulttext,%changes,%currautocreate,%newvals,%autocreatehash); + if (ref($domconfig{'autocreate'}) eq 'HASH') { + foreach my $key (keys(%{$domconfig{'autocreate'}})) { + $currautocreate{$key} = $domconfig{'autocreate'}{$key}; + } + } + my %title= ( xml => 'Auto-creation of courses in XML course description files', + req => 'Auto-creation of validated requests for official courses', + xmldc => 'Identity of course creator of courses from XML files', + ); + my @types = ('xml','req'); + foreach my $item (@types) { + $newvals{$item} = $env{'form.autocreate_'.$item}; + $newvals{$item} =~ s/\D//g; + $newvals{$item} = 0 if ($newvals{$item} eq ''); + } + $newvals{'xmldc'} = $env{'form.autocreate_xmldc'}; + my %domcoords = &get_active_dcs($dom); + unless (exists($domcoords{$newvals{'xmldc'}})) { + $newvals{'xmldc'} = ''; + } + %autocreatehash = ( + autocreate => { xml => $newvals{'xml'}, + req => $newvals{'req'}, + } + ); + if ($newvals{'xmldc'} ne '') { + $autocreatehash{'autocreate'}{'xmldc'} = $newvals{'xmldc'}; + } + my $putresult = &Apache::lonnet::put_dom('configuration',\%autocreatehash, + $dom); + if ($putresult eq 'ok') { + my @items = @types; + if ($newvals{'xml'}) { + push(@items,'xmldc'); + } + foreach my $item (@items) { + if (exists($currautocreate{$item})) { + if ($currautocreate{$item} ne $newvals{$item}) { + $changes{$item} = 1; + } + } elsif ($newvals{$item}) { + $changes{$item} = 1; + } + } + if (keys(%changes) > 0) { + my @offon = ('off','on'); + $resulttext = &mt('Changes made:').'
        '; + foreach my $item (@types) { + if ($changes{$item}) { + my $newtxt = $offon[$newvals{$item}]; + $resulttext .= '
      • '.&mt("$title{$item} set to [_1]$newtxt [_2]",'','').'
      • '; + } + } + if ($changes{'xmldc'}) { + my ($dcname,$dcdom) = split(':',$newvals{'xmldc'}); + my $newtxt = &Apache::loncommon::plainname($dcname,$dcdom); + $resulttext .= '
      • '.&mt("$title{'xmldc'} set to [_1]$newtxt [_2]",'','').'
      • '; + } + $resulttext .= '
      '; + } else { + $resulttext = &mt('No changes made to auto-creation settings'); + } + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + return $resulttext; +} + sub modify_directorysrch { my ($dom,%domconfig) = @_; my ($resulttext,%changes); @@ -4815,7 +5466,7 @@ sub modify_contacts { $currsetting{$key} = $domconfig{'contacts'}{$key}; } } - my (%others,%to); + my (%others,%to,%bcc); my @contacts = ('supportemail','adminemail'); my @mailings = ('errormail','packagesmail','helpdeskmail','lonstatusmail', 'requestsmail'); @@ -4831,6 +5482,10 @@ sub modify_contacts { } $others{$type} = $env{'form.'.$type.'_others'}; $contacts_hash{contacts}{$type}{'others'} = $others{$type}; + if ($type eq 'helpdeskmail') { + $bcc{$type} = $env{'form.'.$type.'_bcc'}; + $contacts_hash{contacts}{$type}{'bcc'} = $bcc{$type}; + } } foreach my $item (@contacts) { $to{$item} = $env{'form.'.$item}; @@ -4855,6 +5510,11 @@ sub modify_contacts { if ($others{$type} ne $currsetting{$type}{'others'}) { push(@{$changes{$type}},'others'); } + if ($type eq 'helpdeskmail') { + if ($bcc{$type} ne $currsetting{$type}{'bcc'}) { + push(@{$changes{$type}},'bcc'); + } + } } } else { my %default; @@ -4877,7 +5537,12 @@ sub modify_contacts { } if ($others{$type} ne '') { push(@{$changes{$type}},'others'); - } + } + if ($type eq 'helpdeskmail') { + if ($bcc{$type} ne '') { + push(@{$changes{$type}},'bcc'); + } + } } } my $putresult = &Apache::lonnet::put_dom('configuration',\%contacts_hash, @@ -4905,7 +5570,13 @@ sub modify_contacts { push(@text,$others{$type}); } $resulttext .= ''. - join(', ',@text).''; + join(', ',@text).''; + if ($type eq 'helpdeskmail') { + if ($bcc{$type} ne '') { + $resulttext .= ' '.&mt('with Bcc to').': '.$bcc{$type}.''; + } + } + $resulttext .= ''; } } $resulttext .= '
    '; @@ -5387,7 +6058,7 @@ sub modify_usermodification { } my @modifiable; if ($context eq 'selfcreate') { - $resulttext .= '
  • '.&mt('Self-creation of account by users with status: [_1] ',$rolename).' - '.&mt('modifiable fields (if institutional data blank): '); + $resulttext .= '
  • '.&mt('Self-creation of account by users with status: [_1]',$rolename).' - '.&mt('modifiable fields (if institutional data blank): '); } else { $resulttext .= '
  • '.&mt('Target user with [_1] role',$rolename).' - '.&mt('modifiable fields: '); } @@ -5422,7 +6093,7 @@ sub modify_defaults { my ($dom,$r) = @_; my ($resulttext,$mailmsgtxt,%newvalues,%changes,@errors); my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); - my @items = ('auth_def','auth_arg_def','lang_def','timezone_def','datelocale_def'); + my @items = ('auth_def','auth_arg_def','lang_def','timezone_def','datelocale_def','portal_def'); my @authtypes = ('internal','krb4','krb5','localauth'); foreach my $item (@items) { $newvalues{$item} = $env{'form.'.$item}; @@ -5458,6 +6129,12 @@ sub modify_defaults { push(@errors,$item); } } + } elsif ($item eq 'portal_def') { + if ($newvalues{$item} ne '') { + unless ($newvalues{$item} =~ /^https?\:\/\/(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])\.)*([A-Za-z]|[A-Za-z][A-Za-z0-9\-]*[A-Za-z0-9])\/?$/) { + push(@errors,$item); + } + } } if (grep(/^\Q$item\E$/,@errors)) { $newvalues{$item} = $domdefaults{$item}; @@ -5531,7 +6208,7 @@ sub modify_scantron { my $error; if ($configuserok eq 'ok') { if ($switchserver) { - $error = &mt("Upload of scantron format file is not permitted to this server: [_1]",$switchserver); + $error = &mt("Upload of bubblesheet format file is not permitted to this server: [_1]",$switchserver); } else { if ($author_ok eq 'ok') { my ($result,$scantronurl) = @@ -5571,25 +6248,25 @@ sub modify_scantron { if (ref($confhash{'scantron'}) eq 'HASH') { $resulttext = &mt('Changes made:').'
      '; if ($confhash{'scantron'}{'scantronformat'} eq '') { - $resulttext .= '
    • '.&mt('[_1] scantron format file removed; [_2] file will be used for courses in this domain.',$custom,$default).'
    • '; + $resulttext .= '
    • '.&mt('[_1] bubblesheet format file removed; [_2] file will be used for courses in this domain.',$custom,$default).'
    • '; } else { - $resulttext .= '
    • '.&mt('Custom scantron format file ([_1]) uploaded for use with courses in this domain.',$custom).'
    • '; + $resulttext .= '
    • '.&mt('Custom bubblesheet format file ([_1]) uploaded for use with courses in this domain.',$custom).'
    • '; } $resulttext .= '
    '; } else { - $resulttext = &mt('Changes made to scantron format file.'); + $resulttext = &mt('Changes made to bubblesheet format file.'); } $resulttext .= ''; &Apache::loncommon::devalidate_domconfig_cache($dom); } else { - $resulttext = &mt('No changes made to scantron format file'); + $resulttext = &mt('No changes made to bubblesheet format file'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } } else { - $resulttext = &mt('No changes made to scantron format file'); + $resulttext = &mt('No changes made to bubblesheet format file'); } if ($errors) { $resulttext .= &mt('The following errors occurred: ').'
      '. @@ -5624,15 +6301,13 @@ sub modify_coursecategories { } else { $changes{'togglecats'} = 1; $changes{'categorize'} = 1; - $domconfig{'coursecategories'} = { - togglecats => $env{'form.togglecats'}, - categorize => $env{'form.categorize'}, - }; $changes{'togglecatscomm'} = 1; $changes{'categorizecomm'} = 1; $domconfig{'coursecategories'} = { - togglecats => $env{'form.togglecatscomm'}, - categorize => $env{'form.categorizecomm'}, + togglecats => $env{'form.togglecats'}, + categorize => $env{'form.categorize'}, + togglecatscomm => $env{'form.togglecatscomm'}, + categorizecomm => $env{'form.categorizecomm'}, }; } if (ref($cathash) eq 'HASH') { @@ -5876,7 +6551,6 @@ sub modify_serverstatuses { my %serverstatushash = ( serverstatuses => \%newserverstatus, ); - my %changes; foreach my $type (@pages) { foreach my $setting ('namedusers','machines') { my (@current,@new); @@ -6077,7 +6751,7 @@ sub modify_coursedefaults { my ($resulttext,$errors,%changes,%defaultshash); my %defaultchecked = ('canuse_pdfforms' => 'off'); my @offon = ('off','on'); - my @toggles = ('canuse_pdfforms'); + my @toggles = (); $defaultshash{'coursedefaults'} = {}; @@ -6106,6 +6780,18 @@ sub modify_coursedefaults { } $defaultshash{'coursedefaults'}{$item} = $env{'form.'.$item}; } + my $currdefresponder = $domconfig{'coursedefaults'}{'anonsurvey_threshold'}; + my $newdefresponder = $env{'form.anonsurvey_threshold'}; + $newdefresponder =~ s/\D//g; + if ($newdefresponder eq '' || $newdefresponder < 1) { + $newdefresponder = 1; + } + $defaultshash{'coursedefaults'}{'anonsurvey_threshold'} = $newdefresponder; + if ($currdefresponder ne $newdefresponder) { + unless ($currdefresponder eq '' && $newdefresponder == 10) { + $changes{'anonsurvey_threshold'} = 1; + } + } } my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash, $dom); @@ -6125,6 +6811,8 @@ sub modify_coursedefaults { } else { $resulttext .= '
    • '.&mt('Course/Community users can create/upload PDF forms set to "off"').'
    • '; } + } elsif ($item eq 'anonsurvey_threshold') { + $resulttext .= '
    • '.&mt('Responder count required for display of anonymous survey submissions set to [_1].',$defaultshash{'coursedefaults'}{'anonsurvey_threshold'}).'
    • '; } } $resulttext .= '
    '; @@ -6138,6 +6826,175 @@ sub modify_coursedefaults { return $resulttext; } +sub modify_usersessions { + my ($dom,%domconfig) = @_; + my @types = ('version','excludedomain','includedomain'); + my @prefixes = ('remote','hosted'); + my @lcversions = &Apache::lonnet::all_loncaparevs(); + my (%by_ip,%by_location,@intdoms); + &build_location_hashes(\@intdoms,\%by_ip,\%by_location); + my @locations = sort(keys(%by_location)); + my (%defaultshash,%changes); + foreach my $prefix (@prefixes) { + $defaultshash{'usersessions'}{$prefix} = {}; + } + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); + my $resulttext; + my %iphost = &Apache::lonnet::get_iphost(); + foreach my $prefix (@prefixes) { + foreach my $type (@types) { + my $inuse = $env{'form.'.$prefix.'_'.$type.'_inuse'}; + if ($type eq 'version') { + my $value = $env{'form.'.$prefix.'_'.$type}; + my $okvalue; + if ($value ne '') { + if (grep(/^\Q$value\E$/,@lcversions)) { + $okvalue = $value; + } + } + if (ref($domconfig{'usersessions'}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') { + if ($domconfig{'usersessions'}{$prefix}{$type} ne '') { + if ($inuse == 0) { + $changes{$prefix}{$type} = 1; + } else { + if ($okvalue ne $domconfig{'usersessions'}{$prefix}{$type}) { + $changes{$prefix}{$type} = 1; + } + if ($okvalue ne '') { + $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; + } + } + } else { + if (($inuse == 1) && ($okvalue ne '')) { + $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; + $changes{$prefix}{$type} = 1; + } + } + } else { + if (($inuse == 1) && ($okvalue ne '')) { + $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; + $changes{$prefix}{$type} = 1; + } + } + } else { + if (($inuse == 1) && ($okvalue ne '')) { + $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; + $changes{$prefix}{$type} = 1; + } + } + } else { + my @vals = &Apache::loncommon::get_env_multiple('form.'.$prefix.'_'.$type); + my @okvals; + foreach my $val (@vals) { + if ($val =~ /:/) { + my @items = split(/:/,$val); + foreach my $item (@items) { + if (ref($by_location{$item}) eq 'ARRAY') { + push(@okvals,$item); + } + } + } else { + if (ref($by_location{$val}) eq 'ARRAY') { + push(@okvals,$val); + } + } + } + @okvals = sort(@okvals); + if (ref($domconfig{'usersessions'}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{$prefix}{$type}) eq 'ARRAY') { + if ($inuse == 0) { + $changes{$prefix}{$type} = 1; + } else { + $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; + my @changed = &Apache::loncommon::compare_arrays($domconfig{'usersessions'}{$prefix}{$type},$defaultshash{'usersessions'}{$prefix}{$type}); + if (@changed > 0) { + $changes{$prefix}{$type} = 1; + } + } + } else { + if ($inuse == 1) { + $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; + $changes{$prefix}{$type} = 1; + } + } + } else { + if ($inuse == 1) { + $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; + $changes{$prefix}{$type} = 1; + } + } + } else { + if ($inuse == 1) { + $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; + $changes{$prefix}{$type} = 1; + } + } + } + } + } + if (keys(%changes) > 0) { + my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash, + $dom); + if ($putresult eq 'ok') { + if (ref($defaultshash{'usersessions'}) eq 'HASH') { + if (ref($defaultshash{'usersessions'}{'remote'}) eq 'HASH') { + $domdefaults{'remotesessions'} = $defaultshash{'usersessions'}{'remote'}; + } + if (ref($defaultshash{'usersessions'}{'hosted'}) eq 'HASH') { + $domdefaults{'hostedsessions'} = $defaultshash{'usersessions'}{'hosted'}; + } + } + my $cachetime = 24*60*60; + &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); + my %lt = &usersession_titles(); + $resulttext = &mt('Changes made:').'
      '; + foreach my $prefix (@prefixes) { + if (ref($changes{$prefix}) eq 'HASH') { + $resulttext .= '
    • '.$lt{$prefix}.'
        '; + foreach my $type (@types) { + if (defined($changes{$prefix}{$type})) { + my $newvalue; + if (ref($defaultshash{'usersessions'}) eq 'HASH') { + if (ref($defaultshash{'usersessions'}{$prefix})) { + if ($type eq 'version') { + $newvalue = $defaultshash{'usersessions'}{$prefix}{$type}; + } elsif (ref($defaultshash{'usersessions'}{$prefix}{$type}) eq 'ARRAY') { + if (@{$defaultshash{'usersessions'}{$prefix}{$type}} > 0) { + $newvalue = join(', ',@{$defaultshash{'usersessions'}{$prefix}{$type}}); + } + } + } + } + if ($newvalue eq '') { + if ($type eq 'version') { + $resulttext .= '
      • '.&mt('[_1] set to: off',$lt{$type}).'
      • '; + } else { + $resulttext .= '
      • '.&mt('[_1] set to: none',$lt{$type}).'
      • '; + } + } else { + if ($type eq 'version') { + $newvalue .= ' '.&mt('(or later)'); + } + $resulttext .= '
      • '.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).'
      • '; + } + } + } + $resulttext .= '
      '; + } + } + $resulttext .= '
    '; + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + } else { + $resulttext = &mt('No changes made to settings for user session hosting.'); + } + return $resulttext; +} + sub recurse_check { my ($chkcats,$categories,$depth,$name) = @_; if (ref($chkcats->[$depth]{$name}) eq 'ARRAY') { @@ -6211,4 +7068,85 @@ sub dom_servers { return %uniqservers; } +sub get_active_dcs { + my ($dom) = @_; + my %dompersonnel = &Apache::lonnet::get_domain_roles($dom,['dc']); + my %domcoords; + my $numdcs = 0; + my $now = time; + foreach my $server (keys(%dompersonnel)) { + foreach my $user (sort(keys(%{$dompersonnel{$server}}))) { + my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,$user); + my ($end,$start) = split(':',$dompersonnel{$server}{$user}); + if (($end eq '') || ($end == 0) || ($end > $now)) { + if ($start <= $now) { + $domcoords{$uname.':'.$udom} = $dompersonnel{$server}{$user}; + } + } + } + } + return %domcoords; +} + +sub active_dc_picker { + my ($dom,$curr_dc) = @_; + my %domcoords = &get_active_dcs($dom); + my @dcs = sort(keys(%domcoords)); + my $numdcs = scalar(@dcs); + my $datatable; + my $numinrow = 2; + if ($numdcs > 1) { + $datatable = ''; + for (my $i=0; $i<@dcs; $i++) { + my $rem = $i%($numinrow); + if ($rem == 0) { + if ($i > 0) { + $datatable .= ''; + } + $datatable .= ''; + } + my $check = ' '; + if ($curr_dc eq '') { + if (!$i) { + $check = ' checked="checked" '; + } + } elsif ($dcs[$i] eq $curr_dc) { + $check = ' checked="checked" '; + } + if ($i == @dcs - 1) { + my $colsleft = $numinrow - $rem; + if ($colsleft > 1) { + $datatable .= ''; + } + $datatable .= '
    '; + } else { + $datatable .= ''; + } + } else { + $datatable .= ''; + } + my ($dcname,$dcdom) = split(':',$dcs[$i]); + $datatable .= '
    '; + } elsif (@dcs) { + $datatable .= ''; + } + return ($numdcs,$datatable); +} + +sub usersession_titles { + return &Apache::lonlocal::texthash( + hosted => 'Hosting of sessions for users from other domains on servers in this domain', + + remote => 'Hosting of sessions for users in this domain on servers in other domains', + version => 'LON-CAPA version requirement', + excludedomain => 'Allow all, but exclude specific domains', + includedomain => 'Deny all, but include specific domains', + ); +} + 1;