I have written one script to connect to raw socket. i am able to send header part that i can see on my destination machine using wire-shark that the packets are reaching to that machine.

but, i want to add payload, means send some commands on raw socket and get the response of the same commands.

here is the code:

#!/usr/local/bin/perl


use Socket;

$src_host = "192.1.2.2"; # The source IP/Hostname
$src_port = "1301"; # The Source Port
$dst_host = "192.1.2.3"; # The Destination IP/Hostname
$dst_port = "1302"; # The Destination Port.

if(!defined $src_host or !defined $src_port or !defined $dst_host or !
+defined $dst_port) {
print "Usage: $0 <source host> <source port> <dest host> <dest port>\n
+";
exit;
} 
else {
main();
}
 
sub main {
 my $src_host = (gethostbyname($src_host))[4];
 my $dst_host = (gethostbyname($dst_host))[4];

 socket(RAW, AF_INET, SOCK_RAW, 255) || die $!;
 setsockopt(RAW, 0, 1, 1);
 
 my ($packet) = makeheaders($src_host, $src_port, $dst_host, $dst_port
+);
 my ($destination) = pack('Sna4x8', AF_INET, $dst_port, $dst_host);
 send(RAW,$packet,0,$destination);
}

sub makeheaders {
 local($src_host,$src_port,$dst_host,$dst_port) = @_;
 my $zero_cksum = 0;
 # Lets construct the TCP half
 my $tcp_proto          = 6;
 my ($tcp_len)          = 20;
 my $syn                = 13456;
 my $ack                = 0;
 my $tcp_headerlen      = "5";
 my $tcp_reserved       = 0;
 my $tcp_head_reserved  = $tcp_headerlen .
                          $tcp_reserved;
 my $tcp_urg            = 0; # Flag bits
 my $tcp_ack            = 0; # eh no
 my $tcp_psh            = 0; # eh no
 my $tcp_rst            = 0; # eh no
 my $tcp_syn            = 1; # yeah lets make a connexion! :)
 my $tcp_fin            = 0;
 my $null               = 0;
 my $tcp_win            = 124;
 my $tcp_urg_ptr        = 0;
 my $tcp_all            = $null . $null .
                          $tcp_urg . $tcp_ack .
                          $tcp_psh . $tcp_rst .
                          $tcp_syn . $tcp_fin ;

 # In order to calculate the TCP checksum we have
 # to create a fake tcp header, hence why we did
 # all this stuff :) Stevens called it psuedo headers :)

 my ($tcp_pseudo) = pack('a4a4CCnnnNNH2B8nvn',
  $tcp_len,$src_port,$dst_port,$syn,$ack,
  $tcp_head_reserved,$tcp_all,$tcp_win,$null,$tcp_urg_ptr);

 my ($tcp_checksum) = &checksum($tcp_pseudo);

 # Now lets construct the IP packet
 my $ip_ver             = 4;
 my $ip_len             = 5;
 my $ip_ver_len         = $ip_ver . $ip_len;
 my $ip_tos             = 00;
 my ($ip_tot_len)       = $tcp_len + 20;
 my $ip_frag_id         = 19245;
 my $ip_frag_flag       = "010";
 my $ip_frag_oset       = "0000000000000";
 my $ip_fl_fr           = $ip_frag_flag . $ip_frag_oset;
 my $ip_ttl             = 30;

 # Lets pack this baby and ship it on out!
 my ($pkt) = pack('H2H2nnB16C2na4a4nnNNH2B8nvn',
  $ip_ver_len,$ip_tos,$ip_tot_len,$ip_frag_id,
  $ip_fl_fr,$ip_ttl,$tcp_proto,$zero_cksum,$src_host,
  $dst_host,$src_port,$dst_port,$syn,$ack,$tcp_head_reserved,
  $tcp_all,$tcp_win,$tcp_checksum,$tcp_urg_ptr);

 return $pkt;
}

sub checksum {
 # This of course is a blatent rip from _the_ GOD,
 # W. Richard Stevens.
  
 my ($msg) = @_;
 my ($len_msg,$num_short,$short,$chk);
 $len_msg = length($msg);
 $num_short = $len_msg / 2;
 $chk = 0;
 foreach $short (unpack("S$num_short", $msg)) {
  $chk += $short;
 }
 $chk += unpack("C", substr($msg, $len_msg - 1, 1)) if $len_msg % 2;
 $chk = ($chk >> 16) + ($chk & 0xffff);
 return(~(($chk >> 16) + $chk) & 0xffff);
}
[download]

can anyone help me how to add pay load ..

Dear Monks,

I am aware of Memory::Usage, but it works only under Linux (using /proc). Is there any equivalent for Mac OS ? Or better yet a single module or wrapper that would handle both platforms ?

I have the feeling that this should have been asked in the past, but could not find it in Super search.

Many thanks

--jean

This documentation says it's not:

http://www.plover.com/FAQs/Buffering.html

There's one other exception to the rule that says that filehandles are cold unless they're attached to the terminal: The filehandle STDERR, which is normally used for error logging, is always in line buffered mode by default.

But there are example code in perldoc, which make me think it's sometimes buffered

http://perldoc.perl.org/functions/select.html

use IO::Handle; STDERR->autoflush(1);

Also this blogpost claims that it does

http://blog.famzah.net/2010/04/08/auto-flush-both-stdout-and-stderr-in-perl/

In my tests it's always line buffered, even when not attached to terminal, but I wonder if this is always true or not.

Also I have an error in one of my scripts, which might be related to this (process terminated with signal and STDERR output truncated, even if contains newlines), but I can't reproduce it so can't investigate

I had installed LibXSLT module in a 32 bit Windows machine which worked fine with perl 5.6 but Perl 5.16 (Active state) could not load LibXSLT.dll.

Is it possible to upgrade from 5.6 to 5.16 with the same dll files?

I wanted to use the same perl for 64 bit machine as wel. Is it possible to use single perl for both 32 & 64 bit machine?

ERROR Cant Load 'C:/PROGRA~2/Data/lib/perl5/site/lib/auto/XML/LibXSLT/LibXSLT.xs.dll' for module XML::LibXSLT: load_file:The specified module could not be found at C:/PROGRA~2/Data/lib/perl5/lib/DynaLoader.pm line 191. at C:/PROGRA~2/Data/lib/perl5/site/lib/XML/LibXSLT.pm line 44. BEGIN failed--compilation aborted at C:/PROGRA~2/Data/lib/perl5/site/lib/XML/LibXSLT.pm line 44.

38  bootstrap XML::LibXSLT $VERSION; 
39 
40 # the following magic lets XML::LibXSLT internals know 
41 # where to register XML::LibXML proxy nodes 
42 INIT_THREAD_SUPPORT() if XML::LibXML::threads_shared_enabled(); 
43 $USE_LIBXML_DATA_TYPES = 0;
44 }
[download]

Please suggest how to solve this error

Hi again

I've got this part of my program, which is meant to go through all possibilities of w, x, y, z, except for when they're evenly spaced apart, or in arithmetic sequence if that makes sense to you. Since I already know those cases won't give me what I'm looking for I want to save perl the trouble of considering them. Here's what I've come up with, but I have a feeling there's a way to make it go faster. I wonder if I really need that s variable since it's just one more thing to deal with:

foreach my $w (3..100) {
    foreach my $x (2..$w-1) {
        foreach my $y (1..$x-1) {
            foreach my $z (0..$y-1) {
                
                foreach my $s (1..20) {
                    unless ( $x == $w + $s && $y == $x + $s && $z == $
+y + $s ) {
[download]

I can add more context if you want, this is just part of the program which works fine I just thought I'd see if there's a way to streamline it.

I've got a closed source client/server software that communicate through HTTP. Unfortunately, neither the client nor the server has any authentication module for HTTP communication.

To overcome this I've set up an nginx proxy on the server. However I still need a HTTP handler clientside to capture all outgoing client requests and manipulate it to encompass the authentication mechanism used by the proxy.

bean trying to install Win32::GUI, have tried force, uninstalled and reinstall of strawberry, tried to build it, but here is the error i get when i cpan Win32::GUI

In file included from Scintilla.xs:8:0:
../GUI.h:768:22: warning: 'ImageList_Duplicate' redeclared without dll
+import att
ribute: previous dllimport ignored [-Wattributes]
Scintilla.xs: In function 'CallWndProc':
Scintilla.xs:199:101: error: 'GWL_USERDATA' undeclared (first use in t
+his functi
on)
Scintilla.xs:199:101: note: each undeclared identifier is reported onl
+y once for
 each function it appears in
dmake:  Error code 129, while making 'Scintilla.o'
dmake.exe:  Error code 255, while making 'subdirs'
  ROBERTMAY/Win32-GUI/Win32-GUI-1.06.tar.gz
  C:\strawberry\c\bin\dmake.exe -- NOT OK
CPAN: YAML::XS loaded ok (v0.39)
Running make test
  Can't test without successful make
Running make install
  Make had returned bad status, install seems impossible
Stopping: 'install' failed for 'Win32::GUI'.
[download]

perl vr: 5.16.3

Let me get this over up front, I am a relatively new perl user (Starting over after 15 years).

I have been working on extracting data from a management server via an API supplied by the vendor. So far that is all working great, I am able to get the data. My problem arises in that when I receive the data it will have some odd offset in the time stamps.

I make a call requesting data at the default sample rate of 60 seconds over a period of 1 day. The API returns the data in a sequence of Key:Value pairings for each counter I am retrieving. The first counter may have X secs:Value and proceed through at 60 second increments. Ok great so far, the second and forth counters may return to the top with the first and X is the time stamp but the third counter returns to the top and may be X+6 secs instead of X.

The data ends up looking like this:

2013-05-21 18:46:44,221.667,9.041,92.133,4.008,84.450,6.220,8.983,2.57
+0,5.917,6.710,87.067,6.133
2013-05-21 18:46:45,7.519,5.069
2013-05-21 18:47:44,33.617,2.817,70.900,2.931,161.000,9.811,8.233,2.28
+0,5.617,6.010,86.117,8.108,6.067,5.304
2013-05-21 18:48:44,26.417,1.758,38.933,2.550,42.900,3.526,5.750,1.515
+,4.867,6.132,86.433,6.067
2013-05-21 18:48:45,7.562,5.068
2013-05-21 18:49:44,42.683,2.308,33.633,2.208,42.983,3.807,6.033,1.751
+,4.900,6.042,87.300,8.118,5.983,5.207
2013-05-21 18:50:44,86.983,8.791,103.417,7.851,62.900,8.295,15.500,4.4
+21,8.300,9.368,87.800,7.697,6.050,5.202
2013-05-21 18:51:44,50.033,2.840,63.350,3.071,36.817,3.134,6.217,1.480
+,4.783,5.444,88.433,6.150
2013-05-21 18:51:45,7.725,5.275
2013-05-21 18:52:44,50.017,3.071,61.033,2.538,45.317,4.027,6.233,1.769
+,4.767,5.653,88.383,8.086,5.550,4.966
2013-05-21 18:53:44,38.850,2.265,43.100,2.051,42.683,3.795,5.883,1.403
+,4.850,5.667,89.700,6.000
2013-05-21 18:53:45,7.164,5.061
2013-05-21 18:54:44,22.000,1.741,42.817,2.352,41.700,3.430,5.700,1.543
+,5.567,5.756,87.517,7.939,6.300,5.188
2013-05-21 18:55:44,62.700,6.359,78.267,6.949,58.883,6.804,12.350,3.60
+1,8.200,9.379,87.550,7.349,6.017,5.114
[download]

I would like it to look like this:

2013-05-21 18:47:00,30.400,2.157,9.900,1.315,39.917,4.201,6.383,1.798,
+5.167,7.250,129.950,7.965,5.667,4.892
2013-05-21 18:48:00,33.917,2.276,7.017,1.052,40.150,3.489,5.233,1.440,
+4.900,6.393,129.850,8.257,6.033,5.191
2013-05-21 18:49:00,31.867,2.567,10.367,1.337,45.467,4.138,6.417,1.796
+,5.267,7.148,124.867,8.340,5.983,4.897
2013-05-21 18:50:00,57.533,2.943,8.800,1.063,41.867,3.701,5.083,1.445,
+4.900,6.176,129.517,7.715,5.867,4.925
2013-05-21 18:51:00,72.900,10.128,103.833,6.560,66.317,6.734,14.933,4.
+398,11.267,11.092,119.767,7.753,6.100,5.121
2013-05-21 18:52:00,23.950,1.803,7.217,1.460,50.667,3.845,5.183,1.492,
+4.583,5.481,124.500,9.369,6.017,5.030
2013-05-21 18:53:00,25.500,1.910,9.767,1.754,49.467,4.112,6.133,1.772,
+23.117,17.196,127.583,8.158,6.067,5.076
2013-05-21 18:54:00,47.350,2.344,8.833,1.419,47.283,3.875,5.400,1.409,
+4.867,6.035,148.567,8.428,5.883,4.940
2013-05-21 18:55:00,29.067,2.338,10.400,1.789,45.067,3.250,6.233,1.795
+,5.100,5.866,126.517,7.990,6.133,5.219
[download]

Here is the code I am using to do this:

    my ($list, $obj, $server_ctx) = @_;

    my @objList = @{ $list };
    my (@counter_arr,$objName,@perf_cnt_data,%perfhash);
    my $gen_time_arr = 1;
    my $gen_hash_hdr = 1;
    my $obj_i = 0;
    my ($rec,$tmpHDR,$tmpVAL);
    if ($obj eq "system") {
        $obj = "host";
    }

    $perfhash{"Time"} = "";
    foreach my $perf_out ( @objList ){
        my $instance = $perf_out->child_get("perf-instances");
        my @instances = $instance->children_get("perf-instance-counter
+-data");

        foreach $rec (@instances){
            my $obj_id = $rec->child_get_string("object-id");

            my $IterStart = NaElement->new("$obj" . "-list-info-iter-s
+tart");
            $IterStart->child_add_string("object-name-or-id","$obj_id"
+);

            my $output = $server_ctx->invoke_elem($IterStart);
            if ( $output -> results_status()=~/failed/ ) {
                print "\n\n\tFailed to get list of $obj: Error: ".$out
+put->results_reason(). "\n\n";
            } else {
                my $records = $output->child_get_int("records");
                my $tag = $output->child_get_string("tag");

                $output = $server_ctx->invoke("$obj" . "-list-info-ite
+r-next", "maximum", $records, "tag", $tag);
                if ( $output -> results_status()=~/failed/ ) {
                    print "\n\n\tFailed to iterate list of $obj : Erro
+r: ".$output->results_reason(). "\n\n";
                }
            }
            my $aggregates = $output->child_get("$obj" . "s");
            my @aggregateArr = $aggregates->children_get();
            foreach my $aggr (@aggregateArr) {
                $objName = $aggr->child_get_string("$obj" . "-name");
                $objName =~ s/\///g;
            }

            my $counters = $rec->child_get("counters");
            @perf_cnt_data = $counters->children_get("perf-counter-dat
+a");
            my $rec1;
# TODO If the counter is aggregate:pa_max_disk_busy and returns nothin
+g get the max of disk:disk_busy for the aggregate
            foreach $rec1 (@perf_cnt_data) {
                my $counter_name = $rec1->child_get_string("counter-na
+me");
                my $counter_str = $rec1->child_get_string("counter-dat
+a");
                my @counter_arr = split (',', $counter_str);
                my $colName = $objName . ":" . $counter_name;
                chomp($colName);
                $tmpHDR = $perfhash{"Time"};
                $perfhash{"Time"} = join( ',' , $tmpHDR , $colName);
                for (@counter_arr) {
                    my ($time,$value) = split(':',$_);
                    my @timestamp = ( localtime($time) )[0..5];
                    $time = POSIX::strftime( '%F %H:%M:%S', @timestamp
+);
                    if ($gen_time_arr == 1) {
                        $perfhash{$time} = join('' , "," , $value);
                        $gen_time_arr = 0;
                    }else {
                        if ($perfhash{$time}) {
                            $tmpVAL = $perfhash{$time};
                        } else {
                            $tmpVAL = "";
                        }
                        $perfhash{$time} = join( ',' , $tmpVAL , $valu
+e);
                    }
                }
            }
        }
    }
    return(\%perfhash);
}
[download]

Thanks in advance

Lew

I need to run background tasks at arbitrary points in the future, with queue behavior if multiple execute at or near the same time, ability to manipulate the task list, retry (ideally with exponentially longer retry window), etc.

In Ruby, there is delayed_job (and php port djjob), which does this pretty much perfectly.

The closest Perl solution I could find was Beanstalk::Job, but this doesn't appear to support execution in the "far future" (next week). There is also Schedule::At, which does (and also allows manipulation of the tasks) but it runs external commands and the jobs appear to be executed straight with no queueing mechanism