[28318] in Perl-Users-Digest
Perl-Users Digest, Issue: 9682 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Sep 4 18:05:49 2006
Date: Mon, 4 Sep 2006 15:05:08 -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 Mon, 4 Sep 2006 Volume: 10 Number: 9682
Today's topics:
Re: (Off topic) Cyberwar question <skybuck2000@hotmail.com>
Re: (Off topic) Cyberwar question <skybuck2000@hotmail.com>
Re: (Off topic) Cyberwar question <skybuck2000@hotmail.com>
Re: (Off topic) Cyberwar question <mgarrish@gmail.com>
Re: (Off topic) Cyberwar question <jurgenex@hotmail.com>
Re: CPAN - 'cl' is not recognized as an internal or ext <mumia.w.18.spam+nospam.usenet@earthlink.net>
Re: Cygwin error regarding profile.global <tadmc@augustmail.com>
Re: Cygwin error regarding profile.global <mgarrish@gmail.com>
Re: Cygwin error regarding profile.global beartiger@gmail.com
Re: imagemagick very slow - is there anything better? <someone@example.com>
Re: Insert Log file into oracle table <see.sig@rochester.rr.com>
Re: map tricks <joe@inwap.com>
Re: map tricks <uri@stemsystems.com>
Re: Net::FTP - How Do I Read The Available Space On A P <john@castleamber.com>
Re: Net::FTP - How Do I Read The Available Space On A P <john@castleamber.com>
Re: Net::FTP - How Do I Read The Available Space On A P <see.sig@rochester.rr.com>
Re: Perl script not enterpreting images after moving si <bmth581@aol.com>
Re: Perl script not enterpreting images after moving si <sbryce@scottbryce.com>
Re: Perl script not enterpreting images after moving si <sbryce@scottbryce.com>
Problems detecting multiple clients <bryan@worldspice.net>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 4 Sep 2006 14:04:23 -0700
From: "Skybuck" <skybuck2000@hotmail.com>
Subject: Re: (Off topic) Cyberwar question
Message-Id: <1157403863.568492.149380@h48g2000cwc.googlegroups.com>
Michele Dondi wrote:
> On 3 Sep 2006 03:51:49 -0700, "Skybuck" <skybuck2000@hotmail.com>
> wrote:
>
> >Update:
>
> Not that I (nor most of us) felt a need for it, but...
>
> >5. I will prepare all evidence and I will ask a Dutch
> >"Telecommunication watch dog" (called OPTA in short) to take a look at
> >my case.
>
> ...good luck! Certainly a better option than spamming newsgroups with
> OT requests, and one I recommend you for the future!
>
>
> Michele
Hello Michele Dondi,
Are you as hot looking as your name sounds ?
Oh wait a minute I just saw your e-mail address.
You also have Tiscali.
Ohhhhhhhh nooooooooooo.
Now I might have to block a potential hotchick in the future ;)
What I gotta do for some democracy and freedom.
The sacrifices... oh maaaaaaannnnnnnnnnnnn......
Maybe the force be with us all, all the time =D
Bye,
Skybuck.
------------------------------
Date: 4 Sep 2006 14:11:14 -0700
From: "Skybuck" <skybuck2000@hotmail.com>
Subject: Re: (Off topic) Cyberwar question
Message-Id: <1157404274.236351.34290@i42g2000cwa.googlegroups.com>
Skybuck wrote:
> Michele Dondi wrote:
> > On 3 Sep 2006 03:51:49 -0700, "Skybuck" <skybuck2000@hotmail.com>
> > wrote:
> >
> > >Update:
> >
> > Not that I (nor most of us) felt a need for it, but...
> >
> > >5. I will prepare all evidence and I will ask a Dutch
> > >"Telecommunication watch dog" (called OPTA in short) to take a look at
> > >my case.
> >
> > ...good luck! Certainly a better option than spamming newsgroups with
> > OT requests, and one I recommend you for the future!
> >
> >
> > Michele
>
> Hello Michele Dondi,
>
> Are you as hot looking as your name sounds ?
>
> Oh wait a minute I just saw your e-mail address.
>
> You also have Tiscali.
>
> Ohhhhhhhh nooooooooooo.
>
> Now I might have to block a potential hotchick in the future ;)
>
> What I gotta do for some democracy and freedom.
>
> The sacrifices... oh maaaaaaannnnnnnnnnnnn......
>
> Maybe the force be with us all, all the time =D
>
> Bye,
> Skybuck.
Ohhhhhh noooooooooooo......
I should have known better.
You probably a man with a girlish sounding name.
I fall with suck trickery sometimes. Stupid me ohhh noooo.
May god have mercy on my soul. I am no faggot.
Faggots go to hell ! =D
I am a good hetero sexual if you can call it that at least.
I deserve to go to heaven !
It's the naggers who should go to HELLLL =D
One last question though:
Why do you use a free news reader and still supply part of your e-mail
address... ?
That's weird... I have never seen that before I think...
Bye,
Skybuck.
P.S.:
I guess the nigger food hit my brain and I am not even a nigger, go
figure ! =D
------------------------------
Date: 4 Sep 2006 14:13:42 -0700
From: "Skybuck" <skybuck2000@hotmail.com>
Subject: Re: (Off topic) Cyberwar question
Message-Id: <1157404422.813362.47350@i42g2000cwa.googlegroups.com>
I am feeling kinda funny/abusive/freespeech tonight:
John,
Did you know your name sounds like a goat ? =D
LOL enough said ;)
Bye,
Skybuck.
P.S.:
Intentional top-posting... OHHHHH LOL
Notty me ! =D
John Bokma wrote:
> Tad McClellan <tadmc@augustmail.com> wrote:
>
> > Skybuck <skybuck2000@hotmail.com> wrote:
> >
> >
> >> Subject: (Off topic) Cyberwar question
> >
> >
> > Making off topic posts is rude.
>
> Skybuck is a 15 year old kid (?) that has been kicked away by at least one
> ISP for a good reason. A welcome addition to a kill file, but on the other
> hand, he has a short attention span, and might be gone tomorrow.
>
> --
> John Experienced Perl programmer: http://castleamber.com/
>
> Perl help, tutorials, and examples: http://johnbokma.com/perl/
------------------------------
Date: 4 Sep 2006 14:27:24 -0700
From: "Matt Garrish" <mgarrish@gmail.com>
Subject: Re: (Off topic) Cyberwar question
Message-Id: <1157405244.048263.134530@i42g2000cwa.googlegroups.com>
Skybuck wrote:
> Skybuck wrote:
> > Michele Dondi wrote:
> > > On 3 Sep 2006 03:51:49 -0700, "Skybuck" <skybuck2000@hotmail.com>
> > > wrote:
> > >
> > > >Update:
> > >
> > > Not that I (nor most of us) felt a need for it, but...
> > >
> > > >5. I will prepare all evidence and I will ask a Dutch
> > > >"Telecommunication watch dog" (called OPTA in short) to take a look at
> > > >my case.
> > >
> > > ...good luck! Certainly a better option than spamming newsgroups with
> > > OT requests, and one I recommend you for the future!
> > >
> >
> > Are you as hot looking as your name sounds ?
> >
> You probably a man with a girlish sounding name.
>
Please do us all a favour and go back to whatever sandbox you normally
soil yourself in.
Matt
------------------------------
Date: Mon, 04 Sep 2006 21:56:29 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: (Off topic) Cyberwar question
Message-Id: <hi1Lg.1860$xh4.938@trnddc04>
Skybuck wrote:
>> Are you as hot looking as your name sounds ?
>> Now I might have to block a potential hotchick in the future ;)
> You probably a man with a girlish sounding name.
> I fall with suck trickery sometimes. Stupid me ohhh noooo.
> May god have mercy on my soul. I am no faggot.
> Faggots go to hell ! =D
> I guess the nigger food hit my brain and I am not even a nigger, go
> figure ! =D
<quote>
PROUD TO PLONK
Life's too short to be trolled, spammed or get upset about lame
posters! Make the Net a better place by ignoring those who annoy you.
Don't be annoyed; keep your calm. Be proud to plonk.
</quote>
***PLONK***
Yours for a better Usenet
jue
------------------------------
Date: Mon, 04 Sep 2006 19:21:10 GMT
From: "Mumia W." <mumia.w.18.spam+nospam.usenet@earthlink.net>
Subject: Re: CPAN - 'cl' is not recognized as an internal or external command,
Message-Id: <G0%Kg.3017$v%4.513@newsread1.news.pas.earthlink.net>
On 09/04/2006 03:12 AM, MoshiachNow wrote:
> Mumia W. wrote:
>> You need a C compiler to install those modules.
>
> Thanks.
> No way to install it without a C compiler ?
> Possibly using ppm,as suggested above ?
>
I'm a Linux user :-) The compiler is installed by default here.
Use Sisyphus' advice since you're on Windows.
------------------------------
Date: Mon, 4 Sep 2006 14:26:30 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: Cygwin error regarding profile.global
Message-Id: <slrnefovf6.a80.tadmc@magna.augustmail.com>
Jürgen Exner <jurgenex@hotmail.com> wrote:
> beartiger@gmail.com wrote:
>> Fuck you.
>
> ***PLONK***
I did that almost a year ago.
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 4 Sep 2006 12:44:42 -0700
From: "Matt Garrish" <mgarrish@gmail.com>
Subject: Re: Cygwin error regarding profile.global
Message-Id: <1157399082.421369.162200@e3g2000cwe.googlegroups.com>
beartiger@gmail.com wrote:
> Matt Garrish wrote:
> > beartiger@gmail.com wrote:
> >
> > > anno4000@radom.zrz.tu-berlin.de wrote:
> > > > <beartiger@gmail.com> wrote in comp.lang.perl.misc:
> > > > > This post is simply to document the solution to a cygwin error so that
> > > > > those who have the same issue can find the solution when they do a
> > > > > Google Groups search. Please do not flame me for posting this here.
> > > >
> >
> > > Moron.
> > >
> >
> > You got the order of your respon<snip>
>
> Take a walk toward the closest shore and keep going until your hat
> floats.
>
Yes, your wit is as keen as your understanding of cygwin. That is what
you were trying to prove with thise post, correct?
Matt
------------------------------
Date: 4 Sep 2006 15:04:18 -0700
From: beartiger@gmail.com
Subject: Re: Cygwin error regarding profile.global
Message-Id: <1157407458.171799.185050@i3g2000cwc.googlegroups.com>
Matt Garrish wrote:
> beartiger@gmail.com wrote:
>
> > Matt Garrish wrote:
> > > beartiger@gmail.com wrote:
> > >
> > > > anno4000@radom.zrz.tu-berlin.de wrote:
> > > > > <beartiger@gmail.com> wrote in comp.lang.perl.misc:
> > > > > > This post is simply to document the solution to a cygwin error so that
> > > > > > those who have the same issue can find the solution when they do a
> > > > > > Google Groups search. Please do not flame me for posting this here.
> > > > >
> > >
> > > > Moron.
> > > >
> > >
> > > You got the order of your respon<snip>
> >
> > Take a walk toward the closest shore and keep going until your hat
> > floats.
> >
>
> Yes, your wit is as ke<snip>
Keep posting OT, you hypocritical moron.
J
------------------------------
Date: Mon, 04 Sep 2006 20:08:14 GMT
From: "John W. Krahn" <someone@example.com>
Subject: Re: imagemagick very slow - is there anything better?
Message-Id: <OI%Kg.12427$rd7.5929@edtnps89>
Paul Matthijsse wrote:
> Kees wrote:
> <cut>
>> I have used Image/Perl-Magick for various projects. Even doing complex
>> online transformations of large uploaded pictures I found it to be
>> quite fast.
>
> Quite fast? When I open a 2048x1536 jpg file (from 3 mp camera, file
> compressed to ~ 1 MB) and say
>
> $image->Sharpen(15);
>
> it takes 30 seconds to do that (on an Athlon64 3400+).
>
> $image->Sharpen(25); takes even 1m22s. Problem is that even this level
> of sharpening isn't enough for my photos,
Perhaps you need to clean your lens or buy a better quality lens?
John
--
use Perl;
program
fulfillment
------------------------------
Date: Mon, 04 Sep 2006 20:31:42 GMT
From: Bob Walton <see.sig@rochester.rr.com>
Subject: Re: Insert Log file into oracle table
Message-Id: <O20Lg.36262$uH6.845@twister.nyroc.rr.com>
mattjones@hotmail.co.uk wrote:
...
> Im having trouble loading a .log file into oracle. I can connect to the
> database and i can insert data (that i define in an INSERT statement).
> I eventually need to filter specific info from the .log files (there
> are alot of them - and this script provides an automated process) but
> for now i just want to read the whole script into a table!
>
> CURRENT SCRIPT:
...
> ##### I have also tried the following and putting $LOG into one of the
> values but I just get the value '1' returned!
> my $LOG = open (LOG, "/home/USRNAME/PERL/hello.log");
>
> my @data = <LOG>;
> close LOG;
...
From perldoc -f open:
"Open returns nonzero upon success, the undefined value otherwise. If
the open involved a pipe, the return value happens to be the pid of the
subprocess."
Note that the value returned by open() is not something you want to
store in your database. The "1" you are complaining about is the
nonzero value open() returns saying it was successful in the operation
of opening the file. Yes, you DO want to check it to be sure your file
opened successfully. Maybe something like:
die "Oops, couldn't open log file" unless $LOG;
The data from your file will be in array @data -- but you probably will
want to parse it in some fashion before storing it in your database.
--
Bob Walton
Email: http://bwalton.com/cgi-bin/emailbob.pl
------------------------------
Date: Mon, 04 Sep 2006 13:32:24 -0700
From: Joe Smith <joe@inwap.com>
Subject: Re: map tricks
Message-Id: <teOdnTUTx6EUEGHZnZ2dnUVZ_qydnZ2d@comcast.com>
kraven wrote:
> my %hash = map { chomp; $hash{$_} = $_ } ...
Bad move.
$hash{$_} = something;
builds the hash, and
%hash = (...);
destroys what has been built.
Have you verified that the hash that has been built has
all the keys and no extraneous ones? The intermediate
hash (the one that got destroyed) has extraneous values.
-Joe
------------------------------
Date: Mon, 04 Sep 2006 17:08:35 -0400
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: map tricks
Message-Id: <x7veo38hm4.fsf@mail.sysarch.com>
>>>>> "MD" == Michele Dondi <bik.mido@tiscalinet.it> writes:
MD> On Mon, 04 Sep 2006 06:10:34 GMT, kraven <kraven@noip.com> wrote:
>>> my %hash = read_file( $ARGV[0] ) =~ /^([^:]+):(.+)$/mg ;
MD> [snip]
>> basically the file contains /path/file:files_md5sum
>> the way I presented works very well. Does File::Slurp gunzip files?
>> While I can certainly use something like that on the development system, I
>> am trying to keep the number of modules that I have to install on a bunch
>> of production systems to a minimum.
MD> Uri has a certain tendency to the shameless self ad for File::Slurp,
MD> which is reasonable because it is indeed a useful module. However the
MD> logic he proposed would work just fine with more "standard" IO:
and i did say you can use classic perl slurping techniques. but
the easiest way to show a m/// assigned to a hash was with the module.
MD> my %hash = qx/whatever/ =~ /^([^:]+):(.+)$/mg;
MD> local $/;
MD> my %hash = <> =~ /^([^:]+):(.+)$/mg;
my %hash = do{ local( @ARGV, $/ ) = $filename ; <> } =~
/^([^:]+):(.+)$/mg;
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
------------------------------
Date: 4 Sep 2006 18:41:00 GMT
From: John Bokma <john@castleamber.com>
Subject: Re: Net::FTP - How Do I Read The Available Space On A Partition ???
Message-Id: <Xns98348B318D63Bcastleamber@130.133.1.4>
David Squire <David.Squire@no.spam.from.here.au> wrote:
> tommo_blade wrote:
>> Hello All,
>> I have read thru the perl docs for this module and I have
>> tried a few of the 'methods' available but as yet I have not been able
>> to get my script to pull the data I need from the server. basically I
>> want to know if there is enough 'available space' on a unix partition
>> prior to me FTP'ing a file to that host/partition, I have tried the
>> 'ls' and 'dir' methods but I cannot get what I need. The data I need at
>> unix level can be gained by running a 'df -k' command which when run
>> returns the available disk space in the 'avail' column.
>>
>> Does anyone know of any neat tricks to get this data.
>
> This works:
No it doesn't, it suffers from a race condition as probably all
"solutions".
--
John Experienced Perl programmer: http://castleamber.com/
Perl help, tutorials, and examples: http://johnbokma.com/perl/
------------------------------
Date: 4 Sep 2006 18:44:01 GMT
From: John Bokma <john@castleamber.com>
Subject: Re: Net::FTP - How Do I Read The Available Space On A Partition ???
Message-Id: <Xns98348BB41B03castleamber@130.133.1.4>
"tommo_blade" <mark1.thompson45@btinternet.com> wrote:
> To clarify, I need to get this data using the Net::FTP module and not
> by some preliminary perl script as has been mentioned in this thread.
> Does anyone know if there are any other add-on modules to the Net::FTP
> module that could get this data, i.e. Net::FTP::Common etc, etc.
There is no reliable way, even if it was supported by FTP unless the ftp
server would stop all processes that can generate data on your partition.
While you request how much free space there is, the information will
already be outdated by the time you start the upload. During the upload
another process can generate data. Imagine two programs doing the same:
free space = 1GB
program 1 asks free space and gets 1GB
program 2 asks free space and gets 1GB
program 1 starts to upload 700 MB
program 2 starts to upload 700 MB
???
profit
--
John Experienced Perl programmer: http://castleamber.com/
Perl help, tutorials, and examples: http://johnbokma.com/perl/
------------------------------
Date: Mon, 04 Sep 2006 20:59:09 GMT
From: Bob Walton <see.sig@rochester.rr.com>
Subject: Re: Net::FTP - How Do I Read The Available Space On A Partition ???
Message-Id: <xs0Lg.4739$xV.426@twister.nyroc.rr.com>
tommo_blade wrote:
...
> I have read thru the perl docs for this module and I have
> tried a few of the 'methods' available but as yet I have not been able
> to get my script to pull the data I need from the server. basically I
> want to know if there is enough 'available space' on a unix partition
> prior to me FTP'ing a file to that host/partition, I have tried the
> 'ls' and 'dir' methods but I cannot get what I need. The data I need at
> unix level can be gained by running a 'df -k' command which when run
> returns the available disk space in the 'avail' column.
>
> Does anyone know of any neat tricks to get this data.
Well, I don't know how "neat" it is, but you can use Net::FTP's quot()
method to execute a command on the remote system. I use it to chmod CGI
programs to executable on ISP systems that don't provide command line
access, for example (yeah, I know, I could get a better ISP). To get
the result of the command returned back to you, you will probably need
to redirect the STDOUT of the command to a file, then use the get()
method to get the file, then open and read it. I don't know if the
remote FTP server will run operating system commands with STDOUT
redirected -- you'll have to try it and see. You can check out how it
works with a command-line FTP client -- when you see you can do what you
want with a manual client, then implement it using Net::FTP.
You might be just as well off to do your put() and check the return for
an error.
HTH.
> cheers, Mark.
--
Bob Walton
Email: http://bwalton.com/cgi-bin/emailbob.pl
------------------------------
Date: Mon, 04 Sep 2006 21:35:18 +0100
From: C Drake <bmth581@aol.com>
Subject: Re: Perl script not enterpreting images after moving site to different host
Message-Id: <322pf214u74irqodhhke6akhlfna446ue0@4ax.com>
On Mon, 04 Sep 2006 12:30:33 -0600, Scott Bryce
<sbryce@scottbryce.com> wrote:
>C Drake wrote:
>> Hi, I have this shopping cart script which was woking fine on one
>> server (hosted at Spenix.com). When I moved the website to another
>> host's server (at Forgednetworks.com) the script works ok, except that
>> none of my images show up in the html pages it creates.
>
>Then this is probably not a Perl problem.
>
>> I have checked
>> that all the file and folder permissions are set the same as before
>> and I have not altered the script. And yes, I transferred the image
>> files in binary. The images are located in the same directory as the
>> script (a subdirectory of the cgi-bin).
>
>Move the images out of the cgi-bin directory. I suspect that the server
>is attempting to run them as scripts rather than serve them as images.
>But that is only a guess. Your problem is not a Perl problem. It is
>either a server configuration problem, or an HTML problem. The error
>logs will give you an idea what is happening. If moving the images does
>not solve the problem, post your question, along with any relevant error
>messages from the error logs, into a group that deals with CGI.
Hi Scott,
Many thanks for the input. I emailed the host's tekkie and he got the
images to show up by moving them to my root directory and changing the
script's image refs to (e.g.): <IMG SRC="/image.jpg">
I guess that makes it something to do with the server or its OS,
right?
Thanks again,
C Drake
------------------------------
Date: Mon, 04 Sep 2006 12:30:33 -0600
From: Scott Bryce <sbryce@scottbryce.com>
Subject: Re: Perl script not enterpreting images after moving site to different host
Message-Id: <epidnazIfItT7WHZnZ2dnUVZ_tudnZ2d@comcast.com>
C Drake wrote:
> Hi, I have this shopping cart script which was woking fine on one
> server (hosted at Spenix.com). When I moved the website to another
> host's server (at Forgednetworks.com) the script works ok, except that
> none of my images show up in the html pages it creates.
Then this is probably not a Perl problem.
> I have checked
> that all the file and folder permissions are set the same as before
> and I have not altered the script. And yes, I transferred the image
> files in binary. The images are located in the same directory as the
> script (a subdirectory of the cgi-bin).
Move the images out of the cgi-bin directory. I suspect that the server
is attempting to run them as scripts rather than serve them as images.
But that is only a guess. Your problem is not a Perl problem. It is
either a server configuration problem, or an HTML problem. The error
logs will give you an idea what is happening. If moving the images does
not solve the problem, post your question, along with any relevant error
messages from the error logs, into a group that deals with CGI.
------------------------------
Date: Mon, 04 Sep 2006 14:42:01 -0600
From: Scott Bryce <sbryce@scottbryce.com>
Subject: Re: Perl script not enterpreting images after moving site to different host
Message-Id: <rfadnfwj36YIEmHZnZ2dnUVZ_tCdnZ2d@comcast.com>
C Drake wrote:
> Many thanks for the input. I emailed the host's tekkie and he got the
> images to show up by moving them to my root directory and changing the
> script's image refs to (e.g.): <IMG SRC="/image.jpg">
>
> I guess that makes it something to do with the server or its OS,
> right?
At this point, we are off topic for this newsgroup, but, yes, it had to
do with the server configuration. The server is configured to treat
anything in the cgi-bin directory as an executable.
BTW, the Perl script is not interpreting your images as anything. It is
simply sending HTML to the browser. The browser is requesting the images
from the server, and the server is trying to execute the images.
If you want to discuss this farther, you should post to
comp.infosystems.www.authoring.cgi where this discussion would be on-topic.
------------------------------
Date: 4 Sep 2006 15:04:07 -0700
From: "samasama" <bryan@worldspice.net>
Subject: Problems detecting multiple clients
Message-Id: <1157407447.019512.206780@74g2000cwt.googlegroups.com>
Hi...
I'm trying to detect multiple clients connected to a SOCK_STREAM
server. I'm doing this via a hash. The actual detecting part is going
fine. The problem I'm running into however takes place when a second
client connects from the same ip address (multiple clients)... When a
second connection is made from the same host, it errors out and
disconnects that second connection as it should, but when the first
(original) connection disconnects and tries to re-connect it doesn't
work. This is because the first (original) connections key in the hash
does not get deleted. I've been banging my head into the desk for a few
weeks trying to figure out how to get that key deleted, and properly.
Any help, advice, pointers, brutal criticism is very much welcome and
appreciated.
#!/usr/bin/perl
use warnings;
use diagnostics;
use strict;
use IO::Socket;
use POSIX qw(:sys_wait_h);
our %ip_conns; # hash of connected clients
our $time_to_die = 0;
# Globals for the socket
our $SERVER;
our $CLIENT;
$SIG{CHLD} = \&handle_sigchld;
$SIG{INT} = $SIG{TERM} = \&handle_default;
our $banner =
"\%rwhois V-1.5:000082:00 rwhois.foo.bar (Rwhois Server version)";
our $foo; # Temp for messing with chk_multi_conn
my $pid = fork;
exit if $pid;
die "Couldn't fork: $!\n" unless defined($pid);
POSIX::setsid() || die "Can't start a new session: $!";
$SERVER = IO::Socket::INET->new(
Proto => 'tcp',
LocalAddr => '0.0.0.0',
LocalPort => '4321',
Listen => SOMAXCONN,
Reuse => 1
);
die "WSRwhois : Can't setup server : $!\n " unless $SERVER;
print "[ Server $0 accepting clients ]\n";
until ($time_to_die) {
while ( $CLIENT = $SERVER->accept() ) {
$foo = $CLIENT;
$ip_conns{$CLIENT} = $CLIENT->peerhost;
my $conn_ret = chk_multi_conn();
if ($conn_ret == 1 ) {
delete $ip_conns{$CLIENT};
shutdown($CLIENT, 2); }
my $kidpid = fork;
die "Fork: $!\n" unless defined($kidpid);
if ( $kidpid == 0 ) {
shutdown( $SERVER, 1 );
$CLIENT->autoflush;
print $CLIENT "$banner\015\012";
while ( sysread( $CLIENT, $_, 1024 ) ) {
next unless /\S/;
if (/-quit/) {
print $CLIENT "\%ok\015\012";
shutdown( $CLIENT, 2 );
}
}
delete $ip_conns{$CLIENT};
exit(0);
}
else { # Let the parent do some stuff
}
}
}
sub chk_multi_conn {
my %count = ();
my $times;
foreach my $keys ( keys %ip_conns ) {
my $value = $ip_conns{$keys};
print "#DEBUG Inside chk_multi_conn()\n"; # DEBUG
print "#DEBUG \%ip_conns = $keys => $value\n"; # DEBUG
print "#DEBUG\n"; # DEBUG
print "#DEBUG \$CLIENT = $CLIENT\n"; # DEBUG
$times = $count{$value}++;
}
if ( $times >= 1 ) {
print $CLIENT
"\%error Only 1 connection allowed per host.\n";
#shutdown( $CLIENT, 2 );
return (1);
}
else {
return (0); }
}
sub handle_sigchld {
delete $ip_conns{$foo}; # Just to be sure
#unless ( !$CLIENT ); # Clear the clients connection record
my $pid = wait; # Wait for children to die
$SIG{'CHLD'} = \&handle_sigchld;
}
sub handle_default {
$time_to_die = 1; # Kill daemon
}
--
samasama
------------------------------
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.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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 9682
***************************************
