TITLE 'SAMPLE ENCIPHER/DECIPHER PROGRAM.'
*=====================================================================*
* SYSTEM/370 ASSEMBLER H EXAMPLE - AES-256 ENCRYPT/DECRYPT *
* *
*=====================================================================*
* *
* THIS PROGRAM USES AN ESTABLISHED KEY TO ENCRYPT A BLOCK OF MEMORY *
* AND THEN DECRYPT IT. THE CLEAR TEXT IS COMPARED TO MAKE SURE *
* IT MATCHES. A SNAPDUMP IS GENERATED WHERE THE CIPHER TEXT *
* CAN BE VIEWED. *
* *
* *
* SERVICES USED: *
* CSFSAE *
* CSFDAD *
* *
* Prerequisites: *
* 1. Run the KGUP utility to generate an AES Data Key *
* Example: ADD TYPE(DATA ) LENGTH(32) ALGORITHM(AES), *
* LAB(STEVE.DATASET.ENCRYPTION) *
* 2. Grant authority to the key label to the userid running this *
* job. RACF Example: *
* PERMIT STEVE.DATASET.ENCRYPTION CLASS(CSFKEYS) ID(xxxx) *
* RALTER CSFKEYS STEVE.DATASET.ENCRYPTION *
* ICSF(SYMCPACFWRAP(YES) SYMCPACFRET(YES)) *
* 3. Add to Link edit step for ICSF Services *
* //L.SYSLIB DD DSN=CSF.SCSFMOD0,DISP=SHR *
* *
* *
* CALL ENCIPHER WITH THE KEY LABEL *
* OPERATIONAL FORM *
*=====================================================================*
SPACE
SAMPLE START 0
DS 0H
STM 14,12,12(13) SAVE REGISTERS
BALR 12,0 USE R12 AS BASE REGISTER
USING *,12 PROVIDE SAVE AREA FOR SUBROUTINE
LA 14,SAVE PERFORM SAVE AREA CHAINING
ST 13,4(14) "
ST 14,8(13) "
LR 13,14 "
ENCR EQU *
WTO 'ABOUT TO DO ENCRYPT'
MVC RULEAC,=F'3' SET RULE ARRAY COUNT
MVC RULEA,=CL24'KEYIDENTPKCS-PADAES '
MVC RETCD,=X'FFFFFFFF'
MVC RESCD,=X'FFFFFFFF'
CALL CSFSAE,(RETCD, *
RESCD, *
EXDATAL, *
EXDATA, *
RULEAC, *
RULEA, *
KEYLBLL, *
KEYLBL, *
KEYPARML, *
KEYPARM, *
BLKSZ, *
INITVECL, *
INITVEC, *
CHNDL, *
CHND, *
TEXTL, *
TEXT, *
CIPHER_TEXTL, *
CIPHER_TEXT, *
OPTDATAL, *
OPTDATA)
CLC RETCD,=F'0' CHECK RETURN CODE
BNE BACK OUTPUT RETURN/REASON CODE AND STOP
CLC RESCD,=F'0' CHECK REASON CODE
BNE BACK OUTPUT RETURN/REASON CODE AND STOP
WTO 'ABOUT TO DO DECRYPT'
MVC RETCD,=X'FFFFFFFF'
MVC RESCD,=X'FFFFFFFF'
MVC EXDATAL,=F'0'
MVC KEYPARML,=F'0'
MVC CHNDL,=F'32'
MVC OPTDATAL,=F'0'
CALL CSFSAD,(RETCD, *
RESCD, *
EXDATAL, *
EXDATA, *
RULEAC, *
RULEA, *
KEYLBLL, *
KEYLBL, *
KEYPARML, *
KEYPARM, *
BLKSZ, *
INITVECL, *
INITVEC, *
CHNDL, *
CHND, *
CIPHER_TEXTL, *
CIPHER_TEXT, *
NEW_TEXTL, *
NEW_TEXT, *
OPTDATAL, *
OPTDATA)
CLC RETCD,=F'0' CHECK RETURN CODE
BNE BACK OUTPUT RETURN/REASON CODE AND STOP
CLC RESCD,=F'0' CHECK REASON CODE
BNE BACK OUTPUT RETURN/REASON CODE AND STOP
*
COMPARE EQU * COMPARE START AND END TEXT
CLC TEXT,NEW_TEXT
BE GOODENC
WTO 'DECIPHERED TEXT DOES NOT MATCH STARTING TEXT'
B BACK
GOODENC WTO 'DECIPHERED TEXT MATCHES STARTING TEXT'
*
*
WTO 'TEST PROGRAM TERMINATING'
B RETURN
*
*----------------------------------------------------
* CONVERT RETURN/REASON CODES FROM BINARY TO EBCDIC
*----------------------------------------------------
BACK DS 0F OUTPUT RETURN & REASON CODE
L 5,RETCD LOAD RETURN CODE
L 6,RESCD LOAD REASON CODE
CVD 5,BCD1 CONVERT TO PACK-DECIMAL
CVD 6,BCD2
UNPK ORETCD,BCD1 CONVERT TO EBCDIC
UNPK ORESCD,BCD2
OI ORETCD+7,X'F0' CORRECT LAST DIGIT
OI ORESCD+7,X'F0'
MVC ERROUT+21(4),ORETCD+4
MVC ERROUT+41(8),ORESCD+0
ERROUT WTO 'ERROR CODE = , REASON CODE = '
RETURN EQU *
OPEN (SNAPDCB,OUTPUT)
SNAP DCB=SNAPDCB,ID=245,STORAGE=(MEM_ST,MEM_END)
CLOSE SNAPDCB
L 13,4(13) SAVE AREA RESTORATION
MVC 16(4,13),RETCD SAVE RETURN CODE
LM 14,12,12(13)
BR 14 RETURN TO CALLER
*
MEM_ST EQU *
BCD1 DS D CONVERT TO BCD TEMP AREA
BCD2 DS D CONVERT TO BCD TEMP AREA
ORETCD DS CL8'0' OUTPUT RETURN CODE
ORESCD DS CL8'0' OUTPUT REASON CODE
*
KEYPARML DC F'0'
KEYPARM DC CL8' '
BLKSZ DC F'16'
INITVECL DC F'16'
INITVEC DC XL16'11111111111111111111111111111111'
CHNDL DC F'32'
CHND DC CL32' '
TEXT DC CL32'Hello World'
TEXTL DC F'11' TEXT LENGTH
DC C'ENCRYPTED TEXT:'
CIPHER_TEXTL DC F'32'
CIPHER_TEXT DC XL128'00'
DC C'DECRYPTED TEXT:'
NEW_TEXTL DC F'32'
NEW_TEXT DC CL32' '
DATA_IDL DC F'64'
DATA_ID DC XL64'00' DATA KEY TOKEN
KEYLBLL DC F'64'
KEYLBL DC CL24'STEVE.DATASET.ENCRYPTION'
DC CL40' '
RETCD DS F'0' RETURN CODE
RESCD DS F'0' REASON CODE
EXDATAL DC F'0' EXIT DATA LENGTH
EXDATA DS 0C EXIT DATA
RULEA DS 1CL24 RULE ARRAY
RULEAC DS F'0' RULE ARRAY COUNT
OPTDATAL DC F'0'
OPTDATA DC CL64''
MEM_END EQU *
SNAPDCB DCB BLKSIZE=882,DSORG=PS,LRECL=125,MACRF=(W),RECFM=VBA, *
DDNAME=SNAP1
SAVE DS 18F SAVE REGISTER AREA
END SAMPLE
Sample Assemble/Link/Execute JCL:
//STEP1 EXEC ASMACL,PARM.L='MAP,LET,LIST'
//C.SYSIN DD DSN=IBMUSER.SAMPLES.ASM(CIPHER),DISP=SHR
//L.SYSLMOD DD DSN=IBMUSER.SAMPLES.LOADLIB,DISP=SHR
//L.SYSIN DD *
ENTRY SAMPLE
NAME CIPHER(R)
/*
//L.SYSLIB DD DSN=CSF.SCSFMOD0,DISP=SHR * SERVICES ARE IN HERE
//STEP2 EXEC PGM=CIPHER
//STEPLIB DD DSN=IBMUSER.SAMPLES.LOADLIB,DISP=SHR
//SYSUDUMP DD SYSOUT=*
//SNAP1 DD SYSOUT=*