Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

joeface's scratchpad

by joeface (Pilgrim)
on Sep 01, 2007 at 14:41 UTC ( #636518=scratchpad: print w/replies, xml ) Need Help??

First journey into two new worlds of Perl. Client/Server using IO::Socket, and Perl Tk because I got bored of using the CLI client on Windows...

The server runs on a linux box, and the client runs on an adjacent windows box

The client accepts a URL, and sends it off to the server, which receives it (along with a built-in "fetch" command), and uses wget to fetch whatever's at that location.

Silly use, yes, but it had to do more than Hello World. God only knows what kinds of ideas this is going to give me. Opened up and began illuminating a few dark, scary rooms that I was previously locked out of.

Evolved out of just sending back the string it was originally given, then sending back a reversed string. That code is still in there, but the Tk client only sends the "fetch" command.


#!/usr/bin/perl -w use strict; use IO::Socket; use Getopt::Long; use File::Basename; my $scriptname = basename($0); my $scriptdir = dirname($0); ## Standard options my $silent; my $verbose; GetOptions( "s" => \$silent, "v" => \$verbose, ); my $localhost = ''; my $port = 55555; my $save_loc = '/var/tmp/client-server-gets'; my $server = new IO::Socket::INET ( LocalHost => $localhost, LocalPort => $port, Proto => 'tcp', Listen => 1, Reuse => 1, ); $server or die "Can't create server: $!\n"; printinfo("$scriptname listening on port $port"); while(my $HANDLER = $server->accept()) { $HANDLER or die "server->accept: $!\n"; my $peeraddr = $HANDLER->peeraddr; my $peerhost = $HANDLER->peerhost; my $hostinfo = gethostbyaddr($peeraddr, AF_INET); printinfo("Accepted connection from $peerhost"); my $in = <$HANDLER>; chomp($in); if ($in) { printinfo("Client said \"$in\""); my ($cmd,) = split(/\s+/, $in); $in =~ s/.*?\s+//; if ($cmd eq 'repeat') { print $HANDLER localtime() . ": you said \"$in\"\n"; printinfo("Sent \"$in\" to client"); } elsif ($cmd eq 'reverse') { $in = reverse($in); print $HANDLER localtime() . ": you said \"$in\"\n"; printinfo("Sent \"$in\" to client"); } elsif ($cmd eq 'fetch') { my $file = basename($in); if ($verbose) { system("wget -N -P $save_loc $in"); } else { system("wget -N -P $save_loc -q $in"); } my $rc = $? >> 8; if ($rc == 0) { printinfo("Fetch of item \"$in\" successful"); print $HANDLER "Requested item saved as $save_loc/$fil +e\n"; } else { printinfo("Fetch of item \"$in\" failed"); print $HANDLER "Sorry, your request failed\n"; } } else { print $HANDLER "Sorry, there was no known command atta +ched to your msg\n"; } } } sub printinfo { unless($silent) { print localtime() . ": @_\n"; } } __END__


#!/usr/bin/perl -w use Tk; use strict; use IO::Socket; use File::Basename; my $server = ''; my $port = 55555; my $mw = MainWindow->new; $mw->Label( -text => "\nURL to desired file" )->pack; my $url = $mw->Entry( -width => 100 )->pack; $mw->Label(-text => " ")->pack; ######################## SPACER my $button = $mw->Button( -text => 'Fetch', -command => sub{do_fetch($url)}, -padx => 10, )->pack; #$button->bind('<Enter>', sub{do_fetch($url)}); $mw->Label(-text => " ")->pack; ######################## SPACER my $ent_msg; my $ent = $mw->Entry(-width => 100, -state => "readonly", -textvariable => \$ent_msg)->pack(); MainLoop; sub print_status { my $msg_txt = join(" ", @_); $ent_msg = $msg_txt; $ent->update(); } ################## CLIENT PORTION sub do_fetch { print_status("Submitted request to $server"); my $url = shift; my $url_val = $url->get; my $scriptname = basename($0); my $command = 'fetch'; my $msg = $url_val; unless($msg) { print "Usage: $scriptname <msg>\n"; exit; } chomp($msg); my $client = new IO::Socket::INET ( PeerAddr => $server, PeerPort => $port, Proto => "tcp", ) or die "Can't connect to $server:$port : $!\n"; print $client $command . " " . $msg . "\n"; my $response = <$client>; if ($response) { chomp($response); print_status("$response"); } } __END__

Log In?

What's my password?
Create A New User
[marto]: good morning all
[Corion]: Hi marto ;)
[Corion]: I hope you're well ;)
[marto]: running late today, get to work and people are just sitting around. "can't delete file, quota exceeded"
[Corion]: marto: Oy :-/
[Corion]: Ah, it's only "quota exceeded", not "filesystem full", so it's "merely" an administrative act to up the FS quota resp. inode quota
[Corion]: I've been on databases where I couldn't drop a table or delete rows because the DB was full. Not so much fun...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (7)
As of 2017-01-24 09:53 GMT
Find Nodes?
    Voting Booth?
    Do you watch meteor showers?

    Results (203 votes). Check out past polls.