#!/usr/bin/perl

# ProxyJudge V2.28

#-----// title tag //-----#
$title   = 'ProxyJudge V2.28';

#-----// BODY tag //-----#
$body    = 'bgcolor="#000000" text="#ffffff" link="#00ddff" vlink="#ddddff" alink="#0000ff"';

#-----// Warning tag color //----#
$warn    = '#ff0000';

#-----// Suspection tag color //----#
$suspect = 'orange';

#-----// Anony Level color //----#
$levelcolor = 'yellow';

# # # # # # # # # #

$remote_host = $ENV{'REMOTE_HOST'};
$remote_addr = $ENV{'REMOTE_ADDR'};
if ( ($remote_host eq $remote_addr) || ($remote_host eq '') ) {
  $remote_host        = gethostbyaddr(pack('C4', split(/\./, $remote_addr)), 2) || $remote_addr;
  $ENV{'REMOTE_HOST'} = $remote_host;
}

while (($a, $b) = each %ENV) {
  next if ($a !~ /^HTTP_/);
  $b =~ s/\t/ /g;
  push(@dat, "$a=\t$b \t$a=\t$b");
}
@envdat = sort(@dat);

&remotehost_check();
&proxyenv_check();
&spillenv_check();

&judgement();

&html;

exit;

# # # # # # # # # #

#-----// REMOTE_HOST check //----#
sub remotehost_check {
  local(@hostz);

  if ($remote_host eq $remote_addr) {
    $rh_result  = 'IP Addr.';
    $rh_comment = 'I have no idea.';
    return;

  } else {
    $chk_rh = $remote_host;
    if ($chk_rh =~ /www.*cache|www.*proxy|webcache|delegate|gatekeeper|firewall|proxy|cache|squid|^bbs|^http|^www|^web|^dns|^ftp|^mail|^news|^cgi|^gate|^server|^pop|^smtp|^w3\.|^ns\d{0,2}\.|^fw\d{0,2}\./i) {
      $chk_rh     =~ s#$&#<FONT color="$warn">$&</FONT>#;
      $rh_result  = 'Via a Proxy';
      $rh_comment = ' REMOTE_HOST includes proxy server word.';

    } elsif ($chk_rh =~ /server|gate|www|web|dns|ftp|mail|news|cgi|pop|smtp/i) {
      $chk_rh     =~ s#$&#<FONT color="$suspect">$&</FONT>#;
      $rh_result  = '?';
      $rh_comment = ' REMOTE_HOST includes like proxy server word.';
    }

    @hostz = split(/\./, $chk_rh);
    if ($#hostz == 1) {
      $chk_rh     = "<FONT color=\"$suspect\">$chk_rh</FONT>";
      $rh_result  = '?';
      $rh_comment = " REMOTE_HOST includes only one period, it's dubious.";
      return;

    } elsif ($rh_result ne 'Via a Proxy') {
      if ($hostz[0] !~ /\d/) {
        $hostz[0]    = "<FONT color=\"$suspect\">$hostz[0]</FONT>";
        $rh_result   = '?';
        $rh_comment .= " REMOTE_HOST includes no numbers, it's dubious.";
      } elsif ($hostz[0] =~ /\D\d$/) {
        $hostz[0]    = "<FONT color=\"$suspect\">$hostz[0]</FONT>";
        $rh_result   = '?';
        $rh_comment .= " REMOTE_HOST includes only one number, it's dubious.";
      }
      $chk_rh = join('.', @hostz);
    }
  }
}

# # # # #

#-----// Proxy env. value,User-Agent, Keep-Alive check //----#
sub proxyenv_check {
  local($envdat, $name, $val, $namestat, $valstat);

  foreach $envdat (@envdat) {
    chop($envdat) if ($envdat =~ /\n$/);
    ($name, $val, $namestat, $valstat) = split(/\t/, $envdat);

    if ( ($name eq 'HTTP_USER_AGENT=') && ($val =~ /via/i) ) {
      $valstat  =~ s/via/<FONT color="$warn">via<\/FONT>/i;
      $result   = 'Via a Proxy';
      $comment .= ' USER_AGENT includes "via".';

    } elsif ($name eq 'HTTP_CONNECTION=') {
      if ($val !~ /Keep-Alive/i) {
        $valstat  = "<FONT color=\"$warn\">$valstat</FONT>";
        $result   = 'Anonymized' if ($result ne 'Via a Proxy');
        $comment .= " CONNECTION doesn't have \"Keep-Alive\".";
      } else {
        $noproxy++;
        $keepalive = 'existed';
      }

    } elsif ($name !~ /HTTP_(CONNECTION=|USER_AGENT=|HOST=|PRAGMA=|UA_|ACCEPT|REFERER=|MIME=|EXTENSION=|IF_MODIFIED_SINCE=)/) {

      if ($name !~ /HTTP_(VIA=|.ROXY_.ONNECTION=|X_FORWARDED_FOR=|FORWARDED=|CACHE_CONTROL=|CACHE_INFO=|FROM=|CLIENT_IP=|TE=|SP_HOST=|XONNECTION=)/) {
        $namestat =~ s/$name/<FONT color="$suspect">$name<\/FONT>/i;
        $result   = 'Via a Proxy';
        $comment .= ' Dubious valuable is detected.' if ($comment !~ /Dubious/i);
      } else {
        $namestat =~ s/$&/<FONT color="$warn">$&<\/FONT>/i;
        $result   = 'Via a Proxy';
        $comment .= ' Proxy servers valuable is detected.' if ($comment !~ /Proxy/i);
      }
    } else {
      $noproxy++ if ($name !~ /HTTP_(CONNECTION=|HOST=|PRAGMA=|UA_|ACCEPT|REFERER=|MIME=|EXTENSION=|IF_MODIFIED_SINCE=)/);
    }
    $envdat = "$name\t$val\t$namestat\t$valstat\n";
  }
  return;
}

# # # # #

#-----// Spill IP addr. check //----#
sub spillenv_check {
  local($envdat, $name, $val, $namestat, $valstat);
  local($spill);
  local($hex, $hex_addr);
  local($itself_host, $spill_host);
  local($to_host, $ip_tmp, $to_ip);
  local(%seen, $spill_num);
  local(@temp);

  foreach $envdat (@envdat) {
    chop($envdat) if ($envdat =~ /\n$/);
    ($name, $val, $namestat, $valstat) = split(/\t/, $envdat);

    if ($name !~ /HTTP_(.ONNECTION=|USER_AGENT=|HOST=|PRAGMA=|UA_|ACCEPT|REFERER=|MIME=|EXTENSION=|.ROXY_.ONNECTION=|IF_MODIFIED_SINCE=|CACHE_CONTROL=|CACHE_INFO=)/) {
      $spill = $val;

      $spill =~ s/$remote_host//g;
      $spill =~ s/$remote_addr//g;

      $spill =~ s/\([^\(\)]+\)//g;
      $spill =~ s/ for / /ig;
      $spill =~ s/ by / /ig;
      $spill =~ s/ - / /g;
      $spill =~ s/-\@//g;

      #-----// HTTP_FORWARDED //----#
      if ($spill =~ m#http://#) {
        while ($spill =~ s#http://([^:]+):##i) {
          push(@itself_host, "$1");
        }
      }

      #-----// HTTP_VIA //----#
      if ($name eq 'HTTP_VIA=') {
        while ($spill =~ s# ([^ :]+):# :#i) {
          push(@itself_host, "$1");
        }
      }

      #-----// HTTP_X_FORWARDED_FOR //----#
      if ($name eq 'HTTP_X_FORWARDED_FOR=') {
        while ($spill =~ s#(\d+\.\d+\.\d+\.\d+)\,*# #i) {
          push(@spill_addr, "$1");
        }
      }

      #-----// HTTP_CLIENT_IP //----#
      if ($name eq 'HTTP_CLIENT_IP=') {
        $hex = $spill;
        if ( ($hex !~ /\./) && ($hex =~ s/^([\dA-F]{2})([\dA-F]{2})([\dA-F]{2})([\dA-F]{2})/$1$2$3$4/i) ) {;
          $hex_addr = join('.', hex($1), hex($2), hex($3), hex($4));
          push(@spill_addr, "$hex_addr");
          $valstat .= " -&gt; $hex_addr";
        }
      }
      $spill =~ s/:|\,|;|//g;

      #-----// IP addr. //----#
      if ($spill =~ s/[^a-zA-Z0-9_\-\.]*(\d+)\.(\d+)\.(\d+)\.(\d+)[^a-zA-Z0-9_\-\.]+/$1.$2.$3.$4/i) {
        $spill_addr = "$1.$2.$3.$4";
        push(@spill_addr, "$spill_addr");
      }

      #-----// .***.*** //----#
      if ($spill =~ /\.[^\.]{2,3}\.[a-zA-Z]{2,3}[^a-zA-Z0-9_\-\.]+/) {
        $spill =~ s#([a-zA-Z0-9_\-\.]+)\.([^\.]{2,3})\.([a-zA-Z]{2,3})[^a-zA-Z0-9_\-\.]+#$1.$2.$3#i;
        $spill_addr = "$1.$2.$3";
        push(@spill_addr, "$spill_addr");

      #-----// .*** //----#
      } elsif ($spill =~ /\.[a-zA-Z]{2,3}[^a-zA-Z0-9_\-\.]+/) {
        $spill =~ s#([a-zA-Z0-9_\-\.]+)\.([a-zA-Z]{2,3})[^a-zA-Z0-9_\-\.]+#$1.$2#i;
        $spill_addr = "$1.$2";
        push(@spill_addr, "$spill_addr");
      }
    }
    $envdat = "$name\t$val\t$namestat\t$valstat";
  }
  foreach $spill_addr (@spill_addr) {
    if ($spill_addr !~ /www.*cache|www.*proxy|webcache|delegate|gatekeeper|firewall|proxy|cache|squid|^bbs|^http|^www|^web|^dns|^ftp|^mail|^news|^cgi|^gate|^server|^pop|^smtp|^w3\.|^ns\d{0,2}\.|^fw\d{0,2}\./i) {
      push(@temp, $spill_addr);
    }
  }
  @spill_addr = @temp;
  #-----// Remove Proxy's IP addr. //----#
  foreach $itself_host (@itself_host) {
    next if ($itself_host !~ /\./);
    $itself_host =~ tr/A-Z/a-z/;
    chop($itself_host) if ($itself_host =~ /\n$/);
    foreach $spill_addr (@spill_addr) {
      $spill_addr =~ tr/A-Z/a-z/;
      chop($spill_addr) if ($spill_addr =~ /\n$/);
      if ($itself_host !~ /[a-z]/) {
        $to_host = gethostbyaddr(pack('C4', split(/\./, $itself_host)), 2);
      } else {
        $ip_tmp = (gethostbyname($itself_host))[4];
        $to_ip  = join(".", unpack('C4', $ip_tmp));
      }
      if ( ($itself_host eq $spill_addr) || ($to_host eq $spill_addr) || ($to_ip eq $spill_addr) ) {
        $spill_addr .= ":x";
        next;
      }
    }
    $spill_addr .= "\n";
  }
  foreach $spill_addr (@spill_addr) {
    chop($spill_addr) if ($spill_addr =~ /\n$/);
    if ( ($spill_addr =~ /^127\./) ||
       ($spill_addr =~ /^172\.1[6-9]\./) ||
       ($spill_addr =~ /^172\.2\d\./) ||
       ($spill_addr =~ /^172\.3[0-2]\./) ||
       ($spill_addr =~ /^10\./) ||
       ($spill_addr =~ /^192\.168\./) ||
       ($spill_addr =~ /\.0$/) ||
       ($spill_addr =~ /^0\./) ||
       ($spill_addr =~ /\.255$/) ||
       ($spill_addr =~ /^\d{1,3}\.\d{1,3}\.255\./) ||
       ($spill_addr =~ /^\d{1,3}\.255\./) ||
       ($spill_addr =~ /^255\./) ) {
      $spill_addr .= ':x';
    }
    undef($to_host);
    undef($to_ip);
    undef($ip_tmp);
    if ($spill_addr !~ /[a-z]/) {
      $to_host = gethostbyaddr(pack('C4', split(/\./, $spill_addr)), 2);
    } else {
      $ip_tmp = (gethostbyname($spill_addr))[4];
      $to_ip  = join(".", unpack('C4', $ip_tmp));
    }
    if ( ($to_host eq $remote_host) || ($to_ip eq $remote_addr) ) {
      $spill_addr .= ":x";
    }
    unless($seen{$spill_addr}++){}
    $spill_addr .= "\n";
  }
  foreach $spill_addr (@spill_addr) {
    chop($spill_addr) if ($spill_addr =~ /\n$/);
    if ($spill_addr !~ /:x/) {
      $spill_num++;
      $your_host = $spill_addr;
    }
  }
  if ($spill_num == 0) {
    $your_host = 'Anonymous';
  } elsif ($spill_num != 1) {
    $your_host = 'Anonymous';
    while (($spill_host, $spill_num) = each %seen) {
      if ($spill_num > 1) {
        $your_host = $spill_host;
        last;
      }
    }
  } else {
    $addr_top = $remote_addr;
    $addr_top =~ s/([^\.]+)\.([^\.]+)\.([^\.]+)\..+/$1\.$2\.$3\./;
    $host_top = $remote_host;
    if ($host_top =~ /\.[^\.]{2,3}\.[^\.]{2,3}$/) {
      $host_top =~ s/[^\.]*\.*([^\.]+)\.([^\.]+)\.([^\.]+)$/$1\.$2\.$3/;
    } else {
      $host_top =~ s/[^\.]*\.*([^\.]+)\.([^\.]+)$/$1\.$2/;
    }
    #-----// ***.***.***.??? //----#
    if ($your_host =~ /^($addr_top[^\. ]+)/) {
      $inner = 'true';

    #-----// ??...??.*** //----#
    } elsif ($your_host =~ /(\.{0,1}$host_top)$/) {
      $inner = 'true';
    }
  }
  return;
}

# # # # #

#-----// Judgement //----#
sub judgement {

  #-----// Low Suspect //----#
  if ( ($noproxy == 2) && ($result eq '') ) {
    $result  = 'No proxy!';
    $comment = 'Like no proxy server.';
  } elsif ( ($result eq '') && ($keepalive eq '') ) {
    $result   = 'Anonymized';
    $comment .= 'No "Connection=Keep-Alive" is dubious';
  }

  #-----// NoProxy //----#
  if ($result eq 'NoProxy!') {
    if ($rh_result eq 'IP Addr.') {
      $judge     = '1';
      $j_comment = 'REMOTE_HOST that is IP addr. is precious.';
    } elsif ($rh_result eq 'Via a Proxy') {
      $judge     = '3';
      $j_comment = 'HTTP valuables are checked first.';
    } elsif ($rh_result eq '?') {
      $judge     = '2';
      $j_comment = 'Persistent valuables checkers may suspect.';
    } else {
      $judge     = '2';
      $j_comment = 'Useful proxy server.';
    }

  #-----// Anonymized //----#
  } elsif ($result eq 'Anonymized') {
    if ($rh_result eq 'IP Addr.') {
      $judge     = '2';
      $j_comment = 'Nice. It it useful.';
    } elsif ($rh_result eq 'Via a Proxy') {
      $judge     = '3';
      $j_comment = 'HTTP valuables are checked first.';
    } elsif ($rh_result eq '?') {
      $judge     = '3';
      $j_comment = 'Persistent valuables checkers may suspect.';
    } else {
      $judge     = '2';
      $j_comment = 'Useful proxy server.';
    }

  #-----// Via a Proxy //----#
  } else {
    if ($rh_result eq 'IP Addr.') {
      $judge     = '3';
      $j_comment = 'So-so.';
    } elsif ($rh_result eq 'Via a Proxy') {
      $judge     = '5';
      $j_comment = 'If it is not slow, you can use.';
    } elsif ($rh_result eq '?') {
      $judge     = '3';
      $j_comment = 'So-so.';
    } else {
      $judge     = '4';
      $j_comment = 'If it is not slow, you can use.';
    }
  }

  #-----// SPILL //----#
  if ($your_host ne 'Anonymous') {
    $judge    .= '?';
    if ($inner eq 'true') {
      $j_comment = 'Internal proxy server?';
    } else {
      $j_comment = 'Spill your REMOTE_HOST?';
    }
    $j_comment .= " ($your_host)";
  }
  return;
}

# # # # #

#-----// Generate HTML document //----#
sub html {
  print <<"_HTML_";
Content-type: text/html

<HTML>
<HEAD><font color="#0099cc"><TITLE>$title</TITLE></font></HEAD>
<BODY $body>

<CENTER><font color="#0099cc">$title</font></CENTER>

<P><TABLE WIDTH="100%" HEIGHT="20">
<TR><TD BGCOLOR="#212121"><center><FONT COLOR="#FFFFFF" SIZE="-2">back to -=<A HREF="/services.shtml"><FONT
COLOR="#0099cc">Services</FONT></A>=-</FONT></center></TD></TR>
</TABLE><P>

<PRE>
_HTML_
  if ($ARGV[0] ne '') {
   print "itself_host : @itself_host<HR>\n";
   print "spill_addr : @spill_addr<HR>\n";
  }
  if ($chk_rh =~ /color="$warn"/) {
    print " <FONT color=\"$warn\">via</FONT>  - REMOTE_HOST=$chk_rh\n";
  } elsif ($chk_rh =~ /color="$suspect"/) {
    print "  <FONT color=\"$suspect\">?</FONT>   - REMOTE_HOST=$chk_rh\n";
  } else {
    print "        REMOTE_HOST=$remote_host\n";
  }
  print "        REMOTE_ADDR=$remote_addr\n\n";
  foreach $envdat (@envdat) {
    $envdat =~ s/^[^\t]+\t[^\t]+\t([^\t]+)\t([^\t]+)/$1$2/;
    if ( ($your_host ne 'Anonymous') && ($envdat =~ /$your_host/) ) {
      print "<FONT color=\"$warn\">SPILL</FONT> - ";
      if ($envdat !~ />$your_host</) {
        $envdat =~ s/$your_host/<FONT color="$warn">$your_host<\/FONT>/i;
      }
    } elsif ($envdat =~ /color="$warn"/) {
      print " <FONT color=\"$warn\">via</FONT>  - ";
    } elsif ($envdat =~ /color="$suspect"/) {
      print "  <FONT color=\"$suspect\">?</FONT>   - ";
    } else {
      print "        ";
    }
    print "$envdat\n";
  }
print <<"_HTML_";
</PRE>

<P><TABLE WIDTH="100%" HEIGHT="20">
<TR><TD BGCOLOR="#212121"><center><FONT COLOR="#FFFFFF" SIZE="-2"><FONT COLOR="#212121">decker.dlm.21</FONT></center></TD></TR>
</TABLE><P>

<UL>
<LI>REMOTE_HOST
<DL>
<DT>Result<DD>$rh_result
<DT>Comment<DD>$rh_comment
</DL><P>
<LI>HTTP Env. Value
<DL>
<DT>Result<DD>$result
<DT>Comment<DD>$comment
</DL><P>
<LI>AnonyLevel : <FONT size="+2" color="$levelcolor"><B>$judge</B></FONT>(1:Nice - 5:Bad)<BR>
&nbsp; $j_comment<P>
</UL>
<P>
$nozoki_warn
<P><P>

<P>
<TABLE WIDTH="100%" HEIGHT="20">
<TR><TD BGCOLOR="#212121"><center><FONT COLOR="#FFFFFF" SIZE="-2">back to -=<A HREF="/services.shtml"><FONT
COLOR="#0099cc">Services</FONT></A>=-</FONT></center></TD></TR>
</TABLE>
<P>

</BODY>
</HTML>
_HTML_
  return;
}

__END__