PERL   44

l33t cgi

Guest on 19th August 2022 04:35:00 PM

  1. #!/usr/bin/perl
  2.  
  3. # This program ist published under GPL
  4. # Copyright  by Lennart Poettering, lennart@poettering.de
  5. # With some important changes by Gerhard Blum, gerhard@smoking.de
  6.  
  7. # Maximum size of a page to l33t
  8. $Max = 1000000; # set higher if you have enough RAM to use
  9.  
  10. # Send forms to l33t web?
  11. $FORMon = 1 ; # leave undefined or set to 0 to cancel
  12.  
  13. # Translate 'strings' with these endings in javascript & option tags to point to us
  14. # Leave first $wwwrsc_scr undefined to cancel
  15. $wwwrsc_scr= '(\.plX|\.cgiX|\.aspX|\.s?html?X|\.php\d?X|[\w\~\/\.-]+\/)';
  16. $wwwrsc= '(\.gif|\.jpe?g|\.swf|\.mp3|\.mid|\.zip)'; # do NOT translate these endings
  17. $_='(\?[^\'\"]+|#[^\'\"]+)?';
  18. $wwwrsc_scr =~ s/X/$_/go;
  19.  
  20. use CGI;
  21. use LWP::UserAgent;
  22. use HTTP::Request;
  23.  
  24. # Translates a phrase from readable to l33t text. Ignores all special tags.
  25. sub make_phrase_leet()
  26.   {
  27.     my ($s) = @_;
  28.  
  29.     $s =~ s/s\b/Z/gio if $skill >= 5;
  30.  
  31.     $s =~ tr/aAeEoO/443300/;
  32.  
  33.     $s =~ tr/iItTbB/117788/ if $skill >= 2;
  34.  
  35.     $s =~ tr/sSgG/5\$96/ if $skill >= 3;
  36.  
  37.     $s =~ tr/lLz/||2/ if $skill >= 4;
  38.  
  39.     $s =~ s/c/</gio if $skill >= 5;
  40.     $s =~ s/K/\[</gio if $skill >= 5;
  41.     $s =~ s/W/VV/gio if $skill >= 5;
  42.  
  43.     return $s;
  44.   }
  45.  
  46. # Translates a phrase from readable to l33t text. Handles umlauts and special characters.
  47. sub make_text_leet()
  48.   {
  49.     my ($text) = @_;
  50.     my ($result, @blocks) = split(/&/, $text);
  51.     my ($item, $char, $trailing);
  52.  
  53.     $result = &make_phrase_leet($result);
  54.  
  55.     foreach $item (@blocks)
  56.       {
  57.         if ($item =~ /;/)
  58.           {
  59.             ($char, $trailing) = ($`,$');  # prematch, postmatch
  60.             $result .= "&".$char.";".&make_phrase_leet($trailing);
  61.           }
  62.         else
  63.           {
  64.             $result .= "&" . &make_phrase_leet($item);
  65.           }
  66.       }
  67.    
  68.     return $result;
  69.   }
  70.  
  71. # Fixes a given URL for is. Prepends hostname on relative URLs. Prepends the URL of this script for nto letting the user escape from our l33t web.
  72. # Arguments are the url and a value that indicates if and how our script-address should be prepended or not.
  73. sub fix_url()
  74.   {
  75.     my ($u, $v) = @_;
  76.     my $b, $anchor = '';
  77.    
  78.     if ($u =~ /^http:/io || not ($u =~ /^(\w{1,10}):/o) )
  79.       {
  80.         if (not $u =~ /^http:/o) # same server
  81.           {
  82.             if ($u =~ /^\//o)  #Absolute, same server
  83.               {
  84.                 $b = $url;
  85.                 $b =~ s/^(........*?)\/.*$/$1/o;
  86.                 $u = $b.$u;
  87.               }
  88.             else              #Relative, same server
  89.               {
  90.                 $b = $url;
  91.                 $b =~ s/^(.*\/)(.*)$/$1/o unless ($u =~ /^#/o);
  92.  
  93.                 while ($u =~ s/^\.\.\///o)  # Evaluate ../
  94.                   {          # and think of people pointing higher than document_root
  95.                     $b =~ s/^(.*\/)(.*)\/$/$1/o if ($b =~ /(.*\/){4,}/o);
  96.                   }
  97.                 $u = $b.$u;
  98.               }
  99.           }
  100.         # move #anchor to ourselves; NOT MSIE (cuts parameters when #present)
  101.         if($ENV{'HTTP_USER_AGENT'} !~ /MSIE/o)
  102.           {
  103.             $anchor = $2 if ($u =~ s/^(.*)(#[^\?]*)/$1/o) ;
  104.           }
  105.         if ($v>1)  #send forms to l33t web
  106.           {
  107.             $hidden_fields  = "\n<input type=\"hidden\" name=\"_skill_\" value=\"$skill\">";
  108.             $hidden_fields .= "\n<input type=\"hidden\" name=\"_url_\" value=\"$u\">";
  109.             $hidden_fields .= "\n<input type=\"hidden\" name=\"_isform_\" value=\"l33t\">\n";
  110.             $u = $ourselves.$anchor ;
  111.           }
  112.         elsif ($v)
  113.           {
  114.             $u = $ourselves.$anchor."?_skill_=".$skill."&_url_=".$query->escape($u) ;
  115.           }
  116.       }
  117.    
  118.     return $u;
  119.   }
  120.  
  121. # Translates each tag which needs it.
  122. sub handle_tag()
  123.   {
  124.     my ($tag) = @_;
  125.  
  126.     # These need the script-address to be prepended (because they point to HTML-data)
  127.     # a href | area href
  128.     $tag =~ s/((a|area)(\s|\s.*\s)href\s*=\s*(\"|\')?)(.*?)(\"|\'|\s|$)/$1.&fix_url($5,1).$6/seio;
  129.     # frame src
  130.     $tag =~ s/(frame(\s|\s.*\s)src\s*=\s*(\"|\')?)(.*?)(\"|\'|\s|$)/$1.&fix_url($4,1).$5/seio;
  131.     # script src
  132.     $tag =~ s/(script(\s|\s.*\s)src\s*=\s*(\"|\')?)(.*?)(\"|\'|\s|$)/$1.&fix_url($4,1).$5/seio if $wwwrsc_scr ;
  133.     # meta refresh
  134.     $tag =~ s/(meta(\s|\s.*\s)http-equiv\s*=\s*(\"|\')refresh\3.+?url=)(.*?)\3/$1.&fix_url($4,1).$3/seio;
  135.  
  136.     # form action
  137.     $tag =~ s/(form(\s|\s.*\s)action\s*=\s*(\"|\')?)(.*?)(\"|\'|\s|$)/$1.&fix_url($4,2).$5/seio if $FORMon;
  138.  
  139.     # These need make_javascript() to prepend script-address
  140.     # javascript: in href
  141.     $tag =~ s/((a|area)(\s|\s.*\s)href\s*=\s*\"\s*javascript:[^\"]+?)(\'[^\n]+?\')(.*?\")/$1.&make_javascript($4).$5/seiog ;
  142.     # javascript inside tag
  143.     $tag =~ s/(.+?\son\w+\s*=\s*\"[^\"]+?)(\'.+?\')(.*?\")/$1.&make_javascript($2).$3/eiog ;
  144.     # url in option tag
  145.     $tag =~ s/(option(\s|\s.*\s)value\s*=\s*)((\"|\').+?\4)/$1.&make_javascript($3)/seio ;
  146.  
  147.     # l33t alternate-text in img tag
  148.     $tag =~ s/(img(\s|\s.*\s)alt\s*=\s*(\"|\'))(.*?)\3/$1.&make_text_leet($4).$3/seio;
  149.     # l33t alternate-text in image map
  150.     $tag =~ s/(area(\s|\s.*\s)alt\s*=\s*(\"|\'))(.*?)\3/$1.&make_text_leet($4).$3/seio;
  151.     return $tag;
  152.   }
  153.  
  154. # We do not want to be called recursively
  155. sub deiterate_url()
  156.   {
  157.     my ($url) = @_;
  158.  
  159.     $url =~ s/^$ourselves\?.*?_url_=(.*?)(&.*|$)/$query->unescape($1)/goe;
  160.  
  161.     return $url;
  162.   }
  163.  
  164. # Prepend script-url in javascript-code
  165. sub make_javascript()
  166.   {
  167.     my ($script) = @_;
  168.  
  169.     # check for wwwrsc_scr ending
  170.     $script =~ s/(\"|\')([^\'\"]+?$wwwrsc_scr)\1/$1.&fix_url($2,1).$1/eiog if $wwwrsc_scr ;
  171.     # check for leftover http://abc.de/ef
  172.     $script =~ s/(\"|\')(http:\/\/[^\?\"\']+)\1/$1.&make_javascript2($2).$1/eiog if $wwwrsc_scr ;
  173.  
  174.     return $script;
  175.   }
  176. sub make_javascript2()
  177.   {
  178.     my ($script) = @_;
  179.  
  180.     $script = &fix_url($script,1) if ($script !~ /$wwwrsc$/io) ;
  181.  
  182.     return $script;
  183.   }
  184.  
  185. # check request for content_type and _length, redirect immediate if not convenient
  186. # otherwise, collect packet
  187. sub handle_request()
  188.   {
  189.     $result .= @_[0];
  190.     return if $R_Checked; # must be global
  191.     $res = @_[1]; # might be local
  192.     if(($res->content_type !~ /(text\/html|text\/plain|javascript)/)||($res->content_length > $Max))
  193.       {
  194.         print $query->redirect($url);
  195.         exit;
  196.       }
  197.     $R_Checked = 1;
  198.   }
  199.  
  200.  
  201. $query = new CGI;
  202.  
  203. $url = $query->param('_url_') || $query->param('url');
  204. $skill = int($query->param('_skill_')) || int($query->param('skill'));
  205. $ISform = $query->param('_isform_');
  206.  
  207. $skill = 3 if $skill == 0;
  208. $skill = 5 if $skill > 5;
  209. $skill = 1 if $skill < 1;
  210.  
  211. $ourselves = $query->url();
  212.  
  213. if ($url =~ /^h?t?t?p?:?\/?\/?w?w?w?\.?$/)
  214.   {
  215.     print $query->header;
  216.     print $query->start_html(-title => "Error");
  217.     print "<h2>You did not specify an URL. '".$url."'</h2>";
  218.     print $query->end_html;
  219.   }
  220. else
  221.   {
  222.     $url = "http://".$url if not $url =~ /^http:\/\//o;
  223.  
  224.     $url = &deiterate_url($url);
  225.  
  226.     $ua = new LWP::UserAgent;
  227.     $ua->agent($query->user_agent() ne "" ? $query->user_agent() : "beL33t!/0.1");
  228.  
  229.     if (($query->request_method eq "POST") && ($ISform eq 'l33t'))
  230.       {
  231.         my @list1 = $query->param ;
  232.         my (@list2,$i) = 0;
  233.         foreach (@list1)
  234.           {
  235.             next if /^_(skill|url|isform)_$/o;
  236.             $list2[$i++] =  "$_=" . $query->param($_) ;
  237.           }
  238.         $req = new HTTP::Request POST => $url;
  239.         $req->content(join('&', @list2)) ;
  240.         $req->content_type('application/x-www-form-urlencoded') ;
  241.       }
  242.     elsif (($query->request_method eq "GET") && ($ISform eq 'l33t'))
  243.       {
  244.         my $param = $ENV{'QUERY_STRING'};
  245.         $param =~ s/_(skill|url|isform)_.+?&|$//go;
  246.         $req = new HTTP::Request GET => "$url?$param" ;
  247.       }
  248.     else
  249.       {
  250.         $req = new HTTP::Request GET => $url;
  251.       }
  252.  
  253.     $_ = &deiterate_url($query->referer());
  254.     $_ = $url if ($_ eq $ourselves);
  255.     $req->headers->header("Referer" => $_);
  256.  
  257.     $res = $ua->request($req,\&handle_request);
  258.     $result = $res->content unless $result;
  259.  
  260.     unless ($res->is_success || ($res->content_type  eq 'text/html'))
  261.       {
  262.         print $query->header;
  263.  
  264.         print $query->start_html(-title => "Error");
  265.         print "<p><b>Could not retrieve URL:</b> <i>".$res->error_as_HTML."</i></p>";
  266.         print $query->end_html;
  267.       }
  268.     else
  269.       {
  270.         # Only the server knows the real URL
  271.         $url = $res->base->as_string;
  272.  
  273.         if ($res->content_type eq 'text/html')
  274.           {
  275.             # Translate HTML data
  276.             print $query->header;
  277.  
  278.             $result =~ s/<\s*base\s+href.*?>//gio; # substitute or set base href
  279.             $result = "<base href=\"$url\">\n".$result ;
  280.  
  281.             $result = "<!--\n  l33t-script by lennart\@poettering.de\n     modified by gerhard\@smoking.de\n-->\n\n".$result ;
  282.  
  283.             $overlongcomment = 0;
  284.             ($result, @blocks) = split(/</, $result);
  285.             $result = &make_text_leet($result);
  286.  
  287.             foreach $item (@blocks)
  288.               {
  289.                 if (($item =~ /^!--/o) || $overlongcomment)
  290.                   {
  291.                     if ($item =~ /(.*)-->/so) # finds last -->
  292.                       {
  293.                         ($comment, $trailing) = ($1,$');  # backref, postmatch
  294.                        
  295.                         $result .= "<" .$comment."-->".&make_text_leet($trailing);
  296.                         $overlongcomment = 0;
  297.                       }
  298.                     else
  299.                       {
  300.                         $overlongcomment = 1;
  301.                         $result .= "<".$item;
  302.                       }
  303.                   }
  304.                 elsif ($item =~ /(.*)>/so) # finds last >
  305.                   {
  306.                     ($tag, $trailing) = ($1,$');  # backref, postmatch
  307.                     $hidden_fields = "";
  308.                     $result .= "<".&handle_tag($tag).">$hidden_fields".&make_text_leet($trailing);
  309.                   }
  310.                 else
  311.                   {
  312.                     $result .= "<$item";
  313.                   }
  314.               }
  315.  
  316.             # translate urls in script-section
  317.             $result =~ s/(<script.*?>)(.*?)(<\/script>)/$1.&make_javascript($2).$3/seiog if $wwwrsc_scr ;
  318.            
  319.             print $result;
  320.           }
  321.         elsif ($res->content_type eq 'text/plain')
  322.           {
  323.             print "Content-Type: text/plain\n\n".&make_phrase_leet($result) ;
  324.           }
  325.         elsif ($res->content_type =~ /javascript/o) # extern js
  326.           {
  327.             print "Content-Type: ".$res->content_type."\n\n".&make_javascript($result) ;
  328.           }
  329.         else
  330.           {
  331.             # When we do not have our type of data we send a redirect to the real resource
  332.             print $query->redirect($url);
  333.           }
  334.       }
  335.   }

Raw Paste


Login or Register to edit or fork this paste. It's free.