qtool.pl

< linux网络编程工具>>配套源码

		return "Unable to delete $self->{file_name}: $!";
	}
	return undef;
}


##
## DATA_FILE - Represents a sendmail queue data file.
##
##	This object represents represents a sendmail queue data file.
##	It is really just a place-holder.
##

package DataFile;

sub new
{
	my $this = shift;
	my $class = ref($this) || $this;
	my $self = {};
	bless $self, $class;
	$self->initialize(@_);
	return $self;
}

sub initialize
{
	my $self = shift;
	my $queue_dir = shift;
	$self->{id} = shift;

	$self->{file_name} = $queue_dir . '/df' . $self->{id};
}

sub do_stat
{
	my $self = shift;
	my $result;
	my @result;

	$result = open(QUEUE_FILE, $self->{file_name});
	if (!$result)
	{
		return "Unable to open '$self->{file_name}': $!";
	}
	@result = stat(QUEUE_FILE);
	if (!@result)
	{
		return "Unable to stat '$self->{file_name}': $!";
	}
	$self->{body_size} = $result[7];
	$self->{body_last_mod_time} = $result[9];
}

sub delete
{
	my $self = shift;
	my $result;

	$result = unlink($self->{file_name});
	if (!$result)
	{
		return "Unable to delete $self->{file_name}: $!";
	}
	return undef;
}


##
## QUEUED_MESSAGE - Represents a queued sendmail message.
##
##	This keeps track of the files that make up a queued sendmail 
##	message.
##	Currently it has 'control_file' and 'data_file' as members.
##
##	You can tie it to a fetch only hash using tie. You need to
##	pass a reference to a QueuedMessage as the third argument
##	to tie.
##

package QueuedMessage;

sub new
{
	my $this = shift;
	my $class = ref($this) || $this;
	my $self = {};
	bless $self, $class;
	$self->initialize(@_);
	return $self;
}

sub initialize
{
	my $self = shift;
	my $queue_dir = shift;
	my $id = shift;
	my $data_dir = shift;

	$self->{id} = $id;
	$self->{control_file} = new ControlFile($queue_dir, $id);
	if ($data_dir)
	{
		$self->{data_file} = new DataFile($data_dir, $id);
	}
	else
	{
		$self->{data_file} = new DataFile($queue_dir, $id);
	}
}

sub last_modified_time
{
	my $self = shift;
	my @result;
	@result = stat($self->{data_file}->{file_name});
	return $result[9];
}

sub TIEHASH
{
	my $this = shift;
	my $class = ref($this) || $this;
	my $self = shift;
	return $self;
}

sub FETCH
{
	my $self = shift;
	my $key = shift;

	if (exists $self->{control_file}->{$key})
	{
		return $self->{control_file}->{$key};
	}
	if (exists $self->{data_file}->{$key})
	{
		return $self->{data_file}->{$key};
	}

	return undef;
}

sub lock
{
	my $self = shift;

	return $self->{control_file}->lock();
}

sub unlock
{
	my $self = shift;

	return $self->{control_file}->unlock();
}

sub move
{
	my $self = shift;
	my $destination = shift;
	my $df_dest;
	my $qf_dest;
	my $result;

	$result = $self->lock();
	if ($result)
	{
		return $result;
	}

	$qf_dest = File::Spec->catfile($destination, "qf");
	if (-d $qf_dest)
	{
		$df_dest = File::Spec->catfile($destination, "df");
		if (!-d $df_dest)
		{
			$df_dest = $destination;
		}
	}
	else
	{
		$qf_dest = $destination;
		$df_dest = $destination;
	}

	if (-e File::Spec->catfile($qf_dest, "qf$self->{id}"))
	{
		$result = "There is already a queued message with id '$self->{id}' in '$destination'";
	}

	if (!$result)
	{
		$result = ::move_file($self->{data_file}->{file_name}, 
				      $df_dest);
	}

	if (!$result)
	{
		$result = ::move_file($self->{control_file}->{file_name}, 
				      $qf_dest);
	}

	$self->unlock();

	return $result;
}

sub parse
{
	my $self = shift;

	return $self->{control_file}->parse();
}

sub do_stat
{
	my $self = shift;

	$self->{control_file}->do_stat();
	$self->{data_file}->do_stat();
}

sub setup_vars
{
	my $self = shift;

	$self->parse();
	$self->do_stat();
}

sub delete
{
	my $self = shift;
	my $result;

	$result = $self->{control_file}->delete();
	if ($result)
	{
		return $result;
	}
	$result = $self->{data_file}->delete();
	if ($result)
	{
		return $result;
	}

	return undef;
}

sub bounce
{
	my $self = shift;
	my $command;

	$command = "sendmail -qI$self->{id} -O Timeout.queuereturn=now";
#	print("$command\n");
	system($command);
}

##
## QUEUE - Represents a queued sendmail queue.
##
##	This manages all of the messages in a queue.
##

package Queue;

sub new
{
	my $this = shift;
	my $class = ref($this) || $this;
	my $self = {};
	bless $self, $class;
	$self->initialize(@_);
	return $self;
}

sub initialize
{
	my $self = shift;

	$self->{queue_dir} = shift;
	$self->{files} = {};
}

##
## READ - Loads the queue with all of the objects that reside in it.
##
##	This reads the queue's directory and creates QueuedMessage objects
## 	for every file in the queue that starts with 'qf'.
##

sub read
{
	my $self = shift;
	my @control_files;
	my $queued_message;
	my $file_name;
	my $id;
	my $result;
	my $control_dir;
	my $data_dir;

	$control_dir = File::Spec->catfile($self->{queue_dir}, 'qf');

	if (-e $control_dir)
	{
		$data_dir = File::Spec->catfile($self->{queue_dir}, 'df');
		if (!-e $data_dir)
		{
			$data_dir = $self->{queue_dir};
		}
	}
	else
	{
		$data_dir = $self->{queue_dir};
		$control_dir = $self->{queue_dir};
	}

	$result = opendir(QUEUE_DIR, $control_dir);
	if (!$result)
	{
		return "Unable to open directory '$control_dir'";
	}

	@control_files = grep { /^qf.*/ && -f "$control_dir/$_" } readdir(QUEUE_DIR);
	closedir(QUEUE_DIR);
	foreach $file_name (@control_files)
	{
		$id = substr($file_name, 2);
		$queued_message = new QueuedMessage($control_dir, $id, 
						    $data_dir);
		$self->{files}->{$id} = $queued_message;
	}

	return undef;
}


##
## ADD_QUEUED_MESSAGE - Adds a QueuedMessage to this Queue.
##
##	Adds the QueuedMessage object to the hash and moves the files
##	associated with the QueuedMessage to this Queue's directory.
##

sub add_queued_message
{
	my $self = shift;
	my $queued_message = shift;
	my $result;

	$result = $queued_message->move($self->{queue_dir});
	if ($result)
	{
		return $result;
	}

	$self->{files}->{$queued_message->{id}} = $queued_message;

	return $result;
}

##
## ADD_QUEUE - Adds another Queue's QueuedMessages to this Queue.
##
##	Adds all of the QueuedMessage objects in the passed in queue
##	to this queue.
##

sub add_queue
{
	my $self = shift;
	my $queue = shift;
	my $id;
	my $queued_message;
	my $result;

	while (($id, $queued_message) = each %{$queue->{files}})
	{
		$result = $self->add_queued_message($queued_message);
		if ($result)
		{
			print("$result.\n");
		}
	}
}

##
## ADD - Adds an item to this queue.
##
##	Adds either a Queue or a QueuedMessage to this Queue.
##

sub add
{
	my $self = shift;
	my $source = shift;
	my $type_name;
	my $result;

	$type_name = ref($source);

	if ($type_name eq "QueuedMessage")
	{
		return $self->add_queued_message($source);
	}

	if ($type_name eq "Queue")
	{
		return $self->add_queue($source);
	}

	return "Queue does not know how to add a '$type_name'"
}

sub delete
{
	my $self = shift;
	my $id;
	my $queued_message;

	while (($id, $queued_message) = each %{$self->{files}})
	{
		$result = $queued_message->delete();
		if ($result)
		{
			print("$result.\n");
		}
	}
}

sub bounce
{
	my $self = shift;
	my $id;
	my $queued_message;

	while (($id, $queued_message) = each %{$self->{files}})
	{
		$result = $queued_message->bounce();
		if ($result)
		{
			print("$result.\n");
		}
	}
}

##
## Condition Class
##
## 	This next section is for any class that has an interface called 
##	check_move(source, dest). Each class represents some condition to
##	check for to determine whether we should move the file from 
##	source to dest.
##


##
## OlderThan
##
##	This Condition Class checks the modification time of the
##	source file and returns true if the file's modification time is
##	older than the number of seconds the class was initialzed with.
##

package OlderThan;

sub new
{
	my $this = shift;
	my $class = ref($this) || $this;
	my $self = {};
	bless $self, $class;
	$self->initialize(@_);
	return $self;
}

sub initialize
{
	my $self = shift;

	$self->{age_in_seconds} = shift;
}

sub check_move
{
	my $self = shift;
	my $source = shift;

	if ((time() - $source->last_modified_time()) > $self->{age_in_seconds})
	{
		return 1;
	}

	return 0;
}

##
## Compound
##
##	Takes a list of Move Condition Classes. Check_move returns true
##	if every Condition Class in the list's check_move function returns
##	true.
##

package Compound;

sub new
{
	my $this = shift;
	my $class = ref($this) || $this;
	my $self = {};
	bless $self, $class;
	$self->initialize(@_);
	return $self;
}

sub initialize
{
	my $self = shift;

	$self->{condition_list} = [];
}

sub add
{
	my $self = shift;
	my $new_condition = shift;

	push(@{$self->{condition_list}}, $new_condition);
}

sub check_move
{
	my $self = shift;
	my $source = shift;
	my $dest = shift;
	my $condition;
	my $result;

	foreach $condition (@{$self->{condition_list}})
	{
		if (!$condition->check_move($source, $dest))
		{
			return 0;
		}
	}
	
	return 1;
}

##
## Eval
##
##	Takes a perl expression and evaluates it. The ControlFile object
##	for the source QueuedMessage is avaliable through the name '$msg'.
##

package Eval;

sub new
{
	my $this = shift;
	my $class = ref($this) || $this;
	my $self = {};
	bless $self, $class;
	$self->initialize(@_);
	return $self;
}

sub initialize
{
	my $self = shift;

	$self->{expression} = shift;
}

sub check_move
{
	my $self = shift;
	my $source = shift;
	my $dest = shift;
	my $result;
	my %msg;

	$source->setup_vars();
	tie(%msg, 'QueuedMessage', $source);
	$result = eval($self->{expression});

	return $result;
}