#!@{PERL_PATH} @{WFLAG}
#
# req-mailgate
#  Run on the mail server on new systems mail.
#
# $Id: req-mailgate,v 1.8 2001/01/11 08:39:42 jwise Exp $
#
# 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.

# ===========================================================================
# To do:
#   Test with bad mail headers


# ===========================================================================
# Basic Algorithm:
# 
# read a message from stdin
#
# if it doesn't have req number in the subject line
#   if it should get a req number
#     get a new one, 
#     fix the subject line
#
# if the cc line should be munged
#   munge it
#
# run the mail through sendmail
#
# if it should be given to req
#   give it to req
#   if it should be autoreplied
#     generate autoreply and send it
#
#
# ===========================================================================


# ---------------------------------------------------------------------------
# Main
#  Get configuration.
#  Set the permissions correctly.
#  Read the file.
#
# Globals
#   $req_number        The number of the req - 0 if there isn't one.
#   $new_req           Non zero if this is a new request.
#   $sys               The regexp of the mailing list that should get reqs.
#   $sub_str        
#   $new_number	       The program to run to get the next req number.
#   $mail_body_file    The file the body of the mail is stored in.
#   $mail_header_file  The file the header of the mail is stored in.

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

require "req-mailadt.pl";
require "ctime.pl";

&set_globals($0, $ARGV[0]);
&get_configs();
&start_debugging if ($debug);
&set_permissions();
&headers_init(&message_read_header());
&message_dump_body();

if(!($req_number = &message_get_req())) {
  if(&message_should_get_req()) {
    &message_insert_req($req_number = $new_req = &req_get_new_number());
  }
}

if($config_modify_cc) {
  &message_add_to("cc", "$mailing_list_name");
}

&message_dump_headers();

&run_sendmail_on_mail();

if($req_number) {
  &run_req_on_mail();
  if(&autoreply_check()) {
    &run_autoreply_on_mail();
  }
}

&clean_up();

exit(0);

# ===========================================================================


# ---------------------------------------------------------------------------
# Setting up the environment.
# ---------------------------------------------------------------------------

sub set_globals {
  # 
  # Set globals.  Keep 'em here to find them and get them out of the way.
  # Note that many of these are subbed in during the install process.
  #
  # This expects $0 to be passed in as the first argument, and $ARGV[0]
  # as the second argument.
  #  
  #
  local($command_line_argv0, $arg) = @_;

  if($arg eq "-d") {
    $debug = 1;
  } elsif ($arg eq "-dd") {
    $debug = 1;
    $reqmail_debug = 1;	
  }

  ($program =  $command_line_argv0) =~ s:.*/::;

  $req_number = 0;
  $new_req = 0;

  $sys = "@{MAILING_LIST}";
  $mailing_list_ignore = "@{MAILING_LIST_IGNORE}";
  $mailing_list_name = "@{MAILING_LIST_NAME}";
  $mailing_list_dist = "@{MAILING_LIST_DIST}";
  $mailing_list_user_name = "@{MAILING_LIST_TITLE}";  
  $sub_str   = "@{TAGLINE_PRINTF}";
  $run_nextnum = "@{CODE_NEXTNUM}";
  $run_req = "@{CODE_REQ} mail -";
  $run_sendmail = "@{SENDMAIL_PROGRAM}";
  $run_autoreply = "@{CODE_AUTOREPLY}";

  $mail_body_file = "@{TMP_DIR}/req.body.$$";
  $mail_header_file = "@{TMP_DIR}/req.header.$$";
  $mail_auto_file = "@{TMP_DIR}/req.auto.$$";

  $SIG{'INT'} = "clean_up";
  $SIG{'QUIT'} = "clean_up";
  $ENV{'PATH'} = "/bin";
  $ENV{'SHELL'} = "/bin/sh";
  $ENV{'IFS'} = '';
  $ENV{'ENV'} = '';
}


sub get_configs {
  #
  # Read the configuration file for this instantiation of req.
  #

  $config_modify_cc    = @{CONFIG_MODIFY_CC};
  $config_match_on_cc  = @{CONFIG_MATCH_ON_CC};
  $config_do_autoreply = @{CONFIG_DO_AUTOREPLY};
  $config_add_reply_to = @{CONFIG_ADD_REPLY_TO};
  $config_sendfrom     = @{CONFIG_USE_SENDMAIL_FROM};
}


sub set_permissions {
   # Set the permissions to the correct values for this instantiation.
   # This is just a stub for later expansion.
}


sub clean_up {
  #
  # Any mopping up that needs to be done.
  #
  unlink($mail_body_file) if(-f $mail_body_file && !$debug);
  unlink($mail_header_file) if(-f $mail_header_file && !$debug);
  unlink($mail_auto_file) if(-f $mail_auto_file && !$debug);
  if($debug) {
    print DEBUG "debugging turned on - NOT deleting temporary files\n";
    print DEBUG "program exiting at ", &ctime(time()), "\n";
    close(DEBUG);
  }
}



# ---------------------------------------------------------------------------
# Reading the message
# ---------------------------------------------------------------------------


sub message_read_header {
  #
  # Read the mail headers from stdin.
  #
  local(@header);
  while(<STDIN>) {
    chop;
    last if(/^\s*$/);
    push(@header, $_);
  }
  return(@header);
}


sub message_dump_body {
  #
  # Dump the mail body from stdin to a file, which we can pass to 
  # various other processes.
  # 
  open(OUT, ">$mail_body_file") || 
    die "Unable to open $mail_body_file for writing";
  while(<STDIN>) {
    print OUT || die "Unable to write to $mail_body_file";
  }
  close(OUT);
}


sub message_dump_headers {
  #
  # Dump the headers (probably modified) to a file, which we can pass to
  # various other processes.
  # 
  open(OUT, ">$mail_header_file") || 
    die "Unable to open $mail_header_file for writing";
  select(OUT);
  &headers_dump || die "Unable to write to $mail_header_file";
  close(OUT);
  select(STDOUT);
}


sub message_get_req {
  #
  # Extract the req number from the subject line and return it.
  # Returns 0 if it didn't find it.
  #
  if(&header_get("subject") =~ /@{PERL_TAGLINE_COMPARE}/i) {
    &debug("Found req number $1 in the subject.\n");
    return $1;
  }
  &debug("Didn't find a req number in the subject.\n");
  return 0;
}


sub message_should_get_req {
  #
  # Check to see if this should get a req number based on the headers.
  # Be pretty lenient here... the mail system has already decided that
  # it's being sent to this list, so there's no reason to check for 
  # pathological things in the to or resent-to fields.
  #
  # In fact, for people who want _all_ mail sent to their list to get
  # a req number, this routine could just return a 1.
  #
  # However, if you have mail to 'root' or 'cronlogs' or something like
  # that sent to this alias, you may not want it given a number.
  # 
  ( !(&header_matches_i("from", $mailing_list_ignore)) &&
    &header_matches_i("to", $sys) ||
       &header_matches_i("resent-to", $sys) ||
          &header_matches_i("apparently-to", $sys) ||
	     ($config_match_on_cc && &header_matches_i("cc", $sys)));
}


sub message_insert_req {
  #
  # Insert a req number into the subject line, where the req number is
  # passed in arg1.
  #
  # Don't check to see if there's already a [Req] in it... that
  # should be done elsewhere.
  #
  local($req) = @_;
  local($subj);

  if(&header_exists("subject")) {
    $subj = &header_get("subject");
  } else {
    $subj = "";
  }
  
  $subj = sprintf($sub_str, $req, $subj);
  &header_set("subject", $subj);
  &debug("Set subject to: $subj\n");
}


sub message_reqless_subject {
  #
  # The subject line without any of the [Req] stuff in it.
  #
  local($subj);

  $subj = &header_get("subject");
  $subj =~ s/@{PERL_TAGLINE_COMPARE}//;
  $subj;
}    


sub message_parse_address {
  #
  # Try to parse a from:-style line to get the person's email address.
  # Leave the machine name in the address in case it's not local.
  #
  local($who) = @_;

  &debug("Parsing: $who : for from info.\n");
  if($who eq "") {
    &debug("-> nobody\n");
    return("nobody");
  }
  if($who =~ /<(.*)>/) {
    &debug("-> $1\n");
    return($1);
  }
  if($who =~ /\s*([^\(\)]*)\(.*\)([^\(\)]*)\s*/) {
    &debug("-> ",  $1 . $2, "\n");
    return($1 . $2);
  }
  $who =~ /\s*(\S*)\s*/;
  &debug("-> $1\n");
  $1;
}


sub message_add_to {
  #
  # Given the header field name as the first argument, and a value
  # as the second argument, append the value to the header unless
  # the header already has the value in it.
  #
  # This one is mildly tough, because in headers, @ and - are also
  # typically considered to be part of a word.
  #
  # This means that 'systems@ccs.neu.edu' will not match 'systems'
  # and 'baz' will not match 'baz@foo'.  I think this is reasonable... we'll
  # let the mail system figure out which addresses are equivalent.
  #
  local($header, $value) = @_;
  local($non_word) = ("[^-A-Za-z_@]");

  #
  # Argh, sometimes regexps just don't do what you want them to.
  #
  if(!(&header_matches_i($header, "$non_word$value$non_word") ||
       &header_matches_i($header, "$non_word$value\$") ||
       &header_matches_i($header, "^$value\$") ||
       &header_matches_i($header, "^$value$non_word"))) {
    &header_add($header, $value);
  }
}


# ---------------------------------------------------------------------------
# Autoreply
# ---------------------------------------------------------------------------

sub autoreply_check {
  #
  # Check to see if autoreplying should be done.
  # Probably need more configuration here.
  #

  # Bail if we don't want to do autoreplies.
  return 0 if(!$config_do_autoreply);

  # Bail if we don't have an autoreply program.
  return 0 if(! -x $run_autoreply);

  # Bail if this is a req, but it's not a newly created one.
  return 0 if(!$new_req);

  # Go for it.
  return 1;
}


sub pre_autoreply {
  #
  # Setup the environment for the autoreply program.  Also make
  # a nice header for it to use, should it want to.
  #
  local($to);

  if(&header_exists("reply-to")) {
    $to = &header_get("reply-to");
  } else {
    $to = &header_get("from");
  }

  &debug("Preparing auto-reply file $mail_auto_file\n");
    
  open(NICE, ">$mail_auto_file") || die "Unable to open $mail_auto_file";
  print NICE "To: ", $to, "\n";
  print NICE "Subject: ", &header_get("subject"), "\n";
  print NICE "From: $mailing_list_user_name <$mailing_list_name>\n";
  if($config_add_reply_to) {
    print NICE "Reply-to: $mailing_list_name\n";
  }
  close(NICE);

  $ENV{'REQORIGSUBJ'} = &message_reqless_subject();
  $ENV{'REQNUM'}  = $req_number;
  $ENV{'REQNEWSUBJ'} = &header_get("subject");
  $ENV{'REQUSESUBJ'} = sprintf($sub_str, $req_number, "");
  $ENV{'REQHEADER'} = $mail_header_file;
  $ENV{'REQBODY'} = $mail_body_file;
  $ENV{'REQAUTO'} = $mail_auto_file;
  $ENV{'REQFROM'} = &header_get("from");
  $ENV{'REQUSER'} = &message_parse_address(&header_get("from"));
}



# ---------------------------------------------------------------------------
# External programs
# ---------------------------------------------------------------------------
      
sub req_get_new_number {
  &debug("Getting a new req number.\n");
  open(FOO,"$run_nextnum|") || die "unable to run $run_nextnum";
  chop($num = <FOO>);
  close(FOO);
  &debug("Got new req number: $num\n");
  $num;
}


sub run_req_on_mail {
  &run_mail_through_prog($run_req);
}


sub run_sendmail_on_mail {
  #
  # Get the ucb From line, if it exists.  Be cautious about it, not
  # allowing file names and such...
  #
  local($from) = &header_ucbfrom();
  $from =~ s/[\/\s]+//g;
  if($from && $config_sendfrom) {
    &run_mail_through_prog("$run_sendmail -f$from $mailing_list_dist");
  } else {
    &run_mail_through_prog("$run_sendmail $mailing_list_dist");
  }
}


sub run_mail_through_prog {
  # 
  # Open the process, which should be passed in as an argument.
  # Print the file with headers in it to it.
  # Print a return.
  # Print the file with the body in it to it.
  #
  # Yeah, we could do this by doing a system("cat ..."), but
  #  I'd prefer not to go for extraneous forkings.
  #
  local($prog) = @_;

  &debug("Executing $prog\n");
  open(PROG,"|$prog") || die "unable to run $prog";

  open(HEADER, "$mail_header_file") || die "unable to read $mail_header_file";
  while(<HEADER>) {
    print PROG;
  }
  close(HEADER);

  print PROG "\n";
  open(BODY, "$mail_body_file") || die "unable to read $mail_body_file";
  while(<BODY>) {
    print PROG;
  }
  close(BODY);
 
  close(PROG);

  if($?) {
    &debug("$prog returned an error code to $program.\n");
  }
}


sub run_autoreply_on_mail {
  #
  # First we set up the environment for the auto reply program.
  # Then we call it, and assume that if it returns a 0 exit status,
  # it also printed a valid RFC-822 style message on stdout that should
  # be mailed to the user.
  #
  local(@message);
 
  &pre_autoreply();

  &debug("Executing $run_autoreply\n");
  open(AUTOREPLY,"$run_autoreply|") || die "unable to run $run_autoreply";
  while(<AUTOREPLY>) {
    push(@message, $_);
  }
  close(AUTOREPLY);
  
  #
  # If autoreply returns zero, send the reply it made.
  # The To: header should be correct for this to work.
  #
  if(!$?) {
    open(SENDMAIL, "|$run_sendmail -f$mailing_list_name -t") 
      || die "unable to run $run_sendmail";
    foreach (@message) {
      print SENDMAIL;
    }
    close(SENDMAIL);
  } else {
    &debug("Got non-zero exit value from autoreply program... not mailing.\n");
  }
}


# ---------------------------------------------------------------------------
# Debug
# ---------------------------------------------------------------------------

sub debug {
  #
  # Print debugging information passed in as a set of arguments.
  #
  if($debug) {
    print DEBUG @_;
  }
}


sub start_debugging {
  #
  # Debug to a file instead of to stdout or stderr because this will
  # probably be executed by sendmail, which often does unhelpful things
  # with output.
  # 
  # The global data stuff should probably moved into those routines.
  #
  if($debug) {
    $debug_file = "@{TMP_DIR}/$program.$$";
    open(DEBUG, ">$debug_file") || die "Unable to open $debug_file for debugging";

    # Dup stderr to the debug file, and make it unbuffered in case we crash.
    open(STDERR, ">&DEBUG");
    select(STDERR);
    $| = 1;

    print DEBUG "$program started at ", &ctime($^T), "\n";
    print DEBUG "process ID: $$\n";
    print DEBUG "arguments: $0 ", join(",", @ARGV), "\n";
    print DEBUG "real uid: $<\n";
    print DEBUG "effective uid: $>\n";
    print DEBUG "real gid: $(\n";
    print DEBUG "effective gid: $)\n";
    print DEBUG "INC:", join(",", @INC), "\n";

    print DEBUG "\n";
    print DEBUG "Global data:\n";
    print DEBUG " \$sys = $sys\n";
    print DEBUG " \$mailing_list_name = $mailing_list_name\n";
    print DEBUG " \$mailing_list_dist = $mailing_list_dist\n";
    print DEBUG " \$mailing_list_user_name = $mailing_list_user_name\n";
    print DEBUG " \$sub_str = $sub_str\n";
    print DEBUG " \$run_nextnum = $run_nextnum\n";
    print DEBUG " \$run_req = $run_req\n";
    print DEBUG " \$run_sendmail = $run_sendmail\n";
    print DEBUG " \$run_autoreply = $run_autoreply\n";

    print DEBUG "\n";
    print DEBUG "Configuration data:\n";
    print DEBUG " \$config_modify_cc = $config_modify_cc\n";
    print DEBUG " \$config_match_on_cc  = $config_match_on_cc\n";
    print DEBUG " \$config_do_autoreply = $config_do_autoreply\n";
    print DEBUG " \$config_add_reply_to = $config_add_reply_to\n";

    print DEBUG "\n";
    print DEBUG "Temporary files:\n";
    print DEBUG " \$mail_body_file = $mail_body_file\n";
    print DEBUG " \$mail_header_file = $mail_header_file\n";
    print DEBUG " \$mail_auto_file = $mail_auto_file\n";

    print DEBUG "\n";
    print DEBUG "Program execution logs follow.\n";
  }
}


