Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?

Seekers of Perl Wisdom

( #479=superdoc: print w/ replies, xml ) Need Help??

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. Post a new question!

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.

User Questions
Why is perl -MO=Deparse -f obf.txt unsafe?
2 direct replies — Read more / Contribute
by vpelss
on Feb 06, 2016 at 11:52

    It is my understanding, that perl -MO=Deparse does not actually run the PERL code. Is that correct?

    If so, then why is the following run on a website able to be attacked?

    open (TXTFILE , ">obf.txt"); print TXTFILE $string; close(TXTFILE); #deparse $string = `perl -MO=Deparse -f obf.txt`;

    I thought I read somewhere that "eval" (or was it an other PERL command?) actually ran the code during PERL's compiling phase, and therefore before the rest of the PERL code ran. Is that accurate? If so, maybe that is why it is unsafe.

    I have tried many different attempts to attack that code on my home environment but with no success. So obviously the interent is safe from the likes of me.

    For all the angry Perl Monks out there don't jump all over me because my previous searches on this topic came up empty ;)
Exit codes and signals
2 direct replies — Read more / Contribute
by Anonymous Monk
on Feb 06, 2016 at 08:37
    Dear Monks, I have a process that forks into a parent that runs a monitor and a child that again runs another grandchild process. The grandchild process can terminate with 0 or non-zero exit code, which I can receive in the forked process, and return to the parent. But if the grandchild terminated due to a TERM signal, the exit code seen by the parent monitor is zero.
    elsif ($pid == 0) { # .... my $exitstatus = ... my $returnvalue = $exitstatus >> 8; my $signalled = ($exitstatus & 127); print "status=$exitstatus, signal=$signalled\n"; return($returnvalue); }
    In the above, I would like to return the full $exitstatus so the monitor can know the reason the grandchild quit. One possibility, although I am unsure how unconventional, is to return ($returnvalue | $signalled). Any help is greatly appreciated.
Getting stranger values in subtraction
5 direct replies — Read more / Contribute
by Anonymous Monk
on Feb 06, 2016 at 02:50

    Dear Monks,

    I am at my wits' end over the values "-3.5527136788005e-015" and "-1.4210854715202e-014" when 0 is expected in each case. I'm on Windows Perl 5.14.

    Essentially, what I am doing is to subtract a total amount (a session value) from each item's amount. Sometimes I get the expected 0 but sometimes I get strange values even though last amount to be subtracted from the total amount is equal to that total amount:

    foreach my $key (sort keys %$cart_info) { my $qty = $cart_info->{$key}->{qty}; my $amount = $cart_info->{$key}->{amount}; $session->param('CART')->{total_amount} -= $amount; $session->param('CART')->{total_qty} -= $qty;; } # First sample Before: session_total_amt: 585.86 After: key: 116, amount: 112.09, session_total_amt: 473.77 Before: session_total_amt: 473.77 After: key: 117, amount: 69.75, session_total_amt: 404.02 Before: session_total_amt: 404.02 After: key: 118, amount: 113.57, session_total_amt: 290.45 Before: session_total_amt: 290.45 After: key: 123, amount: 113.57, session_total_amt: 176.88 Before: session_total_amt: 176.88 After: key: 124, amount: 69.75, session_total_amt: 107.13 Before: session_total_amt: 107.13 After: key: 125, amount: 80.89, session_total_amt: 26.24 Before: session_total_amt: 26.24 After: key: 50, amount: 26.24, session_total_amt: -3.5527136788005e-01 +5 # Notice that both the session_total_amt and the amount to be subtract +ed are 26.24. How did I end up with -3.5527136788005e-015? # Second sample Before: session_total_amt: 319.02 After: key: 116, amount: 112.09, session_total_amt: 206.93 Before: session_total_amt: 206.93 After: key: 117, amount: 69.75, session_total_amt: 137.18 Before: session_total_amt: 137.18 After: key: 118, amount: 113.57, session_total_amt: 23.61 Before: session_total_amt: 23.61 After: key: 56, amount: 23.61, session_total_amt: -1.4210854715202e-01 +4 # Same thing here. The session_total_amt and the amount to be subtract +ed are both 23.61.

    What am I missing here? (scratch head)?

OpenSSL and Crypt::CBC don't give the same ciphertext
3 direct replies — Read more / Contribute
by LonelyPilgrim
on Feb 05, 2016 at 18:36

    Greetings, Wise Monks. I am a wayfarer returned from many travels.

    I'm taking a Network Security course and am pretty much a novice when it comes to encryption. My assignment asks me to encrypt and decrypt a 1024-byte plaintext (which happens to be a transcript from the opening of Zork) by calling the OpenSSL binary -- but that's kind of slow, I suspect owing in part to the latency of launching new processes and file I/O, so I had (what I thought to be) the bright idea of doing the decryption separately in Perl (using Crypt::CBC) and timing the difference.

    That's all well and good; doing it the Perl way appears to be considerably faster; but here's my problem: I can't get OpenSSL and Crypt::CBC to give me the same ciphertext. Can anybody help me figure out what I am doing wrong?

    My code:

    #!/usr/bin/env perl use strict; use warnings 'all'; my $test_in = 'test.txt'; my $test_out = 'test.bin'; my $cipher = 'des-cbc'; my $iv = '0123456789ABCDEF'; my $fixed_key = '0123456789ABCDEF'; open (my $infile, '<', $test_in) or die "Couldn't open $test_in for input: $!"; undef $/; my $plaintext = <$infile>; close ($infile); # OpenSSL my $enc = "openssl enc -$cipher -iv $iv -nosalt -out $test_out -K $fix +ed_key"; print "$enc\n"; open (my $pipe, "|-", $enc); print $pipe $plaintext; close $pipe; # Crypt::CBC require Crypt::CBC; require Crypt::Cipher::DES; $iv = pack("h*", $iv); $fixed_key = pack("h*", $fixed_key); my $crypt = Crypt::CBC->new( -cipher => 'Cipher::DES', -iv => $iv, -key => $fixed_key, -literal_key => 1, -header => 'none', ); my $ciphertext = $crypt->encrypt($plaintext); open (my $cipherout, '>', 'cryptx.bin') or die "Couldn't open cryptx.bin for output: $!"; binmode($cipherout); print $cipherout $ciphertext; close $cipherout;

    Comparing test.bin (the output from OpenSSL) and cryptx.bin (the output from Perl) shows that the two are completely different from the first byte. The files are the same length (1032 bytes) and do not change with each run.

    UPDATE: I fixed it. Oh, I'm an idiot. Endianness: so simple and yet so important. It should have been H* instead of h* in my pack statements. Fix that, and it gives the right result.

ImageMagick JPEG metadata foreign characters
1 direct reply — Read more / Contribute
by gld64
on Feb 05, 2016 at 17:19
    My website is hosted on SiteGround. I need my Perl script to read a JPEG's metadata, namely the description and date, ex: Mom and Dad at Niagara Falls. I used ImageMagick but it replaces international characters like (ť) with two decimal points (..) Is ImageMagick overkill for reading two metadata fields, since I'm not planning to manipulate the images? Is there a more direct way for Perl to do this? Is there an alternative to ImageMagick which does read international characters? PS. here's part of my code - which I copied from the net
    # -------------------------------------- use Image::Magick; my $image = Image::Magick->new; $image->Read('pic.jpg'); my %exif = map { s/\s+\z//; $_ } map { split /=/, $_ } split /exif:/, $image->Get('format', '%[EXIF:*]'); my $s = $exif{'ImageDescription'}; # --------------------------------------
    Thanks for all and any information, Guy
Catalyst Concurrency Control
3 direct replies — Read more / Contribute
by Anonymous Monk
on Feb 05, 2016 at 16:01

    I have a Catalyst based application with a DBIx::Class model on top of an SQL database persistence layer. Following Ďbest practiceí all my business logic is all within the framework and not within the database.

    One particular requirement is that the date of an event is between the start date and end date of a parent object. I have a series of tests and am satisfied in my development environment this is always the case. However, in the live environment there are a number of records in the database that do not satisfy this requirement. I have realised that this is due to the high state of flux of all date values and that some users are amending the dates of the parent entities at the same time as others are creating the associated events.

    I have two questions:

    1. What can I do within the framework to ensure that the requirement is met? I assume I need some sort of concurrency control. However, I need to make sure this doesnít impact the scalability of the application more than is necessary.
    2. What tests can I write to ensure that the requirement is met, even in a multi-user environment i.e. how do you write multi-threaded tests to guarantee the concurrency controls are working as expected?
How to not send TLS 1.0 on https soap call
1 direct reply — Read more / Contribute
by davew
on Feb 05, 2016 at 13:29

    I had a perl app to query some data via SOAP, and it was working up until yesterday. Now I just get the error:

    LWP::Protocol::https::Socket: SSL connect attempt failed at /usr/lib/perl5/site_perl/5.8.8/LWP/Protocol/ line 47.

    Someone from the server team told me they just upgraded to no longer support TLS 1.0. I've tried a few things (including upgrading my openssl library from 0.9.8 to 1.0.1), and still can't get it working.

    Here is the snippet of what was working before:

    #!/usr/bin/perl use strict; use LWP::UserAgent; use HTTP::Request; use HTTP::Response; my $ua = LWP::UserAgent->new(); $ua->ssl_opts( SSL_ca_file => '/var/www/cgi-bin/sz/api/apisb-fullrootchain.crt', SSL_verifycn_scheme => 'http', SSL_verifycn_name => '' ); my $req = HTTP::Request->new(POST => ' +s/services/a/68.0'); $req->header( 'Content-Type' => 'text/xml; charset=utf-8', 'SOAPAction' => 'login' ); $req->content($xml_content); my $resp = $ua->request($req);

    In addition to upgrading openssl library, I also tried adding the SSL_version param to ssl_opts call (trying all kinds of permutations of the version string such as tlsv1_1, tlsv11, etc).

    $ua->ssl_opts( SSL_version => '!TLSv1', SSL_ca_file => '/var/www/cgi-bin/sz/api/apisb-fullrootchain.crt', SSL_verifycn_scheme => 'http', SSL_verifycn_name => '' );

    Also, I tried this with similar permutations:

    my $context = new IO::Socket::SSL::SSL_Context( SSL_version => '!tlsv1', ); IO::Socket::SSL::set_default_context($context);

    Here are my specifics:

    [root@one-commerce-vm.cs.qai install]# perl -MIO::Socket::SSL -e 'prin +t "$IO::Socket::SSL::VERSION\n"' 2.023 [root@one-commerce-vm.cs.qai install]# perl -MNet::SSLeay -e 'print "$ +Net::SSLeay::VERSION\n"' 1.72 [root@one-commerce-vm.cs.qai install]# perl -MNet::HTTP -e 'print "$Ne +t::HTTP::VERSION\n"' 6.09 [root@one-commerce-vm.cs.qai install]# perl -MLWP::UserAgent -e 'print + "$LWP::UserAgent::VERSION\n"' 6.15 [root@one-commerce-vm.cs.qai install]# openssl version -a OpenSSL 1.0.1g 7 Apr 2014 built on: Fri Feb 5 09:19:23 PST 2016 platform: linux-x86_64 options: bn(64,64) rc4(16x,int) des(idx,cisc,16,int) idea(int) blowfi +sh(idx) compiler: gcc -DOPENSSL_THREADS -D_REENTRANT -DDSO_DLFCN -DHAVE_DLFCN_ +H -Wa,--noexecstack -m64 -DL_ENDIAN -DTERMIO -O3 -Wall -DOPENSSL_IA32 +_SSE2 -DOPENSSL_BN_ASM_MONT -DOPENSSL_BN_ASM_MONT5 -DOPENSSL_BN_ASM_G +F2m -DSHA1_ASM -DSHA256_ASM -DSHA512_ASM -DMD5_ASM -DAES_ASM -DVPAES_ +ASM -DBSAES_ASM -DWHIRLPOOL_ASM -DGHASH_ASM OPENSSLDIR: "/usr/local/ssl"

    Any suggestions appreciated!

Need help to remove AutoLoader in Tx::Text::SuperText
2 direct replies — Read more / Contribute
by capfan
on Feb 05, 2016 at 13:06

    Hi all!

    I just got co-maint on Tk::Text::SuperText. I wanted to make it look better, like having a lib folder and tests.

    There is also some issues in this module and I would like to investigate. However, the module does use AutoLoader, which makes it harder for me to understand the module.

    So I tried to remove AutoLoader. Simply remove the use AutoLoader statement, remove the __END__ block and move all method inside the module.

    But then it happens: suddently, stuff that worked before does not work anymore. To be precise: With the current state of the module (v0.9.5), typing a < works fine. With the new state, with the adjustments as described above, it crashes immediately.

    How can this be? Any ideas welcome.

Recursive regex
4 direct replies — Read more / Contribute
by raghuprasad241
on Feb 05, 2016 at 12:49
    Hello monks,

    Following is the excerpt from "Programming perl". I am having trouble wrapping my head around this regular expression and there is not much explanation to it in the book, can someone shed some light please? Just an fyi I tried my best to understand this but I am still not clear, sorry if I am asking a question that isn't supposed be asked here.

    "You can do recursive patterns, too. One way is to have a compiled pattern that uses (??{ CODE }) to refer to itself. Recursive matching is pretty irregular, as regular expressions go. Any text on regular expressions will tell you that a standard regex canít match nested parentheses correctly. And thatís correct. Itís also correct that Perlís regexes arenít standard. The following pattern matches a set of nested parentheses, however deep they go:

    $np = qr{ \( (?: (?> [^()]+ ) # NonĖparens without backtracking | (??{ $np }) # Group with matching parens )* \) }x;

    You could use it like this to match a function call:

    $funpat = qr/\w+$np/;<br> "myfunfun(1,(2*(3+4)),5)" =~ /^$funpat$/; #Matches!"

    Jr. Monk
File::Find traversing a link into a mounted flash drive
1 direct reply — Read more / Contribute
by swampyankee
on Feb 05, 2016 at 12:40

    I did a quick search, but didn't quite find anything that was sufficiently close to be an answer

    I'm trying to use File::Find to find image files, so I can randomly change my wallpaper. I know; it's a silly task ⌣. My problem is that I have a bunch of image files on a flash drive, and File::Find won't follow a symbolic link to the contents of the flash drive. I suspect it's because File::Find, even when $File::Find::follow is set won't recurse into a different file system.

    I'm using Fedora 21, Perl v5.18.4, File::Find version 1.23.

    sub image_search { my $name = $File::Find::name; my $dir = $File::Find::dir; my @globbed; my @temp; my $images = '(png$)|(jpg$)|(gif$)|(jpeg$)'; if (-l $name) { print "processing link named $name\n"; @globbed = glob("$name/*"); } else { print "processing directory named $dir\n"; @globbed = glob("$dir/*"); } if (@globbed) { @globbed = grep {m/$images/i} @globbed; $image_list{$dir} = [@globbed]; } } ## end sub image_search
    Sorry for the a) less-than-optimal code design and b) absence of comments.

    Information about American English usage here and here. Floating point issues? Please read this before posting. — emc

Add your question
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others rifling through the Monastery: (2)
    As of 2016-02-06 19:42 GMT
    Find Nodes?
      Voting Booth?

      How many photographs, souvenirs, artworks, trophies or other decorative objects are displayed in your home?

      Results (236 votes), past polls