Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl # this is the server use warnings; use strict; use Net::EasyTCP; $|=1; local $SIG{INT} = sub { close LOG;print "Exiting\n";exit 0;}; print "Hit control-c to stop server\n"; my $host = "localhost"; my $port = "2345"; my $portpassword = "ztest"; my $maxsize = 1000000; #1 meg my $savedir = 'files'; my %okusers = (joe => "loco", zentara => "majormojo", test => "test" ); if (! -d $savedir) { mkdir($savedir,0755) ; print "Save directory created: $savedir\n" ; } open(LOG,">>$savedir/port$port.log") or die "Couldn't open port $port +log: $!"; my $server = new Net::EasyTCP( host => "$host", mode => "server", port => "$port", password => "$portpassword", ) || die "ERROR CREATING SERVER: $@\n"; $server->setcallback( data => \&gotdata, connect => \&connected, disconnect => \&disconnected, ) || die "ERROR SETTING CALLBACKS: $@\n"; $server->start() || die "ERROR STARTING SERVER: $@\n"; #################################################### sub gotdata() { my $client = shift; my $serial = $client->serial(); my $data = $client->data(); my $reply1 = undef; my $reply; my $user = $data->{'user'}; my $pass = $data->{'pass'}; my $filename = $data->{'filename'}; my $filesize = $data->{'filesize'}; my $filedata = $data->{'filedata'}; if((defined $filedata) and (length $filedata >= $maxsize)){ print LOG "ERROR5: Large File trying to sneak in\n"; $reply1 = "ERROR5: $filename is greater than $maxsize byte +s\n"; LOG->flush; } if(! defined $filedata){$reply = &process_user($user,$pass)} else {$reply = $reply1 || &process_file($user,$filename,$filesize,$fil +edata)} print "Client $serial sent: $data echoing status-> $reply\n"; $client->send($reply) || die "ERROR SENDING TO CLIENT: $@\n"; if ($data eq "QUIT") { $client->close() || die "ERROR CLOSING CLIENT: $@\ +n"; } elsif ($data eq "DIE") { $server->stop() || die "ERROR STOPPING SERVER: $@\n +"; } } ########################################################### sub process_file{ my ($user,$filename,$filesize,$filedata) = @_; my $reply; if(-e "$savedir/$filename") { return $reply = "ERROR2: $filename already exists, please al +ter name\n"} if($filesize > $maxsize) { return $reply = "ERROR3: $filename is greater than $maxsize +bytes\n"} if($filedata eq -1){return $reply = "OK-FILE->SEND\n"} open(FILEIN,">$savedir/$filename") or return $reply = "ERROR4: Could not create $filename: $!"; print FILEIN $filedata; close FILEIN; my $size = -s "$savedir/$filename"; $reply = "SUCCESS-> $filename $size bytes uploaded "; my $time = localtime(); print LOG "$reply by $user at $time\n"; LOG->flush; return "$reply\n"; } ########################################################### sub process_user{ my ($user,$pass) = @_; my $reply; my $time = localtime(); if((! defined $okusers{$user}) or ($pass ne $okusers{$user})) { print LOG "BADPASSWORD $user $pass $time\n"; LOG- +>flush; return $reply = "ERROR1: user or password id bad\n"; } $reply = "OK-SEND->$user"; print LOG "$reply at $time\n"; LOG->flush; return "$reply\n"; } ##################################################### sub connected() { my $client = shift; my $serial = $client->serial(); print "Client $serial just connected\n"; my $msginit = "File->upload, max size = $maxsize bytes\n"; $client->send($msginit) || die "ERROR SENDING TO CLIENT: $@\n"; } ################################################### sub disconnected() { my $client = shift; my $serial = $client->serial(); print "Client $serial just disconnected\n"; LOG->flush; } ################################################## #END SERVER #################################################### #################################################### #################################################### #!/usr/bin/perl # ########this is the client######### use strict; use warnings; use Net::EasyTCP; my $host = "localhost"; my $port = "2345"; my $portpassword = "ztest"; my $client = new Net::EasyTCP( mode => "client", host => "$host", port => "$port", password => "$portpassword", # donotcompress => 1, # donotencrypt => 1, )|| die "ERROR CREATING CLIENT: $@\n"; my $encrypt = $client->encryption(); my $compress = $client->compression(); print "encryption method ->$encrypt\ncompression method ->$compress\n" +; my $reply = $client->receive() || die "ERROR RECEIVING: $@\n"; print "$reply\n"; my ($maxsize) = $reply =~ /.* = (\d+) bytes/; my %hash; #global my $filename; #global my $filesize; #global # this section checks user and password # it exits when an OK-SEND-> is received while(1){ &getname(); &sendhash(); print "$reply\n"; if($reply =~ /^OK-SEND->(.*)/){last} } ######user is OK now send files################## while (1){ while (1){ &getfile(); $hash{'filedata'} = -1; &sendhash(); print "$reply\n"; if($reply !~ /^OK-FILE->SEND(.*)/){last} &readfile(); &sendhash(); print "uploading.....please wait\n"; print "$reply\n"; if($reply =~ /^SUCCESS->(.*)/){$hash{'filename'}='';$hash{'files +ize'} = '';last} } print "Send another file? (y)/n\n"; my $input =<STDIN>; if($input !~ /^[qn]/i){next}else{last} } exit 0; ################################################################# sub getname{ print "What is your name?\n"; $hash{'user'} = <STDIN>; chop $hash{'user'}; print "What is your password?\n"; $hash{'pass'} = <STDIN>; chop $hash{'pass'}; } ################################################################# sub getfile{ my $file; my $ok =0; while (1){ print "What file do you want to send?\n"; $file = <STDIN>; chomp $file; if (! -s $file) { warn "ERROR! Can't find or blank file $file\n";next} if (-s $file > $maxsize){warn "ERROR! $file is bigger than $maxsize\n" +;next} if (-s $file){last} } $filesize = -s $file; ($filename) = ( $file =~ /([^\\\/]+)[\\\/]*$/gs ); $hash{'filename'} = $filename; $hash{'filesize'} = $filesize; } ################################################################# sub sendhash{ $client->send(\%hash) || die "ERROR SENDING: $@\n"; $reply = $client->receive() || die "ERROR RECEIVING: $@\n"; } ################################################################ sub readfile{ local $/=undef; open(FILEOUT,"<$hash{'filename'}") or die "Couldn't open file: $!"; $hash{'filedata'} = (<FILEOUT>); close FILEOUT; } ##################################################################

In reply to Sockets-File-Upload with Net::EasyTCP by zentara

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (6)
As of 2024-04-19 07:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found