Where can I find rfc822.pl?
ande...@optical.bms.com
in various archives for rfc822.pl. If anyone can point to where I
can grab a copy of it, I'd appreciate it.
Jay
+---------------------------------------------------------------------+
| Jay Anderson - N3JMC Internet: ande...@optical.bms.com |
| Record Information Center Work: (609)-683-6039 |
| Bristol-Myers Squibb Company Home: (215)-836-1225 |
| Princeton, NJ 08543 FAX: (609)-683-6743 |
| |
+=====================================================================+
Johan Vromans
> 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 j...@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" -------------------------