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";
}
[download]

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
}
[download]

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.

resume structure sent by client to server to reconnect
server op code payload structure

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&#65533
+;nd University", with the special characters messed up (N.B. Perlmonk
+s is showing this incorrectly as well)
[download]

I frequently have to scan files for lines matching various patterns and extract data from those lines. I use code like

my $re_dn = qr{^(\w+) (\d+) (\d{2}:\d{2}:\d{2}) .*: eth(\d): link down
+};
my $re_dn = qr{^(\w+) (\d+) (\d{2}:\d{2}:\d{2}) .*: eth(\d): link up, 
+(\d+)Mbps, ([^,]+), lpa (\w+)};

while(<>) {
        if ( /$qr_dn/ ) {
            my( $mon, $day, $time, $interface ) = ($1,$2,$3,$4);
            # process
            next;
        }
        if ( /$qr_up/ ) {
            my( $mon, $day, $time, $interface, $rate, $duplex, $lpa ) 
+= ($1,$2,$3,$4,$5,$6,$7);
            # process
            next;
        }
    }
[download]

I'd love to know a more elegant idiom. Will someone enlighten me?

Whittled down to the minimum, I have:

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”;
[download]

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.

Hello. How do I run the following from a Perl script on Windows?

get-wmiobject Win32_ComputerSystemProduct | Select-Object -ExpandPrope
+rty UUID # this runs fine from command line
[download]

The followings do not work

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
[download]

Hi - I am not a good programmer in perl.

I use the module Masscan::Scanner. But I have not found a way to process the modules result and would like to have some help on this

# Returns the scan results
my $res = $mas->scan_results if ($scan);
[download]

Any help how I can access e.g. the IP-Address in the result data structure or even the array (seems to be an array) of ports would be welcome

Hello there my fellow Monks,

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.

Is there anyone here who can help sort this out?

Thanks,

-stevieb

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.
[download]

open my $fh, '>', 'data';
binmode $fh;
print $fh pack 'C*', @data;
close $fh;

`convert -depth 8 -size 256x256+0 gray:data data.png`;
[download]

my $img = Imager->new(
    type  => 'raw',
    xsize => 256,
    ysize => 256,
    data  => pack('L>*', @data),
    raw_interleave    => 0,
    raw_storechannels => 1,
    model => 'gray'
);
$img->write(file=>'data.png');
[download]