#       rfc822.pl - parse RFC822 mail header
#
# Copyright (c) 1993, 1994, 1995, 1996, 1997, 1998, 1999 by RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
# $Id: rfc822.pl,v 2.5 1999/10/06 16:41:19 marek Exp $
#
#	$RCSfile: rfc822.pl,v $
#	$Revision: 2.5 $
#	$Author: marek $
#	$Date: 1999/10/06 16:41:19 $

# Takes filehandle from input mail to read as argument
#
# Sets the following global variables:
#
# $FROM	- "From:" field in header
# $REPLYTO - equal to $FROM if "Reply-To:" is not present, else equal to 
#            the "Reply-To:" field
# $SUBJECT - subject in header
# $MDATE - date in header
# $MSGID - message ID in header
# $HELPREQUESTED - help file is requested
# $NEWMODE - only accept new objects
#
# the following variables used to be set here, now never set, 
# thus making the respective keywords obsolete:
#     $opt_A if send to auto-assign or ASSIGN in Subject line 
#     $opt_v if LONGACK in subject                            


# parse keywords on subject line
# GLOBAL VARIABLE: @subj_ans - diagnostic messages 
# 
sub parsesubject # 
{
    # define allowed keywords
    my($keywords)="NEW|ASSIGN|LONGACK|HOWTO|HELP";

    # allowed combinations 
    # ATTENTION -- sets of keywords (between "|" chars) in alphabetical order!
    my($combinations)=
"ASSIGN NEW|ASSIGN LONGACK|ASSIGN LONGACK NEW|LONGACK NEW|HELP HOWTO";

    # sink for silently ignored keywords, should not trigger a message
    my($silent_ignore)=0;

    # sink for obsolete keywords, can be tested to trigger a message
    my($ignore)=0;

    # variables to set for different keywords
    %keyvars=(
	"ASSIGN",   \$ignore,      	# these keywords are there for backward
	"LONGACK",  \$silent_ignore,    # compatibility only
	"NEW",      \$NEWMODE,
	"HOWTO",    \$HELPREQUESTED,
	"HELP",     \$HELPREQUESTED
    );
    my($i,$words,$keyw,@subjectwords, @unknown_keywords);

    # 0. check contents.
    for $i ( split(' ',$SUBJECT)  )   
    {
	if ( $i !~ /^($keywords)$/i)    
	{
	    push @unknown_keywords, $i;
	    &dpr("unknown keyword $i\n");
	}
	else
	{   
	    push @subjectwords, uc $i;
	}
    }
    
    # 1. Proceed if and only if keywords alone on subject line
    #    Ignore everything if both keywords and non-keywords in subject line
    if( $#subjectwords != -1 && $#unknown_keywords != -1)
    {
        push @subj_ans, 
	"Warning: unknown keywords found in subject line:\n".
	    join(' ',@unknown_keywords).
		"\nThus, all keywords in subject line were ignored.\n";
	return;    
    }

    # 2. Check for allowed combinations
    if( join(' ',sort @subjectwords) !~  /^($keywords|$combinations|)$/ )
    {
	push @subj_ans,
"Warning: this combination of keywords in subject line is not allowed.
Thus, all keywords in subject line were ignored.\n";
#	&dpr("unknown combination of keywords\n");
	return;
    }

    # 3. Set variables corresponding to keywords to 1
    for $words (@subjectwords)     
    {
        for $keyw (split('\|',$keywords))  
	{
            if( $words eq $keyw )  	     
	    {
		if( $keyvars{$keyw} == \$ignore)
		{
		    push @subj_ans,
"Warning: obsolete keyword $keyw found in subject line was ignored.\n";
#		    &dpr("obsolete keyword $keyw ignored\n");
		}
		else
		{
		    ${$keyvars{$keyw}}=1;
	        }
	    }
        }
    } 
}

sub parserfc822 {
    local($file)=@_;

    local(%header) = ();

    while (<$file>) {

        s/\s+$//;
        
        last if (!$_);
        
        #
	# check to see if this went to auto-assign, then set -A flag
	# Hardcoded and yuck.

	$opt_A = 1 if (/auto\-assign/i);

        if (/^From:\s+(.*)/i) {
	    
	   if (!$header{"ra"}) {
	      $curfield = "ra";
	      $header{$curfield}=$1;
	   }
	   
	   next;
	   
	}
	
	if (/^Cc:\s+(.*)/i) {
           $curfield = "cc";
           $header{$curfield} = $1;
           next;
        }

	if (/^Reply-To:\s+(.*)/i) {
	    
	    $curfield = "rp";
	    
	    if ($header{$curfield}) {
		$header{$curfield}.=", ".$1;
	    }
	    else {
		$header{$curfield}=$1;
	    }
	    
	    next;
	    
	}
	
	if (/^Subject:\s+(.*)/i) {
	   
	   $curfield="sj";
	   $header{$curfield} = $1;
	   
	   next;
	   
	}

	if (/^Message-Id:\s+(.*)/i) {
	   $curfield = "mi";
	   $header{$curfield} = $1;
	   next;
	}

        
          
	if (/^Date:\s+(.*)/i) {
	    $curfield = "dt";
	    $header{$curfield} = $1;
	    next;
	}

	if (/^\s+(\S.*)$/) {
	   
	   if ($curfield) {
	      $header{$curfield}.=" ".$1;
	   }
	    
	   next;
	
	}

	$curfield = "";
	
    }
    
    if ($header{"ra"}) {
		
       $FROM=$header{"ra"};
		
       $REPLYTO=$FROM;
       $REPLYTO=$header{"rp"} if ($header{"rp"}); 
		
       $CC=$header{"cc"};
		
       $SUBJECT=$header{"sj"};
       &parsesubject();
		
       $MDATE=$header{"dt"};
		
       $MSGID=$header{"mi"};
		
       return $OK;
		
    }
    else {
	    
       return $NOK;
		
    }

}

1;
