/usr/share/perl5/DACScheck.pm is in dacs 1.4.28b-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 | # $Id: DACScheck.pm.in 2594 2012-10-19 17:28:49Z brachman $
# Copyright (c) 2003-2012
# Distributed Systems Software. All rights reserved.
# See the file LICENSE for redistribution information.
# A crude interface between Perl and dacscheck
# Initialize by calling:
# 1) dacscheck_prog to set the absolute pathname of the dacscheck command
# 2) dacscheck_rules to set the absolute pathname of the root directory
# containing the DACS rules (if the default is incorrect or rules are not
# specified with each check).
#
# Then, to check for authorization, call:
# dacscheck(id, resource, ...);
# or from the CGI environment:
# dacscheck_cgi(resource, ...);
#
# These functions return 1 if access is granted, 0 if denied, or -1 if
# an error occurs.
#
# Callers must do:
# use DACScheck;
#
# See dacscheck(1)
package DACScheck;
use strict;
require Exporter;
our @ISA = qw(Exporter);
# Export symbols
our @EXPORT = qw(dacscheck dacscheck_cgi dacscheck_prog dacscheck_rules);
our $VERSION = '1.0.0';
# Locals
my $dacscheck_prog = "/usr/bin/dacscheck";
my $dacscheck_rules = "";
# Return something
1;
# Set the path to use for the dacscheck command
#
sub dacscheck_prog {
my ($prog) = @_;
my $oldprog;
$oldprog = $dacscheck_prog;
$dacscheck_prog = $prog;
return $oldprog;
}
# Set the path to use for the dacscheck rules
#
sub dacscheck_rules {
my ($rules) = @_;
my $oldrules;
$oldrules = $dacscheck_rules;
$dacscheck_rules = $rules;
return $oldrules;
}
# Internal function to actually run dacscheck
#
sub run_dacscheck {
my $exit_value;
my $result;
system @_;
$exit_value = $? >> 8;
# print "dacscheck returned $exit_value for user \"$remote_user\"\n";
if ($exit_value == 1) {
# dacscheck denies access
$result = 0;
}
elsif ($exit_value == 0) {
# dacscheck grants access
$result = 1;
}
else {
# dacscheck error occurred
$result = -1;
}
return $result;
}
# A simple interface to the dacscheck command
# Check if $id is granted access to $resource; additional arguments may
# follow
#
sub dacscheck {
my ($id, $resource, @other_args) = @_;
my @args;
if ($dacscheck_prog eq "") {
return -1;
}
if ($dacscheck_rules eq "") {
@args = ($dacscheck_prog, '-q', '-i', $id, @other_args, $resource);
}
else {
@args = ($dacscheck_prog, '-q', '-i', $id, '-rules', $dacscheck_rules,
@other_args, $resource);
}
return run_dacscheck(@args);
}
# A simple interface to the dacscheck command
# Check if access to $resource is granted based on REMOTE_USER; additional
# arguments may follow
# Return 1 if access is granted
# Return 0 if access is denied
# Return -1 if an error occurs
#
sub dacscheck_cgi {
my ($resource, @other_args) = @_;
my @args;
if ($dacscheck_prog eq "") {
return -1;
}
if ($dacscheck_rules eq "") {
@args = ($dacscheck_prog, '-q', '-icgi', @other_args, $resource);
}
else {
@args = ($dacscheck_prog, '-q', '-icgi', '-rules', $dacscheck_rules,
@other_args, $resource);
}
return run_dacscheck(@args);
}
|