#!perl use strict; use CGI qw(:standard); use Compress::Zlib; use HTML::Entities; use MIME::Base64; my$use_sqz='0'; # set to 1 to use squeeze.pm # next line uses (modified) squeeze.pm (first line commented out) in same dir as script # change "require" to "use" (see squeeze pod) if you installed module in root! if($use_sqz==1){ require "Squeeze.pm"} use vars qw($output @output $c $ocheck $icheck $outy @outy @out @o $o $inny @inny $n $host $path $p $pre $title $ifsqz); my$ltime = localtime(); my$script = url(); my$input = param('input'); my$act = param('act'); my$acto = param('acto'); my$help = param('help'); my$home = param('home'); my$one = param('one'); my$czh = param('czh'); my$ips = param('ips'); my$sel = ' selected'; my$done='0'; my%codes=( ent => 'Enitities', low => 'Lowercase', upp => 'Uppercase', uue => 'UU Encode', uud => 'uu decode', urle => 'URL Encode', urld => 'url decode', querystr => 'Query', rot13 => 'ROT13', base64 => 'MIME Base64', base64u => 'mime dbase64', zlibc => 'ZLIB Compress', zlibu => 'zlib uncompress', sqz => 'Squeeze', sqzz => 'Squeeze1', octl => 'Octal', dword => 'Dword', looku => 'Lookup', hexa => 'Hex1', hexb => 'Hex2', help => '.nfo', home => '<coder>',); my@codez = qw(low upp uue uud base64 base64u zlibc zlibu urle urld ent rot13 looku querystr dword octl hexa hexb help home copy one sqz sqzz); # menu display order my@except = qw(one copy help home looku querystr dword octl hexa hexb); # don't list in menu if($ips){ # if ip is checked display ip menu instead @codez = splice(@codez, 12, 6); # replace array with 6 elements of itself, starting at the 13th undef(@except); # @except = qw(); # don't list in menu unless(($help or $home)){$icheck=' checked'} } unless($czh){ $czh= '1'} # DEFAULT divisor for menu height, 1 to show all, 2 to show half, 10 to show 1. my$dc = ''; # DEFAULT code to select if($use_sqz !=1){ pop @codez; pop @codez} print header; if($acto=~/\?/){&help()} if($acto=~/!/){&genius()} if($act){ foreach(@codez){ unless($_ eq /one|/){ if($act eq $_){ do{\&{$_}}->()}}}} if($one){&line()} if(!$title){ # define title according to action if any $title='<coder>'; if($act){$title = $codes{$act}} if($acto){$title = $codes{$acto}} if(($ips)&&(!$act)){$title='IP Mode'; } } &form2; exit; sub genius{$input='';$output=''} sub line{ #oneline $output=~s/\n|\r//g; $output = decode_entities($output); $ocheck=' checked'; @outy=split(//,$output); $outy=scalar(@outy); $done=1; } sub ent{ # entities if($input =~/&(\w.);/){ $input =~s/&(\w.);/$1/eg; @inny=split(//,$input); foreach(@inny){ push @output, $_; $outy++; } } elsif($input =~/^\w{4}/){ my@inny=split(//,$input); foreach(@inny){ $_ =~ s/.{1}/ord($_)/eg; $_ = '&'.$_.';'; push @output, $_; $outy++; } $done='1'; } } sub copy{} # zzz sub low{($output = $input)=~ tr/A-Z/a-z/} sub upp{($output = $input)=~ tr/a-z/A-Z/} sub uue{ # uuencode $output = decode_entities($input); $output = pack ("u", $input); @outy=split(//,$output); $outy=scalar(@outy);$done='1'; $output = encode_entities($output); } sub uud{ # uudecode $output = decode_entities($input); $output = decode_entities($output); $output = unpack ("u", $output)} sub zlibc{ # zlib compress $output = compress($input); # compress $output = pack ("u", $output); # uuencode @outy=split(//,$output); $outy=scalar(@outy); $done='1'; # count b4 encoding $output = encode_entities($output); } sub zlibu{ # zlib uncompress my $o = unpack ("u", $input); # uudecode $output = uncompress($o)} # uncompress sub urle{($output=$input) =~ s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg} sub urld{($output=$input) =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/eg} sub base64{$output = encode_base64($input)} sub base64u{$output = decode_base64($input)} sub rot13{($output=$input)=~y/A-Za-z/N-ZA-Mn-za-m/} sub sqz{$output = SqueezeText($input)} sub sqzz{ $output = SqueezeText($input); $output =~s/\s+(.)/\U$1/g; # uppercase 1st letter of every word $output =~s/ //g; # strip spaces } sub dword{ my$var=shift(@_); unless($var){@o=split(/\./,$input)} else {@o=split(/\./,$var)} $output=0; $n=1; unless($n==4){ foreach(@o){ if($n==1){$_=($_*16777216)} if($n==2){$_=($_*65536)} if($n==3){$_=($_*256)} if($n==4){$_=($_*1)} push @output, $_; $n++; } } foreach(@output){$output += $_} undef(@output); if($var){ return $output} } sub octl{ @o=split(/\./,$input,4); foreach(@o){ $_=oct($_); # $_='0'. $_ .'.'; # if($n==3){$_=~s/\.//o} push @output, $_; $n++; } foreach(@output){ @outy=split(//,$_); $outy=scalar(@outy); $done='1'; # hmm } } sub hexa{ @o=split(/\./,$input,4); foreach(@o){ $_= sprintf "%1X", $_; ## unless($_=~/../){$_='0'.$_} ## $_= '0x'.$_.'.'; # if($n==3){$_=~s/\.//o} push @output, $_; $n++; } } sub hexb{ @o=split(/\./,$input,4); foreach(@o){ $_= sprintf "%1X", $_; ## unless($_=~/../){$_='0'.$_} ## if($n==0){$_= '0x'.$_} # push @output, $_; $n++; } } sub looku{ # ip to hostname and vice versa, invalid address ok my$var=shift(@_); if($var){$input=$var} unless($input=~/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/){ # hostname to ip @output = unpack("C4",gethostbyname($input)); $n=0; foreach(@output){$_=$_.'.'; $n++; if($n==4){$_=~s|\.||o}}} if($input=~/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/){ # ip to hostname my@digits = split(/\./, $input); my$address = pack('C4', @digits); $output = gethostbyaddr($address,2); if ($output=~/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/){$output=$input}} } sub querystr{ use vars qw($urlfd @urlfd $inputs @inputs $name $value $wha $out @output @put); $wha=1; unless($input=~/^\?|^https?:/){ # construct query string @inputs = split(/\n/,$input); foreach $inputs(@inputs){ $inputs =~ s/\n|\r//g; # prepare to encode entities $inputs = encode_entities($inputs); $inputs =~ tr/ /+/; if($wha==1){$out='?'.$inputs} else {$out='&'.$inputs} # prepend 1st arg with ?, rest with & push @output, $out; $wha++; } } if($input=~/^\?|^https?:/){ # decontruct query string if($input=~/^https?:|[^\?]/){ ($host,$path)=split(/\?/,$input,2); @put = split(/&/,$path); } if($input=~/^\?/){ $input=~s/^\?//o; @put = split(/&/,$input); } elsif($input!~/^\?|^https?|[^\?]/){ $path='must supply a url with a ?'; push @put, $path} foreach (@put){ $_ = $_."\n"; push @output, $_; $wha++; } } } sub form2{ if(!$title){$title='<coder>'} &js_head($title); my$prcnt='0'; my$cz=(scalar(@codez)-scalar(@except)); $cz=($cz/$czh); # show how many codes at once in select menu? makes select menu height=$cz unless($input){$input=''} # next line doesn't like empty input $inny = decode_entities($input); # prepare to count if(($acto=~/help/)){$inny =~ s/\n|\r//g} # don't count these my@inny=split(//,$inny); my$inny=scalar(@inny); # count input chrs if($output){ unless($done==1){ # count output chrs if string $outy = $output;#) =~ s/\n|\r//g; # don't count these @outy=split(//,$outy); $outy=scalar(@outy) } } if(@output){ # count output chrs if array foreach (@output){ @outy=split(//,$_); $o=scalar(@outy); push @o, $o; } foreach(@o){$outy=($outy+$_)} # bug in here somewhere or above... octal count is wrong. } unless(($outy==0)or($inny==0)){ $prcnt=sprintf("%.2f", ($outy/$inny)*100) # output is what percentage of input? } print<
Output $outy chrs ($prcnt%) |