Initial commit.

lib/perl5/Selima/RemoHost.pm

@@ -0,0 +1,82 @@
+# Selima Website Content Management System
+# RemoHost.pm: The subroutine to DNS reverse-query the domain name of the remote host.
+
+#  Copyright (c) 2003-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: 2003-04-07
+
+package Selima::RemoHost;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Exporter);
+use vars qw(@EXPORT @EXPORT_OK);
+BEGIN {
+@EXPORT = qw(remote_host);
+@EXPORT_OK = @EXPORT;
+# Prototype declaration
+sub remote_host();
+}
+
+use Socket qw(inet_aton AF_INET);
+
+use Selima::DataVars qw(:env);
+
+BEGIN {
+if (exists $ENV{"MOD_PERL_API_VERSION"} && $ENV{"MOD_PERL_API_VERSION"} >= 2) {
+    require Apache2::Connection;
+}
+}
+
+use Selima::Cache qw(:remohost);
+use Selima::DataVars qw(:env);
+
+# remote_host: Look up the remote host domain name
+sub remote_host() {
+    local ($_, %_);
+    my ($r, $addr);
+    
+    # Looked-up before
+    if (defined $RemoHost_remote) {
+        return $RemoHost_remote ne "-"? $RemoHost_remote: undef;
+    }
+    
+    if ($IS_MODPERL) {
+        $r = $IS_MP2? Apache2::RequestUtil->request:
+            Apache->request;
+        $addr = $r->connection->remote_ip;
+        $_ = $IS_MP2? $r->connection->get_remote_host:
+            $r->get_remote_host;
+        return ($RemoHost_remote = $_)
+            if defined $_ && $_ ne $addr;
+    } else {
+        $addr = $ENV{"REMOTE_ADDR"};
+        # The server had done the job
+        return ($RemoHost_remote = $ENV{"REMOTE_HOST"})
+            if  exists $ENV{"REMOTE_HOST"}
+                && $ENV{"REMOTE_HOST"} ne $addr;
+    }
+    
+    # Look up now
+    $_ = gethostbyaddr inet_aton($addr), AF_INET;
+    return ($RemoHost_remote = $_) if defined $_;
+    
+    # Return not found
+    $RemoHost_remote = "-";
+    return undef;
+}
+
+return 1;