#!/usr/bin/perl # This program ist published under GPL # Copyright 2000 by Lennart Poettering, lennart@poettering.de # With some important changes by Gerhard Blum, gerhard@smoking.de # Maximum size of a page to l33t $Max = 1000000; # set higher if you have enough RAM to use # Send forms to l33t web? $FORMon = 1 ; # leave undefined or set to 0 to cancel # Translate 'strings' with these endings in javascript & option tags to point to us # Leave first $wwwrsc_scr undefined to cancel $wwwrsc_scr= '(\.plX|\.cgiX|\.aspX|\.s?html?X|\.php\d?X|[\w\~\/\.-]+\/)'; $wwwrsc= '(\.gif|\.jpe?g|\.swf|\.mp3|\.mid|\.zip)'; # do NOT translate these endings $_='(\?[^\'\"]+|#[^\'\"]+)?'; $wwwrsc_scr =~ s/X/$_/go; use CGI; use LWP::UserAgent; use HTTP::Request; # Translates a phrase from readable to l33t text. Ignores all special tags. sub make_phrase_leet() { my ($s) = @_; $s =~ s/s\b/Z/gio if $skill >= 5; $s =~ tr/aAeEoO/443300/; $s =~ tr/iItTbB/117788/ if $skill >= 2; $s =~ tr/sSgG/5\$96/ if $skill >= 3; $s =~ tr/lLz/||2/ if $skill >= 4; $s =~ s/c/</gio if $skill >= 5; $s =~ s/K/\[</gio if $skill >= 5; $s =~ s/W/VV/gio if $skill >= 5; return $s; } # Translates a phrase from readable to l33t text. Handles umlauts and special characters. sub make_text_leet() { my ($text) = @_; my ($result, @blocks) = split(/&/, $text); my ($item, $char, $trailing); $result = &make_phrase_leet($result); foreach $item (@blocks) { if ($item =~ /;/) { ($char, $trailing) = ($`,$'); # prematch, postmatch $result .= "&".$char.";".&make_phrase_leet($trailing); } else { $result .= "&" . &make_phrase_leet($item); } } return $result; } # 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. # Arguments are the url and a value that indicates if and how our script-address should be prepended or not. sub fix_url() { my ($u, $v) = @_; my $b, $anchor = ''; if ($u =~ /^http:/io || not ($u =~ /^(\w{1,10}):/o) ) { if (not $u =~ /^http:/o) # same server { if ($u =~ /^\//o) #Absolute, same server { $b = $url; $b =~ s/^(........*?)\/.*$/$1/o; $u = $b.$u; } else #Relative, same server { $b = $url; $b =~ s/^(.*\/)(.*)$/$1/o unless ($u =~ /^#/o); while ($u =~ s/^\.\.\///o) # Evaluate ../ { # and think of people pointing higher than document_root $b =~ s/^(.*\/)(.*)\/$/$1/o if ($b =~ /(.*\/){4,}/o); } $u = $b.$u; } } # move #anchor to ourselves; NOT MSIE (cuts parameters when #present) if($ENV{'HTTP_USER_AGENT'} !~ /MSIE/o) { $anchor = $2 if ($u =~ s/^(.*)(#[^\?]*)/$1/o) ; } if ($v>1) #send forms to l33t web { $hidden_fields = "\n"; $hidden_fields .= "\n"; $hidden_fields .= "\n\n"; $u = $ourselves.$anchor ; } elsif ($v) { $u = $ourselves.$anchor."?_skill_=".$skill."&_url_=".$query->escape($u) ; } } return $u; } # Translates each tag which needs it. sub handle_tag() { my ($tag) = @_; # These need the script-address to be prepended (because they point to HTML-data) # a href | area href $tag =~ s/((a|area)(\s|\s.*\s)href\s*=\s*(\"|\')?)(.*?)(\"|\'|\s|$)/$1.&fix_url($5,1).$6/seio; # frame src $tag =~ s/(frame(\s|\s.*\s)src\s*=\s*(\"|\')?)(.*?)(\"|\'|\s|$)/$1.&fix_url($4,1).$5/seio; # script src $tag =~ s/(script(\s|\s.*\s)src\s*=\s*(\"|\')?)(.*?)(\"|\'|\s|$)/$1.&fix_url($4,1).$5/seio if $wwwrsc_scr ; # meta refresh $tag =~ s/(meta(\s|\s.*\s)http-equiv\s*=\s*(\"|\')refresh\3.+?url=)(.*?)\3/$1.&fix_url($4,1).$3/seio; # form action $tag =~ s/(form(\s|\s.*\s)action\s*=\s*(\"|\')?)(.*?)(\"|\'|\s|$)/$1.&fix_url($4,2).$5/seio if $FORMon; # These need make_javascript() to prepend script-address # javascript: in href $tag =~ s/((a|area)(\s|\s.*\s)href\s*=\s*\"\s*javascript:[^\"]+?)(\'[^\n]+?\')(.*?\")/$1.&make_javascript($4).$5/seiog ; # javascript inside tag $tag =~ s/(.+?\son\w+\s*=\s*\"[^\"]+?)(\'.+?\')(.*?\")/$1.&make_javascript($2).$3/eiog ; # url in option tag $tag =~ s/(option(\s|\s.*\s)value\s*=\s*)((\"|\').+?\4)/$1.&make_javascript($3)/seio ; # l33t alternate-text in img tag $tag =~ s/(img(\s|\s.*\s)alt\s*=\s*(\"|\'))(.*?)\3/$1.&make_text_leet($4).$3/seio; # l33t alternate-text in image map $tag =~ s/(area(\s|\s.*\s)alt\s*=\s*(\"|\'))(.*?)\3/$1.&make_text_leet($4).$3/seio; return $tag; } # We do not want to be called recursively sub deiterate_url() { my ($url) = @_; $url =~ s/^$ourselves\?.*?_url_=(.*?)(&.*|$)/$query->unescape($1)/goe; return $url; } # Prepend script-url in javascript-code sub make_javascript() { my ($script) = @_; # check for wwwrsc_scr ending $script =~ s/(\"|\')([^\'\"]+?$wwwrsc_scr)\1/$1.&fix_url($2,1).$1/eiog if $wwwrsc_scr ; # check for leftover http://abc.de/ef $script =~ s/(\"|\')(http:\/\/[^\?\"\']+)\1/$1.&make_javascript2($2).$1/eiog if $wwwrsc_scr ; return $script; } sub make_javascript2() { my ($script) = @_; $script = &fix_url($script,1) if ($script !~ /$wwwrsc$/io) ; return $script; } # check request for content_type and _length, redirect immediate if not convenient # otherwise, collect packet sub handle_request() { $result .= @_[0]; return if $R_Checked; # must be global $res = @_[1]; # might be local if(($res->content_type !~ /(text\/html|text\/plain|javascript)/)||($res->content_length > $Max)) { print $query->redirect($url); exit; } $R_Checked = 1; } $query = new CGI; $url = $query->param('_url_') || $query->param('url'); $skill = int($query->param('_skill_')) || int($query->param('skill')); $ISform = $query->param('_isform_'); $skill = 3 if $skill == 0; $skill = 5 if $skill > 5; $skill = 1 if $skill < 1; $ourselves = $query->url(); if ($url =~ /^h?t?t?p?:?\/?\/?w?w?w?\.?$/) { print $query->header; print $query->start_html(-title => "Error"); print "

You did not specify an URL. '".$url."'

"; print $query->end_html; } else { $url = "http://".$url if not $url =~ /^http:\/\//o; $url = &deiterate_url($url); $ua = new LWP::UserAgent; $ua->agent($query->user_agent() ne "" ? $query->user_agent() : "beL33t!/0.1"); if (($query->request_method eq "POST") && ($ISform eq 'l33t')) { my @list1 = $query->param ; my (@list2,$i) = 0; foreach (@list1) { next if /^_(skill|url|isform)_$/o; $list2[$i++] = "$_=" . $query->param($_) ; } $req = new HTTP::Request POST => $url; $req->content(join('&', @list2)) ; $req->content_type('application/x-www-form-urlencoded') ; } elsif (($query->request_method eq "GET") && ($ISform eq 'l33t')) { my $param = $ENV{'QUERY_STRING'}; $param =~ s/_(skill|url|isform)_.+?&|$//go; $req = new HTTP::Request GET => "$url?$param" ; } else { $req = new HTTP::Request GET => $url; } $_ = &deiterate_url($query->referer()); $_ = $url if ($_ eq $ourselves); $req->headers->header("Referer" => $_); $res = $ua->request($req,\&handle_request); $result = $res->content unless $result; unless ($res->is_success || ($res->content_type eq 'text/html')) { print $query->header; print $query->start_html(-title => "Error"); print "

Could not retrieve URL: ".$res->error_as_HTML."

"; print $query->end_html; } else { # Only the server knows the real URL $url = $res->base->as_string; if ($res->content_type eq 'text/html') { # Translate HTML data print $query->header; $result =~ s/<\s*base\s+href.*?>//gio; # substitute or set base href $result = "\n".$result ; $result = "\n\n".$result ; $overlongcomment = 0; ($result, @blocks) = split(//so) # finds last --> { ($comment, $trailing) = ($1,$'); # backref, postmatch $result .= "<" .$comment."-->".&make_text_leet($trailing); $overlongcomment = 0; } else { $overlongcomment = 1; $result .= "<".$item; } } elsif ($item =~ /(.*)>/so) # finds last > { ($tag, $trailing) = ($1,$'); # backref, postmatch $hidden_fields = ""; $result .= "<".&handle_tag($tag).">$hidden_fields".&make_text_leet($trailing); } else { $result .= "<$item"; } } # translate urls in script-section $result =~ s/()(.*?)(<\/script>)/$1.&make_javascript($2).$3/seiog if $wwwrsc_scr ; print $result; } elsif ($res->content_type eq 'text/plain') { print "Content-Type: text/plain\n\n".&make_phrase_leet($result) ; } elsif ($res->content_type =~ /javascript/o) # extern js { print "Content-Type: ".$res->content_type."\n\n".&make_javascript($result) ; } else { # When we do not have our type of data we send a redirect to the real resource print $query->redirect($url); } } }