use NET::SMTP SSL/TLS with SOCKS - perl

I have some realization of bind, connect to SOCKS and connect to SMTP server through SOCKS. How i can use this connect with SSL/TLS NET::SMTP? This question not help me, because SSL handshake can't start.
DEBUG: .../IO/Socket/SSL.pm:683: waiting for fd to become ready: SSL wants a read first
DEBUG: .../IO/Socket/SSL.pm:693: handshake failed because socket did not became ready
Here realization of connect to remote server via proxy:
sub connect {
my ($ip, $port, $is_ssl, $pid, $server) = #_;
if (defined $socket) {
my ($packed_cmd, $buffer, #data, %response);
$packed_cmd = pack("C4Nn", 0x05, 0x01, 0x00, 0x01, $ip, $port);
$socket->send($packed_cmd);
if (defined $socket->recv($buffer, 1024)) {
#data = unpack("C4 L S", $buffer);
$response{'version'} = $data[0];
$response{'result'} = $data[1];
$response{'reg'} = $data[2];
$response{'type'} = $data[3];
$response{'ip'} = $data[4];
$response{'port'} = $data[5];
$socket->blocking(0);
if ($is_ssl) {
&debug(3, $pid, "Try start SSL handshake with [$server]\n");
IO::Socket::SSL->start_SSL($socket, SSL_version => 'SSLv23', SSL_ca_file => SSL_CA_FILE) or &debug(3, $pid, "Cannot start SSL handshake! $#\n") and return 0;
&debug(3, $pid, "SSL handshake done!\n");
}
# TODO: Make TLS support
return 1;
}
}
&debug(3, $pid, "Cannot connect to [$server:$port] through socks server [$socks_name:$socks_server]\n");
return 0;
}
Bind SOCKS
sub bind_socks {
my ($pid) = #_;
my ($method, $packed_cmd, $buffer, #data, %response);
$socket = IO::Socket::INET->new(
PeerAddr => $socks_server,
PeerPort => $socks_port,
Proto => 'tcp',
Timeout => SOCKS5_CONNECT_TIMEOUT
) or &debug(3, $pid, "Cannot connect to the socks server [$socks_server] $#\n") and return 0;
&debug(3, $pid, "Connected to the socks server [$socks_name:$socks_server]\n");
$socket->blocking(1);
if ($socks_username && $socks_password) {
$method = 0x02;
} else {
$method = 0x00;
}
$packed_cmd = pack("C3", 0x05, 0x01, $method);
$socket->send($packed_cmd);
if (defined $socket->recv($buffer, 1024)) {
#data = unpack("C2", $buffer);
$response{'version'} = $data[0];
$response{'method'} = $data[1];
if ((defined $response{'version'}) && (defined $response{'method'}) && ($response{'version'} eq 5) && ($response{'method'} eq $method)) {
if ($method == 2) {
$packed_cmd = pack("CC", 0x01, length($socks_username)) . $socks_username . pack("C", length($socks_password)) . $socks_password;
$socket->send($packed_cmd);
if (defined $socket->recv($buffer, 1024)) {
#data = unpack("C2", $buffer);
$response{'version'} = $data[0];
$response{'status'} = $data[1];
return 1;
}
} else {
return 1;
}
} else {
&debug(3, $pid, "Cannot authenticate on socks server [$socks_name:$socks_server]\n");
return 0;
}
}
&debug(3, $pid, "Cannot authenticate on socks server [$socks_name:$socks_server]\n");
return 0;
}

If you are okay with IMAP instead of SMTP this might help, but prob not what you're looking for:
sub login() {
## Connect to the IMAP server via SSL
my $socket = IO::Socket::SSL->new(PeerAddr => 'imap.gmail.com',PeerPort => 993);
if(!$socket) {
# handle
}
## Build up a client attached to the SSL socket.
## Login is automatic as usual when we provide User and Password
my $imap = Mail::IMAPClient->new(Socket => $socket,
User => $username,
Password => $password,);
if(!$imap) {
# handle
}
if(!$imap->IsAuthenticated() && ...) {
# handle
}
## good to go
my #folders = $imap->folders();
...
}

Here is my beta code to use SMTP via socks proxy. SSL is working correctly with all servers tested by me. With TLS still have sometimes problems, probably something not according to the RFC.

Related

Keep open socket connection Perl

I created a Perl script that open a new socket on my server.
When I connect with telnet to the socket and I write (and receive) something, the connection closes.
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;
use IO::Socket::INET;
$| = 1;
my $sock = IO::Socket::INET->new(Listen => 5,
LocalAddr => 'localhost',
LocalPort => 9000,
Reuse => 1,
Proto => 'tcp');
die "Socket not created $!\n" unless $sock;
print "Server waiting for connections\n";
while(1)
{
# waiting for a new client connection
my $client_socket = $sock->accept();
# get information about a newly connected client
my $client_address = $client_socket->peerhost();
my $client_port = $client_socket->peerport();
print "Connection from $client_address:$client_port\n";
# read up to 1024 characters from the connected client
my $data = "";
$client_socket->recv($data, 1024);
chomp($data);
print "Data: $data\n";
# write response data to the connected client
my $dataok = "OK";
$client_socket->send("$dataok\n");
$client_socket->send("$data\n");
if($data == 500){
close($sock);
exit();
}
elsif($data eq "Close\r") {
close($sock);
exit();
}
}
My telnet session:
telnet localhost 9000
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
e //(Sent)
e //(Received)
Connection closed by foreign host.
Why does my script close the connection?
Thanks in advance
I added a loop in my code and it worked!
Thanks to #simbabque and #SteffenUllrich.
# waiting for a new client connection
my $client_socket = $sock->accept();
# get information about a newly connected client
my $client_address = $client_socket->peerhost();
my $client_port = $client_socket->peerport();
print "Connection from $client_address:$client_port\n";
# read up to 1024 characters from the connected client
while(1){
my $data = "";
$client_socket->recv($data, 1024);
chomp($data);
print "Data: $data\n";
# write response data to the connected client
my $dataok = "OK";
$client_socket->send("$dataok\n");
$client_socket->send("$data\n");
if($data == 500){
close($sock);
exit();
}
elsif($data eq "Close\r") {
close($sock);
exit();
}
}

How to set in PERL recv timeout in my code?

I want to set timeout in my recv function in this specific code below, because sometimes my script stuck forever. I am new in socket programming so i would really appreciate any help. Thanks in advance.
use IO::Socket::INET;
use IO::Select;
use LWP::UserAgent;
use JSON::XS 'decode_json';
use Data::Dumper;
use DBI();
sub dbconn {
my $db_conf = shift;
my $dbh = DBI->connect("DBI:Pg:dbname=somedatabase;host=somehost", "postgres", "",
{pg_server_prepare =>
0,AutoCommit => 1,RaiseError=>1});
$dbh->do("SET CLIENT_ENCODING TO 'UTF-8';");
return $dbh;
}
# auto-flush on socket
$| = 1;
# creating a listening socket
my $socket = new IO::Socket::INET (
LocalHost => '0.0.0.0',
LocalPort => '5000',
Proto => 'tcp',
Listen => 5,
Reuse => 1
);
die "cannot create socket $!\n" unless $socket;
$sel = IO::Select->new( $socket );
print "Server waiting for client connection on port 5000...\n";
my $command = 1;
my $watchTracker = "*HQ,";
my $tl206 = ",LAT:";
my $watchConnectedCheck = ",A,";
my $gpsType;
my $circleString = ",LINK,";
my $dataToSend;
my $new;
my $dbh = dbconn();
while(#ready = $sel->can_read) {
foreach $fh (#ready) {
if($fh == $socket) {
# Create a new socket
$new = $socket->accept;
$new->recv($dataReceived, 1024);
$new->recv($dataReceived, 1024);
# get information about a newly connected client
my $client_address = $new->peerhost();
my $client_port = $new->peerport();
print "===============================================\n";
print "===============================================\n\n";
print "Connection from $client_address:$client_port\n";
print "General data received: $dataReceived\n\n";
#MORE LINES...
}
else {
# Process socket
# Maybe we have finished with the socket
$sel->remove($fh);
$fh->close;
}
}
}
$dbh->disconnect();
Perhaps I am misunderstanding the question, but have you tried setting a timeout in the socket with "Timeout"?
See IO::Socket::INET.
EDIT: I did not catch the 'recv' bit. You have to use setsockopt, which is not wholly portable, so the final answer is somewhat dependent on your platform. Here are some posts that may help:
How do I set `SO_RCVTIMEO` on a socket in Perl?
http://www.perlmonks.org/?node_id=761935
E.g.,
$socket->setsockopt(SOL_SOCKET, SO_RCVTIMEO, pack('l!l!', 30, 0))
or die "setsockopt: $!";

Perl: Printing through socket

I'm trying to script battleship with perl, which can be played over the network.
The problem is that i'm just able to print on the same console, but not on other consoles through the socket.
Client:
$socket = new IO::Socket::INET(
PeerHost => '127.0.0.1',
PeerPort => '5005',
Protocol => 'tcp'
) or die "Socket konnte nicht erstellt werden!\n$!\n";
print "Client kommuniziert auf Port 5005\n";
while ( $eing ne ".\n" ) {
$eing = <> ;
print $socket "$eing";
}
Server:
$socket = new IO::Socket::INET(
LocalHost => '127.0.0.1',
LocalPort => '5005',
Protocol => 'tcp',
Listen => 5,
Reuse => 1
) or die "Socket konnte nicht erstellt werden!\n$!\n";
while ( 1 ) {
$client_socket = $socket -> accept();
$peeraddress = $client_socket -> peerhost();
$peerport = $client_socket -> peerport();
$eing = "";
while ( $eing ne ".\n" ) {
print "while";
&ausgabe;
}
}
sub ausgabe {
foreach $crt_board (#board2) {
foreach $spalte (#$crt_board) {
print $client_socket "$spalte ";
}
print $client_socket "\n";
}
}
The result should be an board which looks like this.
1 2 3 4 5
1 ? ? ? ? ?
2 ? ? ? ? ?
3 ? ? ? ? ?
4 ? ? ? ? ?
5 ? ? ? ? ?
You need to read from a socket if you want transfer data from server to client, or vice versa. Do always use strict (and warnings). The following will get you started:
Client:
use strict;
use IO::Socket::INET;
my $socket = new IO::Socket::INET(
PeerHost => '127.0.0.1',
PeerPort => '5005',
Protocol => 'tcp'
) or die "Socket konnte nicht erstellt werden!\n$!\n";
print "Client kommuniziert auf Port 5005\n";
while ( 1 ) {
my $data;
$socket->recv($data, 64);
print $data;
last if $data =~ m#\.\n#;
}
Server:
use strict;
use IO::Socket::INET;
my $socket = new IO::Socket::INET(
LocalHost => '127.0.0.1',
LocalPort => '5005',
Protocol => 'tcp',
Listen => 5,
Reuse => 1
) or die "Socket konnte nicht erstellt werden!\n$!\n";
while ( my $client_socket = $socket -> accept() ) {
my $peeraddress = $client_socket -> peerhost();
my $peerport = $client_socket -> peerport();
ausgabe($client_socket);
}
sub ausgabe {
my $client_socket = shift;
my #board2 = ([" ", 1,2,3],[1,"?","?","?"],
[2,"?","?","?"], [3,"?","?","?"]);
foreach my $crt_board (#board2) {
foreach my $spalte (#$crt_board) {
$client_socket->send("$spalte ");
}
$client_socket->send("\n");
}
$client_socket->send(".\n");
}

How to suspend https warning message in perl

I use https connection without any certificate using LWP.
How to suspend this annoying warning message so I can get only the number at the last line:
*******************************************************************
Using the default of SSL_verify_mode of SSL_VERIFY_NONE for client
is deprecated! Please set SSL_verify_mode to SSL_VERIFY_PEER
together with SSL_ca_file|SSL_ca_path for verification.
If you really don't want to verify the certificate and keep the
connection open to Man-In-The-Middle attacks please set
SSL_verify_mode explicitly to SSL_VERIFY_NONE in your application.
*******************************************************************
at C:/perl/lib/LWP/Protocol/http.pm line 31.
0
?
That message appears then I use https connection winthout certificate!
Here is the source code:
#!/usr/bin/perl
use LWP::UserAgent;
use JSON;
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
# my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 });
my $ua = LWP::UserAgent->new();
$ua->timeout(15);
my $response = $ua->get("https://useful_link");
if ($response->is_success) {
my $json_text = decode_json $response->content;
my $max_val = -1;
for(my $i = 0; $json_text->{'monitors'}[$i]; $i++) {
# Поиск по значениям хэша с ключом 'monitors'
for(my $j = 0; ; $j++) {
# Поиск по значениям хэша 'properties'
my $json_var = $json_text->{'monitors'}[$i]{'properties'}[$j]{'key'};
if($json_var eq "MemoryPercentUsage") {
my $json_val = $json_text->{'monitors'}[$i]{'properties'}[$j]{'value'};
if($json_val > $max_val) { $max_val = $json_val; }
last;
}
elsif($json_var) { next; }
else { last; }
}
}
print $max_val >= 0 ? $max_val : "Error! Cannot evaluate parameters value!";
}
else { die sprintf "Error! HTTP code: %d - Message:'%s'", $response->code, $response->message; }
It's OK.
I've got my own clumsy solution:
open my $saveout, ">&STDERR";
open STDERR, '>', File::Spec->devnull(); # Связывание STDERR с devnull
# Необходимые операции
my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 });
$ua->timeout(15);
my $response = $ua->get("https://useful_link");
# Конец
open STDERR, ">&", $saveout; # Восстановление STDERR
Just simply binded STDERR with devnull :)

Perl Socket Conditional doesn't work

I'm trying to create a server and client wherein the server returns a diferent message to the client according to what client sends. If the client makes the connection but sends nothing, the server will return message 1 and in case the client sends some data, the server will return message 2. But this doesn't work, the client stays waiting the data and nothing prints.
Client:
use IO::Socket;
my $sock = new IO::Socket::INET (
PeerAddr => '10.1.1.28',
PeerPort => '7070',
Proto => 'tcp' );
if (#ARGV != "") {
print $sock "$ARGV[0] $ARGV[1]";
} else {
$data = <$sock>;
print $data;
}
$sock->close;
Server
use IO::Socket;
my $sock = new IO::Socket::INET (
LocalHost => '10.1.1.28',
LocalPort => '7070',
Proto => 'tcp',
Listen => '1',
);
while(1) {
my $new_sock = $sock->accept();
if (<$new_sock> ne "") {
print $new_sock "conection with parameters";
} else {
print $new_sock "default message";
};
Need to chomp
use IO::Socket;
use Data::Dumper;
my $sock = new IO::Socket::INET(
LocalPort => '7070',
Proto => 'tcp',
Listen => '1',
);
while (1) {
my $new_sock = $sock->accept();
my $in = <$new_sock>;
chomp($in);
if ( $in ne "" ) {
print Dumper($in);
print $new_sock "conection with parameters";
}
else {
print $new_sock "default message";
}
}