Perl 5.8 threads and sockets problem

nkuipers nkuipers at uvic.ca
Thu Feb 27 14:53:34 CST 2003


One more thing.  Print $pid every iteration, and clean up the $pop3C 
definition line.  What I mean is there are two hardcoded reasons for exiting, 
one if $pid is zero and the other at the $pop3C definition, which uses and/or 
in the same line, which is not common...I'm not saying it's a problem line per 
se, I'm just saying you don't often see and/or used together and it IS a line 
that could jump to a "premature" exit, so it is worth some cleaning up and 
attention.



>===== Original Message From "Jeremy Aiyadurai" <jeremygwa at hotmail.com> =====
>Hi all,
>Thanks for all your help so far. Is there any easy way to do this.
>I've looked at POE (Perl Object Environment), but it is too confusing.
>
>The script I am using is to test the use of sockets and threads or (forks)(I
>prefer perl 5.8 threads over forks because of memory). Basically, I would
>like to get this working so I can incorporate it into a program I am working
>on that will be a Win32 service (or unix Daemon) that checks many mail
>(pop3) accounts for new messages at the same time, every few minutes or
>seconds.
>
>So that is the scoop.
>
>Your help "has been" and "is" greatly appreciated.
>Thanks,
>
>Jeremy A.
>
>The following script works for a couple seconds\minutes then exits (i dont
>know why)
>#----------------------------
>
>use IO::Socket qw(:DEFAULT :crlf);
>use Strict;
>
>
>my $pop3C;
>my @thr = ();
>my @Data = (
>	 { 'UID' => "Jeremy", 'SVR' => "mail.host.com", 'PORT' => "110",
>'LOGIN' => "jerdoe", 'PASS' => "****" },
>	 { 'UID' => "Jon", 'SVR' => "mail.host.net", 'PORT' => "110",
>'LOGIN' => "jondoe", 'PASS' => "*******" },
>);
>my $i = 0;
>
>Startup();
>
>
>
>
>sub Startup {
>	$| = 0;
>	for (;;) {
>		foreach my $account (@Data) {
>			if (-f $account->{'UID'}.".acc") {
>	 			next;
>  			}
>			print "Forking $account->{UID}\n";
>
>			#child
>			my $pid = fork();
>			if ($pid == 0){
>				print "Child $account->{UID}\n";
>				go($account);
>				$account = undef;
>				exit(0);
>			}
>
>                }
>
>              sleep(1);
>        }
>  }
>
>
>
>sub go() {
>	my $ac = shift;
>open(X,">".$ac->{UID}.".acc");
>$pop3C = IO::Socket::INET->new(Proto => 'tcp', PeerAddr =>
>	$ac->{SVR},
>	PeerPort => $ac->{PORT} , Timeout => 0)
>	and close(X) or pop3CError ($ac->{SVR},$ac->{PORT});
>print "in $ac->{UID}\n";
>$pop3C->close;
>unlink($ac->{'UID'}.".acc");
>$ac->{'UID'} = undef;
>$ac->{'SVR'} = undef;
>$ac->{'PORT'} = undef;
>$ac->{'LOGIN'} = undef;
>$ac->{'PASS'} = undef;
>$pop3C = undef;
>}
>
>sub pop3CError ($$) {
>close(X);
>print "Cannot connect to the the Pop3 server:$_[0], port:$_[1]\n";
>exit;
>
>}
>--------------------------------------
>>From: "Jeremy Aiyadurai" <jeremygwa at hotmail.com>
>>To: victoria-pm at pm.org
>>Subject: Re: Perl 5.8 threads and sockets problem
>>Date: Tue, 25 Feb 2003 16:28:55 -0800
>
>>Hi all,
>>
>>Thanks for all your help so far.
>>
>>I am still having having problems with the forking.
>>the script will only run for 30 or so seconds,
>>before it exits.
>>
>>I am stumped on how to keep it running continously.
>>
>>The following is the code
>>...............................................
>>use IO::Socket qw(:DEFAULT :crlf);
>>
>>
>>my $pop3C;
>>my @thr = ();
>>my @Data = (
>>	 { 'UID' => "Jeremy", 'SVR' => "mail.h.y", 'PORT' => "110",
>>'LOGIN' => "jerdoe", 'PASS' => "******" },
>>	 { 'UID' => "Jon", 'SVR' => "mail.h.t", 'PORT' => "110",
>>'LOGIN' => "jondoe", 'PASS' => "****" },
>>);
>>my $i = 0;
>>
>>Startup();
>>
>>
>>sub Startup {
>>               $| = 0;
>>               for (;;) {
>>		foreach my $account (@Data) {
>>			if (-f $account->{'UID'}.".acc") {
>>	 			next;
>>  			}
>>			print "Forking $account->{UID}\n";
>>			my $pid = fork();
>>			if ($pid == 0){
>>                                # in child
>>				print "Child $account->{UID}\n";
>>				go($account);
>>				$account = undef;
>>				exit(0);
>>			}
>>
>>                }
>>
>>              sleep(1);
>>        }
>>  }
>>
>>
>>
>>sub go() {
>>	my $ac = shift;
>>
>>$pop3C = IO::Socket::INET->new(Proto => 'tcp', PeerAddr =>
>>	$ac->{SVR},
>>	PeerPort => $ac->{PORT} , Timeout => 0)
>>	or pop3CError ($ac->{SVR},$ac->{PORT});
>>open(X,">".$ac->{UID}.".acc");
>>close(X);
>>print "in $ac->{UID}\n";
>>$pop3C->close;
>>unlink($ac->{'UID'}.".acc");
>>$ac->{'UID'} = undef;
>>$ac->{'SVR'} = undef;
>>$ac->{'PORT'} = undef;
>>$ac->{'LOGIN'} = undef;
>>$ac->{'PASS'} = undef;
>>$pop3C = undef;
>>}
>>
>>sub pop3CError ($$) {
>>
>>print "Cannot connect to the the Pop3 server:$_[0], port:$_[1]\n";
>>exit;
>>
>>}
>>..................................................
>>
>>
>>Your help is much appreciated.
>>Thanks,
>>
>>Jeremy A.
>>
>>
>>
>>
>>
>>
>>>From: abez <abez at abez.ca>
>>>To: Jeremy Aiyadurai <jeremygwa at hotmail.com>
>>>CC: victoria-pm at pm.org
>>>Subject: Re: Perl 5.8 threads and sockets problem
>>>Date: Sun, 23 Feb 2003 22:10:03 -0800 (PST)
>>>
>>>
>>>Well uncomment these lines, so that you "locking" works.
>>> > 			#if (-f $account->{'UID'}.".acc") {
>>> > 	 		#	next;
>>> >   			#}
>>>
>>>I don't know WIN32 too well to guess about the memory but you might want
>>>to
>>>print before that exit where $account = undef; exit; Just print you're
>>>closing
>>>you might get better information.
>>>
>>>Also print debugging info to STDERR if possible it's default unbuffered.
>>>
>>>call wait() before you call sleep(1) and it will make sure your processes
>>>aren't zombified.
>>>
>>>
>>>On Sun, 23 Feb 2003, Jeremy Aiyadurai wrote:
>>>
>>> >
>>> > Hi again,
>>> >
>>> > Thanks for all your help so far.
>>> > I monitored my memory usage while running the script.
>>> > It appears to slowly eat up memory. If i were to run this script day
>>>and
>>> > night as long as I keep my computer on like a server, It would probably
>>> > crash my system even though I have alot of SDRAM.
>>> > Also, the script will run for a while, then crash and exit, does this
>>>have
>>> > to do with fork (thread) races?
>>> > eg. it ends like this
>>> > "
>>> > in Jeremy
>>> > in Jon
>>> > Forking Jeremy
>>> > Forking Jon
>>> > Child Jeremy
>>> > Child Jon
>>> > in Jeremy
>>> > in Jon
>>> > Forking Jeremy
>>> > Child Jeremy
>>> > in Jeremy" - exits here? don't know why? when three jeremy's are in
>>> > sequence, the program terminates.
>>> >
>>> > Your Help is greatly appreciated
>>> >
>>> > Thanks,
>>> > Jeremy A.
>>> >
>>> > here is the script now with the prints "Forking $UID","Child $UID" and
>>>"in
>>> > $UID".
>>> > ---------------------------
>>> > use IO::Socket qw(:DEFAULT :crlf);
>>> > use Win32;
>>> >
>>> >
>>> > my @thr = ();
>>> > my @Data = (
>>> > 	 { 'UID' => "Jeremy", 'SVR' => "mail.host.net", 'PORT' => "110",
>>> > 'LOGIN' => "jerdoe", 'PASS' => "********" },
>>> > 	 { 'UID' => "Jon", 'SVR' => "mail.host.net", 'PORT' => "110",
>>> > 'LOGIN' => "jondoe", 'PASS' => "*****" },
>>> > );
>>> > my $i = 0;
>>> >
>>> > Startup();
>>> >
>>> > #foreach my $account (@Data) {
>>> > #	$str = " rm -f $account->{UID}.acc ";
>>> > #	`$str`;
>>> > #}
>>> >
>>> >
>>> > sub Startup {
>>> > 	for (;;) {
>>> >       #Win32::Sleep(4000);
>>> > 		$| = 0;
>>> > 		foreach my $account (@Data) {
>>> > 			#if (-f $account->{'UID'}.".acc") {
>>> > 	 		#	next;
>>> >   			#}
>>> > 			print "Forking $account->{UID}\n";
>>> > 			my $pid = fork();
>>> > 			if ($pid==0) { #child
>>> > 				print "Child $account->{UID}\n";
>>> > 				go($account);
>>> > 				$account = undef;
>>> > 				exit();
>>> > 			}
>>> >
>>> >                 }
>>> >                 sleep(1);
>>> >         }
>>> >   }
>>> >
>>> >
>>> >
>>> >
>>> > sub go() {
>>> > 	my $ac = shift;
>>> >
>>> > my $pop3C = IO::Socket::INET->new(Proto => 'tcp', PeerAddr =>
>>> > 	$ac->{SVR},
>>> > 	PeerPort => $ac->{PORT} , Timeout => 0)
>>> > 	or pop3CError ($ac->{SVR},$ac->{PORT});
>>> > open(X,">".$ac->{UID}.".acc");
>>> > close(X);
>>> > print "in $ac->{UID}\n";
>>> > Win32::Sleep(4000);
>>> > $pop3C->close;
>>> > $ac->{'UID'} = undef;
>>> > $ac->{'SVR'} = undef;
>>> > $ac->{'PORT'} = undef;
>>> > $ac->{'LOGIN'} = undef;
>>> > $ac->{'PASS'} = undef;
>>> > $pop3C = undef;
>>> > unlink($_[1].".acc");
>>> > }
>>> >
>>> > sub pop3CError ($$) {
>>> >
>>> > print "Cannot connect to the the Pop3 server:$_[0], port:$_[1]\n";
>>> > exit;
>>> >
>>> > }
>>> >
>>> >
>>> >
>>> >
>>> > >From: abez <abez at abez.ca>
>>> > >To: Jeremy Aiyadurai <jeremygwa at hotmail.com>
>>> > >CC: victoria-pm at pm.org
>>> > >Subject: Re: Perl 5.8 threads and sockets problem
>>> > >Date: Sun, 23 Feb 2003 20:35:24 -0800 (PST)
>>> > >
>>> > >
>>> > >
>>> > >Here's what I'd do:
>>> > >
>>> > >use IO::Socket qw(:DEFAULT :crlf);
>>> > >
>>> > >my @thr = ();
>>> > >my @Data = (
>>> > >	 { 'UID' => "abez", 'SVR' => "lycos.com", 'PORT' => "80",
>>> > >'LOGIN' => "abez", 'PASS' => "******" },
>>> > >	 { 'UID' => "casper", 'SVR' => "www.metafilter.com", 'PORT' => "80",
>>> > >'LOGIN' => "casper", 'PASS' => "*****" },
>>> > >);
>>> > >my $i = 0;
>>> > >
>>> > >Startup();
>>> > >
>>> > >foreach my $account (@Data) {
>>> > >	$str = " rm -f $account->{UID}.acc ";
>>> > >	`$str`;
>>> > >}
>>> > >
>>> > >$| = 0;
>>> > >sub Startup {
>>> > >	for (;;) {
>>> > >       #Win32::Sleep(4000);
>>> > >		foreach my $account (@Data) {
>>> > >			#if (-f $account->{'UID'}.".acc") {
>>> > >  	 		#	next;
>>> > >   			#}
>>> > >			print "Forking $account->{UID}\n";
>>> > >			my $pid = fork();
>>> > >			if ($pid==0) { #child
>>> > >				print "Child $account->{UID}\n";
>>> > >				go($account);
>>> > >				exit();
>>> > >			}
>>> > >                 }
>>> > >		sleep(10);
>>> > >         }
>>> > >   }
>>> > >
>>> > >
>>> > >
>>> > >
>>> > >sub go($$$$$) {
>>> > >	my $account = shift;
>>> > >
>>> > >my $pop3C = IO::Socket::INET->new(Proto => 'tcp', PeerAddr =>
>>> > >	$account->{SVR},
>>> > >	PeerPort => $account->{PORT} , Timeout => 60)
>>> > >	or pop3CError ($account->{SVR},$account->{PORT});
>>> > >open(X,">".$account->{UID}.".acc");
>>> > >close(X);
>>> > >print "in $account->{UID}\n";
>>> > >print $pop3C "GET /\n";
>>> > >my @out = <$pop3C>;
>>> > >print join("", at out[0..10]),"\n";
>>> > >$pop3C->close;
>>> > >
>>> > >$pop3C = undef;
>>> > >unlink($_[1].".acc");
>>> > >}
>>> > >
>>> > >sub pop3CError ($$) {
>>> > >
>>> > >print "Cannot connect to the the Pop3 server:$_[0], port:$_[1]\n";
>>> > >exit;
>>> > >
>>> > >}
>>> > >
>>> > >
>>> > >
>>> > >On Sun, 23 Feb 2003, Jeremy Aiyadurai wrote:
>>> > >
>>> > > > hi All,
>>> > > >
>>> > > > Thanks for your help so far.
>>> > > >
>>> > > > I tried threads->create, it made no difference,
>>> > > > as mentioned in the manpage, "The new() method is an alias for
>>>create().
>>> > >"
>>> > > >
>>> > > > Your Help is much appreciated,
>>> > > > thanks
>>> > > >
>>> > > > Jeremy A.
>>> > > >
>>> > > > >From: abez <abez at abez.ca>
>>> > > > >To: Jeremy Aiyadurai <jeremygwa at hotmail.com>
>>> > > > >CC: victoria-pm at pm.org
>>> > > > >Subject: Re: Perl 5.8 threads and sockets problem
>>> > > > >Date: Sun, 23 Feb 2003 18:38:16 -0800 (PST)
>>> > > > >
>>> > > > >
>>> > > > >First of all try threads->create, rather than new. Other than that
>>>I'm
>>> > >too
>>> > > > >dizzy to really help right now (flu).
>>> > > > >
>>> > > > >On Sun, 23 Feb 2003, Jeremy Aiyadurai wrote:
>>> > > > >
>>> > > > > >
>>> > > > > > Hello all,
>>> > > > > >
>>> > > > > > I am new to the group.
>>> > > > > > I have a problem involving sockets and threads.
>>> > > > > >
>>> > > > > > Basically, I want to be able to do two or more pop3 sessions
>>> > > > >simultaniously
>>> > > > > > using a list of different pop3 accounts.
>>> > > > > > my problem is, I can logon to the first account, but when
>>> > > > > > it comes to the second account's turn (in the second thread),
>>>the
>>> > >socket
>>> > > > > > cannot be created.
>>> > > > > >
>>> > > > > > I am new to using threads and have little knowledge of sockets.
>>> > > > > >
>>> > > > > > Your Help is much appreciated,
>>> > > > > >
>>> > > > > > Thanks,
>>> > > > > >
>>> > > > > > Jeremy A.
>>> > > > > >
>>> > > > > > Below is my test script I am having trouble with.
>>> > > > > >
>>> > > > > >
>>> > > > > > #-----------------------------------------------------
>>> > > > > > use threads;
>>> > > > > > use Win32;
>>> > > > > > use IO::Socket qw(:DEFAULT :crlf);
>>> > > > > >
>>> > > > > >
>>> > > > > > my @thr;
>>> > > > > > my @Data;
>>> > > > > > $Data[0] = { 'UID' => "Jeremy", 'SVR' => "mail.host.net",
>>>'PORT' =>
>>> > > > >"110",
>>> > > > > > 'LOGIN' => "account1", 'PASS' => "******" };
>>> > > > > > $Data[1] = { 'UID' => "Dave", 'SVR' => "mail.bost.com", 'PORT'
>>>=>
>>> > >"110",
>>> > > > > > 'LOGIN' => "account2", 'PASS' => "*****" };
>>> > > > > > my $i = 0;
>>> > > > > >
>>> > > > > > sub Startup {
>>> > > > > >     while (1) {
>>> > > > > >       Win32::Sleep(4000);
>>> > > > > >         foreach my $account (@Data)
>>> > > > > >         {
>>> > > > > >                 if(!open(T,"".$account->{'UID'}.".acc"))
>>> > > > > >                 {
>>> > > > > >   		Win32::Sleep(40);
>>> > > > > >   		if($i != 0)
>>> > > > > >   		{
>>> > > > > >   		 $i = $i + 1;
>>> > > > > >   		}
>>> > > > > >   		$thr[$i] =
>>> > > > > >
>>> > > >
>>> > >
>>>
>threads->new(\&go,$account->{'UID'},$account->{'SVR'},$account->{'PORT'},$acc
ount->{'LOGIN'},$account->{'PASS'});
>>> > > > > > 		$thr[$i]->join;
>>> > > > > >                 }else
>>> > > > > >                 {
>>> > > > > >                         close(T);
>>> > > > > >                 }
>>> > > > > >                 $i = $i - 1;
>>> > > > > >
>>> > > > > >         }
>>> > > > > >   }
>>> > > > > >   @AC = -1;
>>> > > > > > }
>>> > > > > >
>>> > > > > > Startup();
>>> > > > > >
>>> > > > > >
>>> > > > > >
>>> > > > > > sub go($$$$$) {
>>> > > > > > print "$_[0],$_[1],$_[2],$_[3],$_[4],$_[5],$_[6]\n";
>>> > > > > >
>>> > > > > > my $pop3C = IO::Socket::INET->new(Proto => 'tcp', PeerAddr =>
>>> > >"$_[1]",
>>> > > > > > PeerPort => $_[2], Timeout => 60) or pop3CError ($_[1],$_[2]);
>>> > > > > > open(X,">".$_[1].".acc");
>>> > > > > > close(X);
>>> > > > > > print "in $_[1]\n";
>>> > > > > > sleep(1);
>>> > > > > > pop3close($pop3C);
>>> > > > > > $pop3C = undef;
>>> > > > > > unlink($_[1].".acc");
>>> > > > > > }
>>> > > > > >
>>> > > > > >
>>> > > > > > sub pop3CError ($$) {
>>> > > > > >
>>> > > > > > print "Cannot connect to the the Pop3 server:$_[0],
>>>port:$_[1]\n";
>>> > > > > > exit;
>>> > > > > >
>>> > > > > > }
>>> > > > > >
>>> > > > > >
>>> > > > > > sub pop3close ($) {
>>> > > > > > 	if ($_[0]) {
>>> > > > > > 	 shutdown ($_[0], 2);
>>> > > > > > 	}
>>> > > > > > }
>>> > > > > > #-----------------------------------------------------
>>> > > > > >
>>> > > > > >
>>> > > > > >
>>> > > > > >
>>> > > > > >
>>> > > > > >
>>>_________________________________________________________________
>>> > > > > > The new MSN 8: smart spam protection and 2 months FREE*
>>> > > > > > http://join.msn.com/?page=features/junkmail
>>> > > > > >
>>> > > > >
>>> > > > >--
>>> > > > >abez ------------------------------------------
>>> > > > >http://www.abez.ca/ Abram Hindle (abez at abez.ca)
>>> > > > >------------------------------------------ abez
>>> > > >
>>> > > >
>>> > > > _________________________________________________________________
>>> > > > Add photos to your messages with MSN 8. Get 2 months FREE*.
>>> > > > http://join.msn.com/?page=features/featuredemail
>>> > > >
>>> > >
>>> > >--
>>> > >abez ------------------------------------------
>>> > >http://www.abez.ca/ Abram Hindle (abez at abez.ca)
>>> > >------------------------------------------ abez
>>> >
>>> >
>>> > _________________________________________________________________
>>> > Help STOP SPAM with the new MSN 8 and get 2 months FREE*
>>> > http://join.msn.com/?page=features/junkmail
>>> >
>>>
>>>--
>>>abez ------------------------------------------
>>>http://www.abez.ca/ Abram Hindle (abez at abez.ca)
>>>------------------------------------------ abez
>>
>>
>>_________________________________________________________________
>>Help STOP SPAM with the new MSN 8 and get 2 months FREE*
>>http://join.msn.com/?page=features/junkmail
>>
>
>
>_________________________________________________________________
>Tired of spam? Get advanced junk mail protection with MSN 8.
>http://join.msn.com/?page=features/junkmail




More information about the Victoria-pm mailing list