contrib/sendmail/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.27 2002/01/29 21:55:49 ca 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                 'G' => 'queue_delay',
 489                 'I' => 'inode_number',
 490                 'K' => 'next_delivery_time',
 491                 'L' => 'content-length',
 492                 'M' => 'message',
 493                 'N' => 'num_delivery_attempts',
 494                 'P' => 'priority',
 495                 'Q' => 'original_recipient',
 496                 'R' => 'recipient',
 497                 'q' => 'quarantine_reason',
 498                 'r' => 'final_recipient',
 499                 'S' => 'sender',
 500                 'T' => 'creation_time',
 501                 'V' => 'version',
 502                 'Y' => 'current_delay',
 503                 'Z' => 'envid',
 504                 '!' => 'deliver_by',
 505                 '$' => 'macro'
 506         );
 507         my $line;
 508         my $line_type;
 509         my $line_value;
 510         my $member_name;
 511         my $member;
 512         my $last_type;
 513
 514         open(CONTROL_FILE, "$self->{file_name}");
 515         while ($line = <CONTROL_FILE>)
 516         {
 517                 $line_type = substr($line, 0, 1);
 518                 if ($line_type eq "\t" && $last_type eq 'H')
 519                 {
 520                         $line_type = 'H';
 521                         $line_value = $line;
 522                 }
 523                 else
 524                 {
 525                         $line_value = substr($line, 1);
 526                 }
 527                 $member_name = $parse_table{$line_type};
 528                 $last_type = $line_type;
 529                 if (!$member_name)
 530                 {
 531                         $member_name = 'unknown';
 532                 }
 533                 if ($self->can($member_name))
 534                 {
 535                         $self->$member_name($line_value);
 536                 }
 537                 $member = $self->{$member_name};
 538                 if (!$member)
 539                 {
 540                         $self->{$member_name} = $line_value;
 541                         next;
 542                 }
 543                 if (ref($member) eq 'ARRAY')
 544                 {
 545                         push(@{$member}, $line_value);
 546                         next;
 547                 }
 548                 $self->{$member_name} = [$member, $line_value];
 549         }
 550         close(CONTROL_FILE);
 551
 552         $self->{parsed} = 1;
 553 }
 554
 555 sub parse_header
 556 {
 557         my $self = shift;
 558         my $line = shift;
 559         my $headers = $self->{headers};
 560         my $last_header = $self->{last_header};
 561         my $header_name;
 562         my $header_value;
 563         my $first_char;
 564
 565         $first_char = substr($line, 0, 1);
 566         if ($first_char eq "?")
 567         {
 568                 $line = substr($line, 3);
 569         }
 570         elsif ($first_char eq "\t")
 571         {
 572                 if (ref($headers->{$last_header}) eq 'ARRAY')
 573                 {
 574                         $headers->{$last_header}[-1] =
 575                                 $headers->{$last_header}[-1] . $line;
 576                 }
 577                 else
 578                 {
 579                         $headers->{$last_header} = $headers->{$last_header} .
 580                                                    $line;
 581                 }
 582                 return;
 583         }
 584         ($header_name, $header_value) = split(/:/, $line, 2);
 585         $self->{last_header} = $header_name;
 586         if (exists $headers->{$header_name})
 587         {
 588                 $headers->{$header_name} = [$headers->{$header_name},
 589                                             $header_value];
 590         }
 591         else
 592         {
 593                 $headers->{$header_name} = $header_value;
 594         }
 595 }
 596
 597 sub is_locked
 598 {
 599         my $self = shift;
 600
 601         return (defined $self->{lock_handle});
 602 }
 603
 604 sub lock
 605 {
 606         my $self = shift;
 607         my $lock_handle;
 608         my $result;
 609
 610         if ($self->is_locked())
 611         {
 612                 # Already locked
 613                 return undef;
 614         }
 615
 616         ($lock_handle, $result) = ::lock_file($self->{file_name});
 617         if (!$lock_handle)
 618         {
 619                 return $result;
 620         }
 621
 622         $self->{lock_handle} = $lock_handle;
 623
 624         return undef;
 625 }
 626
 627 sub unlock
 628 {
 629         my $self = shift;
 630         my $result;
 631
 632         if (!$self->is_locked())
 633         {
 634                 # Not locked
 635                 return undef;
 636         }
 637
 638         $result = ::unlock_file($self->{lock_handle});
 639
 640         $self->{lock_handle} = undef;
 641
 642         return $result;
 643 }
 644
 645 sub do_stat
 646 {
 647         my $self = shift;
 648         my $result;
 649         my @result;
 650
 651         $result = open(QUEUE_FILE, $self->{file_name});
 652         if (!$result)
 653         {
 654                 return "Unable to open '$self->{file_name}': $!";
 655         }
 656         @result = stat(QUEUE_FILE);
 657         if (!@result)
 658         {
 659                 return "Unable to stat '$self->{file_name}': $!";
 660         }
 661         $self->{control_size} = $result[7];
 662         $self->{control_last_mod_time} = $result[9];
 663 }
 664
 665 sub DESTROY
 666 {
 667         my $self = shift;
 668
 669         $self->unlock();
 670 }
 671
 672 sub delete
 673 {
 674         my $self = shift;
 675         my $result;
 676
 677         $result = unlink($self->{file_name});
 678         if (!$result)
 679         {
 680                 return "Unable to delete $self->{file_name}: $!";
 681         }
 682         return undef;
 683 }
 684
 685
 686 ##
 687 ## DATA_FILE - Represents a sendmail queue data file.
 688 ##
 689 ##      This object represents represents a sendmail queue data file.
 690 ##      It is really just a place-holder.
 691 ##
 692
 693 package DataFile;
 694
 695 sub new
 696 {
 697         my $this = shift;
 698         my $class = ref($this) || $this;
 699         my $self = {};
 700         bless $self, $class;
 701         $self->initialize(@_);
 702         return $self;
 703 }
 704
 705 sub initialize
 706 {
 707         my $self = shift;
 708         my $data_dir = shift;
 709         $self->{id} = shift;
 710         my $control_file = shift;
 711
 712         $self->{file_name} = $data_dir . '/df' . $self->{id};
 713         return if -e $self->{file_name};
 714         $control_file->parse();
 715         return if !defined $control_file->{data_file_directory};
 716         $data_dir = $queue_root . '/' . $control_file->{data_file_directory};
 717         chomp $data_dir;
 718         if (-d ($data_dir . '/df'))
 719         {
 720                 $data_dir .= '/df';
 721         }
 722         $self->{file_name} = $data_dir . '/df' . $self->{id};
 723 }
 724
 725 sub do_stat
 726 {
 727         my $self = shift;
 728         my $result;
 729         my @result;
 730
 731         $result = open(QUEUE_FILE, $self->{file_name});
 732         if (!$result)
 733         {
 734                 return "Unable to open '$self->{file_name}': $!";
 735         }
 736         @result = stat(QUEUE_FILE);
 737         if (!@result)
 738         {
 739                 return "Unable to stat '$self->{file_name}': $!";
 740         }
 741         $self->{body_size} = $result[7];
 742         $self->{body_last_mod_time} = $result[9];
 743 }
 744
 745 sub delete
 746 {
 747         my $self = shift;
 748         my $result;
 749
 750         $result = unlink($self->{file_name});
 751         if (!$result)
 752         {
 753                 return "Unable to delete $self->{file_name}: $!";
 754         }
 755         return undef;
 756 }
 757
 758
 759 ##
 760 ## QUEUED_MESSAGE - Represents a queued sendmail message.
 761 ##
 762 ##      This keeps track of the files that make up a queued sendmail
 763 ##      message.
 764 ##      Currently it has 'control_file' and 'data_file' as members.
 765 ##
 766 ##      You can tie it to a fetch only hash using tie. You need to
 767 ##      pass a reference to a QueuedMessage as the third argument
 768 ##      to tie.
 769 ##
 770
 771 package QueuedMessage;
 772
 773 sub new
 774 {
 775         my $this = shift;
 776         my $class = ref($this) || $this;
 777         my $self = {};
 778         bless $self, $class;
 779         $self->initialize(@_);
 780         return $self;
 781 }
 782
 783 sub initialize
 784 {
 785         my $self = shift;
 786         my $queue_dir = shift;
 787         my $id = shift;
 788         my $data_dir = shift;
 789
 790         $self->{id} = $id;
 791         $self->{control_file} = new ControlFile($queue_dir, $id);
 792         if (!$data_dir)
 793         {
 794                 $data_dir = $queue_dir;
 795         }
 796         $self->{data_file} = new DataFile($data_dir, $id, $self->{control_file});
 797 }
 798
 799 sub last_modified_time
 800 {
 801         my $self = shift;
 802         my @result;
 803         @result = stat($self->{data_file}->{file_name});
 804         return $result[9];
 805 }
 806
 807 sub TIEHASH
 808 {
 809         my $this = shift;
 810         my $class = ref($this) || $this;
 811         my $self = shift;
 812         return $self;
 813 }
 814
 815 sub FETCH
 816 {
 817         my $self = shift;
 818         my $key = shift;
 819
 820         if (exists $self->{control_file}->{$key})
 821         {
 822                 return $self->{control_file}->{$key};
 823         }
 824         if (exists $self->{data_file}->{$key})
 825         {
 826                 return $self->{data_file}->{$key};
 827         }
 828
 829         return undef;
 830 }
 831
 832 sub lock
 833 {
 834         my $self = shift;
 835
 836         return $self->{control_file}->lock();
 837 }
 838
 839 sub unlock
 840 {
 841         my $self = shift;
 842
 843         return $self->{control_file}->unlock();
 844 }
 845
 846 sub move
 847 {
 848         my $self = shift;
 849         my $destination = shift;
 850         my $df_dest;
 851         my $qf_dest;
 852         my $result;
 853
 854         $result = $self->lock();
 855         if ($result)
 856         {
 857                 return $result;
 858         }
 859
 860         $qf_dest = File::Spec->catfile($destination, "qf");
 861         if (-d $qf_dest)
 862         {
 863                 $df_dest = File::Spec->catfile($destination, "df");
 864                 if (!-d $df_dest)
 865                 {
 866                         $df_dest = $destination;
 867                 }
 868         }
 869         else
 870         {
 871                 $qf_dest = $destination;
 872                 $df_dest = $destination;
 873         }
 874
 875         if (-e File::Spec->catfile($qf_dest, "$qprefix$self->{id}"))
 876         {
 877                 $result = "There is already a queued message with id '$self->{id}' in '$destination'";
 878         }
 879
 880         if (!$result)
 881         {
 882                 $result = ::move_file($self->{data_file}->{file_name},
 883                                       $df_dest);
 884         }
 885
 886         if (!$result)
 887         {
 888                 $result = ::move_file($self->{control_file}->{file_name},
 889                                       $qf_dest);
 890         }
 891
 892         $self->unlock();
 893
 894         return $result;
 895 }
 896
 897 sub parse
 898 {
 899         my $self = shift;
 900
 901         return $self->{control_file}->parse();
 902 }
 903
 904 sub do_stat
 905 {
 906         my $self = shift;
 907
 908         $self->{control_file}->do_stat();
 909         $self->{data_file}->do_stat();
 910 }
 911
 912 sub setup_vars
 913 {
 914         my $self = shift;
 915
 916         $self->parse();
 917         $self->do_stat();
 918 }
 919
 920 sub delete
 921 {
 922         my $self = shift;
 923         my $result;
 924
 925         $result = $self->{control_file}->delete();
 926         if ($result)
 927         {
 928                 return $result;
 929         }
 930         $result = $self->{data_file}->delete();
 931         if ($result)
 932         {
 933                 return $result;
 934         }
 935
 936         return undef;
 937 }
 938
 939 sub bounce
 940 {
 941         my $self = shift;
 942         my $command;
 943
 944         $command = "sendmail -qI$self->{id} -O Timeout.queuereturn=now";
 945 #       print("$command\n");
 946         system($command);
 947 }
 948
 949 ##
 950 ## QUEUE - Represents a queued sendmail queue.
 951 ##
 952 ##      This manages all of the messages in a queue.
 953 ##
 954
 955 package Queue;
 956
 957 sub new
 958 {
 959         my $this = shift;
 960         my $class = ref($this) || $this;
 961         my $self = {};
 962         bless $self, $class;
 963         $self->initialize(@_);
 964         return $self;
 965 }
 966
 967 sub initialize
 968 {
 969         my $self = shift;
 970
 971         $self->{queue_dir} = shift;
 972         $self->{files} = {};
 973 }
 974
 975 ##
 976 ## READ - Loads the queue with all of the objects that reside in it.
 977 ##
 978 ##      This reads the queue's directory and creates QueuedMessage objects
 979 ##      for every file in the queue that starts with 'qf' or 'hf'
 980 ##      (depending on the -Q option).
 981 ##
 982
 983 sub read
 984 {
 985         my $self = shift;
 986         my @control_files;
 987         my $queued_message;
 988         my $file_name;
 989         my $id;
 990         my $result;
 991         my $control_dir;
 992         my $data_dir;
 993
 994         $control_dir = File::Spec->catfile($self->{queue_dir}, 'qf');
 995
 996         if (-e $control_dir)
 997         {
 998                 $data_dir = File::Spec->catfile($self->{queue_dir}, 'df');
 999                 if (!-e $data_dir)
1000                 {
1001                         $data_dir = $self->{queue_dir};
1002                 }
1003         }
1004         else
1005         {
1006                 $data_dir = $self->{queue_dir};
1007                 $control_dir = $self->{queue_dir};
1008         }
1009
1010         $result = opendir(QUEUE_DIR, $control_dir);
1011         if (!$result)
1012         {
1013                 return "Unable to open directory '$control_dir'";
1014         }
1015
1016         @control_files = grep { /^$qprefix.*/ && -f "$control_dir/$_" } readdir(QUEUE_DIR);
1017         closedir(QUEUE_DIR);
1018         foreach $file_name (@control_files)
1019         {
1020                 $id = substr($file_name, 2);
1021                 $queued_message = new QueuedMessage($control_dir, $id,
1022                                                     $data_dir);
1023                 $self->{files}->{$id} = $queued_message;
1024         }
1025
1026         return undef;
1027 }
1028
1029
1030 ##
1031 ## ADD_QUEUED_MESSAGE - Adds a QueuedMessage to this Queue.
1032 ##
1033 ##      Adds the QueuedMessage object to the hash and moves the files
1034 ##      associated with the QueuedMessage to this Queue's directory.
1035 ##
1036
1037 sub add_queued_message
1038 {
1039         my $self = shift;
1040         my $queued_message = shift;
1041         my $result;
1042
1043         $result = $queued_message->move($self->{queue_dir});
1044         if ($result)
1045         {
1046                 return $result;
1047         }
1048
1049         $self->{files}->{$queued_message->{id}} = $queued_message;
1050
1051         return $result;
1052 }
1053
1054 ##
1055 ## ADD_QUEUE - Adds another Queue's QueuedMessages to this Queue.
1056 ##
1057 ##      Adds all of the QueuedMessage objects in the passed in queue
1058 ##      to this queue.
1059 ##
1060
1061 sub add_queue
1062 {
1063         my $self = shift;
1064         my $queue = shift;
1065         my $id;
1066         my $queued_message;
1067         my $result;
1068
1069         while (($id, $queued_message) = each %{$queue->{files}})
1070         {
1071                 $result = $self->add_queued_message($queued_message);
1072                 if ($result)
1073                 {
1074                         print("$result.\n");
1075                 }
1076         }
1077 }
1078
1079 ##
1080 ## ADD - Adds an item to this queue.
1081 ##
1082 ##      Adds either a Queue or a QueuedMessage to this Queue.
1083 ##
1084
1085 sub add
1086 {
1087         my $self = shift;
1088         my $source = shift;
1089         my $type_name;
1090         my $result;
1091
1092         $type_name = ref($source);
1093
1094         if ($type_name eq "QueuedMessage")
1095         {
1096                 return $self->add_queued_message($source);
1097         }
1098
1099         if ($type_name eq "Queue")
1100         {
1101                 return $self->add_queue($source);
1102         }
1103
1104         return "Queue does not know how to add a '$type_name'"
1105 }
1106
1107 sub delete
1108 {
1109         my $self = shift;
1110         my $id;
1111         my $queued_message;
1112
1113         while (($id, $queued_message) = each %{$self->{files}})
1114         {
1115                 $result = $queued_message->delete();
1116                 if ($result)
1117                 {
1118                         print("$result.\n");
1119                 }
1120         }
1121 }
1122
1123 sub bounce
1124 {
1125         my $self = shift;
1126         my $id;
1127         my $queued_message;
1128
1129         while (($id, $queued_message) = each %{$self->{files}})
1130         {
1131                 $result = $queued_message->bounce();
1132                 if ($result)
1133                 {
1134                         print("$result.\n");
1135                 }
1136         }
1137 }
1138
1139 ##
1140 ## Condition Class
1141 ##
1142 ##      This next section is for any class that has an interface called
1143 ##      check_move(source, dest). Each class represents some condition to
1144 ##      check for to determine whether we should move the file from
1145 ##      source to dest.
1146 ##
1147
1148
1149 ##
1150 ## OlderThan
1151 ##
1152 ##      This Condition Class checks the modification time of the
1153 ##      source file and returns true if the file's modification time is
1154 ##      older than the number of seconds the class was initialzed with.
1155 ##
1156
1157 package OlderThan;
1158
1159 sub new
1160 {
1161         my $this = shift;
1162         my $class = ref($this) || $this;
1163         my $self = {};
1164         bless $self, $class;
1165         $self->initialize(@_);
1166         return $self;
1167 }
1168
1169 sub initialize
1170 {
1171         my $self = shift;
1172
1173         $self->{age_in_seconds} = shift;
1174 }
1175
1176 sub check_move
1177 {
1178         my $self = shift;
1179         my $source = shift;
1180
1181         if ((time() - $source->last_modified_time()) > $self->{age_in_seconds})
1182         {
1183                 return 1;
1184         }
1185
1186         return 0;
1187 }
1188
1189 ##
1190 ## Compound
1191 ##
1192 ##      Takes a list of Move Condition Classes. Check_move returns true
1193 ##      if every Condition Class in the list's check_move function returns
1194 ##      true.
1195 ##
1196
1197 package Compound;
1198
1199 sub new
1200 {
1201         my $this = shift;
1202         my $class = ref($this) || $this;
1203         my $self = {};
1204         bless $self, $class;
1205         $self->initialize(@_);
1206         return $self;
1207 }
1208
1209 sub initialize
1210 {
1211         my $self = shift;
1212
1213         $self->{condition_list} = [];
1214 }
1215
1216 sub add
1217 {
1218         my $self = shift;
1219         my $new_condition = shift;
1220
1221         push(@{$self->{condition_list}}, $new_condition);
1222 }
1223
1224 sub check_move
1225 {
1226         my $self = shift;
1227         my $source = shift;
1228         my $dest = shift;
1229         my $condition;
1230         my $result;
1231
1232         foreach $condition (@{$self->{condition_list}})
1233         {
1234                 if (!$condition->check_move($source, $dest))
1235                 {
1236                         return 0;
1237                 }
1238         }
1239
1240         return 1;
1241 }
1242
1243 ##
1244 ## Eval
1245 ##
1246 ##      Takes a perl expression and evaluates it. The ControlFile object
1247 ##      for the source QueuedMessage is avaliable through the name '$msg'.
1248 ##
1249
1250 package Eval;
1251
1252 sub new
1253 {
1254         my $this = shift;
1255         my $class = ref($this) || $this;
1256         my $self = {};
1257         bless $self, $class;
1258         $self->initialize(@_);
1259         return $self;
1260 }
1261
1262 sub initialize
1263 {
1264         my $self = shift;
1265
1266         $self->{expression} = shift;
1267 }
1268
1269 sub check_move
1270 {
1271         my $self = shift;
1272         my $source = shift;
1273         my $dest = shift;
1274         my $result;
1275         my %msg;
1276
1277         $source->setup_vars();
1278         tie(%msg, 'QueuedMessage', $source);
1279         $result = eval($self->{expression});
1280
1281         return $result;
1282 }