[21814] in Perl-Users-Digest
Perl-Users Digest, Issue: 4018 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Oct 23 18:10:41 2002
Date: Wed, 23 Oct 2002 15:10:16 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Wed, 23 Oct 2002 Volume: 10 Number: 4018
Today's topics:
waitpid not returning pid? dkoleary@attbi.com
Re: waitpid not returning pid? dkoleary@attbi.com
Re: waitpid not returning pid? <mike_constant@yahoo.com>
Re: waitpid not returning pid? <mike_constant@yahoo.com>
Re: What is a file XXX.pl.swp ?? (Steve)
Win32::Perms a246456@fmr.com
Re: Win32::Perms a246456@fmr.com
Re: Writing Microsoft Outlook Notes With Perl (Chris)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Wed, 23 Oct 2002 19:15:44 GMT
From: dkoleary@attbi.com
Subject: waitpid not returning pid?
Message-Id: <yzCt9.2383$wF6.901379@news.randori.com>
Hey;
I apologize in advance for the long post. I'm writing a script which
will eventually scp multiple oracle archive logs simultaneously to a
DR site. Unlike the last time I had to use fork/exec calls, I have to
track specific pids so I can remove the original file if the scp was
successful or put the archive log back on the list if it didn't.
The perl version is a precompiled swdepot, version 5.6.1 on an HP
superdome running HPUX 11.11.
The script is still in the early stages. I'm working through the
fork/exec logic when I found what appears to be a discrepancy between
what the documentation says waitpid is supposed to return and what it's
returning.
I have the script exec'ing a max of $thresh children. Once a child dies,
another one can kick off. The logic to delete the archive log will
eventually be in the reaper function. At the moment, I'm simply
trying to track what pids are starting and getting killed.
The fork/exec portion of the script updates some hashes if we're in the
parent or does a very simple infinite loop if in the child.
Here's the log file of a short test run (I added the line numbers):
1 10/23/02 13:20:47 : Starting archd run.
2 10/23/02 13:20:47 : Reading /logcopy/test
3 10/23/02 13:20:47 : New file found: PRDarch1_253303.dbf
4 10/23/02 13:20:47 : File : PRDarch1_253303.dbf
5 10/23/02 13:20:47 : File (pid): PRDarch1_253303.dbf
6 10/23/02 13:20:47 : PID : 28252
7 10/23/02 13:20:47 : New file found: PRDarch1_253304.dbf
8 10/23/02 13:20:47 : File : PRDarch1_253304.dbf
9 10/23/02 13:20:47 : File (pid): PRDarch1_253304.dbf
10 10/23/02 13:20:47 : PID : 28253
11 10/23/02 13:20:47 : New file found: PRDarch1_253305.dbf
12 10/23/02 13:20:47 : File : PRDarch1_253305.dbf
13 10/23/02 13:20:47 : File (pid): PRDarch1_253305.dbf
14 10/23/02 13:20:47 : PID : 28254
15 10/23/02 13:21:17 : Reading /logcopy/test
16 10/23/02 13:21:42 : Stiff: 1
17 10/23/02 13:21:42 : File succeeded. Time: 17256621.7
18 10/23/02 13:22:12 : Reading /logcopy/test
19 10/23/02 13:22:12 : New file found: PRDarch1_253306.dbf
20 10/23/02 13:22:12 : File : PRDarch1_253306.dbf
21 10/23/02 13:22:12 : File (pid): PRDarch1_253306.dbf
22 10/23/02 13:22:12 : PID : 29088
23 10/23/02 13:22:42 : Reading /logcopy/test
Right after line 15, I killed PID 28254 from a different window.
As expected, the signal handler caught it. Here's the function:
1 sub reaper
2 { my ($stiff,$rc,$end);
3 our (%files,%new_files,%pids,$num);
4 while ($stiff = waitpid(-1, &WNOHANG) > 0)
5 { $num--; ### Number of running scps.
6 log_it("Stiff: $stiff");
7 $rc = $? >> 8;
8 if ($rc > 0 )
9 { log_it("File $pids{$stiff} failed w/RC $rc!");
10 ### Put file back on new_files list.
11 $new_files{$pids{$stiff}} = 1;
12 }
13 else
14 { $end = timelocal(localtime);
15 my $time = ($end - ${$files{$pids{$stiff}}}[1])/60;
16 log_it("File $pids{$stiff} succeeded. Time: $time");
17 delete($files{$pids{$stiff}});
18 }
19 }
20 $SIG{CHLD} = \&reaper;
21 }
Based on the waitpid documentation in the programming perl book, and
recipie 16.19, $stiff should be the process id of the dead child. Yet,
according to the log, $stiff == 1. Obviously, init isn't dead,
otherwise, I'd be having a radically different day. So, the question:
What am I messing up?
The full script, should anyone need it, will be sent as a followup to
this post in what's probably a vain attempt to keep this to a reasonable
length.
Thanks for any hints/tips/suggestions.
Doug O'Leary
--------
Senior UNIX Admin
Independent consultant
dkoleary@attbi.com
resume: http://home.attbi.com/~dkoleary/resume.html
------------------------------
Date: Wed, 23 Oct 2002 19:19:04 GMT
From: dkoleary@attbi.com
Subject: Re: waitpid not returning pid?
Message-Id: <FCCt9.2384$wF6.901379@news.randori.com>
Here's the full script should anyone need it.
Thanks again for any tips/hints/suggestions.
Doug
#!/usr/bin/perl
=cut
####################################################################
archd: Daemon process to monitor /logcopy/dbf filesystem for files
to scp to sapq1d01. This daemon will initiate scp sessions
as child processes with a maximum number of children setting
to avoid bottlenecking the system.
Author: Doug O'Leary
Created: 10/22/02
Updated:
####################################################################
=cut
use strict;
use POSIX ":sys_wait_h";
use Time::Local;
####################################################################
# Functions
####################################################################
sub log_it
{
my $msg = shift;
my ($sec, $min, $hour, $day, $mon, $year) = (localtime())[0..5];
my $Date = sprintf ("%02d/%02d/%02d %02d:%02d:%02d",
$mon+1, $day, $year%100, $hour, $min, $sec);
print "$Date : $msg\n";
}
sub reaper
{ my ($stiff,$rc,$end);
our (%files,%new_files,%pids,$num);
while ($stiff = waitpid(-1, &WNOHANG) > 0)
{ $num--; ### Number of running scps.
log_it("Stiff: $stiff");
$rc = $? >> 8;
if ($rc > 0 )
{ log_it("File $pids{$stiff} failed w/RC $rc!");
### Put file back on new_files list.
$new_files{$pids{$stiff}} = 1;
}
else
{ $end = timelocal(localtime);
my $time = ($end - ${$files{$pids{$stiff}}}[1])/60;
log_it("File $pids{$stiff} succeeded. Time: $time");
delete($files{$pids{$stiff}});
}
}
$SIG{CHLD} = \&reaper;
}
####################################################################
# Main
####################################################################
my $filesystem = "/logcopy/test";
our (%files,%new_files,%pids);
our $num = 0; ### Number of currently running scps
my $thresh = 3; ### Total number of concurrent scps allowed
# my $thresh = 10; ### Total number of concurrent scps allowed
my $sleepy_time = 30; ### Amount of time to sleep betwixt dir reads
my $dest_host = "sapq1d01";
my $dest_dir = "/logcopy/test";
my $log = "./archd.log";
$SIG{CHLD} = \&reaper; # Sets up reaping of zombie children Cool! hehe
####################################################################
# @{%files} structure
# ${$files{$file}}[0] = $pid
# ${$files{$file}}[1] = $start time
#-------------------------------------------------------------------
# %pids = $scp_pid => $file
####################################################################
### Set up logging:
open (Log, ">> $log" ) || die "Can't create $log - ($!)";
my $old_out = select(Log);
$| = 1;
log_it ("Starting archd run.");
### Infinite loop
while (1)
{
log_it("Reading $filesystem");
### Read dir
opendir(Dir,"$filesystem") || die "Can't opendir $filesystem ($!)";
while (defined(my $file = readdir(Dir)))
{
### Skip ., .., and lost+found
next if ($file =~ /^\.\.?$/ || $file =~ /lost\+found/ );
next if ($file !~ /dbf$/);
### If file not already found, find it.
$new_files{$file} = 1
if (! defined($files{$file}) && ! defined($new_files{$file}));
}
closedir Dir;
if ( scalar(keys %new_files) > 0 && $num < $thresh)
{ foreach my $file (sort keys %new_files)
{ last if ($num >= $thresh);
log_it("New file found: $file") if (! defined($files{$file}));
my $pid;
if ($pid = fork) ### Parent
{ my $start = timelocal(localtime);
$files{$file} = [ $pid, $start ];
$pids{$pid} = $file;
delete($new_files{$file});
$num++;
log_it("File : $file");
log_it("File (pid): $pids{$pid}");
log_it("PID : ${$files{$file}}[0]");
}
elsif (defined($pid)) ### Child
{ while (1)
{ sleep 30; }
}
}
}
sleep $sleepy_time;
}
# elsif (defined($pid)) ### Child
# { my $source = sprintf ("%s/%s", $filesystem, $file);
# my $target = sprintf ("%s:%s/%s", $dest_host, $dest_dir, $file);
# my @args = ( "/usr/local/bin/scp", "-Q", "-B",
# "$source",
# "$target"
# );
# # "-b 65536",
# # "-c arcfour",
# @args = ("ls","-ld","$filesystem/$file");
# system(@args);
# my $rc = $? >> 8;
# exit $rc;
# }
# print "-" x 70 . "\n";
# foreach my $t (sort keys %new_files)
# { print "|$t|\n"; }
# }
# }
# sleep $sleepy_time;
# }
--------
Senior UNIX Admin
Independent consultant
dkoleary@attbi.com
resume: http://home.attbi.com/~dkoleary/resume.html
------------------------------
Date: Wed, 23 Oct 2002 14:16:58 -0700
From: "Newbie" <mike_constant@yahoo.com>
Subject: Re: waitpid not returning pid?
Message-Id: <ap73js$s890k$1@ID-161864.news.dfncis.de>
<dkoleary@attbi.com> wrote in message
news:FCCt9.2384$wF6.901379@news.randori.com...
> Here's the full script should anyone need it.
>
> Thanks again for any tips/hints/suggestions.
>
IMO, you put too much stuff into the signal handler which is dangerous when
running with Perl versions prior to 5.8. You can simply wait for a child
process to avoid zombies like this.
[pseudo]
use strict;
while (1) {
my @filelist = getnewfiles;
while (my $file = pop @filelist) {
my $pid = fork or die "can't fork: $!\n";
$procs++;
if (fork == 0) {
process $file;
exit 0;
}
if ($procs == $limit) {
wait;
}
}
}
No signal handler is needed, which helps you avoid collecting cores on
systems under heavy load. (Perl versions prior to 5.8).
------------------------------
Date: Wed, 23 Oct 2002 14:19:24 -0700
From: "Newbie" <mike_constant@yahoo.com>
Subject: Re: waitpid not returning pid?
Message-Id: <ap73oe$rrr55$1@ID-161864.news.dfncis.de>
"Newbie" <mike_constant@yahoo.com> wrote in message
news:ap73js$s890k$1@ID-161864.news.dfncis.de...
>
> <dkoleary@attbi.com> wrote in message
> news:FCCt9.2384$wF6.901379@news.randori.com...
> > Here's the full script should anyone need it.
> >
> > Thanks again for any tips/hints/suggestions.
> >
> IMO, you put too much stuff into the signal handler which is dangerous
when
> running with Perl versions prior to 5.8. You can simply wait for a child
> process to avoid zombies like this.
>
> [pseudo]
>
>
> No signal handler is needed, which helps you avoid collecting cores on
> systems under heavy load. (Perl versions prior to 5.8).
Oh la la, I missed decreasing the number of forked processes when a child
exits
use strict;
while (1) {
my @filelist = getnewfiles;
while (my $file = pop @filelist) {
my $pid = fork or die "can't fork: $!\n";
$procs++;
if (fork == 0) {
process $file;
exit 0;
}
if ($procs == $limit) {
wait;
$procs--;
}
}
}
------------------------------
Date: Wed, 23 Oct 2002 18:43:33 GMT
From: THISISAFAKE@ADDRESS.000 (Steve)
Subject: Re: What is a file XXX.pl.swp ??
Message-Id: <3db6ed89.70069825@news.earthlink.net>
On Wed, 23 Oct 2002 06:50:02 GMT, Martien Verbruggen
<mgjv@tradingpost.com.au> wrote:
<<snip>>
>
>\begin[totally,utterly]{offtopic}
>
Sorry, I assumed because it came with a Perl script, it was the right
place to ask. :-(
I have emailed the programmer to tell me.
Steve
My real email address is dealsgalore[A-T]earthlink.net
www.cheap-land.com
------------------------------
Date: Wed, 23 Oct 2002 16:30:25 -0400
From: a246456@fmr.com
Subject: Win32::Perms
Message-Id: <3DB706E1.8D7D8A36@fmr.com>
I am trying to install win32-perms module from http://www.roth.net/. I
am getting this errors. Could you someone tell what is wrong with this
module??
PPM interactive shell (2.1.6) - type 'help' for available commands.
PPM> install http://www.roth.net/perl/packages/win32-perms.ppd
Install package 'http://www.roth.net/perl/packages/win32-perms.ppd?'
(y/N): y
Installing package
'http://www.roth.net/perl/packages/win32-perms.ppd'...
Error installing package
'http://www.roth.net/perl/packages/win32-perms.ppd': Co
uld not locate a PPD file for package
http://www.roth.net/perl/packages/win32-pe
rms.ppd
Thanks,
------------------------------
Date: Wed, 23 Oct 2002 16:34:26 -0400
From: a246456@fmr.com
Subject: Re: Win32::Perms
Message-Id: <3DB707D2.474F0752@fmr.com>
I tried locally by downloading Win32-Perms.ppd. Still having issues.
C:\temp>ppm install Win32-Perms.ppd
Installing package 'Win32-Perms.ppd'...
Error installing package 'Win32-Perms.ppd': Error reading
http://www.roth.net/perl/packages/x86/Win32/Perms_5006.tar.gz
a246456@fmr.com wrote:
> I am trying to install win32-perms module from http://www.roth.net/. I
> am getting this errors. Could you someone tell what is wrong with this
> module??
>
> PPM interactive shell (2.1.6) - type 'help' for available commands.
> PPM> install http://www.roth.net/perl/packages/win32-perms.ppd
> Install package 'http://www.roth.net/perl/packages/win32-perms.ppd?'
> (y/N): y
> Installing package
> 'http://www.roth.net/perl/packages/win32-perms.ppd'...
> Error installing package
> 'http://www.roth.net/perl/packages/win32-perms.ppd': Co
> uld not locate a PPD file for package
> http://www.roth.net/perl/packages/win32-pe
> rms.ppd
>
> Thanks,
------------------------------
Date: 23 Oct 2002 14:32:15 -0700
From: mullman@charter.net (Chris)
Subject: Re: Writing Microsoft Outlook Notes With Perl
Message-Id: <c71b7a2c.0210231332.39b077aa@posting.google.com>
Bob Walton <bwalton@rochester.rr.com> wrote in message news:<3DB60885.70804@rochester.rr.com>...
> Chris wrote:
>
> > I've got this half-baked idea for writing a program that will
> > dynamically generate Microsoft Outlook Notes from information gathered
> > from a database. I know how to do everything except create the
> > Outlook Note. Can anyone point me in the direction of information for
> > accomplishing this? I've seen others do this (not with Perl) where
> > the program will seek data from the weather service and write that
> > data into an Outlook Note. That's similar to what I am trying to do.
> >
> > Any help will be greatly appreciated.
> >
> > Chris
> >
>
> By "Outlook Note", do you mean "email note"? If so,
>
> use Net::SMTP;
No, I'm talking about the Memo's part of Outlook that allows you to
write individual's "notes" which look like Post-It notes.
Chris
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 4018
***************************************
