contrib/sendmail-8.13.4/contrib/qtool.pl

   1 #!/usr/bin/env perl
   2 ##
   3 ## Copyright (c) 1998-2002 Sendmail, Inc. and its suppliers.
   4 ##      All rights reserved.
   5 ##
   6 ## $Id: qtool.pl,v 8.28 2002/06/27 23:06:16 gshapiro Exp $
   7 ##
   8 use strict;
   9 use File::Basename;
  10 use File::Copy;
  11 use File::Spec;
  12 use Fcntl qw(:flock :DEFAULT);
  13 use Getopt::Std;
  14
  15 ##
  16 ## QTOOL
  17 ##      This program is for moving files between sendmail queues. It is
  18 ## pretty similar to just moving the files manually, but it locks the files
  19 ## the same way sendmail does to prevent problems.
  20 ##
  21 ##      NOTICE: Do not use this program to move queue files around
  22 ## if you use sendmail 8.12 and multiple queue groups. It may interfere
  23 ## with sendmail's internal queue group selection strategy and can cause
  24 ## mail to be not delivered.
  25 ##
  26 ##      The syntax is the reverse of mv (ie. the target argument comes
  27 ## first). This lets you pick the files you want to move using find and
  28 ## xargs.
  29 ##
  30 ##      Since you cannot delete queues while sendmail is running, QTOOL
  31 ## assumes that when you specify a directory as a source, you mean that you
  32 ## want all of the queue files within that directory moved, not the
  33 ## directory itself.
  34 ##
  35 ##      There is a mechanism for adding conditionals for moving the files.
  36 ## Just create an Object with a check_move(source, dest) method and add it
  37 ## to the $conditions object. See the handling of the '-s' option for an
  38 ## example.
  39 ##
  40
  41 ##
  42 ## OPTION NOTES
  43 ##
  44 ## The -e option:
  45 ##      The -e option takes any valid perl expression and evaluates it
  46 ##      using the eval() function. Inside the expression the variable
  47 ##      '$msg' is bound to the ControlFile object for the current source
  48 ##      queue message. This lets you check for any value in the message
  49 ##      headers or the control file. Here's an example:
  50 ##
  51 ##      ./qtool.pl -e '$msg{num_delivery_attempts} >= 2' /q1 /q2
  52 ##
  53 ##      This would move any queue files whose number of delivery attempts
  54 ##      is greater than or equal to 2 from the queue 'q2' to the queue 'q1'.
  55 ##
  56 ##      See the function ControlFile::parse for a list of available
  57 ##      variables.
  58 ##
  59
  60 my %opts;
  61 my %sources;
  62 my $dst_name;
  63 my $destination;
  64 my $source_name;
  65 my $source;
  66 my $result;
  67 my $action;
  68 my $new_condition;
  69 my $qprefix;
  70 my $queuegroups = 0;
  71 my $conditions = new Compound();
  72
  73 Getopt::Std::getopts('bC:de:Qs:', \%opts);
  74
  75 sub move_action
  76 {
  77         my $source = shift;
  78         my $destination = shift;
  79
  80         $result = $destination->add($source);
  81         if ($result)
  82         {
  83                 print("$result.\n");
  84         }
  85 }
  86
  87 sub delete_action
  88 {
  89         my $source = shift;
  90
  91         return $source->delete();
  92 }
  93
  94 sub bounce_action
  95 {
  96         my $source = shift;
  97
  98         return $source->bounce();
  99 }
 100
 101 $action = \&move_action;
 102 if (defined $opts{d})
 103 {
 104         $action = \&delete_action;
 105 }
 106 elsif (defined $opts{b})
 107 {
 108         $action = \&bounce_action;
 109 }
 110
 111 if (defined $opts{s})
 112 {
 113         $new_condition = new OlderThan($opts{s});
 114         $conditions->add($new_condition);
 115 }
 116
 117 if (defined $opts{e})
 118 {
 119         $new_condition = new Eval($opts{e});
 120         $conditions->add($new_condition);
 121 }
 122
 123 if (defined $opts{Q})
 124 {
 125         $qprefix = "hf";
 126 }
 127 else
 128 {
 129         $qprefix = "qf";
 130 }
 131
 132 if ($action == \&move_action)
 133 {
 134         $dst_name = shift(@ARGV);
 135         if (!-d $dst_name)
 136         {
 137                 print("The destination '$dst_name' must be an existing " .
 138                       "directory.\n");
 139                 usage();
 140                 exit;
 141         }
 142         $destination = new Queue($dst_name);
 143 }
 144
 145 # determine queue_root by reading config file
 146 my $queue_root;
 147 {
 148         my $config_file = "/etc/mail/sendmail.cf";
 149         if (defined $opts{C})
 150         {
 151                 $config_file = $opts{C};
 152         }
 153
 154         my $line;
 155         open(CONFIG_FILE, $config_file) or die "$config_file: $!";
 156
 157         ##  Notice: we can only break out of this loop (using last)
 158         ##      when both entries (queue directory and group group)
 159         ##      have been found.
 160         while ($line = <CONFIG_FILE>)
 161         {
 162                 chomp $line;
 163                 if ($line =~ m/^O QueueDirectory=(.*)/)
 164                 {
 165                         $queue_root = $1;
 166                         if ($queue_root =~ m/(.*)\/[^\/]+\*$/)
 167                         {
 168                                 $queue_root = $1;
 169                         }
 170                         # found also queue groups?
 171                         if ($queuegroups)
 172                         {
 173                                 last;
 174                         }
 175                 }
 176                 if ($line =~ m/^Q.*/)
 177                 {
 178                         $queuegroups = 1;
 179                         if ($action == \&move_action)
 180                         {
 181                                 print("WARNING: moving queue files around " .
 182                                       "when queue groups are used may\n" .
 183                                       "result in undelivered mail!\n");
 184                         }
 185                         # found also queue directory?
 186                         if (defined $queue_root)
 187                         {
 188                                 last;
 189                         }
 190                 }
 191         }
 192         close(CONFIG_FILE);
 193         if (!defined $queue_root)
 194         {
 195                 die "QueueDirectory option not defined in $config_file";
 196         }
 197 }
 198
 199 while (@ARGV)
 200 {
 201         $source_name = shift(@ARGV);
 202         $result = add_source(\%sources, $source_name);
 203         if ($result)
 204         {
 205                 print("$result.\n");
 206                 exit;
 207         }
 208 }
 209
 210 if (keys(%sources) == 0)
 211 {
 212         exit;
 213 }
 214
 215 while (($source_name, $source) = each(%sources))
 216 {
 217         $result = $conditions->check_move($source, $destination);
 218         if ($result)
 219         {
 220                 $result = &{$action}($source, $destination);
 221                 if ($result)
 222                 {
 223                         print("$result\n");
 224                 }
 225         }
 226 }
 227
 228 sub usage
 229 {
 230         print("Usage:\t$0 [options] directory source ...\n");
 231         print("\t$0 [-Q][-d|-b] source ...\n");
 232         print("Options:\n");
 233         print("\t-b\t\tBounce the messages specified by source.\n");
 234         print("\t-C configfile\tSpecify sendmail config file.\n");
 235         print("\t-d\t\tDelete the messages specified by source.\n");
 236         print("\t-e [perl expression]\n");
 237         print("\t\t\tMove only messages for which perl expression\n");
 238         print("\t\t\treturns true.\n");
 239         print("\t-Q\t\tOperate on quarantined files.\n");
 240         print("\t-s [seconds]\tMove only messages whose queue file is older\n");
 241         print("\t\t\tthan seconds.\n");
 242 }
 243
 244 ##
 245 ## ADD_SOURCE -- Adds a source to the source hash.
 246 ##
 247 ##      Determines whether source is a file, directory, or id. Then it
 248 ##      creates a QueuedMessage or Queue for that source and adds it to the
 249 ##      list.
 250 ##
 251 ##      Parameters:
 252 ##              sources -- A hash that contains all of the sources.
 253 ##              source_name -- The name of the source to add
 254 ##
 255 ##      Returns:
 256 ##              error_string -- Undef if ok. Error string otherwise.
 257 ##
 258 ##      Notes:
 259 ##              If a new source comes in with the same ID as a previous
 260 ##              source, the previous source gets overwritten in the sources
 261 ##              hash. This lets the user specify things like * and it still
 262 ##              works nicely.
 263 ##
 264
 265 sub add_source
 266 {
 267         my $sources = shift;
 268         my $source_name = shift;
 269         my $source_base_name;
 270         my $source_dir_name;
 271         my $data_dir_name;
 272         my $source_id;
 273         my $source_prefix;
 274         my $queued_message;
 275         my $queue;
 276         my $result;
 277
 278         ($source_base_name, $source_dir_name) = File::Basename::fileparse($source_name);
 279         $data_dir_name = $source_dir_name;
 280
 281         $source_prefix = substr($source_base_name, 0, 2);
 282         if (!-d $source_name && $source_prefix ne $qprefix &&
 283             $source_prefix ne 'df')
 284         {
 285                 $source_base_name = "$qprefix$source_base_name";
 286                 $source_name = File::Spec->catfile("$source_dir_name",
 287                                                    "$source_base_name");
 288         }
 289         $source_id = substr($source_base_name, 2);
 290
 291         if (!-e $source_name)
 292         {
 293                 $source_name = File::Spec->catfile("$source_dir_name", "qf",
 294                                                    "$qprefix$source_id");
 295                 if (!-e $source_name)
 296                 {
 297                         return "'$source_name' does not exist";
 298                 }
 299                 $data_dir_name = File::Spec->catfile("$source_dir_name", "df");
 300                 if (!-d $data_dir_name)
 301                 {
 302                         $data_dir_name = $source_dir_name;
 303                 }
 304                 $source_dir_name = File::Spec->catfile("$source_dir_name",
 305                                                        "qf");
 306         }
 307
 308         if (-f $source_name)
 309         {
 310                 $queued_message = new QueuedMessage($source_dir_name,
 311                                                     $source_id,
 312                                                     $data_dir_name);
 313                 $sources->{$source_id} = $queued_message;
 314                 return undef;
 315         }
 316
 317         if (!-d $source_name)
 318         {
 319                 return "'$source_name' is not a plain file or a directory";
 320         }
 321
 322         $queue = new Queue($source_name);
 323         $result = $queue->read();
 324         if ($result)
 325         {
 326                 return $result;
 327         }
 328
 329         while (($source_id, $queued_message) = each(%{$queue->{files}}))
 330         {
 331                 $sources->{$source_id} = $queued_message;
 332         }
 333
 334         return undef;
 335 }
 336
 337 ##
 338 ## LOCK_FILE -- Opens and then locks a file.
 339 ##
 340 ##      Opens a file for read/write and uses flock to obtain a lock on the
 341 ##      file. The flock is Perl's flock which defaults to flock on systems
 342 ##      that support it. On systems without flock it falls back to fcntl
 343 ##      locking.
 344 ##
 345 ##      Parameters:
 346 ##              file_name -- The name of the file to open and lock.
 347 ##
 348 ##      Returns:
 349 ##              (file_handle, error_string) -- If everything works then
 350 ##                      file_handle is a reference to a file handle and
 351 ##                      error_string is undef. If there is a problem then
 352 ##                      file_handle is undef and error_string is a string
 353 ##                      explaining the problem.
 354 ##
 355
 356 sub lock_file
 357 {
 358         my $file_name = shift;
 359         my $result;
 360
 361         $result = sysopen(FILE_TO_LOCK, $file_name, Fcntl::O_RDWR);
 362         if (!$result)
 363         {
 364                 return (undef, "Unable to open '$file_name': $!");
 365         }
 366
 367         $result = flock(FILE_TO_LOCK, Fcntl::LOCK_EX | Fcntl::LOCK_NB);
 368         if (!$result)
 369         {
 370                 return (undef, "Could not obtain lock on '$file_name': $!");
 371         }
 372
 373         return (\*FILE_TO_LOCK, undef);
 374 }
 375
 376 ##
 377 ## UNLOCK_FILE -- Unlocks a file.
 378 ##
 379 ##      Unlocks a file using Perl's flock.
 380 ##
 381 ##      Parameters:
 382 ##              file -- A file handle.
 383 ##
 384 ##      Returns:
 385 ##              error_string -- If undef then no problem. Otherwise it is a
 386 ##                      string that explains problem.
 387 ##
 388
 389 sub unlock_file
 390 {
 391         my $file = shift;
 392         my $result;
 393
 394         $result = flock($file, Fcntl::LOCK_UN);
 395         if (!$result)
 396         {
 397                 return "Unlock failed on '$result': $!";
 398         }
 399
 400         return undef;
 401 }
 402
 403 ##
 404 ## MOVE_FILE -- Moves a file.
 405 ##
 406 ##      Moves a file.
 407 ##
 408 ##      Parameters:
 409 ##              src_name -- The name of the file to be move.
 410 ##              dst_nome -- The name of the place to move it to.
 411 ##
 412 ##      Returns:
 413 ##              error_string -- If undef then no problem. Otherwise it is a
 414 ##                      string that explains problem.
 415 ##
 416
 417 sub move_file
 418 {
 419         my $src_name = shift;
 420         my $dst_name = shift;
 421         my $result;
 422
 423         $result = File::Copy::move($src_name, $dst_name);
 424         if (!$result)
 425         {
 426                 return "File move from '$src_name' to '$dst_name' failed: $!";
 427         }
 428
 429         return undef;
 430 }
 431
 432
 433 ##
 434 ## CONTROL_FILE - Represents a sendmail queue control file.
 435 ##
 436 ##      This object represents represents a sendmail queue control file.
 437 ##      It can parse and lock its file.
 438 ##
 439
 440
 441 package ControlFile;
 442
 443 sub new
 444 {
 445         my $this = shift;
 446         my $class = ref($this) || $this;
 447         my $self = {};
 448         bless $self, $class;
 449         $self->initialize(@_);
 450         return $self;
 451 }
 452
 453 sub initialize
 454 {
 455         my $self = shift;
 456         my $queue_dir = shift;
 457         $self->{id} = shift;
 458
 459         $self->{file_name} = $queue_dir . '/' . $qprefix . $self->{id};
 460         $self->{headers} = {};
 461 }
 462
 463 ##
 464 ## PARSE - Parses the control file.
 465 ##
 466 ##      Parses the control file. It just sticks each entry into a hash.
 467 ##      If a key has more than one entry, then it points to a list of
 468 ##      entries.
 469 ##
 470
 471 sub parse
 472 {
 473         my $self = shift;
 474         if ($self->{parsed})
 475         {
 476                 return;
 477         }
 478         my %parse_table =
 479         (
 480                 'A' => 'auth',
 481                 'B' => 'body_type',
 482                 'C' => 'controlling_user',
 483                 'D' => 'data_file_name',
 484                 'd' => 'data_file_directory',
 485                 'E' => 'error_recipient',
 486                 'F' => 'flags',
 487                 'H' => 'parse_header',
 488                 'I' => 'inode_number',
 489                 'K' => 'next_delivery_time',
 490                 'L' => 'content-length',
 491                 'M' => 'message',
 492                 'N' => 'num_delivery_attempts',
 493                 'P' => 'priority',
 494                 'Q' => 'original_recipient',
 495                 'R' => 'recipient',
 496                 'q' => 'quarantine_reason',
 497                 'r' => 'final_recipient',
 498                 'S' => 'sender',
 499                 'T' => 'creation_time',
 500                 'V' => 'version',
 501                 'Y' => 'current_delay',
 502                 'Z' => 'envid',
 503                 '!' => 'deliver_by',
 504                 '$' => 'macro'
 505         );
 506         my $line;
 507         my $line_type;
 508         my $line_value;
 509         my $member_name;
 510         my $member;
 511         my $last_type;
 512
 513         open(CONTROL_FILE, "$self->{file_name}");
 514         while ($line = <CONTROL_FILE>)
 515         {
 516                 $line_type = substr($line, 0, 1);
 517                 if ($line_type eq "\t" && $last_type eq 'H')
 518                 {
 519                         $line_type = 'H';
 520                         $line_value = $line;
 521                 }
 522                 else
 523                 {
 524                         $line_value = substr($line, 1);
 525                 }
 526                 $member_name = $parse_table{$line_type};
 527                 $last_type = $line_type;
 528                 if (!$member_name)
 529                 {
 530                         $member_name = 'unknown';
 531                 }
 532                 if ($self->can($member_name))
 533                 {
 534                         $self->$member_name($line_value);
 535                 }
 536                 $member = $self->{$member_name};
 537                 if (!$member)
 538                 {
 539                         $self->{$member_name} = $line_value;
 540                         next;
 541                 }
 542                 if (ref($member) eq 'ARRAY')
 543                 {
 544                         push(@{$member}, $line_value);
 545                         next;
 546                 }
 547                 $self->{$member_name} = [$member, $line_value];
 548         }
 549         close(CONTROL_FILE);
 550
 551         $self->{parsed} = 1;
 552 }
 553
 554 sub parse_header
 555 {
 556         my $self = shift;
 557         my $line = shift;
 558         my $headers = $self->{headers};
 559         my $last_header = $self->{last_header};
 560         my $header_name;
 561         my $header_value;
 562         my $first_char;
 563
 564         $first_char = substr($line, 0, 1);
 565         if ($first_char eq "?")
 566         {
 567                 $line = substr($line, 3);
 568         }
 569         elsif ($first_char eq "\t")
 570         {
 571                 if (ref($headers->{$last_header}) eq 'ARRAY')
 572                 {
 573                         $headers->{$last_header}[-1] =
 574                                 $headers->{$last_header}[-1] . $line;
 575                 }
 576                 else
 577                 {
 578                         $headers->{$last_header} = $headers->{$last_header} .
 579                                                    $line;
 580                 }
 581                 return;
 582         }
 583         ($header_name, $header_value) = split(/:/, $line, 2);
 584         $self->{last_header} = $header_name;
 585         if (exists $headers->{$header_name})
 586         {
 587                 $headers->{$header_name} = [$headers->{$header_name},
 588                                             $header_value];
 589         }
 590         else
 591         {
 592                 $headers->{$header_name} = $header_value;
 593         }
 594 }
 595
 596 sub is_locked
 597 {
 598         my $self = shift;
 599
 600         return (defined $self->{lock_handle});
 601 }
 602
 603 sub lock
 604 {
 605         my $self = shift;
 606         my $lock_handle;
 607         my $result;
 608
 609         if ($self->is_locked())
 610         {
 611                 # Already locked
 612                 return undef;
 613         }
 614
 615         ($lock_handle, $result) = ::lock_file($self->{file_name});
 616         if (!$lock_handle)
 617         {
 618                 return $result;
 619         }
 620
 621         $self->{lock_handle} = $lock_handle;
 622
 623         return undef;
 624 }
 625
 626 sub unlock
 627 {
 628         my $self = shift;
 629         my $result;
 630
 631         if (!$self->is_locked())
 632         {
 633                 # Not locked
 634                 return undef;
 635         }
 636
 637         $result = ::unlock_file($self->{lock_handle});
 638
 639         $self->{lock_handle} = undef;
 640
 641         return $result;
 642 }
 643
 644 sub do_stat
 645 {
 646         my $self = shift;
 647         my $result;
 648         my @result;
 649
 650         $result = open(QUEUE_FILE, $self->{file_name});
 651         if (!$result)
 652         {
 653                 return "Unable to open '$self->{file_name}': $!";
 654         }
 655         @result = stat(QUEUE_FILE);
 656         if (!@result)
 657         {
 658                 return "Unable to stat '$self->{file_name}': $!";
 659         }
 660         $self->{control_size} = $result[7];
 661         $self->{control_last_mod_time} = $result[9];
 662 }
 663
 664 sub DESTROY
 665 {
 666         my $self = shift;
 667
 668         $self->unlock();
 669 }
 670
 671 sub delete
 672 {
 673         my $self = shift;
 674         my $result;
 675
 676         $result = unlink($self->{file_name});
 677         if (!$result)
 678         {
 679                 return "Unable to delete $self->{file_name}: $!";
 680         }
 681         return undef;
 682 }
 683
 684
 685 ##
 686 ## DATA_FILE - Represents a sendmail queue data file.
 687 ##
 688 ##      This object represents represents a sendmail queue data file.
 689 ##      It is really just a place-holder.
 690 ##
 691
 692 package DataFile;
 693
 694 sub new
 695 {
 696         my $this = shift;
 697         my $class = ref($this) || $this;
 698         my $self = {};
 699         bless $self, $class;
 700         $self->initialize(@_);
 701         return $self;
 702 }
 703
 704 sub initialize
 705 {
 706         my $self = shift;
 707         my $data_dir = shift;
 708         $self->{id} = shift;
 709         my $control_file = shift;
 710
 711         $self->{file_name} = $data_dir . '/df' . $self->{id};
 712         return if -e $self->{file_name};
 713         $control_file->parse();
 714         return if !defined $control_file->{data_file_directory};
 715         $data_dir = $queue_root . '/' . $control_file->{data_file_directory};
 716         chomp $data_dir;
 717         if (-d ($data_dir . '/df'))
 718         {
 719                 $data_dir .= '/df';
 720         }
 721         $self->{file_name} = $data_dir . '/df' . $self->{id};
 722 }
 723
 724 sub do_stat
 725 {
 726         my $self = shift;
 727         my $result;
 728         my @result;
 729
 730         $result = open(QUEUE_FILE, $self->{file_name});
 731         if (!$result)
 732         {
 733                 return "Unable to open '$self->{file_name}': $!";
 734         }
 735         @result = stat(QUEUE_FILE);
 736         if (!@result)
 737         {
 738                 return "Unable to stat '$self->{file_name}': $!";
 739         }
 740         $self->{body_size} = $result[7];
 741         $self->{body_last_mod_time} = $result[9];
 742 }
 743
 744 sub delete
 745 {
 746         my $self = shift;
 747         my $result;
 748
 749         $result = unlink($self->{file_name});
 750         if (!$result)
 751         {
 752                 return "Unable to delete $self->{file_name}: $!";
 753         }
 754         return undef;
 755 }
 756
 757
 758 ##
 759 ## QUEUED_MESSAGE - Represents a queued sendmail message.
 760 ##
 761 ##      This keeps track of the files that make up a queued sendmail
 762 ##      message.
 763 ##      Currently it has 'control_file' and 'data_file' as members.
 764 ##
 765 ##      You can tie it to a fetch only hash using tie. You need to
 766 ##      pass a reference to a QueuedMessage as the third argument
 767 ##      to tie.
 768 ##
 769
 770 package QueuedMessage;
 771
 772 sub new
 773 {
 774         my $this = shift;
 775         my $class = ref($this) || $this;
 776         my $self = {};
 777         bless $self, $class;
 778         $self->initialize(@_);
 779         return $self;
 780 }
 781
 782 sub initialize
 783 {
 784         my $self = shift;
 785         my $queue_dir = shift;
 786         my $id = shift;
 787         my $data_dir = shift;
 788
 789         $self->{id} = $id;
 790         $self->{control_file} = new ControlFile($queue_dir, $id);
 791         if (!$data_dir)
 792         {
 793                 $data_dir = $queue_dir;
 794         }
 795         $self->{data_file} = new DataFile($data_dir, $id, $self->{control_file});
 796 }
 797
 798 sub last_modified_time
 799 {
 800         my $self = shift;
 801         my @result;
 802         @result = stat($self->{data_file}->{file_name});
 803         return $result[9];
 804 }
 805
 806 sub TIEHASH
 807 {
 808         my $this = shift;
 809         my $class = ref($this) || $this;
 810         my $self = shift;
 811         return $self;
 812 }
 813
 814 sub FETCH
 815 {
 816         my $self = shift;
 817         my $key = shift;
 818
 819         if (exists $self->{control_file}->{$key})
 820         {
 821                 return $self->{control_file}->{$key};
 822         }
 823         if (exists $self->{data_file}->{$key})
 824         {
 825                 return $self->{data_file}->{$key};
 826         }
 827
 828         return undef;
 829 }
 830
 831 sub lock
 832 {
 833         my $self = shift;
 834
 835         return $self->{control_file}->lock();
 836 }
 837
 838 sub unlock
 839 {
 840         my $self = shift;
 841
 842         return $self->{control_file}->unlock();
 843 }
 844
 845 sub move
 846 {
 847         my $self = shift;
 848         my $destination = shift;
 849         my $df_dest;
 850         my $qf_dest;
 851         my $result;
 852
 853         $result = $self->lock();
 854         if ($result)
 855         {
 856                 return $result;
 857         }
 858
 859         $qf_dest = File::Spec->catfile($destination, "qf");
 860         if (-d $qf_dest)
 861         {
 862                 $df_dest = File::Spec->catfile($destination, "df");
 863                 if (!-d $df_dest)
 864                 {
 865                         $df_dest = $destination;
 866                 }
 867         }
 868         else
 869         {
 870                 $qf_dest = $destination;
 871                 $df_dest = $destination;
 872         }
 873
 874         if (-e File::Spec->catfile($qf_dest, "$qprefix$self->{id}"))
 875         {
 876                 $result = "There is already a queued message with id '$self->{id}' in '$destination'";
 877         }
 878
 879         if (!$result)
 880         {
 881                 $result = ::move_file($self->{data_file}->{file_name},
 882                                       $df_dest);
 883         }
 884
 885         if (!$result)
 886         {
 887                 $result = ::move_file($self->{control_file}->{file_name},
 888                                       $qf_dest);
 889         }
 890
 891         $self->unlock();
 892
 893         return $result;
 894 }
 895
 896 sub parse
 897 {
 898         my $self = shift;
 899
 900         return $self->{control_file}->parse();
 901 }
 902
 903 sub do_stat
 904 {
 905         my $self = shift;
 906
 907         $self->{control_file}->do_stat();
 908         $self->{data_file}->do_stat();
 909 }
 910
 911 sub setup_vars
 912 {
 913         my $self = shift;
 914
 915         $self->parse();
 916         $self->do_stat();
 917 }
 918
 919 sub delete
 920 {
 921         my $self = shift;
 922         my $result;
 923
 924         $result = $self->{control_file}->delete();
 925         if ($result)
 926         {
 927                 return $result;
 928         }
 929         $result = $self->{data_file}->delete();
 930         if ($result)
 931         {
 932                 return $result;
 933         }
 934
 935         return undef;
 936 }
 937
 938 sub bounce
 939 {
 940         my $self = shift;
 941         my $command;
 942
 943         $command = "sendmail -qI$self->{id} -O Timeout.queuereturn=now";
 944 #       print("$command\n");
 945         system($command);
 946 }
 947
 948 ##
 949 ## QUEUE - Represents a queued sendmail queue.
 950 ##
 951 ##      This manages all of the messages in a queue.
 952 ##
 953
 954 package Queue;
 955
 956 sub new
 957 {
 958         my $this = shift;
 959         my $class = ref($this) || $this;
 960         my $self = {};
 961         bless $self, $class;
 962         $self->initialize(@_);
 963         return $self;
 964 }
 965
 966 sub initialize
 967 {
 968         my $self = shift;
 969
 970         $self->{queue_dir} = shift;
 971         $self->{files} = {};
 972 }
 973
 974 ##
 975 ## READ - Loads the queue with all of the objects that reside in it.
 976 ##
 977 ##      This reads the queue's directory and creates QueuedMessage objects
 978 ##      for every file in the queue that starts with 'qf' or 'hf'
 979 ##      (depending on the -Q option).
 980 ##
 981
 982 sub read
 983 {
 984         my $self = shift;
 985         my @control_files;
 986         my $queued_message;
 987         my $file_name;
 988         my $id;
 989         my $result;
 990         my $control_dir;
 991         my $data_dir;
 992
 993         $control_dir = File::Spec->catfile($self->{queue_dir}, 'qf');
 994
 995         if (-e $control_dir)
 996         {
 997                 $data_dir = File::Spec->catfile($self->{queue_dir}, 'df');
 998                 if (!-e $data_dir)
 999                 {
1000                         $data_dir = $self->{queue_dir};
1001                 }
1002         }
1003         else
1004         {
1005                 $data_dir = $self->{queue_dir};
1006                 $control_dir = $self->{queue_dir};
1007         }
1008
1009         $result = opendir(QUEUE_DIR, $control_dir);
1010         if (!$result)
1011         {
1012                 return "Unable to open directory '$control_dir'";
1013         }
1014
1015         @control_files = grep { /^$qprefix.*/ && -f "$control_dir/$_" } readdir(QUEUE_DIR);
1016         closedir(QUEUE_DIR);
1017         foreach $file_name (@control_files)
1018         {
1019                 $id = substr($file_name, 2);
1020                 $queued_message = new QueuedMessage($control_dir, $id,
1021                                                     $data_dir);
1022                 $self->{files}->{$id} = $queued_message;
1023         }
1024
1025         return undef;
1026 }
1027
1028
1029 ##
1030 ## ADD_QUEUED_MESSAGE - Adds a QueuedMessage to this Queue.
1031 ##
1032 ##      Adds the QueuedMessage object to the hash and moves the files
1033 ##      associated with the QueuedMessage to this Queue's directory.
1034 ##
1035
1036 sub add_queued_message
1037 {
1038         my $self = shift;
1039         my $queued_message = shift;
1040         my $result;
1041
1042         $result = $queued_message->move($self->{queue_dir});
1043         if ($result)
1044         {
1045                 return $result;
1046         }
1047
1048         $self->{files}->{$queued_message->{id}} = $queued_message;
1049
1050         return $result;
1051 }
1052
1053 ##
1054 ## ADD_QUEUE - Adds another Queue's QueuedMessages to this Queue.
1055 ##
1056 ##      Adds all of the QueuedMessage objects in the passed in queue
1057 ##      to this queue.
1058 ##
1059
1060 sub add_queue
1061 {
1062         my $self = shift;
1063         my $queue = shift;
1064         my $id;
1065         my $queued_message;
1066         my $result;
1067
1068         while (($id, $queued_message) = each %{$queue->{files}})
1069         {
1070                 $result = $self->add_queued_message($queued_message);
1071                 if ($result)
1072                 {
1073                         print("$result.\n");
1074                 }
1075         }
1076 }
1077
1078 ##
1079 ## ADD - Adds an item to this queue.
1080 ##
1081 ##      Adds either a Queue or a QueuedMessage to this Queue.
1082 ##
1083
1084 sub add
1085 {
1086         my $self = shift;
1087         my $source = shift;
1088         my $type_name;
1089         my $result;
1090
1091         $type_name = ref($source);
1092
1093         if ($type_name eq "QueuedMessage")
1094         {
1095                 return $self->add_queued_message($source);
1096         }
1097
1098         if ($type_name eq "Queue")
1099         {
1100                 return $self->add_queue($source);
1101         }
1102
1103         return "Queue does not know how to add a '$type_name'"
1104 }
1105
1106 sub delete
1107 {
1108         my $self = shift;
1109         my $id;
1110         my $queued_message;
1111
1112         while (($id, $queued_message) = each %{$self->{files}})
1113         {
1114                 $result = $queued_message->delete();
1115                 if ($result)
1116                 {
1117                         print("$result.\n");
1118                 }
1119         }
1120 }
1121
1122 sub bounce
1123 {
1124         my $self = shift;
1125         my $id;
1126         my $queued_message;
1127
1128         while (($id, $queued_message) = each %{$self->{files}})
1129         {
1130                 $result = $queued_message->bounce();
1131                 if ($result)
1132                 {
1133                         print("$result.\n");
1134                 }
1135         }
1136 }
1137
1138 ##
1139 ## Condition Class
1140 ##
1141 ##      This next section is for any class that has an interface called
1142 ##      check_move(source, dest). Each class represents some condition to
1143 ##      check for to determine whether we should move the file from
1144 ##      source to dest.
1145 ##
1146
1147
1148 ##
1149 ## OlderThan
1150 ##
1151 ##      This Condition Class checks the modification time of the
1152 ##      source file and returns true if the file's modification time is
1153 ##      older than the number of seconds the class was initialzed with.
1154 ##
1155
1156 package OlderThan;
1157
1158 sub new
1159 {
1160         my $this = shift;
1161         my $class = ref($this) || $this;
1162         my $self = {};
1163         bless $self, $class;
1164         $self->initialize(@_);
1165         return $self;
1166 }
1167
1168 sub initialize
1169 {
1170         my $self = shift;
1171
1172         $self->{age_in_seconds} = shift;
1173 }
1174
1175 sub check_move
1176 {
1177         my $self = shift;
1178         my $source = shift;
1179
1180         if ((time() - $source->last_modified_time()) > $self->{age_in_seconds})
1181         {
1182                 return 1;
1183         }
1184
1185         return 0;
1186 }
1187
1188 ##
1189 ## Compound
1190 ##
1191 ##      Takes a list of Move Condition Classes. Check_move returns true
1192 ##      if every Condition Class in the list's check_move function returns
1193 ##      true.
1194 ##
1195
1196 package Compound;
1197
1198 sub new
1199 {
1200         my $this = shift;
1201         my $class = ref($this) || $this;
1202         my $self = {};
1203         bless $self, $class;
1204         $self->initialize(@_);
1205         return $self;
1206 }
1207
1208 sub initialize
1209 {
1210         my $self = shift;
1211
1212         $self->{condition_list} = [];
1213 }
1214
1215 sub add
1216 {
1217         my $self = shift;
1218         my $new_condition = shift;
1219
1220         push(@{$self->{condition_list}}, $new_condition);
1221 }
1222
1223 sub check_move
1224 {
1225         my $self = shift;
1226         my $source = shift;
1227         my $dest = shift;
1228         my $condition;
1229         my $result;
1230
1231         foreach $condition (@{$self->{condition_list}})
1232         {
1233                 if (!$condition->check_move($source, $dest))
1234                 {
1235                         return 0;
1236                 }
1237         }
1238
1239         return 1;
1240 }
1241
1242 ##
1243 ## Eval
1244 ##
1245 ##      Takes a perl expression and evaluates it. The ControlFile object
1246 ##      for the source QueuedMessage is avaliable through the name '$msg'.
1247 ##
1248
1249 package Eval;
1250
1251 sub new
1252 {
1253         my $this = shift;
1254         my $class = ref($this) || $this;
1255         my $self = {};
1256         bless $self, $class;
1257         $self->initialize(@_);
1258         return $self;
1259 }
1260
1261 sub initialize
1262 {
1263         my $self = shift;
1264
1265         $self->{expression} = shift;
1266 }
1267
1268 sub check_move
1269 {
1270         my $self = shift;
1271         my $source = shift;
1272         my $dest = shift;
1273         my $result;
1274         my %msg;
1275
1276         $source->setup_vars();
1277         tie(%msg, 'QueuedMessage', $source);
1278         $result = eval($self->{expression});
1279
1280         return $result;
1281 }