PRINT NOGEN MACRO &N BEGIN &R,&R2,&RENT=N,&VER= *---------------------------------------------------------------------* * B E G I N * *---------------------------------------------------------------------* * * * Generate a CSECT statement, specify and load the base * * registers and generate standard linkage with save area * * * LCLC ®,&LAB,®2,®3,®4,&BASE2,&VERSION GBLC &RENTGBL AIF (K'&VER GT 8).VERERR AIF (K'&VER NE 0).VEROK &VERSION SETC '1.0' AGO .VERCNT .VEROK ANOP &VERSION SETC '&VER' .VERCNT ANOP AIF (K'&N NE 0).LABOK &LAB SETC 'NONAME' MNOTE 4,'***** NO CSECT NAME SPECIFIED, NONAME USED *********' AGO .LABCNT .LABOK ANOP &LAB SETC '&N' .LABCNT ANOP AIF (K'&R NE 0).REGOK ® SETC '12' MNOTE 4,'***** NO BASE REGISTER SPECIFIED, 12 USED **********' AGO .REGCNT .REGOK ANOP AIF ('&R'(1,1) NE 'R').NUMB ® SETC '&R'(2,2) AGO .COMP .NUMB ANOP ® SETC '&R' .COMP ANOP AIF ('®' LT '2').E1 AIF ('®' GT '12').E1 ® SETC '&R' .REGCNT ANOP ®2 SETC '® USE ® AS BASE REGISTER' &BASE2 SETC '1' AIF (K'&R2 EQ 0).BASE1 &BASE2 SETC '2' AIF ('&R2'(1,1) NE 'R').NUMB2 ®3 SETC '&R2'(2,2) AGO .COMP2 .NUMB2 ANOP ®3 SETC '&R2' .COMP2 ANOP AIF ('®3' LT '2').E12 AIF ('®3' GT '12').E12 ®3 SETC '&R2' AIF ('®3' EQ '®').E12 ®4 SETC '®3 USE ®3 AS 2ND BASE REGISTER' MNOTE '***** THIS PROGRAM WILL HAVE 2 BASE REGISTERS ******' .BASE1 ANOP &RENTGBL SETC 'N' AIF ('&RENT'(1,1) NE 'Y').NOTRENT &RENTGBL SETC 'Y' .NOTRENT ANOP &LAB CSECT * BAKR R14,R0 Linkage Stack LAE ®,0(R15,0) Set ® as base register USING &LAB,®2 Establish Addressability STM 14,12,12(13) Save callers registers * AIF ('&BASE2' EQ '1').AONE LAE ®3,2048(R15,0) Set ®3 as second base register LAE ®3,2048(®3,0) Set ®3 as second base register USING &LAB+4096,®4 * .AONE ANOP AIF ('&RENTGBL' EQ 'N').ANOTR GETMAIN R,LV=72,LOC=BELOW Storage for our save area * ST 13,4(1) Cross link save areas * ST 1,8(13) Cross link our save area in callers* XR 13,1 * * XR 1,13 * Swap R13 and R1 * XR 13,1 * * BAS 1,PRGMSAVE * Skip passed eyecatcher * * * MNOTE '====> RE-ENTRANT VERSION OF EOJ WILL BE USED <==== *' * * AGO .INFO .ANOTR ANOP LR 15,13 * * BAS 13,PRGMSAVE+END_EYECATCHER * PRGMSAVE DC 18F'0' * Register save area for non-rent * .INFO ANOP * * * ASSEMBLY INFORMATION - DATE, TIME AND CSECT NAME FOLLOW * * * ASLCSECT DC CL8'&LAB' ********* CSECT NAME *********** * ASLMODV DC CL8'&VERSION' **** VERSION INFORMATION **** * * * DC CL24'WRITTEN BY K E FERGUSON ' * DC CL36'COPYRIGHT - ABBYDALE SYSTEMS LLC. ' * * * ASLASMD DC CL8'&SYSDATE' **** ASSEMBLY DATE (MM/DD/YY) **** * ASLASMT DC CL6' &SYSTIME' **** ASSEMBLY TIME (HH.MM) **** * * * END_EYECATCHER EQU *-PRGMSAVE * * * AIF ('&RENTGBL' EQ 'N').ANOTR2 PRGMSAVE L 1,4(13) Reload his save area * LM 0,1,20(1) Restore R0 and R1 to keep parms * AGO .EXIT .ANOTR2 ANOP ST 13,8(15) Cross save save areas * ST 15,4(13) Cross save save areas * .EXIT ANOP *---------------------------------------------------------------------* * ©Copyright of Abbydale Systems LLC. * *---------------------------------------------------------------------* SPACE 1 MEXIT .E12 MNOTE 8,' -- VALUE FOR SECOND BASE REGISTER INVALID -- ' .E1 MNOTE 8,'IMPROPER REGISTER SPECIFIED, NO STATEMENTS GENERATED' .VERERR MNOTE 8,'LENGTH ERROR FOR THE VER PARAMETER > 8' MEND MACRO &N EOJ &C=0 LCLC &A,&B GBLC &RENTGBL *---------------------------------------------------------------------* * E O J * *---------------------------------------------------------------------* * * * Generate standard return linkage and return code. * * * AIF ('&N' EQ '').GO &N DS 0H .GO AIF ('&C'(1,1) EQ '(').REGCODE LA 15,&C PUT CONDITION CODE INTO REG 15 * AGO .RESTORE .REGCODE ANOP AIF ('&C'(3,1) EQ ')').MOVE1 AIF ('&C'(4,1) EQ ')').MOVE2 AIF ('&C'(5,1) EQ ')').MOVE3 .MERROR ANOP MNOTE 16,'*** INVALID REGISTER PASSED AS RETURN CODE REGISTER' MEXIT .MOVE3 ANOP &A SETC '&C'(2,3) AGO .CONT .MOVE2 ANOP &A SETC '&C'(2,2) AGO .CONT .MOVE1 ANOP &A SETC '&C'(2,1) .CONT ANOP AIF ('&A'(1,1) EQ 'R').RVALUE AIF ('&A' GT '15').MERROR AGO .LOADIT .RVALUE ANOP &B SETC '&A'(2,2) AIF ('&B' GT '15').MERROR .LOADIT ANOP LR 15,&A LOAD REGISTER 15 WITH CODE * .RESTORE ANOP AIF ('&RENTGBL' EQ 'Y').YESRENT PR AGO .EXIT .YESRENT ANOP LR 2,15 LR 1,13 PUT ADDRESS OF GOTTEN INTO REG 1 * L 13,4(1) PUT HIS SAVE AREA ADDRESS IN REG 13* FREEMAIN R,LV=72,A=(1) FREE STORAGE * LR 15,2 PR .EXIT ANOP * *---------------------------------------------------------------------* * ©Copyright of Abbydale Systems LLC. * *---------------------------------------------------------------------* MEND MACRO &NAME WTP &MSG *---------------------------------------------------------------------* * W T P * *---------------------------------------------------------------------* * * * Write To Programmer issues a WTO with a route code of 11 * * * &NAME WTO &MSG,ROUTCDE=11,DESC=7 *---------------------------------------------------------------------* * ©Copyright of Abbydale Systems LLC. * *---------------------------------------------------------------------* MEND ASLIPVLD START 0 ASLIPVLD AMODE 31 ASLIPVLD RMODE ANY GBLC &ASLCPY,&ASLCPL,&ASLVER &ASLCPL SETC 'THIS PRODUCT CONTAINS RESTRICTED MATERIALS OF ABBYDALE SX YSTEMS LLC.' &ASLCPY SETC 'ABBYDALE SYSTEMS LLC.' &ASLVER SETC 'VERSION 2.0' *---------------------------------------------------------------------* * A S L E Q U C * *---------------------------------------------------------------------* * Register Equates * *---------------------------------------------------------------------* R0 EQU 0 * R1 EQU 1 * R2 EQU 2 * R3 EQU 3 * R4 EQU 4 * R5 EQU 5 * R6 EQU 6 * R7 EQU 7 * R8 EQU 8 A S L E Q U C * R9 EQU 9 * R10 EQU 10 EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER * R11 EQU 11 TO MAKE THE USE OF REGISTER OPERANDS IN * R12 EQU 12 INSTRUCTIONS SELF EXPLANITORY.THIS ALSO * R13 EQU 13 CREATES ENTRIES IN CROSS REFERENCE. * R14 EQU 14 * R15 EQU 15 * FPR0 EQU 0 * FPR2 EQU 2 * FPR4 EQU 4 * FPR6 EQU 6 * *---------------------------------------------------------------------* * ©Copyright of Abbydale Systems LLC. * *---------------------------------------------------------------------* * COPY ASLEQUC Register equates ASLIPVLD TITLE ' - Validate an IP Addr - &ASLCPY' *---------------------------------------------------------------------* * ASLIPVLD * *---------------------------------------------------------------------* * * * Description : Validate a passed IP address * * * * Created on : 11 Jul 2021 * * Created by : Kevin Ferguson * * : Userid MIT001 * * : Using ABBYDALE.DEVL.SOURCE(ASLIPVLD) * * * * Called by : * * * * Calls : * * * * Register Usage : * * R0 : Standard linkage and work register * * R1 : Standard linkage and work register * * R2 : Used for CVB instruction only * * R3 : Work register (Length of remaining string * * R4 : Work register (Length of string being checked) * * R5 : Work register (Start of string) * * R6 : Work register (used for scan length) * * R7 : Work register (Remaining length for right justify) * * R8 : * Not used * * R9 : Count of periods * * R10 : * Not used * * R11 : DSECT mapping * * R12 : Base Register * * R13 : Save area address * * R14 : Return Address * * R15 : Return Code * * * * Change Activity : * * * *---------------------------------------------------------------------* * ©Copyright of Abbydale Systems LLC. * *---------------------------------------------------------------------* ASLIPVLD BEGIN R12,VER=2.0,RENT=Y LR R5,R1 Preserve R1 in R5 * ** Now we need to get some storage * LA R2,IPDSect_Length Get length for storage size STORAGE OBTAIN,ADDR=(11),LOC=(RES,ANY),LENGTH=(R2) USING IPDSect,R11 Establish Addressability ST R5,Passed_Parm Save parameter address XC Flags,Flags Set all flags off DEVTYPE =CL8'MESSAGE ',Double Check for message dd card LTR R15,R15 Did we have one? BNZ Keep_Going No - skip setting the switch OI Flags,Message Set the flag Keep_Going DS 0H MVC Cond_Code,=F'16' Set default return code for fail XR R3,R3 Clear R3 to parm length L R1,0(R5) Point to parm address LH R3,0(R1) Load passed parm length ST R3,Parm_Length Save it C R3,=F'23' Maximum allowed length BL Test_Low No - Skip to test low Too_Long DS 0H TM Flags,Message Flag set? BNO Exit_Release No - go to exit WTP 'Too long' B Exit_Release Now go to exit Test_Low DS 0H C R3,=F'6' Minimum allowed length BH Test_bracket No - Skip to test for bracket TM Flags,Message Flag set? BNO Exit_Release No - go to exit WTP 'Too short' B Exit_Release Now go to exit Test_Bracket DS 0H LA R5,2(R1) Point to parameter ST R5,Passed_Parm Save parameter string BCTR R3,0 Subtract 1 from length for execute XR R1,R1 Clear R1 EX R3,Scan_Chars scan for valid characters BZ All_Valid All valid - skip TM Flags,Message Flag set? BNO Exit_Release No - go to exit WTP 'Invalid Character Detected' B Exit_Release Now go to exit All_Valid DS 0H XR R1,R1 Clear R1 EX R3,Scan_Brack scan for a bracket BZ NO_Brack No Bracket - Skip LR R4,R1 Save location of bracket * ** We need to check for out of order brackets and () * CLI 1(R1),C')' Immediate close bracket? BNE Press_on TM Flags,Message Flag set? BNO Exit_Release No - go to exit WTP 'Invalid Port format' B Exit_Release Now go to exit Press_On DS 0H OI Flags,Do_Port Indicate that we have a port SR R4,R5 Find length to bracket ST R4,Parm_Length Save length to bracket LR R6,R3 Copy Parm length to R6 SR R6,R4 Length of port number? MVC Cond_Code,=F'8' Set default fail for Port LR R4,R1 Keep position safe LA R4,1(R4) Skip the open bracket XR R1,R1 Clear R1 EX R6,Scan_EndBrack scan for an End Bracket BNZ Port_validish TM Flags,Message Flag set? BNO Exit_Release No - go to exit WTP 'No end bracket for port' B Exit_Release Now go to exit Port_validish DS 0H SR R1,R4 Length of port ST R1,Port_Length Save length of port number BCTR R1,0 Decrease for move LA R7,5 Set maximum length SR R7,R1 Find remaining length BCTR R7,0 Decrease MVC Port_Number,=c'00000' Set zeros LA R5,Port_Number Load address of port number area LA R5,0(R7,R5) right justify with this EX R1,Move_Port Move the port number LR R6,R1 Put length into R4 for scan XR R1,R1 CLear R1 for result EX R6,Scan_Numbers Make sure all are numbers BZ All_Numbers If all numbers keep going TM Flags,Message Flag set? BNO Exit_Release No - go to exit WTP 'Invalid Numeric in Port' B Exit_Release Now go to exit All_Numbers DS 0H PACK DOUBLE,Port_Number(5) Pack the port address CVB R2,Double Make it easier to check C R2,High_Port Is the port number too high BNH Check_Low No - Go and check low value TM Flags,Message Flag set? BNO Exit_Release No - go to exit WTP 'Invalid Port range - Too high' B Exit_Release Now go to exit Check_Low DS 0H C R2,Low_Port Is the port number too low BNL Port_OK No - Go and check low value TM Flags,Message Flag set? BNO Exit_Release No - go to exit WTP 'Invalid Port range - Too low' B Exit_Release Now go to exit Port_OK DS 0H No_Brack DS 0H MVC Cond_Code,=F'16' Reset Condition code L R3,Parm_Length Restore parameter length BCTR R3,0 Subtract one for execute C R3,=F'15' New Maximum with no Port BH Too_Long Too Long? - Go issue message L R5,Passed_Parm Reload parm address EX R3,Move_Parm Save pass IP Address XC Counter,Counter Initialize counter L R9,Counter Load counter ST R5,LastDot Set last dot position Rescan DS 0H XR R1,R1 Clear for period scan EX R3,Scan_dot Find a period BZ Check_Count Go and check the counter LR R4,R1 Save register LA R1,1(R1) Skip the dot ST R1,LastDot Save it LA R9,1(R9) ** Increase counter ST R9,Counter * SR R4,R5 Calculate length C R4,=F'3' Is it longer than 3 digits? BNH CON_OK No - Skip TM Flags,Message Flag set? BNO Exit_Release No - go to exit WTP 'Invalid length in IP addrees' B Exit_Release Now go to exit CON_OK DS 0H LA R7,4 Set maximum length SR R7,R4 Find remaining length MVC Con_Addr,=c'0000' Set zeros LA R6,Con_Addr Load address of Con_Addr area LA R6,0(R7,R6) right justify with this BCTR R4,0 Reduce for move EX R4,Move_Con Move the address LA R4,1(R4) Restore actual length PACK DOUBLE,Con_Addr(4) Pack the Con address CVB R2,Double Make it easier to check C R2,=F'255' Is it higher then 255? BNH Not_Too_High No - Skip TM Flags,Message Flag set? BNO Exit_Release No - go to exit WTP 'Invalid IP Address - > 255' B Exit_Release Now go to exit Not_Too_High DS 0H LTR R2,R2 Is it zero? BNZ So_far_so_Good No - we should be fine CLC Counter,=F'1' Is it the first level BNE So_far_so_Good No - we should be fine TM Flags,Message Flag set? BNO Exit_Release No - go to exit WTP 'Invalid IP Address - Zero first level' B Exit_Release Now go to exit So_far_so_Good DS 0H L R5,LastDot Skip the dot LA R4,1(R4) Account for the dot SR R3,R4 Decrease by our length LTR R3,R3 Are we at the end yet? BZ Check_Count Yes - Go and check dot count BCTR R3,0 Account for the found dot C R9,=f'4' Check number of dots BNE Rescan If it isn't 4 rescan TM Flags,Message Flag set? BNO Exit_Release No - go to exit WTP 'Too many dots in address' B Exit_Release Now go to exit Check_Count DS 0H L R1,Counter Load counter C R1,=F'3' Have we had too many periods? BNE Exit_Release No - Go and exit XC Cond_Code,Cond_Code Set condition code 0 Exit_Release DS 0H L R5,Cond_Code Load our condition code LA R2,IPDSect_Length Get length for storage size STORAGE RELEASE,ADDR=(11),LENGTH=(R2) LR R15,R5 Load return code into R15 EOJ C=(R15) Return to caller Boom EX R15,Boom *---------------------------------------------------------------------* * Executed Instructions * *---------------------------------------------------------------------* Scan_Dot TRT 0(*-*,R5),TRTABLE Scan_Chars TRT 0(*-*,R5),TRTABLE2 Scan_Numbers TRT 0(*-*,R5),TRTABLE3 Scan_BRACK TRT 0(*-*,R5),TRTABLE4 Scan_EndBrack TRT 0(*-*,R4),TRTABLE5 Move_Port MVC 0(*-*,R5),0(R4) Move_Parm MVC IP_Address(*-*),0(R5) Move_Con MVC 0(*-*,R6),0(R5) *---------------------------------------------------------------------* * End of Executed Instructions * *---------------------------------------------------------------------* * High and Low Port Numbers s * *---------------------------------------------------------------------* High_Port DC F'65535' Highest port number allowed Low_Port DC F'1024' Lowest port number allowed *---------------------------------------------------------------------* * End of Port Numbers * *---------------------------------------------------------------------* TRTABLE DS 0CL256 * 0 1 2 3 4 5 6 7 8 9 A B C D E F DC X'00000000000000000000000000000000' 00-0F DC X'00000000000000000000000000000000' 10-1F DC X'00000000000000000000000000000000' 20-2F DC X'00000000000000000000000000000000' 30-3F DC X'00000000000000000000004B00000000' 40-4F DC X'00000000000000000000000000000000' 50-5F DC X'00000000000000000000000000000000' 60-6F DC X'00000000000000000000000000000000' 70-7F DC X'00000000000000000000000000000000' 80-8F DC X'00000000000000000000000000000000' 90-9F DC X'00000000000000000000000000000000' A0-AF DC X'00000000000000000000000000000000' B0-BF DC X'00000000000000000000000000000000' C0-CF DC X'00000000000000000000000000000000' D0-DF DC X'00000000000000000000000000000000' E0-EF DC X'00000000000000000000000000000000' F0-FF ORG TRTABLE2 DS 0CL256 * 0 1 2 3 4 5 6 7 8 9 A B C D E F DC X'400102030405060708090A0B0C0D0E0F' 00-0F DC X'101112131415161718191A1B1C1D1E1F' 10-1F DC X'202122232425262728292A2B2C2D2E2F' 20-2F DC X'303132333435363738393A3B3C3D3E3F' 30-3F DC X'404142434445464748494A004C004E4F' 40-4F DC X'505152535455565758595A5B5C005E5F' 50-5F DC X'606162636465666768696A6B6C6D6E6F' 60-6F DC X'707172737475767778797A7B7C7D7E7F' 70-7F DC X'808182838485868788898A8B8C8D8E8F' 80-8F DC X'909192939495969798999A9B9C9D9E9F' 90-9F DC X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF' A0-AF DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' B0-BF DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' C0-CF DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' D0-DF DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' E0-EF DC X'00000000000000000000000000000000' F0-FF ORG TRTABLE3 DS 0CL256 * 0 1 2 3 4 5 6 7 8 9 A B C D E F DC X'400102030405060708090A0B0C0D0E0F' 00-0F DC X'101112131415161718191A1B1C1D1E1F' 10-1F DC X'202122232425262728292A2B2C2D2E2F' 20-2F DC X'303132333435363738393A3B3C3D3E3F' 30-3F DC X'404142434445464748494A4B4C4D4E4F' 40-4F DC X'505152535455565758595A5B5C5D5E5F' 50-5F DC X'606162636465666768696A6B6C6D6E6F' 60-6F DC X'707172737475767778797A7B7C7D7E7F' 70-7F DC X'808182838485868788898A8B8C8D8E8F' 80-8F DC X'909192939495969798999A9B9C9D9E9F' 90-9F DC X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF' A0-AF DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' B0-BF DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' C0-CF DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' D0-DF DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' E0-EF DC X'00000000000000000000000000000000' F0-FF ORG TRTNUMB DS 256XL1'00' ORG TRTNUMB+C'0' DC CL10'0123456789' ORG TRTABLE4 DS 256XL1'00' ORG TRTABLE4+C'(' DC CL1'(' ORG TRTABLE5 DS 256XL1'00' ORG TRTABLE5+C')' DC CL1')' LTORG *---------------------------------------------------------------------* * Start of IPDSect data mapping * *---------------------------------------------------------------------* IPDsect DSECT Double DS 0D Force align to double word boundry Fullword1 DS F First fullword Fullword2 DS F Passed_Parm DS F To preserve the passed parameter address Parm_Length DS F For saving length of IP address Cond_Code DS F For condition code Counter DS F For counting periods LastDot DS F Save poistion of last period Con_Addr DS F Save area for cononical address Port_number DS CL6 Save area for port number Port_Length DS F For saving length of port IP_Address DS CL15 Save area for IP address Flags DS XL1 Message EQU B'00000001' Write error message flag Do_Port EQU B'00000010' Process IP Port *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* * Save Areas * *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* IPDSect_End EQU * IPDSect_Length EQU IPDSect_ENd-IPDSect Length of IP DSect *---------------------------------------------------------------------* * End of IPDSect data mapping * *---------------------------------------------------------------------* *---------------------------------------------------------------------* * End of ASLIPVLD * *---------------------------------------------------------------------* END ASLIPVLD PUNCH ' MODE AMODE(31)' Binder AMODE statement. PUNCH ' MODE RMODE(ANY)' Binder RMODE statement. PUNCH ' ENTRY ASLIPVLD' Module entry point. PUNCH ' ALIAS VALIDIP' Binder Module Alias. PUNCH ' NAME ASLIPVLD(R)' Module name.. END