If
you have a question on how to do something in Perl, or
you need a Perl solution to an actual real-life problem, or
you're unsure why something you've tried just isn't working...
then this section is the place to ask.
However, you might consider asking in the chatterbox first (if you're a
registered user). The response time tends to be quicker, and if it turns
out that the problem/solutions are too much for the cb to handle, the
kind monks will be sure to direct you here.
Hello, I'm trying to retrieve the full TCP_INFO socket structure on a macOS system using Perl.
I have no problem retrieving this structure on other systems (Linux, FreeBSD...) using the getsockopt function, but on these systems the structure is less than 256 bytes long.
On macOS, this structure is supposed to be 292 bytes long, as one can see here. When I try to retrieve this structure from Perl using getsockopt on macOS 12.0.1 (Darwin 21.1.0), I only get 256 bytes of data: the last values are missing from the structure.
Is it due to this code from Perl core, which seems to limit getsockopt results to 256 bytes ? And in this case, what can I do to retrieve the full TCP_INFO structure ?
Here is a code snippet to reproduce the problem on macOS:
use warnings;
use strict;
use Socket qw'PF_INET SOCK_STREAM inet_aton sockaddr_in IPPROTO_TCP';
my $TCP_INFO = ($^O eq 'darwin' ? 0x200 : eval { Socket::TCP_INFO() })
or die "This system doesn't support the TCP_INFO structure.\n";
my ($testHost,$testPort)=('perl.org',443);
my $tcpProto=getprotobyname('tcp');
socket(my $sock, PF_INET, SOCK_STREAM, $tcpProto)
or die "Could not create socket - $!\n";
my $iaddr=inet_aton($testHost);
my $paddr=sockaddr_in($testPort,$iaddr);
connect($sock,$paddr)
or die "Failed to connect to $testHost:$testPort - $!\n";
my $tcpInfoData=getsockopt($sock,IPPROTO_TCP,$TCP_INFO)
or die "Error while calling getsockopt - $!\n";
my $tcpInfoLength=length($tcpInfoData);
if($tcpInfoLength < 256) {
print "This system doesn't have a TCP_INFO structure large enough to
+ reproduce the problem.\n";
}elsif($tcpInfoLength == 256) {
print "The TCP_INFO structure seems to be truncated to 256 bytes on
+this system.\n";
}else{
print "This system doesn't seem to be affected by the problem.\n";
}
I am having some difficulty trying to understand how to reconnect this websocket. I have a simple discord bot that i am using to provide services to users at a website i moderate. Everything works as expected except when the gateway operation code '7' (server requests reconnect) is sent to my client. To reconnect/resume a connection, you must send session id, token and sequence number of the last event. I have all of this info already and am not to sure about how to reconnect/resume the websocket connection. I would ask at discord api chat but this isnt a discord problem, its a me not knowing how to reconnect with the lib i am using problem lol. EDIT: Before this code there are a POST and a GET request sent to their servers for authorization and logging the bot in. When i do this i get the session_id and token. those two values are stored in a %globals hash and accessed when needed to reconnect.
here is a snippet from my script:
my $ua = Mojo::UserAgent->new;
$ua->inactivity_timeout(0);
$ua->websocket(
$gateway . ':443?v=9&application/json, text/plain, */*' => sub {
my ( $ua, $tx ) = @_;
# Check if WebSocket handshake was successful
say 'WebSocket handshake failed!' and return unless $tx->is_we
+bsocket;
# Wait for WebSocket to be closed
$tx->on(
finish => sub {
my ( $tx, $code, $reason ) = @_;
say "WebSocket closed with status $code and $reason";
$ua->websocket->resume; #would i use the payload he
+re somehow instead of using sub reconnect()?
}
);
$tx->on(
message => sub {
my ( $tx, $msg ) = @_;
my $data = decode_json($msg);
my %payload = %$data;
$globals{'sequence'} = $payload{'s'} if defined $paylo
+ad{'s'};
for ( $payload{'op'} ) {
when ('7') { reconnect( $tx, %payload ) }
}
}
);
}
);
Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
sub reconnect {
my $reconnect_payload = {
op => 6,
d => {
token => $globals{'token'},
session_id => $globals{'session_id'},
seq => defined( $globals{'sequence'} ) ? $globals{
+'sequence'} : 'null'
},
s => 'null',
t => 'null'
};
#how to reconnect
}
The code is not a drop in place and work kind of thing. There could be syntax errors but hopefully this gets the point across of what i am trying to figure out. I just cant figure out how to reconnect.
here are links to their api reference and i am pretty sure i have the payload setup right, I just dont know how to reconnect this websocket when requested.
I'm struggling with something that I thought would be very simple. I have a legacy system which sends data in JSON. The underlying data, which I can't change, uses HTML entities. I need to convert this to UTF8, because a receiving system can't handle the entities. I wrote a one-line test for this, which is failing, and I don't know why.
When I do the conversion on the text itself, it looks fine. When I do the conversion on the JSON, it also looks fine, but when I decode the JSON for the test, it seems to re-convert the UTF8 JSON elements into something wrong. A simple test case:
#!/usr/bin/env perl
use strict;
use warnings;
use HTML::Entities;
use Encode;
use JSON::MaybeXS;
my $original_string = "Eötvös Loránd University";
my $converted_string = encode_utf8( decode_entities($original_string)
+);
print "Original string: [$original_string]\n"; # shows the entities
print "Converted string: [$converted_string]\n"; # shows the special c
+haracters
my $entities_json = '{"school":"Eötvös Loránd Uni
+versity"}';
my $converted_json = encode_utf8(decode_entities($entities_json));
print "Original JSON: [$entities_json]\n"; # shows the entities
print "Converted JSON: [$converted_json]\n"; # looks right: shows the
+special characters
my $decoded_json = decode_json($converted_json);
print "School: " . $decoded_json->{'school'} . "\n"; # should be "Eötv
+ös Loránd University" but is actually "�tv�s Lor�
+;nd University", with the special characters messed up (N.B. Perlmonk
+s is showing this incorrectly as well)
use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request::Common;
use Authen::NTLM;
use LWP::ConsoleLogger::Everywhere;
ntlmv2(1);
my $ua = LWP::UserAgent->new(keep_alive => 1, ssl_opts => { verify_hos
+tname => 0 });
$ua->credentials(internal.com:9004', '', 'user', 'pass');
my $req = GET “https://internal.com:9004/api”;
I assume because it is an internal site, if I don't turn off verify_hostname, I get:
500 Can't connect to internal.com:9004 (Bad File descriptor)
However, if I turn off verify_hostname, the ConsoleLogger shows that I am attempting to do my NTLM authentication, however I can't seem to get by:
401 Unauthorized
I do notice in the result header a warning:
Client-SSL-Warning: Peer certificate not verified
I'm wondering if my authentication problems are due to not verifying the host. I'd prefer that, but I've tried downloading certificates, extracting a fingerprint, but can't seem to get past the 500 error without turning off verify_hostname. How can I verify my internal site? And/or should I be looking elsewhere for my NTLM Authentication issue?
I'm attempting this from Strawberry on Windows, but I am able to authenticate against my internal site using curl from one of my linux hosts, so I know the url and credentials are correct.
my ($UUID) = system ("get-wmiobject Win32_ComputerSystemProduct | Sele
+ct-Object -ExpandProperty UUID"); # 'get-wmiobject' is not recognized
+ as an internal or external command
my ($UUID) = system ('get-wmiobject Win32_ComputerSystemProduct | Sele
+ct-Object -ExpandProperty UUID');
my ($UUID) = `get-wmiobject Win32_ComputerSystemProduct | Select-Objec
+t -ExpandProperty UUID`; # same error as above, `` works perfectly fi
+ne on macOS
I recently published a new distribution to the CPAN (Net::MyIP), but even after a week, it hasn't become available by searching, nor with cpan/cpanm tools. I can see that it is there and even being tested if I go to the link directly (here), but for some reason it's not being indexed.
I sent an email to modules@perl.org, but the only response I got was someone wondering whether it was an issue with the distribution itself. Seems pretty unlikely as this is my 59th distribution I've authored and uploaded over the course of a decade-plus. There were no errors, the PAUSE page claimed it uploaded properly, and even the PAUSE logs indicated that.
This distribution is a prerequisite for another one I completed at the same time, but can't upload due to what would be a broken dependency.
Digest::SHA1 giving an error while executing an one of my Perl script. So anyone Can help on this
perl pgw_client.pl
Can't load '/usr/local/lib64/perl5/auto/Digest/SHA1/SHA1.so' for modul
+e Digest::SHA1: at pgw_client.pl line 24.
Compilation failed in require at pgw_client.pl line 24.
BEGIN failed--compilation aborted at pgw_client.pl line 24.
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).