Quellcode

#!/usr/bin/perl
$szBody    = '';
$szWarn    = 'red';
$szSuspect = 'orange';
$szLevelColor = 'blue';

if( $ARGV[0] eq 'ja' ||
    $ENV{'HTTP_USER_AGENT'} =~ /jp|ja/i ||
    $ENV{'HTTP_ACCEPT_LANGUAGE'} =~ /jp|ja/i ) {
  $fszJapanese = 'yes';
}
if( $ARGV[0] eq 'en' ) {
  $fszJapanese = '';
}

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

while( ( $szName, $szValue ) = each %ENV ) {
  next if( $szName !~ /^HTTP_/ );
  $szValue =~ s/\t/ /g;
  push( @aszValues, "$szName=\t$szValue \t$szName=\t$szValue");
}

@aszEnvValues = sort( @aszValues );

if( $fszCSS eq 'yes' ) {
  $szColor  = "<STRONG style=\"color:";
  $szEndTag = "</STRONG>";
} else {
  $szColor  = "<FONT color=\"";
  $szEndTag = "</FONT>";
}

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

&judgement();

&html;

exit;

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

  if( $szRemoteHost eq $szRemoteAddr ) {
    $szRH_Result  = 'IP Addr.';
    return;

  } else {
    $szCheck_RH = $szRemoteHost;
    if( $szCheck_RH =~ /www.*cache|[URL]www.*proxy[/URL]|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 ) {
      $szCheck_RH   =~ s#$&#$szColor$szWarn">$&$szEndTag#;
      $szRH_Result  = 'Via a Proxy';
        $szRH_Comment .= " REMOTE_HOST includes proxy server word \"$szCheck_RH\".";

    } elsif( $szCheck_RH =~ /server|gate|www|web|dns|ftp|mail|news|cgi|pop|smtp/i ) {
      $szCheck_RH   =~ s#$&#$szColor$szSuspect">$&$szEndTag#;
      $szRH_Result  = '?';
        $szRH_Comment .= " REMOTE_HOST includes proxy server like word \"$szCheck_RH\".";
    }

    @aiHosts = split( /\./, $szCheck_RH );
    if( $#aiHosts == 1 ) {
      $szCheck_RH = "$szColor$szSuspect\">$szCheck_RH$szEndTag";
      $szRH_Result  = '?';
        $szRH_Comment .= " REMOTE_HOST includes only one period, it's dubious.";
      return;

    } elsif( $szRH_Result ne 'Via a Proxy' ) {
      if( $aiHosts[0] !~ /\d/ ) {
        $aiHosts[0]    = "$szColor$szSuspect\">$aiHosts[0]$szEndTag";
        $szRH_Result   = '?';
          $szRH_Comment .= " REMOTE_HOST includes no numbers, it's dubious.";

      } elsif( $aiHosts[0] =~ /\D\d$/ ) {
        $aiHosts[0]    = "$szColor$szSuspect\">$aiHosts[0]$szEndTag";
        $szRH_Result   = '?';
        if( $fszJapanese eq 'yes' ) {
          $szRH_Comment .= " REMOTE_HOST includes only one number, it's dubious.";
        }
      }
      $szCheck_RH = join( '.', @aiHosts );
    }
  }
}

#-----// Proxy env. value,User-Agent, Keep-Alive check //----#
sub proxyenv_check {
  local( $szEnvValue, $szName, $szValue, $szNameStat, $szValueStat );

  foreach $szEnvValue ( @aszEnvValues ) {
    chop( $szEnvValue ) if( $szEnvValue =~ /\n$/ );
    ( $szName, $szValue, $szNameStat, $szValueStat )
      = split( /\t/, $szEnvValue );

    if( $szName eq 'HTTP_USER_AGENT=' && $szValue =~ /via/i ) {
      $szValueStat =~ s/via/$szColor$szWarn">via$szEndTag/i;
      $szResult    = 'Via a Proxy';
        $szComment  .= ' USER_AGENT includes "via".';

    } elsif( $szName eq 'HTTP_CONNECTION=' ) {
      if( $szValue !~ /Keep-Alive/i ) {
        $szValueStat = "$szColor$szWarn\">$szValueStat$szEndTag";
        $szResult    = 'Anonymized' if( $szResult ne 'Via a Proxy' );
          $szComment  .= " CONNECTION doesn't have \"Keep-Alive\".";
      } else {
        $iNoProxy++;
        $fszKeepAlive = 'existed';
      }

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

      if( $szName !~ /HTTP_(VIA=|.ROXY_.ONNECTION=|X_FORWARDED_FOR=|FORWARDED=|CACHE_CONTROL=|CACHE_INFO=|FROM=|CLIENT_IP=|TE=|SP_HOST=|XONNECTION=)/ ) {
        $szNameStat =~ s/$szName/$szColor$szSuspect">$szName$szEndTag/i;
        $szResult   = 'Via a Proxy';
          $szComment .= ' Dubious valuable is detected.' if( $szComment !~ /Dubious/ );
      } else {
        $szNameStat =~ s/$&/$szColor$szWarn">$&$szEndTag/i;
        $szResult   = 'Via a Proxy';
          $szComment .= ' Proxy servers valuable is detected.' if( $szComment !~ /Proxy/ );
      }
    } else {
      $iNoProxy++ if( $szName !~ /HTTP_(CONNECTION=|HOST=|PRAGMA=|UA_|ACCEPT|REFERER=|MIME=|EXTENSION=|IF_MODIFIED_SINCE=|COOKIE=)/ );
    }
    $szEnvValue = "$szName\t$szValue\t$szNameStat\t$szValueStat\n";
  }
  return;
}

#-----// Spill IP addr. check //----#
sub spillenv_check {
  local( $szEnvValue, $szName, $szValue, $szNameStat, $szValueStat );
  local( $szSpill );
  local( $szHex, $szHexAddr );
  local( $szItselfHost, $szSpillHost );
  local( $sz2Host, $szIpTemp, $sz2Ip );
  local( %aszSeen, $iSpillNum );
  local( @aszTemp );

  foreach $szEnvValue ( @aszEnvValues ) {
    chop( $szEnvValue ) if( $szEnvValue =~ /\n$/ );
    ( $szName, $szValue, $szNameStat, $szValueStat ) = split( /\t/, $szEnvValue );

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

      $szSpill =~ s/$szRemoteHost//g;
      $szSpill =~ s/$szRemoteAddr//g;

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

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

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

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

      #-----// HTTP_CLIENT_IP //----#
      if( $szName eq 'HTTP_CLIENT_IP=' ) {
        $szHex = $szSpill;
        if( $szHex !~ /\./ && $szHex =~ s/^([\dA-F]{2})([\dA-F]{2})([\dA-F]{2})([\dA-F]{2})/$1$2$3$4/i ) {
          $szHexAddr = join( '.', hex( $1 ), hex( $2 ), hex( $3 ), hex( $4 ) );
          push( @aszSpillAddr, "$szHexAddr" );
          $szValueStat .= " -&gt; $szHexAddr";
        }
      }
      $szSpill =~ s/:|\,|;|//g;

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

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

      #-----// .*** //----#
      } elsif( $szSpill =~ /\.[a-zA-Z]{2,3}[^a-zA-Z0-9_\-\.]+/ ) {
        $szSpill =~ s#([a-zA-Z0-9_\-\.]+)\.([a-zA-Z]{2,3})[^a-zA-Z0-9_\-\.]+#$1.$2#i;
        $szSpillAddr = "$1.$2";
        push( @aszSpillAddr, "$szSpillAddr" );
      }
    }
    $szEnvValue = "$szName\t$szValue\t$szNameStat\t$szValueStat";
  }
  foreach $szSpillAddr ( @aszSpillAddr ) {
    if( $szSpillAddr !~ /www.*cache|[URL]www.*proxy[/URL]|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( @aszTemp, $szSpillAddr );
    }
  }
  @aszSpillAddr = @aszTemp;

  #-----// Remove Proxy's IP addr. //----#
  foreach $szItselfHost ( @aszItselfHost ) {
    next if( $szItselfHost !~ /\./ );
    $szItselfHost =~ tr/A-Z/a-z/;
    chop( $szItselfHost ) if( $szItselfHost =~ /\n$/ );
    foreach $szSpillAddr ( @aszSpillAddr ) {
      $szSpillAddr =~ tr/A-Z/a-z/;
      chop( $szSpillAddr ) if( $szSpillAddr =~ /\n$/ );
      if( $szItselfHost !~ /[a-z]/ ) {
        $sz2Host = gethostbyaddr( pack( 'C4', split( /\./, $szItselfHost ) ), 2 );
      } else {
        $szIpTemp = ( gethostbyname( $szItselfHost ) )[4];
        $sz2Ip    = join( '.', unpack( 'C4', $szIpTemp ) );
      }
      if( $szItselfHost eq $szSpillAddr || $sz2Host eq $szSpillAddr || $sz2Ip eq $szSpillAddr ) {
        $szSpillAddr .= ":p";
        next;
      }
    }
    $szSpillAddr .= "\n";
  }

  foreach $szSpillAddr ( @aszSpillAddr ) {
    chop( $szSpillAddr ) if( $szSpillAddr =~ /\n$/ );
    #-----// Remove Local IP addr and Fake? IP addr //-----#
    if( $szSpillAddr =~ /^127\./ ||
        $szSpillAddr =~ /^172\.1[6-9]\./ ||
        $szSpillAddr =~ /^172\.2\d\./ ||
        $szSpillAddr =~ /^172\.3[0-2]\./ ||
        $szSpillAddr =~ /^10\./ ||
        $szSpillAddr =~ /^192\.168\./ ||
        $szSpillAddr =~ /\.0$/ ||
        $szSpillAddr =~ /^0\./ ||
        $szSpillAddr =~ /\.255$/ ||
        $szSpillAddr =~ /^255\./ ) {
      $szSpillAddr .= ':f';
      next;
    }

Quellcode

#-----// Remove itself IP addr/host //-----#
    undef( $sz2Host );
    undef( $sz2Ip );
    undef( $szIpTemp );
    if( $szSpillAddr !~ /[a-z]/ ) {
      $sz2Host = gethostbyaddr( pack( 'C4', split( /\./, $szSpillAddr ) ), 2 );
    } else {
      $szIpTemp = ( gethostbyname( $szSpillAddr ) )[4];
      $sz2Ip    = join( '.', unpack( 'C4', $szIpTemp ) );
    }
    if( $sz2Host eq $szRemoteHost || $sz2Ip eq $szRemoteAddr ) {
      $szSpillAddr .= ":s";
    }
    unless( $aszSeen{$szSpillAddr}++ ) {}
    $szSpillAddr .= "\n";
  }
  foreach $szSpillAddr ( @aszSpillAddr ) {
    chop( $szSpillAddr ) if( $szSpillAddr =~ /\n$/ );
    if( $szSpillAddr !~ /:x|:f|:s|:p/ ) {
      $iSpillNum++;
      $szYourHost = $szSpillAddr;
    }
  }

  $szAddrTop = $szRemoteAddr;
  $szAddrTop =~ s/([^\.]+)\.([^\.]+)\.([^\.]+)\..+/$1\.$2\.$3\./;
  $szHostTop = $szRemoteHost;
  if( $szHostTop =~ /\.[^\.]{2,3}\.[^\.]{2,3}$/ ) {
    $szHostTop =~ s/[^\.]*\.*([^\.]+)\.([^\.]+)\.([^\.]+)$/$1\.$2\.$3/;
  } else {
    $szHostTop =~ s/[^\.]*\.*([^\.]+)\.([^\.]+)$/$1\.$2/;
  }

  if( $iSpillNum == 0 ) {
    $szYourHost = 'Anonymous';

  } elsif( $iSpillNum != 1 ) {
    undef( @aszTemp );
    while( ( $szSpillHost, $iSpillNum ) = each %aszSeen ) {
      next if( $szSpillHost =~ /^($szAddrTop[^\. ]+)/ );
      next if( $szSpillHost =~ /(\.{0,1}$szHostTop)$/ );
      push( @aszTemp, $szSpillHost );
    }
    $szYourHost = $aszTemp[0];
    $szYourHost = 'Anonymous' if( $szYourHost eq '' );

  } else {
    #-----// ***.***.***.??? //----#
    if( $szYourHost =~ /^($szAddrTop[^\. ]+)/ ) {
      $fszInner = 'true';

    #-----// ??...??.*** //----#
    } elsif( $szYourHost =~ /(\.{0,1}$szHostTop)$/ ) {
      $fszInner = 'true';
    }
  }
  return;
}
#-----// Judgement //----#
sub judgement {

  #-----// Low Suspect //----#
  if( $iNoProxy == 2 && $szResult eq '' ) {
    $szResult  = 'NoProxy!';
      $szComment = 'Like no proxy server.';
  } elsif( $szResult eq '' && $fszKeepAlive eq '' ) {
    $szResult   = 'Anonymized';
      $szComment .= 'No "Connection=Keep-Alive" is dubious';
  }

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

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

  #-----// Via a Proxy //----#
  } else {
    if( $szRH_Result eq 'IP Addr.' ) {
      $szJudge    = '3';
        $szJComment = 'So-so.';
    } elsif ($szRH_Result eq 'Via a Proxy') {
      $szJudge    = '5';
        $szJComment = 'If it is not slow, it is useful.';
    } elsif ($szRH_Result eq '?') {
      $szJudge    = '3';
      if( $fszJapanese eq 'yes' ) {
        $szJComment = 'So-so.';
    } else {
      $szJudge    = '4';
        $szJComment = 'If it is not slow, it is useful.';
    }
  }

  #-----// SPILL //----#
  if( $szYourHost ne 'Anonymous' ) {
    $szJudge    .= '?';
    if( $fszInner eq 'true' ) {
        $szJComment = 'Internal proxy server?';
    } else {
        $szJComment = 'Spill your REMOTE_HOST?';
    }
    $szJComment .= " (||$szYourHost||)";
  }
  return;
}
# # # # #

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

<HTML lang="jp">
<HEAD>
<META http-equiv="Content-Type" content="text/html; charset=EUC-JP">
<META http-equiv="Content-Style-Type" content="text/css">
<META http-equiv="Content-Script-Type" content="text/javascript">
<STYLE type="text/css">
<!--
A.noborder:link{
        color:white;
        text-decoration:none;
}
A.noborder:visited{
        color:white;
        text-decoration:none;
}
A.noborder:active{
        color:white;
        text-decoration:none;
}
A.noborder:hover{
        color:white;
        text-decoration:none;
}
//-->
</STYLE>
</HEAD>
_HTML_

  print <<"_HTML_";
<DIV style="text-align:center">$szTitle</DIV>

<HR>

<PRE>
_HTML_
  if( $ARGV[0] eq 'debug' ) {
   print "itself_host : @aszItselfHost<HR>\n";
   print "spill_addr : @aszSpillAddr<HR>\n";
  }
  if( $szCheck_RH =~ /$szWarn"/ ) {
    print " $szColor$szWarn\">via$szEndTag  - REMOTE_HOST=$szCheck_RH\n";
  } elsif( $szCheck_RH =~ /$szSuspect"/ ) {
    print "  $szColor$szSuspect\">?$szEndTag   - REMOTE_HOST=$szCheck_RH\n";
  } else {
    print "        REMOTE_HOST=$szRemoteHost\n";
  }
  print "        REMOTE_ADDR=||$szRemoteAddr||\n\n";
  foreach $szEnvValue ( @aszEnvValues ) {
    $szEnvValue =~ s/^[^\t]+\t[^\t]+\t([^\t]+)\t([^\t]+)/$1$2/;
    if( $szYourHost ne 'Anonymous' && $szEnvValue =~ /$szYourHost/ ) {
      print "$szColor$szWarn\">SPILL$szEndTag - ";
      if( $szEnvValue !~ />$szYourHost</ ) {
        $szEnvValue =~ s/$szYourHost/$szColor$szWarn">$szYourHost$szEndTag/i;
      }
    } elsif( $szEnvValue =~ /$szWarn"/ ) {
      print " $szColor$szWarn\">via$szEndTag  - ";
    } elsif( $szEnvValue =~ /$szSuspect"/ ) {
      print "  $szColor$szSuspect\">?$szEndTag   - ";
    } else {
      print "        ";
    }
    print "$szEnvValue\n";
  }
  if( $szRH_Comment eq '' ) {
      $szRH_Comment = "Maybe no problem.";
  }
  if( $szComment eq '' ) {
      $szComment = "Maybe no problem.";
  }
  print <<"_HTML_";
</PRE>

<HR>

<UL>
<LI>REMOTE_HOST
<DL>
<DT>Result<DD>$szRH_Result
<DT>Comment<DD>$szRH_Comment
</DL>
<BR>
<LI>HTTP Env. Value
<DL>
<DT>Result<DD>||$szResult||
<DT>Comment<DD>$szComment
</DL>
<BR>
<LI>AnonyLevel : $szColor$szLevelColor">||$szJudge||$szEndTag<BR>
&nbsp; $szJComment
</UL>

<HR>
|| ||
</DIV>
</BODY>
</HTML>
_HTML_
  return;
}

__END__