API tools faq
paste
3morfg

0ch_bbsslip.pl

3morfg
Jun 25th, 2022 (edited)
269
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 14.02 KB | None | 0 0
raw download clone embed print report
  1. #============================================================================================================
  2. #
  3. #   拡張機能 - ワッチョイもどき
  4. #   0ch_bbsslip.pl
  5. #
  6. #============================================================================================================
  7. package ZPL_bbsslip;
  8.  
  9. use Socket;
  10. use Digest::MD5 qw(md5_hex);
  11. use Net::Whois::Raw;
  12. use Geo::IP;
  13.  
  14. #------------------------------------------------------------------------------------------------------------
  15. #   コンストラクタ
  16. #------------------------------------------------------------------------------------------------------------
  17. sub new
  18. {
  19.     my $this = shift;
  20.     my ($Config) = @_;
  21.     my ($obj);
  22.    
  23.     $obj = {};
  24.     bless $obj, $this;
  25.    
  26.     return $obj;
  27. }
  28.  
  29. #------------------------------------------------------------------------------------------------------------
  30. #   拡張機能名称取得
  31. #   -------------------------------------------------------------------------------------
  32. #   @return 名称文字列
  33. #------------------------------------------------------------------------------------------------------------
  34. sub getName
  35. {
  36.     my  $this = shift;
  37.     return 'ワッチョイもどき';
  38. }
  39.  
  40. #------------------------------------------------------------------------------------------------------------
  41. #   拡張機能説明取得
  42. #   -------------------------------------------------------------------------------------
  43. #   @return 説明文字列
  44. #------------------------------------------------------------------------------------------------------------
  45. sub getExplanation
  46. {
  47.     my  $this = shift;
  48.     return 'ワッチョイもどきを名前欄に付けます。';
  49. }
  50.  
  51. #------------------------------------------------------------------------------------------------------------
  52. #   拡張機能タイプ取得
  53. #   -------------------------------------------------------------------------------------
  54. #   @return 拡張機能タイプ(スレ立て:1, レス:2, read:4, index:8, 書き込み前処理:16)
  55. #------------------------------------------------------------------------------------------------------------
  56. sub getType
  57. {
  58.     my  $this = shift;
  59.     return (1 | 2);
  60. }
  61.  
  62. #------------------------------------------------------------------------------------------------------------
  63. #   拡張機能実行インタフェイス
  64. #   -------------------------------------------------------------------------------------
  65. #   @param  $sys    MELKOR
  66. #   @param  $form   SAMWISE
  67. #   @param  $type   実行タイプ
  68. #   @return 正常終了の場合は0
  69. #------------------------------------------------------------------------------------------------------------
  70. sub execute
  71. {
  72.     my $this = shift;
  73.     my ($Sys, $Form, $type) = @_;
  74.  
  75.     #板設定の読み込み
  76.     require './module/isildur.pl';
  77.     $this->{'SET'} = ISILDUR->new;
  78.     $this->{'SET'}->Load($Sys);
  79.     my $bbssetting = $this->{'SET'};
  80.  
  81.     #板のBBS_SLIP設定を確認
  82.     my $bbsslip = $bbssetting->Get('BBS_SLIP');
  83.  
  84.     if ($bbsslip eq 'vvvvv') {
  85.         #IP・リモホ・UAを取得
  86.         my $ip_addr = "$ENV{'REMOTE_ADDR'}";
  87.         my $remoho  = gethostbyaddr(inet_aton($ip_addr), AF_INET);
  88.         my $ua = "$ENV{'HTTP_USER_AGENT'}";
  89.  
  90.         #BBS_SLIP機能呼び出し
  91.         my $res = BBS_SLIP($ip_addr, $remoho, $ua);
  92.  
  93.         #名前欄にワッチョイもどきを追加
  94.         my $from = $Form->Get('FROM');
  95.         if ($from eq '') {
  96.             $from = $bbssetting->Get('BBS_NONAME_NAME');
  97.         }
  98.         $from = "${from} </b>(${res})<b> </b>";
  99.         $Form->Set('FROM',$from);
  100.     }
  101.  
  102.     return 0;
  103. }
  104.  
  105. #------------------------------------------------------------------------------------------------------------
  106. #
  107. #   BBS_SLIP機能
  108. #   -------------------------------------------------------------------------------------
  109. #   @param  $ip_addr IPアドレス
  110. #   @param  $remoho リモートホスト
  111. #   @param  $ua ユーザーエージェント
  112. #   @return 結果文字列
  113. #
  114. #------------------------------------------------------------------------------------------------------------
  115. sub BBS_SLIP
  116. {
  117.     my ($ip_addr, $remoho, $ua) = @_;
  118.     my ($slip_ip, $slip_remoho, $slip_ua);
  119.  
  120.     #bbs_slipに使用する文字
  121.     my @slip_char = (0..9, "a".."z", "A".."Z", ".", "/");
  122.     #slip_ip生成
  123.     $ip_addr =~ /^(\d{1,4})\.(\d{1,4})/;
  124.     my $ip_char1 = $slip_char[$1 % 64];
  125.     my $ip_char2 = $slip_char[$2 % 64];
  126.     $slip_ip = $ip_char1 . $ip_char2;
  127.  
  128.     #slip_remoho生成
  129.     if ($remoho eq "") {
  130.         $slip_remoho = "none";
  131.     }else {
  132.         $remoho =~ /^([a-zA-Z]+)[\d\-\.]*([a-zA-Z][a-zA-Z\d\.\-]+)$/;
  133.         my $remoho_name = "$1 $2";
  134.         my $remoho_dig = md5_hex($remoho_name);
  135.         $remoho_dig =~ /^(.{2})(.{2})/;
  136.         my $remoho_char1 = $slip_char[hex($1) % 64];
  137.         my $remoho_char2 = $slip_char[hex($2) % 64];
  138.         $slip_remoho = $remoho_char1 . $remoho_char2;
  139.     }
  140.  
  141.     #slip_ua生成
  142.     my $ua_dig = md5_hex($ua);
  143.     $ua_dig =~ /^(.{2})(.{2})(.{2})(.{2})/;
  144.     my $ua_char1 = $slip_char[hex($1) % 64];
  145.     my $ua_char2 = $slip_char[hex($2) % 64];
  146.     my $ua_char3 = $slip_char[hex($3) % 64];
  147.     my $ua_char4 = $slip_char[hex($4) % 64];
  148.     $slip_ua = $ua_char1 . $ua_char2 . $ua_char3 . $ua_char4;
  149.  
  150.  
  151.     #スマホ・タブレット判定
  152.     my $fixed_nickname_end = "";
  153.     my $mobile_nickname_end = "";
  154.     if ($ua =~ /.*(iphone|ipad|android|mobile).*/i) {
  155.         $fixed_nickname_end = "W";
  156.         $mobile_nickname_end = "M";
  157.     }else {
  158.         $mobile_nickname_end = "T";
  159.     }
  160.  
  161.  
  162.     #bbs_slipの初期設定
  163.     my $slip_id = "";
  164.     my $slip_nickname = "ﾜｯﾁｮｲ${fixed_nickname_end}";
  165.     my $slip_aa = $slip_ip;
  166.     my $slip_bb = $slip_remoho;
  167.     my $slip_cccc = $slip_ua;
  168.  
  169.  
  170.     #モバイル回線判定用のリモホ・事業者名・IP
  171.     my @mobile_remoho = (
  172.         ".*\\.openmobile\\.ne\\.jp",
  173.         ".*\\.panda-world\\.ne\\.jp",
  174.         "KD027.*\\.au-net\\.ne\\.jp",
  175.         "KD036.*\\.au-net\\.ne\\.jp",
  176.         "KD106.*\\.au-net\\.ne\\.jp",
  177.         "KD111.*\\.au-net\\.ne\\.jp",
  178.         "KD119.*\\.au-net\\.ne\\.jp",
  179.         "KD182.*\\.au-net\\.ne\\.jp",
  180.         ".*\\.msa\\.spmode\\.ne\\.jp",
  181.         ".*\\.msb\\.spmode\\.ne\\.jp",
  182.         ".*\\.msc\\.spmode\\.ne\\.jp",
  183.         ".*\\.msd\\.spmode\\.ne\\.jp",
  184.         ".*\\.mse\\.spmode\\.ne\\.jp",
  185.         ".*\\.msf\\.spmode\\.ne\\.jp",
  186.         ".*\\.fix\\.mopera\\.net",
  187.         ".*\\.air\\.mopera\\.net",
  188.         ".*\\.vmobile\\.jp",
  189.         ".*\\.bmobile\\.ne\\.jp",
  190.         ".*\\.mineo\\.jp",
  191.         ".*omed01\\.tokyo\\.ocn\\.ne\\.jp",
  192.         ".*omed01\\.osaka\\.ocn\\.ne\\.jp",
  193.         ".*mobac01\\.tokyo\\.ocn\\.ne\\.jp",
  194.         ".*mobac01\\.osaka\\.ocn\\.ne\\.jp",
  195.         ".*\\.mvno\\.rakuten\\.jp",
  196.         ".*\\.nttpc\\.ne\\.jp",
  197.         "UQ.*au-net\\.ne\\.jp",
  198.         "dcm\\d(?:-\\d+){4}\\.tky\\.mesh\\.ad\\.jp",
  199.         "neoau\\d(?:-\\d+){4}\\.tky\\.mesh\\.ad\\.jp",
  200.         ".*\\.ap\\.dream\\.jp",
  201.         ".*\\.ap\\.mvno\\.net",
  202.         "fenics\\d+\\.wlan\\.ppp\\.infoweb\\.ne\\.jp"
  203.     );
  204.     my @mobile_whois = (
  205.         "Plus One marketing",
  206.         "LogicLinks",
  207.         "SORASIM"
  208.     );
  209.     my @rakuten_mno_ip = (
  210.         "101\\.102\\.(?:\\d|[1-5]\\d|6[0-3])\\.\\d{1,3}",
  211.         "103\\.124\\.[0-3]\\.\\d{1,3}",
  212.         "110\\.165\\.(?:1(?:2[89]|[3-9]\\d)|2\\d{2})\\.\\d{1,3}",
  213.         "119\\.30\\.(?:19[2-9]|2\\d{2})\\.\\d{1,3}",
  214.         "119\\.31\\.1(?:2[89]|[3-5]\\d)\\.\\d{1,3}",
  215.         "133\\.106\\.(?:1(?:2[89]|[3-9]\\d)|2\\d{2})\\.\\d{1,3}",
  216.         "133\\.106\\.(?:1[6-9]|2\\d|3[01])\\.\\d{1,3}",
  217.         "133\\.106\\.(?:3[2-9]|[45]\\d|6[0-3])\\.\\d{1,3}",
  218.         "133\\.106\\.(?:6[4-9]|[7-9]\\d|1(?:[01]\\d|2[0-7]))\\.\\d{1,3}",
  219.         "133\\.106\\.(?:[89]|1[0-5])\\.\\d{1,3}",
  220.         "157\\.192(?:\\.\\d{1,3}){2}",
  221.         "193\\.114\\.(?:19[2-9]|2\\d{2})\\.\\d{1,3}",
  222.         "193\\.114\\.(?:3[2-9]|[45]\\d|6[0-3])\\.\\d{1,3}",
  223.         "193\\.114\\.(?:6[4-9]|[78]\\d|9[0-5])\\.\\d{1,3}",
  224.         "193\\.115\\.(?:\\d|[12]\\d|3[01])\\.\\d{1,3}",
  225.         "193\\.117\\.(?:[9][6-9]|1(?:[01]\\d|2[0-7]))\\.\\d{1,3}",
  226.         "193\\.118\\.(?:\\d|[12]\\d|3[01])\\.\\d{1,3}",
  227.         "193\\.118\\.(?:6[4-9]|[78]\\d|9[0-5])\\.\\d{1,3}",
  228.         "193\\.119\\.(?:1(?:2[89]|[3-9]\\d)|2\\d{2})\\.\\d{1,3}",
  229.         "193\\.82\\.1(?:[6-8]\\d|9[01])\\.\\d{1,3}",
  230.         "194\\.193\\.2(?:2[4-9]|[34]\\d|5[0-5])\\.\\d{1,3}",
  231.         "194\\.193\\.(?:6[4-9]|[78]\\d|9[0-5])\\.\\d{1,3}",
  232.         "194\\.223\\.(?:[9][6-9]|1(?:[01]\\d|2[0-7]))\\.\\d{1,3}",
  233.         "202\\.176\\.(?:1[6-9]|2\\d|3[01])\\.\\d{1,3}",
  234.         "202\\.216\\.(?:\\d|1[0-5])\\.\\d{1,3}",
  235.         "210\\.157\\.(?:19[2-9]|2(?:[01]\\d|2[0-3]))\\.\\d{1,3}",
  236.         "211\\.133\\.(?:[6-8]\\d|9[01])\\.\\d{1,3}",
  237.         "211\\.7\\.(?:[9][6-9]|1(?:[01]\\d|2[0-7]))\\.\\d{1,3}",
  238.         "219\\.105\\.1(?:4[4-9]|5\\d)\\.\\d{1,3}",
  239.         "219\\.105\\.(?:19[2-9]|2\\d{2})\\.\\d{1,3}",
  240.         "219\\.106\\.(?:\\d{1,2}|1(?:[01]\\d|2[0-7]))\\.\\d{1,3}"
  241.     );
  242.  
  243.     #モバイル回線のslip_id
  244.     my @mobile_ids = (
  245.         "Sr",
  246.         "Sp",
  247.         "Sa",
  248.         "Sd",
  249.         "SD",
  250.         "MM"
  251.     );
  252.  
  253.     #モバイル回線のニックネーム
  254.     my @mobile_nicknames = (
  255.         "ｵｯﾍﾟｹ${mobile_nickname_end}",
  256.         "ｻｻｸｯﾃﾛ${mobile_nickname_end}",
  257.         "ｱｳｱｳｱｰ${mobile_nickname_end}",
  258.         "ｱｳｱｳｲｰ${mobile_nickname_end}",
  259.         "ｱｳｱｳｳｰ${mobile_nickname_end}",
  260.         "ｱｳｱｳｴｰ${mobile_nickname_end}",
  261.         "ｱｳｱｳｵｰ${mobile_nickname_end}",
  262.         "ｱｳｱｳｶｰ${mobile_nickname_end}",
  263.         "ｽﾌﾟｰ${mobile_nickname_end}",
  264.         "ｽﾌﾟｯｯ${mobile_nickname_end}",
  265.         "ｽｯﾌﾟ${mobile_nickname_end}",
  266.         "ｽｯｯﾌﾟ${mobile_nickname_end}",
  267.         "ｽﾌﾟﾌﾟ${mobile_nickname_end}",
  268.         "ｽﾌｯ${mobile_nickname_end}",
  269.         "ﾍﾟﾗﾍﾟﾗ${mobile_nickname_end}",
  270.         "ｴｱﾍﾟﾗ${mobile_nickname_end}",
  271.         "ﾌﾞｰｲﾓ${mobile_nickname_end}",
  272.         "ﾍﾞｰｲﾓ${mobile_nickname_end}",
  273.         "ｵｲｺﾗﾐﾈｵ${mobile_nickname_end}",
  274.         "ﾜﾝﾄﾝｷﾝ${mobile_nickname_end}",
  275.         "ﾜﾝﾐﾝｸﾞｸ${mobile_nickname_end}",
  276.         "ﾊﾞｯﾄﾝｷﾝ${mobile_nickname_end}",
  277.         "ﾊﾞｯﾐﾝｸﾞｸ${mobile_nickname_end}",
  278.         "ﾗｸｯﾍﾟﾍﾟ${mobile_nickname_end}",
  279.         "ﾗｸﾗｯﾍﾟ${mobile_nickname_end}",
  280.         "ｱｳｱｳｸｰ${mobile_nickname_end}",
  281.         "ﾄﾞｺｸﾞﾛ${mobile_nickname_end}",
  282.         "ﾄﾞﾅﾄﾞﾅｰ${mobile_nickname_end}",
  283.         "ﾄﾝﾓｰ${mobile_nickname_end}",
  284.         "ｱﾒ${mobile_nickname_end}",
  285.         "ﾆｬﾌﾆｬ${mobile_nickname_end}",
  286.         "ｲﾙｸﾝ${mobile_nickname_end}",
  287.         "ｹﾞﾏｰ${mobile_nickname_end}",
  288.         "ﾌﾘｯﾃﾙ${mobile_nickname_end}"
  289.     );
  290.  
  291.     #公衆Wi-Fiのリモホ・ネットワーク名・IP
  292.     my @fwifi_remoho = (
  293.         ".*\\.m-zone\\.jp",
  294.         "\\d+\\.wi-fi\\.kddi\\.com",
  295.         ".*\\.wi-fi\\.wi2\\.ne\\.jp",
  296.         ".*\\.family-wifi\\.jp"
  297.     );
  298.     my @fwifi_whois = (
  299.         "INPLUS-FWIFI",
  300.         "FON"
  301.     );
  302.     my $lawson_ip = "210\\.227\\.19\\.[67]\\d\$";
  303.     #公衆Wi-FiのID
  304.     my $fwifi_id = "FF";
  305.     #公衆Wi-Fiのニックネーム
  306.     my @fwifi_nicknames = (
  307.         "ｴﾑｿﾞﾈ${fixed_nickname_end}[公衆]",
  308.         "ｱｳｳｨﾌ${fixed_nickname_end}[公衆]",
  309.         "ﾜｲｰﾜ2${fixed_nickname_end}[公衆]",
  310.         "ﾌｧﾐﾏ${fixed_nickname_end}[公衆]",
  311.         "ﾌｫﾝﾌｫﾝ${fixed_nickname_end}[公衆]",
  312.         "ﾏｸﾄﾞ${fixed_nickname_end}[公衆]"
  313.     );
  314.  
  315.     #逆引き判定
  316.     if ($slip_remoho eq "none") { #逆引きできない場合
  317.         my $isunknown = "yes";
  318.         my $res = whois($ip_addr);
  319.  
  320.         #モバイル回線判定
  321.         my $mobile_nickname_idx = -1;
  322.         for my $name (@mobile_whois) {
  323.             if ($res =~ /.*${name}.*/) {
  324.                 $slip_id = "MM";
  325.                 $slip_nickname = $mobile_nicknames[$mobile_nickname_idx];
  326.                 $slip_aa = $slip_id;
  327.                 $slip_bb = $slip_ip;
  328.                 $isunknown = "no";
  329.                 last;
  330.             }
  331.             $mobile_nickname_idx--;
  332.         }
  333.         #楽天モバイル(MNO)判定
  334.         if ($isunknown eq "yes") {
  335.             for my $name (@rakuten_mno_ip) {
  336.                 if ($ip_addr =~ /${name}/) {
  337.                     $slip_id = "MM";
  338.                     $slip_nickname = "ﾃﾃﾝﾃﾝﾃﾝM";
  339.                     $slip_aa = $slip_id;
  340.                     $slip_bb = $slip_ip;
  341.                     $isunknown = "no";
  342.                     last;
  343.                 }
  344.             }
  345.         }
  346.  
  347.         #公衆判定
  348.         if ($isunknown eq "yes") {
  349.             my $fwifi_nickname_idx = -1;
  350.             for my $name (@fwifi_whois) {
  351.                 if ($res =~ /.*${name}.*/) {
  352.                     $slip_id = $fwifi_id;
  353.                     $slip_nickname = $fwifi_nicknames[$fwifi_nickname_idx];
  354.                     $slip_aa = $slip_id;
  355.                     $slip_bb = $slip_ip;
  356.                     $isunknown = "no";
  357.                     last;
  358.                 }
  359.                 $fwifi_nickname_idx--;
  360.             }
  361.         }
  362.         #ローソン判定
  363.         if ($isunknown eq "yes") {
  364.             if ($ip_addr =~ /${lawson_ip}/) {
  365.                 $slip_id = "FF";
  366.                 $slip_nickname = "ﾛｰｿﾝ${fixed_nickname_end}[公衆]";
  367.                 $slip_aa = $slip_id;
  368.                 $slip_bb = $slip_ip;
  369.                 $isunknown = "no";
  370.             }
  371.         }
  372.  
  373.         #逆引き不可能 ｱﾝﾀﾀﾞﾚ
  374.         if ($isunknown eq "yes") {
  375.             $slip_id = "Un";
  376.             $slip_nickname = "ｱﾝﾀﾀﾞﾚ${fixed_nickname_end}";
  377.             $slip_aa = $slip_id;
  378.             $slip_bb = $slip_ip;
  379.         }
  380.     }else{ #逆引きできる場合
  381.         my $ismobile = 0;
  382.         #モバイル回線判定
  383.         my $mobile_id_idx = 0;
  384.         my $mobile_nickname_idx = 0;
  385.         for my $name (@mobile_remoho) {
  386.             if ($remoho =~ /^${name}$/) {
  387.                 $slip_id = $mobile_ids[$mobile_id_idx];
  388.                 $slip_nickname = $mobile_nicknames[$mobile_nickname_idx];
  389.                 $slip_aa = $slip_id;
  390.                 $slip_bb = $slip_ip;
  391.                 $ismobile = 1;
  392.                 last;
  393.             }
  394.             if ($mobile_id_idx < 2 || $mobile_nickname_idx =~ /^(7|9|15)$/) {
  395.                 $mobile_id_idx++;
  396.             }
  397.             $mobile_nickname_idx++;
  398.         }
  399.  
  400.         #公衆判定
  401.         if ($ismobile == 0) {
  402.             my $fwifi_nickname_idx = 0;
  403.             for my $name (@fwifi_remoho) {
  404.                 if ($remoho =~ /^${name}$/) {
  405.                     $slip_id = $fwifi_id;
  406.                     $slip_nickname = $fwifi_nicknames[$fwifi_nickname_idx];
  407.                     $slip_aa = $slip_id;
  408.                     $slip_bb = $slip_ip;
  409.                     last;
  410.                 }
  411.                 $fwifi_nickname_idx++;
  412.             }
  413.         }
  414.  
  415.   #社畜判定
  416.   if ($ismobile == 0) {
  417.     if ($remoho =~ /^.+\.co\.jp$/) {
  418.       $slip_nickname = "ｼｬﾁｰｸ${fixed_nickname_end}";
  419.     }
  420.   }
  421. }
  422.  
  423.  
  424.     # 国を判定
  425.     my $gi_dat = "./datas/GeoIPCity.dat";
  426.     if (-f $gi_dat) {
  427.         my $gi = Geo::IP->open($gi_dat, GEOIP_STANDARD);
  428.         my $record = $gi->record_by_addr($ip_addr);
  429.         my $ip_country =  $record->country_code;
  430.         if ($ip_country =~ /^(?!.*JP).*$/) {
  431.             $slip_nickname = "ｶﾞｲｺｰｸ${fixed_nickname_end}[${ip_country}]";
  432.             $slip_aa = $ip_country;
  433.             $slip_bb = $slip_ip;
  434.         }
  435.     }
  436.  
  437.  
  438.     #bbs_slipを生成
  439.     my $slip_result = "${slip_nickname} ${slip_aa}${slip_bb}-${slip_cccc}";
  440.  
  441.  
  442.     return $slip_result;
  443. }
  444.  
  445. #============================================================================================================
  446. #   Module END
  447. #============================================================================================================
  448. 1;
  449.  
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!