vdw/trunk/WOU_Secure.pm

package WOU_Secure;

# Security functions
#
# Jeremy Hickerson, 3/6/2002

use strict;

BEGIN {
    use Exporter   ();
    use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

    # set the version for version checking
    $VERSION     = 1.00;
    @ISA         = qw(Exporter);
    @EXPORT      = qw(&gwrsecp &sis_object);
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
    @EXPORT_OK   = qw( );
}
use vars @EXPORT_OK;
use subs qw(gwrsecp sis_object);

use DBI;


# ============================================================
#  GWRSECP - turns on user security role inside a DBI session
# ============================================================
sub gwrsecp {

    my ($dbh, $object) = @_;

    # set session for cost-based optimization now that spriden is on WOPS
    $dbh->do("alter session set optimizer_goal = ALL_ROWS");

    # Copied below from gen$plus:gwrsecp.sql, changed the parts that
    # were specific to sqlplus scripts (the parsing of the object name
    # from the full pathname of the sql script, and the running of the
    # script after setting the role).  This sub gets the actual object
    # name as a parameter and sets the role for the $dbh.  You then use
    # that $dbh in your perl script with the access rights of that role.

    my $sth_pl_sql = $dbh->prepare(q{

        DECLARE
          --
          -- Character string variables.
          --
          HOLD_CMD               VARCHAR2(240);
          OBJECT                 VARCHAR2(30);
          PASSWORD               VARCHAR2(30);
          PASSWORD_OUT           VARCHAR2(30);
          ROLE_NAME              VARCHAR2(30);
          VERSION                VARCHAR2(10);
          --
          -- Number variables.
          --
          SEED1                  NUMBER(8);
          SEED3                  NUMBER(8);
        --
        -- Begin main logic.
        --
        BEGIN
          -- jdh, object is passed directly, don't need to parse
          OBJECT := ?;
          SEED1  := 99999999;  # use your numbers here
          SEED3  := 99999999;  # use your numbers here
          VERSION := NULL;
          --
          -- Obtain encrypted password.
          --
          G$_SECURITY.G$_VERIFY_PASSWORD1_PRD(OBJECT,
                                              VERSION,
                                              PASSWORD,
                                              ROLE_NAME);
          --
          -- Check security status.
          --
          IF PASSWORD = 'INSECURED' THEN
            RETURN;
          END IF;
          --
          -- Call for second phase processing.
          --
          PASSWORD_OUT := G$_SECURITY.G$_DECRYPT_FNC(PASSWORD,
                                 SEED3);
          PASSWORD := PASSWORD_OUT;
          --
          -- Call for third phase processing.
          --
          G$_SECURITY.G$_VERIFY_PASSWORD1_PRD(OBJECT,
                                              VERSION,
                                              PASSWORD,
                                              ROLE_NAME);
          --
          -- Call for fourth phase processing.
          --
          PASSWORD_OUT := G$_SECURITY.G$_DECRYPT_FNC(PASSWORD,
                                                     SEED1);
          PASSWORD := '"' || PASSWORD_OUT || '"';
          --
          -- Invoke needed role.
          --
          HOLD_CMD := ROLE_NAME || ' IDENTIFIED BY ' || PASSWORD;
          DBMS_SESSION.SET_ROLE(HOLD_CMD);
          --
          -- Clear variables.
          --
          HOLD_CMD := NULL;
          OBJECT := NULL;
          PASSWORD := NULL;
          PASSWORD_OUT := NULL;
          ROLE_NAME := NULL;
          SEED1 := 0;
          SEED3 := 0;
          --
        END;} );

    return $sth_pl_sql->execute($object);

}


sub sis_object {
    (my $sis_object = uc(shift) ) =~ s/(\S+[:\]])?(\S+)\.pl/$2/i;  # perl
    $sis_object =~ s/@(\S+[:\]])?(\S+)/$2/i;                       # com
    return $sis_object;
}

return 1;


1	dpavlin	1	package WOU_Secure;
2
3			# Security functions
4			#
5			# Jeremy Hickerson, 3/6/2002
6
7			use strict;
8
9			BEGIN {
10			use Exporter ();
11			use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
12
13			# set the version for version checking
14			$VERSION = 1.00;
15			@ISA = qw(Exporter);
16			@EXPORT = qw(&gwrsecp &sis_object);
17			%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
18			@EXPORT_OK = qw( );
19			}
20			use vars @EXPORT_OK;
21			use subs qw(gwrsecp sis_object);
22
23			use DBI;
24
25
26			# ============================================================
27			# GWRSECP - turns on user security role inside a DBI session
28			# ============================================================
29			sub gwrsecp {
30
31			my ($dbh, $object) = @_;
32
33			# set session for cost-based optimization now that spriden is on WOPS
34			$dbh->do("alter session set optimizer_goal = ALL_ROWS");
35
36			# Copied below from gen$plus:gwrsecp.sql, changed the parts that
37			# were specific to sqlplus scripts (the parsing of the object name
38			# from the full pathname of the sql script, and the running of the
39			# script after setting the role). This sub gets the actual object
40			# name as a parameter and sets the role for the $dbh. You then use
41			# that $dbh in your perl script with the access rights of that role.
42
43			my $sth_pl_sql = $dbh->prepare(q{
44
45			DECLARE
46			--
47			-- Character string variables.
48			--
49			HOLD_CMD VARCHAR2(240);
50			OBJECT VARCHAR2(30);
51			PASSWORD VARCHAR2(30);
52			PASSWORD_OUT VARCHAR2(30);
53			ROLE_NAME VARCHAR2(30);
54			VERSION VARCHAR2(10);
55			--
56			-- Number variables.
57			--
58			SEED1 NUMBER(8);
59			SEED3 NUMBER(8);
60			--
61			-- Begin main logic.
62			--
63			BEGIN
64			-- jdh, object is passed directly, don't need to parse
65			OBJECT := ?;
66			SEED1 := 99999999; # use your numbers here
67			SEED3 := 99999999; # use your numbers here
68			VERSION := NULL;
69			--
70			-- Obtain encrypted password.
71			--
72			G$_SECURITY.G$_VERIFY_PASSWORD1_PRD(OBJECT,
73			VERSION,
74			PASSWORD,
75			ROLE_NAME);
76			--
77			-- Check security status.
78			--
79			IF PASSWORD = 'INSECURED' THEN
80			RETURN;
81			END IF;
82			--
83			-- Call for second phase processing.
84			--
85			PASSWORD_OUT := G$_SECURITY.G$_DECRYPT_FNC(PASSWORD,
86			SEED3);
87			PASSWORD := PASSWORD_OUT;
88			--
89			-- Call for third phase processing.
90			--
91			G$_SECURITY.G$_VERIFY_PASSWORD1_PRD(OBJECT,
92			VERSION,
93			PASSWORD,
94			ROLE_NAME);
95			--
96			-- Call for fourth phase processing.
97			--
98			PASSWORD_OUT := G$_SECURITY.G$_DECRYPT_FNC(PASSWORD,
99			SEED1);
100			PASSWORD := '"' \|\| PASSWORD_OUT \|\| '"';
101			--
102			-- Invoke needed role.
103			--
104			HOLD_CMD := ROLE_NAME \|\| ' IDENTIFIED BY ' \|\| PASSWORD;
105			DBMS_SESSION.SET_ROLE(HOLD_CMD);
106			--
107			-- Clear variables.
108			--
109			HOLD_CMD := NULL;
110			OBJECT := NULL;
111			PASSWORD := NULL;
112			PASSWORD_OUT := NULL;
113			ROLE_NAME := NULL;
114			SEED1 := 0;
115			SEED3 := 0;
116			--
117			END;} );
118
119			return $sth_pl_sql->execute($object);
120
121			}
122
123
124			sub sis_object {
125			(my $sis_object = uc(shift) ) =~ s/(\S+[:\]])?(\S+)\.pl/$2/i; # perl
126			$sis_object =~ s/@(\S+[:\]])?(\S+)/$2/i; # com
127			return $sis_object;
128			}
129
130			return 1;
131
132