%(Copyright © 2006, Oracle Corporation.  All Rights Reserved.)%
%TITLE 'RDB_CYPHER'
MODULE RDB_CYPHER (IDENT = 'V7.2-05121') =
BEGIN
!
!	RDB_CYPHER.B32
!
!   FACILITY:
! 
!	Oracle SQL
!
!   ABSTRACT:
!
!	Example module using encryption.
!
!   FUNCTIONS:
!
!	ENCRYPT_CCN
!	DECRYPT_CCN
!
!   MODIFICATION HISTORY:
!
!   Version 7.2
!	21-Apr-06 05121 (NJL) Code cleanup more.
!	19-APR-06 05119 (NJL) Initial entry.
!-------------------------------------------------------------------------------
!
! This BLISS module is supplied solely as a template example of calling the
! OpenVMS encryption routines from an Rdb stored procedure.  The expected use
! of this module would be to encrypt and decrypt a 20 byte text field
! containing a credit card number.
!
! This software is unencumbered to the public.  No license fee is requested of
! or required for its use.  Oracle does not warrant the software.  The
! submittor does not warrant the software.  Oracle does not provide service for
! this software, will not fix this software, and will not warrant that this
! software works correctly nor works at all.  You are free to adapt and to
! change source code for your needs.
!
! Example declare and use of external procedures:
!
! DROP MODULE ENCRYPTION_SERVICES;
! CREATE MODULE ENCRYPTION_SERVICES 
!   PROCEDURE ENCRYPT_CCN (
!       IN  VARCHAR (100) CHARACTER SET UNSPECIFIED BY DESCRIPTOR,
!       IN  CHAR (20) CHARACTER SET UNSPECIFIED BY DESCRIPTOR,
!       OUT CHAR (24) CHARACTER SET UNSPECIFIED BY DESCRIPTOR);
!      EXTERNAL 
!       NAME ENCRYPT_CCN
!       LOCATION 'RDB_CYPHER.EXE' WITH ALL LOGICAL_NAME TRANSLATION
!       LANGUAGE GENERAL
!       PARAMETER STYLE GENERAL; 
!   PROCEDURE DECRYPT_CCN (
!       IN  VARCHAR (100) CHARACTER SET UNSPECIFIED BY DESCRIPTOR,
!       IN  CHAR (24) CHARACTER SET UNSPECIFIED BY DESCRIPTOR,
!       OUT CHAR (20) CHARACTER SET UNSPECIFIED BY DESCRIPTOR);
!      EXTERNAL
!       NAME DECRYPT_CCN
!       LOCATION 'RDB_CYPHER.EXE' WITH ALL LOGICAL_NAME TRANSLATION
!       LANGUAGE GENERAL
!       PARAMETER STYLE GENERAL;
! END MODULE;
!
! COMMIT;
!
! SET FLAGS 'TRACE'
! DROP TABLE T1;
! CREATE TABLE T1 (NAME CHAR(40), CCN CHAR(24));
! 
! BEGIN
!   DECLARE :CCNCYPHER CHAR (24);
!   DECLARE :CCNPLAIN CHAR (20);
!   SET :CCNPLAIN = '1234567890123456789';
!   CALL ENCRYPT_CCN ('MYLITTLESECRET',:CCNPLAIN,:CCNCYPHER);
!   INSERT INTO T1 VALUES ('TOLIVER, ALVIN', :CCNCYPHER);
!   COMMIT;
! END;
! 
! BEGIN
!   DECLARE :CCNCYPHER CHAR (24);
!   DECLARE :CCNPLAIN CHAR (20);
!   SELECT CCN INTO :CCNCYPHER FROM T1 LIMIT TO 1 ROW;
!   CALL DECRYPT_CCN ('MYLITTLESECRET',:CCNCYPHER,:CCNPLAIN);
!   TRACE :CCNPLAIN;
! END;
!
! COMMIT;
!
! Compile, link and deploy this module:
! 
! $ BLISS RDB_CYPHER.B32
! $ LINK RDB_CYPHER.OBJ+SYS$INPUT:/OPTIONS/SHARE
!	SYMBOL_VECTOR=(ENCRYPT_CCN=PROCEDURE,DECRYPT_CCN=PROCEDURE)
! $ COPY RDB_CYPHER.EXE SYS$COMMON:[SYSLIB] /PROT=W:RE
! $ INSTALL REPLACE SYS$SHARERDB_CYPHER.EXE /OPEN/SHARE/HEAD
!

LIBRARY 'SYS$LIBRARY:STARLET';
REQUIRE 'ENCRYPT$EXAMPLES:ENCRYPT_DEF.R32';
REQUIRE 'ENCRYPT$EXAMPLES:ENCRYPT_STRUCTURES.R32';
EXTERNAL ROUTINE LIB$SCOPY_DXDX, LIB$SFREE1_DD;

MACRO _CHKERR_SIG (EXP) =
    (	BIND CHKERR_SIG_STATUS = (EXP);
        IF NOT CHKERR_SIG_STATUS THEN SIGNAL(CHKERR_SIG_STATUS)) %;

GLOBAL ROUTINE ENCRYPT_CCN (
		KEY_VALUE_DSC : REF $BBLOCK,	    ! Input key string
		PLAIN_TEXT_DSC : REF $BBLOCK,	    ! Input plain text string
		CYPHER_TEXT_DSC : REF $BBLOCK) =    ! Output cypher string
BEGIN	! Encrypt - Pass key string + plain text and cypher text is returned.

    LOCAL TMP_DSC : $BBLOCK [DSC$K_D_BLN];

    $INIT_DYNDESC(TMP_DSC);

    _CHKERR_SIG($ENCRYPT_DEFINE_KEY(
	KEY_NAME = %ASCID 'RDB_ENCRYPT_KEY',
	KEY_VALUE = .KEY_VALUE_DSC,
	KEY_FLAGS = %REF(ENCRYPT$M_KEY_PROCESS)));

    _CHKERR_SIG($ENCRYPT_ENCRYPT_ONE_RECORD(
	INPUT = .PLAIN_TEXT_DSC,
	OUTPUT = TMP_DSC,
	KEY_NAME = %ASCID 'RDB_ENCRYPT_KEY',
	ALGORITHM = %ASCID 'DESCBC'));

    _CHKERR_SIG(LIB$SCOPY_DXDX(TMP_DSC, .CYPHER_TEXT_DSC));

    CH$FILL(0, .TMP_DSC [DSC$W_LENGTH], .TMP_DSC [DSC$A_POINTER]);
    _CHKERR_SIG(LIB$SFREE1_DD(TMP_DSC));

    RETURN SS$_NORMAL;
END;

GLOBAL ROUTINE DECRYPT_CCN (
		KEY_VALUE_DSC : REF $BBLOCK,	    ! Input key string
		CYPHER_TEXT_DSC : REF $BBLOCK,	    ! Input cypher string
		PLAIN_TEXT_DSC : REF $BBLOCK) =	    ! Output plain text string
BEGIN	! Decrypt - Pass key string + cypher text and plain text is returned.

    LOCAL TMP_DSC : $BBLOCK [DSC$K_D_BLN];

    $INIT_DYNDESC(TMP_DSC);

    _CHKERR_SIG($ENCRYPT_DEFINE_KEY(
	KEY_NAME = %ASCID 'RDB_ENCRYPT_KEY',
	KEY_VALUE = .KEY_VALUE_DSC,
	KEY_FLAGS = %REF(ENCRYPT$M_KEY_PROCESS)));

    _CHKERR_SIG($ENCRYPT_DECRYPT_ONE_RECORD(
	INPUT = .CYPHER_TEXT_DSC,
	OUTPUT = TMP_DSC,
	KEY_NAME = %ASCID 'RDB_ENCRYPT_KEY',
	ALGORITHM = %ASCID 'DESCBC'));

    _CHKERR_SIG(LIB$SCOPY_DXDX(TMP_DSC, .PLAIN_TEXT_DSC));

    CH$FILL(0, .TMP_DSC [DSC$W_LENGTH], .TMP_DSC [DSC$A_POINTER]);
    _CHKERR_SIG(LIB$SFREE1_DD(TMP_DSC));

    RETURN SS$_NORMAL;
END;

END
ELUDOM