procmail and perl trouble...

Hi,

I'm trying to grab the email address from an incomming message, pass it to
a perl script for validation, then do something based on that validation.

Everything is working fine, except for one really odd thing.

Occassionally I get a user who has their reply to address set differently
than their actual address. And in one other case the header field x-sender
is passed from the individual's email program. This seems to confuse things
a bit, but I can't nail it down.

Here is the log entry: (with added comments)

#first I use formail to try and determine the correct address
procmail: Executing "formail,-rtzxTo:"
procmail: Assigning "F=nfedder(_at_)GraphicSolutions(_dot_)com"
#looks fine, this is the address the person 'should' be from.
procmail: Match on ! "^^^^"
procmail: Executing 
"/home/getfile/checkuser3.pl,nfedder(_at_)GraphicSolutions(_dot_)com"
#this line apparently looks fine to me.... it appears to be passing the
#correct email address to the script. But the following 'warn' statements
#from the perl script suggest this isn't quite what's going on...
was passed From nfedder(_at_)pop(_dot_)mindspring(_dot_)com  Thu Aug 27 
06:05:16 1998 at
/home/getfile/checkuser3.pl line 16, <STDIN> chunk 1.
got nfedder(_at_)pop(_dot_)mindspring(_dot_)com from From 
nfedder(_at_)pop(_dot_)mindspring(_dot_)com  Thu
Aug 27 06:05:16 1998 at /home/getfile/checkuser3.pl line 30

the pop.mindspring.com in this case belongs to the x-sender header field of
the persons mail.

I have included both the procmail script and the perl script below for
reference.

Any help, hints etc... appreciated.

- Paul

----------.procmailrc [relevant portion]

SHELL=/bin/sh
LOGFILE=procmail.log
COMSAT=no
VERBOSE=on

# first we determine if we are dealing with a 'get' command
:0
* ^Subject: get[ ]*[0-9a-z]
* !^X-Loop: getfile*
* !^Subject:.*Re:
* !^FROM_DEAMON
* !^Subject: get .*[/.]\.
{
  # looks like we got one, so  process accordingly
  :0 H # reverse mailheader and extract name
  * ^Subject: get[ ]*\/[^ ]+
  { FILE="$MATCH" }

  #now get the sender's address
  :0 a
  { F=`formail -rtzxTo:` }

  # here we pass the F variable to the checkuser script to
  # see if it's a valid user. Based on the error code returned
  # send an appropriate message.
  :0 a
  * ! F ?? ^^^^
  {
    RESULT = `/home/getfile/checkuser3.pl "$F"`
  }

  # an 0 result is OK.
  # here we do other things based on an error code returned,
  # example, 401 is user not found.. etc.


  }

}



---------- perl script.

#!/usr/bin/perl -w

use Mysql;
$database="xxxxx";
$user="xxxxx";
$password="xxxxx";

#expect <STDIN> to be an email address... nothing but an email address

#ignore anything else but the first line...
$_=<STDIN>;
#remove any newlines
chomp;
#from this we get a line FROM email_address

warn "was passed $_";
print checkit($_);


sub checkit($) {
  my $test=$_;
  $dbh = Mysql->connect("localhost", $database, $user, $password) ||
     return 804 ;
        #File cannot be opened as read-only in its current state
  unless($test =~ /([\w\(_dot_)\-_]+(_at_)[\w\(_dot_)\-_]+\(_dot_)[a-zA-Z]+)/) {
    warn "bad email address format $1 from: $test\n";
    return 408;
    #408        Specified field has inappropriate data type for this operation
  }
 warn "got $1 from $test";
 # we'll try a bit of a munge domain feature here... chop off the
  # first bit of the mail address and do a query on that as well
  # so if we're passed joe(_at_)mail(_dot_)somewhere(_dot_)com we'll also look 
for
  # joe(_at_)somewhere(_dot_)com
  my $A=$1;
  my $G='';
  # this does a regex and pulls out everything up to the @ symbol,
  # puts it into variable 1 and then puts the last two parts of the
  # domain into variable 2. If there is a match, G gets assigned
  # an alternate query string.
  if($A =~ /([\w\.\-_]+@)[\w\.\-_]*?([\w\-_]+\.[\w\-_]+)$/) {
    $G = "or email='$1$2'"
  }
  # ok... we must have a good one then, check it with the database.
  my $query="select * from isomemberdata where email='$A' $G";
  my $sth=$dbh->query($query);
  unless ($sth->numrows>=1) {
    warn "not a valid subscriber email address: $A \n   was passed $_\n
query: $query";
    return 401;
  }
  # if we make it this far, things are OK.
  return 0;
}

#sub log($) {
#
#}

-------------------Kudosnet Communication Services--------------------
pevad(_at_)kudosnet(_dot_)com                                    
www.kudosnet.com


For value added web hosting and internet commerce sites
http://kudosnet.com/services/

-------------879 View Rd. Qualicum Beach, Canada V9K 1N3--------------