From 6285486bdac951ba5a028f53ba10f0da0f96e820 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Fri, 16 Oct 2026 18:47:44 -0500 Subject: [PATCH] Validate and safely quote course configuration values. Values saved to the course's simple.conf file by the course configuration page and the `updateSetting` API method were not properly sanitized. Boolean, permission, popuplist, and checkbox list values were written to the file without any validation or escaping, and a trailing backslash in a text or list value escaped the closing quote. Since simple.conf is evaluated as perl code, this allowed arbitrary course environment variables to be modified. The ConfigObject classes now validate submitted values against the allowed values for each type, and quote string values with proper escaping. If a submitted value is invalid, then the current value is kept. Quotes are no longer removed from text and list values. That was a poor attempt at sanitizing the values, and it did not work. Now that values are properly escaped, it is no longer needed. Removing quotes also caused a problem with the comparison to the default value. The comparison was made with the submitted value, but the value with quotes removed was saved. For example, if a setting's default value is "the LMS" and "'the LMS'" is entered, then a line setting the value to "the LMS" was saved to simple.conf even though that is identical to the default. That line was then removed the next time the configuration was saved. Furthermore, there is no reason that quotes should not be allowed in these values (for example, in the LMS name), and nothing in the course configuration user interface indicated that quotes were not allowed. The validation of the time type has been fixed. That type is only used for the $pg{timeAssignDue} variable, and the only place that value is used is the getDefaultSetDueDate method in WeBWorK::Utils::DateTime. That method allows whitespace around the hours, minutes, and AM/PM parts of the time, and allows a 24 hour time without AM or PM. The validation did not allow those. Now it does, while still ensuring that the hour is in the valid range (1 to 12 with AM or PM, and 0 to 23 without) since DateTime->new dies if given an hour that is out of range. The simple.conf building and writing logic has been moved from the Instructor::Config module into the new WeBWorK::CourseConfig module. The `updateSetting` API method now uses that as well, so that it only allows changing configurable variables, checks the change_config permissions, and validates values in the same way as the course configuration page. Co-Authored-By: Claude Opus 5.5 --- lib/WeBWorK/ConfigObject.pm | 33 +++- lib/WeBWorK/ConfigObject/boolean.pm | 5 +- lib/WeBWorK/ConfigObject/checkboxlist.pm | 18 ++- lib/WeBWorK/ConfigObject/list.pm | 2 +- lib/WeBWorK/ConfigObject/lms_context_id.pm | 21 +-- lib/WeBWorK/ConfigObject/number.pm | 10 +- lib/WeBWorK/ConfigObject/permission.pm | 5 +- .../ConfigObject/permission_checkboxlist.pm | 18 ++- lib/WeBWorK/ConfigObject/popuplist.pm | 5 +- lib/WeBWorK/ConfigObject/setting.pm | 2 +- lib/WeBWorK/ConfigObject/time.pm | 7 +- lib/WeBWorK/ConfigObject/timezone.pm | 10 +- lib/WeBWorK/ConfigValues.pm | 3 +- .../ContentGenerator/API/CourseActions.pm | 53 ++----- .../ContentGenerator/Instructor/Config.pm | 64 +------- lib/WeBWorK/CourseConfig.pm | 150 ++++++++++++++++++ 16 files changed, 255 insertions(+), 151 deletions(-) create mode 100644 lib/WeBWorK/CourseConfig.pm diff --git a/lib/WeBWorK/ConfigObject.pm b/lib/WeBWorK/ConfigObject.pm index d9a2c0007f..287e105b5e 100644 --- a/lib/WeBWorK/ConfigObject.pm +++ b/lib/WeBWorK/ConfigObject.pm @@ -34,24 +34,49 @@ sub get_value ($self, $ce) { return $value; } +# The submitted value of this setting. This is the html form element value unless an input_name was given, in which +# case that request parameter is used instead. In list context all values of the parameter are returned. +sub new_value ($self) { + return $self->{c}->param($self->{input_name} // $self->{name}); +} + # If use_current is true then return the current course environment value for this setting. -# Otherwise use the value of the html form element. +# Otherwise use the submitted value. sub convert_newval_source ($self, $use_current) { if ($use_current) { return $self->comparison_value($self->get_value($self->{c}->ce)); } else { - return $self->{c}->param($self->{name}) // ''; + return scalar($self->new_value) // ''; } } +sub quote ($self, $value) { + return "'" . ($value =~ s/([\\'])/\\$1/gr) . "'"; +} + +sub add_error ($self, $message) { + push(@{ $self->{errors} }, $message); + return; +} + +sub errors ($self) { + return @{ $self->{errors} // [] }; +} + +# Record that the submitted value is invalid, and save the current course environment value instead. +sub reject ($self, $oldval, $use_current, $message) { + return '' if $use_current; + $self->add_error($message); + return $self->save_string($oldval, 1); +} + # Bit of text to put in the configuration file. The result should be an assignment which is executable by perl. oldval # will be the value of the perl variable, and newval will be whatever an entry widget produces. sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); return '' if $self->comparison_value($oldval) eq $newval || ($self->{secret} && $newval eq SECRET_STRING); - $newval =~ s/['"`]//g; - return "\$$self->{var} = '$newval';\n"; + return "\$$self->{var} = " . $self->quote($newval) . ";\n"; } # A widget to interact with the user diff --git a/lib/WeBWorK/ConfigObject/boolean.pm b/lib/WeBWorK/ConfigObject/boolean.pm index f3636211c1..0ef109ecab 100644 --- a/lib/WeBWorK/ConfigObject/boolean.pm +++ b/lib/WeBWorK/ConfigObject/boolean.pm @@ -10,7 +10,10 @@ sub display_value ($self, $val) { sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); - return '' if $self->comparison_value($oldval) eq $newval; + return $self->reject($oldval, $use_current, + $self->{c}->maketext('Invalid boolean value "[_1]" for variable $[_2].', $newval, $self->{var})) + unless $newval =~ /^[01]\z/; + return '' if $self->comparison_value($oldval) == $newval; return "\$$self->{var} = $newval;\n"; } diff --git a/lib/WeBWorK/ConfigObject/checkboxlist.pm b/lib/WeBWorK/ConfigObject/checkboxlist.pm index ec569ee17e..aea64b3e92 100644 --- a/lib/WeBWorK/ConfigObject/checkboxlist.pm +++ b/lib/WeBWorK/ConfigObject/checkboxlist.pm @@ -10,19 +10,23 @@ sub convert_newval_source ($self, $use_current) { if ($use_current) { return @{ $self->get_value($self->{c}->ce) }; } else { - return $self->{c}->param($self->{name}); + return $self->new_value; } } sub save_string ($self, $oldval, $use_current = 0) { my @newvals = $self->convert_newval_source($use_current); - if ($self->{min} && scalar(@newvals) < $self->{min}) { - $self->{c}->addbadmessage(qq!You need to select at least $self->{min} option for "$self->{doc}".!); - return '' if $use_current; - return $self->save_string($oldval, 1); - } + return $self->reject($oldval, $use_current, + $self->{c}->maketext('You need to select at least [_1] option for "[_2]".', $self->{min}, $self->{doc})) + if $self->{min} && @newvals < $self->{min}; + + my %allowed = map { $_ => 1 } @{ $self->{values} }; + return $self->reject($oldval, $use_current, + $self->{c}->maketext('Invalid value "[_1]" for variable $[_2].', join(', ', @newvals), $self->{var})) + if !$use_current && grep { !$allowed{$_} } @newvals; + return '' if $self->comparison_value($oldval) eq $self->comparison_value(\@newvals); - return "\$$self->{var} = [" . join(',', map {"'$_'"} @newvals) . "];\n"; + return "\$$self->{var} = [" . join(',', map { $self->quote($_) } @newvals) . "];\n"; } sub comparison_value ($self, $val) { diff --git a/lib/WeBWorK/ConfigObject/list.pm b/lib/WeBWorK/ConfigObject/list.pm index 743f9ec74f..de4407a73c 100644 --- a/lib/WeBWorK/ConfigObject/list.pm +++ b/lib/WeBWorK/ConfigObject/list.pm @@ -25,7 +25,7 @@ sub save_string ($self, $oldval, $use_current = 0) { return '' if $newval eq $oldval; # This is a new value. Turn it back into a string and return it. - return "\$$self->{var} = [" . join(',', map {"'$_'"} map { $_ =~ s/['"`]//gr } split(',', $newval)) . "];\n"; + return "\$$self->{var} = [" . join(',', map { $self->quote($_) } split(',', $newval)) . "];\n"; } sub entry_widget ($self, $default, $is_secret = 0) { diff --git a/lib/WeBWorK/ConfigObject/lms_context_id.pm b/lib/WeBWorK/ConfigObject/lms_context_id.pm index 4a7868e24e..8bef2e4feb 100644 --- a/lib/WeBWorK/ConfigObject/lms_context_id.pm +++ b/lib/WeBWorK/ConfigObject/lms_context_id.pm @@ -13,12 +13,13 @@ sub get_value ($self, $ce) { sub save_string ($self, $oldval, $use_current = 0) { return '' if $use_current; - my $c = $self->{c}; - my $ce = $c->ce; + my $c = $self->{c}; + my $ce = $c->ce; + my $newval = scalar $self->new_value; # Unlike all other configuration settings, this one needs to be validated. It must be ensured that this course does # not have the same context id as any other course on the server that has the same LTI configuration. - if (defined $c->param($self->{name}) && $c->param($self->{name}) ne '') { + if (defined $newval && $newval ne '') { my @courseMaps = $c->db->getLTICourseMapsWhere; # If a context id is going to be set and the course is configured for LTI 1.3, then make sure it has all of the @@ -27,7 +28,7 @@ sub save_string ($self, $oldval, $use_current = 0) { if ($ce->{LTIVersion} eq 'v1p3' && !($ce->{LTI}{v1p3}{PlatformID} && $ce->{LTI}{v1p3}{ClientID} && $ce->{LTI}{v1p3}{DeploymentID})) { - $c->addbadmessage($c->maketext( + $self->add_error($c->maketext( 'An LMS context id is requested to be assigned to this course which is set to use LTI 1.3, but ' . 'this course is missing LTI 1.3 authentication parameters. This is not allowed, and so this ' . 'setting was not saved.' @@ -38,7 +39,7 @@ sub save_string ($self, $oldval, $use_current = 0) { for my $courseMap (@courseMaps) { next if $courseMap->course_id eq $c->ce->{courseName} - || $c->param($self->{name}) ne $courseMap->lms_context_id; + || $newval ne $courseMap->lms_context_id; my $other_ce = eval { WeBWorK::CourseEnvironment->new({ courseName => $courseMap->course_id }) }; @@ -50,7 +51,7 @@ sub save_string ($self, $oldval, $use_current = 0) { || $ce->{LTI}{v1p1}{ConsumerKey} eq $other_ce->{LTI}{v1p1}{ConsumerKey}) ) { - $c->addbadmessage($c->maketext( + $self->add_error($c->maketext( 'The requested LMS Context ID is the same as that of another course that is also configured ' . 'to use LTI 1.1, but the consumer keys for both this course and that course are either ' . 'both not set or are the same. This is not allowed, and so this setting was not saved.', @@ -64,7 +65,7 @@ sub save_string ($self, $oldval, $use_current = 0) { && $ce->{LTI}{v1p3}{ClientID} eq $other_ce->{LTI}{v1p3}{ClientID} && $ce->{LTI}{v1p3}{DeploymentID} eq $other_ce->{LTI}{v1p3}{DeploymentID}) { - $c->addbadmessage($c->maketext( + $self->add_error($c->maketext( 'The requested LMS Context ID is the same as that of another course that is also configured ' . 'to use LTI 1.3, but this course and that course have the same LTI 1.3 authentication ' . 'parameters. This is not allowed, and so this setting was not saved.' @@ -74,11 +75,11 @@ sub save_string ($self, $oldval, $use_current = 0) { } } - eval { $c->db->setLTICourseMap($c->ce->{courseName}, $c->param($self->{name})) }; - $c->addbadmessage($c->maketext('An error occurred saving the lms_context_id: [_1]', $@)) if $@; + eval { $c->db->setLTICourseMap($c->ce->{courseName}, $newval) }; + $self->add_error($c->maketext('An error occurred saving the lms_context_id: [_1]', $@)) if $@; } else { eval { $c->db->deleteLTICourseMapWhere({ course_id => $c->ce->{courseName} }) }; - $c->addbadmessage($c->maketext('An error occurred deletinglms_context_id: [_1]', $@)) if $@; + $self->add_error($c->maketext('An error occurred deletinglms_context_id: [_1]', $@)) if $@; } return ''; diff --git a/lib/WeBWorK/ConfigObject/number.pm b/lib/WeBWorK/ConfigObject/number.pm index 2312c98fb5..c15a4e2671 100644 --- a/lib/WeBWorK/ConfigObject/number.pm +++ b/lib/WeBWorK/ConfigObject/number.pm @@ -2,12 +2,10 @@ package WeBWorK::ConfigObject::number; use Mojo::Base 'WeBWorK::ConfigObject', -signatures; sub save_string ($self, $oldval, $use_current = 0) { - my $newval = $self->convert_newval_source($use_current) =~ s/['"`]//gr; - if ($newval !~ m/^[-+]?(\d+(\.\d*)?|\.\d+)$/) { - $self->{c}->addbadmessage(qq{Invalid numeric value "$newval" for variable \$$self->{var}. } - . 'Reverting to the system default value.'); - return ''; - } + my $newval = $self->convert_newval_source($use_current); + return $self->reject($oldval, $use_current, + $self->{c}->maketext('Invalid numeric value "[_1]" for variable $[_2].', $newval, $self->{var})) + unless $newval =~ m/^[-+]?(\d+(\.\d*)?|\.\d+)$/; return '' if $self->comparison_value($oldval) == +$newval; return "\$$self->{var} = $newval;\n"; diff --git a/lib/WeBWorK/ConfigObject/permission.pm b/lib/WeBWorK/ConfigObject/permission.pm index 344cf918f0..af1fc1f0d4 100644 --- a/lib/WeBWorK/ConfigObject/permission.pm +++ b/lib/WeBWorK/ConfigObject/permission.pm @@ -15,8 +15,11 @@ sub display_value ($self, $val) { sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); + return $self->reject($oldval, $use_current, + $self->{c}->maketext('Invalid permission level "[_1]" for variable $[_2].', $newval, $self->{var})) + unless $use_current || exists $self->{c}->ce->{userRoles}{$newval}; return '' if $self->comparison_value($oldval) eq $newval; - return "\$$self->{var} = '$newval';\n"; + return "\$$self->{var} = " . $self->quote($newval) . ";\n"; } sub entry_widget ($self, $default, $is_secret = 0) { diff --git a/lib/WeBWorK/ConfigObject/permission_checkboxlist.pm b/lib/WeBWorK/ConfigObject/permission_checkboxlist.pm index f1b8f2a6d5..cde732d87b 100644 --- a/lib/WeBWorK/ConfigObject/permission_checkboxlist.pm +++ b/lib/WeBWorK/ConfigObject/permission_checkboxlist.pm @@ -16,19 +16,23 @@ sub convert_newval_source ($self, $use_current) { return @{ role_and_above($self->{c}->ce->{userRoles}, $self->get_value($self->{c}->ce)) }; } } else { - return $self->{c}->param($self->{name}); + return $self->new_value; } } sub save_string ($self, $oldval, $use_current = 0) { my @newvals = $self->convert_newval_source($use_current); - if ($self->{min} && scalar(@newvals) < $self->{min}) { - $self->{c}->addbadmessage("You need to select at least $self->{min} display mode."); - return '' if $use_current; - return $self->save_string($oldval, 1); - } + return $self->reject($oldval, $use_current, + $self->{c}->maketext('You need to select at least [_1] option for "[_2]".', $self->{min}, $self->{doc})) + if $self->{min} && @newvals < $self->{min}; + + my $userRoles = $self->{c}->ce->{userRoles}; + return $self->reject($oldval, $use_current, + $self->{c}->maketext('Invalid value "[_1]" for variable $[_2].', join(', ', @newvals), $self->{var})) + if !$use_current && grep { $_ eq 'nobody' || !exists $userRoles->{$_} } @newvals; + return '' if $self->comparison_value($oldval) eq $self->comparison_value(\@newvals); - return "\$$self->{var} = [" . join(',', map {"'$_'"} @newvals) . "];\n"; + return "\$$self->{var} = [" . join(',', map { $self->quote($_) } @newvals) . "];\n"; } sub comparison_value ($self, $val) { diff --git a/lib/WeBWorK/ConfigObject/popuplist.pm b/lib/WeBWorK/ConfigObject/popuplist.pm index f7a1de6aa6..7db9a9d7b3 100644 --- a/lib/WeBWorK/ConfigObject/popuplist.pm +++ b/lib/WeBWorK/ConfigObject/popuplist.pm @@ -10,8 +10,11 @@ sub display_value ($self, $val) { sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); + return $self->reject($oldval, $use_current, + $self->{c}->maketext('Invalid value "[_1]" for variable $[_2].', $newval, $self->{var})) + unless $use_current || grep { $_ eq $newval } @{ $self->{values} }; return '' if $self->comparison_value($oldval) eq $newval; - return ("\$$self->{var} = '$newval';\n"); + return "\$$self->{var} = " . $self->quote($newval) . ";\n"; } sub entry_widget ($self, $default, $is_secret = 0) { diff --git a/lib/WeBWorK/ConfigObject/setting.pm b/lib/WeBWorK/ConfigObject/setting.pm index 45eb79f7f8..29bcbea8e0 100644 --- a/lib/WeBWorK/ConfigObject/setting.pm +++ b/lib/WeBWorK/ConfigObject/setting.pm @@ -16,7 +16,7 @@ sub get_value ($self, $ce) { # so that it is not represented in the course's simple.conf file. sub save_string ($self, $oldval, $use_current = 0) { return '' if $use_current; - $self->{c}->db->setSettingValue($self->{var}, scalar $self->{c}->param($self->{var})); + $self->{c}->db->setSettingValue($self->{var}, scalar $self->new_value); return ''; } diff --git a/lib/WeBWorK/ConfigObject/time.pm b/lib/WeBWorK/ConfigObject/time.pm index 20185d8b33..a82d3b6f27 100644 --- a/lib/WeBWorK/ConfigObject/time.pm +++ b/lib/WeBWorK/ConfigObject/time.pm @@ -7,10 +7,9 @@ sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); return '' if $self->comparison_value($oldval) eq $newval; - if ($newval !~ /^(01|1|02|2|03|3|04|4|05|5|06|6|07|7|08|8|09|9|10|11|12):[0-5]\d(am|pm|AM|PM)$/) { - $self->{c}->addbadmessage(qq{String "$newval" is not a valid time. Reverting to the system default value.}); - return ''; - } + my ($hour, $ampm) = $newval =~ /^\s*(\d{1,2})\s*:\s*[0-5]\d\s*(am|pm|AM|PM)?\s*\z/; + return $self->reject($oldval, $use_current, $self->{c}->maketext('String "[_1]" is not a valid time.', $newval)) + unless defined $hour && ($ampm ? $hour >= 1 && $hour <= 12 : $hour <= 23); return "\$$self->{var} = '$newval';\n"; } diff --git a/lib/WeBWorK/ConfigObject/timezone.pm b/lib/WeBWorK/ConfigObject/timezone.pm index feaf1f8acd..b9b9e3fede 100644 --- a/lib/WeBWorK/ConfigObject/timezone.pm +++ b/lib/WeBWorK/ConfigObject/timezone.pm @@ -9,13 +9,11 @@ sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); return '' if $self->comparison_value($oldval) eq $newval; - if (not DateTime::TimeZone->is_valid_name($newval)) { - $self->{c}->addbadmessage("String '$newval' is not a valid time zone. Reverting to the system default value."); - return ''; - } + return $self->reject($oldval, $use_current, + $self->{c}->maketext('String "[_1]" is not a valid time zone.', $newval)) + unless DateTime::TimeZone->is_valid_name($newval); - $newval =~ s/['"`]//g; - return "\$$self->{var} = '$newval';\n"; + return "\$$self->{var} = " . $self->quote($newval) . ";\n"; } 1; diff --git a/lib/WeBWorK/ConfigValues.pm b/lib/WeBWorK/ConfigValues.pm index 198a2737d5..0000d43744 100644 --- a/lib/WeBWorK/ConfigValues.pm +++ b/lib/WeBWorK/ConfigValues.pm @@ -14,7 +14,7 @@ allowed. =item text -A text string (no quotes allowed). +A text string. =item number @@ -62,6 +62,7 @@ This is specifically for The LMS context id used for content selection. =cut use Mojo::File qw(path); +use XML::LibXML; use WeBWorK::Utils qw(x); diff --git a/lib/WeBWorK/ContentGenerator/API/CourseActions.pm b/lib/WeBWorK/ContentGenerator/API/CourseActions.pm index e2e38be80e..9d530f1744 100644 --- a/lib/WeBWorK/ContentGenerator/API/CourseActions.pm +++ b/lib/WeBWorK/ContentGenerator/API/CourseActions.pm @@ -12,6 +12,7 @@ use WeBWorK::Utils qw(cryptPassword isValidEmailAddress); use WeBWorK::Utils::CourseManagement qw(addCourse); use WeBWorK::Utils::Files qw(surePathToFile path_is_subdir); use WeBWorK::ConfigValues qw(getConfigValues); +use WeBWorK::CourseConfig qw(findConfigObject canChangeConfig buildSimpleConfig writeSimpleConfig); use WeBWorK::Debug qw(debug); our @apiCalls = qw( @@ -441,51 +442,19 @@ sub updateSetting ($c) { return $c->renderError('You do not have permission for the updateSetting API command.') unless $c->authz->hasPermissions($c->authen->{user_id}, 'manage_course_files'); - my $ce = $c->ce; + my $ce = $c->ce; + my $setVar = $c->req->param('var') // ''; - # FIXME: There is no check in this method that the var and value passed in are valid. - my $setVar = $c->req->param('var'); - my $setValue = $c->req->param('value'); - - my $filename = "$ce->{courseDirs}{root}/simple.conf"; - - my $fileoutput = "#!perl -# This file is automatically generated by WeBWorK's web-based -# configuration module. Do not make changes directly to this -# file. It will be overwritten the next time configuration -# changes are saved.\n\n"; - - # Read in the file - open(my $DAT, '<', $filename) - or return $c->renderError("Unable to read $filename. " - . "Ensure that the file exists and the server has write permission for this file."); - my @raw_data = <$DAT>; - close($DAT); - - my $varFound = 0; - - for my $line (@raw_data) { - chomp $line; - if ($line =~ /^\$/) { - my @tmp = split(/\$/, $line); - my ($var, $value) = split(/\s+=\s+/, $tmp[1]); - if ($var eq $setVar) { - $fileoutput .= "\$$var = $setValue;\n"; - $varFound = 1; - } else { - # The value includes the semicolon that hopefully was in the file. - $fileoutput .= "\$$var = $value\n"; - } - } - } + return $c->renderError("Invalid course setting $setVar.") unless findConfigObject($c, $setVar); + return $c->renderError("You do not have permission to change the course setting $setVar.") + unless canChangeConfig($c, $setVar); - $fileoutput .= "\$$setVar = $setValue;\n" unless $varFound; + my ($fileoutput, $errors) = buildSimpleConfig($c, var => $setVar, input_name => 'value'); + return $c->renderError(join(' ', @$errors)) if @$errors; - open(my $OUTPUTFILE, '>', $filename) - or return $c->renderError( - "Unable to write to $filename. Ensure that the server has write permission for this file."); - print $OUTPUTFILE $fileoutput; - close $OUTPUTFILE; + return $c->renderError("Unable to write to $ce->{courseDirs}{root}/simple.conf. " + . 'Ensure that the server has write permission for this file.') + unless writeSimpleConfig($ce, $fileoutput); return $c->render(json => { message => 'Successfully updated course setting' }); } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Config.pm b/lib/WeBWorK/ContentGenerator/Instructor/Config.pm index 614c9498cc..9f3994528a 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Config.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Config.pm @@ -7,36 +7,12 @@ WeBWorK::ContentGenerator::Instructor::Config - Config =cut -use XML::LibXML; - -use WeBWorK::CourseEnvironment; -use WeBWorK::ConfigObject::text; -use WeBWorK::ConfigObject::timezone; -use WeBWorK::ConfigObject::time; -use WeBWorK::ConfigObject::number; -use WeBWorK::ConfigObject::boolean; -use WeBWorK::ConfigObject::permission; -use WeBWorK::ConfigObject::permission_checkboxlist; -use WeBWorK::ConfigObject::list; -use WeBWorK::ConfigObject::checkboxlist; -use WeBWorK::ConfigObject::popuplist; -use WeBWorK::ConfigObject::setting; -use WeBWorK::ConfigObject::lms_context_id; use WeBWorK::ConfigValues qw(getConfigValues); - -# Write contents to outputFilePath and return error messages if any. -sub writeFile ($outputFilePath, $contents) { - if (open my $OUTPUTFILE, '>:encoding(UTF-8)', $outputFilePath) { - print $OUTPUTFILE $contents; - close $OUTPUTFILE; - return 1; - } - return 0; -} +use WeBWorK::CourseConfig qw(configObject buildSimpleConfig writeSimpleConfig); # Make a new config object from data sub objectify ($c, $data) { - return "WeBWorK::ConfigObject::$data->{type}"->new($data, $c); + return configObject($c, $data); } sub initialize ($c) { @@ -51,40 +27,10 @@ sub initialize ($c) { $c->stash->{configValues} = getConfigValues($ce); if ($c->param('make_changes')) { - # Get a copy of the course environment which does not have simple.conf loaded - my $ce2 = WeBWorK::CourseEnvironment->new({ - courseName => $ce->{courseName}, - web_config_filename => 'noSuchFilePlease' - }); - - my $fileoutput = <<~'END_SIMPLE_CONF_HEADER'; - #!perl - # This file is automatically generated by WeBWorK's web-based - # configuration module. Do not make changes directly to this - # file. It will be overwritten the next time configuration - # changes are saved. - - END_SIMPLE_CONF_HEADER - - # Write all settings that are different from the default to the simple configuration file. - for my $configSection (@{ $c->stash->{configValues} }) { - my @configSectionArray = @$configSection; - shift @configSectionArray; - for my $con (@configSectionArray) { - my $conobject = $c->objectify($con); - if (defined $ce->{permissionLevels}{"change_config_$con->{var}"} - && !$c->authz->hasPermissions($c->authen->{user_id}, "change_config_$con->{var}")) - { - # The user does not have permission to change this configuration value. - # So use the current course environment value. - $fileoutput .= $conobject->save_string($conobject->get_value($ce2), 1); - } else { - $fileoutput .= $conobject->save_string($conobject->get_value($ce2)); - } - } - } + my ($fileOutput, $errors) = buildSimpleConfig($c); + $c->addbadmessage($_) for @$errors; - if (writeFile("$ce->{courseDirs}{root}/simple.conf", $fileoutput)) { + if (writeSimpleConfig($ce, $fileOutput)) { $c->addgoodmessage($c->maketext('Changes saved.')); # Redirect back to the instructor config page after saving settings. After the redirect the now saved diff --git a/lib/WeBWorK/CourseConfig.pm b/lib/WeBWorK/CourseConfig.pm new file mode 100644 index 0000000000..43993b27c9 --- /dev/null +++ b/lib/WeBWorK/CourseConfig.pm @@ -0,0 +1,150 @@ +package WeBWorK::CourseConfig; +use Mojo::Base 'Exporter', -signatures; + +=head1 NAME + +WeBWorK::CourseConfig - Utilities for saving a course's web based configuration +in the course's F file. + +=cut + +use Mojo::File qw(path); + +use WeBWorK::CourseEnvironment; +use WeBWorK::ConfigObject::text; +use WeBWorK::ConfigObject::timezone; +use WeBWorK::ConfigObject::time; +use WeBWorK::ConfigObject::number; +use WeBWorK::ConfigObject::boolean; +use WeBWorK::ConfigObject::permission; +use WeBWorK::ConfigObject::permission_checkboxlist; +use WeBWorK::ConfigObject::list; +use WeBWorK::ConfigObject::checkboxlist; +use WeBWorK::ConfigObject::popuplist; +use WeBWorK::ConfigObject::setting; +use WeBWorK::ConfigObject::lms_context_id; +use WeBWorK::ConfigValues qw(getConfigValues); + +our @EXPORT_OK = qw(configObject findConfigObject canChangeConfig buildSimpleConfig writeSimpleConfig); + +=head1 FUNCTIONS + +=head2 configObject + + my $configObject = configObject($c, $data, %options); + +Create a C of the type given in the C<$data> hash (an +entry from C). If the C option is given, then the +new value for the setting is taken from that request parameter instead of the +parameter that the configuration page form uses. + +=cut + +sub configObject ($c, $data, %options) { + return "WeBWorK::ConfigObject::$data->{type}"->new({ %$data, %options }, $c); +} + +=head2 findConfigObject + + my $configObject = findConfigObject($c, $var, %options); + +Find the configuration value whose variable name is C<$var>, and return a +C for it. Returns undefined if C<$var> is not a +configurable variable. + +=cut + +sub findConfigObject ($c, $var, %options) { + for my $configSection (@{ getConfigValues($c->ce) }) { + for my $data (@$configSection[ 1 .. $#$configSection ]) { + return configObject($c, $data, %options) if $data->{var} eq $var; + } + } + return; +} + +=head2 canChangeConfig + + my $allowed = canChangeConfig($c, $var); + +Returns true if the current user is allowed to change the configuration variable +C<$var>. + +=cut + +sub canChangeConfig ($c, $var) { + return !defined $c->ce->{permissionLevels}{"change_config_$var"} + || $c->authz->hasPermissions($c->authen->{user_id}, "change_config_$var"); +} + +=head2 buildSimpleConfig + + my ($contents, $errors) = buildSimpleConfig($c, %options); + +Build the contents of the course's F file. All configuration +values that differ from the default value (the value without F +loaded) are saved. New values are taken from the request parameters, except for +variables the user does not have permission to change, for which the current +course environment value is kept. + +If the C option is given, then only that variable is changed and all other +variables keep their current course environment values. The C +option is passed on to C. + +Invalid submitted values are not saved and the current course environment value +is kept instead. A reference to an array of messages describing those invalid +values is returned along with the file contents. + +Note that values of the C and C types are saved to the +database by this method. + +=cut + +sub buildSimpleConfig ($c, %options) { + my $ce = $c->ce; + + # Get a copy of the course environment which does not have simple.conf loaded. + my $defaultCE = WeBWorK::CourseEnvironment->new({ + courseName => $ce->{courseName}, + web_config_filename => 'noSuchFilePlease' + }); + + my $contents = <<~'END_SIMPLE_CONF_HEADER'; + #!perl + # This file is automatically generated by WeBWorK's web-based + # configuration module. Do not make changes directly to this + # file. It will be overwritten the next time configuration + # changes are saved. + + END_SIMPLE_CONF_HEADER + + my @errors; + + for my $configSection (@{ getConfigValues($ce) }) { + for my $data (@$configSection[ 1 .. $#$configSection ]) { + my $configObject = configObject($c, $data, input_name => $options{input_name}); + my $useCurrent = (defined $options{var} && $options{var} ne $data->{var}) + || !canChangeConfig($c, $data->{var}); + $contents .= $configObject->save_string($configObject->get_value($defaultCE), $useCurrent); + push(@errors, $configObject->errors); + } + } + + return ($contents, \@errors); +} + +=head2 writeSimpleConfig + + my $success = writeSimpleConfig($ce, $contents); + +Write C<$contents> to the course's F file. Returns true on +success. + +=cut + +sub writeSimpleConfig ($ce, $contents) { + eval { path($ce->{courseDirs}{root}, 'simple.conf')->spew($contents, 'UTF-8') }; + return $@ ? 0 : 1; +} + +1;