Initial commit.

lib/perl5/Selima/ScptPriv.pm

@@ -0,0 +1,99 @@
+# Selima Website Content Management System
+# ScptPriv.pm: The script privilege checkers.
+
+#  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-28
+
+package Selima::ScptPriv;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Exporter);
+use vars qw(@EXPORT @EXPORT_OK);
+BEGIN {
+@EXPORT = qw(is_script_permitted is_admin_script);
+@EXPORT_OK = @EXPORT;
+# Prototype declaration
+sub is_script_permitted(;$);
+sub is_admin_script(;$);
+}
+
+use Selima::Cache qw(:scptpriv);
+use Selima::ChkPriv;
+use Selima::DataVars qw($DBH :requri);
+use Selima::Guest;
+use Selima::LogIn;
+
+# is_script_permitted: Check the script privilege
+sub is_script_permitted(;$) {
+    local ($_, %_);
+    my ($script, $sth, $sql, $count);
+    $script = $_[0];
+    # Default to the current script
+    $script = $REQUEST_PATH if !defined $script;
+    
+    # Return the cache
+    return $ScptPriv_is_script_permitted{$script}
+        if exists $ScptPriv_is_script_permitted{$script};
+    
+    # Always true for super users
+    return ($ScptPriv_is_script_permitted{$script} = 1) if is_su();
+    
+    # Obtain the permitted groups
+    $sql = "SELECT groups.id AS grp FROM scptpriv"
+        . " INNER JOIN groups ON scptpriv.grp=groups.sn"
+        . " WHERE scptpriv.script=" . $DBH->quote($script) . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $count = $sth->rows;
+    for ($_ = 0, @_ = qw(); $_ < $count; $_++) {
+        push @_, ${$sth->fetch}[0];
+    }
+    
+    # Only true for guests to act like ordinary administrators
+    return ($ScptPriv_is_script_permitted{$script} = 1)
+        if is_guest && scalar(@_) > 0;
+    
+    # Obtain the belonged groups
+    %_ = map { $_ => 1 } @_;
+    @_ = get_login_groups;
+    # If there is any intersection
+    foreach (@_) {
+        return ($ScptPriv_is_script_permitted{$script} = 1)
+            if exists $_{$_};
+    }
+    
+    # Default to false
+    return ($ScptPriv_is_script_permitted{$script} = 0);
+}
+
+# is_admin_script: If this is an administrative script
+sub is_admin_script(;$) {
+    local ($_, %_);
+    my $script;
+    $script = $_[0];
+    # Default to the current script
+    $script = $REQUEST_PATH if !defined $script;
+    # Return the cache
+    return $ScptPriv_is_admin_script{$script}
+        if exists $ScptPriv_is_admin_script{$script};
+    # Check the "/magicat/" or "/admin/" prefix
+    return ($ScptPriv_is_admin_script{$script} =
+        $script =~ /^\/(?:magicat|admin)\//);
+}
+
+return 1;