Initial commit.

lib/perl5/Selima/GeoIP.pm

@@ -0,0 +1,73 @@
+# 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;