#!/usr/bin/perl
use strict;
use warnings;
use Socket;
use Digest::MD5 qw(md5_hex);
use Net::Whois::Raw;
use Geo::IP;

#IP・リモホ・UAを取得
my $ip_addr = "$ENV{'REMOTE_ADDR'}";
my $remoho  = gethostbyaddr(inet_aton($ip_addr), AF_INET);
my $ua = "$ENV{'HTTP_USER_AGENT'}";

#bbs_slipに使用する文字
my @slip_char = (0..9, "a".."z", "A".."Z", ".", "/");
#slip_ip生成
$ip_addr =~ /^(\d{1,4})\.(\d{1,4})/;
my $ip_char1 = $slip_char[$1 % 64];
my $ip_char2 = $slip_char[$2 % 64];
my $slip_ip = $ip_char1 . $ip_char2;
#slip_remoho生成
$remoho =~ /([a-zA-Z][a-zA-Z-\.]+$)/;
my $remoho_name = $1;
my $remoho_dig = md5_hex($remoho_name);
$remoho_dig =~ /^(.{2})(.{2})/;
my $remoho_char1 = $slip_char[hex($1) % 64];
my $remoho_char2 = $slip_char[hex($2) % 64];
my $slip_remoho = $remoho_char1 . $remoho_char2;
#slip_ua生成
my $ua_dig = md5_hex($ua);
$ua_dig =~ /^(.{2})(.{2})(.{2})(.{2})/;
my $ua_char1 = $slip_char[hex($1) % 64];
my $ua_char2 = $slip_char[hex($2) % 64];
my $ua_char3 = $slip_char[hex($3) % 64];
my $ua_char4 = $slip_char[hex($4) % 64];
my $slip_ua = $ua_char1 . $ua_char2 . $ua_char3 . $ua_char4;

#bbs_slipの初期設定
my $slip_id = "";
my $slip_nickname = "ﾜｯﾁｮｲ";
my $slip_aa = $slip_ip;
my $slip_bb = $slip_remoho;
my $slip_cccc = $slip_ua;

#モバイル回線判定用のリモホ・事業者名・IP
my @mobile_lines_remoho = (
  ".*\\.openmobile\\.ne\\.jp",
  ".*\\.panda-world\\.ne\\.jp",
  "KD027.*\\.au-net\\.ne\\.jp",
  "KD036.*\\.au-net\\.ne\\.jp",
  "KD106.*\\.au-net\\.ne\\.jp",
  "KD111.*\\.au-net\\.ne\\.jp",
  "KD119.*\\.au-net\\.ne\\.jp",
  "KD182.*\\.au-net\\.ne\\.jp",
  ".*\\.msa\\.spmode\\.ne\\.jp",
  ".*\\.msb\\.spmode\\.ne\\.jp",
  ".*\\.msc\\.spmode\\.ne\\.jp",
  ".*\\.msd\\.spmode\\.ne\\.jp",
  ".*\\.mse\\.spmode\\.ne\\.jp",
  ".*\\.msf\\.spmode\\.ne\\.jp",
  ".*\\.fix\\.mopera\\.net",
  ".*\\.air\\.mopera\\.net",
  ".*\\.vmobile\\.jp",
  ".*\\.bmobile\\.ne\\.jp",
  ".*\\.mineo\\.jp",
  ".*omed01\\.tokyo\\.ocn\\.ne\\.jp",
  ".*omed01\\.osaka\\.ocn\\.ne\\.jp",
  ".*mobac01\\.tokyo\\.ocn\\.ne\\.jp",
  ".*mobac01\\.osaka\\.ocn\\.ne\\.jp",
  ".*\\.mvno\\.rakuten\\.jp",
  ".*\\.nttpc\\.ne\\.jp",
  "UQ.*au-net\\.ne\\.jp",
  "fl\\d-.*mesh\\.ad\\.jp",
  "neoau.*mesh\\.ad\\.jp",
  ".*\\.ap\\.dream\\.jp",
  ".*\\.ap\\.mvno\\.net",
  "fenics\\d+\\.wlan\\.ppp\\.infoweb\\.ne\\.jp"
);
my @mobile_lines_whois = (
  "Plus One marketing",
  "LogicLinks",
  "SORASIM"
);
my @rakuten_mno_ip = (
  "101\\.102\\.(?:\\d\\.|[1-5]\\d\\.|6[0-3]\\.)\\d{1,3}",
  "103\\.124\\.[0-3]\\.\\d{1,3}",
  "110\\.165\\.(?:1(?:2[89]|[3-9]\\d)|2\\d{2})\\.\\d{1,3}",
  "119\\.30\\.(?:19[2-9]|2\\d{2})\\.\\d{1,3}",
  "119\\.31\\.1(?:2[89]\\.|[3-5]\\d\\.)\\d{1,3}",
  "133\\.106\\.(?:1(?:2[89]|[3-9]\\d)|2\\d{2})\\.\\d{1,3}",
  "133\\.106\\.(?:1[6-9]\\.|2\\d\\.|3[01]\\.)\\d{1,3}",
  "133\\.106\\.(?:3[2-9]\\.|[45]\\d\\.|6[0-3]\\.)\\d{1,3}",
  "133\\.106\\.(?:6[4-9]\\.|[7-9]\\d\\.|1(?:[01]\\d|2[0-7])\\.)\\d{1,3}",
  "133\\.106\\.(?:[89]\\.|1[0-5]\\.)\\d{1,3}",
  "157\\.192(?:\\.\\d{1,3}){2}",
  "193\\.114\\.(?:19[2-9]|2\\d{2})\\.\\d{1,3}",
  "193\\.114\\.(?:3[2-9]\\.|[45]\\d\\.|6[0-3]\\.)\\d{1,3}",
  "193\\.114\\.(?:6[4-9]\\.|[78]\\d\\.|9[0-5]\\.)\\d{1,3}",
  "193\\.115\\.(?:\\d\\.|[12]\\d\\.|3[01]\\.)\\d{1,3}",
  "193\\.117\\.(?:[9][6-9]\\.|1(?:[01]\\d|2[0-7])\\.)\\d{1,3}",
  "193\\.118\\.(?:\\d\\.|[12]\\d\\.|3[01]\\.)\\d{1,3}",
  "193\\.118\\.(?:6[4-9]\\.|[78]\\d\\.|9[0-5]\\.)\\d{1,3}",
  "193\\.119\\.(?:1(?:2[89]|[3-9]\\d)|2\\d{2})\\.\\d{1,3}",
  "193\\.82\\.1(?:[6-8]\\d|9[01])\\.\\d{1,3}",
  "194\\.193\\.2(?:2[4-9]|[34]\\d|5[0-5])\\.\\d{1,3}",
  "194\\.193\\.(?:6[4-9]\\.|[78]\\d\\.|9[0-5]\\.)\\d{1,3}",
  "194\\.223\\.(?:[9][6-9]\\.|1(?:[01]\\d|2[0-7])\\.)\\d{1,3}",
  "202\\.176\\.(?:1[6-9]\\.|2\\d\\.|3[01]\\.)\\d{1,3}",
  "202\\.216\\.(?:\\d\\.|1[0-5]\\.)\\d{1,3}",
  "210\\.157\\.(?:19[2-9]|2(?:[01]\\d|2[0-3]))\\.\\d{1,3}",
  "211\\.133\\.(?:[6-8]\\d|9[01])\\.\\d{1,3}",
  "211\\.7\\.(?:[9][6-9]\\.|1(?:[01]\\d|2[0-7])\\.)\\d{1,3}",
  "219\\.105\\.1(?:4[4-9]|5\\d)\\.\\d{1,3}",
  "219\\.105\\.(?:19[2-9]|2\\d{2})\\.\\d{1,3}",
  "219\\.106\\.(?:\\d{1,2}\\.|1(?:[01]\\d|2[0-7])\\.)\\d{1,3}"
);
#モバイル回線のslip_id
my @mobile_ids = (
  "Sr",
  "Sp",
  "Sa",
  "Sd",
  "SD",
  "MM"
);
#モバイル回線のニックネーム
my @mobile_nicknames = (
  "ｵｯﾍﾟｹM",
  "ｻｻｸｯﾃﾛM",
  "ｱｳｱｳｱｰM",
  "ｱｳｱｳｲｰM",
  "ｱｳｱｳｳｰM",
  "ｱｳｱｳｴｰM",
  "ｱｳｱｳｵｰM",
  "ｱｳｱｳｶｰM",
  "ｽﾌﾟｰM",
  "ｽﾌﾟｯｯM",
  "ｽｯﾌﾟM",
  "ｽｯｯﾌﾟM",
  "ｽﾌﾟﾌﾟM",
  "ｽﾌｯM",
  "ﾍﾟﾗﾍﾟﾗM",
  "ｴｱﾍﾟﾗM",
  "ﾌﾞｰｲﾓM",
  "ﾍﾞｰｲﾓM",
  "ｵｲｺﾗﾐﾈｵM",
  "ﾜﾝﾄﾝｷﾝM",
  "ﾜﾝﾐﾝｸﾞｸM",
  "ﾊﾞｯﾄﾝｷﾝM",
  "ﾊﾞｯﾐﾝｸﾞｸM",
  "ﾗｸｯﾍﾟﾍﾟM",
  "ﾗｸﾗｯﾍﾟM",
  "ｱｳｱｳｸｰM",
  "ﾄﾞｺｸﾞﾛM",
  "ﾄﾞﾅﾄﾞﾅｰM",
  "ﾄﾝﾓｰM",
  "ｱﾒM",
  "ﾆｬﾌﾆｬM",
  "ｲﾙｸﾝM",
  "ｹﾞﾏｰM",
  "ﾌﾘｯﾃﾙM"
);

#スマホ・タブレット判定
if ($ua =~ /.*(iphone|ipad|android|mobile).*/i) {
  $slip_nickname = "ﾜｯﾁｮｲW";
}
#逆引き判定
if ($remoho eq "") { #逆引きできない場合
  my $isunknown = "yes";
  #モバイル回線判定
  my $res = whois($ip_addr);
  my $mobile_nickname_idx = -1;
  for my $name (@mobile_lines_whois) {
    if ($res =~ /.*${name}.*/) {
      $slip_id = "MM";
      $slip_nickname = $mobile_nicknames[$mobile_nickname_idx];
      $slip_aa = $slip_id;
      $slip_bb = $slip_ip;
      $isunknown = "no";
      last;
    }
    $mobile_nickname_idx--;
  }
  #楽天モバイル(MNO)判定
  if ($isunknown eq "yes") {
    for my $name (@rakuten_mno_ip) {
      if ($ip_addr =~ /${name}/) {
        $slip_id = "MM";
        $slip_nickname = "ﾃﾃﾝﾃﾝﾃﾝM";
        $slip_aa = $slip_id;
        $slip_bb = $slip_ip;
        $isunknown = "no";
        last;
      }
    }
  }
  #逆引き不可能 ｱﾝﾀﾀﾞﾚ
  if ($isunknown eq "yes") {
    $slip_id = "Un";
    $slip_nickname = "ｱﾝﾀﾀﾞﾚ";
    $slip_aa = $slip_id;
    $slip_bb = $slip_ip;
  }
}else{ #逆引きできる場合
  #モバイル回線判定
  my $mobile_id_idx = 0;
  my $mobile_nickname_idx = 0;
  for my $name (@mobile_lines_remoho) {
    if ($remoho =~ /^${name}$/) {
      $slip_id = $mobile_ids[$mobile_id_idx];
      $slip_nickname = $mobile_nicknames[$mobile_nickname_idx];
      $slip_aa = $slip_id;
      $slip_bb = $slip_ip;
      last;
    }
    if ($mobile_id_idx < 2 || $mobile_nickname_idx =~ /^(7|9|15)$/) {
      $mobile_id_idx++;
    }
    $mobile_nickname_idx++;
  }
  #社畜判定
  if ($remoho =~ /^.+\.co\.jp$/) {
    $slip_nickname = "ｼｬﾁｰｸ";
  }
}

#国を判定
my $gi = Geo::IP->open("./GeoIPCity.dat", GEOIP_STANDARD);
my $record = $gi->record_by_addr($ip_addr);
my $ip_country =  $record->country_code;
if ($ip_country =~ /^(?!.*JP).*$/) {
  $slip_nickname = "ｶﾞｲｺｰｸ[${ip_country}]";
  $slip_aa = $ip_country;
  $slip_bb = $slip_ip;
}

#bbs_slipを生成
my $bbs_slip = "${slip_nickname} ${slip_aa}${slip_bb}-${slip_cccc}";


print "Content-Type: text/html; charset=UTF-8\n\n";
print "<html>\n";
print "<head><title>ワッチョイもどき生成テスト</title></head>\n";
print "<body>\n";
print "<h1>ワッチョイもどき生成テスト</h1>\n";
print "<p>$bbs_slip</p>\n";
print "</body>\n";
print "</html>\n";