Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

The Monastery Gates

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

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
Loosing variable content after regular expression
3 direct replies — Read more / Contribute
by metty
on Dec 18, 2014 at 11:23

    Hello,

    I cannot figure out why my variable looses its content after applying a regular expression on it. The program is running in a mod_perl environment using Perl 5.14.2. The following code snippet is part of an object method. An interesting fact: sometimes its working, sometimes its not.

    if (defined($$l_Name_ref)) { print STDERR "1 $$l_Name_ref\n" if (defined($$l_Name_ref)); print STDERR "2 $l_Name_ref\n"; if ($$l_Name_ref =~ /^[a-zA-Z]\w+$/) { print STDERR "3 $l_Name_ref\n"; print STDERR "4 $$l_Name_ref\n"; ...

    Here is the output from the apache log files

    1 MMP_MODULES 2 SCALAR(0x7f80ab361968) 3 SCALAR(0x7f80ab361968) 4 MMP_MODULES 1 TMP_MODULE_HASH 2 SCALAR(0x7f80ad04ed68) 3 SCALAR(0x7f80ad04ed68)
    Use of uninitialized value in concatenation (.) or string at myfile.pm + line 1061.

    The error message indicates the line storing the print command with number 4.

    During the first run, referencing the value 'MMP_MODULES', the program is working fine. The debug code send to STDERR, which is passed to the Apache log files, prints the expected result. During its second run, using the value 'TMP_MODULE_HASH', the regular expression is validated fine, but the referenced value gets undefined. I printed the pointer value. Interesting enough, the pointer to the memory block does not get modified. Just the value gets lost. Any idea why?

    I can fix this by creating a local copy before applying the regular expression:

    if (defined($$l_Name_ref)) { my $l_Name = $$l_Name_ref; if ($l_Name =~ /^[a-zA-Z]\w+$/) { ...

    Using this code, it is always working. As the code is in a central part of my program, which is executed hundreds of times during a web page call, I would like to avoid copying a value without a need.

    How can a regular expression check modify the content of a variable?

How to install perl in custom directory on solaris.
3 direct replies — Read more / Contribute
by Ankur_kuls
on Dec 18, 2014 at 00:30

    Hi, I am facing many issues while installing perl modules with the default perl which comes with sun OS 10. Now I want to install perl in any custom directory. what I know and did is as below

    downloaded the latest perl in any directory (say /home/abc) unzipped and untar it. cd /home/abc/perl-5.20.1 ln -s /usr/sfw/bin/gcc /usr/bin/gcc ln -s /usr/ccs/bin/make /usr/bin/make ./Configure prefix=/customperl/cac make make test make install

    all three make command didn't show any failure but still I didn't get my perl installed in custom /customperl/cac directory. Could any one please tell me where I am wrong or provide me the complete steps to install this...thanks.

Occasional Read Timeout with Mech
3 direct replies — Read more / Contribute
by pirkil
on Dec 17, 2014 at 06:17

    Dear monks, my script has to fetch some data from web, the mechanism looks like this:

    for my $try (1 .. 5) { debug("fetching HTML source: try $try of 5\n") if $debug; my $mech = WWW::Mechanize->new( autocheck => 0, ssl_opts => { verify_hostname => 0, SSL_version => 'TLSv1', }, timeout => 60, ); $mech->proxy('https', $args_hr->{proxy}); # Try::Tiny try { $mech->get( $url ); } catch { $err .= $_ if $_; }; my $text = $mech->content; $err .= "Can't fetch HTML source from $url!\n" if !$mech->s +uccess(); ... sleep 30; # before next try - if download was not succ. }
    I run this script on a server (with cron job). The URL is always the same. Sometimes I got en error, variable $text contains: read timeout at /usr/local/share/perl5/Net/HTTP/Methods.pm line 268. Other runs are OK, so I am not sure what the problem is and how to avoid it. Thanks for help!
Unaltered child return code on Windows
1 direct reply — Read more / Contribute
by salva
on Dec 16, 2014 at 11:48
    I am wrapping an external executable on Windows that can exit with codes bigger than 255. The issue I am facing is that Perl $? seems to be limited to the combination of one byte for the signal and another byte for the errorlevel. For instance, when the program exits with code 1000 (0x3E8), $? becomes 59392 (0xE800).

    Perl has also the variable ${^CHILD_ERROR_NATIVE}, but it seems that on Windows it gets the same value as $?.

    Does anybody known how to get the real exit code without reverting to using an external module as Win32::Process to start and control the slave processes? (on the other hand, I am already using Win32::API, so solutions using it would be acceptable).

getopt::long treating option as an argument
2 direct replies — Read more / Contribute
by harpreetsammi
on Dec 16, 2014 at 10:43

    Hi Experts,

    I am running a perl script which uses GetOpt::Long

    giveinfo.pl -name mike -long

    where, -name option ("name=s") needs a mandatory string argument

    -long is optional flag if set, will provide more details of the user named mike

    If i miss the user name while running giveinfo.pl as below then it does not error out -

    giveinfo.pl -name -long

    In this case, its treating -long as user name and DOES NOT error out. I want that in above case it should error out and say "Option name requires an argument".

    FYI. in the below scenario it error out as expected if i use -name at the end of command line -

    giveinfo.pl -long -name Option name requires an argument

    Can someone please help how can i error out correctly in the below scenerio which is missing name mike -

    giveinfo.pl -name -long

    I don't want to use "=" as -

    giveinfo.pl -name= -long

    Thanks and Regards,

    Harry
Why doesn't this print when i omit the newline?
5 direct replies — Read more / Contribute
by karlgoethebier
on Dec 16, 2014 at 08:07

    Hi all,

    i,m i'm banging my head against the wall with this:

    use strict; use warnings; use IO::All; # v5.18.2 my $io = io $0; while ( my ( $index, $value ) = each @$io ) { print qq($index\t$value); print qq($index\t$value\n); } __END__

    Only the second print works.

    I wonder why.

    Thank you very much for any hint and best regards,

    Karl

    «The Crux of the Biscuit is the Apostrophe»

Net::OpenSSH memory allocation error with seemingly low memory code
1 direct reply — Read more / Contribute
by DanBev
on Dec 15, 2014 at 10:52

    Hello Monks, I appeal to your wisdom for an advice.

    I have an "unable to fork ssh master: can not allocate memory" error when using Net :: OpenSSH-> new.
    I know that this kind of error is spy for unoptimized code, but unfortunately I have a code of 9000 lines that I can't for obvious reasons post (and I know that's very blamable). I am also aware that with a code so long the chance to have bug in the code is virtually 1.

    The only thing I ask is: is it possible to have a "can not allocate memory" if checking the program execution with "top" I see that the memory allocation is practically negligible? How can it be?

    Thank you all.
New Meditations
Authentication with U2F Two-factor keys
No replies — Read more | Post response
by cavac
on Dec 19, 2014 at 07:43

    I just uploaded the first Alpha version of Crypt::U2F, which allows you to handle the server side cryptography of the FIDO alliance's Universal 2nd factor authentication method. See also here.

    This is the same one used by Google services and fully supported in Google Chrome.

    Internally, Crypt::U2F requires Yubico's libu2f-server library installed on your system. I implemented this in two Perl modules: Crypt::U2F is the low level module (sand subject to change), that let's you play around with the underlying library. Crypt::U2F::Simple is the one you should use in most cases.

    Let's have a look into the two examples provided with the tarball. For this to work, you need to install libu2f-server and also install libu2f-host, because we need the u2f-host binary to talk to the actual USB dongle. (I'm currently in the process of making a Perl module for libu2f-host as well, but this will only finish after the hollidays.)

    The whole thing is a two part process: First you have register a new key once, then you can authenticate as often as you like. Each part (registering, authentication) itself is a two-part process as well, first you generate a challenge and send it to the client, then you have to validate the response.

    Ok, let's start with registering a key. For this example, we pass around files to and from u2f-host and also save the registered keyHandle and public key into files as well. In a real world scenario, you will probably use HTTP and Javascript to communicate with the key and save keyHandle and the public key into a database. Here's the code:

    The reason we use Base64 is simple, yet annoying: Everything except the public key is either some sort of text or even ASCII JSON. The public key on the other hand is a binary blob. It's just a matter of convenience to turn it into Base64, because that we it works in textfiles and text columns in databases as well. It don't convert directly in the library, because that might make it problematic to cooperate with other implementations of U2F authentications that also use the original C library (which delivers a binary blob), including the u2f-server example binary that comes with it.

    All of the calls to Crypt::U2F::Simple may fail for one reason or another (including new() and DESTROY()), so make sure you check all the return values!

    Let's tackle the authentication part. We'll use the keyHandle.dat and publicKey.dat generated in the previous step:

    As you can see, the process is quite similar: We load the keyHandle.dat and publicKey.dat (the second one we decode_base64()) and initialize Crypt::U2F::Simple with it. Then we generate a challenge and verify it.

    If you want to make sure the verification step actually works, you can comment out the call can try to fuss the result of u2fhost in authReply.dat. Or just comment out the call to u2fhost after you you did one successfull authentication, this one should give you a u2fs_authentication_verify (-6): Challenge error.

    Limitations and Bugs: Currently (Version 0.10), each Challenge/Verify combo has to run in the same instance of the module. I'm still working on finding out how to fix that. Also, sometimes the USB keyfob seems to be in a strange state after plugging in, returning wrongly calculated authentication replies (at least mine does). Unplugging and replugging solves that problem.

    "For me, programming in Perl is like my cooking. The result may not always taste nice, but it's quick, painless and it get's food on the table."
The Top Ten Perl Obfus
3 direct replies — Read more / Contribute
by eyepopslikeamosquito
on Dec 14, 2014 at 03:24

    Following on from The First Ten Perl Obfus, I thought it would be fun to count down the top ten highest rated Perl Monks obfus of all time.

    Since I cannot super-search by node reputation, please note that this list is based solely on my memory of spectacular obfus I've seen over the years. So, if I have overlooked an obfu gem, please let us know, and I will correct the root node. Note that, to make the top ten, a node needs a reputation of at least 240.

    No 10: Fun With Reserved Keywords by blokhead Sep 11, 2003 rep:200+

    #!/usr/bin/perl not exp log srand xor s qq qx xor s x x length uc ord and print chr ord for qw q join use sub tied qx xor eval xor print qq q q xor int eval lc q m cos and print chr ord for qw y abs ne open tied hex exp ref y m xor scalar srand print qq q q xor int eval lc qq y sqrt cos and print chr ord for qw x printf each return local x y or print qq s s and eval q s undef or oct xor time xor ref print chr int ord lc foreach qw y hex alarm chdir kill exec return y s gt sin sort split

    Constraints are the heart of obfu.

    Here blokhead constrains himself to using lowercase alphabetic characters only, no punctuation at all. Combining with an exact right hand margin produces a visually stunning and surprising block-shaped obfu.

    See also:

    No 9: Mandelbrot flythrough by blokhead Feb 17 2004 rep:200+

    Note that this obfu is formatted with pre tags so that the PerlMonks default line-breaking of code at 70 characters does not spoil the visual presentation.

    #!/usr/bin/perl
     $r=25; $c=80;
                                                  $xr=6;$yr=3;$xc=-0.5;$dw=$z=-4/
                                                  100;local$";while($q=$dr=rand()
                                                 /7){$w+=$dw;$_=join$/,map{$Y=$_*
                                                 $yr/$r;
      join""                                    ,map{$                  x=$_*$
     xr/$c;($                                   x,$y)=                 ($xc+$x
      *cos($                                   w)-$Y*               sin$w,$yc+
                                               $x*sin              ($w)+$Y*cos
      $w);$                                   e=-1;$                    a=$b=0
    ;($a,$b)   =($u-$v+$x,2*$a*               $b+$y)                    while(
    $ u=$a*$   a)+($v=$b*$b)<4.5  &&++$e     <15;if                     (($e>$
      q&&$e<   15)||($e==$q and   rand()     <$dr))  {$q=$e;($d0,$d1)   =($x,$
      y); }                        chr(+(   32,96,+  46,45,43,58,73,37  ,36,64
     ,32)[$                        e/1.5]   );}(-$   c/2)..($c/2)-1;}   (-$r/2
     )..($     r/2)-1;select$",     $",$", 0.015;                       system
    $^O=~m     ~[wW]in~x?"cls":     "clear";print                       ;$xc=(
    $d0+15     *$xc)/16;$yc=($       d1+15*$yc)/                        16;$_*=
    1+$z for                         $xr,$yr;$dw                     *=-1 if rand
    ()<0.02;                          (++$i%110                      )||($z*=-1)}
    

    This beautifully formatted obfu produces a mind-boggling visual effect when run; you truly feel like you are flying through a mandelbrot! Just works out of the box on both Unix and Windows. Brilliant work. Two in a row from blokhead!

    No 8.5: Propose. by Falkkin Aug 18 2004 rep:200+

    #!/usr/bin/perl -w use strict; my$f= $[;my $ch=0;sub l{length} sub r{join"", reverse split ("",$_[$[])}sub ss{substr($_[0] ,$_[1],$_[2])}sub be{$_=$_[0];p (ss($_,$f,1));$f+=l()/2;$f%=l ();$f++if$ch%2;$ch++}my$q=r ("\ntfgpfdfal,thg?bngbj". "naxfcixz");$_=$q; $q=~ tr/f[a-z]/ [l-za-k] /;my@ever=1..&l ;my$mine=$q ;sub p{ print @_; } be $mine for @ever

    Update: this one was added later after tye kindly pointed out that I had missed this heart-warming obfu.

    When run, the above obfu asks: kristen, will you marry me?

    Beautiful.

    Believe it or not, this was a real marriage proposal, in the form of a Perl obfu, posted by Pennsylvanian CMU PhD student Falkkin to fellow Perl Monk Vortacist, aka Kristen. To applause and congratulations all round, Falkkin's innovative marriage proposal was publicly accepted by Vortacist just thirteen minutes later.

    As pointed out by the eagle-eyed ambrus, this touching marriage proposal has since been immortalized in a phd comic strip.

    No 8: There can be only one! by Erudil May 15 2000 rep:300+

    #!/usr/bin/perl -w # there can be only one use strict; $_='$_={one(( one($")<<1)^one( $/))}{{one((one($;) <<($^=(one($/)>>1)>>1) +1)+one($/)>>1)}{{{one((( one($;)<<$^+1)+one($/)>>1)-$ ^)}{{{one(((one($;)<<$^+1)+one( $/)>>1)-1)}{one (one($"))}{{one ((one($;)<<$^)^ (one($")>>1)+1) }{one((one($;)< <$^)-$^)}{{one( ((one($;)<<$^)- $^)+1)}}{one((( one($;)<<$^+1)+ one($/)>>1)-1)} {one(($~=$=)<<1 ^one($")>>1)}{{ {one((one($;)<< $^)-one($/)-1)} {one(((one($;)< <$^+1)+one($/)> >1)-$^-1)}{one( one($"))}}{one( one($/)<<$^+1)} {one((one($;)<< $^)-one($/)-1)} {one(((one($;)< <$^+1)+one($/)> >1)-$^-1)}}}{{{one(((one($;)<<$^)-$^)-$^)}}}{one( one($"))}}{one(($~=$=)<<1^one($")>>1)}}{{one((one ($;)<<$^)-(one($")>>1)+1)}{one((one($;)<<$^)-(one ($")>>1)+$^+1)}}{{one(($~=$=)<<1^(one($")>>1)+$^+ 1)}{one((one($;)<<$^)-one($/)-1)}{one(((one($;)<< $^+1)+one($/)>>1)-$^-1)}}{one($=^(one($")>>1))';s ;{one;chr;g;y;{ne}}\012\040;.rd.;sd;eval;print;#1

    Following on from perhaps the best first post ever made, namely My 2 cents worth, the master strikes again! This one (pun intended) must surely rate as the best ever second post.

    No 7: 3-D Stereogram, Self replicating source. by Toodles Oct 15 2001 rep:300+

    #!/usr/bin/perl # Copyright (c) Marcus Post, <marcus@marcuspost.com> # # # # $_=q,my(@f|@c|x$_=q.my(@f|@c|x$_=q.my(@f|@c|x$_=q.m(@f||@c|x$_=q.m(@f| +|@c|xx @w);@a=@f=<DAT%@w);@a=@f=<DAT%@w);@a=@f=<DAT%@w;@a=@f=<DAAT%@w;@a=@f=< +DAAT%% A>;seek(DATA|0!A>;seek(DAA|0!!A>;seek(DAA|0!A>;seek(DAA|0!!A>;seek(DAA +|0!!AA |0);@c=<DATA>;Y|0);@c<DATA>;Y||0);@c<DATA>Y||0);@c<DATA>Y|||0);@c<DATA +>Y|||| until(($_=pop(zutil(($_==pp(zuttil(($_==p(zuttil(($_==p(zutttil(($_==p +(zuttt @c))=~/^_/){};Qc))=~/^_/){};Qc)))=~/^_/{};Qc)))=~/^_/{};Qc))))=~/^_/{} +;Qc))) unshift(@a|$_)xnshift(@a|$_)xnshhift(a|$_)xnshhift(a|$_)xnshhiift(a|$_ +)xnshh ;for(1..3){pri%;for(1.3){pri%;ffor1.3){pri%;ffor1.3){pri%;ffor11.3){pr +i%;fff nt(shift(@c));!nt(shft(@c));!ntt(hft(@c));!ntt(hft(@c));!ntt(hftt(@c)) +;!nttt }for(@f){my($sY}for@f){my($sY}for@f){my($sY}for@f){my($sY}for@f){mmy($ +sY}foo );split//;$_=sz);splt//;$_=sz);splt//;$_=sz);splt//;$_=sz);splt//;$_== +sz);ss hift(@c);$_=~sQhift(c);$_=~sQhift(c);$_=~sQhift(c);$_=~sQhift(c);$_=~s +QQhiff /(.{15}).*/\1/x/(.{15})*/\1/x/(.{15})*/\1/x/(.{15})*/\1/x/(.{15}})*\1/ +xx/(.. ;@w=split//;fo%;@w=split/;fo%;@w=split/;fo%;@w=split/;fo%;@w=spllit;fo +%%;@ww r(@_){$w[$s+15!r(@_){$w[$s15!r(@_){$w[$s15!r(@_){$w[$s15!!(@_){$$w[s15 +!!!(@@ -$_]=(($w[$s]eY-$_]=(($w[$s]YY-_]=(($w[$s]YY-_]=(($w[$s]YY-_]=((($[$s] +]YY-__ q"|")?".":$w[$zq"|")?".":$w[$zq|")?"."::$[$zq|")??."::$[[$z|")???.::$$ +[[$z|| s]);$s++;}for(Qs]);$s++;}for(Qs];$s++;}}or(Qs];$$s+;}}orr(Qs]$$s++;}}o +rr(Qss 1..75){unless(x1..75){unless(x1.75){unnlss(x1.775){uulsss(x1.75){uuuls +ss(x11 $w[$_]ne''){$w%$w[$_]ne''){$w%$w$_]nee''{$w%$$w$_]nn''{{$w%$$w_]nnn''{ +{$w%$$ [$_]=$w[($_-1)![$_]=$w[($_-1)![$_=$w[[($_-)![$_==w[[($$_-)![$__w[[[($$ +_-)![[ ];}}print(joinY];}}print(joinY];}prinnt(joinY;}prinntt(joinY;}pinnntt( +joinYY ""|@w);print"\z""|@w);print"\z""|w);;print"\z"|w);;pprint"\z"|w;;pppri +nt"\zz n";}print@a;,;#n";}print@a;.;#n";priint@a;.;#n;priintt@a;.;#n;piinntt@ +a;.;## y!|zY\!%x!,Q!;#y!|zY\!%x!.Q!;#y!zY\!!%x!.Q!;#!zY\!!%x!!.Q!;#!z\!!!%x!! +.Q!;## s{Q.*\n}[]g;#<>s{Q.*\n}[]g;#<>sQ.*\nn}[]g;#>sQ.*\nn}[]]g;#>sQ.\nnn}[]] +g;#>ss eval;#EndFini!$eval;#EndFini!$eal;#EEndFin!$eal;;##nddFin!$ea;;###nddF +in!$ee __DATA__ 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000110000000110000000000000000011100000000000000000 000000000001110000001110000000000000000111110000000000000000 000000000011110000011110000000000000001111111000000000000000 000000000011110000011110000000000000001111110000000000000000 000000000011110000011110000000000000001111100000000000000000 000001111111111111111111111110000000001111100000000000000000 000011111111111111111111111100000000000111100000000000000000 000111111111111111111111111000000000000111100000000000000000 000000000011110000011110000000000000000111100000000000000000 000000000011110000011110000000000000000111100000000000000000 000000000011110000011110000000000000000111100000000000000000 000000000011110000011110000000000000000011100000000000000000 000001111111111111111111111110000000000011100000000000000000 000011111111111111111111111100000000000011100000000000000000 000111111111111111111111111000000000000001100000000000000000 000000000011110000011110000000000000000001100000000000000000 000000000011110000011110000000000000000001100000000000000000 000000000011110000011110000000000000000000000000000000000000 000000000011100000011100000000000000000000000000000000000000 000000000011000000011000000000000000000011110000000000000000 000000000000000000000000000000000000000111111000000000000000 000000000000000000000000000000000000000111110000000000000000 000000000000000000000000000000000000000011110000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000

    This original idea of creating a Perl obfu stereogram produced rave reviews when posted.

    The code is certainly mind-bogglingly clever and elaborate. Unfortunately, I've never been able to relax my eyes enough to see these stereogram thingos, so the (stunning if you can see it) visual effect of this obfu was lost on me.

    Though obviously a brilliant coder, Toodles only posted four times and disappeared from PM shortly after stunning us with his original obfu.

    No 6: Saturn by eyepopslikeamosquito Oct 10 2004 rep:300+

    Note that this obfu is formatted with pre tags so that the PerlMonks default line-breaking of code at 70 characters does not spoil the visual presentation.

    #!/usr/bin/perl
                                                                               ;;;;;;
                                                                           ;;;;;;;;;;;
                                                                       ;;;;;;;;;;;;;;;
                                                                    ;;;;;;;;;;;;;;;;;
                                                                 ;;;;;;;;;;;;;;;;;;;
                                                               ;;;;;;;;;;;;;;;;;;;;
                                                             ;;;;;;;;;;;;;;;;;;;;;
                                         +$I=sub{+s+^+     ;;;;;;;      ;;;;;;;;;
                                      $"x$_[1]+gem;$/x$_#   ;;;;        ;;;;;;;;
                                   [0].$_.$/};$W=sub{$~=!q~            ;;;;;;;
                                ~.pop();system($^O=~Win?ClS:#         ;;;;;;;
                              'clear'),print,select$Z,$Z,$Z,!"       ;;;;;;
                             "||$~for@_};$H=sub{+join$/,map($_#     ;;;;;;
                            x$_[0],pop=~m-.+-g),!_};$_=!Mima,s--   ;;;;;
                           "@{['=9+)w'^RINGS]}\%;local@{[Saturn^# ;;;;;
                          wNXIBP]}"-see;s-^#!..+?$/(?=$"+;)--is  ;;;;
                         y-;-'-;s-\w-~-gi;$S=$_;#--Beautiful]  ;;;;
                         @S=m-.+-g;$N=1+.6-!th_,$--=-82-$---  ;;;
                        $_.=$"x-(y---c-$-)for@S;$R=sub{$i#  ;;;  -d
                        =0;join$/,map{$j=$%;join!_,grep#  ;;;  Rhea
                        !($j++%$_[$%]),m-.-g}grep!($i#  ;;;  -Titan
                        ++%$_[0]),@S};$L=join!_,map#  ;;;  -Huygens
                        ~~reverse.$/,@S;@R=(&$I(q-  ;;;  -&&20,051,
                        $_=_^q-q-),&$I(20,41-!q-  ;;;  -,$_=F|K),$
                        I->(15,31,$_=&$R(4-!q-  ;;;  -)),&$I(13-!"
                      ;;",28,$_=&$R(3)),&${  ;;;  _^_^I}(10,20-!"
                    ;;;;;",$_=$R->(2)),q-  ;;;  -&&$S);@O=map&{"
                  ;;;;;;  "&&$H}($_,&${  ;;;  R.!-_}($_))x$_,!"
                 ;;;;;     "+2..2*~~2  ;;;  @Y=reverse@R#Dione
               ;;;;;;       &${m--  ;;;  S|A|T|U}(@R,$N)||!q-
             ;;;;;;;          b-  ;;;  &$W(@O[0,1,2,1,0!=!q-
            ;;;;;;;            ;;;;  -],!1!~~1);&$W($S.!q-
          ;;;;;;;;;        ;;;;;  -,$L,0.16)for$%..5+!q-
         ;;;;;;;;;;    ;;;;;;;;;    Cassini-;&{$W||q-
        ;;;;;;;;;;;;;;;;;;;;;;         -}(@Y,1.6)
       ;;;;;;;;;;;;;;;;;;;;
      ;;;;;;;;;;;;;;;;;;
     ;;;;;;;;;;;;;;;;
    ;;;;;;;;;;;;;;
    ;;;;;;;;;;;
      ;;;;;;
    

    Ahem. This is mine. I am a space nut and had just finished watching Contact. I was deeply moved by the opening sequence of that movie, starting from the Earth, moving past Mars, Jupiter, Saturn, ..., the Milky Way, the Local Group, until the vast scale of the Universe and its billions of galaxies is slowly revealed.

    The other primary influence was Erudil's famous camel code, which splits a camel into four camels. I naturally tried to top that, splitting Saturn into four, then nine, then sixteen Saturns, adding a back and forth tilting effect for good measure.

    Luckily, I was also playing a lot of golf at the time, which was needed to compress the desired code into the Saturn shape. Once I had done that, I set about tweaking the code to match the Saturnian theme. For example:

    $_=!Mima,s-- '=9+)w'^RINGS Saturn^wNXIBP S|A|T|U}(@R,$N)

    I derived the Saturn shape from this beautiful Voyager space probe photograph.

    No 5: spiraling quine by Len Jun 20 2002 rep:300+

    Unix version:

    #!/usr/bin/perl $_=' $q ="\ 47"; wh ile ($ ;= $z += .5 ){ %c= $r=0;$/ ="";whi le(2 0+ $z>($;+=.05)){$c{int$ _+ 2 6+ 2*($ r+= .0 2) * s in$ ;}{1 -$_ +1 0+ int $r*c o s $ ;} =1for(0. .1) }$ t =r ever se;$ /. =` c le ar `. " #! / usr /bi n/ pe rl \n\ $_ =$q \n" ; fo r$y (1..20){$c{$_} { $ y }? $ /.=chop$t : ($/ . =" \4 0") for(0. .53) ; $/. ="\n"}pri nt"$/$ q; s; ". chr(9 2)."s;;g;eval\n "} ';s;\s;;g;eval

    Windows version:

    #!/usr/bin/perl $_=' $q= "\4 7" ;wh ile($;=$z+=.5 ){ %c =$r =0;$/="";while( 21+$ z> ( $; +=.05)) {$c{i nt $ _+ 26 +2*( $r+=. 0 1 9 )*s in $; }{1 - $_ +10+int$r*c os$; }=1 f or(0..1)}$t=re v e r s e; $/. =`cl s` ." #! /u sr /bi n/ pe rl \n\ $_=$q\n" ;f or $y (1. .20){ $c {$ _ } { $y }? $ /.= chop$ t:( $/ . ="\4 0")for( 0..53 ); $ /.=" \n"}system("cls ") ;p ri nt "$/$q;s ;". c h r(92) ."s; ; g; eva l\n" } ';s;\s;;g;eval

    A beautifully formatted obfu producing a dazzling visual effect when run. Well done Len.

    No 4: find-a-func by Erudil Aug 29 2001 rep:300+

    #!/usr/bin/perl -w # find-a-func use strict; $_='$;="per l";map{map {s}^\s+}} ;$_{$_}++unless(/[^a- z]/)}split(/ [\s,]+/)i f(/alpha. *$;/i../w ait/)}`$; doc\040$; toc`;;;@[=k eys%_;$; =20;$:=15;;for(0..($;*$:-1 )){$;[$_]="_" ;}until($%++>3*$;||@]>2*$:-3){@_=split(//,splice(@[,rand( @[),1));if(3>@_){next;}$~=int(rand($;));$^=int(rand($:)); $-=$~+$^*$;;my$Erudil=0;{if($Erudil++>2*$:){next;}$a=(-1, 0,1)[rand(3)];$b=(-1,0,1)[rand(3)];unless(($a||$b)&&$~ +$a*@_<=$;&&$~+$a*@_>=0&&$^+$b*@_<=$:&&$^+$b*@_>=0){re do;;}my$llama=0;;for(0..$#_){unless($;[$-+$a*$_+$b* $;*$_]eq$_[$_]||$;[$-+$a*$_+$b*$;*$_]eq"_"){$llam a++;last;}}if($llama){redo;}push@],join("",@_);f or(0..$#_){$;[$-+$a*$_+$b*$;*$_]=$_[$_];}}}@_ =sort@];unshift@_ ,"Find:","-"x5;for$a(0. .$:-1){for$b(0. .$;-1){$~=("a".."z") [rand(26)];$_ ="$;[$a*$;+$b]". $";s;_;$~; ;print;}$_=s hift@_|| $";;print$ ",$", $_,$ /;$_ =shi ft@_ ||$ ";pr int $"x $;, $"x $;, $", $", $_ ,$/;; ;}' ;;; s[\s+] $$g; eval; __DATA__ The use of the llama image in association with Perl is a trademark of O'Reilly & Associates, Inc. Used with permission.

    Needs "perldoc" on the path. Can be quite slow to run as it mangles the output of "perldoc perltoc", but well worth the wait. Full deconstruction provided by grinder.

    Another Erudil classic.

    No 3: How to (ab)use substr by Erudil May 03 2001 rep: 400+

    #!/usr/bin/perl -w # how to (ab)use substr use strict; my $pi='3.14159210535152623346475240375062163750446240333543375062'; substr ($^X,0)= substr ($pi,-6);map{ substr ($^X,$.++,1)=chr( substr($pi,21,2)+ substr($pi,$_,2))}(12,28,-18,-6,-10,14);map{$^O=$"x( substr ($pi,-5,2)); substr ($^O,sin(++$a/8)*32+ substr ($pi,-2)/2+1,1)=$_; substr ($^O,sin($a/4)*( substr ($pi,2,2))+ substr ($pi,-7,-5)-1,1)=$_;print"$^O$/";eval($^X.('$b,'x3). substr ($pi,-3,1).'.'. substr ($pi,9,2));}(map{chr($_+ substr ($pi,21,2))}( substr ($pi,8)x3)=~/../g);

    Yet another Erudil classic. A work of art.

    No 2: Things are not what they seem like. by Abigail Jul 13 2000 rep:400+

    $; # A lone dollar? =$"; # Pod? $; # The return of the lone dollar? {Just=>another=>Perl=>Hacker=>} # Bare block? =$/; # More pod? print%; # No right operand for %?

    Short. Elegant. Witty. A masterpiece from the inimitable Abigail.

    Deconstruction provided by btrott.

    No 1: camel code by Erudil Dec 06 2000 rep:700+

    #!/usr/bin/perl -w # camel code use strict; $_='ev al("seek\040D ATA,0, 0;");foreach(1..3) {<DATA>;}my @camel1hump;my$camel; my$Camel ;while( <DATA>){$_=sprintf("%-6 9s",$_);my@dromedary 1=split(//);if(defined($ _=<DATA>)){@camel1hum p=split(//);}while(@dromeda ry1){my$camel1hump=0 ;my$CAMEL=3;if(defined($_=shif t(@dromedary1 ))&&/\S/){$camel1hump+=1<<$CAMEL;} $CAMEL--;if(d efined($_=shift(@dromedary1))&&/\S/){ $camel1hump+=1 <<$CAMEL;}$CAMEL--;if(defined($_=shift( @camel1hump))&&/\S/){$camel1hump+=1<<$CAMEL;}$CAMEL--;if( defined($_=shift(@camel1hump))&&/\S/){$camel1hump+=1<<$CAME L;;}$camel.=(split(//,"\040..m`{/J\047\134}L^7FX"))[$camel1h ump];}$camel.="\n";}@camel1hump=split(/\n/,$camel);foreach(@ camel1hump){chomp;$Camel=$_;y/LJF7\173\175`\047/\061\062\063\ 064\065\066\067\070/;y/12345678/JL7F\175\173\047`/;$_=reverse; print"$_\040$Camel\n";}foreach(@camel1hump){chomp;$Camel=$_;y /LJF7\173\175`\047/12345678/;y/12345678/JL7F\175\173\0 47`/; $_=reverse;print"\040$_$Camel\n";}';;s/\s*//g;;eval; eval ("seek\040DATA,0,0;");undef$/;$_=<DATA>;s/\s*//g;( );;s ;^.*_;;;map{eval"print\"$_\"";}/.{4}/g; __DATA__ \124 \1 50\145\040\165\163\145\040\157\1 46\040\1 41\0 40\143\141 \155\145\1 54\040\1 51\155\ 141 \147\145\0 40\151\156 \040\141 \163\16 3\ 157\143\ 151\141\16 4\151\1 57\156 \040\167 \151\164\1 50\040\ 120\1 45\162\ 154\040\15 1\163\ 040\14 1\040\1 64\162\1 41\144 \145\ 155\14 1\162\ 153\04 0\157 \146\ 040\11 7\047\ 122\1 45\15 1\154\1 54\171 \040 \046\ 012\101\16 3\16 3\15 7\143\15 1\14 1\16 4\145\163 \054 \040 \111\156\14 3\056 \040\ 125\163\145\14 4\040\ 167\1 51\164\1 50\0 40\160\ 145\162 \155\151 \163\163 \151\1 57\156\056

    The highest rated PM node of all time. For a long time, you could buy thinkgeek T-shirts with this obfu printed on it! They seem to be out of print now though, at least the thinkgeek link is broken. I loved Erudil's response to all the attention:

    <Elvis> Thankyew ... Thankyew verra much! </Elvis>

    References

    Updated Dec 18 2014: Added obfu 8.5 which I had missed in my original post (thanks tye).

The First Ten Perl Obfus
No replies — Read more | Post response
by eyepopslikeamosquito
on Dec 14, 2014 at 03:14

    Following on from The First Ten Perl Monks, I thought it would be fun to explore the origins of PerlMonks Obfuscated code.

    What was the first PerlMonks Obfuscated code?

    As far as I can tell, it was written on Oct 13 1999 by the early PM developers at the very end of this ancient command line examples faq. Of course, this was well before the PerlMonks official opening on 23 Dec 1999. So, if we disqualify this pre-historic (accidental) obfuscation, the first deliberately obfuscated PerlMonks node was probably OBFUSCATE!!! by the thirteenth Perl Monk jdube on Dec 30 1999 at 04:51.

    PerlMonks Obfuscation Founding Father: jdube

    As was typical of early Perl Monks, jdube also had an everything2 account. Curiously, jdube further authored a companion POETRY!!! node, presumably a crude attempt to pressure vroom into creating PerlMonks Obfuscated code and Perl Poetry sections. Well, by using all caps and three exclamation marks in the node titles he was certainly shouting at vroom.

    Anyway, it seems jdube's clever ploy worked because vroom did indeed create our much loved Obfuscated code and Perl Poetry sections later that same fateful day, Dec 30 1999. By the way, I was shocked to see that the historic Poetry and Obfuscated Sections by vroom has received just one up-vote (mine). If you feel this historic node is worth more than that, you know what you need to do.

    An interesting piece of trivia is that jdube's medieval OBFUSCATE!!!/POETRY!!! barrage took place in the (now obsolete) perlcraft arena. It seems this ancient "perlcraft" section has since been re-branded as Cool Uses For Perl.

    Tragically, our PerlMonks poetry and obfu founding father jdube does not appear in the first ten official Obfuscated nodes, listed below. Sadly, he never did write an official PerlMonks obfuscated node. Sadder still, Perl Monk number 13 jdube was last seen wandering around the monastery in May 2000, and his account now sits abandoned and disabled. Perhaps being the thirteenth user proved unlucky. I wonder what jdube is doing nowadays. Will he return one day to write us another obfu or poem?

    Obu No 1: #!/usr/bin/perl by BBQ (last here Apr 07 2009)

    Created: Dec 30 1999, Rep: 14, 3 replies.

    %A=('r'=>"\n","\t"=>'#','/'=> 's','f'=>'p',"b"=>'n');@C=qw (e ! r/ / e );foreach $k (sort keys %A){ @B=(" ",'u','i',"\b",'l');$s .=qq{$k$B[$x++]$A{$k}$C[$x] \b};if ($x==1){$t=$k.$B[$x-1].$A{$k};}#ops } print$A{r}.$s;#i h8 left over \s's

    The first official PerlMonks obfu was concocted in Brazil by Perl Monk number eleven BBQ, who has the further distinction of being the first foreign Perl Monk. In addition to being the first foreign monk, BBQ is the first non-insider Perl Monk without a companion everything2 account.

    This historic obfu, which still works with modern perls, displays its node title #!/usr/bin/perl on the screen when run. It is a bit trickier than that though, in fact it writes the following 33 characters to stdout:

    CR LF TAB SPACE #! SPACE BACKSPACE /usr/ SPACE BACKSPACE bin/ SPACE BA +CKSPACE f BACKSPACE pe SPACE BACKSPACE rl CR LF SPACE BACKSPACE

    Though not in Erudil's class, that was a decent first attempt from BBQ. And he was well aware of its historical significance commenting:

    I'm actually kinda proud I made it 1st into the obfuscated code bin. :o)
    after vroom manually adjusted the node ownership to its rightful owner.

    Obu No 2: WWWWolf's .signature by WWWWolf (last here Apr 11 2002)

    Created: Jan 06 2000, Rep: 6, 0 replies.

    $_='%?&%[=&+=?%=[%&+&%[*?]&=&~[;&+&{=?[?&%&[&{[%&^=?=[&%&]=?%~&~[?&+&~ +YiFF! =[=~| Weyfour WWWWolf (aka. Urpo Lankinen), a lupine technomancer |=?* +_=}?] %}&};| ICQ:4291042 | wwwwolf@iki.fi | http://www.iki.fi/wwwwolf/ |&;&= +~?]'; tr/?~=*;%&[{}]+_^ (),.:@\/\n0-9!|a-zA-Z/0-9acde/d; $_=pack("H*",$_); p +rint;

    The second PM obfu is also from outside the USA, this time from Oulu, Finland. This one is not especially obfuscated, just the .signature file of WWWWolf (Weyfour WWWWolf's Web of Weird Things).

    Yet again, we see a companion WWWWolf everything2 account. Though he hasn't visited PM since 2002, the artistic WWWWolf appears to be still active, focusing on Drupal, writing, and photography nowadays. So we may yet see a surprise return visit.

    Obu No 3: ArrayHashMonster.pm by Anonymous Monk

    Created: Feb 03 2000, Rep: 2, 0 replies.

    $monster = new ArrayHashMonster ... ; print $monster->[1]; # This might print `Janvier' print $monster->{Jan}; # This can *also* print `Janvier'

    This seems to be just an advertisement for Dominus's ArrayHashMonster CPAN module.

    Obu No 4: Yearbook fun by Xavier (last here Jun 30 2000)

    Created: Feb 04 2000, Rep: 9, 6 replies.

    $a="User-Agent:PlMk";$u=" xavier.penguinpowered.com ";$h="GET / HTTP/1.\n";$u =~s/\n//gs;$d=`echo "$h$a "|nc $u 80`;$d=~s/.+?ml\r (.+)/$1/s;$d=~s/\n+|\s+ \ / /gsx;$d=~s/<a.+?f="(.*? )">(.+?)<\/a>/$2($1)/sgx; $d=~s/<(br|p|li)>/\n/g;$d =~s/<.+?>//gsx;print"$d";

    Not especially obfuscated, just something to put in his high school yearbook, with limited space available. Yet again, we see a companion everything2 account.

    Obu No 5: Tricks with tr/// by japhy (last here Oct 08 2014)

    Created: Feb 09 2000, Rep: 18, 6 replies.

    # to squish a string y sssscccc; y cccscsss; y yyysc; # to get the string length y yyyc; # to clear a string y ccccdddd; y dddcdccc; y yyycd;

    Jeff "japhy" Pinyan is by far the highest rated Perl Monk among the first ten pioneer obfuscators. He was also a Perl Mongers pioneer, joining the first Perl Mongers user group, in New York City in the late 1990s.

    His first (whimsical) obfu above plays around with Perl's tr (aka y) modifiers. These modifiers, and their companion m// and s// modifiers, are a lot of fun and very popular with obfuscators. For example, I remember a playful merlyn japh:

    $Old_MacDonald = q#print #; $had_a_farm = (q-q:Just another Perl hacke +r,:-); s/^/q[Sing it, boys and girls...],$Old_MacDonald.$had_a_farm/eieio;

    and a $A++ obfu from mtve:

    y ccccd x s vvchr oct oct ord uc ave x s vvucve le s vvuc ave x s vvchr oct oct oct ord uc bve x eval

    This sort of syntactic flexibility is why Perl is, and seems likely to remain for the foreseeable future, the premier language for writing elegant and amusing obfuscated code.

    Obu No 6: Use the arrow keys by Foochre (last here Jun 29 2001)

    Created: Feb 15 2000, Rep: 10, 2 replies.

    #!/usr/bin/perl use Curses;keypad initscr;nodelay 1;box qw{| -};($l,$d,$k,@f)=(1..3,[1 +0,10]);& n;while(){refresh;@f=([$f[0][0]+$d%2-($d==1)*2,$f[0][1]+$d%2-1+($d==2) +*2],@f); select$f,$f,$f,.06;($c=getch)+1and$d=4-($c%2?2:0)-($c<260);addch@{pop@ +f},' 'if @f>$l;$l+=$_=inch@{$f[0]};if(!/ /){/\d/||die;addstr 0, 60,$l;&n}addch@ +{$f[0]}, 'O'}sub n{while(){@v=(rand 24,rand 80);inch(@v)eq' '&&last}addch@v,''. +rand 10}

    Was this the first obfu to attempt fancy "visual effects"? Displaying mind-blowing visual effects became wildly popular with obfuscators that followed, for example:

    Obu No 7: My 2 cents worth by Erudil (last here Sep 18 2008)

    Created: Mar 02 2000, Rep: 216, 13 replies.

    #!/usr/bin/perl -w # my 2 cents worth use strict; $_='$_=tue($=+(two ($;)>>(two($;)>>2+2))){tue (too(two(tue($=+(two($;)>>(two ($;)>>2+2))))+(two($;)>>2+2))){tue (too(two(tue($=+(two($;)>>(two($;)>>2+ 2))))+(two($;)>>2+2))-2){tue(too(two(tue ($=+(two($;)>>(two($;)>>2+2)))))){tue(too( too(two($;)>>(two($;) >>2+2)))){tue(too($=+ +(two($;)>>2+2))){tue ((two($;)<<2)-2){tue ((two($;)<<2)-(two($; )>>2+2)){tue(too(two( tue($=+(two($;)>>(two ($;)>>2+2)))))){{tue (too($=+(two($;)>>2)+ (two($;)>>2+2))){{tue (too($=+(two($;)>>2)- 2)){{{tue(too($=+(two ($;)>>(two($;)>>2+2)) -2)){tue(too(too(two( $;)>>(two($;)>>2+2))) ){tue(too(too(too(too (two($;)>>(two($;)>>2 +2)))))){{tue(too($=+ (two($;)>>2)-2))}tue( too($=+(two($;)>>(two ($;)>>2+2))-2)){tue(( two($;)<<2)-((two($;) >>2>>2)<<2))}tue(too( too(two($;)>>(two($;) >>2+2))))}}tue(too($= +(two($;)>>2)+(two($;)>>2+2)))}}tue(too($=+( two($;)>>2+2)))}}tue(too((two($;)<<(two($;)>> 2>>2))+(two($;)>>2)))}}}tue((two($;)<<2)-((two ($;)>>2>>2)<<2)-(two($;)>>2>>2))}}}tue(too($=+( two($;)>>2)-2))}}}tue(too($=+(two($;)>>(two($;) >>2+2))-2))}}}tue(too(too(two($;)>>(two($;)>>2+ 2)))+(two($;)>>(two($;)>>2+2))-2);';y;{};..;sd; s;two;ord;g;s;too;hex;g;s;tue;chr;g;eval;print;

    Wow! Erudil wrote only 13 nodes, all with 100+ rep, and including the highest rated PM node of all time! Given the above masterwork was his "first attempt", I trust you can see why he is a PerlMonks legend, still revered and fondly remembered today.

    This node has the further distinction of being the first ever "block-buster obfu", given its 200+ reputation. Erudil elevated Perl obfu to a true art form.

    Obu No 8: Smile! by Anonymous Monk

    Created: Mar 04 2000, Rep: 9, 1 replies.

    # smiley - ($R=q#for (split/&/ =>q;4a&75@^ 73&74@20^41 &@6e@@6f^&@74 ^68&&65@72&20 &^50@65&@72 ^@6c&@20^48 @@61&@63& 6b@65&72;) {print &@pack ^c@&=> hex$_} ;print "\n"#) =~s,[&^@\s]+, ,g;eval$R

    Obu No 9: recursive self modifying eval japh by Anonymous Monk

    Created: Mar 13 2000, Rep: 6, 3 replies.

    $_='",",/[J|]$/?m)^.J)?(m~"(.+?)"~):s](^(.)(.*\)\?p.*)|(\)\?)(.' .'*))\|(.)]$4$2$6$3$5|]<<eval:s<([\w -%])(?=[^|]*$)><pack+q*c*,' .'(ord$1)-++$i%3>eg!~eval#@|xslvuuipfem#pwht%uimwssd$yvyO'=>eval

    Obu No 10: Tribute to Larry by whitton (last here Apr 07 2000)

    Created: Mar 28 2000, Rep: 9, 0 replies.

    #!/usr/bin/perl -- what is larry wall? @_=qw(l a r r y w a l l);for(0..1){$_[$_] =~ y#a-z#e-w#;} $_[3]=$_[$#_].' ';$_[4]=~s$y$h$;($_[5],$_[6])=($_[6],$_[5]); ++$_[6];$_[7]=chr 3+ord $_[7];$_[8]=~y~a-z~g-t~;print @_,".\n"

    Where are they now?

    Sadly, most of the obfu pioneers listed above have not been sighted for five years or more, the only exception being japhy ... though he only drops in occasionally nowadays.

    References

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (9)
As of 2014-12-21 01:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (100 votes), past polls