
#@package: rfc822 parse_rfc822_line read_rfc822_group read_rfc822 write_rfc822_group write_rfc822 parse_rfc822_mail_address

#
# Copyright (C) 1992-1997 NeoSoft.
#
# 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.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.

#
# we really need to rewrite this in C and be truly RFC-822 compliant,
# it's a pig.
#
# RFC noncompliance issues: Line order isn't maintained, multiple
# lines with the same key aren't supported.
# There may be stuff in there about quoting, too.
#

#
# parse_rfc822_line
#
# Given a line of RFC822 header text and the names of two variables,
# parse the key into one and the value into the other.
#
# Warning, can't do multiple line messages unless line argument contains
# all necessary lines.
#
#
proc parse_rfc822_line {line keyVar valueVar} {
    upvar $keyVar key
    upvar $valueVar value

    set key ""
    set colon [string first ":" $line]
    if {$colon < 2} {
	return 0
    }
    set key [string trim [string range $line 0 [expr $colon-1]]]
    set value [string trim [string range $line [expr $colon+1] end]]
    return 1
}

#
# read_rfc822_group
#
# given a filehandle and an array name, read the file, pulling key-value
# pairs and putting them into the named array, returning when an empty
# line or EOF is found
#
#
proc read_rfc822_group {fp arrayVarName} {
    upvar $arrayVarName rfcArray
    set success 0
    
    while {[gets $fp line] >= 0} {
        if {$line == ""} break

	set firstchar [cindex $line 0]
	if {$firstchar == " " || $firstchar == "\t"} {
	    if {$key != ""} {
	        append rfcArray($key) "\n$line"
	    } else {
		puts stderr "rfc-822 line starts with whitespace with no prior key '$line'"
	    }
	    continue
	}
        set key ""
        set colon [string first ":" $line]
        if {$colon < 2} {
            puts stderr "malformed rfc-822 line '$line'"
        }
        set success 1
        set key [string trim [string range $line 0 [expr $colon-1]]]
        set value [string trim [string range $line [expr $colon+1] end]]
        set rfcArray($key) $value
    }
    return $success
}

#
# read_rfc822
#
# load in a file containing one rfc822 group
#
proc read_rfc822 {fileName arrayVarName} {
    upvar $arrayVarName rfcArray
    
    set fp [open $fileName]
    read_rfc822_group $fp rfcArray
    close $fp
}

#
# write_rfc822_group
#
# given a filehandle and an array name, write the file, pulling key-value
# pairs from the named array, returning when finished.
#
#
proc write_rfc822_group {fp arrayVarName} {
    upvar $arrayVarName rfcArray 

    foreach name [array names rfcArray] {
        set data [split $rfcArray($name) "\n"]
        puts $fp "$name: [lindex $data 0]"
        foreach additionalLine [lrange $data 1 end] {
            puts $fp "\t$additionalLine"
        }
    }
    puts $fp ""
}

#
# write_rfc822
#
# write out a file containing one rfc822 group
#
proc write_rfc822 {fileName arrayVarName} {
    upvar $arrayVarName rfcArray
    
    set fp [open $fileName w]
    write_rfc822_group $fp rfcArray
    close $fp
}

#
# parse_rfc822_mail_address
#
# take the body of an address line and convert it into a name and address
#
proc parse_rfc822_mail_address {line emailAddressVar fullNameVar} {
    upvar $emailAddressVar emailAddress
    upvar $fullNameVar fullName
 
    # in the form "Ellyn Jones <ellyn@NeoSoft.com>"?
    if {[regexp {(.*) <(.*)>} $line dummy fullName emailAddress]} {
        set emailAddress [string tolower $emailAddress]
        return
    }   
    
    # in the form "ellyn@NeoSoft.com (Ellyn Jones)"?
    if {[regexp {(.*) \((.*)\)} $line dummy emailAddress fullName]} {
        set emailAddress [string tolower $emailAddress]
        return
    }
 
    # hmm, take whatever's there as the reply address 
    set emailAddress [string tolower $line]
    set fullName $emailAddress
}

