qtool.pl revision 64562
1178481Sjb#!/usr/bin/env perl 2178481Sjb## 3178481Sjb## Copyright (c) 1998, 1999 Sendmail, Inc. and its suppliers. 4178481Sjb## All rights reserved. 5178481Sjb## 6178481Sjb## $Id: qtool.pl,v 8.15.16.1 2000/04/25 03:44:31 gshapiro Exp $ 7178481Sjb## 8178481Sjbuse strict; 9178481Sjbuse File::Basename; 10178481Sjbuse File::Copy; 11178481Sjbuse File::Spec; 12178481Sjbuse Fcntl qw(:flock :DEFAULT); 13178481Sjbuse Getopt::Std; 14178481Sjb 15178481Sjb## 16178481Sjb## QTOOL 17178481Sjb## This program is for moving files between sendmail queues. It is 18178481Sjb## pretty similar to just moving the files manually, but it locks the files 19178481Sjb## the same way sendmail does to prevent problems. 20178481Sjb## 21178481Sjb## The syntax is the reverse of mv (ie. the target argument comes 22178481Sjb## first). This lets you pick the files you want to move using find and 23178481Sjb## xargs. 24178481Sjb## 25178481Sjb## Since you cannot delete queues while sendmail is running, QTOOL 26178481Sjb## assumes that when you specify a directory as a source, you mean that you 27178481Sjb## want all of the queue files within that directory moved, not the 28178481Sjb## directory itself. 29178481Sjb## 30178481Sjb## There is a mechanism for adding conditionals for moving the files. 31178481Sjb## Just create an Object with a check_move(source, dest) method and add it 32178481Sjb## to the $conditions object. See the handling of the '-s' option for an 33178481Sjb## example. 34178481Sjb## 35178481Sjb 36178481Sjb## 37178481Sjb## OPTION NOTES 38178481Sjb## 39178481Sjb## The -e option: 40178481Sjb## The -e option takes any valid perl expression and evaluates it 41178481Sjb## using the eval() function. Inside the expression the variable 42178481Sjb## '$msg' is bound to the ControlFile object for the current source 43178481Sjb## queue message. This lets you check for any value in the message 44178481Sjb## headers or the control file. Here's an example: 45178481Sjb## 46178481Sjb## ./qtool.pl -e '$msg->{num_delivery_attempts} >= 2' /q1 /q2 47178481Sjb## 48178481Sjb## This would move any queue files whose number of delivery attempts 49178481Sjb## is greater than or equal to 2 from the queue 'q2' to the queue 'q1'. 50178546Sjb## 51178481Sjb## See the function ControlFile::parse for a list of available 52178481Sjb## variables. 53178481Sjb## 54178481Sjb 55178481Sjbmy %opts; 56178481Sjbmy %sources; 57178481Sjbmy $dst_name; 58178481Sjbmy $destination; 59178481Sjbmy $source_name; 60178481Sjbmy $source; 61178481Sjbmy $result; 62178546Sjbmy $action; 63178481Sjbmy $new_condition; 64178481Sjbmy $conditions = new Compound(); 65178481Sjb 66178481SjbGetopt::Std::getopts('bde:s:', \%opts); 67178481Sjb 68178481Sjbsub move_action 69178481Sjb{ 70178481Sjb my $source = shift; 71178481Sjb my $destination = shift; 72178481Sjb 73178481Sjb $result = $destination->add($source); 74178481Sjb if ($result) 75178481Sjb { 76178481Sjb print("$result.\n"); 77178481Sjb } 78178481Sjb} 79178481Sjb 80178481Sjbsub delete_action 81178481Sjb{ 82178546Sjb my $source = shift; 83178481Sjb 84178481Sjb return $source->delete(); 85178481Sjb} 86178481Sjb 87178481Sjbsub bounce_action 88178481Sjb{ 89178481Sjb my $source = shift; 90178481Sjb 91178481Sjb return $source->bounce(); 92178481Sjb} 93178481Sjb 94178481Sjb$action = \&move_action; 95178481Sjbif (defined $opts{d}) 96178481Sjb{ 97178481Sjb $action = \&delete_action; 98178481Sjb} 99178481Sjbelsif (defined $opts{b}) 100178481Sjb{ 101178481Sjb $action = \&bounce_action; 102178481Sjb} 103178481Sjb 104178481Sjbif (defined $opts{s}) 105178481Sjb{ 106178481Sjb $new_condition = new OlderThan($opts{s}); 107178481Sjb $conditions->add($new_condition); 108178481Sjb} 109178481Sjb 110178481Sjbif (defined $opts{e}) 111178481Sjb{ 112178481Sjb $new_condition = new Eval($opts{e}); 113178481Sjb $conditions->add($new_condition); 114178481Sjb} 115178481Sjb 116178481Sjbif ($action == \&move_action) 117178481Sjb{ 118178481Sjb $dst_name = shift(@ARGV); 119178481Sjb if (!-d $dst_name) 120178481Sjb { 121178481Sjb print("The destination '$dst_name' must be an existing " . 122178481Sjb "directory.\n"); 123178481Sjb usage(); 124178481Sjb exit; 125178481Sjb } 126178481Sjb $destination = new Queue($dst_name); 127178481Sjb} 128178481Sjb 129178481Sjbwhile (@ARGV) 130178481Sjb{ 131178481Sjb $source_name = shift(@ARGV); 132178481Sjb $result = add_source(\%sources, $source_name); 133178481Sjb if ($result) 134178481Sjb { 135178481Sjb print("$result.\n"); 136178481Sjb } 137178481Sjb} 138178481Sjb 139178481Sjbif (keys(%sources) == 0) 140178481Sjb{ 141178481Sjb print("You must at least specify at least one source.\n"); 142178481Sjb usage(); 143178481Sjb exit; 144178481Sjb} 145178481Sjb 146178481Sjbwhile (($source_name, $source) = each(%sources)) 147178481Sjb{ 148178481Sjb $result = $conditions->check_move($source, $destination); 149178481Sjb if ($result) 150178481Sjb { 151178481Sjb $result = &{$action}($source, $destination); 152178481Sjb if ($result) 153178481Sjb { 154178481Sjb print("$result\n"); 155178481Sjb } 156178481Sjb } 157178481Sjb} 158178481Sjb 159178481Sjbsub usage 160178481Sjb{ 161178481Sjb print("Usage: $0 [options] directory source ...\n"); 162178481Sjb print(" $0 [-d|-b] source ...\n"); 163178481Sjb print("options:\n"); 164178481Sjb print(" -b Bounce the messages specified by source.\n"); 165178481Sjb print(" -d Delete the messages specified by source.\n"); 166178481Sjb print(" -e [perl expression] Move only messages for which perl expression returns true.\n"); 167178481Sjb print(" -s [seconds] Move only messages older than seconds.\n"); 168178481Sjb} 169178481Sjb 170178481Sjb## 171178481Sjb## ADD_SOURCE -- Adds a source to the source hash. 172178481Sjb## 173178481Sjb## Determines whether source is a file, directory, or id. Then it 174178481Sjb## creates a QueuedMessage or Queue for that source and adds it to the 175178481Sjb## list. 176178481Sjb## 177178546Sjb## Parameters: 178178481Sjb## sources -- A hash that contains all of the sources. 179178481Sjb## source_name -- The name of the source to add 180178481Sjb## 181178481Sjb## Returns: 182178481Sjb## error_string -- Undef if ok. Error string otherwise. 183178481Sjb## 184178481Sjb## Notes: 185178481Sjb## If a new source comes in with the same ID as a previous 186178481Sjb## source, the previous source gets overwritten in the sources 187178481Sjb## hash. This lets the user specify things like * and it still 188178481Sjb## works nicely. 189178481Sjb## 190178481Sjb 191178481Sjbsub add_source 192178481Sjb{ 193178481Sjb my $sources = shift; 194178481Sjb my $source_name = shift; 195178481Sjb my $source_base_name; 196178481Sjb my $source_dir_name; 197178481Sjb my $data_dir_name; 198178481Sjb my $source_id; 199178481Sjb my $source_prefix; 200178481Sjb my $queued_message; 201178481Sjb my $queue; 202178481Sjb my $result; 203178546Sjb 204178481Sjb ($source_base_name, $source_dir_name) = File::Basename::fileparse($source_name); 205178481Sjb $data_dir_name = $source_dir_name; 206178481Sjb 207178481Sjb $source_prefix = substr($source_base_name, 0, 2); 208178481Sjb if (!-d $source_name && $source_prefix ne 'qf' && 209178481Sjb $source_prefix ne 'df') 210178481Sjb { 211178481Sjb $source_base_name = "qf$source_base_name"; 212178481Sjb $source_name = File::Spec->catfile("$source_dir_name", 213178481Sjb "$source_base_name"); 214178481Sjb } 215178481Sjb $source_id = substr($source_base_name, 2); 216178481Sjb 217178481Sjb if (!-e $source_name) 218178481Sjb { 219178481Sjb $source_name = File::Spec->catfile("$source_dir_name", "qf", 220178481Sjb "qf$source_id"); 221178481Sjb if (!-e $source_name) 222178481Sjb { 223178481Sjb return "'$source_name' does not exist"; 224178481Sjb } 225178481Sjb $data_dir_name = File::Spec->catfile("$source_dir_name", "df"); 226178481Sjb $source_dir_name = File::Spec->catfile("$source_dir_name", 227178481Sjb "qf"); 228178481Sjb } 229178481Sjb 230178481Sjb if (-f $source_name) 231178481Sjb { 232178481Sjb $queued_message = new QueuedMessage($source_dir_name, 233178481Sjb $source_id, 234178481Sjb $data_dir_name); 235178481Sjb $sources->{$source_id} = $queued_message; 236178481Sjb return undef; 237178481Sjb } 238178481Sjb 239178481Sjb if (!-d $source_name) 240178481Sjb { 241178481Sjb return "'$source_name' is not a plain file or a directory"; 242178481Sjb } 243178481Sjb 244178481Sjb $queue = new Queue($source_name); 245178481Sjb $result = $queue->read(); 246178481Sjb if ($result) 247178481Sjb { 248178481Sjb return $result; 249178481Sjb } 250178481Sjb 251178481Sjb while (($source_id, $queued_message) = each(%{$queue->{files}})) 252178481Sjb { 253178481Sjb $sources->{$source_id} = $queued_message; 254178481Sjb } 255178481Sjb 256178481Sjb return undef; 257178481Sjb} 258178546Sjb 259178481Sjb## 260178481Sjb## LOCK_FILE -- Opens and then locks a file. 261178481Sjb## 262178481Sjb## Opens a file for read/write and uses flock to obtain a lock on the 263178481Sjb## file. The flock is Perl's flock which defaults to flock on systems 264178481Sjb## that support it. On systems without flock it falls back to fcntl 265178481Sjb## locking. 266178481Sjb## 267178481Sjb## Parameters: 268178481Sjb## file_name -- The name of the file to open and lock. 269178481Sjb## 270178481Sjb## Returns: 271178481Sjb## (file_handle, error_string) -- If everything works then 272178481Sjb## file_handle is a reference to a file handle and 273178481Sjb## error_string is undef. If there is a problem then 274178481Sjb## file_handle is undef and error_string is a string 275178481Sjb## explaining the problem. 276178481Sjb## 277178481Sjb 278178481Sjbsub lock_file 279178481Sjb{ 280178481Sjb my $file_name = shift; 281178481Sjb my $result; 282178481Sjb 283178481Sjb $result = sysopen(FILE_TO_LOCK, $file_name, Fcntl::O_RDWR); 284178481Sjb if (!$result) 285178481Sjb { 286178481Sjb return (undef, "Unable to open '$file_name': $!"); 287178481Sjb } 288178481Sjb 289178481Sjb $result = flock(FILE_TO_LOCK, Fcntl::LOCK_EX | Fcntl::LOCK_NB); 290178481Sjb if (!$result) 291178481Sjb { 292178481Sjb return (undef, "Could not obtain lock on '$file_name': $!"); 293178481Sjb } 294178481Sjb 295178481Sjb return (\*FILE_TO_LOCK, undef); 296178481Sjb} 297178481Sjb 298178481Sjb## 299178481Sjb## UNLOCK_FILE -- Unlocks a file. 300178481Sjb## 301178481Sjb## Unlocks a file using Perl's flock. 302178481Sjb## 303178481Sjb## Parameters: 304178481Sjb## file -- A file handle. 305178481Sjb## 306178481Sjb## Returns: 307178481Sjb## error_string -- If undef then no problem. Otherwise it is a 308178481Sjb## string that explains problem. 309178481Sjb## 310178481Sjb 311178481Sjbsub unlock_file 312178481Sjb{ 313178481Sjb my $file = shift; 314178481Sjb my $result; 315178481Sjb 316178481Sjb $result = flock($file, Fcntl::LOCK_UN); 317178481Sjb if (!$result) 318178481Sjb { 319178481Sjb return "Unlock failed on '$result': $!"; 320178481Sjb } 321178481Sjb 322178481Sjb return undef; 323178481Sjb} 324178481Sjb 325178481Sjb## 326178481Sjb## MOVE_FILE -- Moves a file. 327178481Sjb## 328178481Sjb## Moves a file. 329178481Sjb## 330178481Sjb## Parameters: 331178481Sjb## src_name -- The name of the file to be move. 332178481Sjb## dst_nome -- The name of the place to move it to. 333178481Sjb## 334178481Sjb## Returns: 335178481Sjb## error_string -- If undef then no problem. Otherwise it is a 336178481Sjb## string that explains problem. 337178481Sjb## 338178481Sjb 339178481Sjbsub move_file 340178481Sjb{ 341178481Sjb my $src_name = shift; 342178481Sjb my $dst_name = shift; 343178481Sjb my $result; 344178481Sjb 345178481Sjb $result = File::Copy::move($src_name, $dst_name); 346178481Sjb if (!$result) 347178481Sjb { 348178481Sjb return "File move from '$src_name' to '$dst_name' failed: $!"; 349178481Sjb } 350178481Sjb 351178481Sjb return undef; 352178481Sjb} 353178481Sjb 354178481Sjb 355178481Sjb## 356178481Sjb## CONTROL_FILE - Represents a sendmail queue control file. 357178481Sjb## 358178481Sjb## This object represents represents a sendmail queue control file. 359178481Sjb## It can parse and lock its file. 360178481Sjb## 361178481Sjb 362178481Sjb 363178481Sjbpackage ControlFile; 364178481Sjb 365178481Sjbsub new 366178481Sjb{ 367178481Sjb my $this = shift; 368178481Sjb my $class = ref($this) || $this; 369178481Sjb my $self = {}; 370178481Sjb bless $self, $class; 371178481Sjb $self->initialize(@_); 372178481Sjb return $self; 373178481Sjb} 374178481Sjb 375178481Sjbsub initialize 376178481Sjb{ 377178481Sjb my $self = shift; 378178481Sjb my $queue_dir = shift; 379178481Sjb $self->{id} = shift; 380178481Sjb 381178481Sjb $self->{file_name} = $queue_dir . '/qf' . $self->{id}; 382 $self->{headers} = {}; 383} 384 385## 386## PARSE - Parses the control file. 387## 388## Parses the control file. It just sticks each entry into a hash. 389## If a key has more than one entry, then it points to a list of 390## entries. 391## 392 393sub parse 394{ 395 my $self = shift; 396 if ($self->{parsed}) 397 { 398 return; 399 } 400 my %parse_table = 401 ( 402 'A' => 'auth', 403 'B' => 'body_type', 404 'C' => 'controlling_user', 405 'D' => 'data_file_name', 406 'E' => 'error_recipient', 407 'F' => 'flags', 408 'H' => 'parse_header', 409 'I' => 'inode_number', 410 'K' => 'next_delivery_time', 411 'L' => 'content-length', 412 'M' => 'message', 413 'N' => 'num_delivery_attempts', 414 'P' => 'priority', 415 'Q' => 'original_recipient', 416 'R' => 'recipient', 417 'S' => 'sender', 418 'T' => 'creation_time', 419 'V' => 'version', 420 'X' => 'charset', 421 'Z' => 'envid', 422 '$' => 'macro' 423 ); 424 my $line; 425 my $line_type; 426 my $line_value; 427 my $member_name; 428 my $member; 429 my $last_type; 430 431 open(CONTROL_FILE, "$self->{file_name}"); 432 while ($line = <CONTROL_FILE>) 433 { 434 $line_type = substr($line, 0, 1); 435 if ($line_type eq "\t" && $last_type eq 'H') 436 { 437 $line_type = 'H'; 438 $line_value = $line; 439 } 440 else 441 { 442 $line_value = substr($line, 1); 443 } 444 $member_name = $parse_table{$line_type}; 445 $last_type = $line_type; 446 if (!$member_name) 447 { 448 $member_name = 'unknown'; 449 } 450 if ($self->can($member_name)) 451 { 452 $self->$member_name($line_value); 453 } 454 $member = $self->{$member_name}; 455 if (!$member) 456 { 457 $self->{$member_name} = $line_value; 458 next; 459 } 460 if (ref($member) eq 'ARRAY') 461 { 462 push(@{$member}, $line_value); 463 next; 464 } 465 $self->{$member_name} = [$member, $line_value]; 466 } 467 close(CONTROL_FILE); 468 469 $self->{parsed} = 1; 470} 471 472sub parse_header 473{ 474 my $self = shift; 475 my $line = shift; 476 my $headers = $self->{headers}; 477 my $last_header = $self->{last_header}; 478 my $header_name; 479 my $header_value; 480 my $first_char; 481 482 $first_char = substr($line, 0, 1); 483 if ($first_char eq "?") 484 { 485 $line = substr($line, 3); 486 } 487 elsif ($first_char eq "\t") 488 { 489 if (ref($headers->{$last_header}) eq 'ARRAY') 490 { 491 $headers->{$last_header}[-1] = 492 $headers->{$last_header}[-1] . $line; 493 } 494 else 495 { 496 $headers->{$last_header} = $headers->{$last_header} . 497 $line; 498 } 499 return; 500 } 501 ($header_name, $header_value) = split(/:/, $line, 2); 502 $self->{last_header} = $header_name; 503 if (exists $headers->{$header_name}) 504 { 505 $headers->{$header_name} = [$headers->{$header_name}, 506 $header_value]; 507 } 508 else 509 { 510 $headers->{$header_name} = $header_value; 511 } 512} 513 514sub is_locked 515{ 516 my $self = shift; 517 518 return (defined $self->{lock_handle}); 519} 520 521sub lock 522{ 523 my $self = shift; 524 my $lock_handle; 525 my $result; 526 527 if ($self->is_locked()) 528 { 529 # Already locked 530 return undef; 531 } 532 533 ($lock_handle, $result) = ::lock_file($self->{file_name}); 534 if (!$lock_handle) 535 { 536 return $result; 537 } 538 539 $self->{lock_handle} = $lock_handle; 540 541 return undef; 542} 543 544sub unlock 545{ 546 my $self = shift; 547 my $result; 548 549 if (!$self->is_locked()) 550 { 551 # Not locked 552 return undef; 553 } 554 555 $result = ::unlock_file($self->{lock_handle}); 556 557 $self->{lock_handle} = undef; 558 559 return $result; 560} 561 562sub do_stat 563{ 564 my $self = shift; 565 my $result; 566 my @result; 567 568 $result = open(QUEUE_FILE, $self->{file_name}); 569 if (!$result) 570 { 571 return "Unable to open '$self->{file_name}': $!"; 572 } 573 @result = stat(QUEUE_FILE); 574 if (!@result) 575 { 576 return "Unable to stat '$self->{file_name}': $!"; 577 } 578 $self->{control_size} = $result[7]; 579 $self->{control_last_mod_time} = $result[9]; 580} 581 582sub DESTROY 583{ 584 my $self = shift; 585 586 $self->unlock(); 587} 588 589sub delete 590{ 591 my $self = shift; 592 my $result; 593 594 $result = unlink($self->{file_name}); 595 if (!$result) 596 { 597 return "Unable to delete $self->{file_name}: $!"; 598 } 599 return undef; 600} 601 602 603## 604## DATA_FILE - Represents a sendmail queue data file. 605## 606## This object represents represents a sendmail queue data file. 607## It is really just a place-holder. 608## 609 610package DataFile; 611 612sub new 613{ 614 my $this = shift; 615 my $class = ref($this) || $this; 616 my $self = {}; 617 bless $self, $class; 618 $self->initialize(@_); 619 return $self; 620} 621 622sub initialize 623{ 624 my $self = shift; 625 my $queue_dir = shift; 626 $self->{id} = shift; 627 628 $self->{file_name} = $queue_dir . '/df' . $self->{id}; 629} 630 631sub do_stat 632{ 633 my $self = shift; 634 my $result; 635 my @result; 636 637 $result = open(QUEUE_FILE, $self->{file_name}); 638 if (!$result) 639 { 640 return "Unable to open '$self->{file_name}': $!"; 641 } 642 @result = stat(QUEUE_FILE); 643 if (!@result) 644 { 645 return "Unable to stat '$self->{file_name}': $!"; 646 } 647 $self->{body_size} = $result[7]; 648 $self->{body_last_mod_time} = $result[9]; 649} 650 651sub delete 652{ 653 my $self = shift; 654 my $result; 655 656 $result = unlink($self->{file_name}); 657 if (!$result) 658 { 659 return "Unable to delete $self->{file_name}: $!"; 660 } 661 return undef; 662} 663 664 665## 666## QUEUED_MESSAGE - Represents a queued sendmail message. 667## 668## This keeps track of the files that make up a queued sendmail 669## message. 670## Currently it has 'control_file' and 'data_file' as members. 671## 672## You can tie it to a fetch only hash using tie. You need to 673## pass a reference to a QueuedMessage as the third argument 674## to tie. 675## 676 677package QueuedMessage; 678 679sub new 680{ 681 my $this = shift; 682 my $class = ref($this) || $this; 683 my $self = {}; 684 bless $self, $class; 685 $self->initialize(@_); 686 return $self; 687} 688 689sub initialize 690{ 691 my $self = shift; 692 my $queue_dir = shift; 693 my $id = shift; 694 my $data_dir = shift; 695 696 $self->{id} = $id; 697 $self->{control_file} = new ControlFile($queue_dir, $id); 698 if ($data_dir) 699 { 700 $self->{data_file} = new DataFile($data_dir, $id); 701 } 702 else 703 { 704 $self->{data_file} = new DataFile($queue_dir, $id); 705 } 706} 707 708sub last_modified_time 709{ 710 my $self = shift; 711 my @result; 712 @result = stat($self->{data_file}->{file_name}); 713 return $result[9]; 714} 715 716sub TIEHASH 717{ 718 my $this = shift; 719 my $class = ref($this) || $this; 720 my $self = shift; 721 return $self; 722} 723 724sub FETCH 725{ 726 my $self = shift; 727 my $key = shift; 728 729 if (exists $self->{control_file}->{$key}) 730 { 731 return $self->{control_file}->{$key}; 732 } 733 if (exists $self->{data_file}->{$key}) 734 { 735 return $self->{data_file}->{$key}; 736 } 737 738 return undef; 739} 740 741sub lock 742{ 743 my $self = shift; 744 745 return $self->{control_file}->lock(); 746} 747 748sub unlock 749{ 750 my $self = shift; 751 752 return $self->{control_file}->unlock(); 753} 754 755sub move 756{ 757 my $self = shift; 758 my $destination = shift; 759 my $df_dest; 760 my $qf_dest; 761 my $result; 762 763 $result = $self->lock(); 764 if ($result) 765 { 766 return $result; 767 } 768 769 $qf_dest = File::Spec->catfile($destination, "qf"); 770 if (-d $qf_dest) 771 { 772 $df_dest = File::Spec->catfile($destination, "df"); 773 if (!-d $df_dest) 774 { 775 $df_dest = $destination; 776 } 777 } 778 else 779 { 780 $qf_dest = $destination; 781 $df_dest = $destination; 782 } 783 784 if (-e File::Spec->catfile($qf_dest, "qf$self->{id}")) 785 { 786 $result = "There is already a queued message with id '$self->{id}' in '$destination'"; 787 } 788 789 if (!$result) 790 { 791 $result = ::move_file($self->{data_file}->{file_name}, 792 $df_dest); 793 } 794 795 if (!$result) 796 { 797 $result = ::move_file($self->{control_file}->{file_name}, 798 $qf_dest); 799 } 800 801 $self->unlock(); 802 803 return $result; 804} 805 806sub parse 807{ 808 my $self = shift; 809 810 return $self->{control_file}->parse(); 811} 812 813sub do_stat 814{ 815 my $self = shift; 816 817 $self->{control_file}->do_stat(); 818 $self->{data_file}->do_stat(); 819} 820 821sub setup_vars 822{ 823 my $self = shift; 824 825 $self->parse(); 826 $self->do_stat(); 827} 828 829sub delete 830{ 831 my $self = shift; 832 my $result; 833 834 $result = $self->{control_file}->delete(); 835 if ($result) 836 { 837 return $result; 838 } 839 $result = $self->{data_file}->delete(); 840 if ($result) 841 { 842 return $result; 843 } 844 845 return undef; 846} 847 848sub bounce 849{ 850 my $self = shift; 851 my $command; 852 853 $command = "sendmail -qI$self->{id} -O Timeout.queuereturn=now"; 854# print("$command\n"); 855 system($command); 856} 857 858## 859## QUEUE - Represents a queued sendmail queue. 860## 861## This manages all of the messages in a queue. 862## 863 864package Queue; 865 866sub new 867{ 868 my $this = shift; 869 my $class = ref($this) || $this; 870 my $self = {}; 871 bless $self, $class; 872 $self->initialize(@_); 873 return $self; 874} 875 876sub initialize 877{ 878 my $self = shift; 879 880 $self->{queue_dir} = shift; 881 $self->{files} = {}; 882} 883 884## 885## READ - Loads the queue with all of the objects that reside in it. 886## 887## This reads the queue's directory and creates QueuedMessage objects 888## for every file in the queue that starts with 'qf'. 889## 890 891sub read 892{ 893 my $self = shift; 894 my @control_files; 895 my $queued_message; 896 my $file_name; 897 my $id; 898 my $result; 899 my $control_dir; 900 my $data_dir; 901 902 $control_dir = File::Spec->catfile($self->{queue_dir}, 'qf'); 903 904 if (-e $control_dir) 905 { 906 $data_dir = File::Spec->catfile($self->{queue_dir}, 'df'); 907 if (!-e $data_dir) 908 { 909 $data_dir = $self->{queue_dir}; 910 } 911 } 912 else 913 { 914 $data_dir = $self->{queue_dir}; 915 $control_dir = $self->{queue_dir}; 916 } 917 918 $result = opendir(QUEUE_DIR, $control_dir); 919 if (!$result) 920 { 921 return "Unable to open directory '$control_dir'"; 922 } 923 924 @control_files = grep { /^qf.*/ && -f "$control_dir/$_" } readdir(QUEUE_DIR); 925 closedir(QUEUE_DIR); 926 foreach $file_name (@control_files) 927 { 928 $id = substr($file_name, 2); 929 $queued_message = new QueuedMessage($control_dir, $id, 930 $data_dir); 931 $self->{files}->{$id} = $queued_message; 932 } 933 934 return undef; 935} 936 937 938## 939## ADD_QUEUED_MESSAGE - Adds a QueuedMessage to this Queue. 940## 941## Adds the QueuedMessage object to the hash and moves the files 942## associated with the QueuedMessage to this Queue's directory. 943## 944 945sub add_queued_message 946{ 947 my $self = shift; 948 my $queued_message = shift; 949 my $result; 950 951 $result = $queued_message->move($self->{queue_dir}); 952 if ($result) 953 { 954 return $result; 955 } 956 957 $self->{files}->{$queued_message->{id}} = $queued_message; 958 959 return $result; 960} 961 962## 963## ADD_QUEUE - Adds another Queue's QueuedMessages to this Queue. 964## 965## Adds all of the QueuedMessage objects in the passed in queue 966## to this queue. 967## 968 969sub add_queue 970{ 971 my $self = shift; 972 my $queue = shift; 973 my $id; 974 my $queued_message; 975 my $result; 976 977 while (($id, $queued_message) = each %{$queue->{files}}) 978 { 979 $result = $self->add_queued_message($queued_message); 980 if ($result) 981 { 982 print("$result.\n"); 983 } 984 } 985} 986 987## 988## ADD - Adds an item to this queue. 989## 990## Adds either a Queue or a QueuedMessage to this Queue. 991## 992 993sub add 994{ 995 my $self = shift; 996 my $source = shift; 997 my $type_name; 998 my $result; 999 1000 $type_name = ref($source); 1001 1002 if ($type_name eq "QueuedMessage") 1003 { 1004 return $self->add_queued_message($source); 1005 } 1006 1007 if ($type_name eq "Queue") 1008 { 1009 return $self->add_queue($source); 1010 } 1011 1012 return "Queue does not know how to add a '$type_name'" 1013} 1014 1015sub delete 1016{ 1017 my $self = shift; 1018 my $id; 1019 my $queued_message; 1020 1021 while (($id, $queued_message) = each %{$self->{files}}) 1022 { 1023 $result = $queued_message->delete(); 1024 if ($result) 1025 { 1026 print("$result.\n"); 1027 } 1028 } 1029} 1030 1031sub bounce 1032{ 1033 my $self = shift; 1034 my $id; 1035 my $queued_message; 1036 1037 while (($id, $queued_message) = each %{$self->{files}}) 1038 { 1039 $result = $queued_message->bounce(); 1040 if ($result) 1041 { 1042 print("$result.\n"); 1043 } 1044 } 1045} 1046 1047## 1048## Condition Class 1049## 1050## This next section is for any class that has an interface called 1051## check_move(source, dest). Each class represents some condition to 1052## check for to determine whether we should move the file from 1053## source to dest. 1054## 1055 1056 1057## 1058## OlderThan 1059## 1060## This Condition Class checks the modification time of the 1061## source file and returns true if the file's modification time is 1062## older than the number of seconds the class was initialzed with. 1063## 1064 1065package OlderThan; 1066 1067sub new 1068{ 1069 my $this = shift; 1070 my $class = ref($this) || $this; 1071 my $self = {}; 1072 bless $self, $class; 1073 $self->initialize(@_); 1074 return $self; 1075} 1076 1077sub initialize 1078{ 1079 my $self = shift; 1080 1081 $self->{age_in_seconds} = shift; 1082} 1083 1084sub check_move 1085{ 1086 my $self = shift; 1087 my $source = shift; 1088 1089 if ((time() - $source->last_modified_time()) > $self->{age_in_seconds}) 1090 { 1091 return 1; 1092 } 1093 1094 return 0; 1095} 1096 1097## 1098## Compound 1099## 1100## Takes a list of Move Condition Classes. Check_move returns true 1101## if every Condition Class in the list's check_move function returns 1102## true. 1103## 1104 1105package Compound; 1106 1107sub new 1108{ 1109 my $this = shift; 1110 my $class = ref($this) || $this; 1111 my $self = {}; 1112 bless $self, $class; 1113 $self->initialize(@_); 1114 return $self; 1115} 1116 1117sub initialize 1118{ 1119 my $self = shift; 1120 1121 $self->{condition_list} = []; 1122} 1123 1124sub add 1125{ 1126 my $self = shift; 1127 my $new_condition = shift; 1128 1129 push(@{$self->{condition_list}}, $new_condition); 1130} 1131 1132sub check_move 1133{ 1134 my $self = shift; 1135 my $source = shift; 1136 my $dest = shift; 1137 my $condition; 1138 my $result; 1139 1140 foreach $condition (@{$self->{condition_list}}) 1141 { 1142 if (!$condition->check_move($source, $dest)) 1143 { 1144 return 0; 1145 } 1146 } 1147 1148 return 1; 1149} 1150 1151## 1152## Eval 1153## 1154## Takes a perl expression and evaluates it. The ControlFile object 1155## for the source QueuedMessage is avaliable through the name '$msg'. 1156## 1157 1158package Eval; 1159 1160sub new 1161{ 1162 my $this = shift; 1163 my $class = ref($this) || $this; 1164 my $self = {}; 1165 bless $self, $class; 1166 $self->initialize(@_); 1167 return $self; 1168} 1169 1170sub initialize 1171{ 1172 my $self = shift; 1173 1174 $self->{expression} = shift; 1175} 1176 1177sub check_move 1178{ 1179 my $self = shift; 1180 my $source = shift; 1181 my $dest = shift; 1182 my $result; 1183 my %msg; 1184 1185 $source->setup_vars(); 1186 tie(%msg, 'QueuedMessage', $source); 1187 $result = eval($self->{expression}); 1188 1189 return $result; 1190} 1191