[22887] in Perl-Users-Digest
Perl-Users Digest, Issue: 5108 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Jun 11 18:05:56 2003
Date: Wed, 11 Jun 2003 15:05:09 -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, 11 Jun 2003 Volume: 10 Number: 5108
Today's topics:
Any Security Concerns With This Script? (BrianEWilliams)
Re: Beginning a script in the background (Dave Ardrey)
call other script - dont wait for return <Rene.Scheibe@Stud.TU-Ilmenau.de>
Re: call other script - dont wait for return <Rene.Scheibe@Stud.TU-Ilmenau.de>
Re: Catching error code outside of the range of 0-255 <daniel.nichols@NOSPAMvirgin.net>
Re: db file problem <dwilga-MUNGE@mtholyoke.edu>
Re: db file problem (dan baker)
executing commands on Windows NT <tequila-stuff@cox.net>
Re: executing commands on Windows NT (Malcolm Dew-Jones)
Re: executing commands on Windows NT <tequila-stuff@cox.net>
How to do a 'wrapper' on Windows? <foomf@attbi.com>
Re: How to I arrange for a socket connection to time ou (John Brock)
Re: How to I arrange for a socket connection to time ou <nospam@spamcop.com>
Re: How to I arrange for a socket connection to time ou <nospam@spamcop.com>
Re: IIS running perl scripts with VB not working <nospam@raytheon.com>
Re: manipulating files in Perl question. <gt8306b@mail.gatech.edu>
Net::Telnet Printing <member17678@dbforums.com>
Re: NEWBEE: Client-Server Timout implementation (Zack)
Re: Perl Matrix Filter Module like in Excel? <tzz@lifelogs.com>
Re: using Dumper to save hash and retrieving it. <bdonlan@bd-home-comp.no-ip.org>
Using SOAP::Lite module on remote server, Google API (Mike)
Re: Using SOAP::Lite module on remote server, Google AP <karabot@canada.com>
Re: Using SOAP::Lite module on remote server, Google AP <matthew@weierophinney.net>
Re: Using SOAP::Lite module on remote server, Google AP (Kevin Shay)
Re: Why is the system call not working? <garry@ifr.zvolve.net>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 11 Jun 2003 13:22:03 -0700
From: sorry_no_email@yahoo.com (BrianEWilliams)
Subject: Any Security Concerns With This Script?
Message-Id: <92383dd3.0306111222.289076fc@posting.google.com>
I have the following script which is used to upload files via a
browser to a remote web host that runs Linux/Apache:
#-------------Start---------------------------
#!/usr/bin/perl -w
use CGI::Carp qw(fatalsToBrowser);
use CGI qw(:standard);
use MIME::Lite qw(fatalsToBrowser);
use CGI::Upload;
use File::MMagic;
$mailprog = '/usr/sbin/sendmail';
$TimeStamp = time;
my $upload = CGI::Upload->new;
my $file_name = $upload->file_name('file1');
my $file_type = $upload->file_type('file1');
$upload->mime_magic('/path/to/mime/mimefile.txt');
my $mime_type = $upload->mime_type('file1');
my $file_handle = $upload->file_handle('file1');
$target = "file$TimeStamp.jpg";
open (STORAGE, ">>/path/to/uploaded_files/$target") or die "Error:
File $file_name Upload: $!\n";
while(read($file_handle, $data, 1024)){
print STORAGE $data or die "Can't write to the file because of
$!\n";
}
close STORAGE;
exit;
#-------------End---------------------------
My main question is whether this script has security holes that need
plugging. I would like to hear other comments because I have a lot to
learn. I know I probably have more "use" lines up at the top than I
need.
One thing I am a little cloudy on is this line:
$upload->mime_magic('/path/to/mime/mimefile.txt');
Is this so I can add my own mime types? If so, what format should I
use for the file?
BTW, here is a reference for CGI::Upload
http://search.cpan.org/author/ROBAU/CGI-Upload-1.05/lib/CGI/Upload.pm
------------------------------
Date: 11 Jun 2003 11:32:44 -0700
From: david.ardrey@analog.com (Dave Ardrey)
Subject: Re: Beginning a script in the background
Message-Id: <ca2d7776.0306111032.3ed25413@posting.google.com>
"bd" <bdonlan@bd-home-comp.no-ip.org> wrote in message news:<pan.2003.06.10.19.46.07.628916@bd-home-comp.no-ip.org>...
> On Tue, 10 Jun 2003 10:31:35 +0000, Dave Ardrey wrote:
>
> > I posted this question yesterday but I may have been a little unclear
> > as to what I need. I understand how to, from within a script, start a
> > process in the background:
> >
> > system("command &");
> >
> > However, what I need is for my entire script to immediately go into
> > the background, as soon as I execute it from the unix command line.
> >
> > I realize that I could have a tiny script that just does a system call
> > like above to the "real" script, but that's kind of gross.
> >
> > Is there another way to do it?
>
> Put this in where you want it to background.
> if(fork()) exit 0;
Thanks! That's just what I needed.
Dave
------------------------------
Date: Wed, 11 Jun 2003 23:11:27 +0200
From: "Rene Scheibe" <Rene.Scheibe@Stud.TU-Ilmenau.de>
Subject: call other script - dont wait for return
Message-Id: <bc85tv$gc1k7$1@ID-65612.news.dfncis.de>
i have two scripts.
and i want to call the second out of the first.
but the first should go on right after calling
the second one without waiting for its returning.
so how can i do this?
thanks
rene
------------------------------
Date: Wed, 11 Jun 2003 23:13:35 +0200
From: "Rene Scheibe" <Rene.Scheibe@Stud.TU-Ilmenau.de>
Subject: Re: call other script - dont wait for return
Message-Id: <bc8620$gj1vn$1@ID-65612.news.dfncis.de>
i also want to do this with subs.
is this asynchronous thing possible?
...rene
------------------------------
Date: Wed, 11 Jun 2003 21:17:19 +0000 (UTC)
From: Daniel Nichols <daniel.nichols@NOSPAMvirgin.net>
Subject: Re: Catching error code outside of the range of 0-255
Message-Id: <h17fev44gbp1bfgii2dnaa2s9cimm9lo1h@4ax.com>
Thanks.
It was me so who was responsible for trying to return a large error
code back to Perl!
I'll look at using an Oracle Perl module to handle the errors. I
thought I would avoid them and keep things simple with just a call to
sqlplus. This worked okay in the past in NT scripting for very simple
tasks by using NT's ERRORLEVEL(s).
I thought about only returning a warn or fatal status back to Perl
depending upon what I discover in SQL, but of course, in the situation
where I don't get a connection to Oracle I have no programmatic
control. I simply can't run code.
Daniel.
On 10 Jun 2003 22:57:39 -0700, carltonbrown@hotmail.com (Carlton
Brown) wrote:
>Daniel Nichols <daniel.nichols@NOSPAMvirgin.net> wrote in message news:<0ndcev00jl2i58jb872205pfsjopkrabq3@4ax.com>...
>[ snup ]
>> How can I call an OS program and handle return codes outside of the
>> range 0 to 255.
>
>Long story short - sqlplus is a command-line tool, use DBI/DBD modules
>if you can get them. They contain methods to get the error codes you
>want. Plenty of docs on this. Or you could even (ugh) scrape the
>screen output if you're truly stuck with sqlpus in a strict
>environment without the DB modules.
>
>Short story long - return codes outside of 0-255 are pretty uncommon
>because the terminating system call will typically discard everything
>except the lower 8 bits of whatever is passed to it. In fact I
>personally know of no exceptions. By the time PERL gets the data, the
>system call will have truncated out most of what you were interested
>in. You might ask why vendors try to stuff large software error
>codes into 8-bit OS return values - well, we can only guess.
------------------------------
Date: Wed, 11 Jun 2003 20:41:44 GMT
From: Dan Wilga <dwilga-MUNGE@mtholyoke.edu>
Subject: Re: db file problem
Message-Id: <dwilga-MUNGE-B42A1B.16414111062003@nap.mtholyoke.edu>
In article <bc7jeq$icq$1@nic.grnet.gr>,
"Vassilis Tavoultsidis" <ixanthi@ixanthi.remove.gr> wrote:
> I am working with the simple db files perl gives and I open and close the
> with the dbmopen and dbmclose files. Sometimes (i don't know the conditions)
> it seems that the file contains 2(!!) identical records in it. The records
> have the same key and the same content. If I erase one the other is gone
> too. If i modify one the other is modified too. I have tried to figure out
> what may cause this but nothing.
Are you doing updates to the DB in multiple instances of the same
program at the same time, for instance in a CGI program or something
that uses fork()?
If so, that's probably your problem. The dbmXXX calls don't support any
sort of locking. For more robust flatfile database access, use something
like the DB_INIT_CDB mode of the BerkeleyDB module (available on CPAN).
--
Dan Wilga dwilga-MUNGE@mtholyoke.edu
** Remove the -MUNGE in my address to reply **
------------------------------
Date: 11 Jun 2003 14:24:56 -0700
From: botfood@yahoo.com (dan baker)
Subject: Re: db file problem
Message-Id: <13685ef8.0306111324.72af61c2@posting.google.com>
"Vassilis Tavoultsidis" <ixanthi@ixanthi.remove.gr> wrote in message news:<bc7jeq$icq$1@nic.grnet.gr>...
> I am working with the simple db files perl gives and I open and close the
> with the dbmopen and dbmclose files. Sometimes (i don't know the conditions)
> it seems that the file contains 2(!!) identical records in it. The records
> have the same key and the same content. If I erase one the other is gone
> too. If i modify one the other is modified too. I have tried to figure out
> what may cause this but nothing.
>
> Does anyone know anything about this?
> ----------------
sounds like file locking issues... do you have more than one
person/process using the files? have you opend a "lockfile" and
flock()ed it prior to read/write of your DB?
d
------------------------------
Date: Wed, 11 Jun 2003 16:22:13 -0400
From: "j" <tequila-stuff@cox.net>
Subject: executing commands on Windows NT
Message-Id: <r7MFa.14985$C3.3689@lakeread01>
Maybe I'm missing something obvious here but on unix I can do the following:
@output=`some_unix_command;someother_unix_command`;
using ; to execute the commands in succession. What I need is the
equivilent in windows.
What I want to do is run a batch file to set-up my environment then execute
a couple commands in
the same system or backtick call.
I've tried
system("some_nt_command\nsomeother_nt_command"); #only the first command
executes
$cmd= <<"EOF";
some_nt_command
some_nt_command
EOF
system($cmd);
Doesn't work right either. Anyone have any clues on how this could be done.
My mind is a blank here.
tia,
Jay
------------------------------
Date: 11 Jun 2003 13:49:55 -0800
From: yf110@vtn1.victoria.tc.ca (Malcolm Dew-Jones)
Subject: Re: executing commands on Windows NT
Message-Id: <3ee795f3@news.victoria.tc.ca>
j (tequila-stuff@cox.net) wrote:
: Maybe I'm missing something obvious here but on unix I can do the following:
: @output=`some_unix_command;someother_unix_command`;
: using ; to execute the commands in succession. What I need is the
: equivilent in windows.
: What I want to do is run a batch file to set-up my environment then execute
: a couple commands in
: the same system or backtick call.
: I've tried
: system("some_nt_command\nsomeother_nt_command"); #only the first command
: executes
: $cmd= <<"EOF";
: some_nt_command
: some_nt_command
: EOF
: system($cmd);
: Doesn't work right either. Anyone have any clues on how this could be done.
: My mind is a blank here.
: tia,
: Jay
Try &&
e.g.
C:\> echo hello > xxx && dir xxx && type xxx && del xxx/p
I learned that (for the 10th time) by typing
C:\> help cmd | more
Otherwise you need to put the commands into a temporary batch file and run
the batch file (perhaps using cmd).
You can, of course, set environment variables and the current directory
from within perl before running the command
$ENV{...} = whatever ;
chdir xxx ;
------------------------------
Date: Wed, 11 Jun 2003 17:03:23 -0400
From: "j" <tequila-stuff@cox.net>
Subject: Re: executing commands on Windows NT
Message-Id: <0KMFa.15161$C3.1166@lakeread01>
The && worked great.
Many Thanks,
Jay
"Malcolm Dew-Jones" <yf110@vtn1.victoria.tc.ca> wrote in message
news:3ee795f3@news.victoria.tc.ca...
> j (tequila-stuff@cox.net) wrote:
> : Maybe I'm missing something obvious here but on unix I can do the
following:
> : @output=`some_unix_command;someother_unix_command`;
> : using ; to execute the commands in succession. What I need is the
> : equivilent in windows.
> : What I want to do is run a batch file to set-up my environment then
execute
> : a couple commands in
> : the same system or backtick call.
>
> : I've tried
>
> : system("some_nt_command\nsomeother_nt_command"); #only the first
command
> : executes
>
> : $cmd= <<"EOF";
> : some_nt_command
> : some_nt_command
> : EOF
> : system($cmd);
>
> : Doesn't work right either. Anyone have any clues on how this could be
done.
> : My mind is a blank here.
> : tia,
> : Jay
>
>
> Try &&
>
> e.g.
>
> C:\> echo hello > xxx && dir xxx && type xxx && del xxx/p
>
> I learned that (for the 10th time) by typing
>
> C:\> help cmd | more
>
> Otherwise you need to put the commands into a temporary batch file and run
> the batch file (perhaps using cmd).
>
> You can, of course, set environment variables and the current directory
> from within perl before running the command
>
> $ENV{...} = whatever ;
> chdir xxx ;
>
------------------------------
Date: Wed, 11 Jun 2003 18:49:39 GMT
From: "foomf" <foomf@attbi.com>
Subject: How to do a 'wrapper' on Windows?
Message-Id: <7RKFa.909447$OV.843548@rwcrnsc54>
I've got a problem that is trivial on UNIX of any flavor, but which is
giving me cramps on Windows.
I have a database access program that consumes licenses. It connects to a
server via a program that runs in a DOS command window.
The (sales) people who use this program are wont to simply abandon it for
more important things like clients, lunch, or going
home, without properly shutting it down. This leaves licenses locked up,
and when they turn off their computers, as they also
like to do, the licenses never get freed because the sockets never close
correctly on the server.
I've been instructed to put a wrapper around the process that watches
keyboard input and if it is left untouched for too long, sends the sequence
to shut down the database connection.
I'm finding it extremely hard to create a new process with standard-in bound
to standard-out of my program, in the traditional command window.
Is there anyone who knows how to do this? Can you point me to a way?
------------------------------
Date: 11 Jun 2003 14:54:42 -0400
From: jbrock@panix.com (John Brock)
Subject: Re: How to I arrange for a socket connection to time out?
Message-Id: <bc7tti$l3o$1@panix1.panix.com>
In article <DUJFa.34895$6f3.5663955@news1.telusplanet.net>,
BrianC <nospam@spamcop.com> wrote:
>> > I am using Perl to write a client module which communicates with
>> > a server through a socket connection. I want the client to time
>> > out the socket connection if the server does not respond within,
>> > let's say, 60 seconds, and I am trying to figure out the correct
>> > and idiomatic Perl way to do this. (I also want this to be portable,
>> > since the client needs to run on both Unix and Windows NT).
> I did this:
>
>$CLIENT_MAX_WAIT = 60;
>my $time = time;
>while (defined ($buf = <$sock>) )
> {
> $response .= $buf;
> if( time - $time > $CLIENT_MAX_WAIT) { print "timed out\n"; last(); }
> }
>close $sock;
What if $buf = <$sock> never returns?
--
John Brock
jbrock@panix.com
------------------------------
Date: Wed, 11 Jun 2003 21:01:01 GMT
From: "BrianC" <nospam@spamcop.com>
Subject: Re: How to I arrange for a socket connection to time out?
Message-Id: <hMMFa.27201$MM4.4944200@news0.telusplanet.net>
> > I did this:
> >
> >$CLIENT_MAX_WAIT = 60;
> >my $time = time;
> >while (defined ($buf = <$sock>) )
> > {
> > $response .= $buf;
> > if( time - $time > $CLIENT_MAX_WAIT) { print "timed out\n"; last(); }
> > }
> >close $sock;
>
> What if $buf = <$sock> never returns?
You are right. This works better on the client side:
while( time - $time < $CLIENT_MAX_WAIT)
{
while (defined ($buf = <$sock>) ) { print $buf; }
}
------------------------------
Date: Wed, 11 Jun 2003 21:11:19 GMT
From: "BrianC" <nospam@spamcop.com>
Subject: Re: How to I arrange for a socket connection to time out?
Message-Id: <XVMFa.27236$MM4.4946477@news0.telusplanet.net>
"BrianC" <nospam@spamcop.com> wrote in message
news:hMMFa.27201$MM4.4944200@news0.telusplanet.net...
> > > I did this:
> > >
> > >$CLIENT_MAX_WAIT = 60;
> > >my $time = time;
> > >while (defined ($buf = <$sock>) )
> > > {
> > > $response .= $buf;
> > > if( time - $time > $CLIENT_MAX_WAIT) { print "timed out\n"; last(); }
> > > }
> > >close $sock;
> >
> > What if $buf = <$sock> never returns?
>
> You are right. This works better on the client side:
I have been wrong twice! This works best:
$sock->timeout($CLIENT_MAX_WAIT );
while (defined ($buf = <$sock>) ) { print $buf; }
close $sock;
RTFM BC
------------------------------
Date: Wed, 11 Jun 2003 15:36:33 -0500
From: Chris Olive <nospam@raytheon.com>
Subject: Re: IIS running perl scripts with VB not working
Message-Id: <4qMFa.3530$c6.3314@bos-service2.ext.raytheon.com>
Krusty wrote:
> On computer B, and C IIS win 2000 server, my script exits without
> really running. Or the file I pipe to gets 0 bytes.
>
> If I use a basic exe files, I do get output.
>
> I pretty sure my security setting on both IIS systems are identical.
> Or as far as I can tell. Are there any i should really check again?
> My exe file accesses other websites / works as a crawler.
>
> On thing I noticed on my computer is if I, put a perl dll file in the
> same directory on computer A it fails. (it has activestate installed)
> I'm using pp compiler, but perl2exe doesn't work either.
> I just installed service pack 3 on 1 of them? Is there a difference
> in VB IIS there?
(1) You don't indicate what version of ASPN you are running.
(2) You don't indicate what version of IIS you are running (I am
assuming v5.x since you are running W2K)
(3) Your IIS application or virtual server has to provide execute access
for "Scripts And Executables" to run a Perl CGI. Did you do that?
(4) You have to have .pl (or .cgi) extensions configured in IIS to point
to your Perl.Exe executable. Did you do that?
(5) None of this has anything to do with VB or the VB scripting engine.
(6) Can you do this?:
#!c:/perl/bin/perl
$|++;
print << EOT;
Context-type: text/plain
Running Perl
EOT
exit;
It's doubtful a lot of folks would consider this the exact right
newsgroup to which you should post for a problem like this. I'd be
willing to bet that your problem is either related to your IIS
configuration, or you have a bad Perl install (bad pathing, etc.) This
probably isn't a Perl issue strictly speaking, but maybe the above will
help some.
Chris
-----
Chris Olive
Systems Consultant
Raytheon Technical Services Corporation
Indianapolis, IN
email: olivec(AT)indy(DOT)raytheon(DOT)com
------------------------------
Date: Wed, 11 Jun 2003 16:03:22 -0400
From: "Siddharth K. Joshi" <gt8306b@mail.gatech.edu>
Subject: Re: manipulating files in Perl question.
Message-Id: <Pine.SOL.4.33.0306111603070.6832-100000@acmey.gatech.edu>
That worked, exactly. Thank You.
Siddharth K. Joshi
Georgia Institute of Technology, Atlanta Georgia, 30332
Email: gt8306b@prism.gatech.edu
On Wed, 11 Jun 2003, Janek Schleicher wrote:
> Siddharth K. Joshi wrote at Wed, 11 Jun 2003 12:53:11 -0400:
>
> > I have automated the downloading of .png images that are genarated by a
> > .cgi program. The files are succesfully downloaded to my directory of
> > choice (on an XP box). Now, I'm seeking to "pipeline" those images to an
> > HTML document using the opendir command. Everything works syntactically,
> > save for the fact that upon printing to the HTML filehandle, it prints
> > literally what was specified rather than the data stored in the respective
> > variables containing the images, e.g.:
> >
> > print HTML qq~<tr><td>$myimage</td></tr>~;
> >
> > outputs "myimage.png" rather than the image @ myimage itself.
>
> So it prints what is specified by the variable containing the image
> _filename_. Just because a variable holds a filename, that doesn't mean it
> knows that it is a file.
>
> > So, in sum, there's some problem in the referencing of the file.
>
> Erm yes, allthough it seems to be more a HTML problem instead of Perl
> problem.
> A first start (working local on your computer) might be:
>
> print HTML qq~<tr><td><img src="$myimage"></td></tr>~;
>
>
> Best Wishes,
> Janek
>
------------------------------
Date: Wed, 11 Jun 2003 18:47:30 +0000
From: Mario542 <member17678@dbforums.com>
Subject: Net::Telnet Printing
Message-Id: <2991160.1055357250@dbforums.com>
Does anyone know if Is it possible to print what you want out of a
net::telnet session to make it look cleaner?
Lets say you just want to print the results instead of the whole
session.
my $telnet = Net::Telnet->new(HOST=>'-.-.-.-', Timeout=>3);
$telnet->login (USER, PASS);
my @lines =$telnet->cmd("ls -es ;who");
print "@lines";
--
Posted via http://dbforums.com
------------------------------
Date: 11 Jun 2003 14:27:18 -0700
From: uzmargov@yahoo.com (Zack)
Subject: Re: NEWBEE: Client-Server Timout implementation
Message-Id: <a5f6b9a8.0306111327.1b24ef1f@posting.google.com>
jbrock@panix.com (John Brock) wrote in message news:<bc7gnl$lh5$1@panix1.panix.com>...
> I asked about this recently in this newsgroup: look for the thread
> "How to I arrange for a socket connection to time out?". I ended
> up using IO:Socket for dealing with socket connections and the
> can_read() method of IO::Select for doing the timeouts. I didn't
> need to use alarm() or interupts at all. Note that IO::Socket has
> it's own timeout() method which only applies to connect() and
> accept() (which wouldn't be covered by IO::Select since no filehandle
> exists yet).
>
.....
Thank you very much for the response. I'll look at the thread.
I also have found the solution that seem to work and would be glad to
hear from anyone on the subject of correctness.
Now, I faced another problem:
I want my client to send multiple requests, one after another, so the
schema would be:
1. client request_1 info from server
2. client receives answer from server regarding request_1
3. client request_2 info from server
4. client receives answer from server regarding request_2
The problem I am having is that server receives request_1 and sends
the reply.
However server does not receive request_2 and does not sends the reply
on request_2.
Bellow I provide Client and the server code (with changes regarding my
original question). Also, since I am learning, I would be more than
happy to hear any responses/criticism about the code itself.
#!/usr/bin/perl
###### THIS IS SERVER PART ##########
use Socket;
use Errno qw(EAGAIN);
$SERVER_NAME = "tvgmag3.tvguide.com";
$SERVER_PORT = 5030;
$MAX_CLIENTS = 10;
$TIMEOUT = 5;
$SIG{'ALRM'} = 'Signal_Handler';
%ERRORS = (
error1 => {error_id => 1, error_msg => "Couldn't bind to port
$SERVER_PORT",},
error2 => {error_id => 2, error_msg => "Couldn't listen on port
$SERVER_PORT",},
error3 => {error_id => 3, error_msg => "Can't fork a rocess",},
error4 => {error_id => 4, error_msg => "Didn't understand the
question!",},
error5 => {error_id => 5, error_msg => "The process timeout
occured!"},
);
%WARNINGS = (
warning1 => {warning_id => 1, warning_msg => "Server is started on
$SERVER_NAME:$SERVER_PORT",},
warning2 => {warning_id => 2, warning_msg => "Caught the request from
a Client:",},
warning3 => {warning_id => 3, warning_msg => "Received request from
Client:",},
warning4 => {warning_id => 4, warning_msg => "Caught Signal:",},
);
#########################################################################
MAIN: {
# Make the socket
socket ($SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
# So we can restart our server quickly
setsockopt($SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
# Build up my socket address
$my_addr = sockaddr_in($SERVER_PORT, INADDR_ANY);
bind($SERVER, $my_addr) or die Log_Error($ERRORS{error1}, $!);
# Establish a queue for incoming connections
listen($SERVER, $MAX_CLIENTS) or die Log_Error($ERRORS{error2}, $!);
Log_Warning($WARNINGS{warning1});
# Accept and process connections
while ($client_paddr = accept($CLIENT, $SERVER)) {
#enable command buffering
select((select($SERVER), $| = 1)[0]);
select((select($CLIENT), $| = 1)[0]);
# do something with the new Client connection
{
my ($port, $iaddr) = sockaddr_in($client_paddr);
my $cname = gethostbyaddr($iaddr,AF_INET);
Log_Warning($WARNINGS{warning2},$cname);
}
# fork the child process for each connection
FORK: {
if ($pid = fork) {
# parent here. Child process pid is available in $pid
waitpid($pid,WNOHANG);
}
elsif (defined $pid) { #$pid is zero here if defined
# child here parent process pid is available with getppid
eval {
alarm($TIMEOUT);
work_with_client($client_paddr, $CLIENT);
alarm(0);
};
# propagate errors
die if $@ && $@ ne "alarm\n";
DoKill($$);
}
elsif ($! == EAGAIN) {
# EAGAIN is the supposedly recoverable fork error
sleep 5;
redo FORK;
}
else {
# Some weird fork error occured
die Log_Error($ERRORS{error3}, $!);
}
} # End FORK.
close($CLIENT);
} # END while
close($SERVER);
} # END MAIN
#####################################################################
sub work_with_client {
my $client_paddr = shift;
my $client_sock = shift;
#while(1) {};
my ($client_port, $client_ipaddress) = sockaddr_in($client_paddr);
my $client_name = gethostbyaddr($client_ipaddress, AF_INET);
my $client_question = Get_Request($client_sock);
Log_Warning($WARNINGS{warning3},$client_name);
Log_Msg("The client Request is: $client_question");
if ($client_question =~ /^ls\|/) {
$reply = ls ($');
Send_Reply($client_sock,$reply);
}
elsif ($client_question =~ /^group1\|/) {
$reply = Exec_Group1();
}
elsif ($client_question =~ /^Hello/) {
Send_Reply($client_sock, "Welcome, to Queen, my friend:
$client_name");
}
else {
Send_Reply($client_sock, "WRONG REQUEST");
}
}
#####################################################################
sub Get_Request {
my $sock = shift;
my $client_request;
while ($client_request !~ /\|\|\|\|$/ && sysread($sock, $c, 1)) {
$client_request .= $c;
}
$client_request = substr($client_request,0,length($client_request) -
4);
return $client_request;
}
#####################################################################
sub Send_Reply {
my $sock = shift;
my $reply = shift;
Log_Msg("About to send reply: \"$reply\" to the Client");
$reply .= "\|\|\|\|";
$written = syswrite($sock, $reply, length($reply));
}
#####################################################################
sub ls {
my @path = shift;
$return_val = `ls @path`;
print "value to return: $return_val";
return $return_val;
}
#####################################################################
sub Exec_Group1 {
print "group1 request\n";
}
#####################################################################
sub Log_Msg {
my $msg = shift;
print "$msg\n";
}
#####################################################################
sub Log_Warning {
my $warning_hash = shift;
my $arg = shift;
print "WARNING: ID = $warning_hash->{warning_id}; MESSAGE:
$warning_hash->{warning_msg} $arg\n";
}
#####################################################################
sub Log_Error {
my $error_hash = shift;
my $arg = shift;
print "ERROR: ID = $error_hash->{error_id}; MESSAGE:
$error_hash->{error_msg}. $arg\n";
}
#####################################################################
sub Signal_Handler {
local($sig) = shift;
my $msg;
if ($sig eq "ALRM") {
$msg = "ERROR: ID = " . $ERRORS{error5}->{error_id} . "; ";
$msg .= "MESSAGE: " . $ERRORS{error5}->{error_msg}. "||||";
Log_Warning($WARNINGS{warning4},$sig);
Send_Reply($CLIENT, $msg);
die "alarm\n";
}
}
#####################################################################
sub DoKill {
my $child_pid = shift;
kill (9, $child_pid) if $child_pid;
}
#####################################################################
#####################################################################
#####################################################################
#!/usr/bin/perl
########## THIS IS CLIENT PART ######################################
use Socket;
#########################################################################
MAIN: {
$remote_host = "mag3.tvguide.com";
$remote_port = 5030;
# Create a socket
socket($SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
# Build the address of the remote machine
$internet_addr = inet_aton($remote_host)
or die "Couldn't convert $remote_host into an internet
address: $!\n";
$paddr = sockaddr_in($remote_port, $internet_addr);
# Connect to server
connect($SERVER, $paddr)
or die "Coulnd't connect to $remote_host:$remote_port:
$!\n";
select((select($SERVER), $| = 1)[0]); #enable command buffering
if ($child_pid = fork) {
# Send a handshake
Send_Request($SERVER, "gHello");
Send_Request($SERVER, "Wrong request");
sleep 3;
kill 9, $child_pid;
}
else {
$answer = Get_Reply($SERVER);
$answer = Get_Reply($SERVER);
}
# Terminate the connection when done
close($SERVER);
} # End MAIN
###########################################################################
sub Get_Reply {
my $sock = shift;
my $reply;
while (sysread($sock, $c, 1) && $reply !~ /\|\|\|\|$/) {
$reply .= $c;
}
print "REPLY FROM Get_SERVER_Reply () : $reply\n";
return $reply;
}
###########################################################################
sub Send_Request {
my $filehandle = shift;
my $msg = shift;
$msg .= "||||";
$written = syswrite($filehandle, $msg, length($msg));
die "syswrite failed: $!\n" unless $written == length($msg);
}
###########################################################################
------------------------------
Date: Wed, 11 Jun 2003 15:51:53 -0400
From: Ted Zlatanov <tzz@lifelogs.com>
Subject: Re: Perl Matrix Filter Module like in Excel?
Message-Id: <4nznko2y06.fsf@lockgroove.bwh.harvard.edu>
On Tue, 10 Jun 2003, Dennis@NoSpam.com wrote:
> However I need to find the bottom 10% of column B. Column B of the
> matrix has 5000 elements. I need to find the 500th (10% of
> 5000)bottom element of Column B and the 500th top element of Column
> C before I can go through the rows one by one to see if the column B
> elements<=#500thB AND Column C element>+#500thC
Because reading backwards makes no sense.
Please *follow* messages with your comments. Why?
Perl lets you retrieve "slices" of an array. For instance, $array[-2]
is the second from last element, while $array[-1] is the last element
in the array. scalar() gives you the size of the array. So, given
@array with 5000 elements:
my $length = scalar @array; # 5000 in your example
die 'empty array @array' unless $length;
my $proportion = 0.1; # 10%
my $block_size = $length * $proportion; # 500 in your example
# we use an array slice here! This gets elements -500 through -1
my @slice_last_10_percent = @array[(-1*$block_size)..-1];
Read all the replies you've received so far. PDL might be especially
relevant to your situation.
Ted
------------------------------
Date: Wed, 11 Jun 2003 16:00:12 -0400
From: "bd" <bdonlan@bd-home-comp.no-ip.org>
Subject: Re: using Dumper to save hash and retrieving it.
Message-Id: <pan.2003.06.11.20.00.04.611612@bd-home-comp.no-ip.org>
On Wed, 11 Jun 2003 14:32:41 +0000, ktom wrote:
> Martien Verbruggen wrote:
>> On Wed, 11 Jun 2003 00:34:53 GMT,
>> ktom <abc@nowhere.com> wrote:
>>
>>>i have created a file using the Data::Dumper command..
>>>
>>>the command used was
>>>print OFILE Data::Dumper->Dump([\%pHash],['*xHash']);
[snip]
>> Is your %xHash lexically scoped (with my)? If so, take into account
>> that do EXPR can't work with lexicals. You need to make sure that
>> %xHash is a global (declare with our, or for old Perls with use vars).
>
> BINGO!! the proper use of 'our' solved the problem!
>
> thanks for the other suggestions as well, they are always helpful.
>
> if you (someone) could explain what purpose the square brackets serve in
> the Data::Dumper->Dump([\%pHash],['*xHash'] statement. I know that it
> works but with my limited experience it doesn't make much sense..
[ ] is like ( ), but produces a reference to an anonymous array (see
perldoc perlreftut). According to perldoc Data::Dumper:
# extended usage with names
print Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]);
[...]
PACKAGE->new(ARRAYREF [, ARRAYREF])
Returns a newly created "Data::Dumper" object. The first argument
is an anonymous array of values to be dumped. The optional second
argument is an anonymous array of names for the values. The names
need not have a leading "$" sign, and must be comprised of alphanu-
meric characters. You can begin a name with a "*" to specify that
the dereferenced type must be dumped instead of the reference
itself, for ARRAY and HASH references.
The prefix specified by $Data::Dumper::Varname will be used with a
numeric suffix if the name for a value is undefined.
Data::Dumper will catalog all references encountered while dumping
the values. Cross-references (in the form of names of substructures
in perl syntax) will be inserted at all possible points, preserving
any structural interdependencies in the original set of values.
Structure traversal is depth-first, and proceeds in order from the
first supplied value to the last.
$OBJ->Dump or PACKAGE->Dump(ARRAYREF [, ARRAYREF])
Returns the stringified form of the values stored in the object
(preserving the order in which they were supplied to "new"), sub-
ject to the configuration options below. In a list context, it
returns a list of strings corresponding to the supplied values.
The second form, for convenience, simply calls the "new" method on
its arguments before dumping the object immediately.
Just remember that the answers to most of life's mysteries can be found in
perldoc :)
------------------------------
Date: 11 Jun 2003 11:20:30 -0700
From: csdude@hotmail.com (Mike)
Subject: Using SOAP::Lite module on remote server, Google API
Message-Id: <46cdc619.0306111020.50832dea@posting.google.com>
Hey, I'm using a remote server, and even though they don't have
SOAP::Lite installed by default, they said that I can install it
myself as long as I change the @INC array. I need the module to work
with the Google API.
The program I'm trying to use came with the Google API, and it is:
#!/usr/bin/perl
use "SOAP::Lite";
my $key='000000000000000000000000';
my $query="foo";
my $googleSearch = SOAP::Lite -> service("file:GoogleSearch.wsdl");
my $result = $googleSearch -> doGoogleSearch($key, $query, 0, 10,
"false", "", "false", "", "latin1", "latin1");
print "About $result->{'estimatedTotalResultsCount'} results.\n";
Since I uploaded the module to the cgi-bin, I changed 'use
"SOAP::Lite";' to 'use lib "Lite";', and then I changed
'$googleSearch=SOAP::Lite->' to '$googleSearch=Lite->'. Of course, I
used the $key that Google emailed to me.
The problem I'm having is that when I run the script, I get an ISE.
The error log says 'Can't locate object method "service" via package
"Lite",' even though the subrouting "service" IS in the Lite.pm
module.
So my questions are:
(1) is the module installed correctly? I just uploaded Lite.pm to the
cgi-bin (and also tried uploading it to the home directory to no
effect). I made a test script of:
use lib "Lite";
print "Content-type: text/html\n\n";
print "It's working";
that worked just fine, but it's not actually using the module, either.
(2) If the module is installed correctly, am I calling it correctly?
The line that says '$googleSearch=Lite->' is obviously where there's a
problem, so I'm thinking there may be a syntax error here, but I don't
know how to fix it.
(3) In reading Lite.pm, it looks like it calls several other SOAP
modules, but I couldn't find any of them on CPAN. Is there somewhere
that I'm supposed to download an entire SOAP package, or should I be
able to do this with just the Lite.pm?
TIA,
Mike
------------------------------
Date: Wed, 11 Jun 2003 14:49:53 -0400
From: "George Karabotsos" <karabot@canada.com>
Subject: Re: Using SOAP::Lite module on remote server, Google API
Message-Id: <rRKFa.3922$JN6.689777@news20.bellglobal.com>
> "SOAP::Lite";' to 'use lib "Lite";', and then I changed
Ok not sure where you loaded the modules or what are you doing ut changing
use SOAP::Lite
to
use lib 'Lite'
does not look correct to me.
I would think you will need something like:
use lib 'SOAP';
use Lite;
then whatever you try to do.
Also instead of changing the program why don't you install the SOAP::Lite
package in a directory you have write permissions to and then just do:
use lib '/path/to/SOAP/local/installation'
in your program.
hope it helps,
George
------------------------------
Date: Wed, 11 Jun 2003 19:11:14 GMT
From: Matthew Weier O'Phinney <matthew@weierophinney.net>
Subject: Re: Using SOAP::Lite module on remote server, Google API
Message-Id: <slrnbeevmv.ti8.matthew@kavalier.weierophinney.net>
* Mike <csdude@hotmail.com>:
> Hey, I'm using a remote server, and even though they don't have
> SOAP::Lite installed by default, they said that I can install it
> myself as long as I change the @INC array. I need the module to work
> with the Google API.
<snip>
> Since I uploaded the module to the cgi-bin, I changed 'use
> "SOAP::Lite";' to 'use lib "Lite";', and then I changed
> '$googleSearch=SOAP::Lite->' to '$googleSearch=Lite->'. Of course, I
> used the $key that Google emailed to me.
The use lib pragma expects not module names but directories where it
should look for modules. If you do a 'perldoc -q lib', you'll see that
what it's doing is shifting each entry in the list given to lib onto
@INC.
What I'd suggest is making a directory where you'll install modules,
installing Soap::Lite there, and then adding the following to your
script:
use lib '/path/to/your/new/lib/directory';
use Soap::Lite;
and then using Soap::Lite's methods as its documentation specifies.
> The problem I'm having is that when I run the script, I get an ISE.
> The error log says 'Can't locate object method "service" via package
> "Lite",' even though the subrouting "service" IS in the Lite.pm
> module.
>
> So my questions are:
>
> (1) is the module installed correctly? I just uploaded Lite.pm to the
> cgi-bin (and also tried uploading it to the home directory to no
> effect).
No. When you 'use Soap::Lite;' perl is looking for 'Soap/Lite.pm'
somewhere in its @INC. If you 'use Lite;' perl is looking for 'Lite.pm'
somewhere in its array. Even if you do the latter, the object created
will be of the class SOAP::Lite, so you need to return to the
appropriate usage (i.e., use '$googleSearch = SOAP::Lite->' instead of
'$googleSearch = Lite->').
> I made a test script of:
>
> use lib "Lite";
> print "Content-type: text/html\n\n";
> print "It's working";
In this example, you're not even loading the SOAP::Lite module; you're
simply telling your script to look for any modules in the "Lite"
directory under the current directory. Since you don't load any, it
doesn't choke, and, of course, it works.
--
Matthew Weier O'Phinney
matthew@weierophinney.net
http://matthew.weierophinney.net
------------------------------
Date: 11 Jun 2003 14:15:04 -0700
From: kevin_shay@yahoo.com (Kevin Shay)
Subject: Re: Using SOAP::Lite module on remote server, Google API
Message-Id: <5550ef1e.0306111315.6461b74a@posting.google.com>
csdude@hotmail.com (Mike) wrote in message news:<46cdc619.0306111020.50832dea@posting.google.com>...
> Hey, I'm using a remote server, and even though they don't have
> SOAP::Lite installed by default, they said that I can install it
> myself as long as I change the @INC array. I need the module to work
> with the Google API.
...
> (1) is the module installed correctly? I just uploaded Lite.pm to the
> cgi-bin (and also tried uploading it to the home directory to no
> effect).
That definitely won't work. SOAP::Lite is a whole package containing a
bunch of different modules. You should download the whole thing from
http://www.soaplite.com/
or
http://search.cpan.org/dist/SOAP-Lite/
(Use the [Download] link at the top, not the SOAP::Lite link in the
list of individual files.)
Then upload it onto your server and install it. You'll need
command-line access to the server. The basics of installing modules:
http://www.perldoc.com/perl5.6/pod/perlmodinstall.html
And here's a good tutorial on how to install modules into your own
directory on a server:
http://www.perl.com/pub/a/2002/04/10/mod_perl.html
I've successfully installed SOAP::Lite in this way and used it with
the Google API, so I know it works.
Kevin
--
perl -MLWP::UserAgent -e '$u=new LWP::UserAgent;$u->agent("japh");
print join(" ",(split(/\s+/,(split/\n/,$u->request(HTTP::Request->
new(GET=>join("",split(/\n/,"http://groups.google.com/groups?selm=
4365%40omepd.UUCP&output=gplain"))))->content)[60]))[0..3]),",\n"'
------------------------------
Date: Wed, 11 Jun 2003 19:50:04 -0000
From: Garry Williams <garry@ifr.zvolve.net>
Subject: Re: Why is the system call not working?
Message-Id: <slrnbef1vs.2j9.garry@zfw.zvolve.net>
On Wed, 11 Jun 2003 12:35:09 -0400, zentara <zentara@highstream.net> wrote:
> On 11 Jun 2003 02:47:30 -0700, magelord@t-online.de (Math55) wrote:
>
>>i wrote this system call with backticks:
>>
>>`du -m -a ./|awk '{print $2 , $1}' > /tmp/all`;
>>
>>it always gives me an parse error because of the ''. even if i try it like this:
>
>>anyone who can help me?
> When I run it, I get an error about the comma between $1 and $2
> awk: cmd. line:1: {print ,}
> awk: cmd. line:1: ^ parse error
Others have pointed out that the error is an awk error -- not Perl.
The reason is that Perl is inteperpolating $1 an $2 instead of awk.
--
Garry Williams
------------------------------
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 5108
***************************************
