view release on metacpan or  search on metacpan

Ezmlm/GpgEzmlm.pm  view on Meta::CPAN

	} else {
		$dot_loc =~ s/\W/_/g;
		warn "[GpgEzmlm] directory name of dotqmail files contains invalid "
				. "characters: $dot_loc (special characters are escaped)";
		return undef;
	}

	# the backup directory should contain the old config file (if it existed)
	# and the original dotqmail files
	$backup_dir = _get_config_backup_dir($self->thislist());
	unless (-r $backup_dir) {
		warn "[GpgEzmlm] failed to revert conversion - the backup directory "
				. "is missing: $backup_dir";
		return undef;
	}

	# the "dot_prefix" is the basename of the main dotqmail file
	# (e.g. '.qmail-list-foo')
	$dot_loc =~ m/\/([^\/]+)$/;
	if (defined($1)) {
		$dot_prefix = $1;
	} else {
		warn '[GpgEzmlm] invalid location of dotqmail file: ' . $dot_loc;
		return undef;
	}

	# the "dotqmail" location must be valid
	unless (defined($dot_loc) && ($dot_loc ne '') && (-e $dot_loc)) {
		$self->_seterror(-1, 'dotqmail files not found: ' . $dot_loc);
		return undef;
	}

	# start reverting the gpg-ezmlm conversion:
	# - restore old dotqmail files
	# - restore old config file (if it existed before)

	# restore original config file (if it exists)
	&_enable_plaintext_config_file($list_dir);

	# replace the dotqmail files with the ones from the backup
	unless ((File::Copy::copy("$backup_dir/$dot_prefix", "$dot_loc"))
			&& (File::Copy::copy("$backup_dir/$dot_prefix-default",
					"$dot_loc-default",))) {
		warn "[GpgEzmlm] failed to restore dotqmail files: $!";
		return undef;
	}

	$self = Mail::Ezmlm->new($list_dir);
	return $self;
}

# == Update the "normal" settings  of the current list ==

=head2 Updating the common configuration settings of the current list:

   $list->update("moUx");

=cut

# update the "normal" (=not related to encryption) settings of the list
sub update {
	my $self = shift;
	my $options = shift;

	my ($result);

	
	# restore the ususal ezmlm-idx config file (for v0.4xx)
	&_enable_plaintext_config_file($self->thislist());
	# let ezmlm-make do the setup
	$result = $self->SUPER::update($options);
	# restore the gpg-ezmlm config file
	&_enable_encryption_config_file($self->thislist());
	# "repair" the dotqmail files (use "gpg-ezmlm-send" instead of "ezmlm-send")
	&_cleanup_dotqmail_files($self->thislist());

	# return the result of the ezmlm-make run
	return $result;
}

# == Update the encryption settings of the current list ==

=head2 Updating the configuration of the current list:

   $list->update_special({ 'allowKeySubmission' => 1 });

=cut

# update the encryption specific settings
sub update_special {
	my ($self, %switches) = @_;
	my (%ok_switches, $one_key, @delete_switches);

	# check for important files: 'config'
	unless (_is_encrypted($self->thislist())) {
		$self->_seterror(-1, "Update failed: '" . $self->thislist()
				. "' does not appear to be a valid list");
		return undef;
	}

	@delete_switches = ();
	# check if all supplied settings are supported
	# btw we change the case (upper/lower) of the setting to the default one
	foreach $one_key (keys %switches) {
		my $ok_key;
		foreach $ok_key (@{$self->{SUPPORTED_OPTIONS}}) {
			# check the key case-insensitively
			if ($ok_key =~ /^$one_key$/i) {
				$ok_switches{$ok_key} = $switches{$one_key};
				push @delete_switches, $one_key;
			}
		}
	}
	# remove all keys, that were accepted above
	# we could not do it before, since this could cause issues with the current
	# "foreach" looping through the hash
	foreach $one_key (@delete_switches) {
		delete $switches{$one_key};
	}

	# %switches should be empty now
	if (%switches) {
		foreach $one_key (keys %switches) {
			warn "[GpgEzmlm] unsupported setting: $one_key";
		}
	}

	my $errorstring;
	my $config_file_old = $self->thislist() . "/config";
	my $config_file_new = $self->thislist() . "/config.new";
	my $gnupg_setting_found = (0==1);
	if (open(CONFIG_OLD, "<$config_file_old")) { 
		if (open(CONFIG_NEW, ">$config_file_new")) { 
			my ($in_line, $one_opt, $one_val, $new_setting);
			while (<CONFIG_OLD>) {
				$in_line = $_;
				$gnupg_setting_found = (0==0) if ($in_line =~ m/^\s*GnuPG\s+/i);
				if (%ok_switches) {
					my $found = 0;
					while (($one_opt, $one_val) = each(%ok_switches)) {
						# is this the right line (maybe commented out)?
						if ($in_line =~ m/^#?\s*$one_opt\s+/i) {
							print CONFIG_NEW _get_config_line($one_opt, $one_val);
							delete $ok_switches{$one_opt};
							$found = 1;
						}
					}
					print CONFIG_NEW $in_line if ($found == 0);
				} else {
					# just print the remaining config file if no other settings are left