gri6507 has asked for the wisdom of the Perl Monks concerning the following question:
Disclamer: I must appologize in advance. This question is about perl, but the way it is peppered throughout our C code is not the best. Yet, for historic reasons, complete C code overhaul is out of the question.
Description: We have a C program that sits in a while(1) loop. Every now and again, this code decides to archive some data (append to existing file) by first fetching the existing file from the server. The archiving routine is done via perl's Net::FTP module. Since many workstations are running this code at the same time and the archiving is done to a single server, there are lots of lock files in place to inforce mutual exclusion.
Problem: The program is started on a workstation (I've seen the problem on just one workstation, but I think others have the problem as well). Time after time the archiving works fine. However some time later (still the same process, so nothing has changed), I get an error
What does this mean? How could the same instance of the C process be both successful and unsuccessful? Perl version v5.6.1 built for sun4-solaris-thread-multi and OS is SunOS 5.8 Generic_108528-13 sun4u sparc SUNW,Ultra-5_10. Here's the C code.Can't locate vars.pm in @INC (@INC contains: /opt/kiS600/lib/perl/sun4 +-solaris-thread-multi /opt/kiS600/lib/perl /usr/local/ActivePerl-5.6/ +lib/5.6.1/sun4-solaris-thread-multi /usr/local/ActivePerl-5.6/lib/5.6 +.1 /usr/local/ActivePerl-5.6/lib/site_perl/5.6.1/sun4-solaris-thread- +multi /usr/local/ActivePerl-5.6/lib/site_perl/5.6.1 /usr/local/Active +Perl-5.6/lib/site_perl .) at /usr/local/ActivePerl-5.6/lib/site_perl/ +5.6.1/Net/FTP.pm line 14. BEGIN failed--compilation aborted at /usr/local/ActivePerl-5.6/lib/sit +e_perl/5.6.1/Net/FTP.pm line 14. Compilation failed in require at archive_getfile.pl line 3. BEGIN failed--compilation aborted at archive_getfile.pl line 3.
/* this function creates and executes a perl script to fetch a remote +file via FTP */ int archive_getfile(const char *remotepath,const char *remotefilename, +const char *localfilename,const char *ip,const char *user,const char +*pw,int failifnotfound) { const char *perlfilename = "archive_getfile.pl"; FILE *perlfile; int r; char line[90]; int verbose = 0; int logintimeout; #ifdef DEBUG_ARCHIVE printf("archive_getfile(%s/%s -> %s)\n",remotepath,remotefilename, +localfilename); #endif perlfile = fopen(perlfilename,"w"); if (!perlfile) { perror("Error creating archive_getfile.pl"); return -1; } fprintf(perlfile,"$|++;\nuse strict;\n"); fprintf(perlfile,"use Net::FTP;\n"); fprintf(perlfile,"my $ip = '%s';\n", ip); fprintf(perlfile,"my $user = '%s';\n", user); fprintf(perlfile,"my $passwd = '%s';\n", pw); fprintf(perlfile,"my $remotepath = '%s';\n", remotepath); fprintf(perlfile,"my $remotefilename = '%s';\n", remotefilename); fprintf(perlfile,"my $localfilename = '%s';\n", localfilename); fprintf(perlfile,"my $global_lock = $remotefilename . '.lock';\n") +; fprintf(perlfile,"my $local_lock = $global_lock . '.local';\n"); fprintf(perlfile,"my $global_delete = $global_lock . '.delete';\n" +); fprintf(perlfile,"my $myname = `uname -n`;\n"); fprintf(perlfile,"my $pid = $$;\n"); fprintf(perlfile,"my $exitcode = 0;\n"); fprintf(perlfile,"my $locked = 0;\n"); fprintf(perlfile,"my $waittime = 0;\n"); fprintf(perlfile,"\n"); fprintf(perlfile,"$SIG{__DIE__}=sub {Finish(-1)};\n"); fprintf(perlfile,"\n"); fprintf(perlfile,"open(LOCK_LOCAL,\"> $local_lock\") || die \"Can' +t write to $local_lock: $!\n\";\n"); fprintf(perlfile,"chomp $myname;\n"); fprintf(perlfile,"print LOCK_LOCAL \"$myname,$pid\n\";\n"); fprintf(perlfile,"close(LOCK_LOCAL);\n"); fprintf(perlfile,"\n"); fprintf(perlfile,"my $ftp = Net::FTP->new($ip, Debug=>0, Timeout=> +500);\n"); fprintf(perlfile,"if($ftp->login($user, $passwd)) {\n"); fprintf(perlfile," if($ftp->cwd($remotepath)) {\n"); fprintf(perlfile," do {\n"); fprintf(perlfile," if(!$ftp->append($local_lock, $global_lock +)) {\n"); fprintf(perlfile," print \"Could not append $local_lock to +$global_lock\n\";\n"); fprintf(perlfile," $exitcode = -40;\n"); fprintf(perlfile," Finish($exitcode);\n"); fprintf(perlfile," }\n"); fprintf(perlfile," if (!$ftp->get($global_lock)) {\n"); fprintf(perlfile," print \"Could not get $global_lock\n\";\ +n"); fprintf(perlfile," $exitcode = -41;\n"); fprintf(perlfile," Finish($exitcode);\n"); fprintf(perlfile," }\n"); fprintf(perlfile," open(LOCK, $global_lock) || die \"Can't op +en $global_lock: $!\n\";\n"); fprintf(perlfile," my $line = <LOCK>;\n"); fprintf(perlfile," chomp $line;\n"); fprintf(perlfile," my ($lock_name, $lock_pid) = split(/,/,$li +ne);\n"); fprintf(perlfile," close(LOCK);\n"); fprintf(perlfile," if (($lock_name eq $myname) && ($lock_pid +== $pid)) {\n"); fprintf(perlfile," $locked = 1;\n"); fprintf(perlfile," } else {\n"); fprintf(perlfile," if ($waittime > 120) {\n"); fprintf(perlfile," print \"Deleting persistant $global_lo +ck\n\";\n"); fprintf(perlfile," my $delete_locked = 0;\n"); fprintf(perlfile," $waittime = 0;\n"); fprintf(perlfile," do {\n"); fprintf(perlfile," if(!$ftp->append($local_lock, $globa +l_delete)) {\n"); fprintf(perlfile," print \"Could not append $local_lo +ck to $global_delete\n\";\n"); fprintf(perlfile," $exitcode = -42;\n"); fprintf(perlfile," Finish($exitcode);\n"); fprintf(perlfile," }\n"); fprintf(perlfile," if (!$ftp->get($global_delete)) {\n" +); fprintf(perlfile," print \"Could not get $global_dele +te\n\";\n"); fprintf(perlfile," $exitcode = -43;\n"); fprintf(perlfile," Finish($exitcode);\n"); fprintf(perlfile," }\n"); fprintf(perlfile," open(LOCK, $global_delete) || die \" +Can't open $global_delete: $!\n\";\n"); fprintf(perlfile," my $line = <LOCK>;\n"); fprintf(perlfile," chomp $line;\n"); fprintf(perlfile," my ($lock_name, $lock_pid) = split(/ +,/,$line);\n"); fprintf(perlfile," close(LOCK);\n"); fprintf(perlfile," if (($lock_name eq $myname) && ($loc +k_pid == $pid)) {\n"); fprintf(perlfile," $delete_locked = 1;\n"); fprintf(perlfile," $ftp->delete($global_lock);\n"); fprintf(perlfile," } else {\n"); fprintf(perlfile," if ($waittime > 30) {\n"); fprintf(perlfile," print \"Call Marty. Something th +at should not have happened, did!\n\";\n"); fprintf(perlfile," $exitcode = -44;\n"); fprintf(perlfile," Finish($exitcode);\n"); fprintf(perlfile," } else {\n"); fprintf(perlfile," print \"Delete lock for $remotef +ilename is locked - waiting 3 seconds before retry.\n\";\n"); fprintf(perlfile," sleep(3);\n"); fprintf(perlfile," $waittime += 3;\n"); fprintf(perlfile," }\n"); fprintf(perlfile," }\n"); fprintf(perlfile," } while (!$delete_locked);\n"); fprintf(perlfile," } else {\n"); fprintf(perlfile," my $sleeptime = int(rand(10))+1;\n"); fprintf(perlfile," print \"File $remotefilename is locked + by $lock_name ($lock_pid)- waiting $sleeptime seconds before retry.\ +n\";\n"); fprintf(perlfile," sleep($sleeptime);\n"); fprintf(perlfile," $waittime += $sleeptime;\n"); fprintf(perlfile," }\n"); fprintf(perlfile," }\n"); fprintf(perlfile," } while (!$locked);\n"); fprintf(perlfile," $ftp->delete($global_delete);\n"); if(verbose) fprintf(perlfile," print 'Got my own lockfile\n';\n +"); fprintf(perlfile," if($ftp->get($remotefilename, $localfilename +)) {\n"); if(verbose) fprintf(perlfile," print \"Retrieved $remotepath/ +$remotefilename\n\";\n"); fprintf(perlfile," } else {\n"); if(failifnotfound) fprintf(perlfile," print \"Could not retri +eve file $remotepath/$remotefilename\n\";\n"); fprintf(perlfile," $exitcode = -100;\n"); fprintf(perlfile," }\n"); fprintf(perlfile," } else {\n"); fprintf(perlfile," print \"Could not cd to $remotepath\n\";\n") +; fprintf(perlfile," $exitcode = -30;\n"); fprintf(perlfile," }\n"); fprintf(perlfile," $ftp->quit;\n"); fprintf(perlfile,"} else {\n"); fprintf(perlfile," print \"Could not login to $ip as $user\n\";\n +"); fprintf(perlfile," $exitcode = -20;\n"); fprintf(perlfile,"}\n"); fprintf(perlfile,"Finish($exitcode);\n"); fprintf(perlfile,"\n"); fprintf(perlfile,"sub Finish {\n"); fprintf(perlfile," unlink($global_lock);\n"); fprintf(perlfile," unlink($local_lock);\n"); fprintf(perlfile," unlink($global_delete);\n"); fprintf(perlfile," exit shift;\n"); fprintf(perlfile,"}\n"); fclose(perlfile); logintimeout = 50; sprintf(line,"perl %s",perlfilename); do { r = system(line); r = r & 0xff00; r >>= 8; r = (char)r; if(r==-20) sleep(10); } while(r==-20 && logintimeout--); remove(perlfilename); return r; }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Can't locate vars.pm ... sometimes
by rinceWind (Monsignor) on Jun 24, 2004 at 14:51 UTC | |
by gri6507 (Deacon) on Jun 24, 2004 at 18:19 UTC | |
|
Re: Can't locate vars.pm ... sometimes
by iburrell (Chaplain) on Jun 24, 2004 at 16:06 UTC | |
by gri6507 (Deacon) on Jun 24, 2004 at 18:16 UTC | |
by iburrell (Chaplain) on Jun 24, 2004 at 19:53 UTC | |
|
Re: Can't locate vars.pm ... sometimes
by graff (Chancellor) on Jun 25, 2004 at 02:22 UTC |