95 lines
2.6 KiB
Perl
95 lines
2.6 KiB
Perl
# 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;
|