http://qs1969.pair.com?node_id=632427

ghenry has asked for the wisdom of the Perl Monks concerning the following question:

Dear All,

I've just downloaded the first version of Trixbox Pro and found in the Fonality folder a script called activate.pl

What are they trying to achieve here that Perl::Tidy can't make sense of? I'm really confused as to why they bothered.

#!/usr/bin/perl #@%^&*!eval(' use strict;use LWP::UserAgent;use File::Copy;use Sys::Hostname;use Ter +m::ReadKey;use Term::ReadLine;use File::Path;use Data::Dumper;use Net +::Ping;use Term::ANSIColor qw(:constants);$Term::ANSIColor::AUTORESET +=1;our $ipnum=qr{([01]?\d\d?|2[0-4]\d|25[0-5])};our $ip_rx=qr{^$ipnum +\.$ipnum\.$ipnum\.$ipnum$};our $if_file='/etc/sysconfig/network-scrip +ts/ifcfg-eth0';our $network_file='/etc/sysconfig/network';our $resolv +_file='/etc/resolv.conf';our $server_url='http://activate.trixbox.com +/activatetb.cgi?';our $test_url='http://activate.trixbox.com/gd_test. +htm?';our $code_url='http://activate.trixbox.com/activate_code.cgi?'; +chomp(my $GVqquVhiAz=`asterisk -V`);$server_url.="ast_ver=$GVqquVhiAz +&";$|++;my($PVOVqKqKJM)=new Term::ReadLine 'Fonality Activation';my($ +EmHDINcXZa)=hostname();my($dUmAMyhvCd)=0;our $tag;OCZveFAbjX();sub OC +ZveFAbjX{ZYaqMtxfrv();system('clear');VArFVNWbam();print GREEN "+---- +--------------------+\n";print GREEN "| ";print BLACK ON_GREEN "trixb +ox Pro Activation";print GREEN " |\n";print GREEN "+----------------- +-------+\n\n";print CYAN BLINK "--> ";print CYAN "You may press 'r' a +t any time to restart activation";print CYAN BLINK " <--\n";$tag=jnZb +UZJApp();KqLlpipjyn(1);lIDBRbqpeC();OzekKOuyhw();}sub sKOyYGxskF{my($ +xKTKQMfbVD,$KgxZXqQGIF,$XbSfEMBcUk,$cTPCMqMfcH)=@_;my $VXeTfFIUiV;if( +length($XbSfEMBcUk)){$KgxZXqQGIF.=" [$XbSfEMBcUk]";if($cTPCMqMfcH){$K +gxZXqQGIF.=" " x($cTPCMqMfcH-length($XbSfEMBcUk));}}{$VXeTfFIUiV=_get +_info_from_terminal($PVOVqKqKJM,$KgxZXqQGIF);chomp $VXeTfFIUiV;goto&O +CZveFAbjX if $VXeTfFIUiV=~/^r$/i;$VXeTfFIUiV=$XbSfEMBcUk,last if(!$VX +eTfFIUiV)&&(length($XbSfEMBcUk)>0);last if $VXeTfFIUiV=~/$xKTKQMfbVD/ +;redo;}return $VXeTfFIUiV;}sub TJQwGbWFKi{my $AlUiwojqTa=shift;my %td +MiGAqRFq=();open my $IcDxuREUNE,"<$AlUiwojqTa" or die $!;for my $XmjV +zWmCmz(grep{$_!~/^\s*#/}<$IcDxuREUNE>){my($k,$v)=split /=|\s+/,$XmjVz +WmCmz;$tdMiGAqRFq{$k}=$v unless $tdMiGAqRFq{$k};}close $IcDxuREUNE;re +turn\%tdMiGAqRFq;}sub FcbTHfkFxM{my($AlUiwojqTa,$tdMiGAqRFq,$oAYUkbbN +Om)=@_;$oAYUkbbNOm||='=';my $lmzUStCpcK;$lmzUStCpcK.="$_$oAYUkbbNOm$$ +tdMiGAqRFq{$_}\n" for keys %$tdMiGAqRFq;open my $IcDxuREUNE,">$AlUiwo +jqTa" or die $!;print $IcDxuREUNE $lmzUStCpcK;close $IcDxuREUNE;}sub +gSYwwUupkM{my $nxbNvJzwFY=qx{/sbin/ifconfig};my $elaMRBWDUG=qr{[\d.]+ +\s};my($dqGjPvcxQR,$PJeFpfLhEr)=$nxbNvJzwFY=~/eth0.+?inet addr:($elaM +RBWDUG).+?Mask:($elaMRBWDUG)/s; return $dqGjPvcxQR, $PJeFpfLhEr; } sub network_restart { print "\n>>> Reconfiguring your network settings...\n\n"; syst +em '/etc/init.d/network restart >>/dev/null 2>>/dev/null';my $msJKpWU +mpl=TJQwGbWFKi $network_file;my $vXFXCrQFnU=TJQwGbWFKi $if_file;my $S +bomKOcnKw=TJQwGbWFKi $resolv_file;($$vXFXCrQFnU{IPADDR},$$vXFXCrQFnU{ +NETMASK})=gSYwwUupkM if $$vXFXCrQFnU{BOOTPROTO}eq 'dhcp';$$vXFXCrQFnU +{IPADDR}=~s/\s*$//;$$msJKpWUmpl{GATEWAY}||=arozmtfBtA();print "\nYour + new IP configuration is:\n";UVjDfyLFLX($vXFXCrQFnU,$SbomKOcnKw,$msJK +pWUmpl);}sub UVjDfyLFLX{my($sfJyxerKYI,$UpWrjVymzj,$TbrsIxlJJJ)=@_;ch +omp($$sfJyxerKYI{NETMASK});print qq{ IP address : $$sfJyxerKYI{IPADDR} Subnet mask : $$sfJyxerKYI{NETMASK} Default gateway : $$TbrsIxlJJJ{GATEWAY} DNS server : $$UpWrjVymzj{nameserver} Mode : $$sfJyxerKYI{BOOTPROTO} }}sub XOYkQtvqAN{my $mMlzdjKpAg=shift;my $p=Net::Ping->new();m +y $eBkWXnmVJM=$p->ping($mMlzdjKpAg,1)?1:0;$p->close;print "\nERROR: T +he installer has detected a conflict for IP address $mMlzdjKpAg\n" if + $eBkWXnmVJM;return $eBkWXnmVJM;}sub arozmtfBtA{my($rRTzLjmLtN)=grep{ +/^0\.0\.0\.0\s/}`/sbin/route -n`;my @WXqMFsGkCQ=split(/\s+/,$rRTzLjmL +tN);return $WXqMFsGkCQ[1];}sub lIDBRbqpeC{my $oaDEGDOCYR=1;my $msJKpW +Umpl=TJQwGbWFKi $network_file;my $vXFXCrQFnU=TJQwGbWFKi $if_file;my $ +SbomKOcnKw=TJQwGbWFKi $resolv_file;($$vXFXCrQFnU{IPADDR},$$vXFXCrQFnU +{NETMASK})=gSYwwUupkM if $$vXFXCrQFnU{BOOTPROTO}eq 'dhcp';$$vXFXCrQFn +U{IPADDR}=~s/\s*$//;$$msJKpWUmpl{GATEWAY}||=arozmtfBtA();print "\nYou +r current IP configuration is:\n";UVjDfyLFLX $vXFXCrQFnU,$SbomKOcnKw, +$msJKpWUmpl;my $VXeTfFIUiV;print "\nSelect your desired IP configurat +ion below:\n\n";print "1. DHCP\n";print "2. Static IP\n";print "3. Ke +ep my current configuration\n";print "r. Restart activation\n";$VXeTf +FIUiV=sKOyYGxskF qr/^(?:1|2|3)$/,"\nSelect option [1,2,3,r]";return i +f $VXeTfFIUiV==3;if($VXeTfFIUiV==1){$$vXFXCrQFnU{BOOTPROTO}='dhcp';}e +lse{my $YVWMjzTYNT=$$vXFXCrQFnU{IPADDR};$$vXFXCrQFnU{BOOTPROTO}='stat +ic';{$vXFXCrQFnU->{IPADDR}=sKOyYGxskF $ip_rx,"Enter IP address ",$vX +FXCrQFnU->{IPADDR},15;if($YVWMjzTYNT ne $vXFXCrQFnU->{IPADDR}){redo i +f XOYkQtvqAN($vXFXCrQFnU->{IPADDR});}}$$vXFXCrQFnU{NETMASK}=sKOyYGxsk +F $ip_rx,"Enter Subnet mask ",$$vXFXCrQFnU{NETMASK},15;$$msJKpWUmpl{G +ATEWAY}=sKOyYGxskF $ip_rx,"Enter Gateway ",$$msJKpWUmpl{GATEWAY}, +15;$$SbomKOcnKw{nameserver}=sKOyYGxskF $ip_rx,"Enter DNS server ",$$ +SbomKOcnKw{nameserver},15;}FcbTHfkFxM $if_file,$vXFXCrQFnU;FcbTHfkFxM + $network_file,$msJKpWUmpl;FcbTHfkFxM $resolv_file,$SbomKOcnKw,' ';ne +twork_restart if $oaDEGDOCYR;KqLlpipjyn();}sub rOknjWmhGj{my $uApaYxE +tCg=shift;my $tYyzaroUCI=join '',('.','/',0..9,'A'..'Z','a'..'z')[ran +d 64,rand 64];return crypt $uApaYxEtCg,$tYyzaroUCI;}sub OzekKOuyhw{pr +int "\nIf you do not have a trixbox Pro username and password, please +\n";print "visit http://www.trixbox.com to obtain an account for FREE +!\n";my $UQPxfutQHG=sKOyYGxskF(qw/^\w+$/,"\nEnter your trixbox Pro us +ername");print "Enter your trixbox Pro password: ";my $JEIeAkJmLx=DMd +pTcCgXX();print "\n";wTywFVxbkC($server_url."username=$UQPxfutQHG&pas +sword=$JEIeAkJmLx");}sub DMdpTcCgXX{ReadMode(3);my $JEIeAkJmLx='';whi +le(1){my $sOvLKRSEaI=eKmBXncRAW();if($sOvLKRSEaI==10){last;}if($sOvLK +RSEaI==127){if(length($JEIeAkJmLx)){chop($JEIeAkJmLx);print chr(8),' +',chr(8);}next;}if($sOvLKRSEaI==27){bstLbHKYNu();$sOvLKRSEaI="\0";}if +($sOvLKRSEaI!="\0"){$JEIeAkJmLx.=chr($sOvLKRSEaI);print '*';}}ReadMod +e(0);return $JEIeAkJmLx;}sub eKmBXncRAW{my $SJRrKNgJkm;if(defined($SJ +RrKNgJkm=ReadKey(0))){}return ord($SJRrKNgJkm);}sub bstLbHKYNu{while( +1){my $SJRrKNgJkm;if(defined($SJRrKNgJkm=ReadKey(-1))){}else{return;} +}return;}sub wTywFVxbkC{my $BQMWjcomfS=shift;my $mZTeCbfneK=shift||"A +ctivating";print "\n";printf "%-59s",">>> $mZTeCbfneK your system now + (may take several minutes)...";my $TrTJQltZLH='/var/adm/bin/setup.pl +';my $fMWWwAVxMf=new LWP::UserAgent;my $XWDoBfXXZZ=$fMWWwAVxMf->get($ +BQMWjcomfS);my $KgxZXqQGIF;if($XWDoBfXXZZ->is_success){my($uqcUwvgUky +,$jhYLzWckFm)=$XWDoBfXXZZ->content=~m{^(.*?)(#!/usr/bin/perl.+)$}s; ($KgxZXqQGIF) = $uqcUwvgUky =~ m!>>>(.+?)<<<!s; if ($jhYLzWckFm) { print "[ " . GREEN . "OK" . WHITE . " ]\n"; +system("/bin/mkdir -p /var/adm/bin")unless-d '/var/adm/bin';open FILE +,">$TrTJQltZLH"||warn $!;print FILE $jhYLzWckFm;close FILE;if(-f $TrT +JQltZLH){system("/usr/bin/perl $TrTJQltZLH");unlink($TrTJQltZLH,'/Fon +ality/activate.pl')if $?==0;}}else{print "[".RED."FAILED".WHITE."]\n" +;print "\nERROR: ".$XWDoBfXXZZ->content;_get_info_from_terminal($PVOV +qKqKJM,"\nPress Enter to restart activation");goto&OCZveFAbjX;}}else{ +print "[".RED."FAILED".WHITE."]\n";print "\nERROR: ".$XWDoBfXXZZ->sta +tus_line."\n".$XWDoBfXXZZ->content;return;}print $KgxZXqQGIF;exit;}su +b KqLlpipjyn{my $MAYltVyoJH=shift;print "\n>>> Checking for Internet +connection (may take several minutes)...";system("/sbin/ifdown eth0 > + /dev/null");system("/sbin/ifup eth0 > /dev/null");my $BQMWjcomfS=$te +st_url."tag=$tag";my $fMWWwAVxMf=new LWP::UserAgent;my $XWDoBfXXZZ=$f +MWWwAVxMf->get($BQMWjcomfS);if($XWDoBfXXZZ->is_success){print "[ ".G +REEN."OK".WHITE." ]\n"}else{print "[".RED."FAILED".WHITE."]\n";print + "\nERROR: Unable to connect to external host. This is typically due\ +n";print " to an IP configuration or network issue.\n\n";my $VX +eTfFIUiV=sKOyYGxskF qr/^(?:1|2)$/,"1. Test your connection again\n2. +Re-configure your IP settings\n\nSelect option [1,2,r]";if($VXeTfFIUi +V==1){KqLlpipjyn()}else{lIDBRbqpeC unless $MAYltVyoJH}}}sub VArFVNWba +m{my($ajVzVgZgjk)=`/usr/bin/tty`;chomp($ajVzVgZgjk);if($ajVzVgZgjk=~/ +^\/dev\/tty[1-6]$/){$dUmAMyhvCd=1;}else{}}sub jnZbUZJApp{system("/sbi +n/ifconfig eth0 | head -1 | sed -e 's/.*HWaddr //;' | sed -e 's/://g; +' | sed -e 's/ //g;' > /etc/tag");open(TAG,'/etc/tag')||die $!;my(@pS +uUVmgycQ)=<TAG>;close(TAG);chomp(@pSuUVmgycQ);return($pSuUVmgycQ[0]); +}sub _get_info_from_terminal{my($PVOVqKqKJM)=shift(@_);my($LFBMmishAR +)=shift(@_).': ';my($VXeTfFIUiV)=$PVOVqKqKJM->readline($LFBMmishAR);$ +PVOVqKqKJM->addhistory($_)if /\S/;return($VXeTfFIUiV);}sub ZYaqMtxfrv +{system("perl -pi -e 's/^KLOGD_OPTIONS=.*/KLOGD_OPTIONS=\"-x -c 4\"/; +' /etc/sysconfig/syslog");system("/etc/init.d/syslog restart > /dev/n +ull 2>&1");}

Tidy version:

#!/usr/bin/perl #@%^&*!eval(' use strict; use LWP::UserAgent; use File::Copy; use Sys::Hostname; use Term::ReadKey; use Term::ReadLine; use File::Path; use Data::Dumper; use Net::Ping; use Term::ANSIColor qw(:constants); $Term::ANSIColor::AUTORESET = 1; our $ipnum = qr{([01]?\d\d?|2[0-4]\d|25[0-5])}; our $ip_rx = qr{^$ipnum\.$ipnum\.$ipnum\.$ipnum$}; our $if_file = '/etc/sysconfig/network-scripts/ifcfg-eth0'; our $network_file = '/etc/sysconfig/network'; our $resolv_file = '/etc/resolv.conf'; our $server_url = 'http://activate.trixbox.com/activatetb.cgi?'; our $test_url = 'http://activate.trixbox.com/gd_test.htm?'; our $code_url = 'http://activate.trixbox.com/activate_code.cgi?'; chomp( my $GVqquVhiAz = `asterisk -V` ); $server_url .= "ast_ver=$GVqquVhiAz&"; $|++; my ($PVOVqKqKJM) = new Term::ReadLine 'Fonality Activation'; my ($EmHDINcXZa) = hostname(); my ($dUmAMyhvCd) = 0; our $tag; OCZveFAbjX(); sub OCZveFAbjX { ZYaqMtxfrv(); system('clear'); VArFVNWbam(); print GREEN "+------------------------+\n"; print GREEN "| "; print BLACK ON_GREEN "trixbox Pro Activation"; print GREEN " |\n"; print GREEN "+------------------------+\n\n"; print CYAN BLINK "--> "; print CYAN "You may press 'r' at any time to restart activation"; print CYAN BLINK " <--\n"; $tag = jnZbUZJApp(); KqLlpipjyn(1); lIDBRbqpeC(); OzekKOuyhw(); } sub sKOyYGxskF { my ( $xKTKQMfbVD, $KgxZXqQGIF, $XbSfEMBcUk, $cTPCMqMfcH ) = @_; my $VXeTfFIUiV; if ( length($XbSfEMBcUk) ) { $KgxZXqQGIF .= " [$XbSfEMBcUk]"; if ($cTPCMqMfcH) { $KgxZXqQGIF .= " " x ( $cTPCMqMfcH - length($XbSfEMBcUk) ) +; } } { $VXeTfFIUiV = _get_info_from_terminal( $PVOVqKqKJM, $KgxZXqQGI +F ); chomp $VXeTfFIUiV; goto &OCZveFAbjX if $VXeTfFIUiV =~ /^r$/i; $VXeTfFIUiV = $XbSfEMBcUk, last if ( !$VXeTfFIUiV ) && ( length($XbSfEMBcUk) > 0 ); last if $VXeTfFIUiV =~ /$xKTKQMfbVD/; redo; } return $VXeTfFIUiV; } sub TJQwGbWFKi { my $AlUiwojqTa = shift; my %tdMiGAqRFq = (); open my $IcDxuREUNE, "<$AlUiwojqTa" or die $!; for my $XmjVzWmCmz ( grep { $_ !~ /^\s*#/ } <$IcDxuREUNE> ) { my ( $k, $v ) = split /=|\s+/, $XmjVzWmCmz; $tdMiGAqRFq{$k} = $v unless $tdMiGAqRFq{$k}; } close $IcDxuREUNE; return \%tdMiGAqRFq; } sub FcbTHfkFxM { my ( $AlUiwojqTa, $tdMiGAqRFq, $oAYUkbbNOm ) = @_; $oAYUkbbNOm ||= '='; my $lmzUStCpcK; $lmzUStCpcK .= "$_$oAYUkbbNOm$$tdMiGAqRFq{$_}\n" for keys %$tdMiGA +qRFq; open my $IcDxuREUNE, ">$AlUiwojqTa" or die $!; print $IcDxuREUNE $lmzUStCpcK; close $IcDxuREUNE; } sub gSYwwUupkM { my $nxbNvJzwFY = qx{/sbin/ifconfig}; my $elaMRBWDUG = qr{[\d.]+\s}; my ( $dqGjPvcxQR, $PJeFpfLhEr ) = $nxbNvJzwFY =~ /eth0.+?inet addr:($elaMRBWDUG).+?Mask:($elaMRBWD +UG)/s; return $dqGjPvcxQR, $PJeFpfLhEr; } sub network_restart { print "\n>>> Reconfiguring your network settings...\n\n"; system '/etc/init.d/network restart >>/dev/null 2>>/dev/null'; my $msJKpWUmpl = TJQwGbWFKi $network_file; my $vXFXCrQFnU = TJQwGbWFKi $if_file; my $SbomKOcnKw = TJQwGbWFKi $resolv_file; ( $$vXFXCrQFnU{IPADDR}, $$vXFXCrQFnU{NETMASK} ) = gSYwwUupkM if $$vXFXCrQFnU{BOOTPROTO} eq 'dhcp'; $$vXFXCrQFnU{IPADDR} =~ s/\s*$//; $$msJKpWUmpl{GATEWAY} ||= arozmtfBtA(); print "\nYour new IP configuration is:\n"; UVjDfyLFLX( $vXFXCrQFnU, $SbomKOcnKw, $msJKpWUmpl ); } sub UVjDfyLFLX { my ( $sfJyxerKYI, $UpWrjVymzj, $TbrsIxlJJJ ) = @_; chomp( $$sfJyxerKYI{NETMASK} ); print qq{ IP address : $$sfJyxerKYI{IPADDR} Subnet mask : $$sfJyxerKYI{NETMASK} Default gateway : $$TbrsIxlJJJ{GATEWAY} DNS server : $$UpWrjVymzj{nameserver} Mode : $$sfJyxerKYI{BOOTPROTO} }; } sub XOYkQtvqAN { my $mMlzdjKpAg = shift; my $p = Net::Ping->new(); my $eBkWXnmVJM = $p->ping( $mMlzdjKpAg, 1 ) ? 1 : 0; $p->close; print "\nERROR: The installer has detected a conflict for IP address $mMlzdj +KpAg\n" if $eBkWXnmVJM; return $eBkWXnmVJM; } sub arozmtfBtA { my ($rRTzLjmLtN) = grep { /^0\.0\.0\.0\s/ } `/sbin/route -n`; my @WXqMFsGkCQ = split( /\s+/, $rRTzLjmLtN ); return $WXqMFsGkCQ[1]; } sub lIDBRbqpeC { my $oaDEGDOCYR = 1; my $msJKpWUmpl = TJQwGbWFKi $network_file; my $vXFXCrQFnU = TJQwGbWFKi $if_file; my $SbomKOcnKw = TJQwGbWFKi $resolv_file; ( $$vXFXCrQFnU{IPADDR}, $$vXFXCrQFnU{NETMASK} ) = gSYwwUupkM if $$vXFXCrQFnU{BOOTPROTO} eq 'dhcp'; $$vXFXCrQFnU{IPADDR} =~ s/\s*$//; $$msJKpWUmpl{GATEWAY} ||= arozmtfBtA(); print "\nYour current IP configuration is:\n"; UVjDfyLFLX $vXFXCrQFnU, $SbomKOcnKw, $msJKpWUmpl; my $VXeTfFIUiV; print "\nSelect your desired IP configuration below:\n\n"; print "1. DHCP\n"; print "2. Static IP\n"; print "3. Keep my current configuration\n"; print "r. Restart activation\n"; $VXeTfFIUiV = sKOyYGxskF qr/^(?:1|2|3)$/, "\nSelect option [1,2,3, +r]"; return if $VXeTfFIUiV == 3; if ( $VXeTfFIUiV == 1 ) { $$vXFXCrQFnU{BOOTPROTO} = 'dhcp'; } else { my $YVWMjzTYNT = $$vXFXCrQFnU{IPADDR}; $$vXFXCrQFnU{BOOTPROTO} = 'static'; { $vXFXCrQFnU->{IPADDR} = sKOyYGxskF $ip_rx, "Enter IP addre +ss ", $vXFXCrQFnU->{IPADDR}, 15; if ( $YVWMjzTYNT ne $vXFXCrQFnU->{IPADDR} ) { redo if XOYkQtvqAN( $vXFXCrQFnU->{IPADDR} ); } } $$vXFXCrQFnU{NETMASK} = sKOyYGxskF $ip_rx, "Enter Subnet mask +", $$vXFXCrQFnU{NETMASK}, 15; $$msJKpWUmpl{GATEWAY} = sKOyYGxskF $ip_rx, "Enter Gateway +", $$msJKpWUmpl{GATEWAY}, 15; $$SbomKOcnKw{nameserver} = sKOyYGxskF $ip_rx, "Enter DNS serve +r ", $$SbomKOcnKw{nameserver}, 15; } FcbTHfkFxM $if_file, $vXFXCrQFnU; FcbTHfkFxM $network_file, $msJKpWUmpl; FcbTHfkFxM $resolv_file, $SbomKOcnKw, ' '; network_restart if $oaDEGDOCYR; KqLlpipjyn(); } sub rOknjWmhGj { my $uApaYxEtCg = shift; my $tYyzaroUCI = join '', ( '.', '/', 0 .. 9, 'A' .. 'Z', 'a' .. 'z' )[ rand 64, rand 64 ] +; return crypt $uApaYxEtCg, $tYyzaroUCI; } sub OzekKOuyhw { print "\nIf you do not have a trixbox Pro username and password, p +lease\n"; print "visit http://www.trixbox.com to obtain an account for FREE! +\n"; my $UQPxfutQHG = sKOyYGxskF( qw/^\w+$/, "\nEnter your trixbox Pro username" ); print "Enter your trixbox Pro password: "; my $JEIeAkJmLx = DMdpTcCgXX(); print "\n"; wTywFVxbkC( $server_url . "username=$UQPxfutQHG&password=$JEIeAkJm +Lx" ); } sub DMdpTcCgXX { ReadMode(3); my $JEIeAkJmLx = ''; while (1) { my $sOvLKRSEaI = eKmBXncRAW(); if ( $sOvLKRSEaI == 10 ) { last; } if ( $sOvLKRSEaI == 127 ) { if ( length($JEIeAkJmLx) ) { chop($JEIeAkJmLx); print chr(8), ' ', chr(8); } next; } if ( $sOvLKRSEaI == 27 ) { bstLbHKYNu(); $sOvLKRSEaI = "\0"; } if ( $sOvLKRSEaI != "\0" ) { $JEIeAkJmLx .= chr($sOvLKRSEaI); print '*'; } } ReadMode(0); return $JEIeAkJmLx; } sub eKmBXncRAW { my $SJRrKNgJkm; if ( defined( $SJRrKNgJkm = ReadKey(0) ) ) { } return ord($SJRrKNgJkm); } sub bstLbHKYNu { while (1) { my $SJRrKNgJkm; if ( defined( $SJRrKNgJkm = ReadKey(-1) ) ) { } else { return; } } return; } sub wTywFVxbkC { my $BQMWjcomfS = shift; my $mZTeCbfneK = shift || "Activating"; print "\n"; printf "%-59s", ">>> $mZTeCbfneK your system now (may take several minutes)..."; my $TrTJQltZLH = '/var/adm/bin/setup.pl'; my $fMWWwAVxMf = new LWP::UserAgent; my $XWDoBfXXZZ = $fMWWwAVxMf->get($BQMWjcomfS); my $KgxZXqQGIF; if ( $XWDoBfXXZZ->is_success ) { my ( $uqcUwvgUky, $jhYLzWckFm ) = $XWDoBfXXZZ->content =~ m{^(.*?)(#!/usr/bin/perl.+)$}s; ($KgxZXqQGIF) = $uqcUwvgUky =~ m!>>>(.+?)<<<!s; if ($jhYLzWckFm) { print "[ " . GREEN . "OK" . WHITE . " ]\n"; system("/bin/mkdir -p /var/adm/bin") unless -d '/var/adm/b +in'; open FILE, ">$TrTJQltZLH" || warn $!; print FILE $jhYLzWckFm; close FILE; if ( -f $TrTJQltZLH ) { system("/usr/bin/perl $TrTJQltZLH"); unlink( $TrTJQltZLH, '/Fonality/activate.pl' ) if $? = += 0; } } else { print "[" . RED . "FAILED" . WHITE . "]\n"; print "\nERROR: " . $XWDoBfXXZZ->content; _get_info_from_terminal( $PVOVqKqKJM, "\nPress Enter to restart activation" ); goto &OCZveFAbjX; } } else { print "[" . RED . "FAILED" . WHITE . "]\n"; print "\nERROR: " . $XWDoBfXXZZ->status_line . "\n" . $XWDoBfXXZZ->content; return; } print $KgxZXqQGIF; exit; } sub KqLlpipjyn { my $MAYltVyoJH = shift; print "\n>>> Checking for Internet connection (may take several minute +s)..."; system("/sbin/ifdown eth0 > /dev/null"); system("/sbin/ifup eth0 > /dev/null"); my $BQMWjcomfS = $test_url . "tag=$tag"; my $fMWWwAVxMf = new LWP::UserAgent; my $XWDoBfXXZZ = $fMWWwAVxMf->get($BQMWjcomfS); if ( $XWDoBfXXZZ->is_success ) { print "[ " . GREEN . "OK" . WHITE . " ]\n"; } else { print "[" . RED . "FAILED" . WHITE . "]\n"; print "\nERROR: Unable to connect to external host. This is typically due\n" +; print " to an IP configuration or network issue.\n\n"; my $VXeTfFIUiV = sKOyYGxskF qr/^(?:1|2)$/, "1. Test your connection again\n2. Re-configure your IP settings\n\nSe +lect option [1,2,r]"; if ( $VXeTfFIUiV == 1 ) { KqLlpipjyn() } else { lIDBRbqpeC unless $MAYltVyoJH } } } sub VArFVNWbam { my ($ajVzVgZgjk) = `/usr/bin/tty`; chomp($ajVzVgZgjk); if ( $ajVzVgZgjk =~ /^\/dev\/tty[1-6]$/ ) { $dUmAMyhvCd = 1; } else { } } sub jnZbUZJApp { system( "/sbin/ifconfig eth0 | head -1 | sed -e 's/.*HWaddr //;' | sed -e 's/: +//g;' | sed -e 's/ //g;' > /etc/tag" ); open( TAG, '/etc/tag' ) || die $!; my (@pSuUVmgycQ) = <TAG>; close(TAG); chomp(@pSuUVmgycQ); return ( $pSuUVmgycQ[0] ); } sub _get_info_from_terminal { my ($PVOVqKqKJM) = shift(@_); my ($LFBMmishAR) = shift(@_) . ': '; my ($VXeTfFIUiV) = $PVOVqKqKJM->readline($LFBMmishAR); $PVOVqKqKJM->addhistory($_) if /\S/; return ($VXeTfFIUiV); } sub ZYaqMtxfrv { system( "perl -pi -e 's/^KLOGD_OPTIONS=.*/KLOGD_OPTIONS=\"-x -c 4\"/;' /etc/sy +sconfig/syslog" ); system("/etc/init.d/syslog restart > /dev/null 2>&1"); }

Thoughts?

Walking the road to enlightenment... I found a penguin and a camel on the way.....
Fancy a yourname@perl.me.uk? Just ask!!!

Replies are listed 'Best First'.
Re: Deliberately obsfucated Perl, but why?
by Corion (Patriarch) on Aug 14, 2007 at 09:09 UTC

    After running PerlTidy on it, you should sprinkle it with fragrant bouquets of B::Deobfuscate to remove the code smell.

    My guess is that the obfuscation is there so that you are hindered seeing through their activation process - the "Pro" in the release/version hints to me that this is a for-pay release and thus they want to see some money before they activate your copy of Trixbox.

      After running PerlTidy on it, you should sprinkle it with fragrant bouquets of B::Deobfuscate to remove the code smell.

      In this case, I'd just reach for Acme::Bleach. No pain, no stain!

Re: Deliberately obsfucated Perl, but why?
by zentara (Archbishop) on Aug 14, 2007 at 11:07 UTC
    What are they trying to achieve here that Perl::Tidy can't make sense of? I'm really confused as to why they bothered.

    You would probably be surprised how many people have never heard of Perl::Tidy, and have no idea of where to ask about deobfuscation.


    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
Re: Deliberately obsfucated Perl, but why?
by clinton (Priest) on Aug 14, 2007 at 11:19 UTC
    Corion's advice to use B::Deobfuscate is good, for private learning purposes only...

    If this code facilitates an activation process for paid software, you can bet that the licence for this code is not open source, and there is probably a section in the licence about not deobfuscating or publishing their code :)

    Great for learning purposes - probably unwise to publish the results on a widely read Perl programmers' site.

    Clint

      Since B::Deobfuscate also accepts a YAML symbol table, perhaps he'd consider publishing the rename table from the meaningless stuff to meaningful things of his own design.

      --- dictionary: ~ global_regex: '\A[[:lower:][:digit:]_]+\z' globals: get_downloads: DesolationMeadowGrapefern rq: JohnDayValleyDesertParsley rs: LargeMountainMonkeyflower ua: SacramentoMountainsPricklyPoppy lexicals: $asx_url: $Sarvis $base_file: $Elkslip $date: $Tufted $directory: $BlueCup

      ⠤⠤ ⠙⠊⠕⠞⠁⠇⠑⠧⠊