#!/usr/bin/perl ###################################################################################### # Script by http://www.garyshood.com # Requires libwww-perl, URI, IO::Socket::SSL, and Mozilla::CA. # Validates under HTML 4.01 Transitional. # This is licensed under the BSD license. # # Copyright (c) 2007, Gary's Hood # # All rights reserved. # # Redistribution and use in source and binary forms, with or without modification, # are permitted provided that the following conditions are met: # # * Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # * Redistributions in binary form must reproduce the above copyright notice, # this list of conditions and the following disclaimer in the documentation and/or # other materials provided with the distribution. # * Neither the name of Gary's Hood nor the names of its contributors may be used # to endorse or promote products derived from this software without specific prior # written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. # IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, # INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF # LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED # OF THE POSSIBILITY OF SUCH DAMAGE. ###################################################################################### use HTML::Entities; use CGI; use HTTP::Request; use IO::Socket::SSL qw(SSL_VERIFY_PEER); use LWP::UserAgent; use URI; use Socket qw( AF_INET AF_INET6 AF_UNSPEC SOCK_STREAM IPPROTO_TCP getaddrinfo inet_ntop inet_pton unpack_sockaddr_in unpack_sockaddr_in6 ); my @DENY4 = map { my ($network, $bits) = split m{/}; [ inet_pton(AF_INET, $network), 0 + $bits ] } qw( 0.0.0.0/8 10.0.0.0/8 100.64.0.0/10 127.0.0.0/8 169.254.0.0/16 172.16.0.0/12 192.0.0.0/24 192.0.2.0/24 192.88.99.0/24 192.168.0.0/16 198.18.0.0/15 198.51.100.0/24 203.0.113.0/24 224.0.0.0/4 240.0.0.0/4 ); # Do not let a public DNS answer loop the fetch back into this server or its # directly connected subnet. push @DENY4, [ inet_pton(AF_INET, '168.235.72.0'), 24 ]; my $GLOBAL6 = inet_pton(AF_INET6, '2000::'); my @DENY6 = map { my ($network, $bits) = split m{/}; [ inet_pton(AF_INET6, $network), 0 + $bits ] } qw( 2001::/23 2001:db8::/32 2002::/16 2620:4f:8000::/48 3fff::/20 ); sub in_prefix { my ($address, $network, $bits) = @_; my $whole = int($bits / 8); return 0 if substr($address, 0, $whole) ne substr($network, 0, $whole); my $remaining = $bits % 8; return 1 unless $remaining; my $mask = (0xff << (8 - $remaining)) & 0xff; return ((ord(substr($address, $whole, 1)) & $mask) == (ord(substr($network, $whole, 1)) & $mask)); } sub is_public_address { my ($family, $packed) = @_; if($family == AF_INET) { return 0 if grep { in_prefix($packed, $_->[0], $_->[1]) } @DENY4; return 1; } if($family == AF_INET6) { # Globally routable IPv6 is allocated from 2000::/3. Explicitly reject # special-purpose ranges within it as well. return 0 unless in_prefix($packed, $GLOBAL6, 3); return 0 if grep { in_prefix($packed, $_->[0], $_->[1]) } @DENY6; return 1; } return 0; } sub public_answers { my ($host, $port) = @_; my ($error, @answers) = getaddrinfo($host, $port, { family => AF_UNSPEC, socktype => SOCK_STREAM, protocol => IPPROTO_TCP, }); die "Unable to resolve host\n" if $error || !@answers; my (@approved, %seen); for my $answer (@answers) { my ($packed, $text); if($answer->{family} == AF_INET) { (undef, $packed) = unpack_sockaddr_in($answer->{addr}); $text = inet_ntop(AF_INET, $packed); } elsif($answer->{family} == AF_INET6) { (undef, $packed) = unpack_sockaddr_in6($answer->{addr}); $text = inet_ntop(AF_INET6, $packed); } else { die "Unsupported address family\n"; } # Reject the whole hostname if any answer is unsafe. This prevents mixed # public/private DNS answers from being used for rebinding. die "No access allowed to that domain\n" unless defined($text) && is_public_address($answer->{family}, $packed); my $key = $answer->{family} . ':' . $text; push @approved, { family => $answer->{family}, ip => $text } unless $seen{$key}++; } die "Unable to resolve host\n" unless @approved; # This server currently has IPv4 Internet access but no global IPv6 route. return sort { ($a->{family} == AF_INET ? 0 : 1) <=> ($b->{family} == AF_INET ? 0 : 1) } @approved; } sub normalized_http_uri { my ($input) = @_; $input = '' unless defined $input; $input =~ s/^\s+|\s+$//g; die "Invalid URL\n" if $input eq '' || length($input) > 4096 || $input =~ /[\x00-\x20\x7f\\]/; if($input =~ m{^//}) { $input = "http:$input"; } elsif($input !~ m{^[A-Za-z][A-Za-z0-9+.-]*://}) { die "Only HTTP and HTTPS URLs are allowed\n" if $input =~ m{^[A-Za-z][A-Za-z0-9+.-]*:}; $input = "http://$input"; } my $uri = URI->new($input); my $scheme = lc($uri->scheme || ''); die "Only HTTP and HTTPS URLs are allowed\n" unless $scheme eq 'http' || $scheme eq 'https'; die "Invalid URL\n" unless defined($uri->host) && length($uri->host); die "Credentials in URLs are not allowed\n" if defined $uri->userinfo; die "Scoped IPv6 addresses are not allowed\n" if $uri->host =~ /%/; my $port = $uri->port; die "Only ports 80 and 443 are allowed\n" unless defined($port) && ($port == 80 || $port == 443); $uri->fragment(undef); return $uri; } sub one_public_request { my ($logical, $answer) = @_; my $wire = $logical->clone; $wire->host($answer->{ip}); my $ua = LWP::UserAgent->new( timeout => 10, max_size => 2 * 1024 * 1024, max_redirect => 0, requests_redirectable => [], protocols_allowed => [qw(http https)], env_proxy => 0, proxy => [], agent => 'GarysHood-HTMLtoBB/2.0', ); if(lc($logical->scheme) eq 'https') { my $tls_name = $logical->host; $ua->ssl_opts( verify_hostname => 1, SSL_verify_mode => SSL_VERIFY_PEER, SSL_verifycn_name => $tls_name, ); # SNI is a DNS hostname extension; certificate verification still uses # the literal address for direct-IP HTTPS URLs. $ua->ssl_opts(SSL_hostname => $tls_name) unless defined(inet_pton(AF_INET, $tls_name)) || defined(inet_pton(AF_INET6, $tls_name)); } my $request = HTTP::Request->new(GET => $wire); # authority retains an explicit non-default port and brackets IPv6. $request->header(Host => $logical->authority); $request->header(Accept => 'text/html,application/xhtml+xml,text/plain;q=0.9,*/*;q=0.1'); $request->header('Accept-Encoding' => 'identity'); return $ua->request($request); } sub fetch_public_url { my ($input) = @_; my $logical = normalized_http_uri($input); for my $redirects (0 .. 5) { my @answers = public_answers($logical->host, $logical->port); my $response; for my $answer (@answers) { $response = one_public_request($logical, $answer); # Retry only an LWP-generated transport failure, never an origin # server's real HTTP response. last unless ($response->header('Client-Warning') || '') eq 'Internal response'; } my $code = $response->code; my $location = $response->header('Location'); if($code == 301 || $code == 302 || $code == 303 || $code == 307 || $code == 308) { die "Invalid redirect\n" unless defined($location) && length($location); die "Too many redirects\n" if $redirects == 5; # Resolve relative redirects against the logical hostname, not the # numeric address used for the pinned network connection. $logical = normalized_http_uri(URI->new_abs($location, $logical)->as_string); next; } die "Remote fetch failed\n" unless $response->is_success; die "Remote response is too large\n" if ($response->header('Client-Aborted') || '') eq 'max_size'; my $encoding = lc($response->header('Content-Encoding') || 'identity'); die "Encoded remote responses are not supported\n" unless $encoding eq '' || $encoding eq 'identity'; my $body = $response->decoded_content(charset => 'none'); die "Remote response is too large\n" if length($body) > 2 * 1024 * 1024; return ($body, $logical->as_string); } die "Too many redirects\n"; } $query = new CGI; print $query->header(); $self = $ENV{SCRIPT_NAME}; $perl = $ENV{DOCUMENT_ROOT}; $html = ''; $baseurl = ''; print < HTML To BB Code Converter
Gary's Hood
Articles
Programs
Web Applications
Interactive
Myspace Generators
Contact

AIM:   AIMGarys Hood Bot
Email: admin@garyshood.com
RSS:  Subscribe

Valid HTML 4.01 Transitional Valid CSS!
STARTHTML if ($query->param("html")) { $html = $query->param("html"); } if ($query->param("baseurl")) { $baseurl = $query->param("baseurl"); my ($file, $final_url); my $fetch_error = ''; eval { ($file, $final_url) = fetch_public_url($baseurl); 1; } or do { $fetch_error = $@ || "Remote fetch failed\n"; }; if($fetch_error ne '') { $fetch_error =~ s/[\r\n]+$//; print '

' . encode_entities($fetch_error) . ".

\n"; $html = ''; $baseurl = ''; } else { $html = $file; $baseurl = $final_url; } } @domain = split(/\//,$baseurl); if(@domain > 3) { pop(@domain); } $store = ""; foreach $base(@domain) { $store = "$store$base"; } $store =~ s/http:/http:\/\//gi; $store =~ s/https:/https:\/\//gi; $baseurl = $store; if (!$query->param("ascii")) { $html =~ s/\s\s+/\n/gi; $html =~ s/(.*?)<\/pre>/\[code]$2\[\/code]/sgmi; } $html =~ s/\n//gi; $html =~ s/\r\r//gi; $html =~ s/\Q$baseurl\E//gi if defined($baseurl) && $baseurl ne ''; $html =~ s/(.*?)<\/h[1-7]>/\n\[b]$2\[\/b]\n/sgmi; $html =~ s/

/\n\n/gi; $html =~ s//\n/gi; $html =~ s/(.*?)<\/textarea>/\[code]$2\[\/code]/sgmi; $html =~ s/(.*?)<\/b>/\[b]$1\[\/b]/gi; $html =~ s/(.*?)<\/i>/\[i]$1\[\/i]/gi; $html =~ s/(.*?)<\/u>/\[u]$1\[\/u]/gi; $html =~ s/(.*?)<\/em>/\[i]$1\[\/i]/gi; $html =~ s/(.*?)<\/strong>/\[b]$1\[\/b]/gi; $html =~ s/(.*?)<\/cite>/\[i]$1\[\/i]/gi; $html =~ s/(.*?)<\/font>/\[color=$1]$2\[\/color]/sgmi; $html =~ s/(.*?)<\/font>/\[color=$1]$2\[\/color]/sgmi; $html =~ s///gi; $html =~ s/(.*?)<\/li>/\[\*]$2/gi; $html =~ s//\[list]/gi; $html =~ s/<\/ul>/\[\/list]/gi; $html =~ s/

/\n/gi; $html =~ s/<\/div>/\n/gi; $html =~ s// /gi; $html =~ s//\n/gi; $html =~ s//\[img]$baseurl\/$2\[\/img]/gi; $html =~ s/(.*?)<\/a>/\[url=$baseurl\/$2]$4\[\/url]/gi; $html =~ s/\[url=$baseurl\/http:\/\/(.*?)](.*?)\[\/url]/\[url=http:\/\/$1]$2\[\/url]/gi; $html =~ s/\[img]$baseurl\/http:\/\/(.*?)\[\/img]/\[img]http:\/\/$1\[\/img]/gi; $html =~ s/(.*?)<\/head>//sgmi; $html =~ s/(.*?)<\/object>//sgmi; $html =~ s/(.*?)<\/script>//sgmi; $html =~ s/(.*?)<\/style>//sgmi; $html =~ s/(.*?)<\/title>//sgmi; $html =~ s/<!--(.*?)-->/\n/sgmi; $html =~ s/\/\//\//gi; $html =~ s/http:\//http:\/\//gi; $html =~ s/https:\//https:\/\//gi; $html =~ s/<(?:[^>'"]*|(['"]).*?\1)*>//gsi; $html =~ s/\r\r//gi; $html =~ s/\[img]\//\[img]/gi; $html =~ s/\[url=\//\[url=/gi; if(!defined($html)) { $html = "$baseurl Site not found.\n"; } $html_output = encode_entities($html); print "<h1>HTML To BB Code Converter</h1>\n"; print <<MOREHTML; <div class="para" style="margin-top:5px;"> <div class="div_head">Download:</div> <div class="pad"> <p> <a href="download.php?d=zip">source.zip</a><br> <a href="download.php?d=source">source.txt</a> </p> </div> </div> <p> <script type="text/javascript"><!-- google_ad_client = "pub-4431035264632182"; /* 728x90, created 5/19/08 */ google_ad_slot = "7565484123"; google_ad_width = 728; google_ad_height = 90; //--> </script> <script type="text/javascript" src="https://pagead2.googlesyndication.com/pagead/show_ads.js"> </script> </p> <div class="para"> <div class="div_head">Usage</div> <div class="pad"> <p> This is a form that will convert basic HTML into BB code that is used on various forums. It will strip out most HTML that cannot be converted. </p> </div> </div> <br> <div class="para"> <div class="div_head">Convert</div> <div class="pad"> <form method="post" action="./"> <input type="checkbox" name="ascii">Check this for ASCII Art<br> Website: <input type="text" name="baseurl"> <input type="submit" value="Submit URL"><br> HTML:<br> <textarea cols="80" rows="30" name="html" style="max-width:100%;">$html_output</textarea> <p><input type="submit" value="Submit HTML" class="noindent"></p> </form> </div> </div> </div> MOREHTML print "</body>\n"; print "</html>\n"; undef $html; undef $baseurl; undef $file;