74 lines
2.1 KiB
Perl
74 lines
2.1 KiB
Perl
# Selima Website Content Management System
|
|
# GeoIP.pm: The GeoIP-related subroutines.
|
|
|
|
# Copyright (c) 2004-2018 imacat.
|
|
#
|
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
|
# you may not use this file except in compliance with the License.
|
|
# You may obtain a copy of the License at
|
|
#
|
|
# http://www.apache.org/licenses/LICENSE-2.0
|
|
#
|
|
# Unless required by applicable law or agreed to in writing, software
|
|
# distributed under the License is distributed on an "AS IS" BASIS,
|
|
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
# See the License for the specific language governing permissions and
|
|
# limitations under the License.
|
|
|
|
# Author: imacat <imacat@mail.imacat.idv.tw>
|
|
# First written: 2004-10-16
|
|
|
|
package Selima::GeoIP;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(Exporter);
|
|
use vars qw(@EXPORT @EXPORT_OK);
|
|
BEGIN {
|
|
@EXPORT = qw(country_lookup);
|
|
@EXPORT_OK = @EXPORT;
|
|
# Prototype declaration
|
|
sub country_lookup(;$);
|
|
}
|
|
|
|
use Geo::IP qw(GEOIP_MEMORY_CACHE);
|
|
use Net::CIDR::Lite qw();
|
|
|
|
BEGIN {
|
|
if (exists $ENV{"MOD_PERL_API_VERSION"} && $ENV{"MOD_PERL_API_VERSION"} >= 2) {
|
|
require Apache2::Connection;
|
|
}
|
|
}
|
|
|
|
use Selima::DataVars qw(:env);
|
|
|
|
use vars qw($PRIVATE_NETWORKS);
|
|
$PRIVATE_NETWORKS = Net::CIDR::Lite->new(
|
|
qw(10.0.0.0/8 172.16.0.0/12 192.168.0.0/16));
|
|
|
|
use constant CT_PRIVATE => "AA";
|
|
use constant CT_UNKNOWN => "ZZ";
|
|
|
|
# country_lookup: Look-up country from IP
|
|
sub country_lookup(;$) {
|
|
local ($_, %_);
|
|
my ($GI, $ip, $ct);
|
|
$ip = $_[0];
|
|
# Default to look up the client
|
|
$ip = $IS_MODPERL? ($IS_MP2?
|
|
Apache2::RequestUtil->request->connection->remote_ip:
|
|
Apache->request->connection->remote_ip):
|
|
$ENV{"REMOTE_ADDR"}
|
|
if !defined $ip;
|
|
# Start a new GeoIP handler. It rarely needs to be cached
|
|
$GI = Geo::IP->new(GEOIP_MEMORY_CACHE);
|
|
# Look up in the GeoIP database
|
|
return uc $_ if defined($_ = $GI->country_code_by_addr($ip));
|
|
# Look up private IP
|
|
return CT_PRIVATE if $PRIVATE_NETWORKS->find($ip);
|
|
# Not known
|
|
return CT_UNKNOWN;
|
|
}
|
|
|
|
return 1;
|