#!@{PERL_PATH} @{WFLAG}
#
# req-operation - operate on the files in the request system
#
# $Id: req-operation,v 1.28 2002/03/19 18:54:03 jwise 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.
use strict;
no strict "vars";

push (@INC, "@{CODE_LIB_DIR}");

require "ctime.pl";
require "req-config.pl";
require "req-common.pl";

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

$debug = 0;
    
@file_header    = ();
@file_contents  = ();
@file_actions   = ();
@file_additions = ();

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

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

# XXX -- _need_ to check if user is allowed to call req

&parse_commandline();        


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

sub version {
  print "MiniReq version $version_num\n";
}


sub usage {
  version();
  print "usage:\n";
  print "        $program [-d] <subcommand>\n";
  print "where <subcommand> is one of:\n";
  print "        help\n";
  print "        create\n";
  print "        mcreate <file>\n";
  print "        show <num>\n";
  print "        take <num>\n";
  print "        untake <num>\n";
  print "        steal <num> [file]\n";
  print "        give <num> <user> [file]\n";
  print "        user <num> <user> [file]\n";
  print "        comment <num> <file>\n";
  print "        subject <num> \"<subject>\"\n";
  print "        priority <num> <prio> [file]\n";
  print "        notify <num> [file]\n";
  print "        merge <num1> <num2>  (num1 into num2)\n";
  print "        resolve <num> [file]\n";
  print "        stall <num> [file]\n";
  print "        unstall <num> [file]\n";
  print "        open <num> [file]\n";
  print "        reopen <num> [file]\n";
  print "        kill <num>\n";
# print "        mail [file]\n";
  print "        version\n";
  print "\n";
  print "If [file] is \"-\", stdin is used.\n";
  print "The -d flag produces debugging output.\n";
}  


sub parse_commandline {
	&usage if !@ARGV;

	while (defined($_ = shift @ARGV))
	{
		if (/^-d$/) {
    			$debug = 1;
			print "Turning on debugging.\n";
			next;
  		}
		if (/^-*help$/) {
			&usage;
			exit 0;
		}
	 	if (/^-*version/) { 
			&version;
			exit 0;
  		}

  		if (/^-by$/) {
			# XXX -- this _needs_ to be restricted
			$caller = shift(@ARGV);
			next;
		}  

		if (/^-*mail$/) {
			$input = shift @ARGV;
			if (!defined($input)) {
				&usage;
				exit(1);
			}
			print "set input = $input\n"  if($debug);
			&run_mail_mode;
			exit 0;
		}
		if (/^-*resolve$/) {
			$num = shift @ARGV;
			$input = shift @ARGV;
			if (!defined($num)) {
				&usage;
				exit(1);
			}
			defined($input) || ($input = 0);
			&run_resolve($num, $input, $caller);
			exit 0;
  		}
		if (/^-*comment$/) {
			$num = shift @ARGV;
			$input = shift @ARGV;
			if (!defined($num)) {
				&usage;
				exit 1;
			}
			defined($input) || ($input = '-');
			&run_comment($num, $input, $caller);
			exit 0;
  		}
		if(/^-*create$/) {
			&run_create($caller);
			exit 0;
		}
		if(/^-*mcreate$/) {
			$input = shift @ARGV;
			defined($input) || ($input = '-');
			&run_create_from_mail($input, $caller);
			exit 0;
  		}
		if (/^-*take$/) {
			$num = shift @ARGV;
			if (!defined($num)) {
				&usage;
				exit 1;
			}
			&run_take($num, $caller);
			exit 0;
  		}
		if(/^-*untake$/) {
			$num = shift @ARGV;
			if (!defined($num)) {
				&usage;
				exit 1;
			}
			&run_untake($num, $caller);
			exit 0;
		}
		if (/^-*steal$/) {
			$num = shift @ARGV;
			$input = shift @ARGV;
			if (!defined($num)) {
				&usage;
				exit 1;
			}
			defined($input) || ($input = 0);
			&run_give($num, $input, $caller, $caller);
			exit 0;
  		}
		if (/^-*give$/) {
			$num = shift @ARGV;
			$recipient = shift @ARGV;
			$input = shift @ARGV;
			if (!defined($num) || !defined($recipient)) {
				&usage;
				exit 1;
			}
			defined($input) || ($input = 0);
			&run_give($num, $input, $caller, $recipient);
			exit 0;
  		}
		if (/^-*user$/) {
			$num = shift @ARGV;
			$recipient = shift @ARGV;
			if (!defined($num) || !defined($recipient)) {
				&usage;
				exit 1;
			}
			defined($input) || ($input = 0);
			&run_user($num, $input, $caller, $recipient);
			exit 0;
		}
		if (/^-*subject$/) {
			$num = shift @ARGV;
			$newsubj = shift @ARGV;
			if (!defined($num) || !defined($newsubj)) {
				&usage;
				exit 1;
			}
			&run_subject($num, $newsubj, $caller);
			exit 0;
		}
		if (/^-*priority$/ || /^-*prio$/ ) {
			$num = shift @ARGV;
			$prio = shift @ARGV;
			$input = shift @ARGV;
			if (!defined($num) || !defined($prio)) {
				&usage;
				exit 1;
			}
			defined($input) || ($input = 0);
			&run_prio($num, $input, $caller, $prio);
			exit 0;
  		}
		if (/^-*notify$/) {
			$num = shift @ARGV;
			if (!defined($num)) {
				&usage;
				exit 1;
			}
			defined($input) || ($input = 0);
			&run_notify($num, $input, $caller);
			exit 0;
		}
		if (/^-*stall$/) {
			$num = shift @ARGV;
			$input = shift @ARGV;
			if (!defined($num)) {
				&usage;
				exit 1;
			}
			defined($input) || ($input = 0);
			&run_stall($num, $input, $caller);
			exit 0;
		}
		if (/^-*unstall$/ || /^-*reopen$/ || /^-*open$/) {
			$num = shift @ARGV;
			$input = shift @ARGV;
			if (!defined($num)) {
				&usage;
				exit 1;
			}
			defined($input) || ($input = 0);
			&run_open($num, $input, $caller);
			exit 0;
  		}
		if (/^-*kill$/) {
			$num = shift @ARGV;
			if (!defined($num)) {
				&usage;
				exit 1;
			}
			&run_kill($num, $caller);
			exit 1;
  		}
		if (/^-*merge$/) {
			print "merge currently disabled\n";
			exit 1;

			$num = shift @ARGV;
			$newnum = shift @ARGV;
			if (!defined($num) || !defined($newnum)) {
				&usage;
				exit 1;
			}
			&run_merge($num, $newnum, $caller);
			exit 0;
  		}
		if (/^-*show$/) {
			$num = shift @ARGV;
			if (!defined($num)) {
				&usage;
				exit 1;
			}
			&run_show($num, $caller);
			exit 0;
  		}
		&usage;
		exit 1;
	}
}
  

# ===========================================================================
# 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);

  print "run_mail_mode (input = $input) called.\n" if ($debug);

  # Read the mail, and store the info in local data structures.
  &read_file_once($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_val("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_once($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_once($active);
  ($merged = &get_header_val("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_once($input);
  }

  $num = &get_next_num();

  # Insert the number into the Subject: line, taking out any old one.
  $subject = &get_header_val("Subject");
  &set_header("Subject:", &build_subject_line($subject, $num));
  $date = &get_date_header("Date") || $date;
  $requester = &get_header_val("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);
  &print_comment("created", $caller);
}


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("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_once($file);
  $owner = &get_header_val("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_once($file);
  $owner = &get_header_val("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_once($file);

  # Look up who used to own it.
  $owner = &get_header_val("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_once($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_val("X-Request-Number");
  $from_owner = &get_header_val("X-Request-Owner");
  $from_user = &get_header_val("X-Request-User");
  $from_date = &get_header_val("X-Request-Date");
  $from_priority = &get_header_val("X-Request-Priority");
  $from_updated = &get_header_val("X-Request-Updated");
  $from_notified = &get_header_val("X-Request-Notified");
  @from_contents = @file_contents; 
  @from_header = @file_header;

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

  $to_owner = &get_header_val("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_val("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_val("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_val("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_once($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_once($resolved);
    ($merged = &get_header_val("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_once($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_once($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_once($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); 
    if (open(FOO, "<$input")) {
      if(-t FOO) {
        print "Enter any comments, followed by an EOF.\n";
      }
      &append_additions(<FOO>);
      close(FOO);
    } else {
      print "Couldn't open $input for reading.\n";
      &quit_and_die();
    }
  }
}


# ===========================================================================
# 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_val("X-Request-User");

  &read_file_once($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_once($active_file);
  $subj = &take_out_req(&get_header_val("subject"));
  $user = &get_header_val("X-Request-User");
  ($numbers = &get_header_val("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_once($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_once($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_once {
  local($file) = @_;
  local($file_name);

  print "read_file_once($file) called\n" if($debug);

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

  if(!$have_read_file{$file_name}) {
    if("$file" eq "-"){
      print "reading STDIN\n" if($debug);
      &read_headers(*STDIN);
      &read_body(*STDIN);
    } elsif(-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, $previous_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];
    }
  }
    &dump_header() if ($debug);
}


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_val {
  # 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_val($label))) {
    return "";
  }
  $r =~ s:\n::;
  $r . " (" . time() . ")";
}     


# ===========================================================================
# Routines that help build the final file written.
# ===========================================================================
 
sub append_header {
  local(@args) = @_;

  for $line (@args) {
    $line =~ s:\n*$::;
    push(@file_header, "$line\n");
  }
}


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


sub append_contents {
  local(@args) = @_;

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


sub append_actions {
  local(@args) = @_;

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


sub append_additions {
  local(@args) = @_;

  for $line (@args) {
    $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_once($filename);

  my($user_str) = &get_header_val("X-Request-User");
  $user_str =~ s/\([^\)]+\)//g;  # remove (blah, blah)'s
  $user_str =~ s/[ \t]+/ /g;     # remove extra spaces

  @users = split(/[ ,]+/, $user_str);

  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_val("subject");
    $num = &extract_request_number($subj);
    $subj = &subject_minimal($subj);
  } else {
    $subj = &subject_minimal(&get_header_val("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_val("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($group_gid);

  $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";
  while (defined($_ = <STDIN>) && ($_ ne ".\n")) {
  	push(@answer, $_)
  }

  @answer;
}


# ===========================================================================
# 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();
  &append_additions("\n");
  &append_additions($reason);
  &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});
  }

  while($1 != $$) {
    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);
  }

  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";
  }
}

