Initial commit.

lib/perl5/Selima/HTTPS.pm

@@ -0,0 +1,94 @@
+# Selima Website Content Management System
+# HTTPS.pm: The HTTPS SSL 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-09-12
+
+package Selima::HTTPS;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Exporter);
+use vars qw(@EXPORT @EXPORT_OK);
+BEGIN {
+@EXPORT = qw(https_process https_host fqdn is_https);
+@EXPORT_OK = @EXPORT;
+# Prototype declaration
+sub https_process(;$);
+sub https_host();
+sub fqdn();
+sub is_https();
+}
+
+use Socket qw(inet_aton inet_ntoa AF_INET);
+
+use Selima::Cache qw(:https);
+use Selima::DataVars qw(:hostconf);
+use Selima::Server;
+
+# https_process: Use HTTPs to process the request
+sub https_process(;$) {
+    local ($_, %_);
+    my $https;
+    $https = $_[0];
+    # Set the answer
+    $HTTPS_https_process = 1 if defined $https;
+    # Return the answer
+    return $HTTPS_https_process;
+}
+
+# https_host: The default HTTPs host name
+sub https_host() {
+    local ($_, %_);
+    # Respect the pre-defined setting
+    return $HTTPS_HOST if defined $HTTPS_HOST;
+    # Use the fully-qualified domain name (FQDN)
+    return ($HTTPS_HOST = fqdn);
+}
+
+# fqdn: The fully qualified domain name
+sub fqdn() {
+    local ($_, %_);
+    # Return the cache
+    return $HTTPS_fqdn if defined $HTTPS_fqdn;
+    
+    # Use DNS look-up for the current host name
+    # Apache implementation
+    $_ = is_apache? $ENV{"SERVER_ADDR"}:
+    # Microsoft IIS implementation
+        is_iis? $ENV{"LOCAL_ADDR"}:
+    # Else, do DNS query
+        inet_ntoa(scalar gethostbyname $ENV{"SERVER_NAME"});
+    # Reverse-DNS query for a fully-qualified domain name (FQDN)
+    $HTTPS_fqdn = gethostbyaddr inet_aton($_), AF_INET;
+    
+    return $HTTPS_fqdn;
+}
+
+# is_https: Check if current scheme is HTTPS
+sub is_https() {
+    local ($_, %_);
+    # Apache implementation
+    return exists $ENV{"HTTPS"} if is_apache;
+    # Microsoft IIS implementation
+    return exists $ENV{"SERVER_PORT_SECURE"} if is_iis;
+    # Well, set port 443 to https and others to http.
+    #   This is a bad approach.  Avoid it whenever possible.
+    return ($ENV{"SERVER_PORT"} == 443);
+}
+
+return 1;