Merged Socket->recv with perl on Linux - linux

Sorry for the bad English, it is not my mother tongue.
I am new to perl programming and I'm facing a tedious problem for some hours now.
I have coded a simple Client-Server using IO::Socket::INET. It works flawlessly on Windows, but is broken on Linux.
On Linux, the first recv get both of server's communication and therefor, the second one is waiting endlessly for a communication.
Running the command "perl -version" gives me this result on Windows:
This is perl 5, version 20, subversion 2 (v5.20.2) built for
MSWin32-x64-multi-t hread (with 1 registered patch, see perl -V for
more detail)
And on Linux :
This is perl 5, version 20, subversion 2 (v5.20.2) built for
x86_64-linux-gnu-thread-multi (with 42 registered patches, see perl -V
for more detail)
Here is and exemple of a server:
use IO::Socket;
my $socket= IO::Socket::INET->new( Proto => "tcp",
LocalPort => 2559,
Listen => SOMAXCONN,
Reuse => 1);
while(1)
{
print "Waiting for a client\n";
my $client = $socket->accept();
$client->send("Hello, please connect yourself");
$client->send("Username:");
$client->recv(my $username, 1024);
$client->send("Password:");
$client->recv(my $cipheredpassword, 1024);
$client->send("Thank you, Goodbye.");
$client->close();
print "Connection closed\n";
}
And here is an exemple of a client :
use IO::Socket;
use Digest::MD5 qw(md5_hex);
my $username = "";
my $password = "";
my $server = IO::Socket::INET->new( Proto => "tcp",
PeerAddr => "localhost",
PeerPort => 2559);
# Pick up both $firstServerMessage and
# $serverAskUsernameMessage on Linux
$server->recv(my $firstServerMessage, 1024);
print "$firstServerMessage\n";
# Hangs on Linux
$server->recv(my $serverAskUsernameMessage, 1024);
while($username eq "")
{
print "$serverAskUsernameMessage\n";
chomp($username = <STDIN>);
}
$server->send($username);
$server->recv(my $serverAskPasswordMessage, 1024);
while($password eq "")
{
print "$serverAskPasswordMessage\n";
chomp($password = <STDIN>);
}
my $hashedPassword = md5_hex($password);
$server->send($hashedPassword);
$server->recv(my $lastServerMessage, 1024);
print $lastServerMessage;
I know that the easy solution to this problem would be to avoid having multiple ->recv in a row, but I'm also curious to know why it is not working on Linux.
I have tried to use ->flush and ->autoflush(1), without success.
Your help and knowledge would be appreciated,
L.C.

This problem has nothing to do with the choice of operating system, or indeed the language. The problem relates to the fact of how you are using TCP.
A TCP stream is just that - a stream of bytes. It does not matter to TCP how you write those bytes - you could send in fifty 1-byte chunks, or one 50-byte, or anything inbetween. The TCP stream simply represents the bytes, without message boundaries. It's much the same as file IO - a file on disk doesn't remember the distinction between write calls, only the sum total of bytes that were transferred.
So in your server when you do
$client->send("Hello, please connect yourself");
$client->send("Username:");
It could all get merged in one segment over the wire, and will arrive in one go at the other end. This is why any TCP-based protocol provides some form of framing - be it linefeeds, or message headers that declare the size of the body, or whatever. Some way that the receiver can pull the stream apart again.
For example, you might decide to use "\n" as a message boundary. You can then send using
$client->send("Hello, please connect yourself\n");
$client->send("Username:\n");
and the receiver can use the regular readline to read these lines back out again.

Related

Implementing reliability in UDP (python)

I have written the code for transferring an audio file from client to server using udp (python).
Now I am required to introduce reliability in the codes of UDP. The instructions are given as:
"You will be required to implement following to make UDP reliable:
(a) Sequence and acknowledge numbers
(b) Re-transmission (selective repeat)
(c) Window size of 5-10 UDP segments (stop n wait)
(d) Re ordering on receiver side "
THE SENDER THAT IS CLIENT CODE IS GIVEN BELOW
from socket import *
import time
# Assigning server IP and server port
serverName = "127.0.0.1"
serverPort = 5000
# Setting buffer length
buffer_length = 500
# Assigning the audio file a name
my_audio_file = r"C:\Users\mali.bee17seecs\PycharmProjects\TestProject\Aye_Rah-e-Haq_Ke_Shaheedo.mp3"
clientSocket = socket(AF_INET, SOCK_DGRAM)
# Opening the audio file
f = open(my_audio_file, "rb")
# Reading the buffer length in data
data = f.read(buffer_length)
# While loop for the transfer of file
while data:
if clientSocket.sendto(data, (serverName, serverPort)):
data = f.read(buffer_length)
time.sleep(0.02) # waiting for 0.02 seconds
clientSocket.close()
f.close()
print("File has been Transferred")
THE RECEIVER THAT IS SERVER CODE IS GIVEN BELOW
from socket import *
import select
# Assigning server IP and server port
serverName = "127.0.0.1"
serverPort = 5000
# Setting timeout
timeout = 3
serverSocket = socket(AF_INET, SOCK_DGRAM)
serverSocket.bind((serverName, serverPort))
# While loop for the receiving of file
while True:
data, serverAddress = serverSocket.recvfrom(1024)
if data:
file = open(r"C:\Users\mali.bee17seecs\PycharmProjects\TestProject\Aye_Rah-e-Haq_Ke_Shaheedo.mp3",
"wb")
while True:
ready = select.select([serverSocket], [], [], timeout)
if ready[0]:
data, serverAddress = serverSocket.recvfrom(500)
file.write(data)
else:
file.close()
print("File has been Received")
break
Before answer each request, you should know that we build a reliable UDP by adding some specific infomation before the real content, which you can think as a application layer head. We use them to do some control or collect infomation like TCP does in traffic layer by the head part. It may look like below:
struct Head {
int seq;
int size;
}
(a) Sequence and acknowledge numbers
If you're familar with TCP, it is not hard. You can set seq and when the other side receive it, the controller will judge it and to check if we need to do b/d.
(b) Re-transmission (selective repeat) & (d) Reordering on receiver side
They are familiar to realise, using GBN/ARQ/SACK algorithm to do retransmission, using some simple algorithm like sorting to do reording.
(c) Window size of 5-10 UDP segments (stop n wait)
This part need to do some thing like traffic control that TCP does. I don't how complex you want to do, it's can be really complex or simple, it depends on you.

SOAP::Lite - clients using version 1.1 and 1.2 threaded in mod_perl

I have several SOAP::Lite clients running under mod_perl in Apache hhtpd.
Some of them use 1.1 soap-servers and some of them use 1.2 servers. So I have code like:
# In client 1:
my $soap1 = SOAP::Lite->soapversion("1.1");
$result1 = $soap1->method1();
# In client 2:
my $soap2 = SOAP::Lite->soapversion("1.2");
$result2 = $soap2->method2();
This works in stand-alone clients, but when I run the code under mod_perl, I seem to get stung by that the soapversion
method has side-effects:
# From SOAP::Lite.pm
sub soapversion {
my $self = shift;
my $version = shift or return $SOAP::Constants::SOAP_VERSION;
($version) = grep {
$SOAP::Constants::SOAP_VERSIONS{$_}->{NS_ENV} eq $version
} keys %SOAP::Constants::SOAP_VERSIONS
unless exists $SOAP::Constants::SOAP_VERSIONS{$version};
die qq!$SOAP::Constants::WRONG_VERSION Supported versions:\n#{[
join "\n", map {" $_ ($SOAP::Constants::SOAP_VERSIONS{$_}->{NS_ENV})"} keys %SOAP::Constants::SOAP_VERSIONS
]}\n!
unless defined($version) && defined(my $def = $SOAP::Constants::SOAP_VERSIONS{$version});
foreach (keys %$def) {
eval "\$SOAP::Constants::$_ = '$SOAP::Constants::SOAP_VERSIONS{$version}->{$_}'";
}
$SOAP::Constants::SOAP_VERSION = $version;
return $self;
}
This is what I believe happens:
Basically, the soapversion call rededefines essential constants in $SOAP::Constants. And since this is mod_perl, the $SOAP::Constants are global and shared between every server-thread (I believe. Please correct me if I'm wrong). This leads to a race-condition: Most of the times, the codelines gets executed more-or-less in the sequence seen above. But once in at while (actually about 2% of the calls) the execution sequence is:
Thread1: my $soap1 = SOAP::Lite->soapversion("1.1");
Thread2: my $soap2 = SOAP::Lite->soapversion("1.2");
Thread1: $result1 = $soap1->method1();
Thread2: $result2 = $soap2->method2();
And so, the $soap1->method1() gets called with $SOAP::Constants set as befitting version 1.2 - causing several namespace to be wrong, notably:
xmlns:soapenc="http://www.w3.org/2003/05/soap-encoding"
Which is wrong for 1.1 - who prefers:
xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
If I could somehow make $SOAP::Constants localized to a serverthread or something like that, I guess things would be fine. But any solution will be appreciated.
Run Apache with the prefork model instead of the threading model (mpm_prefork_module instead of mpm_event_module or mpm_worker_module), so that each Apache child will have its own Perl interpreter, hence its own set of constants.
Otherwise have a look on the modperl documentation regarding the PerlOptions directive, specifically the clone and/or parent value. But stop using threads seem simpler to me, threads and Perl were never friends.

Perl Device::SerialPort

Looking for right way to detect one keyword during board boot up message.
After keyword detected, send Enter key after one second.
Kernel is Linux.
# Serial port inisialisation is finished here.
# Read boot message
($count, $result) = $ob->read(300); # at least 300 chars coming till keyword appear
if ($result =~ m/Booting_up/) {
print "send Enter ...\n";
sleep 1;
$ob->write("\r\n");
}
Thanks for hint
It appears that you are using Win32::SerialPort module, or perhaps Device::SerialPort which
provides an object-based user interface essentially identical to the one provided by the Win32::SerialPort module.
Its method read takes the number of bytes to read and returns the number read and writes them into the given string.
You may be "missing" the phrase because it's past the 300-mark, and your code doesn't read any further. Try to loop, getting a few bytes at a time and adding them up, thus building the string in small reads.
my bytes_in = 10; # length of pattern, but it does NOT ensure anything
my ($read, $result);
while (1)
{
my ($count, $read) = $ob->read( $bytes_in );
$result = $result . $read;
if ($result =~ m/Booting_up/) { # is it "Booting_up" or "Booting up" ?
print "send Enter ...\n";
sleep 1; # is this needed?
$ob->write("\r\n");
# last; # in case this is all you need to do
}
last if $count != $bytes_in; # done reading
}
I don't put the $ob->read statement in the loop condition since the documentation isn't crystal clear on how the method works. You may also be able to simply use
while ( my ($count, $read) = $ob->read( $bytes_in ) ) {
$result = $result . $read;
if ($result =~ m/Booting_up/s) {
# ...
}
last if $count != $bytes_in;
}
We read a small number of bytes at a time to prevent problems with either polling or blocking reads, brought up in comments by BenPen. See Configuration and capability methods.
You can first read those first 300 bytes that precede the pattern in one go and then start reading a few (or one) at a time, which would also lead to the quickest identification of the phrase.
This can be tweaked further but let's first see what it does as it stands (I cannot test).
Documentation also offers a few other methods which may be useful, in particular readline and streamline. As this is all rather low level there are yet other ways but if you got all else working perhaps this will be enough to complete it.
Perhaps rather index the string?
($count, $result) = $ob->read(300); # at least 300 chars coming till keyword appear
$substring = 'Booting_up';
if (index($result, $substring) != -1) {
print "send Enter ..\n";
sleep 1;
$ob->write("\r\n");
}

basic chat system on perl under linux

Im trying to write some basic chat system just to learn perl. Im trying to get the chatlog into a 1 file and print new message if it's appears in the chatlog.dat file, So i've wrote a function that does almost the same thing, but I have got some problems and don't know how to solve them.
So now I have 2 problems!
I could not understand how to keep checkFile function always active (like multiprocession) to continuously check for new messages
This problem occurs when I'm trying to write a new message that will be appended into the chatlog. The Interpreter waits for my input on the line my $newMessage = <STDIN>;, but, what if someone writes a new message? it will not be shown until he press enter... how to void that?
my ($sec,$min,$hour) = localtime();
while(1){
my $userMessage = <STDIN>;
last if $userMessage eq "::quit";
`echo "($hour:$min:$sec): $userMessage" >>chatlog.dat`;
}
sub checkFile{
my $lastMessage = "";
my $newMessage = "";
while (1) {
my $context = `cat chatlog.dat`;
split(/\n/, $context);
$newMessage = $_[$#_];
if ($newMessage ne $lastMessage) {
print $newMessage;
$lastMessage = $newMessage;
}
}
}
First:
don't use echo within a perl script. It's nasty to shell escape when you've got perfectly good IO routines.
using cat to read files is about as nasty as using 'echo'.
reading <STDIN> like that will be a blocking call - which means your script will pause.
but that's not as bad as it sounds, because otherwise you're running a 'busy wait' loop which'll repeatedy cat the file. This is a very bad idea.
You're assuming writing a file like that is an atomic operation, when it's not. You'll hit problems with doing that too.
What I would suggest you do it look at IO::Handle and also consider using flock to ensure you've got the file locked for IO. You may also wish to consider File::Tail instead.
I would actually suggest though, you want to consider a different mode of IPC - as 'file swapping' is quite inefficient. If you really want to use the filesystem for your IO, you might want to consider using a FIFO pipe - have each 'client' open it's own, and have a server reading and coalescing them.
Either way though - you'll either need to use IO::Select or perhaps multithreading, just to swap back and forth between reading and writing. http://perldoc.perl.org/IO/Select.html
Answering my own question
sub checkFile{
my $lastMessage = "";
my $newMessage = "";
my $userName = $_[0];
while (1) {
my $context = `cat chatlog.dat`;
split(/\n/, $context);
$newMessage = $_[$#_];
if ($newMessage ne $lastMessage) {
$newMessage =~ /^\(.+\):\((.+)\) (.+$)/;
if ($1 ne $userName) { print "[$1]: $2";}
$lastMessage = $newMessage;
}
}
}
my $userName = "Rocker";
my ($sec,$min,$hour) = localtime();
my $thr = threads -> create ( \&checkFile, $userName ); #Starting a thread to continuously check for the file update
while (1) {
my $userMessage = <STDIN>; #STDIN will not interfere file checking
last if $userMessage eq "::quit";
`echo "($hour:$min:$sec):($userName) $userMessage" >>chatlog.dat` if $userMessage =~ /\S+/;
}
$thr -> join();

Open a cash drawer connected to a usb printer

I have a cash drawer connected to an Epson TM-T20 connected on a USB port.
I have found an example here and applied their ideas to with the codes from here to the printer:
echo -en "\033\160\040\025" | lp -d "USB_TM-T20" -o raw
But this doesn't seem to work. Since epson provides a java library, I decided to have a look at it and decompiled it.
protected byte[] getOpenDrawerCommand()
{
byte[] arrayOfByte = new byte[5];
if (this.m_objDrawerPort.isSupportRealTimeCommand())
{
arrayOfByte[0] = 16;
arrayOfByte[1] = 20;
arrayOfByte[2] = 1;
arrayOfByte[3] = (byte)this.m_objDrawerSettings.getPinNumber(); // seems to be 0
arrayOfByte[4] = (byte)this.m_objDrawerSettings.getOnTime(true); // between 1 and 8
}
else
{
arrayOfByte[0] = 27;
arrayOfByte[1] = 112;
arrayOfByte[2] = (byte)this.m_objDrawerSettings.getPinNumber(); // seems to be 0
arrayOfByte[3] = (byte)this.m_objDrawerSettings.getOnTime(false); // [1, 255]
arrayOfByte[4] = (byte)this.m_objDrawerSettings.getOffTime(false); // [1, 255]
}
return arrayOfByte;
}
We see that the values from the keyfile seem to be correct (at least the first two). Unfortunately I was unable to find the code where it sends the data.
Do you have an idea where I can find more information? The epson website seems to be kind of sparse.
Edit:
It turns out that the connection cable was damaged and the new cable needed to be repinned in order to connect to the printer.
According to the man page, bash's echo command, as well as standalone echo, requires octal character constants to start with a leading zero. This differs slightly from C.
So, try
echo -en '\033\0160\040\025'
or just use hexadecimal.
It also looks like you're sending 4 bytes, while the Java snippet indicates that 5 are necessary.
I also have an Epson TM-T20 and found this answer and links to mostly solve my problem, but I checked the manual and found that the code to open the drawer was ESC p m t1 t2
This translated to:
echo -en '\033p011' | lp -d EPSON_TM_T20 -o raw
I used lpstat -p to find the correct printer name to use.

Resources