view release on metacpan or  search on metacpan

lib/Mail/Salsa/Action/Admin.pm  view on Meta::CPAN

				$self->logs(join("", "[update error] from: ", $self->{'from'}), "list");
			} elsif(exists($result->{'files'})) {
				Mail::Salsa::Utils::tplsendmail(
					smtp_server => $self->{'smtp_server'},
					timeout     => $self->{'timeout'},
					label       => "UPDATED_FILES",
					lang        => $self->{'config'}->{'language'},
					vars        => {
						from  => "$name\-master\@$domain",
						to    => "$name\-owner\@$domain",
						files => $result->{'files'},
					}
				);
				$self->logs(join("", "[updated files] from: ", $self->{'from'}), "list");
			} else {
				$self->logs(join("", "[no admin files] from: ", $self->{'from'}), "list");
			}
		} else {
			Mail::Salsa::Utils::tplsendmail(
				smtp_server => $self->{'smtp_server'},
				timeout     => $self->{'timeout'},
				label       => "ADMINTICKET",
				lang        => $self->{'config'}->{'language'},
				vars        => {
					from => "$name\-master\@$domain",
					to   => "$name\-owner\@$domain",
				}
			);
			$self->logs(join("", "[wrong ticket] from: ", $self->{'from'}), "list");
		}
	} else {
		my $dir = join("/", $self->{'list_dir'}, $domain, $name);
        	unless(-d $dir) {
			Mail::Salsa::Utils::make_dir_rec($dir, 0755);
			(-d $dir) or die("$!");
		}
		my $list = $self->{'list'};
		(-e $files{'stamp.txt'} && -s $files{'stamp.txt'}) or create_file($files{'stamp.txt'}, join("", uc(generate_id(32)), "\n"), 0600);
		(-e $files{'ticket.txt'} && -s $files{'ticket.txt'}) or create_file($files{'ticket.txt'}, join("", uc(generate_id(32)), "\n"), 0600);
		(-e $files{'configuration.txt'} && -s $files{'configuration.txt'}) or create_file($files{'configuration.txt'}, &make_config(), 0600);
		(-e $files{'restrict.txt'} && -s $files{'restrict.txt'}) or create_file($files{'restrict.txt'}, "\# Add here the rules\n\# [allow|deny] [address|subscribers|any] to [post|bounce|proceed] \\\n\# from [localnet|anywhere] with(out) stamp\n\#\n\nallow ...
		(-e $files{'attachments.txt'} && -s $files{'attachments.txt'}) or create_file($files{'attachments.txt'}, "\# Insert here the acl rules.\n\#\n\# [allow|deny] mime/type from [address|domain|subscribers|any]\n\#\n\nallow any/any from any\n", 0600);
		(-e $files{'information.txt'} && -s $files{'information.txt'}) or create_file($files{'information.txt'}, "Please insert here the information about mailing list.\n", 0600);
		(-e $files{'header.txt'} && -s $files{'header.txt'}) or create_file($files{'header.txt'}, "Please remove this text and insert your own text header.\n", 0600);
		(-e $files{'footer.txt'} && -s $files{'footer.txt'}) or create_file($files{'footer.txt'}, "Please remove this text and insert your own text footer.\n", 0600);
		(-e $files{'list.txt'} && -s $files{'list.txt'}) or create_file($files{'list.txt'}, "\# Add here the addresses of the list\n", 0600);
		$self->sendmail(\%files);
		$self->logs(join("", "[send files to owner] from: ", $self->{'from'}), "list");
	}
	return();
}

sub normalize {
	local $_ = shift;

	if(/^($patterns[0]) +<($patterns[1])>\s+/) { return([lc($2), $1]); }
	if(/^<?($patterns[1])>?\s+/) { return([lc($1), ""]); }
	return(["", ""]);
}

sub update_file {
	my $newfile = shift;
	my $oldfile = shift;

	open(NEW, "<", $newfile) or die("$!");
	open(OLD, ">", $oldfile) or die("$!");
	select(OLD);
	while(<NEW>) {
		s/\x0d//g;
		print OLD $_;
	}
	close(OLD);
	close(NEW);

	unlink($newfile) or die("$!");
	return();
}

sub list2hash {
	my $file = shift;

	my @error = ();
	my $n = 1;
	open(FILE, "<", $file) or die("$!");
	while(<FILE>) {
		my ($addr, $name) = @{&normalize($_)};
		$addr ? ($_[0]->{$addr} = $name) : push(@error, "line $n: $_");
		$n++;
	}
	close(FILE);
	unlink($file) or die("$!");

	return(\@error);
}

sub update_list {
	my $list = shift;
	my $hash = shift;

	open(OLDLIST, "<", $list) or die("$!");
	open(NEWLIST, ">", "$list\.new") or die("$!");
	select(NEWLIST);
	while(<OLDLIST>) {
		my ($addr, $name) = @{&normalize($_)};
		$addr or next;
		if(exists($hash->{'unsubscribe'}->{$addr})) {
			delete($hash->{'unsubscribe'}->{$addr});
			next;
		}
		next if(exists($hash->{'subscribe'}->{$addr}));
		print NEWLIST $name ? "$name \<$addr\>" : "$addr", "\n";
	}
	while(my ($addr, $name) = each(%{$hash->{'subscribe'}})) {
		print NEWLIST $name ? "$name \<$addr\>" : "$addr", "\n";
	}
	close(NEWLIST);
	close(OLDLIST);

	rename("$list\.new", $list);
	return();
}

sub replace_list {
	my $newfile = shift;
	my $oldfile = shift;

	my %inserted = ();
	open(NEW, "<", $newfile) or die("$!");
	open(OLD, ">", $oldfile) or die("$!");
	select(OLD);
	while(<NEW>) {
		if(/^\#/) { print OLD $_; next; }
		/[\x0d\x0a]+$/ or $_ .= "\n" if(eof(NEW));
		my ($addr, $name) = @{&normalize($_)};
		$addr or next;
		next if(exists($inserted{$addr}));
		print OLD $name ? "$name <$addr>" : $addr, "\n";
		$inserted{$addr} = "";
	}
	close(OLD);
	close(NEW);

	unlink($newfile) or die("$!");
	return();
}

sub check_confkeys {
	$_ = shift;

	/^title *\= *[^\=]{2,60}$/ and return(1);
	/^prefix *\= *[^\=]{2,30}$/ and return(1);
	/^language *\= *[a-z][a-z]$/ and return(1);
	/^max_message_size *\= *(\d{1,9})$/ and $1 > -1 and return(1);
	/^subscribe *\= *[yn]$/ and return(1);
	/^unsubscribe *\= *[yn]$/ and return(1);
	/^archive *\= *[yn]$/ and return(1);