#!@{PERL_PATH}
#
# req-operation - operate on the files in the request system
#
# $Id: req-operation,v 2.3 1994/11/30 19:50:31 remy Exp $
#
# remy@ccs.neu.edu
# 27 June 1994
#
# Copyright (C) 1994 by Remy Evard
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# any later version.
#
# A copy of the license may be found in docs/license of the source
# distribution.


require "ctime.pl";

&set_globals();
&parse_commandline();        
if(!&check_permissions($caller)) {
  print "Sorry.  You don't have the permissions to run this program.\n";
  exit(1);
}

$SIG{'INT'}  = "quit_and_die";
$SIG{'QUIT'} = "quit_and_die";

$ENV{'PATH'} = "/bin";
$ENV{'SHELL'} = "/bin/sh";
$ENV{'IFS'} = '';

$input = &untaint($input);
$num = &untaint($num);


if    ($mode eq "mail"   ) { &run_mail_mode; }
elsif ($mode eq "resolve") { &run_resolve($num, $input, $caller); }
elsif ($mode eq "create" ) { &run_create($caller); }
elsif ($mode eq "mcreate") { &run_create_from_mail($input, $caller); }
elsif ($mode eq "take"   ) { &run_take($num, $caller); }
elsif ($mode eq "untake" ) { &run_untake($num, $caller); }
elsif ($mode eq "steal"  ) { &run_give($num, $input, $caller, $caller); }
elsif ($mode eq "give"   ) { &run_give($num, $input, $caller, $recipient); }
elsif ($mode eq "user"   ) { &run_user($num, $input, $caller, $recipient); }
elsif ($mode eq "prio"   ) { &run_prio($num, $input, $caller, $prio); }
elsif ($mode eq "notify" ) { &run_notify($num, $input, $caller); }
elsif ($mode eq "stall"  ) { &run_stall($num, $input, $caller); }
elsif ($mode eq "open"   ) { &run_open($num, $input, $caller); }
elsif ($mode eq "kill"   ) { &run_kill($num, $caller); }
elsif ($mode eq "comment") { &run_comment($num, $input, $caller); }
elsif ($mode eq "subject") { &run_subject($num, $newsubj, $caller); }
elsif ($mode eq "merge"  ) { &run_merge($num, $newnum, $caller); }
elsif ($mode eq "show"   ) { &run_show($num, $caller); }
else  {&usage();}

exit(0);


# ===========================================================================
# Preliminary Subroutines
# ===========================================================================

sub set_globals {
  # $program:  The name of the program being executed.
  # $date:     The current time in 'date' format.
  # $caller:   The login name of the person running the program.
  #
  # $mailer_name: The name of the login allowed to run this in mail mode.
  # $group_name:  The name of the group whose members are allowed to run this.
  #
  # $resolved_dir:  Where to put resolved files.
  # $active_dir:    Where to put active files.
  # $error_dir:     Where to put files that have trouble.
  #
  # $mode:  What the program is doing.  See the switch at the top to see
  #         the various values.
  #
  # $num:   The request number given on the command line.
  # $input: The source of input to read from.  "-" means stdin.
  # $recipient: Used to give a request to someone.
  #
  # These four are concatenated to create the file that is written:
  #  @file_header:    The headers of file that will be written at the end.
  #  @file_contents:  The body of the file, typically what it was before.
  #  @file_actions:   A record of the actions done by the program.
  #  @file_additions: Any new data (usually the incoming mail) to put on
  #                   the final file.
  # 

  ($program = "@{CODE_REQ}") =~ s:.*/::;
  $caller = (getpwuid($<))[0];
  umask(@{RUN_UMASK});

  $date = &ctime(time()); 
  chop($date);
  $date .= " (" . time() . ")";

  $mailer_name = "@{SENDMAIL_USER}";
  $group_name = "@{REQUEST_GROUP}";

  $resolved_dir = "@{CODE_RESOLVED_DIR}";
  $active_dir   = "@{CODE_ACTIVE_DIR}";
  $error_dir    = "@{CODE_ERROR_DIR}";
  $error_file   = "$error_dir/pid$$";
  $new_number   = "@{CODE_NEXTNUM}";
  $date_prog    = "@{CODE_GETDATE}";

  $req_logfile  = "@{CODE_REQLOG}";

  $mode  = "nothing";
  $num   = 0;
  $input = "-";
  $recipient = "";
  $newsubj = "<new subject>";
  $newnum  = 0;

  $do_logging = @{CONFIG_DO_LOGGING};

  $debug = 0;

  @file_header    = ();
  @file_contents  = ();
  @file_actions   = ();
  @file_additions = ();
}


sub usage {
  print "usage:  $program [-d] -create\n";
  print "        $program [-d] -mcreate <file>\n";
  print "        $program [-d] -show <num>\n";
  print "        $program [-d] -take <num>\n";
  print "        $program [-d] -untake <num>\n";
  print "        $program [-d] -steal <num> [file]\n";
  print "        $program [-d] -give <num> <user> [file]\n";
  print "        $program [-d] -user <num> <user> [file]\n";
  print "        $program [-d] -comment <num> <file>\n";
  print "        $program [-d] -subject <num> \"<subject>\"\n";
  print "        $program [-d] -prio <num> <prio> <file>\n";
  print "        $program [-d] -notify <num> [file]\n";
  print "        $program [-d] -merge <num1> <num2>  (num1 into num2)\n";
  print "        $program [-d] -resolve <num> [file]\n";
  print "        $program [-d] -stall <num> [file]\n";
  print "        $program [-d] -unstall <num> [file]\n";
  print "        $program [-d] -open <num> [file]\n";
  print "        $program [-d] -reopen <num> [file]\n";
  print "        $program [-d] -kill <num>\n";
  print "        $program [-d] -mail [file]\n";
  print "\n";
  print "  Things in [] are optional.  Things in <> aren't.\n";
  print "  If [file] is \"-\", stdin is used.\n";
  print "  The -d flag produces debugging output.\n";
}  


sub parse_commandline {
  if($ARGV[0] eq "-d") {
    shift(@ARGV);
    $debug = 1;
    print "Turning on debugging.\n";
  }

  $mode = "nothing";
  if($ARGV[0] eq "-mail") {
    if($#ARGV > 1)  { &usage; exit 0; } 
    if($#ARGV == 1) { $input = $ARGV[1]; }
    $mode = "mail";
    return;
  }
  if($ARGV[0] eq "-resolve") {
    if($#ARGV > 2 || $#ARGV < 1)  { &usage; exit 0; } 
    $input = (($#ARGV == 2) ? $ARGV[2] : 0);
    $num = $ARGV[1];
    $mode = "resolve";
    return;
  }
  if($ARGV[0] eq "-comment") {
    if($#ARGV != 2)  { &usage; exit 0; } 
    $input = $ARGV[2];
    $num = $ARGV[1];
    $mode = "comment";
    return;
  }
  if($ARGV[0] eq "-create") {
    if($#ARGV > 0)  { &usage; exit 0; } 
    $mode = "create";
    return;
  }
  if($ARGV[0] eq "-mcreate") {
    if($#ARGV != 1)  { &usage; exit 0; } 
    $input = $ARGV[1];
    $mode = "mcreate";
    return;
  }
  if($ARGV[0] eq "-take") {
    if($#ARGV != 1)  { &usage; exit 0; } 
    $num = $ARGV[1];
    $mode = "take";
    return;
  }
  if($ARGV[0] eq "-untake") {
    if($#ARGV != 1)  { &usage; exit 0; } 
    $num = $ARGV[1];
    $mode = "untake";
    return;
  }
  if($ARGV[0] eq "-steal") {
    if($#ARGV > 2 || $#ARGV < 1)  { &usage; exit 0; } 
    $input = (($#ARGV == 2) ? $ARGV[2] : 0);
    $num = $ARGV[1];
    $mode = "steal";
    return;
  }
  if($ARGV[0] eq "-give") {
    if($#ARGV > 3 || $#ARGV < 2)  { &usage; exit 0; } 
    $num = $ARGV[1];
    $recipient = $ARGV[2];
    $input = (($#ARGV == 3) ? $ARGV[3] : 0);
    $mode = "give";
    return;
  }
  if($ARGV[0] eq "-user") {
    if($#ARGV > 3 || $#ARGV < 2)  { &usage; exit 0; } 
    $num = $ARGV[1];
    $recipient = $ARGV[2];
    $input = (($#ARGV == 3) ? $ARGV[3] : 0);
    $mode = "user";
    return;
  }
  if($ARGV[0] eq "-subject") {
    if($#ARGV != 2)  { &usage; exit 0; } 
    $num = $ARGV[1];
    $newsubj = $ARGV[2];
    $mode = "subject";
    return;
  }
  if($ARGV[0] eq "-prio") {
    if($#ARGV > 3 || $#ARGV < 2)  { &usage; exit 0; } 
    $num = $ARGV[1];
    $prio = $ARGV[2];
    $input = (($#ARGV == 3) ? $ARGV[3] : 0);
    $mode = "prio";
    return;
  }
  if($ARGV[0] eq "-notify") {
    if($#ARGV > 2 || $#ARGV < 1)  { &usage; exit 0; } 
    $input = (($#ARGV == 2) ? $ARGV[2] : 0);
    $num = $ARGV[1];
    $mode = "notify";
    return;
  }
  if($ARGV[0] eq "-stall") {
    if($#ARGV > 2 || $#ARGV < 1)  { &usage; exit 0; } 
    $input = (($#ARGV == 2) ? $ARGV[2] : 0);
    $num = $ARGV[1];
    $mode = "stall";
    return;
  }
  if($ARGV[0] eq "-unstall" || $ARGV[0] eq "-reopen" || $ARGV[0] eq "-open") {
    if($#ARGV > 2 || $#ARGV < 1)  { &usage; exit 0; } 
    $input = (($#ARGV == 2) ? $ARGV[2] : 0);
    $num = $ARGV[1];
    $mode = "open";
    return;
  }
  if($ARGV[0] eq "-kill") {
    if($#ARGV != 1)  { &usage; exit 0; } 
    $num = $ARGV[1];
    $mode = "kill";
    return;
  }
  if($ARGV[0] eq "-merge") {
    if($#ARGV != 2)  { &usage; exit 0; } 
    $num = $ARGV[1];
    $newnum = $ARGV[2];
    $mode = "merge";
    return;
  }
  if($ARGV[0] eq "-show") {
    if($#ARGV != 1)  { &usage; exit 0; } 
    $num = $ARGV[1];
    $mode = "show";
    return;
  }
}
  

# ===========================================================================
# mail mode routines
# ===========================================================================

sub run_mail_mode {
  # Mail which is intended to do some sort of operation on a request is
  # coming in via stdin. 
  # 
  local($num, $active_file, $resolved_file);
  local($from, $resolve_mail, @mailto, $recipient, $line);
  local(@mail_header, @mail_body, %mail_header);

  # Read the mail, and store the info in local data structures.
  &read_file($input);
  @mail_header = @file_header;
  %mail_header = %file_header;
  @mail_body   = @file_contents;
  if(!($num = &extract_request_number($mail_header{"subject"}))) {
    print "Didn't find a request number in run_mail_mode.\n" if ($debug);
    return 0;
  }
  $from = &from($mail_header{"from"});

  # Prepare the request file.
  ($active_file, $resolved_file) =  &prep_file($num, $from);

  # Update it if it exists, otherwise, create it.
  if(&active_request($active_file)) {
    if(&notifying($active_file, $mail_header{"to"}, $mail_header{"cc"})) {
      &do_notify($active_file, $from);
      &log_comment("notified via mail", $from);
    } else {
      &do_comment($active_file, $from);
      &log_comment("commented via mail", $from);
    }
    &append_additions(@mail_header);
    &append_additions("\n");
    &append_additions(@mail_body);
    if(!&subject_equivalent($mail_header{"subject"}, &get_header("subject"))) {
      &do_subject($active_file, $from, $mail_header{"subject"});
    }
  } else {
    &do_create($num, $from);
    &log_comment("created via mail", $from);
  }

  # Run any special mail command that might have been in the headers.
  foreach $do (&mail_header_commands(@mail_header)) {
    if($do =~ /res/i) {
      &do_resolve_headers($active_file, $from);
      $resolve_mail = 1;
      &log_comment("resolved via mail", $from);
    } elsif ($do =~ /give\s+(.*)/) {
      $recipient = $1;
      @mailto = &do_give($active_file, $from, $recipient);
      $line = &give_message($num, $recipient);
      &log_comment("given to $recipient via mail", $from);
    } elsif ($do =~ /stall/) {
      &do_stall($active_file, $from);
      &log_comment("stalled via mail", $from);
    } elsif ($do =~ /prio.*\s+(.*)/) {
      &do_prio($active_file, $from, $1);
      &log_comment("reprioritized to $1 via mail", $from);
    } elsif ($do =~ /requester\s+(.*)/) {
      &do_user($active_file, $from, $1);
      &log_comment("user set to $1 via mail", $from);
    } elsif ($do =~ /user\s+(.*)/) {
      &do_user($active_file, $from, $1);
      &log_comment("user set to $1 via mail", $from);
    } elsif ($do =~ /take/) {
      &do_take($active_file, $from);
      &log_comment("taken via mail", $from);
    }    
  }

  # Release the file and put it where it should be.
  &write_file($active_file);
  &do_resolve($active_file, $resolved_file)  if($resolve_mail);
  &unlock($active_file);
  &mail_give_message($from, $recipient, $line, @mailto);
}


# ===========================================================================
# Resolve routines
# ===========================================================================

sub run_resolve {
  local($num, $input, $caller) = @_;
  local($active_file, $resolved_file);

  ($active_file, $resolved_file) =  &prep_file($num, $caller);

  if(&active_request($active_file)) {
    &do_resolve_headers($active_file, $caller);
  } else {
    print "Request $num doesn't exist.  Nnot resolving it.\n";
    &quit_and_die(0);
  }

  &add_any_comments($input);

  &write_file($active_file);
  &do_resolve($active_file, $resolved_file);
  &unlock($active_file);
  &print_comment("resolved", $caller);
}


sub do_resolve_headers {
  local($file, $caller) = @_;

  &read_file($file);
  &set_header("X-Request-Status:", "resolved");
  &set_header("X-Request-Updated:", $date);
  &append_actions("X-Request-Action: Resolved by $caller.");
}


sub do_resolve {
  # Resolve it by simply moving it to the name stored in the resolved
  # variable name.
  #
  # With merged requets, this gets more complicated, and we have to
  # check the numbers header entry, and then make sure to resolve
  # all the merged pointers as well.
  #
  local($active, $resolved, $num) = @_;
  local($merged, $m);
  local($act_file, $res_file, $err_file);

  &read_file($active);
  ($merged = &get_header("X-Request-Number")) =~ s/\s//g;
  for $m (split(",", $merged)) {
    ($act_file, $res_file, $err_file) = &get_real_file_names($m);
    if(&merged_file($act_file)) {
      rename($act_file, $res_file);
    }
  }
  rename($active, $resolved);
}


# ===========================================================================
# Create routines
# ===========================================================================

sub run_create_from_mail {
  local($input, $caller) = @_;
  local($num, $subject, $requester);
  local($active_file, $resolved_file);
  
  if($input) {
    &read_file($input);
  }

  $num = &get_next_num();

  # Insert the number into the Subject: line, taking out any old one.
  $subject = &get_header("Subject");
  &set_header("Subject:", &build_subject_line($subject, $num));
  $date = &get_date_header("Date") || $date;
  $requester = &get_header("From") || $caller;

  ($active_file, $resolved_file, $error_file) =  &get_file_names($num);
  print "Using $active_file, $resolved_file.\n" if ($debug);
  &lock($active_file) || &dump("unable to lock $active_file"); 

  if(&resolved_request($resolved_file) || &active_request($active_file)) {
    &dump("$num is already a request");
  }

  &do_create($num, $requester);

  &write_file($active_file);
  &unlock($active_file);
}


sub run_create {
  local($caller) = @_;
  local($num, $subject, $requester, $prio, $giveto, $line);
  local($active_file, $resolved_file);
  
  $subject = &read_line("Subject", "");
  $requester = &read_line("Requester", $caller);
  $prio = &read_line("Priority", "@{DEFAULT_PRIORITY}");
  $giveto = &read_line("Give to", "");
  @file_contents = &read_lots_of_lines("Message:");

  $num = &get_next_num();

  # Insert the number into the Subject: line, taking out any old one.
  &set_header("Subject:", &build_subject_line($subject, $num));
  print "Creating \"$subject\"\n";

  ($active_file, $resolved_file, $error_file) =  &get_file_names($num);
  print "Using $active_file, $resolved_file.\n" if ($debug);
  &lock($active_file) || &dump("unable to lock $active_file"); 

  if(&resolved_request($resolved_file) || &active_request($active_file)) {
    &dump("$num is already a request");
  }

  &set_header("Subject:", $subject);
  &set_header("From:", $caller);
  &do_create($num, $requester);
  &set_header("X-Request-Priority:", $prio) if($prio);

  if($giveto) {
    @mailto = &do_give($active_file, $caller, $giveto);
    $line = &give_message($num, $giveto);
  }

  &write_file($active_file);
  &unlock($active_file);
  &mail_give_message($from, $recipient, $line, @mailto);
  if($giveto) {
    &print_comment("created and given to $giveto", $caller);
  } else {
    &print_comment("created", $caller);
  }
}


sub do_create {
  local($num, $from) = @_;
  &set_header("X-Request-Number:",   $num);
  &set_header("X-Request-Owner:",    "");
  &set_header("X-Request-User:",     $from . "\n");
  &set_header("X-Request-Date:",     $date);
  &set_header("X-Request-Due:",      "");
  &set_header("X-Request-Status:",   "open");
  &set_header("X-Request-Priority:", "@{DEFAULT_PRIORITY}");
  &set_header("X-Request-Updated:",  $date);
  &set_header("X-Request-Notified:", "");
  &set_header("X-Request-Keywords:", "");
  &set_header("X-Request-Areas:",    "");
}


# ===========================================================================
# Take routines
# ===========================================================================

sub run_take {
  local($num, $caller) = @_;
  local($line);
  local($active_file, $resolved_file);

  ($active_file, $resolved_file) =  &prep_active_file($num, $caller);

  if(!$active_file) {
     print "Sorry, request $num has been resolved.  You must open it first.\n";
     &quit_and_die(2);
  }

  if(&active_request($active_file)) {
    if($owner = &do_take($active_file, $caller)) {
      print "Sorry, request $num is already owned by $owner.\n";
      &quit_and_die();
    }
  } else {
    print "There isn't a request number $num.\n";
    &quit_and_die();
  }

  &write_file($active_file);
  &unlock($active_file);
  &print_comment("taken", $caller);
}


sub do_take {
  local($file, $who) = @_;
  local($owner);

  &read_file($file);
  $owner = &get_header("X-Request-Owner");
  if($owner ne "" && $owner ne $who && $owner ne "nobody") {
     return($owner);
  }
  &set_header("X-Request-Owner:", $who);
  &set_header("X-Request-Updated:", $date);
  &set_header("X-Request-Status:", "open");
  &append_actions("X-Request-Action: Taken by $who.");
  "";
}


# ===========================================================================
# Un-take routines
# ===========================================================================

sub run_untake {
  local($num, $caller) = @_;
  local($line);

  ($active_file, $resolved_file) =  &prep_file($num, $caller);

  if(&active_request($active_file)) {
    if(($owner = &do_untake($active_file, $caller)) != $caller) {
      print "Sorry, request $num is owned by $owner, not by you.\n";
      &quit_and_die();
    }
  } else {
    print "There isn't a request number $num.\n";
    &quit_and_die();
  }

  &write_file($active_file);
  &unlock($active_file);
  &print_comment("untaken", $caller);
}


sub do_untake {
  local($file, $who) = @_;
  local($owner);

  &read_file($file);
  $owner = &get_header("X-Request-Owner");
  if($owner ne $who) {
     return($owner);
  }
  &set_header("X-Request-Owner:", "");
  &set_header("X-Request-Updated:", $date);
  &set_header("X-Request-Status:", "open");
  &append_actions("X-Request-Action: Un-taken by $caller.");
  $owner;
}



# ===========================================================================
# Give routines
# ===========================================================================

sub run_give {
  local($num, $input, $caller, $receiver)= @_;
  local(@mailto, $line);

  ($active_file, $resolved_file) =  &prep_file($num, $caller);

  if(&active_request($active_file)) {
    @mailto = &do_give($active_file, $caller, $receiver);
    $line = &give_message($num, $receiver);
  } else {
    print "There isn't a request number $num.\n";
    &quit_and_die();
  }

  &add_any_comments($input);

  &write_file($active_file);
  &unlock($active_file);
  &mail_give_message($caller, $receiver, $line, @mailto);
  &print_comment("given to $receiver", $caller);
}


sub do_give {
  local($file, $caller, $receiver) = @_;
  local($owner, @mailto);

  &read_file($file);

  # Look up who used to own it.
  $owner = &get_header("X-Request-Owner");
  if(!($owner eq "" || $owner eq "nobody" || $owner eq $caller)) {
    push(@mailto, $owner);
  }

  # And who's getting it.
  if($receiver ne $owner && $receiver ne $caller) {
    push(@mailto, $receiver);
  }

  &set_header("X-Request-Owner:", $receiver);
  &set_header("X-Request-Updated:", $date);
  &set_header("X-Request-Status:", "open");
  &append_actions("X-Request-Action: Given to $receiver by $caller.");
  @mailto;
}


sub mail_give_message {
  #
  # Mail the give message to everyone in the @mailto list.
  #
  local($mailer, $recipient, $line, @mailto) = @_;
  local($m, $sub, @message);
  
  $sub = "Subject: $line\n";
  push(@message, $sub);
  push(@message, "From: $mailer\n");
  push(@message, "Reply-to: $mailer\n");
  foreach $m (@mailto) {
    &send_mail_to($m, @message);
  }
}


# ===========================================================================
# Subject routines
# ===========================================================================

sub run_subject {
  local($num, $subject, $caller)= @_;
  local(@mailto, $line);

  ($active_file, $resolved_file) =  &prep_file($num, $caller);

  if(&active_request($active_file)) {
    &do_subject($active_file, $caller, $subject);
    print "Subject of $num set to \"$subject\".\n";
  } else {
    print "There isn't a request number $num.\n";
    &quit_and_die();
  }

  &write_file($active_file);
  &unlock($active_file);
  &print_comment("subject changed", $caller);
}


sub do_subject {
  local($file, $caller, $subject) = @_;
  local($owner, @mailto);

  &read_file($file);

  &set_header("Subject", &build_subject_line($subject));
  &set_header("X-Request-Updated:", $date);
  &append_actions("X-Request-Action: Subject changed to \"$subject\" by $caller.");
}


# ===========================================================================
# Merge routines
# ===========================================================================

sub run_merge {  
  # <num2>:
  #  X-request-number: <num1>, <num2>
  #  X-request-owner: if only one has an owner, that person,  Else no one.
  #  X-requester:  <num1>, <num2>
  #  X-request-status: open
  #  X-request-date: (older)
  #  X-request-priority: <num2>  (Should probably be 'highest')
  #  X-request-updated: <date>
  #  X-request-notified: (latest)
  #
  #  <num1>:
  #    X-request-merged: <num2>
  #

  local($from_num, $to_num, $caller) = @_;
  local($from_active, $from_resolved, $to_active, $to_resolved);
  local($from_numline, $from_owner, $from_user, $from_date);
  local($from_priority, $from_updated, $from_notified, @from_contents);
  local(@from_header, $to_numline, $to_owner, $to_user, $to_date);
  local($to_notified);
          
  ($from_active, $from_resolved) = &prep_active_file($from_num, $caller);
  ($to_active, $to_resolved) = &prep_active_file($to_num, $caller);

  if(!$from_active) {
     print "Sorry, request $from_num has been resolved.  You must open it first.\n";
     &quit_and_die(2);
  }

  if(!$to_active) {
     print "Sorry, request $to_num has been resolved.  You must open it first.\n";
     &quit_and_die(2);
  }

  if($from_active eq $to_active) {
    print "$from_num and $to_num are already the same.\n";
    &quit_and_die();
  }

  &reread_file($from_active);
  $from_numline = &get_header("X-Request-Number");
  $from_owner = &get_header("X-Request-Owner");
  $from_user = &get_header("X-Request-User");
  $from_date = &get_header("X-Request-Date");
  $from_priority = &get_header("X-Request-Priority");
  $from_updated = &get_header("X-Request-Updated");
  $from_notified = &get_header("X-Request-Notified");
  @from_contents = @file_contents; 
  @from_header = @file_header;

  &reread_file($to_active);
  $to_numline = &get_header("X-Request-Number");
  &set_header("X-Request-Number", "$to_numline, $from_numline");
  print "$to_numline:$from_numline\n" if ($debug);

  $to_owner = &get_header("X-Request-Owner");
  $owner = ($from_owner || $to_owner);
  if($to_owner && ($owner ne $to_owner)) {
    $owner = "";
  }
  &set_header("X-Request-Owner", $owner);

  $to_user = &get_header("X-Request-User");
  &set_header("X-Request-User", &merge_comma_strings($from_user, $to_user));

  &set_header("X-Request-Status", "open");

  $to_date = &get_header("X-Request-Date");
  $from_seconds = &getseconds($from_date);
  $to_seconds = &getseconds($to_date);
  $to_date = ($from_seconds < $to_seconds) ? $from_date : $to_date;
  &set_header("X-Request-Date", $to_date);

  &set_header("X-Request-Updated:", $date);

  $to_notified = &get_header("X-Request-Notified");
  $from_seconds = &getseconds($from_notified);
  $to_seconds = &getseconds($to_notified);
  $to_notified = ($from_seconds < $to_seconds) ? $from_notified : $to_notified;
  &set_header("X-Request-Notified", $to_notified);

  &append_contents("");
  &append_contents("=" x 75);
  &append_contents("X-Request-Action: $from_num merged into $to_num by $caller.");
  &append_contents("");
  &append_contents(@from_header);
  &append_contents("");
  &append_contents(@from_contents);
  &append_contents("");
  &append_contents(" --- End of merge of $from_num --- ");

  &append_actions("X-Request-Action: $from_num merged into $to_num by $caller.");

  &write_file($to_active);
  &unlock($to_active);
  &print_comment("merged into $to_num", $caller);

  @file_header=();
  @file_contents=();
  @file_actions=();
  @file_additions=();
  &set_header("X-Request-Merged",  $to_num);
  &append_actions("X-Request-Action: $from_num merged into $to_num by $caller.");
  &write_file($from_active);
  &unlock($from_active);
}

sub merge_comma_strings {
  local($a, $b) = @_;
  local(%names, $n);

  for $n (split(",", "$a,$b")) {
    $names{$n} = $n;
  }
  join(",", keys(%names));
}



# ===========================================================================
# Priority routines
# ===========================================================================

sub run_prio {
  local($num, $input, $caller, $prio)= @_;

  ($active_file, $resolved_file) =  &prep_file($num, $caller);

  if(&active_request($active_file)) {
    &do_prio($active_file, $caller, $prio);
  } else {
    print "There isn't a request number $num.\n";
    &quit_and_die();
  }

  &add_any_comments($input);

  &write_file($active_file);
  &unlock($active_file);
  &print_comment("reprioritized to $prio", $caller);
}


sub do_prio {
  local($file, $caller, $prio) = @_;

  &read_file($file);

  $prio =~ tr/A-Z/a-z/;

  &set_header("X-Request-Updated:", $date);
  &set_header("X-Request-Status:",  "open");
  &set_header("X-Request-Priority:", $prio);
  &append_actions("X-Request-Action: Priority set to $prio by $caller.");
}


# ===========================================================================
# Reopen routines
# ===========================================================================
  
sub do_reopen {
  local($active, $resolved, $caller) = @_;
  local($merged, $m);
  local($act_file, $res_file, $err_file);

  # Gawwwds I hate taintperl.  This has been untainted so many times now...
  $resolved = &untaint($resolved);
  $active = &untaint($active);

  if(-f $resolved) {
    &lock($active) || &dump("unable to lock $active");
    &read_file($resolved);
    ($merged = &get_header("X-Request-Number")) =~ s/\s//g;
    for $m (split(",", $merged)) {
      ($act_file, $res_file, $err_file) = &get_real_file_names($m);
      if(&merged_file($res_file)) {
        rename($res_file, $act_file);
      }
    }
    rename($resolved, $active);
    &unlock($active);
  }

  &read_file($active);
  &set_header("X-Request-Status:", "open");
  &set_header("X-Request-Updated:", $date);
  &append_actions("X-Request-Action: Opened by $caller.");
}


# ===========================================================================
# User routines
# ===========================================================================


sub run_user {
  local($num, $input, $caller, $receiver)= @_;

  ($active_file, $resolved_file) = &prep_file($num, $caller);

  if(&active_request($active_file)) {
    &do_user($active_file, $caller, $receiver);
  } else {
    print "There isn't a request number $num.\n";
    &quit_and_die();
  }

  &add_any_comments($input);

  &write_file($active_file);
  &unlock($active_file);
  &print_comment("user set to $receiver", $caller);
}


sub do_user {
  local($active, $caller, $user) = @_;

  &read_file($active);
  &set_header("X-Request-User:", $user);
  &set_header("X-Request-Updated:", $date);
  &append_actions("X-Request-Action: User changed to $user by $caller.");
}


# ===========================================================================
# Show routines
# ===========================================================================

sub run_show {
  local($num, $caller) = @_;
  local($active_file, $resolved_file);
  ($active_file, $resolved_file, $error_file) =  &get_file_names($num);

  if(&active_request($active_file)) {
    open(FOO, $active_file) || &dump("Unable to open $active_file");
    while(<FOO>) {
      print;
    }
    close(FOO);
  } elsif(&resolved_request($resolved_file)) {
    open(FOO, $resolved_file) || &dump("Unable to open $resolved_file");
    while(<FOO>) {
      print;
    }
    close(FOO);
  } else {
    print "Unknown request number $num\n";
  }
}



# ===========================================================================
# Comment routines
# ===========================================================================

sub run_comment {
  local($num, $input, $caller) = @_;

  ($active_file, $resolved_file) =  &prep_file($num, $caller);

  if(&active_request($active_file)) {
    &do_comment($active_file, $caller);
  } else {
    print "There isn't a request number $num.\n";
    &quit_and_die();
  }

  &add_any_comments($input);

  &write_file($active_file);
  &unlock($active_file);
  &print_comment("commented", $caller);
}


sub do_comment {
  local($file, $caller) = @_;

  &read_file($file);
  &set_header("X-Request-Updated:", $date);
  &append_actions("X-Request-Action: Comments added by $caller.");
}


sub add_any_comments {
  local($input) = @_;
  local(*FOO);

  if($input){
    print "reading from $input\n" if ($debug); 
    open(FOO, "<$input");
    if(-t FOO) {
      print "Enter any comments, followed by an EOF.\n";
    }
    &append_additions(<FOO>);
    close(FOO);
  }
}


# ===========================================================================
# Notify routines
# ===========================================================================

sub run_notify {
  local($num, $input, $caller) = @_;

  ($active_file, $resolved_file) =  &prep_file($num, $caller);

  if(&active_request($active_file)) {
    &do_notify($active_file, $caller);
  } else {
    print "There isn't a request number $num.\n";
    &quit_and_die();
  }

  &add_any_comments($input);

  &write_file($active_file);
  &unlock($active_file);
  &print_comment("notified", $caller);
}


sub do_notify {
  local($file, $caller) = @_;
  local($requester) = &get_header("X-Request-User");

  &read_file($file);
  &set_header("X-Request-Updated:", $date);
  &set_header("X-Request-Notified:", $date);
  &append_actions("X-Request-Action: $requester notified by $caller.");
}


# ===========================================================================
# Kill routines
# ===========================================================================

sub run_kill {
  # This one actually deletes the file.  It's not clear if this really
  # should be here, but let's see how it works out.
  #
  local($num, $caller) = @_;
  local($subj, $user, $numbers, $n);

  ($active_file, $resolved_file) =  &prep_file($num, $caller);

  if(!&active_request($active_file)) {
    print "There isn't a request number $num.\n";
    &quit_and_die();
  }
  &read_file($active_file);
  $subj = &take_out_req(&get_header("subject"));
  $user = &get_header("X-Request-User");
  ($numbers = &get_header("X-Request-Number")) =~ s/\s//g;
  print "Really kill #$num ($subj)?\n";
  if(&y_or_n("[y/n]> ")) {
    if(unlink($active_file)) {    # I HATE taintperl... don't use && here.
      if(open(KILL, ">>@{CODE_KILLLOG}")) {
	print KILL "#$num ($subj) from $user killed by $caller on $date.\n";
	close(KILL);
      } else {
	print "warning: unable to open @{CODE_KILLLOG}\n";
      }
      foreach $n (split(",",$numbers)) {
         ($active, $resolved, $err) = &get_real_file_names($n);
         unlink($active) if (-f $active);
         unlink($resolved) if (-f $resolved);
         unlink($err) if (-f $err);
      }
    }
  } 

  &unlock($active_file);
  &print_comment("killed", $caller);
}


# ===========================================================================
# Stall routines
# ===========================================================================

sub run_stall {
  local($num, $input, $caller) = @_;

  ($active_file, $resolved_file) =  &prep_file($num, $caller);

  if(&active_request($active_file)) {
    &do_stall($active_file, $caller);
  } else {
    print "There isn't a request number $num.\n";
    &quit_and_die();
  }

  &add_any_comments($input);

  &write_file($active_file);
  &unlock($active_file);
  &print_comment("stalled", $caller);
}


sub do_stall {
  local($file, $caller) = @_;

  &read_file($file);
  &set_header("X-Request-Updated:", $date);
  &set_header("X-Request-Status:", "stalled");
  &append_actions("X-Request-Action: Stalled by $caller.");
}




# ===========================================================================
# Unstall/open routines
# ===========================================================================

sub run_open {
  local($num, $input, $caller) = @_;

  ($active_file, $resolved_file) =  &prep_file($num, $caller);

  if(&active_request($active_file)) {
    &do_open($active_file, $caller);
  } else {
    print "There isn't a request number $num.\n";
    &quit_and_die();
  }

  &add_any_comments($input);

  &write_file($active_file);
  &unlock($active_file);
  &print_comment("opened", $caller);
}


sub do_open {
  local($file, $caller) = @_;

  &read_file($file);
  &set_header("X-Request-Updated:", $date);
  &set_header("X-Request-Status:", "open");
  &append_actions("X-Request-Action: Opened by $caller.");
}



# ===========================================================================
# File reading routines
# ===========================================================================


sub prep_file {
  # Find the file related to the number, lock it, move it to
  # unresolved, and return the file names used.
  #
  local($num, $caller) = @_;
  local($active_file, $resolved_file);

  ($active_file, $resolved_file, $error_file) =  &get_file_names($num);
  print "Using $active_file, $resolved_file.\n" if ($debug);

  &lock($active_file) || &dump("unable to lock $active_file"); 

  if(&resolved_request($resolved_file)) {
    &do_reopen($active_file, $resolved_file, $caller);
  }

  ($active_file, $resolved_file);
}

sub prep_active_file {
  # Find the file related to the number, make sure it's active, and then
  # lock it and return the file names used.
  #
  # If it's not active, return the empty string.
  #
  local($num, $caller) = @_;
  local($active_file, $resolved_file);

  ($active_file, $resolved_file, $error_file) =  &get_file_names($num);
  print "Using $active_file, $resolved_file.\n" if ($debug);

  &lock($active_file) || &dump("unable to lock $active_file"); 

  if(&resolved_request($resolved_file)) {
    return ("","");
  }

  ($active_file, $resolved_file);
}


sub reread_file {
  local($file) = @_;
  local($file_name);
  
  ($file_name = $file) =~ s:.*/::;

  $have_read_file{$file_name} = 0;
  &read_file($file);
}


sub read_file {
  local($file) = @_;
  local($file_name);

  ($file_name = $file) =~ s:.*/::;

  if(!$have_read_file{$file_name}) {
    if($file eq "-" || -f $file) {
      print "reading $file\n" if($debug);
      open(FILE, "<$file") || &dump("Can't open $file");
      &read_headers(*FILE);
      &read_body(*FILE);
      close(FILE);
    } else {
      print "file $file not found\n" if ($debug);
    }
  } else {
    print "not rereading $file\n" if($debug);
  }

  $have_read_file{$file_name} = 1;
}


sub read_body {
  local(*FILE) = @_;
  @file_contents = <FILE>;
}


# ==========================================================================
# Routines dealing with header fields
# ==========================================================================

sub read_headers {
  #  Read the header of a message, putting the actual lines in the array:
  #     @file_header
  #  Create an assoc list keyed on the downcased header lines called:
  #     %file_header
  #  The assoc list understands header continuation lines, so can cope with
  #  many lines of To: fields, for example.
  #
  local(*FILE) = @_;
  local($i, $prvious_header);

  @file_header = ();
  while(<FILE>) {
    last if(/^\s*$/);
    push(@file_header, $_);
  }

  %file_header=();
  for($i=0;$i<=$#file_header;$i++) {
    if($file_header[$i] =~ /^(\S+):(.*)\s*$/) {
      ($previous_header = $1) =~ tr/[A-Z]/[a-z/;
      $file_header{$previous_header} = $2;
    } elsif($file_header[$i] =~ /^(\s+)(.*)\s*$/) {
      $file_header{$previous_header} .= $file_header[$i];
    }
  }
}


sub set_header {
  #  Take a header (like "Subject:") and a value for it, remove any
  #  trailing spaces, make sure there's a ":" in the line.
  #
  #  Put that line in for one of the same type, or add it if it wasn't
  #  there.
  #
  #  Doesn't cope with multi-line header types.
  # 
  local($label, $value) = @_;
  local($i, $newline);

  $label =~ s/:*\s*$//; 
  $value =~ s/\s*$//;
  $newline = "$label: $value\n";
  for($i=0; $i <= $#file_header; $i++) {
    if($file_header[$i] =~ /^$label/i) {
      $file_header[$i] = $newline;
      last;
    }
  }
  if($i > $#file_header) {
    push(@file_header, $newline);
  }
}


sub get_header {
  # Looks up the data part of a header.  Strips off any colons and ignores
  # case.
  #
  local($label) = @_;
  local($i);

  $label =~ s/\s*$//;
  $label =~ s/:$//;

  for($i=0; $i <= $#file_header; $i++) {
    if($file_header[$i] =~ /^$label:\s*(.*)\s*$/i) {
      return($1);
    }
  }
  "";
}


sub get_date_header {
  local($label) = @_;
  local($r);

  if(!($r = &get_header($label))) {
    return "";
  }
  $r =~ s:\n::;
  $r . " (" . time() . ")";
}     


# ===========================================================================
# Routines that help build the final file written.
# ===========================================================================
 
sub append_header {
  for $line (@_) {
    $line =~ s:\n*$::;
    push(@file_header, "$line\n");
  }
}


sub append_headers {
  # Work around common typo.
  &append_header(@_);
}


sub append_contents {
  for $line (@_) {
    $line =~ s:\n*$::;
    push(@file_contents, "$line\n");
  }
}


sub append_actions {
  for $line (@_) {
    $line =~ s:\n*$::;
    push(@file_actions, "$line\n");
  }
}


sub append_additions {
  for $line (@_) {
    $line =~ s:\n*$::;
    push(@file_additions, "$line\n");
  }
}


sub write_file {
  # @file_header's X-Request lines are printed first to make the headers 
  # more uniform.
  local($file) = @_;

  $file=&untaint($file);  # dammit
  open(FILE,">$file") || &dump("Can't open $file");
  print FILE grep(/^X-Request/i, @file_header);
  print FILE grep(!/^X-Request/i, @file_header);
  print FILE "\n";
  print FILE @file_contents;
  if($#file_actions >= 0) {
    &append_actions("X-Request-Acted: $date");
    print FILE "\n";
    print FILE "=" x 75, "\n";
    print FILE @file_actions;
  }
  if($#file_additions >= 0) {
    print FILE "\n";
    print FILE @file_additions;
  }
  close(FILE);
}


# ===========================================================================
# Header analysis routines
# ===========================================================================

sub from {
  # Try to parse the From: line to get the person's email address.
  # Note that we leave the machine address in with the login name in case
  # the address is non-local.
  #
  local($who) = @_;

  if($who eq "") {
    return("nobody");
  }
  if($who =~ /<(.*)>/) {
    return($1);
  }
  if($who =~ /\s*(.*)\(.*\)(.*)\s*/) {
    return($1 . $2);
  }
  $who =~ /\s*(\S*)\s*/;
  $1;
}


sub notifying {
  # Here we're trying to see if the original requester is a recipient of
  # the mail.  If so, they've been notified.
  #
  # If there are multiple requesters (from a merge), we check to make
  # sure _all_ of them were notified.
  #
  # So we extract the original requester(s) our of the message, drop any
  # part of their name but their login name, and then see if that appears
  # in the to: or cc: lines. 
  #
  # This isn't perfect, but it should mostly work.
  #
  local($filename, $to, $cc) = @_;
  local($u, $notified, @users);

  $notified = 0;
  &read_file($filename);
  @users=split(",", &get_header("X-Request-User"));
  for $u (@users) { 
    $u =~ s:@.*::;
    $notified++ if(($to =~ /\b$u\b/) || ($cc =~ /\b$u\b/));
  }
  $notified == $#users+1;
}


sub extract_request_number {
  # Grub the request number out of the input, which is probably a Subject: 
  # line. 
  # Be careful here, as the number will be part of a file name.
  # Allowing stuff like "../../etc/passwd" to be a number would be bad.
  #
  local($line) = @_;
  if($line =~ /@{PERL_TAGLINE_COMPARE}/) {
    return($1);
  }
  0;
}


sub mail_header_commands {
  # Grub through the array given to us, looking for headers with the
  # X-Request-Do: type header, returning an array of the associated commands.
  #
  local(@mail_headers) = @_;
  local($i, @do_these) = (0);

  for($i=0;$i<=$#mail_headers;$i++) {
    if($mail_headers[$i] =~ /^X-Request-Do:\s*(.*)\s*$/i) {
      push(@do_these, $1);
    }
  }
  @do_these;
}



# ===========================================================================
# Subject line formatting routines
# ===========================================================================

sub subject_equivalent {
  #
  # Given two subject lines, see if they're roughly the same thing.
  #
  local($a, $b) = @_;

  &subject_minimal($a) eq &subject_minimal($b);
}


sub subject_minimal {
  # 
  # Given a subject line, rip out the req# and any things that look like
  #  Re:
  # and any leading or trailing white space.
  #
  local($s) = @_;
  $s = &take_out_req($s);
  $s =~ s/\s+Re://gi;
  $s =~ s/^Re://gi;
  $s =~ s/^\s*//;
  $s =~ s/\s*$//;
  $s;
}


sub take_out_req {
  #
  # Extract the request number section of a req
  #
  local($line) = @_;

  $line =~ s:@{PERL_TAGLINE_COMPARE}\s*::;
  $line;  
}


sub build_subject_line {
  #
  # Given a string, build a subject out of it.
  # If a number is given as the second argument, put that in as the
  # request number.
  #
  local($subj, $number) = @_;
  if(!defined($number)) {
    $number = $num ? $num : &extract_request_number($subj);
  }
  sprintf("@{TAGLINE_PRINTF}", $number, &subject_minimal($subj));
}


# ===========================================================================
# Comment-related routines
# ===========================================================================

sub make_comment {
  #
  # This routine builds a regularly formatted output describing the
  # action that took place.  
  #
  local($comment) = @_;
  local($subj);

  if($num == 0) {
    $subj = &get_header("subject");
    $num = &extract_request_number($subj);
    $subj = &subject_minimal($subj);
  } else {
    $subj = &subject_minimal(&get_header("subject"));
  }
  "$subj (#$num) $comment";
}


sub print_comment {
  local($comment, $caller) = @_;
  local($line, $time, @time);
  print $line = &make_comment($comment), ".\n";
  &do_log_comment($line, " by $caller.");
}


sub log_comment {
  #
  # The routine that builds the log comment and then logs it.
  #
  local($comment, $caller) = @_;
  local($line);
  $line = &make_comment($comment);
  &do_log_comment($line, " by $caller.");
}


sub do_log_comment {
  #
  # This routine logs a comment to the logfile.
  #
  local(@comment) = @_;
  local(@time, $time);

  @time = split('\s+',&ctime(time()));
  $time="$time[3], $time[1] $time[2]";

  if ($do_logging) {
    open(LOG, ">>$req_logfile") || &dump("can't open $req_logfile");
    print LOG join("",@comment);
    print LOG " $time\n";
    close(LOG);
  }
}


sub give_message {
  local($num, $receiver) = @_;
  local($subj);

  $subj = &subject_minimal(&get_header("subject"));

  "$subj (#$num) has been given to $receiver.";
}


# ===========================================================================
# Imagine a useful description of what this set of routines does.
# ===========================================================================


sub get_next_num { 
  open(FOO,"$new_number|") || &dump("unable to run $new_number");
  chop($num = <FOO>);
  close(FOO);
  &untaint($num);
}


sub send_mail_to {
  local($to, @message) = @_;

  $to = &untaint($to);
  unshift(@message, "To: $to\n");
  if(open(MAIL, "|@{SENDMAIL_PROGRAM} $to")) {
    print MAIL @message;
    close(MAIL);
  } else {
    warn "unable to send mail to $to";
  }
}


sub check_permissions {
  local($caller) = @_;
  local($mailer_uid, $group_gid);

  if($mode eq "mail") {
    if($mailer_name eq "skip-mail-permissions-check") {
      return(1);
    }
    $mailer_uid = (getpwnam($mailer_name))[2];
    if($< == $mailer_uid) {
      return(1);
    }
  }

  $group_gid = (getgrnam($group_name))[2];
  print "$group_name: $group_gid\n" if ($debug);
  print "groups: $(\n" if($debug);
  foreach $g (split(/\s/,$()) {
    if( $g == $group_gid ) {
      return(1);
    }
  }

  return(0);
}

sub untaint {
  local($foo) = @_;
  $foo =~ /^(.*)$/;
  $1;
}


sub y_or_n {
  local($prompt) = @_;

  print STDOUT $prompt;
  local($answer) = scalar(<STDIN>);
  &untaint($answer);   # LAME
  $answer =~ /^y/i;
}


sub read_line {
  local($prompt, $default) = @_;
  local($answer);

  print STDOUT $prompt;
  print STDOUT " [$default]"  if($default);
  print STDOUT ": ";
  $answer = scalar(<STDIN>);
  chop($answer);
  if($answer =~ /^\s*$/) {
    $answer = $default;
  }
  $answer;
}


sub read_lots_of_lines {
  local($prompt) = @_;
  local(@answer);

  print STDOUT $prompt, "\n";
  print STDOUT " (Enter a line with a only a . or ^D in it when you're done.)\n";
  push(@answer, $_) while (($_ = <STDIN>) && ($_ ne ".\n" && $_ ne "~q\n"));

  chop $_;
  if ($_ eq "~q") {
    print "Aborted.\n";
    &quit_and_die();
  }
  @answer;
}


sub getseconds {
  local($datestr) = @_;
  local($sec);

  # Look for the number of seconds to be in parenthesis on the date line.
  if($datestr =~ /\((\d+)\)/) {
    return $1;
  }

  if($datestr = /^\s*$/) {
    return 0;
  }

  # Otherwise, parse the date string.
  if(!(($datestr =~ /[A-Z][A-Z][A-Z]/) || ($datestr =~ /-\d\d\d/))) {
    $datestr .= " EDT";
  }
  $datestr =~ s:\(.*\)::;
  open(DATEFOO, "@{CODE_GETDATE} \"$datestr\"|") || &dump("Can't run getdate");
  chop($sec = <DATEFOO>);
  close(DATEFOO);

  $sec;
}


# ===========================================================================
# Routines that know about merged requests
# ===========================================================================

sub get_file_names {
  local($newnum) = @_;
  local($num, $active_file, $resolved_file, $error_file);

  do {
    $num = $newnum;
    ($active_file, $resolved_file, $error_file) = 
	&get_real_file_names($num);
  } while(($newnum = &merged_file($active_file)) || 
	  ($newnum = &merged_file($resolved_file)));
  ($active_file, $resolved_file, $error_file);
}


sub merged_file {
  local($file) = @_;
  local($num);

  $num = 0;
  if( -f $file) { 
    open(FOO, "$file") || &dump("Unable to open $file");
    if(scalar(<FOO>) =~ /^X-Request-Merged:\s*(\d+)\s*$/i) {
      $num=$1;
    }
    close(FOO);
  }
  
  $num;
}


# ===========================================================================
# Routines that know about the resolved and active queues.
#   Isolate this knowlege in these routines, and we can reimplement the
#   underlying mechansisms if necessary.
# ===========================================================================

sub get_real_file_names {
  # Given a request number, return the name of the associated active file
  # and resolved file.  
  # Don't do any checking for existence, but should probably make sure
  # the files are in reasonable places for security reasons.
  #
  local($num) = @_;
  (&untaint("$active_dir/$num"), 
   &untaint("$resolved_dir/$num"), 
   &untaint("$error_dir/$num:$$"));
}
  

sub resolved_request {
  local($file) = @_;
  (-f $file);
}


sub active_request {
  local($file) = @_;
  (-f $file);
}


# ===========================================================================
# Exit routines
# ===========================================================================

sub quit_and_die {
  #
  #
  # 
  local($error_level) = @_;
  if(!defined($error_level)) {
    $error_level = 1;
  }

  &unlock_all();
  exit($error_level);
}


sub dump {
  local($reason) = @_;

  &unlock_all();
  &write_file($error_file);
  die $reason;
}



# ===========================================================================
# Locking routines
# ===========================================================================

sub lock {
  # Locking files under UNIX is a nightmare, and using perl only makes it
  # worse.  This routine avoids the use of lockf() or flock() and instead
  # creates a separate lock file.  After creating it, it makes sure that
  # its own PID is in the file, which ensures against most of the simultaneous
  # lock issues.
  #
  # Keep track of the files that we've locked in case we're killed and
  # need to unlock them all.
  #
  # If multiple requests to lock the same file happen, simply increment
  # the lock count for that file... it's already locked.
  #
  # After some number of lock attempts, it fails, returning a 0.
  # If the lock is successfull, it returns a 1.
  #
  local($file) = @_;
  local($i, $maxtries) = (0, 10);

  $file = &untaint($file);
  # See if it's already locked.
  if($locked{$file}) {
    return(++$locked{$file});
  }

  do {
    while(-f "$file.lock") {
      print "$file.lock exists\n" if ($debug);
      if(++$i >= $maxtries) {
        $locked{$file} = 0;
        return(0);
      }
      print "try $i\n" if ($debug);
      sleep(5);
    }
    open(FOOLOCK, ">$file.lock") || &dump("unable to open $file.lock");
    print FOOLOCK "$file locked by process $$ on ", `hostname`;
    close(FOOLOCK);

    $locked{$file} = 1;

    sleep(2);

    open(FOO, "<$file.lock");
    <FOO> =~ /process (\d+) on/;
    close(FOO);

  } while($1 != $$);

  return(1);
}


sub unlock {
  # unlock the file, first making sure it was us who locked it.  Extraneous
  # lock files may get left around if they're not in the right format.
  #
  local($file) = @_;

  $file = &untaint($file);
  if(--$locked{$file} == 0) {
    open(FOO, "<$file.lock");
    <FOO> =~ /process (\d+) on/;
    close(FOO);
    unlink("$file.lock") if($1 == $$) ;
  }
}


sub unlock_all {
  for $file (keys(%locked)) {
    if($locked{$file}) {
      $locked{$file} = 1;
      &unlock($file);
    }
  }
}


# ===========================================================================
# Debugging routines
# ===========================================================================

sub dump_header {
  for($i=0;$i<=$#file_header;$i++) {
    print "$i: $file_header[$i]";
  }
  print "\n";
  for $k (keys(%file_header)) {
    print "$k: $file_header{$k}\n";
  }
}

