jv@mh.nl (Johan Vromans) (06/14/91)
In article <1991Jun12.193018.16059@uvaarpa.Virginia.EDU> anderson@optical.bms.com writes: > I need to parse email headers and have been looking (unsuccessfully) > in various archives for rfc822.pl. If anyone can point to where I > can grab a copy of it, I'd appreciate it. Reposting time... Note that rfc822.pl is a part of a mail server package, all written in perl. (Gee, this is old. We didn't even have packages then...) #!/bin/sh # This is a shell archive (produced by shar 3.49) # To extract the files from this archive, save it to a file, remove # everything above the "!/bin/sh" line above, and type "sh file_name". # # made 06/14/1991 08:02 UTC by jv@largo # Source directory /u1/users/jv # # existing files will NOT be overwritten unless -c is specified # # This shar contains: # length mode name # ------ ---------- ------------------------------------------ # 4162 -r--r--r-- rfc822.pl # # ============= rfc822.pl ============== if test -f 'rfc822.pl' -a X"$1" != X"-c"; then echo 'x - skipping rfc822.pl (File already exists)' else echo 'x - extracting rfc822.pl (Text)' sed 's/^X//' << 'SHAR_EOF' > 'rfc822.pl' && X#!/usr/bin/perl X X$[ = 0; # let arrays start at 0]; X X# BEGIN module rfc822_read X# X# Copyright 1989 Johan Vromans X# X# This software may be redistributed on the same terms as the X# GNU Public Licence. X# X# Private variables: X# X $rfc822_line_in_cache = ""; X# X# Global variables X# X $rfc822_version = "@(#)@ rfc822 2.1 - rfc822.pl"; X# X $rfc822_input = 0; X $rfc822_line = ""; X $rfc822_header = ""; X $rfc822_contents = ""; X @rfc822_addresses = (); X %rfc822_addr_comments = (); X# X# Global constants X# X $rfc822_valid_header = 0; X $rfc822_empty_line = 1; X $rfc822_data_line = 2; X# X# Exported routines X# X# rfc822_start_read initializes this module X# X# must be passed the filename to read from X# X# rfc822_read_header reads, and parses RFC822 header X# X# returns $rfc822_valid_header if a valid RFC822 header was found. X# $rfc822_header and $rfc822_contents contain the header and contents. X# $rfc822_line contains the normalized header. X# If called with a non-null argument: does not handle continuation lines. X# (for reading the body of a message). X# X# returns $rfc822_empty_line if an empty line was read. X# X# returns $rfc822_data_line otherwise. X# $rfc822_line contains the contents of the line. X# X# rfc822_not_eof the read-ahead systems notion of end-of-file X# X# rfc822_parse_addresses parses an address specification. X# X# return addresses in @rfc822_addresses, the address X# comments in %rfc822_addr_comments. X# X Xsub rfc822_start_read { X local ($rfc822_file) = @_; X if ( $rfc822_input != 0 ) { X close (rfc822_input); X $rfc822_input = 1; X } X if (open (rfc822_input, $rfc822_file)) { X # read ahead to make eof work properly X $rfc822_line_in_cache = <rfc822_input>; X return 1; X } else { return 0; } X} X Xsub rfc822_not_eof { X return (($rfc822_line_in_cache ne "") || (!eof (rfc822_input))); X} X Xsub rfc822_read_header { X X local ($line); X local ($body) = shift (@_); X X if ( $rfc822_line_in_cache ne "" ) { X $line = $rfc822_line_in_cache; X $rfc822_line_in_cache = ""; X chop ($line); X } else { X $line = <rfc822_input>; X chop ( $line ); X } X X if ( $line =~ /^([-\w]+)\s*:\s*/ ) { X $rfc822_header = $1; X $rfc822_contents = $'; #'; X } else { X $rfc822_line = $line; X $rfc822_header = $rfc822_contents = ""; X return $rfc822_empty_line if $rfc822_line eq ""; X return $rfc822_data_line; X } X X # handle continuation lines X while ( ($rfc822_line_in_cache eq "") && (! eof) ) { X $rfc822_line_in_cache = $line = <rfc822_input>; X chop ($line); X if ( !$body && ($line =~ /^\s+/) ) { X $rfc822_contents = $rfc822_contents . " " . $'; #'; X $rfc822_line_in_cache = ""; X } X } X $rfc822_line = $rfc822_header . ": " . $rfc822_contents; X return $rfc822_valid_header; X} X Xsub rfc822_parse_addresses { X # X # syntax: address [, address ...] X # X # address: addr [ ( comment ) ] | [ comment ] <addr> X # X X local ($addr) = shift (@_); X local ($left); X local (@left); X local ($right); X local ($comment); X X @rfc822_addresses = (); X %rfc822_addr_comments = (); X X # first break out the (...) comments X while ( $addr =~ /\(([^)]*)\)/ ) { X $right = $'; X $comment = $1; X @left = split (/[ \t]+/, $`); X if ( $#left >= 0 ) { X # print "() match: \"", $left[$#left], "\" -> \"$1\"\n"; X unshift (@rfc822_addresses, pop (@left)); X $rfc822_addr_comments{$rfc822_addresses[0]} = $1; X } X if ( $right =~ /^\s*,\s*/ ) { X $right = $'; X } X $addr = join (" ", @left) . " " . $right; X # print "todo: $addr\n"; X } X X # then split on commas, and handle each part separately X @addr = split (/,/, $addr); X X while ( $#addr >= 0 ) { X $addr = shift (@addr); X # print "doing: \"$addr\"\n"; X $addr = $' if $addr =~ /^\s+/ ; X $addr = $` if $addr =~ /\s+$/ ; X next if $addr eq ""; X if ( $addr =~ /<([^>]+)>/ ) { X # print "\"$addr\" matched: \"$`\"-\"$+\"-\"$'\"\n"; X unshift (@rfc822_addresses, $1); X $rfc822_addr_comments{$1} = join (" ", split (/[ \t]+/, "$` $'")); X } X else { X unshift (@rfc822_addresses, $addr); X $rfc822_addr_comments{$addr} = ""; X # print "did: \"$addr\"\n"; X } X } X X} X# END module rfc822_read SHAR_EOF chmod 0444 rfc822.pl || echo 'restore of rfc822.pl failed' Wc_c="`wc -c < 'rfc822.pl'`" test 4162 -eq "$Wc_c" || echo 'rfc822.pl: original size 4162, current size' "$Wc_c" fi exit 0 -- Johan Vromans jv@mh.nl via internet backbones Multihouse Automatisering bv uucp: ..!{uunet,hp4nl}!mh.nl!jv Doesburgweg 7, 2803 PL Gouda, The Netherlands phone/fax: +31 1820 62911/62500 ------------------------ "Arms are made for hugging" -------------------------